00001  IDENTIFICATION DIVISION.                                         12/23/19
00002  PROGRAM-ID.             DTSBX800.                                DTSBX800
00003  AUTHOR.                 NGC.                                        LV009
00004  DATE-WRITTEN.           OCTOBER 2006.                            DTSBX800
00005  DATE-COMPILED.                                                   DTSBX800
00006      SKIP3                                                        DTSBX800
00007 *****                                                             DTSBX800
00008 *                                                                 DTSBX800
00009 *    FUNCTION:  CREATE FILE OF RELATIONSHIP RECORDS               DTSBX800
00010 *               IN EFFECTIVE DATE, PREDECESSOR, SUCCESSOR         DTSBX800
00011 *               ORDER.  USED FOR TRANSFERRING EXPERIENCE.         DTSBX800
00012 *                                                                 DTSBX800
00013 * >>>  THIS PROGRAM CAN RUN IN TWO MODES, BASED ON A PARM.        DTSBX800
00014 * >>>  PARM = 0: SELECT ONLY EXPERIENCE RATING RELATIONSHIPS.     DTSBX800
00015 * >>>  PARM = 1: SELECT ALL RELATIONSHIPS.                        DTSBX800
00016 * >>>  THE 'SELECT ALL' SETTING IS USED IN PROCESSING ICESA       DTSBX800
00017 * >>>  REPORTS (DTSBD551).                                        DTSBX800
00018 *                                                                 DTSBX800
00019 *    07/11/2019  MODIFIED TO NOT EXCLUDE EMPLOYER FROM THE SUC TAB   CL**9
00020 *                PROGRAM DTSZX800 NEED TO RUN BEFORE THIS PROGRAM    CL**9
00021 *                REBUILT THE PRED/SUCC REL TABLE.                    CL**9
00022 *                REFERENCE:                     PROGRAMMER:   ZL1    CL**9
00023 *                                                                    CL**9
00024 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX         CL**9
00025 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX         CL**9
00026 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER:          CL**9
00027 *                                                                    CL**9
00028 *****                                                             DTSBX800
00029      SKIP3                                                        DTSBX800
00030  ENVIRONMENT DIVISION.                                            DTSBX800
00031      SKIP2                                                        DTSBX800
00032  INPUT-OUTPUT SECTION.                                            DTSBX800
00033                                                                   DTSBX800
00034  FILE-CONTROL.                                                    DTSBX800
00035      SELECT SORT-FILE    ASSIGN TO SORTFILE.                      DTSBX800
00036                                                                   DTSBX800
00037      SELECT ESP-FILE     ASSIGN TO DTSFIESP                       DTSBX800
00038             FILE STATUS IS ESP-STATUS.                            DTSBX800
00039                                                                   DTSBX800
00040  DATA DIVISION.                                                   DTSBX800
00041                                                                   DTSBX800
00042  FILE SECTION.                                                    DTSBX800
00043                                                                   DTSBX800
00044  SD  SORT-FILE.                                                   DTSBX800
00045                                                                   DTSBX800
00046  01  SORT-REC.                                                    DTSBX800
00047      05  SORT-KEY                    PIC X(16).                   DTSBX800
00048                                                                   DTSBX800
00049  FD  ESP-FILE                                                     DTSBX800
00050      RECORDING MODE IS F                                          DTSBX800
00051      BLOCK CONTAINS 0 RECORDS                                     DTSBX800
00052      LABEL RECORDS ARE OMITTED.                                   DTSBX800
00053                                                                   DTSBX800
00054  01  ESP-FILE-REC                    PIC X(16).                   DTSBX800
00055                                                                   DTSBX800
00056                                                                   DTSBX800
00057  WORKING-STORAGE SECTION.                                         DTSBX800
000575 77  PAN-VALET PICTURE X(24) VALUE '009DTSBX800  12/23/19'.       DTSBX800
00058  77  PAN-VALET PICTURE X(24) VALUE '001DTSBX800  01/16/08'.       DTSBX800
00059      SKIP3                                                        DTSBX800
00060  01  WRK-AREA.                                                    DTSBX800
00061      05  WRK-ABEND-CD              PIC S9(04)  COMP  VALUE +340.  DTSBX800
00062                                                                   DTSBX800
00063      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBZ340'.DTSBX800
00064                                                                   DTSBX800
00065      05  WRK-SRT-CNT                 PIC S9(07) COMP-3 VALUE +0.  DTSBX800
00066      05  WRK-ESP-CNT                 PIC S9(07) COMP-3 VALUE +0.  DTSBX800
00067                                                                   DTSBX800
00068      05  WRK-ERROR-IND               PIC  X(01).                  DTSBX800
00069          88 WRK-ERROR-YES-88      VALUE 'Y'.                      DTSBX800
00070          88 WRK-ERROR-NO-88       VALUE 'N'.                      DTSBX800
00071                                                                   DTSBX800
00072      05  ESP-STATUS                  PIC  X(02).                  DTSBX800
00073          88 ESP-STATUS-OK-88      VALUE '00'.                     DTSBX800
00074                                                                   DTSBX800
00075      05  SORT-STATUS                 PIC  X(02) VALUE '00'.       DTSBX800
00076          88 SORT-OK-88            VALUE '00'.                     DTSBX800
00077          88 SORT-EOF-88           VALUE '10'.                     DTSBX800
00078                                                                   DTSBX800
00079      05  WRK-TRACE-IND                   PIC  X(01).              DTSBX800
00080                                                                   DTSBX800
00081      05  PCT-DISP                        PIC  9.9999.             DTSBX800
00082                                                                   DTSBX800
00083      05  WRK-ESP-REC.                                             DTSBX800
00084          10  WRK-ESP-EFF-DT              PIC S9(09) COMP-3.       DTSBX800
00085          10  WRK-ESP-PRED                PIC S9(07) COMP-3.       DTSBX800
00086          10  WRK-ESP-SUC                 PIC S9(07) COMP-3.       DTSBX800
00087          10  WRK-ESP-PCT                 PIC S9V9(04) COMP-3.     DTSBX800
00088                                                                   DTSBX800
00089  01  L921-LINK-AREA.                                              DTSBX800
00090  ++INCLUDE DTSIL921                                               DTSBX800
00091                                                                   DTSBX800
00092  01  ISKL-REC.                                                    DTSBX800
00093  ++INCLUDE DTSIISKL                                               DTSBX800
00094                                                                   DTSBX800
00095  01  IPES-REC.                                                    DTSBX800
00096  ++INCLUDE DTSIIPES                                               DTSBX800
00097                                                                   DTSBX800
00098  LINKAGE SECTION.                                                 DTSBX800
00099                                                                   DTSBX800
00100  01  PARM-AREA.                                                   DTSBX800
00101      05  PARM-LENGTH                PIC S9(04)  COMP.             DTSBX800
00102                                                                   DTSBX800
00103 ***********************************************************       DTSBX800
00104 *  PARM = 0: SELECT ONLY 'EXPERIENCE RATING' RELATIONSHIPS.       DTSBX800
00105 *  PARM = 1: SELECT ALL RELATIONSHIPS.                            DTSBX800
00106 ***********************************************************       DTSBX800
00107      05  PARM-DATA.                                               DTSBX800
00108          10  PARM-EMP-NO            PIC  X(01).                   DTSBX800
00109              88  PARM-RATING-ONLY-88  VALUE '0'.                  DTSBX800
00110              88  PARM-SELECT-ALL-88   VALUE '1'.                  DTSBX800
00111                                                                   DTSBX800
00112  PROCEDURE DIVISION.                                              DTSBX800
00113                                                                   DTSBX800
00114  DTSBX800-MAIN.                                                   DTSBX800
00115      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBX800
00116      IF WRK-ERROR-YES-88                                          DTSBX800
00117         GO TO DTSBX800-MAIN-EXIT.                                 DTSBX800
00118                                                                   DTSBX800
00119      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBX800
00120                                                                   DTSBX800
00121      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBX800
00122                                                                   DTSBX800
00123  DTSBX800-MAIN-EXIT.                                              DTSBX800
00124      GOBACK.                                                      DTSBX800
00125      EJECT                                                        DTSBX800
00126  I0000-INITIATE.                                                  DTSBX800
00127                                                                   DTSBX800
00128      SET WRK-ERROR-NO-88 TO TRUE.                                 DTSBX800
00129                                                                   DTSBX800
00130      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBX800
00131      IF WRK-ERROR-YES-88                                          DTSBX800
00132         GO TO I0000-EXIT.                                         DTSBX800
00133                                                                   DTSBX800
00134  I0000-EXIT.                                                      DTSBX800
00135      EXIT.                                                        DTSBX800
00136  I1000-OPEN-FILES.                                                DTSBX800
00137      MOVE WRK-TRACE-IND TO L921-TRACE-IND.                        DTSBX800
00138                                                                   DTSBX800
00139      MOVE WRK-MOD-NAME TO L921-MOD-NAME.                          DTSBX800
00140                                                                   DTSBX800
00141      OPEN OUTPUT ESP-FILE.                                        DTSBX800
00142      IF NOT ESP-STATUS-OK-88                                      DTSBX800
00143         DISPLAY 'CANNOT OPEN ESP OUTPUT FILE ' ESP-STATUS         DTSBX800
00144         SET WRK-ERROR-YES-88          TO TRUE                     DTSBX800
00145         GO TO I1000-EXIT                                          DTSBX800
00146      END-IF.                                                      DTSBX800
00147      PERFORM S921A-OPEN-READ   THRU S921A-EXIT.                   DTSBX800
00148                                                                   DTSBX800
00149  I1000-EXIT.                                                      DTSBX800
00150      EXIT.                                                        DTSBX800
00151                                                                   DTSBX800
00152      EJECT                                                        DTSBX800
00153  P0000-PROCESS.                                                   DTSBX800
00154      SORT SORT-FILE                                               DTSBX800
00155        ON ASCENDING KEY SORT-KEY                                  DTSBX800
00156        INPUT PROCEDURE P1000-GET-IPES    THRU P1000-EXIT          DTSBX800
00157        OUTPUT PROCEDURE P2000-WRITE-ESP  THRU P2000-EXIT.         DTSBX800
00158                                                                   DTSBX800
00159  P0000-EXIT.                                                      DTSBX800
00160      EXIT.                                                        DTSBX800
00161                                                                   DTSBX800
00162  P1000-GET-IPES.                                                  DTSBX800
00163      MOVE LOW-VALUES                    TO IPES-KEY-AREA.         DTSBX800
00164      SET IPES-PES-88                    TO TRUE.                  DTSBX800
00165      MOVE IPES-KEY-AREA                 TO ISKL-KEY-AREA.         DTSBX800
00166      PERFORM S921B-START-BROWSE         THRU S921B-EXIT.          DTSBX800
00167                                                                   DTSBX800
00168      PERFORM UNTIL L921-NO-REC-88                                 DTSBX800
00169         MOVE ISKL-REC                      TO IPES-REC            DTSBX800
00170      DISPLAY 'TRANSFER EXP RATING ' IPES-SUC-EMP-NO                  CL**7
00171         ' TRANSFER CODE ' IPES-EXP-TRNSF-CD                          CL**7
00172                                                                      CL**7
00173         IF PARM-RATING-ONLY-88                                    DTSBX800
00174            IF IPES-EXP-TRNSF-YES-88                               DTSBX800
00175               PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT        DTSBX800
00176               ADD +1                       TO WRK-SRT-CNT         DTSBX800
00177            END-IF                                                 DTSBX800
00178         ELSE                                                      DTSBX800
00179            PERFORM P1100-WRITE-SORT-REC    THRU P1100-EXIT        DTSBX800
00180            ADD +1                          TO WRK-SRT-CNT         DTSBX800
00181         END-IF                                                    DTSBX800
00182         PERFORM S921D-READ-NEXT            THRU S921D-EXIT        DTSBX800
00183      END-PERFORM.                                                 DTSBX800
00184                                                                   DTSBX800
00185  P1000-EXIT.                                                      DTSBX800
00186      EXIT.                                                        DTSBX800
00187                                                                   DTSBX800
00188  P1100-WRITE-SORT-REC.                                            DTSBX800
00189 *    IF IPES-SUC-EMP-NO = 582326 OR 813262 OR 862472                 CL**8
00190 *       OR 753582                                                    CL**8
00191 *    DISPLAY 'PASS ' WRK-ESP-EFF-DT '  ' WRK-ESP-PRED                CL**8
00192 *       '  ' WRK-ESP-SUC '  ' WRK-ESP-PCT                            CL**8
00193 *       GO TO P1100-EXIT.                                            CL**8
00194                                                                      CL**3
00195      MOVE IPES-EFF-DATE           TO WRK-ESP-EFF-DT.              DTSBX800
00196      MOVE IPES-PRED-EMP-NO        TO WRK-ESP-PRED.                DTSBX800
00197      MOVE IPES-SUC-EMP-NO         TO WRK-ESP-SUC.                 DTSBX800
00198      MOVE IPES-PERCENT-TRNSFRD    TO WRK-ESP-PCT.                 DTSBX800
00199                                                                   DTSBX800
00200      DISPLAY 'IN ' WRK-ESP-EFF-DT '  ' WRK-ESP-PRED                  CL**2
00201         '  ' WRK-ESP-SUC '  ' WRK-ESP-PCT.                           CL**7
00202                                                                   DTSBX800
00203      RELEASE SORT-REC             FROM WRK-ESP-REC.               DTSBX800
00204                                                                   DTSBX800
00205  P1100-EXIT.                                                      DTSBX800
00206      EXIT.                                                        DTSBX800
00207                                                                   DTSBX800
00208                                                                   DTSBX800
00209  P2000-WRITE-ESP.                                                 DTSBX800
00210                                                                   DTSBX800
00211      SET SORT-OK-88   TO TRUE.                                    DTSBX800
00212      RETURN SORT-FILE                                             DTSBX800
00213         AT END                                                    DTSBX800
00214            SET SORT-EOF-88  TO TRUE.                              DTSBX800
00215                                                                   DTSBX800
00216      PERFORM P2100-WRITE-ESP       THRU P2100-EXIT                DTSBX800
00217        UNTIL SORT-EOF-88.                                         DTSBX800
00218                                                                   DTSBX800
00219  P2000-EXIT.                                                      DTSBX800
00220      EXIT.                                                        DTSBX800
00221                                                                   DTSBX800
00222  P2100-WRITE-ESP.                                                 DTSBX800
00223      IF SORT-RETURN NOT = +0                                      DTSBX800
00224         DISPLAY 'BAD RETURN ON SORT FILE ' SORT-RETURN            DTSBX800
00225         SET SORT-EOF-88  TO TRUE                                  DTSBX800
00226         GO TO P2100-EXIT                                          DTSBX800
00227      END-IF.                                                      DTSBX800
00228                                                                   DTSBX800
00229      MOVE SORT-REC TO WRK-ESP-REC.                                DTSBX800
00230 **   DISPLAY 'OUT ' WRK-ESP-EFF-DT '  ' WRK-ESP-PRED              DTSBX800
00231 **      '  ' WRK-ESP-SUC '  ' WRK-ESP-PCT.                        DTSBX800
00232      WRITE ESP-FILE-REC FROM SORT-REC.                            DTSBX800
00233      IF NOT ESP-STATUS-OK-88                                      DTSBX800
00234         DISPLAY 'CANNOT WRITE ESP REC ' ESP-STATUS                DTSBX800
00235         SET SORT-EOF-88  TO TRUE                                  DTSBX800
00236         GO TO P2100-EXIT                                          DTSBX800
00237      ELSE                                                         DTSBX800
00238         ADD +1                       TO WRK-ESP-CNT               DTSBX800
00239      END-IF.                                                      DTSBX800
00240                                                                   DTSBX800
00241      RETURN SORT-FILE                                             DTSBX800
00242         AT END                                                    DTSBX800
00243            SET SORT-EOF-88  TO TRUE                               DTSBX800
00244            GO TO P2100-EXIT                                       DTSBX800
00245      END-RETURN.                                                  DTSBX800
00246  P2100-EXIT.                                                      DTSBX800
00247      EXIT.                                                        DTSBX800
00248                                                                   DTSBX800
00249  T0000-TERMINATE.                                                 DTSBX800
00250                                                                   DTSBX800
00251      DISPLAY ' '.                                                 DTSBX800
00252                                                                   DTSBX800
00253      DISPLAY '*** DTSBX800 TERMINATION STATISTICS ***'.           DTSBX800
00254                                                                   DTSBX800
00255      DISPLAY ' '.                                                 DTSBX800
00256                                                                   DTSBX800
00257      DISPLAY 'IPES AIX RECORDS READ             :            '    DTSBX800
00258              WRK-SRT-CNT.                                         DTSBX800
00259                                                                   DTSBX800
00260      DISPLAY 'NUMBER OF ESP RECORDS WRITTEN     :            '    DTSBX800
00261              WRK-ESP-CNT.                                         DTSBX800
00262                                                                   DTSBX800
00263      PERFORM S921C-CLOSE THRU S921C-EXIT.                         DTSBX800
00264                                                                   DTSBX800
00265  T0000-EXIT.                                                      DTSBX800
00266      EXIT.                                                        DTSBX800
00267      EJECT                                                        DTSBX800
00268  S921A-OPEN-READ.                                                 DTSBX800
00269      SET L921-OPEN-READ-88      TO TRUE.                          DTSBX800
00270      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX800
00271                            ISKL-REC.                              DTSBX800
00272  S921A-EXIT.                                                      DTSBX800
00273      EXIT.                                                        DTSBX800
00274                                                                   DTSBX800
00275  S921B-START-BROWSE.                                              DTSBX800
00276      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX800
00277      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX800
00278                            ISKL-REC.                              DTSBX800
00279  S921B-EXIT.                                                      DTSBX800
00280      EXIT.                                                        DTSBX800
00281                                                                   DTSBX800
00282  S921C-CLOSE.                                                     DTSBX800
00283      SET L921-CLOSE-88        TO TRUE.                            DTSBX800
00284      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX800
00285                            ISKL-REC.                              DTSBX800
00286  S921C-EXIT.                                                      DTSBX800
00287      EXIT.                                                        DTSBX800
00288                                                                   DTSBX800
00289  S921D-READ-NEXT.                                                 DTSBX800
00290      SET L921-READ-NEXT-88    TO TRUE.                            DTSBX800
00291      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX800
00292                            ISKL-REC.                              DTSBX800
00293  S921D-EXIT.                                                      DTSBX800
00294      EXIT.                                                        DTSBX800
00295                                                                   DTSBX800
00296                                                                   DTSBX800
00297  S999-ABEND.                                                      DTSBX800
00298      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX800
00299  S999-EXIT.                                                       DTSBX800
00300      EXIT.                                                        DTSBX800
00301                                                                   DTSBX800
