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