MP Batchs, copybooks, jcls, Procs
This commit is contained in:
812
Batch/DTSBX441.cob
Normal file
812
Batch/DTSBX441.cob
Normal file
@ -0,0 +1,812 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/01/24
|
||||
00002 PROGRAM-ID. DTSBX441. DTSBX441
|
||||
00003 AUTHOR. SC. LV083
|
||||
00004 DATE-WRITTEN. APRIL 2024. CL*21
|
||||
00005 DATE-COMPILED. DTSBX441
|
||||
00006 SKIP3 DTSBX441
|
||||
00007 ***** DTSBX441
|
||||
00008 * DTSBX441
|
||||
00009 * DTSBX441
|
||||
00010 * FUNCTION: READ X104 FILE,IF X104-INACTIVE-DATE = 0000000000 CL*78
|
||||
00011 * OR X104-INACTIVE-CODE = SPACES, READ MPRF-REC TO CL*78
|
||||
00012 * CHECK THE MPRF-EMP-STATUS. IF THE MPRF-EMP-STATUS CL*78
|
||||
00013 * IS ACTIVE, WRITE THE X104 RECORD AS IS TO X104-NEW CL*82
|
||||
00014 * IF THE STATUS IS INACTIVE,READ THE MSOL-REC, GET CL*78
|
||||
00015 * THE INACTIVE DATE,INACTIVE CODE,LIAB-DATE & WRITE CL*82
|
||||
00016 * TO X104-NEW REC. CL*78
|
||||
00017 * DTSBX441
|
||||
00018 * MODIFICATION LOG: DTSBX441
|
||||
00019 * DTSBX441
|
||||
00020 * 04/08/2024 INITIAL DEVELOPMENT. CL*21
|
||||
00021 * REFERENCE: PROGRAMMER: SC CL*21
|
||||
00022 * DTSBX441
|
||||
00023 DTSBX441
|
||||
00024 ENVIRONMENT DIVISION. DTSBX441
|
||||
00025 INPUT-OUTPUT SECTION. DTSBX441
|
||||
00026 DTSBX441
|
||||
00027 FILE-CONTROL. DTSBX441
|
||||
00028 DTSBX441
|
||||
00029 SELECT X104-DETERM-FILE ASSIGN TO EXPBX104 DTSBX441
|
||||
00030 FILE STATUS IS X104-IN-STATUS. CL*45
|
||||
00031 DTSBX441
|
||||
00032 SELECT X104-NEW-FILE ASSIGN TO EXPNW104 CL*22
|
||||
00033 FILE STATUS IS X104-NEW-STATUS. CL*22
|
||||
00034 CL*22
|
||||
00035 DTSBX441
|
||||
00036 DATA DIVISION. DTSBX441
|
||||
00037 FILE SECTION. DTSBX441
|
||||
00038 DTSBX441
|
||||
00039 FD X104-DETERM-FILE DTSBX441
|
||||
00040 RECORDING MODE IS F. DTSBX441
|
||||
00041 01 X104-REC PIC X(119). CL*70
|
||||
00042 DTSBX441
|
||||
00043 FD X104-NEW-FILE CL*22
|
||||
00044 RECORDING MODE IS F. CL*22
|
||||
00045 01 X104-NEW-REC. CL*36
|
||||
00046 05 X104-NEW-REC-TYPE PIC X(03). CL*45
|
||||
00047 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00048 05 X104-NEW-EMP-NO PIC 9(06). CL*37
|
||||
00049 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00050 05 X104-NEW-STAFF-REVIEW-IND PIC X(01). CL*37
|
||||
00051 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00052 05 X104-NEW-LIAB-CD PIC X(02). CL*37
|
||||
00053 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00054 05 X104-NEW-ELIG-CD PIC X(02). CL*37
|
||||
00055 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00056 05 X104-NEW-NAICS-CD PIC 9(06). CL*37
|
||||
00057 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00058 05 X104-NEW-ORG-TYPE PIC X(03). CL*37
|
||||
00059 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00060 05 X104-NEW-INCORP-STATE PIC X(02). CL*37
|
||||
00061 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00062 05 X104-NEW-INCORP-DATE PIC X(10). CL*37
|
||||
00063 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00064 05 X104-NEW-HOUSEHOLD-FILING PIC X(01). CL*37
|
||||
00065 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00066 05 X104-NEW-FIRST-WAGE-DT PIC X(10). CL*37
|
||||
00067 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00068 05 X104-NEW-FIRST-500-QTR PIC X(06). CL*37
|
||||
00069 05 FILLER PIC X(01) VALUE ','. CL*36
|
||||
00070 05 X104-NEW-ACQUIRE-IND PIC X(01). CL*37
|
||||
00071 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00072 05 X104-NEW-MERGER-SPLIT-IND PIC X(01). CL*37
|
||||
00073 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00074 05 X104-NEW-REORG-IND PIC X(01). CL*37
|
||||
00075 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00076 05 X104-NEW-COMMON-OWN-IND PIC X(01). CL*37
|
||||
00077 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00078 05 X104-NEW-SALE-TRANSFER-IND PIC X(01). CL*37
|
||||
00079 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00080 05 X104-NEW-NOT-LIAB-REASON PIC X(01). CL*37
|
||||
00081 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00082 05 X104-NEW-INACTIVE-DATE PIC X(10). CL*37
|
||||
00083 05 FILLER PIC X(01) VALUE ','. CL*37
|
||||
00084 05 X104-NEW-INACTIVE-CODE PIC X(02). CL*37
|
||||
00085 05 FILLER PIC X(30) VALUE SPACE. CL*56
|
||||
00086 CL*37
|
||||
00087 WORKING-STORAGE SECTION. DTSBX441
|
||||
000875 77 PAN-VALET PICTURE X(24) VALUE '083DTSBX441 08/01/24'. DTSBX441
|
||||
00088 DTSBX441
|
||||
00089 01 WRK-AREA. DTSBX441
|
||||
00090 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +410.DTSBX441
|
||||
00091 05 ABEND-MSG PIC X(60). DTSBX441
|
||||
00092 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX410'.DTSBX441
|
||||
00093 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DTSBX441
|
||||
00094 DTSBX441
|
||||
00095 DTSBX441
|
||||
00096 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX441
|
||||
00097 05 WRK-TRACE-NO PIC 9(13). DTSBX441
|
||||
00098 05 WRK-TRACE-NO-X REDEFINES WRK-TRACE-NO DTSBX441
|
||||
00099 PIC B(12)9. DTSBX441
|
||||
00100 DTSBX441
|
||||
00101 05 WORK-HOLD-DATE1 PIC X(10) VALUE SPACE. CL*79
|
||||
00102 05 WORK-HOLD-DATE2 PIC X(10) VALUE SPACE. CL*79
|
||||
00103 05 WORK-INACT-DATE PIC S9(09) COMP-3. CL*51
|
||||
00104 05 WORK-LIAB-DATE PIC S9(09) COMP-3. CL*79
|
||||
00105 05 WORK-INACT-CODE PIC X(2) VALUE SPACE. CL*42
|
||||
00106 CL*39
|
||||
00107 05 WRK-ERROR-IND PIC X(01). DTSBX441
|
||||
00108 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX441
|
||||
00109 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX441
|
||||
00110 DTSBX441
|
||||
00111 05 WRK-SELECT-SOL-IND PIC X(01). DTSBX441
|
||||
00112 88 WRK-SELECT-SOL-YES-88 VALUE 'Y'. DTSBX441
|
||||
00113 88 WRK-SELECT-SOL-NO-88 VALUE 'N'. DTSBX441
|
||||
00114 DTSBX441
|
||||
00115 05 WRK-MPRF-IND PIC X(01). CL*45
|
||||
00116 88 WRK-MPRF-OK VALUE 'Y'. CL*45
|
||||
00117 88 WRK-MPRF-NO-REC VALUE 'N'. CL*45
|
||||
00118 CL*45
|
||||
00119 05 WRK-SELECT-INACT-IND PIC X(01). DTSBX441
|
||||
00120 88 WRK-SELECT-INACT-YES-88 VALUE 'Y'. DTSBX441
|
||||
00121 88 WRK-SELECT-INACT-NO-88 VALUE 'N'. DTSBX441
|
||||
00122 DTSBX441
|
||||
00123 DTSBX441
|
||||
00124 05 X104-IN-STATUS PIC X(02) VALUE SPACES. CL*32
|
||||
00125 88 X104-IN-OK-88 VALUE '00'. CL*32
|
||||
00126 88 X104-IN-EOF-88 VALUE '10'. CL*32
|
||||
00127 CL*23
|
||||
00128 05 X104-NEW-STATUS PIC X(02). CL*32
|
||||
00129 88 X104-NEW-OK-88 VALUE '00'. CL*32
|
||||
00130 DTSBX441
|
||||
00131 05 X104-IN-CNT PIC S9(07) COMP-3 VALUE +0. CL*39
|
||||
00132 05 X104-OUT-CNT PIC S9(07) COMP-3 VALUE +0. CL*39
|
||||
00133 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. CL*52
|
||||
00134 CL*72
|
||||
00135 05 WRK-INACT-SLASH-DT. CL*72
|
||||
00136 15 WRK-INACT-MM PIC X(02) VALUE SPACE. CL*79
|
||||
00137 15 FILLER PIC X(01) VALUE '/'. CL*72
|
||||
00138 15 WRK-INACT-DD PIC X(02) VALUE SPACE. CL*79
|
||||
00139 15 FILLER PIC X(01) VALUE '/'. CL*72
|
||||
00140 15 WRK-INACT-YYYY PIC X(04) VALUE SPACE. CL*79
|
||||
00141 DTSBX441
|
||||
00142 05 WRK-LIAB-SLASH-DT. CL*79
|
||||
00143 15 WRK-LIAB-MM PIC X(02) VALUE SPACE. CL*79
|
||||
00144 15 FILLER PIC X(01) VALUE '/'. CL*79
|
||||
00145 15 WRK-LIAB-DD PIC X(02) VALUE SPACE. CL*79
|
||||
00146 15 FILLER PIC X(01) VALUE '/'. CL*79
|
||||
00147 15 WRK-LIAB-YYYY PIC X(04) VALUE SPACE. CL*79
|
||||
00148 CL*79
|
||||
00149 01 MSG-AREA. DTSBX441
|
||||
00150 05 MSG1-AREA. DTSBX441
|
||||
00151 10 MSG1-ID PIC X(03) VALUE '800'. DTSBX441
|
||||
00152 10 MSG1-TEXT. DTSBX441
|
||||
00153 15 FILLER PIC X(40) DTSBX441
|
||||
00154 VALUE ' '. DTSBX441
|
||||
00155 15 FILLER PIC X(40) DTSBX441
|
||||
00156 VALUE ' '. DTSBX441
|
||||
00157 DTSBX441
|
||||
00158 01 TALLY-AREA. DTSBX441
|
||||
00159 05 SLASH-NAME. DTSBX441
|
||||
00160 10 SLASH-NAME-CHAR OCCURS 40 TIMES PIC X(01). DTSBX441
|
||||
00161 05 FIRST-NAME PIC X(40) VALUE SPACE. DTSBX441
|
||||
00162 05 MIDDLE-INIT PIC X(01) VALUE SPACE. DTSBX441
|
||||
00163 05 LAST-NAME PIC X(40) VALUE SPACE. DTSBX441
|
||||
00164 05 NSUB PIC S9(04) COMP. DTSBX441
|
||||
00165 05 FSUB PIC S9(04) COMP. DTSBX441
|
||||
00166 05 LSUB PIC S9(04) COMP. DTSBX441
|
||||
00167 05 LAST-NAME-COMPLETE-IND PIC X(01). DTSBX441
|
||||
00168 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBX441
|
||||
00169 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBX441
|
||||
00170 05 FIRST-NAME-COMPLETE-IND PIC X(01). DTSBX441
|
||||
00171 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBX441
|
||||
00172 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBX441
|
||||
00173 05 MID-INIT-COMPLETE-IND PIC X(01). DTSBX441
|
||||
00174 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBX441
|
||||
00175 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBX441
|
||||
00176 05 D-S PIC X(02) VALUE SPACE. DTSBX441
|
||||
00177 05 SLASH-TALLY PIC S9(04) COMP. DTSBX441
|
||||
00178 05 LAST-NAME-LEN PIC S9(04) COMP. DTSBX441
|
||||
00179 05 FIRST-MID-LEN PIC S9(04) COMP. DTSBX441
|
||||
00180 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSBX441
|
||||
00181 05 TOTAL-LEN PIC S9(04) COMP. DTSBX441
|
||||
00182 EJECT DTSBX441
|
||||
00183 01 WRK-X104-REC. CL*69
|
||||
00184 ++INCLUDE DTSNH104 CL*69
|
||||
00185 DTSBX441
|
||||
00186 01 L001-LINK-AREA. DTSBX441
|
||||
00187 ++INCLUDE DTSIL001 DTSBX441
|
||||
00188 DTSBX441
|
||||
00189 01 L003-LINK-AREA. DTSBX441
|
||||
00190 ++INCLUDE DTSIL003 DTSBX441
|
||||
00191 DTSBX441
|
||||
00192 01 L004-LINK-AREA. DTSBX441
|
||||
00193 ++INCLUDE DTSIL004 DTSBX441
|
||||
00194 DTSBX441
|
||||
00195 01 L005-LINK-AREA. DTSBX441
|
||||
00196 ++INCLUDE DTSIL005 DTSBX441
|
||||
00197 DTSBX441
|
||||
00198 01 L109-LINK-AREA. DTSBX441
|
||||
00199 ++INCLUDE DTSIL109 DTSBX441
|
||||
00200 DTSBX441
|
||||
00201 01 L410-LINK-AREA. DTSBX441
|
||||
00202 ++INCLUDE DTSIL410 DTSBX441
|
||||
00203 DTSBX441
|
||||
00204 01 L516-LINK-AREA. DTSBX441
|
||||
00205 ++INCLUDE DTSIL516 DTSBX441
|
||||
00206 DTSBX441
|
||||
00207 01 L600-LINK-AREA. DTSBX441
|
||||
00208 ++INCLUDE DTSIL600 DTSBX441
|
||||
00209 DTSBX441
|
||||
00210 01 L101-LINK-AREA. DTSBX441
|
||||
00211 ++INCLUDE DTSIL101 DTSBX441
|
||||
00212 DTSBX441
|
||||
00213 01 L910-LINK-AREA. DTSBX441
|
||||
00214 ++INCLUDE DTSIL910 DTSBX441
|
||||
00215 SKIP3 DTSBX441
|
||||
00216 01 MSKL-REC. DTSBX441
|
||||
00217 ++INCLUDE DTSIMSKL DTSBX441
|
||||
00218 SKIP3 DTSBX441
|
||||
00219 01 MHDR-REC. DTSBX441
|
||||
00220 ++INCLUDE DTSIMHDR DTSBX441
|
||||
00221 SKIP3 DTSBX441
|
||||
00222 01 MPRF-REC. DTSBX441
|
||||
00223 ++INCLUDE DTSIMPRF DTSBX441
|
||||
00224 DTSBX441
|
||||
00225 01 MSOL-REC. DTSBX441
|
||||
00226 ++INCLUDE DTSIMSOL DTSBX441
|
||||
00227 DTSBX441
|
||||
00228 01 MERA-REC. DTSBX441
|
||||
00229 ++INCLUDE DTSIMERA DTSBX441
|
||||
00230 DTSBX441
|
||||
00231 ++INCLUDE DTSIMQTR DTSBX441
|
||||
00232 DTSBX441
|
||||
00233 01 MFAE-REC. DTSBX441
|
||||
00234 ++INCLUDE DTSIMFAE DTSBX441
|
||||
00235 DTSBX441
|
||||
00236 01 MOPO-REC. DTSBX441
|
||||
00237 ++INCLUDE DTSIMOPO DTSBX441
|
||||
00238 DTSBX441
|
||||
00239 01 MTAD-REC. DTSBX441
|
||||
00240 ++INCLUDE DTSIMTAD DTSBX441
|
||||
00241 DTSBX441
|
||||
00242 01 MTAA-REC. DTSBX441
|
||||
00243 ++INCLUDE DTSIMTAA DTSBX441
|
||||
00244 DTSBX441
|
||||
00245 01 MREL-REC. DTSBX441
|
||||
00246 ++INCLUDE DTSIMREL DTSBX441
|
||||
00247 DTSBX441
|
||||
00248 01 MRTE-REC. DTSBX441
|
||||
00249 ++INCLUDE DTSIMRTE DTSBX441
|
||||
00250 DTSBX441
|
||||
00251 01 MLOG-REC. DTSBX441
|
||||
00252 ++INCLUDE DTSIMLOG DTSBX441
|
||||
00253 DTSBX441
|
||||
00254 01 MJRN-REC. DTSBX441
|
||||
00255 ++INCLUDE DTSIMJRN DTSBX441
|
||||
00256 DTSBX441
|
||||
00257 01 MRPT-REC. DTSBX441
|
||||
00258 ++INCLUDE DTSIMRPT DTSBX441
|
||||
00259 DTSBX441
|
||||
00260 01 MPAY-REC. DTSBX441
|
||||
00261 ++INCLUDE DTSIMPAY DTSBX441
|
||||
00262 DTSBX441
|
||||
00263 01 L921-LINK-AREA. DTSBX441
|
||||
00264 ++INCLUDE DTSIL921 DTSBX441
|
||||
00265 SKIP3 DTSBX441
|
||||
00266 01 ISKL-REC. DTSBX441
|
||||
00267 ++INCLUDE DTSIISKL DTSBX441
|
||||
00268 SKIP3 DTSBX441
|
||||
00269 01 IPES-REC. DTSBX441
|
||||
00270 ++INCLUDE DTSIIPES DTSBX441
|
||||
00271 DTSBX441
|
||||
00272 01 L931-LINK-AREA. DTSBX441
|
||||
00273 ++INCLUDE DTSIL931 DTSBX441
|
||||
00274 EJECT DTSBX441
|
||||
00275 01 FSKL-REC. DTSBX441
|
||||
00276 ++INCLUDE DTSIFSKL DTSBX441
|
||||
00277 EJECT DTSBX441
|
||||
00278 01 FCYR-REC. DTSBX441
|
||||
00279 ++INCLUDE DTSIFCYR DTSBX441
|
||||
00280 DTSBX441
|
||||
00281 01 FUIR-REC. DTSBX441
|
||||
00282 ++INCLUDE DTSIFUIR DTSBX441
|
||||
00283 DTSBX441
|
||||
00284 01 L981-LINK-AREA. DTSBX441
|
||||
00285 ++INCLUDE DTSIL981 DTSBX441
|
||||
00286 SKIP3 DTSBX441
|
||||
00287 01 WWGH-REC. DTSBX441
|
||||
00288 ++INCLUDE DTSIWWGH DTSBX441
|
||||
00289 EJECT DTSBX441
|
||||
00290 01 L982-LINK-AREA. DTSBX441
|
||||
00291 ++INCLUDE DTSIL982 DTSBX441
|
||||
00292 SKIP3 DTSBX441
|
||||
00293 01 WNAM-REC. DTSBX441
|
||||
00294 ++INCLUDE DTSIWNAM DTSBX441
|
||||
00295 EJECT DTSBX441
|
||||
00296 DTSBX441
|
||||
00297 PROCEDURE DIVISION. DTSBX441
|
||||
00298 DTSBX441
|
||||
00299 DTSBX441-MAIN. CL*28
|
||||
00300 CL*28
|
||||
00301 PERFORM I0000-INITIALIZE THRU I0000-EXIT. CL*28
|
||||
00302 CL*28
|
||||
00303 IF WRK-ERROR-YES-88 CL*45
|
||||
00304 GO TO DTSBX441-MAIN-EXIT. CL*28
|
||||
00305 CL*28
|
||||
00306 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*28
|
||||
00307 CL*28
|
||||
00308 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*28
|
||||
00309 CL*28
|
||||
00310 DTSBX441-MAIN-EXIT. CL*28
|
||||
00311 GOBACK. CL*28
|
||||
00312 CL*28
|
||||
00313 I0000-INITIALIZE. DTSBX441
|
||||
00314 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX441
|
||||
00315 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX441
|
||||
00316 CL*42
|
||||
00317 SET WRK-ERROR-NO-88 TO TRUE. DTSBX441
|
||||
00318 DTSBX441
|
||||
00319 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX441
|
||||
00320 DTSBX441
|
||||
00321 I0000-EXIT. DTSBX441
|
||||
00322 EXIT. DTSBX441
|
||||
00323 DTSBX441
|
||||
00324 I2000-OPEN-FILES. DTSBX441
|
||||
00325 OPEN INPUT X104-DETERM-FILE. CL*23
|
||||
00326 IF X104-IN-OK-88 CL*45
|
||||
00327 NEXT SENTENCE CL**5
|
||||
00328 ELSE CL**5
|
||||
00329 DISPLAY 'OPEN ERROR ON X104 FILE ' X104-IN-STATUS CL*45
|
||||
00330 SET WRK-ERROR-YES-88 TO TRUE CL**5
|
||||
00331 GO TO I2000-EXIT CL**5
|
||||
00332 END-IF. CL**5
|
||||
00333 DTSBX441
|
||||
00334 OPEN OUTPUT X104-NEW-FILE. CL*23
|
||||
00335 IF X104-NEW-OK-88 CL*45
|
||||
00336 NEXT SENTENCE CL*23
|
||||
00337 ELSE CL*23
|
||||
00338 DISPLAY 'OPEN ERROR ON X104 NEW FILE ' X104-NEW-STATUS CL*45
|
||||
00339 SET WRK-ERROR-YES-88 TO TRUE CL*23
|
||||
00340 GO TO I2000-EXIT CL*23
|
||||
00341 END-IF. CL*23
|
||||
00342 CL*23
|
||||
00343 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*29
|
||||
00344 DTSBX441
|
||||
00345 I2000-EXIT. DTSBX441
|
||||
00346 EXIT. DTSBX441
|
||||
00347 DTSBX441
|
||||
00348 P0000-PROCESS. DTSBX441
|
||||
00349 PERFORM S1010-READ-X104-IN THRU S1010-EXIT. CL*32
|
||||
00350 CL*32
|
||||
00351 IF X104-IN-EOF-88 CL*32
|
||||
00352 DISPLAY 'INPUT FILE IS EMPTY' CL*32
|
||||
00353 GO TO P0000-EXIT CL*32
|
||||
00354 END-IF. CL*32
|
||||
00355 CL*32
|
||||
00356 PERFORM UNTIL X104-IN-EOF-88 CL*32
|
||||
00357 PERFORM P3100-UPDATE-INACT-DT THRU P3100-EXIT CL*32
|
||||
00358 PERFORM S1010-READ-X104-IN THRU S1010-EXIT CL*32
|
||||
00359 END-PERFORM. CL*32
|
||||
00360 CL*32
|
||||
00361 P0000-EXIT. CL*32
|
||||
00362 EXIT. CL*32
|
||||
00363 CL*32
|
||||
00364 CL*33
|
||||
00365 P3100-UPDATE-INACT-DT. CL*33
|
||||
00366 CL*58
|
||||
00367 IF X104-INACTIVE-DATE = 0000000000 OR CL*78
|
||||
00368 X104-INACTIVE-CODE = SPACES CL*33
|
||||
00369 CL*33
|
||||
00370 PERFORM P3200-GET-INACT-DT THRU P3200-EXIT CL*45
|
||||
00371 ELSE CL*33
|
||||
00372 WRITE X104-NEW-REC FROM WRK-X104-REC DTSBX441
|
||||
00373 ADD +1 TO X104-OUT-CNT CL*45
|
||||
00374 END-IF. CL*33
|
||||
00375 CL*33
|
||||
00376 P3100-EXIT. CL*33
|
||||
00377 EXIT. CL*33
|
||||
00378 CL*33
|
||||
00379 P3200-GET-INACT-DT. CL*33
|
||||
00380 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*29
|
||||
00381 MOVE X104-EMP-NO TO MSKL-EMP-NO. CL*29
|
||||
00382 CL*29
|
||||
00383 SET MSKL-PRF-88 TO TRUE. CL*29
|
||||
00384 CL*29
|
||||
00385 PERFORM S910-READ THRU S910-EXIT. CL*29
|
||||
00386 IF L910-OK-88 CL*29
|
||||
00387 SET WRK-MPRF-OK TO TRUE CL*29
|
||||
00388 ELSE CL*29
|
||||
00389 DISPLAY 'EMP NO NOT IN USE ' MSKL-EMP-NO CL*29
|
||||
00390 PERFORM S999-ABEND THRU S999-EXIT. CL*47
|
||||
00391 CL*29
|
||||
00392 MOVE MSKL-REC TO MPRF-REC. CL*29
|
||||
00393 CL*30
|
||||
00394 IF MPRF-EMP-STATUS = 'I' CL*30
|
||||
00395 PERFORM P3300-READ-SOL THRU P3300-EXIT CL*51
|
||||
00396 ELSE CL*30
|
||||
00397 WRITE X104-NEW-REC FROM WRK-X104-REC DTSBX441
|
||||
00398 ADD +1 TO X104-OUT-CNT. CL*42
|
||||
00399 CL*33
|
||||
00400 CL*33
|
||||
00401 P3200-EXIT. CL*33
|
||||
00402 EXIT. CL*33
|
||||
00403 CL*29
|
||||
00404 P3300-READ-SOL. CL*33
|
||||
00405 MOVE ZEROES TO WORK-INACT-DATE. CL*43
|
||||
00406 MOVE ZEROES TO WORK-LIAB-DATE. CL*81
|
||||
00407 CL*43
|
||||
00408 MOVE LOW-VALUES TO MSOL-REC. CL*35
|
||||
00409 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*35
|
||||
00410 MOVE X104-EMP-NO TO MSOL-EMP-NO. CL*35
|
||||
00411 SET MSOL-SOL-88 TO TRUE. CL*35
|
||||
00412 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL*35
|
||||
00413 CL*47
|
||||
00414 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL*35
|
||||
00415 CL*50
|
||||
00416 IF L910-OK-88 CL*35
|
||||
00417 PERFORM S910B-READ THRU S910B-EXIT CL*51
|
||||
00418 ELSE CL*50
|
||||
00419 PERFORM S999-ABEND THRU S999-EXIT. CL*50
|
||||
00420 CL*47
|
||||
00421 IF L910-OK-88 CL*35
|
||||
00422 PERFORM P3310-BUILD-NEW-X104 THRU P3310-EXIT CL*50
|
||||
00423 UNTIL L910-NO-REC-88 CL*51
|
||||
00424 ELSE CL*47
|
||||
00425 PERFORM S999-ABEND THRU S999-EXIT. CL*50
|
||||
00426 CL*63
|
||||
00427 MOVE WORK-INACT-DATE TO WORK-HOLD-DATE1 CL*79
|
||||
00428 CL*72
|
||||
00429 MOVE WORK-HOLD-DATE1(2:4) TO WRK-INACT-YYYY CL*79
|
||||
00430 MOVE WORK-HOLD-DATE1(6:2) TO WRK-INACT-MM CL*79
|
||||
00431 MOVE WORK-HOLD-DATE1(8:2) TO WRK-INACT-DD CL*79
|
||||
00432 CL*73
|
||||
00433 MOVE WORK-LIAB-DATE TO WORK-HOLD-DATE2 CL*79
|
||||
00434 CL*79
|
||||
00435 MOVE WORK-HOLD-DATE2(2:4) TO WRK-LIAB-YYYY CL*79
|
||||
00436 MOVE WORK-HOLD-DATE2(6:2) TO WRK-LIAB-MM CL*79
|
||||
00437 MOVE WORK-HOLD-DATE2(8:2) TO WRK-LIAB-DD CL*79
|
||||
00438 CL*79
|
||||
00439 MOVE WRK-LIAB-SLASH-DT TO X104-FIRST-WAGE-DT CL*79
|
||||
00440 MOVE WRK-INACT-SLASH-DT TO X104-INACTIVE-DATE CL*73
|
||||
00441 MOVE WORK-INACT-CODE TO X104-INACTIVE-CODE CL*73
|
||||
00442 CL*63
|
||||
00443 WRITE X104-NEW-REC FROM WRK-X104-REC DTSBX441
|
||||
00444 ADD +1 TO X104-OUT-CNT. CL*42
|
||||
00445 CL*35
|
||||
00446 P3300-EXIT. CL*33
|
||||
00447 EXIT. CL*33
|
||||
00448 CL*33
|
||||
00449 P3310-BUILD-NEW-X104. CL*35
|
||||
00450 MOVE MSKL-REC TO MSOL-REC. CL*47
|
||||
00451 CL*47
|
||||
00452 IF MSOL-INACT-DATE > WORK-INACT-DATE CL*35
|
||||
00453 MOVE MSOL-LIAB-DATE TO WORK-LIAB-DATE CL*81
|
||||
00454 MOVE MSOL-INACT-DATE TO WORK-INACT-DATE CL*81
|
||||
00455 MOVE MSOL-INACT-CD TO WORK-INACT-CODE. CL*41
|
||||
00456 CL*35
|
||||
00457 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*51
|
||||
00458 CL*47
|
||||
00459 P3310-EXIT. CL*35
|
||||
00460 EXIT. CL*35
|
||||
00461 CL*35
|
||||
00462 DTSBX441
|
||||
00463 S1010-READ-X104-IN. CL*32
|
||||
00464 READ X104-DETERM-FILE INTO WRK-X104-REC CL*69
|
||||
00465 IF X104-IN-OK-88 CL*32
|
||||
00466 ADD +1 TO X104-IN-CNT CL*45
|
||||
00467 ELSE CL*32
|
||||
00468 IF X104-IN-EOF-88 CL*32
|
||||
00469 DISPLAY 'EOF' CL*32
|
||||
00470 ELSE CL*32
|
||||
00471 DISPLAY 'CANNOT READ X104 INPUT ' X104-IN-STATUS CL*53
|
||||
00472 PERFORM S999-ABEND THRU S999-EXIT CL*53
|
||||
00473 END-IF CL*32
|
||||
00474 END-IF. CL*32
|
||||
00475 CL*32
|
||||
00476 S1010-EXIT. CL*32
|
||||
00477 EXIT. CL*32
|
||||
00478 CL*32
|
||||
00479 T0000-TERMINATE. DTSBX441
|
||||
00480 DTSBX441
|
||||
00481 DISPLAY '*********************************************'. DTSBX441
|
||||
00482 DISPLAY '* DTSBX441 TERMINATION STATISTICS'. CL*41
|
||||
00483 DISPLAY '* '. DTSBX441
|
||||
00484 DISPLAY '* DETERMINATION RECS READ : ' CL*41
|
||||
00485 X104-IN-CNT. CL*45
|
||||
00486 DISPLAY '* DETERMINATION RECS WRITTEN : ' CL*45
|
||||
00487 X104-OUT-CNT. CL*45
|
||||
00488 DISPLAY '*********************************************'. DTSBX441
|
||||
00489 DTSBX441
|
||||
00490 DTSBX441
|
||||
00491 CLOSE X104-DETERM-FILE CL*25
|
||||
00492 X104-NEW-FILE. CL*25
|
||||
00493 DTSBX441
|
||||
00494 PERFORM S910-CLOSE THRU S910-EXIT. CL*41
|
||||
00495 DTSBX441
|
||||
00496 T0000-EXIT. DTSBX441
|
||||
00497 EXIT. DTSBX441
|
||||
00498 DTSBX441
|
||||
00499 S001-FROM-FED-8. DTSBX441
|
||||
00500 SET L001-FROM-FED-8 TO TRUE. DTSBX441
|
||||
00501 GO TO S001-DATE. DTSBX441
|
||||
00502 DTSBX441
|
||||
00503 S001-FROM-ABS-DAY. DTSBX441
|
||||
00504 SET L001-FROM-ABS-DAY TO TRUE. DTSBX441
|
||||
00505 GO TO S001-DATE. DTSBX441
|
||||
00506 DTSBX441
|
||||
00507 S001-DATE. DTSBX441
|
||||
00508 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX441
|
||||
00509 S001-EXIT. DTSBX441
|
||||
00510 EXIT. DTSBX441
|
||||
00511 DTSBX441
|
||||
00512 S003-AGENCY-DAY. DTSBX441
|
||||
00513 SET L003-AGENCY-DAY TO TRUE. DTSBX441
|
||||
00514 GO TO S003-WORK-DAY. DTSBX441
|
||||
00515 DTSBX441
|
||||
00516 S003-WORK-DAY. DTSBX441
|
||||
00517 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX441
|
||||
00518 S003-EXIT. DTSBX441
|
||||
00519 EXIT. DTSBX441
|
||||
00520 DTSBX441
|
||||
00521 S004-FROM-DATE. DTSBX441
|
||||
00522 SET L004-FROM-DATE TO TRUE. DTSBX441
|
||||
00523 GO TO S004-QTR. DTSBX441
|
||||
00524 DTSBX441
|
||||
00525 S004-FROM-5. DTSBX441
|
||||
00526 SET L004-FROM-5 TO TRUE. DTSBX441
|
||||
00527 GO TO S004-QTR. DTSBX441
|
||||
00528 DTSBX441
|
||||
00529 S004-FROM-ABS. DTSBX441
|
||||
00530 SET L004-FROM-ABS TO TRUE. DTSBX441
|
||||
00531 GO TO S004-QTR. DTSBX441
|
||||
00532 DTSBX441
|
||||
00533 S004-FROM-3. DTSBX441
|
||||
00534 SET L004-FROM-3 TO TRUE. DTSBX441
|
||||
00535 GO TO S004-QTR. DTSBX441
|
||||
00536 DTSBX441
|
||||
00537 S004-QTR. DTSBX441
|
||||
00538 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX441
|
||||
00539 S004-EXIT. DTSBX441
|
||||
00540 EXIT. DTSBX441
|
||||
00541 DTSBX441
|
||||
00542 S005-SYS-DATE. DTSBX441
|
||||
00543 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX441
|
||||
00544 DTSBX441
|
||||
00545 S005-EXIT. DTSBX441
|
||||
00546 EXIT. DTSBX441
|
||||
00547 DTSBX441
|
||||
00548 S101-PER-MONTH-NO. DTSBX441
|
||||
00549 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBX441
|
||||
00550 GO TO S101-INT-CHARGE. DTSBX441
|
||||
00551 DTSBX441
|
||||
00552 S101-INT-CHARGE. DTSBX441
|
||||
00553 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBX441
|
||||
00554 S101-EXIT. DTSBX441
|
||||
00555 EXIT. DTSBX441
|
||||
00556 DTSBX441
|
||||
00557 S109-SUR-BY-QTR. DTSBX441
|
||||
00558 SET L109-CLASS-SELF-INS-88 TO TRUE. DTSBX441
|
||||
00559 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBX441
|
||||
00560 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBX441
|
||||
00561 DTSBX441
|
||||
00562 S109-QTR-EXIT. DTSBX441
|
||||
00563 EXIT. DTSBX441
|
||||
00564 DTSBX441
|
||||
00565 S410-FILE-SCHED. DTSBX441
|
||||
00566 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBX441
|
||||
00567 S410-EXIT. DTSBX441
|
||||
00568 EXIT. DTSBX441
|
||||
00569 DTSBX441
|
||||
00570 S516-LIABILITY. DTSBX441
|
||||
00571 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX441
|
||||
00572 MPRF-REC. DTSBX441
|
||||
00573 S516-EXIT. DTSBX441
|
||||
00574 EXIT. DTSBX441
|
||||
00575 DTSBX441
|
||||
00576 S910-OPEN-READ. CL*29
|
||||
00577 SET L910-OPEN-READ-88 TO TRUE. CL*29
|
||||
00578 GO TO S910-MSTR-IO. CL*29
|
||||
00579 CL*29
|
||||
00580 S910-OPEN-UPDATE-NO-AIX. CL*29
|
||||
00581 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*29
|
||||
00582 GO TO S910-MSTR-IO. CL*29
|
||||
00583 CL*29
|
||||
00584 S910-READ. CL*29
|
||||
00585 SET L910-READ-88 TO TRUE. CL*29
|
||||
00586 GO TO S910-MSTR-IO. CL*29
|
||||
00587 CL*29
|
||||
00588 S910-START-BROWSE. CL*29
|
||||
00589 SET L910-START-BROWSE-88 TO TRUE. CL*29
|
||||
00590 GO TO S910-MSTR-IO. CL*29
|
||||
00591 CL*29
|
||||
00592 S910-READ-NEXT. CL*29
|
||||
00593 SET L910-READ-NEXT-88 TO TRUE. CL*29
|
||||
00594 GO TO S910-MSTR-IO. CL*29
|
||||
00595 CL*29
|
||||
00596 S910-COUNT. CL*29
|
||||
00597 SET L910-COUNT-88 TO TRUE. CL*29
|
||||
00598 GO TO S910-MSTR-IO. CL*29
|
||||
00599 CL*29
|
||||
00600 S910-REWRITE. CL*29
|
||||
00601 SET L910-REWRITE-88 TO TRUE. CL*29
|
||||
00602 GO TO S910-MSTR-IO. CL*29
|
||||
00603 CL*29
|
||||
00604 S910-DELETE. CL*29
|
||||
00605 SET L910-DELETE-88 TO TRUE. CL*29
|
||||
00606 GO TO S910-MSTR-IO. CL*29
|
||||
00607 CL*29
|
||||
00608 S910-CLOSE. CL*29
|
||||
00609 SET L910-CLOSE-88 TO TRUE. CL*29
|
||||
00610 GO TO S910-MSTR-IO. CL*29
|
||||
00611 CL*29
|
||||
00612 S910-MSTR-IO. CL*29
|
||||
00613 CALL 'DTSBU910' USING L910-LINK-AREA CL*29
|
||||
00614 MSKL-REC. CL*29
|
||||
00615 S910-EXIT. CL*29
|
||||
00616 EXIT. CL*29
|
||||
00617 SKIP3 CL*29
|
||||
00618 S910A-OPEN-READ. DTSBX441
|
||||
00619 SET L910-OPEN-READ-88 TO TRUE. DTSBX441
|
||||
00620 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00621 DTSBX441
|
||||
00622 S910A-EXIT. DTSBX441
|
||||
00623 EXIT. DTSBX441
|
||||
00624 DTSBX441
|
||||
00625 S910B-READ. DTSBX441
|
||||
00626 SET L910-READ-88 TO TRUE. DTSBX441
|
||||
00627 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00628 DTSBX441
|
||||
00629 S910B-EXIT. DTSBX441
|
||||
00630 EXIT. DTSBX441
|
||||
00631 DTSBX441
|
||||
00632 S910C-START-BROWSE. DTSBX441
|
||||
00633 SET L910-START-BROWSE-88 TO TRUE. DTSBX441
|
||||
00634 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00635 DTSBX441
|
||||
00636 S910C-EXIT. DTSBX441
|
||||
00637 EXIT. DTSBX441
|
||||
00638 DTSBX441
|
||||
00639 S910Y-READ-NEXT. CL**3
|
||||
00640 SET L910-READ-NEXT-88 TO TRUE. CL**3
|
||||
00641 MOVE MSOL-REC TO MSKL-REC CL**3
|
||||
00642 DISPLAY 'SOL KEY B ' MSOL-KEY-AREA. CL*17
|
||||
00643 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. CL**3
|
||||
00644 DISPLAY 'NEXT MSKL ' MSKL-KEY-AREA CL*17
|
||||
00645 DISPLAY 'L910 ' L910-RESULT-IND. CL*18
|
||||
00646 CL**3
|
||||
00647 S910Y-EXIT. CL**3
|
||||
00648 EXIT. CL**3
|
||||
00649 S910D-READ-NEXT. DTSBX441
|
||||
00650 SET L910-READ-NEXT-88 TO TRUE. DTSBX441
|
||||
00651 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00652 IF L910-OK-88 DTSBX441
|
||||
00653 IF MSKL-PRF-88 DTSBX441
|
||||
00654 ADD +1 TO WRK-MPRF-CNT DTSBX441
|
||||
00655 END-IF DTSBX441
|
||||
00656 END-IF. DTSBX441
|
||||
00657 DTSBX441
|
||||
00658 S910D-EXIT. DTSBX441
|
||||
00659 EXIT. DTSBX441
|
||||
00660 DTSBX441
|
||||
00661 S910E-COUNT. DTSBX441
|
||||
00662 SET L910-COUNT-88 TO TRUE. DTSBX441
|
||||
00663 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00664 DTSBX441
|
||||
00665 S910E-EXIT. DTSBX441
|
||||
00666 EXIT. DTSBX441
|
||||
00667 DTSBX441
|
||||
00668 S910F-REWRITE. DTSBX441
|
||||
00669 SET L910-REWRITE-88 TO TRUE. DTSBX441
|
||||
00670 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00671 DTSBX441
|
||||
00672 S910F-EXIT. DTSBX441
|
||||
00673 EXIT. DTSBX441
|
||||
00674 DTSBX441
|
||||
00675 S910G-CLOSE. DTSBX441
|
||||
00676 SET L910-CLOSE-88 TO TRUE. DTSBX441
|
||||
00677 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441
|
||||
00678 DTSBX441
|
||||
00679 S910G-EXIT. DTSBX441
|
||||
00680 EXIT. DTSBX441
|
||||
00681 DTSBX441
|
||||
00682 S910Z-MSTR-IO. DTSBX441
|
||||
00683 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX441
|
||||
00684 MSKL-REC. DTSBX441
|
||||
00685 S910Z-EXIT. DTSBX441
|
||||
00686 EXIT. DTSBX441
|
||||
00687 DTSBX441
|
||||
00688 S921-OPEN-READ. DTSBX441
|
||||
00689 SET L921-OPEN-READ-88 TO TRUE. DTSBX441
|
||||
00690 GO TO S921-AIX-IO. DTSBX441
|
||||
00691 DTSBX441
|
||||
00692 S921-START-BROWSE. DTSBX441
|
||||
00693 SET L921-START-BROWSE-88 TO TRUE. DTSBX441
|
||||
00694 GO TO S921-AIX-IO. DTSBX441
|
||||
00695 DTSBX441
|
||||
00696 S921-READ-NEXT. DTSBX441
|
||||
00697 SET L921-READ-NEXT-88 TO TRUE. DTSBX441
|
||||
00698 GO TO S921-AIX-IO. DTSBX441
|
||||
00699 DTSBX441
|
||||
00700 S921-CLOSE. DTSBX441
|
||||
00701 SET L921-CLOSE-88 TO TRUE. DTSBX441
|
||||
00702 GO TO S921-AIX-IO. DTSBX441
|
||||
00703 DTSBX441
|
||||
00704 S921-AIX-IO. DTSBX441
|
||||
00705 CALL 'DTSBU921' DTSBX441
|
||||
00706 USING L921-LINK-AREA DTSBX441
|
||||
00707 ISKL-REC. DTSBX441
|
||||
00708 DTSBX441
|
||||
00709 S921-EXIT. EXIT. DTSBX441
|
||||
00710 DTSBX441
|
||||
00711 S931A-OPEN-READ. DTSBX441
|
||||
00712 SET L931-OPEN-READ-88 TO TRUE. DTSBX441
|
||||
00713 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441
|
||||
00714 DTSBX441
|
||||
00715 S931A-EXIT. DTSBX441
|
||||
00716 EXIT. DTSBX441
|
||||
00717 DTSBX441
|
||||
00718 S931B-START-BROWSE. DTSBX441
|
||||
00719 SET L931-START-BROWSE-88 TO TRUE. DTSBX441
|
||||
00720 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441
|
||||
00721 DTSBX441
|
||||
00722 S931B-EXIT. DTSBX441
|
||||
00723 EXIT. DTSBX441
|
||||
00724 DTSBX441
|
||||
00725 S931C-READ-NEXT. DTSBX441
|
||||
00726 SET L931-READ-NEXT-88 TO TRUE. DTSBX441
|
||||
00727 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441
|
||||
00728 DTSBX441
|
||||
00729 S931C-EXIT. DTSBX441
|
||||
00730 EXIT. DTSBX441
|
||||
00731 DTSBX441
|
||||
00732 S931D-CLOSE. DTSBX441
|
||||
00733 SET L931-CLOSE-88 TO TRUE. DTSBX441
|
||||
00734 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441
|
||||
00735 DTSBX441
|
||||
00736 S931D-EXIT. DTSBX441
|
||||
00737 EXIT. DTSBX441
|
||||
00738 DTSBX441
|
||||
00739 S931Z-REF-IO. DTSBX441
|
||||
00740 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX441
|
||||
00741 FSKL-REC. DTSBX441
|
||||
00742 S931Z-EXIT. EXIT. DTSBX441
|
||||
00743 DTSBX441
|
||||
00744 S981A-OPEN-READ. DTSBX441
|
||||
00745 SET L981-OPEN-READ-88 TO TRUE. DTSBX441
|
||||
00746 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441
|
||||
00747 DTSBX441
|
||||
00748 S981A-EXIT. DTSBX441
|
||||
00749 EXIT. DTSBX441
|
||||
00750 DTSBX441
|
||||
00751 S981C-CLOSE. DTSBX441
|
||||
00752 SET L981-CLOSE-88 TO TRUE. DTSBX441
|
||||
00753 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441
|
||||
00754 DTSBX441
|
||||
00755 S981C-EXIT. DTSBX441
|
||||
00756 EXIT. DTSBX441
|
||||
00757 DTSBX441
|
||||
00758 S981D-START-BROWSE. DTSBX441
|
||||
00759 SET L981-START-BROWSE-88 TO TRUE. DTSBX441
|
||||
00760 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441
|
||||
00761 DTSBX441
|
||||
00762 S981D-EXIT. DTSBX441
|
||||
00763 EXIT. DTSBX441
|
||||
00764 DTSBX441
|
||||
00765 S981E-READ-NEXT. DTSBX441
|
||||
00766 SET L981-READ-NEXT-88 TO TRUE. DTSBX441
|
||||
00767 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441
|
||||
00768 DTSBX441
|
||||
00769 S981E-EXIT. DTSBX441
|
||||
00770 EXIT. DTSBX441
|
||||
00771 DTSBX441
|
||||
00772 S981Z-WAGE-I. DTSBX441
|
||||
00773 CALL 'DTSBU981' USING L981-LINK-AREA DTSBX441
|
||||
00774 WWGH-REC. DTSBX441
|
||||
00775 S981Z-EXIT. DTSBX441
|
||||
00776 EXIT. DTSBX441
|
||||
00777 DTSBX441
|
||||
00778 S982A-START-BROWSE. DTSBX441
|
||||
00779 SET L982-START-BROWSE-88 TO TRUE. DTSBX441
|
||||
00780 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX441
|
||||
00781 DTSBX441
|
||||
00782 S982A-EXIT. DTSBX441
|
||||
00783 EXIT. DTSBX441
|
||||
00784 DTSBX441
|
||||
00785 S982C-OPEN-READ. DTSBX441
|
||||
00786 SET L982-OPEN-READ-88 TO TRUE. DTSBX441
|
||||
00787 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX441
|
||||
00788 DTSBX441
|
||||
00789 S982C-EXIT. DTSBX441
|
||||
00790 EXIT. DTSBX441
|
||||
00791 DTSBX441
|
||||
00792 S982D-CLOSE. DTSBX441
|
||||
00793 SET L982-CLOSE-88 TO TRUE. DTSBX441
|
||||
00794 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX441
|
||||
00795 DTSBX441
|
||||
00796 S982D-EXIT. DTSBX441
|
||||
00797 EXIT. DTSBX441
|
||||
00798 DTSBX441
|
||||
00799 S982Z-WNAM-IO. DTSBX441
|
||||
00800 CALL 'DTSBU982' USING L982-LINK-AREA DTSBX441
|
||||
00801 WNAM-REC. DTSBX441
|
||||
00802 S982Z-EXIT. DTSBX441
|
||||
00803 EXIT. DTSBX441
|
||||
00804 DTSBX441
|
||||
00805 S999-ABEND. DTSBX441
|
||||
00806 DISPLAY '*** DTSBX441 ABENDING. ' CL*83
|
||||
00807 ABEND-MSG. DTSBX441
|
||||
00808 DTSBX441
|
||||
00809 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX441
|
||||
00810 S999-EXIT. DTSBX441
|
||||
00811 EXIT. DTSBX441
|
||||
Reference in New Issue
Block a user