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