00001  IDENTIFICATION DIVISION.                                         01/05/99
00002  PROGRAM-ID.             DTSBE308.                                DTSBE308
00003  AUTHOR.                 TRW S&ITG.                                  LV012
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE308
00005  DATE-UPDATED.           JANUARY 1999.                               CL*12
00006  DATE-COMPILED.                                                   DTSBE308
00007      SKIP3                                                        DTSBE308
00008 *****                                                             DTSBE308
00009 *                                                                 DTSBE308
00010 *    CALLING SEQUENCE:  DTSBE308 CREATES DTSIR308 RECORDS.           CL*12
00011 *                       DTSBD800 CALLS DTSBR308                      CL*12
00012 *                                WHICH PRODUCES THE CREDIT REPORT.   CL*12
00013 *                                                                    CL*12
00014 *                                                                    CL*12
00015 *    FUNCTION:  EMPLOYER ACCOUNTS CREDIT REPORT.                  DTSBE308
00016 *                                                                 DTSBE308
00017 *                                                                 DTSBE308
00018 *    MODIFICATION LOG:                                            DTSBE308
00019 *                                                                 DTSBE308
00020 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE308
00021 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE308
00022 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE308
00023 *                                                                 DTSBE308
00024 *                                                                 DTSBE308
00025 *  DESCRIPTION:                                                   DTSBE308
00026 *                                                                 DTSBE308
00027 *                                                                 DTSBE308
00028 *    INITIATION:                                                  DTSBE308
00029 *                                                                 DTSBE308
00030 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE308
00031 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE308
00032 *                                                                 DTSBE308
00033 *      NO PARAMETERS ARE INPUT.                                   DTSBE308
00034 *                                                                 DTSBE308
00035 *                                                                 DTSBE308
00036 *                                                                 DTSBE308
00037 *    PROCESSING:                                                  DTSBE308
00038 *                                                                 DTSBE308
00039 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (308R1).       DTSBE308
00040 *                                                                 DTSBE308
00041 *      IF MPRF-STATUS-INACTIVE-88                                 DTSBE308
00042 *          SCAN THE MSOL RECORDS AND MAKE R308-INACT-DATE         DTSBE308
00043 *          EQUAL TO THE LARGEST MSOL-INACT-DATE ENCOUNTERED.      DTSBE308
00044 *                                                                 DTSBE308
00045 *                                                                 DTSBE308
00046 *    TERMINATION:                                                 DTSBE308
00047 *                                                                 DTSBE308
00048 *      NONE.                                                      DTSBE308
00049 *                                                                 DTSBE308
00050 *                                                                 DTSBE308
00051 *    RECORDS READ:                                                DTSBE308
00052 *                                                                 DTSBE308
00053 *      MASTER:                                                    DTSBE308
00054 *                                                                 DTSBE308
00055 *        MSOL                                                     DTSBE308
00056 *                                                                 DTSBE308
00057 *                                                                 DTSBE308
00058 *      ALTERNATE INDEX:                                           DTSBE308
00059 *                                                                 DTSBE308
00060 *        NONE.                                                    DTSBE308
00061 *                                                                 DTSBE308
00062 *                                                                 DTSBE308
00063 *      REFERENCE:                                                 DTSBE308
00064 *                                                                 DTSBE308
00065 *        NONE.                                                    DTSBE308
00066 *                                                                 DTSBE308
00067 *                                                                 DTSBE308
00068 *    RECORDS UPDATED:                                             DTSBE308
00069 *                                                                 DTSBE308
00070 *        NONE.                                                    DTSBE308
00071 *                                                                 DTSBE308
00072 *                                                                 DTSBE308
00073 *    REPORT RECORDS WRITTEN:                                      DTSBE308
00074 *                                                                 DTSBE308
00075 *        R308  EMPLOYER ACCOUNTS CREDIT REPORT.                   DTSBE308
00076 *                                                                 DTSBE308
00077 *                                                                 DTSBE308
00078 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE308
00079 *                                                                 DTSBE308
00080 *        NONE.                                                    DTSBE308
00081 *                                                                 DTSBE308
00082 *                                                                 DTSBE308
00083 *    MODULES CALLED:                                              DTSBE308
00084 *                                                                 DTSBE308
00085 *        DTSBU910  MASTER FILE I/O.                                  CL**3
00086 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**3
00087 *        DTSBU921  ALTERNATE INDEX I-O MODULE.                       CL*12
00088 *                                                                 DTSBE308
00089 *                                                                 DTSBE308
00090 *    VERMONT REFERENCE:                                           DTSBE308
00091 *                                                                 DTSBE308
00092 *        TXBE316                                                  DTSBE308
00093 *                                                                 DTSBE308
00094 *****                                                             DTSBE308
00095      SKIP3                                                        DTSBE308
00096  ENVIRONMENT DIVISION.                                            DTSBE308
00097      SKIP3                                                        DTSBE308
00098  DATA DIVISION.                                                   DTSBE308
00099      SKIP3                                                        DTSBE308
00100  WORKING-STORAGE SECTION.                                         DTSBE308
001005 77  PAN-VALET PICTURE X(24) VALUE '012DTSBE308  01/05/99'.       DTSBE308
00101      SKIP3                                                        DTSBE308
00102  01  WRK-AREA.                                                    DTSBE308
00103      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +308.DTSBE308
00104      SKIP1                                                        DTSBE308
00105      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE308'.   CL**3
00106      SKIP3                                                        DTSBE308
00107      05  ABEND-MSG                   PIC  X(60).                     CL*12
00108      EJECT                                                        DTSBE308
00109  01  L921-LINK-AREA.                                                 CL**8
00110  ++INCLUDE DTSIL921                                                  CL**8
00111      SKIP3                                                           CL**8
00112  01  IPES-REC.                                                       CL**8
00113  ++INCLUDE DTSIIPES                                                  CL**8
00114      SKIP3                                                           CL**8
00115  01  ISKL-REC.                                                       CL**8
00116  ++INCLUDE DTSIISKL                                                  CL**8
00117      SKIP3                                                           CL**8
00118  01  MSKL-REC.                                                    DTSBE308
00119  ++INCLUDE DTSIMSKL                                                  CL**3
00120      SKIP3                                                        DTSBE308
00121  01  L910-LINK-AREA.                                                 CL*10
00122  ++INCLUDE DTSIL910                                                  CL*10
00123      SKIP3                                                           CL*10
00124  01  MSOL-REC.                                                    DTSBE308
00125  ++INCLUDE DTSIMSOL                                                  CL**3
00126      EJECT                                                        DTSBE308
00127  01  R308-REC.                                                    DTSBE308
00128  ++INCLUDE DTSIR308                                                  CL**3
00129      EJECT                                                        DTSBE308
00130  LINKAGE SECTION.                                                 DTSBE308
00131      SKIP3                                                        DTSBE308
00132  01  LECM-LINK-AREA.                                              DTSBE308
00133  ++INCLUDE DTSILECM                                                  CL**3
00134      EJECT                                                        DTSBE308
00135  01  MPRF-LINK-REC.                                               DTSBE308
00136  ++INCLUDE DTSIMPRF                                                  CL**3
00137      EJECT                                                        DTSBE308
00138  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE308
00139                           MPRF-LINK-REC.                          DTSBE308
00140      SKIP2                                                        DTSBE308
00141      IF LECM-PROCESS-88                                           DTSBE308
00142          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE308
00143      ELSE                                                         DTSBE308
00144      IF LECM-INITIALIZE-88                                        DTSBE308
00145          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE308
00146      ELSE                                                         DTSBE308
00147      IF LECM-TERMINATE-88                                         DTSBE308
00148          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE308
00149      ELSE                                                         DTSBE308
00150          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE308
00151            TO ABEND-MSG                                           DTSBE308
00152          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE308
00153      SKIP2                                                        DTSBE308
00154      GOBACK.                                                      DTSBE308
00155      EJECT                                                        DTSBE308
00156  I0000-INITIALIZE.                                                DTSBE308
00157      SKIP2                                                        DTSBE308
00158      MOVE LENGTH OF R308-REC TO R308-LENGTH.                         CL**5
00159      MOVE '308'              TO R308-REC-TYPE.                       CL**5
00160      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE308
00161      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE308
00162                                                                   DTSBE308
00163      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE308
00164      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE308
00165      SKIP2                                                        DTSBE308
00166  I0000-EXIT.                                                      DTSBE308
00167      EXIT.                                                        DTSBE308
00168      EJECT                                                        DTSBE308
00169  P0000-PROCESS.                                                   DTSBE308
00170      IF MPRF-TOT-CREDIT-AMT = +0                                  DTSBE308
00171          GO TO P0000-EXIT.                                        DTSBE308
00172                                                                   DTSBE308
00173      IF MPRF-STATUS-ACT-88                                        DTSBE308
00174          SET R308-STATUS-ACT-88 TO TRUE                           DTSBE308
00175      ELSE                                                         DTSBE308
00176          SET R308-STATUS-INACT-88 TO TRUE.                        DTSBE308
00177                                                                   DTSBE308
00178      MOVE MPRF-EMP-CLASS TO R308-EMP-CLASS.                       DTSBE308
00179      IF MPRF-CLASS-SUB-88                                         DTSBE308
00180          NEXT SENTENCE                                            DTSBE308
00181      ELSE                                                         DTSBE308
00182          SET R308-CLASS-RATED-88 TO TRUE.                            CL**3
00183                                                                   DTSBE308
00184      IF R308-CLASS-UNK-88                                            CL**3
00185          SET R308-SORT-UNK-88 TO TRUE                                CL**3
00186      ELSE                                                         DTSBE308
00187      IF R308-CLASS-SELF-INS-88                                       CL**3
00188          SET R308-SORT-SELF-INS-88 TO TRUE                           CL**3
00189      ELSE                                                         DTSBE308
00190          SET R308-SORT-RATED-88 TO TRUE.                             CL**3
00191                                                                   DTSBE308
00192      MOVE MPRF-EMP-NO TO R308-EMP-NO.                             DTSBE308
00193                                                                   DTSBE308
00194      MOVE MPRF-PRIMARY-NAME TO R308-PRIMARY-NAME.                    CL**3
00195                                                                   DTSBE308
00196      MOVE MPRF-TOT-CREDIT-AMT TO R308-TOT-CREDIT-AMT.             DTSBE308
00197                                                                   DTSBE308
00198      MOVE MPRF-UC30-CREDIT-IND TO R308-UC30-CREDIT-IND.              CL**2
00199                                                                   DTSBE308
00200      MOVE +0 TO R308-INACT-DATE.                                  DTSBE308
00201                                                                   DTSBE308
00202      IF MPRF-STATUS-INACT-88                                      DTSBE308
00203          MOVE LOW-VALUES TO MSOL-KEY-AREA                         DTSBE308
00204          MOVE MPRF-EMP-NO TO MSOL-EMP-NO                          DTSBE308
00205          SET MSOL-SOL-88 TO TRUE                                  DTSBE308
00206          MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA                      DTSBE308
00207          PERFORM S910-START-BROWSE THRU S910-EXIT                 DTSBE308
00208          PERFORM P1000-MSOL-SCAN THRU P1000-EXIT                  DTSBE308
00209              UNTIL L910-NO-REC-88.                                DTSBE308
00210      PERFORM S945-SUCCESSOR THRU  S945-EXIT.                         CL**6
00211      PERFORM S946-WRITE-R308 THRU S946-EXIT.                      DTSBE308
00212  P0000-EXIT.                                                      DTSBE308
00213      EXIT.                                                        DTSBE308
00214  P1000-MSOL-SCAN.                                                 DTSBE308
00215      MOVE MSKL-REC TO MSOL-REC.                                   DTSBE308
00216                                                                   DTSBE308
00217      IF MSOL-INACT-DATE > R308-INACT-DATE                         DTSBE308
00218          MOVE MSOL-INACT-DATE TO R308-INACT-DATE.                 DTSBE308
00219                                                                   DTSBE308
00220      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE308
00221  P1000-EXIT.                                                      DTSBE308
00222      EXIT.                                                        DTSBE308
00223      EJECT                                                        DTSBE308
00224  T0000-TERMINATE.                                                 DTSBE308
00225      SKIP2                                                        DTSBE308
00226      SKIP2                                                        DTSBE308
00227  T0000-EXIT.                                                      DTSBE308
00228      EXIT.                                                        DTSBE308
00229      EJECT                                                        DTSBE308
00230  S910-READ.                                                       DTSBE308
00231      SET L910-READ-88 TO TRUE.                                    DTSBE308
00232      GO TO S910-MSTR-IO.                                          DTSBE308
00233      SKIP1                                                        DTSBE308
00234  S910-START-BROWSE.                                               DTSBE308
00235      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE308
00236      GO TO S910-MSTR-IO.                                          DTSBE308
00237      SKIP1                                                        DTSBE308
00238  S910-READ-NEXT.                                                  DTSBE308
00239      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE308
00240      GO TO S910-MSTR-IO.                                          DTSBE308
00241      SKIP1                                                        DTSBE308
00242  S910-COUNT.                                                      DTSBE308
00243      SET L910-COUNT-88 TO TRUE.                                   DTSBE308
00244      GO TO S910-MSTR-IO.                                          DTSBE308
00245      SKIP1                                                        DTSBE308
00246  S910-MSTR-IO.                                                    DTSBE308
00247      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**3
00248                            MSKL-REC.                              DTSBE308
00249  S910-EXIT.                                                       DTSBE308
00250      EXIT.                                                        DTSBE308
00251      SKIP3                                                        DTSBE308
00252  S921-START-BROWSE.                                                  CL**8
00253      SET L921-START-BROWSE-88 TO TRUE.                               CL**8
00254      CALL 'DTSBU921' USING L921-LINK-AREA                            CL**8
00255                            ISKL-REC.                                 CL**8
00256  S921-EXIT.                                                          CL**8
00257      EXIT.                                                           CL**8
00258      SKIP3                                                           CL**8
00259  S945-SUCCESSOR.                                                     CL**6
00260      SKIP1                                                        DTSBE308
00261      IF MPRF-STATUS-ACT-88                                           CL**7
00262         SET R308-NO-SUCCESSOR-88 TO TRUE                             CL*11
00263         GO TO S945-EXIT.                                             CL**8
00264      MOVE LOW-VALUES TO IPES-KEY-AREA.                               CL**8
00265      SET IPES-PES-88 TO TRUE.                                        CL**8
00266      MOVE MPRF-EMP-NO TO IPES-PRED-EMP-NO.                           CL**8
00267      MOVE IPES-KEY-AREA TO ISKL-KEY-AREA.                            CL**9
00268      PERFORM S921-START-BROWSE THRU S921-EXIT.                       CL**8
00269      IF L921-NO-REC-88                                               CL**8
00270         SET R308-NO-SUCCESSOR-88 TO TRUE                             CL**9
00271         GO TO S945-EXIT                                              CL**9
00272      ELSE                                                            CL**8
00273         MOVE ISKL-REC TO IPES-REC                                    CL**9
00274         IF MPRF-EMP-NO = IPES-PRED-EMP-NO                            CL**8
00275            SET R308-SUCCESSOR-88    TO TRUE                          CL**9
00276         ELSE                                                         CL**8
00277            SET R308-NO-SUCCESSOR-88 TO TRUE.                         CL**9
00278  S945-EXIT.                                                          CL**6
00279      EXIT.                                                        DTSBE308
00280      SKIP3                                                        DTSBE308
00281  S946-WRITE-R308.                                                    CL**6
00282      CALL 'DTSBU946' USING R308-REC.                                 CL**6
00283      GO TO S946-EXIT.                                                CL**6
00284      SKIP1                                                           CL**6
00285  S946-EXIT.                                                          CL**6
00286      EXIT.                                                           CL**6
00287      SKIP3                                                           CL**6
00288  S999-ABEND.                                                      DTSBE308
00289      DISPLAY '*** DTSBE308 ABENDING.  '                              CL**3
00290              ABEND-MSG.                                           DTSBE308
00291      SKIP1                                                        DTSBE308
00292      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**3
00293  S999-EXIT.                                                       DTSBE308
00294      EXIT.                                                        DTSBE308
