347 lines
27 KiB
COBOL
347 lines
27 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/07/99
|
|
00002 PROGRAM-ID. DTSBD995. DTSBD995
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
|
00004 DATE-WRITTEN. MARCH 1995. DTSBD995
|
|
00005 DATE-COMPILED. DTSBD995
|
|
00006 SKIP3 DTSBD995
|
|
00007 ***** DTSBD995
|
|
00008 * DTSBD995
|
|
00009 * FUNCTION: CONVERT MANUAL BEFORE LOADING IT INTO ASSIST/GT. DTSBD995
|
|
00010 * DTSBD995
|
|
00011 * DTSBD995
|
|
00012 * MODIFICATION LOG: DTSBD995
|
|
00013 * DTSBD995
|
|
00014 * 03/07/95 INITIAL DEVELOPMENT. DTSBD995
|
|
00015 * WORK ORDER: PROGRAMMER: RHC DTSBD995
|
|
00016 * DTSBD995
|
|
00017 * 07/07/1999 REVIEWED AND MODIFIED FOR DC. CL**2
|
|
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
|
00019 * CL**2
|
|
00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
|
|
00023 * DTSBD995
|
|
00024 * DTSBD995
|
|
00025 * DESCRIPTION: DTSBD995
|
|
00026 * DTSBD995
|
|
00027 * WRITE OUT ALL LINES FROM THE INPUT FILE WRAPPING AS DTSBD995
|
|
00028 * NECESSARY AT THE 65TH COLUMN, WITH THESE EXCEPTIONS: DTSBD995
|
|
00029 * DTSBD995
|
|
00030 * 1. DO NOT OUTPUT BLANK LINES APPEARING IMMEDIATELY DTSBD995
|
|
00031 * BEFORE LINES BEGINNING WITH "<NP" OR "<H" DTSBD995
|
|
00032 * DTSBD995
|
|
00033 * 2. REDUCE TWO OR MORE CONSECUTIVE LINES STARTING WITH DTSBD995
|
|
00034 * "<NP" TO ONE LINE (CONSIDERING #1 ABOVE) DTSBD995
|
|
00035 * DTSBD995
|
|
00036 * 3. DELETE LINES STARTING WITH "<NP" WHICH APPEAR DTSBD995
|
|
00037 * IMMEDIATELY BEFORE OR AFTER LINES BEGINNING WITH DTSBD995
|
|
00038 * "<H" (CONSIDERING #1 ABOVE) DTSBD995
|
|
00039 * DTSBD995
|
|
00040 * 4. DELETE LINES STARTING WITH "<W" AND "/+" DTSBD995
|
|
00041 * DTSBD995
|
|
00042 * NOTE: OUTPUT ALL OTHER LINES BEGINNING WITH "<" WITHOUT DTSBD995
|
|
00043 * PROCESSING, AS THEY CONTAIN SPECIAL CHARACTERS DTSBD995
|
|
00044 * DTSBD995
|
|
00045 * DTSBD995
|
|
00046 * SEQUENCE: DTSBD995
|
|
00047 * DTSBD995
|
|
00048 * LOAD THE BUFFER FROM THE INPUT FILE. DURING THE BUFFER DTSBD995
|
|
00049 * LOAD, OBSERVE RULES 1-4 ABOVE. DTSBD995
|
|
00050 * THE "LOAD" IS FINISHED WHEN THE BUFFER HAS A BLOCK OF DTSBD995
|
|
00051 * NON-BLANK LINES FOLLOWED BY A BLOCK OF BLANK LINES, AND DTSBD995
|
|
00052 * THERE IS A VALID NON-BLANK LINE IN THE INPUT RECORD. DTSBD995
|
|
00053 * (OR END OF INPUT FILE SOMEWHERE ALONG THE WAY.) DTSBD995
|
|
00054 * DTSBD995
|
|
00055 / DTSBD995
|
|
00056 * DO PARAGRAPH COMPRESSION FROM LINES IN THE BUFFER DTSBD995
|
|
00057 * ACCORDING TO THE DESCRIPTION. DTSBD995
|
|
00058 * WRITE PARAGRAPHS AND LINES BEGINNING WITH '<' FROM DTSBD995
|
|
00059 * THE BUFFER TO THE OUTPUT FILE. DTSBD995
|
|
00060 * DTSBD995
|
|
00061 * WRITE BLANK LINES FROM THE BUFFER TO THE OUTPUT FILE. DTSBD995
|
|
00062 * DTSBD995
|
|
00063 * REPEAT SEQUENCE UNTIL THE END OF THE INPUT FILE. DTSBD995
|
|
00064 * DTSBD995
|
|
00065 ***** DTSBD995
|
|
00066 DTSBD995
|
|
00067 ENVIRONMENT DIVISION. DTSBD995
|
|
00068 DTSBD995
|
|
00069 INPUT-OUTPUT SECTION. DTSBD995
|
|
00070 FILE-CONTROL. DTSBD995
|
|
00071 SELECT INPUT-FILE ASSIGN TO UT-S-DD1. DTSBD995
|
|
00072 SELECT OUTPUT-FILE ASSIGN TO UT-S-DD2. DTSBD995
|
|
00073 SKIP3 DTSBD995
|
|
00074 DATA DIVISION. DTSBD995
|
|
00075 FILE SECTION. DTSBD995
|
|
00076 DTSBD995
|
|
00077 FD INPUT-FILE DTSBD995
|
|
00078 RECORD 80 DTSBD995
|
|
00079 BLOCK 0 DTSBD995
|
|
00080 RECORDING MODE F. DTSBD995
|
|
00081 01 INPUT-REC. DTSBD995
|
|
00082 05 FILLER. DTSBD995
|
|
00083 88 INPUT-NEW-PAGE VALUE '<NP'. DTSBD995
|
|
00084 10 FILLER. DTSBD995
|
|
00085 88 INPUT-HDG VALUE '<H'. DTSBD995
|
|
00086 88 INPUT-BYPASS VALUE '<W' '/+'. DTSBD995
|
|
00087 15 FILLER PIC X(01). DTSBD995
|
|
00088 88 INPUT-NO-WRAP VALUE '<'. DTSBD995
|
|
00089 15 FILLER PIC X(01). DTSBD995
|
|
00090 10 FILLER PIC X(01). DTSBD995
|
|
00091 05 FILLER PIC X(77). DTSBD995
|
|
00092 SKIP3 DTSBD995
|
|
00093 FD OUTPUT-FILE DTSBD995
|
|
00094 RECORD 80 DTSBD995
|
|
00095 BLOCK 0 DTSBD995
|
|
00096 RECORDING MODE F. DTSBD995
|
|
00097 01 OUTPUT-REC PIC X(80). DTSBD995
|
|
00098 EJECT DTSBD995
|
|
00099 WORKING-STORAGE SECTION. DTSBD995
|
|
000995 77 PAN-VALET PICTURE X(24) VALUE '004DTSBD995 07/07/99'. DTSBD995
|
|
00100 SKIP3 DTSBD995
|
|
00101 01 WS-AREA. DTSBD995
|
|
00102 05 WS-ABEND-CD PIC S9(04) COMP VALUE +995. DTSBD995
|
|
00103 DTSBD995
|
|
00104 05 WS-CHAR-CNT PIC S9(04) COMP. DTSBD995
|
|
00105 05 WS-LINE-CNT PIC S9(04) COMP. DTSBD995
|
|
00106 SKIP3 DTSBD995
|
|
00107 01 INDICATORS. DTSBD995
|
|
00108 05 EOF-IND PIC X(01). DTSBD995
|
|
00109 88 EOF-YES VALUE 'Y'. DTSBD995
|
|
00110 88 EOF-NO VALUE 'N'. DTSBD995
|
|
00111 05 BLANK-LINE-IND PIC X(01). DTSBD995
|
|
00112 88 BLANK-LINE-YES VALUE 'Y'. DTSBD995
|
|
00113 88 BLANK-LINE-NO VALUE 'N'. DTSBD995
|
|
00114 88 READ-UNTIL VALUE 'R'. DTSBD995
|
|
00115 SKIP3 DTSBD995
|
|
00116 01 POINTERS. DTSBD995
|
|
00117 05 PTR-CURR PIC S9(04) COMP. DTSBD995
|
|
00118 05 PTR-MAX PIC S9(04) COMP VALUE 248. CL**4
|
|
00119 DTSBD995
|
|
00120 05 PTR-LAST-NONBLANK PIC S9(04) COMP. DTSBD995
|
|
00121 05 PTR-TAIL PIC S9(04) COMP. DTSBD995
|
|
00122 DTSBD995
|
|
00123 01 INPUT-TABLE. DTSBD995
|
|
00124 05 I-BUFFER OCCURS 248. CL**4
|
|
00125 10 I-REC. DTSBD995
|
|
00126 15 FILLER. DTSBD995
|
|
00127 88 I-NEW-PAGE VALUE '<NP'. DTSBD995
|
|
00128 20 FILLER. DTSBD995
|
|
00129 88 I-HDG VALUE '<H'. DTSBD995
|
|
00130 88 I-BYPASS VALUE '<W' '/+'. DTSBD995
|
|
00131 25 FILLER PIC X(01). DTSBD995
|
|
00132 88 I-NO-WRAP VALUE '<'. DTSBD995
|
|
00133 25 FILLER PIC X(01). DTSBD995
|
|
00134 20 FILLER PIC X(01). DTSBD995
|
|
00135 15 FILLER PIC X(62). DTSBD995
|
|
00136 15 I-LAST-15 PIC X(15). DTSBD995
|
|
00137 EJECT DTSBD995
|
|
00138 01 L090-LINK-AREA. DTSBD995
|
|
00139 ++INCLUDE DTSIL090 CL**3
|
|
00140 EJECT DTSBD995
|
|
00141 PROCEDURE DIVISION. DTSBD995
|
|
00142 DTSBD995
|
|
00143 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD995
|
|
00144 SKIP3 DTSBD995
|
|
00145 SET READ-UNTIL TO TRUE. DTSBD995
|
|
00146 PERFORM P1100-READ THRU P1100-EXIT DTSBD995
|
|
00147 UNTIL BLANK-LINE-NO DTSBD995
|
|
00148 OR EOF-YES. DTSBD995
|
|
00149 SKIP3 DTSBD995
|
|
00150 IF EOF-YES DTSBD995
|
|
00151 DISPLAY 'ABEND REASON:' DTSBD995
|
|
00152 DISPLAY 'NO USEFUL DATA IN THE INPUT FILE' DTSBD995
|
|
00153 PERFORM S999-ABEND THRU S999-EXIT. DTSBD995
|
|
00154 SKIP3 DTSBD995
|
|
00155 MOVE +0 TO PTR-CURR. DTSBD995
|
|
00156 PERFORM P0000-PROCESS THROUGH P0000-EXIT DTSBD995
|
|
00157 UNTIL EOF-YES. DTSBD995
|
|
00158 SKIP3 DTSBD995
|
|
00159 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD995
|
|
00160 SKIP3 DTSBD995
|
|
00161 GOBACK. DTSBD995
|
|
00162 SKIP3 DTSBD995
|
|
00163 I0000-INITIATE. DTSBD995
|
|
00164 DTSBD995
|
|
00165 OPEN INPUT INPUT-FILE DTSBD995
|
|
00166 OUTPUT OUTPUT-FILE. DTSBD995
|
|
00167 SET EOF-NO TO TRUE. DTSBD995
|
|
00168 DTSBD995
|
|
00169 I0000-EXIT. EXIT. DTSBD995
|
|
00170 EJECT DTSBD995
|
|
00171 P0000-PROCESS. DTSBD995
|
|
00172 DTSBD995
|
|
00173 * NOTES: AT THIS POINT, BLANK-LINE-NO IS TRUE. DTSBD995
|
|
00174 * PTR-CURR IS +0, UNLESS RULE#1 WAS BROUGHT INTO PLAY. DTSBD995
|
|
00175 DTSBD995
|
|
00176 PERFORM P1000-STORE THRU P1000-EXIT DTSBD995
|
|
00177 UNTIL BLANK-LINE-YES DTSBD995
|
|
00178 OR EOF-YES. DTSBD995
|
|
00179 MOVE PTR-CURR TO PTR-LAST-NONBLANK. DTSBD995
|
|
00180 DTSBD995
|
|
00181 PERFORM P1000-STORE THRU P1000-EXIT DTSBD995
|
|
00182 UNTIL BLANK-LINE-NO DTSBD995
|
|
00183 OR EOF-YES. DTSBD995
|
|
00184 *RULE#1 DTSBD995
|
|
00185 IF EOF-NO DTSBD995
|
|
00186 IF INPUT-NEW-PAGE DTSBD995
|
|
00187 OR INPUT-HDG DTSBD995
|
|
00188 MOVE PTR-LAST-NONBLANK TO PTR-CURR DTSBD995
|
|
00189 GO TO P0000-EXIT. DTSBD995
|
|
00190 SKIP3 DTSBD995
|
|
00191 MOVE PTR-CURR TO PTR-TAIL. DTSBD995
|
|
00192 DTSBD995
|
|
00193 MOVE +1 TO PTR-CURR. DTSBD995
|
|
00194 PERFORM P2000-WRITE THRU P2000-EXIT DTSBD995
|
|
00195 UNTIL PTR-CURR GREATER THAN PTR-LAST-NONBLANK. DTSBD995
|
|
00196 DTSBD995
|
|
00197 IF EOF-NO DTSBD995
|
|
00198 PERFORM VARYING PTR-CURR FROM PTR-CURR BY 1 DTSBD995
|
|
00199 UNTIL PTR-CURR GREATER THAN PTR-TAIL DTSBD995
|
|
00200 MOVE SPACE TO OUTPUT-REC DTSBD995
|
|
00201 WRITE OUTPUT-REC DTSBD995
|
|
00202 END-PERFORM. DTSBD995
|
|
00203 SKIP3 DTSBD995
|
|
00204 MOVE +0 TO PTR-CURR. DTSBD995
|
|
00205 DTSBD995
|
|
00206 P0000-EXIT. EXIT. DTSBD995
|
|
00207 EJECT DTSBD995
|
|
00208 P1000-STORE. DTSBD995
|
|
00209 DTSBD995
|
|
00210 *RULE#2,#3 DTSBD995
|
|
00211 IF PTR-CURR NOT = +0 DTSBD995
|
|
00212 IF INPUT-NEW-PAGE DTSBD995
|
|
00213 IF I-NEW-PAGE (PTR-CURR) DTSBD995
|
|
00214 OR I-HDG (PTR-CURR) DTSBD995
|
|
00215 PERFORM P1100-READ THRU P1100-EXIT DTSBD995
|
|
00216 GO TO P1000-EXIT. DTSBD995
|
|
00217 DTSBD995
|
|
00218 *RULE#3 DTSBD995
|
|
00219 IF PTR-CURR NOT = +0 DTSBD995
|
|
00220 IF INPUT-HDG DTSBD995
|
|
00221 IF I-NEW-PAGE (PTR-CURR) DTSBD995
|
|
00222 MOVE INPUT-REC TO I-BUFFER (PTR-CURR) DTSBD995
|
|
00223 PERFORM P1100-READ THRU P1100-EXIT DTSBD995
|
|
00224 GO TO P1000-EXIT. DTSBD995
|
|
00225 DTSBD995
|
|
00226 *RULE#4 DTSBD995
|
|
00227 IF INPUT-BYPASS DTSBD995
|
|
00228 PERFORM P1100-READ THRU P1100-EXIT DTSBD995
|
|
00229 GO TO P1000-EXIT. DTSBD995
|
|
00230 SKIP3 DTSBD995
|
|
00231 IF PTR-CURR = PTR-MAX DTSBD995
|
|
00232 DISPLAY 'ABEND REASON:' DTSBD995
|
|
00233 DISPLAY 'MORE ENTRIES THAN WILL FIT IN THE INPUT TABLE.' DTSBD995
|
|
00234 PERFORM S999-ABEND THRU S999-EXIT. DTSBD995
|
|
00235 DTSBD995
|
|
00236 ADD +1 TO PTR-CURR DTSBD995
|
|
00237 MOVE INPUT-REC TO I-BUFFER (PTR-CURR). DTSBD995
|
|
00238 PERFORM P1100-READ THRU P1100-EXIT. DTSBD995
|
|
00239 DTSBD995
|
|
00240 P1000-EXIT. EXIT. DTSBD995
|
|
00241 SKIP3 DTSBD995
|
|
00242 P1100-READ. DTSBD995
|
|
00243 DTSBD995
|
|
00244 READ INPUT-FILE DTSBD995
|
|
00245 AT END DTSBD995
|
|
00246 SET EOF-YES TO TRUE. DTSBD995
|
|
00247 DTSBD995
|
|
00248 IF INPUT-REC = SPACE DTSBD995
|
|
00249 SET BLANK-LINE-YES TO TRUE DTSBD995
|
|
00250 ELSE DTSBD995
|
|
00251 IF INPUT-BYPASS DTSBD995
|
|
00252 SET READ-UNTIL TO TRUE DTSBD995
|
|
00253 ELSE DTSBD995
|
|
00254 SET BLANK-LINE-NO TO TRUE. DTSBD995
|
|
00255 DTSBD995
|
|
00256 P1100-EXIT. EXIT. DTSBD995
|
|
00257 EJECT DTSBD995
|
|
00258 P2000-WRITE. DTSBD995
|
|
00259 DTSBD995
|
|
00260 IF I-NO-WRAP (PTR-CURR) DTSBD995
|
|
00261 WRITE OUTPUT-REC FROM I-REC (PTR-CURR) DTSBD995
|
|
00262 ADD +1 TO PTR-CURR DTSBD995
|
|
00263 GO TO P2000-EXIT. DTSBD995
|
|
00264 SKIP3 DTSBD995
|
|
00265 MOVE +0 TO L090-INDENT. DTSBD995
|
|
00266 DTSBD995
|
|
00267 *THE FIRST TWO CASES ARE SINGLE LINES IN THE INPUT FILE. DTSBD995
|
|
00268 *THE THIRD CASE IS FOR MULTIPLE LINES IN THE INPUT FILE. DTSBD995
|
|
00269 IF I-LAST-15 (PTR-CURR) = SPACE DTSBD995
|
|
00270 WRITE OUTPUT-REC FROM I-REC (PTR-CURR) DTSBD995
|
|
00271 ADD +1 TO PTR-CURR DTSBD995
|
|
00272 GO TO P2000-EXIT DTSBD995
|
|
00273 DTSBD995
|
|
00274 ELSE DTSBD995
|
|
00275 IF PTR-CURR = PTR-LAST-NONBLANK DTSBD995
|
|
00276 OR I-NO-WRAP (PTR-CURR + 1) DTSBD995
|
|
00277 INSPECT I-REC (PTR-CURR) DTSBD995
|
|
00278 TALLYING L090-INDENT FOR LEADING SPACES DTSBD995
|
|
00279 IF I-REC (PTR-CURR) (L090-INDENT + 4:2) = SPACES DTSBD995
|
|
00280 ADD +5 TO L090-INDENT DTSBD995
|
|
00281 END-IF DTSBD995
|
|
00282 DTSBD995
|
|
00283 ELSE DTSBD995
|
|
00284 INSPECT I-REC (PTR-CURR + 1) DTSBD995
|
|
00285 TALLYING L090-INDENT FOR LEADING SPACES. DTSBD995
|
|
00286 SKIP3 DTSBD995
|
|
00287 MOVE +1 TO L090-PHRASE-CNT. DTSBD995
|
|
00288 MOVE I-REC (PTR-CURR) (1:) TO L090-PHRASE-TABLE (1). DTSBD995
|
|
00289 ADD +1 TO PTR-CURR. DTSBD995
|
|
00290 DTSBD995
|
|
00291 PERFORM P2100-LOAD-PHRASE-TABLE THRU P2100-EXIT DTSBD995
|
|
00292 VARYING PTR-CURR FROM PTR-CURR BY 1 DTSBD995
|
|
00293 UNTIL I-NO-WRAP (PTR-CURR) DTSBD995
|
|
00294 OR PTR-CURR > PTR-LAST-NONBLANK. DTSBD995
|
|
00295 DTSBD995
|
|
00296 PERFORM S090-RAP-WRAP THRU S090-EXIT. DTSBD995
|
|
00297 DTSBD995
|
|
00298 PERFORM VARYING WS-LINE-CNT FROM 1 BY 1 DTSBD995
|
|
00299 UNTIL WS-LINE-CNT > L090-PARAGRAPH-LINE-CNT DTSBD995
|
|
00300 WRITE OUTPUT-REC FROM L090-PARAGRAPH-LINE (WS-LINE-CNT) DTSBD995
|
|
00301 END-PERFORM. DTSBD995
|
|
00302 DTSBD995
|
|
00303 P2000-EXIT. EXIT. DTSBD995
|
|
00304 EJECT DTSBD995
|
|
00305 P2100-LOAD-PHRASE-TABLE. DTSBD995
|
|
00306 DTSBD995
|
|
00307 MOVE +0 TO WS-CHAR-CNT. DTSBD995
|
|
00308 INSPECT I-REC (PTR-CURR) DTSBD995
|
|
00309 TALLYING WS-CHAR-CNT FOR LEADING SPACES. DTSBD995
|
|
00310 DTSBD995
|
|
00311 ADD +1 TO L090-PHRASE-CNT. DTSBD995
|
|
00312 DTSBD995
|
|
00313 MOVE I-REC (PTR-CURR) (WS-CHAR-CNT + 1: ) DTSBD995
|
|
00314 TO L090-PHRASE-TABLE (L090-PHRASE-CNT). DTSBD995
|
|
00315 DTSBD995
|
|
00316 P2100-EXIT. EXIT. DTSBD995
|
|
00317 EJECT DTSBD995
|
|
00318 S090-RAP-WRAP. DTSBD995
|
|
00319 DTSBD995
|
|
00320 MOVE +65 TO L090-DESIRED-LINE-LIMIT. DTSBD995
|
|
00321 SET L090-NO-SPECIAL-CHAR-88 TO TRUE. DTSBD995
|
|
00322 DTSBD995
|
|
00323 CALL 'DTSBU090' USING L090-LINK-AREA. CL**2
|
|
00324 DTSBD995
|
|
00325 IF L090-UNSUCCESSFUL-88 DTSBD995
|
|
00326 DISPLAY 'ABEND REASON:' DTSBD995
|
|
00327 DISPLAY 'RETURN-CODE SHOWED FAILURE OF DTSBU090' CL**2
|
|
00328 PERFORM S999-ABEND THRU S999-EXIT. DTSBD995
|
|
00329 DTSBD995
|
|
00330 S090-EXIT. EXIT. DTSBD995
|
|
00331 SKIP3 DTSBD995
|
|
00332 S999-ABEND. DTSBD995
|
|
00333 DTSBD995
|
|
00334 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD995
|
|
00335 CALL 'DTSBU999' USING WS-ABEND-CD. CL**2
|
|
00336 DTSBD995
|
|
00337 S999-EXIT. EXIT. DTSBD995
|
|
00338 SKIP3 DTSBD995
|
|
00339 SKIP3 DTSBD995
|
|
00340 T0000-TERMINATE. DTSBD995
|
|
00341 DTSBD995
|
|
00342 CLOSE INPUT-FILE DTSBD995
|
|
00343 OUTPUT-FILE. DTSBD995
|
|
00344 DTSBD995
|
|
00345 T0000-EXIT. EXIT. DTSBD995
|