process/report/approved-vouchers.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     Approved Vouchers Report
   6   ------------------------------------------------------------------------*/
   7 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
   8
   9 DEF VAR preview   AS LOGI NO-UNDO       INIT No.
  10 DEF VAR payment-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 exporting AS LOGI NO-UNDO       INIT No.
  14 DEF VAR file-name AS CHAR NO-UNDO       INIT "".
  15 DEF VAR cheque-date AS DATE NO-UNDO.
  16 DEF VAR cheque-message AS CHAR NO-UNDO  INIT "".
  17 DEF VAR print-approval-page AS LOGI NO-UNDO INIT No.
  18 DEF VAR first-cheque-no AS INT NO-UNDO  INIT ?.
  19 DEF VAR enforce-cheque-limit AS LOGI NO-UNDO  INIT No.
  20 DEF VAR test-client-code AS CHAR NO-UNDO INIT ?.
  21 DEF VAR creditor-list AS CHAR NO-UNDO   INIT "".
  22 DEF VAR creditor-1 AS INT NO-UNDO       INIT 0.
  23 DEF VAR creditor-n AS INT NO-UNDO       INIT 999999.
  24 DEF VAR project-1 AS INT NO-UNDO        INIT 0.
  25 DEF VAR project-n AS INT NO-UNDO        INIT 999999.
  26 DEF VAR account-1 AS DEC NO-UNDO        INIT 0.
  27 DEF VAR account-n AS DEC NO-UNDO        INIT 10000.
  28 RUN parse-parameters.
  29
  30 DEF VAR user-name AS CHAR NO-UNDO.
  31 {inc/username.i "user-name"}
  32 DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO.
  33 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  34
  35 &SCOPED-DEFINE CARD-PYMT "Credit Card Payment"
  36
  37 DEF VAR pr-line AS CHAR INIT "" NO-UNDO.        /* used everywhere to hold print line */
  38 DEF VAR on-approval-page AS LOGI NO-UNDO.
  39
  40 DEF VAR title-font            AS CHAR NO-UNDO   INITIAL "proportional,helv,point,12,bold".
  41 DEF VAR time-font             AS CHAR NO-UNDO   INITIAL "proportional,helv,point,6,normal".
  42 DEF VAR break1-font           AS CHAR NO-UNDO   INITIAL "proportional,helv,point,12,bold".
  43 DEF VAR break2-font           AS CHAR NO-UNDO   INITIAL "proportional,helv,point,8,bold".
  44 DEF VAR line1-font            AS CHAR NO-UNDO   INITIAL "fixed,courier,cpi,18,lpi,9,bold".
  45 DEF VAR line2-font            AS CHAR NO-UNDO   INITIAL "fixed,courier,cpi,18,lpi,9,normal".
  46 DEF VAR amt-fmt               AS CHAR INIT "(>>,>>>,>>9.99)" NO-UNDO.
  47 DEF VAR i AS INT NO-UNDO.
  48
  49 /* ensure bank account is scoped to entire program */
  50 FIND FIRST BankAccount WHERE BankAccount.BankAccountCode = bank-account NO-LOCK NO-ERROR.
  51
  52 {inc/ofc-this.i}
  53 {inc/ofc-acct.i "CREDITORS" "sundry-creditors"}
  54 {inc/ofc-set.i "Card-Payment-Creditor" "card-payment-creditor"}
  55
  56 DEF VAR pay-by-card AS CHAR NO-UNDO INITIAL "".
  57
  58 DEF TEMP-TABLE Payment NO-UNDO
  59     FIELD CreditorCode AS INT
  60     FIELD OtherCreditorCode AS INT
  61     FIELD Name AS CHAR
  62     FIELD BankAccountCode AS CHAR
  63     FIELD ChequeNo AS INT
  64     FIELD Amount AS DEC
  65     FIELD PaymentStyle AS CHAR
  66     INDEX XPKPayments IS UNIQUE PRIMARY CreditorCode PaymentStyle
  67     INDEX XAK1Payments BankAccountCode ChequeNo PaymentStyle
  68     INDEX XAK2Name Name
  69     INDEX XAK3Payments PaymentStyle .
  70
  71 DEF TEMP-TABLE BeingPaid NO-UNDO
  72     FIELD BankAccountCode AS CHAR
  73     FIELD ChequeNo AS INT
  74     FIELD PaymentStyle AS CHAR
  75     FIELD VoucherSeq AS INT
  76     FIELD CreditorCode AS INT
  77     INDEX XPKBeingPaid IS UNIQUE PRIMARY VoucherSeq PaymentStyle
  78     INDEX XAK1BeingPaid PaymentStyle  .
  79
  80 DEF TEMP-TABLE PseudoCheque NO-UNDO
  81     FIELD ChequeNo LIKE Cheque.ChequeNo
  82     FIELD CreditorCode LIKE Cheque.CreditorCode
  83     FIELD PayeeName LIKE Cheque.PayeeName
  84     FIELD Amount LIKE Cheque.Amount
  85     INDEX XPKPseudo IS UNIQUE PRIMARY ChequeNo
  86     INDEX XAK1Pseudo PayeeName CreditorCode.
  87
  88 /* _UIB-CODE-BLOCK-END */
  89 &ANALYZE-RESUME
  90
  91
  92 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  93
  94 /* ********************  Preprocessor Definitions  ******************** */
  95
  96 &Scoped-define PROCEDURE-TYPE Procedure
  97
  98
  99
 100 /* _UIB-PREPROCESSOR-BLOCK-END */
 101 &ANALYZE-RESUME
 102
 103
 104 /* ************************  Function Prototypes ********************** */
 105
 106 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD check-client Procedure
 107 FUNCTION check-client RETURNS LOGICAL
 108   ( INPUT et AS CHAR, INPUT ec AS INT )  FORWARD.
 109
 110 /* _UIB-CODE-BLOCK-END */
 111 &ANALYZE-RESUME
 112
 113 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-parent-entity Procedure
 114 FUNCTION get-parent-entity RETURNS CHARACTER
 115   ( INPUT et AS CHAR, INPUT ec AS INT )  FORWARD.
 116
 117 /* _UIB-CODE-BLOCK-END */
 118 &ANALYZE-RESUME
 119
 120 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pay-creditor Procedure
 121 FUNCTION pay-creditor RETURNS LOGICAL
 122   ( INPUT creditor-code AS INT )  FORWARD.
 123
 124 /* _UIB-CODE-BLOCK-END */
 125 &ANALYZE-RESUME
 126
 127 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pay-voucher Procedure
 128 FUNCTION pay-voucher RETURNS LOGICAL
 129   ( /* parameter-definitions */ )  FORWARD.
 130
 131 /* _UIB-CODE-BLOCK-END */
 132 &ANALYZE-RESUME
 133
 134 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD print-payment Procedure
 135 FUNCTION print-payment RETURNS DECIMAL
 136   ( /* parameter-definitions */ )  FORWARD.
 137
 138 /* _UIB-CODE-BLOCK-END */
 139 &ANALYZE-RESUME
 140
 141
 142 /* *********************** Procedure Settings ************************ */
 143
 144 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 145 /* Settings for THIS-PROCEDURE
 146    Type: Procedure
 147    Allow:
 148    Frames: 0
 149    Add Fields to: Neither
 150    Other Settings: CODE-ONLY COMPILE
 151  */
 152 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 153
 154 /* *************************  Create Window  ************************** */
 155
 156 &ANALYZE-SUSPEND _CREATE-WINDOW
 157 /* DESIGN Window definition (used by the UIB)
 158   CREATE WINDOW Procedure ASSIGN
 159          HEIGHT             = .08
 160          WIDTH              = 40.
 161 /* END WINDOW DEFINITION */
 162                                                                         */
 163 &ANALYZE-RESUME
 164
 165
 166
 167 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 168 /* ************************* Included-Libraries *********************** */
 169
 170 {inc/method/m-txtrep.i}
 171
 172 /* _UIB-CODE-BLOCK-END */
 173 &ANALYZE-RESUME
 174
 175
 176
 177 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 178
 179
 180 /* ***************************  Main Block  *************************** */
 181
 182 OUTPUT TO VALUE( IF exporting THEN file-name ELSE txtrep-print-file ) KEEP-MESSAGES PAGE-SIZE 0.
 183 RUN pclrep-start( preview OR exporting,
 184                   "reset,portrait,tm,2,a4,lm,6," + line1-font).
 185
 186 IF print-approval-page THEN RUN approval-page.
 187 RUN build-payment-info.
 188 RUN imitate-cheque-run.
 189 RUN print-payment-summary.
 190
 191 OUTPUT CLOSE.
 192
 193 IF exporting THEN
 194   MESSAGE "Export Complete" VIEW-AS ALERT-BOX INFORMATION TITLE "Finished".
 195 ELSE
 196   RUN pclrep-finish.
 197
 198 /* _UIB-CODE-BLOCK-END */
 199 &ANALYZE-RESUME
 200
 201
 202 /* **********************  Internal Procedures  *********************** */
 203
 204 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE approval-page Procedure
 205 PROCEDURE approval-page :
 206 /*------------------------------------------------------------------------------
 207   Purpose:
 208 ------------------------------------------------------------------------------*/
 209   on-approval-page = Yes.
 210   RUN pclrep-down-by(4).
 211   RUN pclrep-line( title-font + ",point,18", "Cheque Authorisation" ).
 212   RUN pclrep-line( line1-font + ",cpi,8,lpi,4", " ").
 213   RUN pclrep-down-by(8).
 214   RUN pclrep-line( title-font + ",point,15,lpi,4", "Documentation correct:" ).
 215   RUN pclrep-down-by(4).
 216   RUN pclrep-line( line1-font + ",cpi,8,lpi,4", "_________________________________     ___ /___ /____").
 217   RUN pclrep-down-by(8).
 218   RUN pclrep-line( title-font + ",point,15,lpi,4", "Cheques approved for signature:" ).
 219   RUN pclrep-down-by(4).
 220   RUN pclrep-line( line1-font + ",cpi,8,lpi,4", "_________________________________     ___ /___ /____").
 221   RUN pclrep-page-break.
 222
 223   on-approval-page = No.
 224 END PROCEDURE.
 225
 226 /* _UIB-CODE-BLOCK-END */
 227 &ANALYZE-RESUME
 228
 229
 230 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-card-payment Procedure
 231 PROCEDURE build-card-payment :
 232 /*------------------------------------------------------------------------------
 233   Purpose:
 234 ------------------------------------------------------------------------------*/
 235 DEF BUFFER CardPayment FOR Payment.
 236 DEF BUFFER CardVchrPaid FOR BeingPaid.
 237
 238 DEF VAR card-creditor AS INT NO-UNDO.
 239
 240   IF NOT CAN-FIND( FIRST Payment WHERE Payment.PaymentStyle = "CARD") THEN RETURN.
 241   ASSIGN card-creditor = INT(card-payment-creditor) NO-ERROR.
 242   IF ERROR-STATUS:ERROR THEN DO:
 243     MESSAGE "The Office Setting 'Card-Payment-Creditor' needs" SKIP
 244             "to be set to a Creditor Code before the 'CARD'" SKIP
 245             "payment style can be used."
 246             VIEW-AS ALERT-BOX ERROR
 247             TITLE "Card-Payment-Creditor not set".
 248     RETURN ERROR "FAIL".
 249   END.
 250
 251   FOR EACH Payment WHERE Payment.PaymentStyle = "CARD":
 252     FIND CardPayment WHERE CardPayment.CreditorCode = card-creditor
 253                      AND CardPayment.PaymentStyle = {&CARD-PYMT}
 254                      NO-LOCK NO-ERROR.
 255     IF NOT AVAILABLE(CardPayment) THEN DO:
 256       CREATE CardPayment.
 257       CardPayment.CreditorCode = card-creditor.
 258       CardPayment.PaymentStyle = {&CARD-PYMT}.
 259     END.
 260
 261     /* re-assign the vouchers as being paid by the credit card */
 262     FOR EACH BeingPaid OF Payment:
 263       CREATE CardVchrPaid.
 264       BUFFER-COPY BeingPaid TO CardVchrPaid ASSIGN
 265               CardVchrPaid.CreditorCode = CardPayment.CreditorCode
 266               CardVchrPaid.PaymentStyle = CardPayment.PaymentStyle.
 267     END.
 268
 269   END.
 270
 271 END PROCEDURE.
 272
 273 /* _UIB-CODE-BLOCK-END */
 274 &ANALYZE-RESUME
 275
 276
 277 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-payment-info Procedure
 278 PROCEDURE build-payment-info :
 279 /*------------------------------------------------------------------------------
 280   Purpose:
 281 ------------------------------------------------------------------------------*/
 282   /* Find all of the vouchers which we want to pay */
 283   FOR EACH Voucher WHERE Voucher.VoucherStatus = "A" NO-LOCK:
 284     IF NOT( pay-voucher()) THEN NEXT.
 285     FIND Payment WHERE Payment.CreditorCode = Voucher.CreditorCode
 286                  AND Payment.PaymentStyle = Voucher.PaymentStyle
 287                  NO-LOCK NO-ERROR.
 288     IF NOT AVAILABLE(Payment) THEN DO:
 289       FIND Creditor OF Voucher NO-LOCK.
 290       CREATE Payment.
 291       Payment.CreditorCode = Voucher.CreditorCode.
 292       Payment.PaymentStyle = Voucher.PaymentStyle.
 293       Payment.Amount       = 0.
 294       Payment.Name         = Creditor.PayeeName.
 295     END.
 296     CREATE BeingPaid.
 297     BeingPaid.CreditorCode = Voucher.CreditorCode.
 298     BeingPaid.PaymentStyle = Voucher.PaymentStyle.
 299     BeingPaid.VoucherSeq = Voucher.VoucherSeq.
 300     Payment.Amount = Payment.Amount + Voucher.GoodsValue + Voucher.TaxValue .
 301   END.
 302
 303   /* Remove all the creditors we don't want to pay from the process */
 304   FOR EACH Payment:
 305     IF Payment.Amount > 0 AND pay-creditor( Payment.CreditorCode ) THEN NEXT.
 306     FOR EACH BeingPaid WHERE BeingPaid.CreditorCode = Payment.CreditorCode:
 307       DELETE BeingPaid.
 308     END.
 309     DELETE Payment.
 310   END.
 311
 312   /* if there are any credit card payments, build up the payment for that */
 313   IF CAN-FIND( FIRST Payment WHERE Payment.PaymentStyle = "CARD") THEN DO:
 314     RUN build-card-payment.
 315     IF RETURN-VALUE <> "" THEN RETURN RETURN-VALUE.
 316   END.
 317
 318 END PROCEDURE.
 319
 320 /* _UIB-CODE-BLOCK-END */
 321 &ANALYZE-RESUME
 322
 323
 324 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE imitate-card-transfer Procedure
 325 PROCEDURE imitate-card-transfer :
 326 /*------------------------------------------------------------------------------
 327   Purpose:
 328 ------------------------------------------------------------------------------*/
 329 DEF VAR cheque-total AS DEC NO-UNDO.
 330 DEF VAR i            AS INT NO-UNDO.
 331
 332   FIND Creditor WHERE Creditor.CreditorCode = Payment.CreditorCode NO-LOCK.
 333
 334   FOR EACH BeingPaid OF Payment,
 335       FIRST Voucher WHERE Voucher.VoucherSeq = BeingPaid.VoucherSeq NO-LOCK:
 336     cheque-total = cheque-total + Voucher.GoodsValue + Voucher.TaxValue.
 337     BeingPaid.ChequeNo = PseudoCheque.ChequeNo.
 338   END.
 339
 340 END PROCEDURE.
 341
 342 /* _UIB-CODE-BLOCK-END */
 343 &ANALYZE-RESUME
 344
 345
 346 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE imitate-cheque-run Procedure
 347 PROCEDURE imitate-cheque-run :
 348 /*------------------------------------------------------------------------------
 349   Purpose:
 350 ------------------------------------------------------------------------------*/
 351
 352   FOR EACH Payment WHERE Payment.PaymentStyle <> "CARD" BY Payment.Name:
 353     RUN imitate-payment.
 354   END.
 355
 356   FIND Payment WHERE Payment.PaymentStyle = {&CARD-PYMT} NO-ERROR.
 357   IF AVAILABLE(Payment) THEN DO:
 358     FIND PseudoCheque OF Payment.
 359     FOR EACH Payment WHERE Payment.PaymentStyle = "CARD" BY Payment.Name:
 360       RUN imitate-card-transfer.
 361     END.
 362   END.
 363
 364 END PROCEDURE.
 365
 366 /* _UIB-CODE-BLOCK-END */
 367 &ANALYZE-RESUME
 368
 369
 370 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE imitate-payment Procedure
 371 PROCEDURE imitate-payment :
 372 /*------------------------------------------------------------------------------
 373   Purpose:
 374 ------------------------------------------------------------------------------*/
 375 DEF VAR cheque-total AS DEC NO-UNDO.
 376 DEF VAR i            AS INT NO-UNDO.
 377
 378 DEF BUFFER PCheque FOR PseudoCheque.
 379
 380   FIND Creditor WHERE Creditor.CreditorCode = Payment.CreditorCode NO-LOCK.
 381   FIND LAST PCheque NO-ERROR.
 382
 383   CREATE PseudoCheque.
 384   ASSIGN  PseudoCheque.CreditorCode   = Creditor.CreditorCode
 385           PseudoCheque.PayeeName      = Creditor.PayeeName
 386           PseudoCheque.ChequeNo       = 1 + (IF AVAILABLE(PCheque) THEN PCheque.ChequeNo ELSE 0).
 387
 388   cheque-total = 0.
 389   FOR EACH BeingPaid OF Payment,
 390           FIRST Voucher WHERE Voucher.VoucherSeq = BeingPaid.VoucherSeq NO-LOCK:
 391     cheque-total = cheque-total + Voucher.GoodsValue + Voucher.TaxValue.
 392     BeingPaid.ChequeNo = PseudoCheque.ChequeNo.
 393   END.
 394
 395   PseudoCheque.Amount   = cheque-total.
 396   Payment.ChequeNo      = PseudoCheque.ChequeNo.
 397
 398 END PROCEDURE.
 399
 400 /* _UIB-CODE-BLOCK-END */
 401 &ANALYZE-RESUME
 402
 403
 404 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 405 PROCEDURE inst-page-footer :
 406 /*------------------------------------------------------------------------------
 407   Purpose:
 408 ------------------------------------------------------------------------------*/
 409
 410 END PROCEDURE.
 411
 412 /* _UIB-CODE-BLOCK-END */
 413 &ANALYZE-RESUME
 414
 415
 416 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 417 PROCEDURE inst-page-header :
 418 /*------------------------------------------------------------------------------
 419   Purpose:
 420 ------------------------------------------------------------------------------*/
 421   IF on-approval-page THEN RETURN.
 422
 423   pr-line = timeStamp.
 424   IF NOT exporting THEN DO:
 425     pr-line = pr-line + CHR(13) + SPC(275) + "Page: " + STRING( pclrep-page-number ).
 426   END.
 427   RUN pclrep-line( time-font, pr-line).
 428
 429   RUN pclrep-line( ?, "").
 430   RUN pclrep-line( ?, "").
 431   IF test-client-code = ? THEN
 432     RUN pclrep-line( title-font, SPC(45) + "Vouchers Approved for Payment" ).
 433   ELSE
 434     RUN pclrep-line( title-font, SPC(40) + "Vouchers Approved for Payment - " + test-client-code ).
 435   RUN pclrep-line( time-font, "").
 436   RUN pclrep-line( time-font, "").
 437
 438
 439 END PROCEDURE.
 440
 441 /* _UIB-CODE-BLOCK-END */
 442 &ANALYZE-RESUME
 443
 444
 445 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 446 PROCEDURE parse-parameters :
 447 /*------------------------------------------------------------------------------
 448   Purpose:
 449 ------------------------------------------------------------------------------*/
 450 DEF VAR token AS CHAR NO-UNDO.
 451 DEF VAR i AS INT NO-UNDO.
 452
 453 {inc/showopts.i "report-options"}
 454
 455   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 456     token = ENTRY( i, report-options, "~n" ).
 457
 458     CASE ENTRY( 1, token ):
 459       WHEN "Preview" THEN               preview = Yes.
 460       WHEN "EnforceLimit" THEN          enforce-cheque-limit = Yes.
 461       WHEN "ApprovalPage" THEN          print-approval-page = Yes.
 462       WHEN "PaymentStyle" THEN          payment-style = ENTRY(2,token).
 463       WHEN "DueBefore" THEN             due-before = DATE(ENTRY(2,token)).
 464       WHEN "OneClient" THEN             test-client-code = ENTRY(2,token).
 465       WHEN "CreditorList" THEN          creditor-list = SUBSTRING( token, INDEX(token,",") + 1).
 466
 467       WHEN "Message" THEN               cheque-message = SUBSTRING( token, INDEX(token,",") + 1).
 468
 469       WHEN "CreditorRange" THEN ASSIGN
 470         creditor-1 = INT(ENTRY(2,token))
 471         creditor-n = INT(ENTRY(3,token)).
 472
 473       WHEN "ProjectRange" THEN ASSIGN
 474         project-1 = INT(ENTRY(2,token))
 475         project-n = INT(ENTRY(3,token)).
 476
 477       WHEN "AccountRange" THEN ASSIGN
 478         account-1 = INT(ENTRY(2,token))
 479         account-n = INT(ENTRY(3,token)).
 480
 481
 482     END CASE.
 483
 484   END.
 485
 486   DO i = 1 TO NUM-ENTRIES(creditor-list):
 487     ENTRY(i,creditor-list) = STRING(INT(ENTRY(i,creditor-list))).
 488   END.
 489
 490 END PROCEDURE.
 491
 492 /* _UIB-CODE-BLOCK-END */
 493 &ANALYZE-RESUME
 494
 495
 496 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-payment-summary Procedure
 497 PROCEDURE print-payment-summary :
 498 /*------------------------------------------------------------------------------
 499   Purpose:
 500 ------------------------------------------------------------------------------*/
 501 DEF VAR line AS CHAR NO-UNDO.
 502 DEF VAR payment-total AS DEC NO-UNDO.
 503
 504   FOR EACH Payment WHERE Payment.PaymentStyle <> {&CARD-PYMT}
 505                      AND Payment.PaymentStyle <> "CARD"
 506                      BY Payment.ChequeNo:
 507     payment-total = payment-total + print-payment().
 508   END.
 509   FOR EACH Payment WHERE Payment.PaymentStyle = {&CARD-PYMT}
 510                     BY Payment.ChequeNo:
 511     payment-total = payment-total + print-payment().
 512   END.
 513   line = SPC(90) + "==============".
 514   RUN pclrep-line( line2-font, line ).
 515   line = STRING( "Total cost of approved vouchers", "X(90)") + STRING( payment-total, ">>>,>>>,>>9.99CR" ).
 516   RUN pclrep-line( line2-font, line ).
 517   RUN pclrep-down-by( 2 ).
 518
 519   IF CAN-FIND( FIRST Payment WHERE Payment.PaymentStyle = "CARD") THEN DO:
 520     payment-total = 0.
 521     FOR EACH Payment WHERE Payment.PaymentStyle = "CARD"
 522                       BY Payment.Name:
 523       payment-total = payment-total + print-payment().
 524     END.
 525     line = SPC(90) + "==============".
 526     RUN pclrep-line( line2-font, line ).
 527     line = STRING( "Total of transfers to credit card", "X(90)") + STRING( payment-total, ">>>,>>>,>>9.99CR" ).
 528     RUN pclrep-line( line2-font, line ).
 529   END.
 530
 531 END PROCEDURE.
 532
 533 /* _UIB-CODE-BLOCK-END */
 534 &ANALYZE-RESUME
 535
 536
 537 /* ************************  Function Implementations ***************** */
 538
 539 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION check-client Procedure
 540 FUNCTION check-client RETURNS LOGICAL
 541   ( INPUT et AS CHAR, INPUT ec AS INT ) :
 542 /*------------------------------------------------------------------------------
 543   Purpose:  Decide whether this cheque run is for the client who receives
 544             expenses for this entity type / entity code.
 545 ------------------------------------------------------------------------------*/
 546 DEF VAR entity-code AS CHAR NO-UNDO.
 547 DEF VAR result AS LOGI NO-UNDO.
 548
 549   IF test-client-code = ? THEN RETURN Yes.
 550
 551   DO WHILE et <> "L":
 552     entity-code = get-parent-entity( et, ec ).
 553     et = SUBSTRING( entity-code, 1, 1).
 554     ec = INT( SUBSTRING( entity-code, 2) ).
 555   END.
 556
 557   FIND Company WHERE Company.CompanyCode = ec NO-LOCK NO-ERROR.
 558   result = (Company.ClientCode = test-client-code).
 559
 560   RETURN result.
 561
 562 END FUNCTION.
 563
 564 /* _UIB-CODE-BLOCK-END */
 565 &ANALYZE-RESUME
 566
 567
 568 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-parent-entity Procedure
 569 FUNCTION get-parent-entity RETURNS CHARACTER
 570   ( INPUT et AS CHAR, INPUT ec AS INT ) :
 571 /*------------------------------------------------------------------------------
 572   Purpose:
 573     Notes:
 574 ------------------------------------------------------------------------------*/
 575 DEF VAR parent-entity AS CHAR NO-UNDO.
 576
 577   CASE et:
 578     WHEN "J" THEN DO:
 579       FIND Project WHERE Project.ProjectCode = ec NO-LOCK NO-ERROR.
 580       parent-entity = Project.EntityType + STRING( Project.EntityCode, "99999").
 581     END.
 582     WHEN "P" THEN DO:
 583       FIND Property WHERE Property.PropertyCode = ec NO-LOCK NO-ERROR.
 584       parent-entity = "L" + STRING( Property.CompanyCode, "99999").
 585     END.
 586     WHEN "T" THEN DO:
 587       FIND Tenant WHERE Tenant.TenantCode = ec NO-LOCK NO-ERROR.
 588       parent-entity = Tenant.EntityType + STRING( Tenant.EntityCode, "99999").
 589     END.
 590     WHEN "C" THEN DO:
 591       FIND Creditor WHERE Creditor.CreditorCode = ec NO-LOCK NO-ERROR.
 592       parent-entity = "L" + STRING( Creditor.CompanyCode, "99999").
 593     END.
 594   END CASE.
 595
 596   RETURN parent-entity.
 597
 598 END FUNCTION.
 599
 600 /* _UIB-CODE-BLOCK-END */
 601 &ANALYZE-RESUME
 602
 603
 604 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pay-creditor Procedure
 605 FUNCTION pay-creditor RETURNS LOGICAL
 606   ( INPUT creditor-code AS INT ) :
 607 /*------------------------------------------------------------------------------
 608   Purpose:  Decide whether we pay a particular creditor this time
 609     Notes:
 610 ------------------------------------------------------------------------------*/
 611 DEF BUFFER RecentCheque FOR Cheque.
 612 DEF BUFFER ThisCreditor FOR Creditor.
 613
 614 DEF VAR cheque-days AS DEC NO-UNDO.
 615
 616   IF creditor-code < creditor-1 THEN RETURN No.
 617   IF creditor-code > creditor-n THEN RETURN No.
 618
 619   IF TRIM(creditor-list) <> "" AND LOOKUP(STRING(creditor-code), creditor-list) = 0 THEN RETURN No.
 620
 621   IF enforce-cheque-limit THEN DO:
 622     FIND LAST RecentCheque WHERE RecentCheque.CreditorCode = creditor-code NO-LOCK NO-ERROR.
 623     IF AVAILABLE(RecentCheque) THEN DO:
 624       FIND ThisCreditor OF RecentCheque NO-LOCK NO-ERROR.
 625       IF AVAILABLE(ThisCreditor) THEN DO:
 626         cheque-days = ThisCreditor.ChequesPerMonth / 30.
 627         IF (cheque-date - RecentCheque.Date) < INT(cheque-days) THEN RETURN No.
 628       END.
 629     END.
 630   END.
 631
 632   RETURN Yes.
 633
 634 END FUNCTION.
 635
 636 /* _UIB-CODE-BLOCK-END */
 637 &ANALYZE-RESUME
 638
 639
 640 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pay-voucher Procedure
 641 FUNCTION pay-voucher RETURNS LOGICAL
 642   ( /* parameter-definitions */ ) :
 643 /*------------------------------------------------------------------------------
 644   Purpose:  Decide if an approved voucher should be paid in this cheque run
 645     Notes:
 646 ------------------------------------------------------------------------------*/
 647   IF Voucher.EntityType = "J" THEN DO:
 648     IF Voucher.EntityCode < project-1 THEN RETURN No.
 649     IF Voucher.EntityCode > project-n THEN RETURN No.
 650   END.
 651
 652   IF Voucher.AccountCode < account-1 THEN RETURN No.
 653   IF Voucher.AccountCode > account-n THEN RETURN No.
 654
 655   IF Voucher.DateDue > due-before AND Voucher.GoodsValue > 0.0 THEN RETURN No.
 656
 657   IF payment-style <> "" AND Voucher.PaymentStyle <> payment-style THEN RETURN No.
 658
 659   IF test-client-code <> ? THEN
 660     RETURN check-client( Voucher.EntityType, Voucher.EntityCode ).
 661
 662   RETURN Yes.
 663
 664 END FUNCTION.
 665
 666 /* _UIB-CODE-BLOCK-END */
 667 &ANALYZE-RESUME
 668
 669
 670 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION print-payment Procedure
 671 FUNCTION print-payment RETURNS DECIMAL
 672   ( /* parameter-definitions */ ) :
 673 /*------------------------------------------------------------------------------
 674   Purpose:
 675     Notes:
 676 ------------------------------------------------------------------------------*/
 677 DEF VAR line AS CHAR NO-UNDO.
 678 DEF VAR cheque-total AS DEC NO-UNDO.
 679
 680   FIND FIRST Creditor WHERE Creditor.CreditorCode = Payment.CreditorCode NO-LOCK NO-ERROR.
 681   IF Payment.PaymentStyle = "CARD" THEN
 682     line = "Xfer to card  ".
 683   ELSE
 684     line = "Payment " + STRING( Payment.ChequeNo, ">999999").
 685
 686   line = line + "  C" + STRING( Creditor.CreditorCode, "99999") + " "
 687        + Creditor.Payee.
 688
 689   IF Payment.PaymentStyle <> "CARD" AND Payment.PaymentStyle <> "CHEQ" THEN DO:
 690     FIND PaymentStyle OF Payment NO-LOCK NO-ERROR.
 691     line = STRING( line, "X(70)") + (IF AVAILABLE(PaymentStyle) THEN PaymentStyle.Description ELSE Payment.PaymentStyle).
 692   END.
 693   RUN pclrep-line( line1-font, line ).
 694
 695   cheque-total = 0.
 696   FOR EACH BeingPaid OF Payment, FIRST Voucher WHERE Voucher.VoucherSeq = BeingPaid.VoucherSeq NO-LOCK:
 697     line = SPC(9) + "Voucher" + STRING( Voucher.VoucherSeq, ">>>>>>9") + ",  "
 698          + STRING( Voucher.Date, "99/99/9999" ) + "   "
 699          + STRING( Voucher.Description, "X(50)" ) + " "
 700          + STRING( Voucher.TaxValue + Voucher.GoodsValue, ">>>,>>>,>>9.99CR" ).
 701     cheque-total = cheque-total + Voucher.TaxValue + Voucher.GoodsValue .
 702     RUN pclrep-line( line2-font, line ).
 703   END.
 704   line = SPC(90) + "--------------".
 705   RUN pclrep-line( line2-font, line ).
 706   line = SPC(90) + STRING( cheque-total, ">>>,>>>,>>9.99CR" ).
 707   RUN pclrep-line( line2-font, line ).
 708   RUN pclrep-line( ?, ? ).
 709
 710   RETURN cheque-total.
 711
 712 END FUNCTION.
 713
 714 /* _UIB-CODE-BLOCK-END */
 715 &ANALYZE-RESUME
 716
 717