00001  IDENTIFICATION DIVISION.                                         03/21/12
00002  PROGRAM-ID.             DTSBE351.                                DTSBE351
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV026
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE351
00005  DATE-COMPILED.                                                   DTSBE351
00006      SKIP3                                                        DTSBE351
00007 *****                                                             DTSBE351
00008 *                                                                 DTSBE351
00009 *    FUNCTION:  EMPLOYER REPORT MASS MAILING EXTRACT.             DTSBE351
00010 *                                                                 DTSBE351
00011 *                                                                 DTSBE351
00012 *    MODIFICATION LOG:                                            DTSBE351
00013 *                                                                 DTSBE351
00014 *    05/23/96  NEW LOGIC ADDED FOR PROCESSING ELECTRONIC FILING   DTSBE351
00015 *              UC-30.                                             DTSBE351
00016 *              WORK ORDER: NONE                 PROGRAMMER: SFW   DTSBE351
00017 *                                                                 DTSBE351
00018 *    08/06/96  RECOMPILED BECAUSE R902-ELF-ADD-88 ADDED TO DAILY  DTSBE351
00019 *              SORT IN DTSIR902.                                  DTSBE351
00020 *              REFERENCE RFP: #WARPII           PROGRAMMER: MJA   DTSBE351
00021 *                                                                 DTSBE351
00022 *    12/02/96  ADDED R908-ELECTRONIC-FILER-IND TO R908 SORT AREA  DTSBE351
00023 *              ADDED CODE TO P2000-SETUP-BASIC-R902 PARAGRAPH     DTSBE351
00024 *              SINCE THAT IS WHERE THE ELF RECORDS ARE READ.      DTSBE351
00025 *              REFERENCE RFP: #WARP II          PROGRAMMER: MJA   DTSBE351
00026 *                                                                 DTSBE351
00027 *    03/03/1999  REVIEWED AND MODIFIED FOR DC.                    DTSBE351
00028 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBE351
00029 *                                                                 DTSBE351
00030 *    05/24/1999  PICKUP MODIFICATION.  PARM YRQ >= LECM-PICKUP-   DTSBE351
00031 *                YRQ.                                             DTSBE351
00032 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSBE351
00033 *                                                                 DTSBE351
00034 *    06/03/1999  MODIFIED R902 GENERATION FOR DC REQUIREMENTS.    DTSBE351
00035 *                REFERENCE: DIR 68              PROGRAMMER: GD    DTSBE351
00036 *                                                                 DTSBE351
00037 *    12/08/1999  ADD LECM-PARM-DISP-CREDIT-IND.  SUPPRESSES       DTSBE351
00038 *                PRINTING OF CREDIT AMOUNTS FOR ALL EMPLOYERS.    DTSBE351
00039 *                REFERENCE:                     PROGRAMMER: GD    DTSBE351
00040 *                                                                 DTSBE351
00041 *    09/06/2000  ADDED CODE TO READ MFAE TYPE 1 (UC30) RECORD.    DTSBE351
00042 *                IF RECORD IS FOUND, UC30 WILL NOT BE PRINTED.    DTSBE351
00043 *                REFERENCE:                     PROGRAMMER: ZL1   DTSBE351
00044 *                                                                 DTSBE351
00045 *    12/11/2001  ADDED CODE TO BYPASS HOUSEHOLD EMPLOYERS         DTSBE351
00046 *                FILING ANNUALLY.                                 DTSBE351
00047 *                REFERENCE:                     PROGRAMMER: ZL1   DTSBE351
00048 *                                                                 DTSBE351
00049 *    08/14/2002  RECOMPILED FOR NEW VERSION OF DTSIL516.  THE     DTSBE351
00050 *                PROGRAM WILL TREAT EMPLOYERS WITH ESTIMATED      DTSBE351
00051 *                RATES AS IF THERE WERE NO RATE ON FILE: IT       DTSBE351
00052 *                IT NOT SEND A UC30, AND WILL WRITE AN R907       DTSBE351
00053 *                ERROR MESSAGE.                                   DTSBE351
00054 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBE351
00055 *                                                                 DTSBE351
00056 *                                                                 DTSBE351
00057 *    10/10/2007  ADDED CODE TO BYPASS ICESA EMPLOYERS. DO NOT     DTSBE351
00058 *                PRINT UC30 FOR EMPLOYERS FILING ICESA REPORT.    DTSBE351
00059 *                REFERENCE:                     PROGRAMMER: ZL1   DTSBE351
00060 *                                                                 DTSBE351
00061 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE351
00062 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE351
00063 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBE351
00064 *                                                                 DTSBE351
00065 *                                                                 DTSBE351
00066 *  DESCRIPTION:                                                   DTSBE351
00067 *                                                                 DTSBE351
00068 *                                                                 DTSBE351
00069 *    INITIATION:                                                  DTSBE351
00070 *                                                                 DTSBE351
00071 *      SET LECM-MST-OPEN-UPDATE-88 TO TRUE.                       DTSBE351
00072 *      SET LECM-REF-OPEN-UPDATE-88 TO TRUE.                       DTSBE351
00073 *                                                                 DTSBE351
00074 *      EDIT AND DEFAULT PARAMETERS.  SEE PRINTED OUTPUTS          DTSBE351
00075 *      DESCRIPTIONS AND LAYOUTS (902R1 AND 902R2).                DTSBE351
00076 *                                                                 DTSBE351
00077 *      IF WRK-PARM-SUBJECT-YRQ IS GREATER THAN                    DTSBE351
00078 *      LECM-LAST-UC30-MASS-MAIL-YRQ THEN MOVE                     DTSBE351
00079 *      WRK-PARM-SUBJECT-YRQ TO LECM-LAST-UC30-MASS-MAIL-YRQ.      DTSBE351
00080 *                                                                 DTSBE351
00081 *      READ FCYR RECORD (TO LOOKUP WRK-TAX-WAGE-BASE).            DTSBE351
00082 *                                                                 DTSBE351
00083 *                                                                 DTSBE351
00084 *    PROCESSING:                                                  DTSBE351
00085 *                                                                 DTSBE351
00086 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (719R1,        DTSBE351
00087 *      902R1, 902R2, AND 908R1).                                  DTSBE351
00088 *                                                                 DTSBE351
00089 *                                                                 DTSBE351
00090 *    TERMINATION:                                                 DTSBE351
00091 *                                                                 DTSBE351
00092 *      READ THE MHDR RECORD.  IF WRK-PARM-SUBJECT-YRQ IS          DTSBE351
00093 *      GREATER THAN MHDR-LAST-UC30-MASS-MAIL-YRQ THEN MOVE        DTSBE351
00094 *      WRK-PARM-SUBJECT-YRQ TO MHDR-LAST-UC30-MASS-MAIL-YRQ       DTSBE351
00095 *      AND REWRITE THE MHDR-RECORD.                               DTSBE351
00096 *                                                                 DTSBE351
00097 *      READ FQTR RECORD FOR WRK-PARM-SUBJECT-YRQ.  IF FOUND,      DTSBE351
00098 *      REWRITE; IF NOT FOUND, CREATE A FQTR RECORD AND WRITE.     DTSBE351
00099 *      MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-MASS-MAIL-DATE.       DTSBE351
00100 *                                                                 DTSBE351
00101 *                                                                 DTSBE351
00102 *    RECORDS READ:                                                DTSBE351
00103 *                                                                 DTSBE351
00104 *      MASTER:                                                    DTSBE351
00105 *                                                                 DTSBE351
00106 *        MHDR                                                     DTSBE351
00107 *        MQTR                                                     DTSBE351
00108 *        MFAE                                                     DTSBE351
00109 *                                                                 DTSBE351
00110 *      ALTERNATE INDEX:                                           DTSBE351
00111 *                                                                 DTSBE351
00112 *        NONE.                                                    DTSBE351
00113 *                                                                 DTSBE351
00114 *                                                                 DTSBE351
00115 *      REFERENCE:                                                 DTSBE351
00116 *                                                                 DTSBE351
00117 *        FCYR                                                     DTSBE351
00118 *        FQTR                                                     DTSBE351
00119 *                                                                 DTSBE351
00120 *                                                                 DTSBE351
00121 *    RECORDS UPDATED:                                             DTSBE351
00122 *                                                                 DTSBE351
00123 *        MHDR (REWRITE)                                           DTSBE351
00124 *        FQTR (WRITE, REWRITE)                                    DTSBE351
00125 *                                                                 DTSBE351
00126 *                                                                 DTSBE351
00127 *    REPORT RECORDS WRITTEN:                                      DTSBE351
00128 *                                                                 DTSBE351
00129 *        R719  RQC CONTRIBUTION REPORT UNIVERSE.                  DTSBE351
00130 *        R902  EMPLOYER'S QUARTERLY WAGE REPORT.                  DTSBE351
00131 *        R907  UNUSUAL CONDITIONS ENCOUNTERED REPORT.             DTSBE351
00132 *        R908  UC-30 COUNTS LIST.                                 DTSBE351
00133 *                                                                 DTSBE351
00134 *                                                                 DTSBE351
00135 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE351
00136 *                                                                 DTSBE351
00137 *        NONE.                                                    DTSBE351
00138 *                                                                 DTSBE351
00139 *                                                                 DTSBE351
00140 *    MODULES CALLED:                                              DTSBE351
00141 *                                                                 DTSBE351
00142 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBE351
00143 *        DTSBU004  QUARTER CONVERSION/EDIT.                       DTSBE351
00144 *        DTSBU111  ADDRESS LOOKUP.                                DTSBE351
00145 *        DTSBU112  ADDRESS FORMAT.                                DTSBE351
00146 *        DTSBU516  DETERMINE LIABILITY, DUE DATE, AND RATE        DTSBE351
00147 *                  FOR A GIVEN QUARTER.                           DTSBE351
00148 *        DTSBU910  MASTER FILE I/O DRIVER.                        DTSBE351
00149 *        DTSBU931  REFERENCE FILE I/O DRIVER.                     DTSBE351
00150 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE351
00151 *                                                                 DTSBE351
00152 *                                                                 DTSBE351
00153 *****                                                             DTSBE351
00154      SKIP3                                                        DTSBE351
00155  ENVIRONMENT DIVISION.                                            DTSBE351
00156      EJECT                                                        DTSBE351
00157  DATA DIVISION.                                                   DTSBE351
00158      SKIP3                                                        DTSBE351
00159  WORKING-STORAGE SECTION.                                         DTSBE351
001595 77  PAN-VALET PICTURE X(24) VALUE '026DTSBE351  03/21/12'.       DTSBE351
00160      SKIP3                                                        DTSBE351
00161  01  WRK-AREA.                                                    DTSBE351
00162      05  WRK-ABEND-CD               PIC S9(04)  COMP  VALUE +351. DTSBE351
00163                                                                   DTSBE351
00164      05  WRK-MOD-NAME               PIC  X(08)  VALUE 'DTSBE351'. DTSBE351
00165                                                                   DTSBE351
00166                                                                   DTSBE351
00167      05  ABEND-MSG                  PIC  X(60).                   DTSBE351
00168                                                                   DTSBE351
00169                                                                   DTSBE351
00170      05  WRK-PARM-SUBJECT-YRQ       PIC S9(05)  COMP-3.           DTSBE351
00171      05  WRK-LAST-UC30-MAIL-YRQ     PIC S9(05)  COMP-3.           DTSBE351
00172                                                                   DTSBE351
00173                                                                   DTSBE351
00174      05  WRK-UC30-SKIP-IND              PIC  X(08).               DTSBE351
00175          88  WRK-UC30-SKIP-MAG-88     VALUE 'MAG UC30'.           DTSBE351
00176          88  WRK-UC30-SKIP-WEB-88     VALUE 'WEB UC30'.           DTSBE351
00177          88  WRK-UC30-SKIP-VALID-88   VALUE 'WEB UC30',           DTSBE351
00178                                             'MAG UC30'.           DTSBE351
00179      05  WRK-UC30-SKIP-88               PIC  X(01).               DTSBE351
00180          88  WRK-UC30-SKIP-YES-88     VALUE 'Y'.                  DTSBE351
00181          88  WRK-UC30-SKIP-NO-88      VALUE 'N'.                  DTSBE351
00182                                                                   DTSBE351
00183      05  WRK-PARM-DISP-CREDIT-IND       PIC  X(01).               DTSBE351
00184          88  WRK-PARM-DISP-CREDIT-YES-88     VALUE 'Y'.           DTSBE351
00185          88  WRK-PARM-DISP-CREDIT-NO-88      VALUE 'N'.           DTSBE351
00186          88  WRK-PARM-DISP-CREDIT-VALID-88   VALUE 'Y', 'N'.      DTSBE351
00187                                                                   DTSBE351
00188                                                                   DTSBE351
00189      05  WRK-TAX-WAGE-BASE          PIC S9(07)V9(02)  COMP-3.     DTSBE351
00190                                                                   DTSBE351
00191      05  TOT-MPRF-READ              PIC 9(05) VALUE ZEROS.        DTSBE351
00192      05  TOT-MPRF-READ-NOT-ACTIVE   PIC 9(05) VALUE ZEROS.        DTSBE351
00193      05  TOT-MPRF-READ-NOT-LIABLE   PIC 9(05) VALUE ZEROS.        DTSBE351
00194      05  TOT-MPRF-READ-ANN-FILER    PIC 9(05) VALUE ZEROS.        DTSBE351
00195      05  TOT-MPRF-READ-PEND-SCHED   PIC 9(05) VALUE ZEROS.        DTSBE351
00196      05  TOT-MPRF-READ-RPT-TYPE     PIC 9(05) VALUE ZEROS.        DTSBE351
00197      05  TOT-MPRF-READ-NO-RATE      PIC 9(05) VALUE ZEROS.        DTSBE351
00198      05  TOT-MPRF-RETN-NO-MAIL      PIC 9(05) VALUE ZEROS.        DTSBE351
00199      05  TOT-MPRF-READ-NO-MAIL      PIC 9(05) VALUE ZEROS.        DTSBE351
00200      05  TOT-MPRF-READ-MAG-UC30     PIC 9(05) VALUE ZEROS.        DTSBE351
00201      05  TOT-MPRF-READ-NOT-UC30     PIC 9(05) VALUE ZEROS.        DTSBE351
00202      05  TOT-MPRF-READ-R902         PIC 9(05) VALUE ZEROS.        DTSBE351
00203                                                                   DTSBE351
00204      05  WRK-SLASH-QTR              PIC X(04).                    DTSBE351
00205                                                                   DTSBE351
00206      05  WRK-EDIT-STATUS-IND             PIC X(01).               DTSBE351
00207          88  WRK-EDIT-PASSED-88                VALUE 'Y'.         DTSBE351
00208          88  WRK-EDIT-FAILED-88                VALUE 'N'.         DTSBE351
00209                                                                   DTSBE351
00210                                                                   DTSBE351
00211                                                                   DTSBE351
00212      05  WRK-MFAE-IND               PIC X(01).                    DTSBE351
00213          88  WRK-MFAE-FOUND-88                  VALUE  'Y'.       DTSBE351
00214          88  WRK-MFAE-NOT-FOUND-88              VALUE  'N'.       DTSBE351
00215                                                                   DTSBE351
00216      05  WRK-MQTR-IND               PIC X(01).                    DTSBE351
00217          88  WRK-MQTR-FOUND-88                  VALUE  'Y'.       DTSBE351
00218          88  WRK-MQTR-NOT-FOUND-88              VALUE  'N'.       DTSBE351
00219      EJECT                                                        DTSBE351
00220  01  MSG-AREA.                                                    DTSBE351
00221      05  MSG1-AREA.                                               DTSBE351
00222          10  MSG1-ID                PIC  X(03)  VALUE '393'.      DTSBE351
00223          10  MSG1-TEXT.                                           DTSBE351
00224              15  FILLER             PIC  X(40)                    DTSBE351
00225                VALUE 'RATE MISSING.  NO QUARTERLY REPORT PRINT'.  DTSBE351
00226              15  FILLER             PIC  X(40)                    DTSBE351
00227                VALUE 'ED FROM UC-30 MASS MAILING RUN.  YRQ =  '.  DTSBE351
00228              15  MSG1-SLASHED-YRQ   PIC  X(04).                   DTSBE351
00229      EJECT                                                        DTSBE351
00230  01  L001-LINK-AREA.                                              DTSBE351
00231  ++INCLUDE DTSIL001                                               DTSBE351
00232      EJECT                                                        DTSBE351
00233  01  L004-LINK-AREA.                                              DTSBE351
00234  ++INCLUDE DTSIL004                                               DTSBE351
00235      EJECT                                                        DTSBE351
00236  01  L111-LINK-AREA.                                              DTSBE351
00237  ++INCLUDE DTSIL111                                               DTSBE351
00238      EJECT                                                        DTSBE351
00239  01  L112-LINK-AREA.                                              DTSBE351
00240  ++INCLUDE DTSIL112                                               DTSBE351
00241      EJECT                                                        DTSBE351
00242  01  L516-LINK-AREA.                                              DTSBE351
00243  ++INCLUDE DTSIL516                                               DTSBE351
00244      EJECT                                                        DTSBE351
00245  01  L910-LINK-AREA.                                              DTSBE351
00246  ++INCLUDE DTSIL910                                               DTSBE351
00247      SKIP3                                                        DTSBE351
00248  01  MSKL-REC.                                                    DTSBE351
00249  ++INCLUDE DTSIMSKL                                               DTSBE351
00250      EJECT                                                        DTSBE351
00251  01  MRPT-REC.                                                    DTSBE351
00252  ++INCLUDE DTSIMRPT                                               DTSBE351
00253      EJECT                                                        DTSBE351
00254  01  MHDR-REC.                                                    DTSBE351
00255  ++INCLUDE DTSIMHDR                                               DTSBE351
00256      EJECT                                                        DTSBE351
00257  01  MELF-REC.                                                    DTSBE351
00258  ++INCLUDE DTSIMELF                                               DTSBE351
00259      EJECT                                                        DTSBE351
00260  01  MQTR-REC.                                                    DTSBE351
00261  ++INCLUDE DTSIMQTR                                               DTSBE351
00262      EJECT                                                        DTSBE351
00263 *01  MTNM-REC.                                                    DTSBE351
00264 ***INCLUDE DTSIMTNM                                               DTSBE351
00265      EJECT                                                        DTSBE351
00266 *01  MTCK-REC.                                                    DTSBE351
00267 ***INCLUDE DTSIMTCK                                               DTSBE351
00268      EJECT                                                        DTSBE351
00269  01  L931-LINK-AREA.                                              DTSBE351
00270  ++INCLUDE DTSIL931                                               DTSBE351
00271      EJECT                                                        DTSBE351
00272  01  FSKL-REC.                                                    DTSBE351
00273  ++INCLUDE DTSIFSKL                                               DTSBE351
00274      EJECT                                                        DTSBE351
00275  01  FCYR-REC.                                                    DTSBE351
00276  ++INCLUDE DTSIFCYR                                               DTSBE351
00277      EJECT                                                        DTSBE351
00278  01  FQTR-REC.                                                    DTSBE351
00279  ++INCLUDE DTSIFQTR                                               DTSBE351
00280      EJECT                                                        DTSBE351
00281  01  MFAE-REC.                                                    DTSBE351
00282  ++INCLUDE DTSIMFAE                                               DTSBE351
00283      EJECT                                                        DTSBE351
00284  01  R719-REC.                                                    DTSBE351
00285  ++INCLUDE DTSIR719                                               DTSBE351
00286      SKIP3                                                        DTSBE351
00287  01  R902-REC.                                                    DTSBE351
00288  ++INCLUDE DTSIR902                                               DTSBE351
00289      SKIP3                                                        DTSBE351
00290  01  R907-REC.                                                    DTSBE351
00291  ++INCLUDE DTSIR907                                               DTSBE351
00292      SKIP3                                                        DTSBE351
00293  01  R908-REC.                                                    DTSBE351
00294  ++INCLUDE DTSIR908                                               DTSBE351
00295      EJECT                                                        DTSBE351
00296  LINKAGE SECTION.                                                 DTSBE351
00297                                                                   DTSBE351
00298  01  LECM-LINK-AREA.                                              DTSBE351
00299  ++INCLUDE DTSILECM                                               DTSBE351
00300                                                                   DTSBE351
00301                                                                   DTSBE351
00302          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE351
00303              15  LECM-PARM-SUBJECT-YRQ           PIC  X(03).      DTSBE351
00304              15  FILLER                          PIC  X(01).      DTSBE351
00305              15  LECM-PARM-DISP-CREDIT-IND       PIC  X(01).      DTSBE351
00306                  88  LECM-PARM-DISP-CREDIT-YES-88  VALUE 'Y'.     DTSBE351
00307                  88  LECM-PARM-DISP-CREDIT-NO-88   VALUE 'N'.     DTSBE351
00308              15  FILLER                          PIC  X(63).      DTSBE351
00309      EJECT                                                        DTSBE351
00310  01  MPRF-LINK-REC.                                               DTSBE351
00311  ++INCLUDE DTSIMPRF                                               DTSBE351
00312      EJECT                                                        DTSBE351
00313  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE351
00314                           MPRF-LINK-REC.                          DTSBE351
00315                                                                   DTSBE351
00316      EVALUATE TRUE                                                DTSBE351
00317      WHEN LECM-PROCESS-88                                         DTSBE351
00318          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE351
00319                                                                   DTSBE351
00320      WHEN LECM-INITIALIZE-88                                      DTSBE351
00321          SET WRK-EDIT-PASSED-88 TO TRUE                           DTSBE351
00322          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE351
00323          IF WRK-EDIT-FAILED-88                                    DTSBE351
00324             PERFORM S999-ABEND THRU S999-EXIT                     DTSBE351
00325          END-IF                                                   DTSBE351
00326                                                                   DTSBE351
00327      WHEN LECM-TERMINATE-88                                       DTSBE351
00328          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE351
00329                                                                   DTSBE351
00330      WHEN OTHER                                                   DTSBE351
00331          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE351
00332            TO ABEND-MSG                                           DTSBE351
00333          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE351
00334                                                                   DTSBE351
00335                                                                   DTSBE351
00336      GOBACK.                                                      DTSBE351
00337      EJECT                                                        DTSBE351
00338  I0000-INITIALIZE.                                                DTSBE351
00339      MOVE LECM-TRACE-IND TO L910-TRACE-IND                        DTSBE351
00340                             L931-TRACE-IND                        DTSBE351
00341                             L516-TRACE-IND.                       DTSBE351
00342                                                                   DTSBE351
00343      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBE351
00344                           L931-MOD-NAME                           DTSBE351
00345                           R907-MODULE-NAME.                       DTSBE351
00346                                                                   DTSBE351
00347                                                                   DTSBE351
00348      MOVE LENGTH OF R719-REC TO R719-LENGTH.                      DTSBE351
00349                                                                   DTSBE351
00350      MOVE LENGTH OF R902-REC TO R902-LENGTH.                      DTSBE351
00351                                                                   DTSBE351
00352      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBE351
00353                                                                   DTSBE351
00354      MOVE LENGTH OF R908-REC TO R908-LENGTH.                      DTSBE351
00355                                                                   DTSBE351
00356                                                                   DTSBE351
00357      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE351
00358                                                                   DTSBE351
00359                                                                   DTSBE351
00360      IF WRK-PARM-SUBJECT-YRQ > LECM-LAST-UC30-MASS-MAIL-YRQ       DTSBE351
00361          MOVE WRK-PARM-SUBJECT-YRQ                                DTSBE351
00362            TO LECM-LAST-UC30-MASS-MAIL-YRQ.                       DTSBE351
00363                                                                   DTSBE351
00364                                                                   DTSBE351
00365      MOVE LOW-VALUES TO FCYR-KEY-AREA.                            DTSBE351
00366                                                                   DTSBE351
00367      SET FCYR-CYR-88 TO TRUE.                                     DTSBE351
00368                                                                   DTSBE351
00369      MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9.                   DTSBE351
00370                                                                   DTSBE351
00371      MOVE L004-QTR-5-YR TO FCYR-YR.                               DTSBE351
00372                                                                   DTSBE351
00373      MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBE351
00374                                                                   DTSBE351
00375      PERFORM S931-READ THRU S931-EXIT.                            DTSBE351
00376                                                                   DTSBE351
00377      IF L931-NO-REC-88                                            DTSBE351
00378          MOVE 'TAXABLE WAGE BASE NOT FOUND'                       DTSBE351
00379            TO ABEND-MSG                                           DTSBE351
00380          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE351
00381                                                                   DTSBE351
00382      MOVE FSKL-REC TO FCYR-REC.                                   DTSBE351
00383                                                                   DTSBE351
00384      MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE.            DTSBE351
00385                                                                   DTSBE351
00386                                                                   DTSBE351
00387      SET LECM-MST-OPEN-UPDATE-HDR-88 TO TRUE.                     DTSBE351
00388                                                                   DTSBE351
00389      SET LECM-REF-OPEN-UPDATE-88 TO TRUE.                         DTSBE351
00390  I0000-EXIT.                                                      DTSBE351
00391      EXIT.                                                        DTSBE351
00392  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE351
00393      PERFORM I1100-SUBJECT-YRQ    THRU I1100-EXIT.                DTSBE351
00394      PERFORM I1200-DISPLAY-CREDIT THRU I1200-EXIT.                DTSBE351
00395  I1000-EXIT.                                                      DTSBE351
00396      EXIT.                                                        DTSBE351
00397      SKIP3                                                        DTSBE351
00398  I1100-SUBJECT-YRQ.                                               DTSBE351
00399      IF LECM-PARM-SUBJECT-YRQ = SPACES                            DTSBE351
00400          MOVE LECM-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9        DTSBE351
00401          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSBE351
00402          ADD +1 TO L004-ABS-QTR                                   DTSBE351
00403          PERFORM S004-FROM-ABS THRU S004-EXIT                     DTSBE351
00404          MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ                DTSBE351
00405      ELSE                                                         DTSBE351
00406          MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X               DTSBE351
00407          PERFORM S004-FROM-3 THRU S004-EXIT                       DTSBE351
00408          IF (L004-VALID-QTR)                                      DTSBE351
00409                 AND                                               DTSBE351
00410             (L004-QTR-5-9 > LECM-PICKUP-YRQ)                      DTSBE351
00411              MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ            DTSBE351
00412          ELSE                                                     DTSBE351
00413              MOVE 'PARM-SUBJECT-YRQ NOT VALID'                    DTSBE351
00414                TO ABEND-MSG                                       DTSBE351
00415              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE351
00416                                                                   DTSBE351
00417      DISPLAY  'LAST UC30 MAIL YRQ ' LECM-LAST-UC30-MASS-MAIL-YRQ. DTSBE351
00418      MOVE LECM-LAST-UC30-MASS-MAIL-YRQ TO WRK-LAST-UC30-MAIL-YRQ. DTSBE351
00419                                                                   DTSBE351
00420      MOVE L004-SLASH-QTR          TO  WRK-SLASH-QTR.              DTSBE351
00421  I1100-EXIT.                                                      DTSBE351
00422      EXIT.                                                        DTSBE351
00423                                                                   DTSBE351
00424  I1200-DISPLAY-CREDIT.                                            DTSBE351
00425      MOVE LECM-PARM-DISP-CREDIT-IND TO                            DTSBE351
00426           WRK-PARM-DISP-CREDIT-IND.                               DTSBE351
00427                                                                   DTSBE351
00428      IF WRK-PARM-DISP-CREDIT-IND = SPACES                         DTSBE351
00429         SET WRK-PARM-DISP-CREDIT-NO-88 TO TRUE.                   DTSBE351
00430                                                                   DTSBE351
00431      IF WRK-PARM-DISP-CREDIT-VALID-88                             DTSBE351
00432         NEXT SENTENCE                                             DTSBE351
00433       ELSE                                                        DTSBE351
00434           MOVE 'PARM-DISP-CREDIT-IND NOT VALID'                   DTSBE351
00435             TO ABEND-MSG                                          DTSBE351
00436           PERFORM S999-ABEND THRU S999-EXIT.                      DTSBE351
00437                                                                   DTSBE351
00438  I1200-EXIT.                                                      DTSBE351
00439      EXIT.                                                        DTSBE351
00440      EJECT                                                        DTSBE351
00441 ***************************************************************   DTSBE351
00442                                                                   DTSBE351
00443 *  THE REPORT EXTRACT RECORDS FOR THE QUARTERLY REPORTS.          DTSBE351
00444 *  R719 - WRITTEN FOR RATED EMPLOYERS                             DTSBE351
00445 *  R902 - WRITTEN FOR BOTH RATED AND SELF INSURED EMPLOYERS       DTSBE351
00446 *  R908 - WRITTEN FOR ALL EMPLOYERS                               DTSBE351
00447 *  R907 - WRITTEN FOR EMPLOYERS WITH NO RATE (NO UC30 SENT        DTSBE351
00448 *         TO THESE EMPLOYERS)                                     DTSBE351
00449 ***************************************************************   DTSBE351
00450                                                                   DTSBE351
00451  P0000-PROCESS.                                                   DTSBE351
00452      ADD 1 TO TOT-MPRF-READ                                       DTSBE351
00453                                                                   DTSBE351
00454      IF MPRF-CLASS-SUB-88                                         DTSBE351
00455          NEXT SENTENCE                                            DTSBE351
00456      ELSE                                                         DTSBE351
00457          ADD 1 TO TOT-MPRF-READ-NOT-ACTIVE                        DTSBE351
00458          GO TO P0000-EXIT.                                        DTSBE351
00459                                                                   DTSBE351
00460                                                                   DTSBE351
00461      MOVE WRK-PARM-SUBJECT-YRQ       TO  L516-YRQ.                DTSBE351
00462                                                                   DTSBE351
00463      PERFORM S516-LIABILITY THRU S516-EXIT.                       DTSBE351
00464                                                                   DTSBE351
00465      IF L516-NOT-LIABLE-88                                        DTSBE351
00466          ADD 1 TO TOT-MPRF-READ-NOT-LIABLE                        DTSBE351
00467          GO TO P0000-EXIT.                                        DTSBE351
00468                                                                   DTSBE351
00469      IF L516-ANN-SCHED-88                                         DTSBE351
00470          ADD 1 TO TOT-MPRF-READ-ANN-FILER                         DTSBE351
00471          GO TO P0000-EXIT.                                        DTSBE351
00472                                                                   DTSBE351
00473      IF L516-PENDING-SCHED-88                                     DTSBE351
00474          ADD 1 TO TOT-MPRF-READ-PEND-SCHED                        DTSBE351
00475         PERFORM P1000-WRITE-907 THRU P1000-EXIT                   DTSBE351
00476         GO TO P0000-EXIT.                                         DTSBE351
00477                                                                   DTSBE351
00478      IF MPRF-CLASS-SELF-INS-88                                    DTSBE351
00479          NEXT SENTENCE                                            DTSBE351
00480      ELSE                                                         DTSBE351
00481          MOVE MPRF-EMP-NO TO R719-EMP-NO                          DTSBE351
00482          MOVE LECM-CURR-RUN-DATE TO R719-RUN-DATE                 DTSBE351
00483          PERFORM S946-WRITE-R719 THRU S946-EXIT.                  DTSBE351
00484                                                                   DTSBE351
00485                                                                   DTSBE351
00486      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE351
00487                                                                   DTSBE351
00488      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE351
00489                                                                   DTSBE351
00490      SET MQTR-QTR-88 TO TRUE.                                     DTSBE351
00491                                                                   DTSBE351
00492      MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ.                       DTSBE351
00493                                                                   DTSBE351
00494      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE351
00495                                                                   DTSBE351
00496      PERFORM S910-READ THRU S910-EXIT.                            DTSBE351
00497                                                                   DTSBE351
00498      IF L910-NO-REC-88                                            DTSBE351
00499          SET WRK-MQTR-NOT-FOUND-88 TO TRUE                        DTSBE351
00500      ELSE                                                         DTSBE351
00501          SET WRK-MQTR-FOUND-88 TO TRUE                            DTSBE351
00502          MOVE MSKL-REC TO  MQTR-REC                               DTSBE351
00503          IF MQTR-CURR-RCVD-88                                     DTSBE351
00504          ADD 1 TO TOT-MPRF-READ-RPT-TYPE                          DTSBE351
00505              GO TO P0000-EXIT.                                    DTSBE351
00506                                                                   DTSBE351
00507                                                                   DTSBE351
00508      SET WRK-UC30-SKIP-NO-88 TO TRUE.                             DTSBE351
00509      MOVE LOW-VALUES TO MRPT-KEY-AREA.                            DTSBE351
00510                                                                   DTSBE351
00511      MOVE WRK-LAST-UC30-MAIL-YRQ TO MRPT-YRQ                      DTSBE351
00512                                                                   DTSBE351
00513      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                             DTSBE351
00514                                                                   DTSBE351
00515      SET MRPT-RPT-88 TO TRUE.                                     DTSBE351
00516                                                                   DTSBE351
00517      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE351
00518                                                                   DTSBE351
00519      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE351
00520                                                                   DTSBE351
00521      IF L910-OK-88                                                DTSBE351
00522           MOVE MSKL-REC                   TO MRPT-REC             DTSBE351
00523          MOVE MRPT-RESPONSIBLE-OP-ID TO WRK-UC30-SKIP-IND         DTSBE351
00524            IF WRK-UC30-SKIP-VALID-88                              DTSBE351
00525               ADD 1 TO TOT-MPRF-READ-MAG-UC30                     DTSBE351
00526               SET WRK-UC30-SKIP-YES-88 TO TRUE                    DTSBE351
00527            ELSE                                                   DTSBE351
00528               ADD 1 TO TOT-MPRF-READ-NOT-UC30                     DTSBE351
00529               SET WRK-UC30-SKIP-NO-88 TO TRUE                     DTSBE351
00530            END-IF                                                 DTSBE351
00531      END-IF.                                                      DTSBE351
00532                                                                   DTSBE351
00533      IF WRK-UC30-SKIP-YES-88                                      DTSBE351
00534         DISPLAY ' MAG FILER NO UC30 '  MPRF-EMP-NO                DTSBE351
00535         GO TO P0000-EXIT.                                         DTSBE351
00536                                                                   DTSBE351
00537      IF L910-NO-REC-88                                            DTSBE351
00538         ADD 1 TO TOT-MPRF-READ-NOT-UC30.                          DTSBE351
00539                                                                   DTSBE351
00540      IF MPRF-CLASS-SELF-INS-88                                    DTSBE351
00541          NEXT SENTENCE                                            DTSBE351
00542      ELSE                                                         DTSBE351
00543          IF L516-NO-RATE-88                                       DTSBE351
00544             ADD 1 TO TOT-MPRF-READ-NO-RATE                        DTSBE351
00545              PERFORM P1000-WRITE-907 THRU P1000-EXIT              DTSBE351
00546              GO TO P0000-EXIT.                                    DTSBE351
00547                                                                   DTSBE351
00548                                                                   DTSBE351
00549      IF MPRF-UC30-MASS-MAIL-NO-88                                 DTSBE351
00550         ADD 1 TO TOT-MPRF-READ-NO-MAIL                            DTSBE351
00551         GO TO P0000-EXIT                                          DTSBE351
00552      END-IF.                                                      DTSBE351
00553                                                                   DTSBE351
00554      IF MPRF-RETURN-MAIL-YES-88                                   DTSBE351
00555         ADD 1 TO TOT-MPRF-RETN-NO-MAIL                            DTSBE351
00556         GO TO P0000-EXIT                                          DTSBE351
00557      END-IF.                                                      DTSBE351
00558                                                                   DTSBE351
00559 *    PERFORM P1700-READ-MFAE   THRU P1700-EXIT.                   DTSBE351
00560                                                                   DTSBE351
00561 *    IF WRK-MFAE-FOUND-88                                         DTSBE351
00562 *       DISPLAY ' NOT MAG BUT ON RATE TAPE ' MRPT-EMP-NO          DTSBE351
00563 *       GO TO P0000-EXIT                                          DTSBE351
00564 *    END-IF.                                                      DTSBE351
00565                                                                   DTSBE351
00566      PERFORM P2000-SETUP-BASIC-R902 THRU P2000-EXIT.              DTSBE351
00567                                                                   DTSBE351
00568                                                                   DTSBE351
00569      PERFORM P3000-SETUP-R908 THRU P3000-EXIT.                    DTSBE351
00570                                                                   DTSBE351
00571      PERFORM P4000-TO-MTAD-ADDR THRU P4000-EXIT.                  DTSBE351
00572                                                                   DTSBE351
00573 *****MOVE LOW-VALUES TO MTNM-KEY-AREA.                            DTSBE351
00574                                                                   DTSBE351
00575 *****MOVE MPRF-EMP-NO TO MTNM-EMP-NO.                             DTSBE351
00576                                                                   DTSBE351
00577 *****SET MTNM-TNM-88 TO TRUE.                                     DTSBE351
00578                                                                   DTSBE351
00579 *****MOVE MTNM-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE351
00580                                                                   DTSBE351
00581 *****PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE351
00582                                                                   DTSBE351
00583 *****PERFORM P5000-MTNM-SCAN THRU P5000-EXIT                      DTSBE351
00584 *********UNTIL L910-NO-REC-88.                                    DTSBE351
00585  P0000-EXIT.                                                      DTSBE351
00586      EXIT.                                                        DTSBE351
00587      EJECT                                                        DTSBE351
00588  P1000-WRITE-907.                                                 DTSBE351
00589      MOVE MSG1-ID TO R907-MSG-ID.                                 DTSBE351
00590                                                                   DTSBE351
00591      MOVE MPRF-EMP-NO TO R907-EMP-NO.                             DTSBE351
00592                                                                   DTSBE351
00593      MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9.                   DTSBE351
00594                                                                   DTSBE351
00595      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE351
00596                                                                   DTSBE351
00597      MOVE L004-SLASH-QTR TO MSG1-SLASHED-YRQ.                     DTSBE351
00598                                                                   DTSBE351
00599      MOVE MSG1-TEXT TO R907-MSG-TEXT.                             DTSBE351
00600                                                                   DTSBE351
00601      PERFORM S946-WRITE-R907 THRU S946-EXIT.                      DTSBE351
00602  P1000-EXIT.                                                      DTSBE351
00603      EXIT.                                                        DTSBE351
00604      EJECT                                                        DTSBE351
00605  P1700-READ-MFAE.                                                 DTSBE351
00606                                                                   DTSBE351
00607      MOVE LOW-VALUES  TO MFAE-KEY-AREA.                           DTSBE351
00608      MOVE MPRF-EMP-NO TO MFAE-EMP-NO.                             DTSBE351
00609      SET MFAE-FAE-88  TO TRUE.                                    DTSBE351
00610      SET  MFAE-SERVICE-UC30-88 TO TRUE.                           DTSBE351
00611      MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE351
00612                                                                   DTSBE351
00613      PERFORM S910-READ  THRU S910-EXIT.                           DTSBE351
00614                                                                   DTSBE351
00615      IF L910-NO-REC-88                                            DTSBE351
00616          SET WRK-MFAE-NOT-FOUND-88 TO TRUE                        DTSBE351
00617      ELSE                                                         DTSBE351
00618          SET WRK-MFAE-FOUND-88 TO TRUE.                           DTSBE351
00619                                                                   DTSBE351
00620  P1700-EXIT.                                                      DTSBE351
00621      EXIT.                                                        DTSBE351
00622      EJECT.                                                       DTSBE351
00623                                                                   DTSBE351
00624  P2000-SETUP-BASIC-R902.                                          DTSBE351
00625      SET R902-SORT-TYPE-QTR-88 TO TRUE.                           DTSBE351
00626                                                                   DTSBE351
00627      MOVE LOW-VALUES TO R902-VAR-SORT-AREA.                       DTSBE351
00628                                                                   DTSBE351
00629      MOVE MPRF-EMP-CLASS TO R902-QUARTERLY-EMP-CLASS.             DTSBE351
00630                                                                   DTSBE351
00631      MOVE MPRF-EMP-NO TO R902-QUARTERLY-EMP-NO.                   DTSBE351
00632                                                                   DTSBE351
00633      MOVE WRK-PARM-SUBJECT-YRQ TO R902-QUARTERLY-YRQ.             DTSBE351
00634                                                                   DTSBE351
00635                                                                   DTSBE351
00636      SET R902-QUARTERLY-88 TO TRUE.                               DTSBE351
00637                                                                   DTSBE351
00638      MOVE MPRF-PRIMARY-NAME TO R902-PRI-NAME-FIRST4.              DTSBE351
00639                                                                   DTSBE351
00640      MOVE WRK-TAX-WAGE-BASE TO R902-TAX-WAGE-BASE.                DTSBE351
00641                                                                   DTSBE351
00642      MOVE L516-UI-RATE TO R902-UI-RATE.                           DTSBE351
00643                                                                   DTSBE351
00644      IF (WRK-MQTR-FOUND-88)                                       DTSBE351
00645               AND                                                 DTSBE351
00646         (MQTR-RPT-DUE-DATE  GREATER THAN ZERO)                    DTSBE351
00647          MOVE MQTR-RPT-DUE-DATE TO R902-RPT-DUE-DATE              DTSBE351
00648      ELSE                                                         DTSBE351
00649          MOVE L516-DEFAULT-RPT-DUE-DATE                           DTSBE351
00650            TO  R902-RPT-DUE-DATE.                                 DTSBE351
00651                                                                   DTSBE351
00652      MOVE MPRF-FEIN TO R902-FEIN.                                 DTSBE351
00653                                                                   DTSBE351
00654      MOVE +0 TO R902-QTRLY-CR-AMT.                                DTSBE351
00655                                                                   DTSBE351
00656      MOVE +0 TO R902-DAILY-WAIVER-START-YRQ                       DTSBE351
00657                 R902-DAILY-WAIVER-END-YRQ                         DTSBE351
00658                 R902-DAILY-WAIVER-DATE.                           DTSBE351
00659                                                                   DTSBE351
00660      MOVE 'N' TO R902-DAILY-SUPPLEMENTAL-IND.                     DTSBE351
00661                                                                   DTSBE351
00662      IF NOT MPRF-NAICS-CD-NONCLASSIF-88                           DTSBE351
00663         MOVE MPRF-NAICS-CD    TO R902-INDUSTRY-CD                 DTSBE351
00664      ELSE                                                         DTSBE351
00665      IF NOT MPRF-SIC-CD-NONCLASSIF-88                             DTSBE351
00666         MOVE MPRF-SIC-CD      TO R902-INDUSTRY-CD.                DTSBE351
00667                                                                   DTSBE351
00668      MOVE LOW-VALUES TO MELF-KEY-AREA.                            DTSBE351
00669      MOVE MPRF-EMP-NO TO MELF-EMP-NO.                             DTSBE351
00670      SET MELF-ELF-88 TO TRUE.                                     DTSBE351
00671      MOVE MELF-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE351
00672      PERFORM S910-READ THRU S910-EXIT.                            DTSBE351
00673      IF L910-NO-REC-88                                            DTSBE351
00674          SET R902-ELECTRNIC-WAGES-NO-88      TO TRUE              DTSBE351
00675      ELSE                                                         DTSBE351
00676          MOVE MSKL-REC TO MELF-REC                                DTSBE351
00677          IF MELF-WAGES-YES-88                                     DTSBE351
00678              SET R902-ELECTRNIC-WAGES-YES-88 TO TRUE              DTSBE351
00679          ELSE                                                     DTSBE351
00680              SET R902-ELECTRNIC-WAGES-NO-88  TO TRUE.             DTSBE351
00681  P2000-EXIT.                                                      DTSBE351
00682      EXIT.                                                        DTSBE351
00683      EJECT.                                                       DTSBE351
00684  P3000-SETUP-R908.                                                DTSBE351
00685      MOVE MPRF-EMP-NO TO R908-EMP-NO.                             DTSBE351
00686                                                                   DTSBE351
00687      MOVE WRK-PARM-SUBJECT-YRQ TO R908-YRQ.                       DTSBE351
00688                                                                   DTSBE351
00689      MOVE MPRF-EMP-CLASS TO R908-EMP-CLASS.                       DTSBE351
00690  P3000-EXIT.                                                      DTSBE351
00691      EXIT.                                                        DTSBE351
00692      EJECT                                                        DTSBE351
00693 **************************************************************    DTSBE351
00694 *  THIS PARAGRAPH PROCESSES THE TAX MAILING ADDRESS AND WRITES    DTSBE351
00695 *  THE R902 AND R908 EXTRACT RECORDS.                             DTSBE351
00696 **************************************************************    DTSBE351
00697                                                                   DTSBE351
00698  P4000-TO-MTAD-ADDR.                                              DTSBE351
00699      IF MPRF-CLASS-SELF-INS-88                                    DTSBE351
00700          MOVE +0 TO R902-QTRLY-CR-AMT                             DTSBE351
00701      ELSE                                                         DTSBE351
00702      IF WRK-PARM-DISP-CREDIT-YES-88                               DTSBE351
00703         IF (MPRF-UC30-CREDIT-YES-88)                              DTSBE351
00704                AND                                                DTSBE351
00705            (MPRF-PURSUED-RPT-CNT EQUAL ZERO)                      DTSBE351
00706                AND                                                DTSBE351
00707            (MPRF-TOT-CREDIT-AMT GREATER THAN ZERO)                DTSBE351
00708             MOVE MPRF-TOT-CREDIT-AMT TO R902-QTRLY-CR-AMT         DTSBE351
00709         ELSE                                                      DTSBE351
00710             MOVE ZERO TO R902-QTRLY-CR-AMT                        DTSBE351
00711         END-IF                                                    DTSBE351
00712      ELSE                                                         DTSBE351
00713          MOVE ZERO TO R902-QTRLY-CR-AMT                           DTSBE351
00714      END-IF.                                                      DTSBE351
00715                                                                   DTSBE351
00716      PERFORM P4100-LOOKUP-ADDR THRU P4100-EXIT.                   DTSBE351
00717                                                                   DTSBE351
00718                                                                   DTSBE351
00719 *****IF MPRF-UC30-PRIMARY-88                                      DTSBE351
00720 *********SET R902-QTRLY-PRIMARY-88 TO TRUE                        DTSBE351
00721 *****ELSE                                                         DTSBE351
00722 *********SET R902-QTRLY-SECND-NONE-88 TO TRUE.                    DTSBE351
00723                                                                   DTSBE351
00724                                                                   DTSBE351
00725      ADD 1 TO TOT-MPRF-READ-R902.                                 DTSBE351
00726      PERFORM S946-WRITE-R902 THRU S946-EXIT.                      DTSBE351
00727                                                                   DTSBE351
00728                                                                   DTSBE351
00729      PERFORM S946-WRITE-R908 THRU S946-EXIT.                      DTSBE351
00730                                                                   DTSBE351
00731                                                                   DTSBE351
00732 *****IF R902-QTRLY-PRIMARY-88                                     DTSBE351
00733 *********PERFORM P4200-SETUP-MTCK  THRU  P4200-EXIT               DTSBE351
00734 *********PERFORM S910-WRITE  THRU  S910-EXIT.                     DTSBE351
00735  P4000-EXIT.                                                      DTSBE351
00736      EXIT.                                                        DTSBE351
00737      EJECT                                                        DTSBE351
00738  P4100-LOOKUP-ADDR.                                               DTSBE351
00739      MOVE MPRF-EMP-NO TO L111-EMP-NO.                             DTSBE351
00740                                                                   DTSBE351
00741      SET L111-LOOKUP-TAD-88 TO TRUE.                              DTSBE351
00742                                                                   DTSBE351
00743      SET L111-ID-NO-TAD-MAIL-88 TO TRUE.                          DTSBE351
00744                                                                   DTSBE351
00745      PERFORM S111-LOOKUP-ADDR  THRU  S111-EXIT.                   DTSBE351
00746                                                                   DTSBE351
00747      IF L111-ADDR-FOUND-88                                        DTSBE351
00748          SET L112-TAD-ADDR-88 TO TRUE                             DTSBE351
00749          PERFORM P4110-FORMAT-ADDR THRU P4110-EXIT                DTSBE351
00750      ELSE                                                         DTSBE351
00751          MOVE ALL '?' TO R902-QUARTERLY-ZIP-CODE                  DTSBE351
00752                          R902-FMT-ADDR                            DTSBE351
00753                          R902-ZIP                                 DTSBE351
00754                          R902-ADVANCED-BARCODE.                   DTSBE351
00755  P4100-EXIT.                                                      DTSBE351
00756      EXIT.                                                        DTSBE351
00757      SKIP3                                                        DTSBE351
00758  P4110-FORMAT-ADDR.                                               DTSBE351
00759      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSBE351
00760                                                                   DTSBE351
00761      MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME.                 DTSBE351
00762                                                                   DTSBE351
00763      MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA.             DTSBE351
00764                                                                   DTSBE351
00765      PERFORM S112-FORMAT-ADDR  THRU  S112-EXIT.                   DTSBE351
00766                                                                   DTSBE351
00767      MOVE L112-MAILING-ADDRESS TO R902-FMT-ADDR.                  DTSBE351
00768                                                                   DTSBE351
00769      MOVE L112-ZIP TO R902-ZIP                                    DTSBE351
00770                       R902-QUARTERLY-ZIP-CODE.                    DTSBE351
00771                                                                   DTSBE351
00772      MOVE L112-ADVANCED-BARCODE TO R902-ADVANCED-BARCODE.         DTSBE351
00773  P4110-EXIT.                                                      DTSBE351
00774      EXIT.                                                        DTSBE351
00775      EJECT.                                                       DTSBE351
00776 *P4200-SETUP-MTCK.                                                DTSBE351
00777 *****MOVE LOW-VALUES TO MTCK-REC.                                 DTSBE351
00778                                                                   DTSBE351
00779 *****MOVE MPRF-EMP-NO TO MTCK-EMP-NO.                             DTSBE351
00780                                                                   DTSBE351
00781 *****SET MTCK-TCK-88 TO TRUE.                                     DTSBE351
00782                                                                   DTSBE351
00783 *****ADD +1 TO LECM-EMP-ABSTIME.                                  DTSBE351
00784                                                                   DTSBE351
00785 *****MOVE LECM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME.                  DTSBE351
00786                                                                   DTSBE351
00787 *****MOVE ZERO TO MTCK-PURGE-DATE                                 DTSBE351
00788 ******************MTCK-ACKNOWLEDGED-DATE.                         DTSBE351
00789                                                                   DTSBE351
00790 *****SET MTCK-TYPE-MANUAL-88 TO TRUE.                             DTSBE351
00791                                                                   DTSBE351
00792 *****PERFORM P4210-CALC-TRIGGER-DATE THRU P4210-EXIT.             DTSBE351
00793                                                                   DTSBE351
00794 *****MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE                  DTSBE351
00795                                                                   DTSBE351
00796 *****MOVE 'COLLCT' TO MTCK-DEST-OP-ID                             DTSBE351
00797                                                                   DTSBE351
00798 *****SET MTCK-SOURCE-SYSTEM-88 TO TRUE.                           DTSBE351
00799                                                                   DTSBE351
00800 *****SET MTCK-NOT-CONVERTED-88 TO TRUE.                           DTSBE351
00801                                                                   DTSBE351
00802 *****MOVE LECM-CURR-RUN-DATE TO MTCK-ESTB-DATE                    DTSBE351
00803 ********************************MTCK-CHNG-DATE.                   DTSBE351
00804                                                                   DTSBE351
00805 *****MOVE +1 TO MTCK-TEXT-CNT.                                    DTSBE351
00806                                                                   DTSBE351
00807 *****MOVE WRK-SLASH-QTR TO MSG2-SLASHED-YRQ.                      DTSBE351
00808                                                                   DTSBE351
00809 *****MOVE MSG2-TCK TO MTCK-TEXT (MTCK-TEXT-CNT).                  DTSBE351
00810                                                                   DTSBE351
00811 *****MOVE MTCK-REC TO MSKL-REC.                                   DTSBE351
00812 *P4200-EXIT.                                                      DTSBE351
00813 *****EXIT.                                                        DTSBE351
00814      EJECT                                                        DTSBE351
00815 *P4210-CALC-TRIGGER-DATE.                                         DTSBE351
00816 *****MOVE R902-RPT-DUE-DATE TO L001-FED-8-DATE-9.                 DTSBE351
00817                                                                   DTSBE351
00818 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBE351
00819                                                                   DTSBE351
00820 *****ADD +10 TO L001-JUL-ABS-DAY.                                 DTSBE351
00821                                                                   DTSBE351
00822 *****PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBE351
00823 *P4210-EXIT.                                                      DTSBE351
00824 *****EXIT.                                                        DTSBE351
00825      EJECT                                                        DTSBE351
00826 *P5000-MTNM-SCAN.                                                 DTSBE351
00827 *****MOVE MSKL-REC TO MTNM-REC.                                   DTSBE351
00828                                                                   DTSBE351
00829 *****IF MTNM-UC30-MASS-YES-88                                     DTSBE351
00830 *********PERFORM P5100-TO-MTAA-ADDR THRU P5100-EXIT               DTSBE351
00831 *********MOVE MTNM-KEY-AREA TO MSKL-KEY-AREA                      DTSBE351
00832 *********PERFORM S910-READ THRU S910-EXIT                         DTSBE351
00833 *********IF L910-NO-REC-88                                        DTSBE351
00834 *************MOVE 'LOGIC ERROR IN P5000'                          DTSBE351
00835 ***************TO ABEND-MSG                                       DTSBE351
00836 *************PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE351
00837                                                                   DTSBE351
00838 *****PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE351
00839 *P5000-EXIT.                                                      DTSBE351
00840 *****EXIT.                                                        DTSBE351
00841      SKIP3                                                        DTSBE351
00842  P5100-TO-MTAA-ADDR.                                              DTSBE351
00843 *****SET L111-LOOKUP-TAA-88 TO TRUE.                              DTSBE351
00844                                                                   DTSBE351
00845 *****MOVE MTNM-ID-NO TO L111-ID-NO.                               DTSBE351
00846                                                                   DTSBE351
00847 *****PERFORM S111-LOOKUP-ADDR THRU S111-EXIT.                     DTSBE351
00848                                                                   DTSBE351
00849 *****IF L111-ADDR-FOUND-88                                        DTSBE351
00850 *********SET L112-TAA-ADDR-88 TO TRUE                             DTSBE351
00851 *********PERFORM P4110-FORMAT-ADDR THRU P4110-EXIT                DTSBE351
00852 *****ELSE                                                         DTSBE351
00853 *********MOVE ALL '?' TO R902-QUARTERLY-ZIP-CODE                  DTSBE351
00854 *************************R902-FMT-ADDR                            DTSBE351
00855 *************************R902-ZIP                                 DTSBE351
00856 *************************R902-DELIV-POINT                         DTSBE351
00857 *************************R902-CHECK-DIGIT.                        DTSBE351
00858                                                                   DTSBE351
00859 *****MOVE ZERO TO R902-QTRLY-CR-AMT.                              DTSBE351
00860                                                                   DTSBE351
00861 *****SET R902-QTRLY-SECONDARY-88 TO TRUE.                         DTSBE351
00862                                                                   DTSBE351
00863 *****PERFORM S946-WRITE-R902 THRU S946-EXIT.                      DTSBE351
00864                                                                   DTSBE351
00865 *****PERFORM S946-WRITE-R908 THRU S946-EXIT.                      DTSBE351
00866 *P5100-EXIT.                                                      DTSBE351
00867 *****EXIT.                                                        DTSBE351
00868      EJECT                                                        DTSBE351
00869  T0000-TERMINATE.                                                 DTSBE351
00870      MOVE LOW-VALUES TO FQTR-KEY-AREA.                            DTSBE351
00871                                                                   DTSBE351
00872      SET FQTR-QTR-88 TO TRUE.                                     DTSBE351
00873                                                                   DTSBE351
00874      MOVE WRK-PARM-SUBJECT-YRQ                                    DTSBE351
00875        TO  FQTR-YRQ.                                              DTSBE351
00876                                                                   DTSBE351
00877      MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBE351
00878                                                                   DTSBE351
00879      PERFORM S931-READ THRU S931-EXIT.                            DTSBE351
00880                                                                   DTSBE351
00881      IF L931-NO-REC-88                                            DTSBE351
00882          MOVE LOW-VALUES TO FQTR-DATA-AREA                        DTSBE351
00883          MOVE LECM-CURR-RUN-DATE                                  DTSBE351
00884            TO FQTR-UC30-MASS-MAIL-DATE                            DTSBE351
00885          MOVE +0 TO FQTR-SELF-INS-TAX-DUE-DATE                    DTSBE351
00886                     FQTR-LATE-PEN-ASSESSED-DATE                   DTSBE351
00887                     FQTR-UC30-FIRST-DEL-DATE                      DTSBE351
00888                     FQTR-UC30-FINAL-DEL-DATE                      DTSBE351
00889                     FQTR-UC30-FINAL-ACTION-DATE                   DTSBE351
00890                     FQTR-SELF-INS-CHG-RUN-DATE                    DTSBE351
00891                     FQTR-INTENT-2-ESTIMATE-DATE                   DTSBE351
00892                     FQTR-ESTIMATED-DATE                           DTSBE351
00893                     FQTR-SELF-INS-2ND-LETTER-DATE                 DTSBE351
00894          MOVE LECM-CURR-RUN-DATE                                  DTSBE351
00895            TO FQTR-ESTB-DATE                                      DTSBE351
00896               FQTR-CHNG-DATE                                      DTSBE351
00897          MOVE FQTR-REC TO FSKL-REC                                DTSBE351
00898          PERFORM S931-WRITE THRU S931-EXIT                        DTSBE351
00899      ELSE                                                         DTSBE351
00900          MOVE FSKL-REC TO FQTR-REC                                DTSBE351
00901          MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-MASS-MAIL-DATE      DTSBE351
00902          MOVE LECM-CURR-RUN-DATE TO FQTR-CHNG-DATE                DTSBE351
00903          MOVE FQTR-REC TO FSKL-REC                                DTSBE351
00904          PERFORM S931-REWRITE THRU S931-EXIT.                     DTSBE351
00905                                                                   DTSBE351
00906                                                                   DTSBE351
00907      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBE351
00908                                                                   DTSBE351
00909      MOVE +0 TO MHDR-EMP-NO.                                      DTSBE351
00910                                                                   DTSBE351
00911      SET MHDR-HDR-88 TO TRUE.                                     DTSBE351
00912                                                                   DTSBE351
00913      MOVE MHDR-REC TO MSKL-REC.                                   DTSBE351
00914                                                                   DTSBE351
00915      PERFORM S910-READ THRU S910-EXIT.                            DTSBE351
00916                                                                   DTSBE351
00917      IF L910-NO-REC-88                                            DTSBE351
00918          MOVE 'MHDR RECORD NOT FOUND'                             DTSBE351
00919            TO ABEND-MSG                                           DTSBE351
00920          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE351
00921                                                                   DTSBE351
00922      MOVE MSKL-REC TO MHDR-REC.                                   DTSBE351
00923                                                                   DTSBE351
00924      IF WRK-PARM-SUBJECT-YRQ > MHDR-LAST-UC30-MASS-MAIL-YRQ       DTSBE351
00925          MOVE WRK-PARM-SUBJECT-YRQ                                DTSBE351
00926            TO  MHDR-LAST-UC30-MASS-MAIL-YRQ                       DTSBE351
00927          MOVE LECM-CURR-RUN-DATE TO MHDR-CHNG-DATE                DTSBE351
00928          MOVE MHDR-REC TO  MSKL-REC                               DTSBE351
00929          PERFORM S910-REWRITE THRU S910-EXIT.                     DTSBE351
00930      DISPLAY ' TOT MPRF RECS READ    = ' TOT-MPRF-READ.           DTSBE351
00931      DISPLAY ' TOT MPRF NOT ACTIVE   = ' TOT-MPRF-READ-NOT-ACTIVE.DTSBE351
00932      DISPLAY ' TOT MPRF NOT LIABLE   = ' TOT-MPRF-READ-NOT-LIABLE.DTSBE351
00933      DISPLAY ' TOT MPRF ANN FILER    = ' TOT-MPRF-READ-ANN-FILER. DTSBE351
00934      DISPLAY ' TOT MPRF PEND SCHED   = ' TOT-MPRF-READ-PEND-SCHED.DTSBE351
00935      DISPLAY ' TOT MQTR INV RPT TYP  = ' TOT-MPRF-READ-RPT-TYPE.  DTSBE351
00936      DISPLAY ' TOT MPRF NO RATE      = ' TOT-MPRF-READ-NO-RATE.   DTSBE351
00937      DISPLAY ' TOT MPRF NO MASS MAIL = ' TOT-MPRF-READ-NO-MAIL.   DTSBE351
00938      DISPLAY ' TOT MPRF RETURN MAIL  = ' TOT-MPRF-RETN-NO-MAIL    DTSBE351
00939      DISPLAY ' TOT MAG UC30 FILERS   = ' TOT-MPRF-READ-MAG-UC30.  DTSBE351
00940      DISPLAY ' TOT NOT MAG  FILERS   = ' TOT-MPRF-READ-NOT-UC30.  DTSBE351
00941      DISPLAY ' TOT UC30 RECS WRITTEN = ' TOT-MPRF-READ-R902.      DTSBE351
00942  T0000-EXIT.                                                      DTSBE351
00943      EXIT.                                                        DTSBE351
00944      EJECT                                                        DTSBE351
00945 *S001-FROM-FED-8.                                                 DTSBE351
00946 *****SET L001-FROM-FED-8 TO TRUE.                                 DTSBE351
00947 *****GO TO S001-DATE.                                             DTSBE351
00948                                                                   DTSBE351
00949 *S001-FROM-ABS-DAY.                                               DTSBE351
00950 *****SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE351
00951 *****GO TO S001-DATE.                                             DTSBE351
00952                                                                   DTSBE351
00953 *S001-DATE.                                                       DTSBE351
00954 *****CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE351
00955 *S001-EXIT.                                                       DTSBE351
00956 *****EXIT.                                                        DTSBE351
00957      SKIP3                                                        DTSBE351
00958  S004-FROM-5.                                                     DTSBE351
00959      SET L004-FROM-5 TO TRUE.                                     DTSBE351
00960      GO TO S004-QTR.                                              DTSBE351
00961                                                                   DTSBE351
00962  S004-FROM-ABS.                                                   DTSBE351
00963      SET L004-FROM-ABS TO TRUE.                                   DTSBE351
00964      GO TO S004-QTR.                                              DTSBE351
00965                                                                   DTSBE351
00966  S004-FROM-3.                                                     DTSBE351
00967      SET L004-FROM-3 TO TRUE.                                     DTSBE351
00968      GO TO S004-QTR.                                              DTSBE351
00969                                                                   DTSBE351
00970  S004-QTR.                                                        DTSBE351
00971      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE351
00972  S004-EXIT.                                                       DTSBE351
00973      EXIT.                                                        DTSBE351
00974      SKIP3                                                        DTSBE351
00975  S111-LOOKUP-ADDR.                                                DTSBE351
00976      CALL 'DTSBU111' USING L111-LINK-AREA.                        DTSBE351
00977  S111-EXIT.                                                       DTSBE351
00978      EXIT.                                                        DTSBE351
00979      SKIP3                                                        DTSBE351
00980  S112-FORMAT-ADDR.                                                DTSBE351
00981      CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBE351
00982  S112-EXIT.                                                       DTSBE351
00983      EXIT.                                                        DTSBE351
00984      SKIP3                                                        DTSBE351
00985  S516-LIABILITY.                                                  DTSBE351
00986      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBE351
00987                            MPRF-LINK-REC.                         DTSBE351
00988  S516-EXIT.                                                       DTSBE351
00989      EXIT.                                                        DTSBE351
00990      SKIP3                                                        DTSBE351
00991  S910-READ.                                                       DTSBE351
00992      SET L910-READ-88 TO TRUE.                                    DTSBE351
00993      GO TO S910-MSTR-IO.                                          DTSBE351
00994                                                                   DTSBE351
00995  S910-START-BROWSE.                                               DTSBE351
00996      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE351
00997      GO TO S910-MSTR-IO.                                          DTSBE351
00998                                                                   DTSBE351
00999  S910-READ-NEXT.                                                  DTSBE351
01000       SET L910-READ-NEXT-88 TO TRUE.                              DTSBE351
01001       GO TO S910-MSTR-IO.                                         DTSBE351
01002                                                                   DTSBE351
01003 *S910-COUNT.                                                      DTSBE351
01004 *****SET L910-COUNT-88 TO TRUE.                                   DTSBE351
01005 *****GO TO S910-MSTR-IO.                                          DTSBE351
01006                                                                   DTSBE351
01007 *S910-WRITE.                                                      DTSBE351
01008 *****SET L910-WRITE-88 TO TRUE.                                   DTSBE351
01009 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE351
01010 *****GO TO S910-MSTR-IO.                                          DTSBE351
01011                                                                   DTSBE351
01012  S910-REWRITE.                                                    DTSBE351
01013      SET L910-REWRITE-88 TO TRUE.                                 DTSBE351
01014      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE351
01015      GO TO S910-MSTR-IO.                                          DTSBE351
01016                                                                   DTSBE351
01017 *S910-DELETE.                                                     DTSBE351
01018 *****SET L910-DELETE-88 TO TRUE.                                  DTSBE351
01019 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE351
01020 *****GO TO S910-MSTR-IO.                                          DTSBE351
01021                                                                   DTSBE351
01022  S910-MSTR-IO.                                                    DTSBE351
01023      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE351
01024                            MSKL-REC.                              DTSBE351
01025  S910-EXIT.                                                       DTSBE351
01026      EXIT.                                                        DTSBE351
01027      SKIP3                                                        DTSBE351
01028  S931-READ.                                                       DTSBE351
01029      SET L931-READ-88 TO TRUE.                                    DTSBE351
01030      GO TO S931-REF-I.                                            DTSBE351
01031                                                                   DTSBE351
01032 *S931-START-BROWSE.                                               DTSBE351
01033 *****SET L931-START-BROWSE-88 TO TRUE.                            DTSBE351
01034 *****GO TO S931-REF-I.                                            DTSBE351
01035                                                                   DTSBE351
01036 *S931-READ-NEXT.                                                  DTSBE351
01037 *****SET L931-READ-NEXT-88 TO TRUE.                               DTSBE351
01038 *****GO TO S931-REF-I.                                            DTSBE351
01039                                                                   DTSBE351
01040  S931-WRITE.                                                      DTSBE351
01041      SET L931-WRITE-88 TO TRUE.                                   DTSBE351
01042      GO TO S931-REF-I.                                            DTSBE351
01043                                                                   DTSBE351
01044  S931-REWRITE.                                                    DTSBE351
01045      SET L931-REWRITE-88 TO TRUE.                                 DTSBE351
01046      GO TO S931-REF-I.                                            DTSBE351
01047                                                                   DTSBE351
01048 *S931-DELETE.                                                     DTSBE351
01049 *****SET L931-DELETE-88 TO TRUE.                                  DTSBE351
01050 *****GO TO S931-REF-I.                                            DTSBE351
01051                                                                   DTSBE351
01052  S931-REF-I.                                                      DTSBE351
01053      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBE351
01054                            FSKL-REC.                              DTSBE351
01055  S931-EXIT.                                                       DTSBE351
01056      EXIT.                                                        DTSBE351
01057      SKIP3                                                        DTSBE351
01058  S946-WRITE-R719.                                                 DTSBE351
01059      CALL 'DTSBU946' USING R719-REC.                              DTSBE351
01060      GO TO S946-EXIT.                                             DTSBE351
01061                                                                   DTSBE351
01062  S946-WRITE-R902.                                                 DTSBE351
01063      CALL 'DTSBU946' USING R902-REC.                              DTSBE351
01064      GO TO S946-EXIT.                                             DTSBE351
01065                                                                   DTSBE351
01066  S946-WRITE-R907.                                                 DTSBE351
01067      CALL 'DTSBU946' USING R907-REC.                              DTSBE351
01068      GO TO S946-EXIT.                                             DTSBE351
01069                                                                   DTSBE351
01070  S946-WRITE-R908.                                                 DTSBE351
01071      CALL 'DTSBU946' USING R908-REC.                              DTSBE351
01072      GO TO S946-EXIT.                                             DTSBE351
01073                                                                   DTSBE351
01074  S946-EXIT.                                                       DTSBE351
01075      EXIT.                                                        DTSBE351
01076      SKIP3                                                        DTSBE351
01077  S999-ABEND.                                                      DTSBE351
01078      DISPLAY '*** DTSBE351 ABENDING.  '                           DTSBE351
01079              ABEND-MSG.                                           DTSBE351
01080                                                                   DTSBE351
01081      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE351
01082  S999-EXIT.                                                       DTSBE351
01083      EXIT.                                                        DTSBE351
