process/report/vchenqry.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 sort-sequence  AS CHAR NO-UNDO.
   9 DEF VAR date-1         AS DATE NO-UNDO.
  10 DEF VAR date-n         AS DATE NO-UNDO.
  11 DEF VAR creditor-1     LIKE Creditor.CreditorCode NO-UNDO.
  12 DEF VAR creditor-n     LIKE Creditor.CreditorCode NO-UNDO.
  13 DEF VAR status-list    AS CHAR NO-UNDO.
  14 DEF VAR entered-before AS DATE NO-UNDO.
  15 DEF VAR due-before     AS DATE NO-UNDO.
  16 DEF VAR preview        AS LOGI NO-UNDO INITIAL No.
  17 DEF VAR export-details AS LOGI NO-UNDO INITIAL NO.
  18 DEF VAR detail-report  AS LOGI NO-UNDO INITIAL No.
  19 RUN parse-parameters.
  20
  21 /* Report counters */
  22 DEF VAR pn AS INT INITIAL 0 NO-UNDO.
  23
  24 /* Line definitions */
  25 DEF VAR trn-line       AS CHAR NO-UNDO.
  26 DEF VAR trn-no         AS INT NO-UNDO.
  27
  28 DEF VAR prn-line AS CHAR NO-UNDO.
  29 DEF VAR reset-page            AS CHAR NO-UNDO INITIAL "reset,landscape,a4,tm,0,lm,3,".
  30 DEF VAR title-font            AS CHAR NO-UNDO INITIAL "Proportional,Helvetica,Bold,Point,12".
  31 DEF VAR small-font            AS CHAR NO-UNDO INITIAL "Proportional,Helvetica,Bold,Point,5".
  32 DEF VAR header-font           AS CHAR NO-UNDO INITIAL "Proportional,Helvetica,Bold,Point,8".
  33 DEF VAR creditor-font         AS CHAR NO-UNDO INITIAL "Proportional,Helvetica,Bold,Point,10".
  34 DEF VAR column-font           AS CHAR NO-UNDO INITIAL "Fixed,Courier,cpi,18,lpi,10,Bold".
  35 DEF VAR line-printer          AS CHAR NO-UNDO INITIAL "Fixed,Courier,cpi,18,lpi,10,normal".
  36
  37 DEF VAR i AS INT NO-UNDO.
  38
  39 DEF VAR user-name AS CHAR NO-UNDO.
  40 {inc/username.i "user-name"}
  41
  42 DEF VAR brk-tot AS DEC NO-UNDO.
  43 DEF VAR g-tot AS DEC NO-UNDO INITIAL 0.0 .
  44 DEF VAR x-tot AS DEC NO-UNDO INITIAL 0.0 .
  45
  46 {inc/ofc-this.i}
  47 DEF VAR gst-rate AS DEC NO-UNDO.
  48 gst-rate = (Office.GST / 100).
  49 DEF VAR voucher-tax-remaining AS DEC NO-UNDO INITIAL 0.0 .
  50
  51 /* ensure record scoping */
  52 FIND FIRST Approver NO-LOCK.
  53 FIND FIRST Creditor NO-LOCK.
  54
  55 DEF TEMP-TABLE ReportVoucher NO-UNDO
  56     FIELD CompanyCode LIKE Company.CompanyCode
  57     FIELD CreditorCode LIKE Creditor.CreditorCode
  58     FIELD CreditorName LIKE Creditor.NAME
  59     FIELD InvoiceDate LIKE Voucher.Date
  60     FIELD VoucherSeq LIKE Voucher.VoucherSeq
  61   .
  62
  63 /* _UIB-CODE-BLOCK-END */
  64 &ANALYZE-RESUME
  65
  66
  67 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  68
  69 /* ********************  Preprocessor Definitions  ******************** */
  70
  71 &Scoped-define PROCEDURE-TYPE Procedure
  72 &Scoped-define DB-AWARE no
  73
  74
  75
  76 /* _UIB-PREPROCESSOR-BLOCK-END */
  77 &ANALYZE-RESUME
  78
  79
  80 /* ************************  Function Prototypes ********************** */
  81
  82 &IF DEFINED(EXCLUDE-safe-chr-fmt) = 0 &THEN
  83
  84 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD safe-chr-fmt Procedure
  85 FUNCTION safe-chr-fmt RETURNS CHARACTER
  86   ( INPUT val AS CHAR, INPUT fmt AS CHAR )  FORWARD.
  87
  88 /* _UIB-CODE-BLOCK-END */
  89 &ANALYZE-RESUME
  90
  91 &ENDIF
  92
  93 &IF DEFINED(EXCLUDE-safe-date-fmt) = 0 &THEN
  94
  95 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD safe-date-fmt Procedure
  96 FUNCTION safe-date-fmt RETURNS CHARACTER
  97   ( INPUT val AS DATE, INPUT fmt AS CHAR )  FORWARD.
  98
  99 /* _UIB-CODE-BLOCK-END */
 100 &ANALYZE-RESUME
 101
 102 &ENDIF
 103
 104 &IF DEFINED(EXCLUDE-safe-dec-fmt) = 0 &THEN
 105
 106 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD safe-dec-fmt Procedure
 107 FUNCTION safe-dec-fmt RETURNS CHARACTER
 108   ( INPUT val AS DEC, INPUT fmt AS CHAR )  FORWARD.
 109
 110 /* _UIB-CODE-BLOCK-END */
 111 &ANALYZE-RESUME
 112
 113 &ENDIF
 114
 115 &IF DEFINED(EXCLUDE-safe-int-fmt) = 0 &THEN
 116
 117 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD safe-int-fmt Procedure
 118 FUNCTION safe-int-fmt RETURNS CHARACTER
 119   ( INPUT val AS INT, INPUT fmt AS CHAR )  FORWARD.
 120
 121 /* _UIB-CODE-BLOCK-END */
 122 &ANALYZE-RESUME
 123
 124 &ENDIF
 125
 126
 127 /* *********************** Procedure Settings ************************ */
 128
 129 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 130 /* Settings for THIS-PROCEDURE
 131    Type: Procedure
 132    Allow:
 133    Frames: 0
 134    Add Fields to: Neither
 135    Other Settings: CODE-ONLY COMPILE
 136  */
 137 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 138
 139 /* *************************  Create Window  ************************** */
 140
 141 &ANALYZE-SUSPEND _CREATE-WINDOW
 142 /* DESIGN Window definition (used by the UIB)
 143   CREATE WINDOW Procedure ASSIGN
 144          HEIGHT             = .1
 145          WIDTH              = 40.
 146 /* END WINDOW DEFINITION */
 147                                                                         */
 148 &ANALYZE-RESUME
 149
 150 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 151 /* ************************* Included-Libraries *********************** */
 152
 153 {inc/method/m-txtrep.i}
 154 {inc/convert.i}
 155
 156 /* _UIB-CODE-BLOCK-END */
 157 &ANALYZE-RESUME
 158
 159
 160
 161
 162
 163 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 164
 165
 166 /* ***************************  Main Block  *************************** */
 167
 168 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 169 RUN pclrep-start( preview, reset-page + line-printer).
 170
 171 RUN get-status-list.
 172 IF creditor-n < creditor-1 THEN creditor-n = creditor-1.
 173 IF date-n < date-1 THEN date-n = TODAY + 99999.
 174
 175 IF sort-sequence BEGINS "C" OR sort-sequence = "Name" THEN
 176   RUN voucher-enquiry-by-creditor.
 177 ELSE IF sort-sequence = "E" THEN
 178   RUN voucher-enquiry-by-entity.
 179 ELSE IF sort-sequence = "ExportDetails" THEN
 180   RUN voucher-export-details-report.
 181 ELSE
 182   RUN voucher-enquiry-by-approver.
 183
 184 OUTPUT CLOSE.
 185 RUN pclrep-finish.
 186
 187 /* _UIB-CODE-BLOCK-END */
 188 &ANALYZE-RESUME
 189
 190
 191 /* **********************  Internal Procedures  *********************** */
 192
 193 &IF DEFINED(EXCLUDE-each-approver) = 0 &THEN
 194
 195 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-approver Procedure
 196 PROCEDURE each-approver :
 197 /*------------------------------------------------------------------------------
 198   Purpose:  Each approver
 199 ------------------------------------------------------------------------------*/
 200   IF pclrep-page-position > 0 THEN RUN pclrep-page-break.
 201
 202   DEF VAR this-status AS CHAR NO-UNDO.
 203
 204   brk-tot = 0.00.
 205   DO i = 1 TO LENGTH( status-list ):
 206
 207     this-status = SUBSTR( status-list, i, 1 ).
 208     FOR EACH Voucher NO-LOCK WHERE Voucher.ApproverCode = Approver.ApproverCode
 209                             AND Voucher.VoucherStatus = this-status
 210                             AND Voucher.Date >= date-1
 211                             AND Voucher.Date <= date-n
 212                             AND Voucher.CreatedDate < entered-before
 213                             AND Voucher.CreditorCode >= creditor-1
 214                             AND Voucher.CreditorCode <= creditor-n
 215                             AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before)
 216                             BY Voucher.ApproverCode BY Voucher.VoucherStatus BY Voucher.Date:
 217       FIND Creditor OF Voucher NO-LOCK.
 218       RUN each-voucher.
 219     END.
 220
 221   END.
 222
 223   RUN pclrep-line( line-printer, FILL(" ",73) + FILL( "-", 15 )).
 224   RUN pclrep-line( line-printer, FILL(" ",75) + STRING( brk-tot, ">>,>>>,>>9.99CR" )).
 225   RUN pclrep-down-by( 2 ).
 226
 227   IF brk-tot > 0 THEN g-tot = g-tot + brk-tot.
 228
 229 END PROCEDURE.
 230
 231 /* _UIB-CODE-BLOCK-END */
 232 &ANALYZE-RESUME
 233
 234 &ENDIF
 235
 236 &IF DEFINED(EXCLUDE-each-company) = 0 &THEN
 237
 238 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-company Procedure
 239 PROCEDURE each-company :
 240 /*------------------------------------------------------------------------------
 241   Purpose:  Each company
 242 ------------------------------------------------------------------------------*/
 243   DEF VAR this-status AS CHAR NO-UNDO.
 244
 245   brk-tot = 0.00.
 246   DO i = 1 TO LENGTH( status-list ):
 247
 248     this-status = SUBSTR( status-list, i, 1 ).
 249     FOR EACH Voucher NO-LOCK WHERE Voucher.EntityType = "L"
 250                             AND Voucher.EntityCode = Company.CompanyCode
 251                             AND Voucher.VoucherStatus = this-status
 252                             AND Voucher.Date >= date-1
 253                             AND Voucher.Date <= date-n
 254                             AND Voucher.CreatedDate < entered-before
 255                             AND Voucher.CreditorCode >= creditor-1
 256                             AND Voucher.CreditorCode <= creditor-n
 257                             AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before)
 258                             BY Voucher.ApproverCode BY Voucher.VoucherStatus BY Voucher.Date:
 259       FIND Creditor OF Voucher NO-LOCK.
 260       RUN save-voucher-details.
 261     END.
 262
 263     FOR EACH Project NO-LOCK WHERE Project.EntityType = 'L' AND Project.EntityCode = Company.CompanyCode,
 264             EACH Voucher NO-LOCK WHERE Voucher.EntityType = "J"
 265                             AND Voucher.EntityCode = Project.EntityCode
 266                             AND Voucher.VoucherStatus = this-status
 267                             AND Voucher.Date >= date-1
 268                             AND Voucher.Date <= date-n
 269                             AND Voucher.CreatedDate < entered-before
 270                             AND Voucher.CreditorCode >= creditor-1
 271                             AND Voucher.CreditorCode <= creditor-n
 272                             AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before)
 273                             BY Voucher.ApproverCode BY Voucher.VoucherStatus BY Voucher.Date:
 274       FIND Creditor OF Voucher NO-LOCK.
 275       RUN save-voucher-details.
 276     END.
 277
 278     FOR EACH Property NO-LOCK OF Company,
 279              EACH Voucher NO-LOCK WHERE Voucher.EntityType = "P"
 280                             AND Voucher.EntityCode = Property.PropertyCode
 281                             AND Voucher.VoucherStatus = this-status
 282                             AND Voucher.Date >= date-1
 283                             AND Voucher.Date <= date-n
 284                             AND Voucher.CreatedDate < entered-before
 285                             AND Voucher.CreditorCode >= creditor-1
 286                             AND Voucher.CreditorCode <= creditor-n
 287                             AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before)
 288                             BY Voucher.ApproverCode BY Voucher.VoucherStatus BY Voucher.Date:
 289       FIND Creditor OF Voucher NO-LOCK.
 290       RUN save-voucher-details.
 291     END.
 292
 293     FOR EACH Property NO-LOCK OF Company,
 294             EACH Project NO-LOCK WHERE Project.EntityType = 'P' AND Project.EntityCode = Property.PropertyCode,
 295             EACH Voucher NO-LOCK WHERE Voucher.EntityType = "J"
 296                             AND Voucher.EntityCode = Project.EntityCode
 297                             AND Voucher.VoucherStatus = this-status
 298                             AND Voucher.Date >= date-1
 299                             AND Voucher.Date <= date-n
 300                             AND Voucher.CreatedDate < entered-before
 301                             AND Voucher.CreditorCode >= creditor-1
 302                             AND Voucher.CreditorCode <= creditor-n
 303                             AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before)
 304                             BY Voucher.ApproverCode BY Voucher.VoucherStatus BY Voucher.Date:
 305       FIND Creditor OF Voucher NO-LOCK.
 306       RUN save-voucher-details.
 307     END.
 308   END.
 309
 310   FIND FIRST ReportVoucher OF Company NO-LOCK NO-ERROR.
 311   IF NOT AVAILABLE(ReportVoucher) THEN RETURN.
 312
 313   IF NOT(export-details) THEN DO:
 314     RUN pclrep-line( creditor-font,
 315             STRING( Company.CompanyCode, "99999" ) + " - " + Company.LegalName ).
 316   END.
 317
 318   FOR EACH ReportVoucher OF Company NO-LOCK,
 319            FIRST Creditor OF ReportVoucher NO-LOCK,
 320            FIRST Voucher OF ReportVoucher NO-LOCK
 321                   BY ReportVoucher.CompanyCode
 322                   BY ReportVoucher.CreditorName
 323                   BY ReportVoucher.CreditorCode
 324                   BY ReportVoucher.InvoiceDate
 325                   BY ReportVoucher.VoucherSeq:
 326      RUN each-voucher.
 327   END.
 328
 329   IF NOT(export-details) THEN DO:
 330     RUN pclrep-line( line-printer, FILL(" ",73) + FILL( "-", 15 )).
 331     RUN pclrep-line( line-printer, FILL(" ",75) + STRING( brk-tot, ">>,>>>,>>9.99CR" )).
 332     RUN pclrep-down-by( 2 ).
 333   END.
 334
 335   IF brk-tot > 0 THEN g-tot = g-tot + brk-tot.
 336
 337 END PROCEDURE.
 338
 339 /* _UIB-CODE-BLOCK-END */
 340 &ANALYZE-RESUME
 341
 342 &ENDIF
 343
 344 &IF DEFINED(EXCLUDE-each-creditor) = 0 &THEN
 345
 346 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-creditor Procedure
 347 PROCEDURE each-creditor :
 348 /*------------------------------------------------------------------------------
 349   Purpose:
 350 ------------------------------------------------------------------------------*/
 351 DEF VAR this-status AS CHAR NO-UNDO.
 352
 353   IF NOT(export-details) THEN DO:
 354     RUN pclrep-line( creditor-font,
 355             STRING( Creditor.CreditorCode, "99999" ) + " - " + Creditor.Name ).
 356   END.
 357
 358   brk-tot = 0.00.
 359   DO i = 1 TO LENGTH( status-list ):
 360     this-status = SUBSTR( status-list, i, 1 ).
 361     FOR EACH Voucher OF Creditor NO-LOCK WHERE Voucher.VoucherStatus = this-status
 362                     AND Voucher.Date >= date-1 AND Voucher.Date <= date-n
 363                     AND Voucher.CreatedDate < entered-before
 364                     AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before)
 365                     BY Voucher.VoucherSeq:
 366       RUN each-voucher.
 367     END.
 368   END.
 369
 370   IF NOT(export-details) THEN DO:
 371     RUN pclrep-line( line-printer, FILL(" ",73) + FILL( "-", 15 )).
 372     RUN pclrep-line( line-printer, FILL(" ",75) + STRING( brk-tot, ">>,>>>,>>9.99CR" )).
 373     RUN pclrep-line( line-printer, "").
 374   END.
 375
 376   IF brk-tot > 0 THEN g-tot = g-tot + brk-tot.
 377
 378 END PROCEDURE.
 379
 380 /* _UIB-CODE-BLOCK-END */
 381 &ANALYZE-RESUME
 382
 383 &ENDIF
 384
 385 &IF DEFINED(EXCLUDE-each-voucher) = 0 &THEN
 386
 387 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-voucher Procedure
 388 PROCEDURE each-voucher :
 389 /*------------------------------------------------------------------------------
 390   Purpose:
 391 ------------------------------------------------------------------------------*/
 392   IF date-1 <> ? AND Voucher.Date < date-1 THEN RETURN.
 393   IF date-n <> ? AND Voucher.Date > date-n THEN RETURN.
 394
 395   brk-tot = brk-tot + ( Voucher.GoodsValue + Voucher.TaxValue ).
 396
 397 /*
 398  *  Can we have the fields in the following order:
 399  *      1.Creditor Number
 400  *      2.Creditor Name (Alphabetically sorted)
 401  *      3.Invoice Number
 402  *      4.Voucher Number
 403  *      5.Date
 404  *      6.Total
 405  */
 406   IF NOT(export-details) THEN DO:
 407     prn-line = STRING( Creditor.CreditorCode, "99999" )
 408              + " " + STRING( Creditor.Name, "X(30)" )
 409              + FILL(" ",3) + STRING( IF Voucher.InvoiceReference <> ? THEN Voucher.InvoiceReference ELSE "", "X(12)" )
 410              + FILL(" ",2) + STRING( Voucher.VoucherSeq, ">>9999" )
 411              + FILL(" ",3) + STRING( Voucher.Date, "99/99/9999" )
 412              + FILL(" ",3) + STRING( Voucher.GoodsValue + Voucher.TaxValue, ">>,>>>,>>9.99CR" )
 413              + " " + STRING( Voucher.VoucherStatus, "X" )
 414              + " " + STRING( Voucher.ApproverCode, "X(4)" )
 415              + " " + STRING( Voucher.CreatedDate, "99/99/9999" )
 416              + FILL(" ",3) + STRING( Voucher.Description, "X(50)" )
 417       . /* <--- fullstop is a really bad terminator because it can be invisible! */
 418
 419
 420     RUN pclrep-line( line-printer, prn-line ).
 421   END.
 422
 423   IF export-details OR detail-report THEN DO:
 424     voucher-tax-remaining = Voucher.TaxValue.
 425     FOR EACH VoucherLine OF Voucher NO-LOCK:
 426       RUN each-voucher-line.
 427     END.
 428     IF NOT(export-details) THEN DO:
 429       RUN pclrep-line( line-printer, "").
 430     END.
 431   END.
 432
 433 END PROCEDURE.
 434
 435 /* _UIB-CODE-BLOCK-END */
 436 &ANALYZE-RESUME
 437
 438 &ENDIF
 439
 440 &IF DEFINED(EXCLUDE-each-voucher-line) = 0 &THEN
 441
 442 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-voucher-line Procedure
 443 PROCEDURE each-voucher-line :
 444 /*------------------------------------------------------------------------------
 445   Purpose:
 446 ------------------------------------------------------------------------------*/
 447 DEF VAR tax-amount AS DEC NO-UNDO.
 448 DEF VAR order-coding AS CHAR NO-UNDO.
 449
 450   IF export-details THEN DO:
 451     x-tot = x-tot + VoucherLine.Amount.
 452     tax-amount = VoucherLine.TaxAmount.
 453     IF tax-amount = 0.0 OR tax-amount = ? THEN DO:
 454       tax-amount = MIN( voucher-tax-remaining, VoucherLine.Amount * gst-rate ).
 455       IF ABS(voucher-tax-remaining - tax-amount) < 0.03 THEN DO:
 456           tax-amount = voucher-tax-remaining.
 457       END.
 458     END.
 459     voucher-tax-remaining = voucher-tax-remaining - tax-amount.
 460     order-coding = STRING(Voucher.OrderCode,">>>>>>9").
 461     IF Voucher.OrderCode = ? OR Voucher.OrderCode = 0 THEN
 462         order-coding = Voucher.OurOrderNo.
 463     prn-line = " " + safe-chr-fmt( Voucher.VoucherStatus, "X" )
 464         + FILL(" ",2) + safe-chr-fmt( Voucher.InvoiceReference, "X(12)" )
 465         + FILL(" ",2) + safe-chr-fmt(order-coding, "X(15)")
 466         + FILL(" ",2) + safe-int-fmt( Voucher.VoucherSeq, ">>9999" )
 467         + FILL(" ",3) + safe-date-fmt( Voucher.Date, "99/99/9999" )
 468         + FILL(" ",3) + safe-int-fmt( Voucher.CreditorCode, "99999" )
 469         + FILL(" ",3) + safe-chr-fmt( REPLACE(REPLACE(VoucherLine.Description, '~r', ""), '~n', " "), "X(50)" )
 470         + FILL(" ",2) + safe-dec-fmt( VoucherLine.Amount, "->>>,>>>,>>9.99" )
 471         + FILL(" ",2) + safe-dec-fmt( VoucherLine.Amount + tax-amount, "->>>,>>>,>>9.99" )
 472         + FILL(" ",2) + safe-chr-fmt( VoucherLine.EntityType, "X" )
 473         + safe-int-fmt( VoucherLine.EntityCode, "99999" )
 474         + " " + safe-dec-fmt( VoucherLine.AccountCode, "9999.99" )
 475         + FILL(" ",2) + safe-chr-fmt( Voucher.ApproverCode, "X(4)" ).
 476   END.
 477   ELSE DO:
 478     prn-line = FILL(" ",12) + STRING( VoucherLine.EntityType, "X" ) + " "
 479              + STRING( VoucherLine.EntityCode, "99999" ) + " "
 480              + STRING( VoucherLine.AccountCode, "9999.99" ) + "   "
 481              + STRING( VoucherLine.Description, "X(50)" ) + "   "
 482              + STRING( VoucherLine.Amount, ">>,>>>,>>9.99CR" ) + " "
 483              + (IF VoucherLine.TaxAmount <> 0 THEN STRING( VoucherLine.TaxAmount, ">>,>>>,>>9.99CR" ) ELSE "").
 484   END.
 485
 486   RUN pclrep-line( line-printer, prn-line ).
 487
 488 END PROCEDURE.
 489
 490 /* _UIB-CODE-BLOCK-END */
 491 &ANALYZE-RESUME
 492
 493 &ENDIF
 494
 495 &IF DEFINED(EXCLUDE-get-status-list) = 0 &THEN
 496
 497 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-status-list Procedure
 498 PROCEDURE get-status-list :
 499 /*------------------------------------------------------------------------------
 500   Purpose:
 501 ------------------------------------------------------------------------------*/
 502 DEF VAR status-order AS CHAR NO-UNDO.
 503 DEF VAR new-list     AS CHAR NO-UNDO.
 504
 505   FOR EACH VoucherStatus NO-LOCK BY VoucherStatus.SequenceCode:
 506     status-order = status-order + VoucherStatus.VoucherStatus.
 507   END.
 508
 509   DO i = 1 TO LENGTH( status-order ):
 510     new-list = new-list
 511              + (IF INDEX( status-list, SUBSTR(status-order,i,1) ) <> 0
 512                                 THEN SUBSTR( status-order, i, 1 ) ELSE "").
 513   END.
 514
 515   status-list = new-list.
 516
 517 END PROCEDURE.
 518
 519 /* _UIB-CODE-BLOCK-END */
 520 &ANALYZE-RESUME
 521
 522 &ENDIF
 523
 524 &IF DEFINED(EXCLUDE-inst-page-footer) = 0 &THEN
 525
 526 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 527 PROCEDURE inst-page-footer :
 528 /*------------------------------------------------------------------------------
 529   Purpose:
 530 ------------------------------------------------------------------------------*/
 531
 532 END PROCEDURE.
 533
 534 /* _UIB-CODE-BLOCK-END */
 535 &ANALYZE-RESUME
 536
 537 &ENDIF
 538
 539 &IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN
 540
 541 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 542 PROCEDURE inst-page-header :
 543 /*------------------------------------------------------------------------------
 544   Purpose:
 545 ------------------------------------------------------------------------------*/
 546   IF export-details THEN RETURN.
 547
 548   RUN pclrep-line(line-printer,"").
 549   RUN pclrep-line("","").
 550   RUN pclrep-line(small-font, "Printed at " + STRING( TIME, "HH:MM:SS" ) + ", "
 551                              + STRING( TODAY, "99/99/9999" ) + " for "
 552                              + STRING( user-name, (IF preview THEN "X(60)" ELSE "X(240)"))
 553                              + (IF sort-sequence = "ExportDetails" THEN "" ELSE "Page " + STRING( pclrep-page-number ))).
 554   RUN pclrep-line("","").
 555
 556   IF sort-sequence = "A" THEN DO:
 557       IF AVAILABLE(Approver) THEN FIND Person OF Approver NO-LOCK NO-ERROR.
 558       prn-line = FILL(" ",20) + "Voucher Enquiry"
 559                + (IF date-1 > DATE(1,1,1) THEN (" from " + STRING( date-1, "99/99/9999")) ELSE "")
 560                + (IF date-n < (TODAY + 99998) THEN (" to " + STRING( date-n, "99/99/9999")) ELSE "")
 561                + " - " + (IF AVAILABLE(Person) THEN (Person.FirstName + " " + Person.LastName)
 562                                                ELSE "* * * Person not on file * * *")
 563                + " (" + (IF AVAILABLE(Approver) THEN Approver.ApproverCode ELSE "UNKNOWN") + ")".
 564   END.
 565   ELSE DO:
 566       prn-line = FILL(" ",50) + STRING( "Voucher Enquiry Report", "X(30)" ).
 567   END.
 568   RUN pclrep-line(title-font, prn-line ).
 569
 570   RUN pclrep-line( column-font,"").
 571   RUN pclrep-line( "","").
 572   IF sort-sequence = "ExportDetails" THEN DO:
 573     RUN pclrep-line( "", "   Invoice Ref     Order           Voucher Invoice Date Creditor  Description                                              Excl. GST        Incl. GST  Expense Coding  Apprvr" ).
 574   END.
 575   ELSE DO:
 576     RUN pclrep-line( "", "Creditor details                       Invoice No.   Vchr #      Date             Amount  St Apvr Entry Date   Description" ).
 577   END.
 578   RUN pclrep-line( "","").
 579
 580 END PROCEDURE.
 581
 582 /* _UIB-CODE-BLOCK-END */
 583 &ANALYZE-RESUME
 584
 585 &ENDIF
 586
 587 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 588
 589 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 590 PROCEDURE parse-parameters :
 591 /*------------------------------------------------------------------------------
 592   Purpose:
 593 ------------------------------------------------------------------------------*/
 594 DEF VAR token AS CHAR NO-UNDO.
 595 DEF VAR i AS INT NO-UNDO.
 596
 597   {inc/showopts.i "report-options"}
 598
 599   due-before = DATE(12,31,9999).
 600   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 601     token = ENTRY( i, report-options, "~n" ).
 602
 603     CASE ENTRY( 1, token ):
 604       WHEN "Preview" THEN               preview = Yes.
 605       WHEN "Detail" THEN                detail-report = Yes.
 606       WHEN "Statuses" THEN              status-list = ENTRY(2,token).
 607       WHEN "DueBefore" THEN             due-before = DATE(ENTRY(2,token)).
 608       WHEN "EnteredBefore" THEN         entered-before = DATE(ENTRY(2,token)).
 609       WHEN "Sort" THEN                  sort-sequence = ENTRY(2,token).
 610
 611       WHEN "CreditorRange" THEN ASSIGN
 612         creditor-1 = INT(ENTRY(2,token))
 613         creditor-n = INT(ENTRY(3,token)).
 614
 615       WHEN "DateRange" THEN ASSIGN
 616         date-1 = DATE(ENTRY(2,token))
 617         date-n = DATE(ENTRY(3,token)).
 618
 619     END CASE.
 620
 621   END.
 622
 623 END PROCEDURE.
 624
 625 /* _UIB-CODE-BLOCK-END */
 626 &ANALYZE-RESUME
 627
 628 &ENDIF
 629
 630 &IF DEFINED(EXCLUDE-save-voucher-details) = 0 &THEN
 631
 632 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE save-voucher-details Procedure
 633 PROCEDURE save-voucher-details :
 634 /*------------------------------------------------------------------------------
 635   Purpose:  Record the voucher details for when we produce the report later.
 636 ------------------------------------------------------------------------------*/
 637   IF date-1 <> ? AND Voucher.Date < date-1 THEN RETURN.
 638   IF date-n <> ? AND Voucher.Date > date-n THEN RETURN.
 639
 640   CREATE ReportVoucher.
 641   ASSIGN ReportVoucher.CompanyCode = Company.CompanyCode
 642          ReportVoucher.CreditorCode = Creditor.CreditorCode
 643          ReportVoucher.CreditorName = Creditor.NAME
 644          ReportVoucher.InvoiceDate = Voucher.DATE
 645          ReportVoucher.VoucherSeq = Voucher.VoucherSeq.
 646
 647 END PROCEDURE.
 648
 649 /* _UIB-CODE-BLOCK-END */
 650 &ANALYZE-RESUME
 651
 652 &ENDIF
 653
 654 &IF DEFINED(EXCLUDE-voucher-enquiry-by-approver) = 0 &THEN
 655
 656 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE voucher-enquiry-by-approver Procedure
 657 PROCEDURE voucher-enquiry-by-approver :
 658 /*------------------------------------------------------------------------------
 659   Purpose:
 660 ------------------------------------------------------------------------------*/
 661
 662   FOR EACH Approver WHERE
 663          CAN-FIND(FIRST Voucher WHERE Voucher.ApproverCode = Approver.ApproverCode
 664                     AND INDEX( status-list, Voucher.VoucherStatus ) <> 0
 665                     AND Voucher.Date >= date-1
 666                     AND Voucher.Date <= date-n
 667                     AND Voucher.CreditorCode >= creditor-1
 668                     AND Voucher.CreditorCode <= creditor-n
 669                     AND Voucher.CreatedDate < entered-before
 670                     AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before) ):
 671     RUN each-approver.
 672   END.
 673
 674   RUN pclrep-down-by( 2 ).
 675   RUN pclrep-line( line-printer, FILL(" ",117) + FILL( "=", 15 )).
 676   RUN pclrep-line( line-printer, STRING( "Total for all vouchers listed", "X(117)")
 677                                  + STRING( g-tot, ">>,>>>,>>9.99CR" )).
 678
 679 END PROCEDURE.
 680
 681 /* _UIB-CODE-BLOCK-END */
 682 &ANALYZE-RESUME
 683
 684 &ENDIF
 685
 686 &IF DEFINED(EXCLUDE-voucher-enquiry-by-creditor) = 0 &THEN
 687
 688 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE voucher-enquiry-by-creditor Procedure
 689 PROCEDURE voucher-enquiry-by-creditor :
 690 /*------------------------------------------------------------------------------
 691   Purpose:
 692 ------------------------------------------------------------------------------*/
 693 DEF VAR totals-line AS CHAR INITIAL "" NO-UNDO.
 694
 695   IF sort-sequence MATCHES "*Name" THEN DO:
 696     FOR EACH Creditor NO-LOCK WHERE Creditor.CreditorCode >= creditor-1
 697                       AND Creditor.CreditorCode <= creditor-n
 698                       AND CAN-FIND( LAST Voucher OF Creditor
 699                               WHERE INDEX( status-list, Voucher.VoucherStatus ) <> 0
 700                               AND Voucher.Date >= date-1
 701                               AND Voucher.Date <= date-n
 702                               AND Voucher.CreatedDate < entered-before
 703                               AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before) )
 704                       BY Creditor.Name:
 705       RUN each-creditor.
 706     END.
 707   END.
 708   ELSE /* IF sort-sequence = "CreditorCode" THEN */ DO:
 709     FOR EACH Creditor NO-LOCK WHERE Creditor.CreditorCode >= creditor-1
 710                       AND Creditor.CreditorCode <= creditor-n
 711                       AND CAN-FIND( LAST Voucher OF Creditor
 712                               WHERE INDEX( status-list, Voucher.VoucherStatus ) <> 0
 713                               AND Voucher.Date >= date-1
 714                               AND Voucher.Date <= date-n
 715                               AND Voucher.CreatedDate < entered-before
 716                               AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before) )
 717                       BY Creditor.CreditorCode:
 718       RUN each-creditor.
 719     END.
 720   END.
 721
 722   RUN pclrep-line( line-printer, "" ).
 723   RUN pclrep-line( line-printer, FILL(" ",(IF export-details THEN 110 ELSE 147)) + FILL( "=", 15 )).
 724   IF status-list = "A" THEN DO:
 725     totals-line = "Total of cheques to be produced".
 726   END.
 727   ELSE DO:
 728     totals-line = "Total of outstanding creditors listed".
 729   END.
 730   totals-line = STRING( totals-line, (IF export-details THEN "X(110)" ELSE "X(147)") ).
 731
 732   RUN pclrep-line( line-printer, totals-line + STRING( g-tot, ">>,>>>,>>9.99CR" )).
 733
 734 END PROCEDURE.
 735
 736 /* _UIB-CODE-BLOCK-END */
 737 &ANALYZE-RESUME
 738
 739 &ENDIF
 740
 741 &IF DEFINED(EXCLUDE-voucher-enquiry-by-entity) = 0 &THEN
 742
 743 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE voucher-enquiry-by-entity Procedure
 744 PROCEDURE voucher-enquiry-by-entity :
 745 /*------------------------------------------------------------------------------
 746   Purpose:
 747 ------------------------------------------------------------------------------*/
 748
 749   FOR EACH Company NO-LOCK:
 750     RUN each-company.
 751   END.
 752
 753
 754   RUN pclrep-down-by( 2 ).
 755   RUN pclrep-line( line-printer, FILL(" ",117) + FILL( "=", 15 )).
 756   RUN pclrep-line( line-printer, STRING( "Total for all vouchers listed", "X(117)")
 757                                  + STRING( g-tot, ">>,>>>,>>9.99CR" )).
 758
 759 END PROCEDURE.
 760
 761 /* _UIB-CODE-BLOCK-END */
 762 &ANALYZE-RESUME
 763
 764 &ENDIF
 765
 766 &IF DEFINED(EXCLUDE-voucher-export-details-report) = 0 &THEN
 767
 768 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE voucher-export-details-report Procedure
 769 PROCEDURE voucher-export-details-report :
 770 /*------------------------------------------------------------------------------
 771   Purpose:
 772 ------------------------------------------------------------------------------*/
 773 DEF VAR totals-line AS CHAR INITIAL "" NO-UNDO.
 774
 775   RUN pclrep-line( line-printer, "" ).
 776
 777   export-details = YES.
 778
 779   FOR EACH Creditor NO-LOCK WHERE Creditor.CreditorCode >= creditor-1
 780                       AND Creditor.CreditorCode <= creditor-n
 781                       AND CAN-FIND( LAST Voucher OF Creditor
 782                               WHERE INDEX( status-list, Voucher.VoucherStatus ) <> 0
 783                               AND Voucher.Date >= date-1
 784                               AND Voucher.Date <= date-n
 785                               AND Voucher.CreatedDate < entered-before
 786                               AND (Voucher.DateDue = ? OR Voucher.DateDue <= due-before) )
 787                       BY Creditor.CreditorCode:
 788     RUN each-creditor.
 789   END.
 790
 791   RUN pclrep-line( line-printer, "" ).
 792   RUN pclrep-line( line-printer, FILL(" ",117) + FILL( "=", 15 ) + "  " + FILL( "=", 15 )).
 793   IF status-list = "A" THEN DO:
 794     totals-line = "Total of cheques to be produced".
 795   END.
 796   ELSE DO:
 797     totals-line = "Total of outstanding creditors listed".
 798   END.
 799   totals-line = STRING( totals-line, "X(117)" ).
 800
 801   RUN pclrep-line( line-printer, totals-line + STRING( x-tot, "->>>,>>>,>>9.99" ) + "  " + STRING( g-tot, "->>>,>>>,>>9.99" )).
 802
 803 END PROCEDURE.
 804
 805 /* _UIB-CODE-BLOCK-END */
 806 &ANALYZE-RESUME
 807
 808 &ENDIF
 809
 810 /* ************************  Function Implementations ***************** */
 811
 812 &IF DEFINED(EXCLUDE-safe-chr-fmt) = 0 &THEN
 813
 814 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION safe-chr-fmt Procedure
 815 FUNCTION safe-chr-fmt RETURNS CHARACTER
 816   ( INPUT val AS CHAR, INPUT fmt AS CHAR ) :
 817 /*------------------------------------------------------------------------------
 818   Purpose:
 819     Notes:
 820 ------------------------------------------------------------------------------*/
 821 DEF VAR answer AS CHAR NO-UNDO.
 822
 823   IF val = ? THEN DO:
 824       answer = STRING("",fmt).
 825   END.
 826   ELSE DO:
 827       answer = STRING( val, fmt ).
 828   END.
 829
 830   RETURN answer.
 831
 832 END FUNCTION.
 833
 834 /* _UIB-CODE-BLOCK-END */
 835 &ANALYZE-RESUME
 836
 837 &ENDIF
 838
 839 &IF DEFINED(EXCLUDE-safe-date-fmt) = 0 &THEN
 840
 841 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION safe-date-fmt Procedure
 842 FUNCTION safe-date-fmt RETURNS CHARACTER
 843   ( INPUT val AS DATE, INPUT fmt AS CHAR ) :
 844 /*------------------------------------------------------------------------------
 845   Purpose:
 846     Notes:
 847 ------------------------------------------------------------------------------*/
 848 DEF VAR answer AS CHAR NO-UNDO.
 849
 850   IF val = ? THEN DO:
 851       answer = FILL(" ", LENGTH(fmt)).
 852   END.
 853   ELSE DO:
 854       answer = STRING( val, fmt ).
 855   END.
 856
 857   RETURN answer.
 858
 859 END FUNCTION.
 860
 861 /* _UIB-CODE-BLOCK-END */
 862 &ANALYZE-RESUME
 863
 864 &ENDIF
 865
 866 &IF DEFINED(EXCLUDE-safe-dec-fmt) = 0 &THEN
 867
 868 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION safe-dec-fmt Procedure
 869 FUNCTION safe-dec-fmt RETURNS CHARACTER
 870   ( INPUT val AS DEC, INPUT fmt AS CHAR ) :
 871 /*------------------------------------------------------------------------------
 872   Purpose:
 873     Notes:
 874 ------------------------------------------------------------------------------*/
 875 DEF VAR answer AS CHAR NO-UNDO.
 876
 877   IF val = ? THEN DO:
 878       answer = FILL(" ", LENGTH(STRING(0.0,fmt))).
 879   END.
 880   ELSE DO:
 881       answer = STRING( val, fmt ).
 882   END.
 883
 884   RETURN answer.
 885
 886 END FUNCTION.
 887
 888 /* _UIB-CODE-BLOCK-END */
 889 &ANALYZE-RESUME
 890
 891 &ENDIF
 892
 893 &IF DEFINED(EXCLUDE-safe-int-fmt) = 0 &THEN
 894
 895 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION safe-int-fmt Procedure
 896 FUNCTION safe-int-fmt RETURNS CHARACTER
 897   ( INPUT val AS INT, INPUT fmt AS CHAR ) :
 898 /*------------------------------------------------------------------------------
 899   Purpose:
 900     Notes:
 901 ------------------------------------------------------------------------------*/
 902 DEF VAR answer AS CHAR NO-UNDO.
 903
 904   IF val = ? THEN DO:
 905       answer = FILL(" ", LENGTH(STRING(0,fmt))).
 906   END.
 907   ELSE DO:
 908       answer = STRING( val, fmt ).
 909   END.
 910
 911   RETURN answer.
 912
 913 END FUNCTION.
 914
 915 /* _UIB-CODE-BLOCK-END */
 916 &ANALYZE-RESUME
 917
 918 &ENDIF
 919