00001 IDENTIFICATION DIVISION. 08/28/02 00002 PROGRAM-ID. DESBD410. DESBD410 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. MARCH 2001. DESBD410 00005 DATE-COMPILED. DESBD410 00006 SKIP3 DESBD410 00007 ***** DESBD410 00008 * DESBD410 00009 * FUNCTION: ELECTRONIC MEDIA TRACKING DESBD410 00010 * PERIODIC REPORT EXTRACT DESBD410 00011 * FROM ACTIVE LOG RECORDS DESBD410 00012 * DESBD410 00013 * DESBD410 00014 * MODIFICATION LOG: DESBD410 00015 * DESBD410 00016 * 03/15/2018 MODIFIED FROM DTSBR400. DESBD410 00017 * REFERENCE: DC DEVELOPMENT PROGRAMMER: GD DESBD410 00018 * DESBD410 00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD410 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD410 00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD410 00022 * DESBD410 00023 * DESBD410 00024 * DESCRIPTION: DESBD410 00025 * DESBD410 00026 * INITIATION. DESBD410 00027 * DESBD410 00028 * PROCESS PARAMETERS INPUT VIA LINKAGE (IN PARM-AREA). DESBD410 00029 * DESBD410 00030 * DESBD410 00031 * READ THE PARM-FILE UNTIL PARM-EOF. ONE TO FIFTY PARM DESBD410 00032 * RECORDS WILL BE INPUT. DESBD410 00033 * DESBD410 00034 * DISPLAY EACH PARM RECORD. DESBD410 00035 * DESBD410 00036 * EACH PARM RECORD INDICATES AN EXTRACT MODULE TO BE CALLED DESBD410 00037 * DURING THIS PARTICULAR RUN, AND CONTAINS ANY EXTRACT DESBD410 00038 * MODULE SPECIFIC PARAMETERS. DESBD410 00039 * DESBD410 00040 * TABLE PARM RECORDS 1 THRU N IN WRK-EXTRACT-AREA. DESBD410 00041 * DESBD410 00042 * THE SAME WRK-EXTRACT-ID VALUE IN MULTIPLE OCCURRENCES OF DESBD410 00043 * WRK-EXTRACT-AREA IS NOT ALLOWED. IF THIS CONDITION DESBD410 00044 * OCCURS, THEN ABEND THE MODULE. DESBD410 00045 * DESBD410 00046 * MAKE AN 'INITIALIZATION' CALL TO EACH OF THE EXTRACT DESBD410 00047 * MODULES TABLED IN WRK-EXTRACT-AREA. SAVE THE HIGHEST DESBD410 00048 * VALUE RETURNED IN LECM-OPEN-MST-IND AND SAVE THE DESBD410 00049 * HIGHEST VALUE RETURNED IN LECM-OPEN-REF-IND. DESBD410 00050 * DESBD410 00051 * OPEN THE MASTER FILE, ALTERNATE INDEX FILE AND DESBD410 00052 * REFERENCE FILE WITH THE OPEN COMMAND (READ ONLY DESBD410 00053 * OR UPDATE) AS INDICATED BY THE INFORMATION RETURNED DESBD410 00054 * BY THE "INITIALIZATION" CALLS. DESBD410 00055 * DESBD410 00056 * DESBD410 00057 * READ THE MHDR RECORD. DESBD410 00058 * DESBD410 00059 * IF L910-NO-REC-88 DESBD410 00060 * ABEND THE MODULE. DESBD410 00061 * DESBD410 00062 * INITIALIZE THE LECM FIELDS. DESBD410 00063 * DESBD410 00064 * SET LECM-PROCESS-88 TO TRUE. DESBD410 00065 * DESBD410 00066 * SET L921 TO BROWSE ACTIVE LOG RECORDS THROUGH THE DESBD410 00067 * IEAL AIX RECORD. DESBD410 00068 * DESBD410 00069 * MOVE +0 TO WRK-ELOG-CNT. DESBD410 00070 * DESBD410 00071 * DESBD410 00072 * DESBD410 00073 * PROCESSING. DESBD410 00074 * DESBD410 00075 * PERFORM P1000-READ-NEXT DESBD410 00076 * UNTIL L921-NO-REC-88. DESBD410 00077 * DESBD410 00078 * P1000-READ-NEXT. DESBD410 00079 * READ THE NEXT IEAL RECORD. DESBD410 00080 * IF L921-OK-88 DESBD410 00081 * READ THE ELOG RECORD DESBD410 00082 * IF L935-OK-88 DESBD410 00083 * ADD +1 TO WRK-ELOG-CNT DESBD410 00084 * PERFORM S1000-CALL-EXTRACT DESBD410 00085 * VARYING WRK-EXT-IDX FROM 1 BY 1 DESBD410 00086 * UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DESBD410 00087 * DESBD410 00088 * S1000-CALL-EXTRACT. DESBD410 00089 * MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX) DESBD410 00090 * TO LECM-EXTRACT-PARMS. DESBD410 00091 * DESBD410 00092 * CALL 'DESBE***' USING LECM-LINK-AREA DESBD410 00093 * EPRF-REC DESBD410 00094 * ELOG-REC DESBD410 00095 * DESBD410 00096 * IF NO EXTRACT MODULE CORRESPONDING TO WRK-EXTRACT-SUB DESBD410 00097 * EXISTS, THEN THE STEP ABENDS (MODULE NOT FOUND). DESBD410 00098 * DESBD410 00099 * DESBD410 00100 * DESBD410 00101 * TERMINATION. DESBD410 00102 * DESBD410 00103 * SET LECM-TERMINATE-88 TO TRUE. DESBD410 00104 * DESBD410 00105 * PERFORM S1000-CALL-EXTRACT DESBD410 00106 * VARYING WRK-EXT-IDX FROM 1 BY 1 DESBD410 00107 * UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DESBD410 00108 * DESBD410 00109 * DISPLAY TERMINATION STATISTICS (VARIOUS LECM FIELDS AND DESBD410 00110 * WRK-ELOG-CNT. DESBD410 00111 * DESBD410 00112 * CLOSE TAX MASTER FILE. DESBD410 00113 * CLOSE ELECTRONIC MEDIA FILES. DESBD410 00114 * CLOSE ALTERNATE INDEX FILE. DESBD410 00115 * CLOSE REFERENCE FILE. DESBD410 00116 * CLOSE REPORT RECORD FILE. DESBD410 00117 * DESBD410 00118 * SET RETURN-CODE TO 0. DESBD410 00119 * DESBD410 00120 ***** DESBD410 00121 SKIP3 DESBD410 00122 ENVIRONMENT DIVISION. DESBD410 00123 SKIP2 DESBD410 00124 INPUT-OUTPUT SECTION. DESBD410 00125 DESBD410 00126 FILE-CONTROL. DESBD410 00127 SELECT PARM-FILE ASSIGN TO SYSIN. DESBD410 00128 EJECT DESBD410 00129 DATA DIVISION. DESBD410 00130 SKIP3 DESBD410 00131 FILE SECTION. DESBD410 00132 SKIP2 DESBD410 00133 FD PARM-FILE DESBD410 00134 RECORDING MODE IS F DESBD410 00135 BLOCK CONTAINS 0 RECORDS. DESBD410 00136 DESBD410 00137 01 PARM-REC. DESBD410 00138 10 PREC-EXTRACT-ID PIC X(03). DESBD410 00139 10 FILLER PIC X(01). DESBD410 00140 10 PREC-EXTRACT-PARMS PIC X(68). DESBD410 00141 10 FILLER PIC X(08). DESBD410 00142 EJECT DESBD410 00143 WORKING-STORAGE SECTION. DESBD410 001435 77 PAN-VALET PICTURE X(24) VALUE '001DESBD410 08/28/02'. DESBD410 00144 SKIP3 DESBD410 00145 01 WRK-AREA. DESBD410 00146 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +410.DESBD410 00147 DESBD410 00148 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD410'.DESBD410 00149 DESBD410 00150 05 WRK-ELOG-CNT PIC S9(07) COMP-3. DESBD410 00151 DESBD410 00152 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DESBD410 00153 DESBD410 00154 05 PARM-REC-CNT PIC S9(07) COMP-3. DESBD410 00155 DESBD410 00156 05 HOLD-EXTRACT-SUB PIC S9(04) COMP. DESBD410 00157 DESBD410 00158 05 WRK-SUB PIC S9(04) COMP. DESBD410 00159 DESBD410 00160 05 PARM-EOF-IND PIC X(01). DESBD410 00161 DESBD410 00162 05 WRK-RUN-TYPE PIC X(02). DESBD410 00163 DESBD410 00164 05 WRK-PRE-BACKUP-IND PIC X(01). DESBD410 00165 DESBD410 00166 05 WRK-ONLY-CHECK-PARM-IND PIC X(01). DESBD410 00167 DESBD410 00168 05 WRK-TRACE-IND PIC X(01). DESBD410 00169 DESBD410 00170 05 WRK-CUTOFF-DATE PIC S9(09) COMP-3. DESBD410 00171 88 WRK-CUTOFF-DATE-NULL-88 VALUE +0. DESBD410 00172 DESBD410 00173 05 WRK-MST-OPEN-IND PIC X(01). DESBD410 00174 DESBD410 00175 05 WRK-REF-OPEN-IND PIC X(01). DESBD410 00176 DESBD410 00177 *****05 WRK-BTC-IND PIC X(01). DESBD410 00178 DESBD410 00179 05 WRK-LOG-UPDATED-IND PIC X(01). DESBD410 00180 88 WRK-LOG-UPDATED-NO-88 VALUE 'N'. DESBD410 00181 88 WRK-LOG-UPDATED-YES-88 VALUE 'Y'. DESBD410 00182 SKIP3 DESBD410 00183 05 WRK-EXTRACT-CNT PIC S9(04) COMP. DESBD410 00184 DESBD410 00185 05 WRK-EXTRACT-AREA OCCURS 50 TIMES DESBD410 00186 INDEXED BY WRK-EXT-IDX. DESBD410 00187 10 WRK-EXTRACT-ID PIC X(03). DESBD410 00188 10 WRK-EXTRACT-PARMS PIC X(68). DESBD410 00189 SKIP3 DESBD410 00190 05 WRK-START-ABSTIME PIC S9(15) COMP-3. DESBD410 00191 DESBD410 00192 05 WRK-STEP-DURATION-X PIC X(09). DESBD410 00193 05 WRK-STEP-DURATION REDEFINES WRK-STEP-DURATION-X DESBD410 00194 PIC ZZ,ZZ9.99. DESBD410 00195 SKIP3 DESBD410 00196 05 EXTRACT-MOD-NAME. DESBD410 00197 10 FILLER PIC X(05) VALUE 'DESBE'. DESBD410 00198 10 EXTRACT-MOD-ID PIC X(03). DESBD410 00199 EJECT DESBD410 00200 01 MSG-TABLE. DESBD410 00201 05 MSG1-UPDATE-LOCKED-EMP. DESBD410 00202 10 MSG1-ID PIC X(03) VALUE '991'. DESBD410 00203 10 MSG1-TEXT. DESBD410 00204 15 FILLER PIC X(30) DESBD410 00205 VALUE 'DESPITE BEING LOCKED AGAINST U'. DESBD410 00206 15 FILLER PIC X(30) DESBD410 00207 VALUE 'PDATE, A PERIODIC EXTRACT PROC'. DESBD410 00208 15 FILLER PIC X(05) DESBD410 00209 VALUE 'ESS ('. DESBD410 00210 15 MSG1-EXTRACT-ID PIC X(03). DESBD410 00211 15 FILLER PIC X(31) DESBD410 00212 VALUE ') UPDATED THE EMPLOYERS RECORDS'. DESBD410 00213 EJECT DESBD410 00214 01 LECM-LINK-AREA. DESBD410 00215 ++INCLUDE DTSILECM DESBD410 00216 EJECT DESBD410 00217 01 L910-LINK-AREA. DESBD410 00218 ++INCLUDE DTSIL910 DESBD410 00219 EJECT DESBD410 00220 01 MSKL-REC. DESBD410 00221 ++INCLUDE DTSIMSKL DESBD410 00222 EJECT DESBD410 00223 01 MHDR-REC REDEFINES MSKL-REC. DESBD410 00224 ++INCLUDE DTSIMHDR DESBD410 00225 EJECT DESBD410 00226 01 MPRF-REC REDEFINES MSKL-REC. DESBD410 00227 ++INCLUDE DTSIMPRF DESBD410 00228 EJECT DESBD410 00229 01 L921-LINK-AREA. DESBD410 00230 ++INCLUDE DTSIL921 DESBD410 00231 EJECT DESBD410 00232 01 ISKL-REC. DESBD410 00233 ++INCLUDE DTSIISKL DESBD410 00234 EJECT DESBD410 00235 01 IEAL-REC. DESBD410 00236 ++INCLUDE DTSIIEAL DESBD410 00237 EJECT DESBD410 00238 01 L935-LINK-AREA. DESBD410 00239 ++INCLUDE DTSIL935 DESBD410 00240 EJECT DESBD410 00241 01 ESKL-REC. DESBD410 00242 ++INCLUDE DTSIESKL DESBD410 00243 EJECT DESBD410 00244 01 EPRF-REC. DESBD410 00245 ++INCLUDE DTSIEPRF DESBD410 00246 EJECT DESBD410 00247 01 ELOG-REC. DESBD410 00248 ++INCLUDE DTSIELOG DESBD410 00249 EJECT DESBD410 00250 01 L927-LINK-AREA. DESBD410 00251 ++INCLUDE DTSIL927 DESBD410 00252 EJECT DESBD410 00253 01 RSKL-REC. DESBD410 00254 ++INCLUDE DTSIRSK1 DESBD410 00255 SKIP3 DESBD410 00256 01 R907-REC. DESBD410 00257 ++INCLUDE DTSIR907 DESBD410 00258 EJECT DESBD410 00259 01 L931-LINK-AREA. DESBD410 00260 ++INCLUDE DTSIL931 DESBD410 00261 EJECT DESBD410 00262 01 FSKL-REC. DESBD410 00263 ++INCLUDE DTSIFSKL DESBD410 00264 EJECT DESBD410 00265 01 L001-LINK-AREA. DESBD410 00266 ++INCLUDE DTSIL001 DESBD410 00267 EJECT DESBD410 00268 01 L005-LINK-AREA. DESBD410 00269 ++INCLUDE DTSIL005 DESBD410 00270 EJECT DESBD410 00271 LINKAGE SECTION. DESBD410 00272 SKIP3 DESBD410 00273 01 PARM-AREA. DESBD410 00274 05 PARM-LENGTH PIC S9(04) COMP. DESBD410 00275 05 PARM-DATA. DESBD410 00276 10 PARM-RUN-TYPE PIC X(02). DESBD410 00277 10 FILLER PIC X(01). DESBD410 00278 10 PARM-PRE-BACKUP-IND PIC X(01). DESBD410 00279 10 FILLER PIC X(01). DESBD410 00280 10 PARM-ONLY-CHECK-PARM-IND PIC X(01). DESBD410 00281 10 FILLER PIC X(01). DESBD410 00282 10 PARM-TRACE-IND PIC X(01). DESBD410 00283 10 FILLER PIC X(01). DESBD410 00284 10 PARM-CUTOFF-DATE PIC X(06). DESBD410 00285 EJECT DESBD410 00286 PROCEDURE DIVISION USING PARM-AREA. DESBD410 00287 SKIP2 DESBD410 00288 PERFORM I0000-INITIATE THRU I0000-EXIT. DESBD410 00289 DESBD410 00290 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DESBD410 00291 NEXT SENTENCE DESBD410 00292 ELSE DESBD410 00293 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD410 00294 DESBD410 00295 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD410 00296 SKIP2 DESBD410 00297 GOBACK. DESBD410 00298 EJECT DESBD410 00299 I0000-INITIATE. DESBD410 00300 SKIP2 DESBD410 00301 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DESBD410 00302 DESBD410 00303 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DESBD410 00304 DESBD410 00305 PERFORM I3000-INITIALIZE-WRK THRU I3000-EXIT. DESBD410 00306 DESBD410 00307 PERFORM I4000-INITIAL-CALLS THRU I4000-EXIT. DESBD410 00308 DESBD410 00309 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DESBD410 00310 NEXT SENTENCE DESBD410 00311 ELSE DESBD410 00312 PERFORM I5000-OPEN-FILES-2 THRU I5000-EXIT. DESBD410 00313 DESBD410 00314 PERFORM I6000-RERUN-INSTRUCTIONS THRU I6000-EXIT. DESBD410 00315 SKIP2 DESBD410 00316 I0000-EXIT. DESBD410 00317 EXIT. DESBD410 00318 EJECT DESBD410 00319 I1000-PROCESS-PARMS. DESBD410 00320 DISPLAY ' '. DESBD410 00321 DESBD410 00322 DISPLAY '*** DESBD410 PARAMETERS'. DESBD410 00323 DESBD410 00324 DESBD410 00325 IF PARM-LENGTH = +15 DESBD410 00326 NEXT SENTENCE DESBD410 00327 ELSE DESBD410 00328 DISPLAY 'PARM LENGTH NOT EQUAL TO FIFTEEN' DESBD410 00329 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00330 DESBD410 00331 DESBD410 00332 IF PARM-PRE-BACKUP-IND = SPACES DESBD410 00333 MOVE 'N' TO WRK-PRE-BACKUP-IND DESBD410 00334 ELSE DESBD410 00335 IF PARM-PRE-BACKUP-IND = 'Y' OR 'N' DESBD410 00336 MOVE PARM-PRE-BACKUP-IND DESBD410 00337 TO WRK-PRE-BACKUP-IND DESBD410 00338 ELSE DESBD410 00339 DISPLAY 'PARM PRE BACKUP IND = ' DESBD410 00340 PARM-PRE-BACKUP-IND DESBD410 00341 ' IS NOT A VALID VALUE' DESBD410 00342 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00343 DESBD410 00344 DESBD410 00345 IF PARM-RUN-TYPE = SPACES DESBD410 00346 MOVE 'OR' TO WRK-RUN-TYPE DESBD410 00347 ELSE DESBD410 00348 IF PARM-RUN-TYPE = 'WE' OR 'MC' OR 'ME' OR 'QR' OR 'QP' DESBD410 00349 OR 'QD' DESBD410 00350 OR 'QE' OR 'QF' OR 'YE' OR 'OR' DESBD410 00351 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DESBD410 00352 ELSE DESBD410 00353 DISPLAY 'PARM RUN TYPE = ' DESBD410 00354 PARM-RUN-TYPE DESBD410 00355 ' IS NOT A VALID RUN TYPE' DESBD410 00356 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00357 DESBD410 00358 DESBD410 00359 IF PARM-ONLY-CHECK-PARM-IND = SPACES DESBD410 00360 MOVE 'N' TO WRK-ONLY-CHECK-PARM-IND DESBD410 00361 ELSE DESBD410 00362 IF PARM-ONLY-CHECK-PARM-IND = 'Y' OR 'N' DESBD410 00363 MOVE PARM-ONLY-CHECK-PARM-IND DESBD410 00364 TO WRK-ONLY-CHECK-PARM-IND DESBD410 00365 ELSE DESBD410 00366 DISPLAY 'PARM ONLY CHECK PARM IND = ' DESBD410 00367 PARM-ONLY-CHECK-PARM-IND DESBD410 00368 ' IS NOT A VALID VALUE' DESBD410 00369 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00370 DESBD410 00371 DESBD410 00372 IF PARM-TRACE-IND = SPACES DESBD410 00373 MOVE 'N' TO WRK-TRACE-IND DESBD410 00374 ELSE DESBD410 00375 MOVE PARM-TRACE-IND TO WRK-TRACE-IND. DESBD410 00376 DESBD410 00377 IF PARM-CUTOFF-DATE = SPACES DESBD410 00378 SET WRK-CUTOFF-DATE-NULL-88 TO TRUE DESBD410 00379 ELSE DESBD410 00380 MOVE PARM-CUTOFF-DATE TO L001-CAL-6-DATE-X DESBD410 00381 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DESBD410 00382 IF L001-VALID-DATE DESBD410 00383 MOVE L001-FED-8-DATE-9 TO WRK-CUTOFF-DATE DESBD410 00384 ELSE DESBD410 00385 DISPLAY 'PARM CUTOFF DATE = ' DESBD410 00386 PARM-CUTOFF-DATE DESBD410 00387 ' IS NOT A VALID VALUE' DESBD410 00388 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00389 DESBD410 00390 DISPLAY ' '. DESBD410 00391 DESBD410 00392 DISPLAY ' RUN TYPE: ' DESBD410 00393 WRK-RUN-TYPE. DESBD410 00394 DESBD410 00395 DISPLAY ' PRE-BACKUP IND: ' DESBD410 00396 WRK-PRE-BACKUP-IND. DESBD410 00397 DESBD410 00398 DISPLAY 'ONLY CHECK PARM: ' DESBD410 00399 WRK-ONLY-CHECK-PARM-IND. DESBD410 00400 DESBD410 00401 DISPLAY 'TRACE INDICATOR: ' DESBD410 00402 WRK-TRACE-IND. DESBD410 00403 DESBD410 00404 DISPLAY ' '. DESBD410 00405 DESBD410 00406 DESBD410 00407 OPEN INPUT PARM-FILE. DESBD410 00408 DESBD410 00409 MOVE 'N' TO PARM-EOF-IND. DESBD410 00410 DESBD410 00411 MOVE +0 TO PARM-REC-CNT. DESBD410 00412 DESBD410 00413 MOVE +0 TO WRK-EXTRACT-CNT. DESBD410 00414 DESBD410 00415 PERFORM I1100-READ-PARM THRU I1100-EXIT DESBD410 00416 UNTIL PARM-EOF-IND = 'Y'. DESBD410 00417 DESBD410 00418 IF PARM-REC-CNT < 1 OR > 50 DESBD410 00419 DISPLAY 'MORE THAN 50 PARAMETER RECORDS IS NOT VALID' DESBD410 00420 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00421 DESBD410 00422 CLOSE PARM-FILE. DESBD410 00423 I1000-EXIT. DESBD410 00424 EXIT. DESBD410 00425 EJECT DESBD410 00426 I1100-READ-PARM. DESBD410 00427 READ PARM-FILE DESBD410 00428 AT END DESBD410 00429 MOVE 'Y' TO PARM-EOF-IND DESBD410 00430 GO TO I1100-EXIT. DESBD410 00431 DESBD410 00432 DESBD410 00433 DISPLAY '*** ' DESBD410 00434 PARM-REC. DESBD410 00435 DESBD410 00436 DESBD410 00437 IF PREC-EXTRACT-ID = '***' DESBD410 00438 GO TO I1100-EXIT. DESBD410 00439 DESBD410 00440 DESBD410 00441 ADD +1 TO PARM-REC-CNT. DESBD410 00442 DESBD410 00443 PERFORM I1200-LOAD-PARM-TABLE THRU I1200-EXIT. DESBD410 00444 I1100-EXIT. DESBD410 00445 EXIT. DESBD410 00446 EJECT DESBD410 00447 I1200-LOAD-PARM-TABLE. DESBD410 00448 IF WRK-EXTRACT-CNT > 0 DESBD410 00449 PERFORM I1250-DUP-EXTRACT-ID-CHECK THRU I1250-EXIT DESBD410 00450 VARYING WRK-SUB FROM 1 BY 1 DESBD410 00451 UNTIL WRK-SUB > WRK-EXTRACT-CNT. DESBD410 00452 DESBD410 00453 ADD +1 TO WRK-EXTRACT-CNT. DESBD410 00454 DESBD410 00455 IF WRK-EXTRACT-CNT > 50 DESBD410 00456 DISPLAY 'MORE THAN 50 EXTRACT ID CODES INVALID' DESBD410 00457 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00458 DESBD410 00459 MOVE PREC-EXTRACT-ID DESBD410 00460 TO WRK-EXTRACT-ID (WRK-EXTRACT-CNT). DESBD410 00461 DESBD410 00462 MOVE PREC-EXTRACT-PARMS DESBD410 00463 TO WRK-EXTRACT-PARMS (WRK-EXTRACT-CNT). DESBD410 00464 I1200-EXIT. DESBD410 00465 EXIT. DESBD410 00466 EJECT DESBD410 00467 I1250-DUP-EXTRACT-ID-CHECK. DESBD410 00468 IF PREC-EXTRACT-ID = WRK-EXTRACT-ID (WRK-SUB) DESBD410 00469 DISPLAY 'DUPLICATE EXTRACT ID CODES INVALID ' DESBD410 00470 WRK-EXTRACT-ID (WRK-SUB) DESBD410 00471 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00472 I1250-EXIT. DESBD410 00473 EXIT. DESBD410 00474 EJECT DESBD410 00475 I2000-OPEN-FILES-1. DESBD410 00476 MOVE WRK-TRACE-IND TO L910-TRACE-IND DESBD410 00477 L921-TRACE-IND DESBD410 00478 L927-TRACE-IND DESBD410 00479 L931-TRACE-IND DESBD410 00480 L935-TRACE-IND. DESBD410 00481 DESBD410 00482 MOVE WRK-MOD-NAME TO L910-MOD-NAME DESBD410 00483 L921-MOD-NAME DESBD410 00484 L927-MOD-NAME DESBD410 00485 L931-MOD-NAME DESBD410 00486 L935-MOD-NAME. DESBD410 00487 DESBD410 00488 PERFORM S910-OPEN-READ THRU S910-EXIT. DESBD410 00489 DESBD410 00490 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD410 00491 DESBD410 00492 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DESBD410 00493 DESBD410 00494 PERFORM S931-OPEN-READ THRU S931-EXIT. DESBD410 00495 DESBD410 00496 PERFORM S935-OPEN-READ THRU S935-EXIT. DESBD410 00497 DESBD410 00498 MOVE LENGTH OF R907-REC TO R907-LENGTH. DESBD410 00499 I2000-EXIT. DESBD410 00500 EXIT. DESBD410 00501 EJECT DESBD410 00502 I3000-INITIALIZE-WRK. DESBD410 00503 MOVE LOW-VALUES TO MHDR-KEY-AREA. DESBD410 00504 DESBD410 00505 MOVE +0 TO MHDR-EMP-NO. DESBD410 00506 DESBD410 00507 SET MHDR-HDR-88 TO TRUE. DESBD410 00508 DESBD410 00509 PERFORM S910-READ THRU S910-EXIT. DESBD410 00510 DESBD410 00511 IF L910-NO-REC-88 DESBD410 00512 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00513 DESBD410 00514 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD410 00515 DESBD410 00516 MOVE L005-ABSTIME TO WRK-START-ABSTIME. DESBD410 00517 DESBD410 00518 PERFORM I3100-INIT-LECM-PARMS THRU I3100-EXIT. DESBD410 00519 DESBD410 00520 PERFORM S910-CLOSE THRU S910-EXIT. DESBD410 00521 DESBD410 00522 MOVE +0 TO WRK-ELOG-CNT DESBD410 00523 WRK-UPDATED-CNT. DESBD410 00524 I3000-EXIT. DESBD410 00525 EXIT. DESBD410 00526 EJECT DESBD410 00527 I3100-INIT-LECM-PARMS. DESBD410 00528 MOVE WRK-RUN-TYPE TO LECM-RUN-TYPE. DESBD410 00529 DESBD410 00530 IF WRK-RUN-TYPE = 'WE' DESBD410 00531 MOVE MHDR-CMPL-WEEK-BEGIN-DATE TO LECM-PERIOD-START-DATE DESBD410 00532 MOVE MHDR-CMPL-WEEK-END-DATE TO LECM-PERIOD-END-DATE DESBD410 00533 ELSE DESBD410 00534 IF WRK-RUN-TYPE = 'MC' OR 'ME' DESBD410 00535 MOVE MHDR-CMPL-MONTH-BEGIN-DATE TO LECM-PERIOD-START-DATE DESBD410 00536 MOVE MHDR-CMPL-MONTH-END-DATE TO LECM-PERIOD-END-DATE DESBD410 00537 ELSE DESBD410 00538 IF WRK-RUN-TYPE = 'QR' OR 'QD' OR 'QE' OR 'QF' OR 'QP' DESBD410 00539 MOVE MHDR-CMPL-QTR-BEGIN-DATE TO LECM-PERIOD-START-DATE DESBD410 00540 MOVE MHDR-CMPL-QTR-END-DATE TO LECM-PERIOD-END-DATE DESBD410 00541 ELSE DESBD410 00542 IF WRK-RUN-TYPE = 'YE' DESBD410 00543 MOVE MHDR-CMPL-YEAR-BEGIN-DATE TO LECM-PERIOD-START-DATE DESBD410 00544 MOVE MHDR-CMPL-YEAR-END-DATE TO LECM-PERIOD-END-DATE DESBD410 00545 ELSE DESBD410 00546 MOVE +0 TO LECM-PERIOD-START-DATE DESBD410 00547 MOVE +0 TO LECM-PERIOD-END-DATE. DESBD410 00548 DESBD410 00549 MOVE L005-ABSTIME TO LECM-RUN-ABSTIME. DESBD410 00550 DESBD410 00551 MOVE L005-DATE TO LECM-SYS-DATE. DESBD410 00552 DESBD410 00553 MOVE L005-TIME TO LECM-SYS-TIME. DESBD410 00554 DESBD410 00555 MOVE MHDR-CURR-RUN-DATE TO LECM-CURR-RUN-DATE. DESBD410 00556 DESBD410 00557 MOVE MHDR-CURR-MAIL-DATE TO LECM-CURR-MAIL-DATE. DESBD410 00558 DESBD410 00559 MOVE MHDR-PRIOR-RUN-DATE TO LECM-PRIOR-RUN-DATE. DESBD410 00560 DESBD410 00561 MOVE MHDR-PRIOR-MAIL-DATE TO LECM-PRIOR-MAIL-DATE. DESBD410 00562 DESBD410 00563 MOVE MHDR-LAST-UC30-MASS-MAIL-YRQ DESBD410 00564 TO LECM-LAST-UC30-MASS-MAIL-YRQ. DESBD410 00565 DESBD410 00566 MOVE MHDR-LAST-PEN-ASSESSED-YRQ DESBD410 00567 TO LECM-LAST-PEN-ASSESSED-YRQ. DESBD410 00568 DESBD410 00569 MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ DESBD410 00570 TO LECM-LAST-UC30-DEL-MAIL-YRQ. DESBD410 00571 DESBD410 00572 MOVE MHDR-FIRST-PURSUED-RPT-YRQ DESBD410 00573 TO LECM-FIRST-PURSUED-RPT-YRQ. DESBD410 00574 DESBD410 00575 MOVE MHDR-LAST-RATE-END-YRQ DESBD410 00576 TO LECM-LAST-RATE-END-YRQ. DESBD410 00577 DESBD410 00578 MOVE MHDR-LAST-MJRN-PURGE-DATE DESBD410 00579 TO LECM-LAST-MJRN-PURGE-DATE. DESBD410 00580 DESBD410 00581 MOVE +19924 TO LECM-PICKUP-YRQ. DESBD410 00582 DESBD410 00583 MOVE WRK-TRACE-IND TO LECM-TRACE-IND. DESBD410 00584 I3100-EXIT. DESBD410 00585 EXIT. DESBD410 00586 EJECT DESBD410 00587 I4000-INITIAL-CALLS. DESBD410 00588 SET LECM-INITIALIZE-88 TO TRUE. DESBD410 00589 DESBD410 00590 SET LECM-MST-OPEN-READ-88 TO TRUE. DESBD410 00591 DESBD410 00592 SET LECM-REF-OPEN-READ-88 TO TRUE. DESBD410 00593 DESBD410 00594 MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND. DESBD410 00595 DESBD410 00596 MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND. DESBD410 00597 DESBD410 00598 PERFORM I4100-EXTRACT-LOOP THRU I4100-EXIT DESBD410 00599 VARYING WRK-EXT-IDX FROM 1 BY 1 DESBD410 00600 UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DESBD410 00601 I4000-EXIT. DESBD410 00602 EXIT. DESBD410 00603 SKIP3 DESBD410 00604 I4100-EXTRACT-LOOP. DESBD410 00605 SET LECM-MST-OPEN-READ-88 TO TRUE. DESBD410 00606 DESBD410 00607 SET LECM-REF-OPEN-READ-88 TO TRUE. DESBD410 00608 DESBD410 00609 PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT. DESBD410 00610 DESBD410 00611 IF LECM-MST-OPEN-IND > WRK-MST-OPEN-IND DESBD410 00612 MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND. DESBD410 00613 DESBD410 00614 IF LECM-REF-OPEN-IND > WRK-REF-OPEN-IND DESBD410 00615 MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND. DESBD410 00616 I4100-EXIT. DESBD410 00617 EXIT. DESBD410 00618 EJECT DESBD410 00619 I5000-OPEN-FILES-2. DESBD410 00620 MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND. DESBD410 00621 DESBD410 00622 MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND. DESBD410 00623 DESBD410 00624 IF (LECM-MST-OPEN-UPDATE-HDR-88) DESBD410 00625 OR DESBD410 00626 (LECM-MST-OPEN-UPDATE-88) DESBD410 00627 IF WRK-PRE-BACKUP-IND = 'Y' DESBD410 00628 NEXT SENTENCE DESBD410 00629 ELSE DESBD410 00630 DISPLAY 'MASTER FILE UPDATING POSSIBLE ' DESBD410 00631 'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"' DESBD410 00632 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00633 DESBD410 00634 IF LECM-MST-OPEN-READ-88 DESBD410 00635 NEXT SENTENCE DESBD410 00636 ELSE DESBD410 00637 PERFORM S935-CLOSE THRU S935-EXIT DESBD410 00638 IF LECM-MST-OPEN-UPDATE-HDR-88 DESBD410 00639 PERFORM S935-OPEN-UPDATE-HDR THRU S935-EXIT DESBD410 00640 ELSE DESBD410 00641 IF LECM-MST-OPEN-UPDATE-88 DESBD410 00642 PERFORM S921-CLOSE THRU S921-EXIT DESBD410 00643 PERFORM S935-OPEN-UPDATE THRU S935-EXIT DESBD410 00644 PERFORM S921-OPEN-UPDATE THRU S921-EXIT DESBD410 00645 ELSE DESBD410 00646 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00647 DESBD410 00648 IF LECM-REF-OPEN-UPDATE-88 DESBD410 00649 IF WRK-PRE-BACKUP-IND = 'Y' DESBD410 00650 NEXT SENTENCE DESBD410 00651 ELSE DESBD410 00652 DISPLAY 'REFERENCE FILE UPDATING POSSIBLE ' DESBD410 00653 'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"' DESBD410 00654 PERFORM S999-ABEND THRU S999-EXIT. DESBD410 00655 DESBD410 00656 IF LECM-REF-OPEN-UPDATE-88 DESBD410 00657 PERFORM S931-CLOSE THRU S931-EXIT DESBD410 00658 PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DESBD410 00659 I5000-EXIT. DESBD410 00660 EXIT. DESBD410 00661 EJECT DESBD410 00662 I6000-RERUN-INSTRUCTIONS. DESBD410 00663 DISPLAY ' '. DESBD410 00664 DESBD410 00665 DISPLAY ' '. DESBD410 00666 DESBD410 00667 DISPLAY '****************************************' DESBD410 00668 '****************************************'. DESBD410 00669 DESBD410 00670 DISPLAY '** ' DESBD410 00671 ' **'. DESBD410 00672 DESBD410 00673 DISPLAY '** DESBD410 RERUN' DESBD410 00674 ' INSTRUCTIONS **'. DESBD410 00675 DESBD410 00676 DISPLAY '** ' DESBD410 00677 ' **'. DESBD410 00678 DESBD410 00679 DISPLAY '** IF DESBD410 ABENDS THEN: ' DESBD410 00680 ' **'. DESBD410 00681 DESBD410 00682 IF LECM-MST-OPEN-UPDATE-HDR-88 DESBD410 00683 DISPLAY '** ' DESBD410 00684 ' **' DESBD410 00685 DISPLAY '** RESTORE MASTER FILE HEADER R' DESBD410 00686 'ECORD PRIOR TO ATTEMPTING RERUN. **'. DESBD410 00687 DESBD410 00688 IF LECM-MST-OPEN-UPDATE-88 DESBD410 00689 DISPLAY '** ' DESBD410 00690 ' **' DESBD410 00691 DISPLAY '** RESTORE MASTER FILE PRIOR TO' DESBD410 00692 ' ATTEMPTING RERUN. **'. DESBD410 00693 DESBD410 00694 IF LECM-REF-OPEN-UPDATE-88 DESBD410 00695 DISPLAY '** ' DESBD410 00696 ' **' DESBD410 00697 DISPLAY '** RESTORE REFERENCE FILE PRIOR' DESBD410 00698 ' TO ATTEMPTING RERUN. **'. DESBD410 00699 DESBD410 00700 IF (LECM-MST-OPEN-UPDATE-HDR-88) DESBD410 00701 OR DESBD410 00702 (LECM-MST-OPEN-UPDATE-88) DESBD410 00703 OR DESBD410 00704 (LECM-REF-OPEN-UPDATE-88) DESBD410 00705 NEXT SENTENCE DESBD410 00706 ELSE DESBD410 00707 DISPLAY '** ' DESBD410 00708 ' **' DESBD410 00709 DISPLAY '** NO SPECIAL ACTIONS NEEDED. ' DESBD410 00710 ' **'. DESBD410 00711 DESBD410 00712 DISPLAY '** ' DESBD410 00713 ' **'. DESBD410 00714 DESBD410 00715 DISPLAY '****************************************' DESBD410 00716 '****************************************'. DESBD410 00717 DESBD410 00718 DISPLAY ' '. DESBD410 00719 DESBD410 00720 DISPLAY ' '. DESBD410 00721 I6000-EXIT. DESBD410 00722 EXIT. DESBD410 00723 EJECT DESBD410 00724 P0000-PROCESS. DESBD410 00725 SET LECM-PROCESS-88 TO TRUE. DESBD410 00726 DESBD410 00727 MOVE LOW-VALUES TO IEAL-KEY-AREA. DESBD410 00728 DESBD410 00729 MOVE ZERO TO IEAL-LOG-NO-SFX DESBD410 00730 IEAL-LOG-NO. DESBD410 00731 DESBD410 00732 SET IEAL-EAL-88 TO TRUE. DESBD410 00733 DESBD410 00734 MOVE IEAL-REC TO ISKL-REC. DESBD410 00735 DESBD410 00736 PERFORM S921-START-BROWSE THRU S921-EXIT. DESBD410 00737 DESBD410 00738 PERFORM P1000-READ-NEXT THRU P1000-EXIT DESBD410 00739 UNTIL L921-NO-REC-88. DESBD410 00740 P0000-EXIT. DESBD410 00741 EXIT. DESBD410 00742 EJECT DESBD410 00743 P1000-READ-NEXT. DESBD410 00744 MOVE ISKL-REC TO IEAL-REC. DESBD410 00745 DISPLAY 'BD410 ' IEAL-LOG-NO DESBD410 00746 ' ' IEAL-COMPLETE-DATE. DESBD410 00747 DESBD410 00748 IF WRK-CUTOFF-DATE-NULL-88 DESBD410 00749 NEXT SENTENCE DESBD410 00750 ELSE DESBD410 00751 IF IEAL-COMPLETE-DATE < WRK-CUTOFF-DATE DESBD410 00752 PERFORM S921-READ-NEXT THRU S921-EXIT DESBD410 00753 GO TO P1000-EXIT. DESBD410 00754 DESBD410 00755 MOVE LOW-VALUES TO ELOG-REC. DESBD410 00756 SET ELOG-LOG-88 TO TRUE. DESBD410 00757 MOVE IEAL-LOG-NO TO ELOG-LOG-NO DESBD410 00758 MOVE ELOG-KEY-AREA TO ESKL-KEY-AREA. DESBD410 00759 DESBD410 00760 PERFORM S935-READ THRU S935-EXIT. DESBD410 00761 IF L935-OK-88 DESBD410 00762 MOVE ESKL-REC TO ELOG-REC DESBD410 00763 ELSE DESBD410 00764 DISPLAY 'CANNOT READ LOG ' ELOG-LOG-NO DESBD410 00765 SET L921-NO-REC-88 TO TRUE DESBD410 00766 GO TO P1000-EXIT. DESBD410 00767 DESBD410 00768 MOVE LOW-VALUES TO EPRF-REC. DESBD410 00769 SET EPRF-PRF-88 TO TRUE. DESBD410 00770 MOVE ELOG-ELF-ID TO EPRF-ELF-ID. DESBD410 00771 MOVE ELOG-DATA-TYPE-CD TO EPRF-DATA-TYPE-CD. DESBD410 00772 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DESBD410 00773 DESBD410 00774 PERFORM S935-READ THRU S935-EXIT. DESBD410 00775 IF L935-OK-88 DESBD410 00776 MOVE ESKL-REC TO EPRF-REC DESBD410 00777 ELSE DESBD410 00778 DISPLAY 'CANNOT READ PRF ' EPRF-ELF-ID DESBD410 00779 SET L921-NO-REC-88 TO TRUE DESBD410 00780 GO TO P1000-EXIT. DESBD410 00781 DESBD410 00782 ADD +1 TO WRK-ELOG-CNT. DESBD410 00783 DESBD410 00784 SET WRK-LOG-UPDATED-NO-88 TO TRUE. DESBD410 00785 DESBD410 00786 MOVE LECM-RUN-ABSTIME TO LECM-EMP-ABSTIME. DESBD410 00787 DESBD410 00788 PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT DESBD410 00789 VARYING WRK-EXT-IDX FROM 1 BY 1 DESBD410 00790 UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DESBD410 00791 DESBD410 00792 IF WRK-LOG-UPDATED-YES-88 DESBD410 00793 PERFORM P1100-EMPLOYER-UPDATED THRU P1100-EXIT. DESBD410 00794 DESBD410 00795 PERFORM S921-READ-NEXT THRU S921-EXIT. DESBD410 00796 P1000-EXIT. DESBD410 00797 EXIT. DESBD410 00798 SKIP3 DESBD410 00799 P1100-EMPLOYER-UPDATED. DESBD410 00800 IF EPRF-UPD-ACTIVE-88 DESBD410 00801 NEXT SENTENCE DESBD410 00802 ELSE DESBD410 00803 MOVE LECM-RUN-ABSTIME TO EPRF-UPDATE-END-ABSTIME DESBD410 00804 MOVE +0 TO MPRF-UPDATE-TASK-ID DESBD410 00805 MOVE 'BATCH' TO EPRF-UPDATE-OP-ID DESBD410 00806 MOVE SPACES TO EPRF-UPDATE-TERMID DESBD410 00807 MOVE SPACES TO EPRF-UPDATE-NETNAME DESBD410 00808 MOVE LECM-SYS-DATE TO EPRF-UPDATE-START-DATE DESBD410 00809 MOVE LECM-SYS-TIME TO EPRF-UPDATE-START-TIME DESBD410 00810 MOVE SPACES TO EPRF-UPDATE-SCR-ID DESBD410 00811 EPRF-UPDATE-FUNCTION DESBD410 00812 MOVE LECM-CURR-RUN-DATE TO EPRF-CHNG-DATE. DESBD410 00813 DESBD410 00814 MOVE EPRF-REC TO ESKL-REC. DESBD410 00815 PERFORM S935-REWRITE THRU S935-EXIT. DESBD410 00816 DESBD410 00817 MOVE ELOG-REC TO ESKL-REC. DESBD410 00818 PERFORM S935-REWRITE THRU S935-EXIT. DESBD410 00819 DESBD410 00820 ADD +1 TO WRK-UPDATED-CNT. DESBD410 00821 P1100-EXIT. DESBD410 00822 EXIT. DESBD410 00823 EJECT DESBD410 00824 T0000-TERMINATE. DESBD410 00825 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DESBD410 00826 NEXT SENTENCE DESBD410 00827 ELSE DESBD410 00828 SET LECM-TERMINATE-88 TO TRUE DESBD410 00829 PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT DESBD410 00830 VARYING WRK-EXT-IDX FROM 1 BY 1 DESBD410 00831 UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DESBD410 00832 DESBD410 00833 DESBD410 00834 DISPLAY ' '. DESBD410 00835 DESBD410 00836 DISPLAY '*** DESBD410 TERMINATION STATISTICS ***'. DESBD410 00837 DESBD410 00838 DISPLAY ' '. DESBD410 00839 DESBD410 00840 DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DESBD410 00841 WRK-ELOG-CNT. DESBD410 00842 DESBD410 00843 DISPLAY ' '. DESBD410 00844 DESBD410 00845 DISPLAY 'NUMBER OF MASTER FILE EMPLOYERS UPDATED : 'DESBD410 00846 WRK-UPDATED-CNT. DESBD410 00847 DESBD410 00848 DISPLAY ' '. DESBD410 00849 DESBD410 00850 DISPLAY 'MODULE LINKAGE - RUN TYPE : ' DESBD410 00851 LECM-RUN-TYPE. DESBD410 00852 DESBD410 00853 DISPLAY ' '. DESBD410 00854 DESBD410 00855 DISPLAY 'MODULE LINKAGE - PERIOD START DATE : ' DESBD410 00856 LECM-PERIOD-START-DATE. DESBD410 00857 DESBD410 00858 DISPLAY ' '. DESBD410 00859 DESBD410 00860 DISPLAY 'MODULE LINKAGE - PERIOD END DATE : ' DESBD410 00861 LECM-PERIOD-END-DATE. DESBD410 00862 DESBD410 00863 DISPLAY ' '. DESBD410 00864 DESBD410 00865 DESBD410 00866 PERFORM S935-CLOSE THRU S935-EXIT. DESBD410 00867 DESBD410 00868 PERFORM S921-CLOSE THRU S921-EXIT. DESBD410 00869 DESBD410 00870 PERFORM S927-CLOSE THRU S927-EXIT. DESBD410 00871 DESBD410 00872 PERFORM S931-CLOSE THRU S931-EXIT. DESBD410 00873 DESBD410 00874 MOVE -1 TO RSK1-LENGTH. DESBD410 00875 DESBD410 00876 PERFORM S946-RPT-O THRU S946-EXIT. DESBD410 00877 DESBD410 00878 DESBD410 00879 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD410 00880 DESBD410 00881 COMPUTE WRK-STEP-DURATION ROUNDED DESBD410 00882 = (L005-ABSTIME - WRK-START-ABSTIME ) / 1000. DESBD410 00883 DESBD410 00884 DISPLAY '*** ' DESBD410 00885 WRK-STEP-DURATION-X DESBD410 00886 ' STEP DURATION (SECONDS)'. DESBD410 00887 DESBD410 00888 *****MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND. DESBD410 00889 DESBD410 00890 *****MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND. DESBD410 00891 DESBD410 00892 *****IF LECM-MST-OPEN-READ-88 DESBD410 00893 ***** MOVE +0 TO RETURN-CODE DESBD410 00894 *****ELSE DESBD410 00895 *****IF LECM-MST-OPEN-UPDATE-HDR-88 DESBD410 00896 ***** MOVE +1 TO RETURN-CODE DESBD410 00897 *****ELSE DESBD410 00898 ***** MOVE +2 TO RETURN-CODE. DESBD410 00899 T0000-EXIT. DESBD410 00900 EXIT. DESBD410 00901 EJECT DESBD410 00902 S1000-CALL-EXTRACT. DESBD410 00903 SET LECM-EMP-UPDATED-NO-88 TO TRUE. DESBD410 00904 DESBD410 00905 MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX) DESBD410 00906 TO LECM-EXTRACT-PARMS. DESBD410 00907 DESBD410 00908 MOVE WRK-EXTRACT-ID (WRK-EXT-IDX) TO EXTRACT-MOD-ID. DESBD410 00909 DESBD410 00910 CALL EXTRACT-MOD-NAME USING LECM-LINK-AREA DESBD410 00911 EPRF-REC DESBD410 00912 ELOG-REC. DESBD410 00913 DESBD410 00914 IF LECM-EMP-UPDATED-YES-88 DESBD410 00915 PERFORM S1100-EMPLOYER-UPDATED THRU S1100-EXIT. DESBD410 00916 S1000-EXIT. DESBD410 00917 EXIT. DESBD410 00918 SKIP3 DESBD410 00919 S1100-EMPLOYER-UPDATED. DESBD410 00920 IF LECM-PROCESS-88 DESBD410 00921 NEXT SENTENCE DESBD410 00922 ELSE DESBD410 00923 GO TO S1100-EXIT. DESBD410 00924 DESBD410 00925 SET WRK-LOG-UPDATED-YES-88 TO TRUE. DESBD410 00926 DESBD410 00927 IF EPRF-UPD-ACTIVE-88 DESBD410 00928 MOVE MSG1-ID TO R907-MSG-ID DESBD410 00929 MOVE EPRF-ELF-ID TO R907-EMP-NO DESBD410 00930 MOVE EXTRACT-MOD-ID TO MSG1-EXTRACT-ID DESBD410 00931 MOVE MSG1-TEXT TO R907-MSG-TEXT DESBD410 00932 MOVE WRK-MOD-NAME TO R907-MODULE-NAME DESBD410 00933 MOVE R907-REC TO RSKL-REC DESBD410 00934 PERFORM S946-RPT-O THRU S946-EXIT. DESBD410 00935 S1100-EXIT. DESBD410 00936 EXIT. DESBD410 00937 EJECT DESBD410 00938 S001-FROM-CAL-6. DESBD410 00939 SET L001-FROM-CAL-6 TO TRUE. DESBD410 00940 GO TO S001-DATE. DESBD410 00941 DESBD410 00942 S001-DATE. DESBD410 00943 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD410 00944 S001-EXIT. DESBD410 00945 EXIT. DESBD410 00946 S005-FROM-SYS. DESBD410 00947 SET L005-FROM-SYS TO TRUE. DESBD410 00948 GO TO S005-ABSTIME. DESBD410 00949 DESBD410 00950 S005-ABSTIME. DESBD410 00951 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD410 00952 S005-EXIT. DESBD410 00953 EXIT. DESBD410 00954 SKIP3 DESBD410 00955 S910-OPEN-READ. DESBD410 00956 SET L910-OPEN-READ-88 TO TRUE. DESBD410 00957 GO TO S910-MSTR-IO. DESBD410 00958 DESBD410 00959 S910-OPEN-UPDATE-HDR. DESBD410 00960 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DESBD410 00961 GO TO S910-MSTR-IO. DESBD410 00962 DESBD410 00963 S910-OPEN-UPDATE. DESBD410 00964 SET L910-OPEN-UPDATE-88 TO TRUE. DESBD410 00965 GO TO S910-MSTR-IO. DESBD410 00966 DESBD410 00967 S910-READ. DESBD410 00968 SET L910-READ-88 TO TRUE. DESBD410 00969 GO TO S910-MSTR-IO. DESBD410 00970 DESBD410 00971 S910-START-BROWSE. DESBD410 00972 SET L910-START-BROWSE-88 TO TRUE. DESBD410 00973 GO TO S910-MSTR-IO. DESBD410 00974 DESBD410 00975 S910-READ-NEXT. DESBD410 00976 SET L910-READ-NEXT-88 TO TRUE. DESBD410 00977 GO TO S910-MSTR-IO. DESBD410 00978 DESBD410 00979 S910-REWRITE. DESBD410 00980 SET L910-REWRITE-88 TO TRUE. DESBD410 00981 GO TO S910-MSTR-IO. DESBD410 00982 DESBD410 00983 S910-CLOSE. DESBD410 00984 SET L910-CLOSE-88 TO TRUE. DESBD410 00985 GO TO S910-MSTR-IO. DESBD410 00986 DESBD410 00987 S910-MSTR-IO. DESBD410 00988 CALL 'DTSBU910' USING L910-LINK-AREA DESBD410 00989 MSKL-REC. DESBD410 00990 S910-EXIT. DESBD410 00991 EXIT. DESBD410 00992 SKIP3 DESBD410 00993 S921-OPEN-READ. DESBD410 00994 SET L921-OPEN-READ-88 TO TRUE. DESBD410 00995 GO TO S921-AIX-IO. DESBD410 00996 DESBD410 00997 S921-OPEN-UPDATE. DESBD410 00998 SET L921-OPEN-UPDATE-88 TO TRUE. DESBD410 00999 GO TO S921-AIX-IO. DESBD410 01000 DESBD410 01001 S921-START-BROWSE. DESBD410 01002 SET L921-START-BROWSE-88 TO TRUE. DESBD410 01003 GO TO S921-AIX-IO. DESBD410 01004 DESBD410 01005 S921-READ-NEXT. DESBD410 01006 SET L921-READ-NEXT-88 TO TRUE. DESBD410 01007 GO TO S921-AIX-IO. DESBD410 01008 DESBD410 01009 S921-CLOSE. DESBD410 01010 SET L921-CLOSE-88 TO TRUE. DESBD410 01011 GO TO S921-AIX-IO. DESBD410 01012 DESBD410 01013 S921-AIX-IO. DESBD410 01014 CALL 'DTSBU921' USING L921-LINK-AREA DESBD410 01015 ISKL-REC. DESBD410 01016 S921-EXIT. DESBD410 01017 EXIT. DESBD410 01018 SKIP3 DESBD410 01019 S927-OPEN-UPDATE. DESBD410 01020 SET L927-OPEN-UPDATE-88 TO TRUE. DESBD410 01021 GO TO S927-BTC-O. DESBD410 01022 DESBD410 01023 S927-CLOSE. DESBD410 01024 SET L927-CLOSE-88 TO TRUE. DESBD410 01025 GO TO S927-BTC-O. DESBD410 01026 DESBD410 01027 S927-BTC-O. DESBD410 01028 CALL 'DTSBU927' USING L927-LINK-AREA DESBD410 01029 RSKL-REC. DESBD410 01030 S927-EXIT. DESBD410 01031 EXIT. DESBD410 01032 SKIP3 DESBD410 01033 S931-OPEN-READ. DESBD410 01034 SET L931-OPEN-READ-88 TO TRUE. DESBD410 01035 GO TO S931-REF-IO. DESBD410 01036 DESBD410 01037 S931-OPEN-UPDATE. DESBD410 01038 SET L931-OPEN-UPDATE-88 TO TRUE. DESBD410 01039 GO TO S931-REF-IO. DESBD410 01040 DESBD410 01041 S931-CLOSE. DESBD410 01042 SET L931-CLOSE-88 TO TRUE. DESBD410 01043 GO TO S931-REF-IO. DESBD410 01044 DESBD410 01045 S931-REF-IO. DESBD410 01046 CALL 'DTSBU931' USING L931-LINK-AREA DESBD410 01047 FSKL-REC. DESBD410 01048 S931-EXIT. DESBD410 01049 EXIT. DESBD410 01050 SKIP3 DESBD410 01051 S935-OPEN-READ. DESBD410 01052 SET L935-OPEN-READ-88 TO TRUE. DESBD410 01053 GO TO S935-MSTR-IO. DESBD410 01054 DESBD410 01055 S935-OPEN-UPDATE-HDR. DESBD410 01056 SET L935-OPEN-UPDATE-HDR-88 TO TRUE. DESBD410 01057 GO TO S935-MSTR-IO. DESBD410 01058 DESBD410 01059 S935-OPEN-UPDATE. DESBD410 01060 SET L935-OPEN-UPDATE-88 TO TRUE. DESBD410 01061 GO TO S935-MSTR-IO. DESBD410 01062 DESBD410 01063 S935-READ. DESBD410 01064 SET L935-READ-88 TO TRUE. DESBD410 01065 GO TO S935-MSTR-IO. DESBD410 01066 DESBD410 01067 S935-START-BROWSE. DESBD410 01068 SET L935-START-BROWSE-88 TO TRUE. DESBD410 01069 GO TO S935-MSTR-IO. DESBD410 01070 DESBD410 01071 S935-READ-NEXT. DESBD410 01072 SET L935-READ-NEXT-88 TO TRUE. DESBD410 01073 GO TO S935-MSTR-IO. DESBD410 01074 DESBD410 01075 S935-REWRITE. DESBD410 01076 SET L935-REWRITE-88 TO TRUE. DESBD410 01077 GO TO S935-MSTR-IO. DESBD410 01078 DESBD410 01079 S935-CLOSE. DESBD410 01080 SET L935-CLOSE-88 TO TRUE. DESBD410 01081 GO TO S935-MSTR-IO. DESBD410 01082 DESBD410 01083 S935-MSTR-IO. DESBD410 01084 CALL 'DTSBU935' USING L935-LINK-AREA DESBD410 01085 ESKL-REC. DESBD410 01086 S935-EXIT. DESBD410 01087 EXIT. DESBD410 01088 SKIP3 DESBD410 01089 S946-RPT-O. DESBD410 01090 CALL 'DTSBU946' USING RSKL-REC. DESBD410 01091 S946-EXIT. DESBD410 01092 EXIT. DESBD410 01093 SKIP3 DESBD410 01094 S999-ABEND. DESBD410 01095 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD410 01096 S999-EXIT. DESBD410 01097 EXIT. DESBD410