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
