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