793 lines
63 KiB
COBOL
793 lines
63 KiB
COBOL
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
|