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