From 36d46c6510ee93ffc52f6b914389c66351b16f33 Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Thu, 12 Nov 2020 11:42:05 +0000 Subject: [PATCH] Bug 18267: Refactored Edifact Price Calculations Refactored the price calculations for Quotes and Invoices This takes in to account various combinations used by different vendors. Makes the extraction of basic price, quantity and tax information more reliable. Tests are in Edifact.t and EdiInvoice.t Signed-off-by: Kyle M Hall Signed-off-by: Jonathan Druart --- Koha/EDI.pm | 132 +++++++++++++++++++++++++++++-------------- Koha/Edifact/Line.pm | 74 ++++++++++++++++++++++-- t/EdiInvoice.t | 26 ++++++++- t/Edifact.t | 15 ++++- 4 files changed, 198 insertions(+), 49 deletions(-) diff --git a/Koha/EDI.pm b/Koha/EDI.pm index 445998d51e..2de2b8bf08 100644 --- a/Koha/EDI.pm +++ b/Koha/EDI.pm @@ -315,40 +315,57 @@ sub process_invoice { } ); } + # If quantity_invoiced is present use it in preference + my $quantity = $line->quantity_invoiced; + if (!$quantity) { + $quantity = $line->quantity; + } - my $price = _get_invoiced_price($line); + my ( $price, $price_excl_tax ) = _get_invoiced_price($line, $quantity); + my $tax_rate = $line->tax_rate; + if ($tax_rate && $tax_rate->{rate} != 0) { + $tax_rate->{rate} /= 100; + } - if ( $order->quantity > $line->quantity ) { + if ( $order->quantity > $quantity ) { my $ordered = $order->quantity; # part receipt $order->orderstatus('partial'); - $order->quantity( $ordered - $line->quantity ); + $order->quantity( $ordered - $quantity ); $order->update; my $received_order = $order->copy( { - ordernumber => undef, - quantity => $line->quantity, - quantityreceived => $line->quantity, - orderstatus => 'complete', - unitprice => $price, - invoiceid => $invoiceid, - datereceived => $msg_date, + ordernumber => undef, + quantity => $quantity, + quantityreceived => $quantity, + orderstatus => 'complete', + unitprice => $price, + unitprice_tax_included => $price, + unitprice_tax_excluded => $price_excl_tax, + invoiceid => $invoiceid, + datereceived => $msg_date, + tax_rate_on_receiving => $tax_rate->{rate}, + tax_value_on_receiving => $quantity * $price_excl_tax * $tax_rate->{rate}, } ); transfer_items( $schema, $line, $order, - $received_order ); + $received_order, $quantity ); receipt_items( $schema, $line, - $received_order->ordernumber ); + $received_order->ordernumber, $quantity ); } else { # simple receipt all copies on order - $order->quantityreceived( $line->quantity ); + $order->quantityreceived( $quantity ); $order->datereceived($msg_date); $order->invoiceid($invoiceid); $order->unitprice($price); + $order->unitprice_tax_excluded($price_excl_tax); + $order->unitprice_tax_included($price); + $order->tax_rate_on_receiving($tax_rate->{rate}); + $order->tax_value_on_receiving( $quantity * $price_excl_tax * $tax_rate->{rate}); $order->orderstatus('complete'); $order->update; - receipt_items( $schema, $line, $ordernumber ); + receipt_items( $schema, $line, $ordernumber, $quantity ); } } else { @@ -369,21 +386,33 @@ sub process_invoice { } sub _get_invoiced_price { - my $line = shift; - my $price = $line->price_net; - if ( !defined $price ) { # no net price so generate it from lineitem amount - $price = $line->amt_lineitem; - if ( $price and $line->quantity > 1 ) { - $price /= $line->quantity; # div line cost by qty + my $line = shift; + my $qty = shift; + my $line_total = $line->amt_total; + my $excl_tax = $line->amt_lineitem; + + # If no tax some suppliers omit the total owed + # If no total given calculate from cost exclusive of tax + # + tax amount (if present, sometimes omitted if 0 ) + if ( !defined $line_total ) { + my $x = $line->amt_taxoncharge; + if ( !defined $x ) { + $x = 0; } + $line_total = $excl_tax + $x; + } + + # invoices give amounts per orderline, Koha requires that we store + # them per item + if ( $qty != 1 ) { + return ( $line_total / $qty, $excl_tax / $qty ); } - return $price; + return ( $line_total, $excl_tax ); # return as is for most common case } sub receipt_items { - my ( $schema, $inv_line, $ordernumber ) = @_; + my ( $schema, $inv_line, $ordernumber, $quantity ) = @_; my $logger = Log::Log4perl->get_logger(); - my $quantity = $inv_line->quantity; # itemnumber is not a foreign key ??? makes this a bit cumbersome my @item_links = $schema->resultset('AqordersItem')->search( @@ -469,10 +498,9 @@ sub receipt_items { } sub transfer_items { - my ( $schema, $inv_line, $order_from, $order_to ) = @_; + my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_; # Transfer x items from the orig order to a completed partial order - my $quantity = $inv_line->quantity; my $gocc = 0; my %mapped_by_branch; while ( $gocc < $quantity ) { @@ -638,26 +666,37 @@ sub quote_item { } $order_quantity = 1; # attempts to create an orderline for each gir } + my $price = $item->price_info; + # Howells do not send an info price but do have a gross price + if (!$price) { + $price = $item->price_gross; + } my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id ); + # NB quote will not include tax info it only contains the list price + my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive ); + # database definitions should set some of these defaults but dont my $order_hash = { biblionumber => $bib->{biblionumber}, entrydate => dt_from_string()->ymd(), basketno => $basketno, - listprice => $item->price, + listprice => $price, quantity => $order_quantity, quantityreceived => 0, order_vendornote => q{}, order_internalnote => $order_note, - replacementprice => $item->price, - rrp_tax_included => $item->price, - rrp_tax_excluded => $item->price, - ecost => _discounted_price( $quote->vendor->discount, $item->price ), - uncertainprice => 0, - sort1 => q{}, - sort2 => q{}, - currency => $vendor->listprice(), + replacementprice => $price, + rrp_tax_included => $price, + rrp_tax_excluded => $price, + rrp => $price, + ecost => $ecost, + ecost_tax_included => $ecost, + ecost_tax_excluded => $ecost, + uncertainprice => 0, + sort1 => q{}, + sort2 => q{}, + currency => $vendor->listprice(), }; # suppliers references @@ -884,8 +923,8 @@ sub quote_item { notforloan => -1, cn_sort => q{}, cn_source => 'ddc', - price => $item->price, - replacementprice => $item->price, + price => $price, + replacementprice => $price, itype => $item->girfield( 'stock_category', $occurrence ), location => @@ -946,7 +985,13 @@ sub get_edifact_ean { # We should not need to have a routine to do this here sub _discounted_price { - my ( $discount, $price ) = @_; + my ( $discount, $price, $discounted_price ) = @_; + if (defined $discounted_price) { + return $discounted_price; + } + if (!$price) { + return 0; + } return $price - ( ( $discount * $price ) / 100 ); } @@ -1180,7 +1225,7 @@ Koha::EDI =head2 receipt_items - receipt_items( schema_obj, invoice_line, ordernumber) + receipt_items( schema_obj, invoice_line, ordernumber, $quantity) receipts the items recorded on this invoice line @@ -1188,7 +1233,7 @@ Koha::EDI =head2 transfer_items - transfer_items(schema, invoice_line, originating_order, receiving_order) + transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity) Transfer the items covered by this invoice line from their original order to another order recording the partial fulfillment of the original @@ -1241,16 +1286,19 @@ Koha::EDI =head2 _get_invoiced_price - _get_invoiced_price(line_object) + (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity) - Returns the net price or an equivalent calculated from line cost / qty + Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem + monetary fields =head2 _discounted_price - ecost = _discounted_price(discount, item_price) + ecost = _discounted_price(discount, item_price, discounted_price) utility subroutine to return a price calculated from the vendors discount and quoted price + if invoice has a field containing discounted price that is returned + instead of recalculating =head2 _check_for_existing_bib diff --git a/Koha/Edifact/Line.pm b/Koha/Edifact/Line.pm index 5f51284156..8d14ba5e5f 100644 --- a/Koha/Edifact/Line.pm +++ b/Koha/Edifact/Line.pm @@ -64,6 +64,9 @@ sub _parse_lines { push @item_description, $s; } elsif ( $s->tag eq 'QTY' ) { + if ( $s->elem( 0, 0 ) eq '47' ) { + $d->{quantity_invoiced} = $s->elem( 0, 1 ); + } $d->{quantity} = $s->elem( 0, 1 ); } elsif ( $s->tag eq 'DTM' ) { @@ -379,6 +382,11 @@ sub quantity { return $self->{quantity}; } +sub quantity_invoiced { + my $self = shift; + return $self->{quantity_invoiced}; +} + sub price { my $self = shift; return $self->{price}; @@ -716,6 +724,22 @@ sub moa_amt { } return; } +sub moa_multiple_amt { + my ( $self, $qualifier ) = @_; + # return a repeatable MOA field + my $amt = 0; + my $found = 0; + foreach my $s ( @{ $self->{segs} } ) { + if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) { + $amt += $s->elem( 0, 1 ); + $found = 1; + } + } + if ($found) { + return $amt; + } + return; +} sub amt_discount { my $self = shift; @@ -744,16 +768,32 @@ sub amt_lineitem { my $self = shift; return $self->moa_amt('203'); } +sub amt_taxoncharge { + my $self = shift; + return $self->moa_multiple_amt('124'); +} sub pri_price { my ( $self, $price_qualifier ) = @_; + # In practice qualifier is AAE in the quote and AAA & AAB in invoices + # but the following are defined + # AAA calculation price net (unit price excl tax but incl any allowances or charges) + # AAB calculation price gross (unit price excl all taxes, allowances and charges ) + # AAE information price (incl tax but excl allowances or charges ) + # AAF information price (including all taxes, allowances or charges) foreach my $s ( @{ $self->{segs} } ) { if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) { - return { - price => $s->elem( 0, 1 ), - type => $s->elem( 0, 2 ), - type_qualifier => $s->elem( 0, 3 ), + # in practice not all 3 fields may be present + # so use a temp variable to avoid runtime warnings + my $p = { + price => undef, + type => undef, + type_qualifier => undef, }; + $p->{price} = $s->elem( 0, 1 ); + $p->{type} = $s->elem( 0, 2 ); + $p->{type_qualifier} = $s->elem( 0, 3 ); + return $p; } } return; @@ -792,7 +832,7 @@ sub price_info { # information price incl tax,allowances, charges sub price_info_inclusive { my $self = shift; - my $p = $self->pri_price('AAE'); + my $p = $self->pri_price('AAF'); if ( defined $p ) { return $p->{price}; } @@ -804,6 +844,30 @@ sub tax { return $self->moa_amt('124'); } +sub tax_rate { + my $self = shift; + my $tr = {}; + foreach my $s ( @{ $self->{segs} } ) { + if ( $s->tag eq 'TAX' && $s->elem( 0, 0 ) == 7 ) { + $tr->{type} = $s->elem( 1, 0 ); # VAT, GST or IMP + $tr->{rate} = $s->elem( 4, 3 ); # percentage + # category values may be: + # E = exempt from tax + # G = export item, tax not charged + # H = higher rate + # L = lower rate + # S = standard rate + # Z = zero-rated + $tr->{category} = $s->elem( 5, 0 ); + if (!defined $tr->{rate} && $tr->{category} eq 'Z') { + $tr->{rate} = 0; + } + return $tr; + } + } + return; +} + sub availability_date { my $self = shift; if ( exists $self->{availability_date} ) { diff --git a/t/EdiInvoice.t b/t/EdiInvoice.t index 14e7596486..3800b75126 100755 --- a/t/EdiInvoice.t +++ b/t/EdiInvoice.t @@ -3,7 +3,8 @@ use strict; use warnings; use FindBin qw( $Bin ); -use Test::More tests => 19; +use Test::More tests => 26; +use Koha::EDI; BEGIN { use_ok('Koha::Edifact') } @@ -70,6 +71,29 @@ my $lineprice = $lines->[7]->price_net; is( $lineprice, 4.55, 'correct net line price returned' ); +$lineprice = $lines->[7]->price_gross; + +is( $lineprice, 7.99, 'correct gross line price returned' ); + my $tax = $lines->[7]->tax; is( $tax, 0, 'correct tax amount returned' ); + +my $tax_rate = $lines->[7]->tax_rate; + +is( $tax_rate->{rate}, 0.0, 'correct tax rate returned' ); + +my $tax_on_charge = $lines->[7]->amt_taxoncharge; + +is( $tax_on_charge, 0, 'correct tax on charge value returned' ); + +my $qty_invoiced = $lines->[7]->quantity_invoiced; + +is( $qty_invoiced, 1, 'quantity_invoiced returns correct value' ); + +my ($lt, $excl) = Koha::EDI::_get_invoiced_price($lines->[7], 1); +is( $lt, 4.55, 'invoiced price calculated'); +is($excl, 4.55, 'Price excluding tax returned correctly'); + +($lt, $excl) = Koha::EDI::_get_invoiced_price($lines->[7], 2); +is( $lt, 4.55 / 2, 'invoiced pricei calculated for copies > 1'); diff --git a/t/Edifact.t b/t/Edifact.t index 6dedeac3a2..2e5de55a22 100755 --- a/t/Edifact.t +++ b/t/Edifact.t @@ -3,7 +3,8 @@ use strict; use warnings; use FindBin qw( $Bin ); -use Test::More tests => 35; +use Test::More tests => 40; +use Koha::EDI; BEGIN { use_ok('Koha::Edifact') } @@ -52,6 +53,8 @@ my $test_line = $lin->[-1]; is( $test_line->line_item_number, 18, 'correct line number returned' ); is( $test_line->item_number_id, '9780273761006', 'correct ean returned' ); is( $test_line->quantity, 1, 'quantity returned' ); +is( $test_line->price_info, 114.97, 'price returned' ); +is( $test_line->price_info_inclusive, undef, 'discounted price undefined as expected' ); my $test_title = 'International business [electronic resource]'; my $marcrec = $test_line->marc_record; @@ -120,3 +123,13 @@ is( $y, 'ANF', 'Collection code returned' ); $y = $ol->girfield( 'stock_category', 4 ); is( $y, 'RS', 'Copy stock category returned' ); + +# test internal routines for prices +my $dp = Koha::EDI::_discounted_price(33.0, 9); +is( $dp, 6.03, 'Discount calculated' ); + +$dp = Koha::EDI::_discounted_price(0.0, 9); +is( $dp, 9.0, 'Discount calculated with discount = 0' ); + +$dp = Koha::EDI::_discounted_price(0.0, 9, 8.0); +is( $dp, 8.0, 'Discount overriden by incoming calculated value'); -- 2.39.5