From bf19d2c8487f7277721c386175a3147621f32872 Mon Sep 17 00:00:00 2001 From: Bill Erickson Date: Mon, 3 Dec 2012 14:51:41 -0500 Subject: [PATCH] EDI response honor lineitem-level status; debit cleanup * Honor lineitem-level order status info (FTX+LIN) which indicates, in some cases, that all ordered copies should be cancelled because the LI as a whole is cancelled * Delete fund debits for cancelled lineitem details when appropriate Signed-off-by: Bill Erickson Signed-off-by: Lebbeous Fogle-Weekley --- .../perlmods/lib/OpenILS/Application/Acq/EDI.pm | 169 +++++++++++++++++---- .../src/perlmods/lib/OpenILS/Utils/EDIReader.pm | 6 +- Open-ILS/src/sql/Pg/950.data.seed-values.sql | 1 + .../upgrade/XXXX.data.acq_cancel_not_accepted.sql | 14 ++ 4 files changed, 159 insertions(+), 31 deletions(-) create mode 100644 Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm index 1ed4697c96..dbabd2550d 100644 --- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm +++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm @@ -15,6 +15,8 @@ use OpenILS::Utils::RemoteAccount; use OpenILS::Utils::CStoreEditor q/new_editor/; use OpenILS::Utils::Fieldmapper; use OpenILS::Application::Acq::EDI::Translator; +use OpenILS::Application::AppUtils; +my $U = 'OpenILS::Application::AppUtils'; use OpenILS::Utils::EDIReader; @@ -442,7 +444,7 @@ sub process_parsed_msg { my $li = $e->retrieve_acq_lineitem($li_id); if (!$li) { - $logger->error("EDI: reqest for invalid lineitem ID '$li_id'"); + $logger->error("EDI: request for invalid lineitem ID '$li_id'"); $e->rollback; next; } @@ -473,19 +475,23 @@ sub process_parsed_msg { my $lids = $e->json_query({ select => {acqlid => ['id']}, from => 'acqlid', - where => { lineitem => $li->id } + where => {lineitem => $li->id} }); my @lids = map { $_->{id} } @$lids; my $lid_count = scalar(@lids); my $lids_covered = 0; - my $lids_touched = 0; - + my $lids_cancelled = 0; + my $order_qty; + my $dispatch_qty; + for my $qty (@{$li_hash->{quantities}}) { - my $qty_count = $qty->{quantity} or next; + my $qty_count = $qty->{quantity}; my $qty_code = $qty->{code}; + next unless defined $qty_count; + if (!$qty_code) { $logger->warn("EDI: Response for LI $li_id specifies quantity ". "$qty_count with no 6063 code! Contact vendor to resolve."); @@ -495,6 +501,7 @@ sub process_parsed_msg { $logger->info("EDI: LI $li_id processing quantity count=$qty_count / code=$qty_code"); if ($qty_code eq '21') { # "ordered quantity" + $order_qty = $qty_count; $logger->info("EDI: LI $li_id -- vendor confirms $qty_count ordered"); $logger->warn("EDI: LI $li_id -- order count $qty_count ". "does not match LID count $lid_count") unless $qty_count == $lid_count; @@ -504,6 +511,7 @@ sub process_parsed_msg { $lids_covered += $qty_count; if ($qty_code eq '12') { + $dispatch_qty = $qty_count; $logger->info("EDI: LI $li_id -- vendor dispatched $qty_count"); next; @@ -527,43 +535,144 @@ sub process_parsed_msg { next; } - my $break = 0; - foreach (1 .. $qty_count) { + my ($cancel_count, $fatal) = + $class->cancel_lids($e, $eg_reason, $qty_count, $lid_count, \@lids); - my $lid_id = shift @lids; - if (!$lid_id) { - $logger->warn("EDI: Used up all $lid_count LIDs. ". - "Ignoring extra status '" . $eg_reason->label . "'"); - last; - } + last if $fatal; - my $lid = $e->retrieve_acq_lineitem_detail($lid_id); - $lid->cancel_reason($eg_reason->id); - $e->update_acq_lineitem_detail($lid); - $lids_touched++; + $lids_cancelled += $cancel_count; - # if ALL the items have the same cancel_reason, the LI gets it too - $li->cancel_reason($eg_reason->id) if $qty_count == $lid_count; + # if ALL the items have the same cancel_reason, the LI gets it too + $li->cancel_reason($eg_reason->id) if $qty_count == $lid_count; - $li->edit_time('now'); - unless ($e->update_acq_lineitem($li)) { - $logger->error("EDI: update_acq_lineitem failed " . $e->die_event); - $break = 1; - last; - } + $li->edit_time('now'); + unless ($e->update_acq_lineitem($li)) { + $logger->error("EDI: update_acq_lineitem failed " . $e->die_event); + last; } + } + + # in case the provider neglected to echo back the order count + $order_qty = $lid_count unless defined $order_qty; + + # it may be necessary to change the logic here to look for lineitem + # order status / availability status instead of dispatch_qty and + # assume that dispatch_qty simply equals the number of unaccounted-for copies + if (defined $dispatch_qty) { + # provider is telling us how may copies were delivered + + # number of copies neither cancelled or delivered + my $remaining_lids = $order_qty - ($dispatch_qty + $lids_cancelled); + + if ($remaining_lids > 0) { + + # the vendor did not ship all items and failed to provide cancellation + # quantities for some or all of the items to be cancelled. When this + # happens, we cancel the remaining un-delivered copies using the + # lineitem order status to determine the cancel reason. + + my $reason_id; + my $stat; + + if ($stat = $li_hash->{order_status}) { + $logger->info("EDI: lineitem has order status $stat"); + + if ($stat eq '200') { + $reason_id = 1007; # not accepted + + } elsif ($stat eq '400') { + $reason_id = 1283; # back-order + } + + } elsif ($stat = $li_hash->{avail_status}) { + $logger->info("EDI: lineitem has availability status $stat"); + + if ($stat eq 'NP') { + # not yet published + # TODO: needs cancellation? + } + } + + if ($reason_id) { + my $reason = $e->retrieve_acq_cancel_reason($reason_id); + + my ($cancel_count, $fatal) = + $class->cancel_lids($e, $reason, $remaining_lids, $lid_count, \@lids); + + last if $fatal; + $lids_cancelled += $cancel_count; + + # All LIDs cancelled with same reason, apply + # the same cancel reason to the lineitem + $li->cancel_reason($reason->id) if $remaining_lids == $order_qty; + + $li->edit_time('now'); + unless ($e->update_acq_lineitem($li)) { + $logger->error("EDI: update_acq_lineitem failed " . $e->die_event); + last; + } - # non-recoverable transaction error - # note in this case the commit below will be a silent no-op - last if $break; + } else { + $logger->warn("EDI: vendor says we ordered $order_qty and cancelled ". + "$lids_cancelled, but only shipped $dispatch_qty"); + } + } } # LI and LIDs updated, let's wrap this one up. + # this is a no-op if the xact has already been rolled back $e->commit; - $logger->info("EDI LI $li_id -- $lids_covered LIDs mentioned; ". - "$lids_touched LIDs had cancel_reason's applied"); + $logger->info("EDI: LI $li_id -- $order_qty LIDs ordered; ". + "$lids_cancelled LIDs cancelled"); + } +} + +sub cancel_lids { + my ($class, $e, $reason, $count, $lid_count, $lid_ids) = @_; + + my $cancel_count = 0; + + foreach (1 .. $count) { + + my $lid_id = shift @$lid_ids; + + if (!$lid_id) { + $logger->warn("EDI: Used up all $lid_count LIDs. ". + "Ignoring extra status '" . $reason->label . "'"); + last; + } + + my $lid = $e->retrieve_acq_lineitem_detail($lid_id); + $lid->cancel_reason($reason->id); + + # item is cancelled. Remove the fund debit. + unless ($U->is_true($reason->keep_debits)) { + + if (my $debit_id = $lid->fund_debit) { + + $lid->clear_fund_debit; + my $debit = $e->retrieve_acq_fund_debit($debit_id); + + if ($U->is_true($debit->encumbrance)) { + $logger->info("EDI: deleting debit $debit_id for cancelled LID $lid_id"); + + unless ($e->delete_acq_fund_debit($debit)) { + $logger->error("EDI: unable to update fund_debit " . $e->die_event); + return (0, 1); + } + } else { + # do not delete a paid-for debit + $logger->warn("EDI: cannot delete invoiced debit $debit_id"); + } + } + } + + $e->update_acq_lineitem_detail($lid); + $cancel_count++; } + + return ($cancel_count); } diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm index d3b5697545..e6c872e043 100644 --- a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm +++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm @@ -35,7 +35,11 @@ my %edi_li_fields = ( amount_billed => qr/^MOA\+203:(\d+)/, net_unit_price => qr/^PRI\+AAA:(\d+)/, gross_unit_price=> qr/^PRI\+AAB:(\d+)/, - expected_date => qr/^DTM\+44:([^:]+)/ + expected_date => qr/^DTM\+44:([^:]+)/, + avail_status => qr/^FTX\+LIN\++([^:]+):8B:28/, + # "1B" codes are deprecated, but still in use. + # Pretend it's "12B" and it should just work + order_status => qr/^FTX\+LIN\++([^:]+):12?B:28/ ); my %edi_li_ident_fields = ( diff --git a/Open-ILS/src/sql/Pg/950.data.seed-values.sql b/Open-ILS/src/sql/Pg/950.data.seed-values.sql index 9f2c2f2805..50b190b50d 100644 --- a/Open-ILS/src/sql/Pg/950.data.seed-values.sql +++ b/Open-ILS/src/sql/Pg/950.data.seed-values.sql @@ -8742,6 +8742,7 @@ INSERT INTO acq.cancel_reason (keep_debits, id, org_unit, label, description) VA ('t',( 3+1000), 1, 'Changed', 'The information is to be or has been changed.'), ('t',( 4+1000), 1, 'No action', 'This line item is not affected by the actual message.'), ('t',( 5+1000), 1, 'Accepted without amendment', 'This line item is entirely accepted by the seller.'), +('f',( 7+1000), 1, 'Not accepted', 'This line item is not accepted by the seller.'), ('f',( 10+1000), 1, 'Not found', 'This line item is not found in the referenced message.'), ('t',( 24+1000), 1, 'Accepted with amendment, no confirmation required', 'Accepted with changes which require no confirmation.'); diff --git a/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql b/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql new file mode 100644 index 0000000000..e8ed2a85f4 --- /dev/null +++ b/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql @@ -0,0 +1,14 @@ + +BEGIN; + +INSERT INTO acq.cancel_reason (keep_debits, id, org_unit, label, description) + VALUES ( + 'f', + 1007, + 1, + 'Not accepted', + 'This line item is not accepted by the seller.' + ); + +COMMIT; + -- 2.11.0