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
