process/report/orderfrm.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6
   7 &SCOPED-DEFINE trn-per-page 58
   8 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
   9
  10 {inc/ofc-this.i}
  11 {inc/ofc-set.i "Order-form-routine" "order-form-routine"}
  12 IF AVAILABLE(OfficeSetting) AND order-form-routine <> 'process/report/orderfrm.p' THEN DO:
  13   RUN VALUE(order-form-routine)( report-options ).
  14   RETURN.
  15 END.
  16
  17 DEF VAR entity-type   AS CHAR NO-UNDO INITIAL "J".
  18 DEF VAR entity-code   AS INT NO-UNDO.
  19 DEF VAR order-list    AS CHAR NO-UNDO.
  20 DEF VAR no-of-copies  AS INT NO-UNDO INITIAL 0.
  21 DEF VAR supplier-copy AS LOGI NO-UNDO INITIAL No.
  22 DEF VAR output-to-pdf AS LOGI NO-UNDO INITIAL NO.
  23 DEF VAR email-address AS CHAR NO-UNDO.
  24 DEF VAR notes-out-codes AS CHAR NO-UNDO.
  25 RUN parse-parameters.
  26
  27 /* Report counters */
  28 DEF VAR ln AS DEC INIT 0.00 NO-UNDO.
  29
  30 /* Line definitions */
  31
  32 DEF VAR date-in-words    AS CHAR NO-UNDO.
  33 DEF VAR creditor-address AS CHAR NO-UNDO EXTENT 7.
  34 DEF VAR creditor-phones  AS CHAR NO-UNDO EXTENT 2.
  35 DEF VAR trn-line         AS CHAR NO-UNDO.
  36 DEF VAR trn-no           AS INT  NO-UNDO.
  37 DEF VAR regarding        AS CHAR NO-UNDO.
  38 DEF VAR client-code      AS CHAR NO-UNDO.
  39 DEF VAR entity-name      AS CHAR NO-UNDO.
  40 DEF VAR account-name     AS CHAR NO-UNDO.
  41
  42 DEF VAR reset-page            AS CHAR NO-UNDO.
  43 DEF VAR half-line             AS CHAR NO-UNDO. half-line = CHR(27) + "=".
  44 DEF VAR time-font             AS CHAR NO-UNDO.
  45 DEF VAR title-font            AS CHAR NO-UNDO.
  46 DEF VAR num-font              AS CHAR NO-UNDO.
  47 DEF VAR prompt-font           AS CHAR NO-UNDO.
  48 DEF VAR re-font               AS CHAR NO-UNDO.
  49 DEF VAR creditor-address-font AS CHAR NO-UNDO.
  50 DEF VAR body-font             AS CHAR NO-UNDO.
  51 DEF VAR line-printer          AS CHAR NO-UNDO.
  52 DEF VAR order-body-font       AS CHAR NO-UNDO.
  53 DEF VAR stamp-font            AS CHAR NO-UNDO.
  54
  55 DEF VAR page-no               AS INT NO-UNDO.
  56
  57 DEF VAR logo-codes            AS CHAR NO-UNDO.
  58 DEF VAR copy-no               AS INT  NO-UNDO.
  59
  60 DEF VAR time-stamp AS CHAR NO-UNDO.
  61 DEF VAR user-name  AS CHAR NO-UNDO.
  62 {inc/username.i "user-name"}
  63
  64
  65 time-stamp =
  66   STRING( TODAY, "99/99/9999" ) + " " + STRING( TIME, "HH:MM:SS" ) +
  67     " for " + user-name.
  68
  69 {inc/ofc-set.i "Order-notes-routine" "order-notes-routine"}
  70 IF NOT AVAILABLE(OfficeSetting) THEN
  71     order-notes-routine = "".
  72
  73 /* _UIB-CODE-BLOCK-END */
  74 &ANALYZE-RESUME
  75
  76
  77 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  78
  79 /* ********************  Preprocessor Definitions  ******************** */
  80
  81 &Scoped-define PROCEDURE-TYPE Procedure
  82 &Scoped-define DB-AWARE no
  83
  84
  85
  86 /* _UIB-PREPROCESSOR-BLOCK-END */
  87 &ANALYZE-RESUME
  88
  89
  90
  91 /* *********************** Procedure Settings ************************ */
  92
  93 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  94 /* Settings for THIS-PROCEDURE
  95    Type: Procedure
  96    Allow:
  97    Frames: 0
  98    Add Fields to: Neither
  99    Other Settings: CODE-ONLY
 100  */
 101 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 102
 103 /* *************************  Create Window  ************************** */
 104
 105 &ANALYZE-SUSPEND _CREATE-WINDOW
 106 /* DESIGN Window definition (used by the UIB)
 107   CREATE WINDOW Procedure ASSIGN
 108          HEIGHT             = .05
 109          WIDTH              = 29.86.
 110 /* END WINDOW DEFINITION */
 111                                                                         */
 112 &ANALYZE-RESUME
 113
 114 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 115 /* ************************* Included-Libraries *********************** */
 116
 117 {inc/method/m-txtrep.i}
 118 {inc/method/m-hpgl.i}
 119 {inc/persndtl.i}
 120 {inc/entity.i}
 121 {inc/convert.i}
 122
 123 /* _UIB-CODE-BLOCK-END */
 124 &ANALYZE-RESUME
 125
 126
 127
 128
 129
 130 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 131
 132
 133 /* ***************************  Main Block  *************************** */
 134
 135 DEF VAR preview AS LOGI INIT No NO-UNDO.
 136
 137 IF output-to-pdf THEN DO:
 138     RUN txtrep-output-mode( "pdf" ).
 139     RUN hpgl-output-mode( "pdf" ).
 140 END.
 141
 142 RUN get-control-strings.
 143
 144 /*
 145 If printing then send all orders to one file, otherwise for PDF output
 146 see the procedure in this file called purchase-orders().
 147 */
 148 IF NOT output-to-pdf THEN
 149     OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 150
 151 RUN purchase-orders.
 152
 153 IF NOT output-to-pdf THEN DO:
 154     OUTPUT CLOSE.
 155     RUN view-output-file ( preview ).
 156 END.
 157
 158 /* _UIB-CODE-BLOCK-END */
 159 &ANALYZE-RESUME
 160
 161
 162 /* **********************  Internal Procedures  *********************** */
 163
 164 &IF DEFINED(EXCLUDE-carriage-return) = 0 &THEN
 165
 166 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE carriage-return Procedure
 167 PROCEDURE carriage-return :
 168 /*------------------------------------------------------------------------------
 169   Purpose:
 170   Parameters:  <none>
 171   Notes:
 172 ------------------------------------------------------------------------------*/
 173
 174   PUT CONTROL CHR(13).
 175
 176 END PROCEDURE.
 177
 178 /* _UIB-CODE-BLOCK-END */
 179 &ANALYZE-RESUME
 180
 181 &ENDIF
 182
 183 &IF DEFINED(EXCLUDE-each-order) = 0 &THEN
 184
 185 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-order Procedure
 186 PROCEDURE each-order :
 187 /*------------------------------------------------------------------------------
 188   Purpose:
 189 ------------------------------------------------------------------------------*/
 190   RUN get-order-details.
 191   RUN get-creditor-details.
 192   DO copy-no = 1 TO no-of-copies:
 193
 194     page-no = 1.
 195
 196     RUN page-header.
 197     RUN order-body.
 198     RUN page-footer.
 199     RUN page-feed.
 200
 201   END.
 202
 203 END PROCEDURE.
 204
 205 /* _UIB-CODE-BLOCK-END */
 206 &ANALYZE-RESUME
 207
 208 &ENDIF
 209
 210 &IF DEFINED(EXCLUDE-get-account-figures) = 0 &THEN
 211
 212 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-account-figures Procedure
 213 PROCEDURE get-account-figures :
 214 /*------------------------------------------------------------------------------
 215   Purpose:
 216 ------------------------------------------------------------------------------*/
 217 DEF OUTPUT PARAMETER YTD-Budget AS DEC NO-UNDO INITIAL 0.0 .
 218 DEF OUTPUT PARAMETER FY-Budget AS DEC NO-UNDO INITIAL 0.0 .
 219 DEF OUTPUT PARAMETER Total-Committed AS DEC NO-UNDO INITIAL 0.0 .
 220 DEF OUTPUT PARAMETER Wait-Appvl AS DEC NO-UNDO INITIAL 0.0 .
 221 DEF OUTPUT PARAMETER OS-Orders AS DEC NO-UNDO INITIAL 0.0 .
 222 DEF OUTPUT PARAMETER YTD-Spent AS DEC NO-UNDO INITIAL 0.0 .
 223
 224 DEF VAR m1 AS INT NO-UNDO.
 225 DEF VAR m2 AS INT NO-UNDO.
 226 DEF VAR m3 AS INT NO-UNDO.
 227
 228 DEF VAR et AS CHAR NO-UNDO.
 229 DEF VAR ec AS INT NO-UNDO.
 230 DEF VAR ac AS DEC NO-UNDO.
 231
 232 /* DEF BUFFER tmp_Project FOR Project. */
 233
 234   FIND Month WHERE Month.StartDate <= TODAY AND Month.EndDate >= TODAY NO-LOCK.
 235   m2 = Month.MonthCode.
 236   FIND FinancialYear OF Month NO-LOCK.
 237   IF Order.EntityType = 'J' THEN DO:
 238     FIND FIRST Month NO-LOCK.    m1 = Month.MonthCode.
 239   END.
 240   ELSE DO:
 241     FIND FIRST Month OF FinancialYear NO-LOCK.    m1 = Month.MonthCode.
 242   END.
 243   FIND LAST Month OF FinancialYear NO-LOCK.     m3 = Month.MonthCode.
 244
 245   ac = Order.AccountCode.
 246   et = Order.EntityType.
 247   ec = Order.EntityCode.
 248
 249   FOR EACH AccountBalance WHERE AccountBalance.EntityType  = et
 250                             AND AccountBalance.EntityCode  = ec
 251                             AND AccountBalance.AccountCode = ac
 252                             AND AccountBalance.MonthCode >= m1
 253                             AND AccountBalance.MonthCode <= m3 NO-LOCK:
 254     FY-Budget = FY-Budget + AccountBalance.Budget.
 255     IF AccountBalance.MonthCode <= m2 THEN DO:
 256       YTD-Budget = YTD-Budget + AccountBalance.Budget.
 257       YTD-Spent  = YTD-Spent + AccountBalance.Balance.
 258     END.
 259   END.
 260
 261   DEF BUFFER tmp_Order FOR Order.
 262     FOR EACH tmp_Order WHERE tmp_Order.EntityType  = et
 263                          AND tmp_Order.EntityCode  = ec
 264                          AND tmp_Order.AccountCode = ac
 265                          AND ROWID(tmp_Order) <> ROWID(Order) NO-LOCK:
 266       OS-Orders = OS-Orders + tmp_Order.ApprovedAmount .
 267       FOR EACH Voucher WHERE Voucher.EntityType  = et
 268                          AND Voucher.EntityCode  = ec
 269                          AND Voucher.OrderCode = tmp_Order.OrderCode NO-LOCK:
 270         IF Voucher.VoucherStatus = "U" THEN DO:
 271           Wait-Appvl = Wait-Appvl + Voucher.GoodsValue.
 272         END.
 273         IF Voucher.VoucherStatus <> "C" THEN DO:
 274           OS-Orders = OS-Orders - Voucher.GoodsValue.
 275         END.
 276       END.
 277     END.
 278
 279
 280   OS-Orders = OS-Orders + Order.ApprovedAmount .
 281   FOR EACH Voucher WHERE Voucher.EntityType  = et
 282                      AND Voucher.EntityCode  = ec
 283                      AND Voucher.OrderCode = Order.OrderCode NO-LOCK:
 284     IF Voucher.VoucherStatus = "U" THEN
 285       Wait-Appvl = Wait-Appvl + Voucher.GoodsValue.
 286     ELSE IF Voucher.VoucherStatus <> "C" THEN DO:
 287       OS-Orders = OS-Orders - Voucher.GoodsValue.
 288     END.
 289   END.
 290
 291   Total-Committed = YTD-Spent + OS-Orders + Wait-Appvl.
 292
 293 END PROCEDURE.
 294
 295 /* _UIB-CODE-BLOCK-END */
 296 &ANALYZE-RESUME
 297
 298 &ENDIF
 299
 300 &IF DEFINED(EXCLUDE-get-control-strings) = 0 &THEN
 301
 302 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 303 PROCEDURE get-control-strings :
 304 /*------------------------------------------------------------------------------
 305   Purpose:     Get all control strings for this report
 306   Parameters:  <none>
 307   Notes:
 308 ------------------------------------------------------------------------------*/
 309 DEF VAR rows AS DEC NO-UNDO.
 310 DEF VAR cols AS DEC NO-UNDO.
 311
 312   RUN make-control-string( "PCL", "reset,simplex,portrait,a4,tm,0,lm,6",
 313     OUTPUT reset-page, OUTPUT rows, OUTPUT cols ).
 314
 315   RUN make-control-string( "PCL", "Helvetica,Point,20,Bold,Proportional,lpi,3.6",
 316                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 317
 318   RUN make-control-string( "PCL", "Times,Point,6,Normal,Proportional,lpi,12",
 319                   OUTPUT time-font, OUTPUT rows, OUTPUT cols ).
 320
 321   RUN make-control-string( "PCL", "Helvetica,Point,12,Proportional,Bold,lpi,6",
 322                   OUTPUT prompt-font, OUTPUT rows, OUTPUT cols ).
 323
 324   RUN make-control-string( "PCL", "Times,Point,16,Bold,Proportional,lpi,4.5",
 325                   OUTPUT num-font, OUTPUT rows, OUTPUT cols ).
 326
 327   RUN make-control-string( "PCL", "Helvetica,Point,14,Proportional,Bold,lpi,5",
 328                   OUTPUT re-font, OUTPUT rows, OUTPUT cols ).
 329
 330   RUN make-control-string( "PCL", "Helvetica,Point,10,Proportional,Normal,lpi,7",
 331                   OUTPUT creditor-address-font, OUTPUT rows, OUTPUT cols ).
 332
 333   RUN make-control-string( "PCL", "Courier,fixed,Point,10,normal,lpi,7",
 334                   OUTPUT order-body-font, OUTPUT rows, OUTPUT cols ).
 335
 336   RUN make-control-string( "PCL", "Courier,fixed,cpi,14,lpi,6,normal",
 337                   OUTPUT line-printer, OUTPUT rows, OUTPUT cols ).
 338
 339   RUN make-control-string( "PCL", "Times,Point,4,Proportional,Normal,lpi,17",
 340                   OUTPUT stamp-font, OUTPUT rows, OUTPUT cols ).
 341
 342 END PROCEDURE.
 343
 344 /* _UIB-CODE-BLOCK-END */
 345 &ANALYZE-RESUME
 346
 347 &ENDIF
 348
 349 &IF DEFINED(EXCLUDE-get-creditor-details) = 0 &THEN
 350
 351 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-creditor-details Procedure
 352 PROCEDURE get-creditor-details :
 353 /*------------------------------------------------------------------------------
 354   Purpose:
 355 ------------------------------------------------------------------------------*/
 356
 357   DEF VAR i         AS INT  NO-UNDO.
 358   DEF VAR addr      AS CHAR NO-UNDO.
 359
 360   FIND Creditor WHERE Creditor.CreditorCode = Order.CreditorCode NO-LOCK NO-ERROR.
 361
 362   RUN process/getaddr.p( "C", Creditor.CreditorCode, "PYMT,MAIN", OUTPUT addr ).
 363   DO i = 1 TO 7: creditor-address[i] = "". END.
 364   DO i = 1 TO NUM-ENTRIES( addr, CHR(10) ):
 365     creditor-address[i] = ENTRY( i, addr, CHR(10) ).
 366   END.
 367
 368   creditor-phones[1] = "".
 369   FIND FIRST PhoneDetail WHERE PhoneDetail.PersonCode = Creditor.PaymentContact
 370                            AND PhoneType = 'BUS' NO-LOCK NO-ERROR.
 371   IF AVAILABLE(PhoneDetail) THEN DO:
 372     RUN combine-phone( PhoneDetail.cCountryCode, PhoneDetail.cSTDCode, PhoneDetail.Number,
 373                      OUTPUT creditor-phones[1] ).
 374     creditor-phones[1] = "Bus: " + creditor-phones[1].
 375   END.
 376
 377   FIND FIRST PhoneDetail WHERE PhoneDetail.PersonCode = Creditor.PaymentContact
 378                            AND PhoneType = 'FAX' NO-LOCK NO-ERROR.
 379   creditor-phones[2] = "".
 380   IF AVAILABLE(PhoneDetail) THEN DO:
 381     RUN combine-phone( PhoneDetail.cCountryCode, PhoneDetail.cSTDCode, PhoneDetail.Number,
 382                      OUTPUT creditor-phones[2] ).
 383     creditor-phones[2] = "Fax: " + creditor-phones[2].
 384   END.
 385 END PROCEDURE.
 386
 387 /* _UIB-CODE-BLOCK-END */
 388 &ANALYZE-RESUME
 389
 390 &ENDIF
 391
 392 &IF DEFINED(EXCLUDE-get-order-details) = 0 &THEN
 393
 394 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-order-details Procedure
 395 PROCEDURE get-order-details :
 396 /*------------------------------------------------------------------------------
 397   Purpose:
 398 ------------------------------------------------------------------------------*/
 399   IF NOT AVAILABLE Order THEN RETURN.
 400
 401   entity-name = get-entity-name( entity-type, entity-code).
 402   client-code = get-entity-client( entity-type, entity-code).
 403   account-name = get-entity-account( entity-type, entity-code, Order.AccountCode ).
 404
 405   RUN hpgl-initialize.
 406   RUN client-logo( entity-type, entity-code, client-code ).
 407   RUN client-address( entity-type, entity-code, client-code ).
 408   RUN hpgl-get-codes( yes, yes, OUTPUT logo-codes ).
 409
 410 END PROCEDURE.
 411
 412 /* _UIB-CODE-BLOCK-END */
 413 &ANALYZE-RESUME
 414
 415 &ENDIF
 416
 417 &IF DEFINED(EXCLUDE-next-line) = 0 &THEN
 418
 419 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE next-line Procedure
 420 PROCEDURE next-line :
 421 /*------------------------------------------------------------------------------
 422   Purpose:
 423   Parameters:  <none>
 424   Notes:
 425 ------------------------------------------------------------------------------*/
 426
 427   trn-no = trn-no + 1.
 428
 429   IF trn-no > {&trn-per-page} THEN
 430   DO:
 431     RUN page-footer.
 432     RUN page-feed.
 433     RUN page-header.
 434   END.
 435
 436 END PROCEDURE.
 437
 438 /* _UIB-CODE-BLOCK-END */
 439 &ANALYZE-RESUME
 440
 441 &ENDIF
 442
 443 &IF DEFINED(EXCLUDE-order-body) = 0 &THEN
 444
 445 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE order-body Procedure
 446 PROCEDURE order-body :
 447 /*------------------------------------------------------------------------------
 448   Purpose:
 449 ------------------------------------------------------------------------------*/
 450
 451 &SCOP wrap-width 70
 452
 453   DEf VAR i AS INT NO-UNDO.
 454   DEF VAR order-text AS CHAR NO-UNDO.
 455
 456   PUT CONTROL order-body-font.
 457
 458   RUN word-wrap( Order.Description, {&wrap-width}, OUTPUT order-text ).
 459
 460   DO i = 1 TO NUM-ENTRIES( order-text, "~n" ):
 461     RUN next-line.
 462     PUT UNFORMATTED ENTRY( i, order-text, "~n" ).
 463     RUN skip-line(1).
 464   END.
 465
 466 END PROCEDURE.
 467
 468 /* _UIB-CODE-BLOCK-END */
 469 &ANALYZE-RESUME
 470
 471 &ENDIF
 472
 473 &IF DEFINED(EXCLUDE-page-feed) = 0 &THEN
 474
 475 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 476 PROCEDURE page-feed :
 477 /*------------------------------------------------------------------------------
 478   Purpose:
 479   Parameters:  <none>
 480   Notes:
 481 ------------------------------------------------------------------------------*/
 482
 483   PUT CONTROL CHR(12).
 484   page-no = page-no + 1.
 485
 486 END PROCEDURE.
 487
 488 /* _UIB-CODE-BLOCK-END */
 489 &ANALYZE-RESUME
 490
 491 &ENDIF
 492
 493 &IF DEFINED(EXCLUDE-page-footer) = 0 &THEN
 494
 495 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-footer Procedure
 496 PROCEDURE page-footer :
 497 /*------------------------------------------------------------------------------
 498   Purpose:
 499 ------------------------------------------------------------------------------*/
 500
 501   IF copy-no = 1 AND supplier-copy THEN
 502     RUN page-footer-creditor.
 503   ELSE
 504     RUN page-footer-copy.
 505
 506 END PROCEDURE.
 507
 508 /* _UIB-CODE-BLOCK-END */
 509 &ANALYZE-RESUME
 510
 511 &ENDIF
 512
 513 &IF DEFINED(EXCLUDE-page-footer-copy) = 0 &THEN
 514
 515 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-footer-copy Procedure
 516 PROCEDURE page-footer-copy :
 517 /*------------------------------------------------------------------------------
 518   Purpose:
 519 ------------------------------------------------------------------------------*/
 520 DEF VAR YTD-Budget AS DEC NO-UNDO .
 521 DEF VAR FY-Budget AS DEC NO-UNDO .
 522 DEF VAR Total-Committed AS DEC NO-UNDO .
 523 DEF VAR Wait-Appvl AS DEC NO-UNDO .
 524 DEF VAR OS-Orders AS DEC NO-UNDO .
 525 DEF VAR YTD-Spent AS DEC NO-UNDO .
 526
 527   RUN get-account-figures( OUTPUT YTD-Budget, OUTPUT FY-Budget, OUTPUT Total-Committed,
 528                         OUTPUT Wait-Appvl, OUTPUT OS-Orders, OUTPUT YTD-Spent ).
 529   PUT CONTROL line-printer.
 530   RUN pcl-moveto( 56, 10 ).     RUN carriage-return.
 531   PUT UNFORMATTED "Account coding: " + STRING(Order.AccountCode, "9999.99")
 532                SPACE(3) account-name.
 533   RUN carriage-return.
 534
 535   PUT CONTROL title-font.   PUT UNFORMATTED FILL( "__", 60 ). PUT CONTROL line-printer.
 536   RUN skip-line(1.2).
 537
 538   PUT UNFORMATTED "Total Paid Year to date:    " + STRING(YTD-Spent, "->>>,>>>,>>9.99")
 539         SPACE(20) "Full Year Budget: "    + STRING(FY-Budget,"->>>,>>>,>>9.99").
 540   RUN skip-line(1.2).
 541
 542   PUT UNFORMATTED "Vouchers awaiting approval: " + STRING(Wait-Appvl, "->>>,>>>,>>9.99")
 543         SPACE(20) "YTD Budget:       "    + STRING(YTD-Budget,"->>>,>>>,>>9.99").
 544   RUN skip-line(1.2).
 545
 546   PUT UNFORMATTED "Orders not yet invoiced:    " + STRING(OS-Orders, "->>>,>>>,>>9.99")
 547         SPACE(20) "Total Committed:  "    + STRING(Total-Committed,"->>>,>>>,>>9.99").
 548   RUN carriage-return.
 549   PUT CONTROL title-font.   PUT UNFORMATTED FILL( "__", 60 ). PUT CONTROL line-printer.
 550   RUN skip-line(2).
 551
 552   PUT CONTROL prompt-font.
 553   PUT UNFORMATTED "__________  :  Ordered from supplier".
 554   RUN carriage-return.
 555   PUT UNFORMATTED SPACE(55) "__________   ____/_____/_____  :  Order requested".
 556   RUN skip-line(2).
 557
 558   PUT UNFORMATTED "__________  :  Copy to accounts".
 559   RUN carriage-return.
 560   PUT UNFORMATTED SPACE(55) "__________   ____/_____/_____  :  Order approved".
 561   RUN skip-line(2).
 562
 563   PUT UNFORMATTED "__________  :  Filing Code".
 564   RUN skip-line(0.7).
 565   PUT CONTROL stamp-font.
 566   PUT UNFORMATTED time-stamp.
 567
 568 /*  PUT CONTROL line-printer.
 569   RUN pcl-moveto( 103, 10 ).  */
 570   RUN print-copy-sign.
 571
 572 END PROCEDURE.
 573
 574 /* _UIB-CODE-BLOCK-END */
 575 &ANALYZE-RESUME
 576
 577 &ENDIF
 578
 579 &IF DEFINED(EXCLUDE-page-footer-creditor) = 0 &THEN
 580
 581 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-footer-creditor Procedure
 582 PROCEDURE page-footer-creditor :
 583 /*------------------------------------------------------------------------------
 584   Purpose:
 585   Parameters:  <none>
 586   Notes:
 587 ------------------------------------------------------------------------------*/
 588
 589   IF order-notes-routine <> "" THEN DO:
 590     RUN hpgl-initialize.
 591     IF output-to-pdf THEN
 592         RUN VALUE(order-notes-routine) ( "pdf" ).
 593     ELSE
 594         RUN VALUE(order-notes-routine) ( "hpgl" ).
 595     RUN hpgl-append( RETURN-VALUE ).
 596     RUN hpgl-get-codes( YES, YES, OUTPUT notes-out-codes ).
 597     PUT CONTROL notes-out-codes.
 598
 599     PUT CONTROL line-printer.
 600     RUN pcl-moveto( 65, 11 ). RUN carriage-return.
 601     RUN skip-line(1).
 602   END.
 603   ELSE DO:
 604     PUT CONTROL line-printer.
 605     RUN pcl-moveto( 65, 11 ). RUN carriage-return.
 606
 607     PUT CONTROL prompt-font.
 608     PUT UNFORMATTED "To assist in prompt payment please quote our order number on all correspondence".
 609     RUN skip-line(1).
 610   END.
 611
 612 END PROCEDURE.
 613
 614 /* _UIB-CODE-BLOCK-END */
 615 &ANALYZE-RESUME
 616
 617 &ENDIF
 618
 619 &IF DEFINED(EXCLUDE-page-header) = 0 &THEN
 620
 621 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 622 PROCEDURE page-header :
 623 /*------------------------------------------------------------------------------
 624   Purpose:
 625   Parameters:  <none>
 626   Notes:
 627 ------------------------------------------------------------------------------*/
 628
 629   RUN reset-page.
 630   RUN print-title.
 631   RUN print-address.
 632   RUN print-header.
 633
 634 END PROCEDURE.
 635
 636 /* _UIB-CODE-BLOCK-END */
 637 &ANALYZE-RESUME
 638
 639 &ENDIF
 640
 641 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 642
 643 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 644 PROCEDURE parse-parameters :
 645 /*------------------------------------------------------------------------------
 646   Purpose:
 647 ------------------------------------------------------------------------------*/
 648 DEF VAR token AS CHAR NO-UNDO.
 649 DEF VAR i AS INT NO-UNDO.
 650
 651 {inc/showopts.i "report-options"}
 652
 653   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 654     token = ENTRY( i, report-options, "~n" ).
 655
 656     CASE ENTRY( 1, token ):
 657       WHEN "SupplierCopy" THEN      supplier-copy = Yes.
 658       WHEN "InternalCopies" THEN    no-of-copies = INT( ENTRY(2,token) ).
 659       WHEN "OutputPDF" THEN output-to-pdf = YES.
 660       WHEN "EmailAddress" THEN email-address = ENTRY( 2, token ).
 661       WHEN "Entity" THEN ASSIGN
 662         entity-type = ENTRY(2,token)
 663         entity-code = INT( ENTRY(3,token) ) .
 664       WHEN "Orders" THEN
 665         order-list = SUBSTRING(token, INDEX(token,",") + 1).
 666     END CASE.
 667   END.
 668
 669   IF supplier-copy THEN no-of-copies = no-of-copies + 1.
 670
 671   /* Regardless of options, force one copy only if for PDF output */
 672   IF output-to-pdf THEN
 673     no-of-copies = 1.
 674
 675 END PROCEDURE.
 676
 677 /* _UIB-CODE-BLOCK-END */
 678 &ANALYZE-RESUME
 679
 680 &ENDIF
 681
 682 &IF DEFINED(EXCLUDE-print-address) = 0 &THEN
 683
 684 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-address Procedure
 685 PROCEDURE print-address :
 686 /*------------------------------------------------------------------------------
 687   Purpose:
 688   Parameters:  <none>
 689   Notes:
 690 ------------------------------------------------------------------------------*/
 691
 692   DEF VAR order-date AS CHAR NO-UNDO.
 693
 694   RUN skip-line(1).
 695   PUT CONTROL creditor-address-font.
 696
 697   PUT UNFORMATTED STRING( creditor-address[1], "X(50)" ). RUN carriage-return.
 698   PUT UNFORMATTED SPACE( 100 ) "Order No:". RUN carriage-return.
 699   PUT CONTROL line-printer. RUN pcl-move-relative( 0, 55 ).
 700   PUT CONTROL num-font.
 701   PUT UNFORMATTED SPACE( 35 ) Order.EntityType STRING( Order.EntityCode ) + "/" + STRING( Order.OrderCode ).
 702   PUT CONTROL creditor-address-font.  RUN skip-line(1).
 703
 704   PUT UNFORMATTED STRING( creditor-address[2], "X(50)" ). RUN skip-line(1).
 705   PUT UNFORMATTED STRING( creditor-address[3], "X(50)" ). RUN skip-line(1).
 706   PUT UNFORMATTED STRING( creditor-address[4], "X(50)" ). RUN carriage-return.
 707
 708   RUN date-to-word( Order.OrderDate, OUTPUT order-date ).
 709   PUT UNFORMATTED SPACE(118) STRING( order-date, "X(20)" ). RUN skip-line(1).
 710   PUT UNFORMATTED STRING( creditor-address[5], "X(50)" ).  RUN skip-line(1).
 711   PUT UNFORMATTED STRING( creditor-address[6], "X(50)" ).  RUN skip-line(1).
 712   PUT UNFORMATTED STRING( creditor-address[7], "X(50)" ).  RUN skip-line(1).
 713   RUN skip-line(1).
 714
 715   PUT UNFORMATTED STRING( creditor-phones[1], "X(50)" ).  RUN skip-line(1).
 716   PUT UNFORMATTED STRING( creditor-phones[2], "X(50)" ).  RUN skip-line(1).
 717
 718 END PROCEDURE.
 719
 720 /* _UIB-CODE-BLOCK-END */
 721 &ANALYZE-RESUME
 722
 723 &ENDIF
 724
 725 &IF DEFINED(EXCLUDE-print-copy-sign) = 0 &THEN
 726
 727 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-copy-sign Procedure
 728 PROCEDURE print-copy-sign :
 729 /*------------------------------------------------------------------------------
 730   Purpose:
 731 ------------------------------------------------------------------------------*/
 732 DEF VAR copy-codes AS CHAR NO-UNDO.
 733
 734   RUN hpgl-initialize.
 735   RUN hpgl-copywatermark.
 736   RUN hpgl-get-codes( yes, no, OUTPUT copy-codes ).
 737   PUT CONTROL copy-codes.
 738
 739 END PROCEDURE.
 740
 741 /* _UIB-CODE-BLOCK-END */
 742 &ANALYZE-RESUME
 743
 744 &ENDIF
 745
 746 &IF DEFINED(EXCLUDE-print-header) = 0 &THEN
 747
 748 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-header Procedure
 749 PROCEDURE print-header :
 750 /*------------------------------------------------------------------------------
 751   Purpose:
 752 ------------------------------------------------------------------------------*/
 753 DEF VAR approver-text AS CHAR NO-UNDO.
 754 DEF VAR i AS INT NO-UNDO.
 755
 756   RUN skip-line(1).
 757   RUN pcl-move-relative( 0, 45 ).
 758   PUT CONTROL title-font.
 759   PUT UNFORMATTED "PURCHASE ORDER". RUN carriage-return.
 760   PUT CONTROL creditor-address-font.
 761   /* PUT UNFORMATTED SPACE(138) STRING( "Page " + STRING( page-no ) ). */
 762   PUT CONTROL line-printer.  RUN skip-line(1).
 763   PUT CONTROL title-font.
 764   PUT UNFORMATTED FILL( "__", 60 ).
 765   RUN skip-line(1).
 766
 767    /* Regarding bit */
 768   PUT CONTROL re-font.
 769   PUT UNFORMATTED "RE: ". RUN carriage-return.
 770   PUT UNFORMATTED SPACE(15) entity-name.
 771   IF Order.EntityType = 'P' THEN DO:
 772     FIND FIRST Property WHERE Property.PropertyCode = Order.EntityCode NO-LOCK NO-ERROR.
 773     IF AVAILABLE(Property) THEN DO:
 774       RUN skip-line(1).
 775       PUT UNFORMATTED SPACE(15) Property.StreetAddress .
 776     END.
 777   END.
 778   RUN skip-line(1.3).
 779   IF Order.OrderAmount > 0 THEN DO:
 780     PUT UNFORMATTED "Amount: ". RUN carriage-return.
 781     PUT UNFORMATTED SPACE(15) TRIM( STRING( Order.OrderAmount, "$>>>,>>>,>>9.99" ) ).
 782     IF Order.TaxAmount <> ? AND Order.TaxAmount <> 0 THEN DO:
 783       PUT UNFORMATTED "  plus GST of  " TRIM( STRING( Order.TaxAmount, "$>>>,>>>,>>9.99" ) ).
 784     END.
 785     RUN skip-line(1.3).
 786   END.
 787   ELSE IF Order.ApprovedAmount > 0 THEN DO:
 788     approver-text = "us".
 789     FIND Usr WHERE Usr.UserName = Order.FirstApprover NO-LOCK NO-ERROR.
 790     IF AVAILABLE(Usr) THEN DO:
 791       FIND Person OF Usr NO-LOCK NO-ERROR.
 792       IF AVAILABLE(Person) THEN approver-text = Person.FirstName + " " + Person.LastName.
 793     END.
 794     approver-text = "Please contact " + approver-text + " for further approval if the required work will "
 795                   + "exceed " + TRIM( STRING( Order.ApprovedAmount, "$>>>,>>>,>>9.99" ) )
 796                   + " in total.".
 797
 798     RUN word-wrap( approver-text, 80, OUTPUT approver-text ).
 799
 800     PUT CONTROL prompt-font.
 801     DO i = 1 TO NUM-ENTRIES( approver-text, "~n" ):
 802       RUN next-line.
 803       PUT UNFORMATTED ENTRY( i, approver-text, "~n" ).
 804       RUN skip-line(1).
 805     END.
 806   END.
 807
 808   PUT CONTROL line-printer.
 809   RUN skip-line(1).
 810
 811 END PROCEDURE.
 812
 813 /* _UIB-CODE-BLOCK-END */
 814 &ANALYZE-RESUME
 815
 816 &ENDIF
 817
 818 &IF DEFINED(EXCLUDE-print-title) = 0 &THEN
 819
 820 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-title Procedure
 821 PROCEDURE print-title :
 822 /*------------------------------------------------------------------------------
 823   Purpose:
 824   Parameters:  <none>
 825   Notes:
 826 ------------------------------------------------------------------------------*/
 827
 828   PUT CONTROL line-printer.
 829   RUN skip-line(2).
 830
 831   PUT CONTROL logo-codes.
 832
 833   PUT CONTROL line-printer.
 834   RUN skip-line(2).
 835
 836 END PROCEDURE.
 837
 838 /* _UIB-CODE-BLOCK-END */
 839 &ANALYZE-RESUME
 840
 841 &ENDIF
 842
 843 &IF DEFINED(EXCLUDE-purchase-orders) = 0 &THEN
 844
 845 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE purchase-orders Procedure
 846 PROCEDURE purchase-orders :
 847 /*------------------------------------------------------------------------------
 848   Purpose:
 849 ------------------------------------------------------------------------------*/
 850 DEF VAR i AS INT NO-UNDO.
 851
 852   RUN get-control-strings.
 853
 854   RUN date-to-word( TODAY, OUTPUT date-in-words ).
 855
 856   CASE entity-type:
 857     WHEN "J" THEN DO:
 858       FIND Project WHERE Project.ProjectCode = entity-code NO-LOCK NO-ERROR.
 859       IF NOT AVAILABLE Project THEN RETURN.
 860     END.
 861     WHEN "P" THEN DO:
 862       FIND Property WHERE Property.PropertyCode = entity-code NO-LOCK NO-ERROR.
 863       IF NOT AVAILABLE Property THEN DO:
 864         MESSAGE "Could not find the property" VIEW-AS ALERT-BOX ERROR.
 865         RETURN.
 866       END.
 867     END.
 868     WHEN "L" THEN DO:
 869       FIND Company WHERE Company.CompanyCode = entity-code NO-LOCK NO-ERROR.
 870       IF NOT AVAILABLE Company THEN RETURN.
 871     END.
 872     OTHERWISE DO:
 873       MESSAGE "No creditor to create order for." VIEW-AS ALERT-BOX ERROR.
 874     END.
 875   END CASE.
 876
 877   IF order-list <> ? THEN
 878   DO i = 1 TO NUM-ENTRIES( order-list ):
 879
 880     /* If outputting to PDF the do individual files for each order */
 881     IF output-to-pdf THEN DO:
 882         RUN txtrep-pdf-filename( 'Order-' + ENTRY( i, order-list ) ).
 883         OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 884
 885         /* Inject the email control sequence if this is to be emailed */
 886         IF email-address <> "" THEN
 887             RUN txtrep-do-email( email-address, 'Purchase Order', 'templates/email/orderfrm.txt' ).
 888     END.
 889
 890     FOR EACH Order WHERE Order.EntityType = entity-type
 891                  AND Order.EntityCode = entity-code
 892                  AND Order.OrderCode = INT( ENTRY( i, order-list ) ) NO-LOCK:
 893         RUN each-order.
 894
 895     /* If PDF mode then output will be opened again for the next file */
 896         IF output-to-pdf THEN
 897             OUTPUT CLOSE.
 898     END.
 899   END.
 900
 901 END PROCEDURE.
 902
 903 /* _UIB-CODE-BLOCK-END */
 904 &ANALYZE-RESUME
 905
 906 &ENDIF
 907
 908 &IF DEFINED(EXCLUDE-reset-page) = 0 &THEN
 909
 910 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 911 PROCEDURE reset-page :
 912 /*------------------------------------------------------------------------------
 913   Purpose:
 914   Parameters:  <none>
 915   Notes:
 916 ------------------------------------------------------------------------------*/
 917
 918   PUT CONTROL reset-page.
 919   trn-no = 0.
 920   ln = 0.
 921
 922 END PROCEDURE.
 923
 924 /* _UIB-CODE-BLOCK-END */
 925 &ANALYZE-RESUME
 926
 927 &ENDIF
 928
 929 &IF DEFINED(EXCLUDE-skip-line) = 0 &THEN
 930
 931 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
 932 PROCEDURE skip-line :
 933 /*------------------------------------------------------------------------------
 934   Purpose:
 935   Parameters:  <none>
 936   Notes:
 937 ------------------------------------------------------------------------------*/
 938
 939   DEF INPUT PARAMETER n AS DEC NO-UNDO.
 940
 941   DEF VAR int-part AS INT NO-UNDO.
 942   DEF VAR dec-part AS DEC NO-UNDO.
 943
 944   int-part = TRUNCATE( n, 0 ).
 945   IF int-part < 0 THEN RETURN.
 946   dec-part = n - int-part.
 947   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 948
 949   /* Need to have this like the following - do not touch */
 950   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 951   IF dec-part <> 0 THEN PUT CONTROL half-line.
 952
 953   ln = ln + n.
 954
 955   RUN carriage-return.
 956
 957 END PROCEDURE.
 958
 959 /* _UIB-CODE-BLOCK-END */
 960 &ANALYZE-RESUME
 961
 962 &ENDIF
 963
 964 &IF DEFINED(EXCLUDE-skip-to-line) = 0 &THEN
 965
 966 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-to-line Procedure
 967 PROCEDURE skip-to-line :
 968 /*------------------------------------------------------------------------------
 969   Purpose:
 970   Parameters:  <none>
 971   Notes:
 972 ------------------------------------------------------------------------------*/
 973
 974   DEF INPUT PARAMETER line-no AS DEC NO-UNDO.
 975
 976   DEF VAR int-part AS INT NO-UNDO.
 977   DEF VAR dec-part AS DEC NO-UNDO.
 978
 979   int-part = TRUNCATE( line-no - ln, 0 ).
 980   IF int-part < 0 THEN RETURN.
 981   dec-part = ( line-no - ln ) - int-part.
 982   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 983
 984   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 985   IF dec-part <> 0 THEN PUT CONTROL half-line.
 986
 987   ln = line-no.
 988
 989   RUN carriage-return.
 990
 991 END PROCEDURE.
 992
 993 /* _UIB-CODE-BLOCK-END */
 994 &ANALYZE-RESUME
 995
 996 &ENDIF
 997