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