gnucash maint: Bug 797521 - Receivable Aging (beta): invoice->payments refined
Christopher Lam
clam at code.gnucash.org
Mon Dec 16 00:10:52 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/75dba612 (commit)
from https://github.com/Gnucash/gnucash/commit/5e7c2954 (commit)
commit 75dba61255c3382dafc4c029517e3c2eac6bb8cd
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 16 12:49:43 2019 +0800
Bug 797521 - Receivable Aging (beta): invoice->payments refined
* filter payments from lot's splits by split-is-payment?
* dedupe payments
* sort by payment posted date
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 1e6a20f9b..7e75cae53 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -180,6 +180,11 @@
(eqv? (xaccTransGetTxnType txn) TXN-TYPE-INVOICE))
(define (txn-is-payment? txn)
(eqv? (xaccTransGetTxnType txn) TXN-TYPE-PAYMENT))
+(define (split<? a b)
+ (< (xaccTransGetDate (xaccSplitGetParent a))
+ (xaccTransGetDate (xaccSplitGetParent b))))
+(define (split-is-payment? split)
+ (txn-is-payment? (xaccSplitGetParent split)))
(define (make-aging-table splits to-date payable? date-type currency)
(let ((table (gnc:make-html-table))
@@ -308,42 +313,33 @@
currency total #f #f #f #f (list (make-list link-cols #f))))
(define (make-invoice->payments-table invoice)
- (define lot (gncInvoiceGetPostedLot invoice))
- (let lp ((invoice-splits (gnc-lot-get-split-list lot))
- (result '()))
- (match invoice-splits
- ;; finished. test for underpayment and add outstanding balance
- (() (reverse
- (if (gncInvoiceIsPaid invoice)
- result
- (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
- (make-cell
- (gnc:make-gnc-monetary
- currency (AP-negate (gnc-lot-get-balance lot)))))
- result))))
-
- ;; invoice's lot's payment splits
- ((lot-split . rest-lot-splits)
- (let* ((lot-txn (xaccSplitGetParent lot-split))
- (tfr-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
- (let lp1 ((tfr-splits tfr-splits) (result result))
- (match tfr-splits
- (() (lp rest-lot-splits result))
- ((tfr-split . rest-tfr-splits)
- (let* ((tfr-acct (xaccSplitGetAccount tfr-split))
- (tfr-curr (xaccAccountGetCommodity tfr-acct))
- (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
- (lp1 rest-tfr-splits
- (cons (list
- (qof-print-date (xaccTransGetDate lot-txn))
- (let ((num (gnc-get-num-action lot-txn lot-split)))
- (if (string-null? num) (_ "Payment") num))
- (make-cell
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:split-anchor-text tfr-split)
- (gnc:make-gnc-monetary tfr-curr tfr-amt)))))
- result)))))))))))
+ (define (tfr-split->row tfr-split)
+ (let* ((pmt-txn (xaccSplitGetParent tfr-split))
+ (tfr-acct (xaccSplitGetAccount tfr-split))
+ (tfr-curr (xaccAccountGetCommodity tfr-acct))
+ (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
+ (list
+ (qof-print-date (xaccTransGetDate pmt-txn))
+ (let ((num (gnc-get-num-action pmt-txn tfr-split)))
+ (if (string-null? num) (_ "Payment") num))
+ (make-cell
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text tfr-split)
+ (gnc:make-gnc-monetary tfr-curr tfr-amt)))))))
+ (let* ((lot (gncInvoiceGetPostedLot invoice))
+ (pmt-splits (append-map
+ (compose xaccTransGetPaymentAcctSplitList xaccSplitGetParent)
+ (filter split-is-payment? (gnc-lot-get-split-list lot))))
+ (dedupe-splits (sort-and-delete-duplicates pmt-splits split<? equal?)))
+ (if (gncInvoiceIsPaid invoice)
+ (map tfr-split->row dedupe-splits)
+ (append (map tfr-split->row dedupe-splits)
+ (list
+ (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
+ (make-cell
+ (gnc:make-gnc-monetary
+ currency (AP-negate (gnc-lot-get-balance lot))))))))))
(define (payment-txn->overpayment-and-invoices txn)
(let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
Summary of changes:
.../report/business-reports/new-owner-report.scm | 68 ++++++++++------------
1 file changed, 32 insertions(+), 36 deletions(-)
More information about the gnucash-changes
mailing list