DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
477
CICS/DTSCU827.cob
Normal file
477
CICS/DTSCU827.cob
Normal file
@ -0,0 +1,477 @@
|
||||
00001 IDENTIFICATION DIVISION. 09/30/98
|
||||
00002 PROGRAM-ID. DTSCU827. DTSCU827
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
||||
00004 DATE-WRITTEN. APRIL 1994. DTSCU827
|
||||
00005 DATE-COMPILED. DTSCU827
|
||||
00006 SKIP3 DTSCU827
|
||||
00007 ***** DTSCU827
|
||||
00008 * DTSCU827
|
||||
00009 * FUNCTION: VSAM KSDS WORK FILE INPUT/OUTPUT. DTSCU827
|
||||
00010 * DTSCU827
|
||||
00011 * DTSCU827
|
||||
00012 * MODIFICATION LOG: DTSCU827
|
||||
00013 * DTSCU827
|
||||
00014 * 04/12/94 INITIAL DEVELOPMENT. DTSCU827
|
||||
00015 * WORK ORDER: PROGRAMMER: RHC DTSCU827
|
||||
00016 * DTSCU827
|
||||
00017 * 09/29/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 * DTSCU827
|
||||
00024 * DTSCU827
|
||||
00025 * DESCRIPTION: DTSCU827
|
||||
00026 * DTSCU827
|
||||
00027 * DTSCU827 PERFORMS ALL REQUIRED VSAM WORK FILE CL**2
|
||||
00028 * INPUT/OUTPUT. DTSCU827'S COMMAREA CONSISTS OF CL**2
|
||||
00029 * DTSIL827, FOLLOWED BY DTSIVSKL. SEE DFHCOMMAREA CL**2
|
||||
00030 * OF THIS MODULE FOR AN EXAMPLE. DTSCU827
|
||||
00031 * DTSCU827
|
||||
00032 ***** DTSCU827
|
||||
00033 SKIP3 DTSCU827
|
||||
00034 ENVIRONMENT DIVISION. DTSCU827
|
||||
00035 SKIP3 DTSCU827
|
||||
00036 DATA DIVISION. DTSCU827
|
||||
00037 SKIP3 DTSCU827
|
||||
00038 WORKING-STORAGE SECTION. DTSCU827
|
||||
000385 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU827 09/30/98'. DTSCU827
|
||||
00039 SKIP3 DTSCU827
|
||||
00040 01 WRK-AREA. DTSCU827
|
||||
00041 05 WRK-ABEND-CD PIC X(04) VALUE 'U827'. DTSCU827
|
||||
00042 CL**2
|
||||
00043 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU827
|
||||
00044 CL**2
|
||||
00045 *****05 WRK-TEST-FILE-NAME PIC X(08) VALUE 'DTSFWRK'. CL**2
|
||||
00046 CL**2
|
||||
00047 *****05 WRK-TCL-FILE-NAME PIC X(08) VALUE 'DTSTWRK'. CL**2
|
||||
00048 CL**2
|
||||
00049 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFWRK'. CL**2
|
||||
00050 CL**2
|
||||
00051 05 EMSG-NOT-AVAILABLE. DTSCU827
|
||||
00052 10 FILLER PIC X(04) VALUE 'E091'. DTSCU827
|
||||
00053 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU827
|
||||
00054 10 EMSG-FILE-NAME PIC X(08). DTSCU827
|
||||
00055 10 FILLER PIC X(33) DTSCU827
|
||||
00056 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU827
|
||||
00057 CL**2
|
||||
00058 CL**2
|
||||
00059 *****05 WRK-CICS-APPLID PIC X(08). CL**2
|
||||
00060 CL**2
|
||||
00061 *****05 WRK-CICS-OP-ID PIC X(08). CL**2
|
||||
00062 *********88 WRK-TCL-OP-ID-88 VALUES 'CE0756' CL**2
|
||||
00063 *******************************************'CE3568' CL**2
|
||||
00064 *******************************************'C84986'. CL**2
|
||||
00065 CL**2
|
||||
00066 05 WRK-FILE-NAME PIC X(08). DTSCU827
|
||||
00067 CL**2
|
||||
00068 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU827
|
||||
00069 EJECT DTSCU827
|
||||
00070 01 VLEN-LITERALS. DTSCU827
|
||||
00071 ++INCLUDE DTSIVLEN CL**3
|
||||
00072 EJECT DTSCU827
|
||||
00073 01 VIO-REC. DTSCU827
|
||||
00074 ++INCLUDE DTSIVSKL CL**3
|
||||
00075 EJECT DTSCU827
|
||||
00076 LINKAGE SECTION. DTSCU827
|
||||
00077 SKIP3 DTSCU827
|
||||
00078 01 DFHCOMMAREA. DTSCU827
|
||||
00079 05 L827-CONTROL-BLOCK. DTSCU827
|
||||
00080 ++INCLUDE DTSIL827 CL**3
|
||||
00081 SKIP3 DTSCU827
|
||||
00082 05 VCOMM-REC. DTSCU827
|
||||
00083 ++INCLUDE DTSIVSKL CL**3
|
||||
00084 SKIP3 DTSCU827
|
||||
00085 05 VCOR-REC REDEFINES VCOMM-REC. DTSCU827
|
||||
00086 ++INCLUDE DTSIVCOR CL**3
|
||||
00087 EJECT DTSCU827
|
||||
00088 PROCEDURE DIVISION. DTSCU827
|
||||
00089 SKIP2 DTSCU827
|
||||
00090 *****EXEC CICS DTSCU827
|
||||
00091 ***** ASSIGN DTSCU827
|
||||
00092 ***** APPLID (WRK-CICS-APPLID) DTSCU827
|
||||
00093 *****END-EXEC. DTSCU827
|
||||
00094 ***** CL**2
|
||||
00095 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU827
|
||||
00096 ***** EXEC CICS DTSCU827
|
||||
00097 ***** ASSIGN DTSCU827
|
||||
00098 ***** USERID (WRK-CICS-OP-ID) DTSCU827
|
||||
00099 ***** END-EXEC DTSCU827
|
||||
00100 ***** CL**2
|
||||
00101 ***** IF WRK-TCL-OP-ID-88 DTSCU827
|
||||
00102 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU827
|
||||
00103 ***** ELSE DTSCU827
|
||||
00104 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU827
|
||||
00105 *****ELSE DTSCU827
|
||||
00106 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU827
|
||||
00107 CL**2
|
||||
00108 MOVE SPACES TO L827-MSG-AREA. DTSCU827
|
||||
00109 CL**4
|
||||
00110 SET L827-OK-88 TO TRUE. DTSCU827
|
||||
00111 CL**2
|
||||
00112 IF L827-READ-NEXT-88 DTSCU827
|
||||
00113 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU827
|
||||
00114 ELSE DTSCU827
|
||||
00115 IF L827-READ-88 DTSCU827
|
||||
00116 PERFORM P1100-READ THRU P1100-EXIT DTSCU827
|
||||
00117 ELSE DTSCU827
|
||||
00118 IF L827-START-BROWSE-88 DTSCU827
|
||||
00119 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU827
|
||||
00120 ELSE DTSCU827
|
||||
00121 IF L827-END-BROWSE-88 DTSCU827
|
||||
00122 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU827
|
||||
00123 ELSE DTSCU827
|
||||
00124 IF L827-READ-PREV-88 DTSCU827
|
||||
00125 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU827
|
||||
00126 ELSE DTSCU827
|
||||
00127 IF L827-WRITE-88 DTSCU827
|
||||
00128 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU827
|
||||
00129 ELSE DTSCU827
|
||||
00130 IF L827-REWRITE-88 DTSCU827
|
||||
00131 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU827
|
||||
00132 ELSE DTSCU827
|
||||
00133 IF L827-DELETE-88 DTSCU827
|
||||
00134 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU827
|
||||
00135 ELSE DTSCU827
|
||||
00136 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00137 CL**4
|
||||
00138 CL**4
|
||||
00139 EXEC CICS DTSCU827
|
||||
00140 RETURN DTSCU827
|
||||
00141 END-EXEC. DTSCU827
|
||||
00142 CL**4
|
||||
00143 CL**4
|
||||
00144 GOBACK. DTSCU827
|
||||
00145 EJECT DTSCU827
|
||||
00146 P1100-READ. DTSCU827
|
||||
00147 MOVE LOW-VALUES TO VIO-REC. DTSCU827
|
||||
00148 CL**4
|
||||
00149 MOVE VSKL-KEY-AREA OF VCOMM-REC TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
|
||||
00150 CL**4
|
||||
00151 MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU827
|
||||
00152 CL**2
|
||||
00153 EXEC CICS DTSCU827
|
||||
00154 READ DTSCU827
|
||||
00155 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00156 INTO (VIO-REC) DTSCU827
|
||||
00157 LENGTH (WRK-REC-LENGTH) DTSCU827
|
||||
00158 RIDFLD (VSKL-KEY-AREA OF VIO-REC) DTSCU827
|
||||
00159 RESP (WRK-RESP-CD) DTSCU827
|
||||
00160 END-EXEC. DTSCU827
|
||||
00161 CL**2
|
||||
00162 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU827
|
||||
00163 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00164 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00165 GO TO P1100-EXIT. DTSCU827
|
||||
00166 CL**2
|
||||
00167 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU827
|
||||
00168 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00169 GO TO P1100-EXIT. DTSCU827
|
||||
00170 CL**2
|
||||
00171 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00172 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU827
|
||||
00173 ELSE DTSCU827
|
||||
00174 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00175 P1100-EXIT. DTSCU827
|
||||
00176 EXIT. DTSCU827
|
||||
00177 EJECT DTSCU827
|
||||
00178 P2100-START-BROWSE. DTSCU827
|
||||
00179 MOVE LOW-VALUES TO VIO-REC. DTSCU827
|
||||
00180 CL**4
|
||||
00181 MOVE VSKL-KEY-AREA OF VCOMM-REC TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
|
||||
00182 CL**2
|
||||
00183 EXEC CICS DTSCU827
|
||||
00184 STARTBR DTSCU827
|
||||
00185 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00186 RIDFLD (VSKL-KEY-AREA OF VIO-REC) DTSCU827
|
||||
00187 RESP (WRK-RESP-CD) DTSCU827
|
||||
00188 END-EXEC. DTSCU827
|
||||
00189 CL**2
|
||||
00190 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU827
|
||||
00191 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00192 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00193 GO TO P2100-EXIT. DTSCU827
|
||||
00194 CL**2
|
||||
00195 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU827
|
||||
00196 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00197 GO TO P2100-EXIT. DTSCU827
|
||||
00198 CL**2
|
||||
00199 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00200 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU827
|
||||
00201 ELSE DTSCU827
|
||||
00202 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00203 P2100-EXIT. DTSCU827
|
||||
00204 EXIT. DTSCU827
|
||||
00205 EJECT DTSCU827
|
||||
00206 P2200-READ-NEXT. DTSCU827
|
||||
00207 IF L827-READ-NEXT-88 DTSCU827
|
||||
00208 MOVE LOW-VALUES TO VIO-REC DTSCU827
|
||||
00209 MOVE VSKL-KEY-AREA OF VCOMM-REC DTSCU827
|
||||
00210 TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
|
||||
00211 CL**2
|
||||
00212 MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU827
|
||||
00213 CL**2
|
||||
00214 EXEC CICS DTSCU827
|
||||
00215 READNEXT DTSCU827
|
||||
00216 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00217 INTO (VIO-REC) DTSCU827
|
||||
00218 LENGTH (WRK-REC-LENGTH) DTSCU827
|
||||
00219 RIDFLD (VSKL-KEY-AREA OF VIO-REC) DTSCU827
|
||||
00220 RESP (WRK-RESP-CD) DTSCU827
|
||||
00221 END-EXEC. DTSCU827
|
||||
00222 CL**2
|
||||
00223 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU827
|
||||
00224 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00225 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00226 GO TO P2200-EXIT. DTSCU827
|
||||
00227 CL**2
|
||||
00228 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU827
|
||||
00229 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00230 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU827
|
||||
00231 GO TO P2200-EXIT. DTSCU827
|
||||
00232 CL**2
|
||||
00233 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00234 NEXT SENTENCE DTSCU827
|
||||
00235 ELSE DTSCU827
|
||||
00236 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00237 CL**2
|
||||
00238 IF VSKL-REC-TYPE OF VIO-REC = VSKL-REC-TYPE OF VCOMM-REC DTSCU827
|
||||
00239 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU827
|
||||
00240 ELSE DTSCU827
|
||||
00241 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00242 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU827
|
||||
00243 P2200-EXIT. DTSCU827
|
||||
00244 EXIT. DTSCU827
|
||||
00245 EJECT DTSCU827
|
||||
00246 P2300-READ-PREV. DTSCU827
|
||||
00247 MOVE LOW-VALUES TO VIO-REC. DTSCU827
|
||||
00248 CL**4
|
||||
00249 MOVE VSKL-KEY-AREA OF VCOMM-REC DTSCU827
|
||||
00250 TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
|
||||
00251 CL**2
|
||||
00252 MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU827
|
||||
00253 CL**2
|
||||
00254 EXEC CICS DTSCU827
|
||||
00255 READPREV DTSCU827
|
||||
00256 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00257 INTO (VIO-REC) DTSCU827
|
||||
00258 LENGTH (WRK-REC-LENGTH) DTSCU827
|
||||
00259 RIDFLD (VSKL-KEY-AREA OF VIO-REC) DTSCU827
|
||||
00260 RESP (WRK-RESP-CD) DTSCU827
|
||||
00261 END-EXEC. DTSCU827
|
||||
00262 CL**2
|
||||
00263 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU827
|
||||
00264 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00265 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00266 GO TO P2300-EXIT. DTSCU827
|
||||
00267 CL**2
|
||||
00268 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU827
|
||||
00269 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00270 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU827
|
||||
00271 GO TO P2300-EXIT. DTSCU827
|
||||
00272 CL**2
|
||||
00273 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00274 NEXT SENTENCE DTSCU827
|
||||
00275 ELSE DTSCU827
|
||||
00276 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00277 CL**2
|
||||
00278 IF VSKL-REC-TYPE OF VIO-REC = VSKL-REC-TYPE OF VCOMM-REC DTSCU827
|
||||
00279 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU827
|
||||
00280 ELSE DTSCU827
|
||||
00281 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00282 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU827
|
||||
00283 P2300-EXIT. DTSCU827
|
||||
00284 EXIT. DTSCU827
|
||||
00285 EJECT DTSCU827
|
||||
00286 P2400-END-BROWSE. DTSCU827
|
||||
00287 EXEC CICS DTSCU827
|
||||
00288 ENDBR DTSCU827
|
||||
00289 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00290 RESP (WRK-RESP-CD) DTSCU827
|
||||
00291 END-EXEC. DTSCU827
|
||||
00292 CL**2
|
||||
00293 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU827
|
||||
00294 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00295 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00296 GO TO P2400-EXIT. DTSCU827
|
||||
00297 CL**2
|
||||
00298 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU827
|
||||
00299 NEXT SENTENCE DTSCU827
|
||||
00300 ELSE DTSCU827
|
||||
00301 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00302 P2400-EXIT. DTSCU827
|
||||
00303 EXIT. DTSCU827
|
||||
00304 EJECT DTSCU827
|
||||
00305 P3100-WRITE. DTSCU827
|
||||
00306 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU827
|
||||
00307 CL**4
|
||||
00308 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU827
|
||||
00309 CL**2
|
||||
00310 EXEC CICS DTSCU827
|
||||
00311 WRITE DTSCU827
|
||||
00312 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00313 FROM (VIO-REC) DTSCU827
|
||||
00314 LENGTH (WRK-REC-LENGTH) DTSCU827
|
||||
00315 RIDFLD (VSKL-KEY-AREA OF VIO-REC) DTSCU827
|
||||
00316 RESP (WRK-RESP-CD) DTSCU827
|
||||
00317 END-EXEC. DTSCU827
|
||||
00318 CL**2
|
||||
00319 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU827
|
||||
00320 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00321 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00322 GO TO P3100-EXIT. DTSCU827
|
||||
00323 CL**2
|
||||
00324 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00325 NEXT SENTENCE DTSCU827
|
||||
00326 ELSE DTSCU827
|
||||
00327 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00328 P3100-EXIT. DTSCU827
|
||||
00329 EXIT. DTSCU827
|
||||
00330 EJECT DTSCU827
|
||||
00331 P3200-REWRITE. DTSCU827
|
||||
00332 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU827
|
||||
00333 CL**4
|
||||
00334 IF L827-NO-REC-88 DTSCU827
|
||||
00335 PERFORM S899-ABEND THRU S899-EXIT DTSCU827
|
||||
00336 ELSE DTSCU827
|
||||
00337 IF L827-FILE-CLOSED-88 DTSCU827
|
||||
00338 GO TO P3200-EXIT. DTSCU827
|
||||
00339 CL**2
|
||||
00340 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU827
|
||||
00341 CL**4
|
||||
00342 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU827
|
||||
00343 CL**2
|
||||
00344 EXEC CICS DTSCU827
|
||||
00345 REWRITE DTSCU827
|
||||
00346 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00347 FROM (VIO-REC) DTSCU827
|
||||
00348 LENGTH (WRK-REC-LENGTH) DTSCU827
|
||||
00349 RESP (WRK-RESP-CD) DTSCU827
|
||||
00350 END-EXEC. DTSCU827
|
||||
00351 CL**2
|
||||
00352 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU827
|
||||
00353 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00354 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00355 GO TO P3200-EXIT. DTSCU827
|
||||
00356 CL**2
|
||||
00357 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00358 NEXT SENTENCE DTSCU827
|
||||
00359 ELSE DTSCU827
|
||||
00360 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00361 P3200-EXIT. DTSCU827
|
||||
00362 EXIT. DTSCU827
|
||||
00363 EJECT DTSCU827
|
||||
00364 P3300-DELETE. DTSCU827
|
||||
00365 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU827
|
||||
00366 CL**4
|
||||
00367 IF L827-NO-REC-88 DTSCU827
|
||||
00368 PERFORM S899-ABEND THRU S899-EXIT DTSCU827
|
||||
00369 ELSE DTSCU827
|
||||
00370 IF L827-FILE-CLOSED-88 DTSCU827
|
||||
00371 GO TO P3300-EXIT. DTSCU827
|
||||
00372 CL**2
|
||||
00373 EXEC CICS DTSCU827
|
||||
00374 DELETE DTSCU827
|
||||
00375 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00376 RESP (WRK-RESP-CD) DTSCU827
|
||||
00377 END-EXEC. DTSCU827
|
||||
00378 CL**2
|
||||
00379 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU827
|
||||
00380 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00381 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00382 GO TO P3300-EXIT. DTSCU827
|
||||
00383 CL**2
|
||||
00384 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00385 NEXT SENTENCE DTSCU827
|
||||
00386 ELSE DTSCU827
|
||||
00387 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00388 P3300-EXIT. DTSCU827
|
||||
00389 EXIT. DTSCU827
|
||||
00390 EJECT DTSCU827
|
||||
00391 S1100-NOT-AVAILABLE. DTSCU827
|
||||
00392 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU827
|
||||
00393 CL**4
|
||||
00394 MOVE EMSG-NOT-AVAILABLE TO L827-MSG-AREA. DTSCU827
|
||||
00395 CL**4
|
||||
00396 SET L827-FILE-CLOSED-88 TO TRUE. DTSCU827
|
||||
00397 S1100-EXIT. DTSCU827
|
||||
00398 EXIT. DTSCU827
|
||||
00399 SKIP3 DTSCU827
|
||||
00400 S1200-NOT-FOUND. DTSCU827
|
||||
00401 SET L827-NO-REC-88 TO TRUE. DTSCU827
|
||||
00402 S1200-EXIT. DTSCU827
|
||||
00403 EXIT. DTSCU827
|
||||
00404 EJECT DTSCU827
|
||||
00405 ******************************************************************DTSCU827
|
||||
00406 * IF ADDITIONAL RECORD TYPES ARE ADDED, SEE DTSCU823 AND CL**2
|
||||
00407 * DTSCU831 FOR EXAMPLES OF THE FOLLOWING THREE PARAGRAPH SETS. CL**2
|
||||
00408 ******************************************************************DTSCU827
|
||||
00409 SKIP3 DTSCU827
|
||||
00410 S2100-IO-TO-COMM. DTSCU827
|
||||
00411 IF VSKL-COR-88 OF VIO-REC DTSCU827
|
||||
00412 MOVE VIO-REC TO VCOR-REC DTSCU827
|
||||
00413 ELSE DTSCU827
|
||||
00414 GO TO S899-ABEND. DTSCU827
|
||||
00415 S2100-EXIT. DTSCU827
|
||||
00416 EXIT. DTSCU827
|
||||
00417 SKIP3 DTSCU827
|
||||
00418 S2200-COMM-TO-IO. DTSCU827
|
||||
00419 IF VSKL-COR-88 OF VCOMM-REC DTSCU827
|
||||
00420 MOVE LOW-VALUES TO VCOR-KEY-FILLER DTSCU827
|
||||
00421 MOVE VCOR-REC TO VIO-REC DTSCU827
|
||||
00422 ELSE DTSCU827
|
||||
00423 GO TO S899-ABEND. DTSCU827
|
||||
00424 S2200-EXIT. DTSCU827
|
||||
00425 EXIT. DTSCU827
|
||||
00426 SKIP3 DTSCU827
|
||||
00427 S2300-CALCULATE-LENGTH. DTSCU827
|
||||
00428 IF VSKL-COR-88 OF VIO-REC DTSCU827
|
||||
00429 MOVE VLEN-COR-LENGTH TO WRK-REC-LENGTH DTSCU827
|
||||
00430 ELSE DTSCU827
|
||||
00431 GO TO S899-ABEND. DTSCU827
|
||||
00432 S2300-EXIT. DTSCU827
|
||||
00433 EXIT. DTSCU827
|
||||
00434 EJECT DTSCU827
|
||||
00435 S3100-READ-UPDATE. DTSCU827
|
||||
00436 MOVE LOW-VALUES TO VIO-REC. DTSCU827
|
||||
00437 CL**4
|
||||
00438 MOVE VSKL-KEY-AREA OF VCOMM-REC TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
|
||||
00439 CL**4
|
||||
00440 MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU827
|
||||
00441 CL**2
|
||||
00442 EXEC CICS DTSCU827
|
||||
00443 READ DTSCU827
|
||||
00444 DATASET (WRK-FILE-NAME) DTSCU827
|
||||
00445 INTO (VIO-REC) DTSCU827
|
||||
00446 LENGTH (WRK-REC-LENGTH) DTSCU827
|
||||
00447 RIDFLD (VSKL-KEY-AREA OF VIO-REC) DTSCU827
|
||||
00448 UPDATE DTSCU827
|
||||
00449 RESP (WRK-RESP-CD) DTSCU827
|
||||
00450 END-EXEC. DTSCU827
|
||||
00451 CL**2
|
||||
00452 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU827
|
||||
00453 OR DFHRESP (SYSIDERR) DTSCU827
|
||||
00454 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU827
|
||||
00455 GO TO S3100-EXIT. DTSCU827
|
||||
00456 CL**2
|
||||
00457 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU827
|
||||
00458 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU827
|
||||
00459 GO TO S3100-EXIT. DTSCU827
|
||||
00460 CL**2
|
||||
00461 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU827
|
||||
00462 NEXT SENTENCE DTSCU827
|
||||
00463 ELSE DTSCU827
|
||||
00464 PERFORM S899-ABEND THRU S899-EXIT. DTSCU827
|
||||
00465 S3100-EXIT. DTSCU827
|
||||
00466 EXIT. DTSCU827
|
||||
00467 EJECT DTSCU827
|
||||
00468 S899-ABEND. DTSCU827
|
||||
00469 CL**2
|
||||
00470 EXEC CICS DTSCU827
|
||||
00471 ABEND DTSCU827
|
||||
00472 ABCODE (WRK-ABEND-CD) DTSCU827
|
||||
00473 END-EXEC. DTSCU827
|
||||
00474 CL**2
|
||||
00475 S899-EXIT. DTSCU827
|
||||
00476 EXIT. DTSCU827
|
||||
Reference in New Issue
Block a user