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