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