00001  IDENTIFICATION DIVISION.                                         02/26/01
00002  PROGRAM-ID.             DOESU946.                                DOESU946
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           DECEMBER 1991.                           DOESU946
00005  DATE-COMPILED.                                                   DOESU946
00006                                                                   DOESU946
00007 *****                                                             DOESU946
00008 *                                                                 DOESU946
00009 *    FUNCTION:  VARIABLE LENGTH RECORD (FILE 1) OUTPUT.           DOESU946
00010 *                                                                 DOESU946
00011 *                                                                 DOESU946
00012 *    MODIFICATION LOG:                                            DOESU946
00013 *                                                                 DOESU946
00014 *    12/18/91  INITIAL DEVELOPMENT.                               DOESU946
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DOESU946
00016 *                                                                 DOESU946
00017 *    09/30/1998  REVIEWED AND MODIFIED FOR DC.                    DOESU946
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DOESU946
00019 *                                                                 DOESU946
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DOESU946
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DOESU946
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DOESU946
00023 *                                                                 DOESU946
00024 *                                                                 DOESU946
00025 *    DESCRIPTION:                                                 DOESU946
00026 *                                                                 DOESU946
00027 *        DTSBU946 WRITES REPORT RECORDS TO DTSFVRO1.              DOESU946
00028 *                                                                 DOESU946
00029 *                                                                 DOESU946
00030 *****                                                             DOESU946
00031                                                                   DOESU946
00032  ENVIRONMENT DIVISION.                                            DOESU946
00033                                                                   DOESU946
00034  INPUT-OUTPUT SECTION.                                            DOESU946
00035                                                                   DOESU946
00036  FILE-CONTROL.                                                    DOESU946
00037      SELECT VAR-FILE ASSIGN TO DOESVRO1                              CL**2
00038          FILE STATUS IS FILE-STATUS.                              DOESU946
00039                                                                   DOESU946
00040  DATA DIVISION.                                                   DOESU946
00041                                                                   DOESU946
00042  FILE SECTION.                                                    DOESU946
00043                                                                   DOESU946
00044  FD  VAR-FILE                                                     DOESU946
00045      RECORDING MODE IS V                                          DOESU946
00046      BLOCK CONTAINS 0 RECORDS.                                    DOESU946
00047                                                                   DOESU946
00048  01  FILE-REC.                                                    DOESU946
00049  ++INCLUDE DTSIRVAR                                               DOESU946
00050      EJECT                                                        DOESU946
00051  WORKING-STORAGE SECTION.                                         DOESU946
000515 77  PAN-VALET PICTURE X(24) VALUE '002DOESU946  02/26/01'.       DOESU946
00052                                                                   DOESU946
00053  01  WRK-AREA.                                                    DOESU946
00054      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +946.DOESU946
00055                                                                   DOESU946
00056      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DOESU946
00057                                                                   DOESU946
00058      05  VAR-CHAR-CNT                PIC S9(04)  COMP.            DOESU946
00059                                                                   DOESU946
00060      05  WRK-REC-CNT                 PIC S9(07)  COMP-3.          DOESU946
00061                                                                   DOESU946
00062      05  FILE-STATUS                 PIC  X(02).                  DOESU946
00063          88  FILE-OK-88                     VALUE '00'.           DOESU946
00064      EJECT                                                        DOESU946
00065  01  RLEN-LENGTH-LITERALS.                                        DOESU946
00066  ++INCLUDE DTSIRLEN                                               DOESU946
00067      EJECT                                                        DOESU946
00068  LINKAGE SECTION.                                                 DOESU946
00069                                                                   DOESU946
00070  01  LINK-REC.                                                    DOESU946
00071  ++INCLUDE DTSIRVAR                                               DOESU946
00072      EJECT                                                        DOESU946
00073  PROCEDURE DIVISION USING LINK-REC.                               DOESU946
00074                                                                   DOESU946
00075      IF FIRST-TIME-IND = 'Y'                                      DOESU946
00076          PERFORM P1000-OPEN THRU P1000-EXIT                       DOESU946
00077          MOVE +0  TO WRK-REC-CNT                                  DOESU946
00078          MOVE 'N' TO FIRST-TIME-IND.                              DOESU946
00079                                                                   DOESU946
00080      IF RVAR-LENGTH OF LINK-REC = -1                              DOESU946
00081          DISPLAY '*** '                                           DOESU946
00082                  WRK-REC-CNT                                      DOESU946
00083                  ' DTSFVRO1 RECORDS WRITTEN'                      DOESU946
00084          PERFORM P2000-CLOSE THRU P2000-EXIT                      DOESU946
00085      ELSE                                                         DOESU946
00086          IF RVAR-LENGTH OF LINK-REC < RLEN-MIN-LENGTH             DOESU946
00087          OR RVAR-LENGTH OF LINK-REC > RLEN-MAX-LENGTH             DOESU946
00088              DISPLAY 'RECORD LENGTH: ' RVAR-LENGTH OF LINK-REC    DOESU946
00089              PERFORM S999-ABEND THRU S999-EXIT                    DOESU946
00090          ELSE                                                     DOESU946
00091              COMPUTE VAR-CHAR-CNT = RVAR-LENGTH OF LINK-REC - 2   DOESU946
00092              MOVE LINK-REC TO FILE-REC                            DOESU946
00093              PERFORM P3000-WRITE THRU P3000-EXIT                  DOESU946
00094              ADD +1 TO WRK-REC-CNT.                               DOESU946
00095                                                                   DOESU946
00096      GOBACK.                                                      DOESU946
00097      EJECT                                                        DOESU946
00098  P1000-OPEN.                                                      DOESU946
00099      OPEN OUTPUT VAR-FILE.                                        DOESU946
00100                                                                   DOESU946
00101      IF NOT FILE-OK-88                                            DOESU946
00102          DISPLAY 'CANT OPEN VARIABLE LENGTH FILE'                 DOESU946
00103          PERFORM S999-ABEND THRU S999-EXIT.                       DOESU946
00104  P1000-EXIT.                                                      DOESU946
00105      EXIT.                                                        DOESU946
00106                                                                   DOESU946
00107                                                                   DOESU946
00108                                                                   DOESU946
00109  P2000-CLOSE.                                                     DOESU946
00110      CLOSE VAR-FILE.                                              DOESU946
00111      IF NOT FILE-OK-88                                            DOESU946
00112          DISPLAY 'CANT CLOSE VARIABLE LENGTH FILE'                DOESU946
00113          PERFORM S999-ABEND THRU S999-EXIT.                       DOESU946
00114  P2000-EXIT.                                                      DOESU946
00115      EXIT.                                                        DOESU946
00116                                                                   DOESU946
00117                                                                   DOESU946
00118                                                                   DOESU946
00119  P3000-WRITE.                                                     DOESU946
00120      WRITE FILE-REC.                                              DOESU946
00121                                                                   DOESU946
00122      IF NOT FILE-OK-88                                            DOESU946
00123          DISPLAY 'CANT WRITE VARIABLE LENGTH FILE'                DOESU946
00124          PERFORM S999-ABEND THRU S999-EXIT.                       DOESU946
00125  P3000-EXIT.                                                      DOESU946
00126      EXIT.                                                        DOESU946
00127      EJECT                                                        DOESU946
00128  S999-ABEND.                                                      DOESU946
00129      DISPLAY '*** I/O MODULE ABENDING'.                           DOESU946
00130      DISPLAY '*** FILE-STATUS = ' FILE-STATUS.                    DOESU946
00131                                                                   DOESU946
00132      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DOESU946
00133  S999-EXIT.                                                       DOESU946
00134      EXIT.                                                        DOESU946
