00001 IDENTIFICATION DIVISION. 11/21/18 00002 PROGRAM-ID. DTSBX465. DTSBX465 00003 LV016 00004 ******************************************************************DTSBX465 00005 * *DTSBX465 00006 * *DTSBX465 00007 * FUNCTION: *DTSBX465 00008 * *DTSBX465 00009 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE *DTSBX465 00010 * FILE FOR THE OFFICE OF TAX AND REVENUE. UI WAGE DATA *DTSBX465 00011 * WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON *DTSBX465 00012 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX465 00013 * *DTSBX465 00014 * CONTACT: WALTER GOETZ 202-442-6312 TAX AND REVENUE(OTR) *DTSBX465 00015 * *DTSBX465 00016 * G.A.BROWN *DTSBX465 00017 ******************************************************************DTSBX465 00018 * DTSBX465 00019 * MODIFICATION HISTORY: DTSBX465 00020 * DTSBX465 00021 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK DTSBX465 00022 * ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT DTSBX465 00023 * FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE DTSBX465 00024 * AND THE COMPLETE QUARTER END DATE FIELDS. IF THE DTSBX465 00025 * INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED, DTSBX465 00026 * THE PROGRAM EDITING RESULTS WILL ABEND. DTSBX465 00027 * REFERENCE RFP: STEVE PROGRAMMER: RLWDTSBX465 00028 * DTSBX465 00029 * 06-17-2018 MODIFIED PROGRAM TO READ WAGE NAME FILE AN OUTPUT CL**8 00030 * FULL NAME ON OUTPUT WAGE FILE TO OTR CL**8 00031 * REFERENCE RFP: STEVE PROGRAMMER: ZL1 CL**8 00032 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX465 00033 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX465 00034 * REFERENCE RFP #**** PROGRAMMER: XXXDTSBX465 00035 ***** DTSBX465 00036 DTSBX465 00037 ENVIRONMENT DIVISION. DTSBX465 00038 CONFIGURATION SECTION. DTSBX465 00039 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX465 00040 INPUT-OUTPUT SECTION. DTSBX465 00041 FILE-CONTROL. DTSBX465 00042 SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES. DTSBX465 00043 SELECT WAGE-FILE-G ASSIGN TO UT-S-GOVT. DTSBX465 00044 SELECT WAGE-FILE-F ASSIGN TO UT-S-FED. DTSBX465 00045 DATA DIVISION. DTSBX465 00046 FILE SECTION. DTSBX465 00047 DTSBX465 00048 FD WAGE-FILE DTSBX465 00049 RECORDING MODE IS F DTSBX465 00050 LABEL RECORD ARE STANDARD DTSBX465 00051 RECORD CONTAINS 80 CHARACTERS CL**3 00052 BLOCK CONTAINS 0 RECORDS DTSBX465 00053 DATA RECORD IS WAGE-REC. DTSBX465 00054 DTSBX465 00055 01 WAGE-REC. DTSBX465 00056 03 EMPLOYEE-SSN PIC 9(9). DTSBX465 00057 03 EMPLOYEE-LAST-NAME PIC X(20). CL**3 00058 03 EMPLOYEE-FIRST-NAME PIC X(15). CL**3 00059 03 EMPLOYEE-MID-INIT PIC X(01). CL**3 00060 03 EMPLOYER-ACCT-NUM PIC 9(6). DTSBX465 00061 03 EMPLOYEE-WAGES PIC 9(7). DTSBX465 00062 03 CEN-YEAR-QUARTER PIC 9(5). DTSBX465 00063 03 WAGE-UPDATE-DATE PIC 9(8). DTSBX465 00064 03 FEDERAL-ID-NUMBER PIC 9(9). DTSBX465 00065 DTSBX465 00066 FD WAGE-FILE-G DTSBX465 00067 RECORDING MODE IS F DTSBX465 00068 LABEL RECORD ARE STANDARD DTSBX465 00069 RECORD CONTAINS 80 CHARACTERS CL**3 00070 BLOCK CONTAINS 0 RECORDS DTSBX465 00071 DATA RECORD IS WAGE-REC-G. DTSBX465 00072 DTSBX465 00073 01 WAGE-REC-G. DTSBX465 00074 03 EMPLOYEE-SSN-G PIC 9(9). DTSBX465 00075 03 EMPLOYEE-LAST-NAME-G PIC X(20). CL**3 00076 03 EMPLOYEE-FIRST-NAME-G PIC X(15). CL**3 00077 03 EMPLOYEE-MID-INIT-G PIC X(01). CL**3 00078 03 EMPLOYER-ACCT-NUM-G PIC 9(6). DTSBX465 00079 03 EMPLOYEE-WAGES-G PIC 9(7). DTSBX465 00080 03 CEN-YEAR-QUARTER-G PIC 9(5). DTSBX465 00081 03 WAGE-UPDATE-DATE-G PIC 9(8). DTSBX465 00082 03 FEDERAL-ID-NUMBER-G PIC 9(9). DTSBX465 00083 DTSBX465 00084 DTSBX465 00085 FD WAGE-FILE-F DTSBX465 00086 RECORDING MODE IS F DTSBX465 00087 LABEL RECORD ARE STANDARD DTSBX465 00088 RECORD CONTAINS 80 CHARACTERS CL**3 00089 BLOCK CONTAINS 0 RECORDS DTSBX465 00090 DATA RECORD IS WAGE-REC-F. DTSBX465 00091 DTSBX465 00092 01 WAGE-REC-F. DTSBX465 00093 03 EMPLOYEE-SSN-F PIC 9(9). DTSBX465 00094 03 EMPLOYEE-LAST-NAME-F PIC X(20). CL**3 00095 03 EMPLOYEE-FIRST-NAME-F PIC X(15). CL**3 00096 03 EMPLOYEE-MID-INIT-F PIC X(01). CL**3 00097 03 EMPLOYER-ACCT-NUM-F PIC 9(6). DTSBX465 00098 03 EMPLOYEE-WAGES-F PIC 9(7). DTSBX465 00099 03 CEN-YEAR-QUARTER-F PIC 9(5). DTSBX465 00100 03 WAGE-UPDATE-DATE-F PIC 9(8). DTSBX465 00101 03 FEDERAL-ID-NUMBER-F PIC 9(9). DTSBX465 00102 DTSBX465 00103 ******************************************************************DTSBX465 00104 * WORKING STORAGE SECTION *DTSBX465 00105 ******************************************************************DTSBX465 00106 WORKING-STORAGE SECTION. DTSBX465 001065 77 PAN-VALET PICTURE X(24) VALUE '016DTSBX465 11/21/18'. DTSBX465 00107 DTSBX465 00108 01 SELECT-CARD. DTSBX465 00109 03 PRG-NAME PIC X(10) VALUE '**DTSBX465'. DTSBX465 00110 03 FIL PIC XX. DTSBX465 00111 03 FROM-ACTIVITY-DATE PIC 9(8). DTSBX465 00112 03 FIL PIC X. DTSBX465 00113 03 TO-ACTIVITY-DATE PIC 9(8). DTSBX465 00114 03 FIL PIC X VALUE SPACE. DTSBX465 00115 03 DCGOVT PIC X(3). DTSBX465 00116 03 FIL PIC X. DTSBX465 00117 03 FEDGOVT PIC X(3). DTSBX465 00118 03 FIL PIC X. DTSBX465 00119 03 BUSINESS PIC X(3). DTSBX465 00120 03 FIL PIC X(39). DTSBX465 00121 DTSBX465 00122 01 COUNTERS. DTSBX465 00123 03 FEDERAL-ID-NUMBER-WS PIC 9(9). DTSBX465 00124 03 STOP-RECS PIC 9(5). DTSBX465 00125 03 UNMATCH-SW PIC X. DTSBX465 00126 03 ALL-NINES PIC 9. DTSBX465 00127 03 RECS-IN PIC 9(9). DTSBX465 00128 03 RECS-OUT PIC 9(9). DTSBX465 00129 03 QTR-WAGES PIC 9(9). DTSBX465 00130 03 DC-WAGES PIC 9(9). DTSBX465 00131 03 FED-WAGES PIC 9(9). DTSBX465 00132 03 BUSINESS-WAGES PIC 9(9). DTSBX465 00133 03 DC-ACCT PIC 9(6). DTSBX465 00134 03 EMP-ACCT-HOLD PIC 9(6). DTSBX465 00135 03 EMP-ACCT-HOLD-RED PIC 9(6). DTSBX465 00136 03 EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED. DTSBX465 00137 05 ACCT-FOUR PIC 9(4). DTSBX465 00138 05 ACCT-THREE-WS REDEFINES ACCT-FOUR. DTSBX465 00139 07 ACCT-THREE-RED PIC 9(3). DTSBX465 00140 07 ACCT-FIL PIC 9. DTSBX465 00141 05 ACCT-TWO PIC 99. DTSBX465 00142 DTSBX465 00143 03 W-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 00144 03 WRK-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 00145 03 ABEND-CODE PIC S9(04) COMP CL**2 00146 VALUE +465. DTSBX465 00147 03 ABEND-MOD PIC X(08) DTSBX465 00148 VALUE 'DTSBU999'. DTSBX465 00149 03 ABEND-MSG PIC X(60). DTSBX465 00150 DTSBX465 00151 03 WRK-BEGIN-DATE PIC S9(09) COMP-3. DTSBX465 00152 03 WRK-END-DATE PIC S9(09) COMP-3. DTSBX465 00153 DTSBX465 00154 03 WRK-BEGIN-DATE-DISP PIC 9(08). DTSBX465 00155 03 FILLER REDEFINES WRK-BEGIN-DATE-DISP. DTSBX465 00156 05 WRK-BEGIN-YR PIC 9(04). DTSBX465 00157 05 WRK-BEGIN-MO PIC 9(02). DTSBX465 00158 05 WRK-BEGIN-DA PIC 9(02). DTSBX465 00159 DTSBX465 00160 03 WRK-END-DATE-DISP PIC 9(08). DTSBX465 00161 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX465 00162 05 WRK-END-YR PIC 9(04). DTSBX465 00163 05 WRK-END-MO PIC 9(02). DTSBX465 00164 05 WRK-END-DA PIC 9(02). DTSBX465 00165 CL**3 00166 03 WRK-NAME. CL**3 00167 05 WRK-LNAME PIC X(20) VALUE SPACES. CL**3 00168 05 WRK-FNAME PIC X(15) VALUE SPACES. CL**3 00169 05 WRK-INAME PIC X(01) VALUE SPACES. CL**3 00170 01 L001-LINK-AREA. DTSBX465 00171 ++INCLUDE DTSIL001 DTSBX465 00172 DTSBX465 00173 01 L004-LINK-AREA. DTSBX465 00174 ++INCLUDE DTSIL004 DTSBX465 00175 DTSBX465 00176 01 L910-LINK-AREA. DTSBX465 00177 ++INCLUDE DTSIL910 DTSBX465 00178 CL**3 00179 01 L982-LINK-AREA. CL**3 00180 ++INCLUDE DTSIL982 CL**3 00181 DTSBX465 00182 01 MSKL-REC. DTSBX465 00183 ++INCLUDE DTSIMSKL DTSBX465 00184 DTSBX465 00185 01 MHDR-REC. DTSBX465 00186 ++INCLUDE DTSIMHDR DTSBX465 00187 DTSBX465 00188 01 MPRF-REC. DTSBX465 00189 ++INCLUDE DTSIMPRF DTSBX465 00190 CL**3 00191 01 WNAM-REC. CL**3 00192 ++INCLUDE DTSIWNAM CL**3 00193 CL**3 00194 01 COMMON-LINKAGE-SECTION. DTSBX465 00195 ++INCLUDE EWGLINKB DTSBX465 00196 EJECT DTSBX465 00197 EJECT DTSBX465 00198 ******************************************************************DTSBX465 00199 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX465 00200 ******************************************************************DTSBX465 00201 PROCEDURE DIVISION. DTSBX465 00202 BEGIN00000. DTSBX465 00203 OPEN OUTPUT WAGE-FILE, WAGE-FILE-G, WAGE-FILE-F. DTSBX465 00204 ** DTSBX465 00205 **** OPEN UI WAGE MASTER FILE FOR READ ONLY DTSBX465 00206 ** DTSBX465 00207 SET DBW-RANDOM-PROCESSING TO TRUE. DTSBX465 00208 SET DBW-HEADER-RECORD TO TRUE. DTSBX465 00209 SET DBW-OPEN-INPUT TO TRUE. DTSBX465 00210 CALL 'EWG960D' DTSBX465 00211 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 00212 DTSBX465 00213 PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT. DTSBX465 00214 PERFORM S982O-OPEN-READ THRU S982O-EXIT. CL**6 00215 DTSBX465 00216 MOVE ZEROS TO COUNTERS. DTSBX465 00217 MOVE ZERO TO WRK-BEGIN-DATE DTSBX465 00218 WRK-END-DATE. DTSBX465 00219 DTSBX465 00220 MAIN0100-INITIATE. DTSBX465 00221 ACCEPT SELECT-CARD. DTSBX465 00222 DISPLAY ' '. DTSBX465 00223 DISPLAY ' ' SELECT-CARD. DTSBX465 00224 DISPLAY ' '. DTSBX465 00225 DISPLAY ' PROGRAM ' PRG-NAME. DTSBX465 00226 DISPLAY ' FROM-DATE ' FROM-ACTIVITY-DATE. DTSBX465 00227 DISPLAY ' TO-DATE ' TO-ACTIVITY-DATE. DTSBX465 00228 DISPLAY ' DC GOVT ' DCGOVT DTSBX465 00229 DISPLAY ' FED GOVT ' FEDGOVT DTSBX465 00230 DISPLAY ' BUSINESS ' BUSINESS DTSBX465 00231 DISPLAY ' '. DTSBX465 00232 DISPLAY ' '. DTSBX465 00233 DTSBX465 00234 IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX465 00235 AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX465 00236 PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT DTSBX465 00237 ELSE DTSBX465 00238 PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT DTSBX465 00239 PERFORM INIT0200-END-DATE THRU INIT0200-EXIT. DTSBX465 00240 DTSBX465 00241 IF WRK-END-DATE < WRK-BEGIN-DATE DTSBX465 00242 MOVE 'PERIOD END LESS THAN PERIOD BEGIN' DTSBX465 00243 TO ABEND-MSG DTSBX465 00244 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 00245 DTSBX465 00246 MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP. DTSBX465 00247 MOVE WRK-END-DATE TO WRK-END-DATE-DISP. DTSBX465 00248 DISPLAY ' '. DTSBX465 00249 DISPLAY ' FROM-DATE/DEFAULT FROM DATE ' WRK-BEGIN-DATE-DISP.DTSBX465 00250 DISPLAY ' TO-DATE/DEFAULT TO-DATE ' WRK-END-DATE-DISP. DTSBX465 00251 DISPLAY ' '. DTSBX465 00252 DTSBX465 00253 MOVE LOW-VALUE TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 00254 PERFORM MAIN0200-PROCESS-WAGE THRU MAIN0200-EX DTSBX465 00255 UNTIL DBW-END-OF-FILE. DTSBX465 00256 GO TO TERM0100-CLOSE-FILES. DTSBX465 00257 DTSBX465 00258 INIT0100-BEGIN-DATE. DTSBX465 00259 MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX465 00260 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX465 00261 IF L001-VALID-DATE DTSBX465 00262 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE DTSBX465 00263 ELSE DTSBX465 00264 MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG DTSBX465 00265 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 00266 DTSBX465 00267 MOVE WRK-BEGIN-DATE TO L004-DATE. DTSBX465 00268 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX465 00269 IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE DTSBX465 00270 MOVE 'PERIOD BEGIN NOT START OF QTR' DTSBX465 00271 TO ABEND-MSG DTSBX465 00272 PERFORM S999-ABEND THRU S999-EXIT DTSBX465 00273 END-IF. DTSBX465 00274 DTSBX465 00275 INIT0100-EXIT. DTSBX465 00276 EXIT. DTSBX465 00277 DTSBX465 00278 INIT0200-END-DATE. DTSBX465 00279 MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX465 00280 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX465 00281 IF L001-VALID-DATE DTSBX465 00282 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE DTSBX465 00283 ELSE DTSBX465 00284 MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG DTSBX465 00285 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 00286 DTSBX465 00287 MOVE WRK-END-DATE TO L004-DATE. DTSBX465 00288 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX465 00289 IF WRK-END-DATE NOT = L004-QTR-END-DATE DTSBX465 00290 DISPLAY ' END DT ' L004-QTR-END-DATE CL*16 00291 MOVE 'PERIOD END NOT END OF QTR' DTSBX465 00292 TO ABEND-MSG DTSBX465 00293 PERFORM S999-ABEND THRU S999-EXIT DTSBX465 00294 END-IF. DTSBX465 00295 DTSBX465 00296 INIT0200-EXIT. DTSBX465 00297 EXIT. DTSBX465 00298 DTSBX465 00299 INIT0300-DEFAULT-DATES. DTSBX465 00300 DTSBX465 00301 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX465 00302 MOVE +0 TO MSKL-EMP-NO. DTSBX465 00303 SET MSKL-HDR-88 TO TRUE. DTSBX465 00304 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. DTSBX465 00305 DTSBX465 00306 IF L910-NO-REC-88 DTSBX465 00307 MOVE 'MHDR RECORD IS MISSING' DTSBX465 00308 TO ABEND-MSG DTSBX465 00309 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 00310 DTSBX465 00311 MOVE MSKL-REC TO MHDR-REC. DTSBX465 00312 DTSBX465 00313 MOVE MHDR-CMPL-QTR-BEGIN-DATE DTSBX465 00314 TO WRK-BEGIN-DATE. DTSBX465 00315 MOVE MHDR-CMPL-QTR-END-DATE DTSBX465 00316 TO WRK-END-DATE. DTSBX465 00317 DTSBX465 00318 MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE. DTSBX465 00319 MOVE WRK-END-DATE TO TO-ACTIVITY-DATE. DTSBX465 00320 DTSBX465 00321 INIT0300-EXIT. DTSBX465 00322 EXIT. DTSBX465 00323 DTSBX465 00324 MAIN0200-PROCESS-WAGE. DTSBX465 00325 MOVE 'S' TO DBW-PROCESSING-MODE. DTSBX465 00326 MOVE 'SG01' TO DBW-SEGNAME. DTSBX465 00327 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX465 00328 PERFORM LOCATE-WAGE THRU L-W-EX DTSBX465 00329 UNTIL DBW-NO-RECORD-FOUND. DTSBX465 00330 ADD 1 TO RECS-IN. DTSBX465 00331 IF WGP-SSN = 999999999 DTSBX465 00332 GO TO TERM0100-CLOSE-FILES. DTSBX465 00333 IF ALL-NINES = 1 DTSBX465 00334 GO TO TERM0100-CLOSE-FILES. DTSBX465 00335 MAIN0200-EX. DTSBX465 00336 EXIT. DTSBX465 00337 DTSBX465 00338 LOCATE-WAGE. DTSBX465 00339 MOVE 'R' TO DBW-PROCESSING-MODE. DTSBX465 00340 MOVE 'SG02' TO DBW-SEGNAME. DTSBX465 00341 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX465 00342 IF DBW-NO-RECORD-FOUND DTSBX465 00343 GO TO L-W-EX. DTSBX465 00344 PERFORM SEGMENT-2-DATA THRU S-2-D-EX. DTSBX465 00345 L-W-EX. DTSBX465 00346 EXIT. DTSBX465 00347 DTSBX465 00348 SEGMENT-2-DATA. DTSBX465 00349 ********************************************************** DTSBX465 00350 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX465 00351 ******* ************************************************** DTSBX465 00352 IF WGP-SSN = 999999999 DTSBX465 00353 MOVE 1 TO ALL-NINES DTSBX465 00354 GO TO S-2-D-EX. DTSBX465 00355 DTSBX465 00356 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX465 00357 IF WGD-ACTIVITY-DATE NOT LESS THAN FROM-ACTIVITY-DATE DTSBX465 00358 AND DTSBX465 00359 WGD-ACTIVITY-DATE NOT GREATER THAN TO-ACTIVITY-DATE DTSBX465 00360 NEXT SENTENCE ELSE DTSBX465 00361 GO TO S-2-D-EX. DTSBX465 00362 DTSBX465 00363 * DISPLAY ' ENO : ' WGD-ACCOUNT-NUMBER ' ' CL*12 00364 * ' DOCS: ' WGD-ACTIVITY-DATE ' ' CL*12 00365 * ' FROM: ' FROM-ACTIVITY-DATE ' ' CL*12 00366 * ' TO : ' TO-ACTIVITY-DATE. CL*12 00367 DTSBX465 00368 MOVE WGD-ACCOUNT-NUMBER TO EMP-ACCT-HOLD. DTSBX465 00369 MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED. DTSBX465 00370 DTSBX465 00371 IF ACCT-FOUR = DTSBX465 00372 1101 OR 1102 OR 1104 OR 1105 OR 1106 OR 1108 OR DTSBX465 00373 1109 OR 1110 OR 1111 OR 1112 OR 1113 OR 1115 OR DTSBX465 00374 1116 OR 1117 OR 1118 OR 1119 OR 1120 OR 1121 OR 1122 OR DTSBX465 00375 1123 OR 1124 OR 1125 OR 1126 OR 1127 OR 1128 OR 1129 OR DTSBX465 00376 1130 OR 1131 OR 1132 OR 1133 OR 1134 OR 1135 OR 1136 OR DTSBX465 00377 1137 OR 1138 OR 1139 OR 1140 OR 1141 OR 1142 OR 1144 OR DTSBX465 00378 1145 OR 1146 OR 1147 OR 1148 OR 1149 OR 1150 OR 1151 OR DTSBX465 00379 1153 OR 1154 OR 1155 OR 1156 DTSBX465 00380 GO TO S-2-D-EX. DTSBX465 00381 DTSBX465 00382 ADD 1 TO QTR-WAGES. DTSBX465 00383 DTSBX465 00384 40-WRITE-DCGOV-FEDL-BUS-ACCTS. DTSBX465 00385 DTSBX465 00386 PERFORM 110-FEIN-LOOK-UP THRU 110-FLU-EXIT. DTSBX465 00387 DTSBX465 00388 IF WGP-SSN = 000000000 DTSBX465 00389 GO TO S-2-D-EX. DTSBX465 00390 DTSBX465 00391 IF L910-NO-REC-88 DTSBX465 00392 GO TO S-2-D-EX. DTSBX465 00393 DTSBX465 00394 IF DCGOVT = 'DCG' DTSBX465 00395 IF EMP-ACCT-HOLD = 998888 CL*13 00396 PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT DTSBX465 00397 GO TO S-2-D-EX. DTSBX465 00398 DTSBX465 00399 IF FEDGOVT = 'FED' DTSBX465 00400 IF ACCT-THREE-RED = 000 DTSBX465 00401 PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT DTSBX465 00402 GO TO S-2-D-EX. DTSBX465 00403 DTSBX465 00404 IF BUSINESS = 'BUS' CL*15 00405 PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*15 00406 DTSBX465 00407 GO TO S-2-D-EX. DTSBX465 00408 DTSBX465 00409 025-WRITE-FEDERAL-ACCOUNTS. DTSBX465 00410 DTSBX465 00411 * DISPLAY ' FED ACCT ' WGD-ACCOUNT-NUMBER CL*15 00412 IF ACCT-THREE-RED = 000 DTSBX465 00413 ADD 1 TO FED-WAGES. DTSBX465 00414 DTSBX465 00415 MOVE WGP-SSN TO EMPLOYEE-SSN-F. DTSBX465 00416 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER-F. DTSBX465 00417 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM-F. DTSBX465 00418 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES-F. DTSBX465 00419 * MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME-F. CL**3 00420 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE-F. DTSBX465 00421 MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER-F. DTSBX465 00422 * CL**2 00423 MOVE SPACES TO WRK-NAME. CL**2 00424 MOVE LOW-VALUE TO WNAM-REC. CL**2 00425 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL**2 00426 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL**2 00427 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME-F CL**3 00428 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME-F CL**3 00429 MOVE WRK-INAME TO EMPLOYEE-MID-INIT-F CL**3 00430 WRITE WAGE-REC-F. DTSBX465 00431 MOVE SPACES TO WAGE-REC-F. DTSBX465 00432 025-W-F-A-EXT. DTSBX465 00433 EXIT. DTSBX465 00434 DTSBX465 00435 050-WRITE-GOVERNMENT-ACCOUNTS. DTSBX465 00436 * DISPLAY ' DC GOV ACCT ' WGD-ACCOUNT-NUMBER CL*15 00437 * IF WGD-ACCOUNT-NUMBER = 998888 CL*13 00438 ADD 1 TO DC-WAGES. DTSBX465 00439 DTSBX465 00440 MOVE WGP-SSN TO EMPLOYEE-SSN-G. DTSBX465 00441 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER-G. DTSBX465 00442 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM-G. DTSBX465 00443 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES-G. DTSBX465 00444 * MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME-G. CL**3 00445 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE-G. DTSBX465 00446 MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER-G. DTSBX465 00447 * CL**3 00448 MOVE SPACES TO WRK-NAME. CL**3 00449 MOVE LOW-VALUE TO WNAM-REC. CL**3 00450 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL**3 00451 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL**3 00452 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME-G CL**3 00453 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME-G CL**3 00454 MOVE WRK-INAME TO EMPLOYEE-MID-INIT-G CL**3 00455 WRITE WAGE-REC-G. DTSBX465 00456 MOVE SPACES TO WAGE-REC-G. DTSBX465 00457 050-W-G-A-EXT. DTSBX465 00458 EXIT. DTSBX465 00459 100-WRITE-BUSINESS-ACCOUNTS. DTSBX465 00460 DTSBX465 00461 ADD 1 TO BUSINESS-WAGES. DTSBX465 00462 MOVE WGP-SSN TO EMPLOYEE-SSN. DTSBX465 00463 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER. DTSBX465 00464 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM. DTSBX465 00465 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES. DTSBX465 00466 * MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME. CL**3 00467 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. DTSBX465 00468 MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER. DTSBX465 00469 MOVE SPACES TO WRK-NAME. CL**3 00470 MOVE LOW-VALUE TO WNAM-REC. CL**3 00471 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL**3 00472 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL**3 00473 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME CL**3 00474 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME CL**3 00475 MOVE WRK-INAME TO EMPLOYEE-MID-INIT CL**3 00476 WRITE WAGE-REC. DTSBX465 00477 MOVE SPACES TO WAGE-REC. DTSBX465 00478 DTSBX465 00479 100-W-B-A-EXT. DTSBX465 00480 EXIT. DTSBX465 00481 S-2-D-EX. DTSBX465 00482 EXIT. DTSBX465 00483 110-FEIN-LOOK-UP. DTSBX465 00484 DTSBX465 00485 MOVE ZEROS TO FEDERAL-ID-NUMBER-WS. DTSBX465 00486 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX465 00487 DTSBX465 00488 MOVE WGD-ACCOUNT-NUMBER TO MSKL-EMP-NO. DTSBX465 00489 SET MSKL-PRF-88 TO TRUE. CL*14 00490 * SET L910-READ-88 TO TRUE. CL*14 00491 DTSBX465 00492 * PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. CL*14 00493 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT CL*14 00494 DTSBX465 00495 IF L910-NO-REC-88 DTSBX465 00496 DISPLAY 'ACCT NOT IN DTS: ' WGD-ACCOUNT-NUMBER CL*15 00497 GO TO 110-FLU-EXIT. DTSBX465 00498 DTSBX465 00499 MOVE MSKL-REC TO MPRF-REC. DTSBX465 00500 DTSBX465 00501 * IF MPRF-STATUS-ACT-88 CL*15 00502 * NEXT SENTENCE CL*15 00503 * ELSE CL*15 00504 * DISPLAY ' ACCT NOT ACTIVE ' MPRF-FEIN CL*15 00505 * SET L910-NO-REC-88 TO TRUE CL*15 00506 * GO TO 110-FLU-EXIT. CL*15 00507 DTSBX465 00508 MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS. DTSBX465 00509 DTSBX465 00510 110-FLU-EXIT. DTSBX465 00511 EXIT. DTSBX465 00512 DTSBX465 00513 114-S910-OPEN-READ. DTSBX465 00514 SET L910-OPEN-READ-88 TO TRUE. DTSBX465 00515 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX465 00516 114-S910-OPEN-READ-EXIT. DTSBX465 00517 EXIT. DTSBX465 00518 DTSBX465 00519 115-S910-READ. DTSBX465 00520 SET L910-READ-88 TO TRUE. DTSBX465 00521 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX465 00522 115-S910-READ-EXIT. DTSBX465 00523 EXIT. DTSBX465 00524 DTSBX465 00525 116-S910-CLOSE. DTSBX465 00526 SET L910-CLOSE-88 TO TRUE. DTSBX465 00527 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX465 00528 116-S910-CLOSE-EXIT. DTSBX465 00529 EXIT. DTSBX465 00530 DTSBX465 00531 120-READ-MPRF. DTSBX465 00532 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX465 00533 MSKL-REC. DTSBX465 00534 120-READ-MPRF-EXIT. DTSBX465 00535 EXIT. DTSBX465 00536 CL**2 00537 130-READ-NAME. CL**2 00538 ******************************************************************DTSBX465 00539 * SEARCH FOR NAME ON WAGE NAME FILE * CL**2 00540 ******************************************************************DTSBX465 00541 CL**2 00542 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL**2 00543 CL**2 00544 IF NOT L982-OK-88 CL**2 00545 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN CL**2 00546 GO TO 130-READ-NAME-EXIT CL**4 00547 END-IF. CL**2 00548 CL**2 00549 MOVE WNAM-SSN TO W-SSN. CL**2 00550 CL**2 00551 IF WRK-SSN = W-SSN CL**2 00552 MOVE WNAM-LAST-NAME TO WRK-LNAME CL**3 00553 MOVE WNAM-FIRST-NAME TO WRK-FNAME CL**3 00554 MOVE WNAM-MID-INIT TO WRK-INAME CL**3 00555 ELSE CL**2 00556 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN. CL**2 00557 130-READ-NAME-EXIT. CL**2 00558 EXIT. CL**2 00559 ****************************************************************** CL**2 00560 * TERMINATION ROUTINE * CL**2 00561 ****************************************************************** CL**2 00562 TERM0100-CLOSE-FILES. DTSBX465 00563 CLOSE WAGE-FILE, WAGE-FILE-G, WAGE-FILE-F. DTSBX465 00564 DTSBX465 00565 MOVE 'C' TO DBW-COMMAND-CODE. DTSBX465 00566 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX465 00567 DTSBX465 00568 PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT. DTSBX465 00569 DTSBX465 00570 DISPLAY 'NUMBER RECORDS READ *** ' RECS-IN. DTSBX465 00571 DISPLAY ' ' . DTSBX465 00572 DISPLAY 'DC WAGES ' DC-WAGES. DTSBX465 00573 DISPLAY 'BUSINESS WAGES ' BUSINESS-WAGES. DTSBX465 00574 DISPLAY 'FEDRAL WAGES ' FED-WAGES. DTSBX465 00575 DISPLAY ' ' . DTSBX465 00576 DISPLAY 'NUMBER RECORDS PRINTED *** ' RECS-OUT. DTSBX465 00577 STOP RUN. DTSBX465 00578 TERM0100-EXIT. DTSBX465 00579 EXIT. DTSBX465 00580 EJECT DTSBX465 00581 ******************************************************************DTSBX465 00582 * SERVICE ROUTINES *DTSBX465 00583 ******************************************************************DTSBX465 00584 SERV1001-READ-MASTER. DTSBX465 00585 MOVE 'R' TO DBW-COMMAND-CODE. DTSBX465 00586 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX465 00587 SERV1001-EXIT. DTSBX465 00588 EXIT. DTSBX465 00589 SERV2001-RESET-MASTER. DTSBX465 00590 MOVE 'S' TO DBW-COMMAND-CODE. DTSBX465 00591 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX465 00592 SERV2001-EXIT. DTSBX465 00593 EXIT. DTSBX465 00594 SERV9001-ACCESS-DATABASE. DTSBX465 00595 IF DBW-SEGNAME = 'SG01' DTSBX465 00596 CALL 'EWG960D' DTSBX465 00597 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 00598 IF DBW-SEGNAME = 'SG02' DTSBX465 00599 CALL 'EWG960D' DTSBX465 00600 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 00601 SERV9001-EXIT. DTSBX465 00602 EXIT. DTSBX465 00603 DTSBX465 00604 S001-FROM-CAL-6. DTSBX465 00605 SET L001-FROM-CAL-6 TO TRUE. DTSBX465 00606 GO TO S001-DATE. DTSBX465 00607 DTSBX465 00608 S001-FROM-FED-8. DTSBX465 00609 SET L001-FROM-FED-8 TO TRUE. DTSBX465 00610 GO TO S001-DATE. DTSBX465 00611 DTSBX465 00612 S001-FROM-ABS. DTSBX465 00613 SET L001-FROM-ABS-DAY TO TRUE. DTSBX465 00614 GO TO S001-DATE. DTSBX465 00615 DTSBX465 00616 S001-DATE. DTSBX465 00617 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX465 00618 S001-EXIT. DTSBX465 00619 EXIT. DTSBX465 00620 DTSBX465 00621 S004-FROM-DATE. DTSBX465 00622 SET L004-FROM-DATE TO TRUE. DTSBX465 00623 GO TO S004-YRQ. DTSBX465 00624 DTSBX465 00625 S004-YRQ. DTSBX465 00626 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX465 00627 S004-EXIT. DTSBX465 00628 EXIT. DTSBX465 00629 S982O-OPEN-READ. CL**5 00630 SET L982-OPEN-READ-88 TO TRUE. CL**5 00631 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00632 CL**3 00633 S982O-EXIT. CL**3 00634 EXIT. CL**3 00635 CL**3 00636 S982A-START-BROWSE. CL**3 00637 SET L982-START-BROWSE-88 TO TRUE. CL**3 00638 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00639 CL**3 00640 S982A-EXIT. CL**3 00641 EXIT. CL**3 00642 S982B-READ-NEXT. CL**3 00643 SET L982-READ-NEXT-88 TO TRUE. CL**3 00644 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00645 CL**3 00646 S982B-EXIT. CL**3 00647 EXIT. CL**3 00648 S982C-WRITE. CL**3 00649 SET L982-WRITE-88 TO TRUE. CL**3 00650 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00651 CL**3 00652 S982C-EXIT. CL**3 00653 EXIT. CL**3 00654 CL**3 00655 S982D-REWRITE. CL**3 00656 SET L982-REWRITE-88 TO TRUE. CL**3 00657 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00658 S982D-EXIT. CL**3 00659 EXIT. CL**3 00660 S982F-CLOSE. CL**3 00661 SET L982-CLOSE-88 TO TRUE. CL**3 00662 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00663 CL**3 00664 S982F-EXIT. CL**3 00665 EXIT. CL**3 00666 CL**3 00667 S982Z-WNAM-IO. CL**3 00668 CALL 'DTSBU982' USING L982-LINK-AREA CL**3 00669 WNAM-REC. CL**3 00670 S982Z-EXIT. CL**3 00671 EXIT. CL**3 00672 CL**3 00673 DTSBX465 00674 S999-ABEND. DTSBX465 00675 DISPLAY '**** DTSBX465 ABENDING ' DTSBX465 00676 ABEND-MSG. DTSBX465 00677 CALL ABEND-MOD USING ABEND-CODE. DTSBX465 00678 DTSBX465 00679 S999-EXIT. DTSBX465 00680 EXIT. DTSBX465 00681 DTSBX465