912 lines
72 KiB
COBOL
912 lines
72 KiB
COBOL
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
|