859 lines
68 KiB
COBOL
859 lines
68 KiB
COBOL
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
|