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