mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-20 11:48:30 -06:00
[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:
parent
0212537cca
commit
5f6b9946d4
@ -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)))))))
|
||||
|
||||
;; ***************************************************************************
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user