process/scn2bud.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
   7
   8 DEF VAR scenario-code  LIKE Scenario.ScenarioCode NO-UNDO.
   9 DEF VAR scenario-set  AS CHAR NO-UNDO       INITIAL "".
  10 DEF VAR debug-mode    AS LOGI NO-UNDO       INITIAL Yes.
  11 DEF VAR to-clear      AS CHAR NO-UNDO.
  12 DEF VAR forecast-from AS DATE NO-UNDO       INITIAL ?.
  13 DEF VAR forecast-to   AS DATE NO-UNDO       INITIAL ?.
  14 DEF VAR entity-t AS CHAR NO-UNDO            INITIAL "".
  15 DEF VAR entity-1 AS INT NO-UNDO             INITIAL 0.
  16 DEF VAR entity-n AS INT NO-UNDO             INITIAL 99999.
  17 RUN parse-parameters.
  18 IF RETURN-VALUE = "FAIL" THEN RETURN.
  19
  20 DEF VAR user-name     AS CHAR NO-UNDO.
  21 {inc/username.i "user-name"}
  22
  23 DEF VAR m-1 AS INT NO-UNDO.
  24 DEF VAR m-n AS INT NO-UNDO.
  25 DEF VAR m-budget-closed AS INT NO-UNDO.
  26 DEF VAR m-forecast-closed AS INT NO-UNDO.
  27
  28 DEF VAR header-list   AS CHAR NO-UNDO.
  29 DEF VAR bucket-months AS CHAR NO-UNDO.
  30 DEF VAR empty-buckets AS CHAR NO-UNDO.
  31 DEF VAR bucket-list   AS CHAR NO-UNDO.
  32 DEF VAR delim         AS CHAR NO-UNDO INIT "|".
  33
  34 DEF VAR all-existing-amounts-cleared AS LOGICAL NO-UNDO INITIAL No.
  35
  36 {inc/ofc-this.i}
  37 {inc/ofc-acct.i "CREDITORS" "sundry-creditors" "ERROR"}
  38 DEF VAR creditors-ledger AS INT NO-UNDO.
  39 creditors-ledger = OfficeControlAccount.EntityCode.
  40
  41 DEF VAR n-buckets As INT NO-UNDO.
  42
  43 DEF TEMP-TABLE FlowBucket NO-UNDO
  44   FIELD EntityType        AS CHAR
  45   FIELD EntityCode        AS INT
  46   FIELD AccountCode       AS DEC
  47   FIELD AmountList AS CHAR
  48
  49   INDEX FlowBucket IS UNIQUE PRIMARY EntityType EntityCode AccountCode.
  50
  51 DEF TEMP-TABLE Affected NO-UNDO
  52   FIELD EntityType        AS CHAR
  53   FIELD EntityCode        AS INT
  54   INDEX ent IS UNIQUE PRIMARY EntityType EntityCode.
  55
  56 /* _UIB-CODE-BLOCK-END */
  57 &ANALYZE-RESUME
  58
  59
  60 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  61
  62 /* ********************  Preprocessor Definitions  ******************** */
  63
  64 &Scoped-define PROCEDURE-TYPE Procedure
  65
  66
  67
  68 /* _UIB-PREPROCESSOR-BLOCK-END */
  69 &ANALYZE-RESUME
  70
  71
  72 /* ************************  Function Prototypes ********************** */
  73
  74 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD exclude-cash-flow Procedure
  75 FUNCTION exclude-cash-flow RETURNS LOGICAL
  76  ( ) FORWARD.
  77
  78 /* _UIB-CODE-BLOCK-END */
  79 &ANALYZE-RESUME
  80
  81
  82 /* *********************** Procedure Settings ************************ */
  83
  84 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  85 /* Settings for THIS-PROCEDURE
  86    Type: Procedure
  87    Allow:
  88    Frames: 0
  89    Add Fields to: Neither
  90    Other Settings: CODE-ONLY COMPILE
  91  */
  92 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  93
  94 /* *************************  Create Window  ************************** */
  95
  96 &ANALYZE-SUSPEND _CREATE-WINDOW
  97 /* DESIGN Window definition (used by the UIB)
  98   CREATE WINDOW Procedure ASSIGN
  99          HEIGHT             = .42
 100          WIDTH              = 40.
 101 /* END WINDOW DEFINITION */
 102                                                                         */
 103 &ANALYZE-RESUME
 104
 105
 106
 107 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 108 /* ************************* Included-Libraries *********************** */
 109
 110 {inc/method/m-debug.i}
 111 {inc/cashflow.i}
 112 {inc/entity.i}
 113
 114 /* _UIB-CODE-BLOCK-END */
 115 &ANALYZE-RESUME
 116
 117
 118
 119 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 120
 121
 122 /* ***************************  Main Block  *************************** */
 123 &SCOP KEEP-DEBUG-MESSAGES KEEP-MESSAGES
 124 {&DEBUG-BEGIN}
 125
 126 debug-event("Starting forecast export").
 127 FIND Scenario WHERE Scenario.ScenarioCode = scenario-code NO-LOCK NO-ERROR.
 128 IF NOT AVAILABLE(Scenario) THEN DO:
 129   MESSAGE "Scenario" scenario-code "not found."
 130             VIEW-AS ALERT-BOX ERROR TITLE "No Such Scenario".
 131   RETURN.
 132 END.
 133
 134 /* Get the column headings & initialize the empty buckets */
 135 RUN get-forecast-period.
 136 IF RETURN-VALUE = "FAIL" THEN DO:
 137   debug-event( "Problems with forecast period - bugging out" ).
 138   {&DEBUG-END}
 139   RETURN.
 140 END.
 141
 142 RUN split-cash-flow(forecast-from, forecast-to, "MNTH", forecast-from, forecast-to, "MNTH", 0, No,
 143                     OUTPUT header-list, OUTPUT empty-buckets ).
 144 n-buckets = NUM-ENTRIES(header-list).
 145 RUN get-bucket-months.
 146 IF RETURN-VALUE = "FAIL" THEN DO:
 147   {&DEBUG-END}
 148   RETURN.
 149 END.
 150
 151 IF scenario-set <> "" THEN
 152   RUN process-scenario-set.
 153 ELSE
 154   RUN generate-flows.
 155
 156 RUN apply-to-forecasts.
 157
 158 MESSAGE "Budget/Forecast figures updated" VIEW-AS ALERT-BOX INFORMATION TITLE "Done".
 159
 160 debug-event("Finished").
 161
 162 {&DEBUG-END}
 163
 164 /* _UIB-CODE-BLOCK-END */
 165 &ANALYZE-RESUME
 166
 167
 168 /* **********************  Internal Procedures  *********************** */
 169
 170 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE add-to-bucket Procedure
 171 PROCEDURE add-to-bucket :
 172 /*------------------------------------------------------------------------------
 173   Purpose:
 174   Parameters:  <none>
 175   Notes:
 176 ------------------------------------------------------------------------------*/
 177 DEF INPUT PARAMETER et AS CHAR NO-UNDO.
 178 DEF INPUT PARAMETER ec AS INT NO-UNDO.
 179 DEF INPUT PARAMETER ac AS DEC NO-UNDO.
 180 DEF INPUT PARAMETER split-name AS CHAR NO-UNDO.
 181 DEF INPUT PARAMETER split-flow AS CHAR NO-UNDO.
 182
 183   FIND FIRST FlowBucket WHERE FlowBucket.EntityType = et AND FlowBucket.EntityCode = ec
 184                         AND FlowBucket.AccountCode = ac NO-ERROR.
 185
 186   IF NOT AVAILABLE FlowBucket THEN DO:
 187     CREATE FlowBucket.
 188     ASSIGN  FlowBucket.EntityType = et
 189             FlowBucket.EntityCode = ec
 190             FlowBucket.AccountCode = ac
 191             FlowBucket.AmountList = FILL( "0" + delim, n-buckets - 1) + "0".
 192   END.
 193
 194   /* Add the split information to the bucket */
 195   DEF VAR i   AS INT NO-UNDO.
 196   DEF VAR idx AS INT NO-UNDO.
 197   DEF VAR amt AS DEC NO-UNDO.
 198   DEF VAR n-splits AS INT NO-UNDO.
 199
 200   n-splits = NUM-ENTRIES(split-name).
 201   DO i = 1 TO n-splits:
 202     idx = LOOKUP( ENTRY(i, split-name), header-list ).
 203     IF idx = 0 THEN DO:
 204       MESSAGE "Adding to bucket..." CashFlow.EntityType CashFlow.EntityCode CashFlow.AccountCode CashFlow.RelatedKey.
 205       MESSAGE "Names:" split-name.
 206       MESSAGE "Flows:" split-flow.
 207       MESSAGE i delim idx.
 208     END.
 209     amt = DEC(ENTRY(idx, FlowBucket.AmountList, delim)) + DEC(ENTRY(i, split-flow)).
 210     ENTRY(idx, FlowBucket.AmountList, delim) = STRING(amt).
 211
 212   END.
 213
 214 END PROCEDURE.
 215
 216 /* _UIB-CODE-BLOCK-END */
 217 &ANALYZE-RESUME
 218
 219
 220 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apply-flows Procedure
 221 PROCEDURE apply-flows :
 222 /*------------------------------------------------------------------------------
 223   Purpose:
 224 ------------------------------------------------------------------------------*/
 225 DEF VAR amt AS DEC NO-UNDO.
 226 DEF VAR mth AS INT NO-UNDO.
 227 DEF VAR i AS INT NO-UNDO.
 228
 229   debug-event("Applying flow figures to forecast").
 230   FOR EACH FlowBucket NO-LOCK BREAK BY EntityType BY EntityCode BY AccountCode:
 231     debug-event("Flows for: " + FlowBucket.EntityType + STRING(FlowBucket.EntityCode,"99999")
 232                     + "-" + STRING(FlowBucket.AccountCode,"9999.99") ).
 233     DO i = 1 TO n-buckets:
 234       amt = DEC( ENTRY( i, FlowBucket.AmountList, "|" ) ).
 235       IF amt = 0 THEN NEXT.
 236       mth = INT( ENTRY( i, bucket-months ) ).
 237
 238       FIND AccountBalance OF FlowBucket WHERE AccountBalance.MonthCode = mth EXCLUSIVE-LOCK NO-ERROR.
 239       IF NOT AVAILABLE(AccountBalance) THEN DO:
 240         CREATE AccountBalance.
 241         ASSIGN  AccountBalance.EntityType       = FlowBucket.EntityType
 242                 AccountBalance.EntityCode       = FlowBucket.EntityCode
 243                 AccountBalance.AccountCode      = FlowBucket.AccountCode
 244                 AccountBalance.MonthCode        = mth
 245                 AccountBalance.Balance          = 0
 246                 AccountBalance.Budget           = 0
 247                 AccountBalance.RevisedBudget    = 0 .
 248       END.
 249       RUN set-forecast( amt ).
 250     END.
 251   END.
 252
 253 END PROCEDURE.
 254
 255 /* _UIB-CODE-BLOCK-END */
 256 &ANALYZE-RESUME
 257
 258
 259 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apply-to-forecasts Procedure
 260 PROCEDURE apply-to-forecasts :
 261 /*------------------------------------------------------------------------------
 262   Purpose:
 263 ------------------------------------------------------------------------------*/
 264
 265   DO WHILE CAN-FIND(FIRST FlowBucket ):
 266     RUN clear-forecasts.
 267     RUN apply-flows.
 268     RUN evolve-flow-consequences.
 269   END.
 270
 271 END PROCEDURE.
 272
 273 /* _UIB-CODE-BLOCK-END */
 274 &ANALYZE-RESUME
 275
 276
 277 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clear-accounts Procedure
 278 PROCEDURE clear-accounts :
 279 /*------------------------------------------------------------------------------
 280   Purpose:
 281 ------------------------------------------------------------------------------*/
 282   FOR EACH FlowBucket NO-LOCK BREAK BY EntityType BY EntityCode BY AccountCode:
 283     /* set the balances for the account to zero */
 284     FOR EACH AccountBalance OF Flowbucket WHERE AccountBalance.MonthCode >= m-1
 285                             AND AccountBalance.MonthCode <= m-n:
 286       RUN set-forecast( 0.0 ).
 287     END.
 288
 289     IF FlowBucket.EntityType = "P" THEN DO:
 290       /* Set the appropriate balance for the owning ledger to 0 also */
 291       FIND Property WHERE Property.PropertyCode = FlowBucket.EntityCode NO-LOCK NO-ERROR.
 292       IF AVAILABLE(Property) THEN DO:
 293         FOR EACH AccountBalance OF Flowbucket WHERE AccountBalance.EntityType = "L"
 294                             AND AccountBalance.EntityCode = Property.CompanyCode
 295                             AND AccountBalance.AccountCode = FlowBucket.AccountCode
 296                             AND AccountBalance.MonthCode >= m-1
 297                             AND AccountBalance.MonthCode <= m-n:
 298           RUN set-forecast( 0.0 ).
 299         END.
 300       END.
 301     END.
 302
 303   END.
 304
 305 END PROCEDURE.
 306
 307 /* _UIB-CODE-BLOCK-END */
 308 &ANALYZE-RESUME
 309
 310
 311 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clear-all Procedure
 312 PROCEDURE clear-all :
 313 /*------------------------------------------------------------------------------
 314   Purpose:  Clear all property and gl budget/forecast figures
 315 ------------------------------------------------------------------------------*/
 316 IF all-existing-amounts-cleared THEN RETURN.
 317
 318   FOR EACH AccountBalance WHERE AccountBalance.EntityType = "P"
 319                             AND AccountBalance.MonthCode >= m-1
 320                             AND AccountBalance.MonthCode <= m-n:
 321     RUN set-forecast( 0.0 ).
 322   END.
 323
 324   FOR EACH AccountBalance WHERE AccountBalance.EntityType = "L"
 325                             AND AccountBalance.MonthCode >= m-1
 326                             AND AccountBalance.MonthCode <= m-n:
 327     RUN set-forecast( 0.0 ).
 328   END.
 329
 330   all-existing-amounts-cleared = Yes.
 331
 332 END PROCEDURE.
 333
 334 /* _UIB-CODE-BLOCK-END */
 335 &ANALYZE-RESUME
 336
 337
 338 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clear-entities Procedure
 339 PROCEDURE clear-entities :
 340 /*------------------------------------------------------------------------------
 341   Purpose:
 342 ------------------------------------------------------------------------------*/
 343
 344   FOR EACH FlowBucket NO-LOCK BREAK BY EntityType BY EntityCode BY AccountCode:
 345     FIND Affected OF FlowBucket NO-LOCK NO-ERROR.
 346     IF NOT AVAILABLE(Affected) THEN DO:
 347       CREATE Affected.
 348       Affected.EntityType = FlowBucket.EntityType.
 349       Affected.EntityCode = FlowBucket.EntityCode.
 350     END.
 351
 352 /*
 353     IF FlowBucket.EntityType = "P" THEN DO:
 354       FIND Property WHERE Property.PropertyCode = FlowBucket.EntityCode NO-LOCK NO-ERROR.
 355       IF AVAILABLE(Property) THEN DO:
 356         FIND Affected WHERE Affected.EntityType = "L"
 357                         AND Affected.EntityCode = Property.CompanyCode NO-LOCK NO-ERROR.
 358         IF NOT AVAILABLE(Affected) THEN DO:
 359           CREATE Affected.
 360           Affected.EntityType = "L".
 361           Affected.EntityCode = Property.CompanyCode.
 362         END.
 363       END.
 364     END.
 365 */
 366   END.
 367
 368   /* Now clear all accounts for each of the entities we have discovered */
 369   FOR EACH Affected:
 370     FOR EACH AccountBalance OF Affected WHERE AccountBalance.MonthCode >= m-1
 371                                         AND AccountBalance.MonthCode <= m-n:
 372       RUN set-forecast( 0.0 ).
 373     END.
 374     DELETE Affected.
 375   END.
 376
 377 END PROCEDURE.
 378
 379 /* _UIB-CODE-BLOCK-END */
 380 &ANALYZE-RESUME
 381
 382
 383 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clear-forecasts Procedure
 384 PROCEDURE clear-forecasts :
 385 /*------------------------------------------------------------------------------
 386   Purpose:
 387 ------------------------------------------------------------------------------*/
 388
 389   debug-event("Clearing " + to-clear ).
 390   CASE to-clear:
 391     WHEN "accounts" THEN RUN clear-accounts.
 392     WHEN "entities" THEN RUN clear-entities.
 393     WHEN "all"      THEN RUN clear-all.
 394   END CASE.
 395
 396 END PROCEDURE.
 397
 398 /* _UIB-CODE-BLOCK-END */
 399 &ANALYZE-RESUME
 400
 401
 402 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE evolve-flow-consequences Procedure
 403 PROCEDURE evolve-flow-consequences :
 404 /*------------------------------------------------------------------------------
 405   Purpose:
 406 ------------------------------------------------------------------------------*/
 407
 408   debug-event("Evolving flow consequences from existing flows").
 409   FOR EACH FlowBucket BY ROWID(FlowBucket):
 410     CASE FlowBucket.EntityType:
 411       WHEN "T" THEN ASSIGN  FlowBucket.EntityType = "L".
 412       WHEN "C" THEN ASSIGN  FlowBucket.EntityType = "L"
 413                             FlowBucket.EntityCode = creditors-ledger.
 414       WHEN "L" THEN DELETE FlowBucket.
 415
 416       WHEN "P" THEN DO:
 417         FIND Property NO-LOCK WHERE Property.PropertyCode = FlowBucket.EntityCode NO-ERROR.
 418         IF AVAILABLE(Property) THEN ASSIGN  FlowBucket.EntityType = "L"
 419                                             FlowBucket.EntityCode = Property.CompanyCode.
 420       END.
 421
 422       WHEN "J" THEN DO:
 423         FIND ProjectBudget WHERE ProjectBudget.ProjectCode = FlowBucket.EntityCode
 424                            AND ProjectBudget.AccountCode = FlowBucket.AccountCode NO-LOCK NO-ERROR.
 425         IF AVAILABLE(ProjectBudget) THEN
 426             ASSIGN  FlowBucket.EntityType  = ProjectBudget.EntityType
 427                     FlowBucket.EntityCode  = ProjectBudget.EntityCode
 428                     FlowBucket.AccountCode = ProjectBudget.EntityAccount.
 429       END.
 430
 431 /* Handle fixed assets when they arrive...
 432       WHEN "F" THEN DO:
 433         FIND FixedAsset WHERE FixedAsset.AssetCode = FlowBucket.EntityCode NO-LOCK NO-ERROR.
 434         IF AVAILABLE(FixedAsset) THEN
 435             ASSIGN  FlowBucket.EntityType  = FixedAsset.EntityType
 436                     FlowBucket.EntityCode  = FixedAsset.EntityCode.
 437       END.
 438 */
 439     END CASE.
 440   END.
 441
 442 END PROCEDURE.
 443
 444 /* _UIB-CODE-BLOCK-END */
 445 &ANALYZE-RESUME
 446
 447
 448 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE generate-flows Procedure
 449 PROCEDURE generate-flows :
 450 /*------------------------------------------------------------------------------
 451   Purpose:
 452 ------------------------------------------------------------------------------*/
 453 DEF VAR split-name  AS CHAR NO-UNDO.
 454 DEF VAR split-flow  AS CHAR NO-UNDO.
 455 DEF VAR i           AS INT  NO-UNDO.
 456
 457   RUN get-forecast-period.
 458   IF RETURN-VALUE = "FAIL" THEN RETURN.
 459
 460   FOR EACH CashFlow OF Scenario NO-LOCK:
 461     IF exclude-cash-flow() THEN NEXT.
 462
 463     RUN split-cash-flow( forecast-from, forecast-to, "MNTH",
 464         CashFlow.StartDate, CashFlow.EndDate, CashFlow.FrequencyCode, CashFlow.Amount,
 465         flow-on-1st(CashFlow.CashFlowType, CashFlow.FrequencyCode),
 466         OUTPUT split-name, OUTPUT split-flow ).
 467
 468     IF debug-mode THEN
 469       RUN dump-cash-flow( split-name, split-flow, "" ).
 470
 471     RUN add-to-bucket( CashFlow.EntityType, CashFlow.EntityCode, CashFlow.AccountCode, split-name, split-flow ).
 472
 473   END.
 474
 475 END PROCEDURE.
 476
 477 /* _UIB-CODE-BLOCK-END */
 478 &ANALYZE-RESUME
 479
 480
 481 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-bucket-months Procedure
 482 PROCEDURE get-bucket-months :
 483 /*------------------------------------------------------------------------------
 484   Purpose:
 485 ------------------------------------------------------------------------------*/
 486 DEF VAR i AS INT NO-UNDO.
 487
 488   bucket-months = "".
 489   DO i = 1 TO n-buckets:
 490     FIND Month WHERE Month.StartDate = start-of-bucket(ENTRY(i,header-list)) NO-LOCK NO-ERROR.
 491     IF NOT AVAILABLE(Month) THEN DO:
 492       debug-event("Couldn't find Month for '" + ENTRY(i,header-list) + "'").
 493       RETURN "FAIL".
 494     END.
 495     bucket-months = bucket-months + STRING(Month.MonthCode) + ",".
 496   END.
 497   bucket-months = TRIM(bucket-months, ",").
 498
 499 END PROCEDURE.
 500
 501 /* _UIB-CODE-BLOCK-END */
 502 &ANALYZE-RESUME
 503
 504
 505 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-forecast-period Procedure
 506 PROCEDURE get-forecast-period :
 507 /*------------------------------------------------------------------------------
 508   Purpose:
 509 ------------------------------------------------------------------------------*/
 510 forecast-from = ?.
 511 forecast-to = ?.
 512
 513   FIND Month WHERE Month.MonthCode = m-1 NO-LOCK NO-ERROR.
 514   IF NOT AVAILABLE(Month) THEN DO:
 515     debug-event( "Scenario " + STRING(Scenario.ScenarioCode)
 516              + " - cannot find Month for start of forecast period" ).
 517     MESSAGE "Cannot find first month of scenario period to apply forecasts"
 518             VIEW-AS ALERT-BOX ERROR TITLE "Start Month not found!".
 519     RETURN "FAIL".
 520   END.
 521   forecast-from = Month.StartDate.
 522
 523   FIND Month WHERE Month.MonthCode = m-n NO-LOCK NO-ERROR.
 524   IF NOT AVAILABLE(Month) THEN DO:
 525     debug-event( "Scenario " + STRING(Scenario.ScenarioCode)
 526              + " - cannot find Month for end of forecast period" ).
 527     MESSAGE "Cannot find first month of scenario period to apply forecasts"
 528             VIEW-AS ALERT-BOX ERROR TITLE "Start Month not found!".
 529     RETURN "FAIL".
 530   END.
 531   forecast-to = Month.EndDate.
 532
 533 {inc/ofc-this.i}
 534 {inc/ofc-set.i "Budget-Closed-To" "budget-closed-to" "ERROR"}
 535 DEF VAR budget-closed-date AS DATE NO-UNDO  INITIAL ?.
 536   ASSIGN budget-closed-date = DATE(budget-closed-to) NO-ERROR.
 537   IF budget-closed-date = ? THEN DO:
 538     debug-event( "Budget-Closed-To not set to a valid date." ).
 539     MESSAGE "Office Setting 'Budget-Closed-To' is not a valid date."
 540             VIEW-AS ALERT-BOX ERROR TITLE "Invalid 'Budget-Closed-To' date".
 541     RETURN "FAIL".
 542   END.
 543
 544   FIND FIRST Month WHERE Month.StartDate > budget-closed-date NO-LOCK NO-ERROR.
 545   IF NOT AVAILABLE(Month) THEN DO:
 546     debug-event( "Cannot find Month for budget closed date" ).
 547     MESSAGE "Cannot find month for budget closed date"
 548             VIEW-AS ALERT-BOX ERROR TITLE "Start Month not found!".
 549     RETURN "FAIL".
 550   END.
 551   m-budget-closed = Month.MonthCode.
 552
 553 {inc/ofc-set.i "Forecast-Closed-To" "forecast-closed-to" "ERROR"}
 554 DEF VAR forecast-closed-date AS DATE NO-UNDO  INITIAL ?.
 555   ASSIGN forecast-closed-date = DATE(forecast-closed-to) NO-ERROR.
 556   IF forecast-closed-date = ? THEN DO:
 557     debug-event( "Forecast-Closed-To not set to a valid date." ).
 558     MESSAGE "Office Setting 'Forecast-Closed-To' is not a valid date."
 559             VIEW-AS ALERT-BOX ERROR TITLE "Invalid 'Forecast-Closed-To' date".
 560     RETURN "FAIL".
 561   END.
 562
 563   FIND FIRST Month WHERE Month.StartDate > forecast-closed-date NO-LOCK NO-ERROR.
 564   IF NOT AVAILABLE(Month) THEN DO:
 565     debug-event( "Cannot find Month for forecast closed date" ).
 566     MESSAGE "Cannot find month for forecast closed date"
 567             VIEW-AS ALERT-BOX ERROR TITLE "Start Month not found!".
 568     RETURN "FAIL".
 569   END.
 570   m-forecast-closed = Month.MonthCode.
 571
 572 END PROCEDURE.
 573
 574 /* _UIB-CODE-BLOCK-END */
 575 &ANALYZE-RESUME
 576
 577
 578 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 579 PROCEDURE parse-parameters :
 580 /*------------------------------------------------------------------------------
 581   Purpose:
 582 ------------------------------------------------------------------------------*/
 583 DEF VAR i           AS INT NO-UNDO.
 584 DEF VAR token       AS CHAR NO-UNDO.
 585 DEF VAR attrib-desc AS CHAR NO-UNDO.
 586
 587   MESSAGE report-options.
 588
 589   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 590
 591     token = ENTRY( i, report-options, "~n" ).
 592     CASE( ENTRY( 1, token ) ):
 593
 594       WHEN "Clear" THEN         to-clear = ENTRY( 2, token ).
 595       WHEN "Scenario" THEN      scenario-code = INT( ENTRY( 2, token ) ).
 596       WHEN "ScenarioSet" THEN   scenario-set = SUBSTRING( token, 13 ).
 597       WHEN "Debug" THEN         debug-mode = Yes.
 598
 599       WHEN "MonthRange" THEN ASSIGN
 600         m-1 = INT( ENTRY( 2, token ))
 601         m-n = INT( ENTRY( 3, token )).
 602
 603       WHEN "EntityType" THEN    entity-t = SUBSTRING( ENTRY( 2, token ), 1, 1).
 604       WHEN "EntityRange" THEN ASSIGN
 605         entity-1 = INT( ENTRY( 2, token ))
 606         entity-n = INT( ENTRY( 3, token )).
 607
 608     END CASE.
 609   END.
 610
 611   IF scenario-set <> "" THEN DO:
 612     FIND FIRST Scenario WHERE CAN-FIND( ScenarioParameter OF Scenario
 613                 WHERE ScenarioParameter.ParameterID = "Member-Of"
 614                 AND LOOKUP( scenario-set, ScenarioParameter.Data ) > 0 )
 615                 NO-LOCK NO-ERROR.
 616     IF AVAILABLE(Scenario) THEN
 617       scenario-code = Scenario.ScenarioCode.
 618     ELSE DO:
 619       MESSAGE "No scenarios are members of set '" + scenario-set + "'"
 620                 VIEW-AS ALERT-BOX ERROR TITLE "Set is Empty".
 621       RETURN "FAIL".
 622     END.
 623   END.
 624
 625 END PROCEDURE.
 626
 627 /* _UIB-CODE-BLOCK-END */
 628 &ANALYZE-RESUME
 629
 630
 631 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-scenario-set Procedure
 632 PROCEDURE process-scenario-set :
 633 /*------------------------------------------------------------------------------
 634   Purpose:
 635   Parameters:  <none>
 636   Notes:
 637 ------------------------------------------------------------------------------*/
 638
 639   FOR EACH Scenario WHERE CAN-FIND( ScenarioParameter OF Scenario
 640                         WHERE ScenarioParameter.ParameterID = "Member-Of"
 641                         AND LOOKUP( scenario-set, ScenarioParameter.Data ) > 0 )
 642                         NO-LOCK:
 643     RUN generate-flows.
 644   END.
 645 END PROCEDURE.
 646
 647 /* _UIB-CODE-BLOCK-END */
 648 &ANALYZE-RESUME
 649
 650
 651 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-forecast Procedure
 652 PROCEDURE set-forecast :
 653 /*------------------------------------------------------------------------------
 654   Purpose:  Set the forecast figures and, if applicable, the budget figures
 655 ------------------------------------------------------------------------------*/
 656 DEF INPUT PARAMETER new-value AS DEC NO-UNDO.
 657
 658   IF AccountBalance.MonthCode >= m-forecast-closed THEN DO:
 659
 660     AccountBalance.RevisedBudget = new-value.
 661
 662     IF AccountBalance.MonthCode >= m-budget-closed THEN
 663       AccountBalance.Budget = new-value.
 664   END.
 665
 666 END PROCEDURE.
 667
 668 /* _UIB-CODE-BLOCK-END */
 669 &ANALYZE-RESUME
 670
 671
 672 /* ************************  Function Implementations ***************** */
 673
 674 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION exclude-cash-flow Procedure
 675 FUNCTION exclude-cash-flow RETURNS LOGICAL
 676  ( ):
 677 /*------------------------------------------------------------------
 678   Decides whether or not to include the current the current cash flow
 679         in the forecast.
 680   Note: CashFlow record must be available
 681 ------------------------------------------------------------------*/
 682
 683   /* exclude if outside date period */
 684   IF CashFlow.StartDate > forecast-to OR CashFlow.EndDate < forecast-from THEN RETURN Yes.
 685
 686   /* exclude if wrong entity type */
 687   IF entity-t <> "" AND CashFlow.EntityType <> entity-t THEN DO:
 688     debug-event( "Cash flow excluded: wrong entity type '" + CashFlow.EntityType + "' vs '" + entity-t + "'").
 689     RETURN Yes.
 690   END.
 691
 692   /* exclude if it's outside the entity range */
 693   IF CashFlow.EntityCode < entity-1 OR CashFlow.EntityCode > entity-n THEN  DO:
 694     debug-event( "Cash flow excluded: outside entity range, " + STRING(CashFlow.EntityCode) + " vs " + STRING(entity-1) + "-" + STRING(entity-n)).
 695     RETURN Yes.
 696   END.
 697
 698   /* otherwise include it */
 699   RETURN No.
 700
 701 END FUNCTION.
 702
 703 /* _UIB-CODE-BLOCK-END */
 704 &ANALYZE-RESUME
 705
 706