727 lines
57 KiB
COBOL
727 lines
57 KiB
COBOL
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
|