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
