00001  IDENTIFICATION DIVISION.                                         03/12/99
00002  PROGRAM-ID.             DTSBE791.                                DTSBE791
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV008
00004                          UPDATED BY TRW/BDM OCT. 1998.               CL**2
00005  DATE-WRITTEN.           DECEMBER 1994.                           DTSBE791
00006  DATE-COMPILED.                                                   DTSBE791
00007      SKIP3                                                        DTSBE791
00008 *****                                                             DTSBE791
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                               CL**4
00010 *                       DTSBE791 WHICH UPDATES DTSIR791              CL**4
00011 *                       DTSBR791 READS DTSIR791 RECORDS.             CL**4
00012 *                                                                    CL**4
00013 *    FUNCTION:  OPERATOR ID LIST EXTRACT.                         DTSBE791
00014 *                                                                 DTSBE791
00015 *                                                                 DTSBE791
00016 *    MODIFICATION LOG:                                            DTSBE791
00017 *                                                                 DTSBE791
00018 * 03-14-95 REARRANGE SORT ORDER, ADD CONTROL BREAKS AND TOTALS.   DTSBE791
00019 *          REFERENCE RFP #CR052           AUTHOR OF CHANGE - RHC  DTSBE791
00020 *                                                                 DTSBE791
00021 * XX-XX-XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX       DTSBE791
00022 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX       DTSBE791
00023 *          REFERENCE RFP #                AUTHOR OF CHANGE - XXX  DTSBE791
00024 *                                                                 DTSBE791
00025 *                                                                 DTSBE791
00026 *  DESCRIPTION:                                                   DTSBE791
00027 *                                                                 DTSBE791
00028 *                                                                 DTSBE791
00029 *    INITIATION:                                                  DTSBE791
00030 *                                                                 DTSBE791
00031 *      NO PARAMETERS ARE INPUT.                                   DTSBE791
00032 *                                                                 DTSBE791
00033 *                                                                 DTSBE791
00034 *    PROCESSING:                                                  DTSBE791
00035 *                                                                 DTSBE791
00036 *      NONE.                                                      DTSBE791
00037 *                                                                 DTSBE791
00038 *                                                                 DTSBE791
00039 *    TERMINATION:                                                 DTSBE791
00040 *                                                                 DTSBE791
00041 *      DO A START BROWSE ON THE FOPR RECORDS.                     DTSBE791
00042 *                                                                 DTSBE791
00043 *      SCAN THE FOPR RECORDS AND FOR EACH FOPR RECORD             DTSBE791
00044 *      ENCOUNTERED, CONSTRUCT AND WRITE A R791 RECORD.            DTSBE791
00045 *                                                                 DTSBE791
00046 *                                                                 DTSBE791
00047 *    RECORDS READ:                                                DTSBE791
00048 *                                                                 DTSBE791
00049 *      MASTER:                                                    DTSBE791
00050 *                                                                 DTSBE791
00051 *        NONE                                                     DTSBE791
00052 *                                                                 DTSBE791
00053 *                                                                 DTSBE791
00054 *      ALTERNATE INDEX:                                           DTSBE791
00055 *                                                                 DTSBE791
00056 *        NONE.                                                    DTSBE791
00057 *                                                                 DTSBE791
00058 *                                                                 DTSBE791
00059 *      REFERENCE:                                                 DTSBE791
00060 *                                                                 DTSBE791
00061 *        FOPR                                                     DTSBE791
00062 *                                                                 DTSBE791
00063 *                                                                 DTSBE791
00064 *    RECORDS UPDATED:                                             DTSBE791
00065 *                                                                 DTSBE791
00066 *        NONE                                                     DTSBE791
00067 *                                                                 DTSBE791
00068 *                                                                 DTSBE791
00069 *    REPORT RECORDS WRITTEN:                                      DTSBE791
00070 *                                                                 DTSBE791
00071 *        R791  OPERATOR ID LIST REPORT RECORD.                    DTSBE791
00072 *                                                                 DTSBE791
00073 *                                                                 DTSBE791
00074 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE791
00075 *                                                                 DTSBE791
00076 *        NONE.                                                    DTSBE791
00077 *                                                                 DTSBE791
00078 *                                                                 DTSBE791
00079 *    MODULES CALLED:                                              DTSBE791
00080 *                                                                 DTSBE791
00081 *        DTSBU931  REFERENCE FILE I/O DRIVER.                        CL**2
00082 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**2
00083 *                                                                 DTSBE791
00084 *                                                                 DTSBE791
00085 *    VERMONT REFERENCE:                                           DTSBE791
00086 *                                                                 DTSBE791
00087 *        NONE.                                                    DTSBE791
00088 *                                                                 DTSBE791
00089 *****                                                             DTSBE791
00090      SKIP3                                                        DTSBE791
00091  ENVIRONMENT DIVISION.                                            DTSBE791
00092      EJECT                                                        DTSBE791
00093  DATA DIVISION.                                                   DTSBE791
00094      SKIP3                                                        DTSBE791
00095  WORKING-STORAGE SECTION.                                         DTSBE791
000955 77  PAN-VALET PICTURE X(24) VALUE '008DTSBE791  03/12/99'.       DTSBE791
00096      SKIP3                                                        DTSBE791
00097  01  WRK-AREA.                                                    DTSBE791
00098      05  WRK-ABEND-CD               PIC S9(04)  COMP  VALUE +791. DTSBE791
00099      SKIP1                                                        DTSBE791
00100      05  WRK-MOD-NAME               PIC  X(08)  VALUE 'DTSBE791'.    CL**2
00101      SKIP3                                                        DTSBE791
00102      05  ABEND-MSG                  PIC  X(60).                   DTSBE791
00103      SKIP3                                                        DTSBE791
00104  01  MSG-AREA.                                                    DTSBE791
00105      05  MSG1-AREA.                                               DTSBE791
00106          10  MSG1-ID                PIC  X(03)  VALUE '   '.      DTSBE791
00107          10  MSG1-TEXT.                                           DTSBE791
00108              15  FILLER             PIC  X(40)                    DTSBE791
00109                VALUE '                                        '.  DTSBE791
00110              15  FILLER             PIC  X(40)                    DTSBE791
00111                VALUE '                                        '.  DTSBE791
00112      EJECT                                                        DTSBE791
00113  01  L001-LINK-AREA.                                              DTSBE791
00114  ++INCLUDE DTSIL001                                                  CL**2
00115      EJECT                                                        DTSBE791
00116  01  L004-LINK-AREA.                                              DTSBE791
00117  ++INCLUDE DTSIL004                                                  CL**2
00118      EJECT                                                        DTSBE791
00119  01  L931-LINK-AREA.                                              DTSBE791
00120  ++INCLUDE DTSIL931                                                  CL**2
00121      SKIP3                                                        DTSBE791
00122  01  FSKL-REC.                                                    DTSBE791
00123  ++INCLUDE DTSIFSKL                                                  CL**2
00124      SKIP3                                                        DTSBE791
00125  01  FOPR-REC.                                                    DTSBE791
00126  ++INCLUDE DTSIFOPR                                                  CL**2
00127      EJECT                                                        DTSBE791
00128  01  R791-REC.                                                    DTSBE791
00129  ++INCLUDE DTSIR791                                                  CL**2
00130      EJECT                                                        DTSBE791
00131  LINKAGE SECTION.                                                 DTSBE791
00132      SKIP3                                                        DTSBE791
00133  01  LECM-LINK-AREA.                                              DTSBE791
00134  ++INCLUDE DTSILECM                                                  CL**2
00135      EJECT                                                        DTSBE791
00136  01  MPRF-LINK-REC.                                               DTSBE791
00137  ++INCLUDE DTSIMPRF                                                  CL**2
00138      EJECT                                                        DTSBE791
00139  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE791
00140                           MPRF-LINK-REC.                          DTSBE791
00141      SKIP2                                                        DTSBE791
00142      MOVE LENGTH OF R791-REC TO R791-LENGTH.                         CL**7
00143      MOVE '791'              TO R791-REC-TYPE.                       CL**7
00144      SKIP2                                                           CL**7
00145      IF LECM-PROCESS-88                                           DTSBE791
00146          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE791
00147      ELSE                                                         DTSBE791
00148      IF LECM-INITIALIZE-88                                        DTSBE791
00149          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE791
00150      ELSE                                                         DTSBE791
00151      IF LECM-TERMINATE-88                                         DTSBE791
00152          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE791
00153      ELSE                                                         DTSBE791
00154          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE791
00155            TO ABEND-MSG                                           DTSBE791
00156          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE791
00157      SKIP2                                                        DTSBE791
00158      GOBACK.                                                      DTSBE791
00159      EJECT                                                        DTSBE791
00160 **************************************************************    DTSBE791
00161 *  THIS PARAGRAPH PERFORMS THE INITIATION FUNCTIONS.              DTSBE791
00162 **************************************************************    DTSBE791
00163                                                                   DTSBE791
00164  I0000-INITIALIZE.                                                DTSBE791
00165      SKIP2                                                        DTSBE791
00166      MOVE LECM-TRACE-IND TO L931-TRACE-IND.                       DTSBE791
00167      MOVE WRK-MOD-NAME TO L931-MOD-NAME.                          DTSBE791
00168                                                                   DTSBE791
00169      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE791
00170                                                                   DTSBE791
00171      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE791
00172      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE791
00173      SKIP2                                                        DTSBE791
00174  I0000-EXIT.                                                      DTSBE791
00175      EXIT.                                                        DTSBE791
00176      EJECT                                                        DTSBE791
00177  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE791
00178                                                                   DTSBE791
00179  I1000-EXIT.                                                      DTSBE791
00180      EXIT.                                                        DTSBE791
00181      EJECT                                                        DTSBE791
00182  P0000-PROCESS.                                                   DTSBE791
00183                                                                   DTSBE791
00184                                                                   DTSBE791
00185  P0000-EXIT.                                                      DTSBE791
00186      EXIT.                                                        DTSBE791
00187      EJECT                                                        DTSBE791
00188  T0000-TERMINATE.                                                 DTSBE791
00189      MOVE LOW-VALUES          TO  FSKL-KEY-AREA.                  DTSBE791
00190      SET FSKL-OPR-88          TO  TRUE.                           DTSBE791
00191                                                                   DTSBE791
00192      PERFORM S931-START-BROWSE THRU S931-EXIT.                    DTSBE791
00193                                                                   DTSBE791
00194      PERFORM                                                      DTSBE791
00195        UNTIL L931-NO-REC-88                                       DTSBE791
00196          MOVE FSKL-REC TO FOPR-REC                                DTSBE791
00197          MOVE FOPR-BUREAU-NAME OF FOPR-REC TO R791-BUREAU-NAME    DTSBE791
00198          MOVE FOPR-UNIT-NAME   OF FOPR-REC TO R791-UNIT-NAME      DTSBE791
00199          MOVE FOPR-OP-ID       OF FOPR-REC TO R791-OP-ID          DTSBE791
00200          MOVE FOPR-REC                     TO R791-DATA-AREA      DTSBE791
00201          PERFORM S946-WRITE-R791 THRU S946-EXIT                   DTSBE791
00202          PERFORM S931-READ-NEXT THRU S931-EXIT                    DTSBE791
00203      END-PERFORM.                                                 DTSBE791
00204  T0000-EXIT.                                                      DTSBE791
00205      EXIT.                                                        DTSBE791
00206      EJECT                                                        DTSBE791
00207  S001-FROM-FED-8.                                                 DTSBE791
00208      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE791
00209      GO TO S001-DATE.                                             DTSBE791
00210                                                                   DTSBE791
00211  S001-FROM-ABS-DAY.                                               DTSBE791
00212      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE791
00213      GO TO S001-DATE.                                             DTSBE791
00214                                                                   DTSBE791
00215  S001-DATE.                                                       DTSBE791
00216      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00217  S001-EXIT.                                                       DTSBE791
00218      EXIT.                                                        DTSBE791
00219      SKIP3                                                        DTSBE791
00220  S004-FROM-5.                                                     DTSBE791
00221      SET L004-FROM-5 TO TRUE.                                     DTSBE791
00222      GO TO S004-QTR.                                              DTSBE791
00223                                                                   DTSBE791
00224  S004-FROM-ABS.                                                   DTSBE791
00225      SET L004-FROM-ABS TO TRUE.                                   DTSBE791
00226      GO TO S004-QTR.                                              DTSBE791
00227                                                                   DTSBE791
00228  S004-FROM-3.                                                     DTSBE791
00229      SET L004-FROM-3 TO TRUE.                                     DTSBE791
00230      GO TO S004-QTR.                                              DTSBE791
00231                                                                   DTSBE791
00232  S004-QTR.                                                        DTSBE791
00233      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL**2
00234  S004-EXIT.                                                       DTSBE791
00235      EXIT.                                                        DTSBE791
00236      SKIP3                                                        DTSBE791
00237  S931-READ.                                                       DTSBE791
00238      SET L931-READ-88 TO TRUE.                                    DTSBE791
00239      GO TO S931-REF-I.                                            DTSBE791
00240                                                                   DTSBE791
00241  S931-START-BROWSE.                                               DTSBE791
00242      SET L931-START-BROWSE-88 TO TRUE.                            DTSBE791
00243      GO TO S931-REF-I.                                            DTSBE791
00244                                                                   DTSBE791
00245  S931-READ-NEXT.                                                  DTSBE791
00246      SET L931-READ-NEXT-88 TO TRUE.                               DTSBE791
00247      GO TO S931-REF-I.                                            DTSBE791
00248                                                                   DTSBE791
00249  S931-REF-I.                                                      DTSBE791
00250      CALL 'DTSBU931' USING L931-LINK-AREA                            CL**2
00251                            FSKL-REC.                              DTSBE791
00252  S931-EXIT.                                                       DTSBE791
00253      EXIT.                                                        DTSBE791
00254      SKIP3                                                        DTSBE791
00255  S946-WRITE-R791.                                                 DTSBE791
00256      CALL 'DTSBU946' USING R791-REC.                                 CL**2
00257      GO TO S946-EXIT.                                                CL**8
00258  S946-EXIT.                                                       DTSBE791
00259      EXIT.                                                        DTSBE791
00260      SKIP3                                                        DTSBE791
00261  S999-ABEND.                                                      DTSBE791
00262      DISPLAY '*** DTSBE791 ABENDING.  '                              CL**2
00263              ABEND-MSG.                                           DTSBE791
00264                                                                   DTSBE791
00265      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00266  S999-EXIT.                                                       DTSBE791
00267      EXIT.                                                        DTSBE791
