Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 18267: Refactored Edifact Price Calculations

Browse source 
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 <kyle@bywatersolutions.com>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
This commit is contained in:
Colin Campbell 2020-11-12 11:42:05 +00:00 committed by Jonathan Druart
parent ea725f4724
commit 36d46c6510
4 changed files with 198 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

132
Koha/EDI.pm
View file

@ -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;
}
return $price;
# invoices give amounts per orderline, Koha requires that we store
# them per item
if ( $qty != 1 ) {
return ( $line_total / $qty, $excl_tax / $qty );
}
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

74
Koha/Edifact/Line.pm
View file

@ -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} ) {

26
t/EdiInvoice.t
View file

@ -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');

15
t/Edifact.t
View file

@ -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');