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