Add blank column, rename column.
[capital-apms-progress.git] / process / interest-charges.p
blobc09d5bfa173fadb01966a56a1cd1c84aac7d1142
1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
2 &ANALYZE-RESUME
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.
25 RUN parse-parameters.
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".
35 {inc/ofc-this.i}
36 {inc/ofc-acct.i "DEBTORS" "sundry-debtors"}
38 /* _UIB-CODE-BLOCK-END */
39 &ANALYZE-RESUME
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 */
52 &ANALYZE-RESUME
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 */
64 &ANALYZE-RESUME
66 &ENDIF
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 */
75 &ANALYZE-RESUME
77 &ENDIF
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 */
86 &ANALYZE-RESUME
88 &ENDIF
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 */
97 &ANALYZE-RESUME
99 &ENDIF
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 */
108 &ANALYZE-RESUME
110 &ENDIF
113 /* *********************** Procedure Settings ************************ */
115 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
116 /* Settings for THIS-PROCEDURE
117 Type: Procedure
118 Allow:
119 Frames: 0
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
130 HEIGHT = 31.8
131 WIDTH = 32.57.
132 /* END WINDOW DEFINITION */
134 &ANALYZE-RESUME
136 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
137 /* ************************* Included-Libraries *********************** */
139 {inc/method/m-txtrep.i}
141 /* _UIB-CODE-BLOCK-END */
142 &ANALYZE-RESUME
148 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
151 /* *************************** Main Block *************************** */
153 RUN build-interest-charges.
154 RUN charge-interest.
156 /* _UIB-CODE-BLOCK-END */
157 &ANALYZE-RESUME
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 /*------------------------------------------------------------------------------
167 Purpose:
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".
182 RETURN ERROR "FAIL".
183 END.
185 FOR EACH Payment WHERE Payment.PaymentStyle = "CARD":
186 FIND CardPayment WHERE CardPayment.CreditorCode = card-creditor
187 AND CardPayment.PaymentStyle = {&CARD-PYMT}
188 NO-LOCK NO-ERROR.
189 IF NOT AVAILABLE(CardPayment) THEN DO:
190 CREATE CardPayment.
191 CardPayment.CreditorCode = card-creditor.
192 CardPayment.PaymentStyle = {&CARD-PYMT}.
193 END.
195 /* re-assign the vouchers as being paid by the credit card */
196 FOR EACH BeingPaid OF Payment:
197 CREATE CardVchrPaid.
198 BUFFER-COPY BeingPaid TO CardVchrPaid ASSIGN
199 CardVchrPaid.CreditorCode = CardPayment.CreditorCode
200 CardVchrPaid.PaymentStyle = CardPayment.PaymentStyle.
201 END.
203 END.
205 END PROCEDURE.
207 /* _UIB-CODE-BLOCK-END */
208 &ANALYZE-RESUME
210 &ENDIF
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 /*------------------------------------------------------------------------------
217 Purpose:
218 ------------------------------------------------------------------------------*/
219 DEF VAR
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. */
224 END.
225 END.
227 END PROCEDURE.
229 /* _UIB-CODE-BLOCK-END */
230 &ANALYZE-RESUME
232 &ENDIF
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 /*------------------------------------------------------------------------------
239 Purpose:
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.
249 CREATE NewDocument.
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.
262 END.
264 /* Debit the creditor */
265 CREATE NewAcctTrans.
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 = "".
276 CREATE NewAcctTrans.
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.
287 END PROCEDURE.
289 /* _UIB-CODE-BLOCK-END */
290 &ANALYZE-RESUME
292 &ENDIF
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 /*------------------------------------------------------------------------------
299 Purpose:
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.
307 cheque-run:
308 DO TRANSACTION ON ERROR UNDO cheque-run, RETURN ERROR "FAIL":
310 /* Create the batch */
311 CREATE NewBatch.
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 ).
320 END.
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 ).
329 END.
330 END.
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".
338 END.
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 = ?.
361 END.
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 ).
374 END PROCEDURE.
376 /* _UIB-CODE-BLOCK-END */
377 &ANALYZE-RESUME
379 &ENDIF
381 &IF DEFINED(EXCLUDE-do-payment) = 0 &THEN
383 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-payment Procedure
384 PROCEDURE do-payment :
385 /*------------------------------------------------------------------------------
386 Purpose:
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.
397 CREATE NewDocument.
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".
410 RETURN ERROR "FAIL".
411 END.
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
423 NO-ERROR .
425 cheque-total = 0.
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.
432 END.
434 /* Debit the creditor */
435 CREATE NewAcctTrans.
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.
447 CREATE NewAcctTrans.
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.
458 RETURN "".
460 END PROCEDURE.
462 /* _UIB-CODE-BLOCK-END */
463 &ANALYZE-RESUME
465 &ENDIF
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 ------------------------------------------------------------------------------*/
475 END PROCEDURE.
477 /* _UIB-CODE-BLOCK-END */
478 &ANALYZE-RESUME
480 &ENDIF
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 */
498 END PROCEDURE.
500 /* _UIB-CODE-BLOCK-END */
501 &ANALYZE-RESUME
503 &ENDIF
505 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
507 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
508 PROCEDURE parse-parameters :
509 /*------------------------------------------------------------------------------
510 Purpose:
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" ).
519 DO i = 1 TO 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)).
549 END CASE.
551 END.
553 /* ensure entries in creditor list are just plain numbers */
554 n = NUM-ENTRIES( creditor-list ).
555 DO i = 1 TO n:
556 ENTRY(i, creditor-list ) = STRING( INT( TRIM(ENTRY(i,creditor-list)) ) ).
557 END.
559 END PROCEDURE.
561 /* _UIB-CODE-BLOCK-END */
562 &ANALYZE-RESUME
564 &ENDIF
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 /*------------------------------------------------------------------------------
571 Purpose:
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"
589 BY Payment.ChequeNo:
590 payment-total = payment-total + print-payment().
591 END.
592 FOR EACH Payment WHERE Payment.PaymentStyle = {&CARD-PYMT}
593 BY Payment.ChequeNo:
594 payment-total = payment-total + print-payment().
595 END.
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:
603 payment-total = 0.
604 FOR EACH Payment WHERE Payment.PaymentStyle = "CARD"
605 BY Payment.Name:
606 payment-total = payment-total + print-payment().
607 END.
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 ).
612 END.
614 OUTPUT CLOSE.
615 RUN view-output-file ( preview ).
617 txtrep-print-file = print-file-original.
618 txtrep-control-file = control-file-original.
620 END PROCEDURE.
622 /* _UIB-CODE-BLOCK-END */
623 &ANALYZE-RESUME
625 &ENDIF
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.
641 DO WHILE et <> "L":
642 entity-code = get-parent-entity( et, ec ).
643 et = SUBSTRING( entity-code, 1, 1).
644 ec = INT( SUBSTRING( entity-code, 2) ).
645 END.
647 FIND Company WHERE Company.CompanyCode = ec NO-LOCK NO-ERROR.
648 result = (Company.ClientCode = test-client-code).
650 RETURN result.
652 END FUNCTION.
654 /* _UIB-CODE-BLOCK-END */
655 &ANALYZE-RESUME
657 &ENDIF
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 /*------------------------------------------------------------------------------
665 Purpose:
666 Notes:
667 ------------------------------------------------------------------------------*/
668 DEF VAR parent-entity AS CHAR NO-UNDO.
670 CASE et:
671 WHEN "J" THEN DO:
672 FIND Project WHERE Project.ProjectCode = ec NO-LOCK NO-ERROR.
673 parent-entity = Project.EntityType + STRING( Project.EntityCode, "99999").
674 END.
675 WHEN "P" THEN DO:
676 FIND Property WHERE Property.PropertyCode = ec NO-LOCK NO-ERROR.
677 parent-entity = "L" + STRING( Property.CompanyCode, "99999").
678 END.
679 WHEN "T" THEN DO:
680 FIND Tenant WHERE Tenant.TenantCode = ec NO-LOCK NO-ERROR.
681 parent-entity = Tenant.EntityType + STRING( Tenant.EntityCode, "99999").
682 END.
683 WHEN "C" THEN DO:
684 FIND Creditor WHERE Creditor.CreditorCode = ec NO-LOCK NO-ERROR.
685 parent-entity = "L" + STRING( Creditor.CompanyCode, "99999").
686 END.
687 END CASE.
689 RETURN parent-entity.
691 END FUNCTION.
693 /* _UIB-CODE-BLOCK-END */
694 &ANALYZE-RESUME
696 &ENDIF
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
705 Notes:
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.
724 END.
725 END.
726 END.
728 RETURN Yes.
730 END FUNCTION.
732 /* _UIB-CODE-BLOCK-END */
733 &ANALYZE-RESUME
735 &ENDIF
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
744 Notes:
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.
749 END.
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 ).
761 RETURN Yes.
763 END FUNCTION.
765 /* _UIB-CODE-BLOCK-END */
766 &ANALYZE-RESUME
768 &ENDIF
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 /*------------------------------------------------------------------------------
776 Purpose:
777 Notes:
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 ".
785 ELSE
786 line = "Cheque " + STRING( Payment.ChequeNo, ">999999").
788 line = line + " C" + STRING( Creditor.CreditorCode, "99999") + " "
789 + Creditor.Payee.
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).
794 END.
795 RUN pclrep-line( payment-font, line ).
797 cheque-total = 0.
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 ).
805 END.
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( ?, ? ).
812 RETURN cheque-total.
814 END FUNCTION.
816 /* _UIB-CODE-BLOCK-END */
817 &ANALYZE-RESUME
819 &ENDIF