00001  IDENTIFICATION DIVISION.                                         08/26/04
00002  PROGRAM-ID.             DTSBD707.                                DTSBD707
00003  AUTHOR.                 TRW.                                        LV003
00004  DATE-WRITTEN.           FEBRUARY 2002.                           DTSBD707
00005  DATE-COMPILED.                                                   DTSBD707
00006                                                                   DTSBD707
00007 *****                                                             DTSBD707
00008 *   08/2004  LOGIC TO UPDATE DATABASE (FIELD ASSIGNMENT RECORD)   DTSBD707
00009 *            COMMENTED.  LINES BEGINNING WITH *TMP* INDICATE      DTSBD707
00010 *            COMMENTED LINES.                                     DTSBD707
00011 *                                                                 DTSBD707
00012 *   FUNCTION:  1.  EACH QUARTER THE TAX STAFF WILL CREATE A       DTSBD707
00013 *              SPREADSHEET CONTAINING ACCOUNT NUMBER WITH 4 CHAR  DTSBD707
00014 *              NAME FOR ALL EMPLOYER'S RETURNED MAIL BECAUSE OF   DTSBD707
00015 *              A BAD ADDRESS.  THIS FILE IS UPLOADED TO THE       DTSBD707
00016 *              MAINFRAME.                                         DTSBD707
00017 *                                                                 DTSBD707
00018 *              2.  FOR EACH EMPLOYER ON THE BAD ADDRESS FILE,     DTSBD707
00019 *              READ THE MPRF RECORD TO GET THE FEIN.              DTSBD707
00020 *                                                                 DTSBD707
00021 *              3.  SORT THE EMPLOYER FEINS (PROGRAM INTERNAL SORT DTSBD707
00022 *              TO MATCH AGAINST THE FUTA FILE.  CREATE A 2ND FILE DTSBD707
00023 *              TO SORT (PROGRAM INTERNAL) DATA IN THE FOLLOWING   DTSBD707
00024 *              SEQUENCE:                                          DTSBD707
00025 *                  A.  RECORD TYPE                                DTSBD707
00026 *                      1=DC ADDRESS IN DUTAS OR THE MATCHING FUTA DTSBD707
00027 *                        RECORD AND PURSUED REPORTS 3 OR MORE.    DTSBD707
00028 *                      2=NEITHER HAS DC ADDRESS OR PURSUED REPORTSDTSBD707
00029 *                        LESS THAN 3.                             DTSBD707
00030 *                  B.  ZIP CODE (SPACE IF NOT DC ZIP)             DTSBD707
00031 *                  C.  ACCOUNT NUMBER                             DTSBD707
00032 *                                                                 DTSBD707
00033 *              4.  PRINT BAD ADDRESS REPORT WITH MAJOR BREAK      DTSBD707
00034 *              ON SORT RECORD TYPE AND SORT ZIP CODE.             DTSBD707
00035 *                                                                 DTSBD707
00036 *              5.  CREATE A FIELD ASSIGNMENT (MFAS) FOR EACH      DTSBD707
00037 *                  EMPLOYER WITH A SORT RECORD TYPE=1 (I.E.:      DTSBD707
00038 *                  EMPLOYER HAS A DC ADDRESS AND 3 OR MORE        DTSBD707
00039 *                  REPORTS ARE BEING PURSUED).                    DTSBD707
00040 *                                                                 DTSBD707
00041 *****                                                             DTSBD707
00042                                                                   DTSBD707
00043  ENVIRONMENT DIVISION.                                            DTSBD707
00044                                                                   DTSBD707
00045  CONFIGURATION SECTION.                                           DTSBD707
00046  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBD707
00047                                                                   DTSBD707
00048  INPUT-OUTPUT SECTION.                                            DTSBD707
00049                                                                   DTSBD707
00050  FILE-CONTROL.                                                    DTSBD707
00051      SELECT PRT-FILE1         ASSIGN TO RPT707R1.                 DTSBD707
00052      SELECT REPORT-FILE       ASSIGN TO REPORTF1.                 DTSBD707
00053      SELECT CERT-REQUEST-FILE ASSIGN TO DTSFRQST.                 DTSBD707
00054      SELECT SORT-FILE         ASSIGN TO SORTWORK.                 DTSBD707
00055      SELECT SORT1-FILE        ASSIGN TO SORTWORK.                 DTSBD707
00056      SELECT BAD-ADDRESSES     ASSIGN TO DTSBADAD.                 DTSBD707
00057                                                                   DTSBD707
00058  DATA DIVISION.                                                   DTSBD707
00059                                                                   DTSBD707
00060  FILE SECTION.                                                    DTSBD707
00061                                                                   DTSBD707
00062  FD  PRT-FILE1                                                    DTSBD707
00063      RECORDING MODE IS F.                                         DTSBD707
00064  01  PRT-RECORD              PIC X(133).                          DTSBD707
00065                                                                   DTSBD707
00066  SD  SORT-FILE.                                                   DTSBD707
00067  01  SORT-RECORD.                                                 DTSBD707
00068      05  SORT-FEIN           PIC 9(09).                           DTSBD707
00069      05  SORT-EMPLOYER       PIC X(06).                           DTSBD707
00070                                                                   DTSBD707
00071  SD  SORT1-FILE.                                                  DTSBD707
00072  01  SORT1-RECORD.                                                DTSBD707
00073      05  SORT1-KEY.                                               DTSBD707
00074          10  SORT1-REC-TYPE      PIC X(01).                       DTSBD707
00075          10  SORT1-ZIP           PIC X(05).                       DTSBD707
00076          10  SORT1-EMPLOYER      PIC X(06).                       DTSBD707
00077      05  SORT1-FILLER            PIC X(258).                      DTSBD707
00078                                                                   DTSBD707
00079  FD  REPORT-FILE                                                  DTSBD707
00080      RECORDING MODE IS F                                          DTSBD707
00081      BLOCK CONTAINS 0 RECORDS                                     DTSBD707
00082      LABEL RECORDS ARE STANDARD.                                  DTSBD707
00083  01  REPORT-RECORD.                                               DTSBD707
00084      05  RPT-KEY.                                                 DTSBD707
00085          10  RPT-REC-TYPE       PIC X(01).                        DTSBD707
00086          10  RPT-ZIP            PIC X(05).                        DTSBD707
00087          10  RPT-EMPLOYER-NBR   PIC X(06).                        DTSBD707
00088      05  RPT-MSG-CD             PIC X(01).                        DTSBD707
00089      05  RPT-DUTAS-NAME         PIC X(40).                        DTSBD707
00090      05  RPT-DUTAS-PHONE        PIC X(10).                        DTSBD707
00091      05  RPT-DUTAS-ADDR         PIC X(40).                        DTSBD707
00092      05  RPT-DUTAS-CITY         PIC X(25).                        DTSBD707
00093      05  RPT-DUTAS-STATE        PIC X(02).                        DTSBD707
00094      05  RPT-DUTAS-ZIP          PIC X(10).                        DTSBD707
00095      05  RPT-DUTAS-PURSUED      PIC 9(02).                        DTSBD707
00096      05  RPT-DUTAS-SIC-CD       PIC X(04).                        DTSBD707
00097      05  RPT-DUTAS-NAICS-CD     PIC X(06).                        DTSBD707
00098      05  RPT-DUTAS-OWN-CD       PIC X(02).                        DTSBD707
00099      05  RPT-FUTA-NAME          PIC X(40).                        DTSBD707
00100      05  RPT-FUTA-ADDR          PIC X(40).                        DTSBD707
00101      05  RPT-FUTA-CITY          PIC X(25).                        DTSBD707
00102      05  RPT-FUTA-STATE         PIC X(02).                        DTSBD707
00103      05  RPT-FUTA-ZIP           PIC X(09).                        DTSBD707
00104                                                                   DTSBD707
00105  FD  BAD-ADDRESSES                                                DTSBD707
00106      RECORDING MODE IS F.                                         DTSBD707
00107  01  BAD-ADDRESS-RECORD.                                          DTSBD707
00108      05  BAR-EMPLOYER        PIC X(07).                           DTSBD707
00109      05  FILLER              PIC X(01).                           DTSBD707
00110      05  BAR-NAME-CHECK      PIC X(04).                           DTSBD707
00111      05  FILLER              PIC X(68).                           DTSBD707
00112                                                                   DTSBD707
00113  FD  CERT-REQUEST-FILE                                            DTSBD707
00114      RECORDING MODE IS F                                          DTSBD707
00115      BLOCK CONTAINS 0 RECORDS                                     DTSBD707
00116      LABEL RECORDS ARE STANDARD.                                  DTSBD707
00117                                                                   DTSBD707
00118  01  REQUEST-REC.                                                 DTSBD707
00119      05  REQUEST-CHAR-CNT                PIC S9(04)  COMP.        DTSBD707
00120      05  REQUEST-HEX-ZERO                PIC S9(04)  COMP.        DTSBD707
00121      05  REQUEST-STATE-CD                PIC  X(02).              DTSBD707
00122      05  REQUEST-FEIN                    PIC  9(09).              DTSBD707
00123      05  REQUEST-FEIN-X REDEFINES REQUEST-FEIN                    DTSBD707
00124                                          PIC  X(09).              DTSBD707
00125      05  REQUEST-DOC-LOC-NUMBER          PIC  X(14).              DTSBD707
00126      05  REQUEST-TAX-PERIOD              PIC  9(06).              DTSBD707
00127      05  REQUEST-TAX-PERIOD-X                                     DTSBD707
00128          REDEFINES REQUEST-TAX-PERIOD.                            DTSBD707
00129          10  REQUEST-TAX-YEAR            PIC  9(04).              DTSBD707
00130          10  REQUEST-TAX-MONTH           PIC  9(02).              DTSBD707
00131      05  REQUEST-CHECK-DIGIT             PIC  X(02).              DTSBD707
00132      05  REQUEST-TAXABLE-WAGES           PIC  9(13)V9(02).        DTSBD707
00133      05  REQUEST-ADDRESS-AREA.                                    DTSBD707
00134          10  REQUEST-ZIP                 PIC  X(12).              DTSBD707
00135          10  REQUEST-STATE               PIC  X(02).              DTSBD707
00136          10  REQUEST-CITY                PIC  X(25).              DTSBD707
00137          10  REQUEST-STREET              PIC  X(35).              DTSBD707
00138          10  REQUEST-NAME-1              PIC  X(35).              DTSBD707
00139          10  REQUEST-NAME-2              PIC  X(35).              DTSBD707
00140          10  REQUEST-NAME-3              PIC  X(35).              DTSBD707
00141          10  REQUEST-NAME-4              PIC  X(35).              DTSBD707
00142      05  REQUEST-NAME-CONTROL            PIC  X(04).              DTSBD707
00143      05  REQUEST-XREF-FEIN               PIC  X(09).              DTSBD707
00144      05  REQUEST-EMP-NO-AREA             PIC  X(15).              DTSBD707
00145      05  REQUEST-FORM-INDICATOR          PIC  X(01).              DTSBD707
00146  EJECT                                                            DTSBD707
00147  WORKING-STORAGE SECTION.                                         DTSBD707
001475 77  PAN-VALET PICTURE X(24) VALUE '003DTSBD707  08/26/04'.       DTSBD707
00148  01  WRK-AREA.                                                    DTSBD707
00149      05  WRK-PAGE-BREAK.                                          DTSBD707
00150          10  WRK-PAGE-REC-TYPE       PIC X(01) VALUE SPACES.      DTSBD707
00151          10  WRK-PAGE-ZIP            PIC X(05) VALUE SPACES.      DTSBD707
00152      05  WRK-ADJUST-DATE             PIC 9(08).                   DTSBD707
00153      05  WRK-ADJUST-DATE-RE REDEFINES WRK-ADJUST-DATE.            DTSBD707
00154          10  WRK-ADJUST-CCYY         PIC 9(04).                   DTSBD707
00155          10  WRK-ADJUST-MM           PIC 9(02).                   DTSBD707
00156          10  FILLER                  PIC X(02).                   DTSBD707
00157      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +707.DTSBD707
00158      05  WRK-ABEND-MSG               PIC  X(60)  VALUE SPACES.    DTSBD707
00159      05  WRK-MSG-CD                  PIC  X(01)  VALUE SPACES.    DTSBD707
00160                                                                   DTSBD707
00161      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD707'.DTSBD707
00162      05  WRK-EMPLOYER                PIC X(06).                   DTSBD707
00163      05  WRK-BAR-IN-CNT              PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00164      05  WRK-FUTA-IN-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00165      05  WRK-BAR-WITH-MPRF-CNT       PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00166      05  WRK-BAR-NO-MPRF-CNT         PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00167      05  WRK-BAR-NO-FUTA-CNT         PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00168      05  WRK-BAR-WITH-FUTA-CNT       PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00169      05  WRK-ADDR-SAME-CNT           PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00170      05  WRK-NO-MTAD-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBD707
00171      05  WRK-L910-RECORD-CNT         PIC S9(03)  COMP-3 VALUE 0.  DTSBD707
00172      05  WRK-MTAD-UPDATED-CNT        PIC S9(03)  COMP-3 VALUE 0.  DTSBD707
00173                                                                   DTSBD707
00174      05  WS-LINE-CNT                 PIC S9(02)  COMP-3 VALUE 60. DTSBD707
00175      05  WS-PAGE-CNT                 PIC S9(05)  COMP-3 VALUE +0. DTSBD707
00176                                                                   DTSBD707
00177      05  WRK-FUTA-ZIP-AREA.                                       DTSBD707
00178          10  WRK-FUTA-ZIP-5          PIC X(05).                   DTSBD707
00179          10  WRK-FUTA-ZIP-PLUS4      PIC X(04).                   DTSBD707
00180          10  WRK-FUTA-ZIP-PLUS3      PIC X(03).                   DTSBD707
00181                                                                   DTSBD707
00182      05  WRK-MTAD-ZIP-AREA.                                       DTSBD707
00183          10  WRK-TAD-ZIP-5           PIC X(05).                   DTSBD707
00184          10  WRK-TAD-DASH            PIC X(01)  VALUE '-'.        DTSBD707
00185          10  WRK-TAD-ZIP-PLUS4       PIC X(04).                   DTSBD707
00186                                                                   DTSBD707
00187      05  WRK-LOG-MSG                     PIC  X(39)  VALUE        DTSBD707
00188            'MAILING ADDRESS REPLACED BY IRS ADDRESS'.             DTSBD707
00189                                                                   DTSBD707
00190      05  DISP-DATE                   PIC X(10).                   DTSBD707
00191      05  DISP-TIME                   PIC X(08).                   DTSBD707
00192      05  DISP-ABSTIME                PIC X(16).                   DTSBD707
00193                                                                   DTSBD707
00194      05  WRK-EDIT-PHONE.                                          DTSBD707
00195          10  FILLER                  PIC X(01) VALUE '('.         DTSBD707
00196          10  WRK-EP-AREA-CODE        PIC X(03).                   DTSBD707
00197          10  FILLER                  PIC X(02) VALUE ')'.         DTSBD707
00198          10  WRK-EP-EXCHANGE         PIC X(03).                   DTSBD707
00199          10  FILLER                  PIC X(01) VALUE '-'.         DTSBD707
00200          10  WRK-EP-NUMBER           PIC X(04).                   DTSBD707
00201      05  WRK-PURSUED-REPORTS.                                     DTSBD707
00202          10  WRK-PR-EMP              PIC X(06).                   DTSBD707
00203          10  FILLER                  PIC X(01) VALUE '/'.         DTSBD707
00204          10  WRK-PR-NBR              PIC X(02).                   DTSBD707
00205  01  HEADER-1.                                                    DTSBD707
00206      05  FILLER                      PIC  X(06)                   DTSBD707
00207                 VALUE ' 707R1'.                                   DTSBD707
00208      05  FILLER                      PIC  X(34).                  DTSBD707
00209      05  WS-AGY-NAME-LINE1           PIC  X(50) VALUE             DTSBD707
00210          '      DEPARTMENT OF EMPLOYMENT SERVICES       '.        DTSBD707
00211      05  FILLER                      PIC  X(20).                  DTSBD707
00212      05  FILLER                      PIC  X(05)                   DTSBD707
00213                 VALUE 'DATE:'.                                    DTSBD707
00214      05  FILLER                      PIC  X(01).                  DTSBD707
00215      05  WS-SYS-DATE                 PIC  X(08).                  DTSBD707
00216  01  HEADER-2.                                                    DTSBD707
00217      05  FILLER                      PIC  X(01) VALUE SPACES.     DTSBD707
00218      05  HDR2-FLD-REP-NAME           PIC  X(41) VALUE SPACES.     DTSBD707
00219      05  FILLER                      PIC  X(32) VALUE             DTSBD707
00220          'DUTAS BAD ADDRESSES BY ZIP CODE'.                       DTSBD707
00221      05  HDR2-VARIABLE.                                           DTSBD707
00222          10  FILLER                  PIC  X(02) VALUE '('.        DTSBD707
00223          10  HDR2-ZIP                PIC  X(05).                  DTSBD707
00224          10  FILLER                  PIC  X(29) VALUE ' )'.       DTSBD707
00225      05  FILLER                      PIC  X(05) VALUE 'PAGE:'.    DTSBD707
00226      05  HDR2-PAGE-CNT               PIC  ZZZ9.                   DTSBD707
00227  01  HEADER-3.                                                    DTSBD707
00228          10  FILLER                  PIC  X(17)                   DTSBD707
00229                 VALUE ' EMPLR/RPTS'.                              DTSBD707
00230          10  FILLER                  PIC  X(42)                   DTSBD707
00231                 VALUE 'DUTAS INFORMATION'.                        DTSBD707
00232          10  FILLER                  PIC  X(40)                   DTSBD707
00233                 VALUE 'FUTA INFORMATION'.                         DTSBD707
00234                                                                   DTSBD707
00235  01  HEADER-4.                                                    DTSBD707
00236          10  FILLER                  PIC  X(01) VALUE SPACE.      DTSBD707
00237          10  FILLER                  PIC  X(14) VALUE ALL '-'.    DTSBD707
00238          10  FILLER                  PIC  X(02) VALUE SPACE.      DTSBD707
00239          10  FILLER                  PIC  X(40) VALUE ALL '-'.    DTSBD707
00240          10  FILLER                  PIC  X(02) VALUE SPACE.      DTSBD707
00241          10  FILLER                  PIC  X(40) VALUE ALL '-'.    DTSBD707
00242                                                                   DTSBD707
00243  01  DETAIL-LINE-1 VALUE SPACES.                                  DTSBD707
00244      05  FILLER                      PIC  X(01).                  DTSBD707
00245      05  DTL1-FIELD1                 PIC  X(16).                  DTSBD707
00246      05  DTL1-FIELD2.                                             DTSBD707
00247          10 DTL1-CITY2               PIC  X(15).                  DTSBD707
00248          10 FILLER                   PIC  X(01).                  DTSBD707
00249          10 DTL1-STATE2              PIC  X(03).                  DTSBD707
00250          10 DTL1-ZIP2                PIC  X(21).                  DTSBD707
00251      05  FILLER                      PIC  X(02).                  DTSBD707
00252      05  DTL1-FIELD3.                                             DTSBD707
00253          10 DTL1-CITY3               PIC  X(15).                  DTSBD707
00254          10 FILLER                   PIC  X(01).                  DTSBD707
00255          10 DTL1-STATE3              PIC  X(03).                  DTSBD707
00256          10 DTL1-ZIP3                PIC  X(21).                  DTSBD707
00257  01  DETAIL-LINE-3.                                               DTSBD707
00258      05  FILLER                      PIC  X(02) VALUE SPACE.      DTSBD707
00259      05  WS-LITERAL-3                PIC  X(50) VALUE SPACE.      DTSBD707
00260      05  WS-COUNTS-3                 PIC  ZZZ,ZZ9.                DTSBD707
00261                                                                   DTSBD707
00262  01  L001-LINK-AREA.                                              DTSBD707
00263  ++INCLUDE DTSIL001                                               DTSBD707
00264      SKIP2                                                        DTSBD707
00265  01  L005-LINK-AREA.                                              DTSBD707
00266  ++INCLUDE DTSIL005                                               DTSBD707
00267      SKIP2                                                        DTSBD707
00268  01  L061-LINK-AREA.                                              DTSBD707
00269  ++INCLUDE DTSIL061                                               DTSBD707
00270      SKIP2                                                        DTSBD707
00271  01  L062-LINK-AREA.                                              DTSBD707
00272  ++INCLUDE DTSIL062                                               DTSBD707
00273      SKIP2                                                        DTSBD707
00274  01  L910-LINK-AREA.                                              DTSBD707
00275  ++INCLUDE DTSIL910                                               DTSBD707
00276      SKIP2                                                        DTSBD707
00277  01  L921-LINK-AREA.                                              DTSBD707
00278  ++INCLUDE DTSIL921                                               DTSBD707
00279      SKIP2                                                        DTSBD707
00280  01  ISKL-REC.                                                    DTSBD707
00281  ++INCLUDE DTSIISKL                                               DTSBD707
00282      SKIP2                                                        DTSBD707
00283  01  IEIN-REC.                                                    DTSBD707
00284  ++INCLUDE DTSIIEIN                                               DTSBD707
00285      SKIP2                                                        DTSBD707
00286  01  L931-LINK-AREA.                                              DTSBD707
00287  ++INCLUDE DTSIL931                                               DTSBD707
00288      SKIP2                                                        DTSBD707
00289  01  FSKL-REC.                                                    DTSBD707
00290  ++INCLUDE DTSIFSKL                                               DTSBD707
00291      SKIP2                                                        DTSBD707
00292  01  MSKL-REC.                                                    DTSBD707
00293  ++INCLUDE DTSIMSKL                                               DTSBD707
00294      SKIP2                                                        DTSBD707
00295  01  MHDR-REC.                                                    DTSBD707
00296  ++INCLUDE DTSIMHDR                                               DTSBD707
00297      SKIP2                                                        DTSBD707
00298  01  MPRF-REC.                                                    DTSBD707
00299  ++INCLUDE DTSIMPRF                                               DTSBD707
00300      SKIP2                                                        DTSBD707
00301  01  MTAD-REC.                                                    DTSBD707
00302  ++INCLUDE DTSIMTAD                                               DTSBD707
00303      SKIP2                                                        DTSBD707
00304  01  MFAS-REC.                                                    DTSBD707
00305  ++INCLUDE DTSIMFAS                                               DTSBD707
00306      EJECT                                                        DTSBD707
00307  PROCEDURE DIVISION.                                              DTSBD707
00308      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD707
00309                                                                   DTSBD707
00310      SORT SORT-FILE ASCENDING KEY SORT-FEIN                       DTSBD707
00311           INPUT  PROCEDURE P1000-GET-FEIN THRU P1999-EXIT         DTSBD707
00312           OUTPUT PROCEDURE P5000-WRITE-RPT-REC THRU               DTSBD707
00313                            P5999-EXIT.                            DTSBD707
00314      CLOSE REPORT-FILE.                                           DTSBD707
00315      SORT SORT1-FILE ASCENDING KEY SORT1-KEY                      DTSBD707
00316           USING REPORT-FILE                                       DTSBD707
00317           GIVING REPORT-FILE.                                     DTSBD707
00318                                                                   DTSBD707
00319      OPEN INPUT REPORT-FILE.                                      DTSBD707
00320      PERFORM P6000-PRINT     THRU P6000-EXIT.                     DTSBD707
00321      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD707
00322                                                                   DTSBD707
00323      GOBACK.                                                      DTSBD707
00324      EJECT                                                        DTSBD707
00325  I0000-INITIATE.                                                  DTSBD707
00326      PERFORM I1000-SYS-DATE   THRU I1000-EXIT.                    DTSBD707
00327      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    DTSBD707
00328  I0000-EXIT.                                                      DTSBD707
00329      EXIT.                                                        DTSBD707
00330                                                                   DTSBD707
00331  I1000-SYS-DATE.                                                  DTSBD707
00332      SET L005-FROM-SYS     TO TRUE.                               DTSBD707
00333      PERFORM S005-SYS-DATE THRU S005-EXIT.                        DTSBD707
00334      MOVE L005-DATE        TO L001-FED-8-DATE-9.                  DTSBD707
00335      SET L001-FROM-FED-8   TO TRUE.                               DTSBD707
00336      PERFORM S001-DATE     THRU S001-EXIT.                        DTSBD707
00337      MOVE L001-SLASH-DATE  TO DISP-DATE, WS-SYS-DATE.             DTSBD707
00338      MOVE L005-TIME        TO DISP-TIME.                          DTSBD707
00339      MOVE L005-ABSTIME     TO DISP-ABSTIME.                       DTSBD707
00340                                                                   DTSBD707
00341      DISPLAY '    '.                                              DTSBD707
00342      DISPLAY 'L005-DATE ' DISP-DATE  ' L005-TIME ' DISP-TIME      DTSBD707
00343         '  L005-ABSTIME ' DISP-ABSTIME.                           DTSBD707
00344                                                                   DTSBD707
00345  I1000-EXIT.                                                      DTSBD707
00346      EXIT.                                                        DTSBD707
00347                                                                   DTSBD707
00348  I2000-OPEN-FILES.                                                DTSBD707
00349      MOVE 'N'          TO L910-TRACE-IND.                         DTSBD707
00350      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBD707
00351                                                                   DTSBD707
00352 ** OPEN MSTR FOR UPDATE                                           DTSBD707
00353 *TMP*PERFORM S910-OPEN-UPDATE THRU S910-EXIT.                     DTSBD707
00354                                                                   DTSBD707
00355 ** OPEN MSTR FOR RETRIEVAL                                        DTSBD707
00356       PERFORM S910-OPEN-READ THRU S910-EXIT.                      DTSBD707
00357                                                                   DTSBD707
00358 ** OPEN AIX FOR UPDATE                                            DTSBD707
00359 *TMP*PERFORM S921-OPEN-UPDATE THRU S921-EXIT.                     DTSBD707
00360                                                                   DTSBD707
00361 ** OPEN AIX FOR READ                                              DTSBD707
00362      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD707
00363                                                                   DTSBD707
00364 ** OPEN REF FOR UPDATE                                            DTSBD707
00365 *TMP*PERFORM S931-OPEN-UPDATE THRU S931-EXIT.                     DTSBD707
00366                                                                   DTSBD707
00367 ** OPEN REF FOR READ                                              DTSBD707
00368      PERFORM S931-OPEN-READ   THRU S931-EXIT.                     DTSBD707
00369                                                                   DTSBD707
00370      OPEN INPUT  CERT-REQUEST-FILE,                               DTSBD707
00371                  BAD-ADDRESSES,                                   DTSBD707
00372           OUTPUT PRT-FILE1,                                       DTSBD707
00373                  REPORT-FILE.                                     DTSBD707
00374  I2000-EXIT.                                                      DTSBD707
00375      EXIT.                                                        DTSBD707
00376                                                                   DTSBD707
00377  P1000-GET-FEIN.                                                  DTSBD707
00378      READ BAD-ADDRESSES                                           DTSBD707
00379           AT END                                                  DTSBD707
00380              CLOSE BAD-ADDRESSES                                  DTSBD707
00381              GO TO P1999-EXIT.                                    DTSBD707
00382                                                                   DTSBD707
00383      ADD +1 TO WRK-BAR-IN-CNT.                                    DTSBD707
00384      MOVE BAR-EMPLOYER (1:3) TO WRK-EMPLOYER (1:3).               DTSBD707
00385      MOVE BAR-EMPLOYER (5:3) TO WRK-EMPLOYER (4:3).               DTSBD707
00386                                                                   DTSBD707
00387      PERFORM P9000-GET-MPRF THRU P9000-EXIT.                      DTSBD707
00388      IF  L910-NO-REC-88                                           DTSBD707
00389      OR  BAR-NAME-CHECK NOT EQUAL MPRF-PRIMARY-NAME (1:4)         DTSBD707
00390      AND BAR-NAME-CHECK NOT EQUAL MPRF-ENTITY-NAME (1:4)          DTSBD707
00391         ADD +1 TO WRK-BAR-NO-MPRF-CNT                             DTSBD707
00392         DISPLAY ' UNMATCHED MPRF RECORD-->' WRK-EMPLOYER          DTSBD707
00393                                  '/' BAR-NAME-CHECK               DTSBD707
00394                                  '/' MPRF-PRIMARY-NAME (1:15)     DTSBD707
00395                                  '/' MPRF-ENTITY-NAME  (1:15)     DTSBD707
00396         GO TO P1000-GET-FEIN.                                     DTSBD707
00397                                                                   DTSBD707
00398      ADD +1                 TO WRK-BAR-WITH-MPRF-CNT.             DTSBD707
00399      MOVE MPRF-FEIN         TO SORT-FEIN.                         DTSBD707
00400      MOVE WRK-EMPLOYER      TO SORT-EMPLOYER.                     DTSBD707
00401      RELEASE SORT-RECORD.                                         DTSBD707
00402      GO TO P1000-GET-FEIN.                                        DTSBD707
00403  P1999-EXIT.                                                      DTSBD707
00404      EXIT.                                                        DTSBD707
00405                                                                   DTSBD707
00406  P5000-WRITE-RPT-REC.                                             DTSBD707
00407  P5010-READ-SORT-FILE.                                            DTSBD707
00408      RETURN SORT-FILE AT END                                      DTSBD707
00409             MOVE 999999999 TO SORT-FEIN.                          DTSBD707
00410  P5010-EXIT.                                                      DTSBD707
00411      EXIT.                                                        DTSBD707
00412  P5020-READ-FUTA-FILE.                                            DTSBD707
00413      READ CERT-REQUEST-FILE AT END                                DTSBD707
00414           MOVE 999999999 TO REQUEST-FEIN                          DTSBD707
00415           GO TO P5020-EXIT.                                       DTSBD707
00416      ADD 1 TO WRK-FUTA-IN-CNT.                                    DTSBD707
00417  P5020-EXIT.                                                      DTSBD707
00418      EXIT.                                                        DTSBD707
00419                                                                   DTSBD707
00420  P5050-COMPARE-FILES.                                             DTSBD707
00421      MOVE SPACE TO WRK-MSG-CD.                                    DTSBD707
00422      IF  SORT-FEIN    EQUAL 999999999                             DTSBD707
00423      AND REQUEST-FEIN EQUAL 999999999                             DTSBD707
00424         GO TO P5999-EXIT.                                         DTSBD707
00425      IF REQUEST-FEIN LESS THAN SORT-FEIN                          DTSBD707
00426         GO TO P5020-READ-FUTA-FILE.                               DTSBD707
00427      IF REQUEST-FEIN GREATER SORT-FEIN                            DTSBD707
00428         ADD 1    TO WRK-BAR-NO-FUTA-CNT                           DTSBD707
00429         MOVE '1' TO WRK-MSG-CD                                    DTSBD707
00430         PERFORM P5060-MOVE-MPRF-DATA THRU P5060-EXIT              DTSBD707
00431         PERFORM P5010-READ-SORT-FILE THRU P5010-EXIT              DTSBD707
00432         GO TO P5050-COMPARE-FILES.                                DTSBD707
00433                                                                   DTSBD707
00434      ADD 1 TO WRK-BAR-WITH-FUTA-CNT.                              DTSBD707
00435      PERFORM P5060-MOVE-MPRF-DATA THRU P5060-EXIT.                DTSBD707
00436      GO TO P5010-READ-SORT-FILE.                                  DTSBD707
00437  P5999-EXIT.                                                      DTSBD707
00438      EXIT.                                                        DTSBD707
00439                                                                   DTSBD707
00440  P5060-MOVE-MPRF-DATA.                                            DTSBD707
00441      INITIALIZE REPORT-RECORD.                                    DTSBD707
00442      MOVE SORT-EMPLOYER TO WRK-EMPLOYER, RPT-EMPLOYER-NBR.        DTSBD707
00443      PERFORM P9000-GET-MPRF THRU P9000-EXIT.                      DTSBD707
00444      IF L910-NO-REC-88                                            DTSBD707
00445         DISPLAY ' MPRF LOGIC SCREWUP<--' SORT-EMPLOYER            DTSBD707
00446         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD707
00447      MOVE MPRF-PRIMARY-NAME    TO RPT-DUTAS-NAME.                 DTSBD707
00448      MOVE MPRF-PURSUED-RPT-CNT TO RPT-DUTAS-PURSUED.              DTSBD707
00449      MOVE MPRF-SIC-CD          TO RPT-DUTAS-SIC-CD.               DTSBD707
00450      MOVE MPRF-NAICS-CD        TO RPT-DUTAS-NAICS-CD.             DTSBD707
00451      MOVE MPRF-OWN-CD          TO RPT-DUTAS-OWN-CD.               DTSBD707
00452                                                                   DTSBD707
00453      PERFORM P5200-FIND-MTAD THRU P5200-EXIT.                     DTSBD707
00454      IF L910-NO-REC-88                                            DTSBD707
00455         ADD 1 TO WRK-NO-MTAD-CNT                                  DTSBD707
00456         MOVE '2'    TO WRK-MSG-CD                                 DTSBD707
00457         INITIALIZE MTAD-REC                                       DTSBD707
00458      ELSE                                                         DTSBD707
00459         MOVE MSKL-REC          TO MTAD-REC                        DTSBD707
00460         IF MTAD-CHNG-DATE GREATER 20020315                        DTSBD707
00461            ADD 1 TO WRK-MTAD-UPDATED-CNT                          DTSBD707
00462            MOVE '3' TO WRK-MSG-CD.                                DTSBD707
00463                                                                   DTSBD707
00464      MOVE MTAD-VOICE-1      TO RPT-DUTAS-PHONE.                   DTSBD707
00465      MOVE MTAD-DELIV-LINE-2 TO RPT-DUTAS-ADDR.                    DTSBD707
00466      MOVE MTAD-CITY         TO RPT-DUTAS-CITY.                    DTSBD707
00467      MOVE MTAD-ST           TO RPT-DUTAS-STATE.                   DTSBD707
00468      MOVE MTAD-ZIP          TO RPT-DUTAS-ZIP.                     DTSBD707
00469                                                                   DTSBD707
00470      IF WRK-MSG-CD GREATER SPACES                                 DTSBD707
00471         MOVE WRK-MSG-CD TO RPT-MSG-CD                             DTSBD707
00472         GO TO P5060-MMD-1.                                        DTSBD707
00473                                                                   DTSBD707
00474      IF  MTAD-DELIV-LINE-2 EQUAL REQUEST-STREET                   DTSBD707
00475      AND REQUEST-ZIP (1:5) EQUAL MTAD-ZIP (1:5)                   DTSBD707
00476      AND REQUEST-ZIP (6:4) EQUAL MTAD-ZIP (7:4)                   DTSBD707
00477         ADD 1 TO WRK-ADDR-SAME-CNT                                DTSBD707
00478         MOVE '4' TO RPT-MSG-CD                                    DTSBD707
00479         GO TO P5060-MMD-1.                                        DTSBD707
00480                                                                   DTSBD707
00481      MOVE REQUEST-NAME-1 TO RPT-FUTA-NAME.                        DTSBD707
00482      MOVE REQUEST-STREET TO RPT-FUTA-ADDR.                        DTSBD707
00483      MOVE REQUEST-CITY   TO RPT-FUTA-CITY.                        DTSBD707
00484      MOVE REQUEST-STATE  TO RPT-FUTA-STATE.                       DTSBD707
00485      MOVE REQUEST-ZIP    TO RPT-FUTA-ZIP.                         DTSBD707
00486  P5060-MMD-1.                                                     DTSBD707
00487      MOVE '1' TO RPT-REC-TYPE.                                    DTSBD707
00488      IF MPRF-PURSUED-RPT-CNT GREATER +2                           DTSBD707
00489         IF 'DC' EQUAL RPT-DUTAS-STATE                             DTSBD707
00490            MOVE RPT-DUTAS-ZIP TO RPT-ZIP                          DTSBD707
00491         ELSE                                                      DTSBD707
00492            IF 'DC' EQUAL RPT-FUTA-STATE                           DTSBD707
00493               MOVE RPT-FUTA-ZIP TO RPT-ZIP                        DTSBD707
00494            ELSE                                                   DTSBD707
00495               MOVE '2' TO RPT-REC-TYPE                            DTSBD707
00496      ELSE                                                         DTSBD707
00497         MOVE '2' TO RPT-REC-TYPE.                                 DTSBD707
00498                                                                   DTSBD707
00499      WRITE REPORT-RECORD.                                         DTSBD707
00500  P5060-EXIT.                                                      DTSBD707
00501      EXIT.                                                        DTSBD707
00502                                                                   DTSBD707
00503  P5200-FIND-MTAD.                                                 DTSBD707
00504      MOVE LOW-VALUES                 TO MTAD-KEY-AREA.            DTSBD707
00505      MOVE SORT-EMPLOYER              TO MTAD-EMP-NO.              DTSBD707
00506      SET MTAD-TAD-88                 TO TRUE.                     DTSBD707
00507      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSBD707
00508      MOVE MTAD-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD707
00509      PERFORM S910-READ THRU S910-EXIT.                            DTSBD707
00510  P5200-EXIT.                                                      DTSBD707
00511      EXIT.                                                        DTSBD707
00512                                                                   DTSBD707
00513  P6000-PRINT.                                                     DTSBD707
00514      PERFORM P9010-GET-MHDR THRU P9010-EXIT.                      DTSBD707
00515  P6000-P-1.                                                       DTSBD707
00516      READ REPORT-FILE                                             DTSBD707
00517        AT END                                                     DTSBD707
00518           GO TO P6000-EXIT.                                       DTSBD707
00519                                                                   DTSBD707
00520      IF WRK-PAGE-BREAK EQUAL SPACES                               DTSBD707
00521         MOVE RPT-REC-TYPE TO WRK-PAGE-REC-TYPE                    DTSBD707
00522         MOVE RPT-ZIP      TO WRK-PAGE-ZIP.                        DTSBD707
00523                                                                   DTSBD707
00524      IF RPT-REC-TYPE EQUAL '1'                                    DTSBD707
00525         PERFORM P6010-WRITE-MFAS THRU P6010-EXIT.                 DTSBD707
00526                                                                   DTSBD707
00527      IF  WRK-PAGE-REC-TYPE NOT EQUAL RPT-REC-TYPE                 DTSBD707
00528      OR  WRK-PAGE-ZIP      NOT EQUAL RPT-ZIP                      DTSBD707
00529      AND WRK-PAGE-REC-TYPE EQUAL '1'                              DTSBD707
00530      OR  WS-LINE-CNT       GREATER 51                             DTSBD707
00531         MOVE RPT-REC-TYPE  TO WRK-PAGE-REC-TYPE                   DTSBD707
00532         MOVE RPT-ZIP       TO WRK-PAGE-ZIP                        DTSBD707
00533         MOVE ZEROS         TO WS-LINE-CNT                         DTSBD707
00534         PERFORM P6020-PRINT-HEADER THRU P6020-EXIT.               DTSBD707
00535                                                                   DTSBD707
00536 ***  WRITE 1ST REPORT LINE  ***                                   DTSBD707
00537      MOVE RPT-EMPLOYER-NBR    TO WRK-PR-EMP.                      DTSBD707
00538      MOVE RPT-DUTAS-PURSUED   TO WRK-PR-NBR.                      DTSBD707
00539      MOVE WRK-PURSUED-REPORTS TO DTL1-FIELD1.                     DTSBD707
00540      MOVE RPT-DUTAS-NAME      TO DTL1-FIELD2.                     DTSBD707
00541                                                                   DTSBD707
00542      IF RPT-MSG-CD EQUAL SPACES                                   DTSBD707
00543         MOVE RPT-FUTA-NAME TO DTL1-FIELD3                         DTSBD707
00544      ELSE                                                         DTSBD707
00545      IF RPT-MSG-CD EQUAL '1'                                      DTSBD707
00546         MOVE ' !! NO MATCHING FUTA RECORD !!' TO DTL1-FIELD3      DTSBD707
00547      ELSE                                                         DTSBD707
00548      IF WRK-MSG-CD EQUAL '2'                                      DTSBD707
00549         MOVE ' !! NO DUTAS MAILING ADDRESS !!' TO DTL1-FIELD3     DTSBD707
00550      ELSE                                                         DTSBD707
00551      IF WRK-MSG-CD EQUAL '3'                                      DTSBD707
00552         MOVE ' !! DUTAS ADDRESS RECENTLY UPDATED !!' TO           DTSBD707
00553              DTL1-FIELD3                                          DTSBD707
00554      ELSE                                                         DTSBD707
00555         MOVE ' !! DUTAS ADDRESS RECENTLY CHANGED !!' TO           DTSBD707
00556              DTL1-FIELD3.                                         DTSBD707
00557      WRITE PRT-RECORD FROM DETAIL-LINE-1  AFTER 2.                DTSBD707
00558                                                                   DTSBD707
00559 ***  WRITE 2ND REPORT LINE  ***                                   DTSBD707
00560      MOVE RPT-DUTAS-PHONE (1:3) TO WRK-EP-AREA-CODE.              DTSBD707
00561      MOVE RPT-DUTAS-PHONE (4:3) TO WRK-EP-EXCHANGE.               DTSBD707
00562      MOVE RPT-DUTAS-PHONE (7:4) TO WRK-EP-NUMBER.                 DTSBD707
00563      MOVE WRK-EDIT-PHONE        TO DTL1-FIELD1.                   DTSBD707
00564      MOVE RPT-DUTAS-ADDR        TO DTL1-FIELD2.                   DTSBD707
00565      IF RPT-MSG-CD EQUAL SPACES                                   DTSBD707
00566         MOVE RPT-FUTA-ADDR TO DTL1-FIELD3                         DTSBD707
00567      ELSE                                                         DTSBD707
00568         MOVE SPACES        TO DTL1-FIELD3.                        DTSBD707
00569      WRITE PRT-RECORD FROM DETAIL-LINE-1  AFTER 1.                DTSBD707
00570                                                                   DTSBD707
00571 ***  WRITE 3ND REPORT LINE  ***                                   DTSBD707
00572      MOVE SPACES                TO DTL1-FIELD1.                   DTSBD707
00573      MOVE RPT-DUTAS-CITY        TO DTL1-FIELD2.                   DTSBD707
00574      MOVE RPT-DUTAS-STATE       TO DTL1-STATE2.                   DTSBD707
00575      MOVE RPT-DUTAS-ZIP         TO DTL1-ZIP2.                     DTSBD707
00576      IF RPT-MSG-CD EQUAL SPACES                                   DTSBD707
00577         MOVE RPT-FUTA-CITY       TO DTL1-FIELD3                   DTSBD707
00578         MOVE RPT-FUTA-STATE      TO DTL1-STATE3                   DTSBD707
00579         MOVE RPT-FUTA-ZIP (1:5)  TO DTL1-ZIP3                     DTSBD707
00580         IF RPT-FUTA-ZIP (6:4) GREATER ZEROS                       DTSBD707
00581            MOVE '-'                TO DTL1-ZIP3 (6:1)             DTSBD707
00582            MOVE RPT-FUTA-ZIP (6:4) TO DTL1-ZIP3 (7:4)             DTSBD707
00583         ELSE                                                      DTSBD707
00584            NEXT SENTENCE                                          DTSBD707
00585      ELSE                                                         DTSBD707
00586         MOVE SPACES TO DTL1-FIELD3.                               DTSBD707
00587      WRITE PRT-RECORD FROM DETAIL-LINE-1  AFTER 1.                DTSBD707
00588                                                                   DTSBD707
00589 *TMP*MOVE RPT-EMPLOYER-NBR TO WRK-EMPLOYER.                       DTSBD707
00590 *    PERFORM P9000-GET-MPRF THRU P9000-EXIT.                      DTSBD707
00591 *    IF L910-NO-REC-88                                            DTSBD707
00592 *       DISPLAY ' MPRF LOGIC SCREWUP-2<--' RPT-EMPLOYER-NBR       DTSBD707
00593 *       PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD707
00594 *    SET MPRF-MFAS-EXISTS-88 TO TRUE.                             DTSBD707
00595 *    MOVE MPRF-REC TO MSKL-REC.                                   DTSBD707
00596 *    PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD707
00597 *    IF NOT L910-OK-88                                            DTSBD707
00598 *       DISPLAY ' MPRF BAD REWRITE'                               DTSBD707
00599 *TMP*   PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD707
00600                                                                   DTSBD707
00601      ADD +4 TO WS-LINE-CNT.                                       DTSBD707
00602      GO TO P6000-P-1.                                             DTSBD707
00603  P6000-EXIT.                                                      DTSBD707
00604      EXIT.                                                        DTSBD707
00605                                                                   DTSBD707
00606  P6010-WRITE-MFAS.                                                DTSBD707
00607      INITIALIZE MFAS-REC.                                         DTSBD707
00608      MOVE RPT-EMPLOYER-NBR TO MFAS-EMP-NO.                        DTSBD707
00609      SET MFAS-STATUS-ACTIVE-88  TO TRUE.                          DTSBD707
00610      SET MFAS-NON-AUDIT-88      TO TRUE.                          DTSBD707
00611      ADD 1 TO MHDR-LAST-USED-ASSIGN-NO.                           DTSBD707
00612      MOVE MHDR-LAST-USED-ASSIGN-NO TO MFAS-ASSIGN-NO.             DTSBD707
00613                                                                   DTSBD707
00614      PERFORM P9030-GET-FIELD-REP THRU P9030-EXIT.                 DTSBD707
00615      MOVE L061-FLD-REP-ID TO MFAS-FLD-REP-ID.                     DTSBD707
00616      DISPLAY MFAS-EMP-NO ' ASSGN=' MHDR-LAST-USED-ASSIGN-NO       DTSBD707
00617              ' ' L061-FLD-REP-ID.                                 DTSBD707
00618      MOVE '13'            TO MFAS-ASSIGN-TYPE.                    DTSBD707
00619      MOVE L005-DATE       TO MFAS-START-DATE,                     DTSBD707
00620                              WRK-ADJUST-DATE.                     DTSBD707
00621      IF WRK-ADJUST-MM EQUAL 12                                    DTSBD707
00622         ADD 1 TO WRK-ADJUST-CCYY                                  DTSBD707
00623         MOVE 1 TO WRK-ADJUST-MM                                   DTSBD707
00624      ELSE                                                         DTSBD707
00625         ADD 1 TO WRK-ADJUST-MM.                                   DTSBD707
00626      MOVE WRK-ADJUST-DATE      TO MFAS-DUE-DATE.                  DTSBD707
00627      MOVE 'SYSTEM'             TO MFAS-SOURCE-OP-ID.              DTSBD707
00628      MOVE RPT-DUTAS-SIC-CD     TO MFAS-SIC-CD.                    DTSBD707
00629      MOVE RPT-DUTAS-NAICS-CD   TO MFAS-NAICS-CD                   DTSBD707
00630      MOVE RPT-DUTAS-OWN-CD     TO MFAS-OWN-CD.                    DTSBD707
00631      SET MFAS-NOT-CONVERTED-88 TO TRUE.                           DTSBD707
00632      MOVE L005-DATE            TO MFAS-ESTB-DATE,                 DTSBD707
00633                                   MFAS-CHNG-DATE.                 DTSBD707
00634      SET MFAS-FAS-88 TO TRUE.                                     DTSBD707
00635      MOVE MFAS-REC   TO MSKL-REC.                                 DTSBD707
00636                                                                   DTSBD707
00637 *TMP*PERFORM S910-WRITE THRU S910-EXIT.                           DTSBD707
00638 *    IF  L910-OK-88                                               DTSBD707
00639 *        NEXT SENTENCE                                            DTSBD707
00640 *    ELSE                                                         DTSBD707
00641 *       MOVE 'WRITE MFAS-REC ERROR' TO WRK-ABEND-MSG              DTSBD707
00642 *TMP*   PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD707
00643                                                                   DTSBD707
00644  P6010-EXIT.                                                      DTSBD707
00645      EXIT.                                                        DTSBD707
00646                                                                   DTSBD707
00647  P6020-PRINT-HEADER.                                              DTSBD707
00648      IF WRK-PAGE-REC-TYPE EQUAL '1'                               DTSBD707
00649         MOVE L061-FLD-REP-ID TO L062-FLD-REP-ID                   DTSBD707
00650         PERFORM S062-FLD-REP-NAME THRU S062-EXIT                  DTSBD707
00651         MOVE L062-NAME TO HDR2-FLD-REP-NAME                       DTSBD707
00652         MOVE RPT-ZIP   TO HDR2-ZIP                                DTSBD707
00653      ELSE                                                         DTSBD707
00654         MOVE SPACES TO HDR2-FLD-REP-NAME                          DTSBD707
00655         MOVE ' N/A' TO HDR2-ZIP.                                  DTSBD707
00656      ADD 1          TO WS-PAGE-CNT.                               DTSBD707
00657      MOVE WS-PAGE-CNT TO HDR2-PAGE-CNT                            DTSBD707
00658      WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE             DTSBD707
00659      WRITE PRT-RECORD FROM HEADER-2 AFTER 1                       DTSBD707
00660      WRITE PRT-RECORD FROM HEADER-3 AFTER 2                       DTSBD707
00661      WRITE PRT-RECORD FROM HEADER-4 AFTER 1.                      DTSBD707
00662  P6020-EXIT.                                                      DTSBD707
00663      EXIT.                                                        DTSBD707
00664                                                                   DTSBD707
00665  P9000-GET-MPRF.                                                  DTSBD707
00666      MOVE LOW-VALUE    TO MSKL-KEY-AREA.                          DTSBD707
00667      MOVE WRK-EMPLOYER TO MSKL-EMP-NO.                            DTSBD707
00668      SET MSKL-PRF-88   TO TRUE.                                   DTSBD707
00669                                                                   DTSBD707
00670      PERFORM S910-READ THRU S910-EXIT.                            DTSBD707
00671                                                                   DTSBD707
00672      IF L910-NO-REC-88                                            DTSBD707
00673         NEXT SENTENCE                                             DTSBD707
00674      ELSE                                                         DTSBD707
00675         MOVE MSKL-REC TO MPRF-REC.                                DTSBD707
00676  P9000-EXIT.                                                      DTSBD707
00677      EXIT.                                                        DTSBD707
00678                                                                   DTSBD707
00679  P9010-GET-MHDR.                                                  DTSBD707
00680      MOVE LOW-VALUE    TO MSKL-KEY-AREA.                          DTSBD707
00681      MOVE ZEROS        TO MSKL-EMP-NO.                            DTSBD707
00682      SET MSKL-HDR-88   TO TRUE.                                   DTSBD707
00683                                                                   DTSBD707
00684      PERFORM S910-READ THRU S910-EXIT.                            DTSBD707
00685                                                                   DTSBD707
00686      IF L910-NO-REC-88                                            DTSBD707
00687         DISPLAY ' MHDR NOT FOUND'                                 DTSBD707
00688         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD707
00689      ELSE                                                         DTSBD707
00690         MOVE MSKL-REC TO MHDR-REC.                                DTSBD707
00691  P9010-EXIT.                                                      DTSBD707
00692      EXIT.                                                        DTSBD707
00693                                                                   DTSBD707
00694  P9020-REWRITE-MHDR.                                              DTSBD707
00695      MOVE MHDR-REC TO MSKL-REC.                                   DTSBD707
00696      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD707
00697      IF NOT L910-OK-88                                            DTSBD707
00698         DISPLAY ' MHDR BAD REWRITE'                               DTSBD707
00699         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD707
00700  P9020-EXIT.                                                      DTSBD707
00701      EXIT.                                                        DTSBD707
00702                                                                   DTSBD707
00703  P9030-GET-FIELD-REP.                                             DTSBD707
00704      IF RPT-DUTAS-STATE EQUAL 'DC'                                DTSBD707
00705         MOVE RPT-DUTAS-ZIP TO L061-FLD-ZIP                        DTSBD707
00706      ELSE                                                         DTSBD707
00707         MOVE RPT-FUTA-ZIP (1:5) TO L061-FLD-ZIP.                  DTSBD707
00708      MOVE 'DC' TO L061-FLD-ST.                                    DTSBD707
00709                                                                   DTSBD707
00710      MOVE RPT-EMPLOYER-NBR TO L061-EMP-NO.                        DTSBD707
00711                                                                   DTSBD707
00712      PERFORM S061-LOOKUP-FLD-REP-ID THRU S061-EXIT.               DTSBD707
00713  P9030-EXIT.                                                      DTSBD707
00714      EXIT.                                                        DTSBD707
00715                                                                   DTSBD707
00716  T0000-TERMINATE.                                                 DTSBD707
00717      ADD  +1          TO WS-PAGE-CNT                              DTSBD707
00718      MOVE WS-PAGE-CNT TO HDR2-PAGE-CNT                            DTSBD707
00719      WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE             DTSBD707
00720      WRITE PRT-RECORD FROM HEADER-2 AFTER 1.                      DTSBD707
00721      MOVE ' *** PROCESSING STATISTICS FOR DTSBD707 ***' TO        DTSBD707
00722           PRT-RECORD.                                             DTSBD707
00723      WRITE PRT-RECORD AFTER 2.                                    DTSBD707
00724                                                                   DTSBD707
00725      MOVE ' NBR INPUT EMPLOYER RECORDS        ' TO WS-LITERAL-3.  DTSBD707
00726      MOVE WRK-BAR-IN-CNT                   TO WS-COUNTS-3.        DTSBD707
00727      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 2.                DTSBD707
00728                                                                   DTSBD707
00729      MOVE ' NBR INPUT FUTA RECORDS            ' TO WS-LITERAL-3.  DTSBD707
00730      MOVE WRK-FUTA-IN-CNT                       TO WS-COUNTS-3.   DTSBD707
00731      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 1.                DTSBD707
00732                                                                   DTSBD707
00733      MOVE ' NBR EMPLOYERS WITH MATCHING MPRF  ' TO WS-LITERAL-3.  DTSBD707
00734      MOVE WRK-BAR-WITH-MPRF-CNT                 TO WS-COUNTS-3.   DTSBD707
00735      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 2.                DTSBD707
00736                                                                   DTSBD707
00737      MOVE ' NBR EMPLOYERS NO MATCHING MPRF    ' TO WS-LITERAL-3.  DTSBD707
00738      MOVE WRK-BAR-NO-MPRF-CNT                   TO WS-COUNTS-3.   DTSBD707
00739      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 1.                DTSBD707
00740                                                                   DTSBD707
00741      MOVE ' NBR ADDRESSES RECENTLY UPDATED    ' TO WS-LITERAL-3.  DTSBD707
00742      MOVE WRK-MTAD-UPDATED-CNT                  TO WS-COUNTS-3.   DTSBD707
00743      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 1.                DTSBD707
00744                                                                   DTSBD707
00745      MOVE ' NBR EMPLOYERS WITH NO MTAD        ' TO WS-LITERAL-3.  DTSBD707
00746      MOVE WRK-NO-MTAD-CNT                       TO WS-COUNTS-3.   DTSBD707
00747      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 1.                DTSBD707
00748                                                                   DTSBD707
00749      MOVE ' NBR EMPLOYERS WITH MATCHING FUTA  ' TO WS-LITERAL-3.  DTSBD707
00750      MOVE WRK-BAR-WITH-FUTA-CNT                 TO WS-COUNTS-3.   DTSBD707
00751      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 2.                DTSBD707
00752                                                                   DTSBD707
00753      MOVE ' NBR EMPLOYERS NO MATCHING FUTA    ' TO WS-LITERAL-3.  DTSBD707
00754      MOVE WRK-BAR-NO-FUTA-CNT                   TO WS-COUNTS-3.   DTSBD707
00755      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 1.                DTSBD707
00756                                                                   DTSBD707
00757      MOVE ' NBR DUTAS ADDRESSES SAME AS FUTA  ' TO WS-LITERAL-3.  DTSBD707
00758      MOVE WRK-ADDR-SAME-CNT                     TO WS-COUNTS-3.   DTSBD707
00759      WRITE PRT-RECORD FROM DETAIL-LINE-3  AFTER 1.                DTSBD707
00760                                                                   DTSBD707
00761      CLOSE CERT-REQUEST-FILE, REPORT-FILE                         DTSBD707
00762            PRT-FILE1.                                             DTSBD707
00763 *TMP*PERFORM P9020-REWRITE-MHDR THRU P9020-EXIT.                  DTSBD707
00764      PERFORM S910-CLOSE         THRU S910-EXIT.                   DTSBD707
00765      PERFORM S921-CLOSE         THRU S921-EXIT.                   DTSBD707
00766      PERFORM S931-CLOSE         THRU S931-EXIT.                   DTSBD707
00767                                                                   DTSBD707
00768  T0000-EXIT.                                                      DTSBD707
00769      EXIT.                                                        DTSBD707
00770                                                                   DTSBD707
00771  S001-DATE.                                                       DTSBD707
00772      SKIP1                                                        DTSBD707
00773      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD707
00774      SKIP2                                                        DTSBD707
00775  S001-EXIT.                                                       DTSBD707
00776      EXIT.                                                        DTSBD707
00777                                                                   DTSBD707
00778  S005-SYS-DATE.                                                   DTSBD707
00779      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD707
00780  S005-EXIT.                                                       DTSBD707
00781      EXIT.                                                        DTSBD707
00782                                                                   DTSBD707
00783  S061-LOOKUP-FLD-REP-ID.                                          DTSBD707
00784      CALL 'DTSBU061' USING L061-LINK-AREA.                        DTSBD707
00785  S061-EXIT.                                                       DTSBD707
00786      EXIT.                                                        DTSBD707
00787                                                                   DTSBD707
00788  S062-FLD-REP-NAME.                                               DTSBD707
00789      CALL 'DTSBU062' USING L062-LINK-AREA.                        DTSBD707
00790  S062-EXIT.                                                       DTSBD707
00791      EXIT.                                                        DTSBD707
00792                                                                   DTSBD707
00793  S910-OPEN-READ.                                                  DTSBD707
00794      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD707
00795      GO TO S910-MSTR-IO.                                          DTSBD707
00796                                                                   DTSBD707
00797  S910-OPEN-UPDATE.                                                DTSBD707
00798      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD707
00799      GO TO S910-MSTR-IO.                                          DTSBD707
00800                                                                   DTSBD707
00801  S910-READ.                                                       DTSBD707
00802      SET L910-READ-88 TO TRUE.                                    DTSBD707
00803      GO TO S910-MSTR-IO.                                          DTSBD707
00804                                                                   DTSBD707
00805  S910-START-BROWSE.                                               DTSBD707
00806      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD707
00807      GO TO S910-MSTR-IO.                                          DTSBD707
00808                                                                   DTSBD707
00809  S910-READ-NEXT.                                                  DTSBD707
00810      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD707
00811      GO TO S910-MSTR-IO.                                          DTSBD707
00812                                                                   DTSBD707
00813  S910-COUNT.                                                      DTSBD707
00814      SET L910-COUNT-88 TO TRUE.                                   DTSBD707
00815      GO TO S910-MSTR-IO.                                          DTSBD707
00816                                                                   DTSBD707
00817  S910-WRITE.                                                      DTSBD707
00818      SET L910-WRITE-88 TO TRUE.                                   DTSBD707
00819      GO TO S910-MSTR-IO.                                          DTSBD707
00820                                                                   DTSBD707
00821  S910-REWRITE.                                                    DTSBD707
00822      SET L910-REWRITE-88 TO TRUE.                                 DTSBD707
00823      GO TO S910-MSTR-IO.                                          DTSBD707
00824                                                                   DTSBD707
00825  S910-CLOSE.                                                      DTSBD707
00826      SET L910-CLOSE-88     TO TRUE.                               DTSBD707
00827      GO TO S910-MSTR-IO.                                          DTSBD707
00828                                                                   DTSBD707
00829  S910-MSTR-IO.                                                    DTSBD707
00830      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD707
00831                            MSKL-REC.                              DTSBD707
00832  S910-EXIT.                                                       DTSBD707
00833      EXIT.                                                        DTSBD707
00834                                                                   DTSBD707
00835  S921-OPEN-READ.                                                  DTSBD707
00836      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD707
00837      GO TO S921-AIX-IO.                                           DTSBD707
00838                                                                   DTSBD707
00839  S921-OPEN-UPDATE.                                                DTSBD707
00840      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBD707
00841      GO TO S921-AIX-IO.                                           DTSBD707
00842                                                                   DTSBD707
00843  S921-READ.                                                       DTSBD707
00844      SET L921-READ-88 TO TRUE.                                    DTSBD707
00845      GO TO S921-AIX-IO.                                           DTSBD707
00846                                                                   DTSBD707
00847  S921-START-BROWSE.                                               DTSBD707
00848      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD707
00849      GO TO S921-AIX-IO.                                           DTSBD707
00850                                                                   DTSBD707
00851  S921-READ-NEXT.                                                  DTSBD707
00852      SET L921-READ-NEXT-88 TO TRUE.                               DTSBD707
00853      GO TO S921-AIX-IO.                                           DTSBD707
00854                                                                   DTSBD707
00855  S921-CLOSE.                                                      DTSBD707
00856      SET L921-CLOSE-88 TO TRUE.                                   DTSBD707
00857      GO TO S921-AIX-IO.                                           DTSBD707
00858                                                                   DTSBD707
00859  S921-AIX-IO.                                                     DTSBD707
00860      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD707
00861                            ISKL-REC.                              DTSBD707
00862  S921-EXIT.                                                       DTSBD707
00863      EXIT.                                                        DTSBD707
00864                                                                   DTSBD707
00865  S931-OPEN-READ.                                                  DTSBD707
00866      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD707
00867      GO TO S931-REF-IO.                                           DTSBD707
00868                                                                   DTSBD707
00869  S931-CLOSE.                                                      DTSBD707
00870      SET L931-CLOSE-88 TO TRUE.                                   DTSBD707
00871      GO TO S931-REF-IO.                                           DTSBD707
00872                                                                   DTSBD707
00873  S931-REF-IO.                                                     DTSBD707
00874      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD707
00875                            FSKL-REC.                              DTSBD707
00876  S931-EXIT.                                                       DTSBD707
00877      EXIT.                                                        DTSBD707
00878                                                                   DTSBD707
00879  S999-ABEND.                                                      DTSBD707
00880                                                                   DTSBD707
00881      DISPLAY '****  DTSBD707 ABENDING '                           DTSBD707
00882         WRK-ABEND-MSG.                                            DTSBD707
00883      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD707
00884                                                                   DTSBD707
00885  S999-EXIT.                                                       DTSBD707
00886      EXIT.                                                        DTSBD707
00887                                                                   DTSBD707
