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