?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Add blank column, rename column.
[capital-apms-progress.git] / process / report / schdapl.p
blob05fe1f93a2379bab74356f83d9954f9621f39409
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
12 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
13
14 DEF VAR preview AS LOGICAL NO-UNDO.
15 DEF VAR exporting AS LOGICAL NO-UNDO INITIAL No.
16 DEF VAR debug-mode AS LOGICAL NO-UNDO INITIAL No.
17 DEF VAR for-agents AS LOGICAL NO-UNDO INITIAL No.
18 DEF VAR file-name AS CHAR NO-UNDO INITIAL ?.
19 DEF VAR selection-style AS CHAR NO-UNDO INITIAL "RP".
20 DEF VAR show-warnings AS LOGI NO-UNDO INITIAL No.
21 DEF VAR show-future-charges AS LOGI NO-UNDO INITIAL No.
22 DEF VAR level-summaries AS LOGI NO-UNDO INITIAL No.
23 DEF VAR property-1 AS INTEGER NO-UNDO.
24 DEF VAR property-n AS INTEGER NO-UNDO.
25 DEF VAR run-date AS DATE NO-UNDO.
26 RUN parse-parameters.
27
28 DEF VAR no-on-level AS INT NO-UNDO.
29 DEF VAR printing-tenancies AS LOGI NO-UNDO INITIAL No.
30
31 DEF VAR building-rental AS DEC NO-UNDO.
32 DEF VAR building-floor AS DEC NO-UNDO.
33 DEF VAR building-parks AS DEC NO-UNDO.
34
35 DEF VAR base-font AS CHAR NO-UNDO INITIAL "courier,lpi,12,cpi,23,normal,fixed".
36 DEF VAR tenancies-font AS CHAR NO-UNDO INITIAL "courier,lpi,9.6,cpi,19,normal,fixed".
37 DEF VAR overview-font AS CHAR NO-UNDO INITIAL "courier,lpi,7,cpi,14,normal,fixed".
38 DEF VAR page-reset AS CHAR NO-UNDO INITIAL "reset,landscape,lm,3,tm,4".
39 DEF VAR disclaimer-font AS CHAR NO-UNDO INITIAL "Times,point,6,proportional,normal".
40 DEF VAR page-header-font AS CHAR NO-UNDO INITIAL "Helvetica,point,12,proportional,bold".
41 DEF VAR error-font1 AS CHAR NO-UNDO INITIAL "courier,lpi,10,cpi,18,normal,bold,fixed".
42 DEF VAR error-font2 AS CHAR NO-UNDO INITIAL "courier,lpi,9,cpi,18,normal,italic,fixed".
43
44 DEFINE TEMP-TABLE Tenancies NO-UNDO
45 FIELD Level AS INT
46 FIELD LevelSeq AS INT
47 FIELD AreaStatus AS CHAR
48 FIELD AreaDescription AS CHAR
49 FIELD TenantName AS CHAR
50 FIELD TenantCode AS INT
51 FIELD LeaseCode AS INT
52 FIELD Quality AS INT
53 FIELD FloorArea AS DEC
54 FIELD NoCarparks AS DEC
55 FIELD MiscArea AS DEC
56 FIELD FloorAreaLeased AS DEC
57 FIELD NoCarparksLeased AS DEC
58 FIELD FloorRent AS DEC
59 FIELD ParkRent AS DEC
60 FIELD MiscRent AS DEC
61 FIELD Expiry AS DATE
62 FIELD YearsToRun AS DEC
63 FIELD NextReview AS DATE
64 FIELD Renewal AS CHAR
65 FIELD NetLease AS LOGI
66 FIELD MarketPSF AS DEC
67 FIELD MarketPPK AS DEC
68 INDEX XPKTenancies IS UNIQUE PRIMARY Level LevelSeq TenantCode LeaseCode.
69
70 DEF VAR month-1 AS INT NO-UNDO.
71 DEF VAR month-n AS INT NO-UNDO.
72 FIND LAST Month WHERE Month.EndDate < TODAY NO-LOCK.
73 FIND FinancialYear OF Month NO-LOCK.
74 FIND FIRST Month OF FinancialYear NO-LOCK.
75 month-1 = Month.MonthCode.
76 FIND LAST Month OF FinancialYear NO-LOCK.
77 month-n = Month.MonthCode.
78
79 {inc/ofc-this.i}
80 {inc/ofc-set.i "Area-Units" "area-units"}
81 DEF VAR area-units-short AS CHAR NO-UNDO.
82 IF NOT AVAILABLE(OfficeSetting) THEN ASSIGN
83 area-units = "Sq.M".
84 area-units-short = LOWER( "P" + REPLACE( REPLACE( area-units, "Q", ""), ".", "")).
85
86 /* _UIB-CODE-BLOCK-END */
87 &ANALYZE-RESUME
88
89
90 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
91
92 /* ******************** Preprocessor Definitions ******************** */
93
94 &Scoped-define PROCEDURE-TYPE Procedure
95 &Scoped-define DB-AWARE no
96
97
98
99 /* _UIB-PREPROCESSOR-BLOCK-END */
100 &ANALYZE-RESUME
101
102
103 /* ************************ Function Prototypes ********************** */
104
105 &IF DEFINED(EXCLUDE-amount-and-psf) = 0 &THEN
106
107 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD amount-and-psf Procedure
108 FUNCTION amount-and-psf RETURNS CHARACTER
109 ( INPUT amount AS DEC ) FORWARD.
110
111 /* _UIB-CODE-BLOCK-END */
112 &ANALYZE-RESUME
113
114 &ENDIF
115
116 &IF DEFINED(EXCLUDE-get-account-budget) = 0 &THEN
117
118 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-account-budget Procedure
119 FUNCTION get-account-budget RETURNS DECIMAL
120 ( INPUT et AS CHAR, INPUT ec AS INT, INPUT ac AS DEC, INPUT m-1 AS INT, INPUT m-n AS INT ) FORWARD.
121
122 /* _UIB-CODE-BLOCK-END */
123 &ANALYZE-RESUME
124
125 &ENDIF
126
127 &IF DEFINED(EXCLUDE-get-annual-amount) = 0 &THEN
128
129 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-annual-amount Procedure
130 FUNCTION get-annual-amount RETURNS DECIMAL
131 ( INPUT period-amount AS DEC, INPUT freq-type AS CHAR ) FORWARD.
132
133 /* _UIB-CODE-BLOCK-END */
134 &ANALYZE-RESUME
135
136 &ENDIF
137
138 &IF DEFINED(EXCLUDE-get-level-code) = 0 &THEN
139
140 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-level-code Procedure
141 FUNCTION get-level-code RETURNS CHARACTER
142 ( INPUT l-no AS INT, INPUT l-seq AS INT ) FORWARD.
143
144 /* _UIB-CODE-BLOCK-END */
145 &ANALYZE-RESUME
146
147 &ENDIF
148
149 &IF DEFINED(EXCLUDE-sum-group) = 0 &THEN
150
151 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD sum-group Procedure
152 FUNCTION sum-group RETURNS DECIMAL
153 ( INPUT group-list AS CHAR, INPUT pattern AS CHAR, INPUT amt-type AS CHAR ) FORWARD.
154
155 /* _UIB-CODE-BLOCK-END */
156 &ANALYZE-RESUME
157
158 &ENDIF
159
160
161 /* *********************** Procedure Settings ************************ */
162
163 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
164 /* Settings for THIS-PROCEDURE
165 Type: Procedure
166 Allow:
167 Frames: 0
168 Add Fields to: Neither
169 Other Settings: CODE-ONLY COMPILE
170 */
171 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
172
173 /* ************************* Create Window ************************** */
174
175 &ANALYZE-SUSPEND _CREATE-WINDOW
176 /* DESIGN Window definition (used by the UIB)
177 CREATE WINDOW Procedure ASSIGN
178 HEIGHT = 28.95
179 WIDTH = 36.14.
180 /* END WINDOW DEFINITION */
181 */
182 &ANALYZE-RESUME
183
184 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
185 /* ************************* Included-Libraries *********************** */
186
187 {inc/method/m-hpgl.i}
188 {inc/date.i}
189 {inc/null.i}
190 {inc/method/m-txtrep.i}
191
192 /* _UIB-CODE-BLOCK-END */
193 &ANALYZE-RESUME
194
195
196
197
198
199 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
200
201
202 /* *************************** Main Block *************************** */
203
204 RUN pclrep-start( preview, page-reset + "," + base-font ).
205 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES APPEND.
206
207 FOR EACH Property WHERE Property.Active AND Property.PropertyCode >= property-1
208 AND Property.PropertyCode <= property-n NO-LOCK:
209 RUN property-schedule.
210 END.
211
212 OUTPUT CLOSE.
213
214 RUN pclrep-finish.
215
216 /* _UIB-CODE-BLOCK-END */
217 &ANALYZE-RESUME
218
219
220 /* ********************** Internal Procedures *********************** */
221
222 &IF DEFINED(EXCLUDE-building-financial) = 0 &THEN
223
224 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE building-financial Procedure
225 PROCEDURE building-financial :
226 /*------------------------------------------------------------------------------
227 Purpose:
228 ------------------------------------------------------------------------------*/
229 RUN pclrep-down-by( 1.2 ).
230 RUN pclrep-line( page-header-font, "Financial Information $ $" + area-units-short ).
231 RUN pclrep-down-by( 0.3 ).
232
233 DEF VAR income AS DEC NO-UNDO.
234 DEF VAR expenses AS DEC NO-UNDO.
235 DEF VAR recoveries AS DEC NO-UNDO.
236 DEF VAR net-income AS DEC NO-UNDO.
237 DEF VAR prop-value AS DEC NO-UNDO.
238 DEF VAR yield AS DEC NO-UNDO.
239
240 income = building-rental.
241 IF CAN-FIND( FIRST TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST"
242 AND TenancyLease.RecoveryType = "A")
243 THEN
244 RUN calculate-expenses-actual( OUTPUT expenses, OUTPUT recoveries).
245 ELSE
246 RUN calculate-expenses-budget( OUTPUT expenses, OUTPUT recoveries).
247
248 net-income = income - expenses + recoveries.
249 prop-value = sum-group( "PROP", "*", "Balance").
250 yield = (net-income / prop-value) * 100.
251 IF yield = ? THEN yield = 0.
252
253 RUN pclrep-line( overview-font, "Income: " + STRING( income, "->>>,>>>,>>9" ) ).
254 RUN pclrep-line( overview-font, "Property expenses: " + amount-and-psf( expenses ) ).
255 RUN pclrep-line( overview-font + ",lpi,14", "Property recoveries: " + amount-and-psf( recoveries ) ).
256 RUN pclrep-line( overview-font + ",lpi,14", " " + FILL( "-", 12 ) ).
257 RUN pclrep-line( overview-font + ",lpi,14", "Net Income: " + STRING( net-income, "->>>,>>>,>>9" ) ).
258 RUN pclrep-line( overview-font, " " + FILL( "=", 12 ) ).
259 RUN pclrep-line( overview-font, "Property value: " + amount-and-psf( prop-value ) ).
260 RUN pclrep-line( overview-font, "Yield: " + STRING( yield, "->,>>>,>>9.9" ) + " %").
261
262 END PROCEDURE.
263
264 /* _UIB-CODE-BLOCK-END */
265 &ANALYZE-RESUME
266
267 &ENDIF
268
269 &IF DEFINED(EXCLUDE-building-overview) = 0 &THEN
270
271 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE building-overview Procedure
272 PROCEDURE building-overview :
273 /*------------------------------------------------------------------------------
274 Purpose:
275 ------------------------------------------------------------------------------*/
276 DEF VAR description-codes AS CHAR NO-UNDO.
277 DEF VAR wall AS DEC NO-UNDO.
278 DEF VAR wqal AS DEC NO-UNDO.
279 DEF VAR avg-floor AS DEC NO-UNDO.
280 DEF VAR base-market AS DEC NO-UNDO.
281 DEF VAR base-carpark AS DEC NO-UNDO.
282 DEF VAR occupancy AS DEC NO-UNDO.
283
284 RUN pclrep-line( base-font, "" ).
285 FIND ConstructionDetails OF Property NO-LOCK NO-ERROR.
286 IF NOT AVAILABLE(ConstructionDetails) THEN DO TRANSACTION:
287 CREATE ConstructionDetails.
288 ConstructionDetails.PropertyCode = Property.PropertyCode.
289 FIND CURRENT ConstructionDetails NO-LOCK.
290 END.
291 RUN hpgl-clear.
292 IF TRIM(ConstructionDetails.DescriptionText) <> "" THEN DO:
293 RUN hpgl-moveto(122,184).
294 RUN hpgl-text( page-header-font, "Building Description" ).
295 RUN hpgl-move-relative( 0, -7).
296 RUN hpgl-wrap-lines( page-header-font + ",normal",
297 REPLACE( ConstructionDetails.DescriptionText, "~n", " "),
298 80, -4.5 ).
299 END.
300 IF for-agents THEN DO:
301 RUN hpgl-moveto(13.5,8).
302 RUN hpgl-wrap-lines( disclaimer-font,
303 "The information supplied by Amtrust Pacific Limited in this summary is provided "
304 + "in good faith and to the best of its knowledge is true and accurate. However "
305 + "AmTrust Pacific Limited nor any of its related companies, officers or "
306 + "employees, or appointed agents makes any representation or warranty, express "
307 + "or implied, as to the completeness or accuracy of such information or accepts "
308 + "any liability to any person that may result from this summary.",
309 280, -1.9 ).
310 END.
311 RUN hpgl-moveto(13.5,184).
312 RUN hpgl-get-codes( No, Yes, OUTPUT description-codes ).
313
314 PUT CONTROL description-codes.
315
316 RUN pclrep-line( page-header-font, "Overview" ).
317 RUN pclrep-down-by( 0.5 ).
318 /* RUN pclrep-line( overview-font, "Ranking by Property Value: " + STRING( Property.Ranking, "->>9" ) ). */
319 RUN pclrep-line( overview-font, "Age: " + STRING( YEAR(ConstructionDetails.ConstructionDate), "9999" ) ).
320
321 RUN get-statistics( OUTPUT wall, OUTPUT wqal, OUTPUT avg-floor, OUTPUT base-market, OUTPUT base-carpark, OUTPUT occupancy).
322 RUN pclrep-line( overview-font, "Weighted average rental duration: " + STRING( wall, "->>9.9" ) ).
323 IF NOT for-agents THEN RUN pclrep-line( overview-font, "Weighted quality: " + STRING( wqal, "->>9.9" ) ).
324 RUN pclrep-line( overview-font, "Average floor rent ($" + area-units-short + "): " + STRING( avg-floor, "->>>,>>9.99" ) ).
325 IF NOT for-agents THEN RUN pclrep-line( overview-font, "Base market floor rent ($" + area-units-short + "): " + STRING( base-market, "->>>,>>9.99" ) ).
326 IF NOT for-agents THEN RUN pclrep-line( overview-font, "Base market carpark rent ($PW): " + STRING( base-carpark, "->>>,>>9.99" ) ).
327 RUN pclrep-line( overview-font, "Occupancy factor: " + STRING( occupancy, "->>>9" ) + " %" ).
328
329 END PROCEDURE.
330
331 /* _UIB-CODE-BLOCK-END */
332 &ANALYZE-RESUME
333
334 &ENDIF
335
336 &IF DEFINED(EXCLUDE-building-tenancies) = 0 &THEN
337
338 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE building-tenancies Procedure
339 PROCEDURE building-tenancies :
340 /*------------------------------------------------------------------------------
341 Purpose:
342 ------------------------------------------------------------------------------*/
343 printing-tenancies = Yes.
344
345 RUN pclrep-down-by( 1.2 ).
346 RUN pclrep-skip-to( 55 ).
347 RUN pclrep-line( page-header-font, "Tenancies" ).
348 RUN pclrep-down-by( -0.2 ).
349
350 RUN tenancies-column-headers.
351
352 FOR EACH Tenancies WHERE Tenancies.Level < 90
353 BY Tenancies.TenantCode BY Tenancies.Level BY Tenancies.LevelSeq:
354 RUN print-tenancies-line.
355 END.
356
357 IF CAN-FIND( FIRST Tenancies WHERE Tenancies.Level >= 90 AND Tenancies.Level < 99999 ) THEN
358 RUN pclrep-down-by( 1 ).
359
360 FOR EACH Tenancies WHERE Tenancies.Level >= 90
361 BY Tenancies.TenantCode BY Tenancies.Level BY Tenancies.LevelSeq:
362 RUN print-tenancies-line.
363 END.
364
365 IF show-warnings AND (Property.TotalArea <> building-floor
366 OR Property.TotalParks <> building-parks)
367 THEN DO:
368 RUN pclrep-down-by( 1 ).
369 RUN pclrep-line( tenancies-font + ",bold", FILL(" ",20)
370 + "* * * WARNING * * *" + FILL(" ",5)
371 + "Sum of areas = " + TRIM(STRING(building-floor, "->>,>>>,>>9.99"))
372 + ", from property file = " + TRIM(STRING(Property.TotalArea, "->>,>>>,>>9.99"))
373 + FILL(" ",15)
374 + "Sum of parks = " + TRIM(STRING(building-parks, "->>,>>>,>>9"))
375 + ", from property file = " + TRIM(STRING(Property.TotalParks, "->>,>>>,>>9")) ).
376 END.
377
378 END PROCEDURE.
379
380 /* _UIB-CODE-BLOCK-END */
381 &ANALYZE-RESUME
382
383 &ENDIF
384
385 &IF DEFINED(EXCLUDE-calculate-expenses-actual) = 0 &THEN
386
387 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE calculate-expenses-actual Procedure
388 PROCEDURE calculate-expenses-actual :
389 /*------------------------------------------------------------------------------
390 Purpose:
391 ------------------------------------------------------------------------------*/
392 DEF OUTPUT PARAMETER expense AS DEC NO-UNDO INITIAL 0.
393 DEF OUTPUT PARAMETER recover AS DEC NO-UNDO INITIAL 0.
394
395 DEF VAR acct-budget AS DEC NO-UNDO.
396 DEF VAR lease-percent AS DEC NO-UNDO.
397
398 FOR EACH ChartOfAccount WHERE ChartOfAccount.ExpenseRecoveryType = "P" NO-LOCK:
399 acct-budget = get-account-budget( "P", Property.PropertyCode, ChartOfAccount.AccountCode, month-1, month-n).
400 IF acct-budget = 0 THEN NEXT.
401
402 expense = expense + acct-budget .
403 FOR EACH TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST"
404 AND TenancyLease.RecoveryType = "A" NO-LOCK:
405 FIND TenancyOutgoing OF TenancyLease WHERE TenancyOutgoing.AccountCode = ChartOfAccount.AccountCode NO-LOCK NO-ERROR.
406 IF AVAILABLE(TenancyOutgoing) THEN DO:
407 lease-percent = TenancyOutgoing.Percentage.
408 IF TenancyOutgoing.FixedAmount > 0 THEN DO:
409 lease-percent = 0.
410 recover = recover + TenancyOutgoing.FixedAmount .
411 END.
412 END.
413 ELSE
414 lease-percent = TenancyLease.OutgoingsRate.
415
416 recover = recover + (acct-budget * lease-percent / 100).
417 END.
418 END.
419
420 FOR EACH TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST"
421 AND TenancyLease.RecoveryType = "F" NO-LOCK:
422 recover = recover + TenancyLease.OutgoingsBudget .
423 END.
424
425 END PROCEDURE.
426
427 /* _UIB-CODE-BLOCK-END */
428 &ANALYZE-RESUME
429
430 &ENDIF
431
432 &IF DEFINED(EXCLUDE-calculate-expenses-budget) = 0 &THEN
433
434 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE calculate-expenses-budget Procedure
435 PROCEDURE calculate-expenses-budget :
436 /*------------------------------------------------------------------------------
437 Purpose:
438 ------------------------------------------------------------------------------*/
439 DEF OUTPUT PARAMETER expense AS DEC NO-UNDO INITIAL 0.
440 DEF OUTPUT PARAMETER recover AS DEC NO-UNDO INITIAL 0.
441
442 DEF VAR lease-percent AS DEC NO-UNDO.
443 FOR EACH PropertyOutgoing OF Property NO-LOCK,
444 FIRST ChartOfAccount OF PropertyOutgoing NO-LOCK:
445 IF PropertyOutgoing.BudgetAmount = 0 THEN NEXT.
446 IF ChartOfAccount.ExpenseRecoveryType = "O" THEN NEXT.
447 expense = expense + PropertyOutgoing.BudgetAmount .
448 FOR EACH TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST"
449 AND TenancyLease.RecoveryType = "B" NO-LOCK:
450 FIND TenancyOutgoing OF TenancyLease WHERE TenancyOutgoing.AccountCode = PropertyOutgoing.AccountCode NO-LOCK NO-ERROR.
451 IF AVAILABLE(TenancyOutgoing) THEN DO:
452 lease-percent = TenancyOutgoing.Percentage.
453 IF TenancyOutgoing.FixedAmount > 0 THEN DO:
454 lease-percent = 0.
455 recover = recover + TenancyOutgoing.FixedAmount .
456 END.
457 END.
458 ELSE
459 lease-percent = TenancyLease.OutgoingsRate.
460
461 recover = recover + (PropertyOutgoing.BudgetAmount * lease-percent / 100).
462 END.
463 END.
464
465 FOR EACH ChartOfAccount WHERE ChartOfAccount.ExpenseRecoveryType = "O" NO-LOCK:
466 FOR EACH TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST"
467 AND TenancyLease.RecoveryType = "B" NO-LOCK:
468 FIND TenancyOutgoing OF TenancyLease WHERE TenancyOutgoing.AccountCode = ChartOfAccount.AccountCode NO-LOCK NO-ERROR.
469 IF AVAILABLE(TenancyOutgoing) THEN
470 recover = recover + TenancyOutgoing.FixedAmount .
471 END.
472 END.
473
474 FOR EACH TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST"
475 AND TenancyLease.RecoveryType = "F" NO-LOCK:
476 recover = recover + TenancyLease.OutgoingsBudget .
477 END.
478
479 END PROCEDURE.
480
481 /* _UIB-CODE-BLOCK-END */
482 &ANALYZE-RESUME
483
484 &ENDIF
485
486 &IF DEFINED(EXCLUDE-get-statistics) = 0 &THEN
487
488 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-statistics Procedure
489 PROCEDURE get-statistics :
490 /*------------------------------------------------------------------------------
491 Purpose:
492 ------------------------------------------------------------------------------*/
493 DEF OUTPUT PARAMETER wall AS DEC NO-UNDO.
494 DEF OUTPUT PARAMETER wqal AS DEC NO-UNDO.
495 DEF OUTPUT PARAMETER avg-floor AS DEC NO-UNDO.
496 DEF OUTPUT PARAMETER base-market AS DEC NO-UNDO.
497 DEF OUTPUT PARAMETER base-carpark AS DEC NO-UNDO.
498 DEF OUTPUT PARAMETER occupancy AS DEC NO-UNDO.
499
500 DEF VAR floor-rent AS DEC NO-UNDO INITIAL 0.
501 DEF VAR all-rent AS DEC NO-UNDO INITIAL 0.
502 DEF VAR total-quality AS DEC NO-UNDO INITIAL 0.
503 DEF VAR income-left AS DEC NO-UNDO INITIAL 0.
504 DEF VAR quality-left AS DEC NO-UNDO INITIAL 0.
505
506 building-rental = 0.
507 building-floor = 0.
508 building-parks = 0.
509
510 RUN make-tenancies.
511
512 FOR EACH Tenancies WHERE Tenancies.AreaStatus <> "T":
513 building-parks = building-parks + Tenancies.NoCarParks.
514 building-floor = building-floor + Tenancies.FloorArea.
515 IF Tenancies.AreaStatus = "L" THEN DO:
516 all-rent = Tenancies.FloorRent + Tenancies.ParkRent + Tenancies.MiscRent .
517 floor-rent = floor-rent + Tenancies.FloorRent.
518 building-rental = building-rental + all-rent.
519
520 occupancy = occupancy + Tenancies.FloorArea.
521 IF Tenancies.FloorRent > 0 THEN DO:
522 income-left = income-left + (Tenancies.FloorRent * Tenancies.YearsToRun).
523 quality-left = quality-left + (Tenancies.Quality * Tenancies.FloorRent * Tenancies.YearsToRun).
524 total-quality = total-quality + Tenancies.Quality.
525 END.
526 END.
527 END.
528
529 wall = income-left / floor-rent.
530 wqal = quality-left / (floor-rent * wall) .
531
532 avg-floor = floor-rent / occupancy.
533 base-market = Property.MarketRental.
534 base-carpark = Property.MarketCarpark.
535 occupancy = (occupancy / building-floor) * 100.
536
537 IF wall = ? THEN wall = 0.
538 IF wqal = ? THEN wqal = 0.
539 IF avg-floor = ? THEN avg-floor = 0.
540 IF base-market = ? THEN base-market = 0.
541 IF base-carpark = ? THEN base-carpark = 0.
542 IF occupancy = ? THEN occupancy = 0.
543
544 END PROCEDURE.
545
546 /* _UIB-CODE-BLOCK-END */
547 &ANALYZE-RESUME
548
549 &ENDIF
550
551 &IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN
552
553 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
554 PROCEDURE inst-page-header :
555 /*------------------------------------------------------------------------------
556 Purpose:
557 ------------------------------------------------------------------------------*/
558 DEF VAR p-line AS CHAR NO-UNDO.
559
560 IF NOT AVAILABLE(Property) THEN RETURN.
561
562 p-line = Property.Name + ", " + Property.StreetAddress + " (P" + STRING( Property.PropertyCode, "99999") + ")".
563 p-line = p-line + FILL( " ", 130 - INT(DEC(LENGTH(p-line)) * 1.3) ) + STRING(run-date,"99/99/9999").
564
565 RUN pclrep-line( page-header-font, p-line).
566 RUN pclrep-line( page-header-font, "").
567
568 IF printing-tenancies THEN RUN tenancies-column-headers.
569
570 END PROCEDURE.
571
572 /* _UIB-CODE-BLOCK-END */
573 &ANALYZE-RESUME
574
575 &ENDIF
576
577 &IF DEFINED(EXCLUDE-make-tenancies) = 0 &THEN
578
579 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE make-tenancies Procedure
580 PROCEDURE make-tenancies :
581 /*------------------------------------------------------------------------------
582 Purpose:
583 ------------------------------------------------------------------------------*/
584 DEF VAR pcnt AS DEC NO-UNDO.
585
586 FOR EACH Tenancies: DELETE Tenancies. END.
587
588 FOR EACH TenancyLease OF Property WHERE TenancyLease.LeaseStatus <> "PAST" NO-LOCK:
589 FIND Tenant OF TenancyLease NO-LOCK.
590 CREATE Tenancies.
591 Tenancies.AreaStatus = "L".
592 Tenancies.AreaDescription = TenancyLease.AreaDescription.
593 Tenancies.TenantCode = TenancyLease.TenantCode.
594 Tenancies.LeaseCode = TenancyLease.TenancyLeaseCode.
595 Tenancies.TenantName = Tenant.Name.
596 Tenancies.Level = ?.
597 Tenancies.Quality = Tenant.Quality.
598 Tenancies.Expiry = TenancyLease.LeaseEndDate.
599 Tenancies.YearsToRun = (TenancyLease.LeaseEndDate - run-date) / 365.
600 IF Tenancies.YearsToRun > 0.08 THEN /* correct */.
601 ELSE Tenancies.YearsToRun = (1 / 12).
602 FIND FIRST RentReview OF TenancyLease WHERE ReviewStatus <> "DONE" NO-LOCK NO-ERROR.
603 IF AVAILABLE(RentReview) THEN Tenancies.NextReview = RentReview.DateDue.
604 Tenancies.Renewal = TenancyLease.RightsOfRenewal.
605 Tenancies.NetLease = NOT TenancyLease.GrossLease.
606
607 rental-space-loop:
608 FOR EACH RentalSpace OF TenancyLease NO-LOCK:
609 FIND AreaType OF RentalSpace NO-LOCK NO-ERROR.
610 IF NOT AVAILABLE(AreaType) THEN DO:
611 IF show-warnings THEN
612 MESSAGE "Can't find an area type '" + RentalSpace.AreaType + "' for Property" Property.PropertyCode ", Lease" TenancyLease.TenancyLeaseCode ", Tenant" TenancyLease.TenantCode ", RentalSpace" RentalSpace.RentalSpaceCode.
613 NEXT rental-space-loop.
614 END.
615 IF Tenancies.Level = ? OR RentalSpace.RentalSpaceCode = TenancyLease.PrimarySpace THEN DO:
616 Tenancies.Level = RentalSpace.Level.
617 Tenancies.LevelSeq = RentalSpace.LevelSeq.
618 END.
619 pcnt = 1.0 .
620 IF RentalSpace.MarketRental <> ? THEN pcnt = RentalSpace.MarketRental / 100.0 .
621
622 IF AreaType.IsFloorArea THEN ASSIGN
623 Tenancies.FloorArea = Tenancies.FloorArea + RentalSpace.AreaSize
624 Tenancies.MarketPSF = Tenancies.MarketPSF
625 + (Property.MarketRental * RentalSpace.AreaSize * pcnt).
626 ELSE IF AreaType.IsCarPark THEN ASSIGN
627 Tenancies.NoCarParks = Tenancies.NoCarParks + RentalSpace.AreaSize
628 Tenancies.MarketPPK = Tenancies.MarketPPK
629 + (Property.MarketCarpark * RentalSpace.AreaSize * pcnt * 52.0).
630 ELSE
631 Tenancies.MiscArea = Tenancies.MiscArea + RentalSpace.AreaSize.
632
633 END.
634
635 rent-charge-loop:
636 FOR EACH RentCharge OF TenancyLease NO-LOCK:
637 FIND AreaType WHERE AreaType.AreaType = RentCharge.RentChargeType NO-LOCK NO-ERROR.
638 IF AVAILABLE(AreaType) THEN DO:
639 IF show-future-charges THEN DO:
640 FIND LAST RentChargeLine OF RentCharge WHERE RentChargeLine.RentChargeLineStatus = "C"
641 NO-LOCK NO-ERROR.
642 IF RentChargeLine.EndDate = RentChargeLine.LastChargedDate
643 AND RentChargeLine.LastChargedDate <> ? THEN NEXT rent-charge-loop.
644 END.
645 ELSE
646 FIND LAST RentChargeLine OF RentCharge WHERE RentChargeLine.RentChargeLineStatus = "C"
647 AND (RentChargeLine.StartDate <= run-date OR RentChargeLine.StartDate = ?)
648 NO-LOCK NO-ERROR.
649 IF NOT AVAILABLE(RentChargeLine) THEN DO:
650 FIND FIRST RentChargeLine OF RentCharge WHERE RentChargeLine.RentChargeLineStatus = "C"
651 AND RentChargeLine.StartDate > run-date NO-LOCK NO-ERROR.
652 IF NOT AVAILABLE(RentChargeLine) THEN DO:
653 IF show-warnings THEN
654 MESSAGE "Can't find an appropriate rent charge line for Tenant" TenancyLease.TenantCode ", Charge" RentCharge.RentChargeType ", Property" Property.PropertyCode ", Lease" TenancyLease.TenancyLeaseCode.
655 NEXT rent-charge-loop.
656 END.
657
658 IF NOT show-future-charges THEN NEXT rent-charge-loop.
659 END.
660 IF AreaType.IsFloorArea THEN
661 Tenancies.FloorRent = Tenancies.FloorRent + get-annual-amount( RentChargeLine.Amount, RentChargeLine.FrequencyCode ) .
662 ELSE IF AreaType.IsCarPark THEN
663 Tenancies.ParkRent = Tenancies.ParkRent + get-annual-amount( RentChargeLine.Amount, RentChargeLine.FrequencyCode ) .
664 ELSE
665 Tenancies.MiscRent = Tenancies.MiscRent + get-annual-amount( RentChargeLine.Amount, RentChargeLine.FrequencyCode ) .
666 END.
667 END.
668 END.
669
670 /* Create vacant and common areas */
671 FOR EACH RentalSpace OF Property WHERE RentalSpace.AreaStatus <> "L" NO-LOCK:
672 IF RentalSpace.AreaStatus = "V" THEN DO:
673 CREATE Tenancies.
674 Tenancies.TenantName = "* * * Vacant * * *".
675 END.
676 ELSE IF RentalSpace.AreaStatus = "C" THEN DO:
677 CREATE Tenancies.
678 Tenancies.TenantName = "* * * Common Area * * *".
679 END.
680 ELSE
681 NEXT. /* ignore other status other than Leased/Vacant/Common */
682
683 Tenancies.AreaStatus = RentalSpace.AreaStatus.
684 Tenancies.Level = RentalSpace.Level.
685 Tenancies.LevelSeq = RentalSpace.LevelSeq.
686 Tenancies.AreaDescription = RentalSpace.Description.
687 Tenancies.TenantCode = ?.
688 pcnt = 1.0 .
689 IF RentalSpace.MarketRental > 0 THEN pcnt = RentalSpace.MarketRental / 100.0 .
690
691 FIND AreaType OF RentalSpace NO-LOCK NO-ERROR.
692 IF NOT AVAILABLE(AreaType) THEN ASSIGN
693 Tenancies.MiscArea = RentalSpace.AreaSize.
694 ELSE IF AreaType.IsFloorArea THEN ASSIGN
695 Tenancies.FloorArea = RentalSpace.AreaSize
696 Tenancies.MarketPSF = Property.MarketRental * RentalSpace.AreaSize * pcnt.
697 ELSE IF AreaType.IsCarPark THEN ASSIGN
698 Tenancies.NoCarParks = RentalSpace.AreaSize
699 Tenancies.MarketPPK = Property.MarketCarpark * RentalSpace.AreaSize * pcnt * 52.0.
700 ELSE
701 Tenancies.MiscArea = RentalSpace.AreaSize.
702 END.
703
704 /* create a final one for holding totals */
705 DEF BUFFER TotTenancies FOR Tenancies.
706 CREATE TotTenancies.
707 TotTenancies.AreaStatus = "T".
708 TotTenancies.Level = 99999.
709 TotTenancies.LevelSeq = 0.
710 TotTenancies.AreaDescription = "Totals".
711 TotTenancies.TenantName = "".
712 TotTenancies.TenantCode = ?.
713 TotTenancies.YearsToRun = ?.
714
715 FOR EACH Tenancies WHERE Tenancies.AreaStatus <> "T":
716 TotTenancies.FloorArea = TotTenancies.FloorArea + Tenancies.FloorArea.
717 TotTenancies.NoCarParks = TotTenancies.NoCarParks + Tenancies.NoCarParks.
718 TotTenancies.MiscArea = TotTenancies.MiscArea + Tenancies.MiscArea.
719 TotTenancies.FloorRent = TotTenancies.FloorRent + Tenancies.FloorRent.
720 TotTenancies.ParkRent = TotTenancies.ParkRent + Tenancies.ParkRent.
721 TotTenancies.MiscRent = TotTenancies.MiscRent + Tenancies.MiscRent.
722 TotTenancies.MarketPSF = TotTenancies.MarketPSF + Tenancies.MarketPSF.
723 TotTenancies.MarketPPK = TotTenancies.MarketPPK + Tenancies.MarketPPK.
724
725 IF Tenancies.AreaStatus <> "V" THEN ASSIGN
726 Tenancies.FloorAreaLeased = Tenancies.FloorArea
727 Tenancies.NoCarParksLeased = Tenancies.NoCarParks
728 TotTenancies.FloorAreaLeased = TotTenancies.FloorAreaLeased + Tenancies.FloorArea
729 TotTenancies.NoCarParksLeased = TotTenancies.NoCarParksLeased + Tenancies.NoCarParks.
730 END.
731
732 END PROCEDURE.
733
734 /* _UIB-CODE-BLOCK-END */
735 &ANALYZE-RESUME
736
737 &ENDIF
738
739 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
740
741 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
742 PROCEDURE parse-parameters :
743 /*------------------------------------------------------------------------------
744 Purpose:
745 ------------------------------------------------------------------------------*/
746 DEF VAR i AS INT NO-UNDO.
747 DEF VAR token AS CHAR NO-UNDO.
748
749 {inc/showopts.i "report-options"}
750
751 run-date = TODAY.
752
753 DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
754 token = ENTRY( i, report-options, "~n" ).
755 CASE( ENTRY( 1, token ) ):
756 WHEN "Properties" THEN ASSIGN
757 property-1 = INT( ENTRY(2,token) )
758 property-n = INT( ENTRY(3,token) ).
759
760 WHEN "Selection" THEN selection-style = ENTRY(2,token).
761 WHEN "File name" THEN file-name = ENTRY(2,token).
762 WHEN "Agents Version" THEN for-agents = ENTRY(2,token) BEGINS "Y".
763 WHEN "Show Future Charges" THEN show-future-charges = ENTRY(2,token) BEGINS "Y".
764 WHEN "Preview" THEN preview = ENTRY(2,token) BEGINS "Y".
765 WHEN "Warnings" THEN show-warnings = ENTRY(2,token) BEGINS "Y".
766 WHEN "Export" THEN exporting = ENTRY(2,token) BEGINS "Y".
767 WHEN "Debug" THEN debug-mode = ENTRY(2,token) BEGINS "Y".
768 END CASE.
769 END.
770
771 IF property-n < property-1 THEN property-n = property-1.
772 IF selection-style = "AP" THEN ASSIGN
773 property-1 = 0
774 property-n = 999999.
775 ELSE IF selection-style = "1P" THEN ASSIGN
776 property-n = property-1.
777
778 END PROCEDURE.
779
780 /* _UIB-CODE-BLOCK-END */
781 &ANALYZE-RESUME
782
783 &ENDIF
784
785 &IF DEFINED(EXCLUDE-print-tenancies-line) = 0 &THEN
786
787 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-tenancies-line Procedure
788 PROCEDURE print-tenancies-line :
789 /*------------------------------------------------------------------------------
790 Purpose:
791 ------------------------------------------------------------------------------*/
792 DEF VAR line AS CHAR NO-UNDO.
793 DEF VAR p-s-f AS CHAR NO-UNDO INITIAL "".
794 DEF VAR p-w AS CHAR NO-UNDO INITIAL "".
795 DEF VAR dashes AS CHAR NO-UNDO INITIAL "---------".
796
797 IF Tenancies.AreaStatus = "T" THEN DO:
798 line = FILL(" ", 68) + dashes + " --- " + dashes + " ----- -----"
799 + FILL(" ", 30) + FILL( " " + dashes, 4).
800 RUN pclrep-line( tenancies-font + ",lpi,16", line ).
801 END.
802
803 IF Tenancies.FloorAreaLeased > 0 AND Tenancies.FloorRent > 0 THEN
804 p-s-f = STRING( Tenancies.FloorRent / Tenancies.FloorAreaLeased, ">,>>9.99" ).
805 IF Tenancies.NoCarParksLeased > 0 AND Tenancies.ParkRent > 0 THEN
806 p-w = STRING( Tenancies.ParkRent / Tenancies.NoCarParksLeased / 52, ">,>>9.99" ).
807
808 line = get-level-code( Tenancies.Level, Tenancies.LevelSeq ).
809 line = TRIM( STRING(line, "X(6)") + Tenancies.AreaDescription ).
810 line = STRING( line, "X(25)") + " "
811 + STRING( Tenancies.TenantName, "X(30)" ) + " "
812 + (IF Tenancies.TenantCode = ? THEN FILL(" ",5) ELSE STRING( Tenancies.TenantCode, "99999")) + " "
813 + STRING( (IF Tenancies.Quality > 0 THEN STRING(Tenancies.Quality,"->9") ELSE ""), "X(3)")
814 + STRING( Tenancies.FloorArea, ">>>>,>>9.99" )
815 + STRING( Tenancies.NoCarParks, ">,>>9" )
816 + STRING( Tenancies.MiscArea, ">>>>,>>9.99" ).
817
818 IF Tenancies.AreaStatus = "L" OR Tenancies.AreaStatus = "T" THEN
819 line = line + STRING( p-s-f, "X(9)" )
820 + STRING( p-w, "X(9)" )
821 + (IF Tenancies.Expiry <> ? THEN STRING( Tenancies.Expiry, "99/99/9999") ELSE FILL(" ",10)) + " "
822 + (IF Tenancies.YearsToRun <> ? THEN STRING( Tenancies.YearsToRun, ">>9.99") ELSE FILL(" ",6)) + " "
823 + (IF Tenancies.NextReview <> ? THEN STRING( Tenancies.NextReview, "99/99/9999") ELSE FILL(" ", 10)) + " "
824 + STRING( Tenancies.FloorRent, "->>,>>>,>>9" )
825 + STRING( Tenancies.ParkRent, "->>,>>>,>>9" )
826 + STRING( Tenancies.MiscRent, "->>,>>>,>>9" )
827 + STRING( Tenancies.FloorRent + Tenancies.ParkRent + Tenancies.MiscRent, "->>,>>>,>>9" ) + " ".
828
829 line = line + (IF Tenancies.AreaStatus = "L" THEN
830 STRING( (IF Tenancies.Renewal = ? THEN "" ELSE Tenancies.Renewal), "X(7)" ) + STRING( Tenancies.NetLease, "Y/N" )
831 ELSE FILL(" ",8)).
832
833 IF NOT for-agents THEN DO:
834 p-s-f = "".
835 p-w = "".
836 IF Tenancies.FloorArea > 0 AND Tenancies.MarketPSF > 0 THEN
837 p-s-f = STRING( Tenancies.MarketPSF / Tenancies.FloorArea, ">>9.99" ).
838 IF Tenancies.NoCarParks > 0 AND Tenancies.MarketPPK > 0 THEN
839 p-w = STRING( Tenancies.MarketPPK / Tenancies.NoCarParks / 52, ">>>9.99" ).
840
841 line = line + STRING( p-s-f, "X(7)" ) + p-w.
842 END.
843
844 RUN pclrep-line( tenancies-font + (IF Tenancies.AreaStatus = "T" THEN ",lpi,16" ELSE ""), line ).
845 END PROCEDURE.
846
847 /* _UIB-CODE-BLOCK-END */
848 &ANALYZE-RESUME
849
850 &ENDIF
851
852 &IF DEFINED(EXCLUDE-property-schedule) = 0 &THEN
853
854 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE property-schedule Procedure
855 PROCEDURE property-schedule :
856 /*------------------------------------------------------------------------------
857 Purpose:
858 ------------------------------------------------------------------------------*/
859 printing-tenancies = No.
860
861 RUN building-overview.
862 IF NOT for-agents THEN RUN building-financial.
863 RUN building-tenancies.
864
865 RUN pclrep-page-break.
866 END PROCEDURE.
867
868 /* _UIB-CODE-BLOCK-END */
869 &ANALYZE-RESUME
870
871 &ENDIF
872
873 &IF DEFINED(EXCLUDE-tenancies-column-headers) = 0 &THEN
874
875 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE tenancies-column-headers Procedure
876 PROCEDURE tenancies-column-headers :
877 /*------------------------------------------------------------------------------
878 Purpose:
879 ------------------------------------------------------------------------------*/
880 DEF VAR hdr-line-1 AS CHAR NO-UNDO.
881 DEF VAR hdr-line-2 AS CHAR NO-UNDO.
882
883 hdr-line-1 = " Rate Parks Lease Years Next Sitting Rent Net ".
884 hdr-line-2 = " Floor Tenant Ref Quality Area Parks Other " + area-units-short + " P.W. Expires to run Review Floor Carpark Other Total Rnwl Lse ".
885
886 IF NOT for-agents THEN DO:
887 hdr-line-1 = hdr-line-1 + " Market".
888 hdr-line-2 = hdr-line-2 + "Floor Park".
889 END.
890
891 RUN pclrep-line( tenancies-font, hdr-line-1 ).
892 RUN pclrep-line( tenancies-font, hdr-line-2 ).
893
894 END PROCEDURE.
895
896 /* _UIB-CODE-BLOCK-END */
897 &ANALYZE-RESUME
898
899 &ENDIF
900
901 /* ************************ Function Implementations ***************** */
902
903 &IF DEFINED(EXCLUDE-amount-and-psf) = 0 &THEN
904
905 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION amount-and-psf Procedure
906 FUNCTION amount-and-psf RETURNS CHARACTER
907 ( INPUT amount AS DEC ) :
908 /*------------------------------------------------------------------------------
909 Purpose:
910 Notes:
911 ------------------------------------------------------------------------------*/
912
913 RETURN STRING( amount, "->>>,>>>,>>9" ) + " "
914 + (IF amount <> ? AND building-floor > 0 THEN
915 STRING( amount / building-floor, "->>>,>>9.99" )
916 ELSE "").
917
918 END FUNCTION.
919
920 /* _UIB-CODE-BLOCK-END */
921 &ANALYZE-RESUME
922
923 &ENDIF
924
925 &IF DEFINED(EXCLUDE-get-account-budget) = 0 &THEN
926
927 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-account-budget Procedure
928 FUNCTION get-account-budget RETURNS DECIMAL
929 ( INPUT et AS CHAR, INPUT ec AS INT, INPUT ac AS DEC, INPUT m-1 AS INT, INPUT m-n AS INT ) :
930 /*------------------------------------------------------------------------------
931 Purpose:
932 Notes:
933 ------------------------------------------------------------------------------*/
934 DEF VAR bud AS DEC NO-UNDO INITIAL 0.0 .
935
936 FOR EACH AccountBalance WHERE AccountBalance.EntityType = et
937 AND AccountBalance.EntityCode = ec AND AccountBalance.AccountCode = ac
938 AND AccountBalance.MonthCode >= m-1 AND AccountBalance.MonthCode <= m-n NO-LOCK:
939 bud = bud + AccountBalance.Budget.
940 END.
941
942 RETURN bud.
943
944 END FUNCTION.
945
946 /* _UIB-CODE-BLOCK-END */
947 &ANALYZE-RESUME
948
949 &ENDIF
950
951 &IF DEFINED(EXCLUDE-get-annual-amount) = 0 &THEN
952
953 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-annual-amount Procedure
954 FUNCTION get-annual-amount RETURNS DECIMAL
955 ( INPUT period-amount AS DEC, INPUT freq-type AS CHAR ) :
956 /*------------------------------------------------------------------------------
957 Purpose:
958 Notes:
959 ------------------------------------------------------------------------------*/
960 DEF VAR annual-amount AS DEC NO-UNDO.
961
962 FIND FrequencyType WHERE FrequencyType.FrequencyCode = freq-type NO-LOCK.
963
964 annual-amount = ((period-amount / FrequencyType.UnitCount) * (IF FrequencyType.RepeatUnits = "D" THEN 365 ELSE 12)).
965
966 RETURN annual-amount.
967
968 END FUNCTION.
969
970 /* _UIB-CODE-BLOCK-END */
971 &ANALYZE-RESUME
972
973 &ENDIF
974
975 &IF DEFINED(EXCLUDE-get-level-code) = 0 &THEN
976
977 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-level-code Procedure
978 FUNCTION get-level-code RETURNS CHARACTER
979 ( INPUT l-no AS INT, INPUT l-seq AS INT ) :
980 /*------------------------------------------------------------------------------
981 Purpose:
982 Notes:
983 ------------------------------------------------------------------------------*/
984 DEF VAR answer AS CHAR NO-UNDO.
985
986 IF l-no >= 99999 THEN RETURN "".
987
988 IF l-no = 0 THEN answer = "G".
989 ELSE IF l-no = 90 THEN answer = "PK".
990 ELSE IF l-no = 80 THEN answer = "B".
991 ELSE IF l-no > 80 AND l-no < 90 THEN answer = "B" + STRING(l-no - 80).
992 ELSE IF l-no < 0 THEN answer = "B" + STRING(ABS(l-no)).
993 ELSE answer = STRING(l-no).
994
995 answer = answer + (IF l-seq = 0 THEN "" ELSE "-" + TRIM(STRING(l-seq))).
996
997 RETURN answer.
998
999 END FUNCTION.
1000
1001 /* _UIB-CODE-BLOCK-END */
1002 &ANALYZE-RESUME
1003
1004 &ENDIF
1005
1006 &IF DEFINED(EXCLUDE-sum-group) = 0 &THEN
1007
1008 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION sum-group Procedure
1009 FUNCTION sum-group RETURNS DECIMAL
1010 ( INPUT group-list AS CHAR, INPUT pattern AS CHAR, INPUT amt-type AS CHAR ) :
1011 /*------------------------------------------------------------------------------
1012 Purpose:
1013 Notes:
1014 ------------------------------------------------------------------------------*/
1015 DEF VAR result AS DEC NO-UNDO INITIAL 0.0 .
1016 DEF VAR account-group AS CHAR NO-UNDO.
1017 DEF VAR i AS INT NO-UNDO.
1018 DEF VAR n AS INT NO-UNDO.
1019
1020 n = NUM-ENTRIES( group-list).
1021 DO i = 1 TO n:
1022 account-group = ENTRY(i,group-list).
1023 FOR EACH ChartOfAccount WHERE ChartOfAccount.AccountGroupCode = account-group NO-LOCK:
1024 IF STRING(ChartOfAccount.AccountCode, "9999.99") MATCHES pattern THEN DO:
1025 FOR EACH AccountSummary WHERE AccountSummary.EntityType = "P"
1026 AND AccountSummary.EntityCode = Property.PropertyCode
1027 AND AccountSummary.AccountCode = ChartOfAccount.AccountCode
1028 NO-LOCK:
1029 result = result + (IF amt-type = "Budget" THEN AccountSummary.Budget ELSE AccountSummary.Balance ) .
1030 END.
1031 END.
1032 END.
1033 END.
1034
1035 RETURN result.
1036
1037 END FUNCTION.
1038
1039 /* _UIB-CODE-BLOCK-END */
1040 &ANALYZE-RESUME
1041
1042 &ENDIF
1043
Capital Accounting & Property Management System (using Progress DB)