process/report/vcntspce.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 /*          This .W file was created with the Progress UIB.             */
  17 /*----------------------------------------------------------------------*/
  18
  19 /* ***************************  Definitions  ************************** */
  20
  21 &SCOPED-DEFINE lines-per-page 112
  22
  23 /* Report counters */
  24 DEF VAR ln AS DEC INIT 0.00 NO-UNDO.
  25
  26 /* Line definitions */
  27
  28 DEF VAR page-no               AS INT INIT 1 NO-UNDO.
  29 DEF VAR reset-page            AS CHAR NO-UNDO.
  30 DEF VAR half-line             AS CHAR NO-UNDO. half-line = CHR(27) + "=".
  31 DEF VAR title-font            AS CHAR NO-UNDO.
  32 DEF VAR time-font             AS CHAR NO-UNDO.
  33 DEF VAR property-font         AS CHAR NO-UNDO.
  34 DEF VAR header-font           AS CHAR NO-UNDO.
  35 DEF VAR line-printer          AS CHAR NO-UNDO.
  36 DEF VAR i AS INT NO-UNDO.
  37
  38 DEF VAR rsp-tot AS DEC EXTENT 2 NO-UNDO.
  39 DEF VAR prp-tot AS DEC EXTENT 2 NO-UNDO.
  40 DEF VAR grd-tot AS DEC EXTENT 2 NO-UNDO.
  41
  42 DEF VAR market-total AS DEC 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             = .1
  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 vacant-spaces.
 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 SPACE(12)
 145     STRING( "Code" ) SPACE(10)
 146     STRING( "Space Description", "X(86)" ) SPACE(4)
 147     STRING( "Area", "X(8)" ) SPACE(4)
 148     STRING( "Expected Market Value" ).
 149   PUT CONTROL line-printer.
 150   RUN skip-line(1).
 151
 152   PUT CONTROL header-font.
 153   PUT UNFORMATTED SPACE(150)
 154     STRING( "$ P.A.", "X(6)" ) SPACE(12)
 155     STRING( "$/Sq M" ).
 156
 157   PUT CONTROL line-printer.
 158   RUN skip-line(3).
 159
 160 END PROCEDURE.
 161
 162 /* _UIB-CODE-BLOCK-END */
 163 &ANALYZE-RESUME
 164
 165
 166 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-property Procedure
 167 PROCEDURE each-property :
 168 /*------------------------------------------------------------------------------
 169   Purpose:
 170   Parameters:  <none>
 171   Notes:
 172 ------------------------------------------------------------------------------*/
 173
 174 DEF VAR i AS INT NO-UNDO.
 175 DEF VAR area-rental AS DEC NO-UNDO.
 176
 177   RUN reset-prp-totals.
 178   i = 0.
 179   FOR EACH RentalSpace OF Property NO-LOCK:
 180     IF RentalSpace.AreaStatus = "V" THEN
 181     DO:
 182       i = i + 1.
 183       IF i = 1 THEN RUN property-header.
 184       RUN each-vacant-space.
 185       area-rental = (IF RentalSpace.MarketRental <> ? THEN RentalSpace.MarketRental ELSE 0.00).
 186     END.
 187     ELSE
 188       area-rental = (IF RentalSpace.ContractedRental <> ? THEN RentalSpace.ContractedRental ELSE 0.00).
 189
 190     market-total = market-total + area-rental.
 191   END.
 192
 193   IF i > 1 THEN RUN property-footer.
 194   IF i > 0 THEN RUN skip-line(0.5).
 195
 196 END PROCEDURE.
 197
 198 /* _UIB-CODE-BLOCK-END */
 199 &ANALYZE-RESUME
 200
 201
 202 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-vacant-space Procedure
 203 PROCEDURE each-vacant-space :
 204 /*------------------------------------------------------------------------------
 205   Purpose:
 206   Parameters:  <none>
 207   Notes:
 208 ------------------------------------------------------------------------------*/
 209
 210   DEF VAR rsp-rate AS DEC NO-UNDO.
 211   DEF VAR c-rate   AS CHAR NO-UNDO.
 212
 213   rsp-tot[1] = IF RentalSpace.AreaSize <> ? THEN RentalSpace.AreaSize ELSE 0.00.
 214   rsp-tot[2] = IF RentalSpace.MarketRental <> ? THEN RentalSpace.MarketRental ELSE 0.00.
 215   IF RentalSpace.AreaType = "C" THEN DO:
 216     ASSIGN
 217       rsp-rate = rsp-tot[2] / rsp-tot[1]
 218       rsp-rate = rsp-rate / 52.
 219
 220     IF rsp-rate = ? THEN rsp-rate = rsp-tot[2].
 221     c-rate   = STRING( rsp-rate, ">>>9.99" ) + "pw".
 222   END.
 223   ELSE DO:
 224     rsp-rate = rsp-tot[2] / rsp-tot[1].
 225     IF rsp-rate = ? THEN rsp-rate = rsp-tot[2].
 226     c-rate   = STRING( rsp-rate, ">>>9.99" ).
 227   END.
 228
 229   PUT UNFORMATTED SPACE(8)
 230     STRING( RentalSpace.RentalSpaceCode, "9999" ) SPACE(6)
 231     STRING( RentalSpace.Description, "X(50)" ) SPACE(4)
 232     STRING( rsp-tot[1], ">>>,>>9.99" ) SPACE(4)
 233     STRING( rsp-tot[2], ">>>,>>>,>>9.99" ) SPACE(4)
 234     STRING( c-rate, "X(12)" ).
 235   RUN skip-line(1).
 236   RUN update-prp-totals.
 237
 238 END PROCEDURE.
 239
 240 /* _UIB-CODE-BLOCK-END */
 241 &ANALYZE-RESUME
 242
 243
 244 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 245 PROCEDURE get-control-strings :
 246 /*------------------------------------------------------------------------------
 247   Purpose:     Get all control strings for this report
 248   Parameters:  <none>
 249   Notes:
 250 ------------------------------------------------------------------------------*/
 251
 252   DEF VAR rows AS DEC NO-UNDO.
 253   DEF VAR cols AS DEC NO-UNDO.
 254
 255   RUN make-control-string ( "PCL", "reset,portrait,a4,tm,0,lm,4",
 256                   OUTPUT reset-page, OUTPUT rows, OUTPUT cols ).
 257
 258   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,12",
 259                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 260
 261   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,6",
 262                   OUTPUT time-font, OUTPUT rows, OUTPUT cols ).
 263
 264   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,8",
 265                   OUTPUT header-font, OUTPUT rows, OUTPUT cols ).
 266
 267   RUN make-control-string ( "PCL", "Proportional,Helvetica,Bold,Point,10",
 268                   OUTPUT property-font, OUTPUT rows, OUTPUT cols ).
 269
 270   RUN make-control-string ( "PCL", "LinePrinter,lpi,9.54",
 271                   OUTPUT line-printer, OUTPUT rows, OUTPUT cols ).
 272
 273 END PROCEDURE.
 274
 275 /* _UIB-CODE-BLOCK-END */
 276 &ANALYZE-RESUME
 277
 278
 279 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 280 PROCEDURE page-feed :
 281 /*------------------------------------------------------------------------------
 282   Purpose:
 283   Parameters:  <none>
 284   Notes:
 285 ------------------------------------------------------------------------------*/
 286
 287   page-no = page-no + 1.
 288   PUT CONTROL CHR(12).
 289
 290 END PROCEDURE.
 291
 292 /* _UIB-CODE-BLOCK-END */
 293 &ANALYZE-RESUME
 294
 295
 296 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 297 PROCEDURE page-header :
 298 /*------------------------------------------------------------------------------
 299   Purpose:
 300   Parameters:  <none>
 301   Notes:
 302 ------------------------------------------------------------------------------*/
 303
 304   RUN reset-page.
 305   RUN print-title.
 306   RUN column-header.
 307
 308 END PROCEDURE.
 309
 310 /* _UIB-CODE-BLOCK-END */
 311 &ANALYZE-RESUME
 312
 313
 314 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-grd-totals Procedure
 315 PROCEDURE print-grd-totals :
 316 /*------------------------------------------------------------------------------
 317   Purpose:
 318   Parameters:  <none>
 319   Notes:
 320 ------------------------------------------------------------------------------*/
 321
 322   RUN skip-line(2).
 323   PUT UNFORMATTED SPACE(72)
 324     STRING( FILL( '-', 10 ) + FILL( ' ', 4 ) + FILL( '-', 14 ), "X(50)" ).
 325   RUN skip-line(1).
 326
 327   DEF VAR percentage AS DEC NO-UNDO.
 328   percentage = grd-tot[2] / market-total.
 329
 330   PUT UNFORMATTED
 331     STRING( "GRAND TOTAL", "X(11)" ) SPACE(61)
 332     STRING( grd-tot[1], ">>>,>>9.99" ) SPACE(4)
 333     STRING( grd-tot[2], ">>>,>>>,>>9.99" ).
 334   RUN skip-line(2).
 335
 336   PUT UNFORMATTED
 337     SPACE( 72 )
 338     STRING( percentage, ">>9.99" ) STRING( "%", "X" ) SPACE(1)
 339     STRING( "of Rental Gross Income as at " + STRING(TODAY, "99/99/9999"), "X(60)" ).
 340   RUN skip-line(1).
 341
 342 END PROCEDURE.
 343
 344 /* _UIB-CODE-BLOCK-END */
 345 &ANALYZE-RESUME
 346
 347
 348 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-title Procedure
 349 PROCEDURE print-title :
 350 /*------------------------------------------------------------------------------
 351   Purpose:
 352   Parameters:  <none>
 353   Notes:
 354 ------------------------------------------------------------------------------*/
 355
 356   PUT CONTROL line-printer.
 357   RUN skip-line(2).
 358   PUT CONTROL time-font.
 359   PUT UNFORMATTED
 360     STRING(
 361       "Printed: " + STRING( TODAY, "99/99/9999" ) + " " +
 362                     STRING( TIME, "HH:MM:SS" ) + " for " + user-name,
 363       "X(100)" ) SPACE(120)
 364       STRING( "Page: " + STRING( page-no ), "X(20)" ).
 365   RUN skip-line(2).
 366   PUT CONTROL title-font.
 367   PUT UNFORMATTED SPACE(45) STRING( "Vacant Space Report", "X(50)" ).
 368   RUN skip-line(1).
 369   PUT CONTROL line-printer.
 370
 371 END PROCEDURE.
 372
 373 /* _UIB-CODE-BLOCK-END */
 374 &ANALYZE-RESUME
 375
 376
 377 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE property-footer Procedure
 378 PROCEDURE property-footer :
 379 /*------------------------------------------------------------------------------
 380   Purpose:
 381   Parameters:  <none>
 382   Notes:
 383 ------------------------------------------------------------------------------*/
 384
 385   PUT UNFORMATTED SPACE(72)
 386     STRING( FILL( '-', 10 ) + FILL( ' ', 4 ) + FILL( '-', 14 ), "X(50)" ).
 387   RUN skip-line(1).
 388
 389   PUT UNFORMATTED SPACE(72)
 390     STRING( prp-tot[1], ">>>,>>9.99" ) SPACE(4)
 391     STRING( prp-tot[2], ">>>,>>>,>>9.99" ).
 392   RUN skip-line(1).
 393
 394   RUN update-grd-totals.
 395   RUN skip-line(1).
 396
 397 END PROCEDURE.
 398
 399 /* _UIB-CODE-BLOCK-END */
 400 &ANALYZE-RESUME
 401
 402
 403 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE property-header Procedure
 404 PROCEDURE property-header :
 405 /*------------------------------------------------------------------------------
 406   Purpose:
 407   Parameters:  <none>
 408   Notes:
 409 ------------------------------------------------------------------------------*/
 410
 411   PUT CONTROL property-font.
 412   PUT UNFORMATTED STRING(
 413     "(" + Property.Region + ") " +
 414     STRING( Property.PropertyCode, "9999" ) + ' - ' + Property.Name,
 415     "X(100)" ).
 416   PUT CONTROL line-printer.
 417   RUN skip-line(2).
 418
 419 END PROCEDURE.
 420
 421 /* _UIB-CODE-BLOCK-END */
 422 &ANALYZE-RESUME
 423
 424
 425 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 426 PROCEDURE reset-page :
 427 /*------------------------------------------------------------------------------
 428   Purpose:
 429   Parameters:  <none>
 430   Notes:
 431 ------------------------------------------------------------------------------*/
 432
 433   PUT CONTROL reset-page.
 434   ln = 0.
 435
 436 END PROCEDURE.
 437
 438 /* _UIB-CODE-BLOCK-END */
 439 &ANALYZE-RESUME
 440
 441
 442 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-prp-totals Procedure
 443 PROCEDURE reset-prp-totals :
 444 /*------------------------------------------------------------------------------
 445   Purpose:
 446   Parameters:  <none>
 447   Notes:
 448 ------------------------------------------------------------------------------*/
 449
 450   DO i = 1 TO 2: prp-tot[i] = 0.00. END.
 451
 452 END PROCEDURE.
 453
 454 /* _UIB-CODE-BLOCK-END */
 455 &ANALYZE-RESUME
 456
 457
 458 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
 459 PROCEDURE skip-line :
 460 /*------------------------------------------------------------------------------
 461   Purpose:
 462   Parameters:  <none>
 463   Notes:
 464 ------------------------------------------------------------------------------*/
 465
 466   DEF INPUT PARAMETER n AS DEC NO-UNDO.
 467
 468   IF ln + n >= {&lines-per-page} THEN
 469   DO:
 470     RUN page-feed.
 471     RUN page-header.
 472     RETURN.
 473   END.
 474
 475   DEF VAR int-part AS INT NO-UNDO.
 476   DEF VAR dec-part AS DEC NO-UNDO.
 477
 478   int-part = TRUNCATE( n, 0 ).
 479   IF int-part < 0 THEN RETURN.
 480   dec-part = n - int-part.
 481   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 482
 483   /* Need to have this like the following - do not touch */
 484   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 485   IF dec-part <> 0 THEN PUT CONTROL half-line.
 486
 487   ln = ln + n.
 488
 489   RUN carriage-return.
 490
 491 END PROCEDURE.
 492
 493 /* _UIB-CODE-BLOCK-END */
 494 &ANALYZE-RESUME
 495
 496
 497 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-to-line Procedure
 498 PROCEDURE skip-to-line :
 499 /*------------------------------------------------------------------------------
 500   Purpose:
 501   Parameters:  <none>
 502   Notes:
 503 ------------------------------------------------------------------------------*/
 504
 505   DEF INPUT PARAMETER line-no AS DEC NO-UNDO.
 506
 507   DEF VAR int-part AS INT NO-UNDO.
 508   DEF VAR dec-part AS DEC NO-UNDO.
 509
 510   int-part = TRUNCATE( line-no - ln, 0 ).
 511   IF int-part < 0 THEN RETURN.
 512   dec-part = ( line-no - ln ) - int-part.
 513   IF int-part = 0 AND dec-part = 0 THEN RETURN.
 514
 515   IF int-part <> 0 THEN PUT CONTROL FILL( CHR(10), int-part ).
 516   IF dec-part <> 0 THEN PUT CONTROL half-line.
 517
 518   ln = line-no.
 519
 520   RUN carriage-return.
 521
 522 END PROCEDURE.
 523
 524 /* _UIB-CODE-BLOCK-END */
 525 &ANALYZE-RESUME
 526
 527
 528 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-grd-totals Procedure
 529 PROCEDURE update-grd-totals :
 530 /*------------------------------------------------------------------------------
 531   Purpose:
 532   Parameters:  <none>
 533   Notes:
 534 ------------------------------------------------------------------------------*/
 535
 536   DO i = 1 TO 2: grd-tot[i] = grd-tot[i] + prp-tot[i]. END.
 537
 538 END PROCEDURE.
 539
 540 /* _UIB-CODE-BLOCK-END */
 541 &ANALYZE-RESUME
 542
 543
 544 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-prp-totals Procedure
 545 PROCEDURE update-prp-totals :
 546 /*------------------------------------------------------------------------------
 547   Purpose:
 548   Parameters:  <none>
 549   Notes:
 550 ------------------------------------------------------------------------------*/
 551
 552   prp-tot[1] = prp-tot[1] + IF RentalSpace.AreaType = "C" THEN 0.00 ELSE rsp-tot[1].
 553   prp-tot[2] = prp-tot[2] + rsp-tot[2].
 554
 555 END PROCEDURE.
 556
 557 /* _UIB-CODE-BLOCK-END */
 558 &ANALYZE-RESUME
 559
 560
 561 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE vacant-spaces Procedure
 562 PROCEDURE vacant-spaces :
 563 /*------------------------------------------------------------------------------
 564   Purpose:
 565   Parameters:  <none>
 566   Notes:
 567 ------------------------------------------------------------------------------*/
 568
 569   RUN get-control-strings.
 570   RUN page-header.
 571
 572   FOR EACH Property NO-LOCK WHERE Property.Active BY Region:
 573     RUN each-property.
 574   END.
 575
 576   RUN print-grd-totals.
 577   RUN page-feed.
 578
 579 END PROCEDURE.
 580
 581 /* _UIB-CODE-BLOCK-END */
 582 &ANALYZE-RESUME
 583
 584