00001  IDENTIFICATION DIVISION.                                         06/17/13
00002  PROGRAM-ID.             DTSBX801.                                DTSBX801
00003  AUTHOR.                 NGC.                                        LV022
00004  DATE-WRITTEN.           JANUARY 2008.                               CL**6
00005  DATE-COMPILED.                                                   DTSBX801
00006      SKIP3                                                        DTSBX801
00007 *****                                                             DTSBX801
00008 *                                                                 DTSBX801
00009 *    FUNCTION:  BUILD PREDECESSOR/SUCCESSOR FILE FOR SDDS            CL*15
00010 *                                                                 DTSBX801
00011 *****                                                             DTSBX801
00012      SKIP3                                                        DTSBX801
00013  ENVIRONMENT DIVISION.                                            DTSBX801
00014      SKIP2                                                        DTSBX801
00015  INPUT-OUTPUT SECTION.                                            DTSBX801
00016                                                                   DTSBX801
00017  FILE-CONTROL.                                                    DTSBX801
00018      SELECT PRED-FILE     ASSIGN TO DTSFPRED                         CL*15
00019             FILE STATUS IS PRED-STATUS.                              CL*15
00020                                                                   DTSBX801
00021  DATA DIVISION.                                                   DTSBX801
00022                                                                   DTSBX801
00023  FILE SECTION.                                                    DTSBX801
00024  FD  PRED-FILE                                                       CL*15
00025      RECORDING MODE IS F                                          DTSBX801
00026      BLOCK CONTAINS 0 RECORDS                                     DTSBX801
00027      LABEL RECORDS ARE OMITTED.                                   DTSBX801
00028                                                                   DTSBX801
00029  01  PRED-FILE-REC               PIC  X(22).                         CL*15
00030                                                                   DTSBX801
00031                                                                   DTSBX801
00032  WORKING-STORAGE SECTION.                                         DTSBX801
000325 77  PAN-VALET PICTURE X(24) VALUE '022DTSBX801  06/17/13'.       DTSBX801
00033      SKIP3                                                        DTSBX801
00034  01  WRK-AREA.                                                    DTSBX801
00035      05  WRK-ABEND-CD              PIC S9(04)  COMP  VALUE +801.     CL**6
00036                                                                   DTSBX801
00037      05  W-PRED-CNT                PIC S9(07) COMP-3 VALUE +0.       CL*15
00038                                                                   DTSBX801
00039      05  W-ERROR-IND               PIC  X(01).                       CL**6
00040          88 W-ERROR-YES-88      VALUE 'Y'.                           CL**6
00041          88 W-ERROR-NO-88       VALUE 'N'.                           CL**6
00042                                                                   DTSBX801
00043      05  W-SUCCESSOR-IND           PIC  X(01).                       CL**6
00044          88 W-SUCCESSOR-NO-88   VALUE '0'.                           CL**6
00045          88 W-SUCCESSOR-YES-88  VALUE '1'.                           CL**6
00046          88 W-PARTIAL-XFER-88   VALUE '2'.                           CL**8
00047                                                                      CL**6
00048      05  PRED-STATUS                 PIC  X(02).                     CL*15
00049          88 PRED-STATUS-OK-88     VALUE '00'.                        CL*15
00050          88 PRED-STATUS-EOF-88    VALUE '10'.                        CL*15
00051                                                                   DTSBX801
00052      05  W-PRED-RECORD.                                              CL*16
00053          10  W-STATE-CODE            PIC  X(02) VALUE '11'.          CL*18
00054          10  W-PRED-UI-ACCT.                                         CL*18
00055              15  FILLER              PIC  X(04) VALUE '0000'.        CL*18
00056              15  W-PRED-ACCT-NO      PIC  9(06).                     CL*18
00057          10  W-SUCC-UI-ACCT.                                         CL*18
00058              15  FILLER              PIC  X(04) VALUE '0000'.        CL*18
00059              15  W-SUCC-ACCT-NO      PIC  9(06).                     CL*18
00060                                                                      CL*16
00061  01  L910-LINK-AREA.                                                 CL*19
00062  ++INCLUDE DTSIL910                                                  CL*19
00063                                                                      CL*16
00064  01  MSKL-REC.                                                       CL*19
00065  ++INCLUDE DTSIMSKL                                                  CL*19
00066                                                                      CL*16
00067  01  MPRF-REC.                                                       CL*19
00068  ++INCLUDE DTSIMPRF                                                  CL*19
00069                                                                   DTSBX801
00070  01  L921-LINK-AREA.                                                 CL*19
00071  ++INCLUDE DTSIL921                                                  CL*19
00072                                                                      CL*19
00073  01  ISKL-REC.                                                       CL*19
00074  ++INCLUDE DTSIISKL                                                  CL*19
00075                                                                      CL*19
00076  01  IPES-REC.                                                       CL*19
00077  ++INCLUDE DTSIIPES                                                  CL*19
00078                                                                      CL*19
00079  PROCEDURE DIVISION.                                                 CL*15
00080                                                                      CL*12
00081  DTSBX801-MAIN.                                                      CL**6
00082      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBX801
00083      IF W-ERROR-YES-88                                               CL**6
00084         GO TO DTSBX801-MAIN-EXIT.                                    CL**6
00085                                                                   DTSBX801
00086      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBX801
00087                                                                   DTSBX801
00088      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBX801
00089                                                                   DTSBX801
00090  DTSBX801-MAIN-EXIT.                                                 CL**6
00091      GOBACK.                                                      DTSBX801
00092      EJECT                                                        DTSBX801
00093  I0000-INITIATE.                                                  DTSBX801
00094                                                                   DTSBX801
00095      SET W-ERROR-NO-88 TO TRUE.                                      CL**6
00096                                                                   DTSBX801
00097      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBX801
00098      IF W-ERROR-YES-88                                               CL**6
00099         GO TO I0000-EXIT.                                         DTSBX801
00100                                                                   DTSBX801
00101  I0000-EXIT.                                                      DTSBX801
00102      EXIT.                                                        DTSBX801
00103  I1000-OPEN-FILES.                                                DTSBX801
00104      OPEN OUTPUT PRED-FILE.                                          CL*16
00105      IF NOT PRED-STATUS-OK-88                                        CL*15
00106         DISPLAY 'CANNOT OPEN PREDECESSOR FILE ' PRED-STATUS          CL*16
00107         SET W-ERROR-YES-88          TO TRUE                          CL**6
00108         GO TO I1000-EXIT                                          DTSBX801
00109      END-IF.                                                      DTSBX801
00110                                                                   DTSBX801
00111      PERFORM S910A-OPEN-READ            THRU S910A-EXIT.             CL*22
00112      PERFORM S921A-OPEN-READ            THRU S921A-EXIT.             CL*22
00113                                                                      CL*16
00114  I1000-EXIT.                                                      DTSBX801
00115      EXIT.                                                        DTSBX801
00116                                                                   DTSBX801
00117  P0000-PROCESS.                                                   DTSBX801
00118      MOVE LOW-VALUES                       TO IPES-KEY-AREA.         CL*16
00119      SET IPES-PES-88                       TO TRUE.                  CL*16
00120      MOVE IPES-KEY-AREA                    TO ISKL-KEY-AREA.         CL*16
00121      PERFORM S921B-START-BROWSE            THRU S921B-EXIT.          CL*16
00122                                                                      CL*16
00123      PERFORM UNTIL L921-NO-REC-88                                    CL*16
00124         MOVE ISKL-REC                      TO IPES-REC               CL*16
00125         IF IPES-EXP-TRNSF-YES-88                                     CL*16
00126            PERFORM P1000-BUILD-OUTPUT      THRU P1000-EXIT           CL*16
00127         END-IF                                                       CL*16
00128         PERFORM S921D-READ-NEXT            THRU S921D-EXIT           CL*16
00129      END-PERFORM.                                                    CL*16
00130                                                                      CL*16
00131  P0000-EXIT.                                                      DTSBX801
00132      EXIT.                                                        DTSBX801
00133                                                                   DTSBX801
00134                                                                   DTSBX801
00135  P1000-BUILD-OUTPUT.                                                 CL*16
00136      SET W-ERROR-NO-88                TO TRUE.                       CL*20
00137                                                                      CL*20
00138      PERFORM P1100-CHECK-MPRF         THRU P1100-EXIT.               CL*20
00139      IF W-ERROR-NO-88                                                CL*20
00140         PERFORM P1200-WRITE           THRU P1200-EXIT                CL*20
00141      END-IF.                                                         CL*20
00142  P1000-EXIT.                                                      DTSBX801
00143      EXIT.                                                        DTSBX801
00144                                                                   DTSBX801
00145  P1100-CHECK-MPRF.                                                   CL*20
00146      PERFORM P1110-PREDECESSOR        THRU P1110-EXIT.               CL*20
00147      IF W-ERROR-NO-88                                                CL*20
00148         PERFORM P1120-SUCCESSOR       THRU P1120-EXIT                CL*20
00149      END-IF.                                                         CL*20
00150                                                                      CL*20
00151  P1100-EXIT.                                                         CL*20
00152      EXIT.                                                           CL*20
00153                                                                      CL*20
00154  P1110-PREDECESSOR.                                                  CL*20
00155      MOVE LOW-VALUES                  TO MSKL-KEY-AREA.              CL*20
00156      MOVE IPES-PRED-EMP-NO            TO MSKL-EMP-NO.                CL*20
00157      SET MSKL-PRF-88                  TO TRUE.                       CL*20
00158      PERFORM S910B-READ               THRU S910B-EXIT.               CL*21
00159      IF L910-NO-REC-88                                               CL*20
00160         SET W-ERROR-YES-88            TO TRUE                        CL*20
00161      END-IF.                                                         CL*20
00162                                                                      CL*20
00163  P1110-EXIT.                                                         CL*20
00164      EXIT.                                                           CL*20
00165                                                                      CL*20
00166  P1120-SUCCESSOR.                                                    CL*21
00167      MOVE LOW-VALUES                  TO MSKL-KEY-AREA.              CL*20
00168      MOVE IPES-SUC-EMP-NO             TO MSKL-EMP-NO.                CL*20
00169      SET MSKL-PRF-88                  TO TRUE.                       CL*20
00170      PERFORM S910B-READ               THRU S910B-EXIT.               CL*21
00171      IF L910-NO-REC-88                                               CL*20
00172         SET W-ERROR-YES-88            TO TRUE                        CL*20
00173      END-IF.                                                         CL*20
00174                                                                      CL*20
00175  P1120-EXIT.                                                         CL*20
00176      EXIT.                                                           CL*20
00177                                                                      CL*20
00178  P1200-WRITE.                                                        CL*20
00179      MOVE IPES-PRED-EMP-NO            TO W-PRED-ACCT-NO.             CL*20
00180      MOVE IPES-SUC-EMP-NO             TO W-SUCC-ACCT-NO.             CL*20
00181                                                                      CL*20
00182      WRITE PRED-FILE-REC              FROM W-PRED-RECORD.            CL*20
00183      IF PRED-STATUS-OK-88                                            CL*20
00184         ADD +1                        TO W-PRED-CNT                  CL*20
00185      ELSE                                                            CL*20
00186         DISPLAY 'CANNOT WRITE PRED RECORD ' PRED-STATUS              CL*20
00187      END-IF.                                                         CL*20
00188                                                                      CL*20
00189  P1200-EXIT.                                                         CL*20
00190      EXIT.                                                           CL*20
00191                                                                      CL*20
00192  T0000-TERMINATE.                                                 DTSBX801
00193                                                                   DTSBX801
00194      DISPLAY ' '.                                                 DTSBX801
00195                                                                   DTSBX801
00196      DISPLAY '*** DTSBX801 TERMINATION STATISTICS ***'.              CL**7
00197                                                                   DTSBX801
00198      DISPLAY ' '.                                                 DTSBX801
00199                                                                   DTSBX801
00200      DISPLAY 'RECORDS WRITTEN                   :            '       CL*16
00201              W-PRED-CNT.                                             CL*16
00202                                                                   DTSBX801
00203                                                                   DTSBX801
00204      CLOSE PRED-FILE.                                                CL*16
00205      PERFORM S910C-CLOSE                THRU S910C-EXIT.             CL*22
00206      PERFORM S921C-CLOSE                THRU S921C-EXIT.             CL*22
00207                                                                   DTSBX801
00208  T0000-EXIT.                                                      DTSBX801
00209      EXIT.                                                        DTSBX801
00210                                                                      CL*19
00211  S910A-OPEN-READ.                                                    CL*19
00212      SET L910-OPEN-READ-88      TO TRUE.                             CL*19
00213      CALL 'DTSBU910' USING L910-LINK-AREA                            CL*19
00214                            MSKL-REC.                                 CL*19
00215  S910A-EXIT.                                                         CL*19
00216      EXIT.                                                           CL*19
00217                                                                      CL*19
00218  S910B-READ.                                                         CL*19
00219      SET L910-READ-88           TO TRUE.                             CL*19
00220      CALL 'DTSBU910' USING L910-LINK-AREA                            CL*19
00221                            MSKL-REC.                                 CL*19
00222  S910B-EXIT.                                                         CL*19
00223      EXIT.                                                           CL*19
00224                                                                      CL*19
00225  S910C-CLOSE.                                                        CL*19
00226      SET L910-CLOSE-88          TO TRUE.                             CL*19
00227      CALL 'DTSBU910' USING L910-LINK-AREA                            CL*19
00228                            MSKL-REC.                                 CL*19
00229  S910C-EXIT.                                                         CL*19
00230      EXIT.                                                           CL*19
00231                                                                      CL*19
00232                                                                      CL*16
00233  S921A-OPEN-READ.                                                    CL*16
00234      SET L921-OPEN-READ-88      TO TRUE.                             CL*16
00235      CALL 'DTSBU921' USING L921-LINK-AREA                            CL*16
00236                            ISKL-REC.                                 CL*16
00237  S921A-EXIT.                                                         CL*16
00238      EXIT.                                                           CL*16
00239                                                                      CL*16
00240  S921B-START-BROWSE.                                                 CL*16
00241      SET L921-START-BROWSE-88 TO TRUE.                               CL*16
00242      CALL 'DTSBU921' USING L921-LINK-AREA                            CL*16
00243                            ISKL-REC.                                 CL*16
00244  S921B-EXIT.                                                         CL*16
00245      EXIT.                                                           CL*16
00246                                                                      CL*16
00247  S921C-CLOSE.                                                        CL*16
00248      SET L921-CLOSE-88        TO TRUE.                               CL*16
00249      CALL 'DTSBU921' USING L921-LINK-AREA                            CL*16
00250                            ISKL-REC.                                 CL*16
00251  S921C-EXIT.                                                         CL*16
00252      EXIT.                                                           CL*16
00253                                                                      CL*16
00254  S921D-READ-NEXT.                                                    CL*16
00255      SET L921-READ-NEXT-88    TO TRUE.                               CL*16
00256      CALL 'DTSBU921' USING L921-LINK-AREA                            CL*16
00257                            ISKL-REC.                                 CL*16
00258  S921D-EXIT.                                                         CL*16
00259      EXIT.                                                           CL*16
00260                                                                   DTSBX801
00261  S999-ABEND.                                                      DTSBX801
00262      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX801
00263  S999-EXIT.                                                       DTSBX801
00264      EXIT.                                                        DTSBX801
00265                                                                   DTSBX801
