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

[report-utilities] gnc:payment-txn->payment-info is exported

Browse Source 
move payment-txn analysis function into report-utilities.scm module.
This commit is contained in:
Christopher Lam 2021-07-08 20:07:20 +08:00
parent d258d59c29
commit dc516bd5d7
2 changed files with 55 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
gnucash/report/report-utilities.scm
View File

@ -97,6 +97,7 @@
(export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total)
(export gnc:multiline-to-html-text)
(export gnc:payment-txn->payment-info)
(export make-file-url)
(export gnc:strify)
(export gnc:pk)
@ -983,6 +984,59 @@ query instead.")
;; ***************************************************************************
;; Business Functions
(define (sign-equal? a b) (or (= 0 a b) (< 0 (* a b))))
(define (not-APAR? s)
(not (xaccAccountIsAPARType (xaccAccountGetType (xaccSplitGetAccount s)))))
;; analyse a payment transaction and return a 3-element vector:
;; (vector invoices opposing-splits overpayment)
;;
;; invoices: a list of (cons invoice inv-APAR-split)
;; opposing-splits: a list of (list pmt-APAR-split partial-amount derived?)
;; partial-amount is a number, derived? is #true if the partial
;; amount does not match the transaction amount
;; overpayment: a number indicating overpayment amount
(define (gnc:payment-txn->payment-info txn)
(let lp ((splits (xaccTransGetSplitList txn))
(invoices '())
(overpayment 0)
(opposing-splits '()))
(match splits
(() (vector invoices opposing-splits overpayment))
(((? not-APAR? split) . rest)
(lp rest invoices (+ overpayment (xaccSplitGetAmount split))
opposing-splits))
((split . rest)
(let ((lot (xaccSplitGetLot split)))
(define (equal-to-split? s) (equal? s split))
(match (gncInvoiceGetInvoiceFromLot lot)
(() (let lp1 ((lot-splits (gnc-lot-get-split-list lot))
(overpayment overpayment)
(opposing-splits opposing-splits))
(match lot-splits
(() (lp rest invoices overpayment opposing-splits))
(((? equal-to-split?) . tail)
(lp1 tail overpayment opposing-splits))
((s . tail)
(let* ((s-lot (xaccSplitGetLot s))
(sum
(fold
(lambda (a b)
(if (equal? s a) b (+ b (xaccSplitGetAmount a))))
0 (gnc-lot-get-split-list s-lot)))
(lot-bal (gnc-lot-get-balance s-lot))
(lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
0 lot-bal))
(partial-amount (- sum lot-bal))
(derived? (not (zero? lot-bal))))
(lp1 tail (+ overpayment partial-amount)
(cons (list s partial-amount derived?)
opposing-splits)))))))
(inv
(lp rest
(cons (cons inv split) invoices)
(+ overpayment (xaccSplitGetAmount split))
opposing-splits))))))))
;; create a stepped list, then add a date in the infinite future for
;; the "current" bucket
(define (make-extended-interval-list to-date num-buckets)

48
gnucash/report/reports/standard/new-owner-report.scm
View File

@ -642,52 +642,6 @@ and do not match the transaction."))))))))
(cons (car lot-txn-splits) non-document)
result))))))))))
(define (not-APAR? s)
(not (xaccAccountIsAPARType (xaccAccountGetType (xaccSplitGetAccount s)))))
(define (payment-txn->payment-info txn)
(let lp ((splits (xaccTransGetSplitList txn))
(invoices '())
(overpayment 0)
(opposing-splits '()))
(match splits
(() (vector invoices opposing-splits overpayment))
(((? not-APAR? split) . rest)
(lp rest invoices (+ overpayment (xaccSplitGetAmount split))
opposing-splits))
((split . rest)
(let ((lot (xaccSplitGetLot split)))
(define (equal-to-split? s) (equal? s split))
(match (gncInvoiceGetInvoiceFromLot lot)
(() (let lp1 ((lot-splits (gnc-lot-get-split-list lot))
(overpayment overpayment)
(opposing-splits opposing-splits))
(match lot-splits
(() (lp rest invoices overpayment opposing-splits))
(((? equal-to-split?) . tail)
(lp1 tail overpayment opposing-splits))
((s . tail)
(let* ((s-lot (xaccSplitGetLot s))
(sum
(fold
(lambda (a b)
(if (equal? s a) b (+ b (xaccSplitGetAmount a))))
0 (gnc-lot-get-split-list s-lot)))
(lot-bal (gnc-lot-get-balance s-lot))
(lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
0 lot-bal))
(partial-amount (- sum lot-bal))
(derived? (not (zero? lot-bal))))
(lp1 tail (+ overpayment partial-amount)
(cons (list s partial-amount derived?)
opposing-splits)))))))
(inv
(lp rest
(cons (cons inv split) invoices)
(+ overpayment (xaccSplitGetAmount split))
opposing-splits))))))))
(define (make-payment->invoices-list txn)
(list
(list
@ -754,7 +708,7 @@ and do not match the transaction."))))))))
currency ((if payable? + -) overpayment))))
(gncTransGetGUID txn)))))
(let* ((payment-info (payment-txn->payment-info txn))
(let* ((payment-info (gnc:payment-txn->payment-info txn))
(invoices-result (invoices-list (vector-ref payment-info 0)))
(payment-result (payments-list (vector-ref payment-info 1)))
(overpayment-result (overpayment-list (vector-ref payment-info 2))))