process/one-off/fix/980826-global-cred-intercompany.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     Author(s)   :
  13     Created     :
  14     Notes       :
  15   ------------------------------------------------------------------------*/
  16
  17 DEF VAR batch-list AS CHAR NO-UNDO INITIAL "".
  18 DEF BUFFER IC-Doc FOR Document.
  19
  20 {inc/ofc-this.i}
  21 {inc/ofc-acct.i "IC-SUSPENSE" "ic-suspense"}
  22
  23 /* _UIB-CODE-BLOCK-END */
  24 &ANALYZE-RESUME
  25
  26
  27 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  28
  29 /* ********************  Preprocessor Definitions  ******************** */
  30
  31 &Scoped-define PROCEDURE-TYPE Procedure
  32
  33
  34
  35 /* _UIB-PREPROCESSOR-BLOCK-END */
  36 &ANALYZE-RESUME
  37
  38
  39
  40 /* *********************** Procedure Settings ************************ */
  41
  42 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  43 /* Settings for THIS-PROCEDURE
  44    Type: Procedure
  45    Allow:
  46    Frames: 0
  47    Add Fields to: Neither
  48    Other Settings: CODE-ONLY COMPILE
  49  */
  50 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  51
  52 /* *************************  Create Window  ************************** */
  53
  54 &ANALYZE-SUSPEND _CREATE-WINDOW
  55 /* DESIGN Window definition (used by the UIB)
  56   CREATE WINDOW Procedure ASSIGN
  57          HEIGHT             = .08
  58          WIDTH              = 56.29.
  59 /* END WINDOW DEFINITION */
  60                                                                         */
  61 &ANALYZE-RESUME
  62
  63
  64
  65
  66 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  67
  68
  69 /* ***************************  Main Block  *************************** */
  70 DEF VAR do-it AS LOGICAL INITIAL No NO-UNDO.
  71
  72 RUN build-batch-list.
  73 DISPLAY batch-list VIEW-AS EDITOR SIZE 78 BY 10.
  74 UPDATE batch-list do-it.
  75
  76 IF do-it THEN RUN process-batch-list( batch-list ).
  77
  78 /* _UIB-CODE-BLOCK-END */
  79 &ANALYZE-RESUME
  80
  81
  82 /* **********************  Internal Procedures  *********************** */
  83
  84 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE build-batch-list Procedure
  85 PROCEDURE build-batch-list :
  86 /*------------------------------------------------------------------------------
  87   Purpose:
  88 ------------------------------------------------------------------------------*/
  89 DEF VAR batch-code AS CHAR NO-UNDO.
  90
  91   FOR EACH AcctTran WHERE AcctTran.EntityType = "L"
  92                       AND AcctTran.EntityCode = OfficeControlAccount.EntityCode
  93                       AND AcctTran.AccountCode = OfficeControlAccount.AccountCode
  94                       AND AcctTran.Amount <> 0
  95                       NO-LOCK:
  96     IF AcctTran.BatchCode = 366 OR AcctTran.BatchCode = 368 THEN NEXT.
  97     FIND Document OF AcctTran NO-LOCK.
  98     IF Document.Documenttype = "ICOA" THEN DO:
  99       batch-code = STRING( AcctTran.BatchCode ).
 100       IF LOOKUP( batch-code, batch-list ) = 0 THEN DO:
 101         batch-list = batch-list + (IF batch-list = "" THEN "" ELSE ",")
 102                    + batch-code.
 103       END.
 104     END.
 105   END.
 106 END PROCEDURE.
 107
 108 /* _UIB-CODE-BLOCK-END */
 109 &ANALYZE-RESUME
 110
 111
 112 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE fix-document Procedure
 113 PROCEDURE fix-document :
 114 /*------------------------------------------------------------------------------
 115   Purpose:  Fix a mis-allocated intercompany in this document
 116 ------------------------------------------------------------------------------*/
 117 DEF BUFFER CredTr FOR AcctTran.
 118 DEF BUFFER CredCons FOR AcctTran.
 119 DEF BUFFER CredAlloc FOR AcctTran.
 120 DEF BUFFER IC1 FOR AcctTran.
 121
 122 DEF VAR ledger-1 AS INT NO-UNDO.
 123 DEF VAR ledger-2 AS INT NO-UNDO.
 124 DEF VAR error-amount AS DEC NO-UNDO.
 125
 126 cred-tr-loop:
 127   FOR EACH CredTr OF Document WHERE CredTr.EntityType = "C" NO-LOCK:
 128     DO TRANSACTION ON ERROR UNDO, NEXT cred-tr-loop:
 129       FIND CredCons OF Document WHERE CredCons.EntityType = "L"
 130                                   AND CredCons.AccountCode = CredTr.AccountCode
 131                                   AND CredCons.ConsequenceOf = CredTr.TransactionCode
 132                                   EXCLUSIVE-LOCK NO-ERROR.
 133       IF NOT AVAILABLE(CredCons) THEN NEXT cred-tr-loop.
 134       IF CredCons.Amount <> - CredTr.Amount THEN DO:
 135         MESSAGE "Warning: Consequential amount <> transaction amount! " CredCons.BatchCode CredCons.DocumentCode CredCons.TransactionCode .
 136         CredCons.Amount = - CredTr.Amount .
 137       END.
 138       ledger-1     = CredCons.EntityCode .
 139       CredCons.Amount = - CredCons.Amount .
 140
 141       FOR EACH CredAlloc NO-LOCK OF Document WHERE CredAlloc.EntityType = "L"
 142                                   AND CredAlloc.TransactionCode <> CredCons.TransactionCode:
 143         ledger-2 = CredAlloc.EntityCode .
 144         error-amount = CredAlloc.Amount .
 145         RUN fix-intercompany( error-amount ).
 146         IF RETURN-VALUE = "FAIL" THEN UNDO, NEXT cred-tr-loop.
 147       END.
 148     END.
 149   END.
 150 END PROCEDURE.
 151
 152 /* _UIB-CODE-BLOCK-END */
 153 &ANALYZE-RESUME
 154
 155
 156 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE fix-intercompany Procedure
 157 PROCEDURE fix-intercompany :
 158 /*------------------------------------------------------------------------------
 159   Purpose:
 160 ------------------------------------------------------------------------------*/
 161 DEF INPUT PARAMETER err-amt AS DEC NO-UNDO.
 162
 163   IF err-amt = 0 THEN RETURN.
 164
 165 DEF BUFFER IC-9900 FOR AcctTran.
 166
 167   FIND FIRST IC-9900 OF IC-Doc WHERE IC-9900.EntityType = "L"
 168                                  AND IC-9900.EntityCode = OfficeControlAccount.EntityCode
 169                                  AND IC-9900.AccountCode = OfficeControlAccount.AccountCode
 170                                  AND IC-9900.Amount <> 0
 171                                  EXCLUSIVE-LOCK NO-ERROR.
 172   IF NOT AVAILABLE(IC-9900) THEN RETURN ERROR.
 173
 174   err-amt = err-amt * 2 .
 175   IC-9900.Amount    = IC-9900.Amount    + err-amt.
 176
 177 END PROCEDURE.
 178
 179 /* _UIB-CODE-BLOCK-END */
 180 &ANALYZE-RESUME
 181
 182
 183 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-batch-list Procedure
 184 PROCEDURE process-batch-list :
 185 /*------------------------------------------------------------------------------
 186   Purpose:
 187 ------------------------------------------------------------------------------*/
 188 DEF INPUT PARAMETER b-list AS CHAR NO-UNDO.
 189
 190 DEF VAR i AS INT NO-UNDO.
 191 DEF VAR n AS INT NO-UNDO.
 192   n = NUM-ENTRIES( b-list ).
 193   DO i = 1 TO n:
 194     FOR EACH Batch WHERE Batch.BatchCode = INT( ENTRY(i,b-list)) NO-LOCK:
 195       FIND LAST IC-Doc OF Batch WHERE IC-Doc.DocumentType = "ICOA" NO-LOCK.
 196       FOR EACH Document OF Batch WHERE CAN-FIND( FIRST AcctTran OF Document WHERE AcctTran.EntityType = "C" ) NO-LOCK:
 197         RUN fix-document.
 198       END.
 199       RUN re-balance-batch.
 200     END.
 201   END.
 202 END PROCEDURE.
 203
 204 /* _UIB-CODE-BLOCK-END */
 205 &ANALYZE-RESUME
 206
 207
 208 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE re-balance-batch Procedure
 209 PROCEDURE re-balance-batch :
 210 /*------------------------------------------------------------------------------
 211   Purpose:
 212 ------------------------------------------------------------------------------*/
 213 DEF VAR batch-ledger AS DEC NO-UNDO.
 214
 215   FOR EACH AcctTran OF Batch WHERE AcctTran.EntityType = "L" NO-LOCK:
 216     batch-ledger = batch-ledger + AcctTran.Amount.
 217   END.
 218   IF batch-ledger <> 0 THEN DO:
 219     FOR EACH AcctTran WHERE AcctTran.EntityType = "L"
 220                         AND AcctTran.EntityCode = OfficeControlAccount.EntityCode
 221                         AND AcctTran.AccountCode = OfficeControlAccount.AccountCode
 222                         AND AcctTran.Amount <> 0 EXCLUSIVE-LOCK:
 223       batch-ledger = batch-ledger - AcctTran.Amount .
 224       AcctTran.Amount = 0.
 225     END.
 226   END.
 227
 228   IF batch-ledger <> 0 THEN DO:
 229     FIND LAST AcctTran WHERE AcctTran.EntityType = "L"
 230                         AND AcctTran.EntityCode = OfficeControlAccount.EntityCode
 231                         AND AcctTran.AccountCode = OfficeControlAccount.AccountCode
 232                         AND AcctTran.Amount <> 0 EXCLUSIVE-LOCK NO-ERROR.
 233     IF AVAILABLE(AcctTran) THEN
 234       AcctTran.Amount = - batch-ledger.
 235   END.
 236
 237   /* clean up batch */
 238   FIND LAST Document OF Batch NO-ERROR.
 239   IF AVAILABLE(Document) THEN DO:
 240     FOR EACH AcctTran OF Document WHERE AcctTran.Amount = 0:
 241       DELETE AcctTran.
 242     END.
 243     FIND LAST AcctTran OF Document NO-ERROR.
 244     IF NOT AVAILABLE(AcctTran) THEN DELETE Document.
 245   END.
 246
 247 END PROCEDURE.
 248
 249 /* _UIB-CODE-BLOCK-END */
 250 &ANALYZE-RESUME
 251
 252