00001 IDENTIFICATION DIVISION. 05/22/01 00002 PROGRAM-ID. DESBD120. DESBD120 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. MARCH 2001. DESBD120 00005 DATE-COMPILED. DESBD120 00006 SKIP3 DESBD120 00007 ***** DESBD120 00008 * DESBD120 00009 * FUNCTION: PRIOR TO RERUNNING THE PROCESS THAT BUILDS DESBD120 00010 * W4 TRANSACTIONS FOR WAGE TAPES, IT IS NECESSARY DESBD120 00011 * TO DELETE ANY W4 AND ELECTRONIC MEDIA RECORDS DESBD120 00012 * CREATED DURING PRIOR RUNS. DESBD120 00013 * DESBD120 00014 * THIS JOBS DELETES ELECTRONIC MEDIA RECORDS DESBD120 00015 * FOR THE LOG NUMBER ENTERED AS A PARM. DESBD120 00016 * DESBD120 00017 * ELECTRONIC MEDIA TRACKING SYSTEM DESBD120 00018 * DESBD120 00019 ***** DESBD120 00020 DESBD120 00021 ******************************************************************DESBD120 00022 * MODIFICATION HISTORY: *DESBD120 00023 * *DESBD120 00024 * 04-26-2001 INITIAL DEVELOPMENT *DESBD120 00025 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *DESBD120 00026 * *DESBD120 00027 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD120 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD120 00029 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *DESBD120 00030 ******************************************************************DESBD120 00031 DESBD120 00032 ENVIRONMENT DIVISION. DESBD120 00033 DESBD120 00034 CONFIGURATION SECTION. DESBD120 00035 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DESBD120 00036 DESBD120 00037 INPUT-OUTPUT SECTION. DESBD120 00038 DESBD120 00039 FILE-CONTROL. DESBD120 00040 SELECT EMH-MSG-FILE ASSIGN TO BD120EMI DESBD120 00041 FILE STATUS IS EMH-MSG-FILE-STATUS. DESBD120 00042 DESBD120 00043 SELECT TEMP-MSG-FILE ASSIGN TO BD120EMO DESBD120 00044 FILE STATUS IS TEMP-MSG-FILE-STATUS. DESBD120 00045 DESBD120 00046 DATA DIVISION. DESBD120 00047 DESBD120 00048 FILE SECTION. DESBD120 00049 DESBD120 00050 ************************************************************ DESBD120 00051 * REPORT FILE RECORD PASSED FROM BENEFITS UPDATE. DESBD120 00052 ************************************************************ DESBD120 00053 FD EMH-MSG-FILE DESBD120 00054 RECORDING MODE IS V DESBD120 00055 BLOCK CONTAINS 0 CHARACTERS DESBD120 00056 RECORD CONTAINS 1 TO 4089 CHARACTERS DESBD120 00057 LABEL RECORDS ARE STANDARD. DESBD120 00058 DESBD120 00059 01 EMH-MSG-REC. DESBD120 00060 05 EMH-MSG-DATA DESBD120 00061 OCCURS 1 TO 4089 TIMES DESBD120 00062 DEPENDING ON WS-REC-LEN PIC X(01). DESBD120 00063 DESBD120 00064 FD TEMP-MSG-FILE DESBD120 00065 RECORDING MODE IS V DESBD120 00066 BLOCK CONTAINS 0 CHARACTERS DESBD120 00067 RECORD CONTAINS 1 TO 4089 CHARACTERS DESBD120 00068 LABEL RECORDS ARE STANDARD. DESBD120 00069 DESBD120 00070 01 TEMP-MSG-REC. DESBD120 00071 05 TEMP-MSG-DATA DESBD120 00072 OCCURS 1 TO 4089 TIMES DESBD120 00073 DEPENDING ON WS-REC-LEN PIC X(01). DESBD120 00074 DESBD120 00075 WORKING-STORAGE SECTION. DESBD120 000755 77 PAN-VALET PICTURE X(24) VALUE '001DESBD120 05/22/01'. DESBD120 00076 DESBD120 00077 01 WRK-AREA. DESBD120 00078 05 ABEND-CODE PIC S9(04) COMP VALUE +120. DESBD120 00079 05 ABEND-MOD PIC X(08) DESBD120 00080 VALUE 'DTSBU999'. DESBD120 00081 DESBD120 00082 05 EMH-MSG-FILE-STATUS PIC X(02) VALUE SPACES. DESBD120 00083 88 EMH-MSG-FILE-OK-88 VALUE ZERO. DESBD120 00084 88 EMH-MSG-FILE-EOF-88 VALUE '10'. DESBD120 00085 DESBD120 00086 05 TEMP-MSG-FILE-STATUS PIC X(02) VALUE SPACES. DESBD120 00087 88 TEMP-MSG-FILE-OK-88 VALUE ZERO. DESBD120 00088 88 TEMP-MSG-FILE-EOF-88 VALUE '10'. DESBD120 00089 DESBD120 00090 05 WRK-EMH-MSG-READ-CNT PIC 9(07) COMP-3. DESBD120 00091 05 WRK-EMH-MSG-DELETE-CNT PIC 9(07) COMP-3. DESBD120 00092 05 WRK-EMH-MSG-WRITE-CNT PIC 9(07) COMP-3. DESBD120 00093 DESBD120 00094 01 WRK-VARIABLES. DESBD120 00095 DESBD120 00096 05 WRK-TRACE-IND PIC X(01) VALUE SPACE. DESBD120 00097 DESBD120 00098 05 WRK-LOG-NO PIC 9(10) VALUE 0. DESBD120 00099 05 FILLER REDEFINES WRK-LOG-NO. DESBD120 00100 10 WRK-LOG-NO-PFX PIC 9(04). DESBD120 00101 10 WRK-LOG-NO-SFX PIC 9(06). DESBD120 00102 DESBD120 00103 05 WRK-INPUT-FILE-EMPTY-IND PIC X(01) VALUE ' '. DESBD120 00104 88 WRK-INPUT-FILE-EMPTY-YES VALUE 'Y'. DESBD120 00105 88 WRK-INPUT-FILE-EMPTY-NO VALUE 'N'. DESBD120 00106 DESBD120 00107 05 WRK-FATAL-ERROR-IND PIC X(01) VALUE ' '. DESBD120 00108 88 WRK-FATAL-ERROR-YES VALUE 'Y'. DESBD120 00109 88 WRK-FATAL-ERROR-NO VALUE 'N'. DESBD120 00110 DESBD120 00111 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD120'. DESBD120 00112 DESBD120 00113 01 WS-EMH-MSG-REC. DESBD120 00114 05 WS-REC-LEN PIC S9(04) COMP VALUE +0. DESBD120 00115 05 WS-LOG-NO PIC 9(10). DESBD120 00116 05 WS-REC-TYPE PIC X(03). DESBD120 00117 88 WS-LOG-88 VALUE 'LOG'. DESBD120 00118 88 WS-MSG-88 VALUE 'MSG'. DESBD120 00119 88 WS-EMH-88 VALUE 'EMH'. DESBD120 00120 05 WS-DATA PIC X(4092). DESBD120 00121 DESBD120 00122 01 L921-LINK-AREA. DESBD120 00123 ++INCLUDE DTSIL921 DESBD120 00124 EJECT DESBD120 00125 01 ISKL-REC. DESBD120 00126 ++INCLUDE DTSIISKL DESBD120 00127 EJECT DESBD120 00128 DESBD120 00129 01 IEAL-REC. DESBD120 00130 ++INCLUDE DTSIIEAL DESBD120 00131 EJECT DESBD120 00132 DESBD120 00133 01 L935-LINK-AREA. DESBD120 00134 ++INCLUDE DTSIL935 DESBD120 00135 EJECT DESBD120 00136 DESBD120 00137 01 ESKL-REC. DESBD120 00138 ++INCLUDE DTSIESKL DESBD120 00139 EJECT DESBD120 00140 DESBD120 00141 01 EPRF-REC. DESBD120 00142 ++INCLUDE DTSIEPRF DESBD120 00143 EJECT DESBD120 00144 DESBD120 00145 01 ELOG-REC. DESBD120 00146 ++INCLUDE DTSIELOG DESBD120 00147 EJECT DESBD120 00148 DESBD120 00149 01 EMSG-REC. DESBD120 00150 ++INCLUDE DTSIEMSG DESBD120 00151 EJECT DESBD120 00152 DESBD120 00153 01 EEMH-REC. DESBD120 00154 ++INCLUDE DTSIEEMH DESBD120 00155 EJECT DESBD120 00156 DESBD120 00157 LINKAGE SECTION. DESBD120 00158 01 PARM-AREA. DESBD120 00159 05 PARM-LENGTH PIC S9(04) COMP. DESBD120 00160 05 PARM-LOG-NO PIC 9(06). DESBD120 00161 DESBD120 00162 PROCEDURE DIVISION USING PARM-AREA. DESBD120 00163 DESBD120 00164 PROC0000-MAIN. DESBD120 00165 DESBD120 00166 PERFORM INIT0000-INITIATE THRU INIT0000-EXIT. DESBD120 00167 DESBD120 00168 IF WRK-INPUT-FILE-EMPTY-NO DESBD120 00169 PERFORM PROC1000-WRITE-SCAN-FILE THRU PROC1000-EXIT DESBD120 00170 UNTIL EMH-MSG-FILE-EOF-88. DESBD120 00171 DESBD120 00172 PERFORM TERM0000-TERMINATE THRU TERM0000-EXIT. DESBD120 00173 DESBD120 00174 PROC0000-EXIT. DESBD120 00175 DESBD120 00176 GOBACK. DESBD120 00177 DESBD120 00178 INIT0000-INITIATE. DESBD120 00179 DESBD120 00180 PERFORM INIT1000-GET-PARM THRU INIT1000-EXIT. DESBD120 00181 DESBD120 00182 PERFORM INIT2000-INIT-WRK-DATA THRU INIT2000-EXIT. DESBD120 00183 PERFORM INIT3000-OPEN-FILES THRU INIT3000-EXIT. DESBD120 00184 PERFORM INIT4000-READ-FIRST THRU INIT4000-EXIT. DESBD120 00185 DESBD120 00186 INIT0000-EXIT. DESBD120 00187 EXIT. DESBD120 00188 DESBD120 00189 ******************************************************************DESBD120 00190 * EDIT PARM-LOG AND CONVERTED TO 10 BYTES LOG NUMBER. *DESBD120 00191 ******************************************************************DESBD120 00192 INIT1000-GET-PARM. DESBD120 00193 IF PARM-LENGTH NOT = +6 DESBD120 00194 DISPLAY 'INVALID PARM LENGTH ' PARM-LENGTH DESBD120 00195 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. DESBD120 00196 DESBD120 00197 IF PARM-LOG-NO NOT NUMERIC DESBD120 00198 DISPLAY 'INVALID LOG NUMBER ' DESBD120 00199 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. DESBD120 00200 DESBD120 00201 MOVE ZEROS TO WRK-LOG-NO. DESBD120 00202 MOVE PARM-LOG-NO TO WRK-LOG-NO-SFX. DESBD120 00203 DESBD120 00204 MOVE ' ' TO WRK-TRACE-IND. DESBD120 00205 MOVE WRK-TRACE-IND TO L921-TRACE-IND DESBD120 00206 L935-TRACE-IND. DESBD120 00207 MOVE WRK-MOD-NAME TO L921-MOD-NAME DESBD120 00208 L935-MOD-NAME. DESBD120 00209 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD120 00210 PERFORM S935-OPEN-READ THRU S935-EXIT. DESBD120 00211 DESBD120 00212 PERFORM SERV1000-READ-ELOG THRU SERV1000-EXIT. DESBD120 00213 IF WRK-FATAL-ERROR-YES DESBD120 00214 DISPLAY '>>> DESBD200 ABENDING <<<' DESBD120 00215 DISPLAY '>>> INVALID LOG NUMBER ' PARM-LOG-NO DESBD120 00216 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. DESBD120 00217 DESBD120 00218 INIT1000-EXIT. DESBD120 00219 EXIT. DESBD120 00220 DESBD120 00221 INIT2000-INIT-WRK-DATA. DESBD120 00222 DESBD120 00223 MOVE ZERO TO WRK-EMH-MSG-READ-CNT DESBD120 00224 WRK-EMH-MSG-DELETE-CNT DESBD120 00225 WRK-EMH-MSG-WRITE-CNT. DESBD120 00226 DESBD120 00227 INIT2000-EXIT. DESBD120 00228 EXIT. DESBD120 00229 DESBD120 00230 INIT3000-OPEN-FILES. DESBD120 00231 DESBD120 00232 OPEN INPUT EMH-MSG-FILE. DESBD120 00233 DESBD120 00234 IF NOT EMH-MSG-FILE-OK-88 DESBD120 00235 DISPLAY 'EMH-LOG FILE OPEN ERROR: ' EMH-MSG-FILE-STATUS DESBD120 00236 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. DESBD120 00237 DESBD120 00238 OPEN OUTPUT TEMP-MSG-FILE. DESBD120 00239 DESBD120 00240 IF NOT TEMP-MSG-FILE-OK-88 DESBD120 00241 DISPLAY 'TEMP-LOG FILE OPEN ERROR: ' TEMP-MSG-FILE-STATUS DESBD120 00242 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. DESBD120 00243 DESBD120 00244 INIT3000-EXIT. DESBD120 00245 EXIT. DESBD120 00246 DESBD120 00247 INIT4000-READ-FIRST. DESBD120 00248 DESBD120 00249 READ EMH-MSG-FILE INTO WS-EMH-MSG-REC. DESBD120 00250 DESBD120 00251 IF EMH-MSG-FILE-OK-88 DESBD120 00252 SET WRK-INPUT-FILE-EMPTY-NO TO TRUE DESBD120 00253 ADD 1 TO WRK-EMH-MSG-READ-CNT DESBD120 00254 ELSE DESBD120 00255 IF EMH-MSG-FILE-EOF-88 DESBD120 00256 DISPLAY 'INPUT FILE IS EMPTY: ' DESBD120 00257 EMH-MSG-FILE-STATUS DESBD120 00258 SET WRK-INPUT-FILE-EMPTY-YES TO TRUE DESBD120 00259 END-IF DESBD120 00260 END-IF. DESBD120 00261 DESBD120 00262 INIT4000-EXIT. DESBD120 00263 EXIT. DESBD120 00264 DESBD120 00265 PROC1000-WRITE-SCAN-FILE. DESBD120 00266 DESBD120 00267 IF WS-LOG-NO = WRK-LOG-NO DESBD120 00268 ADD 1 TO WRK-EMH-MSG-DELETE-CNT DESBD120 00269 GO TO PROC1000-READ-NEXT DESBD120 00270 ELSE DESBD120 00271 PERFORM SERV1300-WRITE-TEMP THRU SERV1300-EXIT DESBD120 00272 END-IF. DESBD120 00273 DESBD120 00274 PROC1000-READ-NEXT. DESBD120 00275 PERFORM SERV1200-READ-NEXT THRU SERV1200-EXIT. DESBD120 00276 DESBD120 00277 PROC1000-EXIT. DESBD120 00278 EXIT. DESBD120 00279 DESBD120 00280 TERM0000-TERMINATE. DESBD120 00281 DESBD120 00282 PERFORM TERM1000-DISPLAY-SUMMARY THRU TERM1000-EXIT. DESBD120 00283 PERFORM TERM2000-CLOSE-FILES THRU TERM2000-EXIT. DESBD120 00284 DESBD120 00285 TERM0000-EXIT. DESBD120 00286 EXIT. DESBD120 00287 DESBD120 00288 TERM1000-DISPLAY-SUMMARY. DESBD120 00289 DESBD120 00290 DISPLAY ' '. DESBD120 00291 DESBD120 00292 DISPLAY '*** DESBD120 TERMINATION STATISTICS ***'. DESBD120 00293 DESBD120 00294 DISPLAY ' '. DESBD120 00295 DESBD120 00296 DISPLAY ' DESBD120 TOTAL INPUT RECORDS READ : ' DESBD120 00297 WRK-EMH-MSG-READ-CNT. DESBD120 00298 DESBD120 00299 DISPLAY ' '. DESBD120 00300 DESBD120 00301 DISPLAY ' DESBD120 TOTAL LOG RECORDS WRITTEN : ' DESBD120 00302 WRK-EMH-MSG-WRITE-CNT. DESBD120 00303 DESBD120 00304 DISPLAY ' '. DESBD120 00305 DESBD120 00306 DISPLAY ' DESBD120 TOTAL LOG RECORDS DELETE : ' DESBD120 00307 WRK-EMH-MSG-DELETE-CNT. DESBD120 00308 DESBD120 00309 TERM1000-EXIT. DESBD120 00310 EXIT. DESBD120 00311 DESBD120 00312 TERM2000-CLOSE-FILES. DESBD120 00313 DESBD120 00314 CLOSE EMH-MSG-FILE DESBD120 00315 TEMP-MSG-FILE. DESBD120 00316 DESBD120 00317 TERM2000-EXIT. DESBD120 00318 EXIT. DESBD120 00319 DESBD120 00320 SERV1000-READ-ELOG. DESBD120 00321 DESBD120 00322 MOVE LOW-VALUES TO IEAL-KEY-AREA. DESBD120 00323 SET IEAL-EAL-88 TO TRUE. DESBD120 00324 MOVE WRK-LOG-NO-SFX TO IEAL-LOG-NO-SFX. DESBD120 00325 MOVE ZEROS TO IEAL-LOG-NO. DESBD120 00326 MOVE IEAL-REC TO ISKL-REC. DESBD120 00327 DESBD120 00328 PERFORM S921-START-BROWSE THRU S921-EXIT. DESBD120 00329 DESBD120 00330 IF L921-OK-88 DESBD120 00331 MOVE ISKL-REC TO IEAL-REC DESBD120 00332 IF IEAL-LOG-NO-SFX = WRK-LOG-NO-SFX DESBD120 00333 MOVE IEAL-LOG-NO TO WRK-LOG-NO DESBD120 00334 ELSE DESBD120 00335 DISPLAY 'INVALID READ PARM-LOG-NBR: ' PARM-LOG-NO DESBD120 00336 SET WRK-FATAL-ERROR-YES TO TRUE DESBD120 00337 ELSE DESBD120 00338 DISPLAY 'INVALID READ PARM-LOG-NO: ' PARM-LOG-NO DESBD120 00339 SET WRK-FATAL-ERROR-YES TO TRUE DESBD120 00340 END-IF. DESBD120 00341 DESBD120 00342 SERV1000-EXIT. DESBD120 00343 EXIT. DESBD120 00344 DESBD120 00345 DESBD120 00346 SERV1200-READ-NEXT. DESBD120 00347 DESBD120 00348 READ EMH-MSG-FILE INTO WS-EMH-MSG-REC. DESBD120 00349 DESBD120 00350 IF EMH-MSG-FILE-OK-88 DESBD120 00351 ADD 1 TO WRK-EMH-MSG-READ-CNT DESBD120 00352 ELSE DESBD120 00353 IF EMH-MSG-FILE-EOF-88 DESBD120 00354 NEXT SENTENCE DESBD120 00355 ELSE DESBD120 00356 DISPLAY 'INPUT FILE READ ERROR: ' DESBD120 00357 EMH-MSG-FILE-STATUS DESBD120 00358 ' RECS READ ' WRK-EMH-MSG-READ-CNT DESBD120 00359 PERFORM SERV9999-ABEND THRU SERV9999-EXIT DESBD120 00360 END-IF DESBD120 00361 END-IF. DESBD120 00362 DESBD120 00363 SERV1200-EXIT. DESBD120 00364 EXIT. DESBD120 00365 DESBD120 00366 SERV1300-WRITE-TEMP. DESBD120 00367 DESBD120 00368 WRITE TEMP-MSG-REC FROM WS-EMH-MSG-REC. DESBD120 00369 DESBD120 00370 IF TEMP-MSG-FILE-OK-88 DESBD120 00371 ADD 1 TO WRK-EMH-MSG-WRITE-CNT DESBD120 00372 ELSE DESBD120 00373 DISPLAY 'TEMP FILE WRITE ERROR: ' DESBD120 00374 TEMP-MSG-FILE-STATUS DESBD120 00375 ' RECS WRITE ' WRK-EMH-MSG-WRITE-CNT DESBD120 00376 PERFORM SERV9999-ABEND THRU SERV9999-EXIT DESBD120 00377 END-IF. DESBD120 00378 DESBD120 00379 SERV1300-EXIT. DESBD120 00380 EXIT. DESBD120 00381 DESBD120 00382 SERV9999-ABEND. DESBD120 00383 DISPLAY '**** DESBD120 ABENDING '. DESBD120 00384 CALL ABEND-MOD USING ABEND-CODE. DESBD120 00385 SERV9999-EXIT. DESBD120 00386 EXIT. DESBD120 00387 DESBD120 00388 S921-OPEN-UPDATE. DESBD120 00389 SET L921-OPEN-UPDATE-88 TO TRUE. DESBD120 00390 GO TO S921-AIX-IO. DESBD120 00391 DESBD120 00392 S921-OPEN-READ. DESBD120 00393 SET L921-OPEN-READ-88 TO TRUE. DESBD120 00394 GO TO S921-AIX-IO. DESBD120 00395 DESBD120 00396 S921-READ. DESBD120 00397 SET L921-READ-88 TO TRUE. DESBD120 00398 GO TO S921-AIX-IO. DESBD120 00399 DESBD120 00400 S921-START-BROWSE. DESBD120 00401 SET L921-START-BROWSE-88 TO TRUE. DESBD120 00402 GO TO S921-AIX-IO. DESBD120 00403 DESBD120 00404 S921-READ-NEXT. DESBD120 00405 SET L921-READ-NEXT-88 TO TRUE. DESBD120 00406 GO TO S921-AIX-IO. DESBD120 00407 DESBD120 00408 S921-DELETE. DESBD120 00409 SET L921-DELETE-88 TO TRUE. DESBD120 00410 GO TO S921-AIX-IO. DESBD120 00411 DESBD120 00412 S921-CLOSE. DESBD120 00413 SET L921-CLOSE-88 TO TRUE. DESBD120 00414 GO TO S921-AIX-IO. DESBD120 00415 DESBD120 00416 S921-AIX-IO. DESBD120 00417 CALL 'DTSBU921' USING L921-LINK-AREA DESBD120 00418 ISKL-REC. DESBD120 00419 S921-EXIT. DESBD120 00420 EXIT. DESBD120 00421 DESBD120 00422 DESBD120 00423 S935-OPEN-READ. DESBD120 00424 SET L935-OPEN-READ-88 TO TRUE. DESBD120 00425 GO TO S935-ELF-IO. DESBD120 00426 DESBD120 00427 S935-READ. DESBD120 00428 SET L935-READ-88 TO TRUE. DESBD120 00429 GO TO S935-ELF-IO. DESBD120 00430 DESBD120 00431 S935-START-BROWSE. DESBD120 00432 SET L935-START-BROWSE-88 TO TRUE. DESBD120 00433 GO TO S935-ELF-IO. DESBD120 00434 DESBD120 00435 S935-READ-NEXT. DESBD120 00436 SET L935-READ-NEXT-88 TO TRUE. DESBD120 00437 GO TO S935-ELF-IO. DESBD120 00438 DESBD120 00439 S935-CLOSE. DESBD120 00440 SET L935-CLOSE-88 TO TRUE. DESBD120 00441 GO TO S935-ELF-IO. DESBD120 00442 DESBD120 00443 S935-ELF-IO. DESBD120 00444 CALL 'DTSBU935' USING L935-LINK-AREA DESBD120 00445 ESKL-REC. DESBD120 00446 S935-EXIT. DESBD120 00447 EXIT. DESBD120 00448 DESBD120