process/report/prjorder.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6
   7 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
   8
   9 DEF VAR project-from LIKE Project.ProjectCode NO-UNDO.
  10 DEF VAR project-to   LIKE Project.ProjectCode NO-UNDO.
  11 DEF VAR upto-month      AS INT  NO-UNDO.
  12 DEF VAR upto-date       AS DATE NO-UNDO.
  13 DEF VAR from-month      AS INT  NO-UNDO     INITIAL 0.
  14 DEF VAR from-date       AS DATE NO-UNDO.
  15 DEF VAR preview         AS LOGICAL NO-UNDO          INITIAL No.
  16 DEF VAR summarise       AS LOGI NO-UNDO     INITIAL No.
  17 RUN parse-parameters.
  18
  19 DEF VAR pending-headers AS CHAR NO-UNDO INITIAL "".
  20 DEF VAR ptot AS DEC NO-UNDO INITIAL 0.
  21 DEF VAR gtot AS DEC NO-UNDO INITIAL 0.
  22
  23 /* Report counters */
  24 DEF VAR ln AS DEC INIT 0.00 NO-UNDO.
  25 DEF VAR lines-per-page AS INT NO-UNDO.
  26
  27 /* Line definitions */
  28
  29 DEF VAR page-no               AS INT INIT 1 NO-UNDO.
  30 DEF VAR reset-page            AS CHAR NO-UNDO.
  31 DEF VAR half-line             AS CHAR NO-UNDO.
  32 DEF VAR title-font            AS CHAR NO-UNDO.
  33 DEF VAR time-font             AS CHAR NO-UNDO.
  34 DEF VAR project-font          AS CHAR EXTENT 3 NO-UNDO.
  35 DEF VAR line-font             AS CHAR NO-UNDO.
  36 DEF VAR i AS INT NO-UNDO.
  37 DEF VAR money-fmt AS CHAR NO-UNDO   INITIAL   ">>>,>>>,>>9.99CR".
  38
  39 DEF VAR money-width AS INT NO-UNDO.
  40 money-width = LENGTH(STRING(0,money-fmt)).
  41
  42 DEF VAR now AS CHAR NO-UNDO.
  43 now = STRING( TODAY, "99/99/9999" ) + " " + STRING( TIME, "HH:MM:SS" ).
  44 DEF VAR user-name AS CHAR NO-UNDO.
  45 {inc/username.i "user-name"}
  46
  47 RUN get-control-strings.
  48
  49 /* _UIB-CODE-BLOCK-END */
  50 &ANALYZE-RESUME
  51
  52
  53 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  54
  55 /* ********************  Preprocessor Definitions  ******************** */
  56
  57 &Scoped-define PROCEDURE-TYPE Procedure
  58
  59
  60
  61 /* _UIB-PREPROCESSOR-BLOCK-END */
  62 &ANALYZE-RESUME
  63
  64
  65 /* ************************  Function Prototypes ********************** */
  66
  67 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD sum-project-orders Procedure
  68 FUNCTION sum-project-orders RETURNS DECIMAL
  69   ( INPUT project-code AS INT )  FORWARD.
  70
  71 /* _UIB-CODE-BLOCK-END */
  72 &ANALYZE-RESUME
  73
  74
  75 /* *********************** Procedure Settings ************************ */
  76
  77 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  78 /* Settings for THIS-PROCEDURE
  79    Type: Procedure
  80    Allow:
  81    Frames: 0
  82    Add Fields to: Neither
  83    Other Settings: CODE-ONLY COMPILE
  84  */
  85 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  86
  87 /* *************************  Create Window  ************************** */
  88
  89 &ANALYZE-SUSPEND _CREATE-WINDOW
  90 /* DESIGN Window definition (used by the UIB)
  91   CREATE WINDOW Procedure ASSIGN
  92          HEIGHT             = .1
  93          WIDTH              = 40.
  94 /* END WINDOW DEFINITION */
  95                                                                         */
  96 &ANALYZE-RESUME
  97
  98
  99
 100 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 101 /* ************************* Included-Libraries *********************** */
 102
 103 {inc/method/m-txtrep.i}
 104
 105 /* _UIB-CODE-BLOCK-END */
 106 &ANALYZE-RESUME
 107
 108
 109
 110 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 111
 112
 113 /* ***************************  Main Block  *************************** */
 114
 115 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 116
 117 RUN order-tracking.
 118
 119 OUTPUT CLOSE.
 120
 121 RUN view-output-file ( preview ).
 122
 123 /* _UIB-CODE-BLOCK-END */
 124 &ANALYZE-RESUME
 125
 126
 127 /* **********************  Internal Procedures  *********************** */
 128
 129 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE column-header Procedure
 130 PROCEDURE column-header :
 131 /*------------------------------------------------------------------------------
 132   Purpose:
 133 ------------------------------------------------------------------------------*/
 134 DEF VAR line-1 AS CHAR NO-UNDO.
 135 DEF VAR line-2 AS CHAR NO-UNDO.
 136
 137   line-1 = "   Order" + FILL(" ", 84) + "1st".
 138   line-2 = "    Date    Reference        Amount     Description" + FILL(" ", 41) + "Appvr        Supplier".
 139
 140   RUN print-line( line-1 ).
 141   RUN print-line( line-2 ).
 142   RUN skip-line( 1.5 ).
 143
 144 END PROCEDURE.
 145
 146 /* _UIB-CODE-BLOCK-END */
 147 &ANALYZE-RESUME
 148
 149
 150 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE detail-sub-projects Procedure
 151 PROCEDURE detail-sub-projects :
 152 /*------------------------------------------------------------------------------
 153   Purpose:
 154 ------------------------------------------------------------------------------*/
 155 DEF INPUT PARAMETER project-code LIKE Project.ProjectCode NO-UNDO.
 156
 157 DEF BUFFER SubProj FOR Project.
 158
 159   FOR EACH SubProj WHERE SubProj.EntityType = "J"
 160                      AND SubProj.EntityCode = project-code NO-LOCK:
 161     FOR EACH Order WHERE Order.ProjectCode = SubProj.ProjectCode NO-LOCK:
 162       RUN each-order.
 163     END.
 164     RUN detail-sub-projects( SubProj.ProjectCode ).
 165   END.
 166
 167 END PROCEDURE.
 168
 169 /* _UIB-CODE-BLOCK-END */
 170 &ANALYZE-RESUME
 171
 172
 173 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-order Procedure
 174 PROCEDURE each-order :
 175 /*------------------------------------------------------------------------------
 176   Purpose:
 177 ------------------------------------------------------------------------------*/
 178 DEF VAR var-text AS CHAR NO-UNDO.
 179 DEF VAR cred-name AS CHAR NO-UNDO.
 180
 181 DEF VAR detail-line AS CHAR NO-UNDO.
 182
 183   IF Order.OrderDate < from-date OR Order.OrderDate > upto-date THEN RETURN.
 184
 185   var-text = WRAP( Order.Description, 50).
 186   FIND Creditor OF Order NO-LOCK NO-ERROR.
 187   IF AVAILABLE(Creditor) THEN
 188     cred-name = Creditor.Name.
 189   ELSE
 190     cred-name = "Creditor not on file!".
 191
 192   detail-line = (IF Order.OrderDate = ? THEN "??/??/????" ELSE STRING( Order.OrderDate, "99/99/9999" )) + "  "
 193               + STRING( STRING( Order.ProjectCode ) + "/" + STRING( Order.OrderCode ), "X(10)")
 194               + STRING( Order.OrderAmount , money-fmt ) + "  "
 195               + STRING( ENTRY( 1, var-text, "~n"), "X(52)" )
 196               + STRING( Order.FirstApprover, "X(6)" )
 197               + STRING( Order.CreditorCode, "99999" ) + "  "
 198               + cred-name
 199                .
 200
 201   RUN project-header.
 202   RUN print-line( detail-line ).
 203
 204   ptot = ptot + Order.OrderAmount .
 205
 206 END PROCEDURE.
 207
 208 /* _UIB-CODE-BLOCK-END */
 209 &ANALYZE-RESUME
 210
 211
 212 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-project Procedure
 213 PROCEDURE each-project :
 214 /*------------------------------------------------------------------------------
 215   Purpose:
 216   Parameters:  <none>
 217   Notes:
 218 ------------------------------------------------------------------------------*/
 219 DEF INPUT PARAMETER project-code LIKE Project.ProjectCode NO-UNDO.
 220
 221 DEF VAR project-name AS CHAR NO-UNDO.
 222 DEF VAR save-gtot AS DEC NO-UNDO.
 223 DEF BUFFER SubProj FOR Project.
 224
 225   FIND Project WHERE Project.ProjectCode = project-code NO-LOCK.
 226   project-name = Project.Name.
 227   RUN pending-project-header( project-code ).
 228
 229   ptot = 0.
 230   FOR EACH Order WHERE Order.ProjectCode = project-code NO-LOCK:
 231     RUN each-order.
 232   END.
 233   IF summarise THEN
 234     RUN summarise-sub-projects( project-code ).
 235   ELSE
 236     RUN detail-sub-projects( project-code ).
 237
 238   IF pending-headers = "" THEN DO:
 239     RUN print-totals( "Total", ptot).
 240     RUN skip-line(1).
 241     gtot = gtot + ptot.
 242   END.
 243
 244 END PROCEDURE.
 245
 246 /* _UIB-CODE-BLOCK-END */
 247 &ANALYZE-RESUME
 248
 249
 250 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 251 PROCEDURE get-control-strings :
 252 /*------------------------------------------------------------------------------
 253   Purpose:     Get all control strings for this report
 254   Parameters:  <none>
 255   Notes:
 256 ------------------------------------------------------------------------------*/
 257 DEF VAR rows AS DEC NO-UNDO.
 258 DEF VAR cols AS DEC NO-UNDO.
 259
 260   RUN make-control-string ( "PCL", "reset,portrait,a4,tm,0,lm,0,Fixed,Courier,cpi,18,lpi,9.54",
 261                   OUTPUT reset-page, OUTPUT lines-per-page, OUTPUT cols ).
 262
 263   IF preview THEN RETURN.
 264   half-line = CHR(27) + "=".
 265
 266   RUN make-control-string ( "PCL", "Fixed,Courier,cpi,18,lpi,9.54",
 267                   OUTPUT line-font, OUTPUT rows, OUTPUT cols ).
 268
 269   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,12",
 270                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 271
 272   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,6",
 273                   OUTPUT time-font, OUTPUT rows, OUTPUT cols ).
 274
 275   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 276                   OUTPUT project-font[1], OUTPUT rows, OUTPUT cols ).
 277
 278   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 279                   OUTPUT project-font[2], OUTPUT rows, OUTPUT cols ).
 280
 281   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 282                   OUTPUT project-font[3], OUTPUT rows, OUTPUT cols ).
 283
 284 END PROCEDURE.
 285
 286 /* _UIB-CODE-BLOCK-END */
 287 &ANALYZE-RESUME
 288
 289
 290 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-entity-name Procedure
 291 PROCEDURE get-entity-name :
 292 /*------------------------------------------------------------------------------
 293   Purpose:
 294   Parameters:  <none>
 295   Notes:
 296 ------------------------------------------------------------------------------*/
 297 DEF INPUT  PARAMETER entity-type AS CHAR NO-UNDO.
 298 DEF INPUT  PARAMETER entity-code AS INT  NO-UNDO.
 299 DEF OUTPUT PARAMETER entity-name AS CHAR NO-UNDO.
 300
 301   DEF BUFFER OtherProject FOR Project.
 302
 303   CASE entity-type:
 304     WHEN "P" THEN DO:
 305       FIND FIRST Property WHERE Property.PropertyCode = entity-code
 306         NO-LOCK NO-ERROR.
 307       IF AVAILABLE Property THEN entity-name = Property.Name.
 308     END.
 309
 310     WHEN "L" THEN DO:
 311       FIND FIRST Company WHERE Company.CompanyCode = entity-code
 312         NO-LOCK NO-ERROR.
 313       IF AVAILABLE Company THEN entity-name = Company.LegalName.
 314     END.
 315
 316     WHEN "T" THEN DO:
 317       FIND FIRST Tenant WHERE Tenant.TenantCode = entity-code
 318         NO-LOCK NO-ERROR.
 319       IF AVAILABLE Tenant THEN entity-name = Tenant.Name.
 320     END.
 321
 322     WHEN "C" THEN DO:
 323       FIND FIRST Creditor WHERE Creditor.CreditorCode = entity-code
 324         NO-LOCK NO-ERROR.
 325       IF AVAILABLE Creditor THEN entity-name = Creditor.Name.
 326     END.
 327
 328     WHEN "J" THEN DO:
 329       FIND FIRST OtherProject WHERE OtherProject.ProjectCode = entity-code
 330         NO-LOCK NO-ERROR.
 331       IF AVAILABLE OtherProject THEN entity-name = OtherProject.Name.
 332     END.
 333
 334   END CASE.
 335
 336 END PROCEDURE.
 337
 338 /* _UIB-CODE-BLOCK-END */
 339 &ANALYZE-RESUME
 340
 341
 342 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE order-tracking Procedure
 343 PROCEDURE order-tracking :
 344 /*------------------------------------------------------------------------------
 345   Purpose:
 346 ------------------------------------------------------------------------------*/
 347
 348   RUN page-header.
 349
 350   FOR EACH Project NO-LOCK WHERE Project.ProjectCode >= project-from
 351                              AND Project.ProjectCode <= project-to:
 352     RUN each-project( Project.ProjectCode ).
 353   END.
 354
 355   IF project-from < project-to THEN DO:
 356     RUN skip-line(2).
 357     RUN print-totals( "Grand total", gtot ).
 358   END.
 359
 360   RUN page-feed.
 361
 362 END PROCEDURE.
 363
 364 /* _UIB-CODE-BLOCK-END */
 365 &ANALYZE-RESUME
 366
 367
 368 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 369 PROCEDURE page-feed :
 370 /*------------------------------------------------------------------------------
 371   Purpose:
 372   Parameters:  <none>
 373   Notes:
 374 ------------------------------------------------------------------------------*/
 375
 376   page-no = page-no + 1.
 377   PUT CONTROL CHR(12).
 378
 379 END PROCEDURE.
 380
 381 /* _UIB-CODE-BLOCK-END */
 382 &ANALYZE-RESUME
 383
 384
 385 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 386 PROCEDURE page-header :
 387 /*------------------------------------------------------------------------------
 388   Purpose:
 389   Parameters:  <none>
 390   Notes:
 391 ------------------------------------------------------------------------------*/
 392
 393   RUN reset-page.
 394   RUN print-title.
 395   RUN column-header.
 396
 397 END PROCEDURE.
 398
 399 /* _UIB-CODE-BLOCK-END */
 400 &ANALYZE-RESUME
 401
 402
 403 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 404 PROCEDURE parse-parameters :
 405 /*------------------------------------------------------------------------------
 406   Purpose:
 407 ------------------------------------------------------------------------------*/
 408 DEF VAR i           AS INT NO-UNDO.
 409 DEF VAR token       AS CHAR NO-UNDO.
 410
 411   FIND FIRST Month NO-LOCK.                 from-month = Month.MonthCode.
 412   FIND LAST Month NO-LOCK.                  upto-month = Month.MonthCode.
 413
 414   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 415     token = ENTRY( i, report-options, "~n" ).
 416     CASE( ENTRY( 1, token ) ):
 417       WHEN "Range" THEN ASSIGN
 418         project-from = INT( ENTRY(2,token) )
 419         project-to   = INT( ENTRY(3,token) ).
 420
 421       WHEN "Summarise" THEN         summarise = Yes.
 422       WHEN "upto" THEN              upto-month = INT( ENTRY(2,token)).
 423       WHEN "From" THEN              from-month = INT( ENTRY(2,token)).
 424       WHEN "Preview" THEN           preview = Yes.
 425     END CASE.
 426   END.
 427   IF project-to < project-from THEN project-to = project-from.
 428
 429   FIND Month WHERE Month.MonthCode = from-month NO-LOCK.
 430   from-date = Month.StartDate.
 431
 432   FIND Month WHERE Month.MonthCode = upto-month NO-LOCK.
 433   upto-date = Month.EndDate.
 434
 435 END PROCEDURE.
 436
 437 /* _UIB-CODE-BLOCK-END */
 438 &ANALYZE-RESUME
 439
 440
 441 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pending-project-header Procedure
 442 PROCEDURE pending-project-header :
 443 /*------------------------------------------------------------------------------
 444   Purpose:
 445 ------------------------------------------------------------------------------*/
 446 DEF INPUT PARAMETER project-code LIKE Project.ProjectCode NO-UNDO.
 447
 448   FIND Project WHERE Project.ProjectCode = project-code NO-LOCK NO-ERROR.
 449   IF NOT AVAILABLE Project THEN RETURN.
 450
 451   DEF VAR entity-name AS CHAR NO-UNDO.
 452   RUN get-entity-name( Project.EntityType, Project.EntityCode, OUTPUT entity-name ).
 453
 454   pending-headers = project-font[1]
 455                   + "(" + STRING( Project.ProjectCode, "99999" ) + ") - "
 456                   + Project.Name + ", " + entity-name
 457                   + line-font + "~n".
 458
 459 END PROCEDURE.
 460
 461 /* _UIB-CODE-BLOCK-END */
 462 &ANALYZE-RESUME
 463
 464
 465 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-line Procedure
 466 PROCEDURE print-line :
 467 /*------------------------------------------------------------------------------
 468   Purpose:
 469 ------------------------------------------------------------------------------*/
 470 DEF INPUT PARAMETER out-line AS CHAR NO-UNDO.
 471
 472   PUT UNFORMATTED out-line.
 473   RUN skip-line(1).
 474
 475 END PROCEDURE.
 476
 477 /* _UIB-CODE-BLOCK-END */
 478 &ANALYZE-RESUME
 479
 480
 481 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-title Procedure
 482 PROCEDURE print-title :
 483 /*------------------------------------------------------------------------------
 484   Purpose:
 485   Parameters:  <none>
 486   Notes:
 487 ------------------------------------------------------------------------------*/
 488
 489   RUN skip-line(2).
 490   PUT CONTROL time-font.
 491   PUT UNFORMATTED
 492     STRING( "Printed: " + now + " for " + user-name, "X(100)" ) SPACE(120)
 493     STRING( "Page: " + STRING( page-no ), "X(20)" ).
 494   RUN skip-line(2).
 495   PUT CONTROL title-font.
 496   PUT UNFORMATTED "Project Orders/Commitments Tracking Report".
 497
 498   FIND FIRST Month NO-LOCK.
 499   IF from-month > Month.MonthCode THEN
 500     PUT UNFORMATTED ", from " STRING( from-date, "99/99/9999").
 501   FIND LAST Month NO-LOCK.
 502   IF upto-month < Month.MonthCode THEN
 503     PUT UNFORMATTED ", up to " STRING( upto-date, "99/99/9999").
 504
 505   RUN skip-line(2).
 506   PUT CONTROL line-font.
 507
 508 END PROCEDURE.
 509
 510 /* _UIB-CODE-BLOCK-END */
 511 &ANALYZE-RESUME
 512
 513
 514 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-totals Procedure
 515 PROCEDURE print-totals :
 516 /*------------------------------------------------------------------------------
 517   Purpose:
 518 ------------------------------------------------------------------------------*/
 519 DEF INPUT PARAMETER title-str AS CHAR NO-UNDO.
 520 DEF INPUT PARAMETER this-total AS DEC NO-UNDO.
 521
 522   RUN print-line( FILL(" ",22) + FILL("-", money-width) ).
 523   RUN print-line( STRING( title-str, "X(22)") + STRING(this-total, money-fmt) ).
 524
 525 END PROCEDURE.
 526
 527 /* _UIB-CODE-BLOCK-END */
 528 &ANALYZE-RESUME
 529
 530
 531 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE project-header Procedure
 532 PROCEDURE project-header :
 533 /*------------------------------------------------------------------------------
 534   Purpose:
 535 ------------------------------------------------------------------------------*/
 536   IF pending-headers = "" THEN RETURN.
 537
 538 DEF VAR i AS INT NO-UNDO.
 539 DEF VAR hdr-line AS CHAR NO-UNDO.
 540
 541   DO WHILE ENTRY( 1, pending-headers, "~n") <> "":
 542     hdr-line = ENTRY( 1, pending-headers, "~n").
 543     pending-headers = SUBSTRING( pending-headers, INDEX( pending-headers, "~n") + 1).
 544     IF hdr-line = ? THEN NEXT.
 545     PUT CONTROL hdr-line.
 546     RUN skip-line(1.5).
 547   END.
 548
 549   pending-headers = "".
 550
 551 END PROCEDURE.
 552
 553 /* _UIB-CODE-BLOCK-END */
 554 &ANALYZE-RESUME
 555
 556
 557 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 558 PROCEDURE reset-page :
 559 /*------------------------------------------------------------------------------
 560   Purpose:
 561   Parameters:  <none>
 562   Notes:
 563 ------------------------------------------------------------------------------*/
 564
 565   PUT CONTROL reset-page.
 566   ln = 0.
 567
 568 END PROCEDURE.
 569
 570 /* _UIB-CODE-BLOCK-END */
 571 &ANALYZE-RESUME
 572
 573
 574 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
 575 PROCEDURE skip-line :
 576 /*------------------------------------------------------------------------------
 577   Purpose:
 578 ------------------------------------------------------------------------------*/
 579 DEF INPUT PARAMETER n AS DEC NO-UNDO.
 580
 581   IF ln + n >= lines-per-page THEN
 582   DO:
 583     RUN page-feed.
 584     RUN page-header.
 585     RETURN.
 586   END.
 587
 588   DEF VAR int-part AS INT NO-UNDO.
 589   DEF VAR dec-part AS DEC NO-UNDO.
 590
 591   int-part = TRUNCATE( n, 0 ).
 592   IF int-part < 0 THEN RETURN.
 593   dec-part = n - int-part.
 594   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 595
 596   IF dec-part <> 0 THEN PUT CONTROL half-line.
 597
 598   IF int-part = 1 THEN PUT UNFORMATTED " " SKIP.
 599   ELSE IF int-part > 1 THEN PUT SKIP(int-part).
 600
 601   ln = ln + n.
 602
 603 END PROCEDURE.
 604
 605 /* _UIB-CODE-BLOCK-END */
 606 &ANALYZE-RESUME
 607
 608
 609 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-to-line Procedure
 610 PROCEDURE skip-to-line :
 611 /*------------------------------------------------------------------------------
 612   Purpose:
 613   Parameters:  <none>
 614   Notes:
 615 ------------------------------------------------------------------------------*/
 616 DEF INPUT PARAMETER line-no AS DEC NO-UNDO.
 617
 618   DEF VAR int-part AS INT NO-UNDO.
 619   DEF VAR dec-part AS DEC NO-UNDO.
 620
 621   int-part = TRUNCATE( line-no - ln, 0 ).
 622   IF int-part < 0 THEN RETURN.
 623   dec-part = ( line-no - ln ) - int-part.
 624   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 625
 626   IF dec-part <> 0 THEN PUT CONTROL half-line.
 627
 628   IF int-part = 1 THEN PUT " " SKIP.
 629   ELSE IF int-part > 1 THEN PUT SKIP( int-part ).
 630
 631   ln = line-no.
 632
 633 END PROCEDURE.
 634
 635 /* _UIB-CODE-BLOCK-END */
 636 &ANALYZE-RESUME
 637
 638
 639 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE summarise-sub-projects Procedure
 640 PROCEDURE summarise-sub-projects :
 641 /*------------------------------------------------------------------------------
 642   Purpose:
 643 ------------------------------------------------------------------------------*/
 644 DEF INPUT PARAMETER project-code LIKE Project.ProjectCode NO-UNDO.
 645
 646 DEF VAR orders AS DEC NO-UNDO.
 647 DEF VAR var-text AS CHAR NO-UNDO.
 648
 649 DEF VAR detail-line AS CHAR NO-UNDO.
 650 DEF BUFFER SubProj FOR Project.
 651
 652   FOR EACH SubProj WHERE SubProj.EntityType = "J"
 653                      AND SubProj.EntityCode = project-code NO-LOCK:
 654     var-text = "Orders for " + SubProj.Name.
 655     orders = sum-project-orders( SubProj.ProjectCode ).
 656
 657     detail-line = FILL( " ", 12)
 658                 + STRING( STRING(SubProj.ProjectCode) + "/sub" , "X(10)")
 659                 + STRING( orders, money-fmt ) + "  "
 660                 + STRING( ENTRY( 1, var-text, "~n"), "X(62)" ) .
 661
 662     IF orders <> 0 THEN DO:
 663       RUN project-header.
 664       RUN print-line( detail-line ).
 665     END.
 666     ptot = ptot + orders.
 667   END.
 668
 669 END PROCEDURE.
 670
 671 /* _UIB-CODE-BLOCK-END */
 672 &ANALYZE-RESUME
 673
 674
 675 /* ************************  Function Implementations ***************** */
 676
 677 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION sum-project-orders Procedure
 678 FUNCTION sum-project-orders RETURNS DECIMAL
 679   ( INPUT project-code AS INT ) :
 680 /*------------------------------------------------------------------------------
 681   Purpose:  Sum orders (or adjustments) up to the upto-date
 682 ------------------------------------------------------------------------------*/
 683 DEF VAR order-total AS DEC NO-UNDO INITIAL 0.
 684
 685 DEF BUFFER SubProj FOR Project.
 686
 687   FOR EACH Order NO-LOCK WHERE Order.ProjectCode = project-code
 688                             AND Order.OrderDate >= from-date
 689                             AND Order.OrderDate <= upto-date:
 690     order-total = order-total + Order.OrderAmount .
 691   END.
 692
 693   FOR EACH SubProj WHERE SubProj.EntityType = "J"
 694                      AND SubProj.EntityCode = project-code NO-LOCK:
 695     order-total = order-total + sum-project-orders( SubProj.ProjectCode ).
 696   END.
 697
 698   RETURN order-total.
 699
 700 END FUNCTION.
 701
 702 /* _UIB-CODE-BLOCK-END */
 703 &ANALYZE-RESUME
 704
 705