1116 lines
88 KiB
COBOL
1116 lines
88 KiB
COBOL
00001 IDENTIFICATION DIVISION. 10/01/15
|
|
00002 PROGRAM-ID. DTSBU590. DTSBU590
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV016
|
|
00004 DATE-WRITTEN. JULY 1994. DTSBU590
|
|
00005 DATE-COMPILED. DTSBU590
|
|
00006 SKIP3 DTSBU590
|
|
00007 ***** DTSBU590
|
|
00008 * DTSBU590
|
|
00009 * FUNCTION: EMPLOYER UPDATE CLEANUP PROCESSING. DTSBU590
|
|
00010 * DTSBU590
|
|
00011 * DTSBU590
|
|
00012 * MODIFICATION LOG: DTSBU590
|
|
00013 * DTSBU590
|
|
00014 * 07/12/94 INITIAL DEVELOPMENT. DTSBU590
|
|
00015 * WORK ORDER: PROGRAMMER: TCL DTSBU590
|
|
00016 * DTSBU590
|
|
00017 * 04/25/95 BYPASS R425R2 WHEN MPRF-FLD-LIST-REMOVE-88. DTSBU590
|
|
00018 * WORK ORDER: CR082 PROGRAMMER: RHC DTSBU590
|
|
00019 * DTSBU590
|
|
00020 * 05/13/95 FOR REIMBURSING EMPLOYERS, INCLUDE ONLY AFT DTSBU590
|
|
00021 * BALANCES DUE ON THE INCREASES IN TOTAL BALANCES DTSBU590
|
|
00022 * DUE LIST. DTSBU590
|
|
00023 * WORK ORDER: CR084 PROGRAMMER: EHH DTSBU590
|
|
00024 * DTSBU590
|
|
00025 * 06/12/95 ADD BATCH NUMBERS TO R424R1. DTSBU590
|
|
00026 * WORK ORDER: CR095 PROGRAMMER: RHC DTSBU590
|
|
00027 * DTSBU590
|
|
00028 * 06/13/95 ACCUMULATE CREDIT TOLERANCE BY EMPLOYER. DTSBU590
|
|
00029 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBU590
|
|
00030 * DTSBU590
|
|
00031 * 10/14/1998 REVIEWED AND MODIFIED FOR DC. DTSBU590
|
|
00032 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU590
|
|
00033 * DTSBU590
|
|
00034 * 02/14/2006 MODIFIED P9110 AND P9120 TO EXCLUDE DTSBU590
|
|
00035 * ADMINISTRATIVE ASSESSMENT FROM TOLERANCE, WITH DTSBU590
|
|
00036 * ONE EXCEPTION - TOLERATE A ROUNDING ERROR OF DTSBU590
|
|
00037 * ONE PENNY. DTSBU590
|
|
00038 * REFERENCE: 2006 SUR-TAX PROGRAMMER: GD DTSBU590
|
|
00039 * DTSBU590
|
|
00040 * 10/29/2008 MODIFIED P9110 AND P9120 TO TOLERATE DTSBU590
|
|
00041 * ADMINISTRATIVE ASSESSMENT AMOUNTS OF LESS DTSBU590
|
|
00042 * THAN $1.00. DTSBU590
|
|
00043 * REFERENCE: DIR 119 PROGRAMMER: GD DTSBU590
|
|
00044 * DTSBU590
|
|
00045 * DTSBU590
|
|
00046 * 09/24/2015 MODIFIED P9110 AND P9120 TO NOT TOLERATE ANY DTSBU590
|
|
00047 * ADMINISTRATIVE ASSESSMENT AMOUNTS. DTSBU590
|
|
00048 * REFERENCE: TOLERANCE PROGRAMMER: ZL1 DTSBU590
|
|
00049 * DTSBU590
|
|
00050 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU590
|
|
00051 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU590
|
|
00052 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU590
|
|
00053 * DTSBU590
|
|
00054 * DTSBU590
|
|
00055 * DESCRIPTION: DTSBU590
|
|
00056 * DTSBU590
|
|
00057 * AFTER ALL TRANSACTIONS FOR A GIVEN EMPLOYER HAVE BEEN DTSBU590
|
|
00058 * PROCESSED DTSBU590 IS CALLED. DTSBU590
|
|
00059 * DTSBU590
|
|
00060 * DTSBU590 PERFORMS ANY EMPLOYER CLEANUP PROCESSING DTSBU590
|
|
00061 * NECESSARY. DTSBU590
|
|
00062 * DTSBU590
|
|
00063 * DTSBU590
|
|
00064 * MASTER FILE RECORDS READ: DTSBU590
|
|
00065 * DTSBU590
|
|
00066 * MQTR DTSBU590
|
|
00067 * MRPT DTSBU590
|
|
00068 * MPAY DTSBU590
|
|
00069 * MADJ DTSBU590
|
|
00070 * MDST DTSBU590
|
|
00071 * DTSBU590
|
|
00072 * DTSBU590
|
|
00073 * MASTER FILE RECORDS UPDATED: DTSBU590
|
|
00074 * DTSBU590
|
|
00075 * MQTR (REWRITE) DTSBU590
|
|
00076 * MDST (WRITE, REWRITE) DTSBU590
|
|
00077 * DTSBU590
|
|
00078 * DTSBU590
|
|
00079 * REPORT RECORDS WRITTEN: DTSBU590
|
|
00080 * DTSBU590
|
|
00081 * NONE DTSBU590
|
|
00082 * DTSBU590
|
|
00083 * DTSBU590
|
|
00084 * MODULES CALLED: DTSBU590
|
|
00085 * DTSBU590
|
|
00086 * DTSBU910 MASTER FILE I/O DRIVER. DTSBU590
|
|
00087 * DTSBU590
|
|
00088 * DTSBU590
|
|
00089 ***** DTSBU590
|
|
00090 SKIP3 DTSBU590
|
|
00091 ENVIRONMENT DIVISION. DTSBU590
|
|
00092 EJECT DTSBU590
|
|
00093 DATA DIVISION. DTSBU590
|
|
00094 SKIP3 DTSBU590
|
|
00095 WORKING-STORAGE SECTION. DTSBU590
|
|
000955 77 PAN-VALET PICTURE X(24) VALUE '016DTSBU590 10/01/15'. DTSBU590
|
|
00096 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU590 10/01/15'. DTSBU590
|
|
00097 77 PAN-VALET PICTURE X(24) VALUE '014DTSBU590 10/29/08'. DTSBU590
|
|
00098 SKIP3 DTSBU590
|
|
00099 01 WRK-AREA. DTSBU590
|
|
00100 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +590.DTSBU590
|
|
00101 DTSBU590
|
|
00102 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU590'.DTSBU590
|
|
00103 DTSBU590
|
|
00104 05 ENTRY-FOUND-IND PIC X(01). DTSBU590
|
|
00105 DTSBU590
|
|
00106 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU590
|
|
00107 DTSBU590
|
|
00108 05 WRK-NULL-DOC-NO. DTSBU590
|
|
00109 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBU590
|
|
00110 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBU590
|
|
00111 DTSBU590
|
|
00112 05 WRK-TOL-DOC-NO PIC X(05). DTSBU590
|
|
00113 DTSBU590
|
|
00114 05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590
|
|
00115 DTSBU590
|
|
00116 05 WRK-SUR-BAL-AMT PIC S9(09)V9(02) COMP-3. DTSBU590
|
|
00117 DTSBU590
|
|
00118 05 WRK-AVAILABLE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590
|
|
00119 DTSBU590
|
|
00120 05 RPT-FOUND-IND PIC X(01). DTSBU590
|
|
00121 DTSBU590
|
|
00122 05 R424-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590
|
|
00123 DTSBU590
|
|
00124 05 WRK-COLLECT-SUR-IND PIC X(01). DTSBU590
|
|
00125 88 WRK-COLLECT-SUR-YES-88 VALUE 'Y'. DTSBU590
|
|
00126 88 WRK-COLLECT-SUR-NO-88 VALUE 'N'. DTSBU590
|
|
00127 DTSBU590
|
|
00128 05 AMT-DISP1 PIC ---,---,--9.99. DTSBU590
|
|
00129 05 AMT-DISP2 PIC ---,---,--9.99. DTSBU590
|
|
00130 EJECT DTSBU590
|
|
00131 01 QTR-TOL-AREA. DTSBU590
|
|
00132 05 QTR-TOL-CNT PIC S9(04) COMP. DTSBU590
|
|
00133 05 QTR-TOL-ENTRY OCCURS 400 TIMES DTSBU590
|
|
00134 INDEXED BY QTR-TOL-IDX. DTSBU590
|
|
00135 10 QTR-TOL-YRQ PIC S9(05) COMP-3. DTSBU590
|
|
00136 10 QTR-TOL-DOC-NO PIC X(05). DTSBU590
|
|
00137 SKIP3 DTSBU590
|
|
00138 01 ORIG-RPT-AREA. DTSBU590
|
|
00139 05 ORIG-RPT-CNT PIC S9(04) COMP. DTSBU590
|
|
00140 05 ORIG-RPT-ENTRY OCCURS 400 TIMES DTSBU590
|
|
00141 INDEXED BY ORIG-RPT-IDX. DTSBU590
|
|
00142 10 ORIG-RPT-YRQ PIC S9(05) COMP-3. DTSBU590
|
|
00143 SKIP3 DTSBU590
|
|
00144 01 TOT-BALANCE-AREA. DTSBU590
|
|
00145 05 INIT-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590
|
|
00146 SKIP3 DTSBU590
|
|
00147 01 PURSUED-AREA. DTSBU590
|
|
00148 05 PURSUED-CNT PIC S9(04) COMP. DTSBU590
|
|
00149 05 PURSUED-ENTRY OCCURS 400 TIMES DTSBU590
|
|
00150 INDEXED BY PURSUED-IDX. DTSBU590
|
|
00151 10 PURSUED-YRQ PIC S9(05) COMP-3. DTSBU590
|
|
00152 EJECT DTSBU590
|
|
00153 01 L061-LINK-AREA. DTSBU590
|
|
00154 ++INCLUDE DTSIL061 DTSBU590
|
|
00155 EJECT DTSBU590
|
|
00156 01 L541-LINK-AREA. DTSBU590
|
|
00157 ++INCLUDE DTSIL541 DTSBU590
|
|
00158 EJECT DTSBU590
|
|
00159 01 L542-LINK-AREA. DTSBU590
|
|
00160 ++INCLUDE DTSIL542 DTSBU590
|
|
00161 EJECT DTSBU590
|
|
00162 01 L549-LINK-AREA. DTSBU590
|
|
00163 ++INCLUDE DTSIL549 DTSBU590
|
|
00164 EJECT DTSBU590
|
|
00165 01 L910-LINK-AREA. DTSBU590
|
|
00166 ++INCLUDE DTSIL910 DTSBU590
|
|
00167 SKIP3 DTSBU590
|
|
00168 01 MSKL-REC. DTSBU590
|
|
00169 ++INCLUDE DTSIMSKL DTSBU590
|
|
00170 SKIP3 DTSBU590
|
|
00171 01 MQTR-REC. DTSBU590
|
|
00172 ++INCLUDE DTSIMQTR DTSBU590
|
|
00173 EJECT DTSBU590
|
|
00174 01 MRPT-REC. DTSBU590
|
|
00175 ++INCLUDE DTSIMRPT DTSBU590
|
|
00176 EJECT DTSBU590
|
|
00177 01 MPAY-REC. DTSBU590
|
|
00178 ++INCLUDE DTSIMPAY DTSBU590
|
|
00179 EJECT DTSBU590
|
|
00180 01 MADJ-REC. DTSBU590
|
|
00181 ++INCLUDE DTSIMADJ DTSBU590
|
|
00182 EJECT DTSBU590
|
|
00183 01 MDST-REC. DTSBU590
|
|
00184 ++INCLUDE DTSIMDST DTSBU590
|
|
00185 EJECT DTSBU590
|
|
00186 01 RSKL-REC. DTSBU590
|
|
00187 ++INCLUDE DTSIRSK1 DTSBU590
|
|
00188 EJECT DTSBU590
|
|
00189 01 R424-REC. DTSBU590
|
|
00190 ++INCLUDE DTSIR424 DTSBU590
|
|
00191 EJECT DTSBU590
|
|
00192 01 R425-REC. DTSBU590
|
|
00193 ++INCLUDE DTSIR425 DTSBU590
|
|
00194 EJECT DTSBU590
|
|
00195 01 R907-REC. DTSBU590
|
|
00196 ++INCLUDE DTSIR907 DTSBU590
|
|
00197 EJECT DTSBU590
|
|
00198 01 CACT-LITERALS. DTSBU590
|
|
00199 ++INCLUDE DTSICACT DTSBU590
|
|
00200 EJECT DTSBU590
|
|
00201 LINKAGE SECTION. DTSBU590
|
|
00202 SKIP3 DTSBU590
|
|
00203 01 L590-LINK-AREA. DTSBU590
|
|
00204 ++INCLUDE DTSIL590 DTSBU590
|
|
00205 EJECT DTSBU590
|
|
00206 01 LBCM-LINK-AREA. DTSBU590
|
|
00207 ++INCLUDE DTSILBCM DTSBU590
|
|
00208 EJECT DTSBU590
|
|
00209 01 MPRF-REC. DTSBU590
|
|
00210 ++INCLUDE DTSIMPRF DTSBU590
|
|
00211 EJECT DTSBU590
|
|
00212 PROCEDURE DIVISION USING L590-LINK-AREA DTSBU590
|
|
00213 LBCM-LINK-AREA DTSBU590
|
|
00214 MPRF-REC. DTSBU590
|
|
00215 DTSBU590
|
|
00216 DTSBU590
|
|
00217 IF FIRST-TIME-IND = 'Y' DTSBU590
|
|
00218 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBU590
|
|
00219 MOVE 'N' TO FIRST-TIME-IND. DTSBU590
|
|
00220 DTSBU590
|
|
00221 IF L590-INITIATE-88 DTSBU590
|
|
00222 PERFORM P1000-INITIATE THRU P1000-EXIT DTSBU590
|
|
00223 ELSE DTSBU590
|
|
00224 IF L590-QTR-TOL-88 DTSBU590
|
|
00225 PERFORM P2000-QTR-TOL THRU P2000-EXIT DTSBU590
|
|
00226 ELSE DTSBU590
|
|
00227 IF L590-ORIG-RPT-88 DTSBU590
|
|
00228 PERFORM P4000-ORIG-RPT THRU P4000-EXIT DTSBU590
|
|
00229 ELSE DTSBU590
|
|
00230 IF L590-QTR-PURSUED-88 DTSBU590
|
|
00231 PERFORM P5000-QTR-PURSUED THRU P5000-EXIT DTSBU590
|
|
00232 ELSE DTSBU590
|
|
00233 IF L590-TERMINATE-88 DTSBU590
|
|
00234 PERFORM P9000-TERMINATE THRU P9000-EXIT DTSBU590
|
|
00235 ELSE DTSBU590
|
|
00236 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590
|
|
00237 DTSBU590
|
|
00238 DTSBU590
|
|
00239 GOBACK. DTSBU590
|
|
00240 EJECT DTSBU590
|
|
00241 I0000-FIRST-TIME. DTSBU590
|
|
00242 MOVE +0 TO WRK-NULL-BATCH-NO DTSBU590
|
|
00243 WRK-NULL-ITEM-NO. DTSBU590
|
|
00244 DTSBU590
|
|
00245 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBU590
|
|
00246 R907-MODULE-NAME. DTSBU590
|
|
00247 DTSBU590
|
|
00248 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBU590
|
|
00249 DTSBU590
|
|
00250 MOVE LENGTH OF R424-REC TO R424-LENGTH. DTSBU590
|
|
00251 DTSBU590
|
|
00252 MOVE LENGTH OF R425-REC TO R425-LENGTH. DTSBU590
|
|
00253 DTSBU590
|
|
00254 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBU590
|
|
00255 I0000-EXIT. DTSBU590
|
|
00256 EXIT. DTSBU590
|
|
00257 EJECT DTSBU590
|
|
00258 P1000-INITIATE. DTSBU590
|
|
00259 MOVE +0 TO QTR-TOL-CNT DTSBU590
|
|
00260 ORIG-RPT-CNT DTSBU590
|
|
00261 PURSUED-CNT. DTSBU590
|
|
00262 DTSBU590
|
|
00263 IF MPRF-CLASS-SELF-INS-88 DTSBU590
|
|
00264 MOVE +0 TO R424-BALANCE-AMT DTSBU590
|
|
00265 PERFORM S2100-SELF-INS-BALANCE-AMT THRU S2100-EXIT DTSBU590
|
|
00266 MOVE R424-BALANCE-AMT TO INIT-TOT-BALANCE-AMT DTSBU590
|
|
00267 ELSE DTSBU590
|
|
00268 MOVE MPRF-TOT-BALANCE-AMT TO INIT-TOT-BALANCE-AMT. DTSBU590
|
|
00269 P1000-EXIT. DTSBU590
|
|
00270 EXIT. DTSBU590
|
|
00271 EJECT DTSBU590
|
|
00272 P2000-QTR-TOL. DTSBU590
|
|
00273 MOVE 'N' TO ENTRY-FOUND-IND. DTSBU590
|
|
00274 DTSBU590
|
|
00275 PERFORM P2100-QTR-TOL-LOOP THRU P2100-EXIT DTSBU590
|
|
00276 VARYING QTR-TOL-IDX FROM 1 BY 1 DTSBU590
|
|
00277 UNTIL (QTR-TOL-IDX > QTR-TOL-CNT) DTSBU590
|
|
00278 OR DTSBU590
|
|
00279 (ENTRY-FOUND-IND = 'Y'). DTSBU590
|
|
00280 DTSBU590
|
|
00281 IF ENTRY-FOUND-IND = 'Y' DTSBU590
|
|
00282 GO TO P2000-EXIT. DTSBU590
|
|
00283 DTSBU590
|
|
00284 IF QTR-TOL-CNT < +400 DTSBU590
|
|
00285 ADD +1 TO QTR-TOL-CNT DTSBU590
|
|
00286 MOVE L590-YRQ TO QTR-TOL-YRQ (QTR-TOL-CNT) DTSBU590
|
|
00287 MOVE L590-TOL-DOC-NO TO QTR-TOL-DOC-NO (QTR-TOL-CNT) DTSBU590
|
|
00288 ELSE DTSBU590
|
|
00289 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590
|
|
00290 P2000-EXIT. DTSBU590
|
|
00291 EXIT. DTSBU590
|
|
00292 SKIP3 DTSBU590
|
|
00293 P2100-QTR-TOL-LOOP. DTSBU590
|
|
00294 IF L590-YRQ = QTR-TOL-YRQ (QTR-TOL-IDX) DTSBU590
|
|
00295 MOVE 'Y' TO ENTRY-FOUND-IND. DTSBU590
|
|
00296 P2100-EXIT. DTSBU590
|
|
00297 EXIT. DTSBU590
|
|
00298 EJECT DTSBU590
|
|
00299 P4000-ORIG-RPT. DTSBU590
|
|
00300 MOVE 'N' TO ENTRY-FOUND-IND. DTSBU590
|
|
00301 DTSBU590
|
|
00302 PERFORM P4100-ORIG-RPT-LOOP THRU P4100-EXIT DTSBU590
|
|
00303 VARYING ORIG-RPT-IDX FROM 1 BY 1 DTSBU590
|
|
00304 UNTIL (ORIG-RPT-IDX > ORIG-RPT-CNT) DTSBU590
|
|
00305 OR DTSBU590
|
|
00306 (ENTRY-FOUND-IND = 'Y'). DTSBU590
|
|
00307 DTSBU590
|
|
00308 IF ENTRY-FOUND-IND = 'Y' DTSBU590
|
|
00309 GO TO P4000-EXIT. DTSBU590
|
|
00310 DTSBU590
|
|
00311 IF ORIG-RPT-CNT < +400 DTSBU590
|
|
00312 ADD +1 TO ORIG-RPT-CNT DTSBU590
|
|
00313 MOVE L590-YRQ TO ORIG-RPT-YRQ (ORIG-RPT-CNT) DTSBU590
|
|
00314 ELSE DTSBU590
|
|
00315 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590
|
|
00316 P4000-EXIT. DTSBU590
|
|
00317 EXIT. DTSBU590
|
|
00318 SKIP3 DTSBU590
|
|
00319 P4100-ORIG-RPT-LOOP. DTSBU590
|
|
00320 IF L590-YRQ = ORIG-RPT-YRQ (ORIG-RPT-IDX) DTSBU590
|
|
00321 MOVE 'Y' TO ENTRY-FOUND-IND. DTSBU590
|
|
00322 P4100-EXIT. DTSBU590
|
|
00323 EXIT. DTSBU590
|
|
00324 EJECT DTSBU590
|
|
00325 P5000-QTR-PURSUED. DTSBU590
|
|
00326 MOVE 'N' TO ENTRY-FOUND-IND. DTSBU590
|
|
00327 DTSBU590
|
|
00328 PERFORM P5100-PURSUED-LOOP THRU P5100-EXIT DTSBU590
|
|
00329 VARYING PURSUED-IDX FROM 1 BY 1 DTSBU590
|
|
00330 UNTIL (PURSUED-IDX > PURSUED-CNT) DTSBU590
|
|
00331 OR DTSBU590
|
|
00332 (ENTRY-FOUND-IND = 'Y'). DTSBU590
|
|
00333 DTSBU590
|
|
00334 IF ENTRY-FOUND-IND = 'Y' DTSBU590
|
|
00335 GO TO P5000-EXIT. DTSBU590
|
|
00336 DTSBU590
|
|
00337 IF PURSUED-CNT < +400 DTSBU590
|
|
00338 ADD +1 TO PURSUED-CNT DTSBU590
|
|
00339 MOVE L590-YRQ TO PURSUED-YRQ (PURSUED-CNT) DTSBU590
|
|
00340 ELSE DTSBU590
|
|
00341 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590
|
|
00342 P5000-EXIT. DTSBU590
|
|
00343 EXIT. DTSBU590
|
|
00344 SKIP3 DTSBU590
|
|
00345 P5100-PURSUED-LOOP. DTSBU590
|
|
00346 IF L590-YRQ = PURSUED-YRQ (PURSUED-IDX) DTSBU590
|
|
00347 MOVE 'Y' TO ENTRY-FOUND-IND. DTSBU590
|
|
00348 P5100-EXIT. DTSBU590
|
|
00349 EXIT. DTSBU590
|
|
00350 EJECT DTSBU590
|
|
00351 P9000-TERMINATE. DTSBU590
|
|
00352 PERFORM P9100-QTR-TOL THRU P9100-EXIT DTSBU590
|
|
00353 VARYING QTR-TOL-IDX FROM 1 BY 1 DTSBU590
|
|
00354 UNTIL QTR-TOL-IDX > QTR-TOL-CNT. DTSBU590
|
|
00355 DTSBU590
|
|
00356 PERFORM P9200-CREDIT-TOL THRU P9200-EXIT. DTSBU590
|
|
00357 DTSBU590
|
|
00358 PERFORM P9300-ORIG-RPT THRU P9300-EXIT DTSBU590
|
|
00359 VARYING ORIG-RPT-IDX FROM 1 BY 1 DTSBU590
|
|
00360 UNTIL ORIG-RPT-IDX > ORIG-RPT-CNT. DTSBU590
|
|
00361 DTSBU590
|
|
00362 PERFORM P9400-TOT-BALANCE-AMT THRU P9400-EXIT. DTSBU590
|
|
00363 DTSBU590
|
|
00364 PERFORM P9500-PURSUED-YRQ THRU P9500-EXIT DTSBU590
|
|
00365 VARYING PURSUED-IDX FROM 1 BY 1 DTSBU590
|
|
00366 UNTIL PURSUED-IDX > PURSUED-CNT. DTSBU590
|
|
00367 DTSBU590
|
|
00368 IF LBCM-EMP-UPDATE-YES-88 DTSBU590
|
|
00369 PERFORM P9900-MPRF-UPDATE-DATA THRU P9900-EXIT. DTSBU590
|
|
00370 P9000-EXIT. DTSBU590
|
|
00371 EXIT. DTSBU590
|
|
00372 EJECT DTSBU590
|
|
00373 P9100-QTR-TOL. DTSBU590
|
|
00374 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU590
|
|
00375 DTSBU590
|
|
00376 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU590
|
|
00377 DTSBU590
|
|
00378 SET MQTR-QTR-88 TO TRUE. DTSBU590
|
|
00379 DTSBU590
|
|
00380 MOVE QTR-TOL-YRQ (QTR-TOL-IDX) TO MQTR-YRQ. DTSBU590
|
|
00381 DTSBU590
|
|
00382 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00383 DTSBU590
|
|
00384 PERFORM S910-READ THRU S910-EXIT. DTSBU590
|
|
00385 DTSBU590
|
|
00386 IF L910-NO-REC-88 DTSBU590
|
|
00387 GO TO P9100-EXIT. DTSBU590
|
|
00388 DTSBU590
|
|
00389 DTSBU590
|
|
00390 MOVE MSKL-REC TO MQTR-REC. DTSBU590
|
|
00391 DTSBU590
|
|
00392 DTSBU590
|
|
00393 MOVE +0 TO WRK-BALANCE-AMT DTSBU590
|
|
00394 WRK-SUR-BAL-AMT. DTSBU590
|
|
00395 DTSBU590
|
|
00396 PERFORM P9110-ACCT-SCAN THRU P9110-EXIT DTSBU590
|
|
00397 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590
|
|
00398 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU590
|
|
00399 DTSBU590
|
|
00400 MOVE WRK-BALANCE-AMT TO AMT-DISP1. DTSBU590
|
|
00401 MOVE WRK-SUR-BAL-AMT TO AMT-DISP2. DTSBU590
|
|
00402 DISPLAY 'BU590 ' MPRF-EMP-NO DTSBU590
|
|
00403 ' TOT ' AMT-DISP1 DTSBU590
|
|
00404 ' SUR ' AMT-DISP2. DTSBU590
|
|
00405 DTSBU590
|
|
00406 IF (WRK-BALANCE-AMT NOT > +0) DTSBU590
|
|
00407 OR DTSBU590
|
|
00408 (WRK-BALANCE-AMT > LBCM-QTR-TOL-MAX) DTSBU590
|
|
00409 GO TO P9100-EXIT DTSBU590
|
|
00410 END-IF. DTSBU590
|
|
00411 DTSBU590
|
|
00412 ******************************************************* DTSBU590
|
|
00413 * IF THE TOTAL BALANCE DUE IS LESS THAN THE THRESHOLD, DTSBU590
|
|
00414 * BUT THE BALANCE DUE IN ADMIN ASSESSMENT IS ABOVE DTSBU590
|
|
00415 * THE .99 THRESHOLD, TOLERATE ALL BUT THE ADMIN ASSESS. DTSBU590
|
|
00416 ******************************************************* DTSBU590
|
|
00417 IF WRK-SUR-BAL-AMT >= +0.01 DTSBU590
|
|
00418 SET WRK-COLLECT-SUR-YES-88 TO TRUE DTSBU590
|
|
00419 ELSE DTSBU590
|
|
00420 SET WRK-COLLECT-SUR-NO-88 TO TRUE DTSBU590
|
|
00421 END-IF. DTSBU590
|
|
00422 DTSBU590
|
|
00423 MOVE QTR-TOL-DOC-NO (QTR-TOL-IDX) TO WRK-TOL-DOC-NO. DTSBU590
|
|
00424 DTSBU590
|
|
00425 PERFORM S1000-L549-INIT-AREA THRU S1000-EXIT. DTSBU590
|
|
00426 DTSBU590
|
|
00427 PERFORM S549-INIT-TRAN THRU S549-EXIT. DTSBU590
|
|
00428 DTSBU590
|
|
00429 PERFORM P9120-ZERO-BALANCE THRU P9120-EXIT DTSBU590
|
|
00430 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590
|
|
00431 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU590
|
|
00432 DTSBU590
|
|
00433 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBU590
|
|
00434 DTSBU590
|
|
00435 MOVE MQTR-REC TO MSKL-REC. DTSBU590
|
|
00436 DTSBU590
|
|
00437 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU590
|
|
00438 DTSBU590
|
|
00439 PERFORM S549-TERM-TRAN-SEC THRU S549-EXIT. DTSBU590
|
|
00440 P9100-EXIT. DTSBU590
|
|
00441 EXIT. DTSBU590
|
|
00442 SKIP3 DTSBU590
|
|
00443 P9110-ACCT-SCAN. DTSBU590
|
|
00444 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBU590
|
|
00445 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590
|
|
00446 TO WRK-BALANCE-AMT DTSBU590
|
|
00447 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590
|
|
00448 TO WRK-SUR-BAL-AMT DTSBU590
|
|
00449 ELSE DTSBU590
|
|
00450 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590
|
|
00451 TO WRK-BALANCE-AMT DTSBU590
|
|
00452 END-IF. DTSBU590
|
|
00453 DTSBU590
|
|
00454 P9110-EXIT. DTSBU590
|
|
00455 EXIT. DTSBU590
|
|
00456 SKIP3 DTSBU590
|
|
00457 P9120-ZERO-BALANCE. DTSBU590
|
|
00458 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBU590
|
|
00459 IF WRK-COLLECT-SUR-YES-88 DTSBU590
|
|
00460 GO TO P9120-EXIT DTSBU590
|
|
00461 END-IF DTSBU590
|
|
00462 ELSE DTSBU590
|
|
00463 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSBU590
|
|
00464 NEXT SENTENCE DTSBU590
|
|
00465 ELSE DTSBU590
|
|
00466 GO TO P9120-EXIT DTSBU590
|
|
00467 END-IF DTSBU590
|
|
00468 END-IF. DTSBU590
|
|
00469 DTSBU590
|
|
00470 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO L541-AMT. DTSBU590
|
|
00471 DTSBU590
|
|
00472 SET L541-ACCT-SUB TO MQTR-ACCT-IDX. DTSBU590
|
|
00473 DTSBU590
|
|
00474 MOVE CACT-CAT-TOLER TO L541-CAT-IND. DTSBU590
|
|
00475 DTSBU590
|
|
00476 MOVE WRK-TOL-DOC-NO TO L541-TRN-DOC-NO. DTSBU590
|
|
00477 DTSBU590
|
|
00478 PERFORM S541-MQTR-AMT THRU S541-EXIT. DTSBU590
|
|
00479 P9120-EXIT. DTSBU590
|
|
00480 EXIT. DTSBU590
|
|
00481 EJECT DTSBU590
|
|
00482 P9200-CREDIT-TOL. DTSBU590
|
|
00483 IF (MPRF-TOT-CREDIT-AMT <= +0) DTSBU590
|
|
00484 OR DTSBU590
|
|
00485 (MPRF-TOT-CREDIT-AMT > LBCM-CR-TOL-MAX) DTSBU590
|
|
00486 GO TO P9200-EXIT. DTSBU590
|
|
00487 DTSBU590
|
|
00488 DTSBU590
|
|
00489 IF LBCM-EMP-CR-TOL-DOC-NO = WRK-NULL-DOC-NO DTSBU590
|
|
00490 MOVE '354' TO R907-MSG-ID DTSBU590
|
|
00491 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBU590
|
|
00492 MOVE DTSBU590
|
|
00493 'CREDIT TOLERANCE WITHIN RANGE BEFORE ACCT TRN. NO ACTION.'DTSBU590
|
|
00494 TO R907-MSG-TEXT DTSBU590
|
|
00495 MOVE R907-REC TO RSKL-REC DTSBU590
|
|
00496 PERFORM S946-RSKL-WRITE THRU S946-EXIT DTSBU590
|
|
00497 GO TO P9200-EXIT. DTSBU590
|
|
00498 DTSBU590
|
|
00499 DTSBU590
|
|
00500 MOVE LBCM-EMP-CR-TOL-DOC-NO TO WRK-TOL-DOC-NO. DTSBU590
|
|
00501 DTSBU590
|
|
00502 PERFORM S1000-L549-INIT-AREA THRU S1000-EXIT. DTSBU590
|
|
00503 DTSBU590
|
|
00504 PERFORM S549-INIT-TRAN THRU S549-EXIT. DTSBU590
|
|
00505 DTSBU590
|
|
00506 DTSBU590
|
|
00507 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU590
|
|
00508 DTSBU590
|
|
00509 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU590
|
|
00510 DTSBU590
|
|
00511 SET MDST-DST-88 TO TRUE. DTSBU590
|
|
00512 DTSBU590
|
|
00513 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU590
|
|
00514 DTSBU590
|
|
00515 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00516 DTSBU590
|
|
00517 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590
|
|
00518 DTSBU590
|
|
00519 PERFORM UNTIL L910-NO-REC-88 DTSBU590
|
|
00520 MOVE MSKL-REC TO MDST-REC DTSBU590
|
|
00521 PERFORM P9210-MDST-PROCESS THRU P9210-EXIT DTSBU590
|
|
00522 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590
|
|
00523 END-PERFORM. DTSBU590
|
|
00524 DTSBU590
|
|
00525 PERFORM S549-TERM-TRAN-SEC THRU S549-EXIT. DTSBU590
|
|
00526 P9200-EXIT. DTSBU590
|
|
00527 EXIT. DTSBU590
|
|
00528 SKIP3 DTSBU590
|
|
00529 P9210-MDST-PROCESS. DTSBU590
|
|
00530 MOVE +0 TO WRK-AVAILABLE-AMT. DTSBU590
|
|
00531 DTSBU590
|
|
00532 PERFORM DTSBU590
|
|
00533 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU590
|
|
00534 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBU590
|
|
00535 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU590
|
|
00536 MOVE MDST-AMT (MDST-ACCT-IDX) TO WRK-AVAILABLE-AMT DTSBU590
|
|
00537 END-IF DTSBU590
|
|
00538 END-PERFORM. DTSBU590
|
|
00539 DTSBU590
|
|
00540 IF WRK-AVAILABLE-AMT <= +0 DTSBU590
|
|
00541 GO TO P9210-EXIT. DTSBU590
|
|
00542 DTSBU590
|
|
00543 DTSBU590
|
|
00544 COMPUTE L542-AMT = WRK-AVAILABLE-AMT * -1. DTSBU590
|
|
00545 DTSBU590
|
|
00546 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBU590
|
|
00547 DTSBU590
|
|
00548 MOVE WRK-TOL-DOC-NO TO L542-TRN-DOC-NO. DTSBU590
|
|
00549 DTSBU590
|
|
00550 PERFORM S542-MDST-AMT THRU S542-EXIT. DTSBU590
|
|
00551 DTSBU590
|
|
00552 DTSBU590
|
|
00553 MOVE WRK-AVAILABLE-AMT TO L542-AMT. DTSBU590
|
|
00554 DTSBU590
|
|
00555 MOVE CACT-CR-TOLER TO L542-ACCT-IND. DTSBU590
|
|
00556 DTSBU590
|
|
00557 MOVE WRK-TOL-DOC-NO TO L542-TRN-DOC-NO. DTSBU590
|
|
00558 DTSBU590
|
|
00559 PERFORM S542-MDST-AMT THRU S542-EXIT. DTSBU590
|
|
00560 DTSBU590
|
|
00561 DTSBU590
|
|
00562 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. DTSBU590
|
|
00563 DTSBU590
|
|
00564 MOVE MDST-REC TO MSKL-REC. DTSBU590
|
|
00565 DTSBU590
|
|
00566 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU590
|
|
00567 P9210-EXIT. DTSBU590
|
|
00568 EXIT. DTSBU590
|
|
00569 EJECT DTSBU590
|
|
00570 P9300-ORIG-RPT. DTSBU590
|
|
00571 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU590
|
|
00572 DTSBU590
|
|
00573 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU590
|
|
00574 DTSBU590
|
|
00575 SET MQTR-QTR-88 TO TRUE. DTSBU590
|
|
00576 DTSBU590
|
|
00577 MOVE ORIG-RPT-YRQ (ORIG-RPT-IDX) TO MQTR-YRQ. DTSBU590
|
|
00578 DTSBU590
|
|
00579 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00580 DTSBU590
|
|
00581 PERFORM S910-READ THRU S910-EXIT. DTSBU590
|
|
00582 DTSBU590
|
|
00583 IF L910-NO-REC-88 DTSBU590
|
|
00584 GO TO P9300-EXIT. DTSBU590
|
|
00585 DTSBU590
|
|
00586 DTSBU590
|
|
00587 MOVE MSKL-REC TO MQTR-REC. DTSBU590
|
|
00588 DTSBU590
|
|
00589 DTSBU590
|
|
00590 IF MQTR-COLL-PROMPT-DUE-AMT < +0 DTSBU590
|
|
00591 NEXT SENTENCE DTSBU590
|
|
00592 ELSE DTSBU590
|
|
00593 GO TO P9300-EXIT. DTSBU590
|
|
00594 DTSBU590
|
|
00595 DTSBU590
|
|
00596 MOVE +0 TO MQTR-COLL-PROMPT-DUE-AMT. DTSBU590
|
|
00597 DTSBU590
|
|
00598 PERFORM P9310-ACCT-DATA-LOOP THRU P9310-EXIT DTSBU590
|
|
00599 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590
|
|
00600 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU590
|
|
00601 DTSBU590
|
|
00602 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBU590
|
|
00603 DTSBU590
|
|
00604 MOVE MQTR-REC TO MSKL-REC. DTSBU590
|
|
00605 DTSBU590
|
|
00606 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU590
|
|
00607 P9300-EXIT. DTSBU590
|
|
00608 EXIT. DTSBU590
|
|
00609 SKIP3 DTSBU590
|
|
00610 P9310-ACCT-DATA-LOOP. DTSBU590
|
|
00611 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBU590
|
|
00612 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590
|
|
00613 TO MQTR-COLL-PROMPT-DUE-AMT. DTSBU590
|
|
00614 P9310-EXIT. DTSBU590
|
|
00615 EXIT. DTSBU590
|
|
00616 EJECT DTSBU590
|
|
00617 P9400-TOT-BALANCE-AMT. DTSBU590
|
|
00618 IF MPRF-CLASS-SELF-INS-88 DTSBU590
|
|
00619 MOVE +0 TO R424-BALANCE-AMT DTSBU590
|
|
00620 PERFORM S2100-SELF-INS-BALANCE-AMT THRU S2100-EXIT DTSBU590
|
|
00621 ELSE DTSBU590
|
|
00622 MOVE MPRF-TOT-BALANCE-AMT TO R424-BALANCE-AMT. DTSBU590
|
|
00623 DTSBU590
|
|
00624 DTSBU590
|
|
00625 ***** DTSBU590
|
|
00626 * DTSBU590
|
|
00627 * PER DC SPECIFICATION RPT424R1.DSC, DO NOT REPORT SELF DTSBU590
|
|
00628 * INSURED EMPLOYERS ON RPT424R1. DTSBU590
|
|
00629 * DTSBU590
|
|
00630 ***** DTSBU590
|
|
00631 DTSBU590
|
|
00632 IF MPRF-CLASS-SELF-INS-88 DTSBU590
|
|
00633 GO TO P9400-EXIT. DTSBU590
|
|
00634 DTSBU590
|
|
00635 DTSBU590
|
|
00636 IF R424-BALANCE-AMT > INIT-TOT-BALANCE-AMT DTSBU590
|
|
00637 NEXT SENTENCE DTSBU590
|
|
00638 ELSE DTSBU590
|
|
00639 GO TO P9400-EXIT. DTSBU590
|
|
00640 DTSBU590
|
|
00641 DTSBU590
|
|
00642 ***** DTSBU590
|
|
00643 * DTSBU590
|
|
00644 * THE DC SPECIFICATION FOR RPT424R1 DOES NOT EXPLICITLY STATE DTSBU590
|
|
00645 * TO BYPASS RPT424R1 WHEN COLLECTIONS ARE SUSPENDED. HOWEVER, DTSBU590
|
|
00646 * TO MAKE RPT424R1 CONSISTENT WITH RPT425R1 AND BECAUSE IN DC DTSBU590
|
|
00647 * RPT424R1 IS ORGANIZED BY FIELD REP CODE, THE FOLLOWING DTSBU590
|
|
00648 * SENTENCE BYPASSES RPT424R1 WHEN COLLECTIONS ARE SUSPENDED. DTSBU590
|
|
00649 * DTSBU590
|
|
00650 ***** DTSBU590
|
|
00651 DTSBU590
|
|
00652 IF MPRF-SUSPEND-COLL-YES-88 DTSBU590
|
|
00653 GO TO P9400-EXIT. DTSBU590
|
|
00654 DTSBU590
|
|
00655 DTSBU590
|
|
00656 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBU590
|
|
00657 DTSBU590
|
|
00658 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBU590
|
|
00659 DTSBU590
|
|
00660 PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT. DTSBU590
|
|
00661 DTSBU590
|
|
00662 MOVE L061-FLD-REP-ID TO R424-FLD-REP-ID. DTSBU590
|
|
00663 DTSBU590
|
|
00664 MOVE MPRF-EMP-NO TO R424-EMP-NO. DTSBU590
|
|
00665 DTSBU590
|
|
00666 MOVE MPRF-PRIMARY-NAME TO R424-PRIMARY-NAME. DTSBU590
|
|
00667 DTSBU590
|
|
00668 COMPUTE R424-INCREASED-AMT DTSBU590
|
|
00669 = R424-BALANCE-AMT - INIT-TOT-BALANCE-AMT. DTSBU590
|
|
00670 DTSBU590
|
|
00671 DTSBU590
|
|
00672 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBU590
|
|
00673 DTSBU590
|
|
00674 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590
|
|
00675 DTSBU590
|
|
00676 SET MSKL-RPT-88 TO TRUE DTSBU590
|
|
00677 DTSBU590
|
|
00678 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590
|
|
00679 DTSBU590
|
|
00680 PERFORM UNTIL L910-NO-REC-88 DTSBU590
|
|
00681 PERFORM P9410-WRITE-R424 THRU P9410-EXIT DTSBU590
|
|
00682 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590
|
|
00683 END-PERFORM. DTSBU590
|
|
00684 DTSBU590
|
|
00685 DTSBU590
|
|
00686 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBU590
|
|
00687 DTSBU590
|
|
00688 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590
|
|
00689 DTSBU590
|
|
00690 SET MSKL-PAY-88 TO TRUE DTSBU590
|
|
00691 DTSBU590
|
|
00692 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590
|
|
00693 DTSBU590
|
|
00694 PERFORM UNTIL L910-NO-REC-88 DTSBU590
|
|
00695 PERFORM P9410-WRITE-R424 THRU P9410-EXIT DTSBU590
|
|
00696 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590
|
|
00697 END-PERFORM. DTSBU590
|
|
00698 DTSBU590
|
|
00699 DTSBU590
|
|
00700 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBU590
|
|
00701 DTSBU590
|
|
00702 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590
|
|
00703 DTSBU590
|
|
00704 SET MSKL-ADJ-88 TO TRUE DTSBU590
|
|
00705 DTSBU590
|
|
00706 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590
|
|
00707 DTSBU590
|
|
00708 PERFORM UNTIL L910-NO-REC-88 DTSBU590
|
|
00709 PERFORM P9410-WRITE-R424 THRU P9410-EXIT DTSBU590
|
|
00710 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590
|
|
00711 END-PERFORM. DTSBU590
|
|
00712 P9400-EXIT. DTSBU590
|
|
00713 EXIT. DTSBU590
|
|
00714 SKIP3 DTSBU590
|
|
00715 P9410-WRITE-R424. DTSBU590
|
|
00716 IF MSKL-RPT-88 DTSBU590
|
|
00717 MOVE MSKL-REC TO MRPT-REC DTSBU590
|
|
00718 IF MRPT-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU590
|
|
00719 MOVE MRPT-BATCH-NO TO R424-BATCH-NO DTSBU590
|
|
00720 ELSE DTSBU590
|
|
00721 GO TO P9410-EXIT DTSBU590
|
|
00722 ELSE DTSBU590
|
|
00723 IF MSKL-PAY-88 DTSBU590
|
|
00724 MOVE MSKL-REC TO MPAY-REC DTSBU590
|
|
00725 IF MPAY-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU590
|
|
00726 MOVE MPAY-BATCH-NO TO R424-BATCH-NO DTSBU590
|
|
00727 ELSE DTSBU590
|
|
00728 GO TO P9410-EXIT DTSBU590
|
|
00729 ELSE DTSBU590
|
|
00730 IF MSKL-ADJ-88 DTSBU590
|
|
00731 MOVE MSKL-REC TO MADJ-REC DTSBU590
|
|
00732 IF MADJ-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU590
|
|
00733 MOVE MADJ-BATCH-NO TO R424-BATCH-NO DTSBU590
|
|
00734 ELSE DTSBU590
|
|
00735 GO TO P9410-EXIT DTSBU590
|
|
00736 ELSE DTSBU590
|
|
00737 GO TO P9410-EXIT. DTSBU590
|
|
00738 DTSBU590
|
|
00739 MOVE R424-REC TO RSKL-REC. DTSBU590
|
|
00740 DTSBU590
|
|
00741 PERFORM S946-RSKL-WRITE THRU S946-EXIT. DTSBU590
|
|
00742 P9410-EXIT. DTSBU590
|
|
00743 EXIT. DTSBU590
|
|
00744 EJECT DTSBU590
|
|
00745 P9500-PURSUED-YRQ. DTSBU590
|
|
00746 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU590
|
|
00747 DTSBU590
|
|
00748 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU590
|
|
00749 DTSBU590
|
|
00750 SET MQTR-QTR-88 TO TRUE. DTSBU590
|
|
00751 DTSBU590
|
|
00752 MOVE PURSUED-YRQ (PURSUED-IDX) TO MQTR-YRQ. DTSBU590
|
|
00753 DTSBU590
|
|
00754 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00755 DTSBU590
|
|
00756 PERFORM S910-READ THRU S910-EXIT. DTSBU590
|
|
00757 DTSBU590
|
|
00758 IF L910-NO-REC-88 DTSBU590
|
|
00759 GO TO P9500-EXIT. DTSBU590
|
|
00760 DTSBU590
|
|
00761 DTSBU590
|
|
00762 MOVE MSKL-REC TO MQTR-REC. DTSBU590
|
|
00763 DTSBU590
|
|
00764 DTSBU590
|
|
00765 IF MQTR-RPT-NOT-PURSUED-88 DTSBU590
|
|
00766 GO TO P9500-EXIT. DTSBU590
|
|
00767 DTSBU590
|
|
00768 DTSBU590
|
|
00769 IF MPRF-SUSPEND-COLL-YES-88 DTSBU590
|
|
00770 GO TO P9500-EXIT. DTSBU590
|
|
00771 DTSBU590
|
|
00772 DTSBU590
|
|
00773 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBU590
|
|
00774 DTSBU590
|
|
00775 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBU590
|
|
00776 DTSBU590
|
|
00777 PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT. DTSBU590
|
|
00778 DTSBU590
|
|
00779 MOVE L061-FLD-REP-ID TO R425-FLD-REP-ID. DTSBU590
|
|
00780 DTSBU590
|
|
00781 MOVE MPRF-EMP-NO TO R425-EMP-NO. DTSBU590
|
|
00782 DTSBU590
|
|
00783 MOVE MQTR-YRQ TO R425-YRQ. DTSBU590
|
|
00784 DTSBU590
|
|
00785 MOVE MPRF-PRIMARY-NAME TO R425-PRIMARY-NAME. DTSBU590
|
|
00786 DTSBU590
|
|
00787 MOVE MQTR-RPT-DUE-DATE TO R425-RPT-DUE-DATE. DTSBU590
|
|
00788 DTSBU590
|
|
00789 MOVE R425-REC TO RSKL-REC. DTSBU590
|
|
00790 DTSBU590
|
|
00791 PERFORM S946-RSKL-WRITE THRU S946-EXIT. DTSBU590
|
|
00792 P9500-EXIT. DTSBU590
|
|
00793 EXIT. DTSBU590
|
|
00794 EJECT DTSBU590
|
|
00795 P9900-MPRF-UPDATE-DATA. DTSBU590
|
|
00796 MOVE LBCM-ABSTIME TO MPRF-UPDATE-END-ABSTIME. DTSBU590
|
|
00797 DTSBU590
|
|
00798 MOVE +0 TO MPRF-UPDATE-TASK-ID. DTSBU590
|
|
00799 DTSBU590
|
|
00800 MOVE 'BATCH' TO MPRF-UPDATE-OP-ID. DTSBU590
|
|
00801 DTSBU590
|
|
00802 MOVE SPACES TO MPRF-UPDATE-TERMID. DTSBU590
|
|
00803 DTSBU590
|
|
00804 MOVE SPACES TO MPRF-UPDATE-NETNAME. DTSBU590
|
|
00805 DTSBU590
|
|
00806 MOVE LBCM-SYS-DATE TO MPRF-UPDATE-START-DATE. DTSBU590
|
|
00807 DTSBU590
|
|
00808 MOVE LBCM-SYS-TIME TO MPRF-UPDATE-START-TIME. DTSBU590
|
|
00809 DTSBU590
|
|
00810 MOVE SPACE TO MPRF-UPDATE-SCR-ID DTSBU590
|
|
00811 MPRF-UPDATE-FUNCTION. DTSBU590
|
|
00812 DTSBU590
|
|
00813 MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSBU590
|
|
00814 P9900-EXIT. DTSBU590
|
|
00815 EXIT. DTSBU590
|
|
00816 EJECT DTSBU590
|
|
00817 S1000-L549-INIT-AREA. DTSBU590
|
|
00818 MOVE WRK-TOL-DOC-NO TO L549-TRN-DOC-NO. DTSBU590
|
|
00819 DTSBU590
|
|
00820 MOVE LBCM-TRACE-IND TO L549-INIT-TRACE-IND. DTSBU590
|
|
00821 DTSBU590
|
|
00822 MOVE LBCM-CURR-RUN-DATE TO L549-INIT-CURR-RUN-DATE. DTSBU590
|
|
00823 DTSBU590
|
|
00824 MOVE LBCM-EMP-ABSTIME TO L549-INIT-ABSTIME. DTSBU590
|
|
00825 DTSBU590
|
|
00826 MOVE MPRF-EMP-NO TO L549-INIT-EMP-NO. DTSBU590
|
|
00827 DTSBU590
|
|
00828 MOVE MPRF-EMP-CLASS TO L549-INIT-EMP-CLASS. DTSBU590
|
|
00829 DTSBU590
|
|
00830 MOVE MPRF-ELIGIBLE-CD TO L549-INIT-ELIGIBLE-CD. DTSBU590
|
|
00831 DTSBU590
|
|
00832 DTSBU590
|
|
00833 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBU590
|
|
00834 DTSBU590
|
|
00835 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBU590
|
|
00836 DTSBU590
|
|
00837 SET MPAY-PAY-88 TO TRUE. DTSBU590
|
|
00838 DTSBU590
|
|
00839 MOVE WRK-TOL-DOC-NO TO MPAY-DOC-NO. DTSBU590
|
|
00840 DTSBU590
|
|
00841 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00842 DTSBU590
|
|
00843 PERFORM S910-READ THRU S910-EXIT. DTSBU590
|
|
00844 DTSBU590
|
|
00845 IF L910-OK-88 DTSBU590
|
|
00846 MOVE MSKL-REC TO MPAY-REC DTSBU590
|
|
00847 PERFORM S1100-FROM-MPAY THRU S1100-EXIT DTSBU590
|
|
00848 GO TO S1000-EXIT. DTSBU590
|
|
00849 DTSBU590
|
|
00850 DTSBU590
|
|
00851 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBU590
|
|
00852 DTSBU590
|
|
00853 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBU590
|
|
00854 DTSBU590
|
|
00855 SET MADJ-ADJ-88 TO TRUE. DTSBU590
|
|
00856 DTSBU590
|
|
00857 MOVE WRK-TOL-DOC-NO TO MADJ-DOC-NO. DTSBU590
|
|
00858 DTSBU590
|
|
00859 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00860 DTSBU590
|
|
00861 PERFORM S910-READ THRU S910-EXIT. DTSBU590
|
|
00862 DTSBU590
|
|
00863 IF L910-OK-88 DTSBU590
|
|
00864 MOVE MSKL-REC TO MADJ-REC DTSBU590
|
|
00865 PERFORM S1200-FROM-MADJ THRU S1200-EXIT DTSBU590
|
|
00866 GO TO S1000-EXIT. DTSBU590
|
|
00867 DTSBU590
|
|
00868 DTSBU590
|
|
00869 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBU590
|
|
00870 DTSBU590
|
|
00871 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBU590
|
|
00872 DTSBU590
|
|
00873 SET MRPT-RPT-88 TO TRUE. DTSBU590
|
|
00874 DTSBU590
|
|
00875 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBU590
|
|
00876 DTSBU590
|
|
00877 MOVE 'N' TO RPT-FOUND-IND. DTSBU590
|
|
00878 DTSBU590
|
|
00879 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590
|
|
00880 DTSBU590
|
|
00881 PERFORM S1010-MRPT-SCAN THRU S1010-EXIT DTSBU590
|
|
00882 UNTIL (L910-NO-REC-88) DTSBU590
|
|
00883 OR DTSBU590
|
|
00884 (RPT-FOUND-IND = 'Y'). DTSBU590
|
|
00885 DTSBU590
|
|
00886 DTSBU590
|
|
00887 IF RPT-FOUND-IND = 'Y' DTSBU590
|
|
00888 PERFORM S1300-FROM-MRPT THRU S1300-EXIT DTSBU590
|
|
00889 ELSE DTSBU590
|
|
00890 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590
|
|
00891 S1000-EXIT. DTSBU590
|
|
00892 EXIT. DTSBU590
|
|
00893 SKIP3 DTSBU590
|
|
00894 S1010-MRPT-SCAN. DTSBU590
|
|
00895 MOVE MSKL-REC TO MRPT-REC. DTSBU590
|
|
00896 DTSBU590
|
|
00897 IF MRPT-DOC-NO = WRK-TOL-DOC-NO DTSBU590
|
|
00898 MOVE 'Y' TO RPT-FOUND-IND DTSBU590
|
|
00899 ELSE DTSBU590
|
|
00900 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU590
|
|
00901 S1010-EXIT. DTSBU590
|
|
00902 EXIT. DTSBU590
|
|
00903 SKIP3 DTSBU590
|
|
00904 S1100-FROM-MPAY. DTSBU590
|
|
00905 MOVE 'N' TO RPT-FOUND-IND. DTSBU590
|
|
00906 DTSBU590
|
|
00907 IF MPAY-APPLIC-YRQ > +0 DTSBU590
|
|
00908 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBU590
|
|
00909 MOVE MPRF-EMP-NO TO MRPT-EMP-NO DTSBU590
|
|
00910 SET MRPT-RPT-88 TO TRUE DTSBU590
|
|
00911 MOVE MPAY-APPLIC-YRQ TO MRPT-YRQ DTSBU590
|
|
00912 MOVE MPAY-DOC-NO TO MRPT-DOC-NO DTSBU590
|
|
00913 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA DTSBU590
|
|
00914 PERFORM S910-READ THRU S910-EXIT DTSBU590
|
|
00915 IF L910-OK-88 DTSBU590
|
|
00916 MOVE MSKL-REC TO MRPT-REC DTSBU590
|
|
00917 MOVE 'Y' TO RPT-FOUND-IND. DTSBU590
|
|
00918 DTSBU590
|
|
00919 IF RPT-FOUND-IND = 'Y' DTSBU590
|
|
00920 MOVE 'R' TO L549-INIT-REC-TYPE DTSBU590
|
|
00921 MOVE MRPT-RPT-TYPE TO L549-INIT-TRANS-TYPE DTSBU590
|
|
00922 ELSE DTSBU590
|
|
00923 MOVE 'P' TO L549-INIT-REC-TYPE DTSBU590
|
|
00924 MOVE MPAY-PAY-TYPE TO L549-INIT-TRANS-TYPE. DTSBU590
|
|
00925 DTSBU590
|
|
00926 MOVE MPAY-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE. DTSBU590
|
|
00927 DTSBU590
|
|
00928 MOVE MPAY-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE. DTSBU590
|
|
00929 DTSBU590
|
|
00930 MOVE MPAY-REMIT-AMT TO L549-INIT-REMIT-AMT. DTSBU590
|
|
00931 DTSBU590
|
|
00932 MOVE MPAY-WAIVE-INT-IND TO L549-INIT-WAIVE-INT-IND. DTSBU590
|
|
00933 DTSBU590
|
|
00934 MOVE MPAY-WAIVE-LATE-PEN-IND DTSBU590
|
|
00935 TO L549-INIT-WAIVE-LATE-PEN-IND. DTSBU590
|
|
00936 DTSBU590
|
|
00937 MOVE MPAY-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ. DTSBU590
|
|
00938 DTSBU590
|
|
00939 MOVE MPAY-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND. DTSBU590
|
|
00940 DTSBU590
|
|
00941 MOVE MPAY-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO. DTSBU590
|
|
00942 DTSBU590
|
|
00943 MOVE MPAY-RESPONSIBLE-ACTIVITY TO L549-INIT-RESP-ACTIVITY. DTSBU590
|
|
00944 DTSBU590
|
|
00945 MOVE MPAY-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBU590
|
|
00946 S1100-EXIT. DTSBU590
|
|
00947 EXIT. DTSBU590
|
|
00948 SKIP3 DTSBU590
|
|
00949 S1200-FROM-MADJ. DTSBU590
|
|
00950 MOVE 'A' TO L549-INIT-REC-TYPE. DTSBU590
|
|
00951 DTSBU590
|
|
00952 MOVE MADJ-ADJ-TYPE TO L549-INIT-TRANS-TYPE. DTSBU590
|
|
00953 DTSBU590
|
|
00954 MOVE MADJ-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE. DTSBU590
|
|
00955 DTSBU590
|
|
00956 MOVE MADJ-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE. DTSBU590
|
|
00957 DTSBU590
|
|
00958 MOVE +0 TO L549-INIT-REMIT-AMT. DTSBU590
|
|
00959 DTSBU590
|
|
00960 MOVE SPACE TO L549-INIT-WAIVE-INT-IND DTSBU590
|
|
00961 L549-INIT-WAIVE-LATE-PEN-IND. DTSBU590
|
|
00962 DTSBU590
|
|
00963 MOVE MADJ-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ. DTSBU590
|
|
00964 DTSBU590
|
|
00965 MOVE MADJ-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND. DTSBU590
|
|
00966 DTSBU590
|
|
00967 MOVE MADJ-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO. DTSBU590
|
|
00968 DTSBU590
|
|
00969 MOVE MADJ-RESPONSIBLE-ACTIVITY TO L549-INIT-RESP-ACTIVITY. DTSBU590
|
|
00970 DTSBU590
|
|
00971 MOVE MADJ-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBU590
|
|
00972 S1200-EXIT. DTSBU590
|
|
00973 EXIT. DTSBU590
|
|
00974 SKIP3 DTSBU590
|
|
00975 S1300-FROM-MRPT. DTSBU590
|
|
00976 MOVE 'R' TO L549-INIT-REC-TYPE. DTSBU590
|
|
00977 DTSBU590
|
|
00978 MOVE MRPT-RPT-TYPE TO L549-INIT-TRANS-TYPE. DTSBU590
|
|
00979 DTSBU590
|
|
00980 MOVE MRPT-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE. DTSBU590
|
|
00981 DTSBU590
|
|
00982 MOVE MRPT-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE. DTSBU590
|
|
00983 DTSBU590
|
|
00984 MOVE +0 TO L549-INIT-REMIT-AMT. DTSBU590
|
|
00985 DTSBU590
|
|
00986 MOVE 'N' TO L549-INIT-WAIVE-INT-IND DTSBU590
|
|
00987 L549-INIT-WAIVE-LATE-PEN-IND. DTSBU590
|
|
00988 DTSBU590
|
|
00989 MOVE MRPT-YRQ TO L549-INIT-APPLIC-YRQ. DTSBU590
|
|
00990 DTSBU590
|
|
00991 MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND. DTSBU590
|
|
00992 DTSBU590
|
|
00993 MOVE WRK-NULL-DOC-NO TO L549-INIT-APPLIC-DOC-NO. DTSBU590
|
|
00994 DTSBU590
|
|
00995 MOVE MRPT-RESPONSIBLE-ACTIVITY TO L549-INIT-RESP-ACTIVITY. DTSBU590
|
|
00996 DTSBU590
|
|
00997 MOVE MRPT-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBU590
|
|
00998 S1300-EXIT. DTSBU590
|
|
00999 EXIT. DTSBU590
|
|
01000 EJECT DTSBU590
|
|
01001 S2100-SELF-INS-BALANCE-AMT. DTSBU590
|
|
01002 MOVE +0 TO R424-BALANCE-AMT. DTSBU590
|
|
01003 DTSBU590
|
|
01004 IF MPRF-TOT-BALANCE-AMT = +0 DTSBU590
|
|
01005 GO TO S2100-EXIT. DTSBU590
|
|
01006 DTSBU590
|
|
01007 DTSBU590
|
|
01008 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBU590
|
|
01009 DTSBU590
|
|
01010 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590
|
|
01011 DTSBU590
|
|
01012 SET MSKL-QTR-88 TO TRUE. DTSBU590
|
|
01013 DTSBU590
|
|
01014 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590
|
|
01015 DTSBU590
|
|
01016 PERFORM DTSBU590
|
|
01017 UNTIL L910-NO-REC-88 DTSBU590
|
|
01018 MOVE MSKL-REC TO MQTR-REC DTSBU590
|
|
01019 PERFORM S2110-PROCESS-MQTR THRU S2110-EXIT DTSBU590
|
|
01020 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590
|
|
01021 END-PERFORM. DTSBU590
|
|
01022 S2100-EXIT. DTSBU590
|
|
01023 EXIT. DTSBU590
|
|
01024 SKIP3 DTSBU590
|
|
01025 S2110-PROCESS-MQTR. DTSBU590
|
|
01026 PERFORM DTSBU590
|
|
01027 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590
|
|
01028 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBU590
|
|
01029 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBU590
|
|
01030 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590
|
|
01031 TO R424-BALANCE-AMT DTSBU590
|
|
01032 END-IF DTSBU590
|
|
01033 END-PERFORM. DTSBU590
|
|
01034 S2110-EXIT. DTSBU590
|
|
01035 EXIT. DTSBU590
|
|
01036 EJECT DTSBU590
|
|
01037 S061-FLD-REP-LOOKUP. DTSBU590
|
|
01038 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBU590
|
|
01039 S061-EXIT. DTSBU590
|
|
01040 EXIT. DTSBU590
|
|
01041 SKIP3 DTSBU590
|
|
01042 S541-MQTR-AMT. DTSBU590
|
|
01043 CALL 'DTSBU541' USING L541-LINK-AREA DTSBU590
|
|
01044 MPRF-REC DTSBU590
|
|
01045 MQTR-REC. DTSBU590
|
|
01046 S541-EXIT. DTSBU590
|
|
01047 EXIT. DTSBU590
|
|
01048 SKIP3 DTSBU590
|
|
01049 S542-MDST-AMT. DTSBU590
|
|
01050 CALL 'DTSBU542' USING L542-LINK-AREA DTSBU590
|
|
01051 MPRF-REC DTSBU590
|
|
01052 MDST-REC. DTSBU590
|
|
01053 S542-EXIT. DTSBU590
|
|
01054 EXIT. DTSBU590
|
|
01055 SKIP3 DTSBU590
|
|
01056 S549-INIT-TRAN. DTSBU590
|
|
01057 SET L549-INIT-TRAN-88 TO TRUE. DTSBU590
|
|
01058 GO TO S549-MJRN-TABLE. DTSBU590
|
|
01059 DTSBU590
|
|
01060 S549-TERM-TRAN-SEC. DTSBU590
|
|
01061 SET L549-TERM-TRAN-SEC-88 TO TRUE. DTSBU590
|
|
01062 GO TO S549-MJRN-TABLE. DTSBU590
|
|
01063 DTSBU590
|
|
01064 S549-MJRN-TABLE. DTSBU590
|
|
01065 CALL 'DTSBU549' USING L549-LINK-AREA. DTSBU590
|
|
01066 S549-EXIT. DTSBU590
|
|
01067 EXIT. DTSBU590
|
|
01068 SKIP3 DTSBU590
|
|
01069 S910-READ. DTSBU590
|
|
01070 SET L910-READ-88 TO TRUE. DTSBU590
|
|
01071 GO TO S910-MSTR-IO. DTSBU590
|
|
01072 DTSBU590
|
|
01073 S910-START-BROWSE. DTSBU590
|
|
01074 SET L910-START-BROWSE-88 TO TRUE. DTSBU590
|
|
01075 GO TO S910-MSTR-IO. DTSBU590
|
|
01076 DTSBU590
|
|
01077 S910-READ-NEXT. DTSBU590
|
|
01078 SET L910-READ-NEXT-88 TO TRUE. DTSBU590
|
|
01079 GO TO S910-MSTR-IO. DTSBU590
|
|
01080 DTSBU590
|
|
01081 *S910-COUNT. DTSBU590
|
|
01082 *****SET L910-COUNT-88 TO TRUE. DTSBU590
|
|
01083 *****GO TO S910-MSTR-IO. DTSBU590
|
|
01084 DTSBU590
|
|
01085 *S910-WRITE. DTSBU590
|
|
01086 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU590
|
|
01087 *****SET L910-WRITE-88 TO TRUE. DTSBU590
|
|
01088 *****GO TO S910-MSTR-IO. DTSBU590
|
|
01089 DTSBU590
|
|
01090 S910-REWRITE. DTSBU590
|
|
01091 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU590
|
|
01092 SET L910-REWRITE-88 TO TRUE. DTSBU590
|
|
01093 GO TO S910-MSTR-IO. DTSBU590
|
|
01094 DTSBU590
|
|
01095 *S910-DELETE. DTSBU590
|
|
01096 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU590
|
|
01097 *****SET L910-DELETE-88 TO TRUE. DTSBU590
|
|
01098 *****GO TO S910-MSTR-IO. DTSBU590
|
|
01099 DTSBU590
|
|
01100 S910-MSTR-IO. DTSBU590
|
|
01101 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU590
|
|
01102 MSKL-REC. DTSBU590
|
|
01103 S910-EXIT. DTSBU590
|
|
01104 EXIT. DTSBU590
|
|
01105 SKIP3 DTSBU590
|
|
01106 S946-RSKL-WRITE. DTSBU590
|
|
01107 CALL 'DTSBU946' USING RSKL-REC. DTSBU590
|
|
01108 S946-EXIT. DTSBU590
|
|
01109 EXIT. DTSBU590
|
|
01110 SKIP3 DTSBU590
|
|
01111 S999-ABEND. DTSBU590
|
|
01112 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU590
|
|
01113 S999-EXIT. DTSBU590
|
|
01114 EXIT. DTSBU590
|