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

[new-owner-report] LHS invoice->RHS payments show partial amounts

Browse Source
This commit is contained in:
Christopher Lam 2020-01-23 22:45:19 +08:00
parent cbb7431752
commit 8e34a7999d
1 changed files with 24 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -490,20 +490,6 @@
((detailed) (list (make-link-blank)))))) ((detailed) (list (make-link-blank))))))
(define (make-invoice->payments-table invoice) (define (make-invoice->payments-table invoice)
(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))))
(make-link-data
(qof-print-date (xaccTransGetDate pmt-txn))
(split->reference tfr-split)
(split->type-str tfr-split)
(splits->desc (list tfr-split))
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:split-anchor-text (txn->transfer-split pmt-txn))
(gnc:make-gnc-monetary tfr-curr tfr-amt))))))
(define (posting-split->row posting-split) (define (posting-split->row posting-split)
(let* ((posting-txn (xaccSplitGetParent posting-split)) (let* ((posting-txn (xaccSplitGetParent posting-split))
(inv (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot posting-split)))) (inv (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot posting-split))))
@ -519,7 +505,6 @@
currency (AP-negate (xaccSplitGetAmount posting-split)))))))) currency (AP-negate (xaccSplitGetAmount posting-split))))))))
(let ((lot (gncInvoiceGetPostedLot invoice))) (let ((lot (gncInvoiceGetPostedLot invoice)))
(let lp ((lot-splits (gnc-lot-get-split-list lot)) (let lp ((lot-splits (gnc-lot-get-split-list lot))
(transfer-splits-seen '())
(link-splits-seen '()) (link-splits-seen '())
(result '())) (result '()))
(cond (cond
@ -538,24 +523,28 @@
;; This is the regular payment split. Find Transfer acct ;; This is the regular payment split. Find Transfer acct
;; splits, and if haven't encountered before, add to result rows. ;; splits, and if haven't encountered before, add to result rows.
((txn-is-payment? (xaccSplitGetParent (car lot-splits))) ((txn-is-payment? (xaccSplitGetParent (car lot-splits)))
(let lp1 ((pmt-splits (xaccTransGetPaymentAcctSplitList (lp (cdr lot-splits)
(xaccSplitGetParent (car lot-splits)))) link-splits-seen
(transfer-splits-seen transfer-splits-seen) (cons (let* ((lot-split (car lot-splits))
(result result)) (lot-txn (xaccSplitGetParent lot-split))
;; this is a secondary 'inner loop', looping (lot-amt (AP-negate (- (xaccSplitGetAmount lot-split))))
;; lot-split->tfr-account-splits. (tfr-split (txn->transfer-split lot-txn)))
(cond (make-link-data
;; finished tfr-splits. loop main lot-splits. (qof-print-date (xaccTransGetDate lot-txn))
((null? pmt-splits) (split->reference lot-split)
(lp (cdr lot-splits) transfer-splits-seen link-splits-seen result)) (split->type-str lot-split)
;; we've encountered this tfr-split before. skip. (splits->desc (list lot-split))
((member (car pmt-splits) transfer-splits-seen) (gnc:make-html-text
(lp1 (cdr pmt-splits) transfer-splits-seen result)) (gnc:html-markup-anchor
;; new tfr-split. render in original currency. (gnc:split-anchor-text lot-split)
(else (gnc:make-gnc-monetary currency lot-amt))
(lp1 (cdr pmt-splits) " of "
(cons (car pmt-splits) transfer-splits-seen) (gnc:html-markup-anchor
(cons (tfr-split->row (car pmt-splits)) result)))))) (gnc:split-anchor-text tfr-split)
(gnc:make-gnc-monetary
(xaccAccountGetCommodity (xaccSplitGetAccount tfr-split))
(AP-negate (xaccSplitGetAmount tfr-split)))))))
result)))
;; This is a lot link split. Find corresponding documents, ;; This is a lot link split. Find corresponding documents,
;; and add to result rows. ;; and add to result rows.
@ -569,7 +558,7 @@
(cond (cond
;; finished peer-splits. loop main lot-splits. ;; finished peer-splits. loop main lot-splits.
((null? link-splits) ((null? link-splits)
(lp (cdr lot-splits) transfer-splits-seen link-splits-seen result)) (lp (cdr lot-splits) link-splits-seen result))
;; peer split is of same sign as lot split. skip. ;; peer split is of same sign as lot split. skip.
((sign-equal? (xaccSplitGetAmount (car lot-splits)) ((sign-equal? (xaccSplitGetAmount (car lot-splits))
(xaccSplitGetAmount (car link-splits))) (xaccSplitGetAmount (car link-splits)))
@ -589,7 +578,7 @@
;; This is either the invoice posting transaction, or a ;; This is either the invoice posting transaction, or a
;; TXN-TYPE-NONE txn which shouldn't happen. Skip both. ;; TXN-TYPE-NONE txn which shouldn't happen. Skip both.
(else (else
(lp (cdr lot-splits) transfer-splits-seen link-splits-seen result)))))) (lp (cdr lot-splits) link-splits-seen 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))