process/report/wall.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        :
   6     Purpose     :
   7     Author(s)   :
   8     Created     :
   9     Notes       :
  10   ------------------------------------------------------------------------*/
  11 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
  12
  13 DEF VAR preview AS LOGICAL NO-UNDO.
  14 DEF VAR detail-report AS LOGICAL INITIAL No NO-UNDO.
  15 DEF VAR as-at-date AS DATE NO-UNDO.
  16 as-at-date = TODAY.
  17 DEF VAR zero-finished-leases AS LOGICAL INITIAL Yes NO-UNDO.
  18 RUN parse-parameters.
  19
  20 /* report variables */
  21 &GLOB NO-REGION "none as yet"
  22 DEF VAR GTRemainingValue AS DECIMAL INITIAL 0 NO-UNDO.
  23 DEF VAR GTAreaValue AS DECIMAL INITIAL 0 NO-UNDO.
  24 DEF VAR RGRemainingValue AS DECIMAL NO-UNDO.
  25 DEF VAR RGAreaValue AS DECIMAL NO-UNDO.
  26 DEF VAR last-region AS CHAR INITIAL {&NO-REGION} NO-UNDO.
  27
  28 DEF VAR LeaseRemaining AS DECIMAL NO-UNDO.
  29 DEF VAR RemainingValue AS DECIMAL NO-UNDO.
  30 DEF VAR NonZRemaining AS DECIMAL NO-UNDO.
  31 DEF VAR SumRemainingValue AS DECIMAL FORMAT "->>>,>>>,>>9.99" NO-UNDO.
  32 DEF VAR AreaValue AS DECIMAL NO-UNDO.
  33 DEF VAR SumAreaValue AS DECIMAL FORMAT "->>>,>>>,>>9.99" NO-UNDO.
  34 DEF VAR SumNonZero AS DECIMAL FORMAT "->>>,>>>,>>9.99" NO-UNDO.
  35 DEF VAR WALL AS DECIMAL FORMAT ">,>>9.99" NO-UNDO.
  36 DEF VAR dispCode AS CHAR FORMAT "X(5)" NO-UNDO.
  37 DEF VAR dispLeaseEndDate AS CHAR FORMAT "X(10)" INITIAL "" NO-UNDO.
  38
  39
  40 /* page control */
  41 DEF VAR prt-ctrl AS CHAR NO-UNDO.
  42 DEF VAR cols AS INT NO-UNDO.
  43 DEF VAR rows AS INT NO-UNDO.
  44
  45
  46 /* page header */
  47 &SCOPED-DEFINE page-width 112
  48 &SCOPED-DEFINE with-clause NO-BOX USE-TEXT NO-LABELS WIDTH {&page-width}
  49
  50 FIND FIRST Company NO-LOCK.
  51 DEF VAR user-name AS CHAR NO-UNDO.
  52 {inc/username.i "user-name"}
  53 DEF VAR timeStamp AS CHAR FORMAT "X(54)" NO-UNDO.
  54 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  55 DEF VAR hline2 AS CHAR FORMAT "X({&page-width})" NO-UNDO.
  56 DEF VAR hline3 AS CHAR FORMAT "X({&page-width})" NO-UNDO.
  57 hline2 = Company.LegalName.
  58 hline2 = SUBSTRING( STRING("","X({&page-width})"), 1, INTEGER(({&page-width} - LENGTH(hline2) ) / 2)) + hline2.
  59 hline3 = "Weighted Average Lease Life".
  60 IF as-at-date <> TODAY THEN hline3 = hline3 + " as at " + STRING( as-at-date, "99/99/9999").
  61 hline3 = SUBSTRING( STRING("","X({&page-width})"), 1, INTEGER(({&page-width} - LENGTH(hline3) ) / 2)) + hline3.
  62
  63 DEFINE FRAME heading-frame WITH 1 DOWN {&with-clause} PAGE-TOP.
  64 FORM HEADER
  65     timeStamp  "Page " + STRING( PAGE-NUMBER ) TO {&page-width} SKIP (1)
  66     hline2 FORMAT "X({&page-width})"
  67     hline3 FORMAT "X({&page-width})" SKIP (2)
  68     "                                                            - - Contracted Rentals - -" SKIP
  69     "Code  Name                                                   Remaining      Annualised   W.A.L.L."
  70     WITH FRAME heading-frame.
  71
  72
  73 DEFINE FRAME report-line WITH DOWN {&with-clause}.
  74 FORM dispCode
  75      Property.Name
  76      SumRemainingValue
  77      SumAreaValue
  78      WALL
  79      dispLeaseEndDate
  80      WITH FRAME report-line.
  81
  82 {inc/ofc-this.i}
  83 {inc/ofc-set.i "WALL-Exclude-Areas" "exclude-area-list"}
  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
 103 /* *********************** Procedure Settings ************************ */
 104
 105 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 106 /* Settings for THIS-PROCEDURE
 107    Type: Procedure
 108    Allow:
 109    Frames: 0
 110    Add Fields to: Neither
 111    Other Settings: CODE-ONLY COMPILE
 112  */
 113 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 114
 115 /* *************************  Create Window  ************************** */
 116
 117 &ANALYZE-SUSPEND _CREATE-WINDOW
 118 /* DESIGN Window definition (used by the UIB)
 119   CREATE WINDOW Procedure ASSIGN
 120          HEIGHT             = 18.45
 121          WIDTH              = 39.
 122 /* END WINDOW DEFINITION */
 123                                                                         */
 124 &ANALYZE-RESUME
 125
 126 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 127 /* ************************* Included-Libraries *********************** */
 128
 129 {inc/method/m-txtrep.i}
 130
 131 /* _UIB-CODE-BLOCK-END */
 132 &ANALYZE-RESUME
 133
 134
 135
 136
 137
 138 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 139
 140
 141 /* ***************************  Main Block  *************************** */
 142
 143 RUN make-control-string ( "PCL", "reset,portrait,tm,2,a4,lm,6,courier,cpi,18,lpi,9",
 144                 OUTPUT prt-ctrl, OUTPUT rows, OUTPUT cols ).
 145
 146 RUN output-control-file ( prt-ctrl ).
 147 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE VALUE(rows).
 148
 149 VIEW FRAME heading-frame.
 150
 151   FOR EACH Property WHERE Property.Active NO-LOCK
 152                 BY Property.Region BY Property.ShortName:
 153     IF last-region <> Property.Region THEN RUN new-region( last-region, Property.Region).
 154     RUN each-property.
 155   END.
 156   RUN new-region( last-region, {&NO-REGION} ).
 157   PUT SKIP (2).
 158   WALL = GTRemainingValue / GTAreaValue.
 159   RUN put-dashes.
 160   DISPLAY "" @ dispCode
 161           ("Total for Portfolio") @ Property.Name
 162           GTRemainingValue @ SumRemainingValue
 163           GTAreaValue @ SumAreaValue
 164           WALL
 165           WITH FRAME report-line.
 166
 167 OUTPUT CLOSE.
 168 /* IF preview THEN RUN set-viewer-title( 'Weighted Average Lease Life' ). */
 169 RUN view-output-file ( preview ).
 170
 171 /* _UIB-CODE-BLOCK-END */
 172 &ANALYZE-RESUME
 173
 174
 175 /* **********************  Internal Procedures  *********************** */
 176
 177 &IF DEFINED(EXCLUDE-each-property) = 0 &THEN
 178
 179 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-property Procedure
 180 PROCEDURE each-property :
 181 /*------------------------------------------------------------------------------
 182   Purpose:
 183   Parameters:  <none>
 184   Notes:
 185 ------------------------------------------------------------------------------*/
 186   SumAreaValue = 0.
 187   SumRemainingValue = 0.
 188   SumNonZero = 0.
 189
 190   FOR EACH RentalSpace OF Property NO-LOCK
 191             WHERE RentalSpace.AreaStatus <> "V"
 192             AND LOOKUP( RentalSpace.AreaType, exclude-area-list ) = 0
 193             AND CAN-FIND( FIRST TenancyLease OF RentalSpace WHERE TenancyLease.LeaseStatus <> "PAST"):
 194     RUN each-rental-space.
 195   END.
 196   /* Don't print if it's zero */
 197   IF SumRemainingValue = 0 AND SumAreaValue = 0 THEN RETURN.
 198
 199   WALL = SumRemainingValue / SumAreaValue.
 200   RGRemainingValue = RGRemainingValue + SumRemainingValue.
 201   RGAreaValue = RGAreaValue + SumAreaValue.
 202   IF detail-report THEN RUN put-dashes.
 203   RUN put-line( STRING( Property.PropertyCode, "99999"), Property.Name,
 204                 SumRemainingValue, SumAreaValue, WALL, "", SumNonZero ).
 205
 206   IF detail-report THEN PUT SKIP(1).
 207
 208 END PROCEDURE.
 209
 210 /* _UIB-CODE-BLOCK-END */
 211 &ANALYZE-RESUME
 212
 213 &ENDIF
 214
 215 &IF DEFINED(EXCLUDE-each-rental-space) = 0 &THEN
 216
 217 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-rental-space Procedure
 218 PROCEDURE each-rental-space :
 219 /*------------------------------------------------------------------------------
 220   Purpose:
 221 ------------------------------------------------------------------------------*/
 222   FIND TenancyLease OF RentalSpace NO-LOCK NO-ERROR.
 223   IF AVAILABLE(TenancyLease) THEN DO:
 224     AreaValue = RentalSpace.ContractedRental.
 225     NonZRemaining = AreaValue.
 226     LeaseRemaining = TenancyLease.LeaseEndDate - as-at-date.
 227     IF LeaseRemaining = ? OR LeaseRemaining < 30.4375 THEN DO:
 228       LeaseRemaining = 30.4375.
 229       NonZRemaining = 0.
 230     END.
 231     ELSE IF LeaseRemaining < 365 THEN DO:
 232       NonZRemaining = AreaValue * (LeaseRemaining / 365.25) .
 233     END.
 234     LeaseRemaining = LeaseRemaining / 365.25.
 235     RemainingValue = AreaValue * LeaseRemaining.
 236
 237     IF as-at-date > TODAY + 30 THEN DO:
 238       IF TenancyLease.LeaseEndDate < as-at-date THEN DO:
 239         LeaseRemaining = 0.
 240         RemainingValue = 0.
 241         AreaValue = 0.
 242         NonZRemaining = 0.
 243         RemainingValue = 0.
 244       END.
 245     END.
 246
 247     IF detail-report AND RemainingValue <> 0 THEN DO:
 248       dispLeaseEndDate = IF LeaseRemaining <= (31 / 365.25) THEN "  Monthly"
 249                          ELSE STRING( TenancyLease.LeaseEndDate, "99/99/9999").
 250       FIND Tenant WHERE Tenant.TenantCode = TenancyLease.TenantCode NO-LOCK NO-ERROR.
 251
 252       RUN put-line( "", IF AVAILABLE(Tenant) THEN Tenant.Name ELSE "* * * Tenant not on file! * * *",
 253                         RemainingValue, AreaValue, LeaseRemaining, dispLeaseEndDate, NonZRemaining).
 254     END.
 255   END.
 256   ELSE DO:
 257     RemainingValue = 0.
 258     AreaValue = 0.
 259   END.
 260
 261   SumAreaValue = SumAreaValue + AreaValue.
 262   SumRemainingValue = SumRemainingValue + RemainingValue.
 263   SumNonZero = SumNonZero + NonZRemaining.
 264
 265
 266 END PROCEDURE.
 267
 268 /* _UIB-CODE-BLOCK-END */
 269 &ANALYZE-RESUME
 270
 271 &ENDIF
 272
 273 &IF DEFINED(EXCLUDE-get-region-name) = 0 &THEN
 274
 275 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-region-name Procedure
 276 PROCEDURE get-region-name :
 277 /*------------------------------------------------------------------------------
 278   Purpose:
 279 ------------------------------------------------------------------------------*/
 280 DEF INPUT PARAMETER region-code AS CHAR NO-UNDO.
 281 DEF OUTPUT PARAMETER region-name AS CHAR NO-UNDO.
 282
 283   CASE region-code:
 284     WHEN "akld" THEN region-name = "Auckland".
 285     WHEN "wgtn" THEN region-name = "Wellington".
 286     WHEN "rot" THEN region-name = "Rotorua".
 287     WHEN "chch" THEN region-name = "Christchurch".
 288     WHEN "ham" THEN region-name = "Hamilton".
 289     WHEN "ZZZZ" THEN region-name = "Sundry".
 290     OTHERWISE DO:
 291       region-name = CAPS( region-code ) + " buildings".
 292     END.
 293   END.
 294 END PROCEDURE.
 295
 296 /* _UIB-CODE-BLOCK-END */
 297 &ANALYZE-RESUME
 298
 299 &ENDIF
 300
 301 &IF DEFINED(EXCLUDE-new-region) = 0 &THEN
 302
 303 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE new-region Procedure
 304 PROCEDURE new-region :
 305 /*------------------------------------------------------------------------------
 306   Purpose:  Show totals for last region, heading for next one
 307 ------------------------------------------------------------------------------*/
 308 DEF INPUT PARAMETER lst-region AS CHAR NO-UNDO.
 309 DEF INPUT PARAMETER nxt-region AS CHAR NO-UNDO.
 310
 311 DEF VAR region-name AS CHAR NO-UNDO.
 312
 313   IF lst-region <> {&NO-REGION} AND RGRemainingValue <> 0 AND RGAreaValue <> 0 THEN DO:
 314     RUN get-region-name( lst-region, OUTPUT region-name).
 315     WALL = RGRemainingValue / RGAreaValue.
 316     RUN put-dashes.
 317     DISPLAY "" @ dispCode
 318             ("Total for " + region-name) @ Property.Name
 319             RGRemainingValue @ SumRemainingValue
 320             RGAreaValue @ SumAreaValue
 321             WALL
 322             WITH FRAME report-line.
 323     RUN put-dashes.
 324     PUT SKIP ( IF detail-report THEN (2) ELSE (1) ).
 325   END.
 326
 327   ASSIGN
 328     GTRemainingValue = GTRemainingValue + RGRemainingValue
 329     GTAreaValue = GTAreaValue + RGAreaValue
 330     RGRemainingValue = 0
 331     RGAreaValue = 0
 332   .
 333
 334   IF nxt-region <> {&NO-REGION} THEN DO:
 335     RUN get-region-name( lst-region, OUTPUT region-name).
 336   END.
 337   last-region = nxt-region.
 338
 339 END PROCEDURE.
 340
 341 /* _UIB-CODE-BLOCK-END */
 342 &ANALYZE-RESUME
 343
 344 &ENDIF
 345
 346 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 347
 348 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 349 PROCEDURE parse-parameters :
 350 /*------------------------------------------------------------------------------
 351   Purpose:
 352 ------------------------------------------------------------------------------*/
 353 DEF VAR i           AS INT NO-UNDO.
 354 DEF VAR token       AS CHAR NO-UNDO.
 355
 356 {inc/showopts.i "report-options"}
 357
 358   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 359     token = ENTRY( i, report-options, "~n" ).
 360     CASE( ENTRY( 1, token ) ):
 361       WHEN "Detail" THEN detail-report = Yes.
 362       WHEN "Preview" THEN preview = Yes.
 363       WHEN "AsAt" THEN as-at-date = DATE( ENTRY(2,token) ).
 364       WHEN "ZeroFinishedLeases" THEN zero-finished-leases = Yes.
 365     END CASE.
 366   END.
 367
 368 END PROCEDURE.
 369
 370 /* _UIB-CODE-BLOCK-END */
 371 &ANALYZE-RESUME
 372
 373 &ENDIF
 374
 375 &IF DEFINED(EXCLUDE-put-dashes) = 0 &THEN
 376
 377 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE put-dashes Procedure
 378 PROCEDURE put-dashes :
 379 /*------------------------------------------------------------------------------
 380   Purpose: Put a line of dashes on the output file
 381 ------------------------------------------------------------------------------*/
 382
 383     PUT UNFORMATTED FILL(' ', 57) + FILL('-',14) + ' ' + FILL('-',14) + '  ' + FILL('-',7) SKIP.
 384
 385 END PROCEDURE.
 386
 387 /* _UIB-CODE-BLOCK-END */
 388 &ANALYZE-RESUME
 389
 390 &ENDIF
 391
 392 &IF DEFINED(EXCLUDE-put-line) = 0 &THEN
 393
 394 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE put-line Procedure
 395 PROCEDURE put-line :
 396 /*------------------------------------------------------------------------------
 397   Purpose:
 398 ------------------------------------------------------------------------------*/
 399 DEF INPUT PARAMETER code AS CHAR NO-UNDO.
 400 DEF INPUT PARAMETER name AS CHAR NO-UNDO.
 401 DEF INPUT PARAMETER remain AS DEC NO-UNDO.
 402 DEF INPUT PARAMETER avalue AS DEC NO-UNDO.
 403 DEF INPUT PARAMETER awall AS DEC NO-UNDO.
 404 DEF INPUT PARAMETER ddate AS CHAR NO-UNDO.
 405 DEF INPUT PARAMETER zvalue AS DEC NO-UNDO.
 406
 407   PUT UNFORMATTED STRING( code, "X(5)") SPACE
 408                   STRING( name, "X(50)") SPACE
 409                   STRING( remain,"->>>,>>>,>>9.99") SPACE
 410                   STRING( avalue,"->>>,>>>,>>9.99") SPACE
 411                   STRING( awall,">,>>9.99") SPACE
 412                   STRING( ddate, "X(10)")
 413                   STRING( zvalue,"->>>,>>>,>>9.99") SPACE
 414                   SKIP.
 415
 416 END PROCEDURE.
 417
 418 /* _UIB-CODE-BLOCK-END */
 419 &ANALYZE-RESUME
 420
 421 &ENDIF
 422