00001 IDENTIFICATION DIVISION. 08/23/25 00002 PROGRAM-ID. DTSVAL04. DTSVAL04 00003 LV027 00004 ******************************************************************DTSVAL04 00005 * *DTSVAL04 00006 * * CL**7 00007 * FUNCTION: *DTSVAL04 00008 * THIS PROGRAM IS WRITTEN TO PRODUCE W4 WAGE TRANSACTIONS, *DTSVAL04 00009 * USING THE ICESA WAGE FORMAT. (FOR dcgov) * CL**7 00010 * 08/11/11 zl1 * CL*12 00011 ******************************************************************DTSVAL04 00012 * FOR INPUT FILES THAT ARE 275 BYTES, USE THIS PROGRAM. * CL*12 00013 ******************************************************************DTSVAL04 00014 ******************************************************************DTSVAL04 00015 * MODIFICATION HISTORY: *DTSVAL04 00016 * *DTSVAL04 00017 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSVAL04 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSVAL04 00019 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *DTSVAL04 00020 ******************************************************************DTSVAL04 00021 DTSVAL04 00022 ENVIRONMENT DIVISION. DTSVAL04 00023 DTSVAL04 00024 CONFIGURATION SECTION. DTSVAL04 00025 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSVAL04 00026 INPUT-OUTPUT SECTION. DTSVAL04 00027 DTSVAL04 00028 FILE-CONTROL. DTSVAL04 00029 DTSVAL04 00030 SELECT ICESA-FILE ASSIGN TO ICESA. DTSVAL04 00031 SELECT ICERR-FILE ASSIGN TO ICERR. CL*14 00032 DTSVAL04 00033 SELECT W4-FILE ASSIGN TO W4FILE. DTSVAL04 00034 DTSVAL04 00035 SELECT PRINT-FILE ASSIGN TO PRINT. DTSVAL04 00036 DTSVAL04 00037 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. DTSVAL04 00038 DTSVAL04 00039 DATA DIVISION. DTSVAL04 00040 FILE SECTION. DTSVAL04 00041 DTSVAL04 00042 FD ICESA-FILE DTSVAL04 00043 RECORDING MODE F DTSVAL04 00044 BLOCK CONTAINS 0 RECORDS DTSVAL04 00045 LABEL RECORDS ARE STANDARD DTSVAL04 00046 DATA RECORD IS ICESA-REC. DTSVAL04 00047 DTSVAL04 00048 01 ICESA-REC. DTSVAL04 00049 05 ICESA-REC-TYPE PIC X(01). DTSVAL04 00050 05 FILLER PIC X(274). DTSVAL04 00051 DTSVAL04 00052 FD ICERR-FILE CL*14 00053 RECORDING MODE F CL*13 00054 BLOCK CONTAINS 0 RECORDS CL*13 00055 LABEL RECORDS ARE STANDARD CL*13 00056 DATA RECORD IS ICERR-REC. CL*13 00057 CL*13 00058 01 ICERR-REC. CL*13 00059 05 ICERR-REC-TYPE PIC X(01). CL*13 00060 05 FILLER PIC X(274). CL*13 00061 CL*13 00062 FD W4-FILE DTSVAL04 00063 RECORDING MODE F DTSVAL04 00064 BLOCK CONTAINS 0 CHARACTERS DTSVAL04 00065 LABEL RECORDS ARE STANDARD DTSVAL04 00066 DATA RECORD IS W4-OUT-RECORD. DTSVAL04 00067 DTSVAL04 00068 01 W4-OUT-RECORD PIC X(80). CL**7 00069 DTSVAL04 00070 FD PRINT-FILE DTSVAL04 00071 RECORDING MODE F DTSVAL04 00072 LABEL RECORDS ARE OMITTED DTSVAL04 00073 DATA RECORD IS PRINT-REC. DTSVAL04 00074 DTSVAL04 00075 01 PRINT-REC PIC X(133). DTSVAL04 00076 DTSVAL04 00077 FD LISTOUT DTSVAL04 00078 RECORD CONTAINS 133 CHARACTERS DTSVAL04 00079 LABEL RECORDS ARE OMITTED DTSVAL04 00080 DATA RECORD IS LIST-REC. DTSVAL04 00081 01 LIST-REC PIC X(133). DTSVAL04 00082 DTSVAL04 00083 ******************************************************************DTSVAL04 00084 * WORKING STORAGE SECTION *DTSVAL04 00085 ******************************************************************DTSVAL04 00086 DTSVAL04 00087 WORKING-STORAGE SECTION. DTSVAL04 000875 77 PAN-VALET PICTURE X(24) VALUE '027DTSVAL04 08/23/25'. DTSVAL04 00088 01 WS-LOWER PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'. CL**3 00089 01 WS-UPPER PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. CL**3 00090 DTSVAL04 00091 01 WRK-AREA. DTSVAL04 00092 05 ABEND-CD PIC X(05) VALUE 'val04'. CL**7 00093 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. DTSVAL04 00094 05 ABEND-MSG PIC X(60). DTSVAL04 00095 05 WRK-MOD-NAME PIC X(08) VALUE 'dtsval04'. CL**7 00096 05 ERROR-SW PIC 9. DTSVAL04 00097 DTSVAL04 00098 01 COUNTERS. DTSVAL04 00099 03 FILE-STATUS-FILE PIC 99. DTSVAL04 00100 03 EMP-QTR-TOT-EARNINGS PIC 9(7). DTSVAL04 00101 03 RECS-IN PIC 9(5). DTSVAL04 00102 03 RECS-OUT PIC 9(5). DTSVAL04 00103 03 QTR-RECS-OUT PIC 9(5). DTSVAL04 00104 03 PAGE-CTR PIC 9(5). DTSVAL04 00105 03 ERROR-RECS PIC 9(5). DTSVAL04 00106 03 ZERO-WAGE-CNT PIC 9(5). DTSVAL04 00107 03 EXCEPTION-CNT PIC 9(5). DTSVAL04 00108 03 WS-ZERO-WAGE-NO PIC 9(5). DTSVAL04 00109 DTSVAL04 00110 01 LINE-CTR PIC 9(5) VALUE 56. DTSVAL04 00111 DTSVAL04 00112 01 WS-QUARTER-YR-QTR PIC 9(05). DTSVAL04 00113 01 FILLER REDEFINES WS-QUARTER-YR-QTR. DTSVAL04 00114 05 WS-QUARTER-YEAR PIC 9(4). DTSVAL04 00115 05 WS-QUARTER-QTR PIC 9(1). DTSVAL04 00116 DTSVAL04 00117 01 L004-LINK-AREA. DTSVAL04 00118 ++INCLUDE DTSIL004 DTSVAL04 00119 EJECT DTSVAL04 00120 DTSVAL04 00121 ++INCLUDE EWGRECS DTSVAL04 00122 DTSVAL04 00123 01 REC-END-IND PIC X(01) VALUE 'N'. DTSVAL04 00124 88 REC-END VALUE 'Y'. DTSVAL04 00125 01 WS-REPT-YEAR PIC X(04). DTSVAL04 00126 01 WS-FILL-YR REDEFINES WS-REPT-YEAR. DTSVAL04 00127 05 WS-REPT-MM PIC X(02). DTSVAL04 00128 05 WS-REPT-YR PIC X(02). DTSVAL04 00129 DTSVAL04 00130 01 WS-TODAY PIC 9(06). DTSVAL04 00131 01 WS-TODAY-REDEF REDEFINES WS-TODAY. DTSVAL04 00132 05 WS-TODAY-YY PIC 9(02). DTSVAL04 00133 05 WS-TODAY-MM PIC 9(02). DTSVAL04 00134 05 WS-TODAY-DD PIC 9(02). DTSVAL04 00135 DTSVAL04 00136 01 WS-AFFI-CODE PIC 9(01) VALUE 2. DTSVAL04 00137 DTSVAL04 00138 01 WS-QTR-NEW. DTSVAL04 00139 05 WS-QTR-QTR PIC 9(01). DTSVAL04 00140 05 WS-QTR-YY PIC 9(02). DTSVAL04 00141 DTSVAL04 00142 01 WS-YQTR. DTSVAL04 00143 05 WS-YQTR-Y PIC 9(02). DTSVAL04 00144 05 WS-YQTR-Q PIC 9(01). DTSVAL04 00145 DTSVAL04 00146 DTSVAL04 00147 01 WS-LAST-NAME PIC X(20). DTSVAL04 00148 01 WS-LAST-NAMES REDEFINES WS-LAST-NAME. DTSVAL04 00149 05 WS-LAST PIC X(03). DTSVAL04 00150 05 WS-LAST-FILLER PIC X(17). DTSVAL04 00151 DTSVAL04 00152 01 WS-HOLD-SSN. DTSVAL04 00153 05 WS-HOLD-SSN-1 PIC 9(03). DTSVAL04 00154 05 WS-HOLD-SSN-2 PIC 9(02). DTSVAL04 00155 05 WS-HOLD-SSN-3 PIC 9(04). DTSVAL04 00156 DTSVAL04 00157 01 TIME-FIXED PIC X(06) VALUE '170000'. DTSVAL04 00158 01 WRITE-CNT PIC 9(08) VALUE ZEROES. DTSVAL04 00159 DTSVAL04 00160 01 WS-ACCOUNT PIC X(15) VALUE SPACES. DTSVAL04 00161 01 WS-ACCOUNT-NO REDEFINES WS-ACCOUNT. DTSVAL04 00162 05 WS-WAGE-ACCOUNT PIC 9(06). DTSVAL04 00163 05 FILLER PIC X(09). DTSVAL04 00164 DTSVAL04 00165 01 WS-TRN-OPER-ID. DTSVAL04 00166 05 WS-TRN-CLM PIC X(06) VALUE '000444'. DTSVAL04 00167 05 WS-TRN-OPR-ID PIC X(02) VALUE '05'. DTSVAL04 00168 DTSVAL04 00169 01 ICESA-CNT PIC 9(08) VALUE ZEROES. DTSVAL04 00170 01 EMPLOYEE-CNT-TAPE PIC 9(07) VALUE ZEROES. DTSVAL04 00171 01 GRAND-EMPLOYEE-CNT PIC 9(08) VALUE ZEROES. DTSVAL04 00172 01 TOTAL-EMPLOYER-CNT PIC 9(06) VALUE ZEROES. DTSVAL04 00173 DTSVAL04 00174 01 WS-HOLDING-AREA PIC 9(12) VALUE ZEROES. DTSVAL04 00175 DTSVAL04 00176 01 QTR-TOTL-GROS-WAGE PIC 9(12)V99. DTSVAL04 00177 01 QTR-WGES-REDEF REDEFINES QTR-TOTL-GROS-WAGE. DTSVAL04 00178 05 WS-FILL-WGE PIC 9(07). DTSVAL04 00179 05 WS-EMPL-WAGE-CENTS PIC 9(05)V99. DTSVAL04 00180 DTSVAL04 00181 01 GRAND-GROS-WAGE PIC 9(13)V99. DTSVAL04 00182 DTSVAL04 00183 01 GRAND-S-RECORD-TOTAL PIC 9(12)V99. DTSVAL04 00184 DTSVAL04 00185 DTSVAL04 00186 01 LINE-COUNT-DETAIL PIC 9(02) VALUE 99. DTSVAL04 00187 01 PAGE-COUNT-1 PIC 9(04) VALUE ZEROES. DTSVAL04 00188 01 PAGE-COUNT-2 PIC 9(04) VALUE ZEROES. DTSVAL04 00189 DTSVAL04 00190 ******************************************************************DTSVAL04 00191 * TRANSACTION W4 - ADD WAGE INFORMATION *DTSVAL04 00192 ******************************************************************DTSVAL04 00193 DTSVAL04 00194 01 W4-TRAN-AREA. DTSVAL04 00195 10 W4-KEY-DATA. DTSVAL04 00196 15 W4-SSN PIC 9(09). DTSVAL04 00197 15 FILLER DTSVAL04 00198 REDEFINES DTSVAL04 00199 W4-SSN. DTSVAL04 00200 20 W4-SSN1 PIC X(03). DTSVAL04 00201 20 W4-SSN2 PIC X(02). DTSVAL04 00202 20 W4-SSN3 PIC X(04). DTSVAL04 00203 15 FILLER PIC 9(01). DTSVAL04 00204 15 W4-TRAN-ID PIC X(02). DTSVAL04 00205 15 W4-TRAN-OPER-ID. DTSVAL04 00206 20 W4-TRAN-CLM-CNTR PIC 9(06). DTSVAL04 00207 20 W4-TRAN-OPR-ID PIC 9(02). DTSVAL04 00208 15 W4-DATE-ENTERED PIC 9(08). DTSVAL04 00209 15 FILLER REDEFINES W4-DATE-ENTERED. DTSVAL04 00210 20 W4-CENTURY-ENTERED PIC 9(2). DTSVAL04 00211 20 W4-DTE-ENTERED PIC 9(6). DTSVAL04 00212 15 W4-TIME-ENTERED PIC 9(06). DTSVAL04 00213 15 FILLER PIC X(6). DTSVAL04 00214 10 W4-TRAN-DATA. DTSVAL04 00215 15 W4-NAME-CHECK PIC X(03). DTSVAL04 00216 15 W4-QUARTER PIC 9(5). DTSVAL04 00217 15 FILLER REDEFINES W4-QUARTER. DTSVAL04 00218 20 W4-QTR-CENTURY PIC 9(2). DTSVAL04 00219 20 W4-QTR PIC 9(3). DTSVAL04 00220 15 W4-AFFI-CODE PIC X(1). DTSVAL04 00221 15 W4-QUARTER-EARNINGS PIC 9(7). DTSVAL04 00222 15 W4-ACCOUNT PIC 9(6). DTSVAL04 00223 15 W4-EMP-NAME PIC X(4). DTSVAL04 00224 15 W4-ZFILLER pic x(14). CL*24 00225 ******************************************************************DTSVAL04 00226 * DETAIL REPORT FOR WAGES *DTSVAL04 00227 ******************************************************************DTSVAL04 00228 01 DETAIL-LINE. DTSVAL04 00229 05 FILLER PIC X(10) VALUE SPACES. DTSVAL04 00230 05 DETAIL-SSN. DTSVAL04 00231 10 DETAIL-SSN1 PIC 9(03). DTSVAL04 00232 10 FILLER PIC X(01) VALUE '-'. DTSVAL04 00233 10 DETAIL-SSN2 PIC 9(02). DTSVAL04 00234 10 FILLER PIC X(01) VALUE '-'. DTSVAL04 00235 10 DETAIL-SSN3 PIC 9(04). DTSVAL04 00236 05 FILLER PIC X(25) VALUE SPACES. DTSVAL04 00237 05 DETAIL-NAME PIC X(03). DTSVAL04 00238 05 FILLER PIC X(33) VALUE SPACES. DTSVAL04 00239 05 DETAIL-EARNINGS PIC ZZZ,Z(03).99. DTSVAL04 00240 DTSVAL04 00241 01 SUMMARY-LINE. DTSVAL04 00242 05 FILLER PIC X(07) VALUE SPACES. DTSVAL04 00243 05 SUM-EMPL-COUNT PIC Z,ZZZ,ZZ9. DTSVAL04 00244 05 FILLER PIC X(11) VALUE SPACES. DTSVAL04 00245 05 SUM-EMPL-FROM-TAPE PIC Z,ZZZ,ZZ9. DTSVAL04 00246 05 FILLER PIC X(12) VALUE SPACES. DTSVAL04 00247 05 SUM-EMPL-MATCH PIC X(03). DTSVAL04 00248 05 FILLER PIC X(03) VALUE SPACES. DTSVAL04 00249 05 SUM-EMPL-GROSS-COUNT DTSVAL04 00250 PIC ZZZ,ZZZ,ZZZ,ZZZ.99. DTSVAL04 00251 05 FILLER PIC X(06) VALUE SPACES. DTSVAL04 00252 05 SUM-EMPL-GROSS-FROM-TAPE DTSVAL04 00253 PIC ZZZ,ZZZ,ZZZ,ZZZ.99. DTSVAL04 00254 05 FILLER PIC X(11) VALUE SPACES. DTSVAL04 00255 05 SUM-EMPL-TOTALS-MATCH PIC X(03). DTSVAL04 00256 DTSVAL04 00257 01 HEADER1. DTSVAL04 00258 03 FILLER PIC X(05) VALUE SPACES. DTSVAL04 00259 03 REPORTING-DATE. DTSVAL04 00260 05 REPORTING-DATE-MM PIC X(02). DTSVAL04 00261 05 FILLER PIC X(01) VALUE '/'. DTSVAL04 00262 05 REPORTING-DATE-DD PIC X(02). DTSVAL04 00263 05 FILLER PIC X(01) VALUE '/'. DTSVAL04 00264 05 REPORTING-DATE-YY PIC X(02). DTSVAL04 00265 03 FILLER PIC X(38) VALUE SPACES. DTSVAL04 00266 03 FILLER PIC X(31) VALUE DTSVAL04 00267 'DISTRICT OF COLUMBIA GOVERNMENT'. DTSVAL04 00268 03 FILLER PIC X(30) VALUE SPACES. DTSVAL04 00269 03 FILLER PIC X(16) VALUE DTSVAL04 00270 'REPORT: dtsval04'. CL**9 00271 03 FILLER PIC X(05) VALUE SPACES. DTSVAL04 00272 DTSVAL04 00273 01 HEADER2. DTSVAL04 00274 03 FILLER PIC X(50) VALUE SPACES. DTSVAL04 00275 03 FILLER PIC X(33) VALUE DTSVAL04 00276 'DEPARTMENT OF EMPLOYMENT SERVICES'. DTSVAL04 00277 03 FILLER PIC X(30) VALUE SPACES. DTSVAL04 00278 03 FILLER PIC X(10) VALUE DTSVAL04 00279 'PAGE NO. '. DTSVAL04 00280 03 HD-PAGE PIC 9(03). DTSVAL04 00281 03 FILLER PIC X(07) VALUE SPACES. DTSVAL04 00282 DTSVAL04 00283 01 HEADER3. DTSVAL04 00284 03 FILLER PIC X(40) VALUE SPACES. DTSVAL04 00285 03 FILLER PIC X(47) VALUE DTSVAL04 00286 'ICESA FORMAT QUARTERLY WAGE REPORT FOR ACCOUNT '. DTSVAL04 00287 03 HD-ACCOUNT PIC 9(06). DTSVAL04 00288 03 FILLER PIC X(40) VALUE SPACES. DTSVAL04 00289 DTSVAL04 00290 01 HEADER3-A. DTSVAL04 00291 03 FILLER PIC X(50) VALUE SPACES. DTSVAL04 00292 03 FILLER PIC X(33) VALUE DTSVAL04 00293 'ICESA FORMAT QUARTERLY TAX REPORT'. DTSVAL04 00294 03 FILLER PIC X(50) VALUE SPACES. DTSVAL04 00295 DTSVAL04 00296 01 HEADER4. DTSVAL04 00297 03 FILLER PIC X(57) VALUE SPACES. DTSVAL04 00298 03 HD-QUARTER PIC X(06). DTSVAL04 00299 03 FILLER PIC X(12) VALUE DTSVAL04 00300 ' QUARTER OF '. DTSVAL04 00301 03 HD-YEAR PIC 9(02). DTSVAL04 00302 03 FILLER PIC X(56) VALUE SPACES. DTSVAL04 00303 DTSVAL04 00304 01 COLUMN-DETAIL-HD1. DTSVAL04 00305 03 FILLER PIC X(14) VALUE SPACES. DTSVAL04 00306 03 FILLER PIC X(03) VALUE 'SSN'. DTSVAL04 00307 03 FILLER PIC X(29) VALUE SPACES. DTSVAL04 00308 03 FILLER PIC X(04) VALUE 'NAME'. DTSVAL04 00309 03 FILLER PIC X(32) VALUE SPACES. DTSVAL04 00310 03 FILLER PIC X(08) VALUE DTSVAL04 00311 'EARNINGS'. DTSVAL04 00312 DTSVAL04 00313 01 COLUMN-SUMMARY-HD1. DTSVAL04 00314 03 FILLER PIC X(10) VALUE SPACES. DTSVAL04 00315 03 FILLER PIC X(08) VALUE DTSVAL04 00316 'EMPLOYEE'. DTSVAL04 00317 03 FILLER PIC X(08) VALUE SPACES. DTSVAL04 00318 03 FILLER PIC X(14) VALUE DTSVAL04 00319 'EMPLOYEE COUNT'. DTSVAL04 00320 03 FILLER PIC X(07) VALUE SPACES. DTSVAL04 00321 03 FILLER PIC X(06) VALUE DTSVAL04 00322 'TOTALS'. DTSVAL04 00323 03 FILLER PIC X(12) VALUE SPACES. DTSVAL04 00324 03 FILLER PIC X(05) VALUE DTSVAL04 00325 'GROSS'. DTSVAL04 00326 03 FILLER PIC X(17) VALUE SPACES. DTSVAL04 00327 03 FILLER PIC X(15) VALUE DTSVAL04 00328 'GROSS AMOUNT'. DTSVAL04 00329 03 FILLER PIC X(10) VALUE SPACES. DTSVAL04 00330 03 FILLER PIC X(06) VALUE DTSVAL04 00331 'TOTALS'. DTSVAL04 00332 DTSVAL04 00333 01 COLUMN-SUMMARY-HD2. DTSVAL04 00334 03 FILLER PIC X(11) VALUE SPACES. DTSVAL04 00335 03 FILLER PIC X(05) VALUE DTSVAL04 00336 'COUNT'. DTSVAL04 00337 03 FILLER PIC X(13) VALUE SPACES. DTSVAL04 00338 03 FILLER PIC X(09) VALUE DTSVAL04 00339 'FROM TAPE'. DTSVAL04 00340 03 FILLER PIC X(09) VALUE SPACES. DTSVAL04 00341 03 FILLER PIC X(06) VALUE DTSVAL04 00342 'MATCH?'. DTSVAL04 00343 03 FILLER PIC X(12) VALUE SPACES. DTSVAL04 00344 03 FILLER PIC X(06) VALUE DTSVAL04 00345 'AMOUNT'. DTSVAL04 00346 03 FILLER PIC X(17) VALUE SPACES. DTSVAL04 00347 03 FILLER PIC X(09) VALUE DTSVAL04 00348 'FROM TAPE'. DTSVAL04 00349 03 FILLER PIC X(15) VALUE SPACES. DTSVAL04 00350 03 FILLER PIC X(06) VALUE DTSVAL04 00351 'MATCH?'. DTSVAL04 00352 DTSVAL04 00353 01 COLUMN-TAX-HD1. DTSVAL04 00354 03 FILLER PIC X(01) VALUE SPACES. DTSVAL04 00355 03 FILLER PIC X(07) VALUE DTSVAL04 00356 'ACCOUNT'. DTSVAL04 00357 03 FILLER PIC X(22) VALUE SPACES. DTSVAL04 00358 03 FILLER PIC X(09) VALUE DTSVAL04 00359 'NUMBER OF'. DTSVAL04 00360 03 FILLER PIC X(16) VALUE SPACES. DTSVAL04 00361 03 FILLER PIC X(03) VALUE DTSVAL04 00362 'TAX'. DTSVAL04 00363 03 FILLER PIC X(34) VALUE SPACES. DTSVAL04 00364 03 FILLER PIC X(05) VALUE DTSVAL04 00365 'GROSS'. DTSVAL04 00366 DTSVAL04 00367 01 COLUMN-TAX-HD2. DTSVAL04 00368 03 FILLER PIC X(02) VALUE SPACES. DTSVAL04 00369 03 FILLER PIC X(06) VALUE DTSVAL04 00370 'NUMBER'. DTSVAL04 00371 03 FILLER PIC X(22) VALUE SPACES. DTSVAL04 00372 03 FILLER PIC X(09) VALUE DTSVAL04 00373 'EMPLOYEES'. DTSVAL04 00374 03 FILLER PIC X(15) VALUE SPACES. DTSVAL04 00375 03 FILLER PIC X(04) VALUE DTSVAL04 00376 'RATE'. DTSVAL04 00377 03 FILLER PIC X(34) VALUE SPACES. DTSVAL04 00378 03 FILLER PIC X(05) VALUE DTSVAL04 00379 'WAGES'. DTSVAL04 00380 DTSVAL04 00381 01 COLUMN-TAX-HD3. DTSVAL04 00382 03 FILLER PIC X(13) VALUE SPACES. DTSVAL04 00383 03 FILLER PIC X(02) VALUE DTSVAL04 00384 'UI'. DTSVAL04 00385 03 FILLER PIC X(27) VALUE SPACES. DTSVAL04 00386 03 FILLER PIC X(06) VALUE DTSVAL04 00387 'EXCESS'. DTSVAL04 00388 03 FILLER PIC X(23) VALUE SPACES. DTSVAL04 00389 03 FILLER PIC X(07) VALUE DTSVAL04 00390 'TAXABLE'. DTSVAL04 00391 03 FILLER PIC X(38) VALUE SPACES. DTSVAL04 00392 03 FILLER PIC X(06) VALUE DTSVAL04 00393 'AMOUNT'. DTSVAL04 00394 DTSVAL04 00395 01 COLUMN-TAX-HD4. DTSVAL04 00396 03 FILLER PIC X(12) VALUE SPACES. DTSVAL04 00397 03 FILLER PIC X(05) VALUE DTSVAL04 00398 'WAGES'. DTSVAL04 00399 03 FILLER PIC X(26) VALUE SPACES. DTSVAL04 00400 03 FILLER PIC X(05) VALUE DTSVAL04 00401 'WAGES'. DTSVAL04 00402 03 FILLER PIC X(24) VALUE SPACES. DTSVAL04 00403 03 FILLER PIC X(05) VALUE DTSVAL04 00404 'WAGES'. DTSVAL04 00405 03 FILLER PIC X(41) VALUE SPACES. DTSVAL04 00406 03 FILLER PIC X(03) VALUE DTSVAL04 00407 'DUE'. DTSVAL04 00408 DTSVAL04 00409 01 EMPLOYER-STATUS-RECORD-DATA. DTSVAL04 00410 *++INCLUDE ESPTAXAD CL*27 00411 EJECT DTSVAL04 00412 DTSVAL04 00413 01 HD1. DTSVAL04 00414 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 00415 03 FIL PIC X(8) VALUE 'dtsval04'. CL**9 00416 03 FIL PIC X(31) VALUE SPACES. DTSVAL04 00417 03 FIL PIC X(42) VALUE DTSVAL04 00418 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. DTSVAL04 00419 03 FIL PIC X(35) VALUE SPACES. DTSVAL04 00420 03 FIL PIC X(5) VALUE 'PAGE:'. DTSVAL04 00421 03 PAGE-CTR-PRT PIC ZZ,ZZ9. DTSVAL04 00422 DTSVAL04 00423 01 HD2. DTSVAL04 00424 03 FIL PIC X(49) VALUE SPACES. DTSVAL04 00425 03 FIL PIC X(39) VALUE DTSVAL04 00426 'DOES UI WAGE RECORD EDIT REPORT'. DTSVAL04 00427 DTSVAL04 00428 01 HD3. DTSVAL04 00429 03 FIL PIC X(57) VALUE SPACES. DTSVAL04 00430 03 FIL PIC X(9) VALUE 'RUN DATE:'. DTSVAL04 00431 03 REPORT-DATE-MM PIC X(2). DTSVAL04 00432 03 FILLER PIC X VALUE '/'. DTSVAL04 00433 03 REPORT-DATE-DD PIC X(2). DTSVAL04 00434 03 FILLER PIC X VALUE '/'. DTSVAL04 00435 03 REPORT-DATE-YY PIC X(2). DTSVAL04 00436 DTSVAL04 00437 01 HD4 PIC X(133) VALUE SPACES. DTSVAL04 00438 DTSVAL04 00439 01 HD5. DTSVAL04 00440 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 00441 03 FIL PIC X(3) VALUE 'SSN'. DTSVAL04 00442 03 FIL PIC X(7) VALUE SPACES. DTSVAL04 00443 03 FIL PIC X(12) VALUE 'DATE ENTERED'. DTSVAL04 00444 03 FIL PIC X(02) VALUE SPACES. DTSVAL04 00445 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. DTSVAL04 00446 03 FIL PIC X(2) VALUE SPACES. DTSVAL04 00447 03 FIL PIC X(7) VALUE 'QUARTER'. DTSVAL04 00448 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 00449 03 FIL PIC X(8) VALUE 'EARNINGS'. DTSVAL04 00450 03 FIL PIC X(7) VALUE SPACES. DTSVAL04 00451 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. DTSVAL04 00452 03 FIL PIC X(2) VALUE SPACES. DTSVAL04 00453 03 FIL PIC X(13) VALUE 'EMPLOYER NAME'. DTSVAL04 00454 03 FIL PIC X(04) VALUE SPACES. DTSVAL04 00455 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'.DTSVAL04 00456 DTSVAL04 00457 01 HD6 PIC X(133) VALUE SPACES. DTSVAL04 00458 DTSVAL04 00459 01 DTL1. DTSVAL04 00460 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 00461 03 SSN-PRT PIC X(9). DTSVAL04 00462 03 FIL PIC XX VALUE SPACES. DTSVAL04 00463 03 DATE-ENTERED-PRT PIC X(08). DTSVAL04 00464 03 FIL PIC X(10) VALUE SPACES. DTSVAL04 00465 03 EMPEE-NAME PIC X(3). DTSVAL04 00466 03 FIL PIC X(07) VALUE SPACES. DTSVAL04 00467 03 QTR-PRT PIC X(6). DTSVAL04 00468 03 FIL PIC X(06) VALUE SPACES. DTSVAL04 00469 03 EARNINGS-PRT PIC 9(7)V99. DTSVAL04 00470 03 EARNINGS-PRT-X REDEFINES EARNINGS-PRT DTSVAL04 00471 PIC X(9). DTSVAL04 00472 03 FIL PIC X(10) VALUE SPACES. DTSVAL04 00473 03 ACCT-NUM-PRT PIC X(6). DTSVAL04 00474 03 FIL PIC X(9) VALUE SPACES. DTSVAL04 00475 03 EMPOR-PRT PIC X(6). DTSVAL04 00476 03 FIL PIC X(08) VALUE SPACES. DTSVAL04 00477 03 MESSAGE-AREA PIC X(30) VALUE SPACES. DTSVAL04 00478 DTSVAL04 00479 01 TOT1. DTSVAL04 00480 03 FIL PIC X(2) VALUE SPACES. DTSVAL04 00481 03 FIL PIC X(21) VALUE 'TOTAL WAGE RECS READ:'. DTSVAL04 00482 03 WAGE-CNT-PRT PIC ZZZ,ZZ9. DTSVAL04 00483 03 FIL PIC X(6) VALUE SPACES. DTSVAL04 00484 03 FIL PIC X(24) VALUE 'TOTAL WAGE RECS WRITTEN:'.DTSVAL04 00485 03 WAGE-OUT-PRT PIC ZZZ,ZZ9. DTSVAL04 00486 03 FIL PIC X(6) VALUE SPACES. DTSVAL04 00487 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. DTSVAL04 00488 03 ERRORS-PRT PIC ZZ,ZZ9. DTSVAL04 00489 03 FIL PIC X(6) VALUE SPACES. DTSVAL04 00490 03 FIL PIC X(20) VALUE 'TOTAL ZERO WAGE REC:'. DTSVAL04 00491 03 ZERO-WAGE-PRT PIC ZZ,ZZ9. DTSVAL04 00492 DTSVAL04 00493 03 BLANK-LINE PIC X(133) VALUE SPACES. DTSVAL04 00494 DTSVAL04 00495 LINKAGE SECTION. DTSVAL04 00496 ******************************************************************DTSVAL04 00497 * *DTSVAL04 00498 * THIS PROCEDURE WILL WRITE THE SELECTED RECORDS *DTSVAL04 00499 * *DTSVAL04 00500 * FOR THE EWGTRNW4 WAGE FORMAT *DTSVAL04 00501 * *DTSVAL04 00502 ******************************************************************DTSVAL04 00503 DTSVAL04 00504 PROCEDURE DIVISION. CL**7 00505 DTSVAL04 00506 MAIN0100-CONTROL. DTSVAL04 00507 DTSVAL04 00508 OPEN INPUT ICESA-FILE DTSVAL04 00509 OUTPUT W4-FILE LISTOUT ICERR-FILE CL*14 00510 PRINT-FILE. DTSVAL04 00511 DTSVAL04 00512 ACCEPT WS-TODAY FROM DATE. DTSVAL04 00513 MOVE WS-TODAY-YY TO REPORT-DATE-YY REPORTING-DATE-YY. DTSVAL04 00514 MOVE WS-TODAY-MM TO REPORT-DATE-MM REPORTING-DATE-MM. DTSVAL04 00515 MOVE WS-TODAY-DD TO REPORT-DATE-DD REPORTING-DATE-DD. DTSVAL04 00516 DTSVAL04 00517 MOVE ZEROS TO COUNTERS. DTSVAL04 00518 DTSVAL04 00519 MOVE LOW-VALUE TO W4-TRAN-AREA. DTSVAL04 00520 DTSVAL04 00521 MOVE ZEROES TO GRAND-GROS-WAGE DTSVAL04 00522 GRAND-S-RECORD-TOTAL DTSVAL04 00523 QTR-TOTL-GROS-WAGE. DTSVAL04 00524 DTSVAL04 00525 PERFORM PROC1000-WAGE-SEARCH THRU DTSVAL04 00526 PROC1000-WAGE-EXIT until rec-end. CL**7 00527 CL**7 00528 CL**7 00529 DTSVAL04 00530 MAIN0100-CONTINUE. DTSVAL04 00531 DTSVAL04 00532 IF ERROR-SW = 1 CL*12 00533 MOVE +3 TO RETURN-CODE CL*12 00534 ELSE DTSVAL04 00535 MOVE ZEROES TO RETURN-CODE. DTSVAL04 00536 DTSVAL04 00537 PERFORM 999-CLOSE-FILES THRU 999-EXIT. DTSVAL04 00538 DTSVAL04 00539 GOBACK. DTSVAL04 00540 DTSVAL04 00541 MAIN0100-CONTROL-EXIT. DTSVAL04 00542 EXIT. DTSVAL04 00543 DTSVAL04 00544 PROC1000-WAGE-SEARCH. DTSVAL04 00545 DTSVAL04 00546 READ ICESA-FILE DTSVAL04 00547 AT END DTSVAL04 00548 MOVE 'Y' TO REC-END-IND CL*19 00549 go to PROC1000-WAGE-EXIT. CL*19 00550 DTSVAL04 00551 MOVE SPACES TO W4-TRAN-AREA. CL*24 00552 MOVE ICESA-REC TO WAGE-RECORD-S CL*14 00553 PERFORM PROC2000-S-RECORD THRU CL*14 00554 PROC2000-S-EXIT. CL*14 00555 PROC1000-WAGE-EXIT. DTSVAL04 00556 EXIT. DTSVAL04 00557 DTSVAL04 00558 DTSVAL04 00559 PROC2000-S-RECORD. DTSVAL04 00560 DTSVAL04 00561 MOVE LOW-VALUES TO W4-TRAN-AREA. CL*26 00562 MOVE 998888 TO W4-ACCOUNT CL*13 00563 HD-ACCOUNT. CL*11 00564 MOVE 'DIST' TO W4-EMP-NAME. CL*13 00565 CL*11 00566 INSPECT S-GROSS-WAGE REPLACING DTSVAL04 00567 LEADING ' ' BY ZERO. DTSVAL04 00568 CL**6 00569 IF S-GROSS-WAGE = ZEROS CL**6 00570 MOVE S-UNEMP-WAGE TO S-GROSS-WAGE. CL**6 00571 DTSVAL04 00572 IF S-GROSS-WAGE NOT NUMERIC DTSVAL04 00573 MOVE 'GROSS-WAGE NOT NUMERIC' TO MESSAGE-AREA DTSVAL04 00574 MOVE 1 TO ERROR-SW DTSVAL04 00575 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*15 00576 DTSVAL04 00577 IF S-GROSS-WAGE = ZEROS DTSVAL04 00578 IF WS-ZERO-WAGE-NO = EXCEPTION-CNT DTSVAL04 00579 ADD 1 TO ZERO-WAGE-CNT DTSVAL04 00580 GO TO PROC1000-WAGE-SEARCH DTSVAL04 00581 ELSE DTSVAL04 00582 MOVE 'GROSS-WAGE EQUAL ZEROS' TO MESSAGE-AREA DTSVAL04 00583 MOVE 1 TO ERROR-SW CL*12 00584 ADD 1 TO ZERO-WAGE-CNT DTSVAL04 00585 ADD 1 TO EXCEPTION-CNT DTSVAL04 00586 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT DTSVAL04 00587 MOVE ZERO TO ERROR-SW DTSVAL04 00588 GO TO PROC2000-S-EXIT. DTSVAL04 00589 DTSVAL04 00590 ADD S-GROSS-WAGE TO grand-gros-wage. CL*21 00591 CL*20 00592 MOVE WS-TODAY TO W4-DTE-ENTERED. DTSVAL04 00593 MOVE 20 TO W4-CENTURY-ENTERED. DTSVAL04 00594 DTSVAL04 00595 IF S-SSN NOT NUMERIC DTSVAL04 00596 OR (S-SSN NOT GREATER THAN ZEROES) DTSVAL04 00597 MOVE 'SSN NOT NUMERIC' TO MESSAGE-AREA DTSVAL04 00598 MOVE 1 TO ERROR-SW DTSVAL04 00599 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT DTSVAL04 00600 ELSE DTSVAL04 00601 MOVE S-SSN TO W4-SSN DTSVAL04 00602 WS-HOLD-SSN DTSVAL04 00603 MOVE WS-HOLD-SSN-1 TO DETAIL-SSN1 DTSVAL04 00604 MOVE WS-HOLD-SSN-2 TO DETAIL-SSN2 DTSVAL04 00605 MOVE WS-HOLD-SSN-3 TO DETAIL-SSN3. DTSVAL04 00606 DTSVAL04 00607 MOVE SPACES TO W4-NAME-CHECK. DTSVAL04 00608 CL**2 00609 INSPECT S-LAST-NAME CONVERTING WS-LOWER TO WS-UPPER. CL**2 00610 CL**2 00611 MOVE S-LAST-NAME TO WS-LAST-NAME. DTSVAL04 00612 DTSVAL04 00613 IF WS-LAST EQUAL SPACES DTSVAL04 00614 MOVE 'EMPLOYEE-NAME EQUAL SPACES' TO MESSAGE-AREA DTSVAL04 00615 MOVE 1 TO ERROR-SW DTSVAL04 00616 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT DTSVAL04 00617 ELSE DTSVAL04 00618 MOVE WS-LAST TO W4-NAME-CHECK DTSVAL04 00619 DETAIL-NAME. DTSVAL04 00620 DTSVAL04 00621 IF S-REPT-MTH NUMERIC AND S-REPT-YR NUMERIC CL**4 00622 MOVE S-REPT-MTH TO WS-REPT-MM DTSVAL04 00623 MOVE S-REPT-YR TO WS-REPT-YR DTSVAL04 00624 MOVE WS-REPT-YR TO WS-QTR-YY DTSVAL04 00625 ELSE DTSVAL04 00626 MOVE 'QTR OR YEAR NOT NUMERIC' TO MESSAGE-AREA DTSVAL04 00627 MOVE 1 TO ERROR-SW DTSVAL04 00628 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*15 00629 DTSVAL04 00630 IF WS-REPT-MM = '03' DTSVAL04 00631 MOVE 1 TO WS-QTR-QTR DTSVAL04 00632 ELSE DTSVAL04 00633 IF WS-REPT-MM = '06' DTSVAL04 00634 MOVE 2 TO WS-QTR-QTR DTSVAL04 00635 ELSE DTSVAL04 00636 IF WS-REPT-MM = '09' DTSVAL04 00637 MOVE 3 TO WS-QTR-QTR DTSVAL04 00638 ELSE DTSVAL04 00639 IF WS-REPT-MM = '12' DTSVAL04 00640 MOVE 4 TO WS-QTR-QTR DTSVAL04 00641 ELSE DTSVAL04 00642 MOVE 'QUARTER ERROR WITH MONTH' DTSVAL04 00643 TO MESSAGE-AREA DTSVAL04 00644 MOVE 1 TO ERROR-SW DTSVAL04 00645 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*15 00646 DTSVAL04 00647 MOVE WS-QTR-QTR TO WS-YQTR-Q. DTSVAL04 00648 MOVE WS-QTR-YY TO WS-YQTR-Y. DTSVAL04 00649 MOVE WS-YQTR TO L004-QTR-3-X. DTSVAL04 00650 PERFORM S004-FROM-3 THRU S004-EXIT. DTSVAL04 00651 IF L004-VALID-QTR DTSVAL04 00652 MOVE L004-QTR-5-9 TO WS-QUARTER-YR-QTR DTSVAL04 00653 W4-QUARTER. DTSVAL04 00654 DTSVAL04 00655 MOVE S-GROSS-WAGE TO QTR-TOTL-GROS-WAGE. DTSVAL04 00656 DTSVAL04 00657 COMPUTE WS-HOLDING-AREA = (QTR-TOTL-GROS-WAGE / 100) * 100 DTSVAL04 00658 MOVE WS-HOLDING-AREA TO W4-QUARTER-EARNINGS DTSVAL04 00659 DETAIL-EARNINGS. DTSVAL04 00660 DTSVAL04 00661 MOVE WS-AFFI-CODE TO W4-AFFI-CODE. DTSVAL04 00662 MOVE 'W4' TO W4-TRAN-ID. DTSVAL04 00663 DTSVAL04 00664 MOVE WS-TRN-OPER-ID TO W4-TRAN-OPER-ID. DTSVAL04 00665 MOVE TIME-FIXED TO W4-TIME-ENTERED. DTSVAL04 00666 DTSVAL04 00667 IF ERROR-SW = 1 CL*14 00668 WRITE ICERR-REC FROM WAGE-RECORD-S CL*14 00669 MOVE ZERO TO ERROR-SW CL*14 00670 ELSE CL*14 00671 * move W4-TRAN-AREA to w4-out-record CL*26 00672 WRITE W4-OUT-RECORD FROM W4-TRAN-AREA CL*26 00673 ADD 1 TO WRITE-CNT CL*16 00674 MOVE ZERO TO ERROR-SW. CL*14 00675 DTSVAL04 00676 ADD 1 TO LINE-COUNT-DETAIL CL*16 00677 EMPLOYEE-CNT-TAPE DTSVAL04 00678 GRAND-EMPLOYEE-CNT. DTSVAL04 00679 DTSVAL04 00680 PROC2000-S-EXIT. DTSVAL04 00681 EXIT. DTSVAL04 00682 ******************************************************************DTSVAL04 00683 * *DTSVAL04 00684 ******************************************************************DTSVAL04 00685 DTSVAL04 00686 PROC4000-F-RECORD. DTSVAL04 00687 DTSVAL04 00688 DISPLAY 'ICESA COUNTS '. DTSVAL04 00689 DTSVAL04 00690 DISPLAY ' '. DTSVAL04 00691 DISPLAY 'TOTAL NUMBER OF S-TYPE REC READ = ' ICESA-CNT. DTSVAL04 00692 DTSVAL04 00693 DISPLAY ' '. DTSVAL04 00694 DISPLAY 'TOTAL NUMBER OF S-TYPE REC GOOD = ' WRITE-CNT. DTSVAL04 00695 DISPLAY ' '. CL*22 00696 DISPLAY 'TOTAL gross wates for dc gov = ' grand-gros-wage. CL*22 00697 DTSVAL04 00698 PROC4000-F-EXIT. DTSVAL04 00699 EXIT. DTSVAL04 00700 DTSVAL04 00701 ******************************************************************DTSVAL04 00702 * *DTSVAL04 00703 ******************************************************************DTSVAL04 00704 DTSVAL04 00705 PROC5000-HEADER-ROUTINE. DTSVAL04 00706 DTSVAL04 00707 MOVE SPACES TO PRINT-REC. DTSVAL04 00708 DTSVAL04 00709 ADD 1 TO PAGE-COUNT-1. DTSVAL04 00710 DTSVAL04 00711 MOVE WS-REPT-YR TO HD-YEAR. DTSVAL04 00712 MOVE PAGE-COUNT-1 TO HD-PAGE. DTSVAL04 00713 DTSVAL04 00714 WRITE PRINT-REC FROM HEADER1 AFTER ADVANCING TOP-OF-PAGE. DTSVAL04 00715 WRITE PRINT-REC FROM HEADER2 AFTER ADVANCING 1. DTSVAL04 00716 WRITE PRINT-REC FROM HEADER3 AFTER ADVANCING 1. DTSVAL04 00717 WRITE PRINT-REC FROM HEADER4 AFTER ADVANCING 2. DTSVAL04 00718 WRITE PRINT-REC FROM COLUMN-DETAIL-HD1 AFTER ADVANCING 2. DTSVAL04 00719 DTSVAL04 00720 MOVE SPACES TO PRINT-REC. DTSVAL04 00721 WRITE PRINT-REC AFTER ADVANCING 2. DTSVAL04 00722 DTSVAL04 00723 MOVE 9 TO LINE-COUNT-DETAIL. DTSVAL04 00724 DTSVAL04 00725 PROC5000-HEADER-EXIT. DTSVAL04 00726 EXIT. DTSVAL04 00727 DTSVAL04 00728 125-WAGE-REPORT. DTSVAL04 00729 MOVE S-SSN TO SSN-PRT. DTSVAL04 00730 MOVE W4-DATE-ENTERED TO DATE-ENTERED-PRT. DTSVAL04 00731 MOVE S-LAST-NAME TO EMPEE-NAME. DTSVAL04 00732 MOVE S-GROSS-WAGE TO EARNINGS-PRT. DTSVAL04 00733 MOVE S-REPORTING-QTR-YR TO QTR-PRT. DTSVAL04 00734 MOVE WS-WAGE-ACCOUNT TO ACCT-NUM-PRT. DTSVAL04 00735 MOVE 'DC GOV' TO EMPOR-PRT. CL*15 00736 IF LINE-CTR > 55 DTSVAL04 00737 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. DTSVAL04 00738 WRITE LIST-REC FROM DTL1. DTSVAL04 00739 IF S-GROSS-WAGE NOT = ZEROS DTSVAL04 00740 ADD 1 TO ERROR-RECS. DTSVAL04 00741 ADD 1 TO LINE-CTR. DTSVAL04 00742 125-WR-EXIT. DTSVAL04 00743 EXIT. DTSVAL04 00744 DTSVAL04 00745 130-WAGE-HEADER. DTSVAL04 00746 ADD 1 TO PAGE-CTR. DTSVAL04 00747 MOVE PAGE-CTR TO PAGE-CTR-PRT. DTSVAL04 00748 WRITE LIST-REC FROM HD1 AFTER TOP-OF-PAGE. DTSVAL04 00749 WRITE LIST-REC FROM HD2. DTSVAL04 00750 WRITE LIST-REC FROM HD3. DTSVAL04 00751 WRITE LIST-REC FROM HD4. DTSVAL04 00752 WRITE LIST-REC FROM HD5. DTSVAL04 00753 WRITE LIST-REC FROM HD6. DTSVAL04 00754 MOVE 6 TO LINE-CTR. DTSVAL04 00755 130-WH-EXIT. DTSVAL04 00756 EXIT. DTSVAL04 00757 DTSVAL04 00758 ******************************************************************DTSVAL04 00759 * OBTAIN YYYYQ YEAR-QUARTER INFORMATION. *DTSVAL04 00760 ******************************************************************DTSVAL04 00761 S004-FROM-3. DTSVAL04 00762 SET L004-FROM-3 TO TRUE. DTSVAL04 00763 GO TO S004-YRQ. DTSVAL04 00764 DTSVAL04 00765 S004-YRQ. DTSVAL04 00766 CALL 'DTSBU004' USING L004-LINK-AREA. DTSVAL04 00767 DTSVAL04 00768 S004-EXIT. DTSVAL04 00769 EXIT. DTSVAL04 00770 EJECT DTSVAL04 00771 DTSVAL04 00772 SERV9999-ABEND. DTSVAL04 00773 DISPLAY '****ICESA *** DTSVAL04 ABENDING ' ABEND-MSG. CL**7 00774 CALL ABEND-MOD USING ABEND-CD. DTSVAL04 00775 SERV9999-EXIT. DTSVAL04 00776 EXIT. DTSVAL04 00777 DTSVAL04 00778 999-CLOSE-FILES. DTSVAL04 00779 MOVE ICESA-CNT TO WAGE-CNT-PRT. DTSVAL04 00780 MOVE WRITE-CNT TO WAGE-OUT-PRT. DTSVAL04 00781 MOVE ERROR-RECS TO ERRORS-PRT. DTSVAL04 00782 MOVE ZERO-WAGE-CNT TO ZERO-WAGE-PRT. DTSVAL04 00783 IF LINE-CTR > 55 DTSVAL04 00784 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. DTSVAL04 00785 WRITE LIST-REC FROM TOT1 AFTER 2. DTSVAL04 00786 CLOSE ICESA-FILE LISTOUT PRINT-FILE CL*14 00787 ICERR-FILE. CL*14 00788 DISPLAY 'TOTAL QTR WAGES ' grand-gros-wage. CL*21 00789 DTSVAL04 00790 999-EXIT. DTSVAL04 00791 EXIT. DTSVAL04