00001 IDENTIFICATION DIVISION. 10/24/18 00002 PROGRAM-ID. DESBD426. DESBD427 00003 AUTHOR. NGC. LV040 00004 DATE-WRITTEN. NOVEMBER 2013. CL**2 00005 DATE-COMPILED. DESBD427 00006 DESBD427 00007 **** CL*38 00008 * DESBD427 00009 * FUNCTION: UPDATE THE WAGE NAME VSAM FILE WITH FULL NAME CL**2 00010 * FROM ESSP DAILY WAGE FILE SUBMISSIONS. CL*32 00011 * DESBD427 00012 * DESBD427 00013 * MODIFICATION HISTORY: DESBD427 00014 * DESBD427 00015 * 05/16/2018 INITIAL DEVELOPMENT CL*32 00016 * REFERENCE: PROGRAMMER: ZL1 CL*32 00017 * DESBD427 00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD427 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD427 00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD427 00021 * DESBD427 00022 * DESCRIPTION: DESBD427 00023 * DESBD427 00024 * DESBD427 00025 * RECORDS READ: DESBD427 00026 * TDEC ONTINE AND DELINQUENT WAGE RECORDS CL**2 00027 * DESBD427 00028 * PRINTED OUTPUTS: DESBD427 00029 * NONE DESBD427 00030 * DESBD427 00031 * RECORDS WRITTEN: DESBD427 00032 * UPDATE WAGE NAME VSAM FILE CL**2 00033 * DESBD427 00034 * MODULES CALLED: DESBD427 00035 * NONE DESBD427 00036 * DESBD427 00037 ***** DESBD427 00038 DESBD427 00039 ENVIRONMENT DIVISION. DESBD427 00040 SKIP2 DESBD427 00041 INPUT-OUTPUT SECTION. DESBD427 00042 SKIP3 DESBD427 00043 FILE-CONTROL. DESBD427 00044 SELECT ESSP-WAGE-IN ASSIGN TO DTSFX144 CL*32 00045 FILE STATUS IS TDEC-IN-STATUS. DESBD427 00046 DESBD427 00047 SELECT X146-WAGE-OUT ASSIGN TO DTSFX146 CL*14 00048 FILE STATUS IS TDEC-IN-STATUS. CL**8 00049 CL**8 00050 DESBD427 00051 DATA DIVISION. DESBD427 00052 DESBD427 00053 FILE SECTION. DESBD427 00054 CL*24 00055 FD ESSP-WAGE-IN CL*32 00056 RECORDING MODE F CL*24 00057 BLOCK CONTAINS 0 RECORDS CL*24 00058 LABEL RECORDS ARE STANDARD. CL*32 00059 CL*24 00060 01 ESSP-WAGE-REC PIC X(120). CL*39 00061 CL*24 00062 FD X146-WAGE-OUT CL**8 00063 RECORDING MODE IS F CL**8 00064 LABEL RECORDS ARE STANDARD CL**8 00065 BLOCK CONTAINS 0 CHARACTERS. CL**8 00066 SKIP1 CL**8 00067 01 X146-REC PIC X(76). CL*15 00068 CL**8 00069 DESBD427 00070 WORKING-STORAGE SECTION. DESBD427 000705 77 PAN-VALET PICTURE X(24) VALUE '040DESBD427 10/24/18'. DESBD427 00071 SKIP3 DESBD427 00072 01 W-AREA. DESBD427 00073 05 W-MOD-NAME PIC X(08) VALUE 'DESBD427'. CL*32 00074 05 W-TRACE-IND PIC X(01) VALUE 'N'. DESBD427 00075 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +427. CL*32 00076 DESBD427 00077 05 W-START-BATCH PIC S9(05) COMP-3 DESBD427 00078 VALUE +71937. DESBD427 00079 DESBD427 00080 05 W-ERROR-IND PIC X(01) VALUE 'N'. DESBD427 00081 88 W-ERROR-YES-88 VALUE 'Y'. DESBD427 00082 88 W-ERROR-NO-88 VALUE 'N'. DESBD427 00083 DESBD427 00084 05 TDEC-IN-STATUS PIC X(02) VALUE SPACES. DESBD427 00085 88 TDEC-IN-OK-88 VALUE '00'. DESBD427 00086 88 TDEC-IN-EOF-88 VALUE '10'. DESBD427 00087 DESBD427 00088 05 PENDING-STATUS PIC X(02) VALUE SPACES. DESBD427 00089 88 PENDING-OK-88 VALUE '00'. DESBD427 00090 DESBD427 00091 05 MISSING-RPT-STATUS PIC X(02) VALUE SPACES. DESBD427 00092 88 MISSING-RPT-OK-88 VALUE '00'. DESBD427 00093 DESBD427 00094 05 WAGE-ERROR-STATUS PIC X(02) VALUE SPACES. DESBD427 00095 88 WAGE-ERROR-OK-88 VALUE '00'. DESBD427 00096 DESBD427 00097 05 RECORD-COUNT-STATUS PIC X(02) VALUE SPACES. DESBD427 00098 88 RECORD-COUNT-OK-88 VALUE '00'. DESBD427 00099 DESBD427 00100 05 WAGE-X148-STATUS PIC X(02) VALUE SPACES. DESBD427 00101 88 WAGE-X148-OK-88 VALUE '00'. DESBD427 00102 DESBD427 00103 DESBD427 00104 05 WAGE-X153-STATUS PIC X(02). DESBD427 00105 88 WAGE-X153-FILE-OK-88 VALUE '00'. DESBD427 00106 88 WAGE-X153-FILE-VERIFY-88 VALUE '97'. DESBD427 00107 DESBD427 00108 05 WAGE-W001-STATUS PIC X(02) VALUE SPACES. DESBD427 00109 88 WAGE-W001-OK-88 VALUE '00'. DESBD427 00110 DESBD427 00111 05 WWG2-STATUS PIC X(02) VALUE SPACES. DESBD427 00112 88 WWG2-OK-88 VALUE '00'. DESBD427 00113 88 WWG2-EOF-88 VALUE '10'. DESBD427 00114 DESBD427 00115 05 WITM-STATUS PIC X(02) VALUE SPACES. DESBD427 00116 88 WITM-OK-88 VALUE '00'. DESBD427 00117 88 WITM-EOF-88 VALUE '10'. DESBD427 00118 DESBD427 00119 05 W-WAGE-REC-IND PIC X(01) VALUE 'N'. DESBD427 00120 88 W-WAGE-REC-ERR-YES-88 VALUE 'Y'. DESBD427 00121 88 W-WAGE-REC-ERR-NO-88 VALUE 'N'. DESBD427 00122 DESBD427 00123 05 W-BATCH-ERR-IND PIC X(01) VALUE 'N'. DESBD427 00124 88 W-BATCH-ERR-YES-88 VALUE 'Y'. DESBD427 00125 88 W-BATCH-ERR-NO-88 VALUE 'N'. DESBD427 00126 DESBD427 00127 05 W-EMP-NBR-CHNG-IND PIC X(01) VALUE 'N'. DESBD427 00128 88 W-EMP-NBR-CHNG-YES-88 VALUE 'Y'. DESBD427 00129 88 W-EMP-NBR-CHNG-NO-88 VALUE 'N'. DESBD427 00130 DESBD427 00131 05 W-WAGE-ERR-IND PIC X(01) VALUE 'N'. DESBD427 00132 88 W-WAGE-ERR-YES-88 VALUE 'Y'. DESBD427 00133 88 W-WAGE-ERR-NO-88 VALUE 'N'. DESBD427 00134 DESBD427 00135 05 W-WAGE-ON-FILE-IND PIC X(01) VALUE 'N'. DESBD427 00136 88 W-WAGE-ON-FILE-YES-88 VALUE 'Y'. DESBD427 00137 88 W-WAGE-ON-FILE-NO-88 VALUE 'N'. DESBD427 00138 DESBD427 00139 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DESBD427 00140 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DESBD427 00141 88 W-EMP-FOUND-NO-88 VALUE 'N'. DESBD427 00142 DESBD427 00143 05 W-EMP-LIABLE-IND PIC X(01) VALUE 'N'. DESBD427 00144 88 W-EMP-LIABLE-YES-88 VALUE 'Y'. DESBD427 00145 88 W-EMP-LIABLE-NO-88 VALUE 'N'. DESBD427 00146 DESBD427 00147 05 W-VALID-QTR-IND PIC X(01) VALUE 'N'. DESBD427 00148 88 W-VALID-QTR-YES-88 VALUE 'Y'. DESBD427 00149 88 W-VALID-QTR-NO-88 VALUE 'N'. DESBD427 00150 DESBD427 00151 05 W-RPT-FOUND-IND PIC X(01) VALUE '0'. DESBD427 00152 88 W-RPT-FOUND-NO-88 VALUE '0'. DESBD427 00153 88 W-RPT-FOUND-MRPT-88 VALUE '1'. DESBD427 00154 88 W-RPT-FOUND-ATC-88 VALUE '2'. DESBD427 00155 88 W-RPT-FOUND-YES-88 VALUE '1' '2'. DESBD427 00156 DESBD427 00157 05 W-SSN-ERR-IND PIC X(01) VALUE 'N'. DESBD427 00158 88 W-SSN-ERR-YES-88 VALUE 'Y'. DESBD427 00159 88 W-SSN-ERR-NO-88 VALUE 'N'. DESBD427 00160 CL**8 00161 05 WRK-SLASH-QTR. CL**8 00162 10 WRK-YEAR PIC 9(04). CL**8 00163 10 FILLER PIC X(01). CL**8 00164 10 WRK-QTR PIC 9(01). CL**8 00165 DESBD427 00166 05 WRK-SLASH-DATE. DESBD427 00167 10 WRK-SLASH-MM PIC 9(02). DESBD427 00168 10 WRK-SLASH-DD PIC 9(02). DESBD427 00169 10 WRK-SLASH-YR PIC 9(02). DESBD427 00170 CL*24 00171 05 WRK-EFF-DATE. CL**8 00172 10 WRK-EFF-MM PIC 9(02). CL**8 00173 10 FILLER PIC X(01) VALUE '/'. CL**8 00174 10 WRK-EFF-DD PIC 9(02) VALUE 01. CL**8 00175 10 FILLER PIC X(01) VALUE '/'. CL**8 00176 10 WRK-EFF-YR PIC 9(04) VALUE ZEROS. CL*34 00177 DESBD427 00178 05 WRK-PEND-DATE. DESBD427 00179 10 WRK-PEND-MM PIC 9(02). DESBD427 00180 10 WRK-PEND-DD PIC 9(02). DESBD427 00181 10 WRK-PEND-YR PIC 9(02). DESBD427 00182 DESBD427 00183 05 W-EMP-NO PIC 9(06) VALUE 0. DESBD427 00184 05 WRK-WADD-CNT PIC 9(05) VALUE 0. CL*20 00185 05 WRK-WUPD-CNT PIC 9(05) VALUE 0. CL*20 00186 05 W-YRQ PIC 9(05) VALUE 0. DESBD427 00187 05 W-ANNUAL-YRQ PIC 9(05) VALUE 0. DESBD427 00188 05 W-DEFAULT-YRQ PIC 9(05) VALUE 0. DESBD427 00189 05 W-DEFAULT-QTR-DISP PIC X(06) VALUE SPACES. DESBD427 00190 05 W-CURR-EMP PIC 9(06) VALUE 0. DESBD427 00191 05 W-CURR-QTR PIC X(06) VALUE SPACES. DESBD427 00192 05 W-CURR-SSN PIC 9(09) VALUE 0. DESBD427 00193 05 W-CURR-WAGES PIC 9(08)V99 VALUE 0. DESBD427 00194 05 W-SEQ-NO PIC S9(07) COMP-3 VALUE +0. DESBD427 00195 05 W-RPT-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD427 00196 05 W-RPT-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD427 00197 05 W-RPT-ITEM PIC S9(03) COMP-3 VALUE +0. DESBD427 00198 05 W-W4-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD427 00199 05 W-MRPT-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD427 00200 05 W-WGH-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD427 00201 05 W-SSN PIC S9(09) COMP-3 VALUE +0. CL**7 00202 05 WRK-SSN PIC S9(09) COMP-3 VALUE +0. CL**7 00203 05 W-MRPT-RESP-OPID PIC X(08). DESBD427 00204 05 W-MRPT-ESTB-DATE PIC S9(09). DESBD427 00205 05 W-DIFF PIC S9(09)V99 COMP-3 VALUE +0. DESBD427 00206 05 W-ESTB-DATE PIC X(10) VALUE SPACES. DESBD427 00207 05 W-SLASH-QTR. CL**8 00208 15 W-SLASH-Y PIC X(04) VALUE SPACES. CL**8 00209 15 W-SLASH-F PIC X(01) VALUE '/'. CL**8 00210 15 W-SLASH-Q PIC X(01) VALUE SPACES. CL*12 00211 05 WRK-NAME. CL**8 00212 15 WRK-LNAME PIC X(20) VALUE SPACES. CL**8 00213 15 WRK-FNAME PIC X(15) VALUE SPACES. CL**8 00214 15 WRK-INAME PIC X(01) VALUE SPACES. CL*13 00215 DESBD427 00216 01 WAGE-TRANS-AREA. DESBD427 00217 05 ESP-TRANSACTION-AREA PIC X(80). DESBD427 00218 ++INCLUDE EWGTRNW4 DESBD427 00219 EJECT DESBD427 00220 DESBD427 00221 05 W-W001-REC. DESBD427 00222 ++INCLUDE DTSIW001 DESBD427 00223 DESBD427 00224 01 WRK-X153-REC. DESBD427 00225 ++INCLUDE DTSIX153 DESBD427 00226 DESBD427 00227 05 W-RPT1-FIRST-TIME PIC X(01) VALUE 'Y'. DESBD427 00228 88 W-RPT1-FIRST-TIME-YES-88 DESBD427 00229 VALUE 'Y'. DESBD427 00230 88 W-RPT1-FIRST-TIME-NO-88 DESBD427 00231 VALUE 'N'. DESBD427 00232 05 W-MISSING-RPT-HDR. DESBD427 00233 10 FILLER PIC X(07) VALUE DESBD427 00234 'EMP; '. DESBD427 00235 10 FILLER PIC X(07) VALUE DESBD427 00236 'BATCH#;'. DESBD427 00237 10 FILLER PIC X(07) VALUE DESBD427 00238 'QTR '. DESBD427 00239 10 FILLER PIC X(06) VALUE DESBD427 00240 'ANN?; '. DESBD427 00241 10 FILLER PIC X(12) VALUE DESBD427 00242 'TOT WAGES;'. DESBD427 00243 10 FILLER PIC X(10) VALUE DESBD427 00244 'WAGE DATE;'. DESBD427 00245 10 FILLER PIC X(07) VALUE DESBD427 00246 'MESSAGE'. DESBD427 00247 DESBD427 00248 05 W-MISSING-RPT-REC. DESBD427 00249 10 MSRP-EMP PIC 9(06). DESBD427 00250 10 FILLER PIC X(01) VALUE ';'. DESBD427 00251 10 MSRP-BATCH PIC 9(05). DESBD427 00252 10 FILLER PIC X(01) VALUE ';'. DESBD427 00253 10 MSRP-QTR PIC X(06). DESBD427 00254 10 FILLER PIC X(01) VALUE ';'. DESBD427 00255 10 MSRP-FILING-SCHED PIC X(05). DESBD427 00256 10 FILLER PIC X(01) VALUE ';'. DESBD427 00257 10 MSRP-TOT-WAGE PIC --------9.99. DESBD427 00258 10 FILLER PIC X(01) VALUE ';'. DESBD427 00259 10 MSRP-DATE PIC X(10). DESBD427 00260 10 FILLER PIC X(01) VALUE ';'. DESBD427 00261 10 MSRP-REASON PIC X(40). DESBD427 00262 88 MSRP-RSN-NOT-FOUND-88 VALUE DESBD427 00263 'ACCOUNT NUMBER DOES NOT EXIST '. DESBD427 00264 88 MSRP-RSN-NOT-LIABLE-88 VALUE DESBD427 00265 'EMPLOYER NOT LIABLE '. DESBD427 00266 88 MSRP-RSN-INVALID-QTR-88 VALUE DESBD427 00267 'INVALID QUARTER '. DESBD427 00268 88 MSRP-RSN-RPT-NOT-FOUND-88 VALUE DESBD427 00269 'REPORT NOT FOUND '. DESBD427 00270 DESBD427 00271 05 W-RPT2-FIRST-TIME PIC X(01) VALUE 'Y'. DESBD427 00272 88 W-RPT2-FIRST-TIME-YES-88 DESBD427 00273 VALUE 'Y'. DESBD427 00274 88 W-RPT2-FIRST-TIME-NO-88 DESBD427 00275 VALUE 'N'. DESBD427 00276 05 W-WAGE-ERROR-HDR. DESBD427 00277 10 FILLER PIC X(09) VALUE DESBD427 00278 'EMPLOYER;'. DESBD427 00279 10 FILLER PIC X(09) VALUE DESBD427 00280 'BATCH#: '. DESBD427 00281 10 FILLER PIC X(08) VALUE DESBD427 00282 'QUARTER;'. DESBD427 00283 10 FILLER PIC X(09) VALUE DESBD427 00284 'W4 WAGES;'. DESBD427 00285 10 FILLER PIC X(12) VALUE DESBD427 00286 'UC-30 WAGES;'. DESBD427 00287 10 FILLER PIC X(11) VALUE DESBD427 00288 'DIFFERENCE;'. DESBD427 00289 10 FILLER PIC X(13) VALUE DESBD427 00290 'WORKER COUNT;'. DESBD427 00291 10 FILLER PIC X(14) VALUE DESBD427 00292 'WAGES ON FILE;'. DESBD427 00293 10 FILLER PIC X(18) VALUE DESBD427 00294 'REPORT ENTERED DT;'. DESBD427 00295 10 FILLER PIC X(17) VALUE DESBD427 00296 'WAGES ENTERED DT;'. DESBD427 00297 10 FILLER PIC X(10) VALUE DESBD427 00298 'RESP OPID;'. DESBD427 00299 05 W-WAGE-ERROR-REC. DESBD427 00300 10 WERR-EMP PIC 9(06). DESBD427 00301 10 FILLER PIC X(01) VALUE ';'. DESBD427 00302 10 WERR-BATCH PIC 9(05). DESBD427 00303 10 FILLER PIC X(01) VALUE ';'. DESBD427 00304 10 WERR-QTR PIC X(06). DESBD427 00305 10 FILLER PIC X(01) VALUE ';'. DESBD427 00306 10 WERR-W4-WAGE PIC --------9.99. DESBD427 00307 10 FILLER PIC X(01) VALUE ';'. DESBD427 00308 10 WERR-MRPT-WAGE PIC --------9.99. DESBD427 00309 10 FILLER PIC X(01) VALUE ';'. DESBD427 00310 10 WERR-DIFFERENCE PIC --------9.99. DESBD427 00311 10 FILLER PIC X(01) VALUE ';'. DESBD427 00312 10 WERR-WORKER-CNT PIC 9(07). DESBD427 00313 10 FILLER PIC X(01) VALUE ';'. DESBD427 00314 10 WERR-WGH-WAGE PIC --------9.99. DESBD427 00315 10 FILLER PIC X(01) VALUE ';'. DESBD427 00316 10 WERR-RPT-DATE PIC X(10). DESBD427 00317 10 FILLER PIC X(01) VALUE ';'. DESBD427 00318 10 WERR-WAGE-DATE PIC X(10). DESBD427 00319 10 FILLER PIC X(01) VALUE ';'. DESBD427 00320 10 WERR-RESP-OPID PIC X(08). DESBD427 00321 DESBD427 00322 05 W-RECORD-COUNT-REC. DESBD427 00323 10 WC-REC-IN. DESBD427 00324 15 FILLER PIC X(30) VALUE DESBD427 00325 'INPUT RECORDS: '. DESBD427 00326 15 WC-REC-IN-CNT PIC 9(07). DESBD427 00327 10 WC-TOT-RPTS. DESBD427 00328 15 FILLER PIC X(30) VALUE DESBD427 00329 'TOTAL REPORTS: '. DESBD427 00330 15 WC-TOT-RPTS-CNT PIC 9(07). DESBD427 00331 10 WC-RPTS-FOUND. DESBD427 00332 15 FILLER PIC X(30) VALUE DESBD427 00333 'REPORTS FOUND: '. DESBD427 00334 15 WC-RPTS-FOUND-CNT PIC 9(07). DESBD427 00335 10 WC-MRPT-FOUND. DESBD427 00336 15 FILLER PIC X(30) VALUE DESBD427 00337 'REPORTS POSTED: '. DESBD427 00338 15 WC-MRPT-FOUND-CNT PIC 9(07). DESBD427 00339 10 WC-ATC-FOUND. DESBD427 00340 15 FILLER PIC X(30) VALUE DESBD427 00341 'REPORTS FOUND IN ATC '. DESBD427 00342 15 WC-ATC-FOUND-CNT PIC 9(07). DESBD427 00343 10 WC-RPT-MISSING. DESBD427 00344 15 FILLER PIC X(30) VALUE DESBD427 00345 'TOTAL REPORTS MISSING '. DESBD427 00346 15 WC-RPT-MISSING-CNT PIC 9(07). DESBD427 00347 10 WC-EMP-CHANGED. DESBD427 00348 15 FILLER PIC X(30) VALUE DESBD427 00349 'EMPLOYER NBR CHANGED '. DESBD427 00350 15 WC-EMP-CHANGED-CNT PIC 9(07). DESBD427 00351 10 WC-NOT-LIABLE. DESBD427 00352 15 FILLER PIC X(30) VALUE DESBD427 00353 'EMPLOYER NOT LIABLE '. DESBD427 00354 15 WC-NOT-LIABLE-CNT PIC 9(07). DESBD427 00355 10 WC-NO-EMP. DESBD427 00356 15 FILLER PIC X(30) VALUE DESBD427 00357 'EMPLOYER NBR NOT FOUND '. DESBD427 00358 15 WC-NO-EMP-CNT PIC 9(07). DESBD427 00359 10 WC-INVALID-QTR. DESBD427 00360 15 FILLER PIC X(30) VALUE DESBD427 00361 'INVALID QUARTER '. DESBD427 00362 15 WC-INVALID-QTR-CNT PIC 9(07). DESBD427 00363 10 WC-WAGE-DIFF. DESBD427 00364 15 FILLER PIC X(30) VALUE DESBD427 00365 'WAGE DISCREPANCIES '. DESBD427 00366 15 WC-WAGE-DIFF-CNT PIC 9(07). DESBD427 00367 10 WC-DUP-SSN. DESBD427 00368 15 FILLER PIC X(30) VALUE DESBD427 00369 'DUPLICATE SSNS '. DESBD427 00370 15 WC-DUP-SSN-CNT PIC 9(07). DESBD427 00371 10 WC-X148. DESBD427 00372 15 FILLER PIC X(30) VALUE DESBD427 00373 'WAGE RECORDS WRITTEN '. DESBD427 00374 15 WC-X148-CNT PIC 9(07). DESBD427 00375 DESBD427 00376 05 WRK-ABSTIME PIC S9(15) COMP-3. DESBD427 00377 05 W-TDEC-IN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00378 05 W-X148-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00379 05 W-X153-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00380 05 W-W001-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00381 05 W-REPORT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00382 05 W-WORKER-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00383 05 W-FOUND-IN-ATC-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00384 05 W-EMP-IN-ATC-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00385 05 W-MRPT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00386 05 W-RPT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00387 05 W-RPT-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00388 05 W-EMP-NBR-CHNG-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00389 05 W-PAY-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00390 05 W-EMP-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00391 05 W-NOT-LIABLE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00392 05 W-MISS-RPT-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00393 05 W-DUP-SSN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00394 05 W-WAGE-MISMATCH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00395 05 W-INVALID-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00396 05 W-PENDING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD427 00397 DESBD427 00398 05 WRK-QTR. CL*32 00399 10 WRK-QTRYR PIC 9(04) VALUE ZEROS. CL*32 00400 10 WRK-QTRYQ PIC 9(01) VALUE ZEROS. CL*32 00401 CL*32 00402 05 AMT-DISP1 PIC ----------9.99. DESBD427 00403 05 AMT-DISP2 PIC ----------9.99. DESBD427 00404 05 AMT-DISP3 PIC ----------9.99. DESBD427 00405 05 AMT-DISP4 PIC ----------9.99. DESBD427 00406 DESBD427 00407 DESBD427 00408 01 L001-LINK-AREA. DESBD427 00409 ++INCLUDE DTSIL001 DESBD427 00410 DESBD427 00411 01 L004-LINK-AREA. DESBD427 00412 ++INCLUDE DTSIL004 DESBD427 00413 DESBD427 00414 01 L005-LINK-AREA. DESBD427 00415 ++INCLUDE DTSIL005 DESBD427 00416 DESBD427 00417 01 L516-LINK-AREA. DESBD427 00418 ++INCLUDE DTSIL516 DESBD427 00419 DESBD427 00420 01 L910-LINK-AREA. DESBD427 00421 ++INCLUDE DTSIL910 DESBD427 00422 DESBD427 00423 01 L982-LINK-AREA. DESBD427 00424 ++INCLUDE DTSIL982 DESBD427 00425 DESBD427 00426 01 X146-WEB-REC. CL*10 00427 ++INCLUDE DTSIX146 CL*10 00428 CL*10 00429 01 X144-WEB-REC. CL*10 00430 15 X144-REC-TYPE PIC X(03) VALUE '144'. CL*19 00431 15 FILLER PIC X(01) VALUE ','. CL*19 00432 15 X144-EMP-NO PIC 9(06). CL*19 00433 15 FILLER PIC X(01) VALUE ','. CL*19 00434 15 X144-QUARTER. CL*36 00435 20 X144-QTRYR PIC 9(04). CL*32 00436 20 FILLER PIC X(01). CL*35 00437 20 X144-QTRYQ PIC 9(01). CL*32 00438 15 FILLER PIC X(01) VALUE ','. CL*32 00439 15 X144-AMEND PIC 9(08). CL*19 00440 15 FILLER PIC X(01) VALUE ','. CL*19 00441 15 X144-SSN PIC 9(09). CL*19 00442 15 FILLER PIC X(01) VALUE ','. CL*19 00443 15 X144-LAST-NAME PIC X(20). CL*19 00444 15 FILLER PIC X(10). CL*19 00445 15 FILLER PIC X(01) VALUE ','. CL*19 00446 15 X144-FIRST-NAME PIC X(15). CL*19 00447 15 FILLER PIC X(15). CL*19 00448 15 FILLER PIC X(01) VALUE ','. CL*19 00449 15 X144-MID-INIT PIC X(01). CL*19 00450 15 FILLER PIC X(01) VALUE ','. CL*19 00451 15 X144-EARNINGS PIC ---------9.99. CL*19 00452 15 FILLER PIC X(01) VALUE ','. CL*19 00453 15 FILLER PIC X(432). CL*19 00454 CL*10 00455 01 MSKL-REC. DESBD427 00456 ++INCLUDE DTSIMSKL DESBD427 00457 DESBD427 00458 01 MHDR-REC. DESBD427 00459 ++INCLUDE DTSIMHDR DESBD427 00460 DESBD427 00461 01 MPRF-REC. DESBD427 00462 ++INCLUDE DTSIMPRF DESBD427 00463 DESBD427 00464 01 MRPT-REC. DESBD427 00465 ++INCLUDE DTSIMRPT DESBD427 00466 DESBD427 00467 01 MPAY-REC. DESBD427 00468 ++INCLUDE DTSIMPAY DESBD427 00469 DESBD427 00470 01 L923-LINK-AREA. DESBD427 00471 ++INCLUDE DTSIL923 DESBD427 00472 DESBD427 00473 01 L009-LINK-AREA. CL*21 00474 ++INCLUDE DTSIL009 CL*21 00475 CL*21 00476 01 ASKL-REC. DESBD427 00477 ++INCLUDE DTSIASKL DESBD427 00478 DESBD427 00479 01 AHDR-REC. DESBD427 00480 ++INCLUDE DTSIAHDR DESBD427 00481 DESBD427 00482 01 ARPT-REC. DESBD427 00483 ++INCLUDE DTSIARPT DESBD427 00484 EJECT DESBD427 00485 01 AATX-REC. DESBD427 00486 ++INCLUDE DTSIAATX DESBD427 00487 DESBD427 00488 01 APAY-REC. DESBD427 00489 ++INCLUDE DTSIAPAY DESBD427 00490 DESBD427 00491 01 L931-LINK-AREA. DESBD427 00492 ++INCLUDE DTSIL931 DESBD427 00493 DESBD427 00494 01 FSKL-REC. DESBD427 00495 ++INCLUDE DTSIFSKL DESBD427 00496 DESBD427 00497 01 L981-LINK-AREA. DESBD427 00498 ++INCLUDE DTSIL981 DESBD427 00499 SKIP3 DESBD427 00500 01 WWGH-REC. DESBD427 00501 ++INCLUDE DTSIWWGH DESBD427 00502 DESBD427 00503 01 WNAM-REC. DESBD427 00504 ++INCLUDE DTSIWNAM DESBD427 00505 DESBD427 00506 PROCEDURE DIVISION. DESBD427 00507 DESBD427 00508 DESBD422-MAIN. DESBD427 00509 PERFORM I0000-INIT THRU I0000-EXIT. DESBD427 00510 IF W-ERROR-YES-88 DESBD427 00511 GO TO DESBD422-MAIN-EXIT. DESBD427 00512 DESBD427 00513 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD427 00514 DESBD427 00515 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD427 00516 DESBD427 00517 DESBD422-MAIN-EXIT. DESBD427 00518 GOBACK. DESBD427 00519 DESBD427 00520 I0000-INIT. DESBD427 00521 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD427 00522 DESBD427 00523 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD427 00524 MOVE L005-SLASH-8-DATE TO X146-PROCESS-DATE. CL**8 00525 MOVE L005-DATE TO L004-DATE. DESBD427 00526 PERFORM S004-FROM-DATE THRU S004-EXIT. DESBD427 00527 SUBTRACT 1 FROM L004-ABS-QTR. DESBD427 00528 PERFORM S004-FROM-ABS THRU S004-EXIT. DESBD427 00529 MOVE L004-QTR-5-9 TO W-DEFAULT-YRQ. DESBD427 00530 MOVE L004-SLASH-5-QTR TO W-DEFAULT-QTR-DISP.DESBD427 00531 DISPLAY 'DEFAULT QTR: ' W-DEFAULT-YRQ DESBD427 00532 ' ' W-DEFAULT-QTR-DISP. DESBD427 00533 DESBD427 00534 I0000-EXIT. DESBD427 00535 EXIT. DESBD427 00536 DESBD427 00537 I2000-OPEN-FILES. DESBD427 00538 PERFORM S1000-OPEN-TDEC-IN THRU S1000-EXIT. DESBD427 00539 IF W-ERROR-YES-88 DESBD427 00540 GO TO I2000-EXIT DESBD427 00541 END-IF. DESBD427 00542 DESBD427 00543 DESBD427 00544 PERFORM S982O-OPEN-UPDATE THRU S982O-EXIT. CL**2 00545 IF NOT L982-OK-88 CL*16 00546 DISPLAY 'NAME FILE CANT OPEN'. CL*16 00547 I2000-EXIT. DESBD427 00548 EXIT. DESBD427 00549 DESBD427 00550 P0000-PROCESS. DESBD427 00551 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT. DESBD427 00552 IF TDEC-IN-EOF-88 DESBD427 00553 DISPLAY 'INPUT FILE IS EMPTY' DESBD427 00554 GO TO P0000-EXIT DESBD427 00555 END-IF. DESBD427 00556 DESBD427 00557 PERFORM UNTIL TDEC-IN-EOF-88 DESBD427 00558 PERFORM P3100-UPDATE-NAME THRU P3100-EXIT CL**2 00559 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT DESBD427 00560 END-PERFORM. DESBD427 00561 DESBD427 00562 DESBD427 00563 P0000-EXIT. DESBD427 00564 EXIT. DESBD427 00565 DESBD427 00566 DESBD427 00567 P3100-UPDATE-NAME. DESBD427 00568 DESBD427 00569 * DISPLAY 'CHECK NAME ' X154-SSN ' ' X154-LAST-NAME. CL**4 00570 MOVE SPACES TO WRK-NAME. CL**8 00571 MOVE LOW-VALUE TO WNAM-REC. DESBD427 00572 MOVE X144-SSN TO WNAM-SSN WRK-SSN. CL*32 00573 MOVE X144-LAST-NAME TO WRK-LNAME. CL*32 00574 MOVE X144-FIRST-NAME TO WRK-FNAME. CL*32 00575 MOVE X144-MID-INIT TO WRK-INAME. CL*32 00576 MOVE X144-QTRYR TO WRK-EFF-YR. CL*34 00577 CL*34 00578 IF X144-QTRYQ = 1 MOVE 01 TO WRK-EFF-MM ELSE CL*34 00579 IF X144-QTRYQ = 2 MOVE 04 TO WRK-EFF-MM ELSE CL*34 00580 IF X144-QTRYQ = 3 MOVE 07 TO WRK-EFF-MM ELSE CL*34 00581 IF X144-QTRYQ = 4 MOVE 10 TO WRK-EFF-MM ELSE CL*34 00582 MOVE 01 TO WRK-EFF-MM. CL*34 00583 CL*34 00584 MOVE L005-SLASH-8-DATE TO X146-PROCESS-DATE. CL**9 00585 MOVE WRK-EFF-DATE TO X146-EFF-DATE. CL*34 00586 CL**9 00587 IF X144-LAST-NAME > SPACES CL*32 00588 MOVE X144-LAST-NAME TO L009-DATA CL*32 00589 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*20 00590 MOVE L009-DATA TO WRK-LNAME X144-LAST-NAME CL*32 00591 ELSE CL*20 00592 MOVE X144-LAST-NAME TO WRK-LNAME. CL*32 00593 CL**9 00594 IF X144-FIRST-NAME > SPACES CL*32 00595 MOVE X144-FIRST-NAME TO L009-DATA CL*32 00596 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*20 00597 MOVE L009-DATA TO WRK-FNAME X144-FIRST-NAME CL*32 00598 ELSE CL*20 00599 MOVE X144-FIRST-NAME TO WRK-FNAME. CL*32 00600 CL*20 00601 IF X144-MID-INIT > SPACES CL*32 00602 MOVE X144-MID-INIT TO L009-DATA CL*32 00603 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*20 00604 MOVE L009-DATA TO WRK-INAME X144-MID-INIT CL*32 00605 ELSE CL*20 00606 MOVE X144-MID-INIT TO WRK-INAME. CL*32 00607 CL*20 00608 DESBD427 00609 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DESBD427 00610 DESBD427 00611 IF NOT L982-OK-88 DESBD427 00612 DISPLAY 'BROWSE NOT OK-ADD NAME' CL**4 00613 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD427 00614 GO TO P3100-EXIT DESBD427 00615 END-IF. DESBD427 00616 DESBD427 00617 MOVE WNAM-SSN TO W-SSN. DESBD427 00618 DESBD427 00619 IF WRK-SSN = W-SSN CL**7 00620 NEXT SENTENCE DESBD427 00621 ELSE DESBD427 00622 DISPLAY 'SSN NOT ON FILE ADD ' X144-SSN CL*23 00623 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD427 00624 GO TO P3100-EXIT. DESBD427 00625 DESBD427 00626 IF WNAM-FIRST-NAME = WRK-FNAME AND CL*39 00627 WNAM-LAST-NAME = WRK-LNAME CL*39 00628 GO TO P3100-EXIT CL*39 00629 END-IF. CL*39 00630 DESBD427 00631 * IF WNAM-TYPE-3CHAR-88 CL*28 00632 PERFORM P3120-REWRITE-NAME THRU P3120-EXIT. CL*28 00633 * ELSE CL*28 00634 * DISPLAY 'WNAM ' WNAM-SSN ' ' WNAM-NAME-TYPE ' ' WNAM-NAME CL*28 00635 * DISPLAY ' DCG ' DCG-SSN ' ' WNAM-NAME-TYPE ' ' DCG-NAME CL*28 00636 * END-IF. CL*28 00637 DESBD427 00638 P3100-EXIT. DESBD427 00639 EXIT. DESBD427 00640 P3110-ADD-NAME. DESBD427 00641 * DESBD427 00642 * DISPLAY 'ADD NAME P3110 ' W001-LAST-NAME. CL**8 00643 * DESBD427 00644 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD427 00645 ADD +1 TO L005-ABSTIME. DESBD427 00646 PERFORM S005-ABSTIME THRU S005-EXIT. DESBD427 00647 MOVE L005-NINES-COMPLEMENT-ABSTIME DESBD427 00648 TO WNAM-NINES-COMPLEMENT-ABSTIME. DESBD427 00649 MOVE X144-SSN TO WNAM-SSN. CL*32 00650 MOVE X144-LAST-NAME TO WNAM-LAST-NAME. CL*32 00651 MOVE X144-FIRST-NAME TO WNAM-FIRST-NAME. CL*32 00652 MOVE X144-MID-INIT TO WNAM-MID-INIT. CL*32 00653 SET WNAM-TYPE-FULL-88 TO TRUE. DESBD427 00654 PERFORM S982C-WRITE THRU S982C-EXIT. DESBD427 00655 DISPLAY 'REC ADDED: ' X144-SSN ' ' WNAM-LAST-NAME ' ' CL*40 00656 WNAM-FIRST-NAME. CL*40 00657 ADD +1 TO WRK-WADD-CNT. CL*20 00658 *& CL**9 00659 MOVE X144-SSN TO X146-SSN CL*32 00660 INSPECT X144-LAST-NAME CL*32 00661 REPLACING ALL ',' BY ' '. CL*30 00662 INSPECT X144-FIRST-NAME CL*32 00663 REPLACING ALL ',' BY ' '. CL*30 00664 MOVE X144-LAST-NAME TO X146-LAST-NAME. CL*32 00665 MOVE X144-FIRST-NAME TO X146-FIRST-NAME. CL*32 00666 MOVE X144-MID-INIT TO X146-MID-INIT. CL*32 00667 SET X146-INSERT-88 TO TRUE. CL*10 00668 WRITE X146-REC FROM X146-WEB-REC. CL*13 00669 DESBD427 00670 P3110-EXIT. DESBD427 00671 EXIT. DESBD427 00672 DESBD427 00673 P3120-REWRITE-NAME. DESBD427 00674 *& DESBD427 00675 * DISPLAY 'UPD NAME P3120 ' W001-LAST-NAME. CL*20 00676 *& DESBD427 00677 MOVE X144-LAST-NAME TO WNAM-LAST-NAME. CL*32 00678 MOVE X144-FIRST-NAME TO WNAM-FIRST-NAME. CL*32 00679 MOVE X144-MID-INIT TO WNAM-MID-INIT. CL*32 00680 SET WNAM-TYPE-FULL-88 TO TRUE. DESBD427 00681 DESBD427 00682 PERFORM S982D-REWRITE THRU S982D-EXIT. DESBD427 00683 DESBD427 00684 DISPLAY ' REC UPDT ' X144-SSN ' ' X144-LAST-NAME ' ' CL*32 00685 X144-FIRST-NAME. CL*32 00686 ADD +1 TO WRK-WUPD-CNT. CL*20 00687 *& CL**8 00688 MOVE X144-SSN TO X146-SSN CL*32 00689 INSPECT X144-LAST-NAME CL*32 00690 REPLACING ALL ',' BY ' '. CL*30 00691 INSPECT X144-FIRST-NAME CL*32 00692 REPLACING ALL ',' BY ' '. CL*30 00693 MOVE X144-LAST-NAME TO X146-LAST-NAME. CL*32 00694 MOVE X144-FIRST-NAME TO X146-FIRST-NAME. CL*32 00695 MOVE X144-MID-INIT TO X146-MID-INIT. CL*32 00696 SET X146-UPDATE-88 TO TRUE. CL*26 00697 WRITE X146-REC FROM X146-WEB-REC. CL*13 00698 DESBD427 00699 P3120-EXIT. DESBD427 00700 EXIT. DESBD427 00701 DESBD427 00702 DESBD427 00703 T0000-TERMINATE. DESBD427 00704 DESBD427 00705 DISPLAY ' '. DESBD427 00706 DISPLAY ' '. DESBD427 00707 DESBD427 00708 DISPLAY '*** DESBD427 TERMINATION STATISTICS ***'. CL*32 00709 DESBD427 00710 DISPLAY ' '. DESBD427 00711 DESBD427 00712 DISPLAY ' '. DESBD427 00713 DISPLAY 'ESSP RECORDS READ : ' CL*32 00714 W-TDEC-IN-CNT. DESBD427 00715 DESBD427 00716 DISPLAY ' '. DESBD427 00717 DISPLAY 'TOTAL NAMES ADDED : ' CL**2 00718 WRK-WADD-CNT. CL*20 00719 DESBD427 00720 DISPLAY ' '. DESBD427 00721 DISPLAY 'TOTAL NAMES UPDATED : ' CL**2 00722 WRK-WUPD-CNT. CL*20 00723 DESBD427 00724 DESBD427 00725 PERFORM S1020-CLOSE-TDEC-IN THRU S1020-EXIT. DESBD427 00726 DESBD427 00727 PERFORM S982F-CLOSE THRU S982F-EXIT. CL**2 00728 DESBD427 00729 T0000-EXIT. DESBD427 00730 EXIT. DESBD427 00731 DESBD427 00732 S001-FROM-FED-8. DESBD427 00733 SET L001-FROM-FED-8 TO TRUE. DESBD427 00734 GO TO S001-DATE. DESBD427 00735 DESBD427 00736 S001-FROM-CAL-8. DESBD427 00737 SET L001-FROM-CAL-8 TO TRUE. DESBD427 00738 GO TO S001-DATE. DESBD427 00739 DESBD427 00740 S001-FROM-ABS-DAY. DESBD427 00741 SET L001-FROM-ABS-DAY TO TRUE. DESBD427 00742 GO TO S001-DATE. DESBD427 00743 DESBD427 00744 S001-DATE. DESBD427 00745 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD427 00746 S001-EXIT. DESBD427 00747 EXIT. DESBD427 00748 DESBD427 00749 S004-FROM-DATE. DESBD427 00750 SET L004-FROM-DATE TO TRUE. DESBD427 00751 GO TO S004-QTR. DESBD427 00752 DESBD427 00753 S004-FROM-5. DESBD427 00754 SET L004-FROM-5 TO TRUE. DESBD427 00755 GO TO S004-QTR. DESBD427 00756 DESBD427 00757 S004-FROM-ABS. DESBD427 00758 SET L004-FROM-ABS TO TRUE. DESBD427 00759 GO TO S004-QTR. DESBD427 00760 DESBD427 00761 S004-FROM-3. DESBD427 00762 SET L004-FROM-3 TO TRUE. DESBD427 00763 GO TO S004-QTR. DESBD427 00764 DESBD427 00765 S004-QTR. DESBD427 00766 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD427 00767 S004-EXIT. DESBD427 00768 DESBD427 00769 S005-FROM-SYS. DESBD427 00770 SET L005-FROM-SYS TO TRUE. DESBD427 00771 GO TO S005-ABSTIME. DESBD427 00772 DESBD427 00773 S005-ABSTIME. DESBD427 00774 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD427 00775 S005-EXIT. DESBD427 00776 EXIT. DESBD427 00777 DESBD427 00778 S516-LIABILITY-INFO. DESBD427 00779 CALL 'DTSBU516' USING L516-LINK-AREA DESBD427 00780 MPRF-REC. DESBD427 00781 S516-EXIT. DESBD427 00782 EXIT. DESBD427 00783 DESBD427 00784 S910A-OPEN-READ. DESBD427 00785 SET L910-OPEN-READ-88 TO TRUE. DESBD427 00786 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD427 00787 DESBD427 00788 S910A-EXIT. DESBD427 00789 EXIT. DESBD427 00790 DESBD427 00791 S910C-CLOSE. DESBD427 00792 SET L910-CLOSE-88 TO TRUE. DESBD427 00793 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD427 00794 DESBD427 00795 S910C-EXIT. DESBD427 00796 EXIT. DESBD427 00797 DESBD427 00798 S910D-START-BROWSE. DESBD427 00799 SET L910-START-BROWSE-88 TO TRUE. DESBD427 00800 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD427 00801 DESBD427 00802 S910D-EXIT. DESBD427 00803 EXIT. DESBD427 00804 DESBD427 00805 S910E-READ-NEXT. DESBD427 00806 SET L910-READ-NEXT-88 TO TRUE. DESBD427 00807 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD427 00808 DESBD427 00809 S910E-EXIT. DESBD427 00810 EXIT. DESBD427 00811 DESBD427 00812 S910F-READ. DESBD427 00813 SET L910-READ-88 TO TRUE. DESBD427 00814 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD427 00815 DESBD427 00816 S910F-EXIT. DESBD427 00817 EXIT. DESBD427 00818 DESBD427 00819 S910Z-MSTR-I. DESBD427 00820 CALL 'DTSBU910' USING L910-LINK-AREA DESBD427 00821 MSKL-REC. DESBD427 00822 S910Z-EXIT. DESBD427 00823 EXIT. DESBD427 00824 DESBD427 00825 S923A-OPEN-READ. DESBD427 00826 SET L923-OPEN-READ-88 TO TRUE. DESBD427 00827 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD427 00828 DESBD427 00829 S923A-EXIT. DESBD427 00830 EXIT. DESBD427 00831 DESBD427 00832 S923B-START-BROWSE. DESBD427 00833 SET L923-START-BROWSE-88 TO TRUE. DESBD427 00834 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD427 00835 DESBD427 00836 S923B-EXIT. DESBD427 00837 EXIT. DESBD427 00838 DESBD427 00839 S923C-READ-NEXT. DESBD427 00840 SET L923-READ-NEXT-88 TO TRUE. DESBD427 00841 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD427 00842 DESBD427 00843 S923C-EXIT. DESBD427 00844 EXIT. DESBD427 00845 DESBD427 00846 S923D-READ. DESBD427 00847 SET L923-READ-88 TO TRUE. DESBD427 00848 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD427 00849 DESBD427 00850 S923D-EXIT. DESBD427 00851 EXIT. DESBD427 00852 DESBD427 00853 S923E-CLOSE. DESBD427 00854 SET L923-CLOSE-88 TO TRUE. DESBD427 00855 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD427 00856 DESBD427 00857 S923E-EXIT. DESBD427 00858 EXIT. DESBD427 00859 DESBD427 00860 DESBD427 00861 S923Z-ATC-IO. DESBD427 00862 CALL 'DTSBU923' USING L923-LINK-AREA DESBD427 00863 ASKL-REC. DESBD427 00864 S923Z-EXIT. DESBD427 00865 EXIT. DESBD427 00866 DESBD427 00867 S931-OPEN-READ. DESBD427 00868 SET L931-OPEN-READ-88 TO TRUE. DESBD427 00869 GO TO S931-REF-IO. DESBD427 00870 DESBD427 00871 S931-CLOSE. DESBD427 00872 SET L931-CLOSE-88 TO TRUE. DESBD427 00873 GO TO S931-REF-IO. DESBD427 00874 DESBD427 00875 S931-REF-IO. DESBD427 00876 CALL 'DTSBU931' USING L931-LINK-AREA DESBD427 00877 FSKL-REC. DESBD427 00878 S931-EXIT. DESBD427 00879 EXIT. DESBD427 00880 DESBD427 00881 S981A-OPEN-READ. DESBD427 00882 SET L981-OPEN-READ-88 TO TRUE. DESBD427 00883 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD427 00884 DESBD427 00885 S981A-EXIT. DESBD427 00886 EXIT. DESBD427 00887 DESBD427 00888 S981C-CLOSE. DESBD427 00889 SET L981-CLOSE-88 TO TRUE. DESBD427 00890 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD427 00891 DESBD427 00892 S981C-EXIT. DESBD427 00893 EXIT. DESBD427 00894 DESBD427 00895 S981D-START-BROWSE. DESBD427 00896 SET L981-START-BROWSE-88 TO TRUE. DESBD427 00897 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD427 00898 DESBD427 00899 S981D-EXIT. DESBD427 00900 EXIT. DESBD427 00901 DESBD427 00902 S981E-READ-NEXT. DESBD427 00903 SET L981-READ-NEXT-88 TO TRUE. DESBD427 00904 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD427 00905 DESBD427 00906 S981E-EXIT. DESBD427 00907 EXIT. DESBD427 00908 DESBD427 00909 S981F-READ. DESBD427 00910 SET L981-READ-88 TO TRUE. DESBD427 00911 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD427 00912 DESBD427 00913 S981F-EXIT. DESBD427 00914 EXIT. DESBD427 00915 DESBD427 00916 S981Z-WAGE-I. DESBD427 00917 CALL 'DTSBU981' USING L981-LINK-AREA DESBD427 00918 WWGH-REC. DESBD427 00919 S981Z-EXIT. DESBD427 00920 EXIT. DESBD427 00921 S982O-OPEN-UPDATE. DESBD427 00922 SET L982-OPEN-UPDATE-88 TO TRUE. DESBD427 00923 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD427 00924 DESBD427 00925 S982O-EXIT. DESBD427 00926 EXIT. DESBD427 00927 DESBD427 00928 S982A-START-BROWSE. DESBD427 00929 SET L982-START-BROWSE-88 TO TRUE. DESBD427 00930 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD427 00931 DESBD427 00932 S982A-EXIT. DESBD427 00933 EXIT. DESBD427 00934 DESBD427 00935 S982B-READ-NEXT. DESBD427 00936 SET L982-READ-NEXT-88 TO TRUE. DESBD427 00937 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD427 00938 DESBD427 00939 S982B-EXIT. DESBD427 00940 EXIT. DESBD427 00941 S982C-WRITE. DESBD427 00942 SET L982-WRITE-88 TO TRUE. DESBD427 00943 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD427 00944 DESBD427 00945 S982C-EXIT. DESBD427 00946 EXIT. DESBD427 00947 DESBD427 00948 S982D-REWRITE. DESBD427 00949 SET L982-REWRITE-88 TO TRUE. DESBD427 00950 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD427 00951 DESBD427 00952 S982D-EXIT. DESBD427 00953 EXIT. DESBD427 00954 S982F-CLOSE. DESBD427 00955 SET L982-CLOSE-88 TO TRUE. DESBD427 00956 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD427 00957 DESBD427 00958 S982F-EXIT. DESBD427 00959 EXIT. DESBD427 00960 DESBD427 00961 S982Z-WNAM-IO. DESBD427 00962 CALL 'DTSBU982' USING L982-LINK-AREA DESBD427 00963 WNAM-REC. DESBD427 00964 S982Z-EXIT. DESBD427 00965 EXIT. DESBD427 00966 DESBD427 00967 S1000-OPEN-TDEC-IN. DESBD427 00968 OPEN INPUT ESSP-WAGE-IN CL*35 00969 IF NOT TDEC-IN-OK-88 DESBD427 00970 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS DESBD427 00971 SET W-ERROR-YES-88 TO TRUE DESBD427 00972 END-IF. DESBD427 00973 DESBD427 00974 OPEN OUTPUT X146-WAGE-OUT CL**8 00975 IF NOT TDEC-IN-OK-88 CL**8 00976 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS CL**8 00977 SET W-ERROR-YES-88 TO TRUE CL**8 00978 END-IF. CL**8 00979 CL**8 00980 S1000-EXIT. DESBD427 00981 EXIT. DESBD427 00982 DESBD427 00983 S1010-READ-TDEC-IN. DESBD427 00984 * READ TDEC-TRAN-IN INTO ESP-TRANSACTION-AREA. DESBD427 00985 READ ESSP-WAGE-IN INTO X144-WEB-REC CL*32 00986 IF TDEC-IN-OK-88 DESBD427 00987 ADD +1 TO W-TDEC-IN-CNT DESBD427 00988 ELSE DESBD427 00989 IF TDEC-IN-EOF-88 DESBD427 00990 DISPLAY 'EOF' DESBD427 00991 ELSE DESBD427 00992 DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS DESBD427 00993 END-IF DESBD427 00994 END-IF. DESBD427 00995 DESBD427 00996 S1010-EXIT. DESBD427 00997 EXIT. DESBD427 00998 DESBD427 00999 S1020-CLOSE-TDEC-IN. DESBD427 01000 CLOSE ESSP-WAGE-IN CL*32 01001 X146-WAGE-OUT. CL*10 01002 DESBD427 01003 S1020-EXIT. DESBD427 01004 EXIT. DESBD427 01005 S009-CONVERT-TO-CAPS. CL*20 01006 CL*20 01007 CALL 'DTSBU009' USING L009-LINK-AREA. CL*20 01008 CL*20 01009 S009-EXIT. CL*20 01010 EXIT. CL*20 01011 DESBD427 01012 S999-ABEND. DESBD427 01013 DISPLAY '*** I/O MODULE ABENDING'. DESBD427 01014 DESBD427 01015 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD427 01016 S999-EXIT. DESBD427 01017 EXIT. DESBD427