forecast/amtrust-to-budgets.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   AmTrust Rental Forecasting Run
   6   ------------------------------------------------------------------------*/
   7 &SCOPED-DEFINE REPORT-ID "Amtrust Rental Run"
   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 month-1 AS INT NO-UNDO       INIT ?.
  13 DEF VAR month-n AS INT NO-UNDO       INIT ?.
  14 DEF VAR forecast-start AS DATE NO-UNDO.
  15 DEF VAR forecast-end AS DATE NO-UNDO.
  16 RUN parse-parameters.
  17 IF ERROR-STATUS:ERROR THEN RETURN.
  18
  19 DEF VAR mfmt AS CHAR NO-UNDO INITIAL "->>>,>>>,>>9.99".
  20 DEF VAR pfmt AS CHAR NO-UNDO INITIAL "->>9.99999".
  21 DEF VAR i AS INT NO-UNDO.
  22
  23 DEF VAR user-name AS CHAR NO-UNDO.
  24 {inc/username.i "user-name"}
  25 DEF VAR timeStamp AS CHAR FORMAT "X(44)" NO-UNDO.
  26 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
  27
  28 DEF VAR base-font AS CHAR NO-UNDO   INITIAL "fixed,courier,cpi,18,lpi,9,normal".
  29 DEF VAR header-font AS CHAR NO-UNDO   INITIAL "proportional,helvetica,point,10,lpi,7,bold".
  30
  31 {inc/ofc-this.i}
  32
  33 /* revised / budget closed-to months */
  34 DEF VAR forecast-first AS INT NO-UNDO   INITIAL 999999.
  35 DEF VAR budget-first AS INT NO-UNDO     INITIAL 999999.
  36 {inc/ofc-set.i "Budget-Closed-To" "budget-closed-date" "ERROR"}
  37 {inc/ofc-set.i "Forecast-Closed-To" "forecast-closed-date" "ERROR"}
  38 FIND FIRST Month WHERE Month.StartDate > DATE(budget-closed-date) NO-LOCK.
  39 budget-first = Month.MonthCode.
  40 FIND FIRST Month WHERE Month.StartDate > DATE(forecast-closed-date) NO-LOCK.
  41 forecast-first = Month.MonthCode.
  42
  43 month-1 = MAX( month-1, MIN(forecast-first, budget-first) ).
  44
  45 DEF BUFFER CascadeP FOR AccountBalance.
  46 DEF BUFFER CascadeL FOR AccountBalance.
  47
  48 /* _UIB-CODE-BLOCK-END */
  49 &ANALYZE-RESUME
  50
  51
  52 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  53
  54 /* ********************  Preprocessor Definitions  ******************** */
  55
  56 &Scoped-define PROCEDURE-TYPE Procedure
  57
  58
  59
  60 /* _UIB-PREPROCESSOR-BLOCK-END */
  61 &ANALYZE-RESUME
  62
  63
  64 /* ************************  Function Prototypes ********************** */
  65
  66 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD clear-account-balance Procedure
  67 FUNCTION clear-account-balance RETURNS LOGICAL
  68   ( /* no parameters */ )  FORWARD.
  69
  70 /* _UIB-CODE-BLOCK-END */
  71 &ANALYZE-RESUME
  72
  73 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD set-budget Procedure
  74 FUNCTION set-budget RETURNS LOGICAL
  75   ( INPUT delta-bud AS DEC )  FORWARD.
  76
  77 /* _UIB-CODE-BLOCK-END */
  78 &ANALYZE-RESUME
  79
  80
  81 /* *********************** Procedure Settings ************************ */
  82
  83 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  84 /* Settings for THIS-PROCEDURE
  85    Type: Procedure
  86    Allow:
  87    Frames: 0
  88    Add Fields to: Neither
  89    Other Settings: CODE-ONLY COMPILE
  90  */
  91 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  92
  93 /* *************************  Create Window  ************************** */
  94
  95 &ANALYZE-SUSPEND _CREATE-WINDOW
  96 /* DESIGN Window definition (used by the UIB)
  97   CREATE WINDOW Procedure ASSIGN
  98          HEIGHT             = .15
  99          WIDTH              = 43.43.
 100 /* END WINDOW DEFINITION */
 101                                                                         */
 102 &ANALYZE-RESUME
 103
 104
 105
 106 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 107 /* ************************* Included-Libraries *********************** */
 108
 109 {inc/date.i}
 110 {inc/method/m-txtrep.i}
 111
 112 /* _UIB-CODE-BLOCK-END */
 113 &ANALYZE-RESUME
 114
 115
 116
 117 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 118
 119
 120 /* ***************************  Main Block  *************************** */
 121
 122 RUN pclrep-start( Yes, "reset,portrait,tm,2,a4,lm,6," + base-font).
 123 OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES PAGE-SIZE 0.
 124
 125 RUN clear-budgets.
 126 RUN apply-to-budgets.
 127
 128 OUTPUT CLOSE.
 129
 130 RUN pclrep-finish.
 131
 132 /* _UIB-CODE-BLOCK-END */
 133 &ANALYZE-RESUME
 134
 135
 136 /* **********************  Internal Procedures  *********************** */
 137
 138 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apply-to-budgets Procedure
 139 PROCEDURE apply-to-budgets :
 140 /*------------------------------------------------------------------------------
 141   Purpose:
 142 ------------------------------------------------------------------------------*/
 143 DEF VAR et AS CHAR NO-UNDO.
 144 DEF VAR ec AS INT NO-UNDO.
 145 DEF VAR ac AS DEC NO-UNDO.
 146 DEF VAR amount AS DEC NO-UNDO.
 147
 148   FOR EACH PropForecast WHERE PropForecast.MonthCode >= month-1
 149                            AND PropForecast.MonthCode <= month-n
 150                            AND PropForecast.Amount <> 0 NO-LOCK:
 151     et = PropForecast.EntityType.
 152     ec = PropForecast.EntityCode.
 153     amount = PropForecast.Amount.
 154     IF LOOKUP( PropForecast.PropForecastType, "BASE,GBAS,NEW,GNEW,VACT,GVAC,ONE") > 0 THEN
 155         amount = - amount.
 156
 157     IF et = "R" THEN DO:
 158       et = "P".
 159       ec = PropForecast.PropertyCode.
 160     END.
 161     DO TRANSACTION:
 162       FIND AccountBalance WHERE AccountBalance.EntityType = et
 163                   AND AccountBalance.EntityCode = ec
 164                   AND AccountBalance.AccountCode = PropForecast.AccountCode
 165                   AND AccountBalance.MonthCode = PropForecast.MonthCode
 166                   EXCLUSIVE-LOCK NO-ERROR.
 167       IF NOT AVAILABLE(AccountBalance) THEN DO:
 168         CREATE AccountBalance.
 169         AccountBalance.EntityType = et.
 170         AccountBalance.EntityCode = ec.
 171         AccountBalance.AccountCode = PropForecast.AccountCode.
 172         AccountBalance.MonthCode = PropForecast.MonthCode.
 173       END.
 174       set-budget( amount ).
 175     END.
 176   END.
 177
 178 END PROCEDURE.
 179
 180 /* _UIB-CODE-BLOCK-END */
 181 &ANALYZE-RESUME
 182
 183
 184 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clear-budgets Procedure
 185 PROCEDURE clear-budgets :
 186 /*------------------------------------------------------------------------------
 187   Purpose:  Clear the budget / revised budget figures
 188     Notes:  trigger/wractbal.p writes the GL but we can't override it because
 189             it writes the
 190 ------------------------------------------------------------------------------*/
 191   RUN pclrep-line( base-font, "Clearing months from " + STRING(month-1) + " to " + STRING(month-n) ).
 192
 193   FOR EACH AccountBalance WHERE AccountBalance.EntityType = "T"
 194            AND AccountBalance.EntityCode > 0 AND AccountBalance.AccountCode > 0
 195            AND AccountBalance.MonthCode >= month-1 AND AccountBalance.MonthCode <= month-n EXCLUSIVE-LOCK:
 196     clear-account-balance().
 197   END.
 198   FOR EACH AccountBalance WHERE AccountBalance.EntityType = "P"
 199            AND AccountBalance.EntityCode > 0 AND AccountBalance.AccountCode > 0
 200            AND AccountBalance.MonthCode >= month-1 AND AccountBalance.MonthCode <= month-n EXCLUSIVE-LOCK:
 201     clear-account-balance().
 202   END.
 203   FOR EACH AccountBalance WHERE AccountBalance.EntityType = "L"
 204            AND AccountBalance.EntityCode > 0 AND AccountBalance.AccountCode > 0
 205            AND AccountBalance.MonthCode >= month-1 AND AccountBalance.MonthCode <= month-n EXCLUSIVE-LOCK:
 206     clear-account-balance().
 207   END.
 208 END PROCEDURE.
 209
 210 /* _UIB-CODE-BLOCK-END */
 211 &ANALYZE-RESUME
 212
 213
 214 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 215 PROCEDURE inst-page-footer :
 216 /*------------------------------------------------------------------------------
 217   Purpose:  Print any page footer
 218 ------------------------------------------------------------------------------*/
 219
 220 END PROCEDURE.
 221
 222 /* _UIB-CODE-BLOCK-END */
 223 &ANALYZE-RESUME
 224
 225
 226 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 227 PROCEDURE inst-page-header :
 228 /*------------------------------------------------------------------------------
 229   Purpose:  Print page header for the rent report
 230 ------------------------------------------------------------------------------*/
 231 DEF VAR tfmt AS CHAR NO-UNDO.
 232
 233   RUN pclrep-line( "univers,Point,7,bold,Proportional", TimeStamp).
 234   RUN pclrep-line( "univers,Point,11,bold,Proportional", SPC(20) + "AmTrust Forecasting Run - Apply to Budgets" ).
 235   RUN pclrep-line( "", "" ).
 236
 237   RUN pclrep-line( base-font + ",bold", "").
 238
 239   RUN pclrep-line( "", "" ).
 240
 241 END PROCEDURE.
 242
 243 /* _UIB-CODE-BLOCK-END */
 244 &ANALYZE-RESUME
 245
 246
 247 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 248 PROCEDURE parse-parameters :
 249 /*------------------------------------------------------------------------------
 250   Purpose:
 251 ------------------------------------------------------------------------------*/
 252 DEF VAR token AS CHAR NO-UNDO.
 253 DEF VAR i AS INT NO-UNDO.
 254
 255 {inc/showopts.i "report-options"}
 256
 257   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 258     token = ENTRY( i, report-options, "~n" ).
 259
 260     /* Preview and Property options are set for each run */
 261     CASE ENTRY( 1, token ):
 262       WHEN "Preview" THEN               preview = Yes.
 263
 264       WHEN "FromMonth" THEN ASSIGN
 265         month-1 = INT(ENTRY(2,token)).
 266
 267     END CASE.
 268   END.
 269
 270 DEF VAR forecast-end AS DATE NO-UNDO.
 271   FIND Month WHERE Month.MonthCode = month-1 NO-LOCK NO-ERROR.
 272   IF NOT AVAILABLE(Month) THEN DO:
 273     MESSAGE "Invalid starting month for forecast"
 274             VIEW-AS ALERT-BOX ERROR.
 275     RETURN ERROR.
 276   END.
 277   forecast-start = Month.StartDate.
 278   forecast-end = Month.StartDate + 367.
 279
 280   FIND LAST Month WHERE Month.EndDate < forecast-end NO-LOCK NO-ERROR.
 281   IF NOT AVAILABLE(Month) THEN DO:
 282     MESSAGE "Invalid ending month for forecast"
 283             VIEW-AS ALERT-BOX ERROR.
 284     RETURN ERROR.
 285   END.
 286   forecast-end = Month.EndDate.
 287   month-n = Month.MonthCode.
 288
 289 END PROCEDURE.
 290
 291 /* _UIB-CODE-BLOCK-END */
 292 &ANALYZE-RESUME
 293
 294
 295 /* ************************  Function Implementations ***************** */
 296
 297 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION clear-account-balance Procedure
 298 FUNCTION clear-account-balance RETURNS LOGICAL
 299   ( /* no parameters */ ) :
 300 /*------------------------------------------------------------------------------
 301   Purpose:  Clear any budget / revised budget figures
 302     Notes:  Checks to see if it's a valid month for applying first.
 303             Just DELETE the accountbalance if there are no transactions.
 304 ------------------------------------------------------------------------------*/
 305
 306   IF preview THEN
 307     RUN pclrep-line( base-font, AccountBalance.EntityType + STRING(AccountBalance.EntityCode,"99999")
 308                 + STRING(AccountBalance.AccountCode, " 9999.99 ")
 309                 + STRING(AccountBalance.MonthCode, ">>,>>9 ")
 310                 + "being cleared" ).
 311
 312   IF AccountBalance.MonthCode >= forecast-first THEN
 313     AccountBalance.RevisedBudget = 0.0 .
 314
 315   IF AccountBalance.MonthCode >= budget-first THEN
 316     AccountBalance.Budget = 0.0 .
 317
 318 END FUNCTION.
 319
 320 /* _UIB-CODE-BLOCK-END */
 321 &ANALYZE-RESUME
 322
 323
 324 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION set-budget Procedure
 325 FUNCTION set-budget RETURNS LOGICAL
 326   ( INPUT delta-bud AS DEC ) :
 327 /*------------------------------------------------------------------------------
 328   Purpose:  Apply the figure to the current AccountBalance budget figure
 329     Notes:  Checks to see if it's a valid month for applying first.
 330 ------------------------------------------------------------------------------*/
 331 DEF VAR et AS CHAR NO-UNDO.
 332 DEF VAR ec AS INT NO-UNDO.
 333
 334   IF AccountBalance.MonthCode >= forecast-first THEN
 335     AccountBalance.RevisedBudget = AccountBalance.RevisedBudget + delta-bud.
 336   IF AccountBalance.MonthCode >= budget-first THEN
 337     AccountBalance.Budget = AccountBalance.Budget + delta-bud.
 338
 339   /* We use two separate buffers for the cascading - it may be a wee bit    */
 340   /* more efficient                                                         */
 341   IF AccountBalance.EntityType <> "L"
 342                 AND AccountBalance.MonthCode >= forecast-first
 343                 AND AccountBalance.MonthCode >= budget-first
 344   THEN DO:
 345     IF AccountBalance.EntityType = "T" THEN DO:
 346       /* Cascade update to relevant entity account of the tenant */
 347       FIND Tenant WHERE Tenant.TenantCode = AccountBalance.EntityCode NO-LOCK.
 348       et = Tenant.EntityType.
 349       ec = Tenant.EntityCode.
 350       FIND CascadeP WHERE CascadeP.EntityType = et
 351                       AND CascadeP.EntityCode = ec
 352                       AND CascadeP.AccountCode = AccountBalance.AccountCode
 353                       AND CascadeP.MonthCode = AccountBalance.MonthCode EXCLUSIVE-LOCK NO-ERROR.
 354       IF NOT AVAILABLE(CascadeP) THEN DO:
 355         CREATE CascadeP.
 356         CascadeP.EntityType  = et.
 357         CascadeP.EntityCode  = ec.
 358         CascadeP.AccountCode = AccountBalance.AccountCode.
 359         CascadeP.MonthCode   = AccountBalance.MonthCode.
 360       END.
 361       IF CascadeP.MonthCode >= forecast-first THEN CascadeP.RevisedBudget = CascadeP.RevisedBudget + delta-bud.
 362       IF CascadeP.MonthCode >= budget-first THEN   CascadeP.Budget = CascadeP.Budget + delta-bud.
 363     END.
 364     ELSE ASSIGN
 365       et = AccountBalance.EntityType
 366       ec = AccountBalance.EntityCode.
 367
 368 /* Property->ledger update is done by the write trigger (trigger/wractbal.p)
 369     IF et = "P" THEN DO:
 370       /* cascade update to relevant GL account */
 371       FIND Property WHERE Property.PropertyCode = ec NO-LOCK.
 372       et = "L".
 373       ec = Property.CompanyCode.
 374       FIND CascadeL WHERE CascadeL.EntityType = et
 375                       AND CascadeL.EntityCode = ec
 376                       AND CascadeL.AccountCode = AccountBalance.AccountCode
 377                       AND CascadeL.MonthCode = AccountBalance.MonthCode EXCLUSIVE-LOCK NO-ERROR.
 378       IF NOT AVAILABLE(CascadeL) THEN DO:
 379         CREATE CascadeL.
 380         CascadeL.EntityType  = et.
 381         CascadeL.EntityCode  = ec.
 382         CascadeL.AccountCode = AccountBalance.AccountCode.
 383         CascadeL.MonthCode   = AccountBalance.MonthCode.
 384       END.
 385       IF CascadeL.MonthCode >= forecast-first THEN CascadeL.RevisedBudget = CascadeL.RevisedBudget + delta-bud.
 386       IF CascadeL.MonthCode >= budget-first THEN   CascadeL.Budget = CascadeL.Budget + delta-bud.
 387     END.
 388 */
 389   END.
 390
 391   RUN pclrep-line( base-font, AccountBalance.EntityType + STRING(AccountBalance.EntityCode,"99999")
 392                 + STRING(AccountBalance.AccountCode, " 9999.99 ")
 393                 + STRING(AccountBalance.MonthCode, ">>,>>9 ")
 394                 + STRING( delta-bud, "->>,>>>,>>9.99 ") ).
 395
 396   RETURN Yes.
 397
 398 END FUNCTION.
 399
 400 /* _UIB-CODE-BLOCK-END */
 401 &ANALYZE-RESUME
 402
 403