00001  IDENTIFICATION DIVISION.                                         02/25/00
00002  PROGRAM-ID.             DTSBR426.                                DTSBR426
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV059
00004  DATE-WRITTEN.           JANUARY 1995.                            DTSBR426
00005                          MODIFIED BY TRW JAN 1999.                   CL**2
00006  DATE-COMPILED.                                                   DTSBR426
00007      SKIP3                                                        DTSBR426
00008 *****                                                             DTSBR426
00009 *                                                                 DTSBR426
00010 *    CALLING SEQUENCE:  DTSBD400 CALLS                               CL**2
00011 *                       DTSBE426 WHICH CREATES DTSIR426 RECORDS      CL**2
00012 *                       DTSBD800 CALLS                               CL**2
00013 *                       DTSBR426 WHICH READS DTSIR426 RECORDS        CL**2
00014 *                                                                    CL**2
00015 *    FUNCTION:  COLLECTIONS SUMMARY REPORT.                       DTSBR426
00016 *                                                                 DTSBR426
00017 *                                                                 DTSBR426
00018 *    MODIFICATION HISTORY:                                        DTSBR426
00019 *                                                                 DTSBR426
00020 * 01-12-95 INITIAL DEVELOPMENT                                    DTSBR426
00021 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - RHC  DTSBR426
00022 *                                                                 DTSBR426
00023 * 03-25-95 ADDED CODE TO PRODUCE A SEPARATE TOTAL PAGE FOR        DTSBR426
00024 *          THE TAX ACCOUNTING UNIT.                               DTSBR426
00025 *          REFERENCE RFP #                AUTHOR OF CHANGE - EHH  DTSBR426
00026 *                                                                 DTSBR426
00027 * 03-29-95 MODIFY FOR DUPLEX.                                     DTSBR426
00028 *          REFERENCE RFP #CR056           AUTHOR OF CHANGE - RHC  DTSBR426
00029 *                                                                 DTSBR426
00030 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR426
00031 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR426
00032 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR426
00033 *                                                                 DTSBR426
00034 *                                                                 DTSBR426
00035 *    DESCRIPTION:                                                 DTSBR426
00036 *                                                                 DTSBR426
00037 *        THIS MODULE PRODUCES THE COLLECTIONS SUMMARY REPORT.     DTSBR426
00038 *                                                                 DTSBR426
00039 *                                                                 DTSBR426
00040 *    RECORDS READ:                                                DTSBR426
00041 *                                                                 DTSBR426
00042 *        NONE.                                                    DTSBR426
00043 *                                                                 DTSBR426
00044 *                                                                 DTSBR426
00045 *    PRINTED OUTPUTS:                                             DTSBR426
00046 *                                                                 DTSBR426
00047 *        426R1  COLLECTIONS SUMMARY REPORT                        DTSBR426
00048 *                                                                 DTSBR426
00049 *                                                                 DTSBR426
00050 *    RECORDS WRITTEN:                                             DTSBR426
00051 *                                                                 DTSBR426
00052 *        NONE.                                                    DTSBR426
00053 *                                                                 DTSBR426
00054 *                                                                 DTSBR426
00055 *    MODULES CALLED:                                              DTSBR426
00056 *                                                                 DTSBR426
00057 *        DTSBU001  DATE CONVERT.                                     CL**2
00058 *        DTSBU062  FIELD REP NAME.                                   CL**2
00059 *                                                                 DTSBR426
00060 *                                                                 DTSBR426
00061 *****                                                             DTSBR426
00062      EJECT                                                        DTSBR426
00063  ENVIRONMENT DIVISION.                                            DTSBR426
00064  CONFIGURATION SECTION.                                              CL*16
00065  SPECIAL-NAMES.                                                      CL*16
00066      C01 IS TOP-OF-PAGE.                                             CL*16
00067  INPUT-OUTPUT SECTION.                                            DTSBR426
00068  FILE-CONTROL.                                                    DTSBR426
00069      SELECT PRT-FILE   ASSIGN TO RPT426R1.                           CL*32
00070      SKIP3                                                        DTSBR426
00071  DATA DIVISION.                                                   DTSBR426
00072  FILE SECTION.                                                    DTSBR426
00073                                                                   DTSBR426
00074  FD  PRT-FILE                                                        CL**9
00075      RECORDING MODE IS F.                                            CL*29
00076  01  PRT-RECORD              PIC X(133).                             CL**9
00077      SKIP3                                                        DTSBR426
00078      EJECT                                                        DTSBR426
00079  WORKING-STORAGE SECTION.                                         DTSBR426
000795 77  PAN-VALET PICTURE X(24) VALUE '059DTSBR426  02/25/00'.       DTSBR426
00080      SKIP3                                                        DTSBR426
00081  01  WRK-AREA.                                                    DTSBR426
00082      05 WRK-ABEND-CD              PIC S9(04)  COMP  VALUE +426.      CL*54
00083      05 WRK-PAGE                  PIC S9(03)  COMP  VALUE +0.        CL*54
00084      05 FIRST-TIME-IND            PIC  X(01)  VALUE 'Y'.             CL*54
00085      SKIP3                                                        DTSBR426
00086      05 WRK-CNT                   PIC S9(04)  COMP  VALUE +0.        CL*54
00087      05 WRK-CAT                   PIC S9(04)  COMP  VALUE +0.        CL*54
00088      05 WRK-ACCT                  PIC S9(04)  COMP  VALUE +0.        CL*54
00089                                                                   DTSBR426
00090      05 WRK-COMPUTATION-DATE      PIC  X(08)  VALUE SPACE.           CL*54
00091      05 WRK-TYPES                 PIC  X(08)  VALUE SPACE.           CL*54
00092      05 WRK-FLD-REP-ID-NAME.                                         CL*54
00093         10 WRK-FLD-REP-ID         PIC  X(03)  VALUE SPACE.           CL*54
00094         10 WRK-FLD-REP-NAME       PIC  X(32)  VALUE SPACE.           CL*54
00095      SKIP3                                                        DTSBR426
00096      05 WRK-TBL-1.                                                   CL*54
00097         10 FILLER.                                                   CL*54
00098            15 FILLER     PIC  X(18)  VALUE ' FIELD ASSIGNMENT'.      CL*54
00099            15 FILLER     PIC  X(099) VALUE ALL '-'.                  CL*54
00100         10 FILLER.                                                   CL*54
00101            15 FILLER     PIC  X(18)  VALUE ' BANKRUPT'.              CL*54
00102            15 FILLER     PIC  X(099) VALUE ALL '-'.                  CL*54
00103         10 FILLER.                                                   CL*54
00104            15 FILLER     PIC  X(18)  VALUE ' NOT BANKRUPT'.          CL*54
00105            15 FILLER     PIC  X(099) VALUE ALL '-'.                  CL*54
00106         10 FILLER.                                                   CL*54
00107            15 FILLER     PIC  X(18)  VALUE ' FIELD REP TOTALS'.      CL*54
00108            15 FILLER     PIC  X(099) VALUE ALL '-'.                  CL*54
00109      05 FILLER   REDEFINES WRK-TBL-1 OCCURS 4 TIMES.                 CL*54
00110         10 WRK-CAT-LABEL.                                            CL*54
00111            15 FILLER                 PIC X(01).                      CL*54
00112            15 WRK-CAT-LITERAL        PIC X(17).                      CL*54
00113            15 FILLER                 PIC X(099).                     CL*58
00114      SKIP3                                                        DTSBR426
00115      05 WRK-ROW-TOT                  PIC S9(04) COMP VALUE +4.       CL*54
00116      05 WRK-COL-TOT                  PIC S9(04) COMP VALUE +5.       CL*54
00117      05 WRK-TBL-2.                                                   CL*54
00118         15 WRK-CATEGORY       OCCURS 4.                              CL*54
00119            20 WRK-COLUMN      OCCURS 5.                              CL*54
00120               25 WRK-LIENED        PIC S9(09)V9(02) COMP VALUE +0.   CL*59
00121               25 WRK-NOT-LIENED    PIC S9(09)V9(02) COMP VALUE +0.   CL*59
00122               25 WRK-TOTAL         PIC S9(09)V9(02) COMP VALUE +0.   CL*59
00123               25 WRK-NBR-ACCTS     PIC S9(05) COMP  VALUE +0.        CL*59
00124      05 WRK-TBL-TOT.                                                 CL*54
00125         15 WRK-CATEGORY-TOT    OCCURS 4.                             CL*54
00126            20 WRK-COLUMN-TOT   OCCURS 5.                             CL*54
00127               25 WRK-LIENED-TOT    PIC S9(09)V9(02) COMP VALUE +0.   CL*59
00128               25 WRK-NOT-LIENED-TOT  PIC S9(09)V99 COMP VALUE +0.    CL*59
00129               25 WRK-TOTAL-TOT     PIC S9(09)V9(02) COMP VALUE +0.   CL*59
00130               25 WRK-NBR-ACCTS-TOT   PIC S9(05) COMP  VALUE +0.      CL*58
00131                                                                      CL*29
00132  01  HEADER-1.                                                       CL*29
00133      05 FILLER                       PIC X(01) VALUE SPACES.         CL*54
00134      05 FILLER                       PIC X(34) VALUE '426R1'.        CL*54
00135      05 HDR1-LRCM-AGY-NAME-LINE1     PIC X(75).                      CL*54
00136      05 FILLER                       PIC X(06) VALUE 'DATE:'.        CL*54
00137      05 HDR1-LRCM-SYS-DATE           PIC X(08).                      CL*54
00138                                                                      CL*29
00139  01  HEADER-2.                                                       CL*29
00140      05 FILLER                       PIC X(35) VALUE SPACES.         CL*54
00141      05 HDR2-LRCM-AGY-NAME-LINE2     PIC X(75).                      CL*54
00142      05 FILLER                       PIC X(06) VALUE 'TIME:'.        CL*54
00143      05 HDR2-LRCM-SYS-TIME           PIC X(08).                      CL*54
00144                                                                      CL*29
00145  01  HEADER-3.                                                       CL*29
00146      05 FILLER                       PIC X(01) VALUE SPACES.         CL*54
00147      05 FILLER                       PIC X(38)                       CL*54
00148                 VALUE 'ROUTE TO:  ENFORCEMENT UNIT'.                 CL*29
00149      05 HDR3-LITERAL                 PIC X(71)                       CL*54
00150                 VALUE '        COLLECTIONS SUMMARY REPORT'.          CL*29
00151      05 FILLER                       PIC X(06) VALUE 'PAGE:'.        CL*54
00152      05 HDR3-PAGE                    PIC ZZ,ZZ9.                     CL*54
00153                                                                      CL*29
00154  01  HEADER-4.                                                       CL*29
00155      05 FILLER                       PIC X(01) VALUE SPACES.         CL*54
00156      05 FILLER                       PIC X(22)                       CL*54
00157                 VALUE 'COMPUTATION DATE:'.                           CL*29
00158      05 HDR4-WRK-COMPUTATION-DATE    PIC X(08).                      CL*54
00159                                                                      CL*29
00160  01  HEADER-5.                                                       CL*29
00161      05 FILLER                       PIC X(01) VALUE SPACES.         CL*54
00162      05 FILLER                       PIC X(22)                       CL*54
00163                 VALUE 'A/R FLD ASSIGN TYPES:'.                       CL*29
00164      05 HDR5-WRK-TYPES               PIC X(08).                      CL*54
00165                                                                      CL*29
00166  01  HEADER-6.                                                       CL*29
00167      05 FILLER                       PIC X(01) VALUE SPACES.         CL*54
00168      05 FILLER                       PIC X(19)                       CL*54
00169                 VALUE 'FIELD REP:'.                                  CL*29
00170      05 HDR6-WRK-FLD-REP-ID          PIC X(05).                      CL*54
00171      05 HDR6-WRK-FLD-REP-NAME        PIC X(32).                      CL*54
00172                                                                      CL*29
00173  01  HEADER-7.                                                       CL*29
00174      05 FILLER                       PIC X(39) VALUE SPACES.         CL*54
00175      05 FILLER                       PIC X(17)                       CL*54
00176                 VALUE 'UI DUE'.                                      CL*29
00177      05 FILLER                       PIC X(18)                       CL*54
00178                 VALUE 'SUR DUE'.                                     CL*29
00179      05 FILLER                       PIC X(18)                       CL*54
00180                 VALUE 'PEN DUE'.                                     CL*29
00181      05 FILLER                       PIC X(20)                       CL*54
00182                 VALUE 'INT DUE'.                                     CL*29
00183      05 FILLER                       PIC X(05)                       CL*54
00184                 VALUE 'TOTAL'.                                       CL*29
00185                                                                      CL*29
00186  01  DETAIL-LINE-1.                                                  CL*29
00187      05 FILLER                       PIC X(07) VALUE SPACES.         CL*54
00188      05 DTL1-LITERAL                 PIC X(23) VALUE SPACES.         CL*54
00189      05 FILLER OCCURS 5 TIMES.                                       CL*54
00190         10 DTL1-AMOUNT               PIC ----,---,--9.99.            CL*54
00191         10 FILLER                    PIC X(03) VALUE SPACES.         CL*54
00192                                                                      CL*29
00193  01  DETAIL-LINE-2.                                                  CL*29
00194      05 FILLER                       PIC X(07) VALUE SPACES.         CL*54
00195      05 DTL2-LITERAL                 PIC X(31) VALUE SPACES.         CL*54
00196      05 FILLER OCCURS 5 TIMES.                                       CL*54
00197         10 DTL2-AMOUNT               PIC ZZZ,ZZ9.                    CL*54
00198         10 FILLER                    PIC X(11) VALUE SPACES.         CL*54
00199      EJECT                                                           CL*29
00200  01  CACT-CONSTANTS-AREA.                                         DTSBR426
00201  ++INCLUDE DTSICACT                                                  CL**2
00202      EJECT                                                        DTSBR426
00203  01  L001-LINK-AREA.                                              DTSBR426
00204  ++INCLUDE DTSIL001                                                  CL**2
00205      EJECT                                                        DTSBR426
00206  01  L062-LINK-AREA.                                              DTSBR426
00207  ++INCLUDE DTSIL062                                                  CL**2
00208      EJECT                                                        DTSBR426
00209  LINKAGE SECTION.                                                 DTSBR426
00210      SKIP3                                                        DTSBR426
00211  01  LRCM-LINK-AREA.                                              DTSBR426
00212  ++INCLUDE DTSILRCM                                                  CL**2
00213      EJECT                                                        DTSBR426
00214  01  R426-REC.                                                    DTSBR426
00215  ++INCLUDE DTSIR426                                                  CL**2
00216      EJECT                                                        DTSBR426
00217  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR426
00218                           R426-REC.                               DTSBR426
00219                                                                      CL*14
00220      IF FIRST-TIME-IND = 'Y'                                      DTSBR426
00221         MOVE 'N' TO FIRST-TIME-IND                                   CL*54
00222         PERFORM I1000-INITIATE                                       CL*54
00223            THRU I1000-EXIT.                                          CL*54
00224                                                                   DTSBR426
00225      IF LRCM-EOR-88                                               DTSBR426
00226          PERFORM T1000-TERMINATE                                     CL*54
00227            THRU T1000-EXIT                                           CL*54
00228      ELSE                                                         DTSBR426
00229          PERFORM P1000-PROCESS                                       CL*54
00230             THRU P1000-EXIT.                                         CL*54
00231                                                                      CL*54
00232      GOBACK.                                                      DTSBR426
00233      EJECT                                                        DTSBR426
00234  I1000-INITIATE.                                                  DTSBR426
00235                                                                   DTSBR426
00236      OPEN OUTPUT PRT-FILE.                                           CL*33
00237      MOVE LOW-VALUES      TO WRK-TBL-TOT.                            CL*36
00238      MOVE R426-COMP-DATE  TO L001-FED-8-DATE-9.                      CL*30
00239      PERFORM S001-FROM-FED-8                                         CL*54
00240         THRU S001-EXIT.                                              CL*54
00241      MOVE L001-SLASH-DATE TO WRK-COMPUTATION-DATE.                DTSBR426
00242      SKIP3                                                        DTSBR426
00243      IF R426-FLD-TYPE-CNT < 0 OR > 3                              DTSBR426
00244          MOVE 'ERROR'                       TO WRK-TYPES             CL*54
00245      ELSE                                                         DTSBR426
00246          IF R426-FLD-TYPE-CNT = 0                                 DTSBR426
00247              MOVE 'NONE'                    TO WRK-TYPES             CL*54
00248          ELSE                                                     DTSBR426
00249              MOVE R426-FLD-TYPE (1)         TO WRK-TYPES             CL*54
00250              IF R426-FLD-TYPE-CNT > 1                             DTSBR426
00251                  MOVE ','                   TO WRK-TYPES (3:1)       CL*54
00252                  MOVE R426-FLD-TYPE (2)     TO WRK-TYPES (4:2)       CL*54
00253                  IF R426-FLD-TYPE-CNT > 2                         DTSBR426
00254                      MOVE ','               TO WRK-TYPES (6:1)       CL*54
00255                      MOVE R426-FLD-TYPE (3) TO WRK-TYPES (7:2).   DTSBR426
00256                                                                      CL*27
00257      MOVE LRCM-AGY-NAME-LINE1  TO HDR1-LRCM-AGY-NAME-LINE1.          CL*31
00258      MOVE LRCM-SYS-DATE        TO HDR1-LRCM-SYS-DATE.                CL*30
00259      MOVE LRCM-AGY-NAME-LINE2  TO HDR2-LRCM-AGY-NAME-LINE2           CL*30
00260      MOVE LRCM-SYS-TIME        TO HDR2-LRCM-SYS-TIME.                CL*30
00261      MOVE WRK-COMPUTATION-DATE TO HDR4-WRK-COMPUTATION-DATE.         CL*27
00262      MOVE WRK-TYPES            TO HDR5-WRK-TYPES.                    CL*27
00263                                                                      CL*27
00264      MOVE R426-FIELD-REP-ID    TO WRK-FLD-REP-ID                     CL*54
00265                                   L062-FLD-REP-ID.                   CL*54
00266      PERFORM S062-FLD-REP                                            CL*54
00267         THRU S062-EXIT.                                              CL*54
00268      MOVE L062-NAME            TO WRK-FLD-REP-NAME.                  CL*54
00269                                                                      CL*28
00270      PERFORM S2000-NEW-REP                                           CL*54
00271         THRU S2000-EXIT.                                             CL*54
00272                                                                   DTSBR426
00273  I1000-EXIT.                                                      DTSBR426
00274      EXIT.                                                        DTSBR426
00275      EJECT                                                        DTSBR426
00276  P1000-PROCESS.                                                   DTSBR426
00277                                                                   DTSBR426
00278      IF R426-FIELD-REP-ID NOT = WRK-FLD-REP-ID                    DTSBR426
00279          PERFORM S1000-PRINT-DETAIL                                  CL*54
00280             THRU S1000-EXIT                                          CL*54
00281               VARYING WRK-CNT FROM 1 BY 1                            CL*54
00282                 UNTIL WRK-CNT > 4                                    CL*54
00283          MOVE R426-FIELD-REP-ID TO WRK-FLD-REP-ID                    CL*28
00284                                    L062-FLD-REP-ID                   CL*28
00285          PERFORM S062-FLD-REP                                        CL*54
00286             THRU S062-EXIT                                           CL*54
00287          MOVE L062-NAME         TO WRK-FLD-REP-NAME                  CL*52
00288          MOVE ZEROS TO WRK-PAGE                                      CL*53
00289          PERFORM S2000-NEW-REP                                       CL*54
00290             THRU S2000-EXIT                                          CL*54
00291          MOVE LOW-VALUES TO WRK-TBL-2.                               CL*36
00292                                                                      CL*27
00293      IF R426-CATEGORY < '1' OR > '3'                              DTSBR426
00294          PERFORM S999-ABEND                                          CL*54
00295             THRU S999-EXIT                                           CL*54
00296      ELSE                                                         DTSBR426
00297          MOVE R426-CATEGORY-9 TO WRK-CAT.                         DTSBR426
00298                                                                   DTSBR426
00299      PERFORM P1100-ACCT-LOOP                                         CL*54
00300         THRU P1100-EXIT.                                             CL*54
00301                                                                   DTSBR426
00302  P1000-EXIT.                                                      DTSBR426
00303      EXIT.                                                        DTSBR426
00304      EJECT                                                        DTSBR426
00305  P1100-ACCT-LOOP.                                                 DTSBR426
00306      PERFORM                                                         CL*54
00307        VARYING WRK-CNT FROM 1 BY 1                                   CL*54
00308          UNTIL WRK-CNT > R426-ACCT-CNT                               CL*54
00309            PERFORM P1110-SET-WRK-ACCT                                CL*54
00310               THRU P1110-EXIT                                        CL*54
00311            ADD R426-LIENED-BAL-AMT (WRK-CNT) TO                      CL*46
00312                     WRK-LIENED     (WRK-CAT, WRK-ACCT)               CL*46
00313                     WRK-LIENED     (WRK-CAT, WRK-COL-TOT)            CL*46
00314                     WRK-LIENED     (WRK-ROW-TOT, WRK-ACCT)           CL*46
00315                     WRK-LIENED     (WRK-ROW-TOT, WRK-COL-TOT)        CL*46
00316                     WRK-TOTAL      (WRK-CAT, WRK-ACCT)               CL*46
00317                     WRK-TOTAL      (WRK-CAT, WRK-COL-TOT)            CL*46
00318                     WRK-TOTAL      (WRK-ROW-TOT, WRK-ACCT)           CL*46
00319                     WRK-TOTAL      (WRK-ROW-TOT, WRK-COL-TOT)        CL*46
00320                     WRK-LIENED-TOT (WRK-CAT, WRK-ACCT)               CL*46
00321                     WRK-LIENED-TOT (WRK-CAT, WRK-COL-TOT)            CL*46
00322                     WRK-LIENED-TOT (WRK-ROW-TOT, WRK-ACCT)           CL*46
00323                     WRK-LIENED-TOT (WRK-ROW-TOT, WRK-COL-TOT)        CL*46
00324                     WRK-TOTAL-TOT  (WRK-CAT, WRK-ACCT)               CL*46
00325                     WRK-TOTAL-TOT  (WRK-CAT, WRK-COL-TOT)            CL*46
00326                     WRK-TOTAL-TOT  (WRK-ROW-TOT, WRK-ACCT)           CL*46
00327                     WRK-TOTAL-TOT  (WRK-ROW-TOT, WRK-COL-TOT)        CL*46
00328            ADD R426-NOT-LIENED-BAL-AMT (WRK-CNT) TO                  CL*46
00329                     WRK-NOT-LIENED     (WRK-CAT, WRK-ACCT)           CL*46
00330                     WRK-NOT-LIENED     (WRK-CAT, WRK-COL-TOT)        CL*46
00331                     WRK-NOT-LIENED     (WRK-ROW-TOT, WRK-ACCT)       CL*46
00332                     WRK-NOT-LIENED     (WRK-ROW-TOT, WRK-COL-TOT)    CL*46
00333                     WRK-TOTAL          (WRK-CAT, WRK-ACCT)           CL*46
00334                     WRK-TOTAL          (WRK-CAT, WRK-COL-TOT)        CL*46
00335                     WRK-TOTAL          (WRK-ROW-TOT, WRK-ACCT)       CL*46
00336                     WRK-TOTAL          (WRK-ROW-TOT, WRK-COL-TOT)    CL*46
00337                     WRK-NOT-LIENED-TOT (WRK-CAT, WRK-ACCT)           CL*46
00338                     WRK-NOT-LIENED-TOT (WRK-CAT, WRK-COL-TOT)        CL*46
00339                     WRK-NOT-LIENED-TOT (WRK-ROW-TOT, WRK-ACCT)       CL*46
00340                     WRK-NOT-LIENED-TOT (WRK-ROW-TOT, WRK-COL-TOT)    CL*46
00341                     WRK-TOTAL-TOT      (WRK-CAT, WRK-ACCT)           CL*46
00342                     WRK-TOTAL-TOT      (WRK-CAT, WRK-COL-TOT)        CL*46
00343                     WRK-TOTAL-TOT      (WRK-ROW-TOT, WRK-ACCT)       CL*46
00344                     WRK-TOTAL-TOT      (WRK-ROW-TOT, WRK-COL-TOT)    CL*46
00345            ADD +1 TO WRK-NBR-ACCTS     (WRK-CAT, WRK-ACCT)           CL*48
00346                      WRK-NBR-ACCTS     (WRK-CAT, WRK-COL-TOT)        CL*48
00347                      WRK-NBR-ACCTS     (WRK-ROW-TOT, WRK-ACCT)       CL*48
00348                      WRK-NBR-ACCTS     (WRK-ROW-TOT, WRK-COL-TOT)    CL*48
00349                      WRK-NBR-ACCTS-TOT (WRK-CAT, WRK-ACCT)           CL*48
00350                      WRK-NBR-ACCTS-TOT (WRK-CAT, WRK-COL-TOT)        CL*48
00351                      WRK-NBR-ACCTS-TOT (WRK-ROW-TOT, WRK-ACCT)       CL*48
00352                      WRK-NBR-ACCTS-TOT (WRK-ROW-TOT, WRK-COL-TOT)    CL*48
00353      END-PERFORM.                                                 DTSBR426
00354                                                                   DTSBR426
00355  P1100-EXIT.                                                      DTSBR426
00356      EXIT.                                                        DTSBR426
00357                                                                      CL*19
00358  P1110-SET-WRK-ACCT.                                                 CL*20
00359      IF R426-ACCT-IND (WRK-CNT) = 'UI'                               CL*54
00360         MOVE 1 TO WRK-ACCT                                           CL*21
00361      ELSE                                                            CL*19
00362         IF R426-ACCT-IND (WRK-CNT) = 'SU'                            CL*54
00363            MOVE 2 TO WRK-ACCT                                        CL*54
00364         ELSE                                                         CL*54
00365            IF R426-ACCT-IND (WRK-CNT) = 'LP'                         CL*54
00366               MOVE 3 TO WRK-ACCT                                     CL*54
00367            ELSE                                                      CL*54
00368               IF R426-ACCT-IND (WRK-CNT) = 'I '                      CL*54
00369                  MOVE 4 TO WRK-ACCT                                  CL*54
00370               ELSE                                                   CL*54
00371                  PERFORM S999-ABEND                                  CL*54
00372                     THRU S999-EXIT.                                  CL*54
00373                                                                      CL*19
00374  P1110-EXIT.                                                         CL*19
00375      EXIT.                                                           CL*19
00376      EJECT                                                        DTSBR426
00377  S001-FROM-FED-8.                                                 DTSBR426
00378                                                                   DTSBR426
00379      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR426
00380                                                                   DTSBR426
00381      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00382                                                                   DTSBR426
00383  S001-EXIT.                                                       DTSBR426
00384      EXIT.                                                        DTSBR426
00385      SKIP3                                                        DTSBR426
00386  S062-FLD-REP.                                                    DTSBR426
00387                                                                   DTSBR426
00388      CALL 'DTSBU062' USING L062-LINK-AREA.                           CL**2
00389                                                                   DTSBR426
00390  S062-EXIT.                                                       DTSBR426
00391      EXIT.                                                        DTSBR426
00392      SKIP3                                                        DTSBR426
00393  S999-ABEND.                                                      DTSBR426
00394                                                                   DTSBR426
00395      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00396                                                                   DTSBR426
00397  S999-EXIT.                                                       DTSBR426
00398      EXIT.                                                        DTSBR426
00399      EJECT                                                        DTSBR426
00400  S1000-PRINT-DETAIL.                                                 CL*14
00401      WRITE PRT-RECORD FROM WRK-CAT-LABEL (WRK-CNT) AFTER 2.          CL*24
00402                                                                      CL*54
00403      MOVE '    $ LIENED:' TO DTL1-LITERAL.                           CL*25
00404      PERFORM S1100-SET-LIENED                                        CL*54
00405         THRU S1100-EXIT                                              CL*54
00406           VARYING WRK-ACCT FROM 1 BY 1                               CL*54
00407             UNTIL WRK-ACCT > 5.                                      CL*54
00408      WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 2.                    CL*24
00409                                                                      CL*24
00410      MOVE '$ NOT LIENED:' TO DTL1-LITERAL.                           CL*25
00411      PERFORM S1110-SET-NOT-LIENED                                    CL*54
00412         THRU S1110-EXIT                                              CL*54
00413           VARYING WRK-ACCT FROM 1 BY 1                               CL*54
00414             UNTIL WRK-ACCT > 5.                                      CL*54
00415      WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 1.                    CL*25
00416                                                                      CL*25
00417      MOVE '     $ TOTAL:' TO DTL1-LITERAL.                           CL*25
00418      PERFORM S1120-SET-TOTAL                                         CL*54
00419         THRU S1120-EXIT                                              CL*54
00420           VARYING WRK-ACCT FROM 1 BY 1                               CL*54
00421             UNTIL WRK-ACCT > 5.                                      CL*54
00422      WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 2.                    CL*25
00423                                                                      CL*25
00424      MOVE 'NUMBER OF ACCOUNTS:' TO DTL2-LITERAL.                     CL*41
00425      PERFORM S1130-SET-NBR-ACCTS                                     CL*54
00426         THRU S1130-EXIT                                              CL*54
00427           VARYING WRK-ACCT FROM 1 BY 1                               CL*54
00428             UNTIL WRK-ACCT > 5.                                      CL*54
00429      WRITE PRT-RECORD FROM DETAIL-LINE-2 AFTER 2.                    CL*26
00430                                                                      CL*25
00431  S1000-EXIT.                                                      DTSBR426
00432      EXIT.                                                        DTSBR426
00433      SKIP3                                                        DTSBR426
00434  S1100-SET-LIENED.                                                   CL*26
00435      MOVE WRK-LIENED  (WRK-CNT, WRK-ACCT)                            CL*54
00436        TO DTL1-AMOUNT (WRK-ACCT).                                    CL*54
00437  S1100-EXIT.                                                         CL*26
00438      EXIT.                                                           CL*26
00439      SKIP3                                                           CL*26
00440  S1110-SET-NOT-LIENED.                                               CL*26
00441      MOVE WRK-NOT-LIENED (WRK-CNT, WRK-ACCT)                         CL*54
00442        TO DTL1-AMOUNT    (WRK-ACCT).                                 CL*54
00443  S1110-EXIT.                                                         CL*26
00444      EXIT.                                                           CL*26
00445      SKIP3                                                           CL*26
00446  S1120-SET-TOTAL.                                                    CL*26
00447      MOVE WRK-TOTAL   (WRK-CNT, WRK-ACCT)                            CL*54
00448        TO DTL1-AMOUNT (WRK-ACCT).                                    CL*54
00449  S1120-EXIT.                                                         CL*26
00450      EXIT.                                                           CL*26
00451      SKIP3                                                           CL*26
00452  S1130-SET-NBR-ACCTS.                                                CL*26
00453      MOVE WRK-NBR-ACCTS (WRK-CNT, WRK-ACCT)                          CL*54
00454        TO DTL2-AMOUNT   (WRK-ACCT).                                  CL*54
00455  S1130-EXIT.                                                         CL*26
00456      EXIT.                                                           CL*26
00457      SKIP3                                                           CL*26
00458  S2000-NEW-REP.                                                   DTSBR426
00459                                                                   DTSBR426
00460      ADD 1                     TO WRK-PAGE.                          CL*26
00461                                                                      CL*27
00462      WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE.               CL*26
00463                                                                      CL*26
00464      WRITE PRT-RECORD FROM HEADER-2 AFTER 1.                         CL*16
00465                                                                      CL*16
00466      MOVE WRK-PAGE TO HDR3-PAGE.                                     CL*28
00467      WRITE PRT-RECORD FROM HEADER-3 AFTER 1.                         CL*16
00468                                                                      CL*16
00469      WRITE PRT-RECORD FROM HEADER-4 AFTER 2.                         CL*16
00470                                                                      CL*16
00471      WRITE PRT-RECORD FROM HEADER-5 AFTER 1.                         CL*16
00472                                                                      CL*16
00473      MOVE WRK-FLD-REP-ID   TO HDR6-WRK-FLD-REP-ID.                   CL*51
00474      MOVE WRK-FLD-REP-NAME TO HDR6-WRK-FLD-REP-NAME.                 CL*51
00475      WRITE PRT-RECORD FROM HEADER-6 AFTER 1.                         CL*16
00476                                                                      CL*16
00477      WRITE PRT-RECORD FROM HEADER-7 AFTER 2.                         CL*16
00478                                                                      CL*20
00479  S2000-EXIT.                                                      DTSBR426
00480      EXIT.                                                        DTSBR426
00481      SKIP3                                                        DTSBR426
00482  T1000-TERMINATE.                                                    CL*23
00483      PERFORM S1000-PRINT-DETAIL                                      CL*54
00484         THRU S1000-EXIT                                              CL*54
00485           VARYING WRK-CNT FROM 1 BY 1                                CL*54
00486             UNTIL WRK-CNT > 4.                                       CL*54
00487                                                                      CL*23
00488      MOVE 'COLLECTION SUMMARY REPORT  - GRAND TOTALS'                CL*54
00489                          TO HDR3-LITERAL.                            CL*54
00490      MOVE 'ALL'          TO WRK-FLD-REP-ID.                          CL*31
00491      MOVE SPACE          TO WRK-FLD-REP-NAME.                        CL*31
00492      MOVE 'GRAND TOTALS' TO WRK-CAT-LITERAL (4).                     CL*31
00493                                                                      CL*23
00494      PERFORM S2000-NEW-REP                                           CL*54
00495         THRU S2000-EXIT.                                             CL*54
00496      MOVE WRK-TBL-TOT TO WRK-TBL-2.                                  CL*28
00497      PERFORM S1000-PRINT-DETAIL                                      CL*54
00498         THRU S1000-EXIT                                              CL*54
00499           VARYING WRK-CNT FROM 1 BY 1                                CL*54
00500             UNTIL WRK-CNT > 4.                                       CL*54
00501                                                                      CL*23
00502      CLOSE PRT-FILE.                                                 CL*23
00503                                                                      CL*23
00504  T1000-EXIT.                                                         CL*23
00505      EXIT.                                                           CL*23
