970 lines
77 KiB
COBOL
970 lines
77 KiB
COBOL
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
|