From 2572ceb7b99fc4fc01bf99f8863897640f476d10 Mon Sep 17 00:00:00 2001 From: Derek Atkins Date: Fri, 2 Jan 2004 21:52:22 +0000 Subject: [PATCH] * src/business/business-reports/aging.scm: When computing the aging report, ignore splits that belong to closed lots. This way we wont get the wrong values when the invoice falls outside the 360-day window but its payment falls inside the window. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@9745 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 7 ++ src/business/business-reports/aging.scm | 109 +++++++++++++----------- 2 files changed, 67 insertions(+), 49 deletions(-) diff --git a/ChangeLog b/ChangeLog index 941f2636c0..bcfd20cc2c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2003-01-02 Derek Atkins + + * src/business/business-reports/aging.scm: When computing the aging + report, ignore splits that belong to closed lots. This way we wont + get the wrong values when the invoice falls outside the 360-day + window but its payment falls inside the window. + 2004-01-01 Derek Atkins * src/engine/qofinstance.c: return a "valid" GUID even if passed a NULL diff --git a/src/business/business-reports/aging.scm b/src/business/business-reports/aging.scm index 77365a8429..805d466783 100644 --- a/src/business/business-reports/aging.scm +++ b/src/business/business-reports/aging.scm @@ -176,52 +176,66 @@ (define (update-company-hash hash split bucket-intervals reverse?) - (let* ((transaction (gnc:split-get-parent split)) - (temp-owner (gnc:owner-create)) - (owner (gnc:owner-from-split split temp-owner))) - - (if - owner - (let* ((guid (gnc:owner-get-guid owner)) - (this-currency (gnc:transaction-get-currency transaction)) - (value (gnc:split-get-value split)) - (this-date (gnc:transaction-get-date-posted transaction)) - (company-info (hash-ref hash guid))) - - (gnc:debug "update-company-hash called") - (gnc:debug "owner: " owner ", guid: " guid) - (gnc:debug "split-value: " value) - (if reverse? (set! value (gnc:numeric-neg value))) - (if company-info - ;; if it's an existing company, destroy the temp owner and - ;; then make sure the currencies match - (begin - (gnc:owner-destroy temp-owner) - (if (not (gnc:commodity-equiv? this-currency - (company-get-currency company-info))) - (cons #f (sprintf (_ "Transactions relating to company %d contain \ -more than one currency. This report is not designed to cope with this possibility."))) - (begin - (gnc:debug "it's an old company") - (if (gnc:numeric-negative-p value) - (process-invoice company-info (gnc:numeric-neg value) bucket-intervals this-date) - (process-payment company-info value)) - (hash-set! hash guid company-info) - (cons #t guid)))) - - ;; if it's a new company - (begin - (gnc:debug "value" value) - (let ((new-company (make-company this-currency owner))) - (if (gnc:numeric-negative-p value) - (process-invoice new-company (gnc:numeric-neg value) bucket-intervals this-date) - (process-payment new-company value)) - (hash-set! hash guid new-company)) - (cons #t guid)))) - - ; else (no owner) - (gnc:owner-destroy temp-owner)))) + (define (do-update value) + (let* ((transaction (gnc:split-get-parent split)) + (temp-owner (gnc:owner-create)) + (owner (gnc:owner-from-split split temp-owner))) + + (if + owner + (let* ((guid (gnc:owner-get-guid owner)) + (this-currency (gnc:transaction-get-currency transaction)) + (this-date (gnc:transaction-get-date-posted transaction)) + (company-info (hash-ref hash guid))) + + (gnc:debug "update-company-hash called") + (gnc:debug "owner: " owner ", guid: " guid) + (gnc:debug "split-value: " value) + (if reverse? (set! value (gnc:numeric-neg value))) + (if company-info + ;; if it's an existing company, destroy the temp owner and + ;; then make sure the currencies match + (begin + (gnc:owner-destroy temp-owner) + (if (not (gnc:commodity-equiv? + this-currency + (company-get-currency company-info))) + (cons #f (sprintf + (_ "Transactions relating to company %d contain \ +more than one currency. This report is not designed to cope with this possibility."))) + (begin + (gnc:debug "it's an old company") + (if (gnc:numeric-negative-p value) + (process-invoice company-info (gnc:numeric-neg value) bucket-intervals this-date) + (process-payment company-info value)) + (hash-set! hash guid company-info) + (cons #t guid)))) + + ;; if it's a new company + (begin + (gnc:debug "value" value) + (let ((new-company (make-company this-currency owner))) + (if (gnc:numeric-negative-p value) + (process-invoice new-company (gnc:numeric-neg value) bucket-intervals this-date) + (process-payment new-company value)) + (hash-set! hash guid new-company)) + (cons #t guid)))) + ; else (no owner) + (gnc:owner-destroy temp-owner)))) + + ;; figure out if this split is part of a closed lot + ;; also save the split value... + (let* ((lot (gnc:split-get-lot split)) + (value (gnc:split-get-value split)) + (is-paid? (if (null? lot) #f (gnc:lot-closed? lot)))) + + ;; if it's closed, then ignore it because it doesn't matter. + ;; XXX: we _could_ just set the value to 0 in order to list + ;; the company. I'm not sure what to do. Perhaps add an + ;; option? + (if (not is-paid?) + (do-update value)))) ;; get the total debt from the buckets (define (buckets-get-total buckets) @@ -277,10 +291,7 @@ more than one currency. This report is not designed to cope with this possibili ;; set up the query to get the splits in the chosen account -;; XXX: Need a better method to actually sort through the 'active' -;; transactions. Currently go back a year, but obviously we need -;; a way to tell that a transaction is 'paid' -;;; FIXME: begindate is a hack +;; XXX: FIXME: begindate is a hack -- we currently only go back a year (define (setup-query query account date) (define (date-copy date) (cons (car date) (cdr date)))