00001 IDENTIFICATION DIVISION. 06/02/25 00002 PROGRAM-ID. DTSBX468. DTSBX468 00003 LV054 00004 ******************************************************************DTSBX468 00005 * *DTSBX468 00006 * FUNCTION: CREATE QUARTERLY WAGE FILE FOR NDNH. * CL*17 00007 * *DTSBX468 00008 * FUNCTION: *DTSBX468 00009 * *DTSBX468 00010 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE *DTSBX468 00011 * FILE FOR THE OFFICE OF TAX AND REVENUE. UI WAGE DATA *DTSBX468 00012 * WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON *DTSBX468 00013 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX468 00014 * *DTSBX468 00015 * CONTACT: WALTER GOETZ 202-442-6312 TAX AND REVENUE(OTR) *DTSBX468 00016 * *DTSBX468 00017 * G.A.BROWN *DTSBX468 00018 ******************************************************************DTSBX468 00019 * DTSBX468 00020 * MODIFICATION HISTORY: DTSBX468 00021 * DTSBX468 00022 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK DTSBX468 00023 * ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT DTSBX468 00024 * FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE DTSBX468 00025 * AND THE COMPLETE QUARTER END DATE FIELDS. IF THE DTSBX468 00026 * INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED, DTSBX468 00027 * THE PROGRAM EDITING RESULTS WILL ABEND. DTSBX468 00028 * REFERENCE RFP: STEVE PROGRAMMER: RLWDTSBX468 00029 * DTSBX468 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 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX468 00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX468 00035 * REFERENCE RFP #**** PROGRAMMER: XXXDTSBX468 00036 ***** DTSBX468 00037 DTSBX468 00038 ENVIRONMENT DIVISION. DTSBX468 00039 CONFIGURATION SECTION. DTSBX468 00040 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX468 00041 INPUT-OUTPUT SECTION. DTSBX468 00042 FILE-CONTROL. DTSBX468 00043 SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES. DTSBX468 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. DTSBX468 00047 FILE SECTION. DTSBX468 00048 DTSBX468 00049 FD WAGE-FILE DTSBX468 00050 RECORDING MODE IS F. CL*21 00051 01 WAGE-REC PIC X(601). CL*19 00052 DTSBX468 00053 DTSBX468 00054 ******************************************************************DTSBX468 00055 * WORKING STORAGE SECTION *DTSBX468 00056 ******************************************************************DTSBX468 00057 WORKING-STORAGE SECTION. DTSBX468 000575 77 PAN-VALET PICTURE X(24) VALUE '054DTSBX468 06/02/25'. DTSBX468 00058 DTSBX468 00059 01 SELECT-CARD. DTSBX468 00060 03 PRG-NAME PIC X(10) VALUE '**DTSBX465'. DTSBX468 00061 03 FIL PIC XX. DTSBX468 00062 03 FROM-ACTIVITY-DATE PIC 9(8). DTSBX468 00063 03 FIL PIC X. DTSBX468 00064 03 TO-ACTIVITY-DATE PIC 9(8). DTSBX468 00065 03 FIL PIC X VALUE SPACE. DTSBX468 00066 03 DCGOVT PIC X(3). DTSBX468 00067 03 FIL PIC X. DTSBX468 00068 03 FEDGOVT PIC X(3). DTSBX468 00069 03 FIL PIC X. DTSBX468 00070 03 BUSINESS PIC X(3). DTSBX468 00071 03 FIL PIC X(39). DTSBX468 00072 DTSBX468 00073 01 COUNTERS. DTSBX468 00074 03 FEDERAL-ID-NUMBER-WS PIC 9(9). DTSBX468 00075 03 STOP-RECS PIC 9(5). CL*46 00076 03 UNMATCH-SW PIC X. CL*46 00077 03 ALL-NINES PIC 9. CL*46 00078 03 RECS-IN PIC 9(9). DTSBX468 00079 03 RECS-OUT PIC 9(9). DTSBX468 00080 03 QTR-WAGES PIC 9(9). DTSBX468 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). DTSBX468 00086 CL*46 00087 03 WRK-YEAR-QUARTER PIC 9(5). CL*47 00088 03 WRK-YEARZ REDEFINES WRK-YEAR-QUARTER. CL*46 00089 05 WRK-YEAR-YR PIC 9(4). CL*18 00090 05 WRK-YEAR-Q PIC 9(1). CL*18 00091 CL*46 00092 03 FED-WAGES PIC 9(9). DTSBX468 00093 03 BUSINESS-WAGES PIC 9(9). DTSBX468 00094 03 DC-ACCT PIC 9(6). DTSBX468 00095 03 EMP-ACCT-HOLD PIC 9(6). DTSBX468 00096 03 EMP-ACCT-HOLD-RED PIC 9(6). DTSBX468 00097 03 EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED. DTSBX468 00098 05 ACCT-FOUR PIC 9(4). DTSBX468 00099 05 ACCT-THREE-WS REDEFINES ACCT-FOUR. DTSBX468 00100 07 ACCT-THREE-RED PIC 9(3). DTSBX468 00101 07 ACCT-FIL PIC 9. DTSBX468 00102 05 ACCT-TWO PIC 99. DTSBX468 00103 DTSBX468 00104 03 W-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 00105 03 WRK-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 00106 03 ABEND-CODE PIC S9(04) COMP CL**2 00107 VALUE +465. DTSBX468 00108 03 ABEND-MOD PIC X(08) DTSBX468 00109 VALUE 'DTSBU999'. DTSBX468 00110 03 ABEND-MSG PIC X(60). DTSBX468 00111 DTSBX468 00112 03 WRK-BEGIN-DATE PIC S9(09) COMP-3. DTSBX468 00113 03 WRK-END-DATE PIC S9(09) COMP-3. DTSBX468 00114 DTSBX468 00115 03 WRK-BEGIN-DATE-DISP PIC 9(08). DTSBX468 00116 03 FILLER REDEFINES WRK-BEGIN-DATE-DISP. DTSBX468 00117 05 WRK-BEGIN-YR PIC 9(04). DTSBX468 00118 05 WRK-BEGIN-MO PIC 9(02). DTSBX468 00119 05 WRK-BEGIN-DA PIC 9(02). DTSBX468 00120 DTSBX468 00121 03 WRK-END-DATE-DISP PIC 9(08). DTSBX468 00122 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX468 00123 05 WRK-END-YR PIC 9(04). DTSBX468 00124 05 WRK-END-MO PIC 9(02). DTSBX468 00125 05 WRK-END-DA PIC 9(02). DTSBX468 00126 CL**3 00127 03 WRK-NAME. CL**3 00128 05 WRK-LNAME PIC X(20) VALUE SPACES. CL**3 00129 05 WRK-FNAME PIC X(15) VALUE SPACES. CL**3 00130 05 WRK-INAME PIC X(01) VALUE SPACES. CL**3 00131 01 HEADER-RECORD. CL*27 00132 05 HEADER-IDENTIFIER PIC X(02) VALUE 'HQ'. CL*27 00133 05 HEADER-STATE-CODE PIC 9(02) VALUE 11. CL*27 00134 05 HEADER-AGENCY-CODE PIC X(09) VALUE SPACES. CL*27 00135 05 HEADER-TRANSMISSION-TYPE PIC X(02) VALUE 'QW'. CL*27 00136 05 FILLER PIC X(01) VALUE SPACE. CL*27 00137 05 HEADER-VERSION-CONTROL PIC X(02) VALUE '01'. CL*27 00138 05 HEADER-DATE-STAMP PIC 9(08) VALUE 20250531. CL*54 00139 05 FILLER REDEFINES HEADER-DATE-STAMP. CL*27 00140 10 HEADER-DATE-STAMP-CC PIC 9(02). CL*27 00141 10 HEADER-DATE-STAMP-YY PIC 9(02). CL*27 00142 10 HEADER-DATE-STAMP-MM PIC 9(02). CL*27 00143 10 HEADER-DATE-STAMP-DD PIC 9(02). CL*27 00144 05 HEADER-BATCH-NUMBER PIC 9(06) VALUE 000210. CL*27 00145 05 FILLER PIC X(263) VALUE SPACES. CL*27 00146 CL*28 00147 01 TRAILER-RECORD. CL*28 00148 05 TRAILER-IDENTIFIER PIC X(02) VALUE 'TQ'. CL*28 00149 05 TRAILER-RECORD-COUNT PIC 9(11) VALUE 2. CL*28 00150 05 FILLER PIC X(282) VALUE SPACES. CL*28 00151 CL*28 00152 CL*33 00153 01 L981-LINK-AREA. CL*33 00154 ++INCLUDE DTSIL981 CL*33 00155 CL*33 00156 01 WWGH-REC. CL*33 00157 ++INCLUDE DTSIWWGH CL*33 00158 CL*33 00159 CL*27 00160 01 NDNH-LINK-AREA. CL*17 00161 ++INCLUDE DTSQWREC CL*18 00162 CL*17 00163 01 L001-LINK-AREA. DTSBX468 00164 ++INCLUDE DTSIL001 DTSBX468 00165 DTSBX468 00166 01 L004-LINK-AREA. DTSBX468 00167 ++INCLUDE DTSIL004 DTSBX468 00168 DTSBX468 00169 01 L910-LINK-AREA. DTSBX468 00170 ++INCLUDE DTSIL910 DTSBX468 00171 CL**3 00172 01 L982-LINK-AREA. CL**3 00173 ++INCLUDE DTSIL982 CL**3 00174 DTSBX468 00175 01 MSKL-REC. DTSBX468 00176 ++INCLUDE DTSIMSKL DTSBX468 00177 DTSBX468 00178 01 MHDR-REC. DTSBX468 00179 ++INCLUDE DTSIMHDR DTSBX468 00180 DTSBX468 00181 CL*19 00182 01 MTAD-REC. CL*19 00183 ++INCLUDE DTSIMTAD CL*19 00184 CL*19 00185 01 MPRF-REC. DTSBX468 00186 ++INCLUDE DTSIMPRF DTSBX468 00187 CL**3 00188 01 WNAM-REC. CL**3 00189 ++INCLUDE DTSIWNAM CL**3 00190 CL**3 00191 *01 COMMON-LINKAGE-SECTION. CL*33 00192 *++INCLUDE EWGLINKB CL*33 00193 EJECT DTSBX468 00194 EJECT DTSBX468 00195 ******************************************************************DTSBX468 00196 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX468 00197 ******************************************************************DTSBX468 00198 PROCEDURE DIVISION. DTSBX468 00199 BEGIN00000. DTSBX468 00200 OPEN OUTPUT WAGE-FILE. CL*18 00201 WRITE WAGE-REC FROM HEADER-RECORD. CL*27 00202 DTSBX468 00203 PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT. DTSBX468 00204 PERFORM S981A1-OPEN-READ THRU S981A1-EXIT. CL*36 00205 IF NOT L981-OK-88 CL*40 00206 DISPLAY ' OPEN WWGH VSAM FAILED ' WWGH-KEY-AREA CL*44 00207 PERFORM S999-ABEND THRU S999-EXIT. CL*40 00208 CL*40 00209 PERFORM S982O-OPEN-READ THRU S982O-EXIT. CL*33 00210 IF NOT L982-OK-88 CL*44 00211 DISPLAY ' OPEN NAME VSAM FAILED ' CL*44 00212 PERFORM S999-ABEND THRU S999-EXIT. CL*44 00213 CL*44 00214 DTSBX468 00215 MOVE ZEROS TO COUNTERS. DTSBX468 00216 MOVE ZERO TO WRK-BEGIN-DATE DTSBX468 00217 WRK-END-DATE. DTSBX468 00218 DTSBX468 00219 MAIN0100-INITIATE. DTSBX468 00220 ACCEPT SELECT-CARD. DTSBX468 00221 DISPLAY ' '. DTSBX468 00222 DISPLAY ' ' SELECT-CARD. DTSBX468 00223 DISPLAY ' '. DTSBX468 00224 DISPLAY ' PROGRAM ' PRG-NAME. DTSBX468 00225 DISPLAY ' FROM-DATE ' FROM-ACTIVITY-DATE. DTSBX468 00226 DISPLAY ' TO-DATE ' TO-ACTIVITY-DATE. DTSBX468 00227 DISPLAY ' DC GOVT ' DCGOVT DTSBX468 00228 DISPLAY ' FED GOVT ' FEDGOVT DTSBX468 00229 DISPLAY ' BUSINESS ' BUSINESS DTSBX468 00230 DISPLAY ' '. DTSBX468 00231 DISPLAY ' '. DTSBX468 00232 DTSBX468 00233 IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX468 00234 AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX468 00235 PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT DTSBX468 00236 ELSE DTSBX468 00237 PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT DTSBX468 00238 PERFORM INIT0200-END-DATE THRU INIT0200-EXIT. DTSBX468 00239 DTSBX468 00240 IF WRK-END-DATE < WRK-BEGIN-DATE DTSBX468 00241 MOVE 'PERIOD END LESS THAN PERIOD BEGIN' DTSBX468 00242 TO ABEND-MSG DTSBX468 00243 PERFORM S999-ABEND THRU S999-EXIT. DTSBX468 00244 DTSBX468 00245 MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP. DTSBX468 00246 MOVE WRK-END-DATE TO WRK-END-DATE-DISP. DTSBX468 00247 DISPLAY ' '. DTSBX468 00248 DISPLAY ' DEFAULT FROM DATE - ' WRK-BEGIN-DATE-DISP. CL*34 00249 DISPLAY ' DEFAULT TO-DATE - ' WRK-END-DATE-DISP. CL*34 00250 DISPLAY ' '. DTSBX468 00251 DTSBX468 00252 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*34 00253 PERFORM P9999-TERMINATE THRU P9999-EXIT. CL*34 00254 STOP RUN. CL*35 00255 DTSBX468 00256 INIT0100-BEGIN-DATE. DTSBX468 00257 MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX468 00258 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX468 00259 IF L001-VALID-DATE DTSBX468 00260 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE DTSBX468 00261 ELSE DTSBX468 00262 MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG DTSBX468 00263 PERFORM S999-ABEND THRU S999-EXIT CL*35 00264 END-IF. CL*31 00265 DTSBX468 00266 * MOVE WRK-BEGIN-DATE TO L004-DATE. CL*31 00267 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*31 00268 * IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE CL*31 00269 * MOVE 'PERIOD BEGIN NOT START OF QTR' CL*31 00270 * TO ABEND-MSG CL*31 00271 * PERFORM S999-ABEND THRU S999-EXIT CL*31 00272 DTSBX468 00273 INIT0100-EXIT. DTSBX468 00274 EXIT. DTSBX468 00275 DTSBX468 00276 INIT0200-END-DATE. DTSBX468 00277 MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX468 00278 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX468 00279 IF L001-VALID-DATE DTSBX468 00280 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE DTSBX468 00281 ELSE DTSBX468 00282 MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG DTSBX468 00283 PERFORM S999-ABEND THRU S999-EXIT. DTSBX468 00284 DTSBX468 00285 * MOVE WRK-END-DATE TO L004-DATE. CL*31 00286 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*31 00287 * IF WRK-END-DATE NOT = L004-QTR-END-DATE CL*31 00288 * DISPLAY ' END DT ' L004-QTR-END-DATE CL*31 00289 * MOVE 'PERIOD END NOT END OF QTR' CL*31 00290 * TO ABEND-MSG CL*31 00291 * PERFORM S999-ABEND THRU S999-EXIT CL*31 00292 * END-IF. CL*31 00293 DTSBX468 00294 INIT0200-EXIT. DTSBX468 00295 EXIT. DTSBX468 00296 DTSBX468 00297 INIT0300-DEFAULT-DATES. DTSBX468 00298 DTSBX468 00299 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX468 00300 MOVE +0 TO MSKL-EMP-NO. DTSBX468 00301 SET MSKL-HDR-88 TO TRUE. DTSBX468 00302 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. DTSBX468 00303 DTSBX468 00304 IF L910-NO-REC-88 DTSBX468 00305 MOVE 'MHDR RECORD IS MISSING' DTSBX468 00306 TO ABEND-MSG DTSBX468 00307 PERFORM S999-ABEND THRU S999-EXIT. DTSBX468 00308 DTSBX468 00309 MOVE MSKL-REC TO MHDR-REC. DTSBX468 00310 DTSBX468 00311 MOVE MHDR-CMPL-QTR-BEGIN-DATE DTSBX468 00312 TO WRK-BEGIN-DATE. DTSBX468 00313 MOVE MHDR-CMPL-QTR-END-DATE DTSBX468 00314 TO WRK-END-DATE. DTSBX468 00315 DTSBX468 00316 MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE. DTSBX468 00317 MOVE WRK-END-DATE TO TO-ACTIVITY-DATE. DTSBX468 00318 DTSBX468 00319 INIT0300-EXIT. DTSBX468 00320 EXIT. DTSBX468 00321 DTSBX468 00322 P0000-PROCESS. CL*33 00323 * DISPLAY 'P0000 PROCESSED '. CL*49 00324 * DISPLAY ' WWGH KEY AREA' WWGH-KEY-AREA. CL*49 00325 MOVE LOW-VALUES TO WWGH-KEY-AREA. CL*41 00326 CL*33 00327 MOVE 010021 TO WWGH-EMP-NO. CL*33 00328 MOVE 20191 TO WWGH-YRQ. CL*33 00329 MOVE 000000000 TO WWGH-SSN. CL*42 00330 CL*33 00331 * DISPLAY ' BEFORE BROWSE ********* ' WWGH-KEY-AREA CL*49 00332 PERFORM S981X-START-BROWSE THRU S981X-EXIT. CL*43 00333 * DISPLAY ' AFTER BROWSE ********* ' WWGH-KEY-AREA CL*49 00334 IF NOT L981-OK-88 CL*43 00335 DISPLAY ' BROWSE FAILED ********* ' WWGH-KEY-AREA CL*43 00336 PERFORM S999-ABEND THRU S999-EXIT. CL*43 00337 CL*33 00338 * PERFORM S981C-READ THRU S981C-EXIT. CL*43 00339 * IF NOT L981-OK-88 CL*43 00340 * DISPLAY ' READ FAILED ********* ' WWGH-KEY-AREA CL*43 00341 * PERFORM S999-ABEND THRU S999-EXIT. CL*43 00342 CL*33 00343 PERFORM P1000-FIND-QTR-WAGE THRU P1000-EXIT CL*33 00344 UNTIL L981-NO-REC-88. CL*34 00345 P0000-EXIT. CL*33 00346 EXIT. DTSBX468 00347 DTSBX468 00348 P1000-FIND-QTR-WAGE. CL*33 00349 ********************************************************** DTSBX468 00350 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX468 00351 ******* ************************************************** DTSBX468 00352 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX468 00353 ADD 1 TO RECS-IN. CL*33 00354 IF WWGH-CHNG-DATE NOT LESS THAN FROM-ACTIVITY-DATE CL*33 00355 AND DTSBX468 00356 WWGH-CHNG-DATE NOT GREATER THAN TO-ACTIVITY-DATE CL*33 00357 NEXT SENTENCE CL*33 00358 ELSE CL*33 00359 GO TO P1000-CONTINUE. CL*33 00360 DTSBX468 00361 * IF WWGH-CHNG-DATE > 20240227 CL*49 00362 * DISPLAY 'FEB WAGES WWGH : ' WWGH-EMP-NO. CL*49 00363 CL*45 00364 MOVE WWGH-EMP-NO TO EMP-ACCT-HOLD. CL*33 00365 MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED. DTSBX468 00366 DTSBX468 00367 DTSBX468 00368 PERFORM P4000-FEIN-LOOK-UP THRU P4000-EXIT. CL*33 00369 DTSBX468 00370 IF L910-NO-REC-88 DTSBX468 00371 DISPLAY 'ACCT NOT IN DTS: ' WWGH-EMP-NO CL*33 00372 GO TO P1000-CONTINUE. CL*33 00373 DTSBX468 00374 PERFORM P2000-WRITE-QTR-WAGES THRU P2000-EXIT. CL*33 00375 * IF DCGOVT = 'DCG' CL*22 00376 * IF EMP-ACCT-HOLD = 998888 CL*22 00377 * PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT CL*18 00378 * PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*22 00379 * GO TO S-2-D-EX. CL*22 00380 DTSBX468 00381 * IF FEDGOVT = 'FED' CL*22 00382 * IF ACCT-THREE-RED = 000 CL*22 00383 * PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT CL*18 00384 * PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*22 00385 * GO TO S-2-D-EX. CL*22 00386 DTSBX468 00387 DTSBX468 00388 P1000-CONTINUE. CL*33 00389 DTSBX468 00390 PERFORM S981C2-READ-NEXT THRU S981C2-EXIT. CL*33 00391 P1000-EXIT. CL*33 00392 EXIT. CL*33 00393 CL*33 00394 P2000-WRITE-QTR-WAGES. CL*33 00395 DTSBX468 00396 ADD 1 TO BUSINESS-WAGES. DTSBX468 00397 MOVE WWGH-SSN TO EMPLOYEE-SSN. CL*33 00398 MOVE WWGH-YRQ TO WRK-YEAR-QUARTER. CL*33 00399 * DISPLAY 'YRQ ' WRK-YEAR-QUARTER. CL*48 00400 MOVE WRK-YEAR-YR TO REPORTING-PERIOD-CCYY. CL*18 00401 MOVE WRK-YEAR-Q TO REPORTING-PERIOD-Q. CL*18 00402 MOVE WWGH-EMP-NO TO EMPLOYER-STATE-TAX-ID. CL*50 00403 MOVE WWGH-EARNINGS TO EMPLOYEE-DOLLARS. CL*33 00404 MOVE ZEROS TO EMPLOYEE-CENTS. CL*18 00405 * MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. CL*18 00406 MOVE FEDERAL-ID-NUMBER-WS TO EMPLOYER-FEIN. CL*18 00407 CL*41 00408 MOVE SPACES TO WRK-NAME. CL*18 00409 MOVE LOW-VALUE TO WNAM-REC. CL*18 00410 MOVE WWGH-SSN TO WNAM-SSN WRK-SSN. CL*33 00411 CL*18 00412 PERFORM P3000-READ-NAME THRU P3000-EXIT. CL*33 00413 CL*33 00414 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME CL*18 00415 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME CL*18 00416 MOVE WRK-INAME TO EMPLOYEE-MIDDLE-NAME CL*21 00417 CL*33 00418 PERFORM P2500-READ-MTAD THRU P2500-EXIT. CL*33 00419 CL*33 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*33 00423 DTSBX468 00424 * IF BUSINESS-WAGES > 10 CL*48 00425 * GO TO P9999-TERMINATE. CL*48 00426 P2000-EXIT. CL*33 00427 EXIT. DTSBX468 00428 CL*33 00429 CL*33 00430 P4000-FEIN-LOOK-UP. CL*33 00431 DTSBX468 00432 MOVE ZEROS TO FEDERAL-ID-NUMBER-WS. DTSBX468 00433 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX468 00434 DTSBX468 00435 MOVE WWGH-EMP-NO TO MSKL-EMP-NO. CL*33 00436 SET MSKL-PRF-88 TO TRUE. CL*14 00437 * SET L910-READ-88 TO TRUE. CL*14 00438 DTSBX468 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 DTSBX468 00442 IF L910-NO-REC-88 DTSBX468 00443 DISPLAY 'ACCT NOT IN DTS: ' WWGH-EMP-NO CL*33 00444 GO TO P4000-EXIT. CL*33 00445 DTSBX468 00446 MOVE MSKL-REC TO MPRF-REC. DTSBX468 00447 DTSBX468 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 DTSBX468 00455 MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS. DTSBX468 00456 MOVE MPRF-PRIMARY-NAME TO EMPLOYER-NAME. CL*18 00457 * IF MPRF-EMP-NO = 998888 CL*45 00458 * DISPLAY ' DCGOV ID ' FEDERAL-ID-NUMBER-WS CL*45 00459 * ' ' EMPLOYER-NAME. CL*45 00460 P4000-EXIT. CL*33 00461 EXIT. DTSBX468 00462 CL*18 00463 P2500-READ-MTAD. CL*33 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 P2500-EXIT. CL*33 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 MOVE SPACES TO OPTIONAL-STREET-ADDRESS1 CL*44 00493 OPTIONAL-STREET-ADDRESS2 CL*44 00494 OPTIONAL-STREET-ADDRESS3 CL*44 00495 OPTIONAL-CITY CL*44 00496 OPTIONAL-STATE CL*44 00497 WRK-ZIP CL*44 00498 OPTIONAL-ZIP-CODE CL*44 00499 OPTIONAL-ZIP4 CL*44 00500 GO TO P2500-EXIT. CL*33 00501 DTSBX468 00502 CL*18 00503 MOVE MSKL-REC TO MTAD-REC. CL*18 00504 MOVE MTAD-ATTN-LINE TO OPTIONAL-STREET-ADDRESS1 CL*18 00505 MOVE MTAD-DELIV-LINE-1 TO OPTIONAL-STREET-ADDRESS2 CL*18 00506 MOVE MTAD-DELIV-LINE-2 TO OPTIONAL-STREET-ADDRESS3 CL*18 00507 MOVE MTAD-CITY TO OPTIONAL-CITY CL*18 00508 MOVE MTAD-ST TO OPTIONAL-STATE CL*18 00509 MOVE MTAD-ZIP TO WRK-ZIP CL*18 00510 MOVE WRK-ZIPA TO OPTIONAL-ZIP-CODE CL*18 00511 MOVE WRK-ZIPB TO OPTIONAL-ZIP4. CL*18 00512 * CL*18 00513 P2500-EXIT. CL*33 00514 EXIT. CL*18 00515 CL*18 00516 114-S910-OPEN-READ. DTSBX468 00517 SET L910-OPEN-READ-88 TO TRUE. DTSBX468 00518 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX468 00519 114-S910-OPEN-READ-EXIT. DTSBX468 00520 EXIT. DTSBX468 00521 DTSBX468 00522 115-S910-READ. DTSBX468 00523 SET L910-READ-88 TO TRUE. DTSBX468 00524 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX468 00525 115-S910-READ-EXIT. DTSBX468 00526 EXIT. DTSBX468 00527 DTSBX468 00528 116-S910-CLOSE. DTSBX468 00529 SET L910-CLOSE-88 TO TRUE. DTSBX468 00530 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX468 00531 116-S910-CLOSE-EXIT. DTSBX468 00532 EXIT. DTSBX468 00533 DTSBX468 00534 120-READ-MPRF. DTSBX468 00535 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX468 00536 MSKL-REC. DTSBX468 00537 120-READ-MPRF-EXIT. DTSBX468 00538 EXIT. DTSBX468 00539 CL**2 00540 P3000-READ-NAME. CL*33 00541 ******************************************************************DTSBX468 00542 * SEARCH FOR NAME ON WAGE NAME FILE * CL**2 00543 ******************************************************************DTSBX468 00544 CL**2 00545 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL**2 00546 CL**2 00547 IF NOT L982-OK-88 CL**2 00548 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN CL**2 00549 GO TO P3000-EXIT CL*33 00550 END-IF. CL**2 00551 CL**2 00552 MOVE WNAM-SSN TO W-SSN. CL**2 00553 CL**2 00554 IF WRK-SSN = W-SSN CL**2 00555 MOVE WNAM-LAST-NAME TO WRK-LNAME CL**3 00556 MOVE WNAM-FIRST-NAME TO WRK-FNAME CL**3 00557 MOVE WNAM-MID-INIT TO WRK-INAME CL**3 00558 ELSE CL**2 00559 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN. CL**2 00560 P3000-EXIT. CL*33 00561 EXIT. CL**2 00562 ****************************************************************** CL**2 00563 * TERMINATION ROUTINE * CL**2 00564 ****************************************************************** CL**2 00565 P9999-TERMINATE. CL*33 00566 CL*28 00567 MOVE BUSINESS-WAGES TO TRAILER-RECORD-COUNT. CL*28 00568 WRITE WAGE-REC FROM TRAILER-RECORD. CL*28 00569 CLOSE WAGE-FILE. CL*18 00570 DTSBX468 00571 DTSBX468 00572 PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT. DTSBX468 00573 DTSBX468 00574 PERFORM S981D-CLOSE THRU S981D-EXIT. CL*33 00575 PERFORM S982F-CLOSE THRU S982F-EXIT. CL*33 00576 CL*33 00577 DISPLAY 'TOTAL WWGH RECORDS READ *** = ' RECS-IN. CL*33 00578 DISPLAY ' ' . DTSBX468 00579 DISPLAY 'TOTAL QTR WAGE RECORDS WRITTEN = ' BUSINESS-WAGES. CL*33 00580 DISPLAY ' ' . DTSBX468 00581 P9999-EXIT. CL*33 00582 EXIT. DTSBX468 00583 EJECT DTSBX468 00584 ******************************************************************DTSBX468 00585 * SERVICE ROUTINES *DTSBX468 00586 ******************************************************************DTSBX468 00587 DTSBX468 00588 S001-FROM-CAL-6. DTSBX468 00589 SET L001-FROM-CAL-6 TO TRUE. DTSBX468 00590 GO TO S001-DATE. DTSBX468 00591 DTSBX468 00592 S001-FROM-FED-8. DTSBX468 00593 SET L001-FROM-FED-8 TO TRUE. DTSBX468 00594 GO TO S001-DATE. DTSBX468 00595 DTSBX468 00596 S001-FROM-ABS. DTSBX468 00597 SET L001-FROM-ABS-DAY TO TRUE. DTSBX468 00598 GO TO S001-DATE. DTSBX468 00599 DTSBX468 00600 S001-DATE. DTSBX468 00601 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX468 00602 S001-EXIT. DTSBX468 00603 EXIT. DTSBX468 00604 DTSBX468 00605 S004-FROM-DATE. DTSBX468 00606 SET L004-FROM-DATE TO TRUE. DTSBX468 00607 GO TO S004-YRQ. DTSBX468 00608 DTSBX468 00609 S004-YRQ. DTSBX468 00610 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX468 00611 S004-EXIT. DTSBX468 00612 EXIT. DTSBX468 00613 S981A-OPEN-UPDATE. CL*32 00614 SET L981-OPEN-UPDATE-88 TO TRUE. CL*32 00615 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 00616 CL*32 00617 S981A-EXIT. CL*32 00618 EXIT. CL*32 00619 CL*32 00620 S981A1-OPEN-READ. CL*36 00621 SET L981-OPEN-READ-88 TO TRUE. CL*33 00622 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*33 00623 CL*33 00624 S981A1-EXIT. CL*33 00625 EXIT. CL*33 00626 CL*33 00627 S981B-WRITE. CL*32 00628 SET L981-WRITE-88 TO TRUE. CL*32 00629 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 00630 CL*32 00631 S981B-EXIT. CL*32 00632 EXIT. CL*32 00633 S981C-READ. CL*32 00634 SET L981-READ-88 TO TRUE. CL*32 00635 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 00636 CL*32 00637 S981C-EXIT. CL*32 00638 EXIT. CL*32 00639 S981X-START-BROWSE. CL*43 00640 DISPLAY ' STARTING BROWSE' CL*43 00641 SET L981-START-BROWSE-88 TO TRUE. CL*33 00642 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*33 00643 DISPLAY ' BROWSE COMPLETE'. CL*43 00644 CL*33 00645 S981X-EXIT. CL*43 00646 EXIT. CL*33 00647 S981C2-READ-NEXT. CL*33 00648 SET L981-READ-NEXT-88 TO TRUE. CL*33 00649 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*33 00650 CL*33 00651 S981C2-EXIT. CL*33 00652 EXIT. CL*33 00653 S981E-DELETE. CL*32 00654 SET L981-DELETE-88 TO TRUE. CL*32 00655 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 00656 CL*32 00657 S981E-EXIT. CL*32 00658 EXIT. CL*32 00659 CL*32 00660 S981D-CLOSE. CL*32 00661 SET L981-CLOSE-88 TO TRUE. CL*32 00662 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 00663 CL*32 00664 S981D-EXIT. CL*32 00665 EXIT. CL*32 00666 S981Z-WWGH-IO. CL*32 00667 CALL 'DTSBU981' USING L981-LINK-AREA CL*32 00668 WWGH-REC. CL*32 00669 S981Z-EXIT. CL*32 00670 EXIT. CL*32 00671 CL*32 00672 CL*32 00673 S982O-OPEN-READ. CL**5 00674 SET L982-OPEN-READ-88 TO TRUE. CL**5 00675 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00676 CL**3 00677 S982O-EXIT. CL**3 00678 EXIT. CL**3 00679 CL**3 00680 S982A-START-BROWSE. CL**3 00681 SET L982-START-BROWSE-88 TO TRUE. CL**3 00682 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00683 CL**3 00684 S982A-EXIT. CL**3 00685 EXIT. CL**3 00686 S982B-READ-NEXT. CL**3 00687 SET L982-READ-NEXT-88 TO TRUE. CL**3 00688 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00689 CL**3 00690 S982B-EXIT. CL**3 00691 EXIT. CL**3 00692 S982C-WRITE. CL**3 00693 SET L982-WRITE-88 TO TRUE. CL**3 00694 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00695 CL**3 00696 S982C-EXIT. CL**3 00697 EXIT. CL**3 00698 CL**3 00699 S982D-REWRITE. CL**3 00700 SET L982-REWRITE-88 TO TRUE. CL**3 00701 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00702 S982D-EXIT. CL**3 00703 EXIT. CL**3 00704 S982F-CLOSE. CL**3 00705 SET L982-CLOSE-88 TO TRUE. CL**3 00706 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 00707 CL**3 00708 S982F-EXIT. CL**3 00709 EXIT. CL**3 00710 CL**3 00711 S982Z-WNAM-IO. CL**3 00712 CALL 'DTSBU982' USING L982-LINK-AREA CL**3 00713 WNAM-REC. CL**3 00714 S982Z-EXIT. CL**3 00715 EXIT. CL**3 00716 CL**3 00717 DTSBX468 00718 S999-ABEND. DTSBX468 00719 DISPLAY '**** DTSBX465 ABENDING ' DTSBX468 00720 ABEND-MSG. DTSBX468 00721 CALL ABEND-MOD USING ABEND-CODE. DTSBX468 00722 DTSBX468 00723 S999-EXIT. DTSBX468 00724 EXIT. DTSBX468 00725 DTSBX468