process/report/cntrtlst.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 DEF VAR e1 AS INT NO-UNDO INITIAL 0.
   9 DEF VAR e2 AS INT NO-UNDO INITIAL 99999.
  10 DEF VAR preview AS LOGICAL NO-UNDO INITIAL No.
  11 DEF VAR contact-details AS LOGICAL NO-UNDO INITIAL No.
  12 DEF VAR all-contacts AS LOGICAL NO-UNDO INITIAL No.
  13 DEF VAR contract-types AS CHAR NO-UNDO INITIAL "".
  14 DEF VAR export-file AS CHAR NO-UNDO INITIAL "".
  15 DEF VAR page-breaks AS LOGI NO-UNDO INITIAL No.
  16 DEF VAR service-column-first AS LOGI NO-UNDO INITIAL No.
  17 DEF VAR sort-by AS CHAR NO-UNDO.
  18 RUN parse-parameters.
  19
  20 &SCOPED-DEFINE lines-per-page 68
  21
  22 /* totals */
  23 DEF VAR p-annual AS DEC NO-UNDO.
  24 DEF VAR g-annual AS DEC NO-UNDO.
  25 DEF VAR pr-annual AS DEC NO-UNDO.
  26 DEF VAR pnr-annual AS DEC NO-UNDO.
  27 DEF VAR gr-annual AS DEC NO-UNDO.
  28 DEF VAR gnr-annual AS DEC NO-UNDO.
  29
  30 DEF VAR account-code AS DEC NO-UNDO.
  31 DEF VAR need-property-header AS LOGI INITIAL No NO-UNDO.
  32
  33 /* Report counters */
  34 DEF VAR ln AS DEC INIT 0.00 NO-UNDO.
  35
  36 /* Line definitions */
  37
  38 DEF VAR page-no               AS INT INIT 1 NO-UNDO.
  39 DEF VAR reset-page            AS CHAR NO-UNDO.
  40 DEF VAR half-line             AS CHAR NO-UNDO. half-line = CHR(27) + "=".
  41
  42 DEF VAR title-font            AS CHAR NO-UNDO.
  43 DEF VAR time-font             AS CHAR NO-UNDO.
  44 DEF VAR property-font         AS CHAR NO-UNDO.
  45 DEF VAR body-font             AS CHAR NO-UNDO.
  46 DEF VAR header-font           AS CHAR NO-UNDO.
  47 DEF VAR line-font          AS CHAR NO-UNDO.
  48 DEF VAR i AS INT NO-UNDO.
  49
  50 DEF VAR user-name AS CHAR NO-UNDO.
  51
  52 {inc/persndtl.i}
  53
  54 /* _UIB-CODE-BLOCK-END */
  55 &ANALYZE-RESUME
  56
  57
  58 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  59
  60 /* ********************  Preprocessor Definitions  ******************** */
  61
  62 &Scoped-define PROCEDURE-TYPE Procedure
  63
  64
  65
  66 /* _UIB-PREPROCESSOR-BLOCK-END */
  67 &ANALYZE-RESUME
  68
  69
  70 /* ************************  Function Prototypes ********************** */
  71
  72 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD include-contract Procedure
  73 FUNCTION include-contract RETURNS LOGICAL
  74   ( INPUT test-contract AS CHAR )  FORWARD.
  75
  76 /* _UIB-CODE-BLOCK-END */
  77 &ANALYZE-RESUME
  78
  79
  80 /* *********************** Procedure Settings ************************ */
  81
  82 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  83 /* Settings for THIS-PROCEDURE
  84    Type: Procedure
  85    Allow:
  86    Frames: 0
  87    Add Fields to: Neither
  88    Other Settings: CODE-ONLY COMPILE
  89  */
  90 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  91
  92 /* *************************  Create Window  ************************** */
  93
  94 &ANALYZE-SUSPEND _CREATE-WINDOW
  95 /* DESIGN Window definition (used by the UIB)
  96   CREATE WINDOW Procedure ASSIGN
  97          HEIGHT             = .08
  98          WIDTH              = 40.
  99 /* END WINDOW DEFINITION */
 100                                                                         */
 101 &ANALYZE-RESUME
 102
 103
 104
 105 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 106 /* ************************* Included-Libraries *********************** */
 107
 108 {inc/method/m-txtrep.i}
 109 {inc/convert.i}
 110
 111 /* _UIB-CODE-BLOCK-END */
 112 &ANALYZE-RESUME
 113
 114
 115
 116 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 117
 118
 119 /* ***************************  Main Block  *************************** */
 120 {inc/username.i "user-name"}
 121
 122 IF export-file <> "" THEN
 123   txtrep-print-file = export-file.
 124 ELSE DO:
 125   RUN get-control-strings.
 126   RUN output-control-file ( reset-page + line-font ).
 127 END.
 128
 129 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 130
 131 CASE sort-by:
 132   WHEN "Property" THEN      RUN listing-by-property.
 133   WHEN "AccountCode" THEN   RUN listing-by-account.
 134 END CASE.
 135
 136 OUTPUT CLOSE.
 137 IF export-file = "" OR preview THEN
 138   RUN view-output-file ( preview ).
 139 ELSE
 140   MESSAGE "Export of Contract details completed"
 141           VIEW-AS ALERT-BOX INFORMATION
 142           TITLE "Export Complete".
 143
 144 /* _UIB-CODE-BLOCK-END */
 145 &ANALYZE-RESUME
 146
 147
 148 /* **********************  Internal Procedures  *********************** */
 149
 150 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE account-header Procedure
 151 PROCEDURE account-header :
 152 /*------------------------------------------------------------------------------
 153   Purpose:
 154 ------------------------------------------------------------------------------*/
 155   IF need-property-header THEN
 156     RUN property-header.
 157   ELSE IF ln + 4 >= {&lines-per-page} THEN
 158     RUN skip-line(4).
 159
 160   IF NOT preview THEN PUT CONTROL property-font.
 161   IF export-file <> "" THEN PUT UNFORMATTED '"'.
 162   RUN skip-line(1).
 163   IF AVAILABLE(ChartOfAccount) THEN
 164     PUT UNFORMATTED  STRING( ChartOfAccount.AccountCode, "9999.99" ) + ' - ' + ChartOfAccount.Name.
 165   ELSE
 166     PUT UNFORMATTED  STRING( account-code, "9999.99" ) + ' - ' + "not set up in chart of accounts".
 167   IF export-file <> "" THEN PUT UNFORMATTED '"'.
 168   ELSE IF NOT preview THEN PUT CONTROL line-font.
 169   RUN skip-line(1).
 170
 171 END PROCEDURE.
 172
 173 /* _UIB-CODE-BLOCK-END */
 174 &ANALYZE-RESUME
 175
 176
 177 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE column-header Procedure
 178 PROCEDURE column-header :
 179 /*------------------------------------------------------------------------------
 180   Purpose:
 181 ------------------------------------------------------------------------------*/
 182
 183   IF export-file = "" THEN DO:
 184     RUN skip-line(1).
 185     IF NOT( preview OR contact-details ) THEN PUT CONTROL header-font.
 186     IF contact-details AND NOT(preview) THEN PUT CONTROL line-font.
 187     RUN skip-line(1).
 188   END.
 189
 190   IF export-file <> "" THEN DO:
 191     IF contact-details THEN
 192       PUT UNFORMATTED ',"Contractor","Type","Service","Reference"'
 193                                 + (IF all-contacts THEN ',"Type"' ELSE '')
 194                                 + ',"Contact","Phone Numbers","Notes"'.
 195     ELSE
 196       PUT UNFORMATTED ',"Creditor","Type","Service","Rnw","Rec","Start","Review","Period","Amount P.A","Per Period","Description / Reference","Notes"'.
 197   END.
 198   ELSE IF contact-details THEN
 199     PUT UNFORMATTED "Type Service"  SPACE(14)
 200                     "Contractor"   SPACE(22)
 201                     "Reference" SPACE(13)
 202                     "Contact"    SPACE(25)
 203                     "Phone Numbers" SPACE(29)
 204                     "Notes".
 205   ELSE IF preview THEN
 206     PUT UNFORMATTED "Creditor"   SPACE(24)
 207                     "Service"    SPACE(14)
 208                     "Rnw"        SPACE(2)
 209                     "Rec"        SPACE(2)
 210                     "  Start"    SPACE(5)
 211                     "  Review"   SPACE(4)
 212                     "Period"     SPACE(8)
 213                     "Amount P.A" SPACE(2)
 214                     "Per Period" SPACE(2)
 215                     "Description / Reference" SPACE(9)
 216                     "Notes".
 217   ELSE
 218     PUT UNFORMATTED "Creditor"   SPACE(38)
 219                     "Service"    SPACE(19)
 220                     "Renew"      SPACE(1)
 221                     "Rec"        SPACE(3)
 222                     "   Start"    SPACE(8)
 223                     "   Review"   SPACE(7)
 224                     "Period"     SPACE(12)
 225                     "Amount P.A" SPACE(3)
 226                     "Per Period" SPACE(3)
 227                     "Description / Reference" SPACE(16)
 228                     "Notes".
 229
 230   IF export-file = "" AND NOT(preview) THEN PUT CONTROL line-font.
 231   RUN skip-line(2).
 232
 233 END PROCEDURE.
 234
 235 /* _UIB-CODE-BLOCK-END */
 236 &ANALYZE-RESUME
 237
 238
 239 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-account-of-property Procedure
 240 PROCEDURE each-account-of-property :
 241 /*------------------------------------------------------------------------------
 242   Purpose:
 243 ------------------------------------------------------------------------------*/
 244 DEF INPUT PARAMETER recoverable-contracts AS LOGI NO-UNDO.
 245 DEF VAR i AS INT NO-UNDO.
 246
 247   FOR EACH ServiceType NO-LOCK BREAK BY ServiceType.AccountCode:
 248     IF NOT include-contract( ServiceType.ServiceType ) THEN NEXT.
 249     IF FIRST-OF( ServiceType.AccountCode ) THEN DO:
 250       i = 0.
 251       p-annual = 0.
 252       pr-annual = 0.
 253       pnr-annual = 0.
 254     END.
 255
 256     account-code = (IF recoverable-contracts THEN ServiceType.AccountCode ELSE ServiceType.NRAccount).
 257     FIND ChartOfAccount WHERE ChartOfAccount.AccountCode = account-code NO-LOCK NO-ERROR.
 258     FOR EACH Contract NO-LOCK WHERE Contract.PropertyCode = Property.PropertyCode
 259                       AND Contract.ServiceType = ServiceType.ServiceType
 260                       AND Contract.Recoverable = recoverable-contracts,
 261               FIRST Creditor WHERE Creditor.CreditorCode = Contract.CreditorCode
 262                             NO-LOCK BY Creditor.Name:
 263       FIND Property OF Contract NO-LOCK NO-ERROR.
 264       IF NOT AVAILABLE(Property) OR NOT Property.Active THEN NEXT.
 265       i = i + 1.
 266       IF i = 1 THEN RUN account-header.
 267       RUN each-contract.
 268     END.
 269
 270     IF export-file = "" AND NOT(contact-details) AND LAST-OF( ServiceType.AccountCode) AND i > 0 THEN DO:
 271       g-annual = g-annual + p-annual.
 272       gr-annual = gr-annual + pr-annual.
 273       gnr-annual = gnr-annual + pnr-annual.
 274       PUT UNFORMATTED FILL(' ', 98) FILL( '=', 13 ).
 275       RUN skip-line(1).
 276       PUT UNFORMATTED FILL(' ', 98) STRING( p-annual, "->,>>>,>>9.99" ).
 277       p-annual = 0.0 .
 278       RUN skip-line(2).
 279     END.
 280   END.
 281
 282 END PROCEDURE.
 283
 284 /* _UIB-CODE-BLOCK-END */
 285 &ANALYZE-RESUME
 286
 287
 288 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-contract Procedure
 289 PROCEDURE each-contract :
 290 /*------------------------------------------------------------------------------
 291   Purpose:
 292 ------------------------------------------------------------------------------*/
 293   IF contact-details THEN DO:
 294     IF export-file = "" THEN RUN each-contract-contact.
 295                         ELSE RUN export-contract-contact.
 296   END.
 297   ELSE DO:
 298     IF export-file = "" THEN RUN each-contract-normal.
 299                         ELSE RUN export-contract-normal.
 300   END.
 301
 302 END PROCEDURE.
 303
 304 /* _UIB-CODE-BLOCK-END */
 305 &ANALYZE-RESUME
 306
 307
 308 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-contract-contact Procedure
 309 PROCEDURE each-contract-contact :
 310 /*------------------------------------------------------------------------------
 311   Purpose:
 312 ------------------------------------------------------------------------------*/
 313
 314 DEF VAR nl          AS INT  NO-UNDO.
 315 DEF VAR i           AS INT  NO-UNDO.
 316 DEF VAR c-name      AS CHAR NO-UNDO.
 317 DEF VAR c-note      AS CHAR NO-UNDO INITIAL "".
 318 DEF VAR c-desc      AS CHAR NO-UNDO.
 319 DEF VAR p-name      AS CHAR NO-UNDO INITIAL "".
 320 DEF VAR phones      AS CHAR NO-UNDO INITIAL "".
 321 DEF VAR this-ph     AS CHAR NO-UNDO INITIAL "".
 322 DEF VAR this-nm     AS CHAR NO-UNDO INITIAL "".
 323 DEF VAR ph-lines AS INT NO-UNDO.
 324 DEF VAR nm-lines AS INT NO-UNDO.
 325
 326   FIND ServiceType   OF Contract NO-LOCK NO-ERROR.
 327   FIND Note          OF Contract NO-LOCK NO-ERROR.
 328
 329   IF all-contacts THEN DO:
 330     p-name = "".
 331     phones = "".
 332     FOR EACH EntityContact WHERE EntityContact.EntityType = "C"
 333                            AND EntityContact.EntityCode = Creditor.CreditorCode NO-LOCK,
 334             FIRST Person OF EntityContact NO-LOCK:
 335       this-ph = WRAP( get-phone-nos( Person.PersonCode ), 40).
 336       this-nm = WRAP( combine-name( "", Person.FirstName, "", Person.LastName, "")
 337                       + " (" + EntityContact.EntityContactType + ")", 30).
 338       ph-lines = NUM-ENTRIES( this-ph, "~n").
 339       nm-lines = NUM-ENTRIES( this-nm, "~n").
 340       phones = phones + (IF p-name <> "" THEN "~n" ELSE "") /* note use of p-name! */
 341              + this-ph + FILL( "~n", MAX( 0, nm-lines - ph-lines)).
 342       p-name = p-name + (IF p-name <> "" THEN "~n" ELSE "")
 343              + this-nm + FILL( "~n", MAX( 0, ph-lines - nm-lines)).
 344     END.
 345   END.
 346   ELSE DO:
 347     FIND Person WHERE Person.PersonCode = Creditor.PaymentContact NO-LOCK NO-ERROR.
 348     IF AVAILABLE(Person) THEN DO:
 349       p-name = WRAP( combine-name( "", Person.FirstName, "", Person.LastName, ""), 30).
 350       phones = WRAP( get-phone-nos( Person.PersonCode ), 40).
 351     END.
 352   END.
 353
 354   RUN word-wrap( Creditor.Name, 30, OUTPUT c-name ).
 355   IF AVAILABLE Note THEN RUN word-wrap( Note.Details, 40, OUTPUT c-note ).
 356   RUN word-wrap( Contract.ContractReference, 20, OUTPUT c-desc ).
 357
 358   nl = MAX( NUM-ENTRIES( c-name, "~n" ), NUM-ENTRIES( c-note, "~n" ), NUM-ENTRIES( c-desc, "~n"),
 359             NUM-ENTRIES( p-name, "~n" ), NUM-ENTRIES( phones, "~n" ) ).
 360   c-name = c-name + FILL( "~n", nl - NUM-ENTRIES( c-name, "~n" ) ).
 361   c-note = c-note + FILL( "~n", nl - NUM-ENTRIES( c-note, "~n" ) ).
 362   c-desc = c-desc + FILL( "~n", nl - NUM-ENTRIES( c-desc, "~n" ) ).
 363   p-name = p-name + FILL( "~n", nl - NUM-ENTRIES( p-name, "~n" ) ).
 364   phones = phones + FILL( "~n", nl - NUM-ENTRIES( phones, "~n" ) ).
 365
 366   RUN skip-line( IF preview THEN 1 ELSE 0.5 ).
 367
 368   DO i = 1 TO nl:
 369     PUT UNFORMATTED
 370       STRING( IF i = 1 THEN Contract.ServiceType ELSE "", "X(4)" ) SPACE(1)
 371       STRING( IF i = 1 AND AVAILABLE ServiceType
 372         THEN ServiceType.Description
 373         ELSE "", "X(19)" )                                  SPACE(2)
 374       STRING( ENTRY( i, c-name, "~n" ), "X(30)" )           SPACE(2)
 375       STRING( ENTRY( i, c-desc, "~n" ),  "X(20)" )          SPACE(2)
 376       STRING( ENTRY( i, p-name, "~n" ),  "X(30)" )          SPACE(2)
 377       STRING( ENTRY( i, phones, "~n" ),  "X(40)" )          SPACE(2)
 378       STRING( ENTRY( i, c-note, "~n" ),  "X(40)" ).
 379     RUN skip-line(1).
 380   END.
 381
 382 END PROCEDURE.
 383
 384 /* _UIB-CODE-BLOCK-END */
 385 &ANALYZE-RESUME
 386
 387
 388 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-contract-normal Procedure
 389 PROCEDURE each-contract-normal :
 390 /*------------------------------------------------------------------------------
 391   Purpose:
 392 ------------------------------------------------------------------------------*/
 393
 394 DEF VAR nl          AS INT  NO-UNDO.
 395 DEF VAR i           AS INT  NO-UNDO.
 396 DEF VAR c-name      AS CHAR NO-UNDO.
 397 DEF VAR c-note      AS CHAR NO-UNDO.
 398 DEF VAR c-desc      AS CHAR NO-UNDO.
 399 DEF VAR c-start     AS CHAR NO-UNDO.
 400 DEF VAR c-review    AS CHAR NO-UNDO.
 401 DEF VAR period-cost AS DEC  NO-UNDO.
 402 DEF VAR fraction    AS DEC  NO-UNDO.
 403
 404   FIND ServiceType   OF Contract NO-LOCK NO-ERROR.
 405   FIND FrequencyType OF Contract NO-LOCK NO-ERROR.
 406   FIND Note          OF Contract NO-LOCK NO-ERROR.
 407
 408   RUN word-wrap( Creditor.Name, 30, OUTPUT c-name ).
 409   IF AVAILABLE Note THEN
 410     RUN word-wrap( Note.Details, 30, OUTPUT c-note ).
 411   RUN word-wrap( Contract.ContractReference, 30, OUTPUT c-desc ).
 412
 413   nl = MAX( NUM-ENTRIES( c-name, "~n" ), NUM-ENTRIES( c-note, "~n" ), NUM-ENTRIES( c-desc, "~n") ).
 414   c-name = c-name + FILL( "~n", nl - NUM-ENTRIES( c-name, "~n" ) ).
 415   c-note = c-note + FILL( "~n", nl - NUM-ENTRIES( c-note, "~n" ) ).
 416   c-desc = c-desc + FILL( "~n", nl - NUM-ENTRIES( c-desc, "~n" ) ).
 417
 418   /* Calculate the period cost */
 419   RUN process/calcfreq.p( Contract.FrequencyCode, OUTPUT fraction ).
 420   period-cost = Contract.AnnualEstimate * fraction.
 421   p-annual = p-annual + Contract.AnnualEstimate.
 422   IF ( Contract.Recoverable ) THEN
 423     pr-annual = pr-annual + Contract.AnnualEstimate.
 424   ELSE
 425     pnr-annual = pnr-annual + Contract.AnnualEstimate.
 426
 427   c-start  = STRING( Contract.StartDate, "99/99/9999").
 428   IF c-start = ? THEN c-start = "".
 429   c-review = STRING( Contract.ReviewDate, "99/99/9999").
 430   IF c-review = ? THEN c-review = "".
 431
 432   RUN skip-line( IF preview THEN 1 ELSE 0.5 ).
 433
 434   DO i = 1 TO nl:
 435     PUT UNFORMATTED
 436       STRING( ENTRY( i, c-name, "~n" ), "X(30)" )           SPACE(2)
 437       STRING( IF i = 1 AND AVAILABLE ServiceType
 438         THEN ServiceType.Description
 439         ELSE "", "X(19)" )                                  SPACE(2)
 440       STRING( IF i <> 1 THEN "" ELSE
 441         STRING( Contract.Renewing, "Yes/No" ), "X(3)" )     SPACE(2)
 442       STRING( IF i <> 1 THEN "" ELSE
 443         STRING( Contract.Recoverable, "Yes/No" ), "X(3)" )  SPACE(2)
 444       STRING( IF i <> 1 THEN "" ELSE c-start, "X(10)" )     SPACE(2)
 445       STRING( IF i <> 1 THEN "" ELSE c-review, "X(10)" )    SPACE(2)
 446       STRING( IF i = 1 AND AVAILABLE FrequencyType
 447         THEN FrequencyType.Description
 448         ELSE "", "X(12)" )                                  SPACE(1)
 449       STRING( IF i <> 1 THEN "" ELSE
 450         STRING( Contract.AnnualEstimate, "->>>,>>9.99" ), "X(11)" ) SPACE(1)
 451       STRING( IF i <> 1 THEN "" ELSE
 452         STRING( period-cost, "->>>,>>9.99" ), "X(11)" )      SPACE(2)
 453       STRING( ENTRY( i, c-desc, "~n" ),  "X(30)" )          SPACE(2)
 454       STRING( ENTRY( i, c-note, "~n" ),  "X(30)" ).
 455     RUN skip-line(1).
 456   END.
 457
 458 END PROCEDURE.
 459
 460 /* _UIB-CODE-BLOCK-END */
 461 &ANALYZE-RESUME
 462
 463
 464 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-property Procedure
 465 PROCEDURE each-property :
 466 /*------------------------------------------------------------------------------
 467   Purpose:
 468 ------------------------------------------------------------------------------*/
 469 DEF VAR i AS INT NO-UNDO.
 470
 471   i = 0.
 472   p-annual = 0.
 473   pr-annual = 0.
 474   pnr-annual = 0.
 475
 476   FOR EACH Contract NO-LOCK WHERE Contract.PropertyCode = Property.PropertyCode
 477                         AND Contract.ServiceType <> "ESTM" ,
 478             FIRST Creditor NO-LOCK WHERE Creditor.CreditorCode = Contract.CreditorCode
 479             BY Property.PropertyCode BY Contract.ServiceType BY Creditor.Name:
 480     IF NOT include-contract( Contract.ServiceType ) THEN NEXT.
 481     i = i + 1.
 482     IF i = 1 THEN RUN property-header.
 483     RUN each-contract.
 484   END.
 485
 486   IF i > 0 AND export-file <> "" THEN RUN skip-line(1).
 487   IF contact-details OR export-file <> "" THEN RETURN.
 488
 489   g-annual = g-annual + p-annual.
 490   gr-annual = gr-annual + pr-annual.
 491   gnr-annual = gnr-annual + pnr-annual.
 492
 493   IF i > 0 THEN DO:
 494     PUT UNFORMATTED FILL(' ', 100) FILL( '=', 11 ).
 495     RUN skip-line(1).
 496     PUT UNFORMATTED FILL(' ', 62)
 497         STRING( pr-annual, "->,>>>,>>9.99" ) "(Rec)"
 498         STRING( pnr-annual, "->,>>>,>>9.99" ) "(N/R)"
 499         STRING( p-annual, "->,>>>,>>9.99" ).
 500     RUN skip-line(2).
 501   END.
 502
 503 END PROCEDURE.
 504
 505 /* _UIB-CODE-BLOCK-END */
 506 &ANALYZE-RESUME
 507
 508
 509 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE export-contract-contact Procedure
 510 PROCEDURE export-contract-contact :
 511 /*------------------------------------------------------------------------------
 512   Purpose:
 513 ------------------------------------------------------------------------------*/
 514
 515 DEF VAR c-name      AS CHAR NO-UNDO.
 516 DEF VAR c-note      AS CHAR NO-UNDO INITIAL "".
 517 DEF VAR c-desc      AS CHAR NO-UNDO.
 518 DEF VAR p-name      AS CHAR NO-UNDO INITIAL "".
 519 DEF VAR phones      AS CHAR NO-UNDO INITIAL "".
 520
 521
 522   FIND ServiceType   OF Contract NO-LOCK NO-ERROR.
 523   FIND Note          OF Contract NO-LOCK NO-ERROR.
 524
 525   c-name = Creditor.Name.
 526   IF AVAILABLE Note THEN c-note = Note.Details.
 527   c-desc = Contract.ContractReference.
 528
 529   IF all-contacts THEN DO:
 530     p-name = "".
 531     phones = "".
 532     FOR EACH EntityContact WHERE EntityContact.EntityType = "C"
 533                            AND EntityContact.EntityCode = Creditor.CreditorCode NO-LOCK,
 534             FIRST Person OF EntityContact NO-LOCK:
 535       p-name = get-phone-nos( Person.PersonCode ).
 536       phones = combine-name( "", Person.FirstName, "", Person.LastName, "").
 537       PUT UNFORMATTED ',"' c-name '",'
 538                       '"' Contract.ServiceType '",'
 539                       '"' (IF AVAILABLE(ServiceType) THEN ServiceType.Description ELSE "") '",'
 540                       '"' c-desc '",'
 541                       '"' EntityContact.EntityContactType '",'
 542                       '"' p-name '",'
 543                       '"' phones '",'
 544                       '"' c-note '"'
 545                       SKIP.
 546
 547     END.
 548   END.
 549   ELSE DO:
 550     FIND Person WHERE Person.PersonCode = Creditor.PaymentContact NO-LOCK NO-ERROR.
 551     IF AVAILABLE(Person) THEN DO:
 552       p-name = combine-name( "", Person.FirstName, "", Person.LastName, "").
 553       phones = get-phone-nos( Person.PersonCode ).
 554     END.
 555     PUT UNFORMATTED ',"' c-name '",'
 556                     '"' Contract.ServiceType '",'
 557                     '"' (IF AVAILABLE(ServiceType) THEN ServiceType.Description ELSE "") '",'
 558                     '"' c-desc '",'
 559                     '"' p-name '",'
 560                     '"' phones '",'
 561                     '"' c-note '"'
 562                     SKIP.
 563   END.
 564
 565
 566 END PROCEDURE.
 567
 568 /* _UIB-CODE-BLOCK-END */
 569 &ANALYZE-RESUME
 570
 571
 572 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE export-contract-normal Procedure
 573 PROCEDURE export-contract-normal :
 574 /*------------------------------------------------------------------------------
 575   Purpose:
 576 ------------------------------------------------------------------------------*/
 577
 578 DEF VAR c-name      AS CHAR NO-UNDO.
 579 DEF VAR c-note      AS CHAR NO-UNDO.
 580 DEF VAR c-desc      AS CHAR NO-UNDO.
 581 DEF VAR c-start     AS CHAR NO-UNDO.
 582 DEF VAR c-review    AS CHAR NO-UNDO.
 583 DEF VAR period-cost AS DEC  NO-UNDO.
 584 DEF VAR fraction    AS DEC  NO-UNDO.
 585
 586   FIND ServiceType   OF Contract NO-LOCK NO-ERROR.
 587   FIND FrequencyType OF Contract NO-LOCK NO-ERROR.
 588   FIND Note          OF Contract NO-LOCK NO-ERROR.
 589
 590   c-name = Creditor.Name.
 591   IF AVAILABLE Note THEN c-note = Note.Details.
 592   c-desc = Contract.ContractReference.
 593
 594   /* Calculate the period cost */
 595   RUN process/calcfreq.p( Contract.FrequencyCode, OUTPUT fraction ).
 596   period-cost = Contract.AnnualEstimate * fraction.
 597   p-annual = p-annual + Contract.AnnualEstimate.
 598   IF ( Contract.Recoverable ) THEN
 599     pr-annual = pr-annual + Contract.AnnualEstimate.
 600   ELSE
 601     pnr-annual = pnr-annual + Contract.AnnualEstimate.
 602
 603   c-start  = STRING( Contract.StartDate, "99/99/9999").
 604   IF c-start = ? THEN c-start = "".
 605   c-review = STRING( Contract.ReviewDate, "99/99/9999").
 606   IF c-review = ? THEN c-review = "".
 607
 608   PUT UNFORMATTED ',"' c-name '",'
 609                   '"' Contract.ServiceType '",'
 610                   '"' (IF AVAILABLE(ServiceType) THEN ServiceType.Description ELSE "") '",'
 611                   '"' STRING( Contract.Renewing, "Yes/No" ) '",'
 612                   '"' STRING( Contract.Recoverable, "Yes/No" ) '",'
 613                   '"' c-start '",'
 614                   '"' c-review '",'
 615                   '"' (IF AVAILABLE(FrequencyType) THEN FrequencyType.Description ELSE "") '",'
 616                   TRIM(STRING( Contract.AnnualEstimate, "->>>>>>>>9.99" )) ','
 617                   TRIM(STRING( period-cost, "->>>>>>>>9.99" )) ','
 618                   '"' c-desc '",'
 619                   '"' c-note '"'
 620                   SKIP.
 621
 622 END PROCEDURE.
 623
 624 /* _UIB-CODE-BLOCK-END */
 625 &ANALYZE-RESUME
 626
 627
 628 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 629 PROCEDURE get-control-strings :
 630 /*------------------------------------------------------------------------------
 631   Purpose:     Get all control strings for this report
 632 ------------------------------------------------------------------------------*/
 633
 634   IF export-file <> "" THEN RETURN.
 635
 636 DEF VAR rows AS DEC NO-UNDO.
 637 DEF VAR cols AS DEC NO-UNDO.
 638
 639   RUN make-control-string ( "PCL", "reset,landscape,a4,tm,0,lm,4",
 640                   OUTPUT reset-page, OUTPUT rows, OUTPUT cols ).
 641
 642   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,12",
 643                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 644
 645   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,6",
 646                   OUTPUT time-font, OUTPUT rows, OUTPUT cols ).
 647
 648   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,8",
 649                   OUTPUT header-font, OUTPUT rows, OUTPUT cols ).
 650
 651   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 652                   OUTPUT property-font, OUTPUT rows, OUTPUT cols ).
 653
 654   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,8",
 655                   OUTPUT body-font, OUTPUT rows, OUTPUT cols ).
 656
 657   RUN make-control-string ( "PCL", "fixed,courier,cpi,18,lpi,10,normal",
 658                   OUTPUT line-font, OUTPUT rows, OUTPUT cols ).
 659
 660 END PROCEDURE.
 661
 662 /* _UIB-CODE-BLOCK-END */
 663 &ANALYZE-RESUME
 664
 665
 666 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE listing-by-account Procedure
 667 PROCEDURE listing-by-account :
 668 /*------------------------------------------------------------------------------
 669   Purpose:
 670 ------------------------------------------------------------------------------*/
 671   FOR EACH Property NO-LOCK WHERE Property.PropertyCode >= e1
 672                             AND Property.PropertyCode <= e2
 673                             AND Property.Active
 674                             AND NOT Property.ExternallyManaged:
 675
 676     g-annual = 0.
 677     gr-annual = 0.
 678     gnr-annual = 0.
 679     need-property-header = Yes.
 680
 681     RUN each-account-of-property(Yes).
 682     RUN each-account-of-property(No).
 683
 684     IF NOT need-property-header THEN DO:
 685       RUN skip-line(1).
 686       IF export-file = "" AND NOT(contact-details) THEN DO:
 687         PUT UNFORMATTED FILL(' ', 100) FILL( '=', 11 ).
 688         RUN skip-line(1).
 689         PUT UNFORMATTED FILL(' ', 64)
 690             STRING( gr-annual, "->>>,>>9.99" ) "(Rec)" FILL( ' ', 2 )
 691             STRING( gnr-annual, "->>>,>>9.99" ) "(N/R)" FILL ( ' ', 2 )
 692             STRING( g-annual, "->>>,>>9.99" ).
 693         RUN skip-line(1).
 694       END.
 695       RUN page-feed.
 696     END.
 697
 698   END.
 699
 700 END PROCEDURE.
 701
 702 /* _UIB-CODE-BLOCK-END */
 703 &ANALYZE-RESUME
 704
 705
 706 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE listing-by-property Procedure
 707 PROCEDURE listing-by-property :
 708 /*------------------------------------------------------------------------------
 709   Purpose:
 710 ------------------------------------------------------------------------------*/
 711
 712   RUN page-header.
 713
 714   g-annual = 0.
 715   gr-annual = 0.
 716   gnr-annual = 0.
 717   FOR EACH Property NO-LOCK WHERE Property.PropertyCode >= e1
 718                             AND Property.PropertyCode <= e2
 719                             AND Property.Active
 720                             AND NOT Property.ExternallyManaged:
 721     RUN each-property.
 722   END.
 723
 724   IF NOT(contact-details) AND g-annual <> p-annual THEN DO:
 725     RUN skip-line(1).
 726     PUT UNFORMATTED FILL(' ', 100) FILL( '=', 11 ).
 727     RUN skip-line(1).
 728     PUT UNFORMATTED FILL(' ', 62)
 729         STRING( gr-annual, "->,>>>,>>9.99" ) "(Rec)"
 730         STRING( gnr-annual, "->,>>>,>>9.99" ) "(N/R)"
 731         STRING( g-annual, "->,>>>,>>9.99" ).
 732     RUN skip-line(1).
 733   END.
 734
 735   RUN page-feed.
 736
 737 END PROCEDURE.
 738
 739 /* _UIB-CODE-BLOCK-END */
 740 &ANALYZE-RESUME
 741
 742
 743 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 744 PROCEDURE page-feed :
 745 /*------------------------------------------------------------------------------
 746   Purpose:
 747 ------------------------------------------------------------------------------*/
 748
 749   IF export-file <> "" THEN RETURN.
 750
 751   page-no = page-no + 1.
 752   PUT CONTROL CHR(12).
 753   ln = 0.
 754
 755 END PROCEDURE.
 756
 757 /* _UIB-CODE-BLOCK-END */
 758 &ANALYZE-RESUME
 759
 760
 761 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 762 PROCEDURE page-header :
 763 /*------------------------------------------------------------------------------
 764   Purpose:
 765 ------------------------------------------------------------------------------*/
 766
 767   RUN print-title.
 768   RUN column-header.
 769
 770 END PROCEDURE.
 771
 772 /* _UIB-CODE-BLOCK-END */
 773 &ANALYZE-RESUME
 774
 775
 776 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 777 PROCEDURE parse-parameters :
 778 /*------------------------------------------------------------------------------
 779   Purpose:  Parse the command line
 780 ------------------------------------------------------------------------------*/
 781 DEF VAR report-style AS CHAR NO-UNDO.
 782 DEF VAR token AS CHAR NO-UNDO.
 783 DEF VAR i AS INT NO-UNDO.
 784
 785 {inc/showopts.i "report-options"}
 786
 787   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 788     token = ENTRY( i, report-options, "~n" ).
 789
 790     CASE ENTRY( 1, token ):
 791       WHEN "Preview" THEN           preview = Yes.
 792       WHEN "ContactDetails" THEN    contact-details = Yes.
 793       WHEN "AllContacts" THEN       all-contacts = Yes.
 794       WHEN "PageBreaks" THEN        page-breaks = Yes.
 795       WHEN "ServiceFirst" THEN      service-column-first = Yes.
 796       WHEN "Style" THEN             report-style = ENTRY( 2, token).
 797       WHEN "Entity1" THEN           e1 = INT(ENTRY( 2, token )).
 798       WHEN "Entity2" THEN           e2 = INT(ENTRY( 2, token )).
 799       WHEN "Export" THEN            export-file = SUBSTRING( token, INDEX( token, ",") + 1).
 800       WHEN "ContractTypes" THEN     contract-types = SUBSTRING( token, INDEX( token, ",") + 1).
 801       WHEN "SortBy" THEN            sort-by = ENTRY( 2, token ).
 802     END CASE.
 803   END.
 804
 805   IF report-style = "A" THEN ASSIGN         e1 = 0      e2 = 99999  .   /* all */
 806   ELSE IF report-style = "1" THEN ASSIGN    e2 = e1 .                   /* one */
 807
 808 END PROCEDURE.
 809
 810 /* _UIB-CODE-BLOCK-END */
 811 &ANALYZE-RESUME
 812
 813
 814 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-title Procedure
 815 PROCEDURE print-title :
 816 /*------------------------------------------------------------------------------
 817   Purpose:
 818 ------------------------------------------------------------------------------*/
 819   IF export-file <> "" THEN RETURN.
 820
 821   IF NOT preview THEN PUT CONTROL line-font.
 822   RUN skip-line(2).
 823   IF NOT preview THEN PUT CONTROL time-font.
 824   PUT UNFORMATTED
 825     STRING( "Printed: " + STRING( TODAY, "99/99/9999" ) + " " +
 826                     STRING( TIME, "HH:MM:SS" ) + " for " + user-name,
 827             "X(180)" )
 828     STRING( "Page: " + STRING( page-no ), "X(10)" ).
 829   RUN skip-line(2).
 830   IF NOT preview THEN PUT CONTROL title-font.
 831   PUT UNFORMATTED SPACE(60) "Service Contracts Listing".
 832   RUN skip-line(1).
 833   IF NOT preview THEN PUT CONTROL line-font.
 834
 835 END PROCEDURE.
 836
 837 /* _UIB-CODE-BLOCK-END */
 838 &ANALYZE-RESUME
 839
 840
 841 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE property-header Procedure
 842 PROCEDURE property-header :
 843 /*------------------------------------------------------------------------------
 844   Purpose:
 845 ------------------------------------------------------------------------------*/
 846
 847   IF sort-by = "AccountCode" THEN RUN page-header.
 848
 849   IF ln > 10 THEN DO:
 850     IF contact-details AND page-breaks THEN
 851       RUN skip-line( {&lines-per-page} - 2 ).
 852     ELSE IF contact-details THEN
 853       RUN skip-line( 2 ).
 854
 855     IF ln + 4 >= {&lines-per-page} THEN
 856       RUN skip-line(4).
 857   END.
 858
 859   IF export-file <> "" THEN PUT UNFORMATTED '"'.
 860   ELSE IF NOT preview THEN PUT CONTROL property-font.
 861   PUT UNFORMATTED  STRING( Property.PropertyCode, "9999" ) + ' - ' + Property.Name.
 862   IF export-file <> "" THEN PUT UNFORMATTED '"'.
 863   ELSE IF NOT preview THEN PUT CONTROL line-font.
 864   RUN skip-line(1.5).
 865   need-property-header = No.
 866
 867 END PROCEDURE.
 868
 869 /* _UIB-CODE-BLOCK-END */
 870 &ANALYZE-RESUME
 871
 872
 873 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 874 PROCEDURE reset-page :
 875 /*------------------------------------------------------------------------------
 876   Purpose:
 877   Parameters:  <none>
 878   Notes:
 879 ------------------------------------------------------------------------------*/
 880
 881   PUT CONTROL reset-page.
 882
 883 END PROCEDURE.
 884
 885 /* _UIB-CODE-BLOCK-END */
 886 &ANALYZE-RESUME
 887
 888
 889 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
 890 PROCEDURE skip-line :
 891 /*------------------------------------------------------------------------------
 892   Purpose:
 893   Parameters:  <none>
 894   Notes:
 895 ------------------------------------------------------------------------------*/
 896
 897   DEF INPUT PARAMETER n AS DEC NO-UNDO.
 898
 899   IF ln + n >= {&lines-per-page} THEN DO:
 900     RUN page-feed.
 901     RUN page-header.
 902     RETURN.
 903   END.
 904
 905   DEF VAR int-part AS INT NO-UNDO.
 906   DEF VAR dec-part AS DEC NO-UNDO.
 907
 908   int-part = TRUNCATE( n, 0 ).
 909   IF int-part < 0 THEN RETURN.
 910   dec-part = n - int-part.
 911   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 912
 913   /* Need to have this like the following - do not touch */
 914   IF int-part = 1 THEN
 915     PUT " " SKIP.
 916   ELSE IF int-part > 1 THEN
 917     PUT SKIP(int-part).
 918
 919   IF export-file <> "" THEN RETURN.
 920
 921   IF dec-part <> 0 THEN PUT CONTROL half-line.
 922
 923   ln = ln + n.
 924
 925 END PROCEDURE.
 926
 927 /* _UIB-CODE-BLOCK-END */
 928 &ANALYZE-RESUME
 929
 930
 931 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-to-line Procedure
 932 PROCEDURE skip-to-line :
 933 /*------------------------------------------------------------------------------
 934   Purpose:
 935   Parameters:  <none>
 936   Notes:
 937 ------------------------------------------------------------------------------*/
 938
 939   DEF INPUT PARAMETER line-no 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( line-no - ln, 0 ).
 945   IF int-part < 0 THEN RETURN.
 946   dec-part = ( line-no - ln ) - int-part.
 947   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 948
 949   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 950   IF dec-part <> 0 THEN PUT CONTROL half-line.
 951
 952   ln = line-no.
 953
 954   RUN carriage-return.
 955
 956 END PROCEDURE.
 957
 958 /* _UIB-CODE-BLOCK-END */
 959 &ANALYZE-RESUME
 960
 961
 962 /* ************************  Function Implementations ***************** */
 963
 964 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION include-contract Procedure
 965 FUNCTION include-contract RETURNS LOGICAL
 966   ( INPUT test-contract AS CHAR ) :
 967 /*------------------------------------------------------------------------------
 968   Purpose:
 969     Notes:
 970 ------------------------------------------------------------------------------*/
 971   IF contract-types = "" THEN RETURN Yes.
 972
 973   RETURN LOOKUP( test-contract, contract-types ) > 0 .
 974
 975 END FUNCTION.
 976
 977 /* _UIB-CODE-BLOCK-END */
 978 &ANALYZE-RESUME
 979
 980