00001 IDENTIFICATION DIVISION. 05/10/04 00002 PROGRAM-ID. DTSBD520. DTSBD520 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV014 00004 DATE-WRITTEN. APRIL 1995. DTSBD520 00005 DATE-COMPILED. DTSBD520 00006 SKIP2 DTSBD520 00007 ***** DTSBD520 00008 * DTSBD520 00009 * FUNCTION: DTSBD520 00010 * DTSBD520 00011 * WAGE FILE EXTRACT STEP OF THE WAGE FILE / TAX FILE DTSBD520 00012 * COMPARISON PROCESS. DTSBD520 00013 * DTSBD520 00014 * DTSBD520 00015 * MODIFICATION HISTORY: DTSBD520 00016 * DTSBD520 00017 * 04/10/95 MODULE WRITTEN. DTSBD520 00018 * RFP: CR048 PROGRAMMER: EHH DTSBD520 00019 * DTSBD520 00020 * 02/13/1999 REVIEWED AND MODIFIED FOR DC. DTSBD520 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD520 00022 * DTSBD520 00023 * 05/20/1999 PICKUP MODIFICATIONS. LIMIT PARAMETER INPUT DTSBD520 00024 * YRQ TO GREATER THAN 19924. DTSBD520 00025 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBD520 00026 * DTSBD520 00027 * 12/14/1999 ADDED CALL TO WAGE I-O MODULE TO OPEN FOR INPUT DTSBD520 00028 * ONLY IN I0000-INITIATE. DTSBD520 00029 * REFERENCE: PROGRAMMER: GD DTSBD520 00030 * DTSBD520 00031 * 04/26/2004 CHANGE WGP-SEGMENT TO WGP-SEGMENT-ONE AND DTSBD520 00032 * WGD-SEGEMENT TO WGD-SEGEMENT-TWO : ZL1 DTSBD520 00033 * DTSBD520 00034 * DTSBD520 00035 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD520 00036 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD520 00037 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD520 00038 * DTSBD520 00039 * DTSBD520 00040 * DESCRIPTION: DTSBD520 00041 * DTSBD520 00042 * DTSBD520 00043 * DTSBD520 00044 * DTSBD520 00045 * DTSBD520 00046 * DTSBD520 00047 * DTSBD520 00048 * RECORDS READ: DTSBD520 00049 * DTSBD520 00050 * MPRF DTSBD520 00051 * MREL DTSBD520 00052 * DTSBD520 00053 * WAGE DTSBD520 00054 * DTSBD520 00055 * DTSBD520 00056 * PRINTED OUTPUTS: DTSBD520 00057 * DTSBD520 00058 * NONE DTSBD520 00059 * DTSBD520 00060 * DTSBD520 00061 * RECORDS WRITTEN: DTSBD520 00062 * DTSBD520 00063 * DTSIX737 WAGE FILE / TAX FILE COMPARISON EXTRACT DTSBD520 00064 * RECORD. DTSBD520 00065 * DTSBD520 00066 * DTSBD520 00067 * MODULES CALLED: DTSBD520 00068 * DTSBD520 00069 * EWG961D WAGE FILE ACCESS MODULE DTSBD520 00070 * DTSBU001 DATE CONVERSION MODULE DTSBD520 00071 * DTSBU004 YEAR/QUARTER CONVERSION MODULE DTSBD520 00072 * DTSBU910 TAX FILE ACCESS MODULE DTSBD520 00073 * DTSBD520 00074 ***** DTSBD520 00075 SKIP3 DTSBD520 00076 ENVIRONMENT DIVISION. DTSBD520 00077 SKIP3 DTSBD520 00078 INPUT-OUTPUT SECTION. DTSBD520 00079 SKIP2 DTSBD520 00080 FILE-CONTROL. DTSBD520 00081 SELECT EXTRACT-FILE ASSIGN TO EXTFILE DTSBD520 00082 FILE STATUS IS EXT-FILE-STATUS. DTSBD520 00083 SKIP2 DTSBD520 00084 DATA DIVISION. DTSBD520 00085 SKIP3 DTSBD520 00086 FILE SECTION. DTSBD520 00087 EJECT DTSBD520 00088 FD EXTRACT-FILE DTSBD520 00089 LABEL RECORDS ARE STANDARD DTSBD520 00090 RECORDING MODE IS F DTSBD520 00091 BLOCK CONTAINS 0 RECORDS. DTSBD520 00092 DTSBD520 00093 01 EXTRACT-REC. DTSBD520 00094 ++INCLUDE DTSIX737 DTSBD520 00095 EJECT DTSBD520 00096 WORKING-STORAGE SECTION. DTSBD520 000965 77 PAN-VALET PICTURE X(24) VALUE '014DTSBD520 05/10/04'. DTSBD520 00097 SKIP3 DTSBD520 00098 01 WRK-AREA. DTSBD520 00099 05 ABEND-CODE PIC S9(04) COMP VALUE +520. DTSBD520 00100 DTSBD520 00101 05 MOD-NAME PIC X(08) VALUE 'DTSBD520'.DTSBD520 00102 DTSBD520 00103 05 MIN-EMP-NO PIC S9(07) COMP-3 DTSBD520 00104 VALUE +1. DTSBD520 00105 DTSBD520 00106 05 MAX-EMP-NO PIC S9(07) COMP-3 DTSBD520 00107 VALUE +999999. DTSBD520 00108 DTSBD520 00109 05 WRK-PICKUP-YRQ PIC S9(05) COMP-3 DTSBD520 00110 VALUE +19924. DTSBD520 00111 DTSBD520 00112 DTSBD520 00113 05 ABEND-MSG PIC X(60). DTSBD520 00114 DTSBD520 00115 DTSBD520 00116 05 EXT-FILE-STATUS PIC X(02). DTSBD520 00117 88 EXT-FILE-OK-88 VALUE '00'. DTSBD520 00118 DTSBD520 00119 05 FILE-COMMAND PIC X(10). DTSBD520 00120 DTSBD520 00121 DTSBD520 00122 05 OUT-EXT-CNT PIC S9(09) COMP-3. DTSBD520 00123 DTSBD520 00124 05 DISPLAY-REC-CNT-X PIC X(11). DTSBD520 00125 05 DISPLAY-REC-CNT REDEFINES DISPLAY-REC-CNT-X DTSBD520 00126 PIC ZZZ,ZZZ,ZZ9. DTSBD520 00127 DTSBD520 00128 DTSBD520 00129 05 WRK-YEAR-START-DATE PIC S9(09) COMP-3. DTSBD520 00130 DTSBD520 00131 05 WRK-YEAR-END-DATE PIC S9(09) COMP-3. DTSBD520 00132 DTSBD520 00133 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSBD520 00134 DTSBD520 00135 05 WRK-END-YRQ PIC S9(05) COMP-3. DTSBD520 00136 DTSBD520 00137 05 WRK-YRQ-CNT PIC S9(04) COMP. DTSBD520 00138 DTSBD520 00139 05 WRK-YRQ OCCURS 4 TIMES DTSBD520 00140 INDEXED BY WRK-YRQ-IDX PIC S9(05) COMP-3. DTSBD520 00141 DTSBD520 00142 DTSBD520 00143 05 MAX-WAGES-EMP-CNT PIC S9(04) COMP. DTSBD520 00144 DTSBD520 00145 05 MAX-PRED-EMP-CNT PIC S9(04) COMP. DTSBD520 00146 DTSBD520 00147 DTSBD520 00148 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD520 00149 EJECT DTSBD520 00150 01 WAGES-TABLE. DTSBD520 00151 05 WAGES-EMP-MAX PIC S9(04) COMP VALUE +1000.DTSBD520 00152 DTSBD520 00153 05 WAGES-EMP-SUB PIC S9(04) COMP. DTSBD520 00154 DTSBD520 00155 05 WAGES-EMP-CNT PIC S9(04) COMP. DTSBD520 00156 DTSBD520 00157 05 WAGES-EMP-AREA OCCURS 1000 TIMES DTSBD520 00158 INDEXED BY WAGES-EMP-IDX1 DTSBD520 00159 WAGES-EMP-IDX2. DTSBD520 00160 10 WAGES-EMP-NO PIC S9(07) COMP-3. DTSBD520 00161 10 WAGES-YRQ-AMT OCCURS 4 TIMES DTSBD520 00162 INDEXED BY WAGES-YRQ-IDX DTSBD520 00163 PIC S9(09)V9(02) COMP-3. DTSBD520 00164 DTSBD520 00165 DTSBD520 00166 DTSBD520 00167 01 PRED-AREA. DTSBD520 00168 05 PRED-EMP-MAX PIC S9(04) COMP VALUE +100.DTSBD520 00169 DTSBD520 00170 05 SUCC-EMP-NO PIC S9(07) COMP-3. DTSBD520 00171 DTSBD520 00172 05 PRED-EMP-SUB PIC S9(04) COMP. DTSBD520 00173 DTSBD520 00174 05 PRED-EMP-CNT PIC S9(04) COMP. DTSBD520 00175 DTSBD520 00176 05 PRED-EMP-AREA OCCURS 100 TIMES DTSBD520 00177 INDEXED BY PRED-EMP-IDX1 DTSBD520 00178 PRED-EMP-IDX2. DTSBD520 00179 10 PRED-EMP-NO PIC S9(07) COMP-3. DTSBD520 00180 EJECT DTSBD520 00181 01 L001-LINK-AREA. DTSBD520 00182 ++INCLUDE DTSIL001 DTSBD520 00183 SKIP3 DTSBD520 00184 01 L004-LINK-AREA. DTSBD520 00185 ++INCLUDE DTSIL004 DTSBD520 00186 EJECT DTSBD520 00187 01 L910-LINK-AREA. DTSBD520 00188 ++INCLUDE DTSIL910 DTSBD520 00189 EJECT DTSBD520 00190 01 MSKL-REC. DTSBD520 00191 ++INCLUDE DTSIMSKL DTSBD520 00192 EJECT DTSBD520 00193 01 MPRF-REC. DTSBD520 00194 ++INCLUDE DTSIMPRF DTSBD520 00195 SKIP3 DTSBD520 00196 01 MREL-REC. DTSBD520 00197 ++INCLUDE DTSIMREL DTSBD520 00198 EJECT DTSBD520 00199 ++INCLUDE EWGLINKB DTSBD520 00200 EJECT DTSBD520 00201 01 EMPLOYER-INDS. DTSBD520 00202 05 EMPLOYER-IND OCCURS 999999 TIMES DTSBD520 00203 PIC X(01). DTSBD520 00204 88 EMP-PRED-EXISTS-NO-88 VALUE '0'. DTSBD520 00205 88 EMP-PRED-EXISTS-YES-88 VALUE '1'. DTSBD520 00206 88 EMP-NOT-RATED-88 VALUE '2'. DTSBD520 00207 EJECT DTSBD520 00208 LINKAGE SECTION. DTSBD520 00209 DTSBD520 00210 01 PARM-AREA. DTSBD520 00211 05 PARM-LENGTH PIC S9(04) COMP. DTSBD520 00212 DTSBD520 00213 05 PARM-DATA. DTSBD520 00214 10 PARM-YRQ-X PIC X(03). DTSBD520 00215 EJECT DTSBD520 00216 PROCEDURE DIVISION USING PARM-AREA. DTSBD520 00217 DTSBD520 00218 DTSBD520 00219 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD520 00220 DTSBD520 00221 DTSBD520 00222 MOVE LOW-VALUES TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBD520 00223 DTSBD520 00224 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DTSBD520 00225 DTSBD520 00226 SET DBW-READ-SEGMENT TO TRUE. DTSBD520 00227 DTSBD520 00228 SET DBW-PROFILE-SEGMENT TO TRUE. DTSBD520 00229 DTSBD520 00230 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 00231 DTSBD520 00232 DTSBD520 00233 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD520 00234 UNTIL DBW-END-OF-FILE. DTSBD520 00235 DTSBD520 00236 DTSBD520 00237 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD520 00238 DTSBD520 00239 DTSBD520 00240 MOVE +0 TO RETURN-CODE. DTSBD520 00241 DTSBD520 00242 DTSBD520 00243 GOBACK. DTSBD520 00244 EJECT DTSBD520 00245 I0000-INITIATE. DTSBD520 00246 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD520 00247 DTSBD520 00248 PERFORM SEXT-OPEN-OUTPUT THRU SEXT-EXIT. DTSBD520 00249 DTSBD520 00250 SET DBW-OPEN-INPUT TO TRUE. DTSBD520 00251 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 00252 DTSBD520 00253 MOVE +0 TO OUT-EXT-CNT. DTSBD520 00254 DTSBD520 00255 MOVE +0 TO MAX-WAGES-EMP-CNT DTSBD520 00256 MAX-PRED-EMP-CNT. DTSBD520 00257 DTSBD520 00258 PERFORM I1000-PARMS THRU I1000-EXIT. DTSBD520 00259 DTSBD520 00260 PERFORM I2000-PRED-EXISTS-INDS THRU I2000-EXIT. DTSBD520 00261 I0000-EXIT. DTSBD520 00262 EXIT. DTSBD520 00263 SKIP3 DTSBD520 00264 I1000-PARMS. DTSBD520 00265 IF PARM-LENGTH = +3 DTSBD520 00266 NEXT SENTENCE DTSBD520 00267 ELSE DTSBD520 00268 MOVE 'PARM-LENGTH NOT EQUAL TO 3' DTSBD520 00269 TO ABEND-MSG DTSBD520 00270 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 00271 DTSBD520 00272 DTSBD520 00273 DISPLAY '***'. DTSBD520 00274 DTSBD520 00275 DISPLAY '*** ' DTSBD520 00276 MOD-NAME DTSBD520 00277 ' PARAMETERS: ' DTSBD520 00278 PARM-DATA. DTSBD520 00279 DTSBD520 00280 DISPLAY '***'. DTSBD520 00281 DTSBD520 00282 DTSBD520 00283 MOVE PARM-YRQ-X TO L004-QTR-3. DTSBD520 00284 DTSBD520 00285 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD520 00286 DTSBD520 00287 IF (L004-INVALID-QTR) DTSBD520 00288 OR DTSBD520 00289 (L004-QTR-5-9 <= WRK-PICKUP-YRQ) DTSBD520 00290 MOVE 'PARM-YRQ-X NOT VALID' DTSBD520 00291 TO ABEND-MSG DTSBD520 00292 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 00293 DTSBD520 00294 MOVE L004-QTR-5-Q TO WRK-YRQ-CNT. DTSBD520 00295 DTSBD520 00296 MOVE L004-QTR-5-9 TO WRK-END-YRQ. DTSBD520 00297 DTSBD520 00298 MOVE 1 TO L004-QTR-5-Q. DTSBD520 00299 DTSBD520 00300 MOVE L004-QTR-5-9 TO WRK-START-YRQ. DTSBD520 00301 DTSBD520 00302 PERFORM DTSBD520 00303 VARYING L004-QTR-5-Q FROM 1 BY 1 DTSBD520 00304 UNTIL L004-QTR-5-Q > WRK-YRQ-CNT DTSBD520 00305 MOVE L004-QTR-5-9 TO WRK-YRQ (L004-QTR-5-Q) DTSBD520 00306 END-PERFORM. DTSBD520 00307 DTSBD520 00308 DTSBD520 00309 MOVE 1 TO L004-QTR-5-Q. DTSBD520 00310 DTSBD520 00311 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 00312 DTSBD520 00313 MOVE L004-QTR-START-DATE TO WRK-YEAR-START-DATE. DTSBD520 00314 DTSBD520 00315 DTSBD520 00316 MOVE 4 TO L004-QTR-5-Q. DTSBD520 00317 DTSBD520 00318 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 00319 DTSBD520 00320 MOVE L004-QTR-END-DATE TO WRK-YEAR-END-DATE. DTSBD520 00321 I1000-EXIT. DTSBD520 00322 EXIT. DTSBD520 00323 SKIP3 DTSBD520 00324 I2000-PRED-EXISTS-INDS. DTSBD520 00325 MOVE ALL '0' TO EMPLOYER-INDS. DTSBD520 00326 DTSBD520 00327 DTSBD520 00328 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD520 00329 DTSBD520 00330 MOVE +0 TO MSKL-EMP-NO. DTSBD520 00331 DTSBD520 00332 SET MSKL-PRF-88 TO TRUE. DTSBD520 00333 DTSBD520 00334 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD520 00335 DTSBD520 00336 PERFORM I2100-MPRF-SCAN THRU I2100-EXIT DTSBD520 00337 UNTIL L910-NO-REC-88. DTSBD520 00338 I2000-EXIT. DTSBD520 00339 EXIT. DTSBD520 00340 SKIP3 DTSBD520 00341 I2100-MPRF-SCAN. DTSBD520 00342 MOVE MSKL-REC TO MPRF-REC. DTSBD520 00343 DTSBD520 00344 DTSBD520 00345 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD520 00346 DTSBD520 00347 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD520 00348 DTSBD520 00349 SET MSKL-REL-88 TO TRUE. DTSBD520 00350 DTSBD520 00351 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD520 00352 DTSBD520 00353 PERFORM I2110-MREL-SCAN THRU I2110-EXIT DTSBD520 00354 UNTIL L910-NO-REC-88. DTSBD520 00355 DTSBD520 00356 DTSBD520 00357 IF (MPRF-EMP-NO < MIN-EMP-NO) DTSBD520 00358 OR DTSBD520 00359 (MPRF-EMP-NO > MAX-EMP-NO) DTSBD520 00360 NEXT SENTENCE DTSBD520 00361 ELSE DTSBD520 00362 IF NOT MPRF-CLASS-RATED-88 DTSBD520 00363 SET EMP-NOT-RATED-88 (MPRF-EMP-NO) TO TRUE. DTSBD520 00364 DTSBD520 00365 DTSBD520 00366 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD520 00367 DTSBD520 00368 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD520 00369 I2100-EXIT. DTSBD520 00370 EXIT. DTSBD520 00371 SKIP3 DTSBD520 00372 I2110-MREL-SCAN. DTSBD520 00373 MOVE MSKL-REC TO MREL-REC. DTSBD520 00374 DTSBD520 00375 PERFORM I2111-EVALUATE-MREL THRU I2111-EXIT. DTSBD520 00376 DTSBD520 00377 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD520 00378 I2110-EXIT. DTSBD520 00379 EXIT. DTSBD520 00380 SKIP3 DTSBD520 00381 I2111-EVALUATE-MREL. DTSBD520 00382 IF (MREL-EFF-DATE < WRK-YEAR-START-DATE) DTSBD520 00383 OR DTSBD520 00384 (MREL-EFF-DATE > WRK-YEAR-END-DATE) DTSBD520 00385 GO TO I2111-EXIT. DTSBD520 00386 DTSBD520 00387 IF MREL-EXP-TRNSF-NO-88 DTSBD520 00388 GO TO I2111-EXIT. DTSBD520 00389 DTSBD520 00390 IF (MREL-EMP-NO < MIN-EMP-NO) DTSBD520 00391 OR DTSBD520 00392 (MREL-EMP-NO > MAX-EMP-NO) DTSBD520 00393 GO TO I2111-EXIT. DTSBD520 00394 DTSBD520 00395 SET EMP-PRED-EXISTS-YES-88 (MREL-EMP-NO) TO TRUE. DTSBD520 00396 I2111-EXIT. DTSBD520 00397 EXIT. DTSBD520 00398 EJECT DTSBD520 00399 P0000-PROCESS. DTSBD520 00400 MOVE +0 TO WAGES-EMP-CNT. DTSBD520 00401 DTSBD520 00402 DTSBD520 00403 SET DBW-RANDOM-PROCESSING TO TRUE. DTSBD520 00404 DTSBD520 00405 SET DBW-WAGE-SEGMENT TO TRUE. DTSBD520 00406 DTSBD520 00407 PERFORM P1000-WGD-LOOP THRU P1000-EXIT DTSBD520 00408 UNTIL DBW-NO-RECORD-FOUND. DTSBD520 00409 DTSBD520 00410 DTSBD520 00411 IF WAGES-EMP-CNT > MAX-WAGES-EMP-CNT DTSBD520 00412 MOVE WAGES-EMP-CNT TO MAX-WAGES-EMP-CNT. DTSBD520 00413 DTSBD520 00414 DTSBD520 00415 PERFORM P2000-EXTRACT-LOOP THRU P2000-EXIT DTSBD520 00416 VARYING WAGES-EMP-IDX1 FROM 1 BY 1 DTSBD520 00417 UNTIL WAGES-EMP-IDX1 > WAGES-EMP-CNT. DTSBD520 00418 DTSBD520 00419 DTSBD520 00420 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DTSBD520 00421 DTSBD520 00422 SET DBW-READ-SEGMENT TO TRUE. DTSBD520 00423 DTSBD520 00424 SET DBW-PROFILE-SEGMENT TO TRUE. DTSBD520 00425 DTSBD520 00426 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 00427 P0000-EXIT. DTSBD520 00428 EXIT. DTSBD520 00429 SKIP3 DTSBD520 00430 P1000-WGD-LOOP. DTSBD520 00431 SET DBW-READ-SEGMENT TO TRUE. DTSBD520 00432 DTSBD520 00433 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 00434 DTSBD520 00435 IF DBW-NO-RECORD-FOUND DTSBD520 00436 GO TO P1000-EXIT. DTSBD520 00437 DTSBD520 00438 DTSBD520 00439 IF WGD-ACCOUNT-NUMBER NOT NUMERIC DTSBD520 00440 GO TO P1000-EXIT. DTSBD520 00441 DTSBD520 00442 IF (WGD-ACCOUNT-NUMBER < MIN-EMP-NO) DTSBD520 00443 OR DTSBD520 00444 (WGD-ACCOUNT-NUMBER > MAX-EMP-NO) DTSBD520 00445 GO TO P1000-EXIT. DTSBD520 00446 DTSBD520 00447 DTSBD520 00448 IF EMP-NOT-RATED-88 (WGD-ACCOUNT-NUMBER) DTSBD520 00449 GO TO P1000-EXIT. DTSBD520 00450 DTSBD520 00451 DTSBD520 00452 MOVE WGD-YR TO L004-QTR-3-YR. DTSBD520 00453 DTSBD520 00454 MOVE WGD-QTR TO L004-QTR-3-Q. DTSBD520 00455 DTSBD520 00456 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD520 00457 DTSBD520 00458 IF L004-INVALID-QTR DTSBD520 00459 GO TO P1000-EXIT. DTSBD520 00460 DTSBD520 00461 IF (L004-QTR-5-9 < WRK-START-YRQ) DTSBD520 00462 OR DTSBD520 00463 (L004-QTR-5-9 > WRK-END-YRQ) DTSBD520 00464 GO TO P1000-EXIT. DTSBD520 00465 DTSBD520 00466 DTSBD520 00467 IF WGD-QUARTER-EARNINGS NOT NUMERIC DTSBD520 00468 GO TO P1000-EXIT. DTSBD520 00469 DTSBD520 00470 DTSBD520 00471 MOVE +0 TO WAGES-EMP-SUB. DTSBD520 00472 DTSBD520 00473 PERFORM DTSBD520 00474 VARYING WAGES-EMP-IDX1 FROM 1 BY 1 DTSBD520 00475 UNTIL (WAGES-EMP-IDX1 > WAGES-EMP-CNT) DTSBD520 00476 OR DTSBD520 00477 (WAGES-EMP-SUB NOT = +0) DTSBD520 00478 IF WAGES-EMP-NO (WAGES-EMP-IDX1) = WGD-ACCOUNT-NUMBER DTSBD520 00479 SET WAGES-EMP-SUB TO WAGES-EMP-IDX1 DTSBD520 00480 END-IF DTSBD520 00481 END-PERFORM. DTSBD520 00482 DTSBD520 00483 DTSBD520 00484 IF WAGES-EMP-SUB = +0 DTSBD520 00485 IF WAGES-EMP-CNT < WAGES-EMP-MAX DTSBD520 00486 ADD +1 TO WAGES-EMP-CNT DTSBD520 00487 MOVE WAGES-EMP-CNT TO WAGES-EMP-SUB DTSBD520 00488 MOVE WGD-ACCOUNT-NUMBER DTSBD520 00489 TO WAGES-EMP-NO (WAGES-EMP-SUB) DTSBD520 00490 MOVE +0 TO WAGES-YRQ-AMT (WAGES-EMP-SUB 1) DTSBD520 00491 WAGES-YRQ-AMT (WAGES-EMP-SUB 2) DTSBD520 00492 WAGES-YRQ-AMT (WAGES-EMP-SUB 3) DTSBD520 00493 WAGES-YRQ-AMT (WAGES-EMP-SUB 4) DTSBD520 00494 ELSE DTSBD520 00495 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBD520 00496 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 00497 DTSBD520 00498 ***** DTSBD520 00499 * DTSBD520 00500 * PER A 02/15/1999 EMAIL FROM GIL DIMATTIA, IGNORE DTSBD520 00501 * WGP-WHOLE-DOLLARS AND ALWAYS USE WGD-QUARTER-EARNINGS. DTSBD520 00502 * DTSBD520 00503 ***** DTSBD520 00504 DTSBD520 00505 *****IF WGP-WHOLE-DOLLARS DTSBD520 00506 *********ADD WGD-QTR-EARN-WHOLE-DOLLAR DTSBD520 00507 **********TO WAGES-YRQ-AMT (WAGES-EMP-SUB L004-QTR-5-Q) DTSBD520 00508 *****ELSE DTSBD520 00509 DTSBD520 00510 ADD WGD-QUARTER-EARNINGS DTSBD520 00511 TO WAGES-YRQ-AMT (WAGES-EMP-SUB L004-QTR-5-Q). DTSBD520 00512 P1000-EXIT. DTSBD520 00513 EXIT. DTSBD520 00514 EJECT DTSBD520 00515 P2000-EXTRACT-LOOP. DTSBD520 00516 MOVE LOW-VALUES TO EXTRACT-REC. DTSBD520 00517 DTSBD520 00518 DTSBD520 00519 MOVE WAGES-EMP-NO (WAGES-EMP-IDX1) TO X737-EMP-NO. DTSBD520 00520 DTSBD520 00521 MOVE WGP-SSN TO X737-SSN. DTSBD520 00522 DTSBD520 00523 MOVE WRK-YRQ-CNT TO X737-YRQ-CNT. DTSBD520 00524 DTSBD520 00525 PERFORM P2100-WAGES-TO-X737 THRU P2100-EXIT DTSBD520 00526 VARYING WAGES-YRQ-IDX FROM 1 BY 1 DTSBD520 00527 UNTIL WAGES-YRQ-IDX > X737-YRQ-CNT. DTSBD520 00528 DTSBD520 00529 IF (WAGES-EMP-CNT > +1) DTSBD520 00530 AND DTSBD520 00531 (EMP-PRED-EXISTS-YES-88 (X737-EMP-NO)) DTSBD520 00532 DTSBD520 00533 MOVE +0 TO PRED-EMP-CNT DTSBD520 00534 DTSBD520 00535 PERFORM P3000-TABLE-PREDECESSORS THRU P3000-EXIT DTSBD520 00536 DTSBD520 00537 IF PRED-EMP-CNT > MAX-PRED-EMP-CNT DTSBD520 00538 MOVE PRED-EMP-CNT TO MAX-PRED-EMP-CNT DTSBD520 00539 END-IF DTSBD520 00540 DTSBD520 00541 PERFORM P2200-PRED-WAGES THRU P2200-EXIT DTSBD520 00542 VARYING WAGES-EMP-IDX2 FROM 1 BY 1 DTSBD520 00543 UNTIL WAGES-EMP-IDX2 > WAGES-EMP-CNT. DTSBD520 00544 DTSBD520 00545 DTSBD520 00546 PERFORM SEXT-WRITE THRU SEXT-EXIT. DTSBD520 00547 P2000-EXIT. DTSBD520 00548 EXIT. DTSBD520 00549 SKIP3 DTSBD520 00550 P2100-WAGES-TO-X737. DTSBD520 00551 SET WRK-YRQ-IDX TO WAGES-YRQ-IDX. DTSBD520 00552 DTSBD520 00553 SET X737-YRQ-IDX TO WAGES-YRQ-IDX. DTSBD520 00554 DTSBD520 00555 MOVE WRK-YRQ (WRK-YRQ-IDX) DTSBD520 00556 TO X737-YRQ (X737-YRQ-IDX). DTSBD520 00557 DTSBD520 00558 MOVE WAGES-YRQ-AMT (WAGES-EMP-IDX1 WAGES-YRQ-IDX) DTSBD520 00559 TO X737-EMP-WAGES (X737-YRQ-IDX). DTSBD520 00560 DTSBD520 00561 MOVE +0 TO X737-PRED-WAGES (X737-YRQ-IDX). DTSBD520 00562 P2100-EXIT. DTSBD520 00563 EXIT. DTSBD520 00564 SKIP3 DTSBD520 00565 P2200-PRED-WAGES. DTSBD520 00566 MOVE WAGES-EMP-NO (WAGES-EMP-IDX2) TO WRK-EMP-NO. DTSBD520 00567 DTSBD520 00568 IF WRK-EMP-NO = X737-EMP-NO DTSBD520 00569 GO TO P2200-EXIT. DTSBD520 00570 DTSBD520 00571 MOVE +0 TO PRED-EMP-SUB. DTSBD520 00572 DTSBD520 00573 PERFORM DTSBD520 00574 VARYING PRED-EMP-IDX1 FROM 1 BY 1 DTSBD520 00575 UNTIL (PRED-EMP-SUB NOT = +0) DTSBD520 00576 OR DTSBD520 00577 (PRED-EMP-IDX1 > PRED-EMP-CNT) DTSBD520 00578 IF WRK-EMP-NO = PRED-EMP-NO (PRED-EMP-IDX1) DTSBD520 00579 SET PRED-EMP-SUB TO PRED-EMP-IDX1 DTSBD520 00580 END-IF DTSBD520 00581 END-PERFORM. DTSBD520 00582 DTSBD520 00583 IF PRED-EMP-SUB = +0 DTSBD520 00584 GO TO P2200-EXIT. DTSBD520 00585 DTSBD520 00586 PERFORM P2210-PRED-WAGES-TO-X737 THRU P2210-EXIT DTSBD520 00587 VARYING WAGES-YRQ-IDX FROM 1 BY 1 DTSBD520 00588 UNTIL WAGES-YRQ-IDX > X737-YRQ-CNT. DTSBD520 00589 P2200-EXIT. DTSBD520 00590 EXIT. DTSBD520 00591 SKIP3 DTSBD520 00592 P2210-PRED-WAGES-TO-X737. DTSBD520 00593 SET X737-YRQ-IDX TO WAGES-YRQ-IDX. DTSBD520 00594 DTSBD520 00595 ADD WAGES-YRQ-AMT (WAGES-EMP-IDX2 WAGES-YRQ-IDX) DTSBD520 00596 TO X737-PRED-WAGES (X737-YRQ-IDX). DTSBD520 00597 P2210-EXIT. DTSBD520 00598 EXIT. DTSBD520 00599 EJECT DTSBD520 00600 P3000-TABLE-PREDECESSORS. DTSBD520 00601 MOVE X737-EMP-NO TO SUCC-EMP-NO. DTSBD520 00602 DTSBD520 00603 PERFORM P3900-TABLE-PREDECESSORS THRU P3900-EXIT. DTSBD520 00604 DTSBD520 00605 PERFORM P3100-PRED-LOOP THRU P3100-EXIT DTSBD520 00606 VARYING PRED-EMP-IDX1 FROM 1 BY 1 DTSBD520 00607 UNTIL PRED-EMP-IDX1 > PRED-EMP-CNT. DTSBD520 00608 P3000-EXIT. DTSBD520 00609 EXIT. DTSBD520 00610 SKIP3 DTSBD520 00611 P3100-PRED-LOOP. DTSBD520 00612 MOVE PRED-EMP-NO (PRED-EMP-IDX1) TO SUCC-EMP-NO. DTSBD520 00613 DTSBD520 00614 PERFORM P3900-TABLE-PREDECESSORS THRU P3900-EXIT. DTSBD520 00615 P3100-EXIT. DTSBD520 00616 EXIT. DTSBD520 00617 SKIP3 DTSBD520 00618 P3900-TABLE-PREDECESSORS. DTSBD520 00619 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD520 00620 DTSBD520 00621 MOVE SUCC-EMP-NO TO MSKL-EMP-NO. DTSBD520 00622 DTSBD520 00623 SET MSKL-REL-88 TO TRUE. DTSBD520 00624 DTSBD520 00625 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD520 00626 DTSBD520 00627 DTSBD520 00628 PERFORM DTSBD520 00629 UNTIL L910-NO-REC-88 DTSBD520 00630 MOVE MSKL-REC TO MREL-REC DTSBD520 00631 PERFORM P3910-ANALYZE-MREL THRU P3910-EXIT DTSBD520 00632 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD520 00633 END-PERFORM. DTSBD520 00634 P3900-EXIT. DTSBD520 00635 EXIT. DTSBD520 00636 SKIP3 DTSBD520 00637 P3910-ANALYZE-MREL. DTSBD520 00638 IF (MREL-EFF-DATE < WRK-YEAR-START-DATE) DTSBD520 00639 OR DTSBD520 00640 (MREL-EFF-DATE > WRK-YEAR-END-DATE) DTSBD520 00641 GO TO P3910-EXIT. DTSBD520 00642 DTSBD520 00643 IF MREL-EXP-TRNSF-NO-88 DTSBD520 00644 GO TO P3910-EXIT. DTSBD520 00645 DTSBD520 00646 IF MREL-PRED-EMP-NO = X737-EMP-NO DTSBD520 00647 GO TO P3910-EXIT. DTSBD520 00648 DTSBD520 00649 MOVE +0 TO PRED-EMP-SUB. DTSBD520 00650 DTSBD520 00651 PERFORM DTSBD520 00652 VARYING PRED-EMP-IDX2 FROM 1 BY 1 DTSBD520 00653 UNTIL (PRED-EMP-IDX2 > PRED-EMP-CNT) DTSBD520 00654 OR DTSBD520 00655 (PRED-EMP-SUB NOT = +0) DTSBD520 00656 IF PRED-EMP-NO (PRED-EMP-IDX2) = MREL-PRED-EMP-NO DTSBD520 00657 SET PRED-EMP-SUB TO PRED-EMP-IDX2 DTSBD520 00658 END-IF DTSBD520 00659 END-PERFORM. DTSBD520 00660 DTSBD520 00661 IF PRED-EMP-SUB = +0 DTSBD520 00662 IF PRED-EMP-CNT < PRED-EMP-MAX DTSBD520 00663 ADD +1 TO PRED-EMP-CNT DTSBD520 00664 MOVE MREL-PRED-EMP-NO DTSBD520 00665 TO PRED-EMP-NO (PRED-EMP-CNT) DTSBD520 00666 ELSE DTSBD520 00667 MOVE 'LOGIC ERROR P3910-1' TO ABEND-MSG DTSBD520 00668 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 00669 P3910-EXIT. DTSBD520 00670 EXIT. DTSBD520 00671 EJECT DTSBD520 00672 T0000-TERMINATE. DTSBD520 00673 SET DBW-CLOSE-DATASET TO TRUE. DTSBD520 00674 DTSBD520 00675 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 00676 DTSBD520 00677 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD520 00678 DTSBD520 00679 PERFORM SEXT-CLOSE THRU SEXT-EXIT. DTSBD520 00680 DTSBD520 00681 DTSBD520 00682 DISPLAY '***'. DTSBD520 00683 DTSBD520 00684 DISPLAY '*** ' DTSBD520 00685 MOD-NAME DTSBD520 00686 ' TERMINATION STATISTICS'. DTSBD520 00687 DTSBD520 00688 DISPLAY '*** '. DTSBD520 00689 DTSBD520 00690 MOVE WRK-START-YRQ TO L004-QTR-5-9. DTSBD520 00691 DTSBD520 00692 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 00693 DTSBD520 00694 DISPLAY '*** FIRST QUARTER EXTRACTED: ' DTSBD520 00695 L004-SLASH-QTR. DTSBD520 00696 DTSBD520 00697 DISPLAY '*** '. DTSBD520 00698 DTSBD520 00699 MOVE WRK-END-YRQ TO L004-QTR-5-9. DTSBD520 00700 DTSBD520 00701 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 00702 DTSBD520 00703 DISPLAY '*** LAST QUARTER EXTRACTED: ' DTSBD520 00704 L004-SLASH-QTR. DTSBD520 00705 DTSBD520 00706 DISPLAY '*** '. DTSBD520 00707 DTSBD520 00708 MOVE OUT-EXT-CNT TO DISPLAY-REC-CNT. DTSBD520 00709 DTSBD520 00710 DISPLAY '*** EXTRACT RECORDS WRITTEN: ' DTSBD520 00711 DISPLAY-REC-CNT-X. DTSBD520 00712 DTSBD520 00713 DISPLAY '*** '. DTSBD520 00714 DTSBD520 00715 MOVE MAX-WAGES-EMP-CNT TO DISPLAY-REC-CNT. DTSBD520 00716 DTSBD520 00717 DISPLAY '*** MAXIMUM WAGES-EMP-AREA OCCURRENCES USED: ' DTSBD520 00718 DISPLAY-REC-CNT-X. DTSBD520 00719 DTSBD520 00720 DISPLAY '*** '. DTSBD520 00721 DTSBD520 00722 MOVE MAX-PRED-EMP-CNT TO DISPLAY-REC-CNT. DTSBD520 00723 DTSBD520 00724 DISPLAY '*** MAXIMUM PRED-EMP-AREA OCCURRENCES USED: ' DTSBD520 00725 DISPLAY-REC-CNT-X. DTSBD520 00726 T0000-EXIT. DTSBD520 00727 EXIT. DTSBD520 00728 EJECT DTSBD520 00729 S001-FROM-FED-8. DTSBD520 00730 SET L001-FROM-FED-8 TO TRUE. DTSBD520 00731 GO TO S001-DATE. DTSBD520 00732 DTSBD520 00733 S001-FROM-ABS-DAY. DTSBD520 00734 SET L001-FROM-ABS-DAY TO TRUE. DTSBD520 00735 GO TO S001-DATE. DTSBD520 00736 DTSBD520 00737 S001-DATE. DTSBD520 00738 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD520 00739 S001-EXIT. DTSBD520 00740 EXIT. DTSBD520 00741 SKIP3 DTSBD520 00742 S004-FROM-3. DTSBD520 00743 SET L004-FROM-3 TO TRUE. DTSBD520 00744 GO TO S004-YRQ. DTSBD520 00745 DTSBD520 00746 S004-FROM-5. DTSBD520 00747 SET L004-FROM-5 TO TRUE. DTSBD520 00748 GO TO S004-YRQ. DTSBD520 00749 DTSBD520 00750 S004-YRQ. DTSBD520 00751 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD520 00752 S004-EXIT. DTSBD520 00753 EXIT. DTSBD520 00754 SKIP3 DTSBD520 00755 S910-OPEN-READ. DTSBD520 00756 SET L910-OPEN-READ-88 TO TRUE. DTSBD520 00757 GO TO S910-MSTR-IO. DTSBD520 00758 DTSBD520 00759 S910-READ. DTSBD520 00760 SET L910-READ-88 TO TRUE. DTSBD520 00761 GO TO S910-MSTR-IO. DTSBD520 00762 DTSBD520 00763 S910-READ-NEXT. DTSBD520 00764 SET L910-READ-NEXT-88 TO TRUE. DTSBD520 00765 GO TO S910-MSTR-IO. DTSBD520 00766 DTSBD520 00767 S910-START-BROWSE. DTSBD520 00768 SET L910-START-BROWSE-88 TO TRUE. DTSBD520 00769 GO TO S910-MSTR-IO. DTSBD520 00770 DTSBD520 00771 S910-CLOSE. DTSBD520 00772 SET L910-CLOSE-88 TO TRUE. DTSBD520 00773 GO TO S910-MSTR-IO. DTSBD520 00774 DTSBD520 00775 S910-MSTR-IO. DTSBD520 00776 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD520 00777 MSKL-REC. DTSBD520 00778 S910-EXIT. DTSBD520 00779 EXIT. DTSBD520 00780 SKIP3 DTSBD520 00781 S961-WAGE-I. DTSBD520 00782 IF DBW-WAGE-SEGMENT DTSBD520 00783 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DTSBD520 00784 WGD-SEGMENT-TWO DTSBD520 00785 ELSE DTSBD520 00786 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DTSBD520 00787 WGP-SEGMENT-ONE. DTSBD520 00788 S961-EXIT. DTSBD520 00789 EXIT. DTSBD520 00790 SKIP3 DTSBD520 00791 SEXT-OPEN-OUTPUT. DTSBD520 00792 OPEN OUTPUT EXTRACT-FILE. DTSBD520 00793 DTSBD520 00794 IF EXT-FILE-OK-88 DTSBD520 00795 GO TO SEXT-EXIT DTSBD520 00796 ELSE DTSBD520 00797 MOVE 'OPEN' TO FILE-COMMAND DTSBD520 00798 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD520 00799 THRU SEXT-UNEXPECTED-EXIT DTSBD520 00800 GO TO SEXT-EXIT. DTSBD520 00801 DTSBD520 00802 SEXT-WRITE. DTSBD520 00803 WRITE EXTRACT-REC. DTSBD520 00804 DTSBD520 00805 IF EXT-FILE-OK-88 DTSBD520 00806 ADD +1 TO OUT-EXT-CNT DTSBD520 00807 GO TO SEXT-EXIT DTSBD520 00808 ELSE DTSBD520 00809 MOVE 'WRITE' TO FILE-COMMAND DTSBD520 00810 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD520 00811 THRU SEXT-UNEXPECTED-EXIT DTSBD520 00812 GO TO SEXT-EXIT. DTSBD520 00813 DTSBD520 00814 SEXT-CLOSE. DTSBD520 00815 CLOSE EXTRACT-FILE. DTSBD520 00816 DTSBD520 00817 IF EXT-FILE-OK-88 DTSBD520 00818 GO TO SEXT-EXIT DTSBD520 00819 ELSE DTSBD520 00820 MOVE 'CLOSE' TO FILE-COMMAND DTSBD520 00821 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD520 00822 THRU SEXT-UNEXPECTED-EXIT DTSBD520 00823 GO TO SEXT-EXIT. DTSBD520 00824 DTSBD520 00825 SEXT-EXIT. DTSBD520 00826 EXIT. DTSBD520 00827 DTSBD520 00828 SEXT-UNEXPECTED-FILE-STATUS. DTSBD520 00829 MOVE SPACES TO ABEND-MSG. DTSBD520 00830 DTSBD520 00831 STRING DTSBD520 00832 'UNEXPECTED EXTRACT FILE STATUS ON ' DTSBD520 00833 DELIMITED BY SIZE DTSBD520 00834 FILE-COMMAND DTSBD520 00835 DELIMITED BY ' ' DTSBD520 00836 ': ' DTSBD520 00837 DELIMITED BY SIZE DTSBD520 00838 EXT-FILE-STATUS DTSBD520 00839 DELIMITED BY SIZE DTSBD520 00840 INTO DTSBD520 00841 ABEND-MSG. DTSBD520 00842 DTSBD520 00843 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 00844 SEXT-UNEXPECTED-EXIT. DTSBD520 00845 EXIT. DTSBD520 00846 SKIP3 DTSBD520 00847 S999-ABEND. DTSBD520 00848 DISPLAY '***'. DTSBD520 00849 DISPLAY '*** ' DTSBD520 00850 MOD-NAME DTSBD520 00851 ' IS ABENDING BECAUSE ' DTSBD520 00852 ABEND-MSG. DTSBD520 00853 DISPLAY '***'. DTSBD520 00854 DTSBD520 00855 CALL 'DTSBU999' USING ABEND-CODE. DTSBD520 00856 S999-EXIT. DTSBD520 00857 EXIT. DTSBD520