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