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