DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
502
Batch/DTSBU530.cob
Normal file
502
Batch/DTSBU530.cob
Normal file
@ -0,0 +1,502 @@
|
||||
00001 IDENTIFICATION DIVISION. 12/13/98
|
||||
00002 PROGRAM-ID. DTSBU530. DTSBU530
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
||||
00004 DATE-WRITTEN. JANUARY 1991. CL**2
|
||||
00005 DATE-COMPILED. CL**2
|
||||
00006 SKIP3 CL**2
|
||||
00007 ***** CL**2
|
||||
00008 * CL**2
|
||||
00009 * FUNCTION: WRITE OFF/REVERSE WRITE OFF PROCESSING. CL**3
|
||||
00010 * CL**2
|
||||
00011 * CL**2
|
||||
00012 * MODIFICATION LOG: CL**2
|
||||
00013 * CL**2
|
||||
00014 * 01/26/92 INITIAL DEVELOPMENT. CL**2
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL CL**2
|
||||
00016 * CL**2
|
||||
00017 * 06/13/95 CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM CL**2
|
||||
00018 * THIS PROGRAM. CL**2
|
||||
00019 * WORK ORDER: CR094 PROGRAMMER: RHC CL**2
|
||||
00020 * CL**2
|
||||
00021 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. CL**3
|
||||
00022 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**3
|
||||
00023 * CL**3
|
||||
00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
||||
00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
||||
00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**3
|
||||
00027 * CL**2
|
||||
00028 * CL**2
|
||||
00029 * DESCRIPTION: CL**2
|
||||
00030 * CL**2
|
||||
00031 * IF L530-WRITE-OFF-88 CL**3
|
||||
00032 * IF MONEY IS DUE OR REPORTS ARE PURSUED OR CREDITS EXIST CL**2
|
||||
00033 * WRITE OFF COLLECTIONS CL**3
|
||||
00034 * ELSE CL**2
|
||||
00035 * CONTINUE CL**2
|
||||
00036 * ELSE CL**2
|
||||
00037 * IF L530-REVERSE-WRITE-OFF-88 CL**3
|
||||
00038 * REVERSE THE WRITE OFF OF COLLECTIONS. CL**3
|
||||
00039 * CL**2
|
||||
00040 * CL**2
|
||||
00041 * IN DC, CREDITS ARE WRITTEN OFF! CL**3
|
||||
00042 * CL**2
|
||||
00043 * CL**2
|
||||
00044 * MASTER FILE RECORDS READ: CL**2
|
||||
00045 * CL**2
|
||||
00046 * MQTR CL**2
|
||||
00047 * MDST CL**2
|
||||
00048 * CL**2
|
||||
00049 * CL**2
|
||||
00050 * MASTER FILE RECORDS UPDATED: CL**2
|
||||
00051 * CL**2
|
||||
00052 * MQTR (REWRITE) CL**2
|
||||
00053 * MDST (REWRITE) CL**2
|
||||
00054 * CL**2
|
||||
00055 * CL**2
|
||||
00056 * REPORT RECORDS WRITTEN: CL**2
|
||||
00057 * CL**2
|
||||
00058 * NONE. CL**2
|
||||
00059 * CL**2
|
||||
00060 * CL**2
|
||||
00061 * MODULES CALLED: CL**2
|
||||
00062 * CL**2
|
||||
00063 * DTSBU541 MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED, CL**3
|
||||
00064 * OR WRITTEN OFF AMOUNT. CL**3
|
||||
00065 * DTSBU542 MDST MAINTENANCE. CL**3
|
||||
00066 * DTSBU590 EMPLOYER CLEANUP. CL**3
|
||||
00067 * DTSBU910 MASTER FILE I/O DRIVER. CL**3
|
||||
00068 * CL**2
|
||||
00069 ***** CL**2
|
||||
00070 SKIP3 CL**2
|
||||
00071 ENVIRONMENT DIVISION. CL**2
|
||||
00072 EJECT CL**2
|
||||
00073 DATA DIVISION. CL**2
|
||||
00074 SKIP3 CL**2
|
||||
00075 WORKING-STORAGE SECTION. CL**2
|
||||
000755 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU530 12/13/98'. CL**2
|
||||
00076 SKIP3 CL**2
|
||||
00077 01 WRK-AREA. CL**2
|
||||
00078 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +530. CL**2
|
||||
00079 CL**2
|
||||
00080 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU530'. CL**3
|
||||
00081 CL**2
|
||||
00082 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL**2
|
||||
00083 CL**2
|
||||
00084 05 WRK-NULL-DOC-NO. CL**2
|
||||
00085 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. CL**2
|
||||
00086 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. CL**2
|
||||
00087 CL**2
|
||||
00088 CL**3
|
||||
00089 05 WRITTEN-OFF-BALANCE-AMT PIC S9(09)V9(02) COMP-3. CL**3
|
||||
00090 CL**3
|
||||
00091 05 WRITTEN-OFF-CREDIT-AMT PIC S9(09)V9(02) COMP-3. CL**3
|
||||
00092 CL**3
|
||||
00093 05 WRITTEN-OFF-PURSUED-RPT-CNT PIC S9(04) COMP. CL**3
|
||||
00094 CL**2
|
||||
00095 05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. CL**2
|
||||
00096 CL**2
|
||||
00097 05 WRK-PURSUED-RPT-IND PIC X(01). CL**2
|
||||
00098 EJECT CL**2
|
||||
00099 01 L910-LINK-AREA. CL**2
|
||||
00100 ++INCLUDE DTSIL910 CL**3
|
||||
00101 SKIP3 CL**2
|
||||
00102 01 MSKL-REC. CL**2
|
||||
00103 ++INCLUDE DTSIMSKL CL**3
|
||||
00104 SKIP3 CL**2
|
||||
00105 01 MQTR-REC. CL**2
|
||||
00106 ++INCLUDE DTSIMQTR CL**3
|
||||
00107 SKIP3 CL**2
|
||||
00108 01 MDST-REC. CL**2
|
||||
00109 ++INCLUDE DTSIMDST CL**3
|
||||
00110 EJECT CL**2
|
||||
00111 01 L541-LINK-AREA. CL**2
|
||||
00112 ++INCLUDE DTSIL541 CL**3
|
||||
00113 SKIP3 CL**2
|
||||
00114 01 L542-LINK-AREA. CL**2
|
||||
00115 ++INCLUDE DTSIL542 CL**3
|
||||
00116 SKIP3 CL**2
|
||||
00117 01 L590-LINK-AREA. CL**2
|
||||
00118 ++INCLUDE DTSIL590 CL**3
|
||||
00119 EJECT CL**2
|
||||
00120 01 CACT-LITERALS. CL**2
|
||||
00121 ++INCLUDE DTSICACT CL**3
|
||||
00122 EJECT CL**2
|
||||
00123 LINKAGE SECTION. CL**2
|
||||
00124 SKIP3 CL**2
|
||||
00125 01 L530-LINK-AREA. CL**2
|
||||
00126 ++INCLUDE DTSIL530 CL**3
|
||||
00127 SKIP3 CL**2
|
||||
00128 01 LBCM-LINK-AREA. CL**2
|
||||
00129 ++INCLUDE DTSILBCM CL**3
|
||||
00130 SKIP3 CL**2
|
||||
00131 01 MPRF-REC. CL**2
|
||||
00132 ++INCLUDE DTSIMPRF CL**3
|
||||
00133 EJECT CL**2
|
||||
00134 PROCEDURE DIVISION USING L530-LINK-AREA CL**2
|
||||
00135 LBCM-LINK-AREA CL**2
|
||||
00136 MPRF-REC. CL**2
|
||||
00137 CL**3
|
||||
00138 CL**3
|
||||
00139 IF FIRST-TIME-IND = 'Y' CL**2
|
||||
00140 PERFORM I0000-FIRST-TIME THRU I0000-EXIT CL**2
|
||||
00141 MOVE 'N' TO FIRST-TIME-IND. CL**2
|
||||
00142 CL**3
|
||||
00143 CL**3
|
||||
00144 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**2
|
||||
00145 CL**3
|
||||
00146 CL**3
|
||||
00147 GOBACK. CL**2
|
||||
00148 EJECT CL**2
|
||||
00149 I0000-FIRST-TIME. CL**2
|
||||
00150 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. CL**2
|
||||
00151 CL**3
|
||||
00152 MOVE 'DTSBU530' TO L910-MOD-NAME. CL**3
|
||||
00153 CL**3
|
||||
00154 MOVE +0 TO WRK-NULL-BATCH-NO CL**3
|
||||
00155 WRK-NULL-ITEM-NO. CL**3
|
||||
00156 I0000-EXIT. CL**2
|
||||
00157 EXIT. CL**2
|
||||
00158 EJECT CL**2
|
||||
00159 P0000-PROCESS. CL**2
|
||||
00160 SET L530-NO-UPDATE-88 TO TRUE. CL**2
|
||||
00161 CL**2
|
||||
00162 MOVE +0 TO WRITTEN-OFF-BALANCE-AMT CL**3
|
||||
00163 WRITTEN-OFF-CREDIT-AMT CL**3
|
||||
00164 WRITTEN-OFF-PURSUED-RPT-CNT. CL**3
|
||||
00165 CL**2
|
||||
00166 CL**2
|
||||
00167 MOVE LOW-VALUES TO MQTR-KEY-AREA. CL**2
|
||||
00168 CL**3
|
||||
00169 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. CL**2
|
||||
00170 CL**3
|
||||
00171 SET MQTR-QTR-88 TO TRUE. CL**2
|
||||
00172 CL**3
|
||||
00173 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL**2
|
||||
00174 CL**3
|
||||
00175 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**2
|
||||
00176 CL**2
|
||||
00177 PERFORM P1000-MQTR-SCAN THRU P1000-EXIT CL**2
|
||||
00178 UNTIL L910-NO-REC-88. CL**2
|
||||
00179 CL**2
|
||||
00180 CL**2
|
||||
00181 MOVE LOW-VALUES TO MDST-KEY-AREA. CL**2
|
||||
00182 CL**3
|
||||
00183 MOVE MPRF-EMP-NO TO MDST-EMP-NO. CL**2
|
||||
00184 CL**3
|
||||
00185 SET MDST-DST-88 TO TRUE. CL**2
|
||||
00186 CL**3
|
||||
00187 SET MDST-CREDIT-REC-88 TO TRUE. CL**2
|
||||
00188 CL**3
|
||||
00189 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. CL**2
|
||||
00190 CL**3
|
||||
00191 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**2
|
||||
00192 CL**2
|
||||
00193 PERFORM P2000-MDST-SCAN THRU P2000-EXIT CL**2
|
||||
00194 UNTIL L910-NO-REC-88. CL**2
|
||||
00195 CL**2
|
||||
00196 CL**2
|
||||
00197 IF (WRITTEN-OFF-BALANCE-AMT > +0) CL**3
|
||||
00198 OR CL**2
|
||||
00199 (WRITTEN-OFF-CREDIT-AMT > +0) CL**3
|
||||
00200 OR CL**2
|
||||
00201 (WRITTEN-OFF-PURSUED-RPT-CNT > +0) CL**3
|
||||
00202 IF MPRF-NOT-WRITTEN-OFF-88 CL**3
|
||||
00203 MOVE L530-WRITE-OFF-DATE TO MPRF-WRITE-OFF-DATE CL**3
|
||||
00204 SET L530-UPDATE-88 TO TRUE CL**2
|
||||
00205 SET LBCM-EMP-UPDATE-YES-88 TO TRUE CL**2
|
||||
00206 ELSE CL**2
|
||||
00207 NEXT SENTENCE CL**2
|
||||
00208 ELSE CL**2
|
||||
00209 IF MPRF-NOT-WRITTEN-OFF-88 CL**3
|
||||
00210 NEXT SENTENCE CL**2
|
||||
00211 ELSE CL**2
|
||||
00212 MOVE +0 TO MPRF-WRITE-OFF-DATE CL**3
|
||||
00213 SET L530-UPDATE-88 TO TRUE CL**2
|
||||
00214 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2
|
||||
00215 SKIP2 CL**2
|
||||
00216 P0000-EXIT. CL**2
|
||||
00217 EXIT. CL**2
|
||||
00218 EJECT CL**2
|
||||
00219 P1000-MQTR-SCAN. CL**2
|
||||
00220 MOVE MSKL-REC TO MQTR-REC. CL**2
|
||||
00221 CL**2
|
||||
00222 MOVE +0 TO WRK-BALANCE-AMT. CL**2
|
||||
00223 CL**2
|
||||
00224 PERFORM P1100-MQTR-ACCT-SCAN THRU P1100-EXIT CL**2
|
||||
00225 VARYING MQTR-ACCT-IDX FROM 1 BY 1 CL**2
|
||||
00226 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. CL**2
|
||||
00227 CL**2
|
||||
00228 IF (WRK-BALANCE-AMT = +0) CL**2
|
||||
00229 OR CL**2
|
||||
00230 (WRK-BALANCE-AMT > LBCM-QTR-TOL-MAX) CL**2
|
||||
00231 NEXT SENTENCE CL**2
|
||||
00232 ELSE CL**2
|
||||
00233 PERFORM S590-QTR-TOL THRU S590-EXIT. CL**2
|
||||
00234 CL**2
|
||||
00235 PERFORM P1200-PURSUED-RPT-IND THRU P1200-EXIT. CL**2
|
||||
00236 CL**2
|
||||
00237 CL**2
|
||||
00238 MOVE MQTR-REC TO MSKL-REC. CL**2
|
||||
00239 CL**2
|
||||
00240 PERFORM S910-REWRITE THRU S910-EXIT. CL**2
|
||||
00241 CL**2
|
||||
00242 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**2
|
||||
00243 P1000-EXIT. CL**2
|
||||
00244 EXIT. CL**2
|
||||
00245 SKIP3 CL**2
|
||||
00246 P1100-MQTR-ACCT-SCAN. CL**2
|
||||
00247 MOVE +0 TO L541-AMT. CL**2
|
||||
00248 CL**3
|
||||
00249 IF L530-WRITE-OFF-88 CL**3
|
||||
00250 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO L541-AMT CL**2
|
||||
00251 ELSE CL**2
|
||||
00252 COMPUTE L541-AMT CL**2
|
||||
00253 = MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) * -1. CL**3
|
||||
00254 CL**2
|
||||
00255 IF L541-AMT NOT = +0 CL**2
|
||||
00256 SET L541-ACCT-SUB TO MQTR-ACCT-IDX CL**2
|
||||
00257 MOVE CACT-CAT-WRITTEN-OFF TO L541-CAT-IND CL**3
|
||||
00258 PERFORM S541-MODIFY-AMT THRU S541-EXIT CL**2
|
||||
00259 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE CL**2
|
||||
00260 SET L530-UPDATE-88 TO TRUE. CL**2
|
||||
00261 CL**2
|
||||
00262 COMPUTE WRITTEN-OFF-BALANCE-AMT CL**3
|
||||
00263 = WRITTEN-OFF-BALANCE-AMT CL**3
|
||||
00264 + MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX). CL**3
|
||||
00265 CL**2
|
||||
00266 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-BALANCE-AMT. CL**2
|
||||
00267 P1100-EXIT. CL**2
|
||||
00268 EXIT. CL**2
|
||||
00269 SKIP3 CL**2
|
||||
00270 P1200-PURSUED-RPT-IND. CL**2
|
||||
00271 MOVE MQTR-PURSUED-RPT-IND TO WRK-PURSUED-RPT-IND. CL**2
|
||||
00272 CL**2
|
||||
00273 IF MQTR-RPT-IS-PURSUED-88 CL**2
|
||||
00274 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT. CL**2
|
||||
00275 CL**2
|
||||
00276 IF L530-WRITE-OFF-88 CL**3
|
||||
00277 PERFORM P1210-WRITE-OFF THRU P1210-EXIT CL**3
|
||||
00278 ELSE CL**2
|
||||
00279 PERFORM P1220-REVERSE THRU P1220-EXIT. CL**2
|
||||
00280 CL**2
|
||||
00281 IF MQTR-RPT-IS-PURSUED-88 CL**2
|
||||
00282 ADD +1 TO MPRF-PURSUED-RPT-CNT. CL**2
|
||||
00283 CL**2
|
||||
00284 IF WRK-PURSUED-RPT-IND = MQTR-PURSUED-RPT-IND CL**2
|
||||
00285 NEXT SENTENCE CL**2
|
||||
00286 ELSE CL**2
|
||||
00287 SET L530-UPDATE-88 TO TRUE CL**2
|
||||
00288 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. CL**2
|
||||
00289 CL**2
|
||||
00290 IF (WRK-PURSUED-RPT-IND = 'N') CL**2
|
||||
00291 AND CL**2
|
||||
00292 (MQTR-RPT-IS-PURSUED-88) CL**2
|
||||
00293 PERFORM S590-QTR-PURSUED THRU S590-EXIT. CL**2
|
||||
00294 P1200-EXIT. CL**2
|
||||
00295 EXIT. CL**2
|
||||
00296 SKIP3 CL**2
|
||||
00297 P1210-WRITE-OFF. CL**3
|
||||
00298 IF (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) CL**2
|
||||
00299 AND CL**2
|
||||
00300 (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ) CL**2
|
||||
00301 ADD +1 TO WRITTEN-OFF-PURSUED-RPT-CNT. CL**3
|
||||
00302 CL**2
|
||||
00303 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. CL**2
|
||||
00304 P1210-EXIT. CL**2
|
||||
00305 EXIT. CL**2
|
||||
00306 SKIP3 CL**2
|
||||
00307 P1220-REVERSE. CL**2
|
||||
00308 IF (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) CL**2
|
||||
00309 AND CL**2
|
||||
00310 (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ) CL**2
|
||||
00311 SET MQTR-RPT-IS-PURSUED-88 TO TRUE CL**2
|
||||
00312 ELSE CL**2
|
||||
00313 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. CL**2
|
||||
00314 P1220-EXIT. CL**2
|
||||
00315 EXIT. CL**2
|
||||
00316 EJECT CL**2
|
||||
00317 P2000-MDST-SCAN. CL**2
|
||||
00318 MOVE MSKL-REC TO MDST-REC. CL**2
|
||||
00319 CL**2
|
||||
00320 IF MDST-CREDIT-REC-88 CL**2
|
||||
00321 NEXT SENTENCE CL**2
|
||||
00322 ELSE CL**2
|
||||
00323 SET L910-NO-REC-88 TO TRUE CL**2
|
||||
00324 GO TO P2000-EXIT. CL**2
|
||||
00325 CL**2
|
||||
00326 IF L530-WRITE-OFF-88 CL**3
|
||||
00327 PERFORM P2100-WRITE-OFF THRU P2100-EXIT CL**3
|
||||
00328 VARYING MDST-ACCT-IDX FROM 1 BY 1 CL**2
|
||||
00329 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT CL**2
|
||||
00330 ELSE CL**2
|
||||
00331 PERFORM P2200-REVERSE THRU P2200-EXIT CL**2
|
||||
00332 VARYING MDST-ACCT-IDX FROM 1 BY 1 CL**2
|
||||
00333 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. CL**2
|
||||
00334 CL**2
|
||||
00335 *****PERFORM P2300-TOLERANCE THRU P2300-EXIT CL**3
|
||||
00336 *********VARYING MDST-ACCT-IDX FROM 1 BY 1 CL**3
|
||||
00337 *********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. CL**3
|
||||
00338 CL**2
|
||||
00339 MOVE MDST-REC TO MSKL-REC. CL**2
|
||||
00340 CL**2
|
||||
00341 PERFORM S910-REWRITE THRU S910-EXIT. CL**2
|
||||
00342 CL**2
|
||||
00343 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**2
|
||||
00344 P2000-EXIT. CL**2
|
||||
00345 EXIT. CL**2
|
||||
00346 SKIP3 CL**2
|
||||
00347 P2100-WRITE-OFF. CL**3
|
||||
00348 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) CL**2
|
||||
00349 NEXT SENTENCE CL**2
|
||||
00350 ELSE CL**2
|
||||
00351 GO TO P2100-EXIT. CL**2
|
||||
00352 CL**2
|
||||
00353 ADD MDST-AMT (MDST-ACCT-IDX) TO WRITTEN-OFF-CREDIT-AMT. CL**3
|
||||
00354 CL**2
|
||||
00355 MOVE MDST-AMT (MDST-ACCT-IDX) TO L542-AMT. CL**2
|
||||
00356 CL**3
|
||||
00357 MOVE CACT-CR-WRITE-OFF TO L542-ACCT-IND. CL**3
|
||||
00358 CL**3
|
||||
00359 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2
|
||||
00360 CL**2
|
||||
00361 COMPUTE L542-AMT = L542-AMT * -1. CL**2
|
||||
00362 CL**3
|
||||
00363 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. CL**2
|
||||
00364 CL**3
|
||||
00365 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2
|
||||
00366 CL**2
|
||||
00367 SET L530-UPDATE-88 TO TRUE. CL**2
|
||||
00368 CL**3
|
||||
00369 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. CL**2
|
||||
00370 CL**2
|
||||
00371 SET MDST-ACCT-IDX TO MDST-ACCT-CNT. CL**2
|
||||
00372 P2100-EXIT. CL**2
|
||||
00373 EXIT. CL**2
|
||||
00374 SKIP3 CL**2
|
||||
00375 P2200-REVERSE. CL**2
|
||||
00376 IF MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) CL**3
|
||||
00377 NEXT SENTENCE CL**2
|
||||
00378 ELSE CL**2
|
||||
00379 GO TO P2200-EXIT. CL**2
|
||||
00380 CL**2
|
||||
00381 MOVE MDST-AMT (MDST-ACCT-IDX) TO L542-AMT. CL**2
|
||||
00382 CL**3
|
||||
00383 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. CL**2
|
||||
00384 CL**3
|
||||
00385 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2
|
||||
00386 CL**2
|
||||
00387 COMPUTE L542-AMT = L542-AMT * -1. CL**2
|
||||
00388 CL**3
|
||||
00389 MOVE CACT-CR-WRITE-OFF TO L542-ACCT-IND. CL**3
|
||||
00390 CL**3
|
||||
00391 PERFORM S542-MODIFY-MDST THRU S542-EXIT. CL**2
|
||||
00392 CL**2
|
||||
00393 SET L530-UPDATE-88 TO TRUE. CL**2
|
||||
00394 CL**3
|
||||
00395 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. CL**2
|
||||
00396 CL**2
|
||||
00397 SET MDST-ACCT-IDX TO MDST-ACCT-CNT. CL**2
|
||||
00398 P2200-EXIT. CL**2
|
||||
00399 EXIT. CL**2
|
||||
00400 SKIP3 CL**2
|
||||
00401 *P2300-TOLERANCE. CL**2
|
||||
00402 *****IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) CL**3
|
||||
00403 *********NEXT SENTENCE CL**3
|
||||
00404 *****ELSE CL**3
|
||||
00405 *********GO TO P2300-EXIT. CL**3
|
||||
00406 CL**3
|
||||
00407 *****IF (MDST-AMT (MDST-ACCT-IDX) = +0) CL**3
|
||||
00408 ***********OR CL**3
|
||||
00409 ********(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX) CL**3
|
||||
00410 *********NEXT SENTENCE CL**3
|
||||
00411 *****ELSE CL**3
|
||||
00412 *********PERFORM S590-CR-TOL THRU S590-EXIT. CL**3
|
||||
00413 *P2300-EXIT. CL**2
|
||||
00414 *****EXIT. CL**3
|
||||
00415 EJECT CL**2
|
||||
00416 S541-MODIFY-AMT. CL**2
|
||||
00417 MOVE LBCM-TRN-DOC-NO TO L541-TRN-DOC-NO. CL**2
|
||||
00418 CL**2
|
||||
00419 CALL 'DTSBU541' USING L541-LINK-AREA CL**3
|
||||
00420 MPRF-REC CL**2
|
||||
00421 MQTR-REC. CL**2
|
||||
00422 S541-EXIT. CL**2
|
||||
00423 EXIT. CL**2
|
||||
00424 SKIP3 CL**2
|
||||
00425 S542-MODIFY-MDST. CL**2
|
||||
00426 MOVE LBCM-TRN-DOC-NO TO L542-TRN-DOC-NO. CL**2
|
||||
00427 CL**2
|
||||
00428 CALL 'DTSBU542' USING L542-LINK-AREA CL**3
|
||||
00429 MPRF-REC CL**2
|
||||
00430 MDST-REC. CL**2
|
||||
00431 S542-EXIT. CL**2
|
||||
00432 EXIT. CL**2
|
||||
00433 SKIP3 CL**2
|
||||
00434 S590-QTR-PURSUED. CL**2
|
||||
00435 SET L590-QTR-PURSUED-88 TO TRUE. CL**2
|
||||
00436 MOVE MQTR-YRQ TO L590-YRQ. CL**2
|
||||
00437 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO. CL**2
|
||||
00438 GO TO S590-EMPLOYER-CLEANUP. CL**2
|
||||
00439 CL**2
|
||||
00440 S590-QTR-TOL. CL**2
|
||||
00441 SET L590-QTR-TOL-88 TO TRUE. CL**2
|
||||
00442 MOVE MQTR-YRQ TO L590-YRQ. CL**2
|
||||
00443 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO. CL**2
|
||||
00444 GO TO S590-EMPLOYER-CLEANUP. CL**2
|
||||
00445 CL**2
|
||||
00446 *S590-CR-TOL. CL**2
|
||||
00447 *****SET L590-CR-TOL-88 TO TRUE. CL**3
|
||||
00448 *****MOVE +0 TO L590-YRQ. CL**3
|
||||
00449 *****MOVE MDST-DOC-NO TO L590-PAY-DOC-NO. CL**3
|
||||
00450 *****GO TO S590-EMPLOYER-CLEANUP. CL**3
|
||||
00451 CL**2
|
||||
00452 S590-EMPLOYER-CLEANUP. CL**2
|
||||
00453 MOVE LBCM-TRN-DOC-NO TO L590-TOL-DOC-NO. CL**2
|
||||
00454 CL**2
|
||||
00455 CALL 'DTSBU590' USING L590-LINK-AREA CL**3
|
||||
00456 LBCM-LINK-AREA CL**2
|
||||
00457 MPRF-REC. CL**2
|
||||
00458 S590-EXIT. CL**2
|
||||
00459 EXIT. CL**2
|
||||
00460 SKIP3 CL**2
|
||||
00461 *S910-READ. CL**2
|
||||
00462 *****SET L910-READ-88 TO TRUE. CL**2
|
||||
00463 *****GO TO S910-MSTR-IO. CL**2
|
||||
00464 CL**3
|
||||
00465 S910-START-BROWSE. CL**2
|
||||
00466 SET L910-START-BROWSE-88 TO TRUE. CL**2
|
||||
00467 GO TO S910-MSTR-IO. CL**2
|
||||
00468 CL**3
|
||||
00469 S910-READ-NEXT. CL**2
|
||||
00470 SET L910-READ-NEXT-88 TO TRUE. CL**2
|
||||
00471 GO TO S910-MSTR-IO. CL**2
|
||||
00472 CL**3
|
||||
00473 *S910-COUNT. CL**2
|
||||
00474 *****SET L910-COUNT-88 TO TRUE. CL**2
|
||||
00475 *****GO TO S910-MSTR-IO. CL**2
|
||||
00476 CL**3
|
||||
00477 *S910-WRITE. CL**2
|
||||
00478 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2
|
||||
00479 *****SET L910-WRITE-88 TO TRUE. CL**2
|
||||
00480 *****GO TO S910-MSTR-IO. CL**2
|
||||
00481 CL**3
|
||||
00482 S910-REWRITE. CL**2
|
||||
00483 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2
|
||||
00484 SET L910-REWRITE-88 TO TRUE. CL**2
|
||||
00485 GO TO S910-MSTR-IO. CL**2
|
||||
00486 CL**3
|
||||
00487 *S910-DELETE. CL**2
|
||||
00488 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL**2
|
||||
00489 *****SET L910-DELETE-88 TO TRUE. CL**2
|
||||
00490 *****GO TO S910-MSTR-IO. CL**2
|
||||
00491 CL**3
|
||||
00492 S910-MSTR-IO. CL**2
|
||||
00493 CALL 'DTSBU910' USING L910-LINK-AREA CL**3
|
||||
00494 MSKL-REC. CL**2
|
||||
00495 S910-EXIT. CL**2
|
||||
00496 EXIT. CL**2
|
||||
00497 SKIP3 CL**2
|
||||
00498 S999-ABEND. CL**2
|
||||
00499 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**3
|
||||
00500 S999-EXIT. CL**2
|
||||
00501 EXIT. CL**2
|
||||
Reference in New Issue
Block a user