MP Batchs, copybooks, jcls, Procs
This commit is contained in:
680
Batch/DTSBX467.cob
Normal file
680
Batch/DTSBX467.cob
Normal file
@ -0,0 +1,680 @@
|
||||
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
|
||||
Reference in New Issue
Block a user