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