Files
DUTAS/Batch/DTSBR732.cob
2025-07-21 11:20:11 -04:00

345 lines
27 KiB
COBOL

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