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