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