507 lines
40 KiB
COBOL
507 lines
40 KiB
COBOL
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
|