process/report/property-picture.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   Report:   Picture of the property with relative space shown
   6   Author:   Andrew McMillan
   7   Date:     14/6/1999
   8   ------------------------------------------------------------------------*/
   9 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
  10
  11 DEF VAR preview   AS LOGI NO-UNDO INIT No.
  12 DEF VAR subleases AS LOGI NO-UNDO INIT No.
  13 DEF VAR boxes     AS LOGI NO-UNDO INIT No.
  14 DEF VAR property-1 AS INT NO-UNDO INIT 0.
  15 DEF VAR property-n AS INT NO-UNDO INIT 99999.
  16 DEF VAR allowable-variation AS DEC NO-UNDO INIT 3.
  17 DEF VAR selection-style AS CHAR NO-UNDO.
  18 DEF VAR show-level-areas AS LOGI NO-UNDO INIT No.
  19 DEF VAR show-area-areas AS LOGI NO-UNDO INIT No.
  20 RUN parse-parameters.
  21
  22 DEF VAR property-code AS INT NO-UNDO.
  23 DEF VAR property-name AS CHAR NO-UNDO.
  24
  25 DEF VAR user-name AS CHAR NO-UNDO.
  26 {inc/username.i "user-name"}
  27 DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO.
  28 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  29
  30 DEF VAR pr-line AS CHAR INIT "" NO-UNDO.        /* used everywhere to hold print line */
  31
  32 DEF VAR title-font  AS CHAR NO-UNDO   INITIAL "proportional,helv,point,12,bold".
  33 DEF VAR time-font   AS CHAR NO-UNDO   INITIAL "proportional,helv,point,6,normal".
  34 DEF VAR break1-font AS CHAR NO-UNDO   INITIAL "proportional,helv,point,12,lpi,7,bold".
  35 DEF VAR break2-font AS CHAR NO-UNDO   INITIAL "proportional,helv,point,8,bold".
  36 DEF VAR base-font   AS CHAR NO-UNDO   INITIAL "fixed,courier,cpi,17,lpi,8.5,bold".
  37
  38 /* Some default fonts and matching line height */
  39 DEF VAR area-font   AS CHAR NO-UNDO   INITIAL "proportional,helv,point,9,normal".
  40 DEF VAR name-font   AS CHAR NO-UNDO   INITIAL "proportional,helv,point,9,normal".
  41 DEF VAR vacant-font   AS CHAR NO-UNDO   INITIAL "proportional,helv,point,9,bold".
  42 DEF VAR line-height AS DEC NO-UNDO    INITIAL 3.
  43 DEF VAR area-offset AS INT NO-UNDO    INITIAL 21.
  44
  45 DEF VAR area-per-park AS DEC NO-UNDO INITIAL 35.
  46 DEF VAR no-levels AS INT NO-UNDO INITIAL 1.
  47 DEF VAR min-level-size AS DEC NO-UNDO INITIAL 999999.
  48 DEF VAR max-level-size AS DEC NO-UNDO INITIAL 1.0.
  49 DEF VAR avg-level-size AS DEC NO-UNDO INITIAL 0.0.
  50 DEF VAR names-per-cycle AS INT NO-UNDO INITIAL 3.
  51 DEF VAR this-level-size AS DEC NO-UNDO.
  52 DEF VAR box-height AS DEC NO-UNDO.
  53 DEF VAR portrait AS LOGI NO-UNDO INITIAL Yes.
  54 DEF VAR line-width AS DEC NO-UNDO INITIAL 120.
  55 DEF VAR level-width AS DEC NO-UNDO INITIAL 0.
  56 DEF VAR level-scale AS DEC NO-UNDO INITIAL 1.
  57 DEF VAR inc-per-level AS INT NO-UNDO INITIAL 0.
  58 DEF VAR sublease-counter AS INT NO-UNDO INITIAL 0.
  59
  60 {inc/ofc-this.i}
  61 {inc/ofc-set.i "Area-Units" "area-units"}
  62 IF NOT AVAILABLE(OfficeSetting) THEN DO:
  63   area-units = "Sq.M.".
  64   area-offset = 11.
  65 END.
  66
  67 DEF TEMP-TABLE Level
  68       FIELD LevelNum AS INT
  69       FIELD LevelSize AS DEC
  70       FIELD NoParks AS DEC
  71       FIELD OtherSize AS DEC
  72       INDEX XPKLevels IS UNIQUE PRIMARY LevelNum.
  73
  74 DEF TEMP-TABLE LevelUse
  75       FIELD LevelNum AS INT
  76       FIELD UseName AS CHAR
  77       FIELD LevelSeq AS DEC
  78       FIELD UseSize AS DEC
  79       FIELD UseParks AS DEC
  80       FIELD UseOther AS DEC
  81       FIELD LeaseEnd AS DATE
  82       INDEX XPKLevelUses IS PRIMARY LevelNum LevelSeq UseName
  83       INDEX XPKLevelUnique IS UNIQUE LevelNum UseName.
  84
  85 /* _UIB-CODE-BLOCK-END */
  86 &ANALYZE-RESUME
  87
  88
  89 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  90
  91 /* ********************  Preprocessor Definitions  ******************** */
  92
  93 &Scoped-define PROCEDURE-TYPE Procedure
  94 &Scoped-define DB-AWARE no
  95
  96
  97
  98 /* _UIB-PREPROCESSOR-BLOCK-END */
  99 &ANALYZE-RESUME
 100
 101
 102 /* ************************  Function Prototypes ********************** */
 103
 104 &IF DEFINED(EXCLUDE-replace-stuff) = 0 &THEN
 105
 106 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD replace-stuff Procedure
 107 FUNCTION replace-stuff RETURNS CHARACTER
 108   ( INPUT st AS CHAR )  FORWARD.
 109
 110 /* _UIB-CODE-BLOCK-END */
 111 &ANALYZE-RESUME
 112
 113 &ENDIF
 114
 115 &IF DEFINED(EXCLUDE-test-floor-space) = 0 &THEN
 116
 117 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD test-floor-space Procedure
 118 FUNCTION test-floor-space RETURNS CHARACTER
 119   ( INPUT type AS CHAR, INPUT area AS DECIMAL )  FORWARD.
 120
 121 /* _UIB-CODE-BLOCK-END */
 122 &ANALYZE-RESUME
 123
 124 &ENDIF
 125
 126
 127 /* *********************** Procedure Settings ************************ */
 128
 129 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 130 /* Settings for THIS-PROCEDURE
 131    Type: Procedure
 132    Allow:
 133    Frames: 0
 134    Add Fields to: Neither
 135    Other Settings: CODE-ONLY COMPILE
 136  */
 137 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 138
 139 /* *************************  Create Window  ************************** */
 140
 141 &ANALYZE-SUSPEND _CREATE-WINDOW
 142 /* DESIGN Window definition (used by the UIB)
 143   CREATE WINDOW Procedure ASSIGN
 144          HEIGHT             = 24.45
 145          WIDTH              = 32.57.
 146 /* END WINDOW DEFINITION */
 147                                                                         */
 148 &ANALYZE-RESUME
 149
 150 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 151 /* ************************* Included-Libraries *********************** */
 152
 153 {inc/date.i}
 154 {inc/method/m-hpgl.i}
 155 {inc/method/m-txtrep.i}
 156
 157 /* _UIB-CODE-BLOCK-END */
 158 &ANALYZE-RESUME
 159
 160
 161
 162
 163
 164 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 165
 166
 167 /* ***************************  Main Block  *************************** */
 168
 169 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 170
 171 RUN pclrep-start( preview, "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9").
 172
 173 IF selection-style = "OneProperty" THEN
 174   RUN for-one-property.
 175 ELSE
 176   RUN for-each-property.
 177
 178 OUTPUT CLOSE.
 179
 180 RUN pclrep-finish.
 181
 182 /* _UIB-CODE-BLOCK-END */
 183 &ANALYZE-RESUME
 184
 185
 186 /* **********************  Internal Procedures  *********************** */
 187
 188 &IF DEFINED(EXCLUDE-boxed-level-end) = 0 &THEN
 189
 190 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE boxed-level-end Procedure
 191 PROCEDURE boxed-level-end :
 192 /*------------------------------------------------------------------------------
 193   Purpose:
 194 ------------------------------------------------------------------------------*/
 195 DEF VAR l-width AS DEC NO-UNDO.
 196
 197   RUN hpgl-move-relative( - level-width, - box-height ).
 198
 199 END PROCEDURE.
 200
 201 /* _UIB-CODE-BLOCK-END */
 202 &ANALYZE-RESUME
 203
 204 &ENDIF
 205
 206 &IF DEFINED(EXCLUDE-boxed-level-start) = 0 &THEN
 207
 208 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE boxed-level-start Procedure
 209 PROCEDURE boxed-level-start :
 210 /*------------------------------------------------------------------------------
 211   Purpose:
 212 ------------------------------------------------------------------------------*/
 213 DEF VAR level-no-offset AS DEC NO-UNDO.
 214
 215   level-no-offset = (box-height / 2) - 1.5.
 216   level-width = 0.
 217   inc-per-level = 0.
 218   RUN hpgl-move-relative( -22, level-no-offset ).
 219   RUN hpgl-text( "Helvetica,Point,9,bold,Proportional", STRING(Level.LevelNum,"->>9") ).
 220   RUN hpgl-move-relative( 9, 0 ).
 221   IF show-level-areas THEN
 222     RUN hpgl-text( area-font, TRIM(STRING(Level.LevelSize,"->,>>>,>>9")) + area-units ).
 223   RUN hpgl-move-relative( 13, - level-no-offset ).
 224
 225   IF (avg-level-size * 2) < max-level-size THEN DO:
 226     level-scale = 1 + ((max-level-size - this-level-size) * 1.1) / max-level-size.
 227   END.
 228   ELSE
 229     level-scale = 1.
 230
 231   level-width = (((max-level-size - (this-level-size * level-scale)) / 2) / max-level-size)
 232               * line-width + 15.
 233   RUN hpgl-move-relative( level-width, 0 ).
 234
 235 END PROCEDURE.
 236
 237 /* _UIB-CODE-BLOCK-END */
 238 &ANALYZE-RESUME
 239
 240 &ENDIF
 241
 242 &IF DEFINED(EXCLUDE-boxed-level-use) = 0 &THEN
 243
 244 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE boxed-level-use Procedure
 245 PROCEDURE boxed-level-use :
 246 /*------------------------------------------------------------------------------
 247   Purpose:
 248 ------------------------------------------------------------------------------*/
 249 DEF INPUT PARAMETER portion AS DEC NO-UNDO.
 250 DEF INPUT PARAMETER tenant AS CHAR NO-UNDO.
 251 DEF INPUT PARAMETER lease-end AS DATE NO-UNDO.
 252 DEF INPUT PARAMETER area AS CHAR NO-UNDO.
 253
 254 DEF VAR box-width AS DEC NO-UNDO.
 255 DEF VAR text-offset AS DEC NO-UNDO.
 256   box-width = portion * line-width * level-scale.
 257   level-width = level-width + box-width.
 258   text-offset = 0.7 + ((inc-per-level MOD names-per-cycle) * (IF portrait THEN line-height ELSE line-height + 2)).
 259   RUN hpgl-box-relative( box-width, box-height ).
 260   RUN hpgl-move-relative( 0.7, text-offset).
 261   IF box-width > 2 THEN DO:
 262     /* move to the left, print the area and move back to the right  */
 263     IF show-area-areas THEN DO:
 264       RUN hpgl-move-relative( - area-offset, 0).
 265       RUN hpgl-text( area-font, area ).
 266       RUN hpgl-move-relative( area-offset, 0).
 267     END.
 268     IF lease-end = ? AND tenant = "Vacant" THEN
 269       RUN hpgl-text( vacant-font, tenant ).
 270     ELSE IF lease-end = ? THEN
 271       RUN hpgl-text( name-font, tenant ).
 272     ELSE IF tenant = "Vacant" THEN
 273       RUN hpgl-text( vacant-font, tenant + " " + STRING(lease-end) ).
 274     ELSE
 275       RUN hpgl-text( name-font, tenant + " " + STRING(lease-end) ).
 276   END.
 277   RUN hpgl-move-relative( box-width - 0.7 , - text-offset ).
 278
 279   inc-per-level = inc-per-level + 1.
 280
 281 END PROCEDURE.
 282
 283 /* _UIB-CODE-BLOCK-END */
 284 &ANALYZE-RESUME
 285
 286 &ENDIF
 287
 288 &IF DEFINED(EXCLUDE-boxed-property-end) = 0 &THEN
 289
 290 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE boxed-property-end Procedure
 291 PROCEDURE boxed-property-end :
 292 /*------------------------------------------------------------------------------
 293   Purpose:
 294 ------------------------------------------------------------------------------*/
 295 DEF VAR printer-codes AS CHAR NO-UNDO.
 296 DEF VAR line AS CHAR NO-UNDO.
 297
 298   RUN hpgl-moveto( (IF portrait THEN 100 ELSE 190), (IF portrait THEN 280 ELSE 195) ).
 299   RUN hpgl-text( "Helvetica,Point,13,Bold,Proportional", Property.Name + " (P" + STRING(Property.PropertyCode) + ")" ).
 300   RUN hpgl-move-relative( 0, -7 ).
 301
 302   FIND Person WHERE Person.PersonCode = Property.Manager NO-LOCK NO-ERROR.
 303   IF AVAILABLE(Person) THEN DO:
 304     line = "Managed by " + Person.FirstName + " " + Person.LastName.
 305     RUN hpgl-text( "Helvetica,Point,9,Normal,Proportional", line ).
 306     RUN hpgl-move-relative( 0, -4 ).
 307   END.
 308
 309   line = "Maximum floor plate: " + TRIM( STRING( max-level-size, ">>,>>>,>>9")) + " " + area-units.
 310   RUN hpgl-text( "Helvetica,Point,9,Normal,Proportional", line ).
 311   RUN hpgl-move-relative( 0, -4 ).
 312
 313   line = "Average floor plate: " + TRIM( STRING( avg-level-size, ">>,>>>,>>9")) + " " + area-units.
 314   RUN hpgl-text( "Helvetica,Point,9,Normal,Proportional", line ).
 315   RUN hpgl-move-relative( 0, -4 ).
 316
 317   line = "Printed: " + STRING( TIME, "HH:MM:SS") + ", " + STRING( TODAY, "99/99/9999").
 318   RUN hpgl-text( "Helvetica,Point,8,Normal,Proportional", line ).
 319   RUN hpgl-move-relative( 0, -4 ).
 320
 321   RUN hpgl-get-codes( no, yes, OUTPUT printer-codes ).
 322   PUT CONTROL printer-codes + CHR(12).
 323
 324 END PROCEDURE.
 325
 326 /* _UIB-CODE-BLOCK-END */
 327 &ANALYZE-RESUME
 328
 329 &ENDIF
 330
 331 &IF DEFINED(EXCLUDE-boxed-property-start) = 0 &THEN
 332
 333 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE boxed-property-start Procedure
 334 PROCEDURE boxed-property-start :
 335 /*------------------------------------------------------------------------------
 336   Purpose:
 337 ------------------------------------------------------------------------------*/
 338   RUN hpgl-initialize.
 339   RUN hpgl-set-orientation( (IF portrait THEN "Portrait" ELSE "Landscape") ).
 340   RUN hpgl-append( "LT" ). /* Solid Line */
 341   RUN hpgl-set-line-width( 0.25 ).
 342
 343   line-width = (IF portrait THEN 120 ELSE 240).
 344   box-height = ( 1 / no-levels) * (IF portrait THEN 230 ELSE 120).
 345   IF box-height > 50 THEN box-height = box-height / 2.
 346   IF box-height > 40 THEN box-height = box-height / 2.
 347   IF box-height > 30 THEN box-height = box-height / 2.
 348   names-per-cycle = INT( box-height / (IF portrait THEN 3 ELSE 5)).
 349   names-per-cycle = MAX( names-per-cycle, (IF portrait THEN 4 ELSE 6)).
 350
 351   IF no-levels > 15 THEN DO:
 352     area-font = "Helvetica,Point,7,normal,Proportional".
 353     name-font = "Helvetica,Point,8,normal,Proportional".
 354     vacant-font = "Helvetica,Point,8,bold,Proportional".
 355     line-height = 2.5 .
 356   END.
 357   ELSE DO:
 358     area-font = "Helvetica,Point,8,normal,Proportional".
 359     name-font = "Helvetica,Point,9,normal,Proportional".
 360     vacant-font = "Helvetica,Point,9,bold,Proportional".
 361     line-height = 3 .
 362   END.
 363
 364   RUN hpgl-moveto( 35, (IF portrait THEN 250 ELSE 160) - box-height ).
 365
 366 END PROCEDURE.
 367
 368 /* _UIB-CODE-BLOCK-END */
 369 &ANALYZE-RESUME
 370
 371 &ENDIF
 372
 373 &IF DEFINED(EXCLUDE-build-levels) = 0 &THEN
 374
 375 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-levels Procedure
 376 PROCEDURE build-levels :
 377 /*------------------------------------------------------------------------------
 378   Purpose:  Print a rough proportional sketch of the property
 379 ------------------------------------------------------------------------------*/
 380 DEF INPUT PARAMETER property-code AS INT NO-UNDO.
 381
 382 DEF VAR floor-area AS CHAR NO-UNDO.
 383 DEF VAR lease-name AS CHAR NO-UNDO.
 384 DEF VAR lease-end AS DATE NO-UNDO.
 385 DEF VAR area-size AS DEC NO-UNDO.
 386   FOR EACH Level:       DELETE Level.       END.
 387   FOR EACH LevelUse:    DELETE LevelUse.    END.
 388
 389   FOR EACH RentalSpace NO-LOCK WHERE RentalSpace.PropertyCode = property-code:
 390     floor-area = test-floor-space( RentalSpace.AreaType, RentalSpace.AreaSize ).
 391     area-size  = RentalSpace.AreaSize.
 392     IF RentalSpace.AreaStatus = "V" THEN        lease-name = "Vacant".
 393     ELSE IF RentalSpace.AreaStatus = "V" THEN   lease-name = "Common".
 394     ELSE DO:
 395       FIND TenancyLease WHERE TenancyLease.TenancyLeaseCode = RentalSpace.TenancyLeaseCode
 396                           AND TenancyLease.LeaseStatus <> "PAST" NO-LOCK NO-ERROR.
 397       IF NOT AVAILABLE(TenancyLease) THEN
 398         ASSIGN
 399           lease-name = "Vacant"
 400           lease-end = ?.
 401       ELSE DO:
 402         FIND Tenant OF TenancyLease NO-LOCK.
 403         lease-name = replace-stuff( Tenant.Name ).
 404         lease-end = TenancyLease.LeaseEndDate.
 405       END.
 406     END.
 407
 408     FOR EACH PropertyView OF RentalSpace NO-LOCK:
 409       RUN make-view-level( INPUT-OUTPUT area-size, INPUT-OUTPUT lease-name, INPUT floor-area, INPUT lease-end ).
 410     END.
 411     IF area-size = 0.0  THEN NEXT.
 412
 413     FIND Level WHERE Level.LevelNum = RentalSpace.Level NO-ERROR.
 414     IF NOT AVAILABLE(Level) THEN DO:
 415       CREATE Level.
 416       Level.LevelNum = RentalSpace.Level.
 417     END.
 418     IF floor-area = "Park" THEN
 419       Level.NoParks = Level.NoParks + area-size .
 420     ELSE IF floor-area = "Yes" THEN
 421       Level.LevelSize = Level.LevelSize + area-size .
 422     ELSE
 423       Level.OtherSize = Level.OtherSize + area-size .
 424
 425     IF lease-name = "Vacant" THEN DO:
 426       lease-end = RentalSpace.VacationDate .
 427     END.
 428     ELSE IF lease-name = "Common" THEN DO:
 429       lease-end = ?.
 430     END.
 431
 432     FIND LevelUse WHERE LevelUse.LevelNum = RentalSpace.Level
 433                     AND Leveluse.UseName = lease-name NO-ERROR.
 434     IF NOT AVAILABLE(LevelUse) THEN DO:
 435       CREATE LevelUse.
 436       LevelUse.LevelNum = RentalSpace.Level.
 437       Leveluse.UseName = lease-name.
 438       LevelUse.LeaseEnd = lease-end.
 439     END.
 440
 441     IF floor-area = "Park" THEN
 442       LevelUse.UseParks = LevelUse.UseParks + area-size .
 443     ELSE IF floor-area = "Yes" THEN
 444       LevelUse.UseSize = LevelUse.UseSize + area-size .
 445     ELSE
 446       LevelUse.UseOther = LevelUse.UseOther + area-size .
 447
 448     RUN set-level-sequence.
 449   END.
 450
 451   IF subleases THEN DO:
 452      FOR EACH TenancyLease OF Property NO-LOCK WHERE TenancyLease.LeaseStatus <> "PAST",
 453                   FIRST Tenant OF TenancyLease:
 454       sublease-counter = 0.
 455       FOR EACH SubLease OF TenancyLease NO-LOCK:
 456         sublease-counter = sublease-counter + 1.
 457         RUN make-sub-lease( SubLease.Name, SubLease.AreaSize, INT(SubLease.Location), Tenant.Name ).
 458       END.
 459     END.
 460   END.
 461
 462 END PROCEDURE.
 463
 464 /* _UIB-CODE-BLOCK-END */
 465 &ANALYZE-RESUME
 466
 467 &ENDIF
 468
 469 &IF DEFINED(EXCLUDE-each-level-use) = 0 &THEN
 470
 471 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-level-use Procedure
 472 PROCEDURE each-level-use :
 473 /*------------------------------------------------------------------------------
 474   Purpose:
 475 ------------------------------------------------------------------------------*/
 476 DEF INPUT PARAMETER this-level-size AS DEC NO-UNDO.
 477 DEF INPUT-OUTPUT PARAMETER level-details AS CHAR NO-UNDO.
 478
 479
 480   IF preview THEN
 481     RUN pclrep-line( base-font, "LevelUse: " + LevelUse.UseName
 482                            + " " + STRING(LevelUse.UseSize)
 483                            + " " + STRING(LevelUse.UseParks)
 484                            + " " + STRING(LevelUse.UseOther) ).
 485
 486 DEF VAR percent-size AS DEC NO-UNDO.
 487
 488   IF this-level-size <> 0 THEN
 489     percent-size = (LevelUse.UseSize / max-level-size) * (this-level-size / Level.LevelSize).
 490
 491   IF boxes THEN DO:
 492     RUN boxed-level-use( percent-size, LevelUse.UseName,
 493                          LevelUse.LeaseEnd, STRING(LevelUse.UseSize, "->>,>>9") ).
 494   END.
 495   percent-size = percent-size * 100.
 496   level-details = level-details + STRING( LevelUse.UseName, "X(15)") + " "
 497                 + STRING(LevelUse.UseSize, "->>,>>9") + " "
 498                 + TRIM( STRING(percent-size, "->>>>>>>>9")) + "%  ".
 499
 500 END PROCEDURE.
 501
 502 /* _UIB-CODE-BLOCK-END */
 503 &ANALYZE-RESUME
 504
 505 &ENDIF
 506
 507 &IF DEFINED(EXCLUDE-each-property) = 0 &THEN
 508
 509 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-property Procedure
 510 PROCEDURE each-property :
 511 /*------------------------------------------------------------------------------
 512   Purpose:  Print a rough proportional sketch of the property
 513 ------------------------------------------------------------------------------*/
 514 DEF INPUT PARAMETER property-code AS INT NO-UNDO.
 515
 516 DEF VAR last-level-size AS DEC NO-UNDO.
 517 DEF VAR level-line AS CHAR NO-UNDO.
 518 DEF VAR no-per-level AS INT NO-UNDO.
 519 DEF VAR max-per-level AS INT NO-UNDO.
 520
 521   RUN build-levels( property-code ).
 522   no-levels = 0.
 523   max-per-level = 0.
 524   no-per-level = 0.
 525   max-level-size = 0.
 526   avg-level-size = 0.0 .
 527   min-level-size = 0.
 528   FOR EACH Level WHERE Level.LevelSize > 0
 529                    AND (Level.LevelNum >= 99 OR Level.LevelNum < 90):
 530     no-levels = no-levels + 1.
 531     avg-level-size = avg-level-size + Level.LevelSize.
 532     max-level-size = MAX( max-level-size, Level.LevelSize ).
 533     min-level-size = MIN( min-level-size, Level.LevelSize ).
 534     no-per-level = 0.
 535     FOR EACH LevelUse OF Level:
 536       no-per-level = no-per-level + 1.
 537     END.
 538     max-per-level = MAX( max-per-level, no-per-level ).
 539   END.
 540   avg-level-size = avg-level-size / no-levels.
 541   IF no-levels > 8 THEN portrait = Yes.
 542   ELSE IF max-per-level > 5 THEN portrait = No.
 543   ELSE portrait = Yes.
 544
 545   IF boxes THEN RUN boxed-property-start.
 546
 547   FOR EACH Level WHERE Level.LevelSize > 0
 548                    AND (Level.LevelNum >= 99 OR Level.LevelNum < 90)
 549                     BY Level.LevelNum DESCENDING :
 550     level-line = STRING( Level.LevelNum, "->>9 ").
 551     this-level-size = Level.LevelSize.
 552     IF (ABS(last-level-size - this-level-size) / MAX(last-level-size, this-level-size)) < allowable-variation THEN
 553       this-level-size = last-level-size.
 554     IF ((max-level-size - this-level-size) / max-level-size) < allowable-variation THEN
 555       this-level-size = max-level-size.
 556
 557     RUN start-level.
 558
 559     FOR EACH LevelUse OF Level BY LevelUse.LevelNum BY LevelUse.LevelSeq BY LevelUse.UseName:
 560       RUN each-level-use( this-level-size, INPUT-OUTPUT level-line ).
 561     END.
 562
 563     RUN end-level( level-line ).
 564     last-level-size = this-level-size.
 565   END.
 566   IF boxes THEN RUN boxed-property-end.
 567
 568   IF preview THEN RUN pclrep-page-break.
 569
 570 END PROCEDURE.
 571
 572 /* _UIB-CODE-BLOCK-END */
 573 &ANALYZE-RESUME
 574
 575 &ENDIF
 576
 577 &IF DEFINED(EXCLUDE-end-level) = 0 &THEN
 578
 579 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE end-level Procedure
 580 PROCEDURE end-level :
 581 /*------------------------------------------------------------------------------
 582   Purpose:
 583 ------------------------------------------------------------------------------*/
 584 DEF INPUT PARAMETER level-details AS CHAR NO-UNDO.
 585
 586   IF boxes THEN
 587     RUN boxed-level-end.
 588   ELSE IF preview THEN
 589     RUN pclrep-line( base-font, level-details ).
 590
 591 END PROCEDURE.
 592
 593 /* _UIB-CODE-BLOCK-END */
 594 &ANALYZE-RESUME
 595
 596 &ENDIF
 597
 598 &IF DEFINED(EXCLUDE-for-each-property) = 0 &THEN
 599
 600 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE for-each-property Procedure
 601 PROCEDURE for-each-property :
 602 /*------------------------------------------------------------------------------
 603   Purpose:
 604 ------------------------------------------------------------------------------*/
 605
 606   FOR EACH Property WHERE Property.PropertyCode >= property-1
 607                       AND Property.PropertyCode <= property-n
 608                       AND Property.Active NO-LOCK:
 609     property-code = Property.PropertyCode.
 610     property-name = Property.Name.
 611     RUN each-property( property-code ).
 612   END.
 613
 614 END PROCEDURE.
 615
 616 /* _UIB-CODE-BLOCK-END */
 617 &ANALYZE-RESUME
 618
 619 &ENDIF
 620
 621 &IF DEFINED(EXCLUDE-for-one-property) = 0 &THEN
 622
 623 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE for-one-property Procedure
 624 PROCEDURE for-one-property :
 625 /*------------------------------------------------------------------------------
 626   Purpose:
 627 ------------------------------------------------------------------------------*/
 628
 629   FIND Property WHERE Property.PropertyCode = property-1 NO-LOCK NO-ERROR.
 630   IF NOT AVAILABLE Property THEN DO:
 631     RUN pclrep-line( base-font + ",bold", "Property " + STRING(property-1) + " not on file!").
 632     RETURN.
 633   END.
 634
 635   property-code = Property.PropertyCode.
 636   property-name = Property.Name.
 637   RUN each-property( property-code ).
 638
 639 END PROCEDURE.
 640
 641 /* _UIB-CODE-BLOCK-END */
 642 &ANALYZE-RESUME
 643
 644 &ENDIF
 645
 646 &IF DEFINED(EXCLUDE-inst-page-footer) = 0 &THEN
 647
 648 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 649 PROCEDURE inst-page-footer :
 650 /*------------------------------------------------------------------------------
 651   Purpose:  Print any page footer
 652 ------------------------------------------------------------------------------*/
 653
 654 END PROCEDURE.
 655
 656 /* _UIB-CODE-BLOCK-END */
 657 &ANALYZE-RESUME
 658
 659 &ENDIF
 660
 661 &IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN
 662
 663 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 664 PROCEDURE inst-page-header :
 665 /*------------------------------------------------------------------------------
 666   Purpose:  Print any page header
 667 ------------------------------------------------------------------------------*/
 668
 669   RUN pclrep-line( "univers,Point,6,bold,Proportional", TimeStamp).
 670   RUN pclrep-line( "", "" ).
 671   RUN pclrep-line( "univers,Point,12,bold,Proportional",
 672             "Property Picture" ).
 673   RUN pclrep-line( "", "" ).
 674
 675   /* Put any column headers here */
 676   pr-line = "  ".
 677   RUN pclrep-line( base-font, pr-line ).
 678   RUN pclrep-down-by(1).
 679
 680 END PROCEDURE.
 681
 682 /* _UIB-CODE-BLOCK-END */
 683 &ANALYZE-RESUME
 684
 685 &ENDIF
 686
 687 &IF DEFINED(EXCLUDE-make-sub-lease) = 0 &THEN
 688
 689 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE make-sub-lease Procedure
 690 PROCEDURE make-sub-lease :
 691 /*------------------------------------------------------------------------------
 692   Purpose:
 693 ------------------------------------------------------------------------------*/
 694 DEF INPUT PARAMETER sublease-name AS CHAR NO-UNDO.
 695 DEF INPUT PARAMETER sublease-area AS DEC NO-UNDO.
 696 DEF INPUT PARAMETER sublease-level AS INT NO-UNDO.
 697 DEF INPUT PARAMETER headlease-name AS CHAR NO-UNDO.
 698
 699   IF NOT(sublease-area > 0) THEN RETURN.
 700   IF sublease-level = ? THEN RETURN.
 701
 702 DEF BUFFER HeadLease FOR LevelUse.
 703   FIND FIRST HeadLease WHERE HeadLease.LevelNum = sublease-level
 704                          AND HeadLease.UseName = headlease-name
 705                          AND HeadLease.UseSize >= sublease-area NO-ERROR.
 706   IF NOT AVAILABLE(HeadLease) THEN RETURN.
 707
 708   sublease-name = headlease-name + " - " + sublease-name .
 709   FIND LevelUse WHERE LevelUse.LevelNum = sublease-level
 710                   AND Leveluse.UseName = sublease-name NO-ERROR.
 711   IF NOT AVAILABLE(LevelUse) THEN DO:
 712     CREATE LevelUse.
 713     LevelUse.LevelNum = sublease-level.
 714     Leveluse.UseName = sublease-name.
 715   END.
 716   LevelUse.UseSize = LevelUse.UseSize + sublease-area .
 717   LevelUse.LevelSeq = HeadLease.LevelSeq + (0.01 * sublease-counter) .
 718   HeadLease.UseSize = HeadLease.UseSize - sublease-area .
 719
 720 END PROCEDURE.
 721
 722 /* _UIB-CODE-BLOCK-END */
 723 &ANALYZE-RESUME
 724
 725 &ENDIF
 726
 727 &IF DEFINED(EXCLUDE-make-view-level) = 0 &THEN
 728
 729 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE make-view-level Procedure
 730 PROCEDURE make-view-level :
 731 /*------------------------------------------------------------------------------
 732   Purpose:
 733 ------------------------------------------------------------------------------*/
 734 DEF INPUT-OUTPUT PARAMETER residual-area AS DEC NO-UNDO.
 735 DEF INPUT-OUTPUT PARAMETER lease-name AS CHAR NO-UNDO.
 736 DEF INPUT PARAMETER floor-area AS CHAR NO-UNDO.
 737 DEF INPUT PARAMETER lease-end AS DATE NO-UNDO.
 738
 739 DEF VAR level-no AS INT NO-UNDO.
 740 DEF VAR area-size AS DEC NO-UNDO.
 741
 742   /* non-null area without other non-null fields simply adjusts area total */
 743   IF PropertyView.AreaSize <> ?
 744         AND (PropertyView.TenantName = ? AND PropertyView.Level = ? AND PropertyView.AreaType = ?) THEN DO:
 745     residual-area = residual-area - PropertyView.AreaSize.
 746     RETURN.
 747   END.
 748
 749   /* non-null name with null area simply adjusts tenant name */
 750   IF PropertyView.AreaSize = ? AND PropertyView.TenantName <> ? THEN DO:
 751     lease-name = PropertyView.TenantName.
 752     RETURN.
 753   END.
 754
 755   area-size = residual-area.
 756   IF PropertyView.AreaSize <> ? THEN area-size = PropertyView.AreaSize.
 757   residual-area = residual-area - area-size.
 758
 759   IF PropertyView.AreaType <> ? THEN
 760     floor-area = test-floor-space( PropertyView.AreaType, 15.7 ).
 761
 762   level-no = RentalSpace.Level.
 763   IF PropertyView.Level <> ? THEN level-no = PropertyView.Level.
 764   FIND Level WHERE Level.LevelNum = level-no NO-ERROR.
 765   IF NOT AVAILABLE(Level) THEN DO:
 766     CREATE Level.
 767     Level.LevelNum = level-no.
 768   END.
 769   Level.LevelSize = Level.LevelSize + area-size .
 770
 771   FIND LevelUse WHERE LevelUse.LevelNum = level-no
 772                   AND Leveluse.UseName = (IF PropertyView.TenantName <> ? THEN PropertyView.TenantName ELSE lease-name) NO-ERROR.
 773   IF NOT AVAILABLE(LevelUse) THEN DO:
 774     CREATE LevelUse.
 775     LevelUse.LevelNum = level-no.
 776     Leveluse.UseName = (IF PropertyView.TenantName <> ? THEN PropertyView.TenantName ELSE lease-name).
 777   END.
 778   LevelUse.UseSize = LevelUse.UseSize + area-size .
 779   IF LevelUse.LeaseEnd = ? AND
 780      lease-end <> ? THEN
 781     LevelUse.LeaseEnd = lease-end.
 782
 783   RUN set-level-sequence.
 784
 785 END PROCEDURE.
 786
 787 /* _UIB-CODE-BLOCK-END */
 788 &ANALYZE-RESUME
 789
 790 &ENDIF
 791
 792 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 793
 794 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 795 PROCEDURE parse-parameters :
 796 /*------------------------------------------------------------------------------
 797   Purpose:
 798 ------------------------------------------------------------------------------*/
 799 DEF VAR token AS CHAR NO-UNDO.
 800 DEF VAR i AS INT NO-UNDO.
 801 DEF VAR fin-year AS INT NO-UNDO.
 802
 803 {inc/showopts.i "report-options"}
 804
 805   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 806     token = ENTRY( i, report-options, "~n" ).
 807
 808     CASE ENTRY( 1, token ):
 809       WHEN "Preview" THEN               preview = Yes.
 810       WHEN "Sublease" THEN              subleases = Yes.
 811       WHEN "LevelAreas" THEN            show-level-areas = Yes.
 812       WHEN "AreaAreas" THEN             show-area-areas = Yes.
 813       WHEN "Selection" THEN             selection-style = ENTRY(2,token).
 814       WHEN "AllowableVariation" THEN    allowable-variation = DEC(ENTRY(2,token)).
 815       WHEN "Properties" THEN ASSIGN
 816         property-1 = INT( ENTRY(2,token) )
 817         property-n = INT( ENTRY(3,token) ).
 818     END CASE.
 819   END.
 820   boxes = NOT(preview).
 821   IF selection-style = "All" THEN ASSIGN property-1 = 0 property-n = 99999.
 822
 823   IF allowable-variation < 1 THEN allowable-variation = 3.
 824   allowable-variation = allowable-variation / 100.
 825 END PROCEDURE.
 826
 827 /* _UIB-CODE-BLOCK-END */
 828 &ANALYZE-RESUME
 829
 830 &ENDIF
 831
 832 &IF DEFINED(EXCLUDE-set-level-sequence) = 0 &THEN
 833
 834 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-level-sequence Procedure
 835 PROCEDURE set-level-sequence :
 836 /*------------------------------------------------------------------------------
 837   Purpose:
 838 ------------------------------------------------------------------------------*/
 839 DEF BUFFER LastUse FOR LevelUse.
 840
 841   IF NOT AVAILABLE(LevelUse) THEN RETURN.
 842
 843   IF AVAILABLE(PropertyView) AND PropertyView.LevelSequence <> ? THEN DO:
 844     LevelUse.LevelSeq = PropertyView.LevelSequence.
 845     RETURN.
 846   END.
 847
 848   IF AVAILABLE(RentalSpace) AND RentalSpace.LevelSequence <> ? THEN DO:
 849     LevelUse.LevelSeq = RentalSpace.LevelSequence.
 850     RETURN.
 851   END.
 852
 853   FIND LAST LastUse WHERE LastUse.LevelNum = LevelUse.LevelNum NO-ERROR.
 854   LevelUse.LevelSeq = 1 + (IF AVAILABLE(LastUse) THEN LastUse.LevelSeq ELSE 0).
 855 END PROCEDURE.
 856
 857 /* _UIB-CODE-BLOCK-END */
 858 &ANALYZE-RESUME
 859
 860 &ENDIF
 861
 862 &IF DEFINED(EXCLUDE-start-level) = 0 &THEN
 863
 864 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE start-level Procedure
 865 PROCEDURE start-level :
 866 /*------------------------------------------------------------------------------
 867   Purpose:
 868 ------------------------------------------------------------------------------*/
 869
 870   IF boxes THEN
 871     RUN boxed-level-start.
 872   ELSE IF preview THEN
 873     RUN pclrep-line( base-font, "Level " + STRING( Level.LevelNum)
 874                          + " " + STRING(Level.LevelSize)
 875                          + " " + STRING(Level.NoParks)
 876                          + " " + STRING(Level.OtherSize)
 877                          ).
 878
 879 END PROCEDURE.
 880
 881 /* _UIB-CODE-BLOCK-END */
 882 &ANALYZE-RESUME
 883
 884 &ENDIF
 885
 886 /* ************************  Function Implementations ***************** */
 887
 888 &IF DEFINED(EXCLUDE-replace-stuff) = 0 &THEN
 889
 890 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION replace-stuff Procedure
 891 FUNCTION replace-stuff RETURNS CHARACTER
 892   ( INPUT st AS CHAR ) :
 893 /*------------------------------------------------------------------------------
 894   Purpose:
 895     Notes:
 896 ------------------------------------------------------------------------------*/
 897 DEF VAR replaced AS CHAR NO-UNDO.
 898
 899   replaced = REPLACE( st, 'New Zealand', 'NZ').
 900   replaced = REPLACE( replaced, ' Limited', '').
 901   replaced = REPLACE( replaced, ' Ltd', '').
 902
 903   RETURN replaced.
 904
 905 END FUNCTION.
 906
 907 /* _UIB-CODE-BLOCK-END */
 908 &ANALYZE-RESUME
 909
 910 &ENDIF
 911
 912 &IF DEFINED(EXCLUDE-test-floor-space) = 0 &THEN
 913
 914 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION test-floor-space Procedure
 915 FUNCTION test-floor-space RETURNS CHARACTER
 916   ( INPUT type AS CHAR, INPUT area AS DECIMAL ) :
 917 /*------------------------------------------------------------------------------
 918   Purpose:  Decide if this is actual floor space
 919 ------------------------------------------------------------------------------*/
 920 DEF BUFFER LocAreaType FOR AreaType.
 921
 922   IF area = ? THEN RETURN "No".
 923   FIND LocAreaType WHERE LocAreaType.AreaType = type NO-LOCK NO-ERROR.
 924   IF AVAILABLE(LocAreaType) THEN DO:
 925     IF LocAreaType.IsCarPark THEN RETURN "Park".
 926     IF LocAreaType.IsFloorArea THEN RETURN "Yes".
 927     RETURN "No".
 928   END.
 929
 930   CASE type:
 931     WHEN "C" THEN RETURN "Park".
 932     WHEN "O" THEN RETURN "Yes".
 933     WHEN "R" THEN RETURN "Yes".
 934     WHEN "W" THEN RETURN "Yes".
 935   END CASE.
 936
 937   RETURN "No".
 938
 939 END FUNCTION.
 940
 941 /* _UIB-CODE-BLOCK-END */
 942 &ANALYZE-RESUME
 943
 944 &ENDIF
 945