process/report/bdincome.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
   8     Syntax      :
   9
  10     Description :
  11   ------------------------------------------------------------------------*/
  12 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
  13
  14 DEF VAR from-property  LIKE Property.PropertyCode NO-UNDO.
  15 DEF VAR to-property    LIKE Property.PropertyCode NO-UNDO.
  16 DEF VAR month-ending   LIKE Month.MonthCode NO-UNDO.
  17
  18 /* Selection Types */
  19 DEF VAR property-range  AS LOGI NO-UNDO.
  20 DEF VAR manager-range AS LOGI NO-UNDO.
  21 DEF VAR administrator-range   AS LOGI NO-UNDO.
  22 DEF VAR region-range  AS LOGI NO-UNDO.
  23 DEF VAR list-range    AS LOGI NO-UNDO.
  24 DEF VAR entity-list   AS LOGI NO-UNDO.
  25 DEF VAR selection-id  AS CHAR NO-UNDO.
  26 DEF VAR group-columns AS LOGI NO-UNDO INITIAL No.
  27
  28 /* Report Syles */
  29 DEF VAR detailed-property     AS LOGI NO-UNDO.
  30 DEF VAR consolidated-account  AS LOGI NO-UNDO.
  31 DEF VAR consolidated-property AS LOGI NO-UNDO.
  32
  33 DEF VAR to-file AS LOGICAL NO-UNDO INITIAL No.
  34 DEF VAR out-file-name AS CHAR NO-UNDO INITIAL "".
  35 DEF VAR report-preview  AS LOGI NO-UNDO.
  36
  37 /* Month range variables */
  38 DEF VAR range-type            AS CHAR NO-UNDO.
  39 DEF VAR month-from            LIKE Month.MonthCode NO-UNDO.
  40 DEF VAR month-to              LIKE Month.MonthCode NO-UNDO.
  41 DEF VAR month-desc            AS CHAR NO-UNDO.
  42
  43 RUN parse-parameters.
  44
  45
  46 DEF VAR ln              AS DEC INIT 0.00 NO-UNDO.
  47 DEF VAR page-lines      AS DEC NO-UNDO.
  48 DEF VAR page-no         AS INT INIT 1 NO-UNDO.
  49 DEF VAR last-multiplier AS DEC NO-UNDO INIT 1.
  50
  51 /* Printer control strings */
  52
  53 DEF VAR reset-page            AS CHAR NO-UNDO.
  54 DEF VAR half-line             AS CHAR NO-UNDO. half-line = CHR(27) + "=" .
  55 DEF VAR line-printer          AS CHAR NO-UNDO.
  56 DEF VAR courier-font          AS CHAR NO-UNDO.
  57 DEF VAR title-font            AS CHAR NO-UNDO.
  58 DEF VAR manager-font          AS CHAR NO-UNDO.
  59
  60 /* Display formats */
  61
  62 DEF VAR acct-fmt  AS CHAR INIT "X(25)" NO-UNDO.
  63 DEF VAR amt-fmt   AS CHAR INIT "(>>,>>>,>>9.99)" NO-UNDO.
  64 DEF VAR var-fmt   AS CHAR INIT "(>,>>>,>>9.99)" NO-UNDO.
  65 DEF VAR disp-mult AS DEC  INIT 1 NO-UNDO.
  66
  67 DEF VAR now       AS CHAR NO-UNDO.
  68 now =  STRING( TODAY, "99/99/9999" ) + ' ' + STRING( TIME, "HH:MM:SS" ).
  69 DEF VAR user-name AS CHAR NO-UNDO.
  70
  71 DEF BUFFER ThisMonth FOR Month.
  72
  73 DEF VAR total AS DEC EXTENT 28 NO-UNDO.  /* 7 totals * 4 groups */
  74 DEF VAR group-amnts AS DEC NO-UNDO EXTENT 7 .
  75 DEF VAR group-totals AS DEC NO-UNDO EXTENT 7 INIT 0.0 .
  76
  77 {inc/ofc-this.i}
  78 {inc/ofc-set.i "AcctGroup-Recoveries" "recoveries-groups"}
  79 IF NOT AVAILABLE(OfficeSetting) THEN recoveries-groups = "OPINC,OPEX".
  80
  81 /* _UIB-CODE-BLOCK-END */
  82 &ANALYZE-RESUME
  83
  84
  85 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  86
  87 /* ********************  Preprocessor Definitions  ******************** */
  88
  89 &Scoped-define PROCEDURE-TYPE Procedure
  90 &Scoped-define DB-AWARE no
  91
  92
  93
  94 /* _UIB-PREPROCESSOR-BLOCK-END */
  95 &ANALYZE-RESUME
  96
  97
  98
  99 /* *********************** Procedure Settings ************************ */
 100
 101 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 102 /* Settings for THIS-PROCEDURE
 103    Type: Procedure
 104    Allow:
 105    Frames: 0
 106    Add Fields to: Neither
 107    Other Settings: CODE-ONLY COMPILE
 108  */
 109 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 110
 111 /* *************************  Create Window  ************************** */
 112
 113 &ANALYZE-SUSPEND _CREATE-WINDOW
 114 /* DESIGN Window definition (used by the UIB)
 115   CREATE WINDOW Procedure ASSIGN
 116          HEIGHT             = 21.8
 117          WIDTH              = 40.
 118 /* END WINDOW DEFINITION */
 119                                                                         */
 120 &ANALYZE-RESUME
 121
 122 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 123 /* ************************* Included-Libraries *********************** */
 124
 125 {inc/method/m-txtrep.i}
 126
 127 /* _UIB-CODE-BLOCK-END */
 128 &ANALYZE-RESUME
 129
 130
 131
 132
 133
 134 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 135
 136
 137 /* ***************************  Main Block  *************************** */
 138 {inc/username.i "user-name"}
 139 IF to-file THEN
 140   OUTPUT TO VALUE(out-file-name) KEEP-MESSAGES PAGE-SIZE 0.
 141 ELSE DO:
 142   RUN get-control-strings.
 143   OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 144 END.
 145
 146 RUN building-income-statement.
 147
 148 OUTPUT CLOSE.
 149
 150 IF to-file THEN
 151   MESSAGE 'File "' + out-file-name + '" generated successfully.'
 152                 VIEW-AS ALERT-BOX INFORMATION TITLE "Trial Balance by Group".
 153 ELSE
 154   RUN view-output-file ( report-preview ).
 155
 156 /* _UIB-CODE-BLOCK-END */
 157 &ANALYZE-RESUME
 158
 159
 160 /* **********************  Internal Procedures  *********************** */
 161
 162 &IF DEFINED(EXCLUDE-account-iteration) = 0 &THEN
 163
 164 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE account-iteration Procedure
 165 PROCEDURE account-iteration :
 166 /*------------------------------------------------------------------------------
 167   Purpose:
 168   Parameters:  <none>
 169   Notes:
 170 ------------------------------------------------------------------------------*/
 171   IF consolidated-account THEN DO:
 172     RUN reset-totals( 1 ).
 173     RUN iterate-property.
 174     RUN print-totals( 1, ChartOfAccount.Name ).
 175   END.
 176   ELSE
 177     RUN each-property-account.
 178
 179 END PROCEDURE.
 180
 181 /* _UIB-CODE-BLOCK-END */
 182 &ANALYZE-RESUME
 183
 184 &ENDIF
 185
 186 &IF DEFINED(EXCLUDE-building-income-statement) = 0 &THEN
 187
 188 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE building-income-statement Procedure
 189 PROCEDURE building-income-statement :
 190 /*------------------------------------------------------------------------------
 191   Purpose:
 192 ------------------------------------------------------------------------------*/
 193
 194   IF NOT detailed-property THEN RUN page-header.
 195
 196   IF consolidated-account THEN
 197     RUN iterate-accounts.
 198   ELSE
 199     RUN iterate-property.
 200
 201   IF NOT (detailed-property OR to-file) THEN RUN page-feed.
 202
 203 END PROCEDURE.
 204
 205 /* _UIB-CODE-BLOCK-END */
 206 &ANALYZE-RESUME
 207
 208 &ENDIF
 209
 210 &IF DEFINED(EXCLUDE-carriage-return) = 0 &THEN
 211
 212 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE carriage-return Procedure
 213 PROCEDURE carriage-return :
 214 /*------------------------------------------------------------------------------
 215   Purpose:
 216   Parameters:  <none>
 217   Notes:
 218 ------------------------------------------------------------------------------*/
 219
 220   PUT CONTROL CHR(13).
 221
 222 END PROCEDURE.
 223
 224 /* _UIB-CODE-BLOCK-END */
 225 &ANALYZE-RESUME
 226
 227 &ENDIF
 228
 229 &IF DEFINED(EXCLUDE-column-header) = 0 &THEN
 230
 231 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE column-header Procedure
 232 PROCEDURE column-header :
 233 /*------------------------------------------------------------------------------
 234   Purpose:
 235 ------------------------------------------------------------------------------*/
 236   IF group-columns THEN DO:
 237     RUN column-header-groups.
 238     RETURN.
 239   END.
 240   IF to-file THEN DO:
 241     PUT UNFORMATTED '"Name","Month Actual","Month Budget","Month Variance"'
 242             + ',"Year Actual","Year Budget","Year Variance"'
 243             + (IF range-type = "NORMAL" THEN ',"F/Y Budget"' ELSE "")
 244             SKIP.
 245     RETURN.
 246   END.
 247
 248   PUT UNFORMATTED SPACE(26)
 249     STRING(
 250       "------------------- MONTH ----------------- ---------------" +
 251       ( IF range-type = "NORMAL" THEN " YEAR TO DATE " ELSE "  FOR RANGE   " ) +
 252       "--------------",
 253     "X(100)" ).
 254   RUN skip-line(1).
 255
 256   PUT UNFORMATTED
 257     STRING(
 258       "Name"   + FILL( ' ', 27 ) +
 259       "Actual" + FILL( ' ', 8 ) + "Budget" + FILL( ' ', 8 ) + "Variance" + FILL( ' ', 8 ) +
 260       "Actual" + FILL( ' ', 9 ) + "Budget" + FILL( ' ', 8 ) + "Variance" + FILL( ' ', 6 ) +
 261       IF range-type = "NORMAL" THEN "F/Y Budget" ELSE "", "X(130)" ).
 262   RUN skip-line(2).
 263
 264 END PROCEDURE.
 265
 266 /* _UIB-CODE-BLOCK-END */
 267 &ANALYZE-RESUME
 268
 269 &ENDIF
 270
 271 &IF DEFINED(EXCLUDE-column-header-groups) = 0 &THEN
 272
 273 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE column-header-groups Procedure
 274 PROCEDURE column-header-groups :
 275 /*------------------------------------------------------------------------------
 276   Purpose:
 277 ------------------------------------------------------------------------------*/
 278   IF to-file THEN DO:
 279     PUT UNFORMATTED '"Name","Rental Income","Recoveries","Total Income"'
 280             + ',"Recoverable Expenses","Non-Recoverables","Total Expenses"'
 281             + ',"Net Income"'
 282             SKIP.
 283     RETURN.
 284   END.
 285
 286   PUT UNFORMATTED SPACE(26)
 287       "        Rental     Recoveries   Total Income  Rec. Expenses   N/R Expenses     Total Exps.    Net Income".
 288   RUN skip-line(1).
 289
 290 END PROCEDURE.
 291
 292 /* _UIB-CODE-BLOCK-END */
 293 &ANALYZE-RESUME
 294
 295 &ENDIF
 296
 297 &IF DEFINED(EXCLUDE-each-balance) = 0 &THEN
 298
 299 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-balance Procedure
 300 PROCEDURE each-balance :
 301 /*------------------------------------------------------------------------------
 302   Purpose:
 303   Parameters:  <none>
 304   Notes:
 305 ------------------------------------------------------------------------------*/
 306
 307   DEF VAR level AS INT NO-UNDO.
 308   DEF VAR base  AS INT NO-UNDO.
 309
 310   DO level = 1 TO 4:
 311
 312     base = ( level - 1 ) * 7.
 313
 314     IF AccountBalance.MonthCode = month-ending THEN DO:
 315       total[ base + 1 ] = total[ base + 1 ] + AccountBalance.Balance.
 316       total[ base + 2 ] = total[ base + 2 ] + AccountBalance.Budget.
 317     END.
 318
 319     IF AccountBalance.MonthCode <= month-ending THEN DO:
 320       total[ base + 4 ] = total[ base + 4 ] + AccountBalance.Balance.
 321       total[ base + 5 ] = total[ base + 5 ] + AccountBalance.Budget.
 322     END.
 323
 324     total[ base + 7 ] = total[ base + 7 ] + AccountBalance.Budget.
 325
 326   END.
 327
 328 END PROCEDURE.
 329
 330 /* _UIB-CODE-BLOCK-END */
 331 &ANALYZE-RESUME
 332
 333 &ENDIF
 334
 335 &IF DEFINED(EXCLUDE-each-property-account) = 0 &THEN
 336
 337 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE each-property-account Procedure
 338 PROCEDURE each-property-account :
 339 /*------------------------------------------------------------------------------
 340   Purpose:
 341   Parameters:  <none>
 342   Notes:
 343 ------------------------------------------------------------------------------*/
 344 DEF VAR level AS INT NO-UNDO.
 345 DEF VAR base  AS INT NO-UNDO.
 346
 347   IF detailed-property THEN RUN reset-totals( 1 ).
 348
 349   FOR EACH AccountBalance NO-LOCK WHERE
 350     AccountBalance.EntityType  = 'P' AND
 351     AccountBalance.EntityCode  = Property.PropertyCode AND
 352     AccountBalance.AccountCode = ChartOfAccount.AccountCode AND
 353     AccountBalance.MonthCode >= month-from AND
 354     AccountBalance.MonthCode <= month-to:
 355     RUN each-balance.
 356   END.
 357
 358   DO level = 1 TO 4:
 359     base = ( level - 1 ) * 7.
 360     total[ base + 3 ] = total[ base + 1 ] - total[ base + 2 ].
 361     total[ base + 6 ] = total[ base + 4 ] - total[ base + 5 ].
 362   END.
 363
 364   IF detailed-property THEN RUN print-totals( 1, ChartOfAccount.Name ).
 365
 366 END PROCEDURE.
 367
 368 /* _UIB-CODE-BLOCK-END */
 369 &ANALYZE-RESUME
 370
 371 &ENDIF
 372
 373 &IF DEFINED(EXCLUDE-get-control-strings) = 0 &THEN
 374
 375 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-control-strings Procedure
 376 PROCEDURE get-control-strings :
 377 /*------------------------------------------------------------------------------
 378   Purpose:
 379 ------------------------------------------------------------------------------*/
 380 DEF VAR rows AS DEC NO-UNDO.
 381 DEF VAR cols AS DEC NO-UNDO.
 382
 383   IF to-file THEN DO:
 384     reset-page = "".
 385     title-font = "".
 386     manager-font = "".
 387     line-printer = "".
 388     courier-font = "".
 389     page-lines = 0.
 390   END.
 391
 392   RUN make-control-string( "PCL", "reset,portrait,a4,tm,2,lm,4",
 393                   OUTPUT reset-page, OUTPUT rows, OUTPUT cols ).
 394
 395   RUN make-control-string( "PCL", "Proportional,Helvetica,Bold,Point,12",
 396                   OUTPUT title-font, OUTPUT rows, OUTPUT cols ).
 397
 398   RUN make-control-string( "PCL", "Proportional,Helvetica,Bold,Point,10",
 399                   OUTPUT manager-font, OUTPUT rows, OUTPUT cols ).
 400
 401   RUN make-control-string( "PCL", "LinePrinter,lpi,9.54",
 402                   OUTPUT line-printer, OUTPUT rows, OUTPUT cols ).
 403
 404   /* Note that this one sets the page length */
 405   RUN make-control-string( "PCL", "courier,cpi,18,lpi,9",
 406                   OUTPUT courier-font, OUTPUT page-lines, OUTPUT cols ).
 407   page-lines = page-lines - 7. /* For top margin of two */
 408
 409   IF report-preview THEN RUN output-control-file( reset-page + courier-font ).
 410
 411 END PROCEDURE.
 412
 413 /* _UIB-CODE-BLOCK-END */
 414 &ANALYZE-RESUME
 415
 416 &ENDIF
 417
 418 &IF DEFINED(EXCLUDE-get-manager-name) = 0 &THEN
 419
 420 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-manager-name Procedure
 421 PROCEDURE get-manager-name :
 422 /*------------------------------------------------------------------------------
 423   Purpose:
 424   Parameters:  <none>
 425   Notes:
 426 ------------------------------------------------------------------------------*/
 427
 428   DEF OUTPUT PARAMETER manager-name AS CHAR NO-UNDO.
 429
 430   IF NOT AVAILABLE Property THEN RETURN.
 431   FIND Person WHERE Person.PersonCode = Property.Manager
 432     NO-LOCK NO-ERROR.
 433
 434   IF NOT AVAILABLE Person THEN RETURN.
 435   manager-name = Person.JobTitle.
 436
 437 END PROCEDURE.
 438
 439 /* _UIB-CODE-BLOCK-END */
 440 &ANALYZE-RESUME
 441
 442 &ENDIF
 443
 444 &IF DEFINED(EXCLUDE-get-month-range) = 0 &THEN
 445
 446 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-month-range Procedure
 447 PROCEDURE get-month-range :
 448 /*------------------------------------------------------------------------------
 449   Purpose:
 450 ------------------------------------------------------------------------------*/
 451
 452   DEF INPUT PARAMETER range-type AS CHAR NO-UNDO.
 453   DEF INPUT PARAMETER range-desc AS CHAR NO-UNDO.
 454
 455   IF range-type = "RANGE" THEN DO:
 456     month-from = INT( ENTRY( 1, range-desc ) ).
 457     month-to   = INT( ENTRY( 2, range-desc ) ).
 458     month-ending = month-to.
 459
 460     FIND Month WHERE Month.MonthCode = month-from NO-LOCK.
 461     month-desc = "from " + STRING( Month.StartDate, "99/99/9999" ).
 462     FIND Month WHERE Month.MonthCode = month-to NO-LOCK.
 463     month-desc = month-desc + " to " + STRING( Month.EndDate, "99/99/9999" ).
 464   END.
 465   ELSE DO:
 466
 467     DEF VAR financial-year        LIKE FinancialYear.FinancialYearCode NO-UNDO.
 468
 469     month-ending = INT( ENTRY( 1, range-desc ) ).
 470     FIND FIRST ThisMonth WHERE ThisMonth.MonthCode = month-ending NO-LOCK.
 471     financial-year = ThisMonth.FinancialYearCode.
 472     month-desc     = "as at " + CAPS( ThisMonth.MonthName ) + ", " + STRING( ThisMonth.FinancialYearCode, "9999" ).
 473
 474     FIND FIRST Month WHERE Month.FinancialYearCode = financial-year NO-LOCK.
 475     month-from = Month.MonthCode.
 476
 477     FIND LAST Month WHERE Month.FinancialYearCode = financial-year NO-LOCK.
 478     month-to = Month.MonthCode.
 479
 480   END.
 481
 482 END PROCEDURE.
 483
 484 /* _UIB-CODE-BLOCK-END */
 485 &ANALYZE-RESUME
 486
 487 &ENDIF
 488
 489 &IF DEFINED(EXCLUDE-iterate-accounts) = 0 &THEN
 490
 491 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iterate-accounts Procedure
 492 PROCEDURE iterate-accounts :
 493 /*------------------------------------------------------------------------------
 494   Purpose:
 495 ------------------------------------------------------------------------------*/
 496
 497   DEF VAR print-acct-totals AS LOGI NO-UNDO.
 498   print-acct-totals = consolidated-account OR detailed-property.
 499
 500   /* Income Groups */
 501
 502   RUN reset-totals( 3 ).
 503
 504   RUN reset-totals( 2 ).
 505   FOR EACH ChartOfAccount NO-LOCK WHERE
 506     ChartOfAccount.AccountGroupCode = "RENT":
 507     RUN account-iteration.
 508   END.
 509   IF print-acct-totals THEN RUN print-totals( 2, "Rental Income" ).
 510   ELSE IF group-columns THEN group-amnts[1] = total[8].
 511
 512   RUN reset-totals( 2 ).
 513   FOR EACH ChartOfAccount NO-LOCK WHERE
 514     LOOKUP( ChartOfAccount.AccountGroupCode, recoveries-groups) > 0:
 515     RUN account-iteration.
 516   END.
 517   IF print-acct-totals THEN RUN print-totals( 2, "Total Recoveries" ).
 518   ELSE IF group-columns THEN group-amnts[2] = total[8].
 519
 520   IF print-acct-totals THEN RUN print-totals( 3, "Total Income" ).
 521   ELSE IF group-columns THEN group-amnts[3] = group-amnts[1] + group-amnts[2].
 522
 523   /* Expense Groups */
 524
 525   RUN reset-totals( 3 ).
 526
 527   RUN reset-totals( 2 ).
 528   FOR EACH ChartOfAccount NO-LOCK WHERE
 529     ( ChartOfAccount.AccountGroupCode = 'PROPEX' ) OR
 530     ( ChartOfAccount.AccountGroupCode = 'LEASNG' AND
 531       TRUNCATE( ChartOfAccount.AccountCode, 0 ) = ChartOfAccount.AccountCode ):
 532     RUN account-iteration.
 533   END.
 534   IF print-acct-totals THEN RUN print-totals( 2, "Expense Recoverable" ).
 535   ELSE IF group-columns THEN group-amnts[4] = total[8].
 536
 537   IF CAN-FIND( AccountGroup WHERE AccountGroup.AccountGroupCode = "TENEX") THEN DO:
 538     RUN reset-totals( 2 ).
 539     FOR EACH ChartOfAccount NO-LOCK WHERE ChartOfAccount.AccountGroupCode = 'TENEX':
 540       RUN account-iteration.
 541     END.
 542     IF print-acct-totals THEN RUN print-totals( 2, "Tenants Expenses Recoverable" ).
 543     ELSE IF group-columns THEN group-amnts[4] = group-amnts[4] + total[8].
 544   END.
 545
 546   RUN reset-totals( 2 ).
 547   FOR EACH ChartOfAccount NO-LOCK WHERE
 548     (( ChartOfAccount.AccountGroupCode = 'PROPEX' OR
 549          ChartOfAccount.AccountGroupCode = 'LEASNG' ) AND
 550          ChartOfAccount.AccountCode - TRUNCATE( ChartOfAccount.AccountCode, 0 ) = 0.10
 551        ) OR ChartOfAccount.AccountGroupCode = 'OWNEX':
 552     RUN account-iteration.
 553   END.
 554   IF print-acct-totals THEN RUN print-totals( 2, "Expenses Non-Recoverable" ).
 555   ELSE IF group-columns THEN group-amnts[5] = total[8].
 556
 557   IF print-acct-totals THEN RUN print-totals( 3, "Total Expenses" ).
 558   ELSE IF group-columns THEN group-amnts[6] = group-amnts[4] + group-amnts[5].
 559
 560   IF print-acct-totals THEN RUN print-totals( 4, "NET INCOME" ).
 561   ELSE IF group-columns THEN DO:
 562     group-amnts[7] = group-amnts[3] + group-amnts[6].
 563     RUN print-group-totals( Property.Name ).
 564   END.
 565 END PROCEDURE.
 566
 567 /* _UIB-CODE-BLOCK-END */
 568 &ANALYZE-RESUME
 569
 570 &ENDIF
 571
 572 &IF DEFINED(EXCLUDE-iterate-property) = 0 &THEN
 573
 574 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iterate-property Procedure
 575 PROCEDURE iterate-property :
 576 /*------------------------------------------------------------------------------
 577   Purpose:
 578   Parameters:  <none>
 579   Notes:
 580 ------------------------------------------------------------------------------*/
 581 DEF VAR i AS INT NO-UNDO.
 582 DEF VAR n AS INT NO-UNDO.
 583 DEF VAR coy-code AS INT NO-UNDO.
 584
 585   IF property-range THEN
 586     FOR EACH Property NO-LOCK WHERE Property.PropertyCode >= from-property
 587                                 AND Property.PropertyCode <= to-property:
 588         RUN property-iteration.
 589     END.
 590   ELSE IF manager-range THEN
 591     FOR EACH Property NO-LOCK WHERE Property.Manager = INT( selection-id ):
 592         RUN property-iteration.
 593     END.
 594   ELSE IF administrator-range THEN
 595     FOR EACH Property NO-LOCK WHERE Property.Administrator = INT( selection-id ):
 596         RUN property-iteration.
 597     END.
 598   ELSE IF region-range THEN
 599     FOR EACH Property NO-LOCK WHERE Property.Region = selection-id:
 600         RUN property-iteration.
 601     END.
 602   ELSE IF entity-list THEN
 603     FOR EACH EntityListMember NO-LOCK WHERE EntityListMember.ListCode = selection-id
 604                             AND EntityListMember.EntityType = "P",
 605               FIRST Property NO-LOCK
 606                  WHERE Property.PropertyCode = EntityListMember.EntityCode
 607                             BY EntityListMember.SortSequence:
 608         RUN property-iteration.
 609     END.
 610   ELSE IF list-range THEN DO:
 611     FIND ConsolidationList WHERE ConsolidationList.Name = selection-id NO-LOCK.
 612     n = NUM-ENTRIES( ConsolidationList.CompanyList ).
 613     DO i = 1 TO n:
 614       coy-code = INT( ENTRY( i, ConsolidationList.CompanyList)).
 615       FOR EACH Property NO-LOCK WHERE Property.CompanyCode = coy-code:
 616         RUN property-iteration.
 617       END.
 618     END.
 619   END.
 620
 621   IF group-columns THEN DO:
 622     IF NOT(to-file) THEN DO:
 623       RUN separator-line.
 624       PUT UNFORMATTED FILL(" ",26).
 625     END.
 626     DO i = 1 TO 7:
 627       IF to-file THEN
 628         PUT UNFORMATTED ',' + STRING( group-totals[i] ).
 629       ELSE
 630         PUT UNFORMATTED STRING( group-totals[i] * (IF i < 4 OR i = 7 THEN -1 ELSE 1),
 631                               amt-fmt ).
 632     END.
 633   END.
 634   ELSE IF consolidated-property THEN RUN print-totals( 4, "NET INCOME" ).
 635
 636 END PROCEDURE.
 637
 638 /* _UIB-CODE-BLOCK-END */
 639 &ANALYZE-RESUME
 640
 641 &ENDIF
 642
 643 &IF DEFINED(EXCLUDE-page-feed) = 0 &THEN
 644
 645 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-feed Procedure
 646 PROCEDURE page-feed :
 647 /*------------------------------------------------------------------------------
 648   Purpose:
 649   Parameters:  <none>
 650   Notes:
 651 ------------------------------------------------------------------------------*/
 652
 653   IF to-file THEN RETURN.
 654
 655   PUT CONTROL CHR(12).
 656   page-no = page-no + 1.
 657
 658 END PROCEDURE.
 659
 660 /* _UIB-CODE-BLOCK-END */
 661 &ANALYZE-RESUME
 662
 663 &ENDIF
 664
 665 &IF DEFINED(EXCLUDE-page-header) = 0 &THEN
 666
 667 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE page-header Procedure
 668 PROCEDURE page-header :
 669 /*------------------------------------------------------------------------------
 670   Purpose:
 671   Parameters:  <none>
 672   Notes:
 673 ------------------------------------------------------------------------------*/
 674
 675   RUN reset-page.
 676
 677   DEF VAR title-string AS CHAR NO-UNDO.
 678   DEF VAR range-desc   AS CHAR NO-UNDO.
 679
 680   PUT UNFORMATTED STRING( "Printed: " + now + " for " + user-name, "X(40)" ).
 681   IF NOT( to-file) THEN
 682     PUT UNFORMATTED SPACE(80) "Page: " + STRING( page-no ).
 683   RUN skip-line(1).
 684
 685   title-string = "Building Income Statement " + month-desc +
 686     IF consolidated-account  THEN ", Consolidated by Account" ELSE
 687     IF consolidated-property THEN ", Consolidated by Property" ELSE "".
 688   IF to-file THEN
 689     PUT UNFORMATTED '"' + title-string + '"'.
 690   ELSE
 691     PUT UNFORMATTED SPACE( ( 132 - LENGTH( title-string ) ) / 2 ) title-string.
 692   RUN skip-line(1).
 693
 694   IF property-range AND NOT detailed-property THEN
 695     range-desc = "Property " + STRING( from-property, "99999" ) + " to " + STRING( to-property, "99999" ).
 696   ELSE IF manager-range THEN
 697   DO:
 698     FIND Person WHERE Person.PersonCode = INT( selection-id ) NO-ERROR.
 699     range-desc = "Portoflio: " + IF AVAILABLE Person THEN Person.JobTitle
 700       ELSE "None".
 701   END.
 702   ELSE IF administrator-range THEN
 703   DO:
 704     FIND Person WHERE Person.PersonCode = INT( selection-id ) NO-ERROR.
 705     range-desc = "Managed by: " + IF AVAILABLE Person THEN ( Person.FirstName + ' ' + Person.LastName )
 706       ELSE "None".
 707   END.
 708   ELSE IF region-range THEN DO:
 709     FIND Region WHERE Region.Region = selection-id NO-LOCK.
 710     range-desc = "Region: " + Region.Name.
 711   END.
 712   ELSE IF entity-list THEN DO:
 713     FIND EntityList WHERE EntityList.ListCode = selection-id NO-LOCK.
 714     range-desc = "Entity List: " + EntityList.Description.
 715   END.
 716
 717   IF detailed-property THEN range-desc = Property.Name + " (" + STRING( Property.PropertyCode, "99999" ) + ")" +
 718     IF range-desc = "" THEN "" ELSE ( ", " + range-desc ).
 719   IF to-file THEN
 720     PUT UNFORMATTED '"' + range-desc + '"' SKIP.
 721   ELSE DO:
 722     PUT UNFORMATTED SPACE( ( 132 - LENGTH( range-desc ) ) / 2 ) range-desc.
 723     RUN skip-line(2).
 724   END.
 725
 726   RUN column-header.
 727
 728 END PROCEDURE.
 729
 730 /* _UIB-CODE-BLOCK-END */
 731 &ANALYZE-RESUME
 732
 733 &ENDIF
 734
 735 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 736
 737 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 738 PROCEDURE parse-parameters :
 739 /*------------------------------------------------------------------------------
 740   Purpose:
 741 ------------------------------------------------------------------------------*/
 742 DEF VAR i              AS INT  NO-UNDO.
 743 DEF VAR token          AS CHAR NO-UNDO.
 744
 745 {inc/showopts.i "report-options"}
 746
 747   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 748     token = ENTRY( i, report-options, "~n" ).
 749
 750     CASE ENTRY( 1, token ):
 751
 752       WHEN "Property" THEN
 753       DO:
 754         selection-id = ENTRY( 3, token ).
 755         CASE ENTRY( 2, token ):
 756           WHEN "RANGE" THEN ASSIGN
 757             property-range = Yes
 758             from-property  = INT( TRIM( ENTRY( 1, selection-id, "-") ) )
 759             to-property    = INT( TRIM( ENTRY( 2, selection-id, "-") ) ).
 760           WHEN "PORTFOLIO" THEN manager-range = Yes.
 761           WHEN "MANAGER"   THEN administrator-range = Yes.
 762           WHEN "REGION"    THEN region-range = Yes.
 763           WHEN "LIST"      THEN list-range = Yes.
 764           WHEN "ELIST"     THEN entity-list = Yes.
 765         END CASE.
 766       END.
 767
 768       WHEN "Style" THEN
 769       CASE ENTRY( 2, token ):
 770         WHEN "Detailed" THEN detailed-property = Yes.
 771         WHEN "Account"  THEN consolidated-account = Yes.
 772         WHEN "Property" THEN consolidated-property = Yes.
 773         WHEN "Groups" THEN ASSIGN
 774           group-columns = Yes
 775           consolidated-property = Yes.
 776       END CASE.
 777
 778       WHEN "Preview" THEN report-preview = Yes.
 779
 780       WHEN "File" THEN DO:
 781         to-file = Yes.
 782         out-file-name = TRIM( ENTRY(2, token ) ).
 783       END.
 784
 785       WHEN "Month" THEN DO:
 786         range-type = ENTRY( 2, token ).
 787         RUN get-month-range( range-type, ENTRY( 3, token ) + "," + ENTRY( 4, token ) ).
 788       END.
 789
 790     END CASE.
 791   END.
 792
 793 END PROCEDURE.
 794
 795 /* _UIB-CODE-BLOCK-END */
 796 &ANALYZE-RESUME
 797
 798 &ENDIF
 799
 800 &IF DEFINED(EXCLUDE-print-group-totals) = 0 &THEN
 801
 802 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-group-totals Procedure
 803 PROCEDURE print-group-totals :
 804 /*------------------------------------------------------------------------------
 805   Purpose:
 806 ------------------------------------------------------------------------------*/
 807 DEF INPUT PARAMETER total-description AS CHAR NO-UNDO.
 808
 809   DEF VAR i          AS INT NO-UNDO.
 810   DEF VAR all-zero   AS LOGI NO-UNDO INIT Yes.
 811
 812   DO i = 1 TO 7:
 813     all-zero = all-zero AND group-amnts[i] = 0.00.
 814   END.
 815   IF all-zero THEN RETURN.
 816
 817   IF to-file THEN
 818     PUT UNFORMATTED '"' + total-description + '"'.
 819   ELSE
 820     PUT UNFORMATTED STRING( total-description, "X(25)" ) SPACE(1).
 821
 822   DO i = 1 TO 7:
 823     IF to-file THEN
 824       PUT UNFORMATTED ',' + STRING( group-amnts[i] ).
 825     ELSE
 826       PUT UNFORMATTED STRING( group-amnts[i] * (IF i < 4 OR i = 7 THEN -1 ELSE 1),
 827                               amt-fmt ).
 828     group-totals[i] = group-totals[i] + group-amnts[i].
 829   END.
 830
 831   RUN skip-line(1).
 832
 833 END PROCEDURE.
 834
 835 /* _UIB-CODE-BLOCK-END */
 836 &ANALYZE-RESUME
 837
 838 &ENDIF
 839
 840 &IF DEFINED(EXCLUDE-print-totals) = 0 &THEN
 841
 842 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE print-totals Procedure
 843 PROCEDURE print-totals :
 844 /*------------------------------------------------------------------------------
 845   Purpose:
 846 ------------------------------------------------------------------------------*/
 847
 848   DEF INPUT PARAMETER level     AS INT NO-UNDO.
 849   DEF INPUT PARAMETER total-description AS CHAR NO-UNDO.
 850
 851   DEF VAR i          AS INT NO-UNDO.
 852   DEF VAR all-zero   AS LOGI NO-UNDO INIT Yes.
 853   DEF VAR multiplier AS DEC NO-UNDO.
 854   DEF VAR n-tots     AS INT NO-UNDO.
 855   n-tots = IF range-type = "NORMAL" THEN 7 ELSE 6.
 856
 857   DO i = 1 TO 7:
 858     all-zero = all-zero AND total[ ( level - 1 ) * 7 + i ] = 0.00.
 859   END.
 860   IF all-zero THEN RETURN.
 861
 862   IF level > 1 THEN RUN separator-line.
 863   IF to-file THEN
 864     PUT UNFORMATTED '"' + total-description + '"'.
 865   ELSE
 866     PUT UNFORMATTED STRING( total-description, "X(25)" ) SPACE(1).
 867
 868   IF level = 4 THEN multiplier = -1.
 869   ELSE IF detailed-property OR consolidated-account THEN
 870   DO:
 871     FIND AccountGroup OF ChartOfAccount NO-LOCK NO-ERROR.
 872     multiplier = IF AVAILABLE AccountGroup THEN
 873       ( IF AccountGroup.CreditGroup THEN -1 ELSE 1 ) ELSE last-multiplier.
 874   END.
 875   ELSE multiplier = -1.
 876
 877   DO i = 1 TO n-tots:
 878     IF to-file THEN
 879       PUT UNFORMATTED ',' + STRING( total[ ( level - 1 ) * 7 + i ] * multiplier ).
 880     ELSE
 881       PUT UNFORMATTED STRING( total[ ( level - 1 ) * 7 + i ] * (IF i = 3 OR i = 6 THEN -1 ELSE multiplier),
 882                               (IF i = 3 OR i = 6 THEN var-fmt ELSE amt-fmt) ).
 883   END.
 884
 885   RUN skip-line( IF level = 1 OR level = 4 THEN 1 ELSE 2 ).
 886
 887   last-multiplier = multiplier.
 888
 889 END PROCEDURE.
 890
 891 /* _UIB-CODE-BLOCK-END */
 892 &ANALYZE-RESUME
 893
 894 &ENDIF
 895
 896 &IF DEFINED(EXCLUDE-property-iteration) = 0 &THEN
 897
 898 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE property-iteration Procedure
 899 PROCEDURE property-iteration :
 900 /*------------------------------------------------------------------------------
 901   Purpose:
 902 ------------------------------------------------------------------------------*/
 903
 904   IF detailed-property OR consolidated-property THEN
 905     IF NOT CAN-FIND( FIRST AccountBalance WHERE
 906       AccountBalance.EntityType = 'P' AND
 907       AccountBalance.EntityCode = Property.PropertyCode AND
 908       AccountBalance.MonthCode >= month-from AND
 909       AccountBalance.MonthCode <= month-to ) THEN RETURN.
 910
 911   IF consolidated-account THEN
 912     RUN each-property-account.
 913   ELSE IF detailed-property THEN DO:
 914     RUN reset-totals( 4 ).
 915     page-no = 1.
 916     RUN page-header.
 917     RUN iterate-accounts.
 918     RUN page-feed.
 919   END.
 920   ELSE IF group-columns THEN DO:
 921     RUN iterate-accounts.
 922   END.
 923   ELSE IF consolidated-property THEN DO:
 924     RUN reset-totals( 1 ).
 925     RUN iterate-accounts.
 926     RUN print-totals( 1, Property.Name ).
 927   END.
 928
 929 END PROCEDURE.
 930
 931 /* _UIB-CODE-BLOCK-END */
 932 &ANALYZE-RESUME
 933
 934 &ENDIF
 935
 936 &IF DEFINED(EXCLUDE-reset-page) = 0 &THEN
 937
 938 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-page Procedure
 939 PROCEDURE reset-page :
 940 /*------------------------------------------------------------------------------
 941   Purpose:
 942   Parameters:  <none>
 943   Notes:
 944 ------------------------------------------------------------------------------*/
 945
 946   IF NOT report-preview THEN
 947   DO:
 948     PUT CONTROL reset-page.
 949     PUT CONTROL courier-font.
 950   END.
 951   ln = 0.
 952
 953 END PROCEDURE.
 954
 955 /* _UIB-CODE-BLOCK-END */
 956 &ANALYZE-RESUME
 957
 958 &ENDIF
 959
 960 &IF DEFINED(EXCLUDE-reset-totals) = 0 &THEN
 961
 962 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-totals Procedure
 963 PROCEDURE reset-totals :
 964 /*------------------------------------------------------------------------------
 965   Purpose:
 966   Parameters:  <none>
 967   Notes:
 968 ------------------------------------------------------------------------------*/
 969
 970   DEF INPUT PARAMETER level AS INT NO-UNDO.
 971
 972   DEF VAR i AS INT NO-UNDO.
 973
 974   DO i = 1 TO 7:
 975     total[ ( level - 1 ) * 7 + i ] = 0.00.
 976   END.
 977
 978 END PROCEDURE.
 979
 980 /* _UIB-CODE-BLOCK-END */
 981 &ANALYZE-RESUME
 982
 983 &ENDIF
 984
 985 &IF DEFINED(EXCLUDE-separator-line) = 0 &THEN
 986
 987 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE separator-line Procedure
 988 PROCEDURE separator-line :
 989 /*------------------------------------------------------------------------------
 990   Purpose:
 991   Parameters:  <none>
 992   Notes:
 993 ------------------------------------------------------------------------------*/
 994
 995   IF to-file THEN
 996     PUT UNFORMATTED '""' + FILL( ',"' + FILL( '-', 14) + '"',
 997                                  (IF range-type = "NORMAL" THEN 7 ELSE 6) ).
 998   ELSE
 999     PUT UNFORMATTED SPACE(26)
1000           FILL( '-', 14 ) + ' ' + FILL( '-', 14 ) + ' ' + FILL( '-', 14 ) + ' ' +
1001           FILL( '-', 14 ) + ' ' + FILL( '-', 14 ) + ' ' + FILL( '-', 14 ) + ' ' +
1002           ( IF range-type = "NORMAL" THEN FILL( '-', 14 ) ELSE "" ).
1003
1004   RUN skip-line(1).
1005
1006 END PROCEDURE.
1007
1008 /* _UIB-CODE-BLOCK-END */
1009 &ANALYZE-RESUME
1010
1011 &ENDIF
1012
1013 &IF DEFINED(EXCLUDE-skip-line) = 0 &THEN
1014
1015 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE skip-line Procedure
1016 PROCEDURE skip-line :
1017 /*------------------------------------------------------------------------------
1018   Purpose:
1019   Parameters:  <none>
1020   Notes:
1021 ------------------------------------------------------------------------------*/
1022 DEF INPUT PARAMETER n AS DEC NO-UNDO.
1023
1024 DEF VAR int-part AS INT NO-UNDO.
1025 DEF VAR dec-part AS DEC NO-UNDO.
1026
1027   int-part = TRUNCATE( n, 0 ).
1028   IF int-part < 0 THEN RETURN.
1029   dec-part = n - int-part.
1030   IF int-part = 0 AND dec-part = 0 THEN RETURN.
1031
1032   IF page-lines > 0 AND (ln + n) >= page-lines THEN DO:
1033     RUN page-feed.
1034     RUN page-header.
1035   END.
1036   ELSE DO:
1037     IF dec-part <> 0 THEN PUT CONTROL half-line.
1038
1039     IF int-part > 1 THEN PUT SKIP(int-part).
1040     ELSE IF int-part = 1 THEN PUT " " SKIP.
1041     ln = ln + n.
1042   END.
1043
1044 END PROCEDURE.
1045
1046 /* _UIB-CODE-BLOCK-END */
1047 &ANALYZE-RESUME
1048
1049 &ENDIF
1050