process/cheq-run.p

   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.
   7
   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 parent-levels AS INT NO-UNDO.
  15 DEF VAR cheque-message AS CHAR NO-UNDO  INIT "".
  16 DEF VAR first-cheque-no AS INT NO-UNDO  INIT ?.
  17 DEF VAR enforce-cheque-limit AS LOGI NO-UNDO  INIT No.
  18 DEF VAR my-vouchers AS LOGI NO-UNDO  INIT No.
  19 DEF VAR test-client-code AS CHAR NO-UNDO INIT ?.
  20 DEF VAR creditor-list AS CHAR NO-UNDO   INIT "".
  21 DEF VAR creditor-1 AS INT NO-UNDO       INIT 0.
  22 DEF VAR creditor-n AS INT NO-UNDO       INIT 999999.
  23 DEF VAR project-1 AS INT NO-UNDO        INIT 0.
  24 DEF VAR project-n AS INT NO-UNDO        INIT 999999.
  25 DEF VAR account-1 AS DEC NO-UNDO        INIT 0.
  26 DEF VAR account-n AS DEC NO-UNDO        INIT 10000.
  27 DEF VAR bankimport-directory AS CHAR NO-UNDO INIT ?.
  28 DEF VAR pdf-output AS LOGICAL INIT NO NO-UNDO.
  29 RUN parse-parameters.
  30
  31 DEF VAR user-name AS CHAR NO-UNDO.
  32 {inc/username.i "user-name"}
  33 DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO.
  34 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  35
  36 &SCOPED-DEFINE CARD-PYMT "Credit Card Payment"
  37
  38 DEF VAR payment-font AS CHAR NO-UNDO INITIAL "fixed,courier,cpi,14,lpi,8,bold".
  39 DEF VAR voucher-font AS CHAR NO-UNDO INITIAL "fixed,courier,cpi,16,lpi,9,normal".
  40
  41 /* Count of direct-debits (bank-import-file) */
  42 DEFINE VARIABLE v-direct-debits AS INTEGER NO-UNDO INITIAL 0.
  43
  44 /* ensure bank account is scoped to entire program */
  45 FIND FIRST BankAccount WHERE BankAccount.BankAccountCode = bank-account NO-LOCK NO-ERROR.
  46
  47 {inc/ofc-this.i}
  48 {inc/ofc-acct.i "CREDITORS" "sundry-creditors"}
  49 {inc/ofc-set.i "Card-Payment-Creditor" "card-payment-creditor"}
  50 {inc/ofc-set-l.i "Multi-Ledger-Creditors" "multi-ledger-creditors"}
  51
  52 {inc/entity.i}
  53
  54 DEF VAR pay-by-card AS CHAR NO-UNDO INITIAL "".
  55
  56 DEF TEMP-TABLE Payment NO-UNDO
  57     FIELD CreditorCode AS INT
  58     FIELD OtherCreditorCode AS INT
  59     FIELD Name AS CHAR
  60     FIELD BankAccountCode AS CHAR
  61     FIELD ChequeNo AS INT
  62     FIELD Amount AS DEC
  63     FIELD PaymentStyle AS CHAR
  64     INDEX XPKPayments IS UNIQUE PRIMARY CreditorCode PaymentStyle
  65     INDEX XAK1Payments BankAccountCode ChequeNo PaymentStyle
  66     INDEX XAK2Name Name
  67     INDEX XAK3Payments PaymentStyle .
  68
  69 DEF TEMP-TABLE BeingPaid NO-UNDO
  70     FIELD BankAccountCode AS CHAR
  71     FIELD ChequeNo AS INT
  72     FIELD PaymentStyle AS CHAR
  73     FIELD VoucherSeq AS INT
  74     FIELD CreditorCode AS INT
  75     INDEX XPKBeingPaid IS UNIQUE PRIMARY VoucherSeq PaymentStyle
  76     INDEX XAK1BeingPaid PaymentStyle  .
  77
  78 /* _UIB-CODE-BLOCK-END */
  79 &ANALYZE-RESUME
  80
  81
  82 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  83
  84 /* ********************  Preprocessor Definitions  ******************** */
  85
  86 &Scoped-define PROCEDURE-TYPE Procedure
  87 &Scoped-define DB-AWARE no
  88
  89
  90
  91 /* _UIB-PREPROCESSOR-BLOCK-END */
  92 &ANALYZE-RESUME
  93
  94
  95 /* ************************  Function Prototypes ********************** */
  96
  97 &IF DEFINED(EXCLUDE-check-client) = 0 &THEN
  98
  99 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD check-client Procedure
 100 FUNCTION check-client RETURNS LOGICAL
 101   ( INPUT et AS CHAR, INPUT ec AS INT )  FORWARD.
 102
 103 /* _UIB-CODE-BLOCK-END */
 104 &ANALYZE-RESUME
 105
 106 &ENDIF
 107
 108 &IF DEFINED(EXCLUDE-pay-creditor) = 0 &THEN
 109
 110 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pay-creditor Procedure
 111 FUNCTION pay-creditor RETURNS LOGICAL
 112   ( INPUT creditor-code AS INT )  FORWARD.
 113
 114 /* _UIB-CODE-BLOCK-END */
 115 &ANALYZE-RESUME
 116
 117 &ENDIF
 118
 119 &IF DEFINED(EXCLUDE-pay-voucher) = 0 &THEN
 120
 121 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pay-voucher Procedure
 122 FUNCTION pay-voucher RETURNS LOGICAL
 123   ( /* parameter-definitions */ )  FORWARD.
 124
 125 /* _UIB-CODE-BLOCK-END */
 126 &ANALYZE-RESUME
 127
 128 &ENDIF
 129
 130 &IF DEFINED(EXCLUDE-print-payment) = 0 &THEN
 131
 132 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD print-payment Procedure
 133 FUNCTION print-payment RETURNS DECIMAL
 134   ( /* parameter-definitions */ )  FORWARD.
 135
 136 /* _UIB-CODE-BLOCK-END */
 137 &ANALYZE-RESUME
 138
 139 &ENDIF
 140
 141 &IF DEFINED(EXCLUDE-get-voucher-payer) = 0 &THEN
 142
 143 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-voucher-payer Procedure
 144 FUNCTION get-voucher-payer RETURNS INTEGER
 145   ( INPUT vouch-entity-type AS CHAR, INPUT vouch-entity-code AS INT )  FORWARD.
 146
 147 /* _UIB-CODE-BLOCK-END */
 148 &ANALYZE-RESUME
 149
 150 &ENDIF
 151
 152 &IF DEFINED(EXCLUDE-get-company-parent) = 0 &THEN
 153
 154 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-company-parent Procedure
 155 FUNCTION get-company-parent RETURNS INTEGER
 156   ( INPUT temp-company-code AS INT )  FORWARD.
 157
 158 /* _UIB-CODE-BLOCK-END */
 159 &ANALYZE-RESUME
 160
 161 &ENDIF
 162
 163 /* *********************** Procedure Settings ************************ */
 164
 165 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 166 /* Settings for THIS-PROCEDURE
 167    Type: Procedure
 168    Allow:
 169    Frames: 0
 170    Add Fields to: Neither
 171    Other Settings: CODE-ONLY COMPILE
 172  */
 173 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 174
 175 /* *************************  Create Window  ************************** */
 176
 177 &ANALYZE-SUSPEND _CREATE-WINDOW
 178 /* DESIGN Window definition (used by the UIB)
 179   CREATE WINDOW Procedure ASSIGN
 180          HEIGHT             = 22
 181          WIDTH              = 32.86.
 182 /* END WINDOW DEFINITION */
 183                                                                         */
 184 &ANALYZE-RESUME
 185
 186 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 187 /* ************************* Included-Libraries *********************** */
 188
 189 {inc/method/m-txtrep.i}
 190
 191 /* _UIB-CODE-BLOCK-END */
 192 &ANALYZE-RESUME
 193
 194
 195
 196
 197
 198 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 199
 200
 201 /* ***************************  Main Block  *************************** */
 202
 203 RUN build-payment-info.
 204 IF RETURN-VALUE = "" THEN DO:
 205   RUN do-cheque-run.
 206   IF RETURN-VALUE <> "" AND RETURN-VALUE <> "OK" THEN
 207     MESSAGE "Problem assigning cheques:" SKIP
 208              ERROR-STATUS:GET-MESSAGE(1) SKIP(1)
 209             "Cancelling cheque run"
 210              VIEW-AS ALERT-BOX ERROR
 211              TITLE "Error In Cheque Run".
 212 END.
 213
 214 /* _UIB-CODE-BLOCK-END */
 215 &ANALYZE-RESUME
 216
 217
 218 /* **********************  Internal Procedures  *********************** */
 219
 220 &IF DEFINED(EXCLUDE-build-card-payment) = 0 &THEN
 221
 222 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-card-payment Procedure
 223 PROCEDURE build-card-payment :
 224 /*------------------------------------------------------------------------------
 225   Purpose:
 226 ------------------------------------------------------------------------------*/
 227 DEF BUFFER CardPayment FOR Payment.
 228 DEF BUFFER CardVchrPaid FOR BeingPaid.
 229
 230 DEF VAR card-creditor AS INT NO-UNDO.
 231
 232   IF NOT CAN-FIND( FIRST Payment WHERE Payment.PaymentStyle = "CARD") THEN RETURN.
 233   ASSIGN card-creditor = INT(card-payment-creditor) NO-ERROR.
 234   IF ERROR-STATUS:ERROR THEN DO:
 235     MESSAGE "The Office Setting 'Card-Payment-Creditor' needs" SKIP
 236             "to be set to a Creditor Code before the 'CARD'" SKIP
 237             "payment style can be used."
 238             VIEW-AS ALERT-BOX ERROR
 239             TITLE "Card-Payment-Creditor not set".
 240     RETURN ERROR "FAIL".
 241   END.
 242
 243   FOR EACH Payment WHERE Payment.PaymentStyle = "CARD":
 244     FIND CardPayment WHERE CardPayment.CreditorCode = card-creditor
 245                      AND CardPayment.PaymentStyle = {&CARD-PYMT}
 246                      NO-LOCK NO-ERROR.
 247     IF NOT AVAILABLE(CardPayment) THEN DO:
 248       CREATE CardPayment.
 249       CardPayment.CreditorCode = card-creditor.
 250       CardPayment.PaymentStyle = {&CARD-PYMT}.
 251     END.
 252
 253     /* re-assign the vouchers as being paid by the credit card */
 254     FOR EACH BeingPaid OF Payment:
 255       CREATE CardVchrPaid.
 256       BUFFER-COPY BeingPaid TO CardVchrPaid ASSIGN
 257               CardVchrPaid.CreditorCode = CardPayment.CreditorCode
 258               CardVchrPaid.PaymentStyle = CardPayment.PaymentStyle.
 259     END.
 260
 261   END.
 262
 263 END PROCEDURE.
 264
 265 /* _UIB-CODE-BLOCK-END */
 266 &ANALYZE-RESUME
 267
 268 &ENDIF
 269
 270 &IF DEFINED(EXCLUDE-build-payment-info) = 0 &THEN
 271
 272 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-payment-info Procedure
 273 PROCEDURE build-payment-info :
 274 /*------------------------------------------------------------------------------
 275   Purpose:
 276 ------------------------------------------------------------------------------*/
 277   /* Find all of the vouchers which we want to pay */
 278   FOR EACH Voucher
 279       WHERE Voucher.VoucherStatus = "A"
 280              AND (my-vouchers = NO OR Voucher.LastModifiedUser = user-name)    NO-LOCK:
 281     IF NOT( pay-voucher()) THEN DO:
 282         NEXT.
 283     END.
 284     FIND Payment WHERE Payment.CreditorCode = Voucher.CreditorCode
 285                  AND Payment.PaymentStyle = (IF forced-style <> ? THEN forced-style ELSE Voucher.PaymentStyle) NO-ERROR.
 286     IF NOT AVAILABLE(Payment) THEN DO:
 287       FIND Creditor OF Voucher NO-LOCK.
 288       CREATE Payment.
 289       Payment.CreditorCode = Voucher.CreditorCode.
 290       Payment.PaymentStyle = (IF forced-style <> ? THEN forced-style ELSE Voucher.PaymentStyle).
 291       Payment.Amount       = 0.
 292       Payment.Name         = Creditor.PayeeName.
 293     END.
 294     CREATE BeingPaid.
 295     BeingPaid.CreditorCode = Voucher.CreditorCode.
 296     BeingPaid.PaymentStyle = Payment.PaymentStyle.
 297     BeingPaid.VoucherSeq = Voucher.VoucherSeq.
 298     Payment.Amount = Payment.Amount + Voucher.GoodsValue + Voucher.TaxValue .
 299   END.
 300
 301   /* Remove all the creditors we don't want to pay from the process */
 302   FOR EACH Payment:
 303     IF Payment.Amount > 0 AND pay-creditor( Payment.CreditorCode ) THEN DO:
 304         IF TRIM(Payment.PaymentStyle) = 'DC' THEN DO:
 305             IF CAN-FIND(FIRST Creditor
 306             WHERE Creditor.CreditorCode = Payment.CreditorCode
 307               AND Creditor.EnableDirectPayment) THEN NEXT.
 308         END.
 309         ELSE NEXT.
 310     END.
 311     FOR EACH BeingPaid WHERE BeingPaid.CreditorCode = Payment.CreditorCode:
 312       DELETE BeingPaid.
 313     END.
 314     DELETE Payment.
 315   END.
 316
 317   /* if there are any credit card payments, build up the payment for that */
 318   IF CAN-FIND( FIRST Payment WHERE Payment.PaymentStyle = "CARD") THEN DO:
 319     RUN build-card-payment.
 320     IF RETURN-VALUE <> "" THEN RETURN RETURN-VALUE.
 321   END.
 322
 323 END PROCEDURE.
 324
 325 /* _UIB-CODE-BLOCK-END */
 326 &ANALYZE-RESUME
 327
 328 &ENDIF
 329
 330 &IF DEFINED(EXCLUDE-do-card-transfer) = 0 &THEN
 331
 332 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-card-transfer Procedure
 333 PROCEDURE do-card-transfer :
 334 /*------------------------------------------------------------------------------
 335   Purpose:
 336 ------------------------------------------------------------------------------*/
 337 DEF INPUT PARAMETER batch-no AS INT NO-UNDO.
 338 DEF INPUT PARAMETER cheque-no AS INT NO-UNDO.
 339
 340 DEF VAR cheque-total AS DEC NO-UNDO.
 341 DEF VAR i            AS INT NO-UNDO.
 342
 343   FIND Creditor WHERE Creditor.CreditorCode = Payment.CreditorCode NO-LOCK.
 344
 345   CREATE NewDocument.
 346   ASSIGN  NewDocument.BatchCode     = batch-no
 347           NewDocument.DocumentType  = "CARD"
 348           NewDocument.Description   = Creditor.PayeeName
 349           NewDocument.Reference     = "To C" + STRING( Creditor.CreditorCode, "99999") .
 350                                       /* bank-account + STRING(cheque-no, ">999999"). */
 351
 352   FOR EACH BeingPaid OF Payment,
 353       FIRST Voucher WHERE Voucher.VoucherSeq = BeingPaid.VoucherSeq EXCLUSIVE-LOCK:
 354     Voucher.VoucherStatus        = "P".
 355     Voucher.BankAccountCode      = bank-account.
 356     Voucher.ChequeNo             = cheque-no.
 357     cheque-total = cheque-total + Voucher.GoodsValue + Voucher.TaxValue.
 358   END.
 359
 360   /* Debit the creditor */
 361   CREATE NewAcctTrans.
 362   ASSIGN  NewAcctTrans.BatchCode      = batch-no
 363           NewAcctTrans.DocumentCode   = NewDocument.DocumentCode
 364           NewAcctTrans.EntityType     = "C"
 365           NewAcctTrans.EntityCode     = Creditor.CreditorCode
 366           NewAcctTrans.AccountCode    = sundry-creditors
 367           NewAcctTrans.Amount         = cheque-total
 368           NewAcctTrans.Date           = cheque-date
 369           NewAcctTrans.Description    = ""
 370           NewAcctTrans.Reference      = "".
 371
 372   CREATE NewAcctTrans.
 373   ASSIGN  NewAcctTrans.BatchCode      = batch-no
 374           NewAcctTrans.DocumentCode   = NewDocument.DocumentCode
 375           NewAcctTrans.Amount         = cheque-total * -1
 376           NewAcctTrans.Date           = cheque-date
 377           NewAcctTrans.Description    = ""
 378           NewAcctTrans.Reference      = ""
 379           NewAcctTrans.EntityType      = "C"        /* Credit the card payment creditor */
 380           NewAcctTrans.EntityCode      = INT(card-payment-creditor)
 381           NewAcctTrans.AccountCode     = sundry-creditors.
 382
 383 END PROCEDURE.
 384
 385 /* _UIB-CODE-BLOCK-END */
 386 &ANALYZE-RESUME
 387
 388 &ENDIF
 389
 390 &IF DEFINED(EXCLUDE-do-cheque-run) = 0 &THEN
 391
 392 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-cheque-run Procedure
 393 PROCEDURE do-cheque-run :
 394 /*------------------------------------------------------------------------------
 395   Purpose:
 396 ------------------------------------------------------------------------------*/
 397 DEF VAR batch-no     AS INT NO-UNDO.
 398 DEF VAR cheque-no    AS INT NO-UNDO.
 399 DEF VAR end-no    AS INT NO-UNDO.
 400
 401   cheque-no = first-cheque-no.
 402
 403 cheque-run:
 404 DO TRANSACTION ON ERROR UNDO cheque-run, RETURN ERROR "FAIL":
 405
 406   /* Create the batch */
 407   CREATE NewBatch.
 408   ASSIGN    NewBatch.BatchType   = 'NORM'
 409             NewBatch.Description = "Cheque Run - " + STRING( TODAY, "99/99/9999" )
 410                                  + ", " + bank-account + " account".
 411
 412   batch-no = NewBatch.BatchCode .
 413   FOR EACH Payment WHERE Payment.PaymentStyle <> "CARD" BY Payment.Name
 414                     ON ERROR UNDO cheque-run, RETURN ERROR "FAIL":
 415     RUN do-payment( batch-no, INPUT-OUTPUT cheque-no ).
 416   END.
 417   end-no = cheque-no - 1.
 418
 419   FIND Payment WHERE Payment.PaymentStyle = {&CARD-PYMT} NO-ERROR.
 420   IF AVAILABLE(Payment) THEN DO:
 421     cheque-no = Payment.ChequeNo.
 422     FOR EACH Payment WHERE Payment.PaymentStyle = "CARD" BY Payment.Name
 423                     ON ERROR UNDO cheque-run, RETURN ERROR "FAIL":
 424       RUN do-card-transfer( batch-no, cheque-no ).
 425     END.
 426   END.
 427
 428   IF end-no < first-cheque-no THEN DO:
 429     /* no cheques produced */
 430     MESSAGE "No cheques to be printed!"
 431             VIEW-AS ALERT-BOX INFORMATION
 432             TITLE "No Cheques to Print" .
 433     UNDO cheque-run, RETURN ERROR "FAIL".
 434   END.
 435
 436 DEF VAR start-printing AS LOGI NO-UNDO INITIAL Yes.
 437
 438   MESSAGE "Ready to print cheques from " + STRING(first-cheque-no, "999999")
 439                      " to " STRING( end-no, "999999") SKIP
 440             "Preview a report on the cheques first? " SKIP
 441             "  - <Yes> to preview a report first" SKIP
 442             "  - <No> to print the cheques now" SKIP
 443             "  - <Cancel> to cancel the cheque run"
 444             VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL
 445             TITLE "Preview Payment Report?" UPDATE start-printing.
 446
 447   IF start-printing = Yes THEN DO:
 448     RUN print-payment-summary( first-cheque-no, end-no ) .
 449     MESSAGE "Ready to print" STRING(end-no - first-cheque-no + 1)
 450              "cheques from " + STRING(first-cheque-no, "999999")
 451                      " to " STRING( end-no, "999999") SKIP
 452             "Print cheques?" SKIP(1)
 453             "(the printer will prompt for cheque forms, if required)"
 454             VIEW-AS ALERT-BOX QUESTION BUTTONS OK-CANCEL
 455             TITLE "Print Cheques?" UPDATE start-printing.
 456     IF start-printing <> Yes THEN start-printing = ?.
 457   END.
 458
 459   IF start-printing = ? THEN UNDO cheque-run, RETURN ERROR.
 460
 461 END.        /* of transaction block */
 462
 463
 464 report-options = "BankAccount," + BankAccount.BankAccountCode
 465                + "~nChequeRange," + STRING(first-cheque-no) + "," + STRING(end-no)
 466                + "~nMessage," + cheque-message.
 467
 468       /* paymentstyle option -> both forced-paymentstyle and payment style should be reduced to
 469         PaymentStyle and passed to chqprt which should then honour payment style
 470         so cheques where voucher.paymentstyle = 'DC' won't get printed
 471         and if exporting BankImportFile
 472            cheques where voucher.paymentstyle <> 'DC'  won't get printed */
 473 IF forced-style <> ? THEN
 474     report-options = report-options + "~nPaymentStyle," + forced-style.
 475 ELSE
 476     report-options = report-options + "~nPaymentStyle," + payment-style.
 477
 478 IF pdf-output THEN
 479     report-options = report-options + "~nOutputPDF".
 480
 481 RUN process/report/chqprt.p( report-options ).
 482
 483 END PROCEDURE.
 484
 485 /* _UIB-CODE-BLOCK-END */
 486 &ANALYZE-RESUME
 487
 488 &ENDIF
 489
 490 &IF DEFINED(EXCLUDE-do-payment) = 0 &THEN
 491
 492 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do-payment Procedure
 493 PROCEDURE do-payment :
 494 /*------------------------------------------------------------------------------
 495   Purpose:
 496 ------------------------------------------------------------------------------*/
 497 DEF INPUT PARAMETER batch-no AS INT NO-UNDO.
 498 DEF INPUT-OUTPUT PARAMETER cheque-no AS INT NO-UNDO.
 499
 500 DEF VAR cheque-total AS DEC NO-UNDO.
 501 DEF VAR i            AS INT NO-UNDO.
 502 DEF BUFFER Chq FOR Cheque.
 503
 504     FIND Creditor WHERE Creditor.CreditorCode = Payment.CreditorCode NO-LOCK.
 505
 506     CREATE NewDocument.
 507     ASSIGN  NewDocument.BatchCode     = batch-no
 508             NewDocument.DocumentType  = "CHEQ"
 509             NewDocument.Description   = Creditor.PayeeName
 510             NewDocument.Reference     = bank-account + "," + TRIM(STRING(cheque-no, ">999999")).
 511
 512     FIND FIRST Chq WHERE Chq.BankAccountCode = bank-account
 513                   AND Chq.ChequeNo = cheque-no NO-LOCK NO-ERROR.
 514     IF AVAILABLE(Chq) THEN DO:
 515       MESSAGE "Cheque number " + bank-account + "/" + TRIM(STRING( cheque-no, ">>>999999")) + " is already in use" SKIP(1)
 516               "Cancelling cheque run"
 517               VIEW-AS ALERT-BOX ERROR
 518               TITLE "Attempt to Re-Issue Cheque".
 519       RETURN ERROR "FAIL".
 520     END.
 521
 522     CREATE Cheque NO-ERROR.
 523     ASSIGN  Cheque.BatchCode          = batch-no
 524             Cheque.DocumentCode       = NewDocument.DocumentCode
 525             Cheque.BankAccountCode    = bank-account
 526             Cheque.ChequeNo           = cheque-no
 527             Cheque.CreditorCode       = Creditor.CreditorCode
 528             Cheque.Date               = cheque-date
 529             Cheque.PayeeName          = Creditor.PayeeName
 530             Payment.ChequeNo          = cheque-no
 531             cheque-no                 = cheque-no + 1
 532             NO-ERROR .
 533
 534     cheque-total = 0.
 535     FOR EACH BeingPaid OF Payment,
 536         FIRST Voucher WHERE Voucher.VoucherSeq = BeingPaid.VoucherSeq EXCLUSIVE-LOCK:
 537       Voucher.VoucherStatus        = "P".
 538       Voucher.BankAccountCode      = bank-account.
 539       Voucher.ChequeNo             = Cheque.ChequeNo.
 540       /* Adjust Voucher.PaymentStyle if Force PaymentStyle option is set */
 541       IF forced-style <> ? THEN Voucher.PaymentStyle = forced-style.
 542       cheque-total = cheque-total + Voucher.GoodsValue + Voucher.TaxValue.
 543     END.
 544
 545
 546     /* Debit the creditor */
 547     CREATE NewAcctTrans.
 548     ASSIGN  NewAcctTrans.BatchCode      = batch-no
 549             NewAcctTrans.DocumentCode   = NewDocument.DocumentCode
 550             NewAcctTrans.EntityType     = "C"
 551             NewAcctTrans.EntityCode     = Creditor.CreditorCode
 552             NewAcctTrans.AccountCode    = sundry-creditors
 553             NewAcctTrans.Amount         = cheque-total
 554             NewAcctTrans.Date           = cheque-date
 555             NewAcctTrans.Description    = ""
 556             NewAcctTrans.Reference      = ""
 557             Cheque.Amount               = cheque-total.
 558
 559     IF multi-ledger-creditors THEN DO:
 560       NewAcctTrans.AccountCode    = BankAccount.CompanyCode.
 561     END.
 562
 563     CREATE NewAcctTrans.
 564     ASSIGN  NewAcctTrans.BatchCode      = batch-no
 565             NewAcctTrans.DocumentCode   = NewDocument.DocumentCode
 566             NewAcctTrans.Amount         = cheque-total * -1
 567             NewAcctTrans.Date           = cheque-date
 568             NewAcctTrans.Description    = ""
 569             NewAcctTrans.Reference      = ""
 570             NewAcctTrans.EntityType     = "L"        /* Credit the bank account */
 571             NewAcctTrans.EntityCode     = BankAccount.CompanyCode
 572             NewAcctTrans.AccountCode    = BankAccount.AccountCode.
 573
 574   RETURN "".
 575
 576 END PROCEDURE.
 577
 578 /* _UIB-CODE-BLOCK-END */
 579 &ANALYZE-RESUME
 580
 581 &ENDIF
 582
 583 &IF DEFINED(EXCLUDE-inst-page-footer) = 0 &THEN
 584
 585 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 586 PROCEDURE inst-page-footer :
 587 /*------------------------------------------------------------------------------
 588   Purpose:  Print any page footer
 589 ------------------------------------------------------------------------------*/
 590
 591 END PROCEDURE.
 592
 593 /* _UIB-CODE-BLOCK-END */
 594 &ANALYZE-RESUME
 595
 596 &ENDIF
 597
 598 &IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN
 599
 600 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 601 PROCEDURE inst-page-header :
 602 /*------------------------------------------------------------------------------
 603   Purpose:  Print any page header
 604 ------------------------------------------------------------------------------*/
 605
 606   RUN pclrep-line( "univers,Point,7,bold,Proportional", TimeStamp).
 607   RUN pclrep-line( "univers,Point,12,bold,Proportional",
 608     SPC(45) + "Cheque Production Report"
 609   ).
 610   RUN pclrep-line( "", "" ).
 611
 612   /* Put any column headers here */
 613
 614 END PROCEDURE.
 615
 616 /* _UIB-CODE-BLOCK-END */
 617 &ANALYZE-RESUME
 618
 619 &ENDIF
 620
 621 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 622
 623 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 624 PROCEDURE parse-parameters :
 625 /*------------------------------------------------------------------------------
 626   Purpose:
 627 ------------------------------------------------------------------------------*/
 628 DEF VAR token AS CHAR NO-UNDO.
 629 DEF VAR i AS INT NO-UNDO.
 630 DEF VAR n AS INT NO-UNDO.
 631
 632 {inc/showopts.i "report-options"}
 633
 634   n =  NUM-ENTRIES( report-options, "~n" ).
 635   DO i = 1 TO n:
 636     token = ENTRY( i, report-options, "~n" ).
 637
 638     CASE ENTRY( 1, token ):
 639       WHEN "Preview" THEN               preview = Yes.
 640       WHEN "EnforceLimit" THEN          enforce-cheque-limit = Yes.
 641       WHEN "MyVouchers" THEN            my-vouchers = Yes.
 642       WHEN "PaymentStyle" THEN          payment-style = ENTRY(2,token).
 643       WHEN "ForcePaymentBy" THEN        forced-style = ENTRY(2,token).
 644       WHEN "DueBefore" THEN             due-before = DATE(ENTRY(2,token)).
 645       WHEN "ChequeDate" THEN            cheque-date = DATE(ENTRY(2,token)).
 646       WHEN "FirstCheque" THEN           first-cheque-no = INT( ENTRY(2,token)).
 647       WHEN "OneClient" THEN             test-client-code = ENTRY(2,token).
 648       WHEN "BankAccount" THEN           bank-account = ENTRY(2,token).
 649       WHEN "CreditorList" THEN          creditor-list = SUBSTRING( token, INDEX(token,",") + 1).
 650
 651       WHEN "Message" THEN               cheque-message = SUBSTRING( token, INDEX(token,",") + 1).
 652
 653       WHEN "CreditorRange" THEN ASSIGN
 654         creditor-1 = INT(ENTRY(2,token))
 655         creditor-n = INT(ENTRY(3,token)).
 656
 657       WHEN "ProjectRange" THEN ASSIGN
 658         project-1 = INT(ENTRY(2,token))
 659         project-n = INT(ENTRY(3,token)).
 660
 661       WHEN "AccountRange" THEN ASSIGN
 662         account-1 = INT(ENTRY(2,token))
 663         account-n = INT(ENTRY(3,token)).
 664
 665       WHEN "OutputPDF" THEN ASSIGN pdf-output = YES.
 666
 667       WHEN "WriteBankImportFileTo" THEN bankimport-directory = ENTRY(2,token).
 668
 669     END CASE.
 670
 671   END.
 672
 673   /* ensure entries in creditor list are just plain numbers */
 674   n =  NUM-ENTRIES( creditor-list ).
 675   DO i = 1 TO n:
 676     ENTRY(i, creditor-list ) = STRING( INT( TRIM(ENTRY(i,creditor-list)) ) ).
 677   END.
 678
 679 END PROCEDURE.
 680
 681 /* _UIB-CODE-BLOCK-END */
 682 &ANALYZE-RESUME
 683
 684 &ENDIF
 685
 686 &IF DEFINED(EXCLUDE-print-payment-summary) = 0 &THEN
 687
 688 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-payment-summary Procedure
 689 PROCEDURE print-payment-summary :
 690 /*------------------------------------------------------------------------------
 691   Purpose:
 692 ------------------------------------------------------------------------------*/
 693 DEF INPUT PARAMETER from-cheque AS INT NO-UNDO.
 694 DEF INPUT PARAMETER to-cheque AS INT NO-UNDO.
 695
 696 DEF VAR control-file-original AS CHAR NO-UNDO.
 697 DEF VAR print-file-original AS CHAR NO-UNDO.
 698 DEF VAR line AS CHAR NO-UNDO.
 699 DEF VAR payment-total AS DEC NO-UNDO.
 700
 701 print-file-original     = txtrep-print-file.
 702 control-file-original   = txtrep-control-file.
 703 RUN txtrep-initialise.
 704 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 705 RUN pclrep-start( preview, "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9").
 706
 707   FOR EACH Payment WHERE Payment.PaymentStyle <> {&CARD-PYMT}
 708                      AND Payment.PaymentStyle <> "CARD"
 709                      BY Payment.ChequeNo:
 710     payment-total = payment-total + print-payment().
 711   END.
 712   FOR EACH Payment WHERE Payment.PaymentStyle = {&CARD-PYMT}
 713                      BY Payment.ChequeNo:
 714     payment-total = payment-total + print-payment().
 715   END.
 716   line = SPC(90) + "==============".
 717   RUN pclrep-line( voucher-font, line ).
 718   line = STRING( "Total payments for cheque run", "X(90)") + STRING( payment-total, ">>>,>>>,>>9.99CR" ).
 719   RUN pclrep-line( voucher-font, line ).
 720   RUN pclrep-down-by( 2 ).
 721
 722   IF CAN-FIND( FIRST Payment WHERE Payment.PaymentStyle = "CARD") THEN DO:
 723     payment-total = 0.
 724     FOR EACH Payment WHERE Payment.PaymentStyle = "CARD"
 725                      BY Payment.Name:
 726       payment-total = payment-total + print-payment().
 727     END.
 728     line = SPC(90) + "==============".
 729     RUN pclrep-line( voucher-font, line ).
 730     line = STRING( "Total of transfers to credit card", "X(90)") + STRING( payment-total, ">>>,>>>,>>9.99CR" ).
 731     RUN pclrep-line( voucher-font, line ).
 732   END.
 733
 734   OUTPUT CLOSE.
 735   RUN view-output-file ( preview ).
 736
 737   txtrep-print-file     = print-file-original.
 738   txtrep-control-file   = control-file-original.
 739
 740 END PROCEDURE.
 741
 742 /* _UIB-CODE-BLOCK-END */
 743 &ANALYZE-RESUME
 744
 745 &ENDIF
 746
 747 /* ************************  Function Implementations ***************** */
 748
 749 &IF DEFINED(EXCLUDE-check-client) = 0 &THEN
 750
 751 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION check-client Procedure
 752 FUNCTION check-client RETURNS LOGICAL
 753   ( INPUT et AS CHAR, INPUT ec AS INT ) :
 754 /*------------------------------------------------------------------------------
 755   Purpose:  Decide whether this cheque run is for the client who receives
 756             expenses for this entity type / entity code.
 757 ------------------------------------------------------------------------------*/
 758 DEF VAR entity-code AS CHAR NO-UNDO.
 759 DEF VAR result AS LOGI NO-UNDO.
 760
 761   DO WHILE et <> "L":
 762     entity-code = get-parent-entity( et, ec ).
 763     et = SUBSTRING( entity-code, 1, 1).
 764     ec = INT( SUBSTRING( entity-code, 2) ).
 765   END.
 766
 767   FIND Company WHERE Company.CompanyCode = ec NO-LOCK NO-ERROR.
 768   result = (Company.ClientCode = test-client-code).
 769
 770   RETURN result.
 771
 772 END FUNCTION.
 773
 774 /* _UIB-CODE-BLOCK-END */
 775 &ANALYZE-RESUME
 776
 777 &ENDIF
 778
 779 &IF DEFINED(EXCLUDE-pay-creditor) = 0 &THEN
 780
 781 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pay-creditor Procedure
 782 FUNCTION pay-creditor RETURNS LOGICAL
 783   ( INPUT creditor-code AS INT ) :
 784 /*------------------------------------------------------------------------------
 785   Purpose:  Decide whether we pay a particular creditor this time
 786     Notes:
 787 ------------------------------------------------------------------------------*/
 788 DEF BUFFER RecentCheque FOR Cheque.
 789 DEF BUFFER ThisCreditor FOR Creditor.
 790
 791 DEF VAR cheque-days AS DEC NO-UNDO.
 792 DEF VAR pay-this-way AS CHAR NO-UNDO.
 793
 794   IF creditor-code < creditor-1 THEN RETURN No.
 795   IF creditor-code > creditor-n THEN RETURN No.
 796
 797   IF TRIM(creditor-list) <> "" AND LOOKUP(STRING(creditor-code), creditor-list) = 0 THEN RETURN No.
 798
 799   pay-this-way = 'CHEQ'.
 800   IF payment-style <> "" THEN pay-this-way = payment-style.
 801   IF forced-style <> "" THEN pay-this-way = forced-style.
 802   IF pay-this-way = 'DC' THEN DO:
 803     FIND ThisCreditor WHERE ThisCreditor.CreditorCode = creditor-code NO-LOCK NO-ERROR.
 804     IF NOT AVAILABLE(ThisCreditor) THEN RETURN NO.
 805     IF NOT ThisCreditor.EnableDirectPayment THEN RETURN NO.
 806   END.
 807
 808   IF enforce-cheque-limit THEN DO:
 809     FIND LAST RecentCheque WHERE RecentCheque.CreditorCode = creditor-code NO-LOCK NO-ERROR.
 810     IF AVAILABLE(RecentCheque) THEN DO:
 811       FIND ThisCreditor OF RecentCheque NO-LOCK NO-ERROR.
 812       IF AVAILABLE(ThisCreditor) THEN DO:
 813         cheque-days = ThisCreditor.ChequesPerMonth / 30.
 814         IF (cheque-date - RecentCheque.Date) < INT(cheque-days) THEN RETURN No.
 815       END.
 816     END.
 817   END.
 818
 819   RETURN Yes.
 820
 821 END FUNCTION.
 822
 823 /* _UIB-CODE-BLOCK-END */
 824 &ANALYZE-RESUME
 825
 826 &ENDIF
 827
 828 &IF DEFINED(EXCLUDE-pay-voucher) = 0 &THEN
 829
 830 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pay-voucher Procedure
 831 FUNCTION pay-voucher RETURNS LOGICAL
 832   ( /* parameter-definitions */ ) :
 833 /*------------------------------------------------------------------------------
 834   Purpose:  Decide if an approved voucher should be paid in this cheque run
 835     Notes:
 836 ------------------------------------------------------------------------------*/
 837 DEF VAR voucher-company AS INT NO-UNDO.
 838
 839   IF Voucher.EntityType = "J" THEN DO:
 840     IF Voucher.EntityCode < project-1 THEN RETURN No.
 841     IF Voucher.EntityCode > project-n THEN RETURN No.
 842   END.
 843
 844   IF Voucher.AccountCode < account-1 THEN RETURN No.
 845   IF Voucher.AccountCode > account-n THEN RETURN No.
 846
 847   IF Voucher.DateDue > due-before AND Voucher.GoodsValue > 0.0 THEN RETURN No.
 848
 849   IF payment-style <> "" AND Voucher.PaymentStyle <> payment-style THEN RETURN No.
 850
 851   IF multi-ledger-creditors THEN DO:
 852     /* Find out if the voucher is for an entity that is to be paid by this bank account */
 853     voucher-company = get-voucher-payer( Voucher.EntityType, Voucher.EntityCode ).
 854     /* voucher-company = get-entity-ledger( Voucher.EntityType, Voucher.EntityCode ). */
 855     IF voucher-company <> BankAccount.CompanyCode THEN RETURN NO.
 856   END.
 857
 858   IF test-client-code <> ? THEN
 859     RETURN check-client( Voucher.EntityType, Voucher.EntityCode ).
 860
 861   RETURN Yes.
 862
 863 END FUNCTION.
 864
 865 /* _UIB-CODE-BLOCK-END */
 866 &ANALYZE-RESUME
 867
 868 &ENDIF
 869
 870 &IF DEFINED(EXCLUDE-print-payment) = 0 &THEN
 871
 872 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION print-payment Procedure
 873 FUNCTION print-payment RETURNS DECIMAL
 874   ( /* parameter-definitions */ ) :
 875 /*------------------------------------------------------------------------------
 876   Purpose:
 877     Notes:
 878 ------------------------------------------------------------------------------*/
 879 DEF VAR line AS CHAR NO-UNDO.
 880 DEF VAR cheque-total AS DEC NO-UNDO.
 881
 882   FIND FIRST Creditor WHERE Creditor.CreditorCode = Payment.CreditorCode NO-LOCK NO-ERROR.
 883   IF Payment.PaymentStyle = "CARD" THEN
 884     line = "Xfer to card  ".
 885   ELSE
 886     line = "Cheque " + STRING( Payment.ChequeNo, ">999999").
 887
 888   line = line + "  C" + STRING( Creditor.CreditorCode, "99999") + " "
 889        + Creditor.Payee.
 890
 891   IF Payment.PaymentStyle <> "CARD" THEN DO:
 892     FIND PaymentStyle OF Payment NO-LOCK NO-ERROR.
 893     line = STRING( line, "X(70)") + (IF AVAILABLE(PaymentStyle) THEN PaymentStyle.Description ELSE Payment.PaymentStyle).
 894   END.
 895   RUN pclrep-line( payment-font, line ).
 896
 897   cheque-total = 0.
 898   FOR EACH BeingPaid OF Payment, FIRST Voucher WHERE Voucher.VoucherSeq = BeingPaid.VoucherSeq NO-LOCK:
 899     line = SPC(9) + "Voucher" + STRING( Voucher.VoucherSeq, ">>>>>>9") + ",  "
 900          + STRING( Voucher.Date, "99/99/9999" ) + "   "
 901          + STRING( Voucher.Description, "X(50)" ) + " "
 902          + STRING( Voucher.TaxValue + Voucher.GoodsValue, ">>>,>>>,>>9.99CR" ).
 903     cheque-total = cheque-total + Voucher.TaxValue + Voucher.GoodsValue .
 904     RUN pclrep-line( voucher-font, line ).
 905   END.
 906   line = SPC(90) + "--------------".
 907   RUN pclrep-line( voucher-font, line ).
 908   line = SPC(90) + STRING( cheque-total, ">>>,>>>,>>9.99CR" ).
 909   RUN pclrep-line( voucher-font, line ).
 910   RUN pclrep-line( ?, ? ).
 911
 912   RETURN cheque-total.
 913
 914 END FUNCTION.
 915
 916 /* _UIB-CODE-BLOCK-END */
 917 &ANALYZE-RESUME
 918
 919 &ENDIF
 920
 921 &IF DEFINED(EXCLUDE-get-voucher-payer) = 0 &THEN
 922
 923 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-voucher-payer Procedure
 924 FUNCTION get-voucher-payer RETURNS INTEGER
 925   ( INPUT vouch-entity-type AS CHAR, INPUT vouch-entity-code AS INT ) :
 926 /*------------------------------------------------------------------------------
 927   Purpose:
 928     Notes: Check the company associated with this voucher entity, and return the
 929            company code for checking against the selected cheque run account.
 930            Note: If the company found has "ParentPaysBills" then continue recursively
 931            until a company without this setting enabled is found and send back that
 932            code instead.
 933 ------------------------------------------------------------------------------*/
 934 DEF VAR payer-company-code AS INTEGER NO-UNDO.
 935 DEF VAR parent-company-code AS INTEGER NO-UNDO.
 936
 937 /* To track the recursion depth */
 938 parent-levels = 0.
 939
 940 /* Find the company for this entity */
 941 payer-company-code = get-entity-ledger( vouch-entity-type, vouch-entity-code ).
 942
 943 /* Find the first parent that does not have ParentPaysBills enabled */
 944 parent-company-code = get-company-parent( payer-company-code ).
 945
 946 RETURN parent-company-code.
 947
 948 END FUNCTION.
 949
 950 /* _UIB-CODE-BLOCK-END */
 951 &ANALYZE-RESUME
 952
 953 &ENDIF
 954
 955 &IF DEFINED(EXCLUDE-get-company-parent) = 0 &THEN
 956
 957 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-company-parent Procedure
 958 FUNCTION get-company-parent RETURNS INTEGER
 959   ( INPUT temp-company-code AS INT ) :
 960 /*------------------------------------------------------------------------------
 961   Purpose:
 962     Notes: For the supplied company, if that company is set to be paid by the parent
 963            company, then recursively look down the parent company paying chain until
 964            a company is found that does not have that setting enabled, and return
 965            that company code.
 966 ------------------------------------------------------------------------------*/
 967 DEF BUFFER parent_Company FOR Company.
 968
 969 /* Some bad recursion probably going on */
 970 IF parent-levels > 10 THEN DO:
 971     MESSAGE "Unable to find parent company. The search resulted in a depth of more than 10 companies. This could mean there is a loop in the company parent/child company relationships." VIEW-AS ALERT-BOX ERROR TITLE "Recursion depth exceeded".
 972
 973     RETURN temp-company-code.
 974 END.
 975
 976 FIND parent_Company WHERE parent_Company.CompanyCode = temp-company-code NO-LOCK NO-ERROR.
 977 IF AVAILABLE parent_Company THEN DO:
 978     IF parent_Company.ParentPaysBills THEN DO:
 979         parent-levels = parent-levels + 1.
 980         RETURN get-company-parent( parent_Company.ParentCode ).
 981     END.
 982     ELSE
 983         RETURN temp-company-code.
 984 END.
 985
 986 /* Incase something is wrong with record linking */
 987 RETURN temp-company-code.
 988
 989 END FUNCTION.
 990
 991 /* _UIB-CODE-BLOCK-END */
 992 &ANALYZE-RESUME
 993
 994 &ENDIF
 995