00001  IDENTIFICATION DIVISION.                                         01/23/01
00002  PROGRAM-ID.             DTSBR413.                                DTSBR413
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV006
00004  DATE-WRITTEN.           DECEMBER 1994.                           DTSBR413
00005  DATE-COMPILED.                                                   DTSBR413
00006                                                                   DTSBR413
00007 *****                                                             DTSBR413
00008 *                                                                 DTSBR413
00009 *    CALLING SEQUENCE:  DTSBE413 CREATES DTSIR413 RECORDS.        DTSBR413
00010 *                       DTSBD800 CALLS DTSBR413                   DTSBR413
00011 *                                WHICH PRODUCES THE REPORT.       DTSBR413
00012 *                                                                 DTSBR413
00013 *    FUNCTION:  CREDIT SUSPENSE CANDIDATES LIST.                  DTSBR413
00014 *                                                                 DTSBR413
00015 *                                                                 DTSBR413
00016 *    MODIFICATION HISTORY:                                        DTSBR413
00017 *                                                                 DTSBR413
00018 * 12-21-94 INITIAL DEVELOPMENT                                    DTSBR413
00019 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - RHC  DTSBR413
00020 *                                                                 DTSBR413
00021 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR413
00022 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR413
00023 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR413
00024 *                                                                 DTSBR413
00025 *                                                                 DTSBR413
00026 *    DESCRIPTION:                                                 DTSBR413
00027 *                                                                 DTSBR413
00028 *        THIS MODULE PRODUCES THE CREDIT SUSPENSE CANDIDATES LIST.DTSBR413
00029 *                                                                 DTSBR413
00030 *                                                                 DTSBR413
00031 *    RECORDS READ:                                                DTSBR413
00032 *                                                                 DTSBR413
00033 *        NONE.                                                    DTSBR413
00034 *                                                                 DTSBR413
00035 *                                                                 DTSBR413
00036 *    PRINTED OUTPUTS:                                             DTSBR413
00037 *                                                                 DTSBR413
00038 *        413R1  CREDIT SUSPENSE CANDIDATES LIST.                  DTSBR413
00039 *                                                                 DTSBR413
00040 *                                                                 DTSBR413
00041 *    RECORDS WRITTEN:                                             DTSBR413
00042 *                                                                 DTSBR413
00043 *        NONE.                                                    DTSBR413
00044 *                                                                 DTSBR413
00045 *                                                                 DTSBR413
00046 *    MODULES CALLED:                                              DTSBR413
00047 *                                                                 DTSBR413
00048 *        DTSBU001  DATE CONVERT.                                  DTSBR413
00049 *                                                                 DTSBR413
00050 *                                                                 DTSBR413
00051 *****                                                             DTSBR413
00052                                                                   DTSBR413
00053  ENVIRONMENT DIVISION.                                            DTSBR413
00054                                                                   DTSBR413
00055  CONFIGURATION SECTION.                                           DTSBR413
00056  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR413
00057                                                                   DTSBR413
00058  INPUT-OUTPUT SECTION.                                            DTSBR413
00059  FILE-CONTROL.                                                    DTSBR413
00060      SELECT PRT-FILE ASSIGN TO RPT413R1.                          DTSBR413
00061                                                                   DTSBR413
00062  DATA DIVISION.                                                   DTSBR413
00063  FILE SECTION.                                                    DTSBR413
00064                                                                   DTSBR413
00065  FD  PRT-FILE                                                     DTSBR413
00066      RECORDING MODE IS F.                                         DTSBR413
00067  01  REPORT-LISTING1                 PIC  X(133).                 DTSBR413
00068                                                                   DTSBR413
00069  WORKING-STORAGE SECTION.                                         DTSBR413
000695 77  PAN-VALET PICTURE X(24) VALUE '006DTSBR413  01/23/01'.       DTSBR413
00070                                                                   DTSBR413
00071  01  WRK-AREA.                                                    DTSBR413
00072      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +413.DTSBR413
00073      05  FIRST-TIME-IND              PIC  X(01)        VALUE 'Y'. DTSBR413
00074                                                                   DTSBR413
00075      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  DTSBR413
00076      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  DTSBR413
00077      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR413
00078      05  WS-DETAIL-CNT               PIC S9(05) COMP-3 VALUE +0.  DTSBR413
00079                                                                   DTSBR413
00080  01  L001-LINK-AREA.                                              DTSBR413
00081  ++INCLUDE DTSIL001                                               DTSBR413
00082                                                                   DTSBR413
00083  01  PAGE-HEADING.                                                DTSBR413
00084      05  HDR-LINE-1.                                              DTSBR413
00085          10  FILLER                      PIC  X(01)  VALUE SPACE. DTSBR413
00086          10  FILLER                      PIC  X(05)               DTSBR413
00087                 VALUE '413R1'.                                    DTSBR413
00088          10  FILLER                      PIC  X(36)  VALUE SPACES.DTSBR413
00089          10  HDR-AGY-NAME-LINE1          PIC  X(50).              DTSBR413
00090          10  FILLER                      PIC  X(27)  VALUE SPACES.DTSBR413
00091          10  FILLER                      PIC  X(05)               DTSBR413
00092                 VALUE 'DATE:'.                                    DTSBR413
00093          10  FILLER                      PIC  X(01)  VALUE SPACE. DTSBR413
00094          10  HDR-SYS-DATE                PIC  X(08).              DTSBR413
00095                                                                   DTSBR413
00096      05  HDR-LINE-2.                                              DTSBR413
00097          10  FILLER                      PIC  X(42)  VALUE SPACES.DTSBR413
00098          10  HDR-AGY-NAME-LINE2          PIC  X(50).              DTSBR413
00099          10  FILLER                      PIC  X(27)  VALUE SPACES.DTSBR413
00100          10  FILLER                      PIC  X(05)               DTSBR413
00101                 VALUE 'TIME:'.                                    DTSBR413
00102          10  FILLER                      PIC  X(01)  VALUE SPACE. DTSBR413
00103          10  HDR-SYS-TIME                PIC  X(08).              DTSBR413
00104                                                                   DTSBR413
00105      05  HDR-LINE-3.                                              DTSBR413
00106          10  FILLER                      PIC  X(01)  VALUE SPACE. DTSBR413
00107          10  FILLER                      PIC  X(33)               DTSBR413
00108                 VALUE 'ROUTE TO:  ACCOUNTING UNIT       '.        DTSBR413
00109          10  FILLER                      PIC  X(16)  VALUE SPACES.DTSBR413
00110          10  FILLER                      PIC  X(35)               DTSBR413
00111                 VALUE 'WRITE OFF CANDIDATES LIST - CREDITS'.      DTSBR413
00112          10  FILLER                      PIC  X(34)  VALUE SPACES.DTSBR413
00113          10  FILLER                      PIC  X(05)               DTSBR413
00114                 VALUE 'PAGE:'.                                    DTSBR413
00115          10  FILLER                      PIC  X(03)  VALUE SPACES.DTSBR413
00116          10  HDR-PAGE-CNT                PIC  ZZ,ZZ9.             DTSBR413
00117                                                                   DTSBR413
00118      05  HDR-LINE-4                      PIC  X(133) VALUE SPACES.DTSBR413
00119      05  HDR-LINE-5.                                              DTSBR413
00120          10  FILLER                      PIC  X(01)  VALUE SPACE. DTSBR413
00121          10  FILLER                      PIC  X(30)               DTSBR413
00122                 VALUE 'CREDIT INACTIVITY CUTOFF DATE:'.           DTSBR413
00123          10  FILLER                      PIC  X(02)  VALUE SPACES.DTSBR413
00124          10  WRK-CUTOFF-DATE             PIC  X(08).              DTSBR413
00125                                                                   DTSBR413
00126      05  HDR-LINE-6                      PIC  X(133) VALUE SPACES.DTSBR413
00127      05  HDR-LINE-7.                                              DTSBR413
00128          10  FILLER                      PIC  X(69)  VALUE SPACES.DTSBR413
00129          10  FILLER                      PIC  X(05)               DTSBR413
00130                 VALUE 'FIELD'.                                    DTSBR413
00131          10  FILLER                      PIC  X(17)  VALUE SPACES.DTSBR413
00132          10  FILLER                      PIC  X(06)               DTSBR413
00133                 VALUE 'CREDIT'.                                   DTSBR413
00134          10  FILLER                      PIC  X(08)  VALUE SPACES.DTSBR413
00135          10  FILLER                      PIC  X(11)               DTSBR413
00136                 VALUE 'NO. PURSUED'.                              DTSBR413
00137                                                                   DTSBR413
00138      05  HDR-LINE-8.                                              DTSBR413
00139          10  FILLER                      PIC  X(07)  VALUE SPACES.DTSBR413
00140          10  FILLER                      PIC  X(06)               DTSBR413
00141                 VALUE 'EMP NO'.                                   DTSBR413
00142          10  FILLER                      PIC  X(09)  VALUE SPACES.DTSBR413
00143          10  FILLER                      PIC  X(13)               DTSBR413
00144                 VALUE 'PRIMARY NAME'.                             DTSBR413
00145          10  FILLER                      PIC  X(34)  VALUE SPACES.DTSBR413
00146          10  FILLER                      PIC  X(04)               DTSBR413
00147                 VALUE 'CODE'.                                     DTSBR413
00148          10  FILLER                      PIC  X(17)  VALUE SPACES.DTSBR413
00149          10  FILLER                      PIC  X(07)               DTSBR413
00150                 VALUE 'BALANCE'.                                  DTSBR413
00151          10  FILLER                      PIC  X(10)  VALUE SPACES.DTSBR413
00152          10  FILLER                      PIC  X(07)               DTSBR413
00153                 VALUE 'REPORTS'.                                  DTSBR413
00154      05  HDR-LINE-9                      PIC  X(133) VALUE SPACES.DTSBR413
00155                                                                   DTSBR413
00156  01  DETAIL-LINE.                                                 DTSBR413
00157      05  DTL-LINE-2.                                              DTSBR413
00158          10  FILLER                      PIC  X(06)  VALUE SPACES.DTSBR413
00159          10  DTL-EMP-NO                  PIC  999B999.            DTSBR413
00160          10  FILLER                      PIC  X(09)  VALUE SPACES.DTSBR413
00161          10  DTL-PRIMARY-NAME            PIC  X(40).              DTSBR413
00162          10  FILLER                      PIC  X(08)  VALUE SPACES.DTSBR413
00163          10  DTL-FLD-REP-ID              PIC  X(02).              DTSBR413
00164          10  FILLER                      PIC  X(11)  VALUE SPACES.DTSBR413
00165          10  DTL-TOT-CREDIT-AMT          PIC  ZZZ,ZZZ,ZZ9.99.     DTSBR413
00166          10  FILLER                      PIC  X(12)  VALUE SPACES.DTSBR413
00167          10  DTL-PURSUED-RPT-CNT         PIC  ZZ9.                DTSBR413
00168                                                                   DTSBR413
00169  01  CONTROL-FOOTING-FINAL.                                       DTSBR413
00170      05  CFF-LINE-3.                                              DTSBR413
00171          10  FILLER                      PIC  X(25)  VALUE SPACES.DTSBR413
00172          10  CFF-DETAIL-CNT              PIC  ZZ,ZZ9.             DTSBR413
00173          10  FILLER                      PIC  X(01)  VALUE SPACE. DTSBR413
00174          10  FILLER                      PIC  X(44)               DTSBR413
00175          VALUE 'CREDIT WRITE OFF CANDIDATES LISTED ON REPORT'.    DTSBR413
00176                                                                   DTSBR413
00177  LINKAGE SECTION.                                                 DTSBR413
00178                                                                   DTSBR413
00179  01  LRCM-LINK-AREA.                                              DTSBR413
00180  ++INCLUDE DTSILRCM                                               DTSBR413
00181      EJECT                                                        DTSBR413
00182  01  R413-REC.                                                    DTSBR413
00183  ++INCLUDE DTSIR413                                               DTSBR413
00184      EJECT                                                        DTSBR413
00185  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR413
00186                           R413-REC.                               DTSBR413
00187                                                                   DTSBR413
00188      IF FIRST-TIME-IND = 'Y'                                      DTSBR413
00189          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR413
00190          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR413
00191                                                                   DTSBR413
00192      IF LRCM-EOR-88                                               DTSBR413
00193          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR413
00194      ELSE                                                         DTSBR413
00195          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR413
00196                                                                   DTSBR413
00197      GOBACK.                                                      DTSBR413
00198                                                                   DTSBR413
00199  I1000-INITIATE.                                                  DTSBR413
00200      MOVE R413-CUTOFF-DATE TO L001-FED-8-DATE-9.                  DTSBR413
00201      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBR413
00202      MOVE L001-SLASH-DATE TO WRK-CUTOFF-DATE.                     DTSBR413
00203                                                                   DTSBR413
00204      OPEN OUTPUT PRT-FILE.                                        DTSBR413
00205      MOVE LRCM-SYS-DATE TO HDR-SYS-DATE.                          DTSBR413
00206      MOVE LRCM-SYS-TIME TO HDR-SYS-TIME.                          DTSBR413
00207      MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1.              DTSBR413
00208      MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2.              DTSBR413
00209      MOVE SPACES TO REPORT-LISTING1.                              DTSBR413
00210                                                                   DTSBR413
00211  I1000-EXIT.                                                      DTSBR413
00212      EXIT.                                                        DTSBR413
00213                                                                   DTSBR413
00214  P1000-PROCESS.                                                   DTSBR413
00215                                                                   DTSBR413
00216      MOVE R413-EMP-NO              TO DTL-EMP-NO.                 DTSBR413
00217      MOVE R413-PRIMARY-NAME        TO DTL-PRIMARY-NAME.           DTSBR413
00218      MOVE R413-FLD-REP-ID          TO DTL-FLD-REP-ID.             DTSBR413
00219      MOVE R413-TOT-CREDIT-AMT      TO DTL-TOT-CREDIT-AMT.         DTSBR413
00220      MOVE R413-PURSUED-RPT-CNT     TO DTL-PURSUED-RPT-CNT.        DTSBR413
00221      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                  DTSBR413
00222      WRITE REPORT-LISTING1 FROM DTL-LINE-2 AFTER 2.               DTSBR413
00223      ADD +1    TO WS-DETAIL-CNT.                                  DTSBR413
00224      ADD +2    TO WS-LINE-CNT2.                                   DTSBR413
00225                                                                   DTSBR413
00226                                                                   DTSBR413
00227  P1000-EXIT.                                                      DTSBR413
00228      EXIT.                                                        DTSBR413
00229                                                                   DTSBR413
00230  P2000-PRINT-HEADER.                                              DTSBR413
00231                                                                   DTSBR413
00232      IF WS-LINE-CNT GREATER 58 OR                                 DTSBR413
00233           WS-LINE-CNT2 GREATER 58                                 DTSBR413
00234         MOVE +0          TO WS-LINE-CNT                           DTSBR413
00235         MOVE +0          TO WS-LINE-CNT2                          DTSBR413
00236         ADD  +1          TO WS-PAGE-CNT                           DTSBR413
00237         MOVE WS-PAGE-CNT TO HDR-PAGE-CNT                          DTSBR413
00238         WRITE REPORT-LISTING1 FROM HDR-LINE-1                     DTSBR413
00239                 AFTER TOP-OF-PAGE                                 DTSBR413
00240         WRITE REPORT-LISTING1 FROM HDR-LINE-2 AFTER 1             DTSBR413
00241         WRITE REPORT-LISTING1 FROM HDR-LINE-3 AFTER 1             DTSBR413
00242         WRITE REPORT-LISTING1 FROM HDR-LINE-4 AFTER 1             DTSBR413
00243         WRITE REPORT-LISTING1 FROM HDR-LINE-5 AFTER 1             DTSBR413
00244         WRITE REPORT-LISTING1 FROM HDR-LINE-6 AFTER 1             DTSBR413
00245         WRITE REPORT-LISTING1 FROM HDR-LINE-7 AFTER 1             DTSBR413
00246         WRITE REPORT-LISTING1 FROM HDR-LINE-8 AFTER 1             DTSBR413
00247         WRITE REPORT-LISTING1 FROM HDR-LINE-9 AFTER 1             DTSBR413
00248         ADD +9    TO WS-LINE-CNT2.                                DTSBR413
00249                                                                   DTSBR413
00250  P2000-EXIT.                                                      DTSBR413
00251      EXIT.                                                        DTSBR413
00252                                                                   DTSBR413
00253                                                                   DTSBR413
00254  T1000-TERMINATE.                                                 DTSBR413
00255                                                                   DTSBR413
00256      IF WS-LINE-CNT GREATER 52 OR                                 DTSBR413
00257           WS-LINE-CNT2 GREATER 52                                 DTSBR413
00258         ADD  +10         TO WS-LINE-CNT2                          DTSBR413
00259         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.               DTSBR413
00260      MOVE WS-DETAIL-CNT    TO CFF-DETAIL-CNT.                     DTSBR413
00261      WRITE REPORT-LISTING1 FROM CFF-LINE-3 AFTER 3.               DTSBR413
00262                                                                   DTSBR413
00263      CLOSE PRT-FILE.                                              DTSBR413
00264                                                                   DTSBR413
00265  T1000-EXIT.                                                      DTSBR413
00266      EXIT.                                                        DTSBR413
00267                                                                   DTSBR413
00268  S001-FROM-FED-8.                                                 DTSBR413
00269                                                                   DTSBR413
00270      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR413
00271                                                                   DTSBR413
00272      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR413
00273                                                                   DTSBR413
00274  S001-EXIT.                                                       DTSBR413
00275      EXIT.                                                        DTSBR413
00276                                                                   DTSBR413
00277 *S999-ABEND.                                                      DTSBR413
00278 *                                                                 DTSBR413
00279 *    CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR413
00280 *                                                                 DTSBR413
00281 *S999-EXIT.                                                       DTSBR413
00282 *    EXIT.                                                        DTSBR413
00283                                                                   DTSBR413
