813 lines
64 KiB
COBOL
813 lines
64 KiB
COBOL
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
|