1020 lines
81 KiB
COBOL
1020 lines
81 KiB
COBOL
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
|