00001  IDENTIFICATION DIVISION.                                         01/31/01
00002  PROGRAM-ID.             DTSBR308.                                DTSBR308
00003  AUTHOR.                 TRW S&ITG.                                  LV021
00004  DATE-WRITTEN.           NOVEMBER 1994.                           DTSBR308
00005  DATE-COMPILED.                                                   DTSBR308
00006      SKIP3                                                        DTSBR308
00007 *****                                                             DTSBR308
00008 *                                                                 DTSBR308
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS DTSBE308 WHICH CREATES     DTSBR308
00010 *                                DTSIR308 RECORDS.                DTSBR308
00011 *                       DTSBD800 CALLS DTSBR308                   DTSBR308
00012 *                                WHICH PRODUCES THE CREDIT REPORT.DTSBR308
00013 *                                                                 DTSBR308
00014 *                                                                 DTSBR308
00015 *    FUNCTION:  EMPLOYER ACCOUNTS CREDIT REPORT.                  DTSBR308
00016 *                                                                 DTSBR308
00017 *                                                                 DTSBR308
00018 *    MODIFICATION HISTORY:                                        DTSBR308
00019 *                                                                 DTSBR308
00020 * 11-11-94 INITIAL DEVELOPMENT                                    DTSBR308
00021 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR308
00022 *                                                                 DTSBR308
00023 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR308
00024 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR308
00025 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR308
00026 *                                                                 DTSBR308
00027 *                                                                 DTSBR308
00028 *    DESCRIPTION:                                                 DTSBR308
00029 *                                                                 DTSBR308
00030 *        THIS MODULE PRODUCES A LIST OF ALL EMPLOYERS WITH A      DTSBR308
00031 *        CREDIT BALANCE.                                          DTSBR308
00032 *                                                                 DTSBR308
00033 *                                                                 DTSBR308
00034 *    RECORDS READ:                                                DTSBR308
00035 *                                                                 DTSBR308
00036 *        NONE.                                                    DTSBR308
00037 *                                                                 DTSBR308
00038 *                                                                 DTSBR308
00039 *    PRINTED OUTPUTS:                                             DTSBR308
00040 *                                                                 DTSBR308
00041 *        308R1  EMPLOYER ACCOUNTS WITH CREDIT REPORT              DTSBR308
00042 *                                                                 DTSBR308
00043 *                                                                 DTSBR308
00044 *    RECORDS WRITTEN:                                             DTSBR308
00045 *                                                                 DTSBR308
00046 *        NONE.                                                    DTSBR308
00047 *                                                                 DTSBR308
00048 *                                                                 DTSBR308
00049 *    MODULES CALLED:                                              DTSBR308
00050 *                                                                 DTSBR308
00051 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     DTSBR308
00052 *                                                                 DTSBR308
00053 *                                                                 DTSBR308
00054 *****                                                             DTSBR308
00055      EJECT                                                        DTSBR308
00056  ENVIRONMENT DIVISION.                                            DTSBR308
00057      SKIP2                                                        DTSBR308
00058                                                                   DTSBR308
00059  CONFIGURATION SECTION.                                           DTSBR308
00060  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR308
00061                                                                   DTSBR308
00062  INPUT-OUTPUT SECTION.                                            DTSBR308
00063      SKIP1                                                        DTSBR308
00064  FILE-CONTROL.                                                    DTSBR308
00065      SELECT PRT-FILE  ASSIGN TO RPT308R1.                         DTSBR308
00066      SKIP3                                                        DTSBR308
00067  DATA DIVISION.                                                   DTSBR308
00068      SKIP3                                                        DTSBR308
00069  FILE SECTION.                                                    DTSBR308
00070                                                                   DTSBR308
00071  FD  PRT-FILE                                                     DTSBR308
00072      RECORDING MODE IS F.                                         DTSBR308
00073  01  PRT-RECORD              PIC X(133).                          DTSBR308
00074                                                                   DTSBR308
00075  WORKING-STORAGE SECTION.                                         DTSBR308
000755 77  PAN-VALET PICTURE X(24) VALUE '021DTSBR308  01/31/01'.       DTSBR308
00076      SKIP3                                                        DTSBR308
00077  01  WRK-AREA.                                                    DTSBR308
00078      05  WRK-ABEND-CD              PIC S9(04)  COMP  VALUE +308.  DTSBR308
00079      05  FIRST-TIME-IND            PIC  X(01)  VALUE 'Y'.         DTSBR308
00080      05  WS-NUMBER-ONE             PIC S9(03)  COMP-3 VALUE +0.   DTSBR308
00081      05  WS-NUMBER-TWO             PIC S9(03)  COMP-3 VALUE +0.   DTSBR308
00082                                                                   DTSBR308
00083      05  WS-ECD-FOOT-CNT           PIC S9(05)  COMP-3 VALUE +0.   DTSBR308
00084      05  WS-ESD-FOOT-CNT           PIC S9(05)  COMP-3 VALUE +0.   DTSBR308
00085      05  WS-SUM-FOOT-CNT           PIC S9(07)  COMP-3 VALUE +0.   DTSBR308
00086      05  WS-LINE-CNT               PIC S9(02)  COMP-3 VALUE 60.   DTSBR308
00087      05  WS-LINE-CNT2              PIC S9(02)  COMP-3 VALUE +0.   DTSBR308
00088      05  WS-PAGE-CNT               PIC S9(05)  COMP-3 VALUE +0.   DTSBR308
00089      05  WS-FOOT-ONE-CREDIT-AMT    PIC S9(07)V99 COMP-3 VALUE +0. DTSBR308
00090      05  WS-FOOT-TWO-CREDIT-AMT    PIC S9(07)V99 COMP-3 VALUE +0. DTSBR308
00091      05  WS-FOOT-SUM-CREDIT-AMT    PIC S9(07)V99 COMP-3 VALUE +0. DTSBR308
00092                                                                   DTSBR308
00093      05  WS-EMP-STATUS-HOLD        PIC  X(01)  VALUE SPACE.       DTSBR308
00094      05  WS-EMP-CLASS-HOLD         PIC  X(01)  VALUE SPACE.       DTSBR308
00095      EJECT                                                        DTSBR308
00096  01  L001-LINK-AREA.                                              DTSBR308
00097  ++INCLUDE DTSIL001                                               DTSBR308
00098      EJECT                                                        DTSBR308
00099  01  PAGE-HEADING.                                                DTSBR308
00100      05  HEADER-1.                                                DTSBR308
00101          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00102          10  FILLER                  PIC  X(05)                   DTSBR308
00103                 VALUE '308R1'.                                    DTSBR308
00104          10  FILLER                  PIC  X(34)  VALUE SPACES.    DTSBR308
00105          10  WS-AGY-NAME-LINE1       PIC  X(50)  VALUE SPACE.     DTSBR308
00106          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR308
00107          10  FILLER                  PIC  X(05)                   DTSBR308
00108                 VALUE 'DATE:'.                                    DTSBR308
00109          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00110          10  WS-SYS-DATE             PIC  X(08)  VALUE SPACE.     DTSBR308
00111      05  HEADER-2.                                                DTSBR308
00112          10  FILLER                  PIC  X(40)  VALUE SPACES.    DTSBR308
00113          10  WS-AGY-NAME-LINE2       PIC  X(50)  VALUE SPACE.     DTSBR308
00114          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR308
00115          10  FILLER                  PIC  X(05)                   DTSBR308
00116                 VALUE 'TIME:'.                                    DTSBR308
00117          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00118          10  WS-SYS-TIME             PIC  X(08)  VALUE SPACE.     DTSBR308
00119      05  HEADER-3.                                                DTSBR308
00120          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00121          10  FILLER                  PIC  X(25)                   DTSBR308
00122                 VALUE 'ROUTE TO:  ACCOUNTING'.                    DTSBR308
00123          10  FILLER                  PIC  X(23)  VALUE SPACES.    DTSBR308
00124          10  FILLER                  PIC  X(31)                   DTSBR308
00125                 VALUE 'EMPLOYER ACCOUNTS CREDIT REPORT'.          DTSBR308
00126          10  FILLER                  PIC  X(38)  VALUE SPACES.    DTSBR308
00127          10  FILLER                  PIC  X(05)                   DTSBR308
00128                 VALUE 'PAGE:'.                                    DTSBR308
00129          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR308
00130          10  HDR3-PAGE-CNT           PIC  ZZ,ZZ9.                 DTSBR308
00131      05  HEADER-4                    PIC  X(133) VALUE SPACES.    DTSBR308
00132 ***  05  HEADER-5                    PIC  X(133) VALUE SPACES.    DTSBR308
00133 ***  05  HEADER-6                    PIC  X(133) VALUE SPACES.    DTSBR308
00134      05  HEADER-7.                                                DTSBR308
00135          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00136          10  FILLER                  PIC  X(18)                   DTSBR308
00137                 VALUE 'EMPLOYER STATUS:  '.                       DTSBR308
00138          10  WS-HDR-EMP-STATUS-DSCR  PIC  X(08)  VALUE SPACE.     DTSBR308
00139      05  HEADER-8.                                                DTSBR308
00140          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00141          10  FILLER                  PIC  X(18)                   DTSBR308
00142                 VALUE ' EMPLOYER CLASS:  '.                       DTSBR308
00143          10  WS-HDR-EMP-CLASS-DSCR   PIC  X(12)  VALUE SPACE.     DTSBR308
00144      05  HEADER-9                    PIC  X(133) VALUE SPACES.    DTSBR308
00145      05  HEADER-10.                                               DTSBR308
00146          10  FILLER                  PIC  X(69)  VALUE SPACES.    DTSBR308
00147          10  FILLER                  PIC  X(05)                   DTSBR308
00148                 VALUE 'PRINT'.                                    DTSBR308
00149          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBR308
00150          10  FILLER                  PIC  X(05)                   DTSBR308
00151                 VALUE 'INACT'.                                    DTSBR308
00152          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00153          10  FILLER                  PIC  X(09)                   DTSBR308
00154                 VALUE 'SUCCESSOR'.                                DTSBR308
00155      05  HEADER-11.                                               DTSBR308
00156          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00157          10  FILLER                  PIC  X(06)                   DTSBR308
00158                 VALUE 'EMP NO'.                                   DTSBR308
00159          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR308
00160          10  FILLER                  PIC  X(13)                   DTSBR308
00161                 VALUE 'NAME         '.                            DTSBR308
00162          10  FILLER                  PIC  X(29)  VALUE SPACES.    DTSBR308
00163          10  FILLER                  PIC  X(14)                   DTSBR308
00164                 VALUE 'CREDIT BALANCE'.                           DTSBR308
00165          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR308
00166          10  FILLER                  PIC  X(06)                   DTSBR308
00167                 VALUE 'UC-30?'.                                   DTSBR308
00168          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBR308
00169          10  FILLER                  PIC  X(04)                   DTSBR308
00170                 VALUE 'DATE'.                                     DTSBR308
00171          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR308
00172          10  FILLER                  PIC  X(07)                   DTSBR308
00173                 VALUE 'EXISTS?'.                                  DTSBR308
00174      SKIP2                                                        DTSBR308
00175  01  DETAIL-LINE.                                                 DTSBR308
00176      05  DTL-LINE-2.                                              DTSBR308
00177          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00178          10  WS-EMP-NO               PIC  999B999.                DTSBR308
00179          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR308
00180          10  WS-PRIMARY-NAME         PIC  X(40)  VALUE SPACE.     DTSBR308
00181          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00182          10  WS-DTL-TOT-CREDIT-AMT   PIC  ZZZ,ZZZ,ZZ9.99.         DTSBR308
00183          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBR308
00184          10  WS-UC30-CREDIT-IND      PIC  X(01)  VALUE SPACE.     DTSBR308
00185          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR308
00186          10  WS-INACT-DATE           PIC  X(08)  VALUE SPACE.     DTSBR308
00187          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR308
00188          10  WS-SUCCESSOR-IND        PIC  X(01)  VALUE SPACE.     DTSBR308
00189      SKIP2                                                        DTSBR308
00190  01  CONTROL-ECD-FOOTING.                                         DTSBR308
00191      05  ECD-LINE-3.                                              DTSBR308
00192          10  FILLER                  PIC  X(41)  VALUE SPACES.    DTSBR308
00193          10  WS-ECD-EMP-STATUS-DSCR  PIC  X(08)  VALUE SPACE.     DTSBR308
00194          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR308
00195          10  WS-ECD-EMP-CLASS-DSCR   PIC  X(11)  VALUE SPACE.     DTSBR308
00196          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00197          10  FILLER                  PIC  X(24)                   DTSBR308
00198                 VALUE 'EMPLOYER CREDIT BALANCE:'.                 DTSBR308
00199          10  WS-ECD-TOT-CREDIT-AMT   PIC  $$$,$$$,$$9.99.         DTSBR308
00200      05  ECD-LINE-4                  PIC  X(133) VALUE SPACES.    DTSBR308
00201      05  ECD-LINE-5.                                              DTSBR308
00202          10  FILLER                  PIC  X(62)  VALUE SPACES.    DTSBR308
00203          10  FILLER                  PIC  X(25)                   DTSBR308
00204                 VALUE '      NUMBER OF ACCOUNTS:'.                DTSBR308
00205          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR308
00206          10  WS-ECD-FOOT-NUMBER      PIC  ZZ,ZZ9.                 DTSBR308
00207      SKIP2                                                        DTSBR308
00208  01  CONTROL-ESD-FOOTING.                                         DTSBR308
00209      05  ESD-LINE-4.                                              DTSBR308
00210          10  FILLER                  PIC  X(41)  VALUE SPACES.    DTSBR308
00211          10  WS-ESD-EMP-STATUS-DSCR  PIC  X(08)  VALUE SPACE.     DTSBR308
00212          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR308
00213          10  FILLER                  PIC  X(05)                   DTSBR308
00214                 VALUE 'TOTAL'.                                    DTSBR308
00215          10  FILLER                  PIC  X(07)  VALUE SPACES.    DTSBR308
00216          10  FILLER                  PIC  X(24)                   DTSBR308
00217                 VALUE 'EMPLOYER CREDIT BALANCE:'.                 DTSBR308
00218          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR308
00219          10  WS-ESD-TOT-CREDIT-AMT   PIC  $$$,$$$,$$9.99.         DTSBR308
00220      05  ESD-LINE-5                  PIC  X(133) VALUE SPACES.    DTSBR308
00221      05  ESD-LINE-6.                                              DTSBR308
00222          10  FILLER                  PIC  X(62)  VALUE SPACES.    DTSBR308
00223          10  FILLER                  PIC  X(25)                   DTSBR308
00224                 VALUE '      NUMBER OF ACCOUNTS:'.                DTSBR308
00225          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR308
00226          10  WS-ESD-FOOT-NUMBER      PIC  ZZ,ZZ9.                 DTSBR308
00227      SKIP2                                                        DTSBR308
00228  01  CONTROL-SUM-FOOTING.                                         DTSBR308
00229      05  SUM-LINE-4.                                              DTSBR308
00230          10  FILLER                  PIC  X(59)  VALUE SPACES.    DTSBR308
00231          10  FILLER                  PIC  X(28)                   DTSBR308
00232                 VALUE 'REPORT TOTAL CREDIT BALANCE:'.             DTSBR308
00233          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR308
00234          10  WS-SUM-TOT-CREDIT-AMT   PIC  $$$,$$$,$$9.99.         DTSBR308
00235 *               SUM R308-TOT-CREDIT-AMT.                          DTSBR308
00236      05  SUM-LINE-5                  PIC  X(133) VALUE SPACES.    DTSBR308
00237      05  SUM-LINE-6.                                              DTSBR308
00238          10  FILLER                  PIC  X(62)  VALUE SPACES.    DTSBR308
00239          10  FILLER                  PIC  X(30)                   DTSBR308
00240                 VALUE '      NUMBER OF ACCOUNTS:'.                DTSBR308
00241          10  WS-SUM-FOOT-NUMBER      PIC  ZZ,ZZ9.                 DTSBR308
00242 *               SUM WS-NUMBER-ONE.                                DTSBR308
00243      EJECT                                                        DTSBR308
00244  LINKAGE SECTION.                                                 DTSBR308
00245      SKIP3                                                        DTSBR308
00246  01  LRCM-LINK-AREA.                                              DTSBR308
00247  ++INCLUDE DTSILRCM                                               DTSBR308
00248      EJECT                                                        DTSBR308
00249  01  R308-REC.                                                    DTSBR308
00250  ++INCLUDE DTSIR308                                               DTSBR308
00251      EJECT                                                        DTSBR308
00252  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR308
00253                           R308-REC.                               DTSBR308
00254      SKIP2                                                        DTSBR308
00255      IF FIRST-TIME-IND = 'Y'                                      DTSBR308
00256          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR308
00257          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR308
00258      SKIP1                                                        DTSBR308
00259      IF LRCM-EOR-88                                               DTSBR308
00260          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR308
00261      ELSE                                                         DTSBR308
00262          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR308
00263      SKIP2                                                        DTSBR308
00264      GOBACK.                                                      DTSBR308
00265      EJECT                                                        DTSBR308
00266  I1000-INITIATE.                                                  DTSBR308
00267                                                                   DTSBR308
00268      OPEN OUTPUT PRT-FILE.                                        DTSBR308
00269      MOVE LRCM-SYS-DATE TO WS-SYS-DATE.                           DTSBR308
00270      MOVE LRCM-SYS-TIME TO WS-SYS-TIME.                           DTSBR308
00271      MOVE LRCM-AGY-NAME-LINE1 TO WS-AGY-NAME-LINE1.               DTSBR308
00272      MOVE LRCM-AGY-NAME-LINE2 TO WS-AGY-NAME-LINE2.               DTSBR308
00273      MOVE SPACES TO PRT-RECORD.                                   DTSBR308
00274                                                                   DTSBR308
00275      MOVE SPACES TO WS-EMP-STATUS-HOLD WS-EMP-CLASS-HOLD.         DTSBR308
00276                                                                   DTSBR308
00277  I1000-EXIT.                                                      DTSBR308
00278      EXIT.                                                        DTSBR308
00279      EJECT                                                        DTSBR308
00280  P1000-PROCESS.                                                   DTSBR308
00281                                                                   DTSBR308
00282      IF R308-EMP-STATUS NOT = WS-EMP-STATUS-HOLD                  DTSBR308
00283 *                                                                 DTSBR308
00284          IF WS-NUMBER-TWO = +0                                    DTSBR308
00285             MOVE +99 TO WS-NUMBER-TWO                             DTSBR308
00286          ELSE                                                     DTSBR308
00287             PERFORM  P3000-PRINT-FOOTER THRU P3000-EXIT           DTSBR308
00288             PERFORM  P4000-PRINT-FOOTER THRU P4000-EXIT           DTSBR308
00289             MOVE +60 TO WS-LINE-CNT2                              DTSBR308
00290          END-IF                                                   DTSBR308
00291 *                                                                 DTSBR308
00292          MOVE R308-EMP-STATUS TO WS-EMP-STATUS-HOLD               DTSBR308
00293          EVALUATE TRUE                                            DTSBR308
00294             WHEN R308-STATUS-ACT-88                               DTSBR308
00295                 MOVE 'ACTIVE' TO WS-HDR-EMP-STATUS-DSCR           DTSBR308
00296                                  WS-ESD-EMP-STATUS-DSCR           DTSBR308
00297                                  WS-ECD-EMP-STATUS-DSCR           DTSBR308
00298             WHEN R308-STATUS-INACT-88                             DTSBR308
00299                 MOVE 'INACTIVE' TO WS-HDR-EMP-STATUS-DSCR         DTSBR308
00300                                    WS-ESD-EMP-STATUS-DSCR         DTSBR308
00301                                    WS-ECD-EMP-STATUS-DSCR         DTSBR308
00302          END-EVALUATE.                                            DTSBR308
00303      SKIP1                                                        DTSBR308
00304      IF R308-EMP-CLASS NOT = WS-EMP-CLASS-HOLD                    DTSBR308
00305 *                                                                 DTSBR308
00306          IF WS-NUMBER-ONE = +0                                    DTSBR308
00307             MOVE +99 TO WS-NUMBER-ONE                             DTSBR308
00308          ELSE                                                     DTSBR308
00309             IF WS-ECD-FOOT-CNT NOT = +0                           DTSBR308
00310                   PERFORM  P3000-PRINT-FOOTER THRU P3000-EXIT     DTSBR308
00311                   MOVE +60 TO WS-LINE-CNT2                        DTSBR308
00312             END-IF                                                DTSBR308
00313          END-IF                                                   DTSBR308
00314 *                                                                 DTSBR308
00315          MOVE R308-EMP-CLASS TO WS-EMP-CLASS-HOLD                 DTSBR308
00316          EVALUATE TRUE                                            DTSBR308
00317 **          WHEN R308-CLASS-UNK-88                                DTSBR308
00318 **              MOVE 'UNKNOWN' TO WS-EMP-CLASS-DSCR               DTSBR308
00319             WHEN R308-CLASS-RATED-88                              DTSBR308
00320                 MOVE 'RATED' TO WS-HDR-EMP-CLASS-DSCR             DTSBR308
00321                                 WS-ECD-EMP-CLASS-DSCR             DTSBR308
00322             WHEN R308-CLASS-SELF-INS-88                           DTSBR308
00323                 MOVE 'SELF INSURED' TO WS-HDR-EMP-CLASS-DSCR      DTSBR308
00324                                        WS-ECD-EMP-CLASS-DSCR      DTSBR308
00325             WHEN OTHER                                            DTSBR308
00326                 MOVE 'UNKNOWN' TO WS-HDR-EMP-CLASS-DSCR           DTSBR308
00327                                   WS-ECD-EMP-CLASS-DSCR           DTSBR308
00328          END-EVALUATE.                                            DTSBR308
00329      SKIP1                                                        DTSBR308
00330      MOVE R308-INACT-DATE TO L001-FED-8-DATE-9.                   DTSBR308
00331      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR308
00332      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR308
00333      IF L001-INVALID-DATE                                         DTSBR308
00334          MOVE SPACES TO WS-INACT-DATE                             DTSBR308
00335      ELSE                                                         DTSBR308
00336          MOVE L001-SLASH-DATE  TO WS-INACT-DATE.                  DTSBR308
00337      MOVE R308-EMP-NO          TO WS-EMP-NO.                      DTSBR308
00338      MOVE R308-PRIMARY-NAME    TO WS-PRIMARY-NAME.                DTSBR308
00339      MOVE R308-TOT-CREDIT-AMT  TO WS-DTL-TOT-CREDIT-AMT.          DTSBR308
00340      MOVE R308-UC30-CREDIT-IND TO WS-UC30-CREDIT-IND.             DTSBR308
00341      MOVE R308-SUCCESSOR-IND   TO WS-SUCCESSOR-IND.               DTSBR308
00342      ADD R308-TOT-CREDIT-AMT   TO WS-FOOT-ONE-CREDIT-AMT .        DTSBR308
00343      ADD R308-TOT-CREDIT-AMT   TO WS-FOOT-TWO-CREDIT-AMT .        DTSBR308
00344      ADD R308-TOT-CREDIT-AMT   TO WS-FOOT-SUM-CREDIT-AMT.         DTSBR308
00345                                                                   DTSBR308
00346      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                  DTSBR308
00347      WRITE PRT-RECORD FROM DTL-LINE-2  AFTER 2.                   DTSBR308
00348      ADD +2    TO WS-LINE-CNT2.                                   DTSBR308
00349      ADD +1    TO WS-ECD-FOOT-CNT.                                DTSBR308
00350      ADD +1    TO WS-ESD-FOOT-CNT.                                DTSBR308
00351      ADD +1    TO WS-SUM-FOOT-CNT.                                DTSBR308
00352                                                                   DTSBR308
00353  P1000-EXIT.                                                      DTSBR308
00354      EXIT.                                                        DTSBR308
00355      EJECT                                                        DTSBR308
00356                                                                   DTSBR308
00357  P2000-PRINT-HEADER.                                              DTSBR308
00358      IF WS-LINE-CNT GREATER 58 OR                                 DTSBR308
00359           WS-LINE-CNT2 GREATER 58                                 DTSBR308
00360         MOVE +0          TO WS-LINE-CNT                           DTSBR308
00361         MOVE +0          TO WS-LINE-CNT2                          DTSBR308
00362         ADD  +1          TO WS-PAGE-CNT                           DTSBR308
00363         MOVE WS-PAGE-CNT TO HDR3-PAGE-CNT                         DTSBR308
00364         WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE          DTSBR308
00365         WRITE PRT-RECORD FROM HEADER-2 AFTER 1                    DTSBR308
00366         WRITE PRT-RECORD FROM HEADER-3 AFTER 1                    DTSBR308
00367         WRITE PRT-RECORD FROM HEADER-4 AFTER 1                    DTSBR308
00368 ***     WRITE PRT-RECORD FROM HEADER-5 AFTER 1                    DTSBR308
00369 ***     WRITE PRT-RECORD FROM HEADER-6 AFTER 1                    DTSBR308
00370         WRITE PRT-RECORD FROM HEADER-7 AFTER 1                    DTSBR308
00371         WRITE PRT-RECORD FROM HEADER-8 AFTER 1                    DTSBR308
00372         WRITE PRT-RECORD FROM HEADER-9 AFTER 1                    DTSBR308
00373         WRITE PRT-RECORD FROM HEADER-10 AFTER 1                   DTSBR308
00374         WRITE PRT-RECORD FROM HEADER-11 AFTER 1                   DTSBR308
00375         ADD +09   TO WS-LINE-CNT2.                                DTSBR308
00376  P2000-EXIT.                                                      DTSBR308
00377      EXIT.                                                        DTSBR308
00378                                                                   DTSBR308
00379  P3000-PRINT-FOOTER.                                              DTSBR308
00380      IF WS-LINE-CNT2 > 52                                         DTSBR308
00381         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                DTSBR308
00382      END-IF.                                                      DTSBR308
00383                                                                   DTSBR308
00384      MOVE WS-FOOT-ONE-CREDIT-AMT TO WS-ECD-TOT-CREDIT-AMT.        DTSBR308
00385      MOVE WS-ECD-FOOT-CNT   TO WS-ECD-FOOT-NUMBER.                DTSBR308
00386      WRITE PRT-RECORD FROM ECD-LINE-3 AFTER 3.                    DTSBR308
00387      WRITE PRT-RECORD FROM ECD-LINE-4 AFTER 1.                    DTSBR308
00388      WRITE PRT-RECORD FROM ECD-LINE-5 AFTER 1.                    DTSBR308
00389 *    ADD +60   TO WS-LINE-CNT2.                                   DTSBR308
00390      MOVE +0 TO WS-FOOT-ONE-CREDIT-AMT.                           DTSBR308
00391      MOVE +0 TO WS-ECD-FOOT-CNT.                                  DTSBR308
00392                                                                   DTSBR308
00393  P3000-EXIT.                                                      DTSBR308
00394      EXIT.                                                        DTSBR308
00395                                                                   DTSBR308
00396  P4000-PRINT-FOOTER.                                              DTSBR308
00397      IF WS-LINE-CNT2 > 52                                         DTSBR308
00398         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                DTSBR308
00399      END-IF.                                                      DTSBR308
00400                                                                   DTSBR308
00401      MOVE WS-FOOT-TWO-CREDIT-AMT TO WS-ESD-TOT-CREDIT-AMT.        DTSBR308
00402      MOVE WS-ESD-FOOT-CNT    TO WS-ESD-FOOT-NUMBER.               DTSBR308
00403      WRITE PRT-RECORD FROM ESD-LINE-4 AFTER 4.                    DTSBR308
00404      WRITE PRT-RECORD FROM ESD-LINE-5 AFTER 1.                    DTSBR308
00405      WRITE PRT-RECORD FROM ESD-LINE-6 AFTER 1.                    DTSBR308
00406 *    ADD +60   TO WS-LINE-CNT2.                                   DTSBR308
00407      MOVE +0 TO WS-FOOT-TWO-CREDIT-AMT.                           DTSBR308
00408      MOVE +0 TO WS-ESD-FOOT-CNT.                                  DTSBR308
00409                                                                   DTSBR308
00410  P4000-EXIT.                                                      DTSBR308
00411      EXIT.                                                        DTSBR308
00412                                                                   DTSBR308
00413  T1000-TERMINATE.                                                 DTSBR308
00414                                                                   DTSBR308
00415      IF WS-LINE-CNT2 > 52                                         DTSBR308
00416         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                DTSBR308
00417      END-IF.                                                      DTSBR308
00418                                                                   DTSBR308
00419      PERFORM  P3000-PRINT-FOOTER THRU P3000-EXIT.                 DTSBR308
00420      PERFORM  P4000-PRINT-FOOTER THRU P4000-EXIT.                 DTSBR308
00421      MOVE WS-FOOT-SUM-CREDIT-AMT TO WS-SUM-TOT-CREDIT-AMT.        DTSBR308
00422      MOVE WS-SUM-FOOT-CNT    TO WS-SUM-FOOT-NUMBER.               DTSBR308
00423      WRITE PRT-RECORD FROM SUM-LINE-4 AFTER 4.                    DTSBR308
00424      WRITE PRT-RECORD FROM SUM-LINE-5 AFTER 1.                    DTSBR308
00425      WRITE PRT-RECORD FROM SUM-LINE-6 AFTER 1.                    DTSBR308
00426                                                                   DTSBR308
00427      CLOSE PRT-FILE.                                              DTSBR308
00428                                                                   DTSBR308
00429  T1000-EXIT.                                                      DTSBR308
00430      EXIT.                                                        DTSBR308
00431      EJECT                                                        DTSBR308
00432  S001-DATE.                                                       DTSBR308
00433      SKIP1                                                        DTSBR308
00434      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR308
00435      SKIP2                                                        DTSBR308
00436  S001-EXIT.                                                       DTSBR308
00437      EXIT.                                                        DTSBR308
00438                                                                   DTSBR308
00439 ***S999-ABEND.                                                    DTSBR308
00440 ***     SKIP1                                                     DTSBR308
00441 ***     CALL 'DTSBU999' USING WRK-ABEND-CD.                       DTSBR308
00442 ***     SKIP2                                                     DTSBR308
00443 *** S999-EXIT.                                                    DTSBR308
00444 ***     EXIT.                                                     DTSBR308
00445                                                                   DTSBR308
