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