00001 IDENTIFICATION DIVISION. 01/23/01 00002 PROGRAM-ID. DTSBR729. DTSBR729 00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV013 00004 DATE-WRITTEN. NOVEMBER 1994. DTSBR729 00005 DATE-COMPILED. DTSBR729 00006 DTSBR729 00007 ***** DTSBR729 00008 * DTSBR729 00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR729 00010 * DTSBE729 WHICH UPDATES DTSIR729 DTSBR729 00011 * DTSBR729 READS DTSIR729 RECORDS. DTSBR729 00012 * FUNCTION: ACCOUNTS AVAILABLE FOR PURGE. DTSBR729 00013 * DTSBR729 00014 * DTSBR729 00015 * MODIFICATION HISTORY: DTSBR729 00016 * DTSBR729 00017 * 11-20-94 INITIAL DEVELOPMENT DTSBR729 00018 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR729 00019 * DTSBR729 00020 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR729 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR729 00022 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR729 00023 * DTSBR729 00024 * DTSBR729 00025 * DESCRIPTION: DTSBR729 00026 * DTSBR729 00027 * THE MODULE PRODUCES A LIST OF ACCOUNTS WHICH MEET THE DTSBR729 00028 * ESTABLISHED CRITERIA FOR BEING AVAILABLE FOR PURGE FROM DTSBR729 00029 * THE PRODUCTION MASTER FILE. DTSBR729 00030 * DTSBR729 00031 * DTSBR729 00032 * RECORDS READ: DTSBR729 00033 * DTSBR729 00034 * NONE. DTSBR729 00035 * DTSBR729 00036 * DTSBR729 00037 * PRINTED OUTPUTS: DTSBR729 00038 * DTSBR729 00039 * 729R1 ACCOUNTS AVAILABLE FOR PURGE LIST DTSBR729 00040 * DTSBR729 00041 * DTSBR729 00042 * RECORDS WRITTEN: DTSBR729 00043 * DTSBR729 00044 * NONE. DTSBR729 00045 * DTSBR729 00046 * DTSBR729 00047 * MODULES CALLED: DTSBR729 00048 * DTSBR729 00049 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR729 00050 * DTSBR729 00051 * DTSBR729 00052 ***** DTSBR729 00053 DTSBR729 00054 ENVIRONMENT DIVISION. DTSBR729 00055 DTSBR729 00056 CONFIGURATION SECTION. DTSBR729 00057 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR729 00058 DTSBR729 00059 INPUT-OUTPUT SECTION. DTSBR729 00060 DTSBR729 00061 FILE-CONTROL. DTSBR729 00062 SELECT PRT-FILE ASSIGN TO RPT729R1. DTSBR729 00063 DTSBR729 00064 DATA DIVISION. DTSBR729 00065 DTSBR729 00066 FILE SECTION. DTSBR729 00067 DTSBR729 00068 FD PRT-FILE DTSBR729 00069 RECORDING MODE IS F. DTSBR729 00070 01 REPORT-LISTING1 PIC X(133). DTSBR729 00071 DTSBR729 00072 WORKING-STORAGE SECTION. DTSBR729 000725 77 PAN-VALET PICTURE X(24) VALUE '013DTSBR729 01/23/01'. DTSBR729 00073 DTSBR729 00074 01 WRK-AREA. DTSBR729 00075 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +729.DTSBR729 00076 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR729 00077 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR729 00078 DTSBR729 00079 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR729 00080 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR729 00081 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR729 00082 DTSBR729 00083 01 L001-LINK-AREA. DTSBR729 00084 ++INCLUDE DTSIL001 DTSBR729 00085 EJECT DTSBR729 00086 DTSBR729 00087 01 PAGE-HEADING. DTSBR729 00088 05 HDR1-LINE-1. DTSBR729 00089 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00090 10 FILLER PIC X(05) DTSBR729 00091 VALUE '729R1'. DTSBR729 00092 10 FILLER PIC X(34) VALUE SPACES. DTSBR729 00093 10 HDR1-AGY-NAME-LINE1 PIC X(50). DTSBR729 00094 10 FILLER PIC X(28) VALUE SPACES. DTSBR729 00095 10 FILLER PIC X(05) DTSBR729 00096 VALUE 'DATE:'. DTSBR729 00097 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00098 10 HDR1-SYS-DATE PIC X(08). DTSBR729 00099 05 HDR1-LINE-2. DTSBR729 00100 10 FILLER PIC X(40) VALUE SPACES. DTSBR729 00101 10 HDR1-AGY-NAME-LINE2 PIC X(50). DTSBR729 00102 10 FILLER PIC X(28) VALUE SPACES. DTSBR729 00103 10 FILLER PIC X(05) DTSBR729 00104 VALUE 'TIME:'. DTSBR729 00105 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00106 10 HDR1-SYS-TIME PIC X(08). DTSBR729 00107 05 HDR1-LINE-3. DTSBR729 00108 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00109 10 FILLER PIC X(33) DTSBR729 00110 VALUE 'ROUTE TO: CHIEF, TAX DIVISION'. DTSBR729 00111 10 FILLER PIC X(84) VALUE SPACES. DTSBR729 00112 10 FILLER PIC X(05) DTSBR729 00113 VALUE 'PAGE:'. DTSBR729 00114 10 FILLER PIC X(03) VALUE SPACES. DTSBR729 00115 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR729 00116 05 HDR1-LINE-4. DTSBR729 00117 10 FILLER PIC X(50) VALUE SPACES. DTSBR729 00118 10 FILLER PIC X(28) DTSBR729 00119 VALUE 'ACCOUNTS AVAILABLE FOR PURGE'. DTSBR729 00120 05 HDR1-LINE-5 PIC X(133) VALUE SPACES. DTSBR729 00121 05 HDR1-LINE-6 PIC X(133) VALUE SPACES. DTSBR729 00122 05 HDR1-LINE-7. DTSBR729 00123 10 FILLER PIC X(13) VALUE SPACES. DTSBR729 00124 10 FILLER PIC X(08) DTSBR729 00125 VALUE 'EMPLOYER'. DTSBR729 00126 10 FILLER PIC X(48) VALUE SPACES. DTSBR729 00127 10 FILLER PIC X(40) DTSBR729 00128 VALUE 'LIABILITY INACTIVE PURSUED BAL '. DTSBR729 00129 10 FILLER PIC X(22) DTSBR729 00130 VALUE 'CRED WRITE AUTOMATIC'. DTSBR729 00131 05 HDR1-LINE-8. DTSBR729 00132 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00133 10 FILLER PIC X(19) DTSBR729 00134 VALUE 'EMP NO CLASS'. DTSBR729 00135 10 FILLER PIC X(08) VALUE SPACES. DTSBR729 00136 10 FILLER PIC X(13) DTSBR729 00137 VALUE 'PRIMARY NAME'. DTSBR729 00138 10 FILLER PIC X(28) VALUE SPACES. DTSBR729 00139 10 FILLER PIC X(40) DTSBR729 00140 VALUE ' DATE DATE REPORTS DUE '. DTSBR729 00141 10 FILLER PIC X(22) DTSBR729 00142 VALUE 'AMT OFF PURGE'. DTSBR729 00143 05 HDR1-LINE-9 PIC X(133) VALUE SPACES. DTSBR729 00144 DTSBR729 00145 01 DETAIL-LINE. DTSBR729 00146 05 DTL1-LINE-1. DTSBR729 00147 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00148 10 DTL1-EMP-NO PIC 999B999. DTSBR729 00149 10 FILLER PIC X(02) VALUE SPACES. DTSBR729 00150 10 WS-EMP-CLASS-DSCR PIC X(13). DTSBR729 00151 10 FILLER PIC X(03) VALUE SPACES. DTSBR729 00152 10 DTL1-PRIMARY-NAME PIC X(40). DTSBR729 00153 10 FILLER PIC X(04) VALUE SPACES. DTSBR729 00154 10 WS-LIAB-DATE PIC X(08). DTSBR729 00155 10 FILLER PIC X(04) VALUE SPACES. DTSBR729 00156 10 WS-INACT-DATE PIC X(08). DTSBR729 00157 10 FILLER PIC X(05) VALUE SPACES. DTSBR729 00158 10 WS-PURSUED-RPT-YES PIC X(03). DTSBR729 00159 10 FILLER PIC X(05) VALUE SPACES. DTSBR729 00160 10 WS-BALANCE-DUE-YES PIC X(03). DTSBR729 00161 10 FILLER PIC X(04) VALUE SPACES. DTSBR729 00162 10 WS-CREDIT-BAL-YES PIC X(03). DTSBR729 00163 10 FILLER PIC X(04) VALUE SPACES. DTSBR729 00164 10 WS-WRITEOFF-ACCT-YES PIC X(03). DTSBR729 00165 10 FILLER PIC X(04) VALUE SPACES. DTSBR729 00166 10 WS-PURGE-ACCT-YES PIC X(03). DTSBR729 00167 DTSBR729 00168 01 CONTROL-FOOTING-FINAL. DTSBR729 00169 05 CTF-LINE-3. DTSBR729 00170 10 FILLER PIC X(25) VALUE SPACES. DTSBR729 00171 10 CTF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR729 00172 10 FILLER PIC X(01) VALUE SPACE. DTSBR729 00173 10 FILLER PIC X(28) DTSBR729 00174 VALUE 'ACCOUNTS AVAILABLE FOR PURGE'. DTSBR729 00175 05 CTF-LINE-7. DTSBR729 00176 10 FILLER PIC X(24) VALUE SPACES. DTSBR729 00177 10 FILLER PIC X(17) DTSBR729 00178 VALUE '*** END OF REPORT'. DTSBR729 00179 EJECT DTSBR729 00180 LINKAGE SECTION. DTSBR729 00181 DTSBR729 00182 01 LRCM-LINK-AREA. DTSBR729 00183 ++INCLUDE DTSILRCM DTSBR729 00184 EJECT DTSBR729 00185 01 R729-REC. DTSBR729 00186 ++INCLUDE DTSIR729 DTSBR729 00187 EJECT DTSBR729 00188 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR729 00189 R729-REC. DTSBR729 00190 DTSBR729 00191 IF FIRST-TIME-IND = 'Y' DTSBR729 00192 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR729 00193 MOVE 'N' TO FIRST-TIME-IND. DTSBR729 00194 DTSBR729 00195 IF LRCM-EOR-88 DTSBR729 00196 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR729 00197 ELSE DTSBR729 00198 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR729 00199 DTSBR729 00200 GOBACK. DTSBR729 00201 DTSBR729 00202 I1000-INITIATE. DTSBR729 00203 DTSBR729 00204 OPEN OUTPUT PRT-FILE. DTSBR729 00205 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE. DTSBR729 00206 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME. DTSBR729 00207 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1. DTSBR729 00208 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2. DTSBR729 00209 MOVE SPACES TO REPORT-LISTING1. DTSBR729 00210 DTSBR729 00211 I1000-EXIT. DTSBR729 00212 EXIT. DTSBR729 00213 DTSBR729 00214 P1000-PROCESS. DTSBR729 00215 DTSBR729 00216 EVALUATE TRUE DTSBR729 00217 WHEN R729-CLASS-RATED-88 DTSBR729 00218 MOVE 'RATED ' TO WS-EMP-CLASS-DSCR DTSBR729 00219 WHEN R729-CLASS-SELF-INS-88 DTSBR729 00220 MOVE 'SELF INSURED' TO WS-EMP-CLASS-DSCR DTSBR729 00221 WHEN R729-CLASS-NEVER-SUB-88 DTSBR729 00222 MOVE 'NEVER SUBJECT' TO WS-EMP-CLASS-DSCR DTSBR729 00223 END-EVALUATE. DTSBR729 00224 DTSBR729 00225 MOVE R729-LIAB-DATE TO L001-FED-8-DATE-9. DTSBR729 00226 SET L001-FROM-FED-8 TO TRUE. DTSBR729 00227 PERFORM S001-DATE THRU S001-EXIT. DTSBR729 00228 IF L001-INVALID-DATE DTSBR729 00229 MOVE SPACES TO WS-LIAB-DATE DTSBR729 00230 ELSE DTSBR729 00231 MOVE L001-SLASH-DATE TO WS-LIAB-DATE. DTSBR729 00232 DTSBR729 00233 MOVE R729-INACT-DATE TO L001-FED-8-DATE-9. DTSBR729 00234 SET L001-FROM-FED-8 TO TRUE. DTSBR729 00235 PERFORM S001-DATE THRU S001-EXIT. DTSBR729 00236 IF L001-INVALID-DATE DTSBR729 00237 MOVE SPACES TO WS-INACT-DATE DTSBR729 00238 ELSE DTSBR729 00239 MOVE L001-SLASH-DATE TO WS-INACT-DATE. DTSBR729 00240 DTSBR729 00241 IF R729-PURSUED-RPT-EXISTS-88 DTSBR729 00242 MOVE 'YES' TO WS-PURSUED-RPT-YES DTSBR729 00243 ELSE DTSBR729 00244 MOVE SPACES TO WS-PURSUED-RPT-YES. DTSBR729 00245 IF R729-TOT-BALANCE-AMT > +0 DTSBR729 00246 MOVE 'YES' TO WS-BALANCE-DUE-YES DTSBR729 00247 ELSE DTSBR729 00248 MOVE SPACES TO WS-BALANCE-DUE-YES. DTSBR729 00249 IF R729-TOT-CREDIT-AMT > +0 DTSBR729 00250 MOVE 'YES' TO WS-CREDIT-BAL-YES DTSBR729 00251 ELSE DTSBR729 00252 MOVE SPACES TO WS-CREDIT-BAL-YES. DTSBR729 00253 IF R729-WRITE-OFF-DATE > +0 DTSBR729 00254 MOVE 'YES' TO WS-WRITEOFF-ACCT-YES DTSBR729 00255 ELSE DTSBR729 00256 MOVE SPACES TO WS-WRITEOFF-ACCT-YES. DTSBR729 00257 IF R729-PURGE-IND-YES-88 DTSBR729 00258 MOVE 'YES' TO WS-PURGE-ACCT-YES DTSBR729 00259 ELSE DTSBR729 00260 MOVE SPACES TO WS-PURGE-ACCT-YES. DTSBR729 00261 DTSBR729 00262 MOVE R729-EMP-NO TO DTL1-EMP-NO. DTSBR729 00263 MOVE R729-PRIMARY-NAME TO DTL1-PRIMARY-NAME. DTSBR729 00264 DTSBR729 00265 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR729 00266 WRITE REPORT-LISTING1 FROM DTL1-LINE-1 AFTER 1. DTSBR729 00267 ADD +1 TO WS-LINE-CNT2. DTSBR729 00268 ADD +1 TO WS-NUMBER-ONE. DTSBR729 00269 DTSBR729 00270 P1000-EXIT. DTSBR729 00271 EXIT. DTSBR729 00272 DTSBR729 00273 P2000-PRINT-HEADER. DTSBR729 00274 DTSBR729 00275 IF WS-LINE-CNT GREATER 59 OR DTSBR729 00276 WS-LINE-CNT2 GREATER 59 DTSBR729 00277 MOVE +0 TO WS-LINE-CNT DTSBR729 00278 MOVE +0 TO WS-LINE-CNT2 DTSBR729 00279 ADD +1 TO WS-PAGE-CNT DTSBR729 00280 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR729 00281 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 DTSBR729 00282 AFTER TOP-OF-PAGE DTSBR729 00283 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 DTSBR729 00284 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 DTSBR729 00285 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 DTSBR729 00286 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 DTSBR729 00287 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 DTSBR729 00288 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 DTSBR729 00289 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 DTSBR729 00290 WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1 DTSBR729 00291 ADD +9 TO WS-LINE-CNT2. DTSBR729 00292 DTSBR729 00293 P2000-EXIT. DTSBR729 00294 EXIT. DTSBR729 00295 DTSBR729 00296 T1000-TERMINATE. DTSBR729 00297 DTSBR729 00298 MOVE WS-NUMBER-ONE TO CTF-NUMBER-ONE. DTSBR729 00299 WRITE REPORT-LISTING1 FROM CTF-LINE-3 AFTER 3. DTSBR729 00300 WRITE REPORT-LISTING1 FROM CTF-LINE-7 AFTER 4. DTSBR729 00301 CLOSE PRT-FILE. DTSBR729 00302 DTSBR729 00303 T1000-EXIT. DTSBR729 00304 EXIT. DTSBR729 00305 EJECT DTSBR729 00306 S001-DATE. DTSBR729 00307 DTSBR729 00308 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR729 00309 DTSBR729 00310 S001-EXIT. DTSBR729 00311 EXIT. DTSBR729 00312 DTSBR729 00313 *S999-ABEND. DTSBR729 00314 * DTSBR729 00315 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR729 00316 * DTSBR729 00317 *S999-EXIT. DTSBR729 00318 * EXIT. DTSBR729