1356 lines
107 KiB
COBOL
1356 lines
107 KiB
COBOL
00001 IDENTIFICATION DIVISION. 11/19/09
|
|
00002 PROGRAM-ID. DTSBU910. DTSBU910
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV019
|
|
00004 DATE-WRITTEN. JULY 1994. DTSBU910
|
|
00005 DATE-COMPILED. DTSBU910
|
|
00006 SKIP3 DTSBU910
|
|
00007 ***** DTSBU910
|
|
00008 * DTSBU910
|
|
00009 * FUNCTION: MASTER FILE INPUT/OUTPUT. DTSBU910
|
|
00010 * DTSBU910
|
|
00011 * DTSBU910
|
|
00012 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBU910
|
|
00013 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBU910
|
|
00014 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBU910
|
|
00015 * DTSBU910
|
|
00016 * SPECIFY TRUNC(OPT) DURING COMPILE OF DTSBU910. TRUNC DTSBU910
|
|
00017 * (OPT) REDUCES CPU RESOUCE USAGE DURING COMPRESSION/ DTSBU910
|
|
00018 * EXPANSION BY 50% (VS TRUNC(STD)). DTSBU910
|
|
00019 * DTSBU910
|
|
00020 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBU910
|
|
00021 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBU910
|
|
00022 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBU910
|
|
00023 * DTSBU910
|
|
00024 * DTSBU910
|
|
00025 * MODIFICATION LOG: DTSBU910
|
|
00026 * DTSBU910
|
|
00027 * 07/09/94 INITIAL DEVELOPMENT. DTSBU910
|
|
00028 * WORK ORDER: PROGRAMMER: EHH DTSBU910
|
|
00029 * DTSBU910
|
|
00030 * 09/18/95 ADD IWHO RECORD CONSTRUCTION. DTSBU910
|
|
00031 * WORK ORDER: JR PROGRAMMER: EHH DTSBU910
|
|
00032 * DTSBU910
|
|
00033 * 06-18-96 RE-COMPILED TO INCORPORATE CHANGES TO DTSIMLEN DTSBU910
|
|
00034 * AND DTSIMSKL. DTSBU910
|
|
00035 * REFERENCE RFP: WARP II PROGRAMMER: MJA DTSBU910
|
|
00036 * DTSBU910
|
|
00037 * 09/29/1998 REVIEWED AND MODIFIED FOR DC. DTSBU910
|
|
00038 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU910
|
|
00039 * DTSBU910
|
|
00040 * 04/18/2003 MODIFIED FOR NEW ELECTRONIC PAYMENT AIX RECORDS DTSBU910
|
|
00041 * DTSIITRT AND DTSIITRE. DTSBU910
|
|
00042 * REFERENCE: EFT PROGRAMMER: GD DTSBU910
|
|
00043 * DTSBU910
|
|
00044 * 07/17/2003 MODIFIED FOR NEW VSAM FILES MSTH AND MSTI DTSBU910
|
|
00045 * REFERENCE: SPLIT MSTB FILE PROGRAMMER: GD DTSBU910
|
|
00046 * DTSBU910
|
|
00047 * 10/23/2006 RECOMPILED FOR NEW VERSION OF DTSIP003 (IPES) DTSBU910
|
|
00048 * REFERENCE: PROGRAMMER: GD DTSBU910
|
|
00049 * DTSBU910
|
|
00050 * 11/10/2006 MODIFIED FOR NEW VSAM FILE MSTJ, AND NEW DTSBU910
|
|
00051 * RECORD TYPES MRRA AND MRWA. DTSBU910
|
|
00052 * REFERENCE: PARTIAL XFERS PROGRAMMER: GD DTSBU910
|
|
00053 * DTSBU910
|
|
00054 * 02/08/2008 RECOMPILED FOR MRFD AND IRFD REFUND RECS DTSBU910
|
|
00055 * REFERENCE: PROGRAMMER: GD DTSBU910
|
|
00056 * DTSBU910
|
|
00057 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU910
|
|
00058 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU910
|
|
00059 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU910
|
|
00060 * DTSBU910
|
|
00061 * DTSBU910
|
|
00062 * DESCRIPTION: DTSBU910
|
|
00063 * DTSBU910
|
|
00064 * PERFORMS ALL MSTER FILE I/O. DTSBU910
|
|
00065 * DTSBU910
|
|
00066 ***** DTSBU910
|
|
00067 SKIP3 DTSBU910
|
|
00068 ENVIRONMENT DIVISION. DTSBU910
|
|
00069 SKIP2 DTSBU910
|
|
00070 INPUT-OUTPUT SECTION. DTSBU910
|
|
00071 DTSBU910
|
|
00072 FILE-CONTROL. DTSBU910
|
|
00073 SELECT MSTA-FILE ASSIGN TO DTSFMSTA DTSBU910
|
|
00074 ORGANIZATION IS INDEXED DTSBU910
|
|
00075 RECORD KEY IS MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00076 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00077 ACCESS IS DYNAMIC. DTSBU910
|
|
00078 SELECT MSTB-FILE ASSIGN TO DTSFMSTB DTSBU910
|
|
00079 ORGANIZATION IS INDEXED DTSBU910
|
|
00080 RECORD KEY IS MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00081 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00082 ACCESS IS DYNAMIC. DTSBU910
|
|
00083 SELECT MSTC-FILE ASSIGN TO DTSFMSTC DTSBU910
|
|
00084 ORGANIZATION IS INDEXED DTSBU910
|
|
00085 RECORD KEY IS MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00086 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00087 ACCESS IS DYNAMIC. DTSBU910
|
|
00088 SELECT MSTD-FILE ASSIGN TO DTSFMSTD DTSBU910
|
|
00089 ORGANIZATION IS INDEXED DTSBU910
|
|
00090 RECORD KEY IS MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00091 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00092 ACCESS IS DYNAMIC. DTSBU910
|
|
00093 SELECT MSTH-FILE ASSIGN TO DTSFMSTH DTSBU910
|
|
00094 ORGANIZATION IS INDEXED DTSBU910
|
|
00095 RECORD KEY IS MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00096 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00097 ACCESS IS DYNAMIC. DTSBU910
|
|
00098 SELECT MSTI-FILE ASSIGN TO DTSFMSTI DTSBU910
|
|
00099 ORGANIZATION IS INDEXED DTSBU910
|
|
00100 RECORD KEY IS MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00101 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00102 ACCESS IS DYNAMIC. DTSBU910
|
|
00103 SELECT MSTJ-FILE ASSIGN TO DTSFMSTJ DTSBU910
|
|
00104 ORGANIZATION IS INDEXED DTSBU910
|
|
00105 RECORD KEY IS MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00106 FILE STATUS IS FILE-STATUS DTSBU910
|
|
00107 ACCESS IS DYNAMIC. DTSBU910
|
|
00108 SKIP3 DTSBU910
|
|
00109 DATA DIVISION. DTSBU910
|
|
00110 SKIP3 DTSBU910
|
|
00111 FILE SECTION. DTSBU910
|
|
00112 SKIP3 DTSBU910
|
|
00113 FD MSTA-FILE. DTSBU910
|
|
00114 DTSBU910
|
|
00115 01 MSTA-SKL-REC. DTSBU910
|
|
00116 ++INCLUDE DTSIMSKL DTSBU910
|
|
00117 SKIP3 DTSBU910
|
|
00118 01 MSTA-VAR-REC. DTSBU910
|
|
00119 05 MSTA-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00120 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00121 PIC X(01). DTSBU910
|
|
00122 SKIP3 DTSBU910
|
|
00123 FD MSTB-FILE. DTSBU910
|
|
00124 DTSBU910
|
|
00125 01 MSTB-SKL-REC. DTSBU910
|
|
00126 ++INCLUDE DTSIMSKL DTSBU910
|
|
00127 SKIP3 DTSBU910
|
|
00128 01 MSTB-VAR-REC. DTSBU910
|
|
00129 05 MSTB-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00130 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00131 PIC X(01). DTSBU910
|
|
00132 SKIP3 DTSBU910
|
|
00133 FD MSTC-FILE. DTSBU910
|
|
00134 DTSBU910
|
|
00135 01 MSTC-SKL-REC. DTSBU910
|
|
00136 ++INCLUDE DTSIMSKL DTSBU910
|
|
00137 SKIP3 DTSBU910
|
|
00138 01 MSTC-VAR-REC. DTSBU910
|
|
00139 05 MSTC-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00140 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00141 PIC X(01). DTSBU910
|
|
00142 SKIP3 DTSBU910
|
|
00143 FD MSTD-FILE. DTSBU910
|
|
00144 DTSBU910
|
|
00145 01 MSTD-SKL-REC. DTSBU910
|
|
00146 ++INCLUDE DTSIMSKL DTSBU910
|
|
00147 SKIP3 DTSBU910
|
|
00148 01 MSTD-VAR-REC. DTSBU910
|
|
00149 05 MSTD-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00150 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00151 PIC X(01). DTSBU910
|
|
00152 SKIP3 DTSBU910
|
|
00153 FD MSTH-FILE. DTSBU910
|
|
00154 DTSBU910
|
|
00155 01 MSTH-SKL-REC. DTSBU910
|
|
00156 ++INCLUDE DTSIMSKL DTSBU910
|
|
00157 SKIP3 DTSBU910
|
|
00158 01 MSTH-VAR-REC. DTSBU910
|
|
00159 05 MSTH-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00160 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00161 PIC X(01). DTSBU910
|
|
00162 SKIP3 DTSBU910
|
|
00163 FD MSTI-FILE. DTSBU910
|
|
00164 DTSBU910
|
|
00165 01 MSTI-SKL-REC. DTSBU910
|
|
00166 ++INCLUDE DTSIMSKL DTSBU910
|
|
00167 SKIP3 DTSBU910
|
|
00168 01 MSTI-VAR-REC. DTSBU910
|
|
00169 05 MSTI-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00170 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00171 PIC X(01). DTSBU910
|
|
00172 SKIP3 DTSBU910
|
|
00173 FD MSTJ-FILE. DTSBU910
|
|
00174 DTSBU910
|
|
00175 01 MSTJ-SKL-REC. DTSBU910
|
|
00176 ++INCLUDE DTSIMSKL DTSBU910
|
|
00177 SKIP3 DTSBU910
|
|
00178 01 MSTJ-VAR-REC. DTSBU910
|
|
00179 05 MSTJ-VAR-CHAR OCCURS 16 TO 1536 TIMES DTSBU910
|
|
00180 DEPENDING ON MIO-REC-LENGTH DTSBU910
|
|
00181 PIC X(01). DTSBU910
|
|
00182 EJECT DTSBU910
|
|
00183 WORKING-STORAGE SECTION. DTSBU910
|
|
001835 77 PAN-VALET PICTURE X(24) VALUE '019DTSBU910 11/19/09'. DTSBU910
|
|
00184 DTSBU910
|
|
00185 01 WRK-AREA. DTSBU910
|
|
00186 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +910.DTSBU910
|
|
00187 DTSBU910
|
|
00188 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU910'.DTSBU910
|
|
00189 DTSBU910
|
|
00190 DTSBU910
|
|
00191 05 FILE-STATE PIC X(03) VALUE 'CL '. DTSBU910
|
|
00192 88 FILE-OPEN-READ-88 VALUE 'OPR'. DTSBU910
|
|
00193 88 FILE-OPEN-UPDATE-88 VALUE 'OPU'. DTSBU910
|
|
00194 88 FILE-OPEN-UPDATE-HDR-88 VALUE 'OPH'. DTSBU910
|
|
00195 88 FILE-OPEN-UPDATE-NO-AIX-88 VALUE 'OPA'. DTSBU910
|
|
00196 88 FILE-CLOSE-88 VALUE 'CL '. DTSBU910
|
|
00197 DTSBU910
|
|
00198 DTSBU910
|
|
00199 05 FILE-STATUS PIC X(02). DTSBU910
|
|
00200 88 FILE-OK-88 VALUE '00'. DTSBU910
|
|
00201 88 FILE-NO-REC-88 VALUE '10' '23'. DTSBU910
|
|
00202 88 FILE-VERIFY-88 VALUE '97'. DTSBU910
|
|
00203 DTSBU910
|
|
00204 DTSBU910
|
|
00205 05 WRK-FILE-SUFFIXES. DTSBU910
|
|
00206 10 FILLER PIC X(04) VALUE 'MSTA'. DTSBU910
|
|
00207 10 FILLER PIC X(04) VALUE 'MSTB'. DTSBU910
|
|
00208 10 FILLER PIC X(04) VALUE 'MSTC'. DTSBU910
|
|
00209 10 FILLER PIC X(04) VALUE 'MSTD'. DTSBU910
|
|
00210 10 FILLER PIC X(04) VALUE 'MSTH'. DTSBU910
|
|
00211 10 FILLER PIC X(04) VALUE 'MSTI'. DTSBU910
|
|
00212 10 FILLER PIC X(04) VALUE 'MSTJ'. DTSBU910
|
|
00213 05 FILLER REDEFINES WRK-FILE-SUFFIXES. DTSBU910
|
|
00214 10 WRK-FILE-SUFFIX OCCURS 7 TIMES DTSBU910
|
|
00215 PIC X(04). DTSBU910
|
|
00216 DTSBU910
|
|
00217 DTSBU910
|
|
00218 05 WRK-FILE-NAME-SUFFIX PIC X(04). DTSBU910
|
|
00219 DTSBU910
|
|
00220 DTSBU910
|
|
00221 05 WRK-REC-PREFIX PIC X(04). DTSBU910
|
|
00222 DTSBU910
|
|
00223 DTSBU910
|
|
00224 05 REC-TYPE-SUB PIC S9(04) COMP. DTSBU910
|
|
00225 DTSBU910
|
|
00226 05 FILE-SUB PIC S9(04) COMP. DTSBU910
|
|
00227 DTSBU910
|
|
00228 DTSBU910
|
|
00229 05 MIO-REC-LENGTH PIC S9(04) COMP. DTSBU910
|
|
00230 DTSBU910
|
|
00231 05 MIO-KEY-LENGTH PIC S9(04) COMP. DTSBU910
|
|
00232 DTSBU910
|
|
00233 05 MIO-KEY-FILLER-LENGTH PIC S9(04) COMP. DTSBU910
|
|
00234 DTSBU910
|
|
00235 05 MIO-KEY-FILLER-START PIC S9(04) COMP. DTSBU910
|
|
00236 DTSBU910
|
|
00237 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSBU910
|
|
00238 DTSBU910
|
|
00239 05 WRK-DATA-LENGTH PIC S9(04) COMP. DTSBU910
|
|
00240 DTSBU910
|
|
00241 05 OCC-COUNT-START PIC S9(04) COMP. DTSBU910
|
|
00242 DTSBU910
|
|
00243 05 OCC-COUNT-X PIC X(02). DTSBU910
|
|
00244 05 OCC-COUNT REDEFINES OCC-COUNT-X DTSBU910
|
|
00245 PIC S9(04) COMP. DTSBU910
|
|
00246 DTSBU910
|
|
00247 DTSBU910
|
|
00248 05 COUNT-COMPLETE-IND PIC X(01). DTSBU910
|
|
00249 EJECT DTSBU910
|
|
00250 01 MCMP-WORK-AREA. DTSBU910
|
|
00251 ++INCLUDE DTSICCMP DTSBU910
|
|
00252 EJECT DTSBU910
|
|
00253 01 MLEN-LENGTH-LITERALS. DTSBU910
|
|
00254 ++INCLUDE DTSIMLEN DTSBU910
|
|
00255 EJECT DTSBU910
|
|
00256 01 MIO-REC. DTSBU910
|
|
00257 ++INCLUDE DTSIMIO DTSBU910
|
|
00258 EJECT DTSBU910
|
|
00259 01 WRK-REC. DTSBU910
|
|
00260 ++INCLUDE DTSIMSKL DTSBU910
|
|
00261 SKIP3 DTSBU910
|
|
00262 10 WRK-DATA-AREA REDEFINES MSKL-DATA-AREA. DTSBU910
|
|
00263 15 WRK-DATA-CHAR OCCURS 1515 TIMES DTSBU910
|
|
00264 INDEXED BY WRK-DATA-IDX DTSBU910
|
|
00265 PIC X(01). DTSBU910
|
|
00266 SKIP3 DTSBU910
|
|
00267 01 MPRF-REC REDEFINES WRK-REC. DTSBU910
|
|
00268 ++INCLUDE DTSIMPRF DTSBU910
|
|
00269 SKIP3 DTSBU910
|
|
00270 01 MBAA-REC REDEFINES WRK-REC. DTSBU910
|
|
00271 ++INCLUDE DTSIMBAA DTSBU910
|
|
00272 SKIP3 DTSBU910
|
|
00273 01 MFAS-REC REDEFINES WRK-REC. DTSBU910
|
|
00274 ++INCLUDE DTSIMFAS DTSBU910
|
|
00275 SKIP3 DTSBU910
|
|
00276 01 MOPO-REC REDEFINES WRK-REC. DTSBU910
|
|
00277 ++INCLUDE DTSIMOPO DTSBU910
|
|
00278 SKIP3 DTSBU910
|
|
00279 01 MPAY-REC REDEFINES WRK-REC. DTSBU910
|
|
00280 ++INCLUDE DTSIMPAY DTSBU910
|
|
00281 SKIP3 DTSBU910
|
|
00282 01 MREL-REC REDEFINES WRK-REC. DTSBU910
|
|
00283 ++INCLUDE DTSIMREL DTSBU910
|
|
00284 SKIP3 DTSBU910
|
|
00285 01 MRFD-REC REDEFINES WRK-REC. DTSBU910
|
|
00286 ++INCLUDE DTSIMRFD DTSBU910
|
|
00287 SKIP3 DTSBU910
|
|
00288 01 MRPT-REC REDEFINES WRK-REC. DTSBU910
|
|
00289 ++INCLUDE DTSIMRPT DTSBU910
|
|
00290 SKIP3 DTSBU910
|
|
00291 01 MTCK-REC REDEFINES WRK-REC. DTSBU910
|
|
00292 ++INCLUDE DTSIMTCK DTSBU910
|
|
00293 SKIP3 DTSBU910
|
|
00294 01 MTAA-REC REDEFINES WRK-REC. DTSBU910
|
|
00295 ++INCLUDE DTSIMTAA DTSBU910
|
|
00296 EJECT DTSBU910
|
|
00297 01 AIX-WORK-AREA. DTSBU910
|
|
00298 ++INCLUDE DTSIXAIX DTSBU910
|
|
00299 EJECT DTSBU910
|
|
00300 01 L921-LINK-AREA. DTSBU910
|
|
00301 ++INCLUDE DTSIL921 DTSBU910
|
|
00302 SKIP3 DTSBU910
|
|
00303 01 ISKL-REC. DTSBU910
|
|
00304 ++INCLUDE DTSIISKL DTSBU910
|
|
00305 SKIP3 DTSBU910
|
|
00306 01 IBTB-REC REDEFINES ISKL-REC. DTSBU910
|
|
00307 ++INCLUDE DTSIIBTB DTSBU910
|
|
00308 SKIP3 DTSBU910
|
|
00309 01 IEIN-REC REDEFINES ISKL-REC. DTSBU910
|
|
00310 ++INCLUDE DTSIIEIN DTSBU910
|
|
00311 SKIP3 DTSBU910
|
|
00312 01 IFAN-REC REDEFINES ISKL-REC. DTSBU910
|
|
00313 ++INCLUDE DTSIIFAN DTSBU910
|
|
00314 SKIP3 DTSBU910
|
|
00315 01 IFID-REC REDEFINES ISKL-REC. DTSBU910
|
|
00316 ++INCLUDE DTSIIFID DTSBU910
|
|
00317 SKIP3 DTSBU910
|
|
00318 01 IOPN-REC REDEFINES ISKL-REC. DTSBU910
|
|
00319 ++INCLUDE DTSIIOPN DTSBU910
|
|
00320 SKIP3 DTSBU910
|
|
00321 01 IOPS-REC REDEFINES ISKL-REC. DTSBU910
|
|
00322 ++INCLUDE DTSIIOPS DTSBU910
|
|
00323 SKIP3 DTSBU910
|
|
00324 01 IPES-REC REDEFINES ISKL-REC. DTSBU910
|
|
00325 ++INCLUDE DTSIIPES DTSBU910
|
|
00326 SKIP3 DTSBU910
|
|
00327 01 ITDS-REC REDEFINES ISKL-REC. DTSBU910
|
|
00328 ++INCLUDE DTSIITDS DTSBU910
|
|
00329 SKIP3 DTSBU910
|
|
00330 01 IZIP-REC REDEFINES ISKL-REC. DTSBU910
|
|
00331 ++INCLUDE DTSIIZIP DTSBU910
|
|
00332 SKIP3 DTSBU910
|
|
00333 01 IBTN-REC REDEFINES ISKL-REC. DTSBU910
|
|
00334 ++INCLUDE DTSIIBTN DTSBU910
|
|
00335 DTSBU910
|
|
00336 01 ITRT-REC REDEFINES ISKL-REC. DTSBU910
|
|
00337 ++INCLUDE DTSIITRT DTSBU910
|
|
00338 DTSBU910
|
|
00339 01 ITRE-REC REDEFINES ISKL-REC. DTSBU910
|
|
00340 ++INCLUDE DTSIITRE DTSBU910
|
|
00341 DTSBU910
|
|
00342 01 IRFD-REC REDEFINES ISKL-REC. DTSBU910
|
|
00343 ++INCLUDE DTSIIRFD DTSBU910
|
|
00344 EJECT DTSBU910
|
|
00345 01 L991-LINK-AREA. DTSBU910
|
|
00346 ++INCLUDE DTSIL991 DTSBU910
|
|
00347 EJECT DTSBU910
|
|
00348 LINKAGE SECTION. DTSBU910
|
|
00349 SKIP3 DTSBU910
|
|
00350 01 L910-LINK-AREA. DTSBU910
|
|
00351 ++INCLUDE DTSIL910 DTSBU910
|
|
00352 SKIP3 DTSBU910
|
|
00353 01 LINK-REC. DTSBU910
|
|
00354 ++INCLUDE DTSIMSKL DTSBU910
|
|
00355 EJECT DTSBU910
|
|
00356 PROCEDURE DIVISION USING L910-LINK-AREA DTSBU910
|
|
00357 LINK-REC. DTSBU910
|
|
00358 DTSBU910
|
|
00359 DTSBU910
|
|
00360 MOVE +0 TO L910-RECORD-CNT. DTSBU910
|
|
00361 DTSBU910
|
|
00362 SET L910-OK-88 TO TRUE. DTSBU910
|
|
00363 DTSBU910
|
|
00364 MOVE +0 TO FILE-SUB DTSBU910
|
|
00365 REC-TYPE-SUB. DTSBU910
|
|
00366 DTSBU910
|
|
00367 IF L910-TRACE-88 DTSBU910
|
|
00368 PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT. DTSBU910
|
|
00369 DTSBU910
|
|
00370 IF L910-OPEN-88 DTSBU910
|
|
00371 PERFORM P4100-OPEN THRU P4100-EXIT DTSBU910
|
|
00372 ELSE DTSBU910
|
|
00373 IF L910-CLOSE-88 DTSBU910
|
|
00374 PERFORM P4200-CLOSE THRU P4200-EXIT DTSBU910
|
|
00375 ELSE DTSBU910
|
|
00376 PERFORM P0100-REC-TYPE THRU P0100-EXIT DTSBU910
|
|
00377 IF L910-READ-88 DTSBU910
|
|
00378 PERFORM P1100-READ THRU P1100-EXIT DTSBU910
|
|
00379 ELSE DTSBU910
|
|
00380 IF L910-START-BROWSE-88 DTSBU910
|
|
00381 PERFORM P1200-START-BROWSE THRU P1200-EXIT DTSBU910
|
|
00382 ELSE DTSBU910
|
|
00383 IF L910-READ-NEXT-88 DTSBU910
|
|
00384 PERFORM P1300-READ-NEXT THRU P1300-EXIT DTSBU910
|
|
00385 ELSE DTSBU910
|
|
00386 IF L910-COUNT-88 DTSBU910
|
|
00387 PERFORM P1500-COUNT THRU P1500-EXIT DTSBU910
|
|
00388 ELSE DTSBU910
|
|
00389 IF L910-WRITE-88 DTSBU910
|
|
00390 PERFORM P2100-WRITE THRU P2100-EXIT DTSBU910
|
|
00391 ELSE DTSBU910
|
|
00392 IF L910-REWRITE-88 DTSBU910
|
|
00393 PERFORM P2200-REWRITE THRU P2200-EXIT DTSBU910
|
|
00394 ELSE DTSBU910
|
|
00395 IF L910-DELETE-88 DTSBU910
|
|
00396 PERFORM P2300-DELETE THRU P2300-EXIT DTSBU910
|
|
00397 ELSE DTSBU910
|
|
00398 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00399 DTSBU910
|
|
00400 IF L910-TRACE-88 DTSBU910
|
|
00401 PERFORM S9200-POST-DISPLAY THRU S9200-EXIT. DTSBU910
|
|
00402 DTSBU910
|
|
00403 DTSBU910
|
|
00404 GOBACK. DTSBU910
|
|
00405 EJECT DTSBU910
|
|
00406 P0100-REC-TYPE. DTSBU910
|
|
00407 MOVE MSKL-REC-TYPE OF LINK-REC TO REC-TYPE-SUB. DTSBU910
|
|
00408 DTSBU910
|
|
00409 IF (REC-TYPE-SUB < +1) DTSBU910
|
|
00410 OR DTSBU910
|
|
00411 (REC-TYPE-SUB > MLEN-MAX-REC-TYPE) DTSBU910
|
|
00412 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00413 DTSBU910
|
|
00414 MOVE MLEN-FILE-ID (REC-TYPE-SUB) TO FILE-SUB. DTSBU910
|
|
00415 DTSBU910
|
|
00416 IF FILE-SUB = +0 DTSBU910
|
|
00417 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00418 P0100-EXIT. DTSBU910
|
|
00419 EXIT. DTSBU910
|
|
00420 EJECT DTSBU910
|
|
00421 P1100-READ. DTSBU910
|
|
00422 IF FILE-SUB = +1 DTSBU910
|
|
00423 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00424 TO MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00425 READ MSTA-FILE INTO MIO-REC DTSBU910
|
|
00426 ELSE DTSBU910
|
|
00427 IF FILE-SUB = +2 DTSBU910
|
|
00428 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00429 TO MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00430 READ MSTB-FILE INTO MIO-REC DTSBU910
|
|
00431 ELSE DTSBU910
|
|
00432 IF FILE-SUB = +3 DTSBU910
|
|
00433 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00434 TO MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00435 READ MSTC-FILE INTO MIO-REC DTSBU910
|
|
00436 ELSE DTSBU910
|
|
00437 IF FILE-SUB = +4 DTSBU910
|
|
00438 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00439 TO MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00440 READ MSTD-FILE INTO MIO-REC DTSBU910
|
|
00441 ELSE DTSBU910
|
|
00442 IF FILE-SUB = +5 DTSBU910
|
|
00443 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00444 TO MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00445 READ MSTH-FILE INTO MIO-REC DTSBU910
|
|
00446 ELSE DTSBU910
|
|
00447 IF FILE-SUB = +6 DTSBU910
|
|
00448 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00449 TO MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00450 READ MSTI-FILE INTO MIO-REC DTSBU910
|
|
00451 ELSE DTSBU910
|
|
00452 IF FILE-SUB = +7 DTSBU910
|
|
00453 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00454 TO MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00455 READ MSTJ-FILE INTO MIO-REC DTSBU910
|
|
00456 ELSE DTSBU910
|
|
00457 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00458 DTSBU910
|
|
00459 IF FILE-NO-REC-88 DTSBU910
|
|
00460 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU910
|
|
00461 GO TO P1100-EXIT. DTSBU910
|
|
00462 DTSBU910
|
|
00463 IF FILE-OK-88 DTSBU910
|
|
00464 PERFORM S2100-IO-TO-LINK THRU S2100-EXIT DTSBU910
|
|
00465 ELSE DTSBU910
|
|
00466 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00467 P1100-EXIT. DTSBU910
|
|
00468 EXIT. DTSBU910
|
|
00469 EJECT DTSBU910
|
|
00470 P1200-START-BROWSE. DTSBU910
|
|
00471 IF FILE-SUB = +1 DTSBU910
|
|
00472 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00473 TO MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00474 START MSTA-FILE DTSBU910
|
|
00475 KEY IS NOT < MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00476 ELSE DTSBU910
|
|
00477 IF FILE-SUB = +2 DTSBU910
|
|
00478 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00479 TO MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00480 START MSTB-FILE DTSBU910
|
|
00481 KEY IS NOT < MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00482 ELSE DTSBU910
|
|
00483 IF FILE-SUB = +3 DTSBU910
|
|
00484 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00485 TO MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00486 START MSTC-FILE DTSBU910
|
|
00487 KEY IS NOT < MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00488 ELSE DTSBU910
|
|
00489 IF FILE-SUB = +4 DTSBU910
|
|
00490 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00491 TO MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00492 START MSTD-FILE DTSBU910
|
|
00493 KEY IS NOT < MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00494 ELSE DTSBU910
|
|
00495 IF FILE-SUB = +5 DTSBU910
|
|
00496 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00497 TO MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00498 START MSTH-FILE DTSBU910
|
|
00499 KEY IS NOT < MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00500 ELSE DTSBU910
|
|
00501 IF FILE-SUB = +6 DTSBU910
|
|
00502 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00503 TO MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00504 START MSTI-FILE DTSBU910
|
|
00505 KEY IS NOT < MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00506 ELSE DTSBU910
|
|
00507 IF FILE-SUB = +7 DTSBU910
|
|
00508 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00509 TO MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00510 START MSTJ-FILE DTSBU910
|
|
00511 KEY IS NOT < MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00512 ELSE DTSBU910
|
|
00513 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00514 DTSBU910
|
|
00515 IF FILE-NO-REC-88 DTSBU910
|
|
00516 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU910
|
|
00517 GO TO P1200-EXIT. DTSBU910
|
|
00518 DTSBU910
|
|
00519 IF FILE-OK-88 DTSBU910
|
|
00520 PERFORM P1300-READ-NEXT THRU P1300-EXIT DTSBU910
|
|
00521 ELSE DTSBU910
|
|
00522 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00523 P1200-EXIT. DTSBU910
|
|
00524 EXIT. DTSBU910
|
|
00525 EJECT DTSBU910
|
|
00526 P1300-READ-NEXT. DTSBU910
|
|
00527 IF FILE-SUB = +1 DTSBU910
|
|
00528 READ MSTA-FILE NEXT INTO MIO-REC DTSBU910
|
|
00529 ELSE DTSBU910
|
|
00530 IF FILE-SUB = +2 DTSBU910
|
|
00531 READ MSTB-FILE NEXT INTO MIO-REC DTSBU910
|
|
00532 ELSE DTSBU910
|
|
00533 IF FILE-SUB = +3 DTSBU910
|
|
00534 READ MSTC-FILE NEXT INTO MIO-REC DTSBU910
|
|
00535 ELSE DTSBU910
|
|
00536 IF FILE-SUB = +4 DTSBU910
|
|
00537 READ MSTD-FILE NEXT INTO MIO-REC DTSBU910
|
|
00538 ELSE DTSBU910
|
|
00539 IF FILE-SUB = +5 DTSBU910
|
|
00540 READ MSTH-FILE NEXT INTO MIO-REC DTSBU910
|
|
00541 ELSE DTSBU910
|
|
00542 IF FILE-SUB = +6 DTSBU910
|
|
00543 READ MSTI-FILE NEXT INTO MIO-REC DTSBU910
|
|
00544 ELSE DTSBU910
|
|
00545 IF FILE-SUB = +7 DTSBU910
|
|
00546 READ MSTJ-FILE NEXT INTO MIO-REC DTSBU910
|
|
00547 ELSE DTSBU910
|
|
00548 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00549 DTSBU910
|
|
00550 IF FILE-NO-REC-88 DTSBU910
|
|
00551 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU910
|
|
00552 GO TO P1300-EXIT. DTSBU910
|
|
00553 DTSBU910
|
|
00554 IF FILE-OK-88 DTSBU910
|
|
00555 NEXT SENTENCE DTSBU910
|
|
00556 ELSE DTSBU910
|
|
00557 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00558 DTSBU910
|
|
00559 IF MSKL-PRF-88 OF LINK-REC DTSBU910
|
|
00560 PERFORM S2100-IO-TO-LINK THRU S2100-EXIT DTSBU910
|
|
00561 GO TO P1300-EXIT. DTSBU910
|
|
00562 DTSBU910
|
|
00563 IF (MIO-EMP-NO = MSKL-EMP-NO OF LINK-REC) DTSBU910
|
|
00564 AND DTSBU910
|
|
00565 (MIO-REC-TYPE = MSKL-REC-TYPE OF LINK-REC) DTSBU910
|
|
00566 PERFORM S2100-IO-TO-LINK THRU S2100-EXIT DTSBU910
|
|
00567 ELSE DTSBU910
|
|
00568 PERFORM S1100-NO-REC THRU S1100-EXIT. DTSBU910
|
|
00569 P1300-EXIT. DTSBU910
|
|
00570 EXIT. DTSBU910
|
|
00571 EJECT DTSBU910
|
|
00572 P1500-COUNT. DTSBU910
|
|
00573 MOVE MSKL-KEY-AREA OF LINK-REC TO MIO-KEY-AREA. DTSBU910
|
|
00574 DTSBU910
|
|
00575 IF MSKL-AUY-88 OF LINK-REC OR MSKL-FAR-88 OF LINK-REC DTSBU910
|
|
00576 MOVE LOW-VALUES TO MIO-KEY-AREA (12:5) DTSBU910
|
|
00577 ELSE DTSBU910
|
|
00578 MOVE LOW-VALUES TO MIO-KEY-FILLER. DTSBU910
|
|
00579 DTSBU910
|
|
00580 IF FILE-SUB = +1 DTSBU910
|
|
00581 MOVE MIO-KEY-AREA DTSBU910
|
|
00582 TO MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00583 START MSTA-FILE DTSBU910
|
|
00584 KEY IS NOT < MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00585 ELSE DTSBU910
|
|
00586 IF FILE-SUB = +2 DTSBU910
|
|
00587 MOVE MIO-KEY-AREA DTSBU910
|
|
00588 TO MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00589 START MSTB-FILE DTSBU910
|
|
00590 KEY IS NOT < MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00591 ELSE DTSBU910
|
|
00592 IF FILE-SUB = +3 DTSBU910
|
|
00593 MOVE MIO-KEY-AREA DTSBU910
|
|
00594 TO MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00595 START MSTC-FILE DTSBU910
|
|
00596 KEY IS NOT < MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00597 ELSE DTSBU910
|
|
00598 IF FILE-SUB = +4 DTSBU910
|
|
00599 MOVE MIO-KEY-AREA DTSBU910
|
|
00600 TO MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00601 START MSTD-FILE DTSBU910
|
|
00602 KEY IS NOT < MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00603 ELSE DTSBU910
|
|
00604 IF FILE-SUB = +5 DTSBU910
|
|
00605 MOVE MIO-KEY-AREA DTSBU910
|
|
00606 TO MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00607 START MSTH-FILE DTSBU910
|
|
00608 KEY IS NOT < MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00609 ELSE DTSBU910
|
|
00610 IF FILE-SUB = +6 DTSBU910
|
|
00611 MOVE MIO-KEY-AREA DTSBU910
|
|
00612 TO MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00613 START MSTI-FILE DTSBU910
|
|
00614 KEY IS NOT < MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00615 ELSE DTSBU910
|
|
00616 IF FILE-SUB = +7 DTSBU910
|
|
00617 MOVE MIO-KEY-AREA DTSBU910
|
|
00618 TO MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00619 START MSTJ-FILE DTSBU910
|
|
00620 KEY IS NOT < MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00621 ELSE DTSBU910
|
|
00622 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00623 DTSBU910
|
|
00624 SET L910-NO-REC-88 TO TRUE. DTSBU910
|
|
00625 DTSBU910
|
|
00626 IF FILE-NO-REC-88 DTSBU910
|
|
00627 MOVE +0 TO L910-RECORD-CNT DTSBU910
|
|
00628 GO TO P1500-EXIT. DTSBU910
|
|
00629 DTSBU910
|
|
00630 IF FILE-OK-88 DTSBU910
|
|
00631 NEXT SENTENCE DTSBU910
|
|
00632 ELSE DTSBU910
|
|
00633 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00634 DTSBU910
|
|
00635 MOVE +0 TO L910-RECORD-CNT. DTSBU910
|
|
00636 DTSBU910
|
|
00637 MOVE 'N' TO COUNT-COMPLETE-IND. DTSBU910
|
|
00638 DTSBU910
|
|
00639 PERFORM P1510-COUNT-LOOP THRU P1510-EXIT DTSBU910
|
|
00640 UNTIL COUNT-COMPLETE-IND = 'Y'. DTSBU910
|
|
00641 P1500-EXIT. DTSBU910
|
|
00642 EXIT. DTSBU910
|
|
00643 SKIP3 DTSBU910
|
|
00644 P1510-COUNT-LOOP. DTSBU910
|
|
00645 IF FILE-SUB = +1 DTSBU910
|
|
00646 READ MSTA-FILE NEXT INTO MIO-REC DTSBU910
|
|
00647 ELSE DTSBU910
|
|
00648 IF FILE-SUB = +2 DTSBU910
|
|
00649 READ MSTB-FILE NEXT INTO MIO-REC DTSBU910
|
|
00650 ELSE DTSBU910
|
|
00651 IF FILE-SUB = +3 DTSBU910
|
|
00652 READ MSTC-FILE NEXT INTO MIO-REC DTSBU910
|
|
00653 ELSE DTSBU910
|
|
00654 IF FILE-SUB = +4 DTSBU910
|
|
00655 READ MSTD-FILE NEXT INTO MIO-REC DTSBU910
|
|
00656 ELSE DTSBU910
|
|
00657 IF FILE-SUB = +5 DTSBU910
|
|
00658 READ MSTH-FILE NEXT INTO MIO-REC DTSBU910
|
|
00659 ELSE DTSBU910
|
|
00660 IF FILE-SUB = +6 DTSBU910
|
|
00661 READ MSTI-FILE NEXT INTO MIO-REC DTSBU910
|
|
00662 ELSE DTSBU910
|
|
00663 IF FILE-SUB = +7 DTSBU910
|
|
00664 READ MSTJ-FILE NEXT INTO MIO-REC DTSBU910
|
|
00665 ELSE DTSBU910
|
|
00666 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00667 DTSBU910
|
|
00668 IF FILE-NO-REC-88 DTSBU910
|
|
00669 MOVE 'Y' TO COUNT-COMPLETE-IND DTSBU910
|
|
00670 GO TO P1510-EXIT. DTSBU910
|
|
00671 DTSBU910
|
|
00672 IF FILE-OK-88 DTSBU910
|
|
00673 NEXT SENTENCE DTSBU910
|
|
00674 ELSE DTSBU910
|
|
00675 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00676 DTSBU910
|
|
00677 IF MSKL-AUY-88 OF LINK-REC OR MSKL-FAR-88 OF LINK-REC DTSBU910
|
|
00678 IF MIO-KEY-AREA (1:11) DTSBU910
|
|
00679 = MSKL-KEY-AREA OF LINK-REC (1:11) DTSBU910
|
|
00680 ADD +1 TO L910-RECORD-CNT DTSBU910
|
|
00681 SET L910-OK-88 TO TRUE DTSBU910
|
|
00682 MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00683 ELSE DTSBU910
|
|
00684 MOVE 'Y' TO COUNT-COMPLETE-IND DTSBU910
|
|
00685 ELSE DTSBU910
|
|
00686 IF (MIO-EMP-NO = MSKL-EMP-NO OF LINK-REC) DTSBU910
|
|
00687 AND DTSBU910
|
|
00688 (MIO-REC-TYPE = MSKL-REC-TYPE OF LINK-REC) DTSBU910
|
|
00689 ADD +1 TO L910-RECORD-CNT DTSBU910
|
|
00690 SET L910-OK-88 TO TRUE DTSBU910
|
|
00691 MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00692 ELSE DTSBU910
|
|
00693 MOVE 'Y' TO COUNT-COMPLETE-IND. DTSBU910
|
|
00694 P1510-EXIT. DTSBU910
|
|
00695 EXIT. DTSBU910
|
|
00696 EJECT DTSBU910
|
|
00697 P2100-WRITE. DTSBU910
|
|
00698 IF FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00699 IF MSKL-HDR-88 OF LINK-REC DTSBU910
|
|
00700 NEXT SENTENCE DTSBU910
|
|
00701 ELSE DTSBU910
|
|
00702 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00703 DTSBU910
|
|
00704 PERFORM S2200-LINK-TO-IO THRU S2200-EXIT. DTSBU910
|
|
00705 DTSBU910
|
|
00706 PERFORM P2110-INITIALIZE-KEY-FILLER THRU P2110-EXIT. DTSBU910
|
|
00707 DTSBU910
|
|
00708 IF FILE-SUB = +1 DTSBU910
|
|
00709 WRITE MSTA-VAR-REC FROM MIO-REC DTSBU910
|
|
00710 ELSE DTSBU910
|
|
00711 IF FILE-SUB = +2 DTSBU910
|
|
00712 WRITE MSTB-VAR-REC FROM MIO-REC DTSBU910
|
|
00713 ELSE DTSBU910
|
|
00714 IF FILE-SUB = +3 DTSBU910
|
|
00715 WRITE MSTC-VAR-REC FROM MIO-REC DTSBU910
|
|
00716 ELSE DTSBU910
|
|
00717 IF FILE-SUB = +4 DTSBU910
|
|
00718 WRITE MSTD-VAR-REC FROM MIO-REC DTSBU910
|
|
00719 ELSE DTSBU910
|
|
00720 IF FILE-SUB = +5 DTSBU910
|
|
00721 WRITE MSTH-VAR-REC FROM MIO-REC DTSBU910
|
|
00722 ELSE DTSBU910
|
|
00723 IF FILE-SUB = +6 DTSBU910
|
|
00724 WRITE MSTI-VAR-REC FROM MIO-REC DTSBU910
|
|
00725 ELSE DTSBU910
|
|
00726 IF FILE-SUB = +7 DTSBU910
|
|
00727 WRITE MSTJ-VAR-REC FROM MIO-REC DTSBU910
|
|
00728 ELSE DTSBU910
|
|
00729 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00730 DTSBU910
|
|
00731 IF FILE-OK-88 DTSBU910
|
|
00732 NEXT SENTENCE DTSBU910
|
|
00733 ELSE DTSBU910
|
|
00734 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00735 DTSBU910
|
|
00736 IF FILE-OPEN-UPDATE-NO-AIX-88 DTSBU910
|
|
00737 GO TO P2100-EXIT. DTSBU910
|
|
00738 DTSBU910
|
|
00739 MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS. DTSBU910
|
|
00740 DTSBU910
|
|
00741 PERFORM S3200-CONSTRUCT-IPOST THRU S3200-EXIT. DTSBU910
|
|
00742 DTSBU910
|
|
00743 PERFORM S3300-UPDATE-AIX THRU S3300-EXIT. DTSBU910
|
|
00744 P2100-EXIT. DTSBU910
|
|
00745 EXIT. DTSBU910
|
|
00746 SKIP3 DTSBU910
|
|
00747 P2110-INITIALIZE-KEY-FILLER. DTSBU910
|
|
00748 COMPUTE MIO-KEY-FILLER-START DTSBU910
|
|
00749 = MLEN-KEY-LEN (REC-TYPE-SUB) + 1. DTSBU910
|
|
00750 DTSBU910
|
|
00751 COMPUTE MIO-KEY-FILLER-LENGTH DTSBU910
|
|
00752 = MLEN-MAX-KEY-LEN - MLEN-KEY-LEN (REC-TYPE-SUB). DTSBU910
|
|
00753 DTSBU910
|
|
00754 IF MIO-KEY-FILLER-LENGTH > +0 DTSBU910
|
|
00755 MOVE LOW-VALUES DTSBU910
|
|
00756 TO MIO-KEY-AREA DTSBU910
|
|
00757 (MIO-KEY-FILLER-START:MIO-KEY-FILLER-LENGTH). DTSBU910
|
|
00758 P2110-EXIT. DTSBU910
|
|
00759 EXIT. DTSBU910
|
|
00760 EJECT DTSBU910
|
|
00761 P2200-REWRITE. DTSBU910
|
|
00762 IF FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00763 IF MSKL-HDR-88 OF LINK-REC DTSBU910
|
|
00764 NEXT SENTENCE DTSBU910
|
|
00765 ELSE DTSBU910
|
|
00766 *& DTSBU910
|
|
00767 DISPLAY 'BU910 HEADER' DTSBU910
|
|
00768 *& DTSBU910
|
|
00769 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00770 DTSBU910
|
|
00771 PERFORM P2900-PREPARE-FOR-UPDATE THRU P2900-EXIT. DTSBU910
|
|
00772 DTSBU910
|
|
00773 IF L910-NO-REC-88 DTSBU910
|
|
00774 *& DTSBU910
|
|
00775 DISPLAY 'BU910 NO REC AFTER P2900' DTSBU910
|
|
00776 *& DTSBU910
|
|
00777 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00778 DTSBU910
|
|
00779 PERFORM S2200-LINK-TO-IO THRU S2200-EXIT. DTSBU910
|
|
00780 DTSBU910
|
|
00781 IF FILE-SUB = +1 DTSBU910
|
|
00782 REWRITE MSTA-VAR-REC FROM MIO-REC DTSBU910
|
|
00783 ELSE DTSBU910
|
|
00784 IF FILE-SUB = +2 DTSBU910
|
|
00785 REWRITE MSTB-VAR-REC FROM MIO-REC DTSBU910
|
|
00786 ELSE DTSBU910
|
|
00787 IF FILE-SUB = +3 DTSBU910
|
|
00788 REWRITE MSTC-VAR-REC FROM MIO-REC DTSBU910
|
|
00789 ELSE DTSBU910
|
|
00790 IF FILE-SUB = +4 DTSBU910
|
|
00791 REWRITE MSTD-VAR-REC FROM MIO-REC DTSBU910
|
|
00792 ELSE DTSBU910
|
|
00793 IF FILE-SUB = +5 DTSBU910
|
|
00794 REWRITE MSTH-VAR-REC FROM MIO-REC DTSBU910
|
|
00795 ELSE DTSBU910
|
|
00796 IF FILE-SUB = +6 DTSBU910
|
|
00797 REWRITE MSTI-VAR-REC FROM MIO-REC DTSBU910
|
|
00798 ELSE DTSBU910
|
|
00799 IF FILE-SUB = +7 DTSBU910
|
|
00800 REWRITE MSTJ-VAR-REC FROM MIO-REC DTSBU910
|
|
00801 ELSE DTSBU910
|
|
00802 *& DTSBU910
|
|
00803 DISPLAY 'BU910 UNKNOWN FILE TYPE ' DTSBU910
|
|
00804 *& DTSBU910
|
|
00805 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00806 DTSBU910
|
|
00807 IF FILE-OK-88 DTSBU910
|
|
00808 NEXT SENTENCE DTSBU910
|
|
00809 ELSE DTSBU910
|
|
00810 *& DTSBU910
|
|
00811 DISPLAY 'BU910 REWRITE FAILED - ' FILE-STATUS DTSBU910
|
|
00812 *& DTSBU910
|
|
00813 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00814 DTSBU910
|
|
00815 IF FILE-OPEN-UPDATE-NO-AIX-88 DTSBU910
|
|
00816 GO TO P2200-EXIT. DTSBU910
|
|
00817 DTSBU910
|
|
00818 PERFORM S3200-CONSTRUCT-IPOST THRU S3200-EXIT. DTSBU910
|
|
00819 DTSBU910
|
|
00820 PERFORM S3300-UPDATE-AIX THRU S3300-EXIT. DTSBU910
|
|
00821 P2200-EXIT. DTSBU910
|
|
00822 EXIT. DTSBU910
|
|
00823 EJECT DTSBU910
|
|
00824 P2300-DELETE. DTSBU910
|
|
00825 IF FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00826 IF MSKL-HDR-88 OF LINK-REC DTSBU910
|
|
00827 NEXT SENTENCE DTSBU910
|
|
00828 ELSE DTSBU910
|
|
00829 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00830 DTSBU910
|
|
00831 PERFORM P2900-PREPARE-FOR-UPDATE THRU P2900-EXIT. DTSBU910
|
|
00832 DTSBU910
|
|
00833 IF L910-NO-REC-88 DTSBU910
|
|
00834 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00835 DTSBU910
|
|
00836 IF FILE-SUB = +1 DTSBU910
|
|
00837 DELETE MSTA-FILE RECORD DTSBU910
|
|
00838 ELSE DTSBU910
|
|
00839 IF FILE-SUB = +2 DTSBU910
|
|
00840 DELETE MSTB-FILE RECORD DTSBU910
|
|
00841 ELSE DTSBU910
|
|
00842 IF FILE-SUB = +3 DTSBU910
|
|
00843 DELETE MSTC-FILE RECORD DTSBU910
|
|
00844 ELSE DTSBU910
|
|
00845 IF FILE-SUB = +4 DTSBU910
|
|
00846 DELETE MSTD-FILE RECORD DTSBU910
|
|
00847 ELSE DTSBU910
|
|
00848 IF FILE-SUB = +5 DTSBU910
|
|
00849 DELETE MSTH-FILE RECORD DTSBU910
|
|
00850 ELSE DTSBU910
|
|
00851 IF FILE-SUB = +6 DTSBU910
|
|
00852 DELETE MSTI-FILE RECORD DTSBU910
|
|
00853 ELSE DTSBU910
|
|
00854 IF FILE-SUB = +7 DTSBU910
|
|
00855 DELETE MSTJ-FILE RECORD DTSBU910
|
|
00856 ELSE DTSBU910
|
|
00857 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00858 DTSBU910
|
|
00859 IF FILE-OK-88 DTSBU910
|
|
00860 NEXT SENTENCE DTSBU910
|
|
00861 ELSE DTSBU910
|
|
00862 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00863 DTSBU910
|
|
00864 IF FILE-OPEN-UPDATE-NO-AIX-88 DTSBU910
|
|
00865 GO TO P2300-EXIT. DTSBU910
|
|
00866 DTSBU910
|
|
00867 MOVE LOW-VALUES TO POST-UPDATE-AIX-RECS. DTSBU910
|
|
00868 DTSBU910
|
|
00869 PERFORM S3300-UPDATE-AIX THRU S3300-EXIT. DTSBU910
|
|
00870 P2300-EXIT. DTSBU910
|
|
00871 EXIT. DTSBU910
|
|
00872 EJECT DTSBU910
|
|
00873 P2900-PREPARE-FOR-UPDATE. DTSBU910
|
|
00874 IF FILE-SUB = +1 DTSBU910
|
|
00875 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00876 TO MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
|
00877 READ MSTA-FILE INTO MIO-REC DTSBU910
|
|
00878 ELSE DTSBU910
|
|
00879 IF FILE-SUB = +2 DTSBU910
|
|
00880 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00881 TO MSKL-KEY-AREA OF MSTB-SKL-REC DTSBU910
|
|
00882 READ MSTB-FILE INTO MIO-REC DTSBU910
|
|
00883 ELSE DTSBU910
|
|
00884 IF FILE-SUB = +3 DTSBU910
|
|
00885 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00886 TO MSKL-KEY-AREA OF MSTC-SKL-REC DTSBU910
|
|
00887 READ MSTC-FILE INTO MIO-REC DTSBU910
|
|
00888 ELSE DTSBU910
|
|
00889 IF FILE-SUB = +4 DTSBU910
|
|
00890 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00891 TO MSKL-KEY-AREA OF MSTD-SKL-REC DTSBU910
|
|
00892 READ MSTD-FILE INTO MIO-REC DTSBU910
|
|
00893 ELSE DTSBU910
|
|
00894 IF FILE-SUB = +5 DTSBU910
|
|
00895 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00896 TO MSKL-KEY-AREA OF MSTH-SKL-REC DTSBU910
|
|
00897 READ MSTH-FILE INTO MIO-REC DTSBU910
|
|
00898 ELSE DTSBU910
|
|
00899 IF FILE-SUB = +6 DTSBU910
|
|
00900 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00901 TO MSKL-KEY-AREA OF MSTI-SKL-REC DTSBU910
|
|
00902 READ MSTI-FILE INTO MIO-REC DTSBU910
|
|
00903 ELSE DTSBU910
|
|
00904 IF FILE-SUB = +7 DTSBU910
|
|
00905 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
|
00906 TO MSKL-KEY-AREA OF MSTJ-SKL-REC DTSBU910
|
|
00907 READ MSTJ-FILE INTO MIO-REC DTSBU910
|
|
00908 ELSE DTSBU910
|
|
00909 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00910 DTSBU910
|
|
00911 IF FILE-NO-REC-88 DTSBU910
|
|
00912 PERFORM S1100-NO-REC THRU S1100-EXIT DTSBU910
|
|
00913 GO TO P2900-EXIT. DTSBU910
|
|
00914 DTSBU910
|
|
00915 IF FILE-OK-88 DTSBU910
|
|
00916 NEXT SENTENCE DTSBU910
|
|
00917 ELSE DTSBU910
|
|
00918 *& DTSBU910
|
|
00919 DISPLAY 'BU910 P2900 READ FAILED - ' FILE-STATUS DTSBU910
|
|
00920 *& DTSBU910
|
|
00921 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00922 DTSBU910
|
|
00923 IF FILE-OPEN-UPDATE-NO-AIX-88 DTSBU910
|
|
00924 MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS DTSBU910
|
|
00925 ELSE DTSBU910
|
|
00926 IF MLEN-AIX-YES-88 (REC-TYPE-SUB) DTSBU910
|
|
00927 PERFORM S2110-IO-TO-WRK THRU S2110-EXIT DTSBU910
|
|
00928 PERFORM S3100-CONSTRUCT-IPRE THRU S3100-EXIT DTSBU910
|
|
00929 ELSE DTSBU910
|
|
00930 MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS. DTSBU910
|
|
00931 P2900-EXIT. DTSBU910
|
|
00932 EXIT. DTSBU910
|
|
00933 EJECT DTSBU910
|
|
00934 P4100-OPEN. DTSBU910
|
|
00935 IF L910-OPEN-READ-88 DTSBU910
|
|
00936 OR DTSBU910
|
|
00937 L910-OPEN-UPDATE-88 DTSBU910
|
|
00938 OR DTSBU910
|
|
00939 L910-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00940 OR DTSBU910
|
|
00941 L910-OPEN-UPDATE-NO-AIX-88 DTSBU910
|
|
00942 NEXT SENTENCE DTSBU910
|
|
00943 ELSE DTSBU910
|
|
00944 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00945 DTSBU910
|
|
00946 MOVE L910-CMND-CD TO FILE-STATE. DTSBU910
|
|
00947 DTSBU910
|
|
00948 DTSBU910
|
|
00949 MOVE +1 TO FILE-SUB. DTSBU910
|
|
00950 DTSBU910
|
|
00951 IF FILE-OPEN-READ-88 DTSBU910
|
|
00952 OPEN INPUT MSTA-FILE DTSBU910
|
|
00953 ELSE DTSBU910
|
|
00954 OPEN I-O MSTA-FILE. DTSBU910
|
|
00955 DTSBU910
|
|
00956 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
00957 NEXT SENTENCE DTSBU910
|
|
00958 ELSE DTSBU910
|
|
00959 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00960 DTSBU910
|
|
00961 DTSBU910
|
|
00962 MOVE +2 TO FILE-SUB. DTSBU910
|
|
00963 DTSBU910
|
|
00964 IF FILE-OPEN-READ-88 OR FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00965 OPEN INPUT MSTB-FILE DTSBU910
|
|
00966 ELSE DTSBU910
|
|
00967 OPEN I-O MSTB-FILE. DTSBU910
|
|
00968 DTSBU910
|
|
00969 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
00970 NEXT SENTENCE DTSBU910
|
|
00971 ELSE DTSBU910
|
|
00972 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00973 DTSBU910
|
|
00974 DTSBU910
|
|
00975 MOVE +3 TO FILE-SUB. DTSBU910
|
|
00976 DTSBU910
|
|
00977 IF FILE-OPEN-READ-88 OR FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00978 OPEN INPUT MSTC-FILE DTSBU910
|
|
00979 ELSE DTSBU910
|
|
00980 OPEN I-O MSTC-FILE. DTSBU910
|
|
00981 DTSBU910
|
|
00982 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
00983 NEXT SENTENCE DTSBU910
|
|
00984 ELSE DTSBU910
|
|
00985 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00986 DTSBU910
|
|
00987 DTSBU910
|
|
00988 MOVE +4 TO FILE-SUB. DTSBU910
|
|
00989 DTSBU910
|
|
00990 IF FILE-OPEN-READ-88 OR FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
00991 OPEN INPUT MSTD-FILE DTSBU910
|
|
00992 ELSE DTSBU910
|
|
00993 OPEN I-O MSTD-FILE. DTSBU910
|
|
00994 DTSBU910
|
|
00995 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
00996 NEXT SENTENCE DTSBU910
|
|
00997 ELSE DTSBU910
|
|
00998 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
00999 DTSBU910
|
|
01000 MOVE +5 TO FILE-SUB. DTSBU910
|
|
01001 DTSBU910
|
|
01002 IF FILE-OPEN-READ-88 OR FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
01003 OPEN INPUT MSTH-FILE DTSBU910
|
|
01004 ELSE DTSBU910
|
|
01005 OPEN I-O MSTH-FILE. DTSBU910
|
|
01006 DTSBU910
|
|
01007 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
01008 NEXT SENTENCE DTSBU910
|
|
01009 ELSE DTSBU910
|
|
01010 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01011 DTSBU910
|
|
01012 MOVE +6 TO FILE-SUB. DTSBU910
|
|
01013 DTSBU910
|
|
01014 IF FILE-OPEN-READ-88 OR FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
01015 OPEN INPUT MSTI-FILE DTSBU910
|
|
01016 ELSE DTSBU910
|
|
01017 OPEN I-O MSTI-FILE. DTSBU910
|
|
01018 DTSBU910
|
|
01019 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
01020 NEXT SENTENCE DTSBU910
|
|
01021 ELSE DTSBU910
|
|
01022 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01023 DTSBU910
|
|
01024 MOVE +7 TO FILE-SUB. DTSBU910
|
|
01025 DTSBU910
|
|
01026 IF FILE-OPEN-READ-88 OR FILE-OPEN-UPDATE-HDR-88 DTSBU910
|
|
01027 OPEN INPUT MSTJ-FILE DTSBU910
|
|
01028 ELSE DTSBU910
|
|
01029 OPEN I-O MSTJ-FILE. DTSBU910
|
|
01030 DTSBU910
|
|
01031 IF FILE-OK-88 OR FILE-VERIFY-88 DTSBU910
|
|
01032 NEXT SENTENCE DTSBU910
|
|
01033 ELSE DTSBU910
|
|
01034 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01035 P4100-EXIT. DTSBU910
|
|
01036 EXIT. DTSBU910
|
|
01037 EJECT DTSBU910
|
|
01038 P4200-CLOSE. DTSBU910
|
|
01039 MOVE L910-CMND-CD TO FILE-STATE. DTSBU910
|
|
01040 DTSBU910
|
|
01041 DTSBU910
|
|
01042 MOVE +1 TO FILE-SUB. DTSBU910
|
|
01043 DTSBU910
|
|
01044 CLOSE MSTA-FILE. DTSBU910
|
|
01045 DTSBU910
|
|
01046 IF FILE-OK-88 DTSBU910
|
|
01047 NEXT SENTENCE DTSBU910
|
|
01048 ELSE DTSBU910
|
|
01049 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01050 DTSBU910
|
|
01051 DTSBU910
|
|
01052 MOVE +2 TO FILE-SUB. DTSBU910
|
|
01053 DTSBU910
|
|
01054 CLOSE MSTB-FILE. DTSBU910
|
|
01055 DTSBU910
|
|
01056 IF FILE-OK-88 DTSBU910
|
|
01057 NEXT SENTENCE DTSBU910
|
|
01058 ELSE DTSBU910
|
|
01059 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01060 DTSBU910
|
|
01061 DTSBU910
|
|
01062 MOVE +3 TO FILE-SUB. DTSBU910
|
|
01063 DTSBU910
|
|
01064 CLOSE MSTC-FILE. DTSBU910
|
|
01065 DTSBU910
|
|
01066 IF FILE-OK-88 DTSBU910
|
|
01067 NEXT SENTENCE DTSBU910
|
|
01068 ELSE DTSBU910
|
|
01069 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01070 DTSBU910
|
|
01071 DTSBU910
|
|
01072 MOVE +4 TO FILE-SUB. DTSBU910
|
|
01073 DTSBU910
|
|
01074 CLOSE MSTD-FILE. DTSBU910
|
|
01075 DTSBU910
|
|
01076 IF FILE-OK-88 DTSBU910
|
|
01077 NEXT SENTENCE DTSBU910
|
|
01078 ELSE DTSBU910
|
|
01079 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01080 DTSBU910
|
|
01081 MOVE +5 TO FILE-SUB. DTSBU910
|
|
01082 DTSBU910
|
|
01083 CLOSE MSTH-FILE. DTSBU910
|
|
01084 DTSBU910
|
|
01085 IF FILE-OK-88 DTSBU910
|
|
01086 NEXT SENTENCE DTSBU910
|
|
01087 ELSE DTSBU910
|
|
01088 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01089 DTSBU910
|
|
01090 MOVE +6 TO FILE-SUB. DTSBU910
|
|
01091 DTSBU910
|
|
01092 CLOSE MSTI-FILE. DTSBU910
|
|
01093 DTSBU910
|
|
01094 IF FILE-OK-88 DTSBU910
|
|
01095 NEXT SENTENCE DTSBU910
|
|
01096 ELSE DTSBU910
|
|
01097 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01098 DTSBU910
|
|
01099 MOVE +7 TO FILE-SUB. DTSBU910
|
|
01100 DTSBU910
|
|
01101 CLOSE MSTJ-FILE. DTSBU910
|
|
01102 DTSBU910
|
|
01103 IF FILE-OK-88 DTSBU910
|
|
01104 NEXT SENTENCE DTSBU910
|
|
01105 ELSE DTSBU910
|
|
01106 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01107 P4200-EXIT. DTSBU910
|
|
01108 EXIT. DTSBU910
|
|
01109 EJECT DTSBU910
|
|
01110 S1100-NO-REC. DTSBU910
|
|
01111 SET L910-NO-REC-88 TO TRUE. DTSBU910
|
|
01112 S1100-EXIT. DTSBU910
|
|
01113 EXIT. DTSBU910
|
|
01114 EJECT DTSBU910
|
|
01115 S2100-IO-TO-LINK. DTSBU910
|
|
01116 PERFORM S2110-IO-TO-WRK THRU S2110-EXIT. DTSBU910
|
|
01117 DTSBU910
|
|
01118 MOVE WRK-REC (1:WRK-REC-LENGTH) DTSBU910
|
|
01119 TO LINK-REC (1:WRK-REC-LENGTH). DTSBU910
|
|
01120 S2100-EXIT. DTSBU910
|
|
01121 EXIT. DTSBU910
|
|
01122 SKIP3 DTSBU910
|
|
01123 S2110-IO-TO-WRK. DTSBU910
|
|
01124 MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF WRK-REC. DTSBU910
|
|
01125 DTSBU910
|
|
01126 MOVE +0 TO MSKL-PURGE-DATE OF WRK-REC. DTSBU910
|
|
01127 DTSBU910
|
|
01128 PERFORM S7000-IO-DATA-TO-WRK-DATA THRU S7000-EXIT. DTSBU910
|
|
01129 DTSBU910
|
|
01130 COMPUTE WRK-REC-LENGTH DTSBU910
|
|
01131 = MLEN-MSKL-NONDATA-LEN + WRK-DATA-LENGTH. DTSBU910
|
|
01132 S2110-EXIT. DTSBU910
|
|
01133 EXIT. DTSBU910
|
|
01134 EJECT DTSBU910
|
|
01135 S2200-LINK-TO-IO. DTSBU910
|
|
01136 PERFORM S2210-LINK-TO-WRK THRU S2210-EXIT. DTSBU910
|
|
01137 DTSBU910
|
|
01138 MOVE MSKL-KEY-AREA OF WRK-REC TO MIO-KEY-AREA. DTSBU910
|
|
01139 DTSBU910
|
|
01140 PERFORM S6000-WRK-DATA-TO-IO-DATA THRU S6000-EXIT. DTSBU910
|
|
01141 DTSBU910
|
|
01142 COMPUTE MIO-REC-LENGTH DTSBU910
|
|
01143 = MLEN-MIO-NONDATA-LEN + MIO-DATA-LENGTH. DTSBU910
|
|
01144 S2200-EXIT. DTSBU910
|
|
01145 EXIT. DTSBU910
|
|
01146 SKIP3 DTSBU910
|
|
01147 S2210-LINK-TO-WRK. DTSBU910
|
|
01148 MOVE MLEN-MSKL-NONDATA-LEN TO WRK-REC-LENGTH. DTSBU910
|
|
01149 DTSBU910
|
|
01150 SET MLEN-IDX TO REC-TYPE-SUB. DTSBU910
|
|
01151 DTSBU910
|
|
01152 MOVE MLEN-FIX-LEN (MLEN-IDX) TO WRK-DATA-LENGTH. DTSBU910
|
|
01153 DTSBU910
|
|
01154 IF MLEN-OCC-MAX (MLEN-IDX) = +0 DTSBU910
|
|
01155 ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH DTSBU910
|
|
01156 MOVE LINK-REC (1:WRK-REC-LENGTH) DTSBU910
|
|
01157 TO WRK-REC (1:WRK-REC-LENGTH) DTSBU910
|
|
01158 GO TO S2210-EXIT. DTSBU910
|
|
01159 DTSBU910
|
|
01160 COMPUTE OCC-COUNT-START = WRK-DATA-LENGTH - 1. DTSBU910
|
|
01161 DTSBU910
|
|
01162 MOVE MSKL-DATA-AREA OF LINK-REC (OCC-COUNT-START:2) DTSBU910
|
|
01163 TO OCC-COUNT-X. DTSBU910
|
|
01164 DTSBU910
|
|
01165 IF (OCC-COUNT < +0) DTSBU910
|
|
01166 OR DTSBU910
|
|
01167 (OCC-COUNT > MLEN-OCC-MAX (MLEN-IDX)) DTSBU910
|
|
01168 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01169 DTSBU910
|
|
01170 COMPUTE WRK-DATA-LENGTH = WRK-DATA-LENGTH DTSBU910
|
|
01171 + (OCC-COUNT * MLEN-VAR-LEN (MLEN-IDX)). DTSBU910
|
|
01172 DTSBU910
|
|
01173 IF WRK-DATA-LENGTH > MLEN-MAX-MSKL-DATA-LEN DTSBU910
|
|
01174 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01175 DTSBU910
|
|
01176 ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH. DTSBU910
|
|
01177 DTSBU910
|
|
01178 MOVE LINK-REC (1:WRK-REC-LENGTH) DTSBU910
|
|
01179 TO WRK-REC (1:WRK-REC-LENGTH). DTSBU910
|
|
01180 S2210-EXIT. DTSBU910
|
|
01181 EXIT. DTSBU910
|
|
01182 EJECT DTSBU910
|
|
01183 ++INCLUDE DTSIP001 DTSBU910
|
|
01184 EJECT DTSBU910
|
|
01185 ++INCLUDE DTSIP002 DTSBU910
|
|
01186 EJECT DTSBU910
|
|
01187 S3300-UPDATE-AIX. DTSBU910
|
|
01188 MOVE WRK-MOD-NAME TO L921-MOD-NAME. DTSBU910
|
|
01189 DTSBU910
|
|
01190 MOVE L910-TRACE-IND TO L921-TRACE-IND. DTSBU910
|
|
01191 DTSBU910
|
|
01192 PERFORM S3310-AIX-LOOP THRU S3310-EXIT DTSBU910
|
|
01193 VARYING AIX-REC-SUB FROM 1 BY 1 DTSBU910
|
|
01194 UNTIL (AIX-REC-SUB > AIX-REC-MAX). DTSBU910
|
|
01195 S3300-EXIT. DTSBU910
|
|
01196 EXIT. DTSBU910
|
|
01197 SKIP3 DTSBU910
|
|
01198 S3310-AIX-LOOP. DTSBU910
|
|
01199 IF PRE-UPDATE-AIX-REC (AIX-REC-SUB) DTSBU910
|
|
01200 = POST-UPDATE-AIX-REC (AIX-REC-SUB) DTSBU910
|
|
01201 GO TO S3310-EXIT. DTSBU910
|
|
01202 DTSBU910
|
|
01203 IF PRE-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES DTSBU910
|
|
01204 MOVE PRE-UPDATE-AIX-REC (AIX-REC-SUB) TO ISKL-REC DTSBU910
|
|
01205 PERFORM S3311-AIX-DELETE THRU S3311-EXIT. DTSBU910
|
|
01206 DTSBU910
|
|
01207 IF POST-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES DTSBU910
|
|
01208 MOVE POST-UPDATE-AIX-REC (AIX-REC-SUB) TO ISKL-REC DTSBU910
|
|
01209 PERFORM S3312-AIX-WRITE THRU S3312-EXIT. DTSBU910
|
|
01210 S3310-EXIT. DTSBU910
|
|
01211 EXIT. DTSBU910
|
|
01212 SKIP3 DTSBU910
|
|
01213 S3311-AIX-DELETE. DTSBU910
|
|
01214 PERFORM S921-AIX-READ THRU S921-EXIT. DTSBU910
|
|
01215 DTSBU910
|
|
01216 IF L921-NO-REC-88 DTSBU910
|
|
01217 GO TO S3311-EXIT. DTSBU910
|
|
01218 DTSBU910
|
|
01219 PERFORM S921-AIX-DELETE THRU S921-EXIT. DTSBU910
|
|
01220 S3311-EXIT. DTSBU910
|
|
01221 EXIT. DTSBU910
|
|
01222 SKIP3 DTSBU910
|
|
01223 S3312-AIX-WRITE. DTSBU910
|
|
01224 PERFORM S921-AIX-READ THRU S921-EXIT. DTSBU910
|
|
01225 DTSBU910
|
|
01226 IF NOT L921-NO-REC-88 DTSBU910
|
|
01227 GO TO S3312-EXIT. DTSBU910
|
|
01228 DTSBU910
|
|
01229 PERFORM S921-AIX-WRITE THRU S921-EXIT. DTSBU910
|
|
01230 S3312-EXIT. DTSBU910
|
|
01231 EXIT. DTSBU910
|
|
01232 EJECT DTSBU910
|
|
01233 ++INCLUDE DTSIP003 DTSBU910
|
|
01234 EJECT DTSBU910
|
|
01235 ++INCLUDE DTSIP006 DTSBU910
|
|
01236 EJECT DTSBU910
|
|
01237 ++INCLUDE DTSIP007 DTSBU910
|
|
01238 EJECT DTSBU910
|
|
01239 S9100-PRE-DISPLAY. DTSBU910
|
|
01240 DISPLAY ' '. DTSBU910
|
|
01241 DTSBU910
|
|
01242 DISPLAY ' '. DTSBU910
|
|
01243 DTSBU910
|
|
01244 DISPLAY '*** DTSBU910 PRE TRACE DISPLAY ***'. DTSBU910
|
|
01245 DTSBU910
|
|
01246 DISPLAY L910-MOD-NAME DTSBU910
|
|
01247 ' = L910-MOD-NAME'. DTSBU910
|
|
01248 DTSBU910
|
|
01249 DISPLAY L910-CMND-CD DTSBU910
|
|
01250 ' = L910-CMND-CD'. DTSBU910
|
|
01251 DTSBU910
|
|
01252 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU910
|
|
01253 S9100-EXIT. DTSBU910
|
|
01254 EXIT. DTSBU910
|
|
01255 SKIP3 DTSBU910
|
|
01256 S9200-POST-DISPLAY. DTSBU910
|
|
01257 DISPLAY ' '. DTSBU910
|
|
01258 DTSBU910
|
|
01259 DISPLAY ' '. DTSBU910
|
|
01260 DTSBU910
|
|
01261 DISPLAY '*** DTSBU910 POST TRACE DISPLAY ***'. DTSBU910
|
|
01262 DTSBU910
|
|
01263 DISPLAY L910-RESULT-IND DTSBU910
|
|
01264 ' = L910-RESULT-IND'. DTSBU910
|
|
01265 DTSBU910
|
|
01266 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU910
|
|
01267 S9200-EXIT. DTSBU910
|
|
01268 EXIT. DTSBU910
|
|
01269 SKIP3 DTSBU910
|
|
01270 S9300-REC-DISPLAY. DTSBU910
|
|
01271 DISPLAY ' '. DTSBU910
|
|
01272 DTSBU910
|
|
01273 IF (MSKL-REC-TYPE OF LINK-REC < +1) DTSBU910
|
|
01274 OR DTSBU910
|
|
01275 (MSKL-REC-TYPE OF LINK-REC > MLEN-MAX-REC-TYPE) DTSBU910
|
|
01276 MOVE SPACES TO WRK-REC-PREFIX DTSBU910
|
|
01277 ELSE DTSBU910
|
|
01278 MOVE MLEN-PREFIX (MSKL-REC-TYPE OF LINK-REC) DTSBU910
|
|
01279 TO WRK-REC-PREFIX. DTSBU910
|
|
01280 DTSBU910
|
|
01281 IF WRK-REC-PREFIX = SPACES DTSBU910
|
|
01282 MOVE '????' TO WRK-REC-PREFIX. DTSBU910
|
|
01283 DTSBU910
|
|
01284 MOVE MLEN-MAX-KEY-LEN TO L991-REQ-CHAR-CNT. DTSBU910
|
|
01285 DTSBU910
|
|
01286 MOVE MSKL-KEY-AREA OF LINK-REC TO L991-REQ-AREA. DTSBU910
|
|
01287 DTSBU910
|
|
01288 PERFORM S991-HEX-FORMAT THRU S991-EXIT. DTSBU910
|
|
01289 DTSBU910
|
|
01290 DISPLAY 'REC TYPE = ' DTSBU910
|
|
01291 WRK-REC-PREFIX. DTSBU910
|
|
01292 DISPLAY 'KEY AREA = ' DTSBU910
|
|
01293 L991-REPLY-HEX-1-AREA. DTSBU910
|
|
01294 DISPLAY ' ' DTSBU910
|
|
01295 L991-REPLY-HEX-2-AREA. DTSBU910
|
|
01296 DISPLAY ' ' DTSBU910
|
|
01297 L991-REPLY-AN-AREA. DTSBU910
|
|
01298 S9300-EXIT. DTSBU910
|
|
01299 EXIT. DTSBU910
|
|
01300 EJECT DTSBU910
|
|
01301 S899-ABEND. DTSBU910
|
|
01302 PERFORM S999-ABEND THRU S999-EXIT. DTSBU910
|
|
01303 S899-EXIT. DTSBU910
|
|
01304 EXIT. DTSBU910
|
|
01305 SKIP3 DTSBU910
|
|
01306 S921-AIX-READ. DTSBU910
|
|
01307 SET L921-READ-88 TO TRUE. DTSBU910
|
|
01308 GO TO S921-AIX-IO. DTSBU910
|
|
01309 DTSBU910
|
|
01310 S921-AIX-DELETE. DTSBU910
|
|
01311 SET L921-DELETE-88 TO TRUE. DTSBU910
|
|
01312 GO TO S921-AIX-IO. DTSBU910
|
|
01313 DTSBU910
|
|
01314 S921-AIX-WRITE. DTSBU910
|
|
01315 SET L921-WRITE-88 TO TRUE. DTSBU910
|
|
01316 GO TO S921-AIX-IO. DTSBU910
|
|
01317 DTSBU910
|
|
01318 S921-AIX-IO. DTSBU910
|
|
01319 DTSBU910
|
|
01320 CALL 'DTSBU921' USING L921-LINK-AREA DTSBU910
|
|
01321 ISKL-REC. DTSBU910
|
|
01322 DTSBU910
|
|
01323 S921-EXIT. DTSBU910
|
|
01324 EXIT. DTSBU910
|
|
01325 SKIP3 DTSBU910
|
|
01326 S991-HEX-FORMAT. DTSBU910
|
|
01327 CALL 'DTSBU991' USING L991-LINK-AREA. DTSBU910
|
|
01328 S991-EXIT. DTSBU910
|
|
01329 EXIT. DTSBU910
|
|
01330 SKIP3 DTSBU910
|
|
01331 S999-ABEND. DTSBU910
|
|
01332 DISPLAY '*** MASTER FILE I/O MODULE ABENDING'. DTSBU910
|
|
01333 DTSBU910
|
|
01334 DISPLAY '*** CMND-CD = ' L910-CMND-CD. DTSBU910
|
|
01335 DTSBU910
|
|
01336 IF (FILE-SUB < +1) DTSBU910
|
|
01337 OR DTSBU910
|
|
01338 (FILE-SUB > +7) DTSBU910
|
|
01339 MOVE '????' TO WRK-FILE-NAME-SUFFIX DTSBU910
|
|
01340 ELSE DTSBU910
|
|
01341 MOVE WRK-FILE-SUFFIX (FILE-SUB) DTSBU910
|
|
01342 TO WRK-FILE-NAME-SUFFIX. DTSBU910
|
|
01343 DTSBU910
|
|
01344 DISPLAY '*** FILE NAME = ' WRK-FILE-NAME-SUFFIX. DTSBU910
|
|
01345 DTSBU910
|
|
01346 DISPLAY '*** FILE STATUS = ' FILE-STATUS. DTSBU910
|
|
01347 DTSBU910
|
|
01348 DISPLAY '*** CALLING MODULE = ' L910-MOD-NAME. DTSBU910
|
|
01349 DTSBU910
|
|
01350 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU910
|
|
01351 DTSBU910
|
|
01352 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU910
|
|
01353 S999-EXIT. DTSBU910
|
|
01354 EXIT. DTSBU910
|