IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Bug 797521 - Receivable Aging (beta): invoice->payments refined

Browse Source 
* filter payments from lot's splits by split-is-payment?
* dedupe payments
* sort by payment posted date
This commit is contained in:
Christopher Lam 2019-12-16 12:49:43 +08:00
parent 5e7c295471
commit 75dba61255
1 changed files with 32 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
gnucash/report/business-reports/new-owner-report.scm
View File

@ -180,6 +180,11 @@
(eqv? (xaccTransGetTxnType txn) TXN-TYPE-INVOICE)) (eqv? (xaccTransGetTxnType txn) TXN-TYPE-INVOICE))
(define (txn-is-payment? txn) (define (txn-is-payment? txn)
(eqv? (xaccTransGetTxnType txn) TXN-TYPE-PAYMENT)) (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) (define (make-aging-table splits to-date payable? date-type currency)
(let ((table (gnc:make-html-table)) (let ((table (gnc:make-html-table))
@ -308,42 +313,33 @@
currency total #f #f #f #f (list (make-list link-cols #f)))) currency total #f #f #f #f (list (make-list link-cols #f))))
(define (make-invoice->payments-table invoice) (define (make-invoice->payments-table invoice)
(define lot (gncInvoiceGetPostedLot invoice)) (define (tfr-split->row tfr-split)
(let lp ((invoice-splits (gnc-lot-get-split-list lot)) (let* ((pmt-txn (xaccSplitGetParent tfr-split))
(result '())) (tfr-acct (xaccSplitGetAccount tfr-split))
(match invoice-splits (tfr-curr (xaccAccountGetCommodity tfr-acct))
;; finished. test for underpayment and add outstanding balance (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
(() (reverse (list
(if (gncInvoiceIsPaid invoice) (qof-print-date (xaccTransGetDate pmt-txn))
result (let ((num (gnc-get-num-action pmt-txn tfr-split)))
(cons (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding")) (if (string-null? num) (_ "Payment") num))
(make-cell (make-cell
(gnc:make-gnc-monetary (gnc:make-html-text
currency (AP-negate (gnc-lot-get-balance lot))))) (gnc:html-markup-anchor
result)))) (gnc:split-anchor-text tfr-split)
(gnc:make-gnc-monetary tfr-curr tfr-amt)))))))
;; invoice's lot's payment splits (let* ((lot (gncInvoiceGetPostedLot invoice))
((lot-split . rest-lot-splits) (pmt-splits (append-map
(let* ((lot-txn (xaccSplitGetParent lot-split)) (compose xaccTransGetPaymentAcctSplitList xaccSplitGetParent)
(tfr-splits (xaccTransGetPaymentAcctSplitList lot-txn))) (filter split-is-payment? (gnc-lot-get-split-list lot))))
(let lp1 ((tfr-splits tfr-splits) (result result)) (dedupe-splits (sort-and-delete-duplicates pmt-splits split<? equal?)))
(match tfr-splits (if (gncInvoiceIsPaid invoice)
(() (lp rest-lot-splits result)) (map tfr-split->row dedupe-splits)
((tfr-split . rest-tfr-splits) (append (map tfr-split->row dedupe-splits)
(let* ((tfr-acct (xaccSplitGetAccount tfr-split)) (list
(tfr-curr (xaccAccountGetCommodity tfr-acct)) (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
(tfr-amt (AP-negate (xaccSplitGetAmount tfr-split)))) (make-cell
(lp1 rest-tfr-splits (gnc:make-gnc-monetary
(cons (list currency (AP-negate (gnc-lot-get-balance lot))))))))))
(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 (payment-txn->overpayment-and-invoices txn) (define (payment-txn->overpayment-and-invoices txn)
(let lp ((splits (xaccTransGetAPARAcctSplitList txn #f)) (let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))