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