Files
DUTAS/Batch/DTSBX467.cob

681 lines
54 KiB
COBOL

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