process/report/rentrevw.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r11
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        :
   6     Purpose     :
   7
   8     Syntax      :
   9
  10     Description :
  11
  12     Author(s)   :
  13     Created     :
  14     Notes       :
  15   ------------------------------------------------------------------------*/
  16
  17 DEF INPUT PARAMETER date-to AS DATE NO-UNDO.
  18
  19 &SCOPED-DEFINE lines-per-page 112
  20
  21 /* Report counters */
  22 DEF VAR ln AS DEC INIT 0.00 NO-UNDO.
  23
  24 /* Line definitions */
  25
  26 DEF VAR page-no               AS INT INIT 1 NO-UNDO.
  27 DEF VAR reset-page            AS CHAR NO-UNDO.
  28 DEF VAR half-line             AS CHAR NO-UNDO. half-line = CHR(27) + "=".
  29 DEF VAR title-font            AS CHAR NO-UNDO.
  30 DEF VAR time-font             AS CHAR NO-UNDO.
  31 DEF VAR rent-review-font      AS CHAR NO-UNDO.
  32 DEF VAR header-font           AS CHAR NO-UNDO.
  33 DEF VAR line-printer          AS CHAR NO-UNDO.
  34 DEF VAR i AS INT NO-UNDO.
  35
  36 DEF VAR area-tot AS DEC INITIAL 0.00 NO-UNDO.
  37 DEF VAR chrg-tot AS DEC INITIAL 0.00 NO-UNDO.
  38 DEF VAR erv-tot  AS DEC INITIAL 0.00 NO-UNDO.
  39
  40 DEF VAR g-area-tot AS DEC INITIAL 0.00 NO-UNDO.
  41 DEF VAR g-chrg-tot AS DEC INITIAL 0.00 NO-UNDO.
  42 DEF VAR g-erv-tot  AS DEC INITIAL 0.00 NO-UNDO.
  43
  44 DEF VAR user-name AS CHAR NO-UNDO.
  45 {inc/username.i "user-name"}
  46
  47 /* _UIB-CODE-BLOCK-END */
  48 &ANALYZE-RESUME
  49
  50
  51 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  52
  53 /* ********************  Preprocessor Definitions  ******************** */
  54
  55 &Scoped-define PROCEDURE-TYPE Procedure
  56
  57
  58
  59 /* _UIB-PREPROCESSOR-BLOCK-END */
  60 &ANALYZE-RESUME
  61
  62
  63
  64 /* *********************** Procedure Settings ************************ */
  65
  66 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  67 /* Settings for THIS-PROCEDURE
  68    Type: Procedure
  69    Allow:
  70    Frames: 0
  71    Add Fields to: Neither
  72    Other Settings: CODE-ONLY COMPILE
  73  */
  74 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  75
  76 /* *************************  Create Window  ************************** */
  77
  78 &ANALYZE-SUSPEND _CREATE-WINDOW
  79 /* DESIGN Window definition (used by the UIB)
  80   CREATE WINDOW Procedure ASSIGN
  81          HEIGHT             = .07
  82          WIDTH              = 40.
  83                                                                         */
  84 &ANALYZE-RESUME
  85
  86
  87
  88 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
  89 /* ************************* Included-Libraries *********************** */
  90
  91 {inc/method/m-txtrep.i}
  92 {inc/convert.i}
  93
  94 /* _UIB-CODE-BLOCK-END */
  95 &ANALYZE-RESUME
  96
  97
  98
  99 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 100
 101
 102 /* ***************************  Main Block  *************************** */
 103
 104 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 105
 106 RUN rent-reviews.
 107
 108 OUTPUT CLOSE.
 109 RUN view-output-file ( no ).
 110
 111 /* _UIB-CODE-BLOCK-END */
 112 &ANALYZE-RESUME
 113
 114
 115 /* **********************  Internal Procedures  *********************** */
 116
 117 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE carriage-return Procedure
 118 PROCEDURE carriage-return :
 119 /*------------------------------------------------------------------------------
 120   Purpose:
 121   Parameters:  <none>
 122   Notes:
 123 ------------------------------------------------------------------------------*/
 124
 125   PUT CONTROL CHR(13).
 126
 127 END PROCEDURE.
 128
 129 /* _UIB-CODE-BLOCK-END */
 130 &ANALYZE-RESUME
 131
 132
 133 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE column-header Procedure
 134 PROCEDURE column-header :
 135 /*------------------------------------------------------------------------------
 136   Purpose:
 137   Parameters:  <none>
 138   Notes:
 139 ------------------------------------------------------------------------------*/
 140
 141   PUT CONTROL line-printer.
 142   RUN skip-line(2).
 143   PUT CONTROL header-font.
 144   PUT UNFORMATTED
 145     STRING( "Date Due", "X(10)" ) SPACE(4)
 146     STRING( "Space Description", "X(60)" ) SPACE(6)
 147     STRING( "Area SQ.M", "X(10)" ) SPACE(8)
 148     STRING( "Estimated Rental Value", "X(22)" ) SPACE(18)
 149     STRING( "Current Rental", "X(20)" ).
 150   PUT CONTROL line-printer.
 151   RUN skip-line(1.5).
 152   PUT CONTROL header-font.
 153   PUT UNFORMATTED
 154     SPACE(130)
 155     STRING( "$", "X" ) SPACE(10)
 156     STRING( "$/Sq M", "X(6)" ) SPACE(18)
 157     STRING( "$", "X" ) SPACE(10)
 158     STRING( "$/Sq M", "X(6)" ).
 159   PUT CONTROL line-printer.
 160   RUN skip-line(3).
 161
 162 END PROCEDURE.
 163
 164 /* _UIB-CODE-BLOCK-END */
 165 &ANALYZE-RESUME
 166
 167
 168 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-rent-review Procedure
 169 PROCEDURE each-rent-review :
 170 /*------------------------------------------------------------------------------
 171   Purpose:
 172   Parameters:  <none>
 173   Notes:
 174 ------------------------------------------------------------------------------*/
 175
 176   DEF VAR i AS INT NO-UNDO.
 177   RUN rent-review-header.
 178   RUN reset-totals.
 179
 180   i = 0.
 181   FOR EACH RentalSpace OF TenancyLease NO-LOCK:
 182     i = i + 1.
 183     RUN each-rental-space.
 184   END.
 185
 186   IF i > 1 THEN RUN rent-review-footer.
 187   RUN skip-line(3).
 188
 189 END PROCEDURE.
 190
 191 /* _UIB-CODE-BLOCK-END */
 192 &ANALYZE-RESUME
 193
 194
 195 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-rental-space Procedure
 196 PROCEDURE each-rental-space :
 197 /*------------------------------------------------------------------------------
 198   Purpose:
 199   Parameters:  <none>
 200   Notes:
 201 ------------------------------------------------------------------------------*/
 202
 203   DEF VAR mrkt AS DEC NO-UNDO.
 204   DEF VAR chrg AS DEC NO-UNDO.
 205   DEF VAR mrkt-rate AS DEC NO-UNDO.
 206   DEF VAR chrg-rate AS DEC NO-UNDO.
 207   DEF VAR c-mrkt-rate AS CHAR NO-UNDO.
 208   DEF VAR c-chrg-rate AS CHAR NO-UNDO.
 209   DEF VAR c-area      AS CHAR NO-UNDO.
 210   DEF VAR suffix      AS CHAR NO-UNDO.
 211
 212   mrkt = IF RentalSpace.MarketRental  = ? THEN 0.00 ELSE RentalSpace.MarketRental.
 213   chrg = IF RentalSpace.ChargedRental = ? THEN 0.00 ELSE RentalSpace.ChargedRental.
 214
 215   IF RentalSpace.AreaType = "C" THEN
 216     ASSIGN
 217       mrkt-rate = ( mrkt / RentalSpace.AreaSize ) / 52
 218       chrg-rate = ( chrg / RentalSpace.AreaSize ) / 52
 219       suffix = "pw".
 220   ELSE
 221     ASSIGN
 222       mrkt-rate = mrkt / RentalSpace.AreaSize
 223       chrg-rate = chrg / RentalSpace.AreaSize.
 224
 225   IF mrkt-rate = ? THEN mrkt-rate = 0.00.  IF chrg-rate = ? THEN chrg-rate = 0.00.
 226   ASSIGN
 227     c-mrkt-rate = STRING( mrkt-rate, ">>>9.99" ) + suffix
 228     c-chrg-rate = STRING( chrg-rate, ">>>9.99" ) + suffix.
 229
 230   c-area = IF RentalSpace.AreaType = "C"
 231     THEN STRING( RentalSpace.AreaSize, "   >>>,>>9" ) + "cp"
 232     ELSE STRING( RentalSpace.AreaSize, ">>>,>>9.99" ).
 233
 234
 235   PUT UNFORMATTED
 236     SPACE(4)
 237     STRING( RentalSpace.RentalSpaceCode, "9999" ) SPACE(2)
 238     STRING( RentalSpace.Description, "X(45)" )    SPACE(2)
 239     STRING( c-area, "X(12)" )                     SPACE(0)
 240     STRING( mrkt, ">>>,>>>,>>9.99" )              SPACE(2)
 241     STRING( c-mrkt-rate, "X(9)" )                 SPACE(2)
 242     STRING( chrg, ">>>,>>>,>>9.99" )              SPACE(2)
 243     STRING( c-chrg-rate, "X(9)" ).
 244   RUN skip-line(1.5).
 245
 246   area-tot = area-tot + IF LOOKUP( RentalSpace.AreaType, "C,N" ) <> 0 THEN 0 ELSE RentalSpace.AreaSize .
 247   chrg-tot = chrg-tot + chrg.
 248   erv-tot  = erv-tot  + mrkt.
 249
 250 END PROCEDURE.
 251
 252 /* _UIB-CODE-BLOCK-END */
 253 &ANALYZE-RESUME
 254
 255
 256 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 257 PROCEDURE get-control-strings :
 258 /*------------------------------------------------------------------------------
 259   Purpose:     Get all control strings for this report
 260   Parameters:  <none>
 261   Notes:
 262 ------------------------------------------------------------------------------*/
 263
 264   DEF VAR rows AS DEC NO-UNDO.
 265   DEF VAR cols AS DEC NO-UNDO.
 266
 267   RUN make-control-string ( "PCL", "reset,portrait,a4,tm,0,lm,4",
 268                   OUTPUT reset-page, OUTPUT rows, OUTPUT cols ).
 269
 270   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,12",
 271                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 272
 273   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,6",
 274                   OUTPUT time-font, OUTPUT rows, OUTPUT cols ).
 275
 276   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,8",
 277                   OUTPUT header-font, OUTPUT rows, OUTPUT cols ).
 278
 279   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,8",
 280                   OUTPUT rent-review-font, OUTPUT rows, OUTPUT cols ).
 281
 282   RUN make-control-string ( "PCL", "LinePrinter,lpi,9.54",
 283                   OUTPUT line-printer, OUTPUT rows, OUTPUT cols ).
 284
 285 END PROCEDURE.
 286
 287 /* _UIB-CODE-BLOCK-END */
 288 &ANALYZE-RESUME
 289
 290
 291 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 292 PROCEDURE page-feed :
 293 /*------------------------------------------------------------------------------
 294   Purpose:
 295   Parameters:  <none>
 296   Notes:
 297 ------------------------------------------------------------------------------*/
 298
 299   page-no = page-no + 1.
 300   PUT CONTROL CHR(12).
 301
 302 END PROCEDURE.
 303
 304 /* _UIB-CODE-BLOCK-END */
 305 &ANALYZE-RESUME
 306
 307
 308 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 309 PROCEDURE page-header :
 310 /*------------------------------------------------------------------------------
 311   Purpose:
 312   Parameters:  <none>
 313   Notes:
 314 ------------------------------------------------------------------------------*/
 315
 316   RUN reset-page.
 317   RUN print-title.
 318   RUN column-header.
 319
 320 END PROCEDURE.
 321
 322 /* _UIB-CODE-BLOCK-END */
 323 &ANALYZE-RESUME
 324
 325
 326 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-title Procedure
 327 PROCEDURE print-title :
 328 /*------------------------------------------------------------------------------
 329   Purpose:
 330   Parameters:  <none>
 331   Notes:
 332 ------------------------------------------------------------------------------*/
 333
 334   PUT CONTROL line-printer.
 335   RUN skip-line(2).
 336   PUT CONTROL time-font.
 337   PUT UNFORMATTED
 338     STRING(
 339       "Printed: " + STRING( TODAY, "99/99/9999" ) + " " +
 340                     STRING( TIME, "HH:MM:SS" ) + " for " + user-name,
 341       "X(100)" ) SPACE(120)
 342       STRING( "Page: " + STRING( page-no ), "X(20)" ).
 343   RUN skip-line(2).
 344   PUT CONTROL title-font.
 345   PUT UNFORMATTED SPACE(42) STRING( "Schedule of Rent Reviews", "X(50)" ).
 346   RUN skip-line(1).
 347   PUT CONTROL line-printer.
 348
 349 END PROCEDURE.
 350
 351 /* _UIB-CODE-BLOCK-END */
 352 &ANALYZE-RESUME
 353
 354
 355 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE rent-review-footer Procedure
 356 PROCEDURE rent-review-footer :
 357 /*------------------------------------------------------------------------------
 358   Purpose:
 359   Parameters:  <none>
 360   Notes:
 361 ------------------------------------------------------------------------------*/
 362   PUT UNFORMATTED SPACE(57) FILL( '-', 10 ) + "  " + FILL( '-', 14 )
 363                             + FILL( ' ', 13 ) + FILL( '-', 14 ).
 364   RUN skip-line(1).
 365   PUT UNFORMATTED SPACE(57)
 366     STRING( area-tot, ">>>,>>9.99" )     SPACE(2)
 367     STRING( erv-tot,  ">>>,>>>,>>9.99" ) SPACE(13)
 368     STRING( chrg-tot, ">>>,>>>,>>9.99" ).
 369   RUN skip-line(1).
 370
 371 END PROCEDURE.
 372
 373 /* _UIB-CODE-BLOCK-END */
 374 &ANALYZE-RESUME
 375
 376
 377 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE rent-review-header Procedure
 378 PROCEDURE rent-review-header :
 379 /*------------------------------------------------------------------------------
 380   Purpose:
 381   Parameters:  <none>
 382   Notes:
 383 ------------------------------------------------------------------------------*/
 384
 385   FIND TenancyLease OF RentReview NO-LOCK NO-ERROR.
 386   FIND Tenant WHERE Tenant.TenantCode = TenancyLease.TenantCode NO-LOCK NO-ERROR.
 387   FIND Property OF TenancyLease NO-LOCK NO-ERROR.
 388
 389   PUT CONTROL rent-review-font.
 390   PUT UNFORMATTED
 391     STRING( RentReview.DateDue, "99/99/9999" ) SPACE(4)
 392     STRING( Property.PropertyCode, "9999" ) STRING( " - ", "X(3)" )
 393     STRING( Property.Name, "X(50)" ) SPACE(4).
 394   PUT CONTROL line-printer.
 395   RUN skip-line(1.5).
 396   PUT CONTROL rent-review-font.
 397   PUT UNFORMATTED
 398     SPACE(31)
 399     STRING( Tenant.Name, "X(50)" ).
 400   PUT CONTROL line-printer.
 401   RUN skip-line(2.5).
 402
 403 END PROCEDURE.
 404
 405 /* _UIB-CODE-BLOCK-END */
 406 &ANALYZE-RESUME
 407
 408
 409 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE rent-reviews Procedure
 410 PROCEDURE rent-reviews :
 411 /*------------------------------------------------------------------------------
 412   Purpose:
 413   Parameters:  <none>
 414   Notes:
 415 ------------------------------------------------------------------------------*/
 416
 417   RUN get-control-strings.
 418   RUN page-header.
 419
 420   FOR EACH RentReview NO-LOCK WHERE RentReview.DateDue <= date-to
 421                               AND RentReview.ReviewStatus <> "DONE"
 422                               BY RentReview.DateDue:
 423     RUN each-rent-review.
 424   END.
 425
 426   RUN report-footer.
 427
 428   RUN page-feed.
 429
 430 END PROCEDURE.
 431
 432 /* _UIB-CODE-BLOCK-END */
 433 &ANALYZE-RESUME
 434
 435
 436 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE report-footer Procedure
 437 PROCEDURE report-footer :
 438 /*------------------------------------------------------------------------------
 439   Purpose:
 440 ------------------------------------------------------------------------------*/
 441   RUN skip-line(2).
 442   PUT UNFORMATTED SPACE(57) FILL( '=', 10 ) + "  " + FILL( '=', 14 )
 443                             + FILL( ' ', 13 ) + FILL( '=', 14 ).
 444   RUN skip-line(1).
 445   PUT UNFORMATTED SPACE(57)
 446     STRING( g-area-tot, ">>>,>>9.99" )     SPACE(2)
 447     STRING( g-erv-tot,  ">>>,>>>,>>9.99" ) SPACE(13)
 448     STRING( g-chrg-tot, ">>>,>>>,>>9.99" ).
 449   RUN skip-line(1).
 450
 451 END PROCEDURE.
 452
 453 /* _UIB-CODE-BLOCK-END */
 454 &ANALYZE-RESUME
 455
 456
 457 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 458 PROCEDURE reset-page :
 459 /*------------------------------------------------------------------------------
 460   Purpose:
 461   Parameters:  <none>
 462   Notes:
 463 ------------------------------------------------------------------------------*/
 464
 465   PUT CONTROL reset-page.
 466   ln = 0.
 467
 468 END PROCEDURE.
 469
 470 /* _UIB-CODE-BLOCK-END */
 471 &ANALYZE-RESUME
 472
 473
 474 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-totals Procedure
 475 PROCEDURE reset-totals :
 476 /*------------------------------------------------------------------------------
 477   Purpose:
 478   Parameters:  <none>
 479   Notes:
 480 ------------------------------------------------------------------------------*/
 481   g-area-tot = g-area-tot + area-tot .
 482   g-chrg-tot = g-chrg-tot + chrg-tot .
 483   g-erv-tot  = g-erv-tot  + erv-tot .
 484
 485   area-tot = 0.00.
 486   chrg-tot = 0.00.
 487   erv-tot  = 0.00.
 488
 489 END PROCEDURE.
 490
 491 /* _UIB-CODE-BLOCK-END */
 492 &ANALYZE-RESUME
 493
 494
 495 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
 496 PROCEDURE skip-line :
 497 /*------------------------------------------------------------------------------
 498   Purpose:
 499   Parameters:  <none>
 500   Notes:
 501 ------------------------------------------------------------------------------*/
 502
 503   DEF INPUT PARAMETER n AS DEC NO-UNDO.
 504
 505   IF ln + n >= {&lines-per-page} THEN
 506   DO:
 507     RUN page-feed.
 508     RUN page-header.
 509     RETURN.
 510   END.
 511
 512   DEF VAR int-part AS INT NO-UNDO.
 513   DEF VAR dec-part AS DEC NO-UNDO.
 514
 515   int-part = TRUNCATE( n, 0 ).
 516   IF int-part < 0 THEN RETURN.
 517   dec-part = n - int-part.
 518   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 519
 520   /* Need to have this like the following - do not touch */
 521   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 522   IF dec-part <> 0 THEN PUT CONTROL half-line.
 523
 524   ln = ln + n.
 525
 526   RUN carriage-return.
 527
 528 END PROCEDURE.
 529
 530 /* _UIB-CODE-BLOCK-END */
 531 &ANALYZE-RESUME
 532
 533
 534 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-to-line Procedure
 535 PROCEDURE skip-to-line :
 536 /*------------------------------------------------------------------------------
 537   Purpose:
 538   Parameters:  <none>
 539   Notes:
 540 ------------------------------------------------------------------------------*/
 541
 542   DEF INPUT PARAMETER line-no AS DEC NO-UNDO.
 543
 544   DEF VAR int-part AS INT NO-UNDO.
 545   DEF VAR dec-part AS DEC NO-UNDO.
 546
 547   int-part = TRUNCATE( line-no - ln, 0 ).
 548   IF int-part < 0 THEN RETURN.
 549   dec-part = ( line-no - ln ) - int-part.
 550   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 551
 552   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 553   IF dec-part <> 0 THEN PUT CONTROL half-line.
 554
 555   ln = line-no.
 556
 557   RUN carriage-return.
 558
 559 END PROCEDURE.
 560
 561 /* _UIB-CODE-BLOCK-END */
 562 &ANALYZE-RESUME
 563
 564