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