00001 IDENTIFICATION DIVISION. 08/11/98 00002 PROGRAM-ID. DTSCU829. DTSCU829 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. APRIL 1994. DTSCU829 00005 DATE-COMPILED. DTSCU829 00006 SKIP3 DTSCU829 00007 ***** DTSCU829 00008 * DTSCU829 00009 * FUNCTION: TEMPORARY STORAGE INPUT/OUTPUT. DTSCU829 00010 * DTSCU829 00011 * DTSCU829 00012 * MODIFICATION LOG: DTSCU829 00013 * DTSCU829 00014 * 04/04/94 INITIAL DEVELOPMENT. DTSCU829 00015 * WORK ORDER: PROGRAMMER: EHH DTSCU829 00016 * DTSCU829 00017 * 08/11/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 * DTSCU829 00024 * DTSCU829 00025 * DESCRIPTION: DTSCU829 00026 * DTSCU829 00027 * DTSCU829 PERFORMS ALL REQUIRED TEMPORARY STORAGE CL**2 00028 * INPUT/OUTPUT. DTSCU829'S COMMAREA CONSISTS OF CL**2 00029 * DTSIL829, FOLLOWED BY A TEMPORARY STORAGE RECORD CL**2 00030 * AREA. DTSCU829 00031 * DTSCU829 00032 * DTSCU829 00033 * DTSCU829 00034 ***** DTSCU829 00035 SKIP3 DTSCU829 00036 ENVIRONMENT DIVISION. DTSCU829 00037 SKIP3 DTSCU829 00038 DATA DIVISION. DTSCU829 00039 SKIP3 DTSCU829 00040 WORKING-STORAGE SECTION. DTSCU829 000405 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU829 08/11/98'. DTSCU829 00041 SKIP3 DTSCU829 00042 01 WRK-AREA. DTSCU829 00043 05 WRK-ABEND-CD PIC X(04) VALUE 'U829'. DTSCU829 00044 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU829 00045 CL**2 00046 05 MAX-REC-LENGTH PIC S9(04) COMP VALUE +4089.DTSCU829 00047 EJECT DTSCU829 00048 LINKAGE SECTION. DTSCU829 00049 SKIP3 DTSCU829 00050 01 DFHCOMMAREA. DTSCU829 00051 05 L829-CONTROL-BLOCK. DTSCU829 00052 ++INCLUDE DTSIL829 CL**5 00053 SKIP3 DTSCU829 00054 05 L829-REC PIC X(4089). DTSCU829 00055 EJECT DTSCU829 00056 PROCEDURE DIVISION. DTSCU829 00057 SKIP2 DTSCU829 00058 SET L829-OK-88 TO TRUE. DTSCU829 00059 CL**2 00060 IF L829-READ-ITEM-88 DTSCU829 00061 PERFORM P1100-READ-ITEM THRU P1100-EXIT DTSCU829 00062 ELSE DTSCU829 00063 IF L829-READ-NEXT-88 DTSCU829 00064 PERFORM P1200-READ-NEXT THRU P1200-EXIT DTSCU829 00065 ELSE DTSCU829 00066 IF L829-WRITE-88 DTSCU829 00067 PERFORM P2100-WRITE THRU P2100-EXIT DTSCU829 00068 ELSE DTSCU829 00069 IF L829-REWRITE-88 DTSCU829 00070 PERFORM P2200-REWRITE THRU P2200-EXIT DTSCU829 00071 ELSE DTSCU829 00072 IF L829-DELETE-QUEUE-88 DTSCU829 00073 PERFORM P2300-DELETE-QUEUE THRU P2300-EXIT DTSCU829 00074 ELSE DTSCU829 00075 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00076 SKIP2 DTSCU829 00077 EXEC CICS DTSCU829 00078 RETURN DTSCU829 00079 END-EXEC. DTSCU829 00080 SKIP2 DTSCU829 00081 GOBACK. DTSCU829 00082 EJECT DTSCU829 00083 P1100-READ-ITEM. DTSCU829 00084 IF (L829-REC-LENGTH < +1) DTSCU829 00085 OR DTSCU829 00086 (L829-REC-LENGTH > MAX-REC-LENGTH) DTSCU829 00087 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00088 CL**2 00089 EXEC CICS DTSCU829 00090 READQ TS DTSCU829 00091 QUEUE (L829-QUEUE-NAME) DTSCU829 00092 INTO (L829-REC) DTSCU829 00093 LENGTH (L829-REC-LENGTH) DTSCU829 00094 ITEM (L829-ITEM-NO) DTSCU829 00095 RESP (WRK-RESP-CD) DTSCU829 00096 END-EXEC. DTSCU829 00097 CL**2 00098 IF WRK-RESP-CD = DFHRESP (ITEMERR) DTSCU829 00099 PERFORM S1100-ITEMERR THRU S1100-EXIT DTSCU829 00100 ELSE DTSCU829 00101 IF WRK-RESP-CD = DFHRESP (QIDERR) DTSCU829 00102 PERFORM S1200-QIDERR THRU S1200-EXIT DTSCU829 00103 ELSE DTSCU829 00104 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU829 00105 NEXT SENTENCE DTSCU829 00106 ELSE DTSCU829 00107 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00108 P1100-EXIT. DTSCU829 00109 EXIT. DTSCU829 00110 EJECT DTSCU829 00111 P1200-READ-NEXT. DTSCU829 00112 IF (L829-REC-LENGTH < +1) DTSCU829 00113 OR DTSCU829 00114 (L829-REC-LENGTH > MAX-REC-LENGTH) DTSCU829 00115 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00116 CL**2 00117 EXEC CICS DTSCU829 00118 READQ TS DTSCU829 00119 QUEUE (L829-QUEUE-NAME) DTSCU829 00120 INTO (L829-REC) DTSCU829 00121 LENGTH (L829-REC-LENGTH) DTSCU829 00122 NEXT DTSCU829 00123 RESP (WRK-RESP-CD) DTSCU829 00124 END-EXEC. DTSCU829 00125 CL**2 00126 IF WRK-RESP-CD = DFHRESP (ITEMERR) DTSCU829 00127 PERFORM S1100-ITEMERR THRU S1100-EXIT DTSCU829 00128 ELSE DTSCU829 00129 IF WRK-RESP-CD = DFHRESP (QIDERR) DTSCU829 00130 PERFORM S1200-QIDERR THRU S1200-EXIT DTSCU829 00131 ELSE DTSCU829 00132 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU829 00133 NEXT SENTENCE DTSCU829 00134 ELSE DTSCU829 00135 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00136 P1200-EXIT. DTSCU829 00137 EXIT. DTSCU829 00138 EJECT DTSCU829 00139 P2100-WRITE. DTSCU829 00140 IF (L829-REC-LENGTH < +1) DTSCU829 00141 OR DTSCU829 00142 (L829-REC-LENGTH > MAX-REC-LENGTH) DTSCU829 00143 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00144 CL**2 00145 IF L829-AUXILIARY-STORAGE-88 DTSCU829 00146 CL**2 00147 EXEC CICS DTSCU829 00148 WRITEQ TS DTSCU829 00149 QUEUE (L829-QUEUE-NAME) DTSCU829 00150 FROM (L829-REC) DTSCU829 00151 LENGTH (L829-REC-LENGTH) DTSCU829 00152 AUXILIARY DTSCU829 00153 RESP (WRK-RESP-CD) DTSCU829 00154 END-EXEC DTSCU829 00155 CL**2 00156 ELSE DTSCU829 00157 IF L829-DEFAULT-STORAGE-88 OR L829-MAIN-STORAGE-88 DTSCU829 00158 CL**2 00159 EXEC CICS DTSCU829 00160 WRITEQ TS DTSCU829 00161 QUEUE (L829-QUEUE-NAME) DTSCU829 00162 FROM (L829-REC) DTSCU829 00163 LENGTH (L829-REC-LENGTH) DTSCU829 00164 MAIN DTSCU829 00165 RESP (WRK-RESP-CD) DTSCU829 00166 END-EXEC DTSCU829 00167 CL**2 00168 ELSE DTSCU829 00169 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00170 CL**2 00171 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU829 00172 NEXT SENTENCE DTSCU829 00173 ELSE DTSCU829 00174 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00175 P2100-EXIT. DTSCU829 00176 EXIT. DTSCU829 00177 EJECT DTSCU829 00178 P2200-REWRITE. DTSCU829 00179 IF (L829-REC-LENGTH < +1) DTSCU829 00180 OR DTSCU829 00181 (L829-REC-LENGTH > MAX-REC-LENGTH) DTSCU829 00182 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00183 CL**2 00184 IF L829-AUXILIARY-STORAGE-88 DTSCU829 00185 CL**2 00186 EXEC CICS DTSCU829 00187 WRITEQ TS DTSCU829 00188 QUEUE (L829-QUEUE-NAME) DTSCU829 00189 REWRITE ITEM (L829-ITEM-NO) DTSCU829 00190 FROM (L829-REC) DTSCU829 00191 LENGTH (L829-REC-LENGTH) DTSCU829 00192 AUXILIARY DTSCU829 00193 RESP (WRK-RESP-CD) DTSCU829 00194 END-EXEC DTSCU829 00195 CL**2 00196 ELSE DTSCU829 00197 IF L829-DEFAULT-STORAGE-88 OR L829-MAIN-STORAGE-88 DTSCU829 00198 CL**2 00199 EXEC CICS DTSCU829 00200 WRITEQ TS DTSCU829 00201 QUEUE (L829-QUEUE-NAME) DTSCU829 00202 REWRITE ITEM (L829-ITEM-NO) DTSCU829 00203 FROM (L829-REC) DTSCU829 00204 LENGTH (L829-REC-LENGTH) DTSCU829 00205 MAIN DTSCU829 00206 RESP (WRK-RESP-CD) DTSCU829 00207 END-EXEC DTSCU829 00208 CL**2 00209 ELSE DTSCU829 00210 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00211 CL**2 00212 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU829 00213 NEXT SENTENCE DTSCU829 00214 ELSE DTSCU829 00215 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00216 P2200-EXIT. DTSCU829 00217 EXIT. DTSCU829 00218 EJECT DTSCU829 00219 P2300-DELETE-QUEUE. DTSCU829 00220 EXEC CICS DTSCU829 00221 DELETEQ TS DTSCU829 00222 QUEUE (L829-QUEUE-NAME) DTSCU829 00223 RESP (WRK-RESP-CD) DTSCU829 00224 END-EXEC. DTSCU829 00225 CL**2 00226 IF WRK-RESP-CD = DFHRESP (QIDERR) DTSCU829 00227 PERFORM S1200-QIDERR THRU S1200-EXIT DTSCU829 00228 ELSE DTSCU829 00229 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU829 00230 NEXT SENTENCE DTSCU829 00231 ELSE DTSCU829 00232 PERFORM S899-ABEND THRU S899-EXIT. DTSCU829 00233 P2300-EXIT. DTSCU829 00234 EXIT. DTSCU829 00235 EJECT DTSCU829 00236 S1100-ITEMERR. DTSCU829 00237 SET L829-ITEMERR-88 TO TRUE. DTSCU829 00238 S1100-EXIT. DTSCU829 00239 EXIT. DTSCU829 00240 SKIP3 DTSCU829 00241 S1200-QIDERR. DTSCU829 00242 SET L829-QIDERR-88 TO TRUE. DTSCU829 00243 S1200-EXIT. DTSCU829 00244 EXIT. DTSCU829 00245 EJECT DTSCU829 00246 S899-ABEND. DTSCU829 00247 CL**2 00248 EXEC CICS DTSCU829 00249 ABEND DTSCU829 00250 ABCODE (WRK-ABEND-CD) DTSCU829 00251 END-EXEC. DTSCU829 00252 CL**2 00253 S899-EXIT. DTSCU829 00254 EXIT. DTSCU829