00001  IDENTIFICATION DIVISION.                                         10/17/13
00002  PROGRAM-ID.             DTSBX340.                                DTSBX340
00003  AUTHOR.                 NGC.                                        LV015
00004  DATE-WRITTEN.           OCTOBER 2007.                            DTSBX340
00005  DATE-COMPILED.                                                   DTSBX340
00006      SKIP3                                                        DTSBX340
00007 *****                                                             DTSBX340
00008 *                                                                 DTSBX340
00009 *    FUNCTION:  INTERNAL WEB MAINFRAME EXTRACT DRIVER             DTSBX340
00010 *                                                                 DTSBX340
00011 *                                                                 DTSBX340
00012 *    MODIFICATION LOG:                                            DTSBX340
00013 *                                                                 DTSBX340
00014 *    10/22/2007  INITIAL DEVELOPMENT.                             DTSBX340
00015 *                REFERENCE:                     PROGRAMMER: GD    DTSBX340
00016 *                                                                 DTSBX340
00017 *    02/12/2009  ADDED CALL TO DTSBX346 FOR BENEFIT CHARGES.      DTSBX340
00018 *                REFERENCE:                     PROGRAMMER: GD    DTSBX340
00019 *                                                                 DTSBX340
00020 *    03/23/2009  MODIFIED I4000 TO INCLUDE ACCOUNTING             DTSBX340
00021 *                DATA FOR EMPLOYERS INACTIVE MORE THAN 3 YEARS    DTSBX340
00022 *                IF THERE HAS BEEN ANY ACCOUNTING ACTIVITY.       DTSBX340
00023 *                DURING THE LAST YEAR.                            DTSBX340
00024 *                THE CHANGE IS TO W-JRN-ABSTIME.                  DTSBX340
00025 *                REFERENCE:                     PROGRAMMER: GD    DTSBX340
00026 *                                                                 DTSBX340
00027 *    06/05/2009  MODIFIED P1100 TO EXTRACT THE PROFILE RECORD     DTSBX340
00028 *                FOR ALL CHARGE-ONLY ACCOUNTS.                    DTSBX340
00029 *                THESE ACCOUNTS ARE NEEDED ON THE WEB DATABASE.   DTSBX340
00030 *                REFERENCE:                     PROGRAMMER: GD    DTSBX340
00031 *                                                                 DTSBX340
00032 *    12/31/2009  MODIFIED P1100 TO EXTRACT DATA FOR ACCOUNTS      DTSBX340
00033 *                WITH STATUS = UNKNOWN.                           DTSBX340
00034 *                THESE ACCOUNTS ARE NEEDED ON THE WEB DATABASE    DTSBX340
00035 *                FOR THE COMPLIANCE PROCESS.                      DTSBX340
00036 *                REFERENCE:                     PROGRAMMER: GD    DTSBX340
00037 *                                                                 DTSBX340
00038 *                                                                 DTSBX340
00039 *    02/10/2012  MODIFIED I1100 TO WRITE HOLIDAYS TO A FILE       DTSBX340
00040 *                REFERENCE:                     PROGRAMMER: ZL1   DTSBX340
00041 *                                                                 DTSBX340
00042 *    10/10/2013  REMOVED CALL TO BX346 FOR CHARGES                DTSBX340
00043 *                REFERENCE:                     PROGRAMMER: ZL1   DTSBX340
00044 *                                                                 DTSBX340
00045 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX340
00046 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX340
00047 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX340
00048 *                                                                 DTSBX340
00049 *                                                                 DTSBX340
00050 *  DESCRIPTION:                                                   DTSBX340
00051 *                                                                 DTSBX340
00052 *                                                                 DTSBX340
00053 *    INITIATION:                                                  DTSBX340
00054 *                                                                 DTSBX340
00055 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBX340
00056 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBX340
00057 *                                                                 DTSBX340
00058 *      EDIT AND DEFAULT PARAMETERS.                               DTSBX340
00059 *                                                                 DTSBX340
00060 *                                                                 DTSBX340
00061 *    PROCESSING:                                                  DTSBX340
00062 *                                                                 DTSBX340
00063 *                                                                 DTSBX340
00064 *    TERMINATION:                                                 DTSBX340
00065 *                                                                 DTSBX340
00066 *                                                                 DTSBX340
00067 *                                                                 DTSBX340
00068 *    RECORDS READ:                                                DTSBX340
00069 *                                                                 DTSBX340
00070 *      MASTER:                                                    DTSBX340
00071 *                                                                 DTSBX340
00072 *        MSOL                                                     DTSBX340
00073 *        MQTR                                                     DTSBX340
00074 *                                                                 DTSBX340
00075 *                                                                 DTSBX340
00076 *      ALTERNATE INDEX:                                           DTSBX340
00077 *                                                                 DTSBX340
00078 *        NONE.                                                    DTSBX340
00079 *                                                                 DTSBX340
00080 *                                                                 DTSBX340
00081 *      REFERENCE:                                                 DTSBX340
00082 *                                                                 DTSBX340
00083 *                                                                 DTSBX340
00084 *                                                                 DTSBX340
00085 *    RECORDS UPDATED:                                             DTSBX340
00086 *                                                                 DTSBX340
00087 *        NONE                                                     DTSBX340
00088 *                                                                 DTSBX340
00089 *                                                                 DTSBX340
00090 *    OUTPUT RECORDS WRITTEN:                                      DTSBX340
00091 *                                                                 DTSBX340
00092 *        DTSBX331                                                 DTSBX340
00093 *                                                                 DTSBX340
00094 *                                                                 DTSBX340
00095 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBX340
00096 *                                                                 DTSBX340
00097 *        NONE.                                                    DTSBX340
00098 *                                                                 DTSBX340
00099 *                                                                 DTSBX340
00100 *    MODULES CALLED:                                              DTSBX340
00101 *                                                                 DTSBX340
00102 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBX340
00103 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBX340
00104 *        DTSBU910  MASTER FILE I/O.                               DTSBX340
00105 *                                                                 DTSBX340
00106 *                                                                 DTSBX340
00107 *                                                                 DTSBX340
00108 *****                                                             DTSBX340
00109      SKIP3                                                        DTSBX340
00110  ENVIRONMENT DIVISION.                                            DTSBX340
00111  INPUT-OUTPUT SECTION.                                            DTSBX340
00112  FILE-CONTROL.                                                    DTSBX340
00113      SELECT SERVER-FILE         ASSIGN TO DTSFSERV                DTSBX340
00114         FILE STATUS IS SRVR-STATUS.                               DTSBX340
00115                                                                   DTSBX340
00116                                                                   DTSBX340
00117  DATA DIVISION.                                                   DTSBX340
00118  FILE SECTION.                                                    DTSBX340
00119  FD  SERVER-FILE                                                  DTSBX340
00120      RECORDING MODE IS F                                          DTSBX340
00121      LABEL RECORDS ARE STANDARD                                   DTSBX340
00122      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX340
00123                                                                   DTSBX340
00124  01  SERVER-REC.                                                  DTSBX340
00125      05  SRVR-EMP-NO                 PIC  9(06).                  DTSBX340
00126                                                                   DTSBX340
00127                                                                   DTSBX340
00128  WORKING-STORAGE SECTION.                                         DTSBX340
001285 77  PAN-VALET PICTURE X(24) VALUE '015DTSBX340  10/17/13'.       DTSBX340
00129  77  PAN-VALET PICTURE X(24) VALUE '002DTSBX340  10/10/13'.       DTSBX340
00130  77  PAN-VALET PICTURE X(24) VALUE '013DTSBX340  03/12/12'.       DTSBX340
00131      SKIP3                                                        DTSBX340
00132  01  W-AREA.                                                      DTSBX340
00133      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE +340.DTSBX340
00134                                                                   DTSBX340
00135      05  W-TRACE-IND                 PIC  X(01)  VALUE SPACE.     DTSBX340
00136      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBE340'.DTSBX340
00137                                                                   DTSBX340
00138      05  ABEND-MSG                   PIC  X(60).                  DTSBX340
00139                                                                   DTSBX340
00140      05  SRVR-STATUS                 PIC  X(02).                  DTSBX340
00141          88  SRVR-STATUS-OK-88         VALUE '00'.                DTSBX340
00142          88  SRVR-STATUS-EOF-88        VALUE '10'.                DTSBX340
00143                                                                   DTSBX340
00144      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DTSBX340
00145          88  W-ERROR-YES-88           VALUE 'Y'.                  DTSBX340
00146          88  W-ERROR-NO-88            VALUE 'N'.                  DTSBX340
00147                                                                   DTSBX340
00148      05  W-RUN-TYPE                  PIC  X(01).                  DTSBX340
00149          88 W-RUN-CONVERT-88          VALUE '0'.                  DTSBX340
00150          88 W-RUN-INCREMENTAL-88      VALUE '1'.                  DTSBX340
00151                                                                   DTSBX340
00152      05  W-SELECT-IND                PIC  X(01) VALUE 'N'.        DTSBX340
00153          88  W-SELECT-NO-88             VALUE '0'.                DTSBX340
00154          88  W-SELECT-ALL-88            VALUE '1'.                DTSBX340
00155          88  W-SELECT-UPD-88            VALUE '2'.                DTSBX340
00156          88  W-SELECT-PRF-88            VALUE '3'.                DTSBX340
00157                                                                   DTSBX340
00158      05  W-SELECT-NAME-IND             PIC X(01).                 DTSBX340
00159          88  W-SELECT-NAME-YES-88       VALUE 'Y'.                DTSBX340
00160          88  W-SELECT-NAME-NO-88        VALUE 'N'.                DTSBX340
00161      05  W-SELECT-ADDR-IND             PIC  X(01).                DTSBX340
00162          88  W-SELECT-ADDR-YES-88       VALUE 'Y'.                DTSBX340
00163          88  W-SELECT-ADDR-NO-88        VALUE 'N'.                DTSBX340
00164      05  W-SELECT-OPO-IND              PIC  X(01).                DTSBX340
00165          88  W-SELECT-OPO-YES-88        VALUE 'Y'.                DTSBX340
00166          88  W-SELECT-OPO-NO-88         VALUE 'N'.                DTSBX340
00167      05  W-SELECT-SOL-IND              PIC  X(01).                DTSBX340
00168          88  W-SELECT-SOL-YES-88        VALUE 'Y'.                DTSBX340
00169          88  W-SELECT-SOL-NO-88         VALUE 'N'.                DTSBX340
00170      05  W-SELECT-FSC-IND              PIC  X(01).                DTSBX340
00171          88  W-SELECT-FSC-YES-88        VALUE 'Y'.                DTSBX340
00172          88  W-SELECT-FSC-NO-88         VALUE 'N'.                DTSBX340
00173      05  W-SELECT-RATE-IND             PIC  X(01).                DTSBX340
00174          88  W-SELECT-RATE-YES-88       VALUE 'Y'.                DTSBX340
00175          88  W-SELECT-RATE-NO-88        VALUE 'N'.                DTSBX340
00176                                                                   DTSBX340
00177 **   05  W-SUBJECT-DATE           PIC S9(09)  COMP-3 VALUE +0.    DTSBX340
00178      05  W-CUTOFF-DATE            PIC S9(09)  COMP-3              DTSBX340
00179                                    VALUE +20020101.               DTSBX340
00180      05  W-LAST-LIAB-YRQ          PIC S9(05)  COMP-3 VALUE +0.    DTSBX340
00181      05  W-INACT-DATE             PIC S9(09)  COMP-3 VALUE +0.    DTSBX340
00182      05  W-INACT-CUTOFF           PIC S9(09)  COMP-3 VALUE +0.    DTSBX340
00183      05  W-JRN-ABSTIME            PIC S9(15)  COMP-3 VALUE +0.    DTSBX340
00184      05  W-HOLD-EMP-NO            PIC S9(07)  COMP-3 VALUE +0.    DTSBX340
00185      05  W-SUBJ-EMP-IND             PIC X(01).                    DTSBX340
00186          88 W-SUBJ-EMP-YES-88           VALUE 'Y'.                DTSBX340
00187          88 W-SUBJ-EMP-NO-88            VALUE 'N'.                DTSBX340
00188      05  W-ACTIVE-JRN-IND           PIC X(01).                    DTSBX340
00189          88 W-ACTIVE-JRN-YES-88         VALUE 'Y'.                DTSBX340
00190          88 W-ACTIVE-JRN-NO-88          VALUE 'N'.                DTSBX340
00191                                                                   DTSBX340
00192      05  W-MPRF-CNT               PIC S9(07)    COMP-3 VALUE +0.  DTSBX340
00193      05  W-SERVER-CNT             PIC S9(07)    COMP-3 VALUE +0.  DTSBX340
00194      05  W-SELECT-NO-CNT          PIC S9(07)    COMP-3 VALUE +0.  DTSBX340
00195      05  W-SELECT-PRF-CNT         PIC S9(07)    COMP-3 VALUE +0.  DTSBX340
00196      05  W-SELECT-ALL-CNT         PIC S9(07)    COMP-3 VALUE +0.  DTSBX340
00197      05  W-SELECT-UPD-CNT         PIC S9(07)    COMP-3 VALUE +0.  DTSBX340
00198      05  DISPLAY-CNT                PIC  Z(06)9.                  DTSBX340
00199                                                                   DTSBX340
00200      05  DISPLAY-AMT1-X              PIC  X(14).                  DTSBX340
00201      05  DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X                    DTSBX340
00202                                      PIC  ---,---,--9.99.         DTSBX340
00203      05  DISPLAY-AMT2-X              PIC  X(14).                  DTSBX340
00204      05  DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X                    DTSBX340
00205                                      PIC  ---,---,--9.99.         DTSBX340
00206      05  DISPLAY-AMT3-X              PIC  X(14).                  DTSBX340
00207      05  DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X                    DTSBX340
00208                                      PIC  ---,---,--9.99.         DTSBX340
00209      05  DISPLAY-AMT4-X              PIC  X(14).                  DTSBX340
00210      05  DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X                    DTSBX340
00211                                      PIC  ---,---,--9.99.         DTSBX340
00212      EJECT                                                        DTSBX340
00213  01  L001-LINK-AREA.                                              DTSBX340
00214  ++INCLUDE DTSIL001                                               DTSBX340
00215      EJECT                                                        DTSBX340
00216  01  L003-LINK-AREA.                                              DTSBX340
00217  ++INCLUDE DTSIL003                                               DTSBX340
00218      EJECT                                                        DTSBX340
00219  01  L004-LINK-AREA.                                              DTSBX340
00220  ++INCLUDE DTSIL004                                               DTSBX340
00221      EJECT                                                        DTSBX340
00222  01  L005-LINK-AREA.                                              DTSBX340
00223  ++INCLUDE DTSIL005                                               DTSBX340
00224                                                                   DTSBX340
00225  01  LX34-LINK-AREA.                                              DTSBX340
00226  ++INCLUDE DTSILX34                                               DTSBX340
00227      EJECT                                                        DTSBX340
00228  01  L910-LINK-AREA.                                              DTSBX340
00229  ++INCLUDE DTSIL910                                               DTSBX340
00230      SKIP3                                                        DTSBX340
00231  01  MSKL-REC.                                                    DTSBX340
00232  ++INCLUDE DTSIMSKL                                               DTSBX340
00233      SKIP3                                                        DTSBX340
00234  01  MHDR-REC.                                                    DTSBX340
00235  ++INCLUDE DTSIMHDR                                               DTSBX340
00236      SKIP3                                                        DTSBX340
00237  01  MPRF-REC.                                                    DTSBX340
00238  ++INCLUDE DTSIMPRF                                               DTSBX340
00239      EJECT                                                        DTSBX340
00240  01  MQTR-REC.                                                    DTSBX340
00241  ++INCLUDE DTSIMQTR                                               DTSBX340
00242      SKIP3                                                        DTSBX340
00243  01  MJRN-REC.                                                    DTSBX340
00244  ++INCLUDE DTSIMJRN                                               DTSBX340
00245      SKIP3                                                        DTSBX340
00246  01  MRPT-REC.                                                    DTSBX340
00247  ++INCLUDE DTSIMRPT                                               DTSBX340
00248      SKIP3                                                        DTSBX340
00249  01  MADJ-REC.                                                    DTSBX340
00250  ++INCLUDE DTSIMADJ                                               DTSBX340
00251      SKIP3                                                        DTSBX340
00252  01  MPAY-REC.                                                    DTSBX340
00253  ++INCLUDE DTSIMPAY                                               DTSBX340
00254      SKIP3                                                        DTSBX340
00255  01  MRTE-REC.                                                    DTSBX340
00256  ++INCLUDE DTSIMRTE                                               DTSBX340
00257      SKIP3                                                        DTSBX340
00258  01  MEVL-REC.                                                    DTSBX340
00259  ++INCLUDE DTSIMEVL                                               DTSBX340
00260      SKIP3                                                        DTSBX340
00261  01  MSOL-REC.                                                    DTSBX340
00262  ++INCLUDE DTSIMSOL                                               DTSBX340
00263      SKIP3                                                        DTSBX340
00264  01  MFSC-REC.                                                    DTSBX340
00265  ++INCLUDE DTSIMFSC                                               DTSBX340
00266      SKIP3                                                        DTSBX340
00267  01  MTAD-REC.                                                    DTSBX340
00268  ++INCLUDE DTSIMTAD                                               DTSBX340
00269      SKIP3                                                        DTSBX340
00270  01  MTAA-REC.                                                    DTSBX340
00271  ++INCLUDE DTSIMTAA                                               DTSBX340
00272      SKIP3                                                        DTSBX340
00273  01  MLOG-REC.                                                    DTSBX340
00274  ++INCLUDE DTSIMLOG                                               DTSBX340
00275      SKIP3                                                        DTSBX340
00276  01  L921-LINK-AREA.                                              DTSBX340
00277  ++INCLUDE DTSIL921                                               DTSBX340
00278      SKIP3                                                        DTSBX340
00279  01  ISKL-REC.                                                    DTSBX340
00280  ++INCLUDE DTSIISKL                                               DTSBX340
00281                                                                   DTSBX340
00282  01  L931-LINK-AREA.                                              DTSBX340
00283  ++INCLUDE DTSIL931                                               DTSBX340
00284      SKIP3                                                        DTSBX340
00285  01  FSKL-REC.                                                    DTSBX340
00286  ++INCLUDE DTSIFSKL                                               DTSBX340
00287      SKIP3                                                        DTSBX340
00288  01  FQTR-REC.                                                    DTSBX340
00289  ++INCLUDE DTSIFQTR                                               DTSBX340
00290                                                                   DTSBX340
00291  LINKAGE SECTION.                                                 DTSBX340
00292      SKIP3                                                        DTSBX340
00293  01  PARM-AREA.                                                   DTSBX340
00294      05  PARM-LENGTH                PIC S9(04)  COMP.             DTSBX340
00295      05  PARM-DATA.                                               DTSBX340
00296          10  PARM-RUN-TYPE          PIC  X(01).                   DTSBX340
00297              88 PARM-RUN-CONVERT-88      VALUE '0'.               DTSBX340
00298              88 PARM-RUN-INCREMENTAL-88  VALUE '1'.               DTSBX340
00299              88 PARM-RUN-VALID-88        VALUE '0', '1'.          DTSBX340
00300                                                                   DTSBX340
00301  PROCEDURE DIVISION USING PARM-AREA.                              DTSBX340
00302                                                                   DTSBX340
00303      PERFORM I0000-INITIALIZE     THRU I0000-EXIT                 DTSBX340
00304      IF W-ERROR-NO-88                                             DTSBX340
00305         PERFORM P0000-PROCESS     THRU P0000-EXIT                 DTSBX340
00306         PERFORM T0000-TERMINATE   THRU T0000-EXIT                 DTSBX340
00307      END-IF.                                                      DTSBX340
00308                                                                   DTSBX340
00309      GOBACK.                                                      DTSBX340
00310                                                                   DTSBX340
00311  I0000-INITIALIZE.                                                DTSBX340
00312      SKIP2                                                        DTSBX340
00313      MOVE W-TRACE-IND TO L910-TRACE-IND.                          DTSBX340
00314                                                                   DTSBX340
00315      MOVE W-MOD-NAME TO L910-MOD-NAME.                            DTSBX340
00316                                                                   DTSBX340
00317      SET L005-FROM-SYS          TO TRUE.                          DTSBX340
00318      PERFORM S005-FROM-SYS      THRU S005-EXIT.                   DTSBX340
00319                                                                   DTSBX340
00320      PERFORM I1000-EDIT-PARM    THRU I1000-EXIT.                  DTSBX340
00321      IF W-ERROR-YES-88                                            DTSBX340
00322         GO TO I0000-EXIT                                          DTSBX340
00323      END-IF.                                                      DTSBX340
00324                                                                   DTSBX340
00325      PERFORM I2000-OPEN-FILES   THRU I2000-EXIT.                  DTSBX340
00326      IF W-ERROR-YES-88                                            DTSBX340
00327         GO TO I0000-EXIT                                          DTSBX340
00328      END-IF.                                                      DTSBX340
00329                                                                   DTSBX340
00330      PERFORM I3000-GET-MHDR               THRU I3000-EXIT.        DTSBX340
00331                                                                   DTSBX340
00332      PERFORM I4000-INIT-LINKAGE           THRU I4000-EXIT.        DTSBX340
00333                                                                   DTSBX340
00334      PERFORM I5000-INITIAL-CALLS          THRU I5000-EXIT.        DTSBX340
00335                                                                   DTSBX340
00336  I0000-EXIT.                                                      DTSBX340
00337      EXIT.                                                        DTSBX340
00338      EJECT                                                        DTSBX340
00339  I1000-EDIT-PARM.                                                 DTSBX340
00340      IF PARM-RUN-VALID-88                                         DTSBX340
00341         MOVE PARM-RUN-TYPE            TO W-RUN-TYPE               DTSBX340
00342         IF W-RUN-CONVERT-88                                       DTSBX340
00343            DISPLAY 'BX340 RUN TYPE: CONVERT'                      DTSBX340
00344         ELSE                                                      DTSBX340
00345            IF W-RUN-INCREMENTAL-88                                DTSBX340
00346               DISPLAY 'BX340 RUN TYPE: INCREMENTAL'               DTSBX340
00347            END-IF                                                 DTSBX340
00348         END-IF                                                    DTSBX340
00349      ELSE                                                         DTSBX340
00350         DISPLAY 'INVALID RUN TYPE: ' PARM-RUN-TYPE                DTSBX340
00351         DISPLAY 'BX340 TERMINATING'                               DTSBX340
00352         SET W-ERROR-YES-88            TO TRUE                     DTSBX340
00353      END-IF.                                                      DTSBX340
00354                                                                   DTSBX340
00355  I1000-EXIT.                                                      DTSBX340
00356      EXIT.                                                        DTSBX340
00357                                                                   DTSBX340
00358                                                                   DTSBX340
00359  I2000-OPEN-FILES.                                                DTSBX340
00360      OPEN INPUT  SERVER-FILE.                                     DTSBX340
00361      IF NOT SRVR-STATUS-OK-88                                     DTSBX340
00362         DISPLAY 'OPEN ERROR ON SERVER FILE ' SRVR-STATUS          DTSBX340
00363         SET W-ERROR-YES-88    TO TRUE                             DTSBX340
00364         GO TO I2000-EXIT                                          DTSBX340
00365      END-IF.                                                      DTSBX340
00366                                                                   DTSBX340
00367      PERFORM S910-OPEN-READ         THRU S910-EXIT.               DTSBX340
00368                                                                   DTSBX340
00369      PERFORM S921-OPEN-READ         THRU S921-EXIT.               DTSBX340
00370                                                                   DTSBX340
00371      PERFORM S931-OPEN-READ         THRU S931-EXIT.               DTSBX340
00372                                                                   DTSBX340
00373                                                                   DTSBX340
00374  I2000-EXIT.                                                      DTSBX340
00375      EXIT.                                                        DTSBX340
00376                                                                   DTSBX340
00377  I3000-GET-MHDR.                                                  DTSBX340
00378      MOVE LOW-VALUES              TO MSKL-REC.                    DTSBX340
00379      MOVE +0                      TO MSKL-EMP-NO.                 DTSBX340
00380      SET MSKL-HDR-88              TO TRUE.                        DTSBX340
00381                                                                   DTSBX340
00382      PERFORM S910-READ            THRU S910-EXIT.                 DTSBX340
00383      IF L910-NO-REC-88                                            DTSBX340
00384         DISPLAY 'DTSBX340: MHDR RECORD IS MISSING'                DTSBX340
00385         SET W-ERROR-YES-88        TO TRUE                         DTSBX340
00386         GO TO I3000-EXIT                                          DTSBX340
00387      ELSE                                                         DTSBX340
00388         MOVE MSKL-REC             TO MHDR-REC                     DTSBX340
00389      END-IF.                                                      DTSBX340
00390                                                                   DTSBX340
00391  I3000-EXIT.                                                      DTSBX340
00392      EXIT.                                                        DTSBX340
00393                                                                   DTSBX340
00394  I4000-INIT-LINKAGE.                                              DTSBX340
00395      MOVE MHDR-CURR-RUN-DATE      TO LX34-CURR-RUN-DATE.          DTSBX340
00396      MOVE MHDR-PRIOR-RUN-DATE     TO LX34-PRIOR-RUN-DATE.         DTSBX340
00397      MOVE L005-DATE               TO LX34-SYS-DATE.               DTSBX340
00398      MOVE L005-TIME               TO LX34-SYS-TIME.               DTSBX340
00399                                                                   DTSBX340
00400      MOVE MHDR-PRIOR-RUN-DATE     TO L001-FED-8-DATE-9.           DTSBX340
00401      SUBTRACT +1                  FROM L001-FED-8-YR.             DTSBX340
00402      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX340
00403      MOVE L001-JUL-ABS-DAY        TO W-JRN-ABSTIME.               DTSBX340
00404      SUBTRACT +2                  FROM L001-FED-8-YR.             DTSBX340
00405      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX340
00406      MOVE L001-FED-8-DATE-9       TO L004-DATE.                   DTSBX340
00407      PERFORM S004-FROM-DATE       THRU S004-EXIT.                 DTSBX340
00408      MOVE L004-QTR-5-9            TO LX34-3-YRS-AGO-YRQ.          DTSBX340
00409                                                                   DTSBX340
00410 **   MOVE MHDR-PRIOR-RUN-DATE     TO L001-FED-8-DATE-9.           DTSBX340
00411 *    SUBTRACT +3                  FROM L001-FED-8-YR.             DTSBX340
00412 *    PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX340
00413 *    MOVE L001-FED-8-DATE-9       TO L004-DATE.                   DTSBX340
00414 *    PERFORM S004-FROM-DATE       THRU S004-EXIT.                 DTSBX340
00415 *    MOVE L004-QTR-5-9            TO LX34-3-YRS-AGO-YRQ.          DTSBX340
00416 *                                                                 DTSBX340
00417 *    MOVE MHDR-CURR-RUN-DATE      TO L005-DATE.                   DTSBX340
00418 *    MOVE ZERO                    TO L005-TIME.                   DTSBX340
00419 *    SET L005-FROM-DATE-TIME      TO TRUE.                        DTSBX340
00420 *    PERFORM S005-FROM-SYS        THRU S005-EXIT.                 DTSBX340
00421 **   MOVE L005-ABSTIME            TO W-JRN-ABSTIME.               DTSBX340
00422                                                                   DTSBX340
00423      MOVE MHDR-PRIOR-RUN-DATE     TO L001-FED-8-DATE-9.           DTSBX340
00424      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX340
00425      SUBTRACT +1                  FROM L001-JUL-ABS-DAY.          DTSBX340
00426      PERFORM S001-FROM-ABS-DAY    THRU S001-EXIT.                 DTSBX340
00427      MOVE L001-FED-8-DATE-9       TO L005-DATE.                   DTSBX340
00428      MOVE ZERO                    TO L005-TIME.                   DTSBX340
00429      SET L005-FROM-DATE-TIME      TO TRUE.                        DTSBX340
00430      PERFORM S005-FROM-SYS        THRU S005-EXIT.                 DTSBX340
00431      MOVE L005-ABSTIME            TO LX34-ABSTIME.                DTSBX340
00432                                                                   DTSBX340
00433      MOVE MHDR-PRIOR-RUN-DATE     TO L004-DATE.                   DTSBX340
00434      PERFORM S004-FROM-DATE       THRU S004-EXIT.                 DTSBX340
00435      SUBTRACT +2                  FROM L004-ABS-QTR.              DTSBX340
00436      PERFORM S004-FROM-ABS        THRU S004-EXIT.                 DTSBX340
00437      MOVE L004-QTR-START-DATE     TO W-INACT-CUTOFF.              DTSBX340
00438                                                                   DTSBX340
00439      MOVE W-CUTOFF-DATE           TO LX34-CUTOFF-DATE.            DTSBX340
00440                                                                   DTSBX340
00441      IF W-RUN-INCREMENTAL-88                                      DTSBX340
00442         SET LX34-RUN-INCREMENTAL-88  TO TRUE                      DTSBX340
00443      ELSE                                                         DTSBX340
00444         IF W-RUN-CONVERT-88                                       DTSBX340
00445            SET LX34-RUN-CONVERT-88      TO TRUE                   DTSBX340
00446         END-IF                                                    DTSBX340
00447      END-IF.                                                      DTSBX340
00448                                                                   DTSBX340
00449      DISPLAY '********************************'.                  DTSBX340
00450      DISPLAY '           DTSBX340'.                               DTSBX340
00451      DISPLAY '  3 YEARS AGO  ' LX34-3-YRS-AGO-YRQ.                DTSBX340
00452      DISPLAY '  INACT CUTOFF ' W-INACT-CUTOFF.                    DTSBX340
00453      DISPLAY '********************************'.                  DTSBX340
00454      DISPLAY SPACE.                                               DTSBX340
00455                                                                   DTSBX340
00456  I4000-EXIT.                                                      DTSBX340
00457      EXIT.                                                        DTSBX340
00458                                                                   DTSBX340
00459  I5000-INITIAL-CALLS.                                             DTSBX340
00460      SET LX34-INITIALIZE-88        TO TRUE.                       DTSBX340
00461                                                                   DTSBX340
00462      PERFORM S341-STATUS           THRU S341-EXIT.                DTSBX340
00463 **   PERFORM S342-ACCT-DAILY       THRU S342-EXIT.                DTSBX340
00464      PERFORM S343-ACCT-CONVERT     THRU S343-EXIT.                DTSBX340
00465      PERFORM S344-DELINQ-COLL      THRU S344-EXIT.                DTSBX340
00466 *    PERFORM S346-CHARGES          THRU S346-EXIT.                DTSBX340
00467                                                                   DTSBX340
00468  I5000-EXIT.                                                      DTSBX340
00469      EXIT.                                                        DTSBX340
00470                                                                   DTSBX340
00471  P0000-PROCESS.                                                   DTSBX340
00472       SET LX34-PROCESS-88           TO TRUE.                      DTSBX340
00473                                                                   DTSBX340
00474       IF LX34-RUN-CONVERT-88                                      DTSBX340
00475          PERFORM P1000-CONVERT      THRU P1000-EXIT               DTSBX340
00476       ELSE                                                        DTSBX340
00477          PERFORM P2000-INCREMENTAL  THRU P2000-EXIT               DTSBX340
00478       END-IF.                                                     DTSBX340
00479                                                                   DTSBX340
00480 *     PERFORM S346-CHARGES          THRU S346-EXIT.               DTSBX340
00481                                                                   DTSBX340
00482      PERFORM S348-HOLIDAYS         THRU S348-EXIT.                DTSBX340
00483  P0000-EXIT.                                                      DTSBX340
00484      EXIT.                                                        DTSBX340
00485                                                                   DTSBX340
00486  P1000-CONVERT.                                                   DTSBX340
00487      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBX340
00488      MOVE +0 TO MSKL-EMP-NO.                                      DTSBX340
00489      SET MSKL-PRF-88 TO TRUE.                                     DTSBX340
00490                                                                   DTSBX340
00491      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBX340
00492      IF NOT L910-OK-88                                            DTSBX340
00493         DISPLAY 'CANNOT READ MASTER FILE '                        DTSBX340
00494         GO TO P1000-EXIT                                          DTSBX340
00495      END-IF.                                                      DTSBX340
00496                                                                   DTSBX340
00497      PERFORM                                                      DTSBX340
00498         UNTIL L910-NO-REC-88                                      DTSBX340
00499         OR W-ERROR-YES-88                                         DTSBX340
00500           ADD +1                            TO W-MPRF-CNT         DTSBX340
00501           MOVE MSKL-REC                     TO MPRF-REC           DTSBX340
00502           PERFORM P1100-SELECT              THRU P1100-EXIT       DTSBX340
00503           IF W-SELECT-PRF-88                                      DTSBX340
00504              PERFORM S341-STATUS            THRU S341-EXIT        DTSBX340
00505           ELSE                                                    DTSBX340
00506              IF W-SELECT-ALL-88                                   DTSBX340
00507                 PERFORM S341-STATUS         THRU S341-EXIT        DTSBX340
00508                 PERFORM S343-ACCT-CONVERT   THRU S343-EXIT        DTSBX340
00509                 PERFORM S344-DELINQ-COLL    THRU S344-EXIT        DTSBX340
00510              END-IF                                               DTSBX340
00511           END-IF                                                  DTSBX340
00512           MOVE MPRF-REC                     TO MSKL-REC           DTSBX340
00513           PERFORM S910-READ-NEXT            THRU S910-EXIT        DTSBX340
00514      END-PERFORM.                                                 DTSBX340
00515                                                                   DTSBX340
00516  P1000-EXIT.                                                      DTSBX340
00517      EXIT.                                                        DTSBX340
00518                                                                   DTSBX340
00519  P1100-SELECT.                                                    DTSBX340
00520      PERFORM S3000-INITIALIZE              THRU S3000-EXIT.       DTSBX340
00521                                                                   DTSBX340
00522      IF MPRF-CLASS-CHG-ONLY-88                                    DTSBX340
00523         SET W-SELECT-PRF-88                TO TRUE                DTSBX340
00524         PERFORM S3100-LX34-SELECTIONS      THRU S3100-EXIT        DTSBX340
00525         GO TO P1100-EXIT                                          DTSBX340
00526      END-IF.                                                      DTSBX340
00527                                                                   DTSBX340
00528 **   IF MPRF-CLASS-CHG-ONLY-88                                    DTSBX340
00529 *       IF MPRF-ELIGIBLE-DC-GOV-88                                DTSBX340
00530 *          SET W-SELECT-PRF-88             TO TRUE                DTSBX340
00531 *          PERFORM S3100-LX34-SELECTIONS   THRU S3100-EXIT        DTSBX340
00532 *          GO TO P1100-EXIT                                       DTSBX340
00533 *       END-IF                                                    DTSBX340
00534 **   END-IF.                                                      DTSBX340
00535                                                                   DTSBX340
00536      IF MPRF-STATUS-INACT-88                                      DTSBX340
00537         PERFORM P1110-INACT-DATES          THRU P1110-EXIT        DTSBX340
00538         IF W-LAST-LIAB-YRQ < LX34-3-YRS-AGO-YRQ                   DTSBX340
00539            IF MPRF-TOT-BALANCE-AMT > ZERO                         DTSBX340
00540            OR MPRF-TOT-CREDIT-AMT > ZERO                          DTSBX340
00541            OR MPRF-PURSUED-RPT-CNT > ZERO                         DTSBX340
00542            OR W-INACT-DATE >= W-INACT-CUTOFF                      DTSBX340
00543            OR W-ACTIVE-JRN-YES-88                                 DTSBX340
00544               SET W-SELECT-ALL-88           TO TRUE               DTSBX340
00545            ELSE                                                   DTSBX340
00546               SET W-SELECT-PRF-88           TO TRUE               DTSBX340
00547            END-IF                                                 DTSBX340
00548         ELSE                                                      DTSBX340
00549            SET W-SELECT-ALL-88              TO TRUE               DTSBX340
00550         END-IF                                                    DTSBX340
00551      ELSE                                                         DTSBX340
00552         SET W-SELECT-ALL-88                 TO TRUE               DTSBX340
00553      END-IF.                                                      DTSBX340
00554                                                                   DTSBX340
00555      IF (MPRF-STATUS-NEVERSUB-88                                  DTSBX340
00556      OR MPRF-STATUS-UNK-88)                                       DTSBX340
00557         SET W-SELECT-ALL-88                 TO TRUE               DTSBX340
00558 ****    PERFORM S2000-UNKNOWN               THRU S2000-EXIT       DTSBX340
00559      END-IF.                                                      DTSBX340
00560                                                                   DTSBX340
00561      PERFORM S3100-LX34-SELECTIONS       THRU S3100-EXIT.         DTSBX340
00562                                                                   DTSBX340
00563      IF W-SELECT-NO-88                                            DTSBX340
00564         ADD +1                           TO W-SELECT-NO-CNT       DTSBX340
00565      END-IF.                                                      DTSBX340
00566                                                                   DTSBX340
00567      EVALUATE TRUE                                                DTSBX340
00568         WHEN W-SELECT-NO-88                                       DTSBX340
00569            ADD +1                        TO W-SELECT-NO-CNT       DTSBX340
00570                                                                   DTSBX340
00571         WHEN W-SELECT-PRF-88                                      DTSBX340
00572            ADD +1                        TO W-SELECT-PRF-CNT      DTSBX340
00573                                                                   DTSBX340
00574         WHEN W-SELECT-ALL-88                                      DTSBX340
00575            ADD +1                        TO W-SELECT-ALL-CNT      DTSBX340
00576                                                                   DTSBX340
00577      END-EVALUATE.                                                DTSBX340
00578                                                                   DTSBX340
00579  P1100-EXIT.                                                      DTSBX340
00580      EXIT.                                                        DTSBX340
00581                                                                   DTSBX340
00582  P1110-INACT-DATES.                                               DTSBX340
00583      MOVE ZERO                       TO W-LAST-LIAB-YRQ           DTSBX340
00584                                         W-INACT-DATE.             DTSBX340
00585      SET W-ACTIVE-JRN-NO-88          TO TRUE.                     DTSBX340
00586                                                                   DTSBX340
00587      MOVE LOW-VALUES                 TO MSOL-REC                  DTSBX340
00588      MOVE MPRF-EMP-NO                TO MSOL-EMP-NO               DTSBX340
00589      SET MSOL-SOL-88                 TO TRUE                      DTSBX340
00590      MOVE MSOL-KEY-AREA              TO MSKL-KEY-AREA             DTSBX340
00591      PERFORM S910-START-BROWSE       THRU S910-EXIT               DTSBX340
00592      PERFORM UNTIL L910-NO-REC-88                                 DTSBX340
00593        MOVE MSKL-REC                 TO MSOL-REC                  DTSBX340
00594        IF NOT MSOL-INACT-WITHDRAWN-88                             DTSBX340
00595           IF MSOL-INACT-INACTIVE-88                               DTSBX340
00596              IF MSOL-LAST-LIAB-YRQ > W-LAST-LIAB-YRQ              DTSBX340
00597                 MOVE MSOL-LAST-LIAB-YRQ                           DTSBX340
00598                                       TO W-LAST-LIAB-YRQ          DTSBX340
00599                 MOVE MSOL-INACT-ENTER-DATE                        DTSBX340
00600                                       TO W-INACT-DATE             DTSBX340
00601              END-IF                                               DTSBX340
00602           END-IF                                                  DTSBX340
00603        END-IF                                                     DTSBX340
00604        PERFORM S910-READ-NEXT         THRU S910-EXIT              DTSBX340
00605      END-PERFORM.                                                 DTSBX340
00606                                                                   DTSBX340
00607 **   IF W-INACT-DATE >= W-INACT-CUTOFF                            DTSBX340
00608 *       DISPLAY 'INACT WITHIN 2 QTRS ' MPRF-EMP-NO                DTSBX340
00609 **   END-IF.                                                      DTSBX340
00610                                                                   DTSBX340
00611      MOVE LOW-VALUES                 TO MJRN-KEY-AREA.            DTSBX340
00612      MOVE MPRF-EMP-NO                TO MJRN-EMP-NO.              DTSBX340
00613      SET MJRN-JRN-88                 TO TRUE.                     DTSBX340
00614      MOVE W-JRN-ABSTIME              TO MJRN-ESTB-ABSTIME.        DTSBX340
00615      MOVE MJRN-KEY-AREA              TO MSKL-KEY-AREA.            DTSBX340
00616      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBX340
00617      IF L910-OK-88                                                DTSBX340
00618         IF W-LAST-LIAB-YRQ < LX34-3-YRS-AGO-YRQ                   DTSBX340
00619            SET W-ACTIVE-JRN-YES-88   TO TRUE                      DTSBX340
00620 **         DISPLAY 'BX340 INACT > 3, ACT JRN ' MPRF-EMP-NO        DTSBX340
00621         END-IF                                                    DTSBX340
00622      END-IF.                                                      DTSBX340
00623                                                                   DTSBX340
00624  P1110-EXIT.                                                      DTSBX340
00625      EXIT.                                                        DTSBX340
00626                                                                   DTSBX340
00627  P2000-INCREMENTAL.                                               DTSBX340
00628       MOVE LOW-VALUES TO MSKL-KEY-AREA.                           DTSBX340
00629       MOVE +0 TO MSKL-EMP-NO.                                     DTSBX340
00630       SET MSKL-PRF-88 TO TRUE.                                    DTSBX340
00631                                                                   DTSBX340
00632       PERFORM S910-START-BROWSE THRU S910-EXIT.                   DTSBX340
00633       IF NOT L910-OK-88                                           DTSBX340
00634          DISPLAY 'CANNOT READ MASTER FILE '                       DTSBX340
00635          GO TO P2000-EXIT                                         DTSBX340
00636       ELSE                                                        DTSBX340
00637          MOVE MSKL-REC            TO MPRF-REC                     DTSBX340
00638       END-IF.                                                     DTSBX340
00639                                                                   DTSBX340
00640       PERFORM S1000-READ-SRVR     THRU S1000-EXIT.                DTSBX340
00641       IF W-ERROR-YES-88                                           DTSBX340
00642          DISPLAY 'CANNOT READ SERVER FILE '                       DTSBX340
00643          GO TO P2000-EXIT                                         DTSBX340
00644       END-IF.                                                     DTSBX340
00645                                                                   DTSBX340
00646       PERFORM                                                     DTSBX340
00647         UNTIL (L910-NO-REC-88                                     DTSBX340
00648         OR     SRVR-STATUS-EOF-88                                 DTSBX340
00649         OR     W-ERROR-YES-88)                                    DTSBX340
00650            SET W-SELECT-NO-88             TO TRUE                 DTSBX340
00651            IF MPRF-EMP-NO < SRVR-EMP-NO                           DTSBX340
00652               PERFORM P2100-EXTRACT       THRU P2100-EXIT         DTSBX340
00653               PERFORM P2010-READ-MPRF     THRU P2010-EXIT         DTSBX340
00654            ELSE                                                   DTSBX340
00655               IF MPRF-EMP-NO = SRVR-EMP-NO                        DTSBX340
00656                  SET W-SELECT-UPD-88      TO TRUE                 DTSBX340
00657                  PERFORM P2100-EXTRACT    THRU P2100-EXIT         DTSBX340
00658                  PERFORM P2010-READ-MPRF  THRU P2010-EXIT         DTSBX340
00659                  PERFORM S1000-READ-SRVR  THRU S1000-EXIT         DTSBX340
00660               ELSE                                                DTSBX340
00661                  DISPLAY 'P2000 ERROR > NO MPRF ' SRVR-EMP-NO     DTSBX340
00662                  PERFORM S1000-READ-SRVR  THRU S1000-EXIT         DTSBX340
00663               END-IF                                              DTSBX340
00664            END-IF                                                 DTSBX340
00665       END-PERFORM.                                                DTSBX340
00666                                                                   DTSBX340
00667       IF SRVR-STATUS-EOF-88                                       DTSBX340
00668       AND L910-OK-88                                              DTSBX340
00669          PERFORM UNTIL L910-NO-REC-88                             DTSBX340
00670             SET W-SELECT-NO-88          TO TRUE                   DTSBX340
00671             PERFORM P2100-EXTRACT       THRU P2100-EXIT           DTSBX340
00672             PERFORM P2010-READ-MPRF     THRU P2010-EXIT           DTSBX340
00673          END-PERFORM                                              DTSBX340
00674       END-IF.                                                     DTSBX340
00675                                                                   DTSBX340
00676       IF SRVR-STATUS-OK-88                                        DTSBX340
00677       AND L910-NO-REC-88                                          DTSBX340
00678          PERFORM UNTIL SRVR-STATUS-EOF-88                         DTSBX340
00679             DISPLAY 'P2000 EOF ERR > NO MPRF ' SRVR-EMP-NO        DTSBX340
00680             READ SERVER-FILE                                      DTSBX340
00681          END-PERFORM                                              DTSBX340
00682       END-IF.                                                     DTSBX340
00683                                                                   DTSBX340
00684  P2000-EXIT.                                                      DTSBX340
00685      EXIT.                                                        DTSBX340
00686                                                                   DTSBX340
00687  P2010-READ-MPRF.                                                 DTSBX340
00688      MOVE MPRF-REC               TO MSKL-REC.                     DTSBX340
00689      PERFORM S910-READ-NEXT      THRU S910-EXIT.                  DTSBX340
00690      MOVE MSKL-REC               TO MPRF-REC.                     DTSBX340
00691                                                                   DTSBX340
00692  P2010-EXIT.                                                      DTSBX340
00693      EXIT.                                                        DTSBX340
00694                                                                   DTSBX340
00695  P2100-EXTRACT.                                                   DTSBX340
00696      PERFORM S3000-INITIALIZE              THRU S3000-EXIT.       DTSBX340
00697      IF MPRF-EMP-NO = SRVR-EMP-NO                                 DTSBX340
00698         SET W-SELECT-UPD-88                TO TRUE                DTSBX340
00699      END-IF.                                                      DTSBX340
00700                                                                   DTSBX340
00701      EVALUATE TRUE                                                DTSBX340
00702        WHEN MPRF-CLASS-CHG-ONLY-88                                DTSBX340
00703          IF MPRF-ESTB-DATE = LX34-PRIOR-RUN-DATE                  DTSBX340
00704          OR MPRF-CHNG-DATE = LX34-PRIOR-RUN-DATE                  DTSBX340
00705            SET W-SELECT-PRF-88             TO TRUE                DTSBX340
00706 **         DISPLAY 'BX340 CHG ONLY ' MPRF-EMP-NO                  DTSBX340
00707 **            '  ' W-SELECT-IND                                   DTSBX340
00708          END-IF                                                   DTSBX340
00709                                                                   DTSBX340
00710         WHEN MPRF-CLASS-SUB-88                                    DTSBX340
00711           IF W-SELECT-UPD-88                                      DTSBX340
00712             PERFORM P2110-CHK-CHANGES        THRU P2110-EXIT      DTSBX340
00713           ELSE                                                    DTSBX340
00714             IF MPRF-ESTB-DATE = LX34-PRIOR-RUN-DATE               DTSBX340
00715             OR MPRF-CHNG-DATE = LX34-PRIOR-RUN-DATE               DTSBX340
00716 **            DISPLAY 'BX340 NEWLY SUBJECT ' MPRF-EMP-NO          DTSBX340
00717               SET W-SELECT-ALL-88              TO TRUE            DTSBX340
00718             END-IF                                                DTSBX340
00719           END-IF                                                  DTSBX340
00720                                                                   DTSBX340
00721         WHEN MPRF-CLASS-UNK-88                                    DTSBX340
00722           IF NOT W-SELECT-UPD-88                                  DTSBX340
00723              PERFORM S2000-UNKNOWN         THRU S2000-EXIT        DTSBX340
00724           END-IF                                                  DTSBX340
00725      END-EVALUATE.                                                DTSBX340
00726                                                                   DTSBX340
00727      EVALUATE TRUE                                                DTSBX340
00728         WHEN W-SELECT-NO-88                                       DTSBX340
00729            ADD +1                        TO W-SELECT-NO-CNT       DTSBX340
00730                                                                   DTSBX340
00731         WHEN W-SELECT-PRF-88                                      DTSBX340
00732            ADD +1                        TO W-SELECT-PRF-CNT      DTSBX340
00733                                                                   DTSBX340
00734         WHEN W-SELECT-ALL-88                                      DTSBX340
00735            ADD +1                        TO W-SELECT-ALL-CNT      DTSBX340
00736                                                                   DTSBX340
00737         WHEN W-SELECT-UPD-88                                      DTSBX340
00738            ADD +1                        TO W-SELECT-UPD-CNT      DTSBX340
00739                                                                   DTSBX340
00740      END-EVALUATE.                                                DTSBX340
00741                                                                   DTSBX340
00742      PERFORM S3100-LX34-SELECTIONS     THRU S3100-EXIT.           DTSBX340
00743                                                                   DTSBX340
00744      EVALUATE TRUE                                                DTSBX340
00745         WHEN W-SELECT-PRF-88                                      DTSBX340
00746            PERFORM S341-STATUS         THRU S341-EXIT             DTSBX340
00747                                                                   DTSBX340
00748         WHEN W-SELECT-UPD-88                                      DTSBX340
00749            PERFORM S341-STATUS         THRU S341-EXIT             DTSBX340
00750 **         PERFORM S342-ACCT-DAILY     THRU S342-EXIT             DTSBX340
00751 *&         PERFORM S344-DELINQ-COLL    THRU S344-EXIT             DTSBX340
00752                                                                   DTSBX340
00753         WHEN W-SELECT-ALL-88                                      DTSBX340
00754            PERFORM S341-STATUS         THRU S341-EXIT             DTSBX340
00755            PERFORM S343-ACCT-CONVERT   THRU S343-EXIT             DTSBX340
00756 *&         PERFORM S344-DELINQ-COLL    THRU S344-EXIT             DTSBX340
00757                                                                   DTSBX340
00758      END-EVALUATE.                                                DTSBX340
00759                                                                   DTSBX340
00760                                                                   DTSBX340
00761  P2100-EXIT.                                                      DTSBX340
00762      EXIT.                                                        DTSBX340
00763                                                                   DTSBX340
00764  P2110-CHK-CHANGES.                                               DTSBX340
00765      MOVE LOW-VALUES                    TO MLOG-REC.              DTSBX340
00766      MOVE MPRF-EMP-NO                   TO MLOG-EMP-NO.           DTSBX340
00767      SET MLOG-LOG-88                    TO TRUE.                  DTSBX340
00768      MOVE LX34-ABSTIME                  TO MLOG-ESTB-ABSTIME.     DTSBX340
00769      MOVE MLOG-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBX340
00770      PERFORM S910-START-BROWSE          THRU S910-EXIT.           DTSBX340
00771                                                                   DTSBX340
00772      PERFORM                                                      DTSBX340
00773      UNTIL L910-NO-REC-88                                         DTSBX340
00774        MOVE MSKL-REC                    TO MLOG-REC               DTSBX340
00775        IF MLOG-ESTB-DATE                = LX34-PRIOR-RUN-DATE     DTSBX340
00776           EVALUATE TRUE                                           DTSBX340
00777             WHEN MLOG-DATA-ELEMENT-NAME = MPRF-PRIMARY-NAME       DTSBX340
00778               SET W-SELECT-NAME-YES-88      TO TRUE               DTSBX340
00779               DISPLAY 'NAME ' MPRF-EMP-NO '  ' MLOG-ESTB-DATE     DTSBX340
00780                                                                   DTSBX340
00781             WHEN MLOG-DE-REC-TYPE       = 'MTAD'                  DTSBX340
00782               SET W-SELECT-ADDR-YES-88      TO TRUE               DTSBX340
00783               DISPLAY 'ADDR ' MPRF-EMP-NO '  ' MLOG-ESTB-DATE     DTSBX340
00784                                                                   DTSBX340
00785             WHEN MLOG-DE-REC-TYPE       = 'MOPO'                  DTSBX340
00786               SET W-SELECT-OPO-YES-88       TO TRUE               DTSBX340
00787               DISPLAY 'OPO ' MPRF-EMP-NO '  ' MLOG-ESTB-DATE      DTSBX340
00788                                                                   DTSBX340
00789             WHEN MLOG-DE-REC-TYPE       = 'MSOL'                  DTSBX340
00790               SET W-SELECT-SOL-YES-88       TO TRUE               DTSBX340
00791               DISPLAY 'SOL ' MPRF-EMP-NO '  ' MLOG-ESTB-DATE      DTSBX340
00792                                                                   DTSBX340
00793             WHEN MLOG-DE-REC-TYPE       = 'MFSC'                  DTSBX340
00794               SET W-SELECT-FSC-YES-88       TO TRUE               DTSBX340
00795               DISPLAY 'FSC ' MPRF-EMP-NO '  ' MLOG-ESTB-DATE      DTSBX340
00796                                                                   DTSBX340
00797             WHEN MLOG-DE-REC-TYPE       = 'MRTE'                  DTSBX340
00798               SET W-SELECT-RATE-YES-88      TO TRUE               DTSBX340
00799               DISPLAY 'RATE ' MPRF-EMP-NO '  ' MLOG-ESTB-DATE     DTSBX340
00800                                                                   DTSBX340
00801           END-EVALUATE                                            DTSBX340
00802         END-IF                                                    DTSBX340
00803         PERFORM S910-READ-NEXT          THRU S910-EXIT            DTSBX340
00804      END-PERFORM.                                                 DTSBX340
00805                                                                   DTSBX340
00806  P2110-EXIT.                                                      DTSBX340
00807      EXIT.                                                        DTSBX340
00808                                                                   DTSBX340
00809                                                                   DTSBX340
00810                                                                   DTSBX340
00811                                                                   DTSBX340
00812  T0000-TERMINATE.                                                 DTSBX340
00813                                                                   DTSBX340
00814      SET LX34-TERMINATE-88         TO TRUE.                       DTSBX340
00815                                                                   DTSBX340
00816      PERFORM S341-STATUS           THRU S341-EXIT.                DTSBX340
00817 **   PERFORM S342-ACCT-DAILY       THRU S342-EXIT.                DTSBX340
00818      PERFORM S343-ACCT-CONVERT     THRU S343-EXIT.                DTSBX340
00819      PERFORM S344-DELINQ-COLL      THRU S344-EXIT.                DTSBX340
00820 *    PERFORM S346-CHARGES          THRU S346-EXIT.                DTSBX340
00821                                                                   DTSBX340
00822      CLOSE SERVER-FILE.                                           DTSBX340
00823                                                                   DTSBX340
00824      PERFORM S910-CLOSE             THRU S910-EXIT.               DTSBX340
00825                                                                   DTSBX340
00826      PERFORM S921-CLOSE             THRU S921-EXIT.               DTSBX340
00827                                                                   DTSBX340
00828      PERFORM S931-CLOSE             THRU S931-EXIT.               DTSBX340
00829                                                                   DTSBX340
00830                                                                   DTSBX340
00831      DISPLAY '*********************************************'.     DTSBX340
00832      DISPLAY '**   DTSBX340 TERMINATION STATISTICS       **'.     DTSBX340
00833      DISPLAY '**                                         **'.     DTSBX340
00834      DISPLAY '**   PROFILE RECORDS READ: ' W-MPRF-CNT             DTSBX340
00835                                       '                  **'.     DTSBX340
00836      DISPLAY '**   SERVER RECORDS READ:  ' W-SERVER-CNT           DTSBX340
00837                                       '                  **'.     DTSBX340
00838      DISPLAY '**                                         **'.     DTSBX340
00839      DISPLAY '**   NOT LIABLE BYPASSED : ' W-SELECT-NO-CNT        DTSBX340
00840                                       '                  **'.     DTSBX340
00841      DISPLAY '**   SELECT ALL          : ' W-SELECT-ALL-CNT       DTSBX340
00842                                       '                  **'.     DTSBX340
00843      DISPLAY '**   SELECT PROFILE      : ' W-SELECT-PRF-CNT       DTSBX340
00844                                       '                  **'.     DTSBX340
00845      DISPLAY '**   SELECT UPDATE       : ' W-SELECT-UPD-CNT       DTSBX340
00846                                       '                  **'.     DTSBX340
00847      DISPLAY '**                                         **'.     DTSBX340
00848      DISPLAY '*********************************************'.     DTSBX340
00849                                                                   DTSBX340
00850  T0000-EXIT.                                                      DTSBX340
00851      EXIT.                                                        DTSBX340
00852                                                                   DTSBX340
00853  S001-FROM-FED-8.                                                 DTSBX340
00854      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX340
00855      GO TO S001-DATE.                                             DTSBX340
00856                                                                   DTSBX340
00857  S001-FROM-ABS-DAY.                                               DTSBX340
00858      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX340
00859      GO TO S001-DATE.                                             DTSBX340
00860                                                                   DTSBX340
00861  S001-FROM-CAL-6.                                                 DTSBX340
00862      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX340
00863      GO TO S001-DATE.                                             DTSBX340
00864                                                                   DTSBX340
00865  S001-DATE.                                                       DTSBX340
00866      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX340
00867  S001-EXIT.                                                       DTSBX340
00868      EXIT.                                                        DTSBX340
00869      SKIP3                                                        DTSBX340
00870  S004-FROM-5.                                                     DTSBX340
00871      SET L004-FROM-5 TO TRUE.                                     DTSBX340
00872      GO TO S004-QTR.                                              DTSBX340
00873                                                                   DTSBX340
00874  S004-FROM-ABS.                                                   DTSBX340
00875      SET L004-FROM-ABS TO TRUE.                                   DTSBX340
00876      GO TO S004-QTR.                                              DTSBX340
00877                                                                   DTSBX340
00878  S004-FROM-3.                                                     DTSBX340
00879      SET L004-FROM-3 TO TRUE.                                     DTSBX340
00880      GO TO S004-QTR.                                              DTSBX340
00881                                                                   DTSBX340
00882  S004-FROM-DATE.                                                  DTSBX340
00883      SET L004-FROM-DATE TO TRUE.                                  DTSBX340
00884      GO TO S004-QTR.                                              DTSBX340
00885                                                                   DTSBX340
00886  S004-QTR.                                                        DTSBX340
00887                                                                   DTSBX340
00888      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX340
00889                                                                   DTSBX340
00890  S004-EXIT.                                                       DTSBX340
00891      EXIT.                                                        DTSBX340
00892      SKIP3                                                        DTSBX340
00893  S005-FROM-SYS.                                                   DTSBX340
00894      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX340
00895  S005-EXIT.                                                       DTSBX340
00896      EXIT.                                                        DTSBX340
00897                                                                   DTSBX340
00898  S341-STATUS.                                                     DTSBX340
00899      CALL 'DTSBX341' USING LX34-LINK-AREA                         DTSBX340
00900                            MPRF-REC.                              DTSBX340
00901                                                                   DTSBX340
00902  S341-EXIT.                                                       DTSBX340
00903      EXIT.                                                        DTSBX340
00904                                                                   DTSBX340
00905  S342-ACCT-DAILY.                                                 DTSBX340
00906      CALL 'DTSBX342' USING LX34-LINK-AREA                         DTSBX340
00907                            MPRF-REC.                              DTSBX340
00908                                                                   DTSBX340
00909  S342-EXIT.                                                       DTSBX340
00910      EXIT.                                                        DTSBX340
00911                                                                   DTSBX340
00912  S343-ACCT-CONVERT.                                               DTSBX340
00913      CALL 'DTSBX343' USING LX34-LINK-AREA                         DTSBX340
00914                            MPRF-REC.                              DTSBX340
00915                                                                   DTSBX340
00916  S343-EXIT.                                                       DTSBX340
00917      EXIT.                                                        DTSBX340
00918                                                                   DTSBX340
00919  S344-DELINQ-COLL.                                                DTSBX340
00920      CALL 'DTSBX344' USING LX34-LINK-AREA                         DTSBX340
00921                            MPRF-REC.                              DTSBX340
00922                                                                   DTSBX340
00923  S344-EXIT.                                                       DTSBX340
00924      EXIT.                                                        DTSBX340
00925                                                                   DTSBX340
00926 *S346-CHARGES.                                                    DTSBX340
00927 *    CALL 'DTSBX346' USING LX34-LINK-AREA                         DTSBX340
00928 *                          MPRF-REC.                              DTSBX340
00929 *                                                                 DTSBX340
00930 *S346-EXIT.                                                       DTSBX340
00931 *    EXIT.                                                        DTSBX340
00932                                                                   DTSBX340
00933                                                                   DTSBX340
00934  S348-HOLIDAYS.                                                   DTSBX340
00935      ADD +1 TO L001-JUL-ABS-DAY.                                  DTSBX340
00936                                                                   DTSBX340
00937      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBX340
00938                                                                   DTSBX340
00939      MOVE L001-FED-8-DATE-9 TO L003-DATE.                         DTSBX340
00940                                                                   DTSBX340
00941      MOVE '2' TO L003-OPTION.                                     DTSBX340
00942      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBX340
00943                                                                   DTSBX340
00944  S348-EXIT.                                                       DTSBX340
00945      EXIT.                                                        DTSBX340
00946                                                                   DTSBX340
00947  S910-OPEN-READ.                                                  DTSBX340
00948      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX340
00949      GO TO S910-MSTR-IO.                                          DTSBX340
00950                                                                   DTSBX340
00951  S910-READ.                                                       DTSBX340
00952      SET L910-READ-88 TO TRUE.                                    DTSBX340
00953      GO TO S910-MSTR-IO.                                          DTSBX340
00954                                                                   DTSBX340
00955  S910-START-BROWSE.                                               DTSBX340
00956      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX340
00957      GO TO S910-MSTR-IO.                                          DTSBX340
00958                                                                   DTSBX340
00959  S910-READ-NEXT.                                                  DTSBX340
00960      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX340
00961      GO TO S910-MSTR-IO.                                          DTSBX340
00962                                                                   DTSBX340
00963  S910-COUNT.                                                      DTSBX340
00964      SET L910-COUNT-88 TO TRUE.                                   DTSBX340
00965      GO TO S910-MSTR-IO.                                          DTSBX340
00966                                                                   DTSBX340
00967  S910-REWRITE.                                                    DTSBX340
00968      SET L910-REWRITE-88 TO TRUE.                                 DTSBX340
00969      GO TO S910-MSTR-IO.                                          DTSBX340
00970                                                                   DTSBX340
00971  S910-CLOSE.                                                      DTSBX340
00972      SET L910-CLOSE-88   TO TRUE.                                 DTSBX340
00973      GO TO S910-MSTR-IO.                                          DTSBX340
00974                                                                   DTSBX340
00975  S910-MSTR-IO.                                                    DTSBX340
00976      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX340
00977                            MSKL-REC.                              DTSBX340
00978  S910-EXIT.                                                       DTSBX340
00979      EXIT.                                                        DTSBX340
00980      SKIP3                                                        DTSBX340
00981                                                                   DTSBX340
00982  S931-OPEN-READ.                                                  DTSBX340
00983      SET L931-OPEN-READ-88 TO TRUE.                               DTSBX340
00984      GO TO S931-REF-IO.                                           DTSBX340
00985                                                                   DTSBX340
00986  S931-READ.                                                       DTSBX340
00987      SET L931-READ-88 TO TRUE.                                    DTSBX340
00988      GO TO S931-REF-IO.                                           DTSBX340
00989                                                                   DTSBX340
00990  S931-CLOSE.                                                      DTSBX340
00991      SET L931-CLOSE-88     TO TRUE.                               DTSBX340
00992      GO TO S931-REF-IO.                                           DTSBX340
00993                                                                   DTSBX340
00994  S931-REF-IO.                                                     DTSBX340
00995      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX340
00996                            FSKL-REC.                              DTSBX340
00997  S931-EXIT.                                                       DTSBX340
00998      EXIT.                                                        DTSBX340
00999                                                                   DTSBX340
01000  S921-OPEN-READ.                                                  DTSBX340
01001      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX340
01002      GO TO S921-AIX-IO.                                           DTSBX340
01003                                                                   DTSBX340
01004  S921-CLOSE.                                                      DTSBX340
01005      SET L921-CLOSE-88     TO TRUE.                               DTSBX340
01006      GO TO S921-AIX-IO.                                           DTSBX340
01007                                                                   DTSBX340
01008  S921-AIX-IO.                                                     DTSBX340
01009      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX340
01010                            ISKL-REC.                              DTSBX340
01011  S921-EXIT.                                                       DTSBX340
01012      EXIT.                                                        DTSBX340
01013                                                                   DTSBX340
01014  S1000-READ-SRVR.                                                 DTSBX340
01015      READ SERVER-FILE.                                            DTSBX340
01016      IF NOT SRVR-STATUS-OK-88                                     DTSBX340
01017         IF SRVR-STATUS-EOF-88                                     DTSBX340
01018            NEXT SENTENCE                                          DTSBX340
01019         ELSE                                                      DTSBX340
01020            DISPLAY 'SERVER FILE READ ERROR ' SRVR-STATUS          DTSBX340
01021            SET W-ERROR-YES-88        TO TRUE                      DTSBX340
01022         END-IF                                                    DTSBX340
01023      ELSE                                                         DTSBX340
01024         ADD +1                    TO W-SERVER-CNT                 DTSBX340
01025      END-IF.                                                      DTSBX340
01026                                                                   DTSBX340
01027  S1000-EXIT.                                                      DTSBX340
01028      EXIT.                                                        DTSBX340
01029                                                                   DTSBX340
01030  S2000-UNKNOWN.                                                   DTSBX340
01031      MOVE LOW-VALUES TO MJRN-KEY-AREA.                            DTSBX340
01032      MOVE MPRF-EMP-NO TO MJRN-EMP-NO.                             DTSBX340
01033      SET MJRN-JRN-88 TO TRUE.                                     DTSBX340
01034      MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX340
01035      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBX340
01036      IF L910-OK-88                                                DTSBX340
01037         SET W-SELECT-ALL-88      TO TRUE                          DTSBX340
01038      ELSE                                                         DTSBX340
01039         SET W-SELECT-NO-88       TO TRUE                          DTSBX340
01040      END-IF.                                                      DTSBX340
01041                                                                   DTSBX340
01042  S2000-EXIT.                                                      DTSBX340
01043      EXIT.                                                        DTSBX340
01044                                                                   DTSBX340
01045  S3000-INITIALIZE.                                                DTSBX340
01046 *    SET LX34-SELECT-NO-88             TO TRUE.                   DTSBX340
01047      SET W-SELECT-NO-88                TO TRUE.                   DTSBX340
01048      IF W-RUN-INCREMENTAL-88                                      DTSBX340
01049         SET W-SELECT-NAME-NO-88        TO TRUE                    DTSBX340
01050         SET W-SELECT-ADDR-NO-88        TO TRUE                    DTSBX340
01051         SET W-SELECT-OPO-NO-88         TO TRUE                    DTSBX340
01052         SET W-SELECT-SOL-NO-88         TO TRUE                    DTSBX340
01053         SET W-SELECT-FSC-NO-88         TO TRUE                    DTSBX340
01054         SET W-SELECT-RATE-NO-88        TO TRUE                    DTSBX340
01055      ELSE                                                         DTSBX340
01056         SET W-SELECT-NAME-YES-88       TO TRUE                    DTSBX340
01057         SET W-SELECT-ADDR-YES-88       TO TRUE                    DTSBX340
01058         SET W-SELECT-OPO-YES-88        TO TRUE                    DTSBX340
01059         SET W-SELECT-SOL-YES-88        TO TRUE                    DTSBX340
01060         SET W-SELECT-FSC-YES-88        TO TRUE                    DTSBX340
01061         SET W-SELECT-RATE-YES-88       TO TRUE                    DTSBX340
01062      END-IF.                                                      DTSBX340
01063                                                                   DTSBX340
01064      PERFORM                                                      DTSBX340
01065        VARYING LX34-SUB FROM +1 BY +1                             DTSBX340
01066        UNTIL LX34-SUB > LX34-MAX                                  DTSBX340
01067          SET LX34-QTR-EXISTS-NO-88 (LX34-SUB) TO TRUE             DTSBX340
01068      END-PERFORM.                                                 DTSBX340
01069                                                                   DTSBX340
01070  S3000-EXIT.                                                      DTSBX340
01071      EXIT.                                                        DTSBX340
01072                                                                   DTSBX340
01073  S3100-LX34-SELECTIONS.                                           DTSBX340
01074      MOVE W-SELECT-IND             TO LX34-SELECT-IND.            DTSBX340
01075      MOVE W-SELECT-NAME-IND        TO LX34-SELECT-NAME-IND.       DTSBX340
01076      MOVE W-SELECT-ADDR-IND        TO LX34-SELECT-ADDR-IND.       DTSBX340
01077      MOVE W-SELECT-OPO-IND         TO LX34-SELECT-OPO-IND.        DTSBX340
01078      MOVE W-SELECT-SOL-IND         TO LX34-SELECT-SOL-IND.        DTSBX340
01079      MOVE W-SELECT-FSC-IND         TO LX34-SELECT-FSC-IND.        DTSBX340
01080      MOVE W-SELECT-RATE-IND        TO LX34-SELECT-RATE-IND.       DTSBX340
01081                                                                   DTSBX340
01082  S3100-EXIT.                                                      DTSBX340
01083      EXIT.                                                        DTSBX340
01084                                                                   DTSBX340
01085  S999-ABEND.                                                      DTSBX340
01086      DISPLAY '*** DTSBX340 ABENDING.  '                           DTSBX340
01087              ABEND-MSG.                                           DTSBX340
01088                                                                   DTSBX340
01089      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX340
01090  S999-EXIT.                                                       DTSBX340
01091      EXIT.                                                        DTSBX340
