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