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