00001 IDENTIFICATION DIVISION. 11/22/04 00002 PROGRAM-ID. DTSBU962. DTSBU962 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. OCTOBER 1994. DTSBU962 00005 DATE-COMPILED. DTSBU962 00006 SKIP3 DTSBU962 00007 ***** DTSBU962 00008 * DTSBU962 00009 * FUNCTION: SEQUENTIAL MASTER FILE OUTPUT. DTSBU962 00010 * DTSBU962 00011 * DTSBU962 00012 * MODIFICATION LOG: DTSBU962 00013 * DTSBU962 00014 * 10/28/94 INITIAL DEVELOPMENT. COPIED FROM MACBU962 DTSBU962 00015 * WORK ORDER: PROGRAMMER: ZL1 DTSBU962 00016 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU962 00017 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU962 00018 * REFERENCE RFP: #XXX PROGRAMMER: XXX DTSBU962 00019 * DTSBU962 00020 * DTSBU962 00021 * DESCRIPTION: DTSBU962 00022 * DTSBU962 00023 * DTSBU962 PERFORMS ALL REQUIRED SEQUENTIAL (TAPE) DTSBU962 00024 * MASTER FILE OUTPUT. DTSBU962 00025 * DTSBU962 00026 * THE "SEQUENTIAL" MASTER FILE WILL USUSALLY DTSBU962 00027 * BE THE ARCHIVED MASTER FILE. DTSBU962 00028 * DTSBU962 00029 * RECORDS RESIDING ON THE SEQUENTIAL MASTER DTSBU962 00030 * FILE ARE NOT STORED IN A COMPRESSED FORMAT. DTSBU962 00031 * WITH COMPRESSION BUILT INTO THE TAPE SUBSYSTEM, DTSBU962 00032 * COMPESSION IN THE APPLICATION WOULD BE A DTSBU962 00033 * WASTE OF CPU CYCLES. DTSBU962 00034 * DTSBU962 00035 * DTSBU962 00036 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU962 00037 * DTSBU962 00038 * OPEN UPDATE. DTSBU962 00039 * OPEN OUTPUT. DTSBU962 00040 * DTSBU962 00041 * CLOSE DTSBU962 00042 * DTSBU962 00043 * WRITE DTSBU962 00044 * DTSBU962 00045 * DTSBU962 00046 ***** DTSBU962 00047 SKIP3 DTSBU962 00048 ENVIRONMENT DIVISION. DTSBU962 00049 SKIP2 DTSBU962 00050 INPUT-OUTPUT SECTION. DTSBU962 00051 DTSBU962 00052 FILE-CONTROL. DTSBU962 00053 SELECT MST-FILE ASSIGN TO DTSFMSTO DTSBU962 00054 FILE STATUS IS FILE-STATUS. DTSBU962 00055 SKIP3 DTSBU962 00056 DATA DIVISION. DTSBU962 00057 SKIP3 DTSBU962 00058 FILE SECTION. DTSBU962 00059 SKIP3 DTSBU962 00060 FD MST-FILE DTSBU962 00061 RECORDING MODE IS V DTSBU962 00062 BLOCK CONTAINS 0 CHARACTERS DTSBU962 00063 RECORD IS VARYING DEPENDING ON MST-REC-LEN. DTSBU962 00064 DTSBU962 00065 01 FILE-REC. DTSBU962 00066 ++INCLUDE DTSIMSKL DTSBU962 00067 DTSBU962 00068 01 FILE-MIN-LENGTH-REC PIC X(21). DTSBU962 00069 DTSBU962 00070 01 FILE-MAX-LENGTH-REC PIC X(4092). DTSBU962 00071 EJECT DTSBU962 00072 WORKING-STORAGE SECTION. DTSBU962 000725 77 PAN-VALET PICTURE X(24) VALUE '005DTSBU962 11/22/04'. DTSBU962 00073 SKIP3 DTSBU962 00074 01 WRK-AREA. DTSBU962 00075 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +962.DTSBU962 00076 DTSBU962 00077 05 MST-REC-LEN PIC 9(04) COMP. DTSBU962 00078 DTSBU962 00079 05 WRK-REC-CNT PIC S9(07) COMP-3. DTSBU962 00080 DTSBU962 00081 05 FILE-STATUS PIC X(02). DTSBU962 00082 88 FILE-OK-88 VALUE '00'. DTSBU962 00083 88 FILE-NO-REC-88 VALUE '10'. DTSBU962 00084 DTSBU962 00085 05 WRK-REC-PREFIX PIC X(04). DTSBU962 00086 DTSBU962 00087 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSBU962 00088 DTSBU962 00089 05 WRK-DATA-LENGTH PIC S9(04) COMP. DTSBU962 00090 DTSBU962 00091 05 OCC-COUNT-START PIC S9(04) COMP. DTSBU962 00092 DTSBU962 00093 05 WRK-KEY-FILLER-START PIC S9(04) COMP. DTSBU962 00094 DTSBU962 00095 05 WRK-KEY-FILLER-LENGTH PIC S9(04) COMP. DTSBU962 00096 DTSBU962 00097 05 OCC-COUNT-X PIC X(02). DTSBU962 00098 05 OCC-COUNT REDEFINES OCC-COUNT-X DTSBU962 00099 PIC S9(04) COMP. DTSBU962 00100 EJECT DTSBU962 00101 01 L991-LINK-AREA. DTSBU962 00102 ++INCLUDE DTSIL991 DTSBU962 00103 EJECT DTSBU962 00104 01 MLEN-LENGTH-LITERALS. DTSBU962 00105 ++INCLUDE DTSIMLEN DTSBU962 00106 EJECT DTSBU962 00107 LINKAGE SECTION. DTSBU962 00108 SKIP3 DTSBU962 00109 01 L962-LINK-AREA. DTSBU962 00110 ++INCLUDE DTSIL962 DTSBU962 00111 EJECT DTSBU962 00112 01 LINK-REC. DTSBU962 00113 ++INCLUDE DTSIMSKL DTSBU962 00114 EJECT DTSBU962 00115 PROCEDURE DIVISION USING L962-LINK-AREA DTSBU962 00116 LINK-REC. DTSBU962 00117 DTSBU962 00118 DTSBU962 00119 IF L962-TRACE-88 DTSBU962 00120 PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT. DTSBU962 00121 DTSBU962 00122 SET L962-OK-88 TO TRUE. DTSBU962 00123 DTSBU962 00124 IF L962-WRITE-88 DTSBU962 00125 PERFORM P2300-WRITE THRU P2300-EXIT DTSBU962 00126 ELSE DTSBU962 00127 IF L962-OPEN-UPDATE-88 DTSBU962 00128 PERFORM P1100-OPEN-UPDATE THRU P1100-EXIT DTSBU962 00129 ELSE DTSBU962 00130 IF L962-CLOSE-88 DTSBU962 00131 PERFORM P1200-CLOSE THRU P1200-EXIT DTSBU962 00132 ELSE DTSBU962 00133 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00134 DTSBU962 00135 IF L962-TRACE-88 DTSBU962 00136 PERFORM S9200-POST-DISPLAY THRU S9200-EXIT. DTSBU962 00137 DTSBU962 00138 DTSBU962 00139 GOBACK. DTSBU962 00140 EJECT DTSBU962 00141 P1100-OPEN-UPDATE. DTSBU962 00142 OPEN OUTPUT MST-FILE. DTSBU962 00143 DTSBU962 00144 IF FILE-OK-88 DTSBU962 00145 NEXT SENTENCE DTSBU962 00146 ELSE DTSBU962 00147 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00148 DTSBU962 00149 MOVE +0 TO WRK-REC-CNT. DTSBU962 00150 P1100-EXIT. DTSBU962 00151 EXIT. DTSBU962 00152 SKIP3 DTSBU962 00153 P1200-CLOSE. DTSBU962 00154 CLOSE MST-FILE. DTSBU962 00155 DTSBU962 00156 IF NOT FILE-OK-88 DTSBU962 00157 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00158 DTSBU962 00159 DISPLAY '*** ' DTSBU962 00160 WRK-REC-CNT DTSBU962 00161 ' DTSFMSTO RECORDS WRITTEN'. DTSBU962 00162 P1200-EXIT. DTSBU962 00163 EXIT. DTSBU962 00164 EJECT DTSBU962 00165 P2300-WRITE. DTSBU962 00166 PERFORM S1000-LINK-TO-FILE THRU S1000-EXIT. DTSBU962 00167 DTSBU962 00168 MOVE WRK-REC-LENGTH TO MST-REC-LEN. DTSBU962 00169 DTSBU962 00170 WRITE FILE-REC. DTSBU962 00171 DTSBU962 00172 IF NOT FILE-OK-88 DTSBU962 00173 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00174 DTSBU962 00175 ADD +1 TO WRK-REC-CNT. DTSBU962 00176 P2300-EXIT. DTSBU962 00177 EXIT. DTSBU962 00178 EJECT DTSBU962 00179 S1000-LINK-TO-FILE. DTSBU962 00180 MOVE MLEN-MSKL-NONDATA-LEN TO WRK-REC-LENGTH. DTSBU962 00181 DTSBU962 00182 IF (MSKL-REC-TYPE OF LINK-REC < +1) DTSBU962 00183 OR DTSBU962 00184 (MSKL-REC-TYPE OF LINK-REC > MLEN-MAX-REC-TYPE) DTSBU962 00185 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00186 DTSBU962 00187 SET MLEN-IDX TO MSKL-REC-TYPE OF LINK-REC. DTSBU962 00188 DTSBU962 00189 IF MLEN-FILE-ID (MLEN-IDX) = +0 DTSBU962 00190 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00191 DTSBU962 00192 MOVE MLEN-FIX-LEN (MLEN-IDX) TO WRK-DATA-LENGTH. DTSBU962 00193 DTSBU962 00194 IF MLEN-OCC-MAX (MLEN-IDX) = +0 DTSBU962 00195 ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH DTSBU962 00196 PERFORM S1100-KEY-FILLER THRU S1100-EXIT DTSBU962 00197 MOVE LINK-REC (1:WRK-REC-LENGTH) DTSBU962 00198 TO FILE-REC (1:WRK-REC-LENGTH) DTSBU962 00199 GO TO S1000-EXIT. DTSBU962 00200 DTSBU962 00201 COMPUTE OCC-COUNT-START = WRK-DATA-LENGTH - 1. DTSBU962 00202 DTSBU962 00203 MOVE MSKL-DATA-AREA OF LINK-REC (OCC-COUNT-START:2) DTSBU962 00204 TO OCC-COUNT-X. DTSBU962 00205 DTSBU962 00206 IF (OCC-COUNT < +0) DTSBU962 00207 OR DTSBU962 00208 (OCC-COUNT > MLEN-OCC-MAX (MLEN-IDX)) DTSBU962 00209 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00210 DTSBU962 00211 COMPUTE WRK-DATA-LENGTH = WRK-DATA-LENGTH DTSBU962 00212 + (OCC-COUNT * MLEN-VAR-LEN (MLEN-IDX)). DTSBU962 00213 DTSBU962 00214 IF WRK-DATA-LENGTH > MLEN-MAX-MSKL-DATA-LEN DTSBU962 00215 PERFORM S999-ABEND THRU S999-EXIT. DTSBU962 00216 DTSBU962 00217 ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH. DTSBU962 00218 DTSBU962 00219 PERFORM S1100-KEY-FILLER THRU S1100-EXIT. DTSBU962 00220 DTSBU962 00221 DTSBU962 00222 MOVE LINK-REC (1:WRK-REC-LENGTH) DTSBU962 00223 TO FILE-REC (1:WRK-REC-LENGTH). DTSBU962 00224 S1000-EXIT. DTSBU962 00225 EXIT. DTSBU962 00226 SKIP3 DTSBU962 00227 S1100-KEY-FILLER. DTSBU962 00228 COMPUTE WRK-KEY-FILLER-START DTSBU962 00229 = MLEN-KEY-LEN (MLEN-IDX) + 1. DTSBU962 00230 DTSBU962 00231 COMPUTE WRK-KEY-FILLER-LENGTH DTSBU962 00232 = MLEN-MAX-KEY-LEN - MLEN-KEY-LEN (MLEN-IDX). DTSBU962 00233 DTSBU962 00234 IF WRK-KEY-FILLER-LENGTH > +0 DTSBU962 00235 MOVE LOW-VALUES DTSBU962 00236 TO MSKL-KEY-AREA OF LINK-REC DTSBU962 00237 (WRK-KEY-FILLER-START:WRK-KEY-FILLER-LENGTH). DTSBU962 00238 S1100-EXIT. DTSBU962 00239 EXIT. DTSBU962 00240 EJECT DTSBU962 00241 S9100-PRE-DISPLAY. DTSBU962 00242 DISPLAY ' '. DTSBU962 00243 DISPLAY ' '. DTSBU962 00244 DISPLAY '*** DTSBU962 PRE TRACE DISPLAY ***'. DTSBU962 00245 DISPLAY L962-MOD-NAME DTSBU962 00246 ' = L962-MOD-NAME'. DTSBU962 00247 DISPLAY L962-CMND-CD DTSBU962 00248 ' = L962-CMND-CD'. DTSBU962 00249 DTSBU962 00250 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU962 00251 S9100-EXIT. DTSBU962 00252 EXIT. DTSBU962 00253 SKIP3 DTSBU962 00254 S9200-POST-DISPLAY. DTSBU962 00255 DISPLAY ' '. DTSBU962 00256 DISPLAY '*** DTSBU962 POST TRACE DISPLAY ***'. DTSBU962 00257 DISPLAY L962-RESULT-IND DTSBU962 00258 ' = L962-RESULT-IND'. DTSBU962 00259 S9200-EXIT. DTSBU962 00260 EXIT. DTSBU962 00261 SKIP3 DTSBU962 00262 S9300-REC-DISPLAY. DTSBU962 00263 DISPLAY ' '. DTSBU962 00264 DTSBU962 00265 IF (MSKL-REC-TYPE OF LINK-REC < +1) DTSBU962 00266 OR DTSBU962 00267 (MSKL-REC-TYPE OF LINK-REC > MLEN-MAX-REC-TYPE) DTSBU962 00268 MOVE SPACES TO WRK-REC-PREFIX DTSBU962 00269 ELSE DTSBU962 00270 MOVE MLEN-PREFIX (MSKL-REC-TYPE OF LINK-REC) DTSBU962 00271 TO WRK-REC-PREFIX. DTSBU962 00272 DTSBU962 00273 IF WRK-REC-PREFIX = SPACES DTSBU962 00274 MOVE '????' TO WRK-REC-PREFIX. DTSBU962 00275 DTSBU962 00276 MOVE MLEN-MAX-KEY-LEN TO L991-REQ-CHAR-CNT. DTSBU962 00277 DTSBU962 00278 MOVE MSKL-KEY-AREA OF LINK-REC TO L991-REQ-AREA. DTSBU962 00279 DTSBU962 00280 PERFORM S991-HEX-FORMAT THRU S991-EXIT. DTSBU962 00281 DTSBU962 00282 DISPLAY 'REC TYPE = ' DTSBU962 00283 WRK-REC-PREFIX. DTSBU962 00284 DISPLAY 'KEY AREA = ' DTSBU962 00285 L991-REPLY-HEX-1-AREA. DTSBU962 00286 DISPLAY ' ' DTSBU962 00287 L991-REPLY-HEX-2-AREA. DTSBU962 00288 DISPLAY ' ' DTSBU962 00289 L991-REPLY-AN-AREA. DTSBU962 00290 S9300-EXIT. DTSBU962 00291 EXIT. DTSBU962 00292 EJECT DTSBU962 00293 S991-HEX-FORMAT. DTSBU962 00294 CALL 'DTSBU991' USING L991-LINK-AREA. DTSBU962 00295 S991-EXIT. DTSBU962 00296 EXIT. DTSBU962 00297 SKIP3 DTSBU962 00298 S999-ABEND. DTSBU962 00299 DISPLAY '*** MASTER FILE SEQUENTIAL INPUT MODULE ABENDING'. DTSBU962 00300 DISPLAY '*** CMND-CD = ' L962-CMND-CD. DTSBU962 00301 DISPLAY '*** FILE-STATUS = ' FILE-STATUS. DTSBU962 00302 DISPLAY '*** CALLING MODULE = ' L962-MOD-NAME. DTSBU962 00303 DTSBU962 00304 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU962 00305 DTSBU962 00306 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU962 00307 S999-EXIT. DTSBU962 00308 EXIT. DTSBU962