process/autoclos.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        : process/autoclos.p
   6     Purpose     : Automatic closing of transactions
   7
   8     Author(s)   : Tyrone McAuley
   9     Created     : Yonks ago
  10
  11     Finished by : Andrew McMillan
  12   ------------------------------------------------------------------------*/
  13 DEF INPUT PARAMETER report-options AS CHAR NO-UNDO.
  14
  15 DEF VAR preview  AS LOGI NO-UNDO    INITIAL No.
  16 DEF VAR simple-only AS LOGI NO-UNDO INITIAL No.
  17 DEF VAR generate-batch AS LOGI NO-UNDO INITIAL No.
  18 DEF VAR entity-type  LIKE EntityType.EntityType NO-UNDO.
  19 DEF VAR entity-start LIKE AcctTran.EntityCode NO-UNDO.
  20 DEF VAR entity-end   LIKE AcctTran.EntityCode NO-UNDO.
  21 DEF VAR account-code   LIKE AcctTran.AccountCode  NO-UNDO.
  22 DEF VAR fuzzy-limit AS DEC NO-UNDO INITIAL 0.05.
  23 DEF VAR debug AS LOGI NO-UNDO INITIAL No.
  24
  25 DEF VAR all-attempts AS INT NO-UNDO.
  26 DEF VAR max-open AS INT NO-UNDO INITIAL 60.
  27 DEF VAR top-attempts AS INT NO-UNDO INITIAL 10.
  28 DEF VAR med-attempts AS INT NO-UNDO INITIAL 10.
  29 DEF VAR low-attempts AS INT NO-UNDO INITIAL 20.
  30 DEF VAR med-level AS INT NO-UNDO INITIAL 3.
  31
  32 RUN parse-parameters.
  33
  34 DEF VAR out-line AS CHAR NO-UNDO INITIAL "".
  35 DEF VAR header-font  AS CHAR NO-UNDO   INITIAL "proportional,helvetica,point,11,bold,lpi,8".
  36 DEF VAR base-font    AS CHAR NO-UNDO   INITIAL "courier,Fixed,cpi,18,lpi,8.5".
  37
  38 DEF TEMP-TABLE OpenTrans NO-UNDO
  39         FIELD BatchCode LIKE AcctTran.BatchCode
  40         FIELD DocumentCode LIKE AcctTran.DocumentCode
  41         FIELD TransactionCode LIKE AcctTran.TransactionCode
  42         FIELD Amount LIKE AcctTran.Amount
  43         INDEX XPKOpen IS UNIQUE PRIMARY BatchCode DocumentCode TransactionCode
  44         INDEX XAK1Open Amount BatchCode DESCENDING.
  45
  46 DEF TEMP-TABLE MatchTry NO-UNDO
  47         FIELD BatchCode LIKE AcctTran.BatchCode
  48         FIELD DocumentCode LIKE AcctTran.DocumentCode
  49         FIELD TransactionCode LIKE AcctTran.TransactionCode
  50         FIELD Depth AS INT
  51         INDEX XPKTry IS UNIQUE PRIMARY BatchCode DocumentCode TransactionCode
  52         INDEX XAKDepth IS UNIQUE Depth.
  53
  54 /* ensure NewBatch & NewDocument are scoped to entire program */
  55 FIND FIRST NewBatch NO-LOCK NO-ERROR.
  56 FIND PREV NewBatch NO-LOCK NO-ERROR.
  57
  58 DEF VAR user-name AS CHAR NO-UNDO.
  59 DEF VAR timeStamp AS CHAR NO-UNDO.
  60
  61 /* _UIB-CODE-BLOCK-END */
  62 &ANALYZE-RESUME
  63
  64
  65 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  66
  67 /* ********************  Preprocessor Definitions  ******************** */
  68
  69 &Scoped-define PROCEDURE-TYPE Procedure
  70 &Scoped-define DB-AWARE no
  71
  72
  73
  74 /* _UIB-PREPROCESSOR-BLOCK-END */
  75 &ANALYZE-RESUME
  76
  77
  78 /* ************************  Function Prototypes ********************** */
  79
  80 &IF DEFINED(EXCLUDE-build-open-list) = 0 &THEN
  81
  82 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD build-open-list Procedure
  83 FUNCTION build-open-list RETURNS LOGICAL
  84   ( INPUT et AS CHAR, INPUT ec AS INT, INPUT ac AS DEC )  FORWARD.
  85
  86 /* _UIB-CODE-BLOCK-END */
  87 &ANALYZE-RESUME
  88
  89 &ENDIF
  90
  91 &IF DEFINED(EXCLUDE-clear-match-tries) = 0 &THEN
  92
  93 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD clear-match-tries Procedure
  94 FUNCTION clear-match-tries RETURNS CHARACTER
  95   ( /* parameter-definitions */ )  FORWARD.
  96
  97 /* _UIB-CODE-BLOCK-END */
  98 &ANALYZE-RESUME
  99
 100 &ENDIF
 101
 102 &IF DEFINED(EXCLUDE-close-matched-group) = 0 &THEN
 103
 104 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD close-matched-group Procedure
 105 FUNCTION close-matched-group RETURNS CHARACTER
 106   ( INPUT et AS CHAR, INPUT ec AS INT, INPUT ac AS DEC )  FORWARD.
 107
 108 /* _UIB-CODE-BLOCK-END */
 109 &ANALYZE-RESUME
 110
 111 &ENDIF
 112
 113 &IF DEFINED(EXCLUDE-show-match-set) = 0 &THEN
 114
 115 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD show-match-set Procedure
 116 FUNCTION show-match-set RETURNS CHARACTER
 117   ( INPUT attempts AS INT, INPUT tgt-1 AS DEC, INPUT dpth AS INT, INPUT tgt-2 AS DEC )  FORWARD.
 118
 119 /* _UIB-CODE-BLOCK-END */
 120 &ANALYZE-RESUME
 121
 122 &ENDIF
 123
 124 &IF DEFINED(EXCLUDE-try-this-one) = 0 &THEN
 125
 126 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD try-this-one Procedure
 127 FUNCTION try-this-one RETURNS LOGICAL
 128   ( INPUT-OUTPUT attempts AS INT, INPUT our-target AS DEC, INPUT in-depth AS INT )  FORWARD.
 129
 130 /* _UIB-CODE-BLOCK-END */
 131 &ANALYZE-RESUME
 132
 133 &ENDIF
 134
 135 &IF DEFINED(EXCLUDE-try-to-match) = 0 &THEN
 136
 137 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD try-to-match Procedure
 138 FUNCTION try-to-match RETURNS LOGICAL
 139   ( INPUT-OUTPUT attempts AS INT )  FORWARD.
 140
 141 /* _UIB-CODE-BLOCK-END */
 142 &ANALYZE-RESUME
 143
 144 &ENDIF
 145
 146
 147 /* *********************** Procedure Settings ************************ */
 148
 149 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 150 /* Settings for THIS-PROCEDURE
 151    Type: Procedure
 152    Allow:
 153    Frames: 0
 154    Add Fields to: Neither
 155    Other Settings: CODE-ONLY COMPILE
 156  */
 157 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 158
 159 /* *************************  Create Window  ************************** */
 160
 161 &ANALYZE-SUSPEND _CREATE-WINDOW
 162 /* DESIGN Window definition (used by the UIB)
 163   CREATE WINDOW Procedure ASSIGN
 164          HEIGHT             = 2.2
 165          WIDTH              = 39.72.
 166 /* END WINDOW DEFINITION */
 167                                                                         */
 168 &ANALYZE-RESUME
 169
 170 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 171 /* ************************* Included-Libraries *********************** */
 172
 173 {inc/method/m-txtrep.i}
 174
 175 /* _UIB-CODE-BLOCK-END */
 176 &ANALYZE-RESUME
 177
 178
 179
 180
 181
 182 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 183
 184
 185 /* ***************************  Main Block  *************************** */
 186 {inc/username.i "user-name"}
 187 timeStamp = STRING( TODAY, "99/99/9999") + ", " + STRING( TIME, "HH:MM:SS") + " for " + user-name.
 188
 189 IF TRANSACTION THEN MESSAGE "Transaction is active".
 190
 191 OUTPUT TO VALUE( txtrep-print-file ) KEEP-MESSAGES PAGE-SIZE 0.
 192 RUN pclrep-start( preview, "reset,portrait,tm,2,a4,lm,4," + base-font).
 193
 194
 195 RUN get-account.
 196 RUN auto-close.
 197
 198 OUTPUT CLOSE.
 199
 200 RUN pclrep-finish.
 201
 202 /* _UIB-CODE-BLOCK-END */
 203 &ANALYZE-RESUME
 204
 205
 206 /* **********************  Internal Procedures  *********************** */
 207
 208 &IF DEFINED(EXCLUDE-auto-close) = 0 &THEN
 209
 210 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE auto-close Procedure
 211 PROCEDURE auto-close :
 212 /*------------------------------------------------------------------------------
 213   Purpose:
 214 ------------------------------------------------------------------------------*/
 215
 216 IF entity-type = 'T' THEN DO:
 217   FOR EACH Tenant NO-LOCK WHERE
 218      Tenant.TenantCode >= entity-start AND Tenant.TenantCode <= entity-end
 219       AND CAN-FIND( FIRST AcctTran WHERE AcctTran.EntityType = entity-type
 220               AND AcctTran.EntityCode = Tenant.TenantCode
 221               AND AcctTran.AccountCode = account-code
 222               AND (AcctTran.ClosingGroup = ? OR AcctTran.ClosedState = 'P') ):
 223     IF NOT CAN-FIND( AccountSummary WHERE AccountSummary.EntityType = entity-type
 224                     AND AccountSummary.EntityCode = Tenant.TenantCode
 225                     AND AccountSummary.AccountCode = account-code
 226                     AND AccountSummary.Balance <> 0 ) THEN
 227       RUN simple-matching( entity-type, Tenant.TenantCode, account-code).
 228     ELSE
 229       RUN complex-matching( entity-type, Tenant.TenantCode, account-code).
 230   END.
 231 END.
 232 ELSE IF entity-type = 'C' THEN DO:
 233   FOR EACH Creditor WHERE
 234      Creditor.CreditorCode >= entity-start AND Creditor.CreditorCode <= entity-end
 235       AND CAN-FIND( FIRST AcctTran WHERE AcctTran.EntityType = entity-type
 236               AND AcctTran.EntityCode = Creditor.CreditorCode
 237               AND AcctTran.AccountCode = account-code
 238               AND (AcctTran.ClosingGroup = ? OR AcctTran.ClosedState = 'P') ):
 239
 240     IF NOT CAN-FIND( AccountSummary WHERE AccountSummary.EntityType = entity-type
 241                       AND AccountSummary.EntityCode = Creditor.CreditorCode
 242                       AND AccountSummary.AccountCode = account-code
 243                       AND AccountSummary.Balance <> 0 ) THEN
 244       RUN simple-matching( entity-type, Creditor.CreditorCode, account-code).
 245     ELSE
 246       RUN complex-matching( entity-type, Creditor.CreditorCode, account-code).
 247   END.
 248 END.
 249
 250 IF generate-batch THEN RUN finish-batch.
 251
 252 END PROCEDURE.
 253
 254 /* _UIB-CODE-BLOCK-END */
 255 &ANALYZE-RESUME
 256
 257 &ENDIF
 258
 259 &IF DEFINED(EXCLUDE-complex-matching) = 0 &THEN
 260
 261 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE complex-matching Procedure
 262 PROCEDURE complex-matching :
 263 /*------------------------------------------------------------------------------
 264   Purpose:
 265 ------------------------------------------------------------------------------*/
 266 DEF INPUT PARAMETER et AS CHAR NO-UNDO.
 267 DEF INPUT PARAMETER ec AS INT NO-UNDO.
 268 DEF INPUT PARAMETER ac AS DEC NO-UNDO.
 269
 270 DEF VAR i AS INT NO-UNDO INITIAL 0.
 271 DEF VAR successes AS INT NO-UNDO INITIAL 0.
 272
 273   IF simple-only THEN RETURN.
 274   IF debug THEN MESSAGE "Trying complex matching for" et + STRING(ec).
 275
 276   /* If there are any partly-closed groups then we just skip it */
 277 /*  IF CAN-FIND( FIRST ClosingGroup WHERE ClosingGroup.EntityType  = et
 278             AND ClosingGroup.EntityCode  = ec AND ClosingGroup.AccountCode = ac
 279             AND ClosingGroup.ClosedStatus <> "F") THEN
 280     RETURN.
 281 */
 282
 283   all-attempts = 0.
 284   DO WHILE i < 1000:
 285     IF NOT build-open-list(et,ec,ac) THEN LEAVE.
 286     IF NOT try-to-match(i) THEN LEAVE.
 287     close-matched-group(et,ec,ac).
 288     successes = successes + 1.
 289   END.
 290
 291   RUN part-close-groups( et, ec, ac ).
 292
 293   out-line = "Closed " + STRING( successes )
 294            + " transaction groups from " + STRING(all-attempts)
 295            + " attempts".
 296   RUN pclrep-line( base-font, out-line ).
 297
 298 END PROCEDURE.
 299
 300 /* _UIB-CODE-BLOCK-END */
 301 &ANALYZE-RESUME
 302
 303 &ENDIF
 304
 305 &IF DEFINED(EXCLUDE-create-transaction) = 0 &THEN
 306
 307 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE create-transaction Procedure
 308 PROCEDURE create-transaction :
 309 /*------------------------------------------------------------------------------
 310   Purpose:
 311 ------------------------------------------------------------------------------*/
 312 DEF INPUT PARAMETER et AS CHAR NO-UNDO.
 313 DEF INPUT PARAMETER ec AS INT  NO-UNDO.
 314 DEF INPUT PARAMETER ac AS DEC  NO-UNDO.
 315 DEF INPUT PARAMETER amount AS DEC NO-UNDO.
 316
 317 DO TRANSACTION:
 318   IF NOT AVAILABLE(NewBatch) THEN DO:
 319     CREATE NewBatch.
 320     NewBatch.BatchType  = "NORM".
 321     NewBatch.Description = "Writeoff small balances " + STRING( TODAY, "99/99/9999").
 322
 323     CREATE NewDocument.
 324     NewDocument.BatchCode     = NewBatch.BatchCode.
 325     NewDocument.DocumentType  = "JRNL".
 326     NewDocument.Reference     = STRING(NewBatch.BatchCode) + "/" + STRING(NewDocument.DocumentCode).
 327     NewDocument.Description   = NewBatch.Description.
 328   END.
 329
 330   CREATE NewAcctTrans.
 331   NewAcctTrans.BatchCode    = NewBatch.BatchCode.
 332   NewAcctTrans.DocumentCode = NewDocument.DocumentCode.
 333   NewAcctTrans.EntityType   = et.
 334   NewAcctTrans.EntityCode   = ec.
 335   NewAcctTrans.AccountCode  = ac.
 336   NewAcctTrans.Date         = TODAY.
 337   NewAcctTrans.Amount       = amount.
 338   NewAcctTrans.Reference    = STRING(NewBatch.BatchCode) + "/"
 339                             + STRING(NewDocument.DocumentCode).
 340
 341 END.
 342
 343 END PROCEDURE.
 344
 345 /* _UIB-CODE-BLOCK-END */
 346 &ANALYZE-RESUME
 347
 348 &ENDIF
 349
 350 &IF DEFINED(EXCLUDE-finish-batch) = 0 &THEN
 351
 352 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE finish-batch Procedure
 353 PROCEDURE finish-batch :
 354 /*------------------------------------------------------------------------------
 355   Purpose:  Finish up the batch generation process with a balancing
 356             transaction to the adjustments account.
 357 ------------------------------------------------------------------------------*/
 358 DEF VAR adjust-total AS DEC NO-UNDO INITIAL 0.0.
 359   FOR EACH NewAcctTrans OF NewBatch:
 360     adjust-total = adjust-total - NewAcctTrans.Amount.
 361   END.
 362
 363   IF adjust-total <> 0.0 THEN DO TRANSACTION:
 364
 365     {inc/ofc-this.i}
 366     {inc/ofc-acct.i "ADJUSTMENTS" "adjustments-ac"}
 367     IF NOT AVAILABLE(OfficeControlAccount) THEN DO:
 368       MESSAGE "No office control account called 'ADJUSTMENTS'"
 369               VIEW-AS ALERT-BOX ERROR TITLE "Office Control Account not set".
 370       FIND CURRENT NewBatch EXCLUSIVE-LOCK NO-ERROR.
 371       DELETE NewBatch.
 372       RETURN.
 373     END.
 374
 375     DEF VAR adjustments-ec AS INT NO-UNDO.
 376     adjustments-ec = OfficeControlAccount.EntityCode .
 377
 378     CREATE NewAcctTrans.
 379     NewAcctTrans.BatchCode    = NewBatch.BatchCode.
 380     NewAcctTrans.DocumentCode = NewDocument.DocumentCode.
 381     NewAcctTrans.EntityType   = "L".
 382     NewAcctTrans.EntityCode   = adjustments-ec.
 383     NewAcctTrans.AccountCode  = adjustments-ac.
 384     NewAcctTrans.Date         = TODAY.
 385     NewAcctTrans.Amount       = adjust-total.
 386     NewAcctTrans.Reference    = STRING(NewBatch.BatchCode)
 387                               + "/" + STRING(NewDocument.DocumentCode).
 388   END.
 389
 390 END PROCEDURE.
 391
 392 /* _UIB-CODE-BLOCK-END */
 393 &ANALYZE-RESUME
 394
 395 &ENDIF
 396
 397 &IF DEFINED(EXCLUDE-get-account) = 0 &THEN
 398
 399 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-account Procedure
 400 PROCEDURE get-account :
 401 /*------------------------------------------------------------------------------
 402   Purpose:
 403   Parameters:  <none>
 404   Notes:
 405 ------------------------------------------------------------------------------*/
 406
 407   FIND Office WHERE Office.ThisOffice = yes NO-LOCK.
 408
 409   FIND OfficeControlAccount OF Office WHERE OfficeControlAccount.Name =
 410     IF entity-type = 'T' THEN "DEBTORS" ELSE 'Creditors' NO-LOCK.
 411
 412   account-code = OfficeControlAccount.AccountCode.
 413
 414 END PROCEDURE.
 415
 416 /* _UIB-CODE-BLOCK-END */
 417 &ANALYZE-RESUME
 418
 419 &ENDIF
 420
 421 &IF DEFINED(EXCLUDE-inst-page-footer) = 0 &THEN
 422
 423 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-footer Procedure
 424 PROCEDURE inst-page-footer :
 425 /*------------------------------------------------------------------------------
 426   Purpose:  Print any page footer
 427 ------------------------------------------------------------------------------*/
 428
 429 END PROCEDURE.
 430
 431 /* _UIB-CODE-BLOCK-END */
 432 &ANALYZE-RESUME
 433
 434 &ENDIF
 435
 436 &IF DEFINED(EXCLUDE-inst-page-header) = 0 &THEN
 437
 438 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-page-header Procedure
 439 PROCEDURE inst-page-header :
 440 /*------------------------------------------------------------------------------
 441   Purpose:  Print any page header
 442 ------------------------------------------------------------------------------*/
 443
 444   RUN pclrep-line( "univers,Point,7,bold,proportional", TimeStamp).
 445   RUN pclrep-line( "univers,Point,12,bold,proportional", FILL( " ", 45) + "Automatic Transaction Closing").
 446
 447   RUN pclrep-line( "", "").
 448
 449 /*  RUN pclrep-line( base-font + ",Bold", out-line ). */
 450
 451
 452 END PROCEDURE.
 453
 454 /* _UIB-CODE-BLOCK-END */
 455 &ANALYZE-RESUME
 456
 457 &ENDIF
 458
 459 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 460
 461 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 462 PROCEDURE parse-parameters :
 463 /*------------------------------------------------------------------------------
 464   Purpose:
 465 ------------------------------------------------------------------------------*/
 466 DEF VAR token AS CHAR NO-UNDO.
 467 DEF VAR i AS INT NO-UNDO.
 468
 469 {inc/showopts.i "report-options"}
 470
 471   DO i = 1 TO NUM-ENTRIES( report-options, "~n" ):
 472     token = ENTRY( i, report-options, "~n" ).
 473
 474     CASE ENTRY( 1, token ):
 475       WHEN "Preview" THEN               preview = Yes.
 476       WHEN "SimpleOnly" THEN            simple-only = Yes.
 477       WHEN "GenerateBatch" THEN         generate-batch = Yes.
 478
 479       WHEN "EntityType" THEN            entity-type = ENTRY(2,token).
 480       WHEN "Fuzziness" THEN             fuzzy-limit = ABS(DEC(ENTRY(2,token))).
 481
 482       WHEN "MaxOpen" THEN               max-open = INT(ENTRY(2,token)).
 483       WHEN "MaxTop" THEN                top-attempts = INT(ENTRY(2,token)).
 484       WHEN "MaxMed" THEN                med-attempts = INT(ENTRY(2,token)).
 485       WHEN "MaxLow" THEN                low-attempts = INT(ENTRY(2,token)).
 486       WHEN "MedLevel" THEN              med-level = INT(ENTRY(2,token)).
 487
 488       WHEN "EntityRange" THEN ASSIGN
 489         entity-start = INT(ENTRY(2,token))
 490         entity-end   = INT(ENTRY(3,token)).
 491
 492     END CASE.
 493
 494   END.
 495
 496   IF max-open > 60 THEN max-open = 80.
 497
 498 END PROCEDURE.
 499
 500 /* _UIB-CODE-BLOCK-END */
 501 &ANALYZE-RESUME
 502
 503 &ENDIF
 504
 505 &IF DEFINED(EXCLUDE-part-close-groups) = 0 &THEN
 506
 507 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE part-close-groups Procedure
 508 PROCEDURE part-close-groups :
 509 /*------------------------------------------------------------------------------
 510   Purpose: Convert 'a' closed groups to 'p' closed groups.
 511 ------------------------------------------------------------------------------*/
 512 DEF INPUT PARAMETER et AS CHAR NO-UNDO.
 513 DEF INPUT PARAMETER ec AS INT NO-UNDO.
 514 DEF INPUT PARAMETER ac AS DEC NO-UNDO.
 515
 516   /* Any 'A' matching groups now get reset to 'P' (part match) */
 517   DO TRANSACTION:
 518     FOR EACH ClosingGroup WHERE ClosingGroup.EntityType  = et
 519             AND ClosingGroup.EntityCode  = ec AND ClosingGroup.AccountCode = ac
 520             AND ClosingGroup.ClosedStatus = "A" EXCLUSIVE-LOCK:
 521       FOR EACH AcctTran OF ClosingGroup EXCLUSIVE-LOCK:
 522         AcctTran.ClosedState = "P".
 523       END.
 524       ClosingGroup.ClosedStatus = "P".
 525     END.
 526   END.
 527
 528 END PROCEDURE.
 529
 530 /* _UIB-CODE-BLOCK-END */
 531 &ANALYZE-RESUME
 532
 533 &ENDIF
 534
 535 &IF DEFINED(EXCLUDE-simple-matching) = 0 &THEN
 536
 537 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE simple-matching Procedure
 538 PROCEDURE simple-matching :
 539 /*------------------------------------------------------------------------------
 540   Purpose:
 541 ------------------------------------------------------------------------------*/
 542 DEF INPUT PARAMETER et AS CHAR NO-UNDO.
 543 DEF INPUT PARAMETER ec AS INT NO-UNDO.
 544 DEF INPUT PARAMETER ac AS DEC NO-UNDO.
 545
 546 DEF VAR closing-group  LIKE AcctTran.ClosingGroup NO-UNDO.
 547
 548   /* Deal to any partly-closed groups */
 549   FOR EACH ClosingGroup WHERE ClosingGroup.EntityType  = et
 550                             AND ClosingGroup.EntityCode  = ec
 551                             AND ClosingGroup.AccountCode = ac
 552                             AND ClosingGroup.ClosedStatus <> "F" EXCLUSIVE-LOCK:
 553     FOR EACH AcctTran OF ClosingGroup EXCLUSIVE-LOCK:
 554       AcctTran.ClosingGroup = ?.
 555       AcctTran.ClosedState = "O".
 556     END.
 557     DELETE ClosingGroup.
 558   END.
 559
 560   FIND LAST ClosingGroup WHERE ClosingGroup.EntityType  = et
 561                             AND ClosingGroup.EntityCode  = ec
 562                             AND ClosingGroup.AccountCode = ac
 563                             AND ClosingGroup.ClosingGroup > 0 NO-LOCK NO-ERROR.
 564
 565   closing-group = (IF AVAILABLE ClosingGroup THEN ClosingGroup.ClosingGroup + 1 ELSE 1).
 566
 567   CREATE ClosingGroup.
 568   ASSIGN    ClosingGroup.EntityType = et
 569             ClosingGroup.EntityCode = ec
 570             ClosingGroup.AccountCode = ac
 571             ClosingGroup.ClosingGroup = closing-group
 572             ClosingGroup.DateClosed = TODAY
 573             ClosingGroup.ClosedStatus = "F"  .
 574
 575   FOR EACH AcctTran WHERE AcctTran.EntityType  = et
 576                       AND AcctTran.EntityCode  = ec
 577                       AND AcctTran.AccountCode = ac
 578                       AND AcctTran.ClosingGroup = ? :
 579     AcctTran.ClosingGroup = closing-group.
 580     AcctTran.ClosedState = "F".
 581   END.
 582
 583 END PROCEDURE.
 584
 585 /* _UIB-CODE-BLOCK-END */
 586 &ANALYZE-RESUME
 587
 588 &ENDIF
 589
 590 /* ************************  Function Implementations ***************** */
 591
 592 &IF DEFINED(EXCLUDE-build-open-list) = 0 &THEN
 593
 594 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION build-open-list Procedure
 595 FUNCTION build-open-list RETURNS LOGICAL
 596   ( INPUT et AS CHAR, INPUT ec AS INT, INPUT ac AS DEC ) :
 597 /*------------------------------------------------------------------------------
 598   Purpose:  Build a list of the open transactions
 599     Notes:
 600 ------------------------------------------------------------------------------*/
 601   FOR EACH OpenTrans:       DELETE OpenTrans.       END.
 602
 603 DEF VAR nn AS INT NO-UNDO INITIAL 0.
 604   IF debug THEN MESSAGE "Building open list for" et ec.
 605
 606   FOR EACH AcctTran WHERE AcctTran.EntityType  = et
 607                       AND AcctTran.EntityCode  = ec
 608                       AND AcctTran.AccountCode = ac
 609                       AND (AcctTran.ClosingGroup = ? OR AcctTran.ClosedState = 'P'):
 610     CREATE OpenTrans.
 611     ASSIGN  OpenTrans.BatchCode = AcctTran.BatchCode
 612             OpenTrans.DocumentCode = AcctTran.DocumentCode
 613             OpenTrans.TransactionCode = AcctTran.TransactionCode
 614             OpenTrans.Amount = AcctTran.Amount.
 615     nn = nn + 1.
 616   END.
 617
 618   out-line = et + STRING(ec) + " has " + STRING( nn )
 619            + " open transactions".
 620
 621   IF nn > max-open THEN DO:
 622     out-line = out-line + " - ignored: too many open transactions".
 623   END.
 624   RUN pclrep-line( base-font, out-line ).
 625
 626   RETURN CAN-FIND( FIRST OpenTrans ) AND (nn <= max-open) .
 627
 628 END FUNCTION.
 629
 630 /* _UIB-CODE-BLOCK-END */
 631 &ANALYZE-RESUME
 632
 633 &ENDIF
 634
 635 &IF DEFINED(EXCLUDE-clear-match-tries) = 0 &THEN
 636
 637 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION clear-match-tries Procedure
 638 FUNCTION clear-match-tries RETURNS CHARACTER
 639   ( /* parameter-definitions */ ) :
 640 /*------------------------------------------------------------------------------
 641   Purpose:
 642     Notes:
 643 ------------------------------------------------------------------------------*/
 644   FOR EACH MatchTry:        DELETE MatchTry.        END.
 645   RETURN "".
 646
 647 END FUNCTION.
 648
 649 /* _UIB-CODE-BLOCK-END */
 650 &ANALYZE-RESUME
 651
 652 &ENDIF
 653
 654 &IF DEFINED(EXCLUDE-close-matched-group) = 0 &THEN
 655
 656 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION close-matched-group Procedure
 657 FUNCTION close-matched-group RETURNS CHARACTER
 658   ( INPUT et AS CHAR, INPUT ec AS INT, INPUT ac AS DEC ) :
 659 /*------------------------------------------------------------------------------
 660   Purpose:  Close the current group of MatchTry transactions
 661     Notes:
 662 ------------------------------------------------------------------------------*/
 663 DEF VAR tot-group AS DEC NO-UNDO INITIAL 0.
 664 DEF VAR group-code AS INT NO-UNDO.
 665 DEF VAR last-date AS DATE NO-UNDO.
 666
 667   RUN pclrep-line( base-font, "Closing Group:").
 668   DEF BUFFER OtherGroup FOR ClosingGroup.
 669   DEF BUFFER OtherTran FOR AcctTran.
 670
 671   FIND LAST ClosingGroup WHERE ClosingGroup.EntityType = et
 672                            AND ClosingGroup.EntityCode = ec
 673                            AND ClosingGroup.AccountCode = ac NO-LOCK NO-ERROR.
 674   group-code = 1 + (IF AVAILABLE(ClosingGroup) THEN ClosingGroup.ClosingGroup ELSE 0).
 675
 676   FOR EACH MatchTry, FIRST AcctTran OF MatchTry, FIRST Document OF AcctTran:
 677     out-line = SPC(5)
 678              + STRING( (IF AcctTran.Reference = "" THEN Document.Reference ELSE AcctTran.Reference), "X(14)")
 679              + STRING( (IF AcctTran.Description = "" THEN Document.Description ELSE AcctTran.Description), "X(52)")
 680              + STRING( AcctTran.Amount, ">>,>>>,>>9.99CR" ).
 681     RUN pclrep-line( base-font, out-line ).
 682     tot-group = tot-group + AcctTran.Amount.
 683     IF last-date >= AcctTran.Date THEN .
 684                                   ELSE last-date = AcctTran.Date .
 685   END.
 686
 687   out-line = SPC(71).
 688   out-line = out-line + FILL( "-", 15) + "~n"
 689            + out-line + STRING( tot-group, ">>,>>>,>>9.99CR" ) + "~n"
 690            + out-line + FILL( "=", 15).
 691
 692   IF tot-group <> 0 AND generate-batch THEN DO:
 693     RUN create-transaction( et, ec, ac, - tot-group ).
 694     out-line = out-line + "~nTransaction created for " + STRING( - tot-group ).
 695   END.
 696   RUN pclrep-line( base-font, out-line ).
 697
 698   /* If the total is non-zero then we set an 'A' type so we don't process */
 699   /* it further which gets changed to a 'P' type at the end of processing */
 700   /* for this entity.                                                     */
 701 DO TRANSACTION:
 702   CREATE ClosingGroup.
 703   ASSIGN ClosingGroup.EntityType = et
 704          ClosingGroup.EntityCode = ec
 705          ClosingGroup.AccountCode = ac
 706          ClosingGroup.ClosingGroup = group-code
 707          ClosingGroup.ClosedStatus = (IF tot-group = 0 THEN "F" ELSE "A")
 708          ClosingGroup.DateClosed = (IF tot-group = 0 THEN TODAY ELSE last-date )
 709          ClosingGroup.Description = (IF tot-group = 0 THEN "" ELSE "Automatic fuzzy closing").
 710
 711   FOR EACH MatchTry, FIRST AcctTran OF MatchTry:
 712     IF AcctTran.ClosedState = "P" THEN DO:
 713       FIND OtherGroup WHERE OtherGroup.EntityType = et
 714                         AND OtherGroup.EntityCode = ec
 715                         AND OtherGroup.AccountCode = ac
 716                         AND OtherGroup.ClosingGroup = AcctTran.ClosingGroup
 717                         EXCLUSIVE-LOCK.
 718       FOR EACH OtherTran OF OtherGroup EXCLUSIVE-LOCK
 719                           WHERE RECID(AcctTran) <> RECID(OtherTran) :
 720         OtherTran.ClosingGroup = ?.
 721         OtherTran.ClosedState = "O".
 722       END.
 723       DELETE OtherGroup.
 724     END.
 725     AcctTran.ClosingGroup = group-code .
 726     AcctTran.ClosedState  = ClosingGroup.ClosedStatus .
 727     IF debug THEN
 728       MESSAGE "Closing:" AcctTran.BatchCode "/" AcctTran.DocumentCode "/" AcctTran.TransactionCode " for " AcctTran.Amount " status set to " ClosingGroup.ClosedStatus.
 729   END.
 730 END.
 731
 732   RUN pclrep-line( "", "").
 733
 734   RETURN "".   /* Function return value. */
 735
 736
 737
 738 END FUNCTION.
 739
 740 /* _UIB-CODE-BLOCK-END */
 741 &ANALYZE-RESUME
 742
 743 &ENDIF
 744
 745 &IF DEFINED(EXCLUDE-show-match-set) = 0 &THEN
 746
 747 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION show-match-set Procedure
 748 FUNCTION show-match-set RETURNS CHARACTER
 749   ( INPUT attempts AS INT, INPUT tgt-1 AS DEC, INPUT dpth AS INT, INPUT tgt-2 AS DEC ) :
 750 /*------------------------------------------------------------------------------
 751   Purpose:  Show the current group of MatchTry transactions
 752     Notes:
 753 ------------------------------------------------------------------------------*/
 754 DEF VAR tot-group AS DEC NO-UNDO INITIAL 0.
 755
 756 DEF VAR set-list AS CHAR NO-UNDO INITIAL "Set: ".
 757 DEF VAR d-att AS CHAR NO-UNDO INITIAL "      ".
 758
 759   IF NOT debug THEN RETURN "".
 760
 761   FOR EACH MatchTry, FIRST AcctTran OF MatchTry BY Depth:
 762     set-list = set-list + TRIM( STRING( AcctTran.Amount, "->>,>>>,>>9.99")) + ", ".
 763     tot-group = tot-group + AcctTran.Amount.
 764   END.
 765
 766   set-list = RIGHT-TRIM( STRING( tot-group, "->>,>>>,>>9.99") + " - " + set-list, " ,").
 767   IF dpth = 1 THEN
 768     d-att = STRING(attempts, ">9    ").
 769   ELSE IF dpth >= med-level THEN
 770     d-att = STRING(attempts, "    >9").
 771   ELSE
 772     d-att = STRING(attempts, "  >9  ").
 773
 774   MESSAGE STRING(dpth,">,>>9") d-att STRING(all-attempts,">>,>>9")
 775           STRING(tgt-1,"->>,>>>,>>9.99") STRING(tgt-2,"->>,>>>,>>9.99")
 776           set-list.
 777
 778   RETURN "".   /* Function return value. */
 779
 780 END FUNCTION.
 781
 782 /* _UIB-CODE-BLOCK-END */
 783 &ANALYZE-RESUME
 784
 785 &ENDIF
 786
 787 &IF DEFINED(EXCLUDE-try-this-one) = 0 &THEN
 788
 789 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION try-this-one Procedure
 790 FUNCTION try-this-one RETURNS LOGICAL
 791   ( INPUT-OUTPUT attempts AS INT, INPUT our-target AS DEC, INPUT in-depth AS INT ) :
 792 /*------------------------------------------------------------------------------
 793   Purpose:
 794     Notes:
 795 ------------------------------------------------------------------------------*/
 796 DEF VAR smaller-target AS DEC NO-UNDO.
 797
 798 DEF VAR out-depth AS INT NO-UNDO.
 799 DEF VAR save-attempts AS INT NO-UNDO.
 800 DEF VAR last-this-level AS DEC NO-UNDO INITIAL 999999999999999.99 .
 801 DEF BUFFER SmallerOne FOR OpenTrans.
 802
 803   attempts = attempts + 1.
 804   IF in-depth = med-level THEN ASSIGN
 805     save-attempts = attempts
 806     attempts = 0.
 807
 808   /* try for an exact match */
 809   FIND FIRST SmallerOne WHERE SmallerOne.Amount = our-target
 810                     AND NOT CAN-FIND(MatchTry OF SmallerOne) NO-LOCK NO-ERROR.
 811   IF AVAILABLE(SmallerOne) THEN DO:
 812     CREATE MatchTry.
 813     BUFFER-COPY SmallerOne TO MatchTry
 814                 ASSIGN MatchTry.Depth = in-depth.
 815     smaller-target = our-target - SmallerOne.Amount.
 816     all-attempts = all-attempts + 1.
 817     show-match-set( attempts, our-target, in-depth, smaller-target).
 818     RETURN Yes.
 819   END.
 820
 821   FOR EACH SmallerOne WHERE NOT( CAN-FIND(MatchTry OF SmallerOne) )
 822                          BY SmallerOne.Amount DESCENDING
 823                          BY SmallerOne.BatchCode
 824                         WHILE attempts < (IF in-depth > med-level THEN low-attempts ELSE med-attempts):
 825     IF SmallerOne.Amount = last-this-level THEN NEXT.
 826     last-this-level = SmallerOne.Amount.
 827
 828     IF debug THEN MESSAGE our-target (our-target + fuzzy-limit) SmallerOne.Amount .
 829     IF SmallerOne.Amount < 0 THEN NEXT.
 830     IF SmallerOne.Amount > (our-target + fuzzy-limit) THEN NEXT.
 831
 832     CREATE MatchTry.
 833     BUFFER-COPY SmallerOne TO MatchTry
 834                 ASSIGN MatchTry.Depth = in-depth.
 835     smaller-target = our-target - SmallerOne.Amount.
 836     all-attempts = all-attempts + 1.
 837     IF debug THEN show-match-set( attempts, our-target, in-depth, smaller-target).
 838     IF smaller-target = 0 THEN DO:
 839       IF NOT debug THEN show-match-set( attempts, our-target, in-depth, smaller-target).
 840       RETURN Yes.
 841     END.
 842
 843     out-depth = in-depth + 1.
 844     IF try-this-one( attempts, smaller-target, out-depth ) THEN DO:
 845       IF NOT debug THEN show-match-set( attempts, our-target, in-depth, smaller-target).
 846       RETURN Yes.
 847     END.
 848     out-depth = in-depth.
 849
 850     /* Fuzzy limit only applies if we've already tried for a zero. */
 851     IF ABS(smaller-target) <= fuzzy-limit THEN DO:
 852       IF NOT debug THEN show-match-set( attempts, our-target, in-depth, smaller-target).
 853       RETURN Yes.
 854     END.
 855
 856     smaller-target = our-target + SmallerOne.Amount.
 857     FOR EACH MatchTry WHERE MatchTry.Depth = in-depth:   DELETE MatchTry.  END.
 858   END.
 859
 860   IF in-depth = med-level THEN attempts = save-attempts.
 861   RETURN FALSE.   /* Function return value. */
 862
 863 END FUNCTION.
 864
 865 /* _UIB-CODE-BLOCK-END */
 866 &ANALYZE-RESUME
 867
 868 &ENDIF
 869
 870 &IF DEFINED(EXCLUDE-try-to-match) = 0 &THEN
 871
 872 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION try-to-match Procedure
 873 FUNCTION try-to-match RETURNS LOGICAL
 874   ( INPUT-OUTPUT attempts AS INT ) :
 875 /*------------------------------------------------------------------------------
 876   Purpose:  Try to match some transactions
 877 ------------------------------------------------------------------------------*/
 878 DEF BUFFER Other FOR OpenTrans.
 879 DEF VAR target AS DEC NO-UNDO.
 880 DEF VAR last-this-level AS DEC NO-UNDO INITIAL 999999999999999.99.
 881 DEF VAR depth AS INT NO-UNDO INITIAL 1.
 882 DEF VAR lower-attempts AS INT NO-UNDO.
 883
 884   FOR EACH OpenTrans WHERE OpenTrans.Amount < 0 BY OpenTrans.Amount:
 885
 886     clear-match-tries().
 887     CREATE MatchTry.
 888     BUFFER-COPY OpenTrans TO MatchTry
 889                 ASSIGN MatchTry.Depth = 0.
 890
 891     target = - OpenTrans.Amount. /* OpenTrans.Amount is negative */
 892
 893     FOR EACH Other WHERE Other.Amount > 0 AND Other.Amount < (target + fuzzy-limit)
 894                      BY Other.Amount DESCENDING BY Other.BatchCode
 895                      WHILE attempts < top-attempts:
 896       IF Other.Amount = last-this-level THEN NEXT.
 897       last-this-level = Other.Amount.
 898       attempts = attempts + 1.
 899
 900       CREATE MatchTry.
 901       BUFFER-COPY Other TO MatchTry
 902                 ASSIGN MatchTry.Depth = depth.
 903
 904       target = target - Other.Amount.
 905       all-attempts = all-attempts + 1.
 906       IF debug THEN show-match-set( attempts, - OpenTrans.Amount, depth, target).
 907       IF target = 0 THEN DO:
 908         IF NOT debug THEN show-match-set( attempts, - OpenTrans.Amount, depth, target).
 909         RETURN Yes.
 910       END.
 911
 912       depth = depth + 1.
 913       lower-attempts = 0.
 914       IF try-this-one( lower-attempts, target, depth ) THEN DO:
 915         IF NOT debug THEN show-match-set( attempts, - OpenTrans.Amount, depth - 1, target).
 916         RETURN Yes.
 917       END.
 918       depth = depth - 1.
 919
 920       IF ABS(target) <= fuzzy-limit THEN DO:
 921         IF NOT debug THEN show-match-set( attempts, - OpenTrans.Amount, depth, target).
 922         RETURN Yes.
 923       END.
 924
 925       target = target + Other.Amount.
 926       FOR EACH MatchTry WHERE MatchTry.Depth = depth:   DELETE MatchTry.  END.
 927     END.
 928   END.
 929
 930   RETURN FALSE.   /* Function return value. */
 931
 932 END FUNCTION.
 933
 934 /* _UIB-CODE-BLOCK-END */
 935 &ANALYZE-RESUME
 936
 937 &ENDIF
 938