00001  IDENTIFICATION DIVISION.                                         09/29/98
00002  PROGRAM-ID.             DTSBU924.                                DTSBU924
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSBU924
00005  DATE-COMPILED.                                                   DTSBU924
00006      SKIP3                                                        DTSBU924
00007 *****                                                             DTSBU924
00008 *                                                                 DTSBU924
00009 *    FUNCTION:  ON-LINE ACTIVITY FILE INPUT.                      DTSBU924
00010 *                                                                 DTSBU924
00011 *                                                                 DTSBU924
00012 *    MODIFICATION LOG:                                            DTSBU924
00013 *                                                                 DTSBU924
00014 *    12/18/91  INITIAL DEVELOPMENT.                               DTSBU924
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU924
00016 *                                                                 DTSBU924
00017 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU924
00018 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU924
00019 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBU924
00020 *                                                                 DTSBU924
00021 *                                                                 DTSBU924
00022 *    DESCRIPTION:                                                 DTSBU924
00023 *                                                                 DTSBU924
00024 *        DTSBU924 PERFORMS ON-LINE ACTIVITY FILE INPUT.              CL**2
00025 *                                                                 DTSBU924
00026 *                                                                 DTSBU924
00027 *    GENERAL SPECIFICATIONS:                                      DTSBU924
00028 *                                                                 DTSBU924
00029 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSBU924
00030 *        MODULE.                                                  DTSBU924
00031 *                                                                 DTSBU924
00032 *        IF A FILE-STATUS OF OTHER THAN '00' OR '10' IS           DTSBU924
00033 *        ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A           DTSBU924
00034 *        FILE-STATUS OF '97' FROM AN OPEN COMMAND).               DTSBU924
00035 *                                                                 DTSBU924
00036 *                                                                 DTSBU924
00037 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSBU924
00038 *                                                                 DTSBU924
00039 *    OPEN-READ                                                    DTSBU924
00040 *        OPEN INPUT.                                              DTSBU924
00041 *                                                                 DTSBU924
00042 *    CLOSE                                                        DTSBU924
00043 *                                                                 DTSBU924
00044 *    READ NEXT                                                    DTSBU924
00045 *                                                                 DTSBU924
00046 *        IF RSK1-REC-TYPE = '000' OR SPACES OR LOW-VALUES         DTSBU924
00047 *            BYPASS THE RECORD.                                   DTSBU924
00048 *                                                                 DTSBU924
00049 *        IF RVAR-LENGTH OF FILE-REC < RLEN-MIN-LENGTH             DTSBU924
00050 *                 OR                                              DTSBU924
00051 *           RVAR-LENGTH OF FILE-REC > RLEN-MAX-LENGTH             DTSBU924
00052 *            ABEND PROCESSING.                                    DTSBU924
00053 *                                                                 DTSBU924
00054 *        VAR-CHAR-CNT MUST BE SET BEFORE THE MOVE FROM            DTSBU924
00055 *        FILE-REC TO LINK-REC.                                    DTSBU924
00056 *                                                                 DTSBU924
00057 *          VAR-CHAR-CNT = RVAR-LENGTH OF FILE-REC - 2.            DTSBU924
00058 *                                                                 DTSBU924
00059 *****                                                             DTSBU924
00060      SKIP3                                                        DTSBU924
00061  ENVIRONMENT DIVISION.                                            DTSBU924
00062                                                                      CL**2
00063                                                                      CL**2
00064  INPUT-OUTPUT SECTION.                                            DTSBU924
00065                                                                      CL**2
00066  FILE-CONTROL.                                                    DTSBU924
00067      SELECT OLA-FILE ASSIGN TO AS-DTSFOLAI                           CL**2
00068          ORGANIZATION IS SEQUENTIAL                               DTSBU924
00069          FILE STATUS IS FILE-STATUS                               DTSBU924
00070          ACCESS IS SEQUENTIAL.                                    DTSBU924
00071      SKIP3                                                        DTSBU924
00072  DATA DIVISION.                                                   DTSBU924
00073      SKIP3                                                        DTSBU924
00074  FILE SECTION.                                                    DTSBU924
00075      SKIP3                                                        DTSBU924
00076  FD  OLA-FILE.                                                    DTSBU924
00077                                                                      CL**2
00078  01  FILE-REC.                                                    DTSBU924
00079  ++INCLUDE DTSIRVAR                                                  CL**2
00080      SKIP3                                                        DTSBU924
00081  01  RSK1-REC.                                                    DTSBU924
00082  ++INCLUDE DTSIRSK1                                                  CL**2
00083      EJECT                                                        DTSBU924
00084  WORKING-STORAGE SECTION.                                         DTSBU924
000845 77  PAN-VALET PICTURE X(24) VALUE '002DTSBU924  09/29/98'.       DTSBU924
00085      SKIP3                                                        DTSBU924
00086  01  WRK-AREA.                                                    DTSBU924
00087      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +924.DTSBU924
00088                                                                      CL**2
00089      05  VAR-CHAR-CNT                PIC S9(04)  COMP.            DTSBU924
00090                                                                      CL**2
00091      05  WRK-REC-CNT                 PIC S9(07)  COMP-3.          DTSBU924
00092                                                                      CL**2
00093      05  FILE-STATUS                 PIC  X(02).                  DTSBU924
00094          88  FILE-OK-88                  VALUE '00'.              DTSBU924
00095          88  FILE-NO-REC-88              VALUE '10'.              DTSBU924
00096          88  FILE-VERIFY-88              VALUE '97'.              DTSBU924
00097      EJECT                                                        DTSBU924
00098  01  RLEN-LENGTH-LITERALS.                                        DTSBU924
00099  ++INCLUDE DTSIRLEN                                                  CL**2
00100      EJECT                                                        DTSBU924
00101  LINKAGE SECTION.                                                 DTSBU924
00102      SKIP3                                                        DTSBU924
00103  01  L924-LINK-AREA.                                              DTSBU924
00104  ++INCLUDE DTSIL924                                                  CL**2
00105      EJECT                                                        DTSBU924
00106  01  LINK-REC.                                                    DTSBU924
00107  ++INCLUDE DTSIRVAR                                                  CL**2
00108      EJECT                                                        DTSBU924
00109  PROCEDURE DIVISION USING L924-LINK-AREA                          DTSBU924
00110                           LINK-REC.                               DTSBU924
00111                                                                      CL**2
00112      IF L924-TRACE-88                                             DTSBU924
00113          PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT.               DTSBU924
00114                                                                      CL**2
00115      SET L924-OK-88 TO TRUE.                                      DTSBU924
00116                                                                      CL**2
00117      IF L924-READ-NEXT-88                                         DTSBU924
00118          PERFORM P2300-READ-NEXT THRU P2300-EXIT                  DTSBU924
00119      ELSE                                                         DTSBU924
00120      IF L924-OPEN-READ-88                                         DTSBU924
00121          PERFORM P1100-OPEN-READ THRU P1100-EXIT                  DTSBU924
00122      ELSE                                                         DTSBU924
00123      IF L924-CLOSE-88                                             DTSBU924
00124          PERFORM P1200-CLOSE THRU P1200-EXIT                      DTSBU924
00125      ELSE                                                         DTSBU924
00126          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU924
00127                                                                      CL**2
00128      IF L924-TRACE-88                                             DTSBU924
00129          PERFORM S9200-POST-DISPLAY THRU S9200-EXIT.              DTSBU924
00130                                                                      CL**2
00131                                                                      CL**2
00132      GOBACK.                                                      DTSBU924
00133      EJECT                                                        DTSBU924
00134  P1100-OPEN-READ.                                                 DTSBU924
00135      OPEN INPUT OLA-FILE.                                         DTSBU924
00136                                                                      CL**2
00137      IF FILE-OK-88 OR FILE-VERIFY-88                              DTSBU924
00138          NEXT SENTENCE                                            DTSBU924
00139      ELSE                                                         DTSBU924
00140          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU924
00141                                                                      CL**2
00142      MOVE +0 TO WRK-REC-CNT.                                      DTSBU924
00143  P1100-EXIT.                                                      DTSBU924
00144      EXIT.                                                        DTSBU924
00145      SKIP3                                                        DTSBU924
00146  P1200-CLOSE.                                                     DTSBU924
00147      CLOSE OLA-FILE.                                              DTSBU924
00148                                                                      CL**2
00149      IF NOT FILE-OK-88                                            DTSBU924
00150          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU924
00151                                                                      CL**2
00152      DISPLAY '*** '                                               DTSBU924
00153              WRK-REC-CNT                                          DTSBU924
00154              ' DTSFOLAI NON DUMMY RECORDS READ'.                     CL**2
00155  P1200-EXIT.                                                      DTSBU924
00156      EXIT.                                                        DTSBU924
00157      EJECT                                                        DTSBU924
00158  P2300-READ-NEXT.                                                 DTSBU924
00159      READ OLA-FILE.                                               DTSBU924
00160                                                                      CL**2
00161      IF FILE-NO-REC-88                                            DTSBU924
00162          SET L924-NO-REC-88 TO TRUE                               DTSBU924
00163          GO TO P2300-EXIT.                                        DTSBU924
00164                                                                      CL**2
00165      IF NOT FILE-OK-88                                            DTSBU924
00166          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU924
00167                                                                      CL**2
00168      IF (RSK1-LENGTH < RLEN-MIN-LENGTH)                           DTSBU924
00169              OR                                                   DTSBU924
00170         (RSK1-LENGTH > RLEN-MAX-LENGTH)                           DTSBU924
00171          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU924
00172                                                                      CL**2
00173      IF RSK1-REC-TYPE = '000' OR SPACE OR LOW-VALUES              DTSBU924
00174          GO TO P2300-READ-NEXT.                                   DTSBU924
00175                                                                      CL**2
00176      ADD +1 TO WRK-REC-CNT.                                       DTSBU924
00177                                                                      CL**2
00178      COMPUTE VAR-CHAR-CNT = RVAR-LENGTH OF FILE-REC - 2.          DTSBU924
00179                                                                      CL**2
00180      MOVE FILE-REC TO LINK-REC.                                   DTSBU924
00181  P2300-EXIT.                                                      DTSBU924
00182      EXIT.                                                        DTSBU924
00183      EJECT                                                        DTSBU924
00184  S9100-PRE-DISPLAY.                                               DTSBU924
00185      DISPLAY ' '.                                                 DTSBU924
00186                                                                      CL**2
00187      DISPLAY ' '.                                                 DTSBU924
00188                                                                      CL**2
00189      DISPLAY '*** DTSBU924 PRE  TRACE DISPLAY ***'.                  CL**2
00190                                                                      CL**2
00191      DISPLAY L924-MOD-NAME                                        DTSBU924
00192              ' = L924-MOD-NAME'.                                  DTSBU924
00193                                                                      CL**2
00194      DISPLAY L924-CMND-CD                                         DTSBU924
00195              ' = L924-CMND-CD'.                                   DTSBU924
00196  S9100-EXIT.                                                      DTSBU924
00197      EXIT.                                                        DTSBU924
00198      SKIP3                                                        DTSBU924
00199  S9200-POST-DISPLAY.                                              DTSBU924
00200      DISPLAY ' '.                                                 DTSBU924
00201                                                                      CL**2
00202      DISPLAY '*** DTSBU924 POST TRACE DISPLAY ***'.                  CL**2
00203                                                                      CL**2
00204      DISPLAY L924-RESULT-IND                                      DTSBU924
00205              ' = L924-RESULT-IND'.                                DTSBU924
00206                                                                      CL**2
00207      DISPLAY RVAR-LENGTH OF LINK-REC                              DTSBU924
00208              ' = RVAR-LENGTH OF LINK-REC'.                        DTSBU924
00209                                                                      CL**2
00210      DISPLAY RVAR-CHAR OF LINK-REC (1)                            DTSBU924
00211              RVAR-CHAR OF LINK-REC(2)                             DTSBU924
00212              RVAR-CHAR OF LINK-REC(3)                             DTSBU924
00213              ' = REC-TYPE OF LINK-REC'.                           DTSBU924
00214  S9200-EXIT.                                                      DTSBU924
00215      EXIT.                                                        DTSBU924
00216      EJECT                                                        DTSBU924
00217  S999-ABEND.                                                      DTSBU924
00218      DISPLAY '*** I/O MODULE ABENDING'.                           DTSBU924
00219                                                                      CL**2
00220      DISPLAY '*** CMND-CD = ' L924-CMND-CD.                       DTSBU924
00221                                                                      CL**2
00222      DISPLAY '*** FILE-STATUS = ' FILE-STATUS.                    DTSBU924
00223                                                                      CL**2
00224      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00225  S999-EXIT.                                                       DTSBU924
00226      EXIT.                                                        DTSBU924
