00001 IDENTIFICATION DIVISION. 08/14/02 00002 PROGRAM-ID. DTSBR732. DTSBR732 00003 AUTHOR. TRW LV001 00004 DATE-WRITTEN. AUGUST 2002. DTSBR732 00005 DATE-COMPILED. DTSBR732 00006 SKIP3 DTSBR732 00007 ***** DTSBR732 00008 * DTSBR732 00009 * CALLING SEQUENCE: DTSBD300 CALLS DTSBR732 00010 * DTSBD920 WHICH UPDATES DTSIR732 DTSBR732 00011 * DTSBR732 READS DTSIR732 RECORDS. DTSBR732 00012 * DTSBR732 00013 * FUNCTION: PURGED OWNER/PARTNER/OFFICER NAME LIST. DTSBR732 00014 * DTSBR732 00015 * DTSBR732 00016 * MODIFICATION HISTORY: DTSBR732 00017 * DTSBR732 00018 * 12-11-94 INITIAL DEVELOPMENT DTSBR732 00019 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR732 00020 * DTSBR732 00021 * 03-02-99 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS. DTSBR732 00022 * REFERENCE RFP #**** AUTHOR OF CHANGE - DVS DTSBR732 00023 * DTSBR732 00024 * 08/12/02 MODIFIED TO DTSBR732 REPORT WRITER PROGRAM TO COBOL II DTSBR732 00025 * REPORT PGM. PROGRAMMER: RW1 DTSBR732 00026 * DTSBR732 00027 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR732 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR732 00029 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR732 00030 * DTSBR732 00031 * DTSBR732 00032 * DESCRIPTION: DTSBR732 00033 * DTSBR732 00034 * THE MODULE PRODUCES A LIST OF ALL OWNER/PARTNER/OFFICER DTSBR732 00035 * NAMES ASSOCIATED WITH ALL ACCOUNTS THAT HAVE BEEN PURGED DTSBR732 00036 * FROM THE ACTIVE EMPLOYER MASTER FILE. DTSBR732 00037 * DTSBR732 00038 * DTSBR732 00039 * RECORDS READ: DTSBR732 00040 * DTSBR732 00041 * NONE. DTSBR732 00042 * DTSBR732 00043 * DTSBR732 00044 * PRINTED OUTPUTS: DTSBR732 00045 * DTSBR732 00046 * 732R1 PURGED OWNER/PARTNER/OFFICER NAMES LIST DTSBR732 00047 * DTSBR732 00048 * DTSBR732 00049 * RECORDS WRITTEN: DTSBR732 00050 * DTSBR732 00051 * NONE. DTSBR732 00052 * DTSBR732 00053 * DTSBR732 00054 * MODULES CALLED: DTSBR732 00055 * DTSBR732 00056 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR732 00057 * DTSBR732 00058 * DTSBR732 00059 ***** DTSBR732 00060 EJECT DTSBR732 00061 ENVIRONMENT DIVISION. DTSBR732 00062 DTSBR732 00063 CONFIGURATION SECTION. DTSBR732 00064 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR732 00065 DTSBR732 00066 INPUT-OUTPUT SECTION. DTSBR732 00067 SKIP1 DTSBR732 00068 FILE-CONTROL. DTSBR732 00069 SELECT PRT-FILE ASSIGN TO RPT732R1. DTSBR732 00070 SKIP3 DTSBR732 00071 DATA DIVISION. DTSBR732 00072 SKIP3 DTSBR732 00073 FILE SECTION. DTSBR732 00074 SKIP2 DTSBR732 00075 FD PRT-FILE DTSBR732 00076 RECORDING MODE IS F. DTSBR732 00077 01 REPORT-LISTING1 PIC X(133). DTSBR732 00078 DTSBR732 00079 EJECT DTSBR732 00080 WORKING-STORAGE SECTION. DTSBR732 000805 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR732 08/14/02'. DTSBR732 00081 DTSBR732 00082 01 WRK-AREA. DTSBR732 00083 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +732.DTSBR732 00084 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR732 00085 05 WS-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR732 00086 DTSBR732 00087 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR732 00088 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR732 00089 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR732 00090 DTSBR732 00091 01 PAGE-HEADING. DTSBR732 00092 05 HDR1-LINE-1. DTSBR732 00093 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00094 10 FILLER PIC X(05) DTSBR732 00095 VALUE '732R1'. DTSBR732 00096 10 FILLER PIC X(34) VALUE SPACES. DTSBR732 00097 10 HDR1-AGY-NAME-LINE1 PIC X(50). DTSBR732 00098 10 FILLER PIC X(28) VALUE SPACES. DTSBR732 00099 10 FILLER PIC X(05) DTSBR732 00100 VALUE 'DATE:'. DTSBR732 00101 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00102 10 HDR1-SYS-DATE PIC X(08). DTSBR732 00103 DTSBR732 00104 05 HDR1-LINE-2. DTSBR732 00105 10 FILLER PIC X(40) VALUE SPACES. DTSBR732 00106 10 HDR1-AGY-NAME-LINE2 PIC X(50). DTSBR732 00107 10 FILLER PIC X(28) VALUE SPACES. DTSBR732 00108 10 FILLER PIC X(05) DTSBR732 00109 VALUE 'TIME:'. DTSBR732 00110 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00111 10 HDR1-SYS-TIME PIC X(08). DTSBR732 00112 DTSBR732 00113 05 HDR1-LINE-3. DTSBR732 00114 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00115 10 FILLER PIC X(33) DTSBR732 00116 VALUE 'ROUTE TO: CHIEF, TAX DIVISION'. DTSBR732 00117 10 FILLER PIC X(84) VALUE SPACES. DTSBR732 00118 10 FILLER PIC X(05) DTSBR732 00119 VALUE 'PAGE:'. DTSBR732 00120 10 FILLER PIC X(03) VALUE SPACES. DTSBR732 00121 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR732 00122 DTSBR732 00123 05 HDR1-LINE-4. DTSBR732 00124 10 FILLER PIC X(50) VALUE SPACES. DTSBR732 00125 10 FILLER PIC X(28) DTSBR732 00126 VALUE ' PURGED EMPLOYER LIST '. DTSBR732 00127 DTSBR732 00128 05 HDR1-LINE-5 PIC X(133) VALUE SPACES. DTSBR732 00129 05 HDR1-LINE-6 PIC X(133) VALUE SPACES. DTSBR732 00130 DTSBR732 00131 05 HDR1-LINE-7. DTSBR732 00132 10 FILLER PIC X(13) VALUE SPACES. DTSBR732 00133 10 FILLER PIC X(08) DTSBR732 00134 VALUE 'EMPLOYER'. DTSBR732 00135 10 FILLER PIC X(72) VALUE SPACES. DTSBR732 00136 10 FILLER PIC X(32) DTSBR732 00137 VALUE 'ZIP LIAB INACTIVE PURGE'. DTSBR732 00138 DTSBR732 00139 05 HDR1-LINE-8. DTSBR732 00140 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00141 10 FILLER PIC X(18) DTSBR732 00142 VALUE 'EMP NO CLASS'. DTSBR732 00143 10 FILLER PIC X(07) VALUE SPACES. DTSBR732 00144 10 FILLER PIC X(26) DTSBR732 00145 VALUE 'OWNER/PARTNER/OFFICER NAME'. DTSBR732 00146 10 FILLER PIC X(08) VALUE SPACES. DTSBR732 00147 10 FILLER PIC X(10) DTSBR732 00148 VALUE ' CITY '. DTSBR732 00149 10 FILLER PIC X(15) VALUE SPACES. DTSBR732 00150 10 FILLER PIC X(05) DTSBR732 00151 VALUE 'STATE'. DTSBR732 00152 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00153 * 10 FILLER PIC X(21) VALUE SPACES. DTSBR732 00154 10 FILLER PIC X(33) DTSBR732 00155 VALUE 'CODE DATE DATE DATE'. DTSBR732 00156 DTSBR732 00157 05 HDR1-LINE-9 PIC X(133) VALUE SPACES. DTSBR732 00158 DTSBR732 00159 01 DETAIL-LINE. DTSBR732 00160 05 DTL1-LINE-1. DTSBR732 00161 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00162 10 DTL1-EMP-NO PIC 999B999. DTSBR732 00163 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00164 10 WS-EMP-CLASS-DSCR PIC X(13). DTSBR732 00165 10 FILLER PIC X(03) VALUE SPACES. DTSBR732 00166 10 DTL1-OPO-NAME PIC X(32). DTSBR732 00167 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00168 10 DTL1-CITY PIC X(25). DTSBR732 00169 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00170 10 DTL1-ST PIC X(02). DTSBR732 00171 10 FILLER PIC X(03) VALUE SPACES. DTSBR732 00172 10 DTL1-ZIP-FIRST5 PIC X(05). DTSBR732 00173 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00174 10 WS-LIAB-DATE PIC X(08). DTSBR732 00175 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00176 10 WS-INACT-DATE PIC X(08). DTSBR732 00177 10 FILLER PIC X(02) VALUE SPACES. DTSBR732 00178 10 WS-PURGE-DATE PIC X(08). DTSBR732 00179 10 FILLER PIC X(05) VALUE SPACES. DTSBR732 00180 DTSBR732 00181 01 CONTROL-FOOTING-FINAL. DTSBR732 00182 05 CTF-LINE-3. DTSBR732 00183 10 FILLER PIC X(27) VALUE SPACES. DTSBR732 00184 10 CTF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR732 00185 10 FILLER PIC X(01) VALUE SPACE. DTSBR732 00186 10 FILLER PIC X(15) DTSBR732 00187 VALUE 'PURGED ACCOUNTS'. DTSBR732 00188 05 CTF-LINE-7. DTSBR732 00189 10 FILLER PIC X(27) VALUE SPACES. DTSBR732 00190 10 FILLER PIC X(17) DTSBR732 00191 VALUE '*** END OF REPORT'. DTSBR732 00192 EJECT DTSBR732 00193 DTSBR732 00194 01 L001-LINK-AREA. DTSBR732 00195 ++INCLUDE DTSIL001 DTSBR732 00196 EJECT DTSBR732 00197 LINKAGE SECTION. DTSBR732 00198 SKIP3 DTSBR732 00199 01 LRCM-LINK-AREA. DTSBR732 00200 ++INCLUDE DTSILRCM DTSBR732 00201 EJECT DTSBR732 00202 01 R732-REC. DTSBR732 00203 ++INCLUDE DTSIR732 DTSBR732 00204 EJECT DTSBR732 00205 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR732 00206 R732-REC. DTSBR732 00207 DTSBR732 00208 IF FIRST-TIME-IND = 'Y' DTSBR732 00209 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR732 00210 MOVE 'N' TO FIRST-TIME-IND. DTSBR732 00211 DTSBR732 00212 IF LRCM-EOR-88 DTSBR732 00213 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR732 00214 ELSE DTSBR732 00215 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR732 00216 DTSBR732 00217 GOBACK. DTSBR732 00218 EJECT DTSBR732 00219 I1000-INITIATE. DTSBR732 00220 DTSBR732 00221 OPEN OUTPUT PRT-FILE. DTSBR732 00222 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE. DTSBR732 00223 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME. DTSBR732 00224 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1. DTSBR732 00225 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2. DTSBR732 00226 MOVE SPACES TO REPORT-LISTING1. DTSBR732 00227 DTSBR732 00228 I1000-EXIT. DTSBR732 00229 EXIT. DTSBR732 00230 DTSBR732 00231 P1000-PROCESS. DTSBR732 00232 DTSBR732 00233 EVALUATE TRUE DTSBR732 00234 WHEN R732-CLASS-REG-88 DTSBR732 00235 MOVE 'REGULAR' TO WS-EMP-CLASS-DSCR DTSBR732 00236 WHEN R732-CLASS-GOV-88 DTSBR732 00237 MOVE 'GOVERNMENTAL' TO WS-EMP-CLASS-DSCR DTSBR732 00238 WHEN R732-CLASS-REIMB-88 DTSBR732 00239 MOVE 'REIMBURSABLE' TO WS-EMP-CLASS-DSCR DTSBR732 00240 WHEN R732-CLASS-NEVER-SUB-88 DTSBR732 00241 MOVE 'NEVER SUBJECT' TO WS-EMP-CLASS-DSCR DTSBR732 00242 END-EVALUATE. DTSBR732 00243 DTSBR732 00244 MOVE R732-LIAB-DATE TO L001-FED-8-DATE-9. DTSBR732 00245 SET L001-FROM-FED-8 TO TRUE. DTSBR732 00246 PERFORM S001-DATE THRU S001-EXIT. DTSBR732 00247 IF L001-INVALID-DATE DTSBR732 00248 MOVE SPACES TO WS-LIAB-DATE DTSBR732 00249 ELSE DTSBR732 00250 MOVE L001-SLASH-DATE TO WS-LIAB-DATE. DTSBR732 00251 DTSBR732 00252 MOVE R732-INACT-DATE TO L001-FED-8-DATE-9. DTSBR732 00253 SET L001-FROM-FED-8 TO TRUE. DTSBR732 00254 PERFORM S001-DATE THRU S001-EXIT. DTSBR732 00255 IF L001-INVALID-DATE DTSBR732 00256 MOVE SPACES TO WS-INACT-DATE DTSBR732 00257 ELSE DTSBR732 00258 MOVE L001-SLASH-DATE TO WS-INACT-DATE. DTSBR732 00259 DTSBR732 00260 MOVE R732-PURGE-DATE TO L001-FED-8-DATE-9. DTSBR732 00261 SET L001-FROM-FED-8 TO TRUE. DTSBR732 00262 PERFORM S001-DATE THRU S001-EXIT. DTSBR732 00263 IF L001-INVALID-DATE DTSBR732 00264 MOVE SPACES TO WS-PURGE-DATE DTSBR732 00265 ELSE DTSBR732 00266 MOVE L001-SLASH-DATE TO WS-PURGE-DATE. DTSBR732 00267 DTSBR732 00268 MOVE R732-EMP-NO TO DTL1-EMP-NO. DTSBR732 00269 MOVE R732-OPO-NAME TO DTL1-OPO-NAME. DTSBR732 00270 MOVE R732-CITY TO DTL1-CITY. DTSBR732 00271 MOVE R732-ST TO DTL1-ST. DTSBR732 00272 MOVE R732-ZIP-FIRST5 TO DTL1-ZIP-FIRST5. DTSBR732 00273 DTSBR732 00274 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR732 00275 WRITE REPORT-LISTING1 FROM DTL1-LINE-1 AFTER 1. DTSBR732 00276 ADD +1 TO WS-LINE-CNT2. DTSBR732 00277 ADD +1 TO WS-NUMBER-ONE. DTSBR732 00278 DTSBR732 00279 P1000-EXIT. DTSBR732 00280 EXIT. DTSBR732 00281 DTSBR732 00282 P2000-PRINT-HEADER. DTSBR732 00283 DTSBR732 00284 IF WS-LINE-CNT GREATER 59 OR DTSBR732 00285 WS-LINE-CNT2 GREATER 59 DTSBR732 00286 MOVE +0 TO WS-LINE-CNT DTSBR732 00287 MOVE +0 TO WS-LINE-CNT2 DTSBR732 00288 ADD +1 TO WS-PAGE-CNT DTSBR732 00289 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR732 00290 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 DTSBR732 00291 AFTER TOP-OF-PAGE DTSBR732 00292 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 DTSBR732 00293 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 DTSBR732 00294 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 DTSBR732 00295 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 DTSBR732 00296 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 DTSBR732 00297 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 DTSBR732 00298 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 DTSBR732 00299 WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1 DTSBR732 00300 ADD +9 TO WS-LINE-CNT2. DTSBR732 00301 DTSBR732 00302 P2000-EXIT. DTSBR732 00303 EXIT. DTSBR732 00304 DTSBR732 00305 T1000-TERMINATE. DTSBR732 00306 DTSBR732 00307 IF WS-LINE-CNT2 GREATER 52 DTSBR732 00308 MOVE +0 TO WS-LINE-CNT2 DTSBR732 00309 ADD +1 TO WS-PAGE-CNT DTSBR732 00310 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR732 00311 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 DTSBR732 00312 AFTER TOP-OF-PAGE DTSBR732 00313 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 DTSBR732 00314 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 DTSBR732 00315 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 DTSBR732 00316 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 DTSBR732 00317 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 DTSBR732 00318 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 DTSBR732 00319 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 DTSBR732 00320 WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1 DTSBR732 00321 ADD +9 TO WS-LINE-CNT2. DTSBR732 00322 DTSBR732 00323 MOVE WS-NUMBER-ONE TO CTF-NUMBER-ONE. DTSBR732 00324 WRITE REPORT-LISTING1 FROM CTF-LINE-3 AFTER 3. DTSBR732 00325 WRITE REPORT-LISTING1 FROM CTF-LINE-7 AFTER 4. DTSBR732 00326 CLOSE PRT-FILE. DTSBR732 00327 DTSBR732 00328 T1000-EXIT. DTSBR732 00329 EXIT. DTSBR732 00330 DTSBR732 00331 S001-DATE. DTSBR732 00332 DTSBR732 00333 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR732 00334 DTSBR732 00335 S001-EXIT. DTSBR732 00336 EXIT. DTSBR732 00337 DTSBR732 00338 S999-ABEND. DTSBR732 00339 DTSBR732 00340 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR732 00341 DTSBR732 00342 S999-EXIT. DTSBR732 00343 EXIT. DTSBR732