00001 IDENTIFICATION DIVISION. 07/17/03 00002 PROGRAM-ID. DTSBE992. DTSBE992 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV015 00004 DATE-WRITTEN. SEPTEMBER 1994. DTSBE992 00005 DATE-COMPILED. DTSBE992 00006 SKIP3 DTSBE992 00007 ***** DTSBE992 00008 * DTSBE992 00009 * FUNCTION: ALTERNATE INDEX EXTRACT. DTSBE992 00010 * DTSBE992 00011 * DTSBE992 00012 * DTSBE992 00013 * MODIFICATION LOG: DTSBE992 00014 * DTSBE992 00015 * 12/01/98 INITIAL DEVELOPMENT. COPIED FROM MACBE992 DTSBE992 00016 * WORK ORDER: JR PROGRAMMER: ZL1 DTSBE992 00017 * DTSBE992 00018 * DTSBE992 00019 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE992 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE992 00021 * REFERENCE RFP: #XXX PROGRAMMER: XXX DTSBE992 00022 * DTSBE992 00023 * DTSBE992 00024 * DESCRIPTION: DTSBE992 00025 * DTSBE992 00026 * DTSBE992 00027 * INITIATION: DTSBE992 00028 * DTSBE992 00029 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE992 00030 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE992 00031 * DTSBE992 00032 * EDIT AND DEFAULT PARAMETERS. DTSBE992 00033 * DTSBE992 00034 * DTSBE992 00035 * PROCESSING: DTSBE992 00036 * DTSBE992 00037 * CONSTRUCT AND WRITE ALTERNATE INDEX FILE RECORDS. DTSBE992 00038 * DTSBE992 00039 * DTSBE992 00040 * TERMINATION: DTSBE992 00041 * DTSBE992 00042 * NONE. DTSBE992 00043 * DTSBE992 00044 * DTSBE992 00045 * RECORDS READ: DTSBE992 00046 * DTSBE992 00047 * MASTER: DTSBE992 00048 * DTSBE992 00049 * MBAA DTSBE992 00050 * MFAS DTSBE992 00051 * MOPO DTSBE992 00052 * MREL DTSBE992 00053 * MTCK DTSBE992 00054 * MTNM DTSBE992 00055 * DTSBE992 00056 * DTSBE992 00057 * ALTERNATE INDEX: DTSBE992 00058 * DTSBE992 00059 * NONE. DTSBE992 00060 * DTSBE992 00061 * DTSBE992 00062 * REFERENCE: DTSBE992 00063 * DTSBE992 00064 * NONE. DTSBE992 00065 * DTSBE992 00066 * DTSBE992 00067 * RECORDS UPDATED: DTSBE992 00068 * DTSBE992 00069 * NONE. DTSBE992 00070 * DTSBE992 00071 * DTSBE992 00072 * REPORT RECORDS WRITTEN: DTSBE992 00073 * DTSBE992 00074 * NONE. DTSBE992 00075 * DTSBE992 00076 * DTSBE992 00077 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE992 00078 * DTSBE992 00079 * NONE. DTSBE992 00080 * DTSBE992 00081 * DTSBE992 00082 * MODULES CALLED: DTSBE992 00083 * DTSBE992 00084 * DTSBU910 MASTER FILE I/O. DTSBE992 00085 * DTSBE992 00086 * DTSBE992 00087 * VERMONT REFERENCE: DTSBE992 00088 * DTSBE992 00089 * DTSBE396 DTSBE992 00090 * DTSBE992 00091 ***** DTSBE992 00092 SKIP3 DTSBE992 00093 ENVIRONMENT DIVISION. DTSBE992 00094 SKIP2 DTSBE992 00095 INPUT-OUTPUT SECTION. DTSBE992 00096 SKIP1 DTSBE992 00097 FILE-CONTROL. DTSBE992 00098 SELECT AIXO-FILE ASSIGN TO DTSFAIXO DTSBE992 00099 FILE STATUS IS FILE-STATUS. DTSBE992 00100 EJECT DTSBE992 00101 DATA DIVISION. DTSBE992 00102 SKIP3 DTSBE992 00103 FILE SECTION. DTSBE992 00104 SKIP2 DTSBE992 00105 FD AIXO-FILE DTSBE992 00106 RECORDING MODE IS F DTSBE992 00107 BLOCK CONTAINS 0 RECORDS. DTSBE992 00108 SKIP1 DTSBE992 00109 01 AIXO-REC PIC X(64). DTSBE992 00110 EJECT DTSBE992 00111 WORKING-STORAGE SECTION. DTSBE992 001115 77 PAN-VALET PICTURE X(24) VALUE '015DTSBE992 07/17/03'. DTSBE992 00112 SKIP3 DTSBE992 00113 01 WRK-AREA. DTSBE992 00114 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +992.DTSBE992 00115 SKIP1 DTSBE992 00116 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE992'.DTSBE992 00117 SKIP3 DTSBE992 00118 05 ABEND-MSG PIC X(60). DTSBE992 00119 SKIP3 DTSBE992 00120 05 FILE-STATUS PIC X(02). DTSBE992 00121 88 FILE-OK-88 VALUE '00'. DTSBE992 00122 SKIP3 DTSBE992 00123 05 REC-TYPE-SUB PIC S9(04) COMP. DTSBE992 00124 EJECT DTSBE992 00125 01 AIX-WORK-AREA. DTSBE992 00126 ++INCLUDE DTSIXAIX DTSBE992 00127 EJECT DTSBE992 00128 01 L910-LINK-AREA. DTSBE992 00129 ++INCLUDE DTSIL910 DTSBE992 00130 SKIP3 DTSBE992 00131 01 WRK-REC. DTSBE992 00132 SKIP1 DTSBE992 00133 05 MSKL-REC. DTSBE992 00134 ++INCLUDE DTSIMSKL DTSBE992 00135 SKIP3 DTSBE992 00136 05 MBAA-REC REDEFINES MSKL-REC. DTSBE992 00137 ++INCLUDE DTSIMBAA DTSBE992 00138 SKIP3 DTSBE992 00139 05 MFAS-REC REDEFINES MSKL-REC. DTSBE992 00140 ++INCLUDE DTSIMFAS DTSBE992 00141 SKIP3 DTSBE992 00142 05 MOPO-REC REDEFINES MSKL-REC. DTSBE992 00143 ++INCLUDE DTSIMOPO DTSBE992 00144 SKIP3 DTSBE992 00145 05 MPAY-REC REDEFINES MSKL-REC. DTSBE992 00146 ++INCLUDE DTSIMPAY DTSBE992 00147 SKIP3 DTSBE992 00148 05 MREL-REC REDEFINES MSKL-REC. DTSBE992 00149 ++INCLUDE DTSIMREL DTSBE992 00150 SKIP3 DTSBE992 00151 05 MRPT-REC REDEFINES MSKL-REC. DTSBE992 00152 ++INCLUDE DTSIMRPT DTSBE992 00153 SKIP3 DTSBE992 00154 05 MTCK-REC REDEFINES MSKL-REC. DTSBE992 00155 ++INCLUDE DTSIMTCK DTSBE992 00156 SKIP3 DTSBE992 00157 05 MTAA-REC REDEFINES MSKL-REC. DTSBE992 00158 ++INCLUDE DTSIMTAA DTSBE992 00159 EJECT DTSBE992 00160 01 IBTB-REC. DTSBE992 00161 ++INCLUDE DTSIIBTB DTSBE992 00162 SKIP3 DTSBE992 00163 01 IBTN-REC. DTSBE992 00164 ++INCLUDE DTSIIBTN DTSBE992 00165 SKIP3 DTSBE992 00166 01 IEIN-REC. DTSBE992 00167 ++INCLUDE DTSIIEIN DTSBE992 00168 SKIP3 DTSBE992 00169 01 IFAN-REC. DTSBE992 00170 ++INCLUDE DTSIIFAN DTSBE992 00171 SKIP3 DTSBE992 00172 01 IFID-REC. DTSBE992 00173 ++INCLUDE DTSIIFID DTSBE992 00174 SKIP3 DTSBE992 00175 01 IOPN-REC. DTSBE992 00176 ++INCLUDE DTSIIOPN DTSBE992 00177 SKIP3 DTSBE992 00178 01 IOPS-REC. DTSBE992 00179 ++INCLUDE DTSIIOPS DTSBE992 00180 SKIP3 DTSBE992 00181 01 IPES-REC. DTSBE992 00182 ++INCLUDE DTSIIPES DTSBE992 00183 SKIP3 DTSBE992 00184 01 ITDS-REC. DTSBE992 00185 ++INCLUDE DTSIITDS DTSBE992 00186 SKIP3 DTSBE992 00187 01 IZIP-REC. DTSBE992 00188 ++INCLUDE DTSIIZIP DTSBE992 00189 SKIP3 DTSBE992 00190 01 ITRT-REC. DTSBE992 00191 ++INCLUDE DTSIITRT DTSBE992 00192 SKIP3 DTSBE992 00193 01 ITRE-REC. DTSBE992 00194 ++INCLUDE DTSIITRE DTSBE992 00195 SKIP3 DTSBE992 00196 EJECT DTSBE992 00197 01 MLEN-LITERALS. DTSBE992 00198 ++INCLUDE DTSIMLEN DTSBE992 00199 EJECT DTSBE992 00200 LINKAGE SECTION. DTSBE992 00201 SKIP3 DTSBE992 00202 01 LECM-LINK-AREA. DTSBE992 00203 ++INCLUDE DTSILECM DTSBE992 00204 SKIP3 DTSBE992 00205 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE992 00206 15 FILLER PIC X(68). DTSBE992 00207 EJECT DTSBE992 00208 01 MPRF-LINK-REC. DTSBE992 00209 ++INCLUDE DTSIMPRF DTSBE992 00210 EJECT DTSBE992 00211 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE992 00212 MPRF-LINK-REC. DTSBE992 00213 SKIP2 DTSBE992 00214 IF LECM-PROCESS-88 DTSBE992 00215 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE992 00216 ELSE DTSBE992 00217 IF LECM-INITIALIZE-88 DTSBE992 00218 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE992 00219 ELSE DTSBE992 00220 IF LECM-TERMINATE-88 DTSBE992 00221 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE992 00222 ELSE DTSBE992 00223 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE992 00224 TO ABEND-MSG DTSBE992 00225 PERFORM S999-ABEND THRU S999-EXIT. DTSBE992 00226 SKIP2 DTSBE992 00227 GOBACK. DTSBE992 00228 EJECT DTSBE992 00229 I0000-INITIALIZE. DTSBE992 00230 SKIP2 DTSBE992 00231 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE992 00232 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE992 00233 DTSBE992 00234 OPEN OUTPUT AIXO-FILE. DTSBE992 00235 DTSBE992 00236 IF FILE-OK-88 DTSBE992 00237 NEXT SENTENCE DTSBE992 00238 ELSE DTSBE992 00239 MOVE 'UNEXPECTED FILE STATUS ENCOUNTERED DURING OPEN' DTSBE992 00240 TO ABEND-MSG DTSBE992 00241 PERFORM S999-ABEND THRU S999-EXIT. DTSBE992 00242 DTSBE992 00243 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE992 00244 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE992 00245 SKIP2 DTSBE992 00246 I0000-EXIT. DTSBE992 00247 EXIT. DTSBE992 00248 EJECT DTSBE992 00249 P0000-PROCESS. DTSBE992 00250 SET MSKL-PRF-88 TO TRUE. DTSBE992 00251 DTSBE992 00252 MOVE +2 TO REC-TYPE-SUB. DTSBE992 00253 DTSBE992 00254 PERFORM S3100-CONSTRUCT-IPRE THRU S3100-EXIT. DTSBE992 00255 DTSBE992 00256 PERFORM S4000-WRITE-AIX-RECS THRU S4000-EXIT. DTSBE992 00257 DTSBE992 00258 DTSBE992 00259 PERFORM P1000-REC-TYPE-LOOP THRU P1000-EXIT DTSBE992 00260 VARYING MLEN-IDX FROM 3 BY 1 DTSBE992 00261 UNTIL MLEN-IDX > MLEN-MAX-REC-TYPE. DTSBE992 00262 P0000-EXIT. DTSBE992 00263 EXIT. DTSBE992 00264 EJECT DTSBE992 00265 P1000-REC-TYPE-LOOP. DTSBE992 00266 IF MLEN-AIX-NO-88 (MLEN-IDX) DTSBE992 00267 GO TO P1000-EXIT. DTSBE992 00268 DTSBE992 00269 SET REC-TYPE-SUB TO MLEN-IDX. DTSBE992 00270 DTSBE992 00271 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE992 00272 DTSBE992 00273 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE992 00274 DTSBE992 00275 SET MSKL-REC-TYPE TO MLEN-IDX. DTSBE992 00276 DISPLAY ' CURR REC = ' MSKL-REC-TYPE ' ' MPRF-EMP-NO. DTSBE992 00277 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE992 00278 DTSBE992 00279 PERFORM P1100-SCAN-RECS THRU P1100-EXIT DTSBE992 00280 UNTIL L910-NO-REC-88. DTSBE992 00281 P1000-EXIT. DTSBE992 00282 EXIT. DTSBE992 00283 SKIP3 DTSBE992 00284 P1100-SCAN-RECS. DTSBE992 00285 PERFORM S3100-CONSTRUCT-IPRE THRU S3100-EXIT. DTSBE992 00286 DTSBE992 00287 PERFORM S4000-WRITE-AIX-RECS THRU S4000-EXIT. DTSBE992 00288 DTSBE992 00289 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE992 00290 P1100-EXIT. DTSBE992 00291 EXIT. DTSBE992 00292 EJECT DTSBE992 00293 T0000-TERMINATE. DTSBE992 00294 SKIP2 DTSBE992 00295 CLOSE AIXO-FILE. DTSBE992 00296 DTSBE992 00297 IF FILE-OK-88 DTSBE992 00298 NEXT SENTENCE DTSBE992 00299 ELSE DTSBE992 00300 MOVE 'UNEXPECTED FILE STATUS ENCOUNTERED DURING CLOSE' DTSBE992 00301 TO ABEND-MSG DTSBE992 00302 PERFORM S999-ABEND THRU S999-EXIT. DTSBE992 00303 SKIP2 DTSBE992 00304 T0000-EXIT. DTSBE992 00305 EXIT. DTSBE992 00306 EJECT DTSBE992 00307 ++INCLUDE DTSIP001 DTSBE992 00308 EJECT DTSBE992 00309 ++INCLUDE DTSIP003 DTSBE992 00310 EJECT DTSBE992 00311 S4000-WRITE-AIX-RECS. DTSBE992 00312 PERFORM DTSBE992 00313 VARYING AIX-REC-SUB FROM 1 BY 1 DTSBE992 00314 UNTIL AIX-REC-SUB > AIX-REC-MAX DTSBE992 00315 IF PRE-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES DTSBE992 00316 MOVE PRE-UPDATE-AIX-REC (AIX-REC-SUB) DTSBE992 00317 TO AIXO-REC DTSBE992 00318 PERFORM S992-WRITE-AIX THRU S992-EXIT DTSBE992 00319 END-IF DTSBE992 00320 END-PERFORM. DTSBE992 00321 S4000-EXIT. DTSBE992 00322 EXIT. DTSBE992 00323 EJECT DTSBE992 00324 S910-READ. DTSBE992 00325 SET L910-READ-88 TO TRUE. DTSBE992 00326 GO TO S910-MSTR-IO. DTSBE992 00327 SKIP1 DTSBE992 00328 S910-START-BROWSE. DTSBE992 00329 SET L910-START-BROWSE-88 TO TRUE. DTSBE992 00330 GO TO S910-MSTR-IO. DTSBE992 00331 SKIP1 DTSBE992 00332 S910-READ-NEXT. DTSBE992 00333 SET L910-READ-NEXT-88 TO TRUE. DTSBE992 00334 GO TO S910-MSTR-IO. DTSBE992 00335 SKIP1 DTSBE992 00336 S910-COUNT. DTSBE992 00337 SET L910-COUNT-88 TO TRUE. DTSBE992 00338 GO TO S910-MSTR-IO. DTSBE992 00339 SKIP1 DTSBE992 00340 S910-MSTR-IO. DTSBE992 00341 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE992 00342 MSKL-REC. DTSBE992 00343 S910-EXIT. DTSBE992 00344 EXIT. DTSBE992 00345 SKIP3 DTSBE992 00346 S992-WRITE-AIX. DTSBE992 00347 WRITE AIXO-REC. DTSBE992 00348 DTSBE992 00349 IF FILE-OK-88 DTSBE992 00350 NEXT SENTENCE DTSBE992 00351 ELSE DTSBE992 00352 PERFORM S999-ABEND THRU S999-EXIT. DTSBE992 00353 S992-EXIT. DTSBE992 00354 EXIT. DTSBE992 00355 SKIP3 DTSBE992 00356 S899-ABEND. DTSBE992 00357 MOVE 'LOGIC ERROR IN S3100' DTSBE992 00358 TO ABEND-MSG. DTSBE992 00359 PERFORM S999-ABEND THRU S999-EXIT. DTSBE992 00360 S899-EXIT. DTSBE992 00361 EXIT. DTSBE992 00362 SKIP3 DTSBE992 00363 S999-ABEND. DTSBE992 00364 DISPLAY '*** DTSBE992 ABENDING. ' DTSBE992 00365 ABEND-MSG. DTSBE992 00366 SKIP1 DTSBE992 00367 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE992 00368 S999-EXIT. DTSBE992 00369 EXIT. DTSBE992