00001 IDENTIFICATION DIVISION. 09/30/98 00002 PROGRAM-ID. DTSBU941. DTSBU941 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. FEBRUARY 1992. DTSBU941 00005 DATE-COMPILED. DTSBU941 00006 SKIP3 DTSBU941 00007 ***** DTSBU941 00008 * DTSBU941 00009 * FUNCTION: VARIABLE LENGTH RECORD INPUT 1. DTSBU941 00010 * DTSBU941 00011 * DTSBU941 00012 * MODIFICATION LOG: DTSBU941 00013 * DTSBU941 00014 * 02/13/92 INITIAL DEVELOPMENT. DTSBU941 00015 * WORK ORDER: PROGRAMMER: TCL DTSBU941 00016 * DTSBU941 00017 * 09/30/1998 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 * DTSBU941 00024 * DTSBU941 00025 * DESCRIPTION: DTSBU941 00026 * DTSBU941 00027 * DTSBU941 PERFORMS ALL REQUIRED VARIABLE LENGTH RECORD CL**2 00028 * INPUT. DTSBU941 00029 * DTSBU941 00030 * DTSBU941 00031 * GENERAL SPECIFICATIONS: DTSBU941 00032 * DTSBU941 00033 * INVENTED TO ADD FLEXIBILITY TO THE VARIABLE LENGTH DTSBU941 00034 * RECORD (REPORT AND TRANSACTION) FILES. IT IS NOT DTSBU941 00035 * CLEAR WHETHER QSAM OR A VSAM ESDS IS THE DTSBU941 00036 * WAY TO GO. BY PUTTING THE READ IN A MODULE, IT WILL DTSBU941 00037 * BE EASY TO SWITCH TECHNIQUES AT A FUTURE TIME. DTSBU941 00038 * DTSBU941 00039 * DTSBU941 00040 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU941 00041 * DTSBU941 00042 * OPEN-READ DTSBU941 00043 * OPEN INPUT. DTSBU941 00044 * DTSBU941 00045 * CLOSE DTSBU941 00046 * DTSBU941 00047 * READ NEXT DTSBU941 00048 * DTSBU941 00049 * IF RSK1-REC-TYPE = '000' OR SPACES OR LOW-VALUES DTSBU941 00050 * BYPASS THE RECORD. DTSBU941 00051 * DTSBU941 00052 * IF RVAR-LENGTH OF FILE-REC < RLEN-MIN-LENGTH DTSBU941 00053 * OR DTSBU941 00054 * RVAR-LENGTH OF FILE-REC > RLEN-MAX-LENGTH DTSBU941 00055 * ABEND PROCESSING. DTSBU941 00056 * DTSBU941 00057 * VAR-CHAR-CNT MUST BE SET BEFORE THE MOVE FROM DTSBU941 00058 * FILE-REC TO LINK-REC. DTSBU941 00059 * DTSBU941 00060 * VAR-CHAR-CNT = RVAR-LENGTH OF FILE-REC - 2. DTSBU941 00061 * DTSBU941 00062 ***** DTSBU941 00063 SKIP3 DTSBU941 00064 ENVIRONMENT DIVISION. DTSBU941 00065 SKIP2 DTSBU941 00066 INPUT-OUTPUT SECTION. DTSBU941 00067 CL**2 00068 FILE-CONTROL. DTSBU941 00069 SELECT VAR-FILE ASSIGN TO DTSFVRI1 CL**2 00070 FILE STATUS IS FILE-STATUS. DTSBU941 00071 SKIP3 DTSBU941 00072 DATA DIVISION. DTSBU941 00073 SKIP3 DTSBU941 00074 FILE SECTION. DTSBU941 00075 SKIP3 DTSBU941 00076 FD VAR-FILE DTSBU941 00077 RECORDING MODE IS V DTSBU941 00078 BLOCK CONTAINS 0 RECORDS. DTSBU941 00079 CL**2 00080 01 FILE-REC. DTSBU941 00081 ++INCLUDE DTSIRVAR CL**2 00082 SKIP3 DTSBU941 00083 01 RSK1-REC. DTSBU941 00084 ++INCLUDE DTSIRSK1 CL**2 00085 EJECT DTSBU941 00086 WORKING-STORAGE SECTION. DTSBU941 000865 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU941 09/30/98'. DTSBU941 00087 SKIP3 DTSBU941 00088 01 WRK-AREA. DTSBU941 00089 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +941.DTSBU941 00090 CL**2 00091 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBU941 00092 CL**2 00093 05 WRK-REC-CNT PIC S9(07) COMP-3. DTSBU941 00094 CL**2 00095 05 FILE-STATUS PIC X(02). DTSBU941 00096 88 FILE-OK-88 VALUE '00'. DTSBU941 00097 88 FILE-NO-REC-88 VALUE '10'. DTSBU941 00098 ***** 88 FILE-VERIFY-88 VALUE '97'. DTSBU941 00099 EJECT DTSBU941 00100 01 RLEN-LENGTH-LITERALS. DTSBU941 00101 ++INCLUDE DTSIRLEN CL**2 00102 EJECT DTSBU941 00103 LINKAGE SECTION. DTSBU941 00104 SKIP3 DTSBU941 00105 01 L941-LINK-AREA. DTSBU941 00106 ++INCLUDE DTSIL941 CL**2 00107 EJECT DTSBU941 00108 01 LINK-REC. DTSBU941 00109 ++INCLUDE DTSIRVAR CL**2 00110 EJECT DTSBU941 00111 PROCEDURE DIVISION USING L941-LINK-AREA DTSBU941 00112 LINK-REC. DTSBU941 00113 CL**2 00114 CL**2 00115 IF L941-TRACE-88 DTSBU941 00116 PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT. DTSBU941 00117 CL**2 00118 SET L941-OK-88 TO TRUE. DTSBU941 00119 CL**2 00120 IF L941-READ-NEXT-88 DTSBU941 00121 PERFORM P2300-READ-NEXT THRU P2300-EXIT DTSBU941 00122 ELSE DTSBU941 00123 IF L941-OPEN-READ-88 DTSBU941 00124 PERFORM P1100-OPEN-READ THRU P1100-EXIT DTSBU941 00125 ELSE DTSBU941 00126 IF L941-CLOSE-88 DTSBU941 00127 PERFORM P1200-CLOSE THRU P1200-EXIT DTSBU941 00128 ELSE DTSBU941 00129 PERFORM S999-ABEND THRU S999-EXIT. DTSBU941 00130 CL**2 00131 IF L941-TRACE-88 DTSBU941 00132 PERFORM S9200-POST-DISPLAY THRU S9200-EXIT. DTSBU941 00133 CL**2 00134 CL**2 00135 GOBACK. DTSBU941 00136 EJECT DTSBU941 00137 P1100-OPEN-READ. DTSBU941 00138 OPEN INPUT VAR-FILE. DTSBU941 00139 CL**2 00140 IF FILE-OK-88 DTSBU941 00141 NEXT SENTENCE DTSBU941 00142 ELSE DTSBU941 00143 PERFORM S999-ABEND THRU S999-EXIT. DTSBU941 00144 CL**2 00145 MOVE +0 TO WRK-REC-CNT. DTSBU941 00146 P1100-EXIT. DTSBU941 00147 EXIT. DTSBU941 00148 SKIP3 DTSBU941 00149 P1200-CLOSE. DTSBU941 00150 CLOSE VAR-FILE. DTSBU941 00151 CL**2 00152 IF NOT FILE-OK-88 DTSBU941 00153 PERFORM S999-ABEND THRU S999-EXIT. DTSBU941 00154 CL**2 00155 DISPLAY '*** ' DTSBU941 00156 WRK-REC-CNT DTSBU941 00157 ' DTSFVRII NON DUMMY RECORDS READ'. CL**2 00158 P1200-EXIT. DTSBU941 00159 EXIT. DTSBU941 00160 EJECT DTSBU941 00161 P2300-READ-NEXT. DTSBU941 00162 READ VAR-FILE. DTSBU941 00163 CL**2 00164 IF FILE-NO-REC-88 DTSBU941 00165 SET L941-NO-REC-88 TO TRUE DTSBU941 00166 GO TO P2300-EXIT. DTSBU941 00167 CL**2 00168 IF NOT FILE-OK-88 DTSBU941 00169 PERFORM S999-ABEND THRU S999-EXIT. DTSBU941 00170 CL**2 00171 IF (RSK1-LENGTH < RLEN-MIN-LENGTH) DTSBU941 00172 OR DTSBU941 00173 (RSK1-LENGTH > RLEN-MAX-LENGTH) DTSBU941 00174 PERFORM S999-ABEND THRU S999-EXIT. DTSBU941 00175 CL**2 00176 IF RSK1-REC-TYPE = '000' OR SPACES OR LOW-VALUES DTSBU941 00177 GO TO P2300-READ-NEXT. DTSBU941 00178 CL**2 00179 ADD +1 TO WRK-REC-CNT. DTSBU941 00180 CL**2 00181 COMPUTE VAR-CHAR-CNT = RVAR-LENGTH OF FILE-REC - 2. DTSBU941 00182 CL**2 00183 MOVE FILE-REC TO LINK-REC. DTSBU941 00184 P2300-EXIT. DTSBU941 00185 EXIT. DTSBU941 00186 EJECT DTSBU941 00187 S9100-PRE-DISPLAY. DTSBU941 00188 DISPLAY ' '. DTSBU941 00189 CL**2 00190 DISPLAY ' '. DTSBU941 00191 CL**2 00192 DISPLAY '*** DTSBU941 PRE TRACE DISPLAY ***'. CL**2 00193 CL**2 00194 DISPLAY L941-MOD-NAME DTSBU941 00195 ' = L941-MOD-NAME'. DTSBU941 00196 CL**2 00197 DISPLAY L941-CMND-CD DTSBU941 00198 ' = L941-CMND-CD'. DTSBU941 00199 S9100-EXIT. DTSBU941 00200 EXIT. DTSBU941 00201 SKIP3 DTSBU941 00202 S9200-POST-DISPLAY. DTSBU941 00203 DISPLAY ' '. DTSBU941 00204 CL**2 00205 DISPLAY '*** DTSBU941 POST TRACE DISPLAY ***'. CL**2 00206 CL**2 00207 DISPLAY L941-RESULT-IND DTSBU941 00208 ' = L941-RESULT-IND'. DTSBU941 00209 CL**2 00210 DISPLAY RVAR-LENGTH OF LINK-REC DTSBU941 00211 ' = RVAR-LENGTH OF LINK-REC'. DTSBU941 00212 CL**2 00213 DISPLAY RVAR-CHAR OF LINK-REC (1) DTSBU941 00214 RVAR-CHAR OF LINK-REC (2) DTSBU941 00215 RVAR-CHAR OF LINK-REC (3) DTSBU941 00216 ' = REC-TYPE OF LINK-REC'. DTSBU941 00217 S9200-EXIT. DTSBU941 00218 EXIT. DTSBU941 00219 EJECT DTSBU941 00220 S999-ABEND. DTSBU941 00221 DISPLAY '*** I/O MODULE ABENDING'. DTSBU941 00222 CL**2 00223 DISPLAY '*** CMND-CD = ' L941-CMND-CD. DTSBU941 00224 CL**2 00225 DISPLAY '*** FILE-STATUS = ' FILE-STATUS. DTSBU941 00226 CL**2 00227 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00228 S999-EXIT. DTSBU941 00229 EXIT. DTSBU941