1019 lines
80 KiB
COBOL
1019 lines
80 KiB
COBOL
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
|