00001 IDENTIFICATION DIVISION. 11/30/98 00002 PROGRAM-ID. DTSBD993. DTSBD993 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. OCTOBER 1992. DTSBD993 00005 DATE-COMPILED. DTSBD993 00006 SKIP3 DTSBD993 00007 ***** DTSBD993 00008 * DTSBD993 00009 * FUNCTION: DELETE PARAMETER SPECIFIED RANGES OF EMPLOYER DTSBD993 00010 * FROM THE MASTER FILE. DTSBD993 00011 * DTSBD993 00012 * DTSBD993 00013 * MODIFICATION LOG: DTSBD993 00014 * DTSBD993 00015 * 12/01/98 INITIAL DEVELOPMENT. COPIED FROM MACBD993 CL**2 00016 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD993 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD993 00019 * REFERENCE RFP: #XXX PROGRAMMER: XXX DTSBD993 00020 * DTSBD993 00021 * DTSBD993 00022 * DESCRIPTION: DTSBD993 00023 * DTSBD993 00024 ***** DTSBD993 00025 SKIP3 DTSBD993 00026 ENVIRONMENT DIVISION. DTSBD993 00027 SKIP2 DTSBD993 00028 INPUT-OUTPUT SECTION. DTSBD993 00029 SKIP1 DTSBD993 00030 FILE-CONTROL. DTSBD993 00031 SELECT PARM-FILE ASSIGN TO SYSIN. DTSBD993 00032 EJECT DTSBD993 00033 DATA DIVISION. DTSBD993 00034 SKIP3 DTSBD993 00035 FILE SECTION. DTSBD993 00036 SKIP2 DTSBD993 00037 FD PARM-FILE DTSBD993 00038 RECORDING MODE IS F DTSBD993 00039 BLOCK CONTAINS 0 RECORDS DTSBD993 00040 LABEL RECORDS ARE STANDARD. DTSBD993 00041 SKIP1 DTSBD993 00042 01 PARM-REC. DTSBD993 00043 05 PREC-ID-NO PIC X(03). DTSBD993 00044 05 FILLER PIC X(01). DTSBD993 00045 05 PREC-START-EMP-NO-X PIC X(06). DTSBD993 00046 05 PREC-START-EMP-NO REDEFINES PREC-START-EMP-NO-X DTSBD993 00047 PIC 9(06). DTSBD993 00048 05 FILLER PIC X(01). DTSBD993 00049 05 PREC-END-EMP-NO-X PIC X(06). DTSBD993 00050 05 PREC-END-EMP-NO REDEFINES PREC-END-EMP-NO-X DTSBD993 00051 PIC 9(06). DTSBD993 00052 05 FILLER PIC X(63). DTSBD993 00053 EJECT DTSBD993 00054 WORKING-STORAGE SECTION. DTSBD993 000545 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD993 11/30/98'. DTSBD993 00055 SKIP3 DTSBD993 00056 01 WRK-AREA. DTSBD993 00057 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +993.DTSBD993 00058 DTSBD993 00059 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBD993 00060 DTSBD993 00061 05 PARM-EMP-DEL-CNT PIC S9(07) COMP-3. DTSBD993 00062 DTSBD993 00063 05 TOT-EMP-DEL-CNT PIC S9(07) COMP-3. DTSBD993 00064 DTSBD993 00065 05 PARM-EOF-IND PIC X(01). DTSBD993 00066 DTSBD993 00067 05 WRK-START-EMP-NO PIC S9(07) COMP-3. DTSBD993 00068 DTSBD993 00069 05 WRK-END-EMP-NO PIC S9(07) COMP-3. DTSBD993 00070 DTSBD993 00071 05 WRK-REC-TYPE PIC S9(04) COMP. DTSBD993 00072 EJECT DTSBD993 00073 01 L910-LINK-AREA. DTSBD993 00074 ++INCLUDE DTSIL910 CL**2 00075 EJECT DTSBD993 00076 01 MSKL-REC. DTSBD993 00077 ++INCLUDE DTSIMSKL CL**2 00078 EJECT DTSBD993 00079 01 MPRF-REC. DTSBD993 00080 ++INCLUDE DTSIMPRF CL**2 00081 EJECT DTSBD993 00082 01 L921-LINK-AREA. DTSBD993 00083 ++INCLUDE DTSIL921 CL**2 00084 EJECT DTSBD993 00085 01 ISKL-REC. DTSBD993 00086 ++INCLUDE DTSIISKL CL**2 00087 EJECT DTSBD993 00088 01 MLEN-AREA. DTSBD993 00089 ++INCLUDE DTSIMLEN CL**2 00090 EJECT DTSBD993 00091 PROCEDURE DIVISION. DTSBD993 00092 SKIP2 DTSBD993 00093 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD993 00094 DTSBD993 00095 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD993 00096 DTSBD993 00097 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD993 00098 SKIP2 DTSBD993 00099 GOBACK. DTSBD993 00100 EJECT DTSBD993 00101 I0000-INITIATE. DTSBD993 00102 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD993 00103 DTSBD993 00104 PERFORM I2000-INITIALIZE-WRK THRU I2000-EXIT. DTSBD993 00105 I0000-EXIT. DTSBD993 00106 EXIT. DTSBD993 00107 EJECT DTSBD993 00108 I1000-OPEN-FILES. DTSBD993 00109 OPEN INPUT PARM-FILE. DTSBD993 00110 DTSBD993 00111 MOVE 'N' TO L910-TRACE-IND DTSBD993 00112 L921-TRACE-IND. DTSBD993 00113 DTSBD993 00114 MOVE 'DTSBD993' TO L910-MOD-NAME CL**2 00115 L921-MOD-NAME. DTSBD993 00116 DTSBD993 00117 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD993 00118 DTSBD993 00119 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBD993 00120 I1000-EXIT. DTSBD993 00121 EXIT. DTSBD993 00122 EJECT DTSBD993 00123 I2000-INITIALIZE-WRK. DTSBD993 00124 MOVE +0 TO PARM-REC-CNT DTSBD993 00125 TOT-EMP-DEL-CNT. DTSBD993 00126 I2000-EXIT. DTSBD993 00127 EXIT. DTSBD993 00128 EJECT DTSBD993 00129 P0000-PROCESS. DTSBD993 00130 DISPLAY '*** DTSBD993 (EMPLOYER DELETE) STATISTICS ***'. CL**2 00131 DTSBD993 00132 MOVE 'N' TO PARM-EOF-IND. DTSBD993 00133 DTSBD993 00134 PERFORM P1000-READ-PROCESS-PARM THRU P1000-EXIT DTSBD993 00135 UNTIL PARM-EOF-IND = 'Y'. DTSBD993 00136 P0000-EXIT. DTSBD993 00137 EXIT. DTSBD993 00138 EJECT DTSBD993 00139 P1000-READ-PROCESS-PARM. DTSBD993 00140 READ PARM-FILE DTSBD993 00141 AT END DTSBD993 00142 MOVE 'Y' TO PARM-EOF-IND DTSBD993 00143 GO TO P1000-EXIT. DTSBD993 00144 DTSBD993 00145 IF PREC-ID-NO = '***' DTSBD993 00146 GO TO P1000-EXIT. DTSBD993 00147 DTSBD993 00148 ADD +1 TO PARM-REC-CNT. DTSBD993 00149 DTSBD993 00150 DISPLAY ' '. DTSBD993 00151 DISPLAY ' '. DTSBD993 00152 DISPLAY PARM-REC. DTSBD993 00153 DTSBD993 00154 IF PREC-START-EMP-NO NOT NUMERIC DTSBD993 00155 DISPLAY ' INVALID START EMP NO. PARM BYPASSED.' DTSBD993 00156 GO TO P1000-EXIT. DTSBD993 00157 DTSBD993 00158 MOVE PREC-START-EMP-NO TO WRK-START-EMP-NO. DTSBD993 00159 DTSBD993 00160 IF PREC-END-EMP-NO-X = SPACES DTSBD993 00161 MOVE WRK-START-EMP-NO TO WRK-END-EMP-NO DTSBD993 00162 ELSE DTSBD993 00163 IF (PREC-END-EMP-NO NOT NUMERIC) DTSBD993 00164 OR DTSBD993 00165 (PREC-END-EMP-NO < WRK-START-EMP-NO) DTSBD993 00166 DISPLAY ' INVALID END EMP NO. PARM BYPASSED.' DTSBD993 00167 GO TO P1000-EXIT DTSBD993 00168 ELSE DTSBD993 00169 MOVE PREC-END-EMP-NO TO WRK-END-EMP-NO. DTSBD993 00170 DTSBD993 00171 MOVE +0 TO PARM-EMP-DEL-CNT. DTSBD993 00172 DTSBD993 00173 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD993 00174 MOVE WRK-START-EMP-NO TO MPRF-EMP-NO. DTSBD993 00175 SET MPRF-PRF-88 TO TRUE. DTSBD993 00176 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD993 00177 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD993 00178 MOVE MSKL-REC TO MPRF-REC. DTSBD993 00179 PERFORM P1100-BROWSE-MPRF THRU P1100-EXIT DTSBD993 00180 UNTIL (L910-NO-REC-88) DTSBD993 00181 OR DTSBD993 00182 (MPRF-EMP-NO > WRK-END-EMP-NO). DTSBD993 00183 DTSBD993 00184 ADD PARM-EMP-DEL-CNT TO TOT-EMP-DEL-CNT. DTSBD993 00185 DTSBD993 00186 DISPLAY ' ' DTSBD993 00187 PARM-EMP-DEL-CNT DTSBD993 00188 ' EMPLOYERS DELETED.'. DTSBD993 00189 P1000-EXIT. DTSBD993 00190 EXIT. DTSBD993 00191 SKIP3 DTSBD993 00192 P1100-BROWSE-MPRF. DTSBD993 00193 ADD +1 TO PARM-EMP-DEL-CNT. DTSBD993 00194 DTSBD993 00195 PERFORM P1110-REC-TYPE-LOOP THRU P1110-EXIT DTSBD993 00196 VARYING MLEN-IDX FROM 3 BY 1 DTSBD993 00197 UNTIL MLEN-IDX > MLEN-MAX-REC-TYPE. DTSBD993 00198 DTSBD993 00199 MOVE MPRF-REC TO MSKL-REC. DTSBD993 00200 DTSBD993 00201 PERFORM S910-DELETE THRU S910-EXIT. DTSBD993 00202 DTSBD993 00203 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD993 00204 DTSBD993 00205 MOVE MSKL-REC TO MPRF-REC. DTSBD993 00206 P1100-EXIT. DTSBD993 00207 EXIT. DTSBD993 00208 SKIP3 DTSBD993 00209 P1110-REC-TYPE-LOOP. DTSBD993 00210 IF MLEN-FILE-ID (MLEN-IDX) = +0 DTSBD993 00211 GO TO P1110-EXIT. DTSBD993 00212 DTSBD993 00213 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD993 00214 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD993 00215 SET MSKL-REC-TYPE TO MLEN-IDX. DTSBD993 00216 DTSBD993 00217 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD993 00218 DTSBD993 00219 PERFORM P1111-DELETE-LOOP THRU P1111-EXIT DTSBD993 00220 UNTIL L910-NO-REC-88. DTSBD993 00221 P1110-EXIT. DTSBD993 00222 EXIT. DTSBD993 00223 SKIP3 DTSBD993 00224 P1111-DELETE-LOOP. DTSBD993 00225 PERFORM S910-DELETE THRU S910-EXIT. DTSBD993 00226 DTSBD993 00227 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD993 00228 P1111-EXIT. DTSBD993 00229 EXIT. DTSBD993 00230 EJECT DTSBD993 00231 T0000-TERMINATE. DTSBD993 00232 DISPLAY ' '. DTSBD993 00233 DISPLAY '*** DTSBD993 TERMINATION STATISTICS ***'. CL**2 00234 DISPLAY ' '. DTSBD993 00235 DISPLAY 'NUMBER OF PARAMETER RECORDS ENCOUNTERED: ' DTSBD993 00236 PARM-REC-CNT. DTSBD993 00237 DISPLAY ' '. DTSBD993 00238 DISPLAY 'NUMBER OF EMPLOYERS DELETED : ' DTSBD993 00239 TOT-EMP-DEL-CNT. DTSBD993 00240 DTSBD993 00241 CLOSE PARM-FILE. DTSBD993 00242 DTSBD993 00243 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD993 00244 DTSBD993 00245 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD993 00246 T0000-EXIT. DTSBD993 00247 EXIT. DTSBD993 00248 EJECT DTSBD993 00249 S910-OPEN-UPDATE. DTSBD993 00250 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD993 00251 GO TO S910-MSTR-IO. DTSBD993 00252 DTSBD993 00253 S910-READ. DTSBD993 00254 SET L910-READ-88 TO TRUE. DTSBD993 00255 GO TO S910-MSTR-IO. DTSBD993 00256 DTSBD993 00257 S910-START-BROWSE. DTSBD993 00258 SET L910-START-BROWSE-88 TO TRUE. DTSBD993 00259 GO TO S910-MSTR-IO. DTSBD993 00260 DTSBD993 00261 S910-READ-NEXT. DTSBD993 00262 SET L910-READ-NEXT-88 TO TRUE. DTSBD993 00263 GO TO S910-MSTR-IO. DTSBD993 00264 DTSBD993 00265 S910-WRITE. DTSBD993 00266 SET L910-WRITE-88 TO TRUE. DTSBD993 00267 GO TO S910-MSTR-IO. DTSBD993 00268 DTSBD993 00269 S910-REWRITE. DTSBD993 00270 SET L910-REWRITE-88 TO TRUE. DTSBD993 00271 GO TO S910-MSTR-IO. DTSBD993 00272 DTSBD993 00273 S910-DELETE. DTSBD993 00274 SET L910-DELETE-88 TO TRUE. DTSBD993 00275 GO TO S910-MSTR-IO. DTSBD993 00276 DTSBD993 00277 S910-CLOSE. DTSBD993 00278 SET L910-CLOSE-88 TO TRUE. DTSBD993 00279 GO TO S910-MSTR-IO. DTSBD993 00280 DTSBD993 00281 S910-MSTR-IO. DTSBD993 00282 CALL 'DTSBU910' USING L910-LINK-AREA CL**2 00283 MSKL-REC. DTSBD993 00284 S910-EXIT. DTSBD993 00285 EXIT. DTSBD993 00286 SKIP3 DTSBD993 00287 S921-OPEN-UPDATE. DTSBD993 00288 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD993 00289 GO TO S921-ALT-INDEX-IO. DTSBD993 00290 DTSBD993 00291 S921-CLOSE. DTSBD993 00292 SET L921-CLOSE-88 TO TRUE. DTSBD993 00293 GO TO S921-ALT-INDEX-IO. DTSBD993 00294 DTSBD993 00295 S921-ALT-INDEX-IO. DTSBD993 00296 CALL 'DTSBU921' USING L921-LINK-AREA CL**2 00297 ISKL-REC. DTSBD993 00298 S921-EXIT. DTSBD993 00299 EXIT. DTSBD993 00300 SKIP3 DTSBD993 00301 S999-ABEND. DTSBD993 00302 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00303 S999-EXIT. DTSBD993 00304 EXIT. DTSBD993