266 lines
21 KiB
COBOL
266 lines
21 KiB
COBOL
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
|