654 lines
52 KiB
COBOL
654 lines
52 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/28/02
|
|
00002 PROGRAM-ID. DESBD220. DESBD220
|
|
00003 *AUTHOR. TRW INC. LV003
|
|
00004 *DATE-WRITTEN. MARCH 2001. DESBD220
|
|
00005 DATE-COMPILED. DESBD220
|
|
00006 DESBD220
|
|
00007 ***** DESBD220
|
|
00008 * DESBD220
|
|
00009 * FUNCTION: DESBD220
|
|
00010 * DESBD220
|
|
00011 * ELECTRONIC MEDIA SYSTEM BATCH UPDATE. DESBD220
|
|
00012 * DESBD220 READS THE RECORDS THAT DESBD200 WRITES TO DESBD220
|
|
00013 * A FLAT FILE DURING THE DAY, AND UPDATES THE VSAM DESBD220
|
|
00014 * FILES. DESBD220
|
|
00015 * DESBD220
|
|
00016 * INPUT: DESBD220
|
|
00017 * DESBD220
|
|
00018 * DTSIRSK4 - MASTER FILE RECORDS PASSED FROM DESBD220
|
|
00019 * FLAT FILE CREATED BY DESBD200. DESBD220
|
|
00020 * DESBD220
|
|
00021 * INPUT-OUTPUT: DESBD220
|
|
00022 * DESBD220
|
|
00023 * DTSIEEMH - VSAM HISTORY FILE. DESBD220
|
|
00024 * DTSIEMSG - VSAM STATUS AND ERROR MESSAGE FILE. DESBD220
|
|
00025 * DESBD220
|
|
00026 ***** DESBD220
|
|
00027 DESBD220
|
|
00028 ******************************************************************DESBD220
|
|
00029 * MODIFICATION HISTORY: *DESBD220
|
|
00030 * *DESBD220
|
|
00031 * 12-01-2000 INITIAL DEVELOPMENT *DESBD220
|
|
00032 * REFERENCE RFP # AUTHOR OF CHANGE - RW *DESBD220
|
|
00033 * *DESBD220
|
|
00034 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD220
|
|
00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD220
|
|
00036 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *DESBD220
|
|
00037 ******************************************************************DESBD220
|
|
00038 DESBD220
|
|
00039 ENVIRONMENT DIVISION. DESBD220
|
|
00040 DESBD220
|
|
00041 DATA DIVISION. DESBD220
|
|
00042 DESBD220
|
|
00043 WORKING-STORAGE SECTION. DESBD220
|
|
000435 77 PAN-VALET PICTURE X(24) VALUE '003DESBD220 08/28/02'. DESBD220
|
|
00044 DESBD220
|
|
00045 01 WRK-AREA. DESBD220
|
|
00046 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +220. DESBD220
|
|
00047 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DESBD220
|
|
00048 DESBD220
|
|
00049 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD220'. DESBD220
|
|
00050 DESBD220
|
|
00051 05 WRK-ELOG-REC-UPDATE PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00052 05 WRK-EEMH-REC-DELETE PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00053 05 WRK-EMSG-REC-DELETE PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00054 05 WRK-EMSG-REC-WRITTEN PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00055 DESBD220
|
|
00056 DESBD220
|
|
00057 01 WRK-VARIABLES. DESBD220
|
|
00058 05 WRK-TRACE-IND PIC X(01) VALUE SPACE. DESBD220
|
|
00059 DESBD220
|
|
00060 05 WRK-FATAL-ERROR-IND PIC X(01) VALUE ' '. DESBD220
|
|
00061 88 WRK-FATAL-ERROR-YES VALUE 'Y'. DESBD220
|
|
00062 88 WRK-FATAL-ERROR-NO VALUE 'N'. DESBD220
|
|
00063 DESBD220
|
|
00064 05 WRK-LOG-NO PIC 9(10) VALUE 0. DESBD220
|
|
00065 DESBD220
|
|
00066 05 ERR-SUB PIC S9(04) COMP VALUE +0. DESBD220
|
|
00067 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. DESBD220
|
|
00068 05 WRK-DISP-DATE PIC X(08). DESBD220
|
|
00069 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00070 05 WRK-DISP-TIME PIC X(08). DESBD220
|
|
00071 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. DESBD220
|
|
00072 05 WRK-ABSTIME-XOR PIC S9(15) COMP-3 VALUE +0. DESBD220
|
|
00073 DESBD220
|
|
00074 05 WRK-EMSG-SEQ PIC 9(05) COMP-3 VALUE 0. DESBD220
|
|
00075 05 WRK-EEMH-SEQ PIC 9(04) COMP-3 VALUE 0. DESBD220
|
|
00076 05 WRK-TOT-CNT PIC S9(05) COMP-3 VALUE +0. DESBD220
|
|
00077 05 WRK-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00078 05 WRK-LAST-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00079 05 WRK-SUCCESS-CNT PIC S9(07) COMP-3 VALUE +0. DESBD220
|
|
00080 DESBD220
|
|
00081 05 WRK-ERR-MESSAGE PIC X(60) VALUE SPACES. DESBD220
|
|
00082 DESBD220
|
|
00083 05 WRK-NO-INPUT-MSG PIC X(60) VALUE DESBD220
|
|
00084 'NO ITEMS WERE RELEASED FOR PROCESSING TODAY'. DESBD220
|
|
00085 DESBD220
|
|
00086 05 WRK-RESULT-CD PIC X(02) VALUE ZERO. DESBD220
|
|
00087 DESBD220
|
|
00088 05 WRK-DATE-TYPE PIC X(03) VALUE SPACES. DESBD220
|
|
00089 05 WRK-RPT-DATE PIC 9(08) VALUE 0. DESBD220
|
|
00090 05 WRK-RPT-DATE-IN PIC 9(08) VALUE 0. DESBD220
|
|
00091 05 FILLER REDEFINES WRK-RPT-DATE-IN. DESBD220
|
|
00092 10 FILLER PIC 9(03). DESBD220
|
|
00093 10 WRK-RPT-DATE-IN-5 PIC 9(05). DESBD220
|
|
00094 05 FILLER REDEFINES WRK-RPT-DATE-IN. DESBD220
|
|
00095 10 FILLER PIC 9(05). DESBD220
|
|
00096 10 WRK-RPT-DATE-IN-3 PIC 9(03). DESBD220
|
|
00097 DESBD220
|
|
00098 01 R102-REC. DESBD220
|
|
00099 ++INCLUDE DESIR102 DESBD220
|
|
00100 EJECT DESBD220
|
|
00101 01 R901-REC. DESBD220
|
|
00102 ++INCLUDE DTSIR901 DESBD220
|
|
00103 EJECT DESBD220
|
|
00104 01 L112-LINK-AREA. DESBD220
|
|
00105 ++INCLUDE DTSIL112 DESBD220
|
|
00106 EJECT DESBD220
|
|
00107 01 L921-LINK-AREA. DESBD220
|
|
00108 ++INCLUDE DTSIL921 DESBD220
|
|
00109 EJECT DESBD220
|
|
00110 01 ISKL-REC. DESBD220
|
|
00111 ++INCLUDE DTSIISKL DESBD220
|
|
00112 EJECT DESBD220
|
|
00113 01 IEET-REC. DESBD220
|
|
00114 ++INCLUDE DTSIIEET DESBD220
|
|
00115 EJECT DESBD220
|
|
00116 01 L935-LINK-AREA. DESBD220
|
|
00117 ++INCLUDE DTSIL935 DESBD220
|
|
00118 EJECT DESBD220
|
|
00119 01 ESKL-REC. DESBD220
|
|
00120 ++INCLUDE DTSIESKL DESBD220
|
|
00121 EJECT DESBD220
|
|
00122 01 EPRF-REC. DESBD220
|
|
00123 ++INCLUDE DTSIEPRF DESBD220
|
|
00124 EJECT DESBD220
|
|
00125 01 ELOG-REC. DESBD220
|
|
00126 ++INCLUDE DTSIELOG DESBD220
|
|
00127 EJECT DESBD220
|
|
00128 01 EMSG-REC. DESBD220
|
|
00129 ++INCLUDE DTSIEMSG DESBD220
|
|
00130 EJECT DESBD220
|
|
00131 01 EEMH-REC. DESBD220
|
|
00132 ++INCLUDE DTSIEEMH DESBD220
|
|
00133 EJECT DESBD220
|
|
00134 01 L941-LINK-AREA. DESBD220
|
|
00135 ++INCLUDE DTSIL941 DESBD220
|
|
00136 EJECT DESBD220
|
|
00137 01 RSK4-REC. DESBD220
|
|
00138 ++INCLUDE DTSIRSK4 DESBD220
|
|
00139 EJECT DESBD220
|
|
00140 DESBD220
|
|
00141 PROCEDURE DIVISION. DESBD220
|
|
00142 DESBD220
|
|
00143 DESBD220-MAIN. DESBD220
|
|
00144 DESBD220
|
|
00145 SET WRK-FATAL-ERROR-NO TO TRUE. DESBD220
|
|
00146 DESBD220
|
|
00147 PERFORM I0000-INIT THRU I0000-EXIT DESBD220
|
|
00148 IF WRK-FATAL-ERROR-YES DESBD220
|
|
00149 GO TO DESBD220-EXIT. DESBD220
|
|
00150 DESBD220
|
|
00151 PERFORM P1000-INPUT-LOOP THRU P1000-EXIT DESBD220
|
|
00152 UNTIL L941-NO-REC-88. DESBD220
|
|
00153 DESBD220
|
|
00154 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD220
|
|
00155 DESBD220
|
|
00156 DESBD220-EXIT. DESBD220
|
|
00157 DESBD220
|
|
00158 GOBACK. DESBD220
|
|
00159 DESBD220
|
|
00160 ******************************************************************DESBD220
|
|
00161 * OPEN FILES AND INITIALIZE WORKING-STORAGE AND LINKAGE. *DESBD220
|
|
00162 * IF THE EDIT PROGAM HAS ATTEMPTED TO PROCESS THIS ITEM *DESBD220
|
|
00163 * PREVIOUSLY, AND IS NOW BEING RE-RUN, DESBD220
|
|
00164 * DELETE ANY ERROR MESSAGE RECORDS AND EMPLOYER *DESBD220
|
|
00165 * HISTORY RECORDS FROM THE PREVIOUS RUN. DESBD220
|
|
00166 ******************************************************************DESBD220
|
|
00167 I0000-INIT. DESBD220
|
|
00168 PERFORM I2000-INIT-RPTS THRU I2000-EXIT. DESBD220
|
|
00169 DESBD220
|
|
00170 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD220
|
|
00171 IF WRK-FATAL-ERROR-YES DESBD220
|
|
00172 GO TO I0000-EXIT. DESBD220
|
|
00173 DESBD220
|
|
00174 I0000-EXIT. DESBD220
|
|
00175 EXIT. DESBD220
|
|
00176 DESBD220
|
|
00177 I1000-OPEN-FILES. DESBD220
|
|
00178 MOVE ' ' TO WRK-TRACE-IND. DESBD220
|
|
00179 DESBD220
|
|
00180 MOVE WRK-TRACE-IND TO L921-TRACE-IND DESBD220
|
|
00181 L935-TRACE-IND DESBD220
|
|
00182 L941-TRACE-IND. DESBD220
|
|
00183 DESBD220
|
|
00184 MOVE WRK-MOD-NAME TO L921-MOD-NAME DESBD220
|
|
00185 L935-MOD-NAME DESBD220
|
|
00186 L941-MOD-NAME. DESBD220
|
|
00187 DESBD220
|
|
00188 MOVE ZERO TO WRK-TOT-CNT DESBD220
|
|
00189 WRK-EMP-CNT DESBD220
|
|
00190 WRK-SUCCESS-CNT. DESBD220
|
|
00191 DESBD220
|
|
00192 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DESBD220
|
|
00193 PERFORM S935-OPEN-UPDATE THRU S935-EXIT. DESBD220
|
|
00194 PERFORM S941-OPEN-READ THRU S941-EXIT. DESBD220
|
|
00195 DESBD220
|
|
00196 I1000-EXIT. DESBD220
|
|
00197 EXIT. DESBD220
|
|
00198 DESBD220
|
|
00199 I2000-INIT-RPTS. DESBD220
|
|
00200 MOVE LENGTH OF R102-REC TO R102-LENGTH. DESBD220
|
|
00201 MOVE '102' TO R102-REC-TYPE. DESBD220
|
|
00202 MOVE LENGTH OF R901-REC TO R901-LENGTH. DESBD220
|
|
00203 MOVE '901' TO R901-REC-TYPE. DESBD220
|
|
00204 MOVE SPACES TO R102-BOX-NO DESBD220
|
|
00205 R102-RPT-TYPE DESBD220
|
|
00206 R102-FORMAT-CD DESBD220
|
|
00207 R102-OPID DESBD220
|
|
00208 R102-FMT-ADDR DESBD220
|
|
00209 R102-ZIP DESBD220
|
|
00210 R102-ADVANCED-BARCODE. DESBD220
|
|
00211 DESBD220
|
|
00212 MOVE ZERO TO R102-ELF-ID DESBD220
|
|
00213 R102-LOG-NO DESBD220
|
|
00214 R102-MAIL-DATE DESBD220
|
|
00215 R102-ERR-CNT. DESBD220
|
|
00216 DESBD220
|
|
00217 PERFORM I2100-ERR-TABLE THRU I2100-EXIT DESBD220
|
|
00218 VARYING ERR-SUB FROM +1 BY +1 DESBD220
|
|
00219 UNTIL ERR-SUB > +50. DESBD220
|
|
00220 DESBD220
|
|
00221 I2000-EXIT. DESBD220
|
|
00222 EXIT. DESBD220
|
|
00223 DESBD220
|
|
00224 DESBD220
|
|
00225 I2100-ERR-TABLE. DESBD220
|
|
00226 MOVE SPACES TO R102-ERR-TABLE (ERR-SUB). DESBD220
|
|
00227 DESBD220
|
|
00228 I2100-EXIT. DESBD220
|
|
00229 EXIT. DESBD220
|
|
00230 DESBD220
|
|
00231 P1000-INPUT-LOOP. DESBD220
|
|
00232 PERFORM S941-READ-NEXT THRU S941-EXIT. DESBD220
|
|
00233 IF L941-NO-REC-88 DESBD220
|
|
00234 PERFORM P1200-COMPLETE-R102 THRU P1200-EXIT DESBD220
|
|
00235 PERFORM P1300-BUILD-R901 THRU P1300-EXIT DESBD220
|
|
00236 GO TO P1000-EXIT DESBD220
|
|
00237 ELSE DESBD220
|
|
00238 IF RSK4-LOG-NO = ZERO DESBD220
|
|
00239 GO TO P1000-EXIT. DESBD220
|
|
00240 DESBD220
|
|
00241 IF WRK-LOG-NO NOT = RSK4-LOG-NO DESBD220
|
|
00242 PERFORM P1200-COMPLETE-R102 THRU P1200-EXIT DESBD220
|
|
00243 PERFORM P1300-BUILD-R901 THRU P1300-EXIT DESBD220
|
|
00244 PERFORM I2000-INIT-RPTS THRU I2000-EXIT DESBD220
|
|
00245 MOVE RSK4-LOG-NO TO WRK-LOG-NO DESBD220
|
|
00246 PERFORM P2000-CHK-PRIOR-RUN THRU P2000-EXIT DESBD220
|
|
00247 PERFORM P3000-BUILD-R102 THRU P3000-EXIT. DESBD220
|
|
00248 DESBD220
|
|
00249 MOVE RSK4-REC-AREA TO ESKL-REC. DESBD220
|
|
00250 IF ESKL-MSG-88 DESBD220
|
|
00251 MOVE ESKL-REC TO EMSG-REC DESBD220
|
|
00252 PERFORM P1100-ERR-TO-R102 THRU P1100-EXIT DESBD220
|
|
00253 ELSE DESBD220
|
|
00254 IF ESKL-EMH-88 DESBD220
|
|
00255 MOVE ESKL-REC TO EEMH-REC DESBD220
|
|
00256 PERFORM S935-WRITE-CHK-DUP-KEY THRU S935-EXIT DESBD220
|
|
00257 IF L935-OK-88 DESBD220
|
|
00258 OR L935-DUP-KEY-88 DESBD220
|
|
00259 NEXT SENTENCE DESBD220
|
|
00260 ELSE DESBD220
|
|
00261 DISPLAY 'CANNOT WRITE RECORD ' ESKL-REC-TYPE. DESBD220
|
|
00262 DESBD220
|
|
00263 P1000-EXIT. DESBD220
|
|
00264 EXIT. DESBD220
|
|
00265 DESBD220
|
|
00266 P1100-ERR-TO-R102. DESBD220
|
|
00267 IF EMSG-TYPE-ERROR-88 DESBD220
|
|
00268 IF ERR-SUB < +50 DESBD220
|
|
00269 ADD +1 TO ERR-SUB DESBD220
|
|
00270 MOVE EMSG-FULL-MESSAGE TO R102-ERROR (ERR-SUB) DESBD220
|
|
00271 MOVE ERR-SUB TO R102-ERR-CNT. DESBD220
|
|
00272 DESBD220
|
|
00273 P1100-EXIT. DESBD220
|
|
00274 EXIT. DESBD220
|
|
00275 DESBD220
|
|
00276 P1200-COMPLETE-R102. DESBD220
|
|
00277 IF WRK-LOG-NO = ZERO DESBD220
|
|
00278 PERFORM P1210-NO-INPUT-RECS THRU P1210-EXIT DESBD220
|
|
00279 GO TO P1200-EXIT. DESBD220
|
|
00280 DESBD220
|
|
00281 IF ERR-SUB = ZERO DESBD220
|
|
00282 SET R102-RPT-TYPE-CONFIRM-88 TO TRUE DESBD220
|
|
00283 ELSE DESBD220
|
|
00284 SET R102-RPT-TYPE-ERROR-88 TO TRUE. DESBD220
|
|
00285 DESBD220
|
|
00286 PERFORM S946-WRITE-R102 THRU S946-EXIT. DESBD220
|
|
00287 DESBD220
|
|
00288 P1200-EXIT. DESBD220
|
|
00289 EXIT. DESBD220
|
|
00290 DESBD220
|
|
00291 P1210-NO-INPUT-RECS. DESBD220
|
|
00292 MOVE SPACES TO R102-BOX-NO DESBD220
|
|
00293 R102-FORMAT-CD DESBD220
|
|
00294 R102-OPID DESBD220
|
|
00295 R102-FMT-ADDR DESBD220
|
|
00296 R102-ADVANCED-BARCODE. DESBD220
|
|
00297 DESBD220
|
|
00298 MOVE ZERO TO R102-ELF-ID DESBD220
|
|
00299 R102-LOG-NO DESBD220
|
|
00300 R102-MAIL-DATE. DESBD220
|
|
00301 DESBD220
|
|
00302 MOVE WRK-NO-INPUT-MSG TO R102-ERROR (1). DESBD220
|
|
00303 MOVE +1 TO R102-ERR-CNT. DESBD220
|
|
00304 DESBD220
|
|
00305 SET R102-RPT-TYPE-ERROR-88 TO TRUE. DESBD220
|
|
00306 DESBD220
|
|
00307 PERFORM S946-WRITE-R102 THRU S946-EXIT. DESBD220
|
|
00308 DESBD220
|
|
00309 P1210-EXIT. DESBD220
|
|
00310 EXIT. DESBD220
|
|
00311 DESBD220
|
|
00312 P1300-BUILD-R901. DESBD220
|
|
00313 IF WRK-LOG-NO = ZERO DESBD220
|
|
00314 GO TO P1300-EXIT. DESBD220
|
|
00315 DESBD220
|
|
00316 IF (EPRF-PRT-UC30-88 OR EPRF-BEN-CHARGE-88) DESBD220
|
|
00317 NEXT SENTENCE DESBD220
|
|
00318 ELSE DESBD220
|
|
00319 IF EPRF-WAGE-88 DESBD220
|
|
00320 IF EPRF-TAPE-88 DESBD220
|
|
00321 NEXT SENTENCE DESBD220
|
|
00322 ELSE DESBD220
|
|
00323 GO TO P1300-EXIT DESBD220
|
|
00324 END-IF DESBD220
|
|
00325 ELSE DESBD220
|
|
00326 GO TO P1300-EXIT DESBD220
|
|
00327 END-IF DESBD220
|
|
00328 END-IF. DESBD220
|
|
00329 DESBD220
|
|
00330 SET R901-ON-REQUEST-88 TO TRUE. DESBD220
|
|
00331 MOVE WRK-MOD-NAME TO R901-GRP1-OP-ID. DESBD220
|
|
00332 MOVE EPRF-ELF-ID TO R901-GRP1-EMP-NO DESBD220
|
|
00333 R901-EMP-NO. DESBD220
|
|
00334 MOVE +1 TO R901-LABEL-CNT. DESBD220
|
|
00335 MOVE L112-ZIP TO R901-ZIP. DESBD220
|
|
00336 MOVE L112-MAILING-ADDRESS TO R901-FMT-ADDR. DESBD220
|
|
00337 MOVE L112-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE. DESBD220
|
|
00338 DESBD220
|
|
00339 PERFORM S946-WRITE-R901 THRU S946-EXIT. DESBD220
|
|
00340 DESBD220
|
|
00341 P1300-EXIT. DESBD220
|
|
00342 EXIT. DESBD220
|
|
00343 DESBD220
|
|
00344 P2000-CHK-PRIOR-RUN. DESBD220
|
|
00345 PERFORM P2100-DELETE-EEMH THRU P2100-EXIT. DESBD220
|
|
00346 PERFORM P2200-DELETE-EMSG THRU P2200-EXIT. DESBD220
|
|
00347 DESBD220
|
|
00348 P2000-EXIT. DESBD220
|
|
00349 EXIT. DESBD220
|
|
00350 DESBD220
|
|
00351 ******************************************************************DESBD220
|
|
00352 * DELETE THE HISTORY RECORD *DESBD220
|
|
00353 * USING THE ALTERNATE INDEX IEET FILE *DESBD220
|
|
00354 ******************************************************************DESBD220
|
|
00355 P2100-DELETE-EEMH. DESBD220
|
|
00356 MOVE LOW-VALUES TO IEET-KEY-AREA. DESBD220
|
|
00357 SET IEET-EET-88 TO TRUE. DESBD220
|
|
00358 MOVE +0 TO IEET-EMP-NO DESBD220
|
|
00359 IEET-RPT-DATE-XOR. DESBD220
|
|
00360 MOVE SPACES TO IEET-DATA-TYPE-CD. DESBD220
|
|
00361 MOVE ZERO TO IEET-LOG-NO. DESBD220
|
|
00362 MOVE IEET-REC TO ISKL-REC. DESBD220
|
|
00363 DESBD220
|
|
00364 PERFORM S921-START-BROWSE THRU S921-EXIT. DESBD220
|
|
00365 IF L921-NO-REC-88 DESBD220
|
|
00366 NEXT SENTENCE DESBD220
|
|
00367 ELSE DESBD220
|
|
00368 PERFORM P2110-SCAN-IEET THRU P2110-EXIT DESBD220
|
|
00369 UNTIL L921-NO-REC-88 DESBD220
|
|
00370 END-IF. DESBD220
|
|
00371 DESBD220
|
|
00372 P2100-EXIT. DESBD220
|
|
00373 EXIT. DESBD220
|
|
00374 DESBD220
|
|
00375 P2110-SCAN-IEET. DESBD220
|
|
00376 DESBD220
|
|
00377 MOVE ISKL-REC TO IEET-REC. DESBD220
|
|
00378 IF IEET-LOG-NO = WRK-LOG-NO DESBD220
|
|
00379 PERFORM P2111-DELETE-EEMH THRU P2111-EXIT DESBD220
|
|
00380 PERFORM S921-START-BROWSE THRU S921-EXIT DESBD220
|
|
00381 GO TO P2110-EXIT DESBD220
|
|
00382 END-IF. DESBD220
|
|
00383 DESBD220
|
|
00384 PERFORM S921-READ-NEXT THRU S921-EXIT. DESBD220
|
|
00385 DESBD220
|
|
00386 P2110-EXIT. DESBD220
|
|
00387 EXIT. DESBD220
|
|
00388 DESBD220
|
|
00389 P2111-DELETE-EEMH. DESBD220
|
|
00390 MOVE LOW-VALUES TO EEMH-REC. DESBD220
|
|
00391 SET EEMH-EMH-88 TO TRUE. DESBD220
|
|
00392 MOVE IEET-EMP-NO TO EEMH-EMP-NO. DESBD220
|
|
00393 COMPUTE EEMH-REPORTING-DATE = DESBD220
|
|
00394 (99999999 - IEET-RPT-DATE-XOR). DESBD220
|
|
00395 MOVE IEET-DATA-TYPE-CD TO EEMH-DATA-TYPE-CD. DESBD220
|
|
00396 MOVE IEET-LOG-NO TO EEMH-LOG-NO. DESBD220
|
|
00397 MOVE EEMH-REC TO ESKL-REC. DESBD220
|
|
00398 DESBD220
|
|
00399 PERFORM S935-READ THRU S935-EXIT. DESBD220
|
|
00400 DESBD220
|
|
00401 IF L935-NO-REC-88 DESBD220
|
|
00402 NEXT SENTENCE DESBD220
|
|
00403 ELSE DESBD220
|
|
00404 PERFORM S935-DELETE THRU S935-EXIT DESBD220
|
|
00405 ADD +1 TO WRK-EEMH-REC-DELETE DESBD220
|
|
00406 END-IF. DESBD220
|
|
00407 DESBD220
|
|
00408 PERFORM S921-READ-NEXT THRU S921-EXIT. DESBD220
|
|
00409 DESBD220
|
|
00410 P2111-EXIT. DESBD220
|
|
00411 EXIT. DESBD220
|
|
00412 DESBD220
|
|
00413 ******************************************************************DESBD220
|
|
00414 * DELETE ANY ERROR MESSAGE RECORD *DESBD220
|
|
00415 * WHEN EMSG-LOG-NO = ELOG-LOG-NO *DESBD220
|
|
00416 ******************************************************************DESBD220
|
|
00417 P2200-DELETE-EMSG. DESBD220
|
|
00418 MOVE LOW-VALUES TO EMSG-REC. DESBD220
|
|
00419 SET EMSG-MSG-88 TO TRUE. DESBD220
|
|
00420 MOVE WRK-LOG-NO TO EMSG-LOG-NO. DESBD220
|
|
00421 MOVE +0 TO EMSG-ABSTIME. DESBD220
|
|
00422 MOVE ZERO TO EMSG-SEQ. DESBD220
|
|
00423 MOVE EMSG-REC TO ESKL-REC. DESBD220
|
|
00424 DESBD220
|
|
00425 PERFORM S935-START-BROWSE THRU S935-EXIT. DESBD220
|
|
00426 IF L935-NO-REC-88 DESBD220
|
|
00427 NEXT SENTENCE DESBD220
|
|
00428 ELSE DESBD220
|
|
00429 PERFORM P2210-DELETE THRU P2210-EXIT DESBD220
|
|
00430 UNTIL L935-NO-REC-88 DESBD220
|
|
00431 END-IF. DESBD220
|
|
00432 DESBD220
|
|
00433 P2200-EXIT. DESBD220
|
|
00434 EXIT. DESBD220
|
|
00435 DESBD220
|
|
00436 P2210-DELETE. DESBD220
|
|
00437 MOVE ESKL-REC TO EMSG-REC. DESBD220
|
|
00438 IF EMSG-LOG-NO = WRK-LOG-NO DESBD220
|
|
00439 IF EMSG-TYPE-ERROR-88 DESBD220
|
|
00440 PERFORM S935-DELETE THRU S935-EXIT DESBD220
|
|
00441 ADD +1 TO WRK-EMSG-REC-DELETE DESBD220
|
|
00442 END-IF DESBD220
|
|
00443 END-IF. DESBD220
|
|
00444 DESBD220
|
|
00445 PERFORM S935-READ-NEXT THRU S935-EXIT. DESBD220
|
|
00446 DESBD220
|
|
00447 P2210-EXIT. DESBD220
|
|
00448 EXIT. DESBD220
|
|
00449 DESBD220
|
|
00450 P3000-BUILD-R102. DESBD220
|
|
00451 PERFORM P3100-READ-LOG THRU P3100-EXIT. DESBD220
|
|
00452 PERFORM P3200-READ-PRF THRU P3200-EXIT. DESBD220
|
|
00453 PERFORM P3300-FORMAT-R102 THRU P3300-EXIT. DESBD220
|
|
00454 DESBD220
|
|
00455 P3000-EXIT. DESBD220
|
|
00456 EXIT. DESBD220
|
|
00457 DESBD220
|
|
00458 P3100-READ-LOG. DESBD220
|
|
00459 MOVE LOW-VALUES TO ELOG-REC. DESBD220
|
|
00460 MOVE WRK-LOG-NO TO ELOG-LOG-NO. DESBD220
|
|
00461 SET ELOG-LOG-88 TO TRUE. DESBD220
|
|
00462 MOVE ELOG-KEY-AREA TO ESKL-KEY-AREA. DESBD220
|
|
00463 DESBD220
|
|
00464 PERFORM S935-READ THRU S935-EXIT. DESBD220
|
|
00465 IF L935-NO-REC-88 DESBD220
|
|
00466 DISPLAY 'CANNOT FIND LOG RECORD' DESBD220
|
|
00467 PERFORM S999-ABEND THRU S999-EXIT DESBD220
|
|
00468 ELSE DESBD220
|
|
00469 MOVE ESKL-REC TO ELOG-REC. DESBD220
|
|
00470 DESBD220
|
|
00471 P3100-EXIT. DESBD220
|
|
00472 EXIT. DESBD220
|
|
00473 DESBD220
|
|
00474 P3200-READ-PRF. DESBD220
|
|
00475 MOVE LOW-VALUES TO EPRF-REC. DESBD220
|
|
00476 MOVE ELOG-ELF-ID TO EPRF-ELF-ID. DESBD220
|
|
00477 MOVE ELOG-DATA-TYPE-CD TO EPRF-DATA-TYPE-CD. DESBD220
|
|
00478 SET EPRF-PRF-88 TO TRUE. DESBD220
|
|
00479 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DESBD220
|
|
00480 DESBD220
|
|
00481 PERFORM S935-READ THRU S935-EXIT. DESBD220
|
|
00482 DESBD220
|
|
00483 IF L935-NO-REC-88 DESBD220
|
|
00484 DISPLAY 'CANNOT FIND PRF RECORD' DESBD220
|
|
00485 PERFORM S999-ABEND THRU S999-EXIT DESBD220
|
|
00486 ELSE DESBD220
|
|
00487 MOVE ESKL-REC TO EPRF-REC. DESBD220
|
|
00488 DESBD220
|
|
00489 P3200-EXIT. DESBD220
|
|
00490 EXIT. DESBD220
|
|
00491 DESBD220
|
|
00492 P3300-FORMAT-R102. DESBD220
|
|
00493 MOVE ELOG-BOX-NO TO R102-BOX-NO. DESBD220
|
|
00494 MOVE EPRF-ELF-ID TO R102-ELF-ID. DESBD220
|
|
00495 MOVE WRK-LOG-NO TO R102-LOG-NO. DESBD220
|
|
00496 MOVE EPRF-FORMAT-CD TO R102-FORMAT-CD. DESBD220
|
|
00497 MOVE ELOG-CHNG-OPID TO R102-OPID. DESBD220
|
|
00498 DESBD220
|
|
00499 SET L112-FID-MAILING-ADDR-88 TO TRUE. DESBD220
|
|
00500 SET L112-ANCHOR-FIRST-88 TO TRUE. DESBD220
|
|
00501 MOVE EPRF-ELF-NAME TO L112-NAME. DESBD220
|
|
00502 MOVE EPRF-ADDRESS TO L112-ADDRESS. DESBD220
|
|
00503 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DESBD220
|
|
00504 MOVE L112-MAILING-ADDRESS TO R102-FMT-ADDR. DESBD220
|
|
00505 MOVE L112-ADVANCED-BARCODE TO R102-ADVANCED-BARCODE. DESBD220
|
|
00506 MOVE ZERO TO R102-MAIL-DATE. DESBD220
|
|
00507 MOVE ZERO TO ERR-SUB. DESBD220
|
|
00508 DESBD220
|
|
00509 P3300-EXIT. DESBD220
|
|
00510 EXIT. DESBD220
|
|
00511 DESBD220
|
|
00512 T0000-TERMINATE. DESBD220
|
|
00513 DISPLAY 'DESBD220 TERMINATION STATISTICS' DESBD220
|
|
00514 DISPLAY 'EMH RECORDS DELETED ' WRK-EEMH-REC-DELETE. DESBD220
|
|
00515 DISPLAY 'MSG RECORDS DELETED ' WRK-EMSG-REC-DELETE. DESBD220
|
|
00516 PERFORM T4000-CLOSE-FILES THRU T4000-EXIT. DESBD220
|
|
00517 DESBD220
|
|
00518 T0000-EXIT. DESBD220
|
|
00519 EXIT. DESBD220
|
|
00520 EJECT DESBD220
|
|
00521 DESBD220
|
|
00522 T4000-CLOSE-FILES. DESBD220
|
|
00523 DESBD220
|
|
00524 PERFORM S921-CLOSE THRU S921-EXIT. DESBD220
|
|
00525 PERFORM S935-CLOSE THRU S935-EXIT. DESBD220
|
|
00526 PERFORM S941-CLOSE THRU S941-EXIT. DESBD220
|
|
00527 DESBD220
|
|
00528 T4000-EXIT. DESBD220
|
|
00529 EXIT. DESBD220
|
|
00530 DESBD220
|
|
00531 S112-ADDR-FORMAT. DESBD220
|
|
00532 CALL 'DTSBU112' USING L112-LINK-AREA. DESBD220
|
|
00533 DESBD220
|
|
00534 S112-EXIT. DESBD220
|
|
00535 EXIT. DESBD220
|
|
00536 DESBD220
|
|
00537 S921-OPEN-UPDATE. DESBD220
|
|
00538 SET L921-OPEN-UPDATE-88 TO TRUE. DESBD220
|
|
00539 GO TO S921-AIX-IO. DESBD220
|
|
00540 DESBD220
|
|
00541 S921-READ. DESBD220
|
|
00542 SET L921-READ-88 TO TRUE. DESBD220
|
|
00543 GO TO S921-AIX-IO. DESBD220
|
|
00544 DESBD220
|
|
00545 S921-START-BROWSE. DESBD220
|
|
00546 SET L921-START-BROWSE-88 TO TRUE. DESBD220
|
|
00547 GO TO S921-AIX-IO. DESBD220
|
|
00548 DESBD220
|
|
00549 S921-READ-NEXT. DESBD220
|
|
00550 SET L921-READ-NEXT-88 TO TRUE. DESBD220
|
|
00551 GO TO S921-AIX-IO. DESBD220
|
|
00552 DESBD220
|
|
00553 S921-DELETE. DESBD220
|
|
00554 SET L921-DELETE-88 TO TRUE. DESBD220
|
|
00555 GO TO S921-AIX-IO. DESBD220
|
|
00556 DESBD220
|
|
00557 S921-CLOSE. DESBD220
|
|
00558 SET L921-CLOSE-88 TO TRUE. DESBD220
|
|
00559 GO TO S921-AIX-IO. DESBD220
|
|
00560 DESBD220
|
|
00561 S921-AIX-IO. DESBD220
|
|
00562 CALL 'DTSBU921' USING L921-LINK-AREA DESBD220
|
|
00563 ISKL-REC. DESBD220
|
|
00564 S921-EXIT. DESBD220
|
|
00565 EXIT. DESBD220
|
|
00566 SKIP3 DESBD220
|
|
00567 DESBD220
|
|
00568 S935-OPEN-READ. DESBD220
|
|
00569 SET L935-OPEN-READ-88 TO TRUE. DESBD220
|
|
00570 GO TO S935-ELF-IO. DESBD220
|
|
00571 DESBD220
|
|
00572 S935-OPEN-UPDATE. DESBD220
|
|
00573 SET L935-OPEN-UPDATE-88 TO TRUE. DESBD220
|
|
00574 GO TO S935-ELF-IO. DESBD220
|
|
00575 DESBD220
|
|
00576 S935-OPEN-UPDATE-NO-AIX. DESBD220
|
|
00577 SET L935-OPEN-UPDATE-NO-AIX-88 TO TRUE. DESBD220
|
|
00578 GO TO S935-ELF-IO. DESBD220
|
|
00579 DESBD220
|
|
00580 S935-READ. DESBD220
|
|
00581 SET L935-READ-88 TO TRUE. DESBD220
|
|
00582 GO TO S935-ELF-IO. DESBD220
|
|
00583 DESBD220
|
|
00584 S935-START-BROWSE. DESBD220
|
|
00585 SET L935-START-BROWSE-88 TO TRUE. DESBD220
|
|
00586 GO TO S935-ELF-IO. DESBD220
|
|
00587 DESBD220
|
|
00588 S935-READ-NEXT. DESBD220
|
|
00589 SET L935-READ-NEXT-88 TO TRUE. DESBD220
|
|
00590 GO TO S935-ELF-IO. DESBD220
|
|
00591 DESBD220
|
|
00592 S935-WRITE. DESBD220
|
|
00593 SET L935-WRITE-88 TO TRUE. DESBD220
|
|
00594 GO TO S935-ELF-IO. DESBD220
|
|
00595 DESBD220
|
|
00596 S935-WRITE-CHK-DUP-KEY. DESBD220
|
|
00597 SET L935-WRITE-CHK-DUP-KEY-88 TO TRUE. DESBD220
|
|
00598 GO TO S935-ELF-IO. DESBD220
|
|
00599 DESBD220
|
|
00600 S935-REWRITE. DESBD220
|
|
00601 SET L935-REWRITE-88 TO TRUE. DESBD220
|
|
00602 GO TO S935-ELF-IO. DESBD220
|
|
00603 DESBD220
|
|
00604 S935-DELETE. DESBD220
|
|
00605 SET L935-DELETE-88 TO TRUE. DESBD220
|
|
00606 GO TO S935-ELF-IO. DESBD220
|
|
00607 DESBD220
|
|
00608 S935-CLOSE. DESBD220
|
|
00609 SET L935-CLOSE-88 TO TRUE. DESBD220
|
|
00610 GO TO S935-ELF-IO. DESBD220
|
|
00611 DESBD220
|
|
00612 S935-ELF-IO. DESBD220
|
|
00613 CALL 'DTSBU935' USING L935-LINK-AREA DESBD220
|
|
00614 ESKL-REC. DESBD220
|
|
00615 S935-EXIT. DESBD220
|
|
00616 EXIT. DESBD220
|
|
00617 SKIP3 DESBD220
|
|
00618 DESBD220
|
|
00619 S941-OPEN-READ. DESBD220
|
|
00620 SET L941-OPEN-READ-88 TO TRUE. DESBD220
|
|
00621 GO TO S941-I. DESBD220
|
|
00622 DESBD220
|
|
00623 S941-READ-NEXT. DESBD220
|
|
00624 SET L941-READ-NEXT-88 TO TRUE. DESBD220
|
|
00625 GO TO S941-I. DESBD220
|
|
00626 DESBD220
|
|
00627 S941-CLOSE. DESBD220
|
|
00628 SET L941-CLOSE-88 TO TRUE. DESBD220
|
|
00629 GO TO S941-I. DESBD220
|
|
00630 DESBD220
|
|
00631 S941-I. DESBD220
|
|
00632 CALL 'DTSBU941' USING L941-LINK-AREA DESBD220
|
|
00633 RSK4-REC. DESBD220
|
|
00634 S941-EXIT. DESBD220
|
|
00635 EXIT. DESBD220
|
|
00636 DESBD220
|
|
00637 S946-WRITE-R102. DESBD220
|
|
00638 CALL 'DTSBU946' USING R102-REC. DESBD220
|
|
00639 GO TO S946-EXIT. DESBD220
|
|
00640 DESBD220
|
|
00641 S946-WRITE-R901. DESBD220
|
|
00642 CALL 'DTSBU946' USING R901-REC. DESBD220
|
|
00643 DESBD220
|
|
00644 S946-EXIT. DESBD220
|
|
00645 EXIT. DESBD220
|
|
00646 DESBD220
|
|
00647 S999-ABEND. DESBD220
|
|
00648 DISPLAY '**** DESBD220 ABENDING ' WRK-ABEND-MSG. DESBD220
|
|
00649 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD220
|
|
00650 S999-EXIT. DESBD220
|
|
00651 EXIT. DESBD220
|
|
00652 DESBD220
|