[report-utilities] fix: overpayments in gnc:owner-splits->aging-list

Previous algorithm had assumed all payments would match attached
invoices. This updated algorithm does not assume.

Invoice: add into appropriate bucket and save invoice+splits into
list.

Payment: scan payments from invoice+splits to find appropriate
invoice, and deduct from the transfer account. The remainder is an
pre/overpayment and added into prepayment bucket.

It will always assume that the splitlist being processed will *all*
belong to one owner.
This commit is contained in:
Christopher Lam 2019-11-10 23:42:26 +08:00
parent 980776f46f
commit 3d5d8191dd

View File

@ -1114,18 +1114,19 @@ flawed. see report-utilities.scm. please update reports.")
(buckets (make-vector num-buckets 0))) (buckets (make-vector num-buckets 0)))
(define (addbucket! idx amt) (define (addbucket! idx amt)
(vector-set! buckets idx (+ amt (vector-ref buckets idx)))) (vector-set! buckets idx (+ amt (vector-ref buckets idx))))
(let lp ((splits splits)) (let lp ((splits splits)
(invoices-and-splits '()))
(cond (cond
((null? splits) ((null? splits)
(vector->list buckets)) (vector->list buckets))
;; next split is an invoice posting split. note we don't need ;; next split is an invoice posting split. add its balance to
;; to handle invoice payments because these payments will ;; bucket, and add splits to invoices-and-splits for payments.
;; reduce the lot balance automatically.
((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits))) ((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits)))
TXN-TYPE-INVOICE) TXN-TYPE-INVOICE)
(let* ((invoice (gncInvoiceGetInvoiceFromTxn (let* ((invoice (gncInvoiceGetInvoiceFromTxn
(xaccSplitGetParent (car splits)))) (xaccSplitGetParent (car splits))))
(inv-splits (gnc-lot-get-split-list (gncInvoiceGetPostedLot invoice)))
(lot (gncInvoiceGetPostedLot invoice)) (lot (gncInvoiceGetPostedLot invoice))
(bal (gnc-lot-get-balance lot)) (bal (gnc-lot-get-balance lot))
(bal (if receivable? bal (- bal))) (bal (if receivable? bal (- bal)))
@ -1136,23 +1137,33 @@ flawed. see report-utilities.scm. please update reports.")
(let loop ((idx 0) (bucket-dates bucket-dates)) (let loop ((idx 0) (bucket-dates bucket-dates))
(if (< date (car bucket-dates)) (if (< date (car bucket-dates))
(addbucket! idx bal) (addbucket! idx bal)
(loop (1+ idx) (cdr bucket-dates))))) (loop (1+ idx) (cdr bucket-dates))))
(lp (cdr splits))) (lp (cdr splits)
(cons (cons invoice inv-splits) invoices-and-splits))))
;; next split is a prepayment ;; next split is a payment. find the associated invoices,
((and (eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits))) ;; deduct their totals. the remaining is an overpayment.
((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits)))
TXN-TYPE-PAYMENT) TXN-TYPE-PAYMENT)
(null? (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot (car splits))))) (let* ((txn (xaccSplitGetParent (car splits)))
(let* ((prepay (xaccSplitGetAmount (car splits))) (payment (apply + (map xaccSplitGetAmount
(prepay (if receivable? prepay (- prepay)))) (xaccTransGetPaymentAcctSplitList txn))))
(gnc:pk 'next=prepay (car splits) prepay) (overpayment
(addbucket! (1- num-buckets) prepay)) (fold
(lp (cdr splits))) (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)))
(gnc:pk 'payment (car splits) payment "->" overpayment)
(when (positive? overpayment)
(addbucket! (1- num-buckets) (- overpayment)))
(lp (cdr splits) invoices-and-splits)))
;; not invoice/prepayment. regular or payment split. ;; not invoice/prepayment. regular or payment split.
(else (else
(gnc:pk 'next=skipped (car splits)) (gnc:pk 'next=skipped (car splits))
(lp (cdr splits))))))) (lp (cdr splits) invoices-and-splits))))))
;; *************************************************************************** ;; ***************************************************************************