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