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