1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
4 /*--------------------------------------------------------------------------
5 ------------------------------------------------------------------------*/
6 DEF INPUT PARAMETER report-options
AS CHAR NO-UNDO.
8 DEF VAR preview
AS LOGI
NO-UNDO INIT Yes.
9 DEF VAR payment-style
AS CHAR NO-UNDO INIT "".
10 DEF VAR forced-style
AS CHAR NO-UNDO INIT ?.
11 DEF VAR bank-account
AS CHAR NO-UNDO INIT "".
12 DEF VAR due-before
AS DATE NO-UNDO.
13 DEF VAR cheque-date
AS DATE NO-UNDO.
14 DEF VAR cheque-message
AS CHAR NO-UNDO INIT "".
15 DEF VAR first-cheque-no
AS INT NO-UNDO INIT ?.
16 DEF VAR enforce-cheque-limit
AS LOGI
NO-UNDO INIT No.
17 DEF VAR test-client-code
AS CHAR NO-UNDO INIT ?.
18 DEF VAR creditor-list
AS CHAR NO-UNDO INIT "".
19 DEF VAR creditor-1
AS INT NO-UNDO INIT 0.
20 DEF VAR creditor-n
AS INT NO-UNDO INIT 999999.
21 DEF VAR project-1
AS INT NO-UNDO INIT 0.
22 DEF VAR project-n
AS INT NO-UNDO INIT 999999.
23 DEF VAR account-1
AS DEC NO-UNDO INIT 0.
24 DEF VAR account-n
AS DEC NO-UNDO INIT 10000.
27 DEF VAR user-name
AS CHAR NO-UNDO.
28 {inc
/username.i
"user-name"}
29 DEF VAR timeStamp
AS CHAR FORMAT "X(44)" NO-UNDO.
30 timeStamp
= STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
32 DEF VAR interest-font
AS CHAR NO-UNDO INITIAL "fixed,courier,cpi,14,lpi,8,bold".
33 DEF VAR transaction-font
AS CHAR NO-UNDO INITIAL "fixed,courier,cpi,16,lpi,9,normal".
36 {inc
/ofc-acct.i
"DEBTORS" "sundry-debtors"}
38 /* _UIB-CODE-BLOCK-END
*/
42 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
44 /* ******************** Preprocessor Definitions
******************** */
46 &Scoped-define PROCEDURE-TYPE Procedure
47 &Scoped-define DB-AWARE no
51 /* _UIB-PREPROCESSOR-BLOCK-END
*/
55 /* ************************ Function Prototypes
********************** */
57 &IF DEFINED(EXCLUDE-check-client) = 0 &THEN
59 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD check-client Procedure
60 FUNCTION check-client
RETURNS LOGICAL
61 ( INPUT et
AS CHAR, INPUT ec
AS INT ) FORWARD.
63 /* _UIB-CODE-BLOCK-END
*/
68 &IF DEFINED(EXCLUDE-get-parent-entity) = 0 &THEN
70 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-parent-entity Procedure
71 FUNCTION get-parent-entity
RETURNS CHARACTER
72 ( INPUT et
AS CHAR, INPUT ec
AS INT ) FORWARD.
74 /* _UIB-CODE-BLOCK-END
*/
79 &IF DEFINED(EXCLUDE-pay-creditor) = 0 &THEN
81 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pay-creditor Procedure
82 FUNCTION pay-creditor
RETURNS LOGICAL
83 ( INPUT creditor-code
AS INT ) FORWARD.
85 /* _UIB-CODE-BLOCK-END
*/
90 &IF DEFINED(EXCLUDE-pay-voucher) = 0 &THEN
92 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pay-voucher Procedure
93 FUNCTION pay-voucher
RETURNS LOGICAL
94 ( /* parameter-definitions
*/ ) FORWARD.
96 /* _UIB-CODE-BLOCK-END
*/
101 &IF DEFINED(EXCLUDE-print-payment) = 0 &THEN
103 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD print-payment Procedure
104 FUNCTION print-payment
RETURNS DECIMAL
105 ( /* parameter-definitions
*/ ) FORWARD.
107 /* _UIB-CODE-BLOCK-END
*/
113 /* *********************** Procedure Settings
************************ */
115 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
116 /* Settings for
THIS-PROCEDURE
120 Add Fields to
: Neither
121 Other Settings
: CODE-ONLY
COMPILE
123 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
125 /* ************************* Create Window
************************** */
127 &ANALYZE-SUSPEND _CREATE-WINDOW
128 /* DESIGN Window definition
(used by the UIB
)
129 CREATE WINDOW Procedure
ASSIGN
132 /* END WINDOW DEFINITION
*/
136 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
137 /* ************************* Included-Libraries
*********************** */
139 {inc
/method
/m-txtrep.i
}
141 /* _UIB-CODE-BLOCK-END
*/
148 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
151 /* *************************** Main Block
*************************** */
153 RUN build-interest-charges.
156 /* _UIB-CODE-BLOCK-END
*/
160 /* ********************** Internal Procedures
*********************** */
162 &IF DEFINED(EXCLUDE-build-card-payment) = 0 &THEN
164 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-card-payment Procedure
165 PROCEDURE build-card-payment
:
166 /*------------------------------------------------------------------------------
168 ------------------------------------------------------------------------------*/
169 DEF BUFFER CardPayment
FOR Payment.
170 DEF BUFFER CardVchrPaid
FOR BeingPaid.
172 DEF VAR card-creditor
AS INT NO-UNDO.
174 IF NOT CAN-FIND( FIRST Payment
WHERE Payment.PaymentStyle
= "CARD") THEN RETURN.
175 ASSIGN card-creditor
= INT(card-payment-creditor
) NO-ERROR.
176 IF ERROR-STATUS:ERROR THEN DO:
177 MESSAGE "The Office Setting 'Card-Payment-Creditor' needs" SKIP
178 "to be set to a Creditor Code before the 'CARD'" SKIP
179 "payment style can be used."
180 VIEW-AS ALERT-BOX ERROR
181 TITLE "Card-Payment-Creditor not set".
185 FOR EACH Payment
WHERE Payment.PaymentStyle
= "CARD":
186 FIND CardPayment
WHERE CardPayment.CreditorCode
= card-creditor
187 AND CardPayment.PaymentStyle
= {&CARD-PYMT}
189 IF NOT AVAILABLE(CardPayment
) THEN DO:
191 CardPayment.CreditorCode
= card-creditor.
192 CardPayment.PaymentStyle
= {&CARD-PYMT}.
195 /* re-assign the vouchers as being paid by the credit card
*/
196 FOR EACH BeingPaid
OF Payment
:
198 BUFFER-COPY BeingPaid
TO CardVchrPaid
ASSIGN
199 CardVchrPaid.CreditorCode
= CardPayment.CreditorCode
200 CardVchrPaid.PaymentStyle
= CardPayment.PaymentStyle.
207 /* _UIB-CODE-BLOCK-END
*/
212 &IF DEFINED(EXCLUDE-build-interest-info) = 0 &THEN
214 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-interest-info Procedure
215 PROCEDURE build-interest-info
:
216 /*------------------------------------------------------------------------------
218 ------------------------------------------------------------------------------*/
220 FOR EACH Tenant
WHERE Active
NO-LOCK:
221 FOR EACH AcctTran
WHERE EntityType
= "T" AND EntityCode
= Tenant.TenantCode
222 AND (ClosingGroup
= ?
OR ClosingGroup
= 0) NO-LOCK:
223 /* DISPLAY AcctTran.
*/
229 /* _UIB-CODE-BLOCK-END
*/
234 &IF DEFINED(EXCLUDE-do-card-transfer) = 0 &THEN
236 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-card-transfer Procedure
237 PROCEDURE do-card-transfer
:
238 /*------------------------------------------------------------------------------
240 ------------------------------------------------------------------------------*/
241 DEF INPUT PARAMETER batch-no
AS INT NO-UNDO.
242 DEF INPUT PARAMETER cheque-no
AS INT NO-UNDO.
244 DEF VAR cheque-total
AS DEC NO-UNDO.
245 DEF VAR i
AS INT NO-UNDO.
247 FIND Creditor
WHERE Creditor.CreditorCode
= Payment.CreditorCode
NO-LOCK.
250 ASSIGN NewDocument.BatchCode
= batch-no
251 NewDocument.DocumentType
= "CARD"
252 NewDocument.Description
= Creditor.PayeeName
253 NewDocument.Reference
= "To C" + STRING( Creditor.CreditorCode
, "99999") .
254 /* bank-account
+ STRING(cheque-no
, ">999999").
*/
256 FOR EACH BeingPaid
OF Payment
,
257 FIRST Voucher
WHERE Voucher.VoucherSeq
= BeingPaid.VoucherSeq
EXCLUSIVE-LOCK:
258 Voucher.VoucherStatus
= "P".
259 Voucher.BankAccountCode
= bank-account.
260 Voucher.ChequeNo
= cheque-no.
261 cheque-total
= cheque-total
+ Voucher.GoodsValue
+ Voucher.TaxValue.
264 /* Debit the creditor
*/
266 ASSIGN NewAcctTrans.BatchCode
= batch-no
267 NewAcctTrans.DocumentCode
= NewDocument.DocumentCode
268 NewAcctTrans.EntityType
= "C"
269 NewAcctTrans.EntityCode
= Creditor.CreditorCode
270 NewAcctTrans.AccountCode
= sundry-creditors
271 NewAcctTrans.Amount
= cheque-total
272 NewAcctTrans.Date
= cheque-date
273 NewAcctTrans.Description
= ""
274 NewAcctTrans.Reference
= "".
277 ASSIGN NewAcctTrans.BatchCode
= batch-no
278 NewAcctTrans.DocumentCode
= NewDocument.DocumentCode
279 NewAcctTrans.Amount
= cheque-total
* -1
280 NewAcctTrans.Date
= cheque-date
281 NewAcctTrans.Description
= ""
282 NewAcctTrans.Reference
= ""
283 NewAcctTrans.EntityType
= "C" /* Credit the card payment creditor
*/
284 NewAcctTrans.EntityCode
= INT(card-payment-creditor
)
285 NewAcctTrans.AccountCode
= sundry-creditors.
289 /* _UIB-CODE-BLOCK-END
*/
294 &IF DEFINED(EXCLUDE-do-cheque-run) = 0 &THEN
296 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-cheque-run Procedure
297 PROCEDURE do-cheque-run
:
298 /*------------------------------------------------------------------------------
300 ------------------------------------------------------------------------------*/
301 DEF VAR batch-no
AS INT NO-UNDO.
302 DEF VAR cheque-no
AS INT NO-UNDO.
303 DEF VAR end-no
AS INT NO-UNDO.
305 cheque-no
= first-cheque-no.
308 DO TRANSACTION ON ERROR UNDO cheque-run
, RETURN ERROR "FAIL":
310 /* Create the batch
*/
312 ASSIGN NewBatch.BatchType
= 'NORM'
313 NewBatch.Description
= "Cheque Run - " + STRING( TODAY, "99/99/9999" )
314 + ", " + bank-account
+ " account".
316 batch-no
= NewBatch.BatchCode .
317 FOR EACH Payment
WHERE Payment.PaymentStyle
<> "CARD" BY Payment.Name
318 ON ERROR UNDO cheque-run
, RETURN ERROR "FAIL":
319 RUN do-payment
( batch-no
, INPUT-OUTPUT cheque-no
).
321 end-no
= cheque-no
- 1.
323 FIND Payment
WHERE Payment.PaymentStyle
= {&CARD-PYMT} NO-ERROR.
324 IF AVAILABLE(Payment
) THEN DO:
325 cheque-no
= Payment.ChequeNo.
326 FOR EACH Payment
WHERE Payment.PaymentStyle
= "CARD" BY Payment.Name
327 ON ERROR UNDO cheque-run
, RETURN ERROR "FAIL":
328 RUN do-card-transfer
( batch-no
, cheque-no
).
332 IF end-no
< first-cheque-no
THEN DO:
333 /* no cheques produced
*/
334 MESSAGE "No cheques to be printed!"
335 VIEW-AS ALERT-BOX INFORMATION
336 TITLE "No Cheques to Print" .
337 UNDO cheque-run
, RETURN ERROR "FAIL".
340 DEF VAR start-printing
AS LOGI
NO-UNDO INITIAL Yes.
342 MESSAGE "Ready to print cheques from " + STRING(first-cheque-no
, "999999")
343 " to " STRING( end-no
, "999999") SKIP
344 "Preview a report on the cheques first? " SKIP
345 " - <Yes> to preview a report first" SKIP
346 " - <No> to print the cheques now" SKIP
347 " - <Cancel> to cancel the cheque run"
348 VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL
349 TITLE "Preview Payment Report?" UPDATE start-printing.
351 IF start-printing
= Yes
THEN DO:
352 RUN print-payment-summary
( first-cheque-no
, end-no
) .
353 MESSAGE "Ready to print" STRING(end-no
- first-cheque-no
+ 1)
354 "cheques from " + STRING(first-cheque-no
, "999999")
355 " to " STRING( end-no
, "999999") SKIP
356 "Print cheques?" SKIP(1)
357 "(the printer will prompt for cheque forms, if required)"
358 VIEW-AS ALERT-BOX QUESTION BUTTONS OK-CANCEL
359 TITLE "Print Cheques?" UPDATE start-printing.
360 IF start-printing
<> Yes
THEN start-printing
= ?.
363 IF start-printing
= ?
THEN UNDO cheque-run
, RETURN ERROR.
365 END.
/* of transaction block
*/
368 report-options
= "BankAccount," + BankAccount.BankAccountCode
369 + "~nChequeRange," + STRING(first-cheque-no
) + "," + STRING(end-no
)
370 + (IF payment-style
= "" THEN "" ELSE "~nPaymentStyle," + payment-style
)
371 + "~nMessage," + cheque-message.
372 RUN process
/report
/chqprt.p
( report-options
).
376 /* _UIB-CODE-BLOCK-END
*/
381 &IF DEFINED(EXCLUDE-do-payment) = 0 &THEN
383 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-payment Procedure
384 PROCEDURE do-payment
:
385 /*------------------------------------------------------------------------------
387 ------------------------------------------------------------------------------*/
388 DEF INPUT PARAMETER batch-no
AS INT NO-UNDO.
389 DEF INPUT-OUTPUT PARAMETER cheque-no
AS INT NO-UNDO.
391 DEF VAR cheque-total
AS DEC NO-UNDO.
392 DEF VAR i
AS INT NO-UNDO.
393 DEF BUFFER Chq
FOR Cheque.
395 FIND Creditor
WHERE Creditor.CreditorCode
= Payment.CreditorCode
NO-LOCK.
398 ASSIGN NewDocument.BatchCode
= batch-no
399 NewDocument.DocumentType
= "CHEQ"
400 NewDocument.Description
= Creditor.PayeeName
401 NewDocument.Reference
= bank-account
+ "," + TRIM(STRING(cheque-no
, ">999999")).
403 FIND FIRST Chq
WHERE Chq.BankAccountCode
= bank-account
404 AND Chq.ChequeNo
= cheque-no
NO-LOCK NO-ERROR.
405 IF AVAILABLE(Chq
) THEN DO:
406 MESSAGE "Cheque number " + bank-account
+ "/" + TRIM(STRING( cheque-no
, ">>>999999")) + " is already in use" SKIP(1)
407 "Cancelling cheque run"
408 VIEW-AS ALERT-BOX ERROR
409 TITLE "Attempt to Re-Issue Cheque".
413 CREATE Cheque
NO-ERROR.
414 ASSIGN Cheque.BatchCode
= batch-no
415 Cheque.DocumentCode
= NewDocument.DocumentCode
416 Cheque.BankAccountCode
= bank-account
417 Cheque.ChequeNo
= cheque-no
418 Cheque.CreditorCode
= Creditor.CreditorCode
419 Cheque.Date
= cheque-date
420 Cheque.PayeeName
= Creditor.PayeeName
421 Payment.ChequeNo
= cheque-no
422 cheque-no
= cheque-no
+ 1
426 FOR EACH BeingPaid
OF Payment
,
427 FIRST Voucher
WHERE Voucher.VoucherSeq
= BeingPaid.VoucherSeq
EXCLUSIVE-LOCK:
428 Voucher.VoucherStatus
= "P".
429 Voucher.BankAccountCode
= bank-account.
430 Voucher.ChequeNo
= Cheque.ChequeNo.
431 cheque-total
= cheque-total
+ Voucher.GoodsValue
+ Voucher.TaxValue.
434 /* Debit the creditor
*/
436 ASSIGN NewAcctTrans.BatchCode
= batch-no
437 NewAcctTrans.DocumentCode
= NewDocument.DocumentCode
438 NewAcctTrans.EntityType
= "C"
439 NewAcctTrans.EntityCode
= Creditor.CreditorCode
440 NewAcctTrans.AccountCode
= sundry-creditors
441 NewAcctTrans.Amount
= cheque-total
442 NewAcctTrans.Date
= cheque-date
443 NewAcctTrans.Description
= ""
444 NewAcctTrans.Reference
= ""
445 Cheque.Amount
= cheque-total.
448 ASSIGN NewAcctTrans.BatchCode
= batch-no
449 NewAcctTrans.DocumentCode
= NewDocument.DocumentCode
450 NewAcctTrans.Amount
= cheque-total
* -1
451 NewAcctTrans.Date
= cheque-date
452 NewAcctTrans.Description
= ""
453 NewAcctTrans.Reference
= ""
454 NewAcctTrans.EntityType
= "L" /* Credit the bank account
*/
455 NewAcctTrans.EntityCode
= BankAccount.CompanyCode
456 NewAcctTrans.AccountCode
= BankAccount.AccountCode.
462 /* _UIB-CODE-BLOCK-END
*/
467 &IF DEFINED(EXCLUDE-inst-page-footer) = 0 &THEN
469 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
470 PROCEDURE inst-page-footer
:
471 /*------------------------------------------------------------------------------
472 Purpose
: Print any page footer
473 ------------------------------------------------------------------------------*/
477 /* _UIB-CODE-BLOCK-END
*/
482 &IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN
484 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
485 PROCEDURE inst-page-header
:
486 /*------------------------------------------------------------------------------
487 Purpose
: Print any page header
488 ------------------------------------------------------------------------------*/
490 RUN pclrep-line
( "univers,Point,7,bold,Proportional", TimeStamp
).
491 RUN pclrep-line
( "univers,Point,12,bold,Proportional",
492 SPC
(45) + "Cheque Production Report"
494 RUN pclrep-line
( "", "" ).
496 /* Put any column headers here
*/
500 /* _UIB-CODE-BLOCK-END
*/
505 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
507 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
508 PROCEDURE parse-parameters
:
509 /*------------------------------------------------------------------------------
511 ------------------------------------------------------------------------------*/
512 DEF VAR token
AS CHAR NO-UNDO.
513 DEF VAR i
AS INT NO-UNDO.
514 DEF VAR n
AS INT NO-UNDO.
516 {inc
/showopts.i
"report-options"}
518 n
= NUM-ENTRIES( report-options
, "~n" ).
520 token
= ENTRY( i
, report-options
, "~n" ).
522 CASE ENTRY( 1, token
):
523 WHEN "Preview" THEN preview
= Yes.
524 WHEN "EnforceLimit" THEN enforce-cheque-limit
= Yes.
525 WHEN "PaymentStyle" THEN payment-style
= ENTRY(2,token
).
526 WHEN "ForcePaymentBy" THEN forced-style
= ENTRY(2,token
).
527 WHEN "DueBefore" THEN due-before
= DATE(ENTRY(2,token
)).
528 WHEN "ChequeDate" THEN cheque-date
= DATE(ENTRY(2,token
)).
529 WHEN "FirstCheque" THEN first-cheque-no
= INT( ENTRY(2,token
)).
530 WHEN "OneClient" THEN test-client-code
= ENTRY(2,token
).
531 WHEN "BankAccount" THEN bank-account
= ENTRY(2,token
).
532 WHEN "CreditorList" THEN creditor-list
= SUBSTRING( token
, INDEX(token
,",") + 1).
534 WHEN "Message" THEN cheque-message
= SUBSTRING( token
, INDEX(token
,",") + 1).
536 WHEN "CreditorRange" THEN ASSIGN
537 creditor-1
= INT(ENTRY(2,token
))
538 creditor-n
= INT(ENTRY(3,token
)).
540 WHEN "ProjectRange" THEN ASSIGN
541 project-1
= INT(ENTRY(2,token
))
542 project-n
= INT(ENTRY(3,token
)).
544 WHEN "AccountRange" THEN ASSIGN
545 account-1
= INT(ENTRY(2,token
))
546 account-n
= INT(ENTRY(3,token
)).
553 /* ensure entries in creditor list are just plain numbers
*/
554 n
= NUM-ENTRIES( creditor-list
).
556 ENTRY(i
, creditor-list
) = STRING( INT( TRIM(ENTRY(i
,creditor-list
)) ) ).
561 /* _UIB-CODE-BLOCK-END
*/
566 &IF DEFINED(EXCLUDE-print-payment-summary) = 0 &THEN
568 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-payment-summary Procedure
569 PROCEDURE print-payment-summary
:
570 /*------------------------------------------------------------------------------
572 ------------------------------------------------------------------------------*/
573 DEF INPUT PARAMETER from-cheque
AS INT NO-UNDO.
574 DEF INPUT PARAMETER to-cheque
AS INT NO-UNDO.
576 DEF VAR control-file-original
AS CHAR NO-UNDO.
577 DEF VAR print-file-original
AS CHAR NO-UNDO.
578 DEF VAR line
AS CHAR NO-UNDO.
579 DEF VAR payment-total
AS DEC NO-UNDO.
581 print-file-original
= txtrep-print-file.
582 control-file-original
= txtrep-control-file.
583 RUN txtrep-initialise.
584 OUTPUT TO VALUE(txtrep-print-file
) KEEP-MESSAGES PAGE-SIZE 0.
585 RUN pclrep-start
( preview
, "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9").
587 FOR EACH Payment
WHERE Payment.PaymentStyle
<> {&CARD-PYMT}
588 AND Payment.PaymentStyle
<> "CARD"
590 payment-total
= payment-total
+ print-payment
().
592 FOR EACH Payment
WHERE Payment.PaymentStyle
= {&CARD-PYMT}
594 payment-total
= payment-total
+ print-payment
().
596 line
= SPC
(90) + "==============".
597 RUN pclrep-line
( voucher-font
, line
).
598 line
= STRING( "Total payments for cheque run", "X(90)") + STRING( payment-total
, ">>>,>>>,>>9.99CR" ).
599 RUN pclrep-line
( voucher-font
, line
).
600 RUN pclrep-down-by
( 2 ).
602 IF CAN-FIND( FIRST Payment
WHERE Payment.PaymentStyle
= "CARD") THEN DO:
604 FOR EACH Payment
WHERE Payment.PaymentStyle
= "CARD"
606 payment-total
= payment-total
+ print-payment
().
608 line
= SPC
(90) + "==============".
609 RUN pclrep-line
( voucher-font
, line
).
610 line
= STRING( "Total of transfers to credit card", "X(90)") + STRING( payment-total
, ">>>,>>>,>>9.99CR" ).
611 RUN pclrep-line
( voucher-font
, line
).
615 RUN view-output-file
( preview
).
617 txtrep-print-file
= print-file-original.
618 txtrep-control-file
= control-file-original.
622 /* _UIB-CODE-BLOCK-END
*/
627 /* ************************ Function Implementations
***************** */
629 &IF DEFINED(EXCLUDE-check-client) = 0 &THEN
631 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION check-client Procedure
632 FUNCTION check-client
RETURNS LOGICAL
633 ( INPUT et
AS CHAR, INPUT ec
AS INT ) :
634 /*------------------------------------------------------------------------------
635 Purpose
: Decide whether this cheque run is for the client who receives
636 expenses for this entity type
/ entity code.
637 ------------------------------------------------------------------------------*/
638 DEF VAR entity-code
AS CHAR NO-UNDO.
639 DEF VAR result
AS LOGI
NO-UNDO.
642 entity-code
= get-parent-entity
( et
, ec
).
643 et
= SUBSTRING( entity-code
, 1, 1).
644 ec
= INT( SUBSTRING( entity-code
, 2) ).
647 FIND Company
WHERE Company.CompanyCode
= ec
NO-LOCK NO-ERROR.
648 result
= (Company.ClientCode
= test-client-code
).
654 /* _UIB-CODE-BLOCK-END
*/
659 &IF DEFINED(EXCLUDE-get-parent-entity) = 0 &THEN
661 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-parent-entity Procedure
662 FUNCTION get-parent-entity
RETURNS CHARACTER
663 ( INPUT et
AS CHAR, INPUT ec
AS INT ) :
664 /*------------------------------------------------------------------------------
667 ------------------------------------------------------------------------------*/
668 DEF VAR parent-entity
AS CHAR NO-UNDO.
672 FIND Project
WHERE Project.ProjectCode
= ec
NO-LOCK NO-ERROR.
673 parent-entity
= Project.EntityType
+ STRING( Project.EntityCode
, "99999").
676 FIND Property
WHERE Property.PropertyCode
= ec
NO-LOCK NO-ERROR.
677 parent-entity
= "L" + STRING( Property.CompanyCode
, "99999").
680 FIND Tenant
WHERE Tenant.TenantCode
= ec
NO-LOCK NO-ERROR.
681 parent-entity
= Tenant.EntityType
+ STRING( Tenant.EntityCode
, "99999").
684 FIND Creditor
WHERE Creditor.CreditorCode
= ec
NO-LOCK NO-ERROR.
685 parent-entity
= "L" + STRING( Creditor.CompanyCode
, "99999").
689 RETURN parent-entity.
693 /* _UIB-CODE-BLOCK-END
*/
698 &IF DEFINED(EXCLUDE-pay-creditor) = 0 &THEN
700 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pay-creditor Procedure
701 FUNCTION pay-creditor
RETURNS LOGICAL
702 ( INPUT creditor-code
AS INT ) :
703 /*------------------------------------------------------------------------------
704 Purpose
: Decide whether we pay a particular creditor this time
706 ------------------------------------------------------------------------------*/
707 DEF BUFFER RecentCheque
FOR Cheque.
708 DEF BUFFER ThisCreditor
FOR Creditor.
710 DEF VAR cheque-days
AS DEC NO-UNDO.
712 IF creditor-code
< creditor-1
THEN RETURN No.
713 IF creditor-code
> creditor-n
THEN RETURN No.
715 IF TRIM(creditor-list
) <> "" AND LOOKUP(STRING(creditor-code
), creditor-list
) = 0 THEN RETURN No.
717 IF enforce-cheque-limit
THEN DO:
718 FIND LAST RecentCheque
WHERE RecentCheque.CreditorCode
= creditor-code
NO-LOCK NO-ERROR.
719 IF AVAILABLE(RecentCheque
) THEN DO:
720 FIND ThisCreditor
OF RecentCheque
NO-LOCK NO-ERROR.
721 IF AVAILABLE(ThisCreditor
) THEN DO:
722 cheque-days
= ThisCreditor.ChequesPerMonth
/ 30.
723 IF (cheque-date
- RecentCheque.Date
) < INT(cheque-days
) THEN RETURN No.
732 /* _UIB-CODE-BLOCK-END
*/
737 &IF DEFINED(EXCLUDE-pay-voucher) = 0 &THEN
739 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pay-voucher Procedure
740 FUNCTION pay-voucher
RETURNS LOGICAL
741 ( /* parameter-definitions
*/ ) :
742 /*------------------------------------------------------------------------------
743 Purpose
: Decide if an approved voucher should be paid in this cheque run
745 ------------------------------------------------------------------------------*/
746 IF Voucher.EntityType
= "J" THEN DO:
747 IF Voucher.EntityCode
< project-1
THEN RETURN No.
748 IF Voucher.EntityCode
> project-n
THEN RETURN No.
751 IF Voucher.AccountCode
< account-1
THEN RETURN No.
752 IF Voucher.AccountCode
> account-n
THEN RETURN No.
754 IF Voucher.DateDue
> due-before
AND Voucher.GoodsValue
> 0.0 THEN RETURN No.
756 IF payment-style
<> "" AND Voucher.PaymentStyle
<> payment-style
THEN RETURN No.
758 IF test-client-code
<> ?
THEN
759 RETURN check-client
( Voucher.EntityType
, Voucher.EntityCode
).
765 /* _UIB-CODE-BLOCK-END
*/
770 &IF DEFINED(EXCLUDE-print-payment) = 0 &THEN
772 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION print-payment Procedure
773 FUNCTION print-payment
RETURNS DECIMAL
774 ( /* parameter-definitions
*/ ) :
775 /*------------------------------------------------------------------------------
778 ------------------------------------------------------------------------------*/
779 DEF VAR line
AS CHAR NO-UNDO.
780 DEF VAR cheque-total
AS DEC NO-UNDO.
782 FIND FIRST Creditor
WHERE Creditor.CreditorCode
= Payment.CreditorCode
NO-LOCK NO-ERROR.
783 IF Payment.PaymentStyle
= "CARD" THEN
784 line
= "Xfer to card ".
786 line
= "Cheque " + STRING( Payment.ChequeNo
, ">999999").
788 line
= line
+ " C" + STRING( Creditor.CreditorCode
, "99999") + " "
791 IF Payment.PaymentStyle
<> "CARD" THEN DO:
792 FIND PaymentStyle
OF Payment
NO-LOCK NO-ERROR.
793 line
= STRING( line
, "X(70)") + (IF AVAILABLE(PaymentStyle
) THEN PaymentStyle.Description
ELSE Payment.PaymentStyle
).
795 RUN pclrep-line
( payment-font
, line
).
798 FOR EACH BeingPaid
OF Payment
, FIRST Voucher
WHERE Voucher.VoucherSeq
= BeingPaid.VoucherSeq
NO-LOCK:
799 line
= SPC
(9) + "Voucher" + STRING( Voucher.VoucherSeq
, ">>>>>>9") + ", "
800 + STRING( Voucher.Date
, "99/99/9999" ) + " "
801 + STRING( Voucher.Description
, "X(50)" ) + " "
802 + STRING( Voucher.TaxValue
+ Voucher.GoodsValue
, ">>>,>>>,>>9.99CR" ).
803 cheque-total
= cheque-total
+ Voucher.TaxValue
+ Voucher.GoodsValue .
804 RUN pclrep-line
( voucher-font
, line
).
806 line
= SPC
(90) + "--------------".
807 RUN pclrep-line
( voucher-font
, line
).
808 line
= SPC
(90) + STRING( cheque-total
, ">>>,>>>,>>9.99CR" ).
809 RUN pclrep-line
( voucher-font
, line
).
810 RUN pclrep-line
( ?
, ?
).
816 /* _UIB-CODE-BLOCK-END
*/