[report-utilities] bugfix: fix overpayment detection

For 1 payment to >1 invoices, previous would miscalculate overpayment.

Old overpayment definition -- from the payment amount, successively
subtract the invoice totals. If remaining is >0, then this is
overpayment. But this fails whereby invoice was partially paid
elsewhere because the overpayment would miss them.

New overpayment definition -- the payment txn is analysed, and all
APAR-splits' lots are analysed. Any lot with no invoice is a
prepayment.

This is a simpler algorithm and does not require the creation and
searching of invoices-and-splits.
This commit is contained in:
Christopher Lam 2019-12-11 19:54:08 +08:00
parent 0212537cca
commit 5f6b9946d4

View File

@ -1140,19 +1140,17 @@ flawed. see report-utilities.scm. please update reports.")
(buckets (make-vector num-buckets 0)))
(define (addbucket! idx amt)
(vector-set! buckets idx (+ amt (vector-ref buckets idx))))
(let lp ((splits splits)
(invoices-and-splits '()))
(let lp ((splits splits))
(cond
((null? splits)
(vector->list buckets))
;; next split is an invoice posting split. add its balance to
;; bucket, and add splits to invoices-and-splits for payments.
;; bucket
((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits)))
TXN-TYPE-INVOICE)
(let* ((invoice (gncInvoiceGetInvoiceFromTxn
(xaccSplitGetParent (car splits))))
(inv-splits (gnc-lot-get-split-list (gncInvoiceGetPostedLot invoice)))
(lot (gncInvoiceGetPostedLot invoice))
(bal (gnc-lot-get-balance lot))
(bal (if receivable? bal (- bal)))
@ -1165,33 +1163,31 @@ flawed. see report-utilities.scm. please update reports.")
(if (< date (car bucket-dates))
(addbucket! idx bal)
(loop (1+ idx) (cdr bucket-dates))))
(lp (cdr splits)
(cons (cons invoice inv-splits) invoices-and-splits))))
(lp (cdr splits))))
;; next split is a payment. find the associated invoices,
;; deduct their totals. the remaining is an overpayment.
;; next split is a payment. analyse its sister APAR splits. any
;; split whose lot-balance is negative is an overpayment.
((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits)))
TXN-TYPE-PAYMENT)
(let* ((txn (xaccSplitGetParent (car splits)))
(payment (apply + (map xaccSplitGetAmount
(xaccTransGetAPARAcctSplitList txn #f))))
(splitlist (xaccTransGetAPARAcctSplitList txn #f))
(payment (apply + (map xaccSplitGetAmount splitlist)))
(overpayment
(fold
(lambda (inv-and-splits payment-left)
(if (member txn (map xaccSplitGetParent (cdr inv-and-splits)))
(- payment-left (gncInvoiceGetTotal (car inv-and-splits)))
payment-left))
(if receivable? (- payment) payment) invoices-and-splits)))
(lambda (a b)
(if (null? (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot a)))
(- b (xaccSplitGetAmount a))
b))
0 splitlist)))
(gnc:msg "next " (gnc:strify (car splits)) " payment " payment
" overpayment " overpayment)
(when (positive? overpayment)
(addbucket! (1- num-buckets) (- overpayment)))
(lp (cdr splits) invoices-and-splits)))
(addbucket! (1- num-buckets) (- overpayment))
(lp (cdr splits))))
;; not invoice/prepayment. regular or payment split.
(else
(gnc:msg "next " (gnc:strify (car splits)) " skipped")
(lp (cdr splits) invoices-and-splits))))))
(lp (cdr splits)))))))
;; ***************************************************************************