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