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