00001  IDENTIFICATION DIVISION.                                         08/13/98
00002  PROGRAM-ID.             DTSBD972.                                DTSBD972
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           JANUARY 1998.                            DTSBD972
00005  DATE-COMPILED.                                                   DTSBD972
00006      SKIP3                                                        DTSBD972
00007 *****                                                             DTSBD972
00008 *                                                                 DTSBD972
00009 *    FUNCTION:  DECOMPOSE VARIABLE LENGTH RECORDS INTO FIXED      DTSBD972
00010 *               LENGTH RECORDS OF LENGTH 80.                      DTSBD972
00011 *                                                                 DTSBD972
00012 *                                                                 DTSBD972
00013 *    MODIFICATION LOG:                                            DTSBD972
00014 *                                                                 DTSBD972
00015 *    01/07/98  INITIAL DEVELOPMENT.                               DTSBD972
00016 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD972
00017 *                                                                 DTSBD972
00018 *    08/13/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00019 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00020 *                                                                    CL**2
00021 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00023 *                                                                 DTSBD972
00024 *                                                                 DTSBD972
00025 *  DESCRIPTION:                                                   DTSBD972
00026 *                                                                 DTSBD972
00027 *****                                                             DTSBD972
00028      SKIP3                                                        DTSBD972
00029  ENVIRONMENT DIVISION.                                            DTSBD972
00030      SKIP2                                                        DTSBD972
00031  INPUT-OUTPUT SECTION.                                            DTSBD972
00032                                                                   DTSBD972
00033  FILE-CONTROL.                                                    DTSBD972
00034      SELECT IN-FILE   ASSIGN TO INFILE                            DTSBD972
00035          FILE STATUS IS IN-FILE-STATUS.                           DTSBD972
00036      SELECT OUT-FILE  ASSIGN TO OUTFILE                           DTSBD972
00037          FILE STATUS IS OUT-FILE-STATUS.                          DTSBD972
00038      EJECT                                                        DTSBD972
00039  DATA DIVISION.                                                   DTSBD972
00040      SKIP3                                                        DTSBD972
00041  FILE SECTION.                                                    DTSBD972
00042      SKIP2                                                        DTSBD972
00043  FD  IN-FILE                                                      DTSBD972
00044      RECORDING MODE IS V                                          DTSBD972
00045      BLOCK CONTAINS 0 CHARACTERS                                  DTSBD972
00046      RECORD IS VARYING DEPENDING ON IN-REC-LEN.                   DTSBD972
00047                                                                   DTSBD972
00048  01  IN-REC-MIN-LENGTH-REC               PIC  X(01).              DTSBD972
00049                                                                   DTSBD972
00050  01  IN-REC-MAX-LENGTH-REC               PIC  X(4092).            DTSBD972
00051      EJECT                                                        DTSBD972
00052  FD  OUT-FILE                                                     DTSBD972
00053      RECORDING MODE IS F                                          DTSBD972
00054      BLOCK CONTAINS 0 RECORDS.                                    DTSBD972
00055                                                                   DTSBD972
00056  01  OUT-REC.                                                     DTSBD972
00057      05  OUT-REC-RECORD-TYPE-IND         PIC  X(01).              DTSBD972
00058          88  OUT-REC-TYPE-NEW-88                VALUE 'N'.        DTSBD972
00059          88  OUT-REC-TYPE-CONTINUE-88           VALUE 'C'.        DTSBD972
00060          88  OUT-REC-TYPE-TRAILING-88           VALUE 'T'.        DTSBD972
00061                                                                   DTSBD972
00062      05  OUT-REC-DATA-LEN                PIC S9(04)      COMP.    DTSBD972
00063                                                                   DTSBD972
00064      05  OUT-REC-DATA                    PIC  X(77).              DTSBD972
00065                                                                   DTSBD972
00066      05  OUT-REC-TRAILING-AREA REDEFINES OUT-REC-DATA.            DTSBD972
00067          10  OUT-REC-TRAILING-REC-CNT    PIC S9(09)  COMP-3.      DTSBD972
00068          10  OUT-REC-TRAILING-TOT-LEN    PIC S9(11)  COMP-3.      DTSBD972
00069          10  FILLER                      PIC  X(66).              DTSBD972
00070      EJECT                                                        DTSBD972
00071  WORKING-STORAGE SECTION.                                         DTSBD972
000715 77  PAN-VALET PICTURE X(24) VALUE '002DTSBD972  08/13/98'.       DTSBD972
00072      SKIP3                                                        DTSBD972
00073  01  WRK-AREA.                                                    DTSBD972
00074      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +972.DTSBD972
00075                                                                   DTSBD972
00076      05  ABEND-MSG                   PIC  X(60).                  DTSBD972
00077                                                                   DTSBD972
00078                                                                   DTSBD972
00079      05  IN-REC-LEN                  PIC  9(05)  COMP.            DTSBD972
00080                                                                   DTSBD972
00081      05  IN-REC-TOT-REC-CNT          PIC S9(09)  COMP-3.          DTSBD972
00082                                                                   DTSBD972
00083      05  IN-REC-TOT-LEN              PIC S9(11)  COMP-3.          DTSBD972
00084                                                                   DTSBD972
00085      05  IN-FILE-STATUS              PIC  X(02).                  DTSBD972
00086          88  IN-FILE-OK-88                   VALUE '00'.          DTSBD972
00087          88  IN-FILE-NO-REC-88               VALUE '10'.          DTSBD972
00088                                                                   DTSBD972
00089                                                                   DTSBD972
00090      05  OUT-FILE-STATUS             PIC  X(02).                  DTSBD972
00091          88  OUT-FILE-OK-88                  VALUE '00'.          DTSBD972
00092                                                                   DTSBD972
00093      05  OUT-REC-TOT-REC-CNT         PIC S9(09)  COMP-3.          DTSBD972
00094                                                                   DTSBD972
00095                                                                   DTSBD972
00096      05  WRK-START-POS               PIC S9(05)  COMP.            DTSBD972
00097      EJECT                                                        DTSBD972
00098  PROCEDURE DIVISION.                                              DTSBD972
00099      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD972
00100                                                                   DTSBD972
00101                                                                   DTSBD972
00102      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBD972
00103          UNTIL IN-FILE-NO-REC-88.                                 DTSBD972
00104                                                                   DTSBD972
00105                                                                   DTSBD972
00106      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD972
00107      SKIP2                                                        DTSBD972
00108      GOBACK.                                                      DTSBD972
00109      EJECT                                                        DTSBD972
00110  I0000-INITIATE.                                                  DTSBD972
00111      OPEN INPUT IN-FILE.                                          DTSBD972
00112                                                                   DTSBD972
00113      IF IN-FILE-OK-88                                             DTSBD972
00114          CONTINUE                                                 DTSBD972
00115      ELSE                                                         DTSBD972
00116          MOVE 'IN-FILE OPEN YIELDED UNEXPECTED STATUS CODE'       DTSBD972
00117            TO ABEND-MSG                                           DTSBD972
00118          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00119                                                                   DTSBD972
00120                                                                   DTSBD972
00121      OPEN OUTPUT OUT-FILE.                                        DTSBD972
00122                                                                   DTSBD972
00123      IF OUT-FILE-OK-88                                            DTSBD972
00124          CONTINUE                                                 DTSBD972
00125      ELSE                                                         DTSBD972
00126          MOVE 'OUT-FILE OPEN YIELDED UNEXPECTED STATUS CODE'      DTSBD972
00127            TO ABEND-MSG                                           DTSBD972
00128          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00129                                                                   DTSBD972
00130                                                                   DTSBD972
00131                                                                   DTSBD972
00132      MOVE +0 TO IN-REC-TOT-REC-CNT                                DTSBD972
00133                 IN-REC-TOT-LEN.                                   DTSBD972
00134                                                                   DTSBD972
00135      MOVE +0 TO OUT-REC-TOT-REC-CNT.                              DTSBD972
00136  I0000-EXIT.                                                      DTSBD972
00137      EXIT.                                                        DTSBD972
00138      EJECT                                                        DTSBD972
00139  P0000-PROCESS.                                                   DTSBD972
00140      READ IN-FILE.                                                DTSBD972
00141                                                                   DTSBD972
00142      IF IN-FILE-NO-REC-88                                         DTSBD972
00143          GO TO P0000-EXIT.                                        DTSBD972
00144                                                                   DTSBD972
00145      IF IN-FILE-OK-88                                             DTSBD972
00146          CONTINUE                                                 DTSBD972
00147      ELSE                                                         DTSBD972
00148          MOVE 'IN-FILE READ YIELDED UNEXPECTED STATUS CODE'       DTSBD972
00149            TO ABEND-MSG                                           DTSBD972
00150          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00151                                                                   DTSBD972
00152                                                                   DTSBD972
00153      IF (IN-REC-LEN < 1)                                          DTSBD972
00154              OR                                                   DTSBD972
00155         (IN-REC-LEN > 4092)                                       DTSBD972
00156          MOVE 'INVALID IN-REC-LEN VALUE ENCOUNTERED'              DTSBD972
00157            TO ABEND-MSG                                           DTSBD972
00158          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00159                                                                   DTSBD972
00160                                                                   DTSBD972
00161      ADD +1 TO IN-REC-TOT-REC-CNT.                                DTSBD972
00162                                                                   DTSBD972
00163      ADD IN-REC-LEN TO IN-REC-TOT-LEN.                            DTSBD972
00164                                                                   DTSBD972
00165                                                                   DTSBD972
00166      SET OUT-REC-TYPE-NEW-88 TO TRUE.                             DTSBD972
00167                                                                   DTSBD972
00168      MOVE +1 TO WRK-START-POS.                                    DTSBD972
00169                                                                   DTSBD972
00170      PERFORM P1000-OUT-REC THRU P1000-EXIT                        DTSBD972
00171          UNTIL WRK-START-POS > IN-REC-LEN.                        DTSBD972
00172  P0000-EXIT.                                                      DTSBD972
00173      EXIT.                                                        DTSBD972
00174      SKIP3                                                        DTSBD972
00175  P1000-OUT-REC.                                                   DTSBD972
00176      IF (IN-REC-LEN - WRK-START-POS + 1) > +77                    DTSBD972
00177          MOVE +77 TO OUT-REC-DATA-LEN                             DTSBD972
00178      ELSE                                                         DTSBD972
00179          COMPUTE OUT-REC-DATA-LEN                                 DTSBD972
00180            = IN-REC-LEN - WRK-START-POS + 1.                      DTSBD972
00181                                                                   DTSBD972
00182      MOVE SPACES TO OUT-REC-DATA.                                 DTSBD972
00183                                                                   DTSBD972
00184      MOVE IN-REC-MAX-LENGTH-REC                                   DTSBD972
00185            (WRK-START-POS:OUT-REC-DATA-LEN)                       DTSBD972
00186        TO OUT-REC-DATA.                                           DTSBD972
00187                                                                   DTSBD972
00188      ADD OUT-REC-DATA-LEN TO WRK-START-POS.                       DTSBD972
00189                                                                   DTSBD972
00190      PERFORM S100-WRITE-OUT-REC THRU S100-EXIT.                   DTSBD972
00191                                                                   DTSBD972
00192                                                                   DTSBD972
00193      SET OUT-REC-TYPE-CONTINUE-88 TO TRUE.                        DTSBD972
00194  P1000-EXIT.                                                      DTSBD972
00195      EXIT.                                                        DTSBD972
00196      EJECT                                                        DTSBD972
00197  T0000-TERMINATE.                                                 DTSBD972
00198      MOVE SPACES TO OUT-REC.                                      DTSBD972
00199                                                                   DTSBD972
00200      SET OUT-REC-TYPE-TRAILING-88 TO TRUE.                        DTSBD972
00201                                                                   DTSBD972
00202      MOVE +0 TO OUT-REC-DATA-LEN.                                 DTSBD972
00203                                                                   DTSBD972
00204      MOVE IN-REC-TOT-REC-CNT TO OUT-REC-TRAILING-REC-CNT.         DTSBD972
00205                                                                   DTSBD972
00206      MOVE IN-REC-TOT-LEN TO OUT-REC-TRAILING-TOT-LEN.             DTSBD972
00207                                                                   DTSBD972
00208      PERFORM S100-WRITE-OUT-REC THRU S100-EXIT.                   DTSBD972
00209                                                                   DTSBD972
00210                                                                   DTSBD972
00211      DISPLAY '***** DTSBD972 TERMINATION STATISTICS *****'.       DTSBD972
00212                                                                   DTSBD972
00213      DISPLAY ' '.                                                 DTSBD972
00214                                                                   DTSBD972
00215      DISPLAY '   IN-REC-TOT-REC-CNT: '                            DTSBD972
00216              IN-REC-TOT-REC-CNT.                                  DTSBD972
00217                                                                   DTSBD972
00218      DISPLAY '       IN-REC-TOT-LEN: '                            DTSBD972
00219              IN-REC-TOT-LEN.                                      DTSBD972
00220                                                                   DTSBD972
00221      DISPLAY '  OUT-REC-TOT-REC-CNT: '                            DTSBD972
00222              OUT-REC-TOT-REC-CNT.                                 DTSBD972
00223                                                                   DTSBD972
00224                                                                   DTSBD972
00225      CLOSE IN-FILE                                                DTSBD972
00226            OUT-FILE.                                              DTSBD972
00227                                                                   DTSBD972
00228      IF IN-FILE-OK-88                                             DTSBD972
00229          CONTINUE                                                 DTSBD972
00230      ELSE                                                         DTSBD972
00231          MOVE 'IN-FILE CLOSE YIELDED UNEXPECTED STATUS CODE'      DTSBD972
00232            TO ABEND-MSG                                           DTSBD972
00233          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00234                                                                   DTSBD972
00235      IF OUT-FILE-OK-88                                            DTSBD972
00236          CONTINUE                                                 DTSBD972
00237      ELSE                                                         DTSBD972
00238          MOVE 'OUT-FILE CLOSE YIELDED UNEXPECTED STATUS CODE'     DTSBD972
00239            TO ABEND-MSG                                           DTSBD972
00240          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00241  T0000-EXIT.                                                      DTSBD972
00242      EXIT.                                                        DTSBD972
00243      EJECT                                                        DTSBD972
00244  S100-WRITE-OUT-REC.                                              DTSBD972
00245      WRITE OUT-REC.                                               DTSBD972
00246                                                                   DTSBD972
00247      IF OUT-FILE-OK-88                                            DTSBD972
00248          CONTINUE                                                 DTSBD972
00249      ELSE                                                         DTSBD972
00250          MOVE 'OUT-FILE WRITE YIELDED UNEXPECTED STATUS CODE'     DTSBD972
00251            TO ABEND-MSG                                           DTSBD972
00252          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD972
00253                                                                   DTSBD972
00254      ADD +1 TO OUT-REC-TOT-REC-CNT.                               DTSBD972
00255  S100-EXIT.                                                       DTSBD972
00256      EXIT.                                                        DTSBD972
00257      SKIP3                                                        DTSBD972
00258  S999-ABEND.                                                      DTSBD972
00259      DISPLAY '***  DTSBD972 ABENDING.  ABEND REASON: '            DTSBD972
00260              ABEND-MSG.                                           DTSBD972
00261                                                                   DTSBD972
00262      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD972
00263  S999-EXIT.                                                       DTSBD972
00264      EXIT.                                                        DTSBD972
