DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
911
CICS/DTSCU835.cob
Normal file
911
CICS/DTSCU835.cob
Normal file
@ -0,0 +1,911 @@
|
||||
00001 IDENTIFICATION DIVISION. 12/01/05
|
||||
00002 PROGRAM-ID. DTSCU835. DTSCU835
|
||||
00003 AUTHOR. TRW. LV002
|
||||
00004 DATE-WRITTEN. JANUARY 2001. DTSCU835
|
||||
00005 DATE-COMPILED. DTSCU835
|
||||
00006 DTSCU835
|
||||
00007 DTSCU835
|
||||
00008 ***** DTSCU835
|
||||
00009 * DTSCU835
|
||||
00010 * FUNCTION: ELECTRONIC MEDIA FILE INPUT/OUTPUT - CICS. DTSCU835
|
||||
00011 * DTSCU835
|
||||
00012 * DTSCU835
|
||||
00013 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSCU835
|
||||
00014 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSCU835
|
||||
00015 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSCU835
|
||||
00016 * DTSCU835
|
||||
00017 * SPECIFY TRUNC(OPT) DURING COMPILE OF DTSCU835. TRUNC DTSCU835
|
||||
00018 * (OPT) REDUCES CPU RESOURCE USAGE DURING COMPRESSION/ DTSCU835
|
||||
00019 * EXPANSION BY 50% (VS TRUNC(STD)). DTSCU835
|
||||
00020 * DTSCU835
|
||||
00021 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSCU835
|
||||
00022 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSCU835
|
||||
00023 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSCU835
|
||||
00024 * DTSCU835
|
||||
00025 * DTSCU835
|
||||
00026 * MODIFICATION LOG: DTSCU835
|
||||
00027 * DTSCU835
|
||||
00028 * 01/23/2001 INITIAL DEVELOPMENT. DTSCU835
|
||||
00029 * WORK ORDER: ELECTRONIC MEDIA PROGRAMMER: GD DTSCU835
|
||||
00030 * DTSCU835
|
||||
00031 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU835
|
||||
00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU835
|
||||
00033 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU835
|
||||
00034 * DTSCU835
|
||||
00035 * DTSCU835
|
||||
00036 * DESCRIPTION: DTSCU835
|
||||
00037 * DTSCU835
|
||||
00038 * ON-LINE ELECTRONIC MEDIA FILE I/O. DTSCU835
|
||||
00039 * DTSCU835
|
||||
00040 ***** DTSCU835
|
||||
00041 DTSCU835
|
||||
00042 DTSCU835
|
||||
00043 DTSCU835
|
||||
00044 ENVIRONMENT DIVISION. DTSCU835
|
||||
00045 DTSCU835
|
||||
00046 DTSCU835
|
||||
00047 DATA DIVISION. DTSCU835
|
||||
00048 DTSCU835
|
||||
00049 WORKING-STORAGE SECTION. DTSCU835
|
||||
000495 77 PAN-VALET PICTURE X(24) VALUE '002DTSCU835 12/01/05'. DTSCU835
|
||||
00050 DTSCU835
|
||||
00051 01 WRK-AREA. DTSCU835
|
||||
00052 05 WRK-ABEND-CD PIC X(04) VALUE 'U835'. DTSCU835
|
||||
00053 DTSCU835
|
||||
00054 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU835
|
||||
00055 DTSCU835
|
||||
00056 DTSCU835
|
||||
00057 05 WRK-PROD-FILE-NAME-PREFIX PIC X(04) VALUE 'DTSF'. DTSCU835
|
||||
00058 DTSCU835
|
||||
00059 DTSCU835
|
||||
00060 05 WRK-FILE-SUFFIXES. DTSCU835
|
||||
00061 10 FILLER PIC X(04) VALUE 'MSTE'. DTSCU835
|
||||
00062 10 FILLER PIC X(04) VALUE 'MSTF'. DTSCU835
|
||||
00063 10 FILLER PIC X(04) VALUE 'MSTG'. DTSCU835
|
||||
00064 05 FILLER REDEFINES WRK-FILE-SUFFIXES. DTSCU835
|
||||
00065 10 WRK-FILE-SUFFIX OCCURS 3 TIMES DTSCU835
|
||||
00066 PIC X(04). DTSCU835
|
||||
00067 DTSCU835
|
||||
00068 DTSCU835
|
||||
00069 05 EMSG-NOT-AVAILABLE. DTSCU835
|
||||
00070 10 FILLER PIC X(04) VALUE 'E091'. DTSCU835
|
||||
00071 10 FILLER PIC X(06) VALUE 'FILE'. DTSCU835
|
||||
00072 10 EMSG-FILE-NAME PIC X(08). DTSCU835
|
||||
00073 10 FILLER PIC X(33) DTSCU835
|
||||
00074 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU835
|
||||
00075 DTSCU835
|
||||
00076 DTSCU835
|
||||
00077 05 WRK-FILE-NAME. DTSCU835
|
||||
00078 10 WRK-FILE-NAME-PREFIX PIC X(04). DTSCU835
|
||||
00079 10 WRK-FILE-NAME-SUFFIX PIC X(04). DTSCU835
|
||||
00080 DTSCU835
|
||||
00081 DTSCU835
|
||||
00082 05 REC-TYPE-SUB PIC S9(04) COMP. DTSCU835
|
||||
00083 DTSCU835
|
||||
00084 05 FILE-SUB PIC S9(04) COMP. DTSCU835
|
||||
00085 DTSCU835
|
||||
00086 DTSCU835
|
||||
00087 05 MIO-KEY-AREA. DTSCU835
|
||||
00088 10 MIO-REC-TYPE PIC S9(04) COMP. DTSCU835
|
||||
00089 10 FILLER PIC X(22). DTSCU835
|
||||
00090 05 FILLER REDEFINES MIO-KEY-AREA. DTSCU835
|
||||
00091 10 FILLER PIC X(02). DTSCU835
|
||||
00092 10 MIO-LOG-NO PIC X(10). DTSCU835
|
||||
00093 10 FILLER PIC X(12). DTSCU835
|
||||
00094 05 FILLER REDEFINES MIO-KEY-AREA. DTSCU835
|
||||
00095 10 FILLER PIC X(02). DTSCU835
|
||||
00096 10 MIO-ELF-ID PIC S9(07) COMP-3. DTSCU835
|
||||
00097 10 FILLER PIC X(18). DTSCU835
|
||||
00098 DTSCU835
|
||||
00099 05 MIO-REC-LENGTH PIC S9(04) COMP. DTSCU835
|
||||
00100 DTSCU835
|
||||
00101 05 MIO-KEY-LENGTH PIC S9(04) COMP. DTSCU835
|
||||
00102 DTSCU835
|
||||
00103 05 MIO-KEY-FILLER-LENGTH PIC S9(04) COMP. DTSCU835
|
||||
00104 DTSCU835
|
||||
00105 05 MIO-KEY-FILLER-START PIC S9(04) COMP. DTSCU835
|
||||
00106 DTSCU835
|
||||
00107 DTSCU835
|
||||
00108 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU835
|
||||
00109 DTSCU835
|
||||
00110 05 WRK-DATA-LENGTH PIC S9(04) COMP. DTSCU835
|
||||
00111 DTSCU835
|
||||
00112 DTSCU835
|
||||
00113 DTSCU835
|
||||
00114 05 COUNT-COMPLETE-IND PIC X(01). DTSCU835
|
||||
00115 EJECT DTSCU835
|
||||
00116 01 ELEN-LENGTH-LITERALS. DTSCU835
|
||||
00117 ++INCLUDE DTSIELEN DTSCU835
|
||||
00118 EJECT DTSCU835
|
||||
00119 01 WRK-REC. DTSCU835
|
||||
00120 ++INCLUDE DTSIESKL DTSCU835
|
||||
00121 SKIP3 DTSCU835
|
||||
00122 01 FILLER REDEFINES WRK-REC. DTSCU835
|
||||
00123 05 WRK-DATA-CHAR OCCURS 1024 TIMES DTSCU835
|
||||
00124 INDEXED BY WRK-DATA-IDX DTSCU835
|
||||
00125 PIC X(01). DTSCU835
|
||||
00126 SKIP3 DTSCU835
|
||||
00127 01 EPRF-REC REDEFINES WRK-REC. DTSCU835
|
||||
00128 ++INCLUDE DTSIEPRF DTSCU835
|
||||
00129 SKIP3 DTSCU835
|
||||
00130 01 ELOG-REC REDEFINES WRK-REC. DTSCU835
|
||||
00131 ++INCLUDE DTSIELOG DTSCU835
|
||||
00132 SKIP3 DTSCU835
|
||||
00133 01 EEMH-REC REDEFINES WRK-REC. DTSCU835
|
||||
00134 ++INCLUDE DTSIEEMH DTSCU835
|
||||
00135 SKIP3 DTSCU835
|
||||
00136 01 AIX-WORK-AREA. DTSCU835
|
||||
00137 ++INCLUDE DTSIXAIX DTSCU835
|
||||
00138 EJECT DTSCU835
|
||||
00139 01 L821-COMM-AREA. DTSCU835
|
||||
00140 05 L821-CONTROL-AREA. DTSCU835
|
||||
00141 ++INCLUDE DTSIL821 DTSCU835
|
||||
00142 SKIP3 DTSCU835
|
||||
00143 05 ISKL-REC. DTSCU835
|
||||
00144 ++INCLUDE DTSIISKL DTSCU835
|
||||
00145 SKIP3 DTSCU835
|
||||
00146 05 IENM-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00147 ++INCLUDE DTSIIENM DTSCU835
|
||||
00148 SKIP3 DTSCU835
|
||||
00149 05 IEAL-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00150 ++INCLUDE DTSIIEAL DTSCU835
|
||||
00151 SKIP3 DTSCU835
|
||||
00152 05 IEAE-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00153 ++INCLUDE DTSIIEAE DTSCU835
|
||||
00154 SKIP3 DTSCU835
|
||||
00155 05 IEBX-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00156 ++INCLUDE DTSIIEBX DTSCU835
|
||||
00157 SKIP3 DTSCU835
|
||||
00158 05 IEOP-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00159 ++INCLUDE DTSIIEOP DTSCU835
|
||||
00160 SKIP3 DTSCU835
|
||||
00161 05 IESR-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00162 ++INCLUDE DTSIIESR DTSCU835
|
||||
00163 SKIP3 DTSCU835
|
||||
00164 05 IEER-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00165 ++INCLUDE DTSIIEER DTSCU835
|
||||
00166 SKIP3 DTSCU835
|
||||
00167 05 IEET-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00168 ++INCLUDE DTSIIEET DTSCU835
|
||||
00169 SKIP3 DTSCU835
|
||||
00170 05 IEPR-REC REDEFINES ISKL-REC. DTSCU835
|
||||
00171 ++INCLUDE DTSIIEPR DTSCU835
|
||||
00172 EJECT DTSCU835
|
||||
00173 LINKAGE SECTION. DTSCU835
|
||||
00174 SKIP3 DTSCU835
|
||||
00175 01 DFHCOMMAREA. DTSCU835
|
||||
00176 05 L835-CONTROL-BLOCK. DTSCU835
|
||||
00177 ++INCLUDE DTSIL835 DTSCU835
|
||||
00178 SKIP3 DTSCU835
|
||||
00179 05 MCOMM-REC. DTSCU835
|
||||
00180 ++INCLUDE DTSIESKL DTSCU835
|
||||
00181 EJECT DTSCU835
|
||||
00182 PROCEDURE DIVISION. DTSCU835
|
||||
00183 MOVE WRK-PROD-FILE-NAME-PREFIX DTSCU835
|
||||
00184 TO WRK-FILE-NAME-PREFIX. DTSCU835
|
||||
00185 DTSCU835
|
||||
00186 DTSCU835
|
||||
00187 MOVE +0 TO L835-RECORD-CNT. DTSCU835
|
||||
00188 DTSCU835
|
||||
00189 MOVE SPACES TO L835-MSG-AREA. DTSCU835
|
||||
00190 DTSCU835
|
||||
00191 SET L835-OK-88 TO TRUE. DTSCU835
|
||||
00192 DTSCU835
|
||||
00193 DTSCU835
|
||||
00194 MOVE ESKL-REC-TYPE OF MCOMM-REC TO REC-TYPE-SUB. DTSCU835
|
||||
00195 DTSCU835
|
||||
00196 IF (REC-TYPE-SUB < +1) DTSCU835
|
||||
00197 OR DTSCU835
|
||||
00198 (REC-TYPE-SUB > ELEN-MAX-REC-ID) DTSCU835
|
||||
00199 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00200 DTSCU835
|
||||
00201 DTSCU835
|
||||
00202 MOVE ELEN-FILE-ID (REC-TYPE-SUB) TO FILE-SUB. DTSCU835
|
||||
00203 DTSCU835
|
||||
00204 IF FILE-SUB = +0 DTSCU835
|
||||
00205 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00206 DTSCU835
|
||||
00207 MOVE WRK-FILE-SUFFIX (FILE-SUB) DTSCU835
|
||||
00208 TO WRK-FILE-NAME-SUFFIX. DTSCU835
|
||||
00209 DTSCU835
|
||||
00210 DTSCU835
|
||||
00211 IF L835-READ-88 DTSCU835
|
||||
00212 PERFORM P1100-READ THRU P1100-EXIT DTSCU835
|
||||
00213 ELSE DTSCU835
|
||||
00214 IF L835-START-BROWSE-88 DTSCU835
|
||||
00215 PERFORM P1200-START-BROWSE THRU P1200-EXIT DTSCU835
|
||||
00216 ELSE DTSCU835
|
||||
00217 IF L835-READ-NEXT-88 DTSCU835
|
||||
00218 PERFORM P1300-READ-NEXT THRU P1300-EXIT DTSCU835
|
||||
00219 ELSE DTSCU835
|
||||
00220 IF L835-READ-PREV-88 DTSCU835
|
||||
00221 PERFORM P1400-READ-PREV THRU P1400-EXIT DTSCU835
|
||||
00222 ELSE DTSCU835
|
||||
00223 IF L835-COUNT-88 DTSCU835
|
||||
00224 PERFORM P1500-COUNT THRU P1500-EXIT DTSCU835
|
||||
00225 ELSE DTSCU835
|
||||
00226 IF L835-END-BROWSE-88 DTSCU835
|
||||
00227 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00228 ELSE DTSCU835
|
||||
00229 IF L835-WRITE-88 DTSCU835
|
||||
00230 PERFORM P2100-WRITE THRU P2100-EXIT DTSCU835
|
||||
00231 ELSE DTSCU835
|
||||
00232 IF L835-REWRITE-88 DTSCU835
|
||||
00233 PERFORM P2200-REWRITE THRU P2200-EXIT DTSCU835
|
||||
00234 ELSE DTSCU835
|
||||
00235 IF L835-DELETE-88 DTSCU835
|
||||
00236 PERFORM P2300-DELETE THRU P2300-EXIT DTSCU835
|
||||
00237 ELSE DTSCU835
|
||||
00238 IF L835-READ-UPDATE-88 DTSCU835
|
||||
00239 PERFORM P3100-READ-UPDATE THRU P3100-EXIT DTSCU835
|
||||
00240 ELSE DTSCU835
|
||||
00241 IF L835-REWRITE-UPDATE-88 DTSCU835
|
||||
00242 PERFORM P3200-REWRITE-UPDATE THRU P3200-EXIT DTSCU835
|
||||
00243 ELSE DTSCU835
|
||||
00244 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00245 DTSCU835
|
||||
00246 DTSCU835
|
||||
00247 EXEC CICS DTSCU835
|
||||
00248 RETURN DTSCU835
|
||||
00249 END-EXEC. DTSCU835
|
||||
00250 DTSCU835
|
||||
00251 DTSCU835
|
||||
00252 GOBACK. DTSCU835
|
||||
00253 EJECT DTSCU835
|
||||
00254 P1100-READ. DTSCU835
|
||||
00255 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00256 DTSCU835
|
||||
00257 MOVE ELEN-MAX-REC-LEN TO MIO-REC-LENGTH. DTSCU835
|
||||
00258 DTSCU835
|
||||
00259 EXEC CICS DTSCU835
|
||||
00260 READ DTSCU835
|
||||
00261 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00262 INTO (WRK-REC) DTSCU835
|
||||
00263 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00264 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00265 RESP (WRK-RESP-CD) DTSCU835
|
||||
00266 END-EXEC. DTSCU835
|
||||
00267 DTSCU835
|
||||
00268 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00269 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00270 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00271 GO TO P1100-EXIT. DTSCU835
|
||||
00272 DTSCU835
|
||||
00273 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU835
|
||||
00274 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00275 GO TO P1100-EXIT. DTSCU835
|
||||
00276 DTSCU835
|
||||
00277 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00278 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00279 DTSCU835
|
||||
00280 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT. DTSCU835
|
||||
00281 P1100-EXIT. DTSCU835
|
||||
00282 EXIT. DTSCU835
|
||||
00283 EJECT DTSCU835
|
||||
00284 P1200-START-BROWSE. DTSCU835
|
||||
00285 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00286 DTSCU835
|
||||
00287 EXEC CICS DTSCU835
|
||||
00288 STARTBR DTSCU835
|
||||
00289 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00290 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00291 RESP (WRK-RESP-CD) DTSCU835
|
||||
00292 END-EXEC. DTSCU835
|
||||
00293 DTSCU835
|
||||
00294 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00295 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00296 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00297 GO TO P1200-EXIT. DTSCU835
|
||||
00298 DTSCU835
|
||||
00299 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU835
|
||||
00300 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00301 GO TO P1200-EXIT. DTSCU835
|
||||
00302 DTSCU835
|
||||
00303 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00304 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00305 DTSCU835
|
||||
00306 PERFORM P1300-READ-NEXT THRU P1300-EXIT. DTSCU835
|
||||
00307 P1200-EXIT. DTSCU835
|
||||
00308 EXIT. DTSCU835
|
||||
00309 EJECT DTSCU835
|
||||
00310 P1300-READ-NEXT. DTSCU835
|
||||
00311 IF L835-READ-NEXT-88 DTSCU835
|
||||
00312 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00313 DTSCU835
|
||||
00314 MOVE ELEN-MAX-REC-LEN TO MIO-REC-LENGTH. DTSCU835
|
||||
00315 DTSCU835
|
||||
00316 EXEC CICS DTSCU835
|
||||
00317 READNEXT DTSCU835
|
||||
00318 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00319 INTO (WRK-REC) DTSCU835
|
||||
00320 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00321 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00322 RESP (WRK-RESP-CD) DTSCU835
|
||||
00323 END-EXEC. DTSCU835
|
||||
00324 DTSCU835
|
||||
00325 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00326 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00327 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00328 GO TO P1300-EXIT. DTSCU835
|
||||
00329 DTSCU835
|
||||
00330 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU835
|
||||
00331 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00332 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00333 GO TO P1300-EXIT. DTSCU835
|
||||
00334 DTSCU835
|
||||
00335 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00336 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00337 DTSCU835
|
||||
00338 ************************************************************* DTSCU835
|
||||
00339 * FOR ALL RECORD TYPES, SET NO RECORD FOUND AT A DTSCU835
|
||||
00340 * BREAK IN RECORD TYPE. DTSCU835
|
||||
00341 ************************************************************* DTSCU835
|
||||
00342 IF ESKL-REC-TYPE OF WRK-REC NOT = DTSCU835
|
||||
00343 ESKL-REC-TYPE OF MCOMM-REC DTSCU835
|
||||
00344 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00345 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00346 GO TO P1300-EXIT. DTSCU835
|
||||
00347 DTSCU835
|
||||
00348 ************************************************************* DTSCU835
|
||||
00349 * FOR THE MESSAGE (EMSG) AND TRIGGER (ETRG) FILES, SET DTSCU835
|
||||
00350 * NO RECORD FOUND AT A BREAK IN LOG NUMBER. DTSCU835
|
||||
00351 * FOR THE EMPLOYER HISTORY FILE (EEMH) SET DTSCU835
|
||||
00352 * NO RECORD FOUND AT A BREAK IN EMP NUMBER. DTSCU835
|
||||
00353 ************************************************************* DTSCU835
|
||||
00354 IF ESKL-MSG-88 OF WRK-REC DTSCU835
|
||||
00355 OR ESKL-TRG-88 OF WRK-REC DTSCU835
|
||||
00356 IF ESKL-ELOG-LOG-NO OF WRK-REC = CL**2
|
||||
00357 ESKL-ELOG-LOG-NO OF MCOMM-REC CL**2
|
||||
00358 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU835
|
||||
00359 ELSE DTSCU835
|
||||
00360 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00361 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00362 END-IF DTSCU835
|
||||
00363 ELSE DTSCU835
|
||||
00364 IF ESKL-EMH-88 OF WRK-REC DTSCU835
|
||||
00365 IF ESKL-EMP-NO OF WRK-REC = ESKL-EMP-NO OF MCOMM-REC DTSCU835
|
||||
00366 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU835
|
||||
00367 ELSE DTSCU835
|
||||
00368 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00369 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00370 END-IF DTSCU835
|
||||
00371 ELSE DTSCU835
|
||||
00372 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU835
|
||||
00373 END-IF. DTSCU835
|
||||
00374 DTSCU835
|
||||
00375 P1300-EXIT. DTSCU835
|
||||
00376 EXIT. DTSCU835
|
||||
00377 EJECT DTSCU835
|
||||
00378 P1400-READ-PREV. DTSCU835
|
||||
00379 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00380 DTSCU835
|
||||
00381 MOVE ELEN-MAX-REC-LEN TO MIO-REC-LENGTH. DTSCU835
|
||||
00382 DTSCU835
|
||||
00383 EXEC CICS DTSCU835
|
||||
00384 READPREV DTSCU835
|
||||
00385 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00386 INTO (WRK-REC) DTSCU835
|
||||
00387 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00388 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00389 RESP (WRK-RESP-CD) DTSCU835
|
||||
00390 END-EXEC. DTSCU835
|
||||
00391 DTSCU835
|
||||
00392 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00393 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00394 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00395 GO TO P1400-EXIT. DTSCU835
|
||||
00396 DTSCU835
|
||||
00397 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU835
|
||||
00398 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00399 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00400 GO TO P1400-EXIT. DTSCU835
|
||||
00401 DTSCU835
|
||||
00402 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00403 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00404 DTSCU835
|
||||
00405 ************************************************************* DTSCU835
|
||||
00406 * FOR ALL RECORD TYPES, SET NO RECORD FOUND AT A DTSCU835
|
||||
00407 * BREAK IN RECORD TYPE. DTSCU835
|
||||
00408 ************************************************************* DTSCU835
|
||||
00409 IF ESKL-REC-TYPE OF WRK-REC NOT = DTSCU835
|
||||
00410 ESKL-REC-TYPE OF MCOMM-REC DTSCU835
|
||||
00411 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00412 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00413 GO TO P1400-EXIT. DTSCU835
|
||||
00414 DTSCU835
|
||||
00415 ************************************************************* DTSCU835
|
||||
00416 * FOR THE MESSAGE (EMSG) AND TRIGGER (ETRG) FILES, SET DTSCU835
|
||||
00417 * NO RECORD FOUND AT A BREAK IN LOG NUMBER. DTSCU835
|
||||
00418 * FOR THE EMPLOYER HISTORY FILE (EEMH) SET DTSCU835
|
||||
00419 * NO RECORD FOUND AT A BREAK IN EMP NUMBER. DTSCU835
|
||||
00420 ************************************************************* DTSCU835
|
||||
00421 IF ESKL-MSG-88 OF WRK-REC DTSCU835
|
||||
00422 OR ESKL-TRG-88 OF WRK-REC DTSCU835
|
||||
00423 IF ESKL-ELOG-LOG-NO OF WRK-REC = CL**2
|
||||
00424 ESKL-ELOG-LOG-NO OF MCOMM-REC CL**2
|
||||
00425 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU835
|
||||
00426 ELSE DTSCU835
|
||||
00427 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00428 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00429 END-IF DTSCU835
|
||||
00430 ELSE DTSCU835
|
||||
00431 IF ESKL-EMH-88 OF WRK-REC DTSCU835
|
||||
00432 IF ESKL-EMP-NO OF WRK-REC = ESKL-EMP-NO OF MCOMM-REC DTSCU835
|
||||
00433 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU835
|
||||
00434 ELSE DTSCU835
|
||||
00435 PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00436 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00437 END-IF DTSCU835
|
||||
00438 ELSE DTSCU835
|
||||
00439 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU835
|
||||
00440 END-IF. DTSCU835
|
||||
00441 DTSCU835
|
||||
00442 P1400-EXIT. DTSCU835
|
||||
00443 EXIT. DTSCU835
|
||||
00444 EJECT DTSCU835
|
||||
00445 P1500-COUNT. DTSCU835
|
||||
00446 * MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00447 * DTSCU835
|
||||
00448 * IF MSKL-AUY-88 OF MCOMM-REC OR MSKL-FAR-88 OF MCOMM-REC DTSCU835
|
||||
00449 * MOVE LOW-VALUES TO MIO-KEY-AREA (12:5) DTSCU835
|
||||
00450 * ELSE DTSCU835
|
||||
00451 * MOVE LOW-VALUES TO MIO-KEY-FILLER. DTSCU835
|
||||
00452 * DTSCU835
|
||||
00453 * EXEC CICS DTSCU835
|
||||
00454 * STARTBR DTSCU835
|
||||
00455 * DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00456 * RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00457 * RESP (WRK-RESP-CD) DTSCU835
|
||||
00458 * END-EXEC. DTSCU835
|
||||
00459 * DTSCU835
|
||||
00460 * IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00461 * OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00462 * PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00463 * GO TO P1500-EXIT. DTSCU835
|
||||
00464 * DTSCU835
|
||||
00465 * SET L835-NO-REC-88 TO TRUE. DTSCU835
|
||||
00466 * DTSCU835
|
||||
00467 * IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU835
|
||||
00468 * MOVE +0 TO L835-RECORD-CNT DTSCU835
|
||||
00469 * GO TO P1500-EXIT. DTSCU835
|
||||
00470 * DTSCU835
|
||||
00471 * IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00472 * PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00473 * DTSCU835
|
||||
00474 * DTSCU835
|
||||
00475 * MOVE +0 TO L835-RECORD-CNT. DTSCU835
|
||||
00476 * DTSCU835
|
||||
00477 * MOVE 'N' TO COUNT-COMPLETE-IND. DTSCU835
|
||||
00478 * DTSCU835
|
||||
00479 * PERFORM P1510-COUNT-LOOP THRU P1510-EXIT DTSCU835
|
||||
00480 * UNTIL COUNT-COMPLETE-IND = 'Y'. DTSCU835
|
||||
00481 P1500-EXIT. DTSCU835
|
||||
00482 EXIT. DTSCU835
|
||||
00483 SKIP3 DTSCU835
|
||||
00484 P1510-COUNT-LOOP. DTSCU835
|
||||
00485 * MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH. DTSCU835
|
||||
00486 * DTSCU835
|
||||
00487 * EXEC CICS DTSCU835
|
||||
00488 * READNEXT DTSCU835
|
||||
00489 * DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00490 * INTO (MIO-REC) DTSCU835
|
||||
00491 * LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00492 * RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00493 * RESP (WRK-RESP-CD) DTSCU835
|
||||
00494 * END-EXEC. DTSCU835
|
||||
00495 * DTSCU835
|
||||
00496 * IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00497 * OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00498 * PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00499 * MOVE 'Y' TO COUNT-COMPLETE-IND DTSCU835
|
||||
00500 * GO TO P1510-EXIT. DTSCU835
|
||||
00501 * DTSCU835
|
||||
00502 * IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU835
|
||||
00503 * PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00504 * MOVE 'Y' TO COUNT-COMPLETE-IND DTSCU835
|
||||
00505 * GO TO P1510-EXIT. DTSCU835
|
||||
00506 * DTSCU835
|
||||
00507 * IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00508 * PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00509 * DTSCU835
|
||||
00510 * DTSCU835
|
||||
00511 * IF MSKL-AUY-88 OF MCOMM-REC OR MSKL-FAR-88 OF MCOMM-REC DTSCU835
|
||||
00512 * IF (MIO-KEY-AREA (1:11) DTSCU835
|
||||
00513 * = MSKL-KEY-AREA OF MCOMM-REC (1:11)) DTSCU835
|
||||
00514 * ADD +1 TO L835-RECORD-CNT DTSCU835
|
||||
00515 * SET L835-OK-88 TO TRUE DTSCU835
|
||||
00516 * MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF MCOMM-REC DTSCU835
|
||||
00517 * ELSE DTSCU835
|
||||
00518 * PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00519 * MOVE 'Y' TO COUNT-COMPLETE-IND DTSCU835
|
||||
00520 * ELSE DTSCU835
|
||||
00521 * IF (MIO-EMP-NO = MSKL-EMP-NO OF MCOMM-REC) DTSCU835
|
||||
00522 * AND DTSCU835
|
||||
00523 * (MIO-REC-TYPE = MSKL-REC-TYPE OF MCOMM-REC) DTSCU835
|
||||
00524 * ADD +1 TO L835-RECORD-CNT DTSCU835
|
||||
00525 * SET L835-OK-88 TO TRUE DTSCU835
|
||||
00526 * MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF MCOMM-REC DTSCU835
|
||||
00527 * ELSE DTSCU835
|
||||
00528 * PERFORM P1600-END-BROWSE THRU P1600-EXIT DTSCU835
|
||||
00529 * MOVE 'Y' TO COUNT-COMPLETE-IND. DTSCU835
|
||||
00530 P1510-EXIT. DTSCU835
|
||||
00531 EXIT. DTSCU835
|
||||
00532 EJECT DTSCU835
|
||||
00533 P1600-END-BROWSE. DTSCU835
|
||||
00534 DTSCU835
|
||||
00535 EXEC CICS DTSCU835
|
||||
00536 ENDBR DTSCU835
|
||||
00537 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00538 RESP (WRK-RESP-CD) DTSCU835
|
||||
00539 END-EXEC. DTSCU835
|
||||
00540 DTSCU835
|
||||
00541 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00542 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00543 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00544 GO TO P1600-EXIT. DTSCU835
|
||||
00545 DTSCU835
|
||||
00546 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU835
|
||||
00547 NEXT SENTENCE DTSCU835
|
||||
00548 ELSE DTSCU835
|
||||
00549 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00550 P1600-EXIT. DTSCU835
|
||||
00551 EXIT. DTSCU835
|
||||
00552 EJECT DTSCU835
|
||||
00553 P2100-WRITE. DTSCU835
|
||||
00554 MOVE ELEN-REC-LEN (REC-TYPE-SUB) DTSCU835
|
||||
00555 TO MIO-REC-LENGTH. DTSCU835
|
||||
00556 DTSCU835
|
||||
00557 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU835
|
||||
00558 DTSCU835
|
||||
00559 PERFORM P2110-INITIALIZE-KEY-FILLER THRU P2110-EXIT. DTSCU835
|
||||
00560 DTSCU835
|
||||
00561 EXEC CICS DTSCU835
|
||||
00562 WRITE DTSCU835
|
||||
00563 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00564 FROM (WRK-REC) DTSCU835
|
||||
00565 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00566 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00567 RESP (WRK-RESP-CD) DTSCU835
|
||||
00568 END-EXEC. DTSCU835
|
||||
00569 DTSCU835
|
||||
00570 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00571 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00572 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00573 GO TO P2100-EXIT. DTSCU835
|
||||
00574 DTSCU835
|
||||
00575 IF L835-WRITE-CHK-DUP-KEY-88 DTSCU835
|
||||
00576 IF WRK-RESP-CD = DFHRESP (DUPKEY) DTSCU835
|
||||
00577 SET L835-DUP-KEY-88 TO TRUE DTSCU835
|
||||
00578 GO TO P2100-EXIT. DTSCU835
|
||||
00579 DTSCU835
|
||||
00580 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00581 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00582 DTSCU835
|
||||
00583 DTSCU835
|
||||
00584 MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS. DTSCU835
|
||||
00585 DTSCU835
|
||||
00586 PERFORM S3200-CONSTRUCT-IPOST THRU S3200-EXIT. DTSCU835
|
||||
00587 DTSCU835
|
||||
00588 PERFORM S3300-UPDATE-AIX THRU S3300-EXIT. DTSCU835
|
||||
00589 P2100-EXIT. DTSCU835
|
||||
00590 EXIT. DTSCU835
|
||||
00591 SKIP3 DTSCU835
|
||||
00592 P2110-INITIALIZE-KEY-FILLER. DTSCU835
|
||||
00593 COMPUTE MIO-KEY-FILLER-START DTSCU835
|
||||
00594 = ELEN-KEY-LEN (REC-TYPE-SUB) + 1. DTSCU835
|
||||
00595 DTSCU835
|
||||
00596 COMPUTE MIO-KEY-FILLER-LENGTH DTSCU835
|
||||
00597 = ELEN-MAX-KEY-LEN - ELEN-KEY-LEN (REC-TYPE-SUB). DTSCU835
|
||||
00598 DTSCU835
|
||||
00599 IF MIO-KEY-FILLER-LENGTH > +0 DTSCU835
|
||||
00600 MOVE LOW-VALUES DTSCU835
|
||||
00601 TO MIO-KEY-AREA DTSCU835
|
||||
00602 (MIO-KEY-FILLER-START:MIO-KEY-FILLER-LENGTH). DTSCU835
|
||||
00603 P2110-EXIT. DTSCU835
|
||||
00604 EXIT. DTSCU835
|
||||
00605 EJECT DTSCU835
|
||||
00606 P2200-REWRITE. DTSCU835
|
||||
00607 PERFORM P2900-PREPARE-FOR-UPDATE THRU P2900-EXIT. DTSCU835
|
||||
00608 DTSCU835
|
||||
00609 IF L835-NO-REC-88 DTSCU835
|
||||
00610 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00611 DTSCU835
|
||||
00612 IF L835-FILE-CLOSED-88 DTSCU835
|
||||
00613 GO TO P2200-EXIT. DTSCU835
|
||||
00614 DTSCU835
|
||||
00615 MOVE ELEN-REC-LEN (REC-TYPE-SUB) DTSCU835
|
||||
00616 TO MIO-REC-LENGTH. DTSCU835
|
||||
00617 DTSCU835
|
||||
00618 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU835
|
||||
00619 DTSCU835
|
||||
00620 EXEC CICS DTSCU835
|
||||
00621 REWRITE DTSCU835
|
||||
00622 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00623 FROM (WRK-REC) DTSCU835
|
||||
00624 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00625 RESP (WRK-RESP-CD) DTSCU835
|
||||
00626 END-EXEC. DTSCU835
|
||||
00627 DTSCU835
|
||||
00628 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00629 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00630 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00631 GO TO P2200-EXIT. DTSCU835
|
||||
00632 DTSCU835
|
||||
00633 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00634 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00635 DTSCU835
|
||||
00636 DTSCU835
|
||||
00637 PERFORM S3200-CONSTRUCT-IPOST THRU S3200-EXIT. DTSCU835
|
||||
00638 DTSCU835
|
||||
00639 PERFORM S3300-UPDATE-AIX THRU S3300-EXIT. DTSCU835
|
||||
00640 P2200-EXIT. DTSCU835
|
||||
00641 EXIT. DTSCU835
|
||||
00642 EJECT DTSCU835
|
||||
00643 P2300-DELETE. DTSCU835
|
||||
00644 PERFORM P2900-PREPARE-FOR-UPDATE THRU P2900-EXIT. DTSCU835
|
||||
00645 DTSCU835
|
||||
00646 IF L835-NO-REC-88 DTSCU835
|
||||
00647 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00648 DTSCU835
|
||||
00649 IF L835-FILE-CLOSED-88 DTSCU835
|
||||
00650 GO TO P2300-EXIT. DTSCU835
|
||||
00651 DTSCU835
|
||||
00652 EXEC CICS DTSCU835
|
||||
00653 DELETE DTSCU835
|
||||
00654 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00655 RESP (WRK-RESP-CD) DTSCU835
|
||||
00656 END-EXEC. DTSCU835
|
||||
00657 DTSCU835
|
||||
00658 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00659 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00660 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00661 GO TO P2300-EXIT. DTSCU835
|
||||
00662 DTSCU835
|
||||
00663 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00664 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00665 DTSCU835
|
||||
00666 DTSCU835
|
||||
00667 MOVE LOW-VALUES TO POST-UPDATE-AIX-RECS. DTSCU835
|
||||
00668 DTSCU835
|
||||
00669 PERFORM S3300-UPDATE-AIX THRU S3300-EXIT. DTSCU835
|
||||
00670 P2300-EXIT. DTSCU835
|
||||
00671 EXIT. DTSCU835
|
||||
00672 EJECT DTSCU835
|
||||
00673 P2900-PREPARE-FOR-UPDATE. DTSCU835
|
||||
00674 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00675 DTSCU835
|
||||
00676 MOVE ELEN-MAX-REC-LEN TO MIO-REC-LENGTH. DTSCU835
|
||||
00677 DTSCU835
|
||||
00678 EXEC CICS DTSCU835
|
||||
00679 READ DTSCU835
|
||||
00680 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00681 INTO (WRK-REC) DTSCU835
|
||||
00682 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00683 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00684 UPDATE DTSCU835
|
||||
00685 RESP (WRK-RESP-CD) DTSCU835
|
||||
00686 END-EXEC. DTSCU835
|
||||
00687 DTSCU835
|
||||
00688 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00689 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00690 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00691 GO TO P2900-EXIT. DTSCU835
|
||||
00692 DTSCU835
|
||||
00693 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU835
|
||||
00694 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00695 GO TO P2900-EXIT. DTSCU835
|
||||
00696 DTSCU835
|
||||
00697 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00698 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00699 DTSCU835
|
||||
00700 DTSCU835
|
||||
00701 IF ELEN-AIX-YES-88 (REC-TYPE-SUB) DTSCU835
|
||||
00702 PERFORM S3100-CONSTRUCT-IPRE THRU S3100-EXIT DTSCU835
|
||||
00703 ELSE DTSCU835
|
||||
00704 MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS. DTSCU835
|
||||
00705 P2900-EXIT. DTSCU835
|
||||
00706 EXIT. DTSCU835
|
||||
00707 EJECT DTSCU835
|
||||
00708 P3100-READ-UPDATE. DTSCU835
|
||||
00709 IF (ESKL-HDR-88 OF MCOMM-REC) DTSCU835
|
||||
00710 OR DTSCU835
|
||||
00711 (ESKL-PRF-88 OF MCOMM-REC) DTSCU835
|
||||
00712 NEXT SENTENCE DTSCU835
|
||||
00713 ELSE DTSCU835
|
||||
00714 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00715 DTSCU835
|
||||
00716 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00717 DTSCU835
|
||||
00718 MOVE ELEN-MAX-REC-LEN TO MIO-REC-LENGTH. DTSCU835
|
||||
00719 DTSCU835
|
||||
00720 EXEC CICS DTSCU835
|
||||
00721 READ DTSCU835
|
||||
00722 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00723 INTO (WRK-REC) DTSCU835
|
||||
00724 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00725 RIDFLD (MIO-KEY-AREA) DTSCU835
|
||||
00726 UPDATE DTSCU835
|
||||
00727 RESP (WRK-RESP-CD) DTSCU835
|
||||
00728 END-EXEC. DTSCU835
|
||||
00729 DTSCU835
|
||||
00730 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00731 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00732 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00733 GO TO P3100-EXIT. DTSCU835
|
||||
00734 DTSCU835
|
||||
00735 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU835
|
||||
00736 PERFORM S1100-NO-REC THRU S1100-EXIT DTSCU835
|
||||
00737 GO TO P3100-EXIT. DTSCU835
|
||||
00738 DTSCU835
|
||||
00739 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00740 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00741 DTSCU835
|
||||
00742 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT. DTSCU835
|
||||
00743 P3100-EXIT. DTSCU835
|
||||
00744 EXIT. DTSCU835
|
||||
00745 EJECT DTSCU835
|
||||
00746 P3200-REWRITE-UPDATE. DTSCU835
|
||||
00747 IF (ESKL-HDR-88 OF MCOMM-REC) DTSCU835
|
||||
00748 OR DTSCU835
|
||||
00749 (ESKL-PRF-88 OF MCOMM-REC) DTSCU835
|
||||
00750 NEXT SENTENCE DTSCU835
|
||||
00751 ELSE DTSCU835
|
||||
00752 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00753 DTSCU835
|
||||
00754 MOVE ELEN-REC-LEN (REC-TYPE-SUB) DTSCU835
|
||||
00755 TO MIO-REC-LENGTH. DTSCU835
|
||||
00756 DTSCU835
|
||||
00757 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU835
|
||||
00758 DTSCU835
|
||||
00759 EXEC CICS DTSCU835
|
||||
00760 REWRITE DTSCU835
|
||||
00761 DATASET (WRK-FILE-NAME) DTSCU835
|
||||
00762 FROM (WRK-REC) DTSCU835
|
||||
00763 LENGTH (MIO-REC-LENGTH) DTSCU835
|
||||
00764 RESP (WRK-RESP-CD) DTSCU835
|
||||
00765 END-EXEC. DTSCU835
|
||||
00766 DTSCU835
|
||||
00767 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU835
|
||||
00768 OR DFHRESP (SYSIDERR) DTSCU835
|
||||
00769 PERFORM S1200-FILE-CLOSED THRU S1200-EXIT DTSCU835
|
||||
00770 GO TO P3200-EXIT. DTSCU835
|
||||
00771 DTSCU835
|
||||
00772 IF WRK-RESP-CD NOT = DFHRESP (NORMAL) DTSCU835
|
||||
00773 PERFORM S999-ABEND THRU S999-EXIT. DTSCU835
|
||||
00774 P3200-EXIT. DTSCU835
|
||||
00775 EXIT. DTSCU835
|
||||
00776 EJECT DTSCU835
|
||||
00777 S1100-NO-REC. DTSCU835
|
||||
00778 SET L835-NO-REC-88 TO TRUE. DTSCU835
|
||||
00779 S1100-EXIT. DTSCU835
|
||||
00780 EXIT. DTSCU835
|
||||
00781 SKIP3 DTSCU835
|
||||
00782 S1200-FILE-CLOSED. DTSCU835
|
||||
00783 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU835
|
||||
00784 DTSCU835
|
||||
00785 MOVE EMSG-NOT-AVAILABLE TO L835-MSG-AREA. DTSCU835
|
||||
00786 DTSCU835
|
||||
00787 SET L835-FILE-CLOSED-88 TO TRUE. DTSCU835
|
||||
00788 S1200-EXIT. DTSCU835
|
||||
00789 EXIT. DTSCU835
|
||||
00790 SKIP3 DTSCU835
|
||||
00791 S1300-AIX-NOT-AVAILABLE. DTSCU835
|
||||
00792 MOVE L821-MSG-AREA TO L835-MSG-AREA. DTSCU835
|
||||
00793 DTSCU835
|
||||
00794 SET L835-FILE-CLOSED-88 TO TRUE. DTSCU835
|
||||
00795 S1300-EXIT. DTSCU835
|
||||
00796 EXIT. DTSCU835
|
||||
00797 EJECT DTSCU835
|
||||
00798 S2100-IO-TO-COMM. DTSCU835
|
||||
00799 MOVE WRK-REC (1:MIO-REC-LENGTH) DTSCU835
|
||||
00800 TO MCOMM-REC (1:MIO-REC-LENGTH). DTSCU835
|
||||
00801 DTSCU835
|
||||
00802 S2100-EXIT. DTSCU835
|
||||
00803 EXIT. DTSCU835
|
||||
00804 EJECT DTSCU835
|
||||
00805 S2200-COMM-TO-IO. DTSCU835
|
||||
00806 MOVE ESKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA. DTSCU835
|
||||
00807 DTSCU835
|
||||
00808 MOVE MCOMM-REC (1:MIO-REC-LENGTH) DTSCU835
|
||||
00809 TO WRK-REC (1:MIO-REC-LENGTH). DTSCU835
|
||||
00810 DTSCU835
|
||||
00811 S2200-EXIT. DTSCU835
|
||||
00812 EXIT. DTSCU835
|
||||
00813 SKIP3 DTSCU835
|
||||
00814 EJECT DTSCU835
|
||||
00815 ++INCLUDE DTSIP011 DTSCU835
|
||||
00816 EJECT DTSCU835
|
||||
00817 ++INCLUDE DTSIP012 DTSCU835
|
||||
00818 EJECT DTSCU835
|
||||
00819 S3300-UPDATE-AIX. DTSCU835
|
||||
00820 PERFORM S3310-AIX-LOOP THRU S3310-EXIT DTSCU835
|
||||
00821 VARYING AIX-REC-SUB FROM 1 BY 1 DTSCU835
|
||||
00822 UNTIL (AIX-REC-SUB > AIX-REC-MAX). DTSCU835
|
||||
00823 S3300-EXIT. DTSCU835
|
||||
00824 EXIT. DTSCU835
|
||||
00825 SKIP3 DTSCU835
|
||||
00826 S3310-AIX-LOOP. DTSCU835
|
||||
00827 IF PRE-UPDATE-AIX-REC (AIX-REC-SUB) DTSCU835
|
||||
00828 = POST-UPDATE-AIX-REC (AIX-REC-SUB) DTSCU835
|
||||
00829 GO TO S3310-EXIT. DTSCU835
|
||||
00830 DTSCU835
|
||||
00831 IF PRE-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES DTSCU835
|
||||
00832 MOVE PRE-UPDATE-AIX-REC (AIX-REC-SUB) TO ISKL-REC DTSCU835
|
||||
00833 PERFORM S3311-AIX-DELETE THRU S3311-EXIT DTSCU835
|
||||
00834 IF L835-FILE-CLOSED-88 DTSCU835
|
||||
00835 GO TO S3310-EXIT. DTSCU835
|
||||
00836 DTSCU835
|
||||
00837 IF POST-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES DTSCU835
|
||||
00838 MOVE POST-UPDATE-AIX-REC (AIX-REC-SUB) TO ISKL-REC DTSCU835
|
||||
00839 PERFORM S3312-AIX-WRITE THRU S3312-EXIT. DTSCU835
|
||||
00840 S3310-EXIT. DTSCU835
|
||||
00841 EXIT. DTSCU835
|
||||
00842 SKIP3 DTSCU835
|
||||
00843 S3311-AIX-DELETE. DTSCU835
|
||||
00844 PERFORM S821-AIX-READ THRU S821-EXIT. DTSCU835
|
||||
00845 DTSCU835
|
||||
00846 IF L821-FILE-CLOSED-88 DTSCU835
|
||||
00847 PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT DTSCU835
|
||||
00848 GO TO S3311-EXIT. DTSCU835
|
||||
00849 DTSCU835
|
||||
00850 IF L821-NO-REC-88 DTSCU835
|
||||
00851 GO TO S3311-EXIT. DTSCU835
|
||||
00852 DTSCU835
|
||||
00853 PERFORM S821-AIX-DELETE THRU S821-EXIT. DTSCU835
|
||||
00854 DTSCU835
|
||||
00855 IF L821-FILE-CLOSED-88 DTSCU835
|
||||
00856 PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT. DTSCU835
|
||||
00857 S3311-EXIT. DTSCU835
|
||||
00858 EXIT. DTSCU835
|
||||
00859 SKIP3 DTSCU835
|
||||
00860 S3312-AIX-WRITE. DTSCU835
|
||||
00861 PERFORM S821-AIX-READ THRU S821-EXIT. DTSCU835
|
||||
00862 DTSCU835
|
||||
00863 IF L821-FILE-CLOSED-88 DTSCU835
|
||||
00864 PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT DTSCU835
|
||||
00865 GO TO S3312-EXIT. DTSCU835
|
||||
00866 DTSCU835
|
||||
00867 IF NOT L821-NO-REC-88 DTSCU835
|
||||
00868 GO TO S3312-EXIT. DTSCU835
|
||||
00869 DTSCU835
|
||||
00870 PERFORM S821-AIX-WRITE THRU S821-EXIT. DTSCU835
|
||||
00871 DTSCU835
|
||||
00872 IF L821-FILE-CLOSED-88 DTSCU835
|
||||
00873 PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT. DTSCU835
|
||||
00874 S3312-EXIT. DTSCU835
|
||||
00875 EXIT. DTSCU835
|
||||
00876 EJECT DTSCU835
|
||||
00877 ++INCLUDE DTSIP013 DTSCU835
|
||||
00878 EJECT DTSCU835
|
||||
00879 S821-AIX-READ. DTSCU835
|
||||
00880 SET L821-READ-88 TO TRUE. DTSCU835
|
||||
00881 GO TO S821-AIX-IO. DTSCU835
|
||||
00882 DTSCU835
|
||||
00883 S821-AIX-DELETE. DTSCU835
|
||||
00884 SET L821-DELETE-88 TO TRUE. DTSCU835
|
||||
00885 GO TO S821-AIX-IO. DTSCU835
|
||||
00886 DTSCU835
|
||||
00887 S821-AIX-WRITE. DTSCU835
|
||||
00888 SET L821-WRITE-88 TO TRUE. DTSCU835
|
||||
00889 GO TO S821-AIX-IO. DTSCU835
|
||||
00890 DTSCU835
|
||||
00891 S821-AIX-IO. DTSCU835
|
||||
00892 DTSCU835
|
||||
00893 EXEC CICS DTSCU835
|
||||
00894 LINK DTSCU835
|
||||
00895 PROGRAM ('DTSCU821') DTSCU835
|
||||
00896 COMMAREA (L821-COMM-AREA) DTSCU835
|
||||
00897 END-EXEC. DTSCU835
|
||||
00898 DTSCU835
|
||||
00899 S821-EXIT. DTSCU835
|
||||
00900 EXIT. DTSCU835
|
||||
00901 SKIP3 DTSCU835
|
||||
00902 S999-ABEND. DTSCU835
|
||||
00903 DTSCU835
|
||||
00904 EXEC CICS DTSCU835
|
||||
00905 ABEND DTSCU835
|
||||
00906 ABCODE (WRK-ABEND-CD) DTSCU835
|
||||
00907 END-EXEC. DTSCU835
|
||||
00908 DTSCU835
|
||||
00909 S999-EXIT. DTSCU835
|
||||
00910 EXIT. DTSCU835
|
||||
Reference in New Issue
Block a user