730 lines
58 KiB
COBOL
730 lines
58 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/07/12
|
|
00002 PROGRAM-ID. DTSCU831. DTSCU831
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009
|
|
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU831
|
|
00005 DATE-COMPILED. DTSCU831
|
|
00006 SKIP3 DTSCU831
|
|
00007 ***** DTSCU831
|
|
00008 * DTSCU831
|
|
00009 * FUNCTION: REFERENCE FILE INPUT/OUTPUT. DTSCU831
|
|
00010 * DTSCU831
|
|
00011 * DTSCU831
|
|
00012 * MODIFICATION LOG: DTSCU831
|
|
00013 * DTSCU831
|
|
00014 * 11/12/91 INITIAL DEVELOPMENT. DTSCU831
|
|
00015 * WORK ORDER: PROGRAMMER: TCL DTSCU831
|
|
00016 * DTSCU831
|
|
00017 * 04/01/94 MODIFIED FOR MONTANA. DTSCU831
|
|
00018 * WORK ORDER: PROGRAMMER: TCL DTSCU831
|
|
00019 * DTSCU831
|
|
00020 * 08/12/1998 REVIEWED AND MODIFIED FOR DC. DTSCU831
|
|
00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCU831
|
|
00022 * DTSCU831
|
|
00023 * 05/09/2000 ADDED FFIS RECORD (2121/2221-MOVE) LOGIC. DTSCU831
|
|
00024 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCU831
|
|
00025 * DTSCU831
|
|
00026 * DTSCU831
|
|
00027 * 05/15/2002 ADDED FAFD RECORD (2121/2221-MOVE) LOGIC. DTSCU831
|
|
00028 * REFERENCE: HOUSEHOLD PROGRAMMER: ZL1 DTSCU831
|
|
00029 * DTSCU831
|
|
00030 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU831
|
|
00031 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU831
|
|
00032 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU831
|
|
00033 * DTSCU831
|
|
00034 * DTSCU831
|
|
00035 * DESCRIPTION: DTSCU831
|
|
00036 * DTSCU831
|
|
00037 * DTSCU831 PERFORMS ALL REQUIRED REFERENCE FILE DTSCU831
|
|
00038 * INPUT/OUTPUT. DTSCU831'S COMMAREA CONSISTS OF DTSCU831
|
|
00039 * DTSIL831, FOLLOWED BY DTSIFSKL. SEE DFHCOMMAREA DTSCU831
|
|
00040 * OF THIS MODULE FOR AN EXAMPLE. DTSCU831
|
|
00041 * DTSCU831
|
|
00042 * DTSCU831
|
|
00043 * DTSCU831
|
|
00044 ***** DTSCU831
|
|
00045 SKIP3 DTSCU831
|
|
00046 ENVIRONMENT DIVISION. DTSCU831
|
|
00047 SKIP3 DTSCU831
|
|
00048 DATA DIVISION. DTSCU831
|
|
00049 SKIP3 DTSCU831
|
|
00050 WORKING-STORAGE SECTION. DTSCU831
|
|
000505 77 PAN-VALET PICTURE X(24) VALUE '009DTSCU831 02/07/12'. DTSCU831
|
|
00051 SKIP3 DTSCU831
|
|
00052 01 WRK-AREA. DTSCU831
|
|
00053 05 WRK-ABEND-CD PIC X(04) VALUE 'U831'. DTSCU831
|
|
00054 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU831
|
|
00055 DTSCU831
|
|
00056 *****05 WRK-TEST-FILE-NAME PIC X(08) VALUE 'DTSFREF'. DTSCU831
|
|
00057 *****05 WRK-TCL-FILE-NAME PIC X(08) VALUE 'DTSTREF'. DTSCU831
|
|
00058 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFREF'. DTSCU831
|
|
00059 DTSCU831
|
|
00060 05 EMSG-NOT-AVAILABLE. DTSCU831
|
|
00061 10 FILLER PIC X(04) VALUE 'E091'. DTSCU831
|
|
00062 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU831
|
|
00063 10 EMSG-FILE-NAME PIC X(08). DTSCU831
|
|
00064 10 FILLER PIC X(33) DTSCU831
|
|
00065 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU831
|
|
00066 SKIP3 DTSCU831
|
|
00067 *****05 WRK-CICS-APPLID PIC X(08). DTSCU831
|
|
00068 DTSCU831
|
|
00069 *****05 WRK-CICS-OP-ID PIC X(08). DTSCU831
|
|
00070 *********88 WRK-TCL-OP-ID-88 VALUES 'CE0756' DTSCU831
|
|
00071 *******************************************'CE3568' DTSCU831
|
|
00072 *******************************************'C84986'. DTSCU831
|
|
00073 DTSCU831
|
|
00074 05 WRK-FILE-NAME PIC X(08). DTSCU831
|
|
00075 DTSCU831
|
|
00076 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU831
|
|
00077 EJECT DTSCU831
|
|
00078 01 FLEN-LITERALS. DTSCU831
|
|
00079 ++INCLUDE DTSIFLEN DTSCU831
|
|
00080 EJECT DTSCU831
|
|
00081 01 FIO-REC. DTSCU831
|
|
00082 ++INCLUDE DTSIFSKL DTSCU831
|
|
00083 EJECT DTSCU831
|
|
00084 LINKAGE SECTION. DTSCU831
|
|
00085 SKIP3 DTSCU831
|
|
00086 01 DFHCOMMAREA. DTSCU831
|
|
00087 05 L831-CONTROL-BLOCK. DTSCU831
|
|
00088 ++INCLUDE DTSIL831 DTSCU831
|
|
00089 SKIP3 DTSCU831
|
|
00090 05 FCOMM-REC. DTSCU831
|
|
00091 ++INCLUDE DTSIFSKL DTSCU831
|
|
00092 SKIP3 DTSCU831
|
|
00093 05 FAFD-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00094 ++INCLUDE DTSIFAFD DTSCU831
|
|
00095 SKIP3 DTSCU831
|
|
00096 05 FCYR-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00097 ++INCLUDE DTSIFCYR DTSCU831
|
|
00098 SKIP3 DTSCU831
|
|
00099 05 FFAT-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00100 ++INCLUDE DTSIFFAT DTSCU831
|
|
00101 SKIP3 DTSCU831
|
|
00102 05 FFAZ-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00103 ++INCLUDE DTSIFFAZ DTSCU831
|
|
00104 SKIP3 DTSCU831
|
|
00105 05 FFID-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00106 ++INCLUDE DTSIFFID DTSCU831
|
|
00107 SKIP3 DTSCU831
|
|
00108 05 FFIS-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00109 ++INCLUDE DTSIFFIS DTSCU831
|
|
00110 SKIP3 DTSCU831
|
|
00111 05 FOPR-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00112 ++INCLUDE DTSIFOPR DTSCU831
|
|
00113 SKIP3 DTSCU831
|
|
00114 05 FQTR-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00115 ++INCLUDE DTSIFQTR DTSCU831
|
|
00116 SKIP3 DTSCU831
|
|
00117 05 FSEL-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00118 ++INCLUDE DTSIFSEL DTSCU831
|
|
00119 SKIP3 DTSCU831
|
|
00120 05 FUIR-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00121 ++INCLUDE DTSIFUIR DTSCU831
|
|
00122 SKIP3 DTSCU831
|
|
00123 05 F581-REC REDEFINES FCOMM-REC. DTSCU831
|
|
00124 ++INCLUDE DTSIF581 DTSCU831
|
|
00125 EJECT DTSCU831
|
|
00126 PROCEDURE DIVISION. DTSCU831
|
|
00127 SKIP2 DTSCU831
|
|
00128 *****EXEC CICS DTSCU831
|
|
00129 ***** ASSIGN DTSCU831
|
|
00130 ***** APPLID (WRK-CICS-APPLID) DTSCU831
|
|
00131 *****END-EXEC. DTSCU831
|
|
00132 ***** DTSCU831
|
|
00133 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU831
|
|
00134 ***** EXEC CICS DTSCU831
|
|
00135 ***** ASSIGN DTSCU831
|
|
00136 ***** USERID (WRK-CICS-OP-ID) DTSCU831
|
|
00137 ***** END-EXEC DTSCU831
|
|
00138 ***** DTSCU831
|
|
00139 ***** IF WRK-TCL-OP-ID-88 DTSCU831
|
|
00140 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU831
|
|
00141 ***** ELSE DTSCU831
|
|
00142 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU831
|
|
00143 *****ELSE DTSCU831
|
|
00144 DTSCU831
|
|
00145 DTSCU831
|
|
00146 DTSCU831
|
|
00147 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU831
|
|
00148 DTSCU831
|
|
00149 MOVE SPACES TO L831-MSG-AREA. DTSCU831
|
|
00150 DTSCU831
|
|
00151 SET L831-OK-88 TO TRUE. DTSCU831
|
|
00152 DTSCU831
|
|
00153 IF L831-READ-NEXT-88 DTSCU831
|
|
00154 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU831
|
|
00155 ELSE DTSCU831
|
|
00156 IF L831-READ-88 DTSCU831
|
|
00157 PERFORM P1100-READ THRU P1100-EXIT DTSCU831
|
|
00158 ELSE DTSCU831
|
|
00159 IF L831-START-BROWSE-88 DTSCU831
|
|
00160 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU831
|
|
00161 ELSE DTSCU831
|
|
00162 IF L831-END-BROWSE-88 DTSCU831
|
|
00163 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU831
|
|
00164 ELSE DTSCU831
|
|
00165 IF L831-READ-PREV-88 DTSCU831
|
|
00166 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU831
|
|
00167 ELSE DTSCU831
|
|
00168 IF L831-WRITE-88 DTSCU831
|
|
00169 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU831
|
|
00170 ELSE DTSCU831
|
|
00171 IF L831-REWRITE-88 DTSCU831
|
|
00172 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU831
|
|
00173 ELSE DTSCU831
|
|
00174 IF L831-DELETE-88 DTSCU831
|
|
00175 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU831
|
|
00176 ELSE DTSCU831
|
|
00177 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00178 SKIP2 DTSCU831
|
|
00179 EXEC CICS DTSCU831
|
|
00180 RETURN DTSCU831
|
|
00181 END-EXEC. DTSCU831
|
|
00182 SKIP2 DTSCU831
|
|
00183 GOBACK. DTSCU831
|
|
00184 EJECT DTSCU831
|
|
00185 P1100-READ. DTSCU831
|
|
00186 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
|
00187 DTSCU831
|
|
00188 MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
|
00189 DTSCU831
|
|
00190 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
|
00191 DTSCU831
|
|
00192 EXEC CICS DTSCU831
|
|
00193 READ DTSCU831
|
|
00194 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00195 INTO (FIO-REC) DTSCU831
|
|
00196 LENGTH (WRK-REC-LENGTH) DTSCU831
|
|
00197 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
|
00198 RESP (WRK-RESP-CD) DTSCU831
|
|
00199 END-EXEC. DTSCU831
|
|
00200 DTSCU831
|
|
00201 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
|
00202 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00203 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00204 GO TO P1100-EXIT. DTSCU831
|
|
00205 DTSCU831
|
|
00206 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU831
|
|
00207 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00208 GO TO P1100-EXIT. DTSCU831
|
|
00209 DTSCU831
|
|
00210 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00211 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU831
|
|
00212 ELSE DTSCU831
|
|
00213 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00214 P1100-EXIT. DTSCU831
|
|
00215 EXIT. DTSCU831
|
|
00216 EJECT DTSCU831
|
|
00217 P2100-START-BROWSE. DTSCU831
|
|
00218 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
|
00219 DTSCU831
|
|
00220 MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
|
00221 DTSCU831
|
|
00222 EXEC CICS DTSCU831
|
|
00223 STARTBR DTSCU831
|
|
00224 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00225 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
|
00226 RESP (WRK-RESP-CD) DTSCU831
|
|
00227 END-EXEC. DTSCU831
|
|
00228 DTSCU831
|
|
00229 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
|
00230 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00231 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00232 GO TO P2100-EXIT. DTSCU831
|
|
00233 DTSCU831
|
|
00234 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU831
|
|
00235 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00236 GO TO P2100-EXIT. DTSCU831
|
|
00237 DTSCU831
|
|
00238 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00239 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU831
|
|
00240 ELSE DTSCU831
|
|
00241 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00242 P2100-EXIT. DTSCU831
|
|
00243 EXIT. DTSCU831
|
|
00244 EJECT DTSCU831
|
|
00245 P2200-READ-NEXT. DTSCU831
|
|
00246 IF L831-READ-NEXT-88 DTSCU831
|
|
00247 MOVE LOW-VALUES TO FIO-REC DTSCU831
|
|
00248 MOVE FSKL-KEY-AREA OF FCOMM-REC DTSCU831
|
|
00249 TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
|
00250 DTSCU831
|
|
00251 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
|
00252 DTSCU831
|
|
00253 EXEC CICS DTSCU831
|
|
00254 READNEXT DTSCU831
|
|
00255 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00256 INTO (FIO-REC) DTSCU831
|
|
00257 LENGTH (WRK-REC-LENGTH) DTSCU831
|
|
00258 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
|
00259 RESP (WRK-RESP-CD) DTSCU831
|
|
00260 END-EXEC. DTSCU831
|
|
00261 DTSCU831
|
|
00262 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
|
00263 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00264 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00265 GO TO P2200-EXIT. DTSCU831
|
|
00266 DTSCU831
|
|
00267 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU831
|
|
00268 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00269 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU831
|
|
00270 GO TO P2200-EXIT. DTSCU831
|
|
00271 DTSCU831
|
|
00272 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00273 NEXT SENTENCE DTSCU831
|
|
00274 ELSE DTSCU831
|
|
00275 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00276 DTSCU831
|
|
00277 IF FSKL-REC-TYPE OF FIO-REC = FSKL-REC-TYPE OF FCOMM-REC DTSCU831
|
|
00278 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU831
|
|
00279 ELSE DTSCU831
|
|
00280 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00281 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU831
|
|
00282 P2200-EXIT. DTSCU831
|
|
00283 EXIT. DTSCU831
|
|
00284 EJECT DTSCU831
|
|
00285 P2300-READ-PREV. DTSCU831
|
|
00286 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
|
00287 DTSCU831
|
|
00288 MOVE FSKL-KEY-AREA OF FCOMM-REC DTSCU831
|
|
00289 TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
|
00290 DTSCU831
|
|
00291 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
|
00292 DTSCU831
|
|
00293 EXEC CICS DTSCU831
|
|
00294 READPREV DTSCU831
|
|
00295 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00296 INTO (FIO-REC) DTSCU831
|
|
00297 LENGTH (WRK-REC-LENGTH) DTSCU831
|
|
00298 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
|
00299 RESP (WRK-RESP-CD) DTSCU831
|
|
00300 END-EXEC. DTSCU831
|
|
00301 DTSCU831
|
|
00302 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
|
00303 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00304 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00305 GO TO P2300-EXIT. DTSCU831
|
|
00306 DTSCU831
|
|
00307 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU831
|
|
00308 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00309 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU831
|
|
00310 GO TO P2300-EXIT. DTSCU831
|
|
00311 DTSCU831
|
|
00312 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00313 NEXT SENTENCE DTSCU831
|
|
00314 ELSE DTSCU831
|
|
00315 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00316 DTSCU831
|
|
00317 IF FSKL-REC-TYPE OF FIO-REC = FSKL-REC-TYPE OF FCOMM-REC DTSCU831
|
|
00318 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU831
|
|
00319 ELSE DTSCU831
|
|
00320 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00321 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU831
|
|
00322 P2300-EXIT. DTSCU831
|
|
00323 EXIT. DTSCU831
|
|
00324 EJECT DTSCU831
|
|
00325 P2400-END-BROWSE. DTSCU831
|
|
00326 DTSCU831
|
|
00327 EXEC CICS DTSCU831
|
|
00328 ENDBR DTSCU831
|
|
00329 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00330 RESP (WRK-RESP-CD) DTSCU831
|
|
00331 END-EXEC. DTSCU831
|
|
00332 DTSCU831
|
|
00333 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
|
00334 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00335 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00336 GO TO P2400-EXIT. DTSCU831
|
|
00337 DTSCU831
|
|
00338 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU831
|
|
00339 NEXT SENTENCE DTSCU831
|
|
00340 ELSE DTSCU831
|
|
00341 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00342 P2400-EXIT. DTSCU831
|
|
00343 EXIT. DTSCU831
|
|
00344 EJECT DTSCU831
|
|
00345 P3100-WRITE. DTSCU831
|
|
00346 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU831
|
|
00347 DTSCU831
|
|
00348 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU831
|
|
00349 DTSCU831
|
|
00350 EXEC CICS DTSCU831
|
|
00351 WRITE DTSCU831
|
|
00352 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00353 FROM (FIO-REC) DTSCU831
|
|
00354 LENGTH (WRK-REC-LENGTH) DTSCU831
|
|
00355 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
|
00356 RESP (WRK-RESP-CD) DTSCU831
|
|
00357 END-EXEC. DTSCU831
|
|
00358 DTSCU831
|
|
00359 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
|
00360 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00361 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00362 GO TO P3100-EXIT. DTSCU831
|
|
00363 DTSCU831
|
|
00364 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00365 NEXT SENTENCE DTSCU831
|
|
00366 ELSE DTSCU831
|
|
00367 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00368 P3100-EXIT. DTSCU831
|
|
00369 EXIT. DTSCU831
|
|
00370 EJECT DTSCU831
|
|
00371 P3200-REWRITE. DTSCU831
|
|
00372 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU831
|
|
00373 DTSCU831
|
|
00374 IF L831-NO-REC-88 DTSCU831
|
|
00375 PERFORM S899-ABEND THRU S899-EXIT DTSCU831
|
|
00376 ELSE DTSCU831
|
|
00377 IF L831-FILE-CLOSED-88 DTSCU831
|
|
00378 GO TO P3200-EXIT. DTSCU831
|
|
00379 DTSCU831
|
|
00380 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU831
|
|
00381 DTSCU831
|
|
00382 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU831
|
|
00383 DTSCU831
|
|
00384 EXEC CICS DTSCU831
|
|
00385 REWRITE DTSCU831
|
|
00386 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00387 FROM (FIO-REC) DTSCU831
|
|
00388 LENGTH (WRK-REC-LENGTH) DTSCU831
|
|
00389 RESP (WRK-RESP-CD) DTSCU831
|
|
00390 END-EXEC. DTSCU831
|
|
00391 DTSCU831
|
|
00392 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
|
00393 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00394 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00395 GO TO P3200-EXIT. DTSCU831
|
|
00396 DTSCU831
|
|
00397 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00398 NEXT SENTENCE DTSCU831
|
|
00399 ELSE DTSCU831
|
|
00400 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00401 P3200-EXIT. DTSCU831
|
|
00402 EXIT. DTSCU831
|
|
00403 EJECT DTSCU831
|
|
00404 P3300-DELETE. DTSCU831
|
|
00405 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU831
|
|
00406 DTSCU831
|
|
00407 IF L831-NO-REC-88 DTSCU831
|
|
00408 PERFORM S899-ABEND THRU S899-EXIT DTSCU831
|
|
00409 ELSE DTSCU831
|
|
00410 IF L831-FILE-CLOSED-88 DTSCU831
|
|
00411 GO TO P3300-EXIT. DTSCU831
|
|
00412 DTSCU831
|
|
00413 EXEC CICS DTSCU831
|
|
00414 DELETE DTSCU831
|
|
00415 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00416 RESP (WRK-RESP-CD) DTSCU831
|
|
00417 END-EXEC. DTSCU831
|
|
00418 DTSCU831
|
|
00419 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
|
00420 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00421 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00422 GO TO P3300-EXIT. DTSCU831
|
|
00423 DTSCU831
|
|
00424 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00425 NEXT SENTENCE DTSCU831
|
|
00426 ELSE DTSCU831
|
|
00427 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00428 P3300-EXIT. DTSCU831
|
|
00429 EXIT. DTSCU831
|
|
00430 EJECT DTSCU831
|
|
00431 S1100-NOT-AVAILABLE. DTSCU831
|
|
00432 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU831
|
|
00433 DTSCU831
|
|
00434 MOVE EMSG-NOT-AVAILABLE TO L831-MSG-AREA. DTSCU831
|
|
00435 DTSCU831
|
|
00436 SET L831-FILE-CLOSED-88 TO TRUE. DTSCU831
|
|
00437 S1100-EXIT. DTSCU831
|
|
00438 EXIT. DTSCU831
|
|
00439 SKIP3 DTSCU831
|
|
00440 S1200-NOT-FOUND. DTSCU831
|
|
00441 SET L831-NO-REC-88 TO TRUE. DTSCU831
|
|
00442 S1200-EXIT. DTSCU831
|
|
00443 EXIT. DTSCU831
|
|
00444 EJECT DTSCU831
|
|
00445 S2100-IO-TO-COMM. DTSCU831
|
|
00446 GO TO S2101-MOVE DTSCU831
|
|
00447 S2102-MOVE DTSCU831
|
|
00448 S2103-MOVE DTSCU831
|
|
00449 S2104-MOVE DTSCU831
|
|
00450 S2105-MOVE DTSCU831
|
|
00451 S2106-MOVE DTSCU831
|
|
00452 S2107-MOVE DTSCU831
|
|
00453 S2108-MOVE DTSCU831
|
|
00454 S2109-MOVE DTSCU831
|
|
00455 S2110-MOVE DTSCU831
|
|
00456 S2111-MOVE DTSCU831
|
|
00457 S2112-MOVE DTSCU831
|
|
00458 S2113-MOVE DTSCU831
|
|
00459 S2114-MOVE DTSCU831
|
|
00460 S2115-MOVE DTSCU831
|
|
00461 S2116-MOVE DTSCU831
|
|
00462 S2117-MOVE DTSCU831
|
|
00463 S2118-MOVE DTSCU831
|
|
00464 S2119-MOVE DTSCU831
|
|
00465 S2120-MOVE DTSCU831
|
|
00466 DEPENDING ON FSKL-REC-TYPE OF FIO-REC. DTSCU831
|
|
00467 DTSCU831
|
|
00468 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00469 SKIP3 DTSCU831
|
|
00470 S2101-MOVE. DTSCU831
|
|
00471 MOVE FIO-REC TO FCYR-REC. DTSCU831
|
|
00472 GO TO S2100-EXIT. DTSCU831
|
|
00473 SKIP3 DTSCU831
|
|
00474 S2102-MOVE. DTSCU831
|
|
00475 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00476 GO TO S2100-EXIT. DTSCU831
|
|
00477 SKIP3 DTSCU831
|
|
00478 S2103-MOVE. DTSCU831
|
|
00479 MOVE FIO-REC TO FFAT-REC. DTSCU831
|
|
00480 GO TO S2100-EXIT. DTSCU831
|
|
00481 SKIP3 DTSCU831
|
|
00482 S2104-MOVE. DTSCU831
|
|
00483 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00484 GO TO S2100-EXIT. DTSCU831
|
|
00485 SKIP3 DTSCU831
|
|
00486 S2105-MOVE. DTSCU831
|
|
00487 MOVE FIO-REC TO FFAZ-REC. DTSCU831
|
|
00488 GO TO S2100-EXIT. DTSCU831
|
|
00489 SKIP3 DTSCU831
|
|
00490 S2106-MOVE. DTSCU831
|
|
00491 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00492 GO TO S2100-EXIT. DTSCU831
|
|
00493 SKIP3 DTSCU831
|
|
00494 S2107-MOVE. DTSCU831
|
|
00495 MOVE FIO-REC TO FFID-REC. DTSCU831
|
|
00496 GO TO S2100-EXIT. DTSCU831
|
|
00497 SKIP3 DTSCU831
|
|
00498 S2108-MOVE. DTSCU831
|
|
00499 MOVE FIO-REC TO FFIS-REC. DTSCU831
|
|
00500 GO TO S2100-EXIT. DTSCU831
|
|
00501 SKIP3 DTSCU831
|
|
00502 S2109-MOVE. DTSCU831
|
|
00503 MOVE FIO-REC TO FOPR-REC. DTSCU831
|
|
00504 GO TO S2100-EXIT. DTSCU831
|
|
00505 SKIP3 DTSCU831
|
|
00506 S2110-MOVE. DTSCU831
|
|
00507 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00508 GO TO S2100-EXIT. DTSCU831
|
|
00509 SKIP3 DTSCU831
|
|
00510 S2111-MOVE. DTSCU831
|
|
00511 MOVE FIO-REC TO FQTR-REC. DTSCU831
|
|
00512 GO TO S2100-EXIT. DTSCU831
|
|
00513 SKIP3 DTSCU831
|
|
00514 S2112-MOVE. DTSCU831
|
|
00515 MOVE FIO-REC TO FAFD-REC. DTSCU831
|
|
00516 GO TO S2100-EXIT. DTSCU831
|
|
00517 SKIP3 DTSCU831
|
|
00518 S2113-MOVE. DTSCU831
|
|
00519 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00520 GO TO S2100-EXIT. DTSCU831
|
|
00521 SKIP3 DTSCU831
|
|
00522 S2114-MOVE. DTSCU831
|
|
00523 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00524 GO TO S2100-EXIT. DTSCU831
|
|
00525 SKIP3 DTSCU831
|
|
00526 S2115-MOVE. DTSCU831
|
|
00527 MOVE FIO-REC TO FSEL-REC. DTSCU831
|
|
00528 GO TO S2100-EXIT. DTSCU831
|
|
00529 SKIP3 DTSCU831
|
|
00530 S2116-MOVE. DTSCU831
|
|
00531 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00532 GO TO S2100-EXIT. DTSCU831
|
|
00533 SKIP3 DTSCU831
|
|
00534 S2117-MOVE. DTSCU831
|
|
00535 MOVE FIO-REC TO FUIR-REC. DTSCU831
|
|
00536 GO TO S2100-EXIT. DTSCU831
|
|
00537 SKIP3 DTSCU831
|
|
00538 S2118-MOVE. DTSCU831
|
|
00539 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00540 GO TO S2100-EXIT. DTSCU831
|
|
00541 SKIP3 DTSCU831
|
|
00542 S2119-MOVE. DTSCU831
|
|
00543 MOVE FIO-REC TO F581-REC. DTSCU831
|
|
00544 GO TO S2100-EXIT. DTSCU831
|
|
00545 SKIP3 DTSCU831
|
|
00546 S2120-MOVE. DTSCU831
|
|
00547 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00548 GO TO S2100-EXIT. DTSCU831
|
|
00549 SKIP3 DTSCU831
|
|
00550 S2100-EXIT. DTSCU831
|
|
00551 EXIT. DTSCU831
|
|
00552 EJECT DTSCU831
|
|
00553 S2200-COMM-TO-IO. DTSCU831
|
|
00554 GO TO S2201-MOVE DTSCU831
|
|
00555 S2202-MOVE DTSCU831
|
|
00556 S2203-MOVE DTSCU831
|
|
00557 S2204-MOVE DTSCU831
|
|
00558 S2205-MOVE DTSCU831
|
|
00559 S2206-MOVE DTSCU831
|
|
00560 S2207-MOVE DTSCU831
|
|
00561 S2208-MOVE DTSCU831
|
|
00562 S2209-MOVE DTSCU831
|
|
00563 S2210-MOVE DTSCU831
|
|
00564 S2211-MOVE DTSCU831
|
|
00565 S2212-MOVE DTSCU831
|
|
00566 S2213-MOVE DTSCU831
|
|
00567 S2214-MOVE DTSCU831
|
|
00568 S2215-MOVE DTSCU831
|
|
00569 S2216-MOVE DTSCU831
|
|
00570 S2217-MOVE DTSCU831
|
|
00571 S2218-MOVE DTSCU831
|
|
00572 S2219-MOVE DTSCU831
|
|
00573 S2220-MOVE DTSCU831
|
|
00574 DEPENDING ON FSKL-REC-TYPE OF FCOMM-REC. DTSCU831
|
|
00575 DTSCU831
|
|
00576 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00577 SKIP3 DTSCU831
|
|
00578 S2201-MOVE. DTSCU831
|
|
00579 MOVE LOW-VALUES TO FCYR-KEY-FILLER. DTSCU831
|
|
00580 MOVE FCYR-REC TO FIO-REC. DTSCU831
|
|
00581 GO TO S2200-EXIT. DTSCU831
|
|
00582 SKIP3 DTSCU831
|
|
00583 S2202-MOVE. DTSCU831
|
|
00584 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00585 GO TO S2200-EXIT. DTSCU831
|
|
00586 SKIP3 DTSCU831
|
|
00587 S2203-MOVE. DTSCU831
|
|
00588 MOVE LOW-VALUES TO FFAT-KEY-FILLER. DTSCU831
|
|
00589 MOVE FFAT-REC TO FIO-REC. DTSCU831
|
|
00590 GO TO S2200-EXIT. DTSCU831
|
|
00591 SKIP3 DTSCU831
|
|
00592 S2204-MOVE. DTSCU831
|
|
00593 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00594 GO TO S2200-EXIT. DTSCU831
|
|
00595 SKIP3 DTSCU831
|
|
00596 S2205-MOVE. DTSCU831
|
|
00597 MOVE LOW-VALUES TO FFAZ-KEY-FILLER. DTSCU831
|
|
00598 MOVE FFAZ-REC TO FIO-REC. DTSCU831
|
|
00599 GO TO S2200-EXIT. DTSCU831
|
|
00600 SKIP3 DTSCU831
|
|
00601 S2206-MOVE. DTSCU831
|
|
00602 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00603 GO TO S2200-EXIT. DTSCU831
|
|
00604 SKIP3 DTSCU831
|
|
00605 S2207-MOVE. DTSCU831
|
|
00606 MOVE LOW-VALUES TO FFID-KEY-FILLER. DTSCU831
|
|
00607 MOVE FFID-REC TO FIO-REC. DTSCU831
|
|
00608 GO TO S2200-EXIT. DTSCU831
|
|
00609 SKIP3 DTSCU831
|
|
00610 S2208-MOVE. DTSCU831
|
|
00611 MOVE LOW-VALUES TO FFIS-KEY-FILLER. DTSCU831
|
|
00612 MOVE FFIS-REC TO FIO-REC. DTSCU831
|
|
00613 GO TO S2200-EXIT. DTSCU831
|
|
00614 SKIP3 DTSCU831
|
|
00615 S2209-MOVE. DTSCU831
|
|
00616 MOVE LOW-VALUES TO FOPR-KEY-FILLER. DTSCU831
|
|
00617 MOVE FOPR-REC TO FIO-REC. DTSCU831
|
|
00618 GO TO S2200-EXIT. DTSCU831
|
|
00619 SKIP3 DTSCU831
|
|
00620 S2210-MOVE. DTSCU831
|
|
00621 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00622 GO TO S2200-EXIT. DTSCU831
|
|
00623 SKIP3 DTSCU831
|
|
00624 S2211-MOVE. DTSCU831
|
|
00625 MOVE LOW-VALUES TO FQTR-KEY-FILLER. DTSCU831
|
|
00626 MOVE FQTR-REC TO FIO-REC. DTSCU831
|
|
00627 GO TO S2200-EXIT. DTSCU831
|
|
00628 SKIP3 DTSCU831
|
|
00629 S2212-MOVE. DTSCU831
|
|
00630 MOVE LOW-VALUES TO FAFD-KEY-FILLER. DTSCU831
|
|
00631 MOVE FAFD-REC TO FIO-REC. DTSCU831
|
|
00632 GO TO S2200-EXIT. DTSCU831
|
|
00633 SKIP3 DTSCU831
|
|
00634 S2213-MOVE. DTSCU831
|
|
00635 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00636 GO TO S2200-EXIT. DTSCU831
|
|
00637 SKIP3 DTSCU831
|
|
00638 S2214-MOVE. DTSCU831
|
|
00639 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00640 GO TO S2200-EXIT. DTSCU831
|
|
00641 SKIP3 DTSCU831
|
|
00642 S2215-MOVE. DTSCU831
|
|
00643 MOVE LOW-VALUES TO FSEL-KEY-FILLER. DTSCU831
|
|
00644 MOVE FSEL-REC TO FIO-REC. DTSCU831
|
|
00645 GO TO S2200-EXIT. DTSCU831
|
|
00646 SKIP3 DTSCU831
|
|
00647 S2216-MOVE. DTSCU831
|
|
00648 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00649 GO TO S2200-EXIT. DTSCU831
|
|
00650 SKIP3 DTSCU831
|
|
00651 S2217-MOVE. DTSCU831
|
|
00652 MOVE LOW-VALUES TO FUIR-KEY-FILLER. DTSCU831
|
|
00653 MOVE FUIR-REC TO FIO-REC. DTSCU831
|
|
00654 GO TO S2200-EXIT. DTSCU831
|
|
00655 SKIP3 DTSCU831
|
|
00656 S2218-MOVE. DTSCU831
|
|
00657 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00658 GO TO S2200-EXIT. DTSCU831
|
|
00659 SKIP3 DTSCU831
|
|
00660 S2219-MOVE. DTSCU831
|
|
00661 MOVE LOW-VALUES TO F581-KEY-FILLER. DTSCU831
|
|
00662 MOVE F581-REC TO FIO-REC. DTSCU831
|
|
00663 GO TO S2200-EXIT. DTSCU831
|
|
00664 SKIP3 DTSCU831
|
|
00665 S2220-MOVE. DTSCU831
|
|
00666 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00667 GO TO S2200-EXIT. DTSCU831
|
|
00668 SKIP3 DTSCU831
|
|
00669 S2200-EXIT. DTSCU831
|
|
00670 EXIT. DTSCU831
|
|
00671 EJECT DTSCU831
|
|
00672 S2300-CALCULATE-LENGTH. DTSCU831
|
|
00673 IF (FSKL-REC-TYPE OF FCOMM-REC < +1) DTSCU831
|
|
00674 OR DTSCU831
|
|
00675 (FSKL-REC-TYPE OF FCOMM-REC > FLEN-MAX-REC-ID) DTSCU831
|
|
00676 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00677 DTSCU831
|
|
00678 SET FLEN-IDX TO FSKL-REC-TYPE OF FCOMM-REC. DTSCU831
|
|
00679 DTSCU831
|
|
00680 IF FLEN-REC-LEN (FLEN-IDX) = +0 DTSCU831
|
|
00681 PERFORM S899-ABEND THRU S899-EXIT DTSCU831
|
|
00682 ELSE DTSCU831
|
|
00683 MOVE FLEN-REC-LEN (FLEN-IDX) TO WRK-REC-LENGTH. DTSCU831
|
|
00684 S2300-EXIT. DTSCU831
|
|
00685 EXIT. DTSCU831
|
|
00686 EJECT DTSCU831
|
|
00687 S3100-READ-UPDATE. DTSCU831
|
|
00688 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
|
00689 DTSCU831
|
|
00690 MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
|
00691 DTSCU831
|
|
00692 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
|
00693 DTSCU831
|
|
00694 EXEC CICS DTSCU831
|
|
00695 READ DTSCU831
|
|
00696 DATASET (WRK-FILE-NAME) DTSCU831
|
|
00697 INTO (FIO-REC) DTSCU831
|
|
00698 LENGTH (WRK-REC-LENGTH) DTSCU831
|
|
00699 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
|
00700 UPDATE DTSCU831
|
|
00701 RESP (WRK-RESP-CD) DTSCU831
|
|
00702 END-EXEC. DTSCU831
|
|
00703 DTSCU831
|
|
00704 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
|
00705 OR DFHRESP (SYSIDERR) DTSCU831
|
|
00706 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
|
00707 GO TO S3100-EXIT. DTSCU831
|
|
00708 DTSCU831
|
|
00709 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU831
|
|
00710 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
|
00711 GO TO S3100-EXIT. DTSCU831
|
|
00712 DTSCU831
|
|
00713 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
|
00714 NEXT SENTENCE DTSCU831
|
|
00715 ELSE DTSCU831
|
|
00716 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
|
00717 S3100-EXIT. DTSCU831
|
|
00718 EXIT. DTSCU831
|
|
00719 EJECT DTSCU831
|
|
00720 S899-ABEND. DTSCU831
|
|
00721 DTSCU831
|
|
00722 EXEC CICS DTSCU831
|
|
00723 ABEND DTSCU831
|
|
00724 ABCODE (WRK-ABEND-CD) DTSCU831
|
|
00725 END-EXEC. DTSCU831
|
|
00726 DTSCU831
|
|
00727 S899-EXIT. DTSCU831
|
|
00728 EXIT. DTSCU831
|