MP Batchs, copybooks, jcls, Procs
This commit is contained in:
858
Batch/DTSBD520.cob
Normal file
858
Batch/DTSBD520.cob
Normal file
@ -0,0 +1,858 @@
|
||||
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
|
||||
Reference in New Issue
Block a user