00001  IDENTIFICATION DIVISION.                                         12/26/02
00002  PROGRAM-ID.             DTSBD610.                                DTSBD610
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV021
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSBD610
00005  DATE-COMPILED.                                                   DTSBD610
00006      SKIP3                                                        DTSBD610
00007 *****                                                             DTSBD610
00008 *                                                                 DTSBD610
00009 *    FUNCTION:  FUTA CERTIFICATION PROCESSING.                    DTSBD610
00010 *                                                                 DTSBD610
00011 *                                                                 DTSBD610
00012 *    MODIFICATION LOG:                                            DTSBD610
00013 *                                                                 DTSBD610
00014 *    01/28/92  INITIAL DEVELOPMENT.                               DTSBD610
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD610
00016 *                                                                 DTSBD610
00017 *    12/05/94  REWRITE FOR 1994/MONTANA.                          DTSBD610
00018 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBD610
00019 *                                                                 DTSBD610
00020 *    01/07/97  REQUEST-CITY INCREASED TO 25 BYTES,                DTSBD610
00021 *              REQUEST-FORM-INDICATOR ADDED.                      DTSBD610
00022 *              WORK ORDER:FUTA DOC 6581         PROGRAMMER: SFW   DTSBD610
00023 *                                                                 DTSBD610
00024 *    01/07/97  ENHANCED TO SEARCH ON REQUEST-EMP-NO IF NO MATCH   DTSBD610
00025 *              FOUND ON REQUEST-FEIN.                             DTSBD610
00026 *              WORK ORDER:FUTA DOC 6581         PROGRAMMER: SFW   DTSBD610
00027 *                                                                 DTSBD610
00028 *    01/10/97  ADDITIONAL CHANGE TO MOVE MPRF-FEIN INSTEAD OF     DTSBD610
00029 *              REQUEST-FEIN TO REPLY-FEIN AND R704-FEIN WHEN A    DTSBD610
00030 *              MATCH IS FOUND ON REQUEST-EMP-NO INSTEAD OF        DTSBD610
00031 *              REQUEST-FEIN.                                      DTSBD610
00032 *              WORK ORDER:ANNETTE RINEHART      PROGRAMMER: SFW   DTSBD610
00033 *                                                                 DTSBD610
00034 *    11/13/97  TAX YEAR 1996 MODIFICATIONS.  INCREASED RECORD     DTSBD610
00035 *              LENGTHS, FOUR DIGIT YEAR, FORM-IND ADDED TO        DTSBD610
00036 *              CERTIFICATION REPLY RECORD AND XREF-FEIN ADDED     DTSBD610
00037 *              TO CERTIFICATION REPLY RECORD.  REQUEST-EMP-NO     DTSBD610
00038 *              LOGIC ENHANCED.                                    DTSBD610
00039 *              WORK ORDER: TCL 222              PROGRAMMER: EHH   DTSBD610
00040 *                                                                 DTSBD610
00041 *  10/16/1998  ADD TWO NEW "PAYMENT" DATA ELEMENTS ('THRU 4/15'   DTSBD610
00042 *              & 'AFTER 4/15').                                   DTSBD610
00043 *              WORK ORDER: TCL 237              PROGRAMMER: KDN   DTSBD610
00044 *                                                                 DTSBD610
00045 *  02/17/1999  REVIEWED AND MODIFIED FOR DC.                      DTSBD610
00046 *              REFERENCE: DC DEVELOPMENT        PROGRAMMER: EHH   DTSBD610
00047 *                                                                 DTSBD610
00048 *  02/27/1999  ADDED OPEN/CLOSE OF REFERENCE FILE.  DTSBU516      DTSBD610
00049 *              MODIFIED TO READ REFERENCE FILE.                   DTSBD610
00050 *              REFERENCE: DC DEVELOPMENT        PROGRAMMER: EHH   DTSBD610
00051 *                                                                 DTSBD610
00052 *  01/07/2000  ADD CODE TO DETECT DUP FEIN + TAX PERIOD CERT.     DTSBD610
00053 *              REQUEST RECORDS.  IF DUP FOUND, REPLY TO ONLY THE  DTSBD610
00054 *              FIRST RECORD WITH A NON ZERO CERTIFICATION REPLY   DTSBD610
00055 *              RECORD AND REPLY TO EACH ADDITIONAL DUP'D RECORD   DTSBD610
00056 *              WITH A ZERO CERTIFICATION REPLY RECORD.  ALSO,     DTSBD610
00057 *              OUTPUT THE FIRST 50 ZERO CERT. REPLY RECORDS       DTSBD610
00058 *              GENERATED AND THE FIRST 50 NON ZERO CERT. REPLY    DTSBD610
00059 *              RECORDS GENERATED.                                 DTSBD610
00060 *              REFERENCE: DC MAINTENANCE        PROGRAMMER: EHH   DTSBD610
00061 *                                                                 DTSBD610
00062 *  10/24/2001  INCREASE THE SIZE OF THE REQUEST-TAXABLE-WAGES FIELDTSBD610
00063 *              IN THE IDENTIFICATION DATA RECORD BY TWO BYTES.    DTSBD610
00064 *              ALSO, ZERO FILL REPLY-SIC-AREA.                    DTSBD610
00065 *              PER FUTA DOCUMENT 6581 (REV. 9-2001)               DTSBD610
00066 *              REFERENCE: DC MAINTENANCE        PROGRAMMER: GAB   DTSBD610
00067 *                                                                 DTSBD610
00068 *  08/14/2002  RECOMPILED FOR NEW VERSION OF DTSIL516. NO CHANGES DTSBD610
00069 *              NEEDED FOR ESTIMATED RATES.                        DTSBD610
00070 *              REFERENCE: HOUSEHOLD             PROGRAMMER: GD    DTSBD610
00071 *                                                                 DTSBD610
00072 *                                                                 DTSBD610
00073 *  MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD610
00074 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD610
00075 *              REFERENCE: XXXXXXXXXXXXXXX       PROGRAMMER: XXX   DTSBD610
00076 *                                                                 DTSBD610
00077 *                                                                 DTSBD610
00078 *  DESCRIPTION:                                                   DTSBD610
00079 *                                                                 DTSBD610
00080 *      DTSBD610 DOES THE ANNUAL IRS FUTA CERTIFICATION PROCESSING.DTSBD610
00081 *      SEE IRS DOCUMENT 6581 ("SPECIFICATIONS FOR THE NATIONWIDE  DTSBD610
00082 *      SYSTEM FOR COMPUTERIZED CERTIFICATION OF STATE FUTA        DTSBD610
00083 *      CREDITS").                                                 DTSBD610
00084 *                                                                 DTSBD610
00085 *      READ THE IRS FUTA CERTIFICATION REQUESTS TAPE.             DTSBD610
00086 *                                                                 DTSBD610
00087 *      FOR EACH RECORD ON THE IRS FUTA CERTIFICATION REQUESTS     DTSBD610
00088 *      TAPE, EVALUATE THE MONTANA UI TAX SYSTEM RECORDS AND       DTSBD610
00089 *      WRITE AN "IRS FUTA CERTIFICATION REPLY" RECORD.            DTSBD610
00090 *                                                                 DTSBD610
00091 *      A CERTIFICATION REPLY MAY INDICATE "SUCCESSFUL CERTIFIC-   DTSBD610
00092 *      ATION" OR "UNSUCCESSFUL CERTIFICATION".                    DTSBD610
00093 *                                                                 DTSBD610
00094 *      CERTIFICATION WILL BE UNSUCCESSFUL IF:                     DTSBD610
00095 *                                                                 DTSBD610
00096 *        . FEIN NOT FOUND.                                        DTSBD610
00097 *                                                                 DTSBD610
00098 *        . FEIN EXISTS FOR MORE THAN ONE EMPLOYER WHO WAS LIABLE  DTSBD610
00099 *          DURING THE PERIOD BEING CERTIFIED.                     DTSBD610
00100 *                                                                 DTSBD610
00101 *        . FOR AN FEIN, NO EMPLOYERS WERE LIABLE AND MULTIPLE     DTSBD610
00102 *        . EMPLOYERS NOT LIABLE DURING PERIOD BEING CERTIFIED.    DTSBD610
00103 *                                                                 DTSBD610
00104 *        . RECORDS FOR THE PERIOD BEING CERTIFIED DO NOT EXIST ON DTSBD610
00105 *          THE MASTER FILE (HAVE BEEN PURGED OR ARE NOT YET DUE). DTSBD610
00106 *                                                                 DTSBD610
00107 *        . EMPLOYER CLASS IS REIMBURSABLE OR GOVERNMENT.          DTSBD610
00108 *                                                                 DTSBD610
00109 *                                                                 DTSBD610
00110 *                                                                 DTSBD610
00111 *      CERTIFICATION WILL BE CONSIDERED SUCCESSFUL IF ANY:        DTSBD610
00112 *                                                                 DTSBD610
00113 *        . EMPLOYER WAS LIABLE DURING PERIOD BEING CERTIFIED.     DTSBD610
00114 *                                                                 DTSBD610
00115 *        . EMPLOYER WAS NOT LIABLE DURING PERIOD BEING CERTIFIED. DTSBD610
00116 *                                                                 DTSBD610
00117 *        . NO QUARTERLY REPORTS HAVE BEEN COLLECTED DURING THE    DTSBD610
00118 *          PERIOD BEING CERTIFIED.  IGNORE ESTIMATED REPORTS.     DTSBD610
00119 *                                                                 DTSBD610
00120 *                                                                 DTSBD610
00121 *                                                                 DTSBD610
00122 *                                                                 DTSBD610
00123 *      IF CERTIFICATION IS SUCCESSFUL:                            DTSBD610
00124 *                                                                 DTSBD610
00125 *        . WRITE A IRS FUTA CERTIFICATION REPLY RECORD.           DTSBD610
00126 *          IGNORE ESTIMATED REPORTS AND PAYMENTS AGAINST ESTIMATEDDTSBD610
00127 *          REPORTS.                                               DTSBD610
00128 *                                                                 DTSBD610
00129 *        . WRITE A R704 RECORD.                                   DTSBD610
00130 *                                                                 DTSBD610
00131 *        . IF THE TAX YEAR BEING CERTIFIED IS EQUAL TO PARM-YEAR  DTSBD610
00132 *          THEN WRITE A "EMPLOYERS CERTIFIED FOR CURRENT YEAR"    DTSBD610
00133 *          RECORD.                                                DTSBD610
00134 *                                                                 DTSBD610
00135 *      IF CERTIFICATION IS NOT SUCCESSFUL:                        DTSBD610
00136 *                                                                 DTSBD610
00137 *        . WRITE A IRS FUTA CERTIFICATION REPLY RECORD.           DTSBD610
00138 *                                                                 DTSBD610
00139 *        . WRITE A R705 RECORD.                                   DTSBD610
00140 *                                                                 DTSBD610
00141 *                                                                 DTSBD610
00142 *      PARAMETERS INPUT:                                          DTSBD610
00143 *                                                                 DTSBD610
00144 *        CURRENT CERTIFICATION YEAR.                              DTSBD610
00145 *                                                                 DTSBD610
00146 *                                                                 DTSBD610
00147 *      TAPES INPUT:                                               DTSBD610
00148 *                                                                 DTSBD610
00149 *        IRS FUTA CERTIFICATION REQUESTS.                         DTSBD610
00150 *                                                                 DTSBD610
00151 *                                                                 DTSBD610
00152 *      MASTER FILE RECORDS READ:                                  DTSBD610
00153 *                                                                 DTSBD610
00154 *        MPRF                                                     DTSBD610
00155 *        MSOL                                                     DTSBD610
00156 *        MQTR                                                     DTSBD610
00157 *        MDST                                                     DTSBD610
00158 *                                                                 DTSBD610
00159 *                                                                 DTSBD610
00160 *      ALTERNATE INDEX FILE RECORDS READ:                         DTSBD610
00161 *                                                                 DTSBD610
00162 *        IEIN                                                     DTSBD610
00163 *                                                                 DTSBD610
00164 *                                                                 DTSBD610
00165 *      MASTER FILE RECORDS UPDATED:                               DTSBD610
00166 *                                                                 DTSBD610
00167 *        NONE.                                                    DTSBD610
00168 *                                                                 DTSBD610
00169 *                                                                 DTSBD610
00170 *      REPORT RECORDS WRITTEN:                                    DTSBD610
00171 *                                                                 DTSBD610
00172 *        R704  SUCCESSFUL FUTA CERTIFICATION.                     DTSBD610
00173 *        R705  FAILED FUTA CERTIFICATION.                         DTSBD610
00174 *                                                                 DTSBD610
00175 *                                                                 DTSBD610
00176 *      TAPES WRITTEN:                                             DTSBD610
00177 *                                                                 DTSBD610
00178 *        IRS FUTA CERTIFICATION REPLY                             DTSBD610
00179 *                                                                 DTSBD610
00180 *          SEE IRS DOCUMENT 6581 "SPECIFICATIONS FOR THE          DTSBD610
00181 *          NATIONWIDE SYSTEM FOR COMPUTERIZED CERTIFICATION       DTSBD610
00182 *          OF STATE FUTA CREDITS" FOR FORMAT.                     DTSBD610
00183 *                                                                 DTSBD610
00184 *                                                                 DTSBD610
00185 *      DISK DATASETS WRITTEN:                                     DTSBD610
00186 *                                                                 DTSBD610
00187 *        EMPLOYERS CERTIFIED FOR CURRENT YEAR                     DTSBD610
00188 *                                                                 DTSBD610
00189 *          ONE RECORD FOR EACH EMPLOYER FOR WHOM A PARM-YEAR      DTSBD610
00190 *          RECORD WAS WRITTEN TO THE "IRS FUTA CERTIFICATION      DTSBD610
00191 *          REPLY" TAPE.  DATA ELEMENTS ARE EMP-NO, TAX-PERIOD,    DTSBD610
00192 *          AND FEIN.  THESE RECORDS WILL BE LOADED INTO A         DTSBD610
00193 *          TEMPORARY VSAM KSDS ("EMPLOYERS CERTIFIED FOR          DTSBD610
00194 *          THE CURRENT YEAR") WHOSE KEY IS EMP-NO.                DTSBD610
00195 *                                                                 DTSBD610
00196 *                                                                 DTSBD610
00197 *      MODULES CALLED:                                            DTSBD610
00198 *                                                                 DTSBD610
00199 *        DTSBU007 YEAR EDIT/CONVERSION.                           DTSBD610
00200 *        DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE FOR     DTSBD610
00201 *                 A GIVEN QUARTER.                                DTSBD610
00202 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD610
00203 *        DTSBU921 ALTERNATE INDEX FILE I/O.                       DTSBD610
00204 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBD610
00205 *                                                                 DTSBD610
00206 *****                                                             DTSBD610
00207      SKIP3                                                        DTSBD610
00208  ENVIRONMENT DIVISION.                                            DTSBD610
00209      SKIP2                                                        DTSBD610
00210  INPUT-OUTPUT SECTION.                                            DTSBD610
00211                                                                   DTSBD610
00212  FILE-CONTROL.                                                    DTSBD610
00213      SELECT CERT-REQUEST-FILE        ASSIGN TO DTSFRQST.          DTSBD610
00214      SELECT CERT-REPLY-FILE          ASSIGN TO DTSFRPLY.          DTSBD610
00215      SELECT ZERO-CERT-REPLY-FILE     ASSIGN TO DTSFZ50.           DTSBD610
00216      SELECT NON-ZERO-CERT-REPLY-FILE ASSIGN TO DTSFNZ50.          DTSBD610
00217      SELECT CURRENT-YEAR-CERT-FILE   ASSIGN TO DTSFCURR.          DTSBD610
00218      SKIP3                                                        DTSBD610
00219  DATA DIVISION.                                                   DTSBD610
00220      SKIP3                                                        DTSBD610
00221  FILE SECTION.                                                    DTSBD610
00222      SKIP2                                                        DTSBD610
00223  FD  CERT-REQUEST-FILE                                            DTSBD610
00224      RECORDING MODE IS F                                          DTSBD610
00225      BLOCK CONTAINS 0 RECORDS                                     DTSBD610
00226      LABEL RECORDS ARE STANDARD.                                  DTSBD610
00227                                                                   DTSBD610
00228  01  REQUEST-REC.                                                 DTSBD610
00229      05  REQUEST-CHAR-CNT                PIC S9(04)  COMP.        DTSBD610
00230      05  REQUEST-HEX-ZERO                PIC S9(04)  COMP.        DTSBD610
00231      05  REQUEST-STATE-CD                PIC  X(02).              DTSBD610
00232      05  REQUEST-FEIN                    PIC  9(09).              DTSBD610
00233      05  REQUEST-FEIN-X REDEFINES REQUEST-FEIN                    DTSBD610
00234                                          PIC  X(09).              DTSBD610
00235      05  REQUEST-DOC-LOC-NUMBER          PIC  X(14).              DTSBD610
00236      05  REQUEST-TAX-PERIOD              PIC  9(06).              DTSBD610
00237      05  REQUEST-TAX-PERIOD-X                                     DTSBD610
00238          REDEFINES REQUEST-TAX-PERIOD.                            DTSBD610
00239          10  REQUEST-TAX-YEAR            PIC  9(04).              DTSBD610
00240          10  REQUEST-TAX-MONTH           PIC  9(02).              DTSBD610
00241      05  REQUEST-CHECK-DIGIT             PIC  X(02).              DTSBD610
00242      05  REQUEST-TAXABLE-WAGES           PIC  9(13)V9(02).        DTSBD610
00243      05  REQUEST-ADDRESS-AREA.                                    DTSBD610
00244          10  REQUEST-ZIP                 PIC  X(12).              DTSBD610
00245          10  REQUEST-STATE               PIC  X(02).              DTSBD610
00246          10  REQUEST-CITY                PIC  X(25).              DTSBD610
00247          10  REQUEST-STREET              PIC  X(35).              DTSBD610
00248          10  REQUEST-NAME-1              PIC  X(35).              DTSBD610
00249          10  REQUEST-NAME-2              PIC  X(35).              DTSBD610
00250          10  REQUEST-NAME-3              PIC  X(35).              DTSBD610
00251          10  REQUEST-NAME-4              PIC  X(35).              DTSBD610
00252      05  REQUEST-NAME-CONTROL            PIC  X(04).              DTSBD610
00253      05  REQUEST-XREF-FEIN               PIC  X(09).              DTSBD610
00254      05  REQUEST-EMP-NO-AREA             PIC  X(15).              DTSBD610
00255      05  REQUEST-FORM-INDICATOR          PIC  X(01).              DTSBD610
00256      EJECT                                                        DTSBD610
00257  FD  CERT-REPLY-FILE                                              DTSBD610
00258      RECORDING MODE IS F                                          DTSBD610
00259      BLOCK CONTAINS 0 RECORDS                                     DTSBD610
00260      LABEL RECORDS ARE STANDARD.                                  DTSBD610
00261                                                                   DTSBD610
00262  01  REPLY-REC.                                                   DTSBD610
00263      05  REPLY-CHAR-CNT                  PIC S9(04)  COMP.        DTSBD610
00264      05  REPLY-HEX-ZERO                  PIC S9(04)  COMP.        DTSBD610
00265      05  REPLY-STATE-CD                  PIC  X(02).              DTSBD610
00266      05  REPLY-FEIN-X.                                            DTSBD610
00267          10  REPLY-FEIN                  PIC  9(09).              DTSBD610
00268      05  REPLY-DOC-LOC-NUMBER            PIC  X(13).              DTSBD610
00269      05  REPLY-TAX-PERIOD                PIC  9(06).              DTSBD610
00270      05  FILLER REDEFINES REPLY-TAX-PERIOD.                       DTSBD610
00271          10  REPLY-TAX-YEAR              PIC  9(04).              DTSBD610
00272          10  REPLY-TAX-MONTH             PIC  9(02).              DTSBD610
00273      05  REPLY-CHECK-DIGIT               PIC  X(02).              DTSBD610
00274      05  REPLY-RATE-AREA OCCURS 4 TIMES.                          DTSBD610
00275          10  REPLY-TAXABLE-WAGES         PIC  9(11)V9(02).        DTSBD610
00276          10  REPLY-ZERO-IND              PIC  X(01).              DTSBD610
00277          10  REPLY-RATE                  PIC  V9(06).             DTSBD610
00278      05  REPLY-PAID-PRIOR-2-1            PIC  9(11)V9(02).        DTSBD610
00279      05  REPLY-PAID-2-1-THRU-2-10        PIC  9(11)V9(02).        DTSBD610
00280      05  REPLY-PAID-AFTER-2-10           PIC  9(11)V9(02).        DTSBD610
00281      05  REPLY-RESPONSE-IND              PIC  X(01).              DTSBD610
00282      05  REPLY-EMP-NO-AREA.                                       DTSBD610
00283          10  REPLY-EMP-NO                PIC  9(06).              DTSBD610
00284          10  FILLER                      PIC  X(09).              DTSBD610
00285      05  REPLY-FORM-INDICATOR            PIC  X(01).              DTSBD610
00286          88  REPLY-FORM-940-88                  VALUE '1'.        DTSBD610
00287          88  REPLY-FORM-1041-88                 VALUE '2'.        DTSBD610
00288          88  REPLY-FORM-1040-88                 VALUE '3'.        DTSBD610
00289      05  REPLY-XREF-FEIN-X.                                       DTSBD610
00290          10  REPLY-XREF-FEIN             PIC  9(09).              DTSBD610
00291      05  REPLY-PAID-THRU-4-15            PIC  9(11)V9(02).        DTSBD610
00292      05  REPLY-PAID-AFTER-4-15           PIC  9(11)V9(02).        DTSBD610
00293      05  REPLY-NAME-CONTROL              PIC  X(04).              DTSBD610
00294      05  REPLY-TOTAL-EMPLOYEES           PIC  9(05).              DTSBD610
00295      05  REPLY-SIC-AREA OCCURS 5 TIMES.                           DTSBD610
00296          10  REPLY-SIC                   PIC  X(04).              DTSBD610
00297          10  REPLY-SIC-EMPLOYEES         PIC  9(05).              DTSBD610
00298          10  REPLY-SIC-TAXABLE-WAGES     PIC  9(11)V9(02).        DTSBD610
00299      EJECT                                                        DTSBD610
00300  FD  ZERO-CERT-REPLY-FILE                                         DTSBD610
00301      RECORDING MODE IS F                                          DTSBD610
00302      BLOCK CONTAINS 0 RECORDS                                     DTSBD610
00303      LABEL RECORDS ARE STANDARD.                                  DTSBD610
00304                                                                   DTSBD610
00305  01  ZERO-CERT-REPLY-REC                 PIC  X(326).             DTSBD610
00306      EJECT                                                        DTSBD610
00307  FD  NON-ZERO-CERT-REPLY-FILE                                     DTSBD610
00308      RECORDING MODE IS F                                          DTSBD610
00309      BLOCK CONTAINS 0 RECORDS                                     DTSBD610
00310      LABEL RECORDS ARE STANDARD.                                  DTSBD610
00311                                                                   DTSBD610
00312  01  NON-ZERO-CERT-REPLY-REC             PIC  X(326).             DTSBD610
00313      EJECT                                                        DTSBD610
00314  FD  CURRENT-YEAR-CERT-FILE                                       DTSBD610
00315      RECORDING MODE IS F                                          DTSBD610
00316      BLOCK CONTAINS 0 RECORDS                                     DTSBD610
00317      LABEL RECORDS ARE STANDARD.                                  DTSBD610
00318                                                                   DTSBD610
00319  01  CURRENT-YEAR-CERT-REC.                                       DTSBD610
00320  ++INCLUDE DTSIX971                                               DTSBD610
00321      EJECT                                                        DTSBD610
00322  WORKING-STORAGE SECTION.                                         DTSBD610
003225 77  PAN-VALET PICTURE X(24) VALUE '021DTSBD610  12/26/02'.       DTSBD610
00323      SKIP3                                                        DTSBD610
00324  01  WRK-AREA.                                                    DTSBD610
00325      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +610.DTSBD610
00326                                                                   DTSBD610
00327      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD610'.DTSBD610
00328                                                                   DTSBD610
00329      05  WRK-REPLY-CHAR-CNT          PIC S9(04)  COMP  VALUE +326.DTSBD610
00330                                                                   DTSBD610
00331                                                                   DTSBD610
00332      05  WRK-PARM-CURRENT-YEAR           PIC  9(04).              DTSBD610
00333                                                                   DTSBD610
00334                                                                   DTSBD610
00335      05  WRK-BROWSE-EMP-NO               PIC S9(07)      COMP-3.  DTSBD610
00336                                                                   DTSBD610
00337      05  WRK-EMP-NO                      PIC S9(07)      COMP-3.  DTSBD610
00338                                                                   DTSBD610
00339      05  WRK-FEIN                        PIC S9(09)      COMP-3.  DTSBD610
00340                                                                   DTSBD610
00341                                                                   DTSBD610
00342      05  WRK-PREV-REQUEST-FEIN-X         PIC  X(09).              DTSBD610
00343                                                                   DTSBD610
00344      05  WRK-PREV-REQUEST-TAX-PERIOD-X   PIC  X(06).              DTSBD610
00345                                                                   DTSBD610
00346                                                                   DTSBD610
00347      05  WRK-EMP-CLASS-RATED-IND         PIC  X(01).              DTSBD610
00348                                                                   DTSBD610
00349      05  WRK-LIABLE-IND                  PIC  X(01).              DTSBD610
00350                                                                   DTSBD610
00351      05  WRK-LIAB-CNT                    PIC S9(04)  COMP.        DTSBD610
00352                                                                   DTSBD610
00353      05  WRK-NOT-LIAB-CNT                PIC S9(04)  COMP.        DTSBD610
00354                                                                   DTSBD610
00355                                                                   DTSBD610
00356      05  CERT-REQUEST-EOF-IND            PIC  X(01).              DTSBD610
00357                                                                   DTSBD610
00358      05  CERT-REQUEST-REC-CNT            PIC S9(07)      COMP-3.  DTSBD610
00359                                                                   DTSBD610
00360      05  CERT-REPLY-MATCHED-REC-CNT      PIC S9(07)      COMP-3.  DTSBD610
00361                                                                   DTSBD610
00362      05  CERT-REPLY-NOT-ONLINE-REC-CNT   PIC S9(07)      COMP-3.  DTSBD610
00363                                                                   DTSBD610
00364      05  CERT-REPLY-UNMATCHED-REC-CNT    PIC S9(07)      COMP-3.  DTSBD610
00365                                                                   DTSBD610
00366      05  CERT-REPLY-TOT-REC-CNT          PIC S9(07)      COMP-3.  DTSBD610
00367                                                                   DTSBD610
00368      05  ZERO-CERT-REPLY-CNT             PIC S9(07)      COMP-3.  DTSBD610
00369                                                                   DTSBD610
00370      05  NON-ZERO-CERT-REPLY-CNT         PIC S9(07)      COMP-3.  DTSBD610
00371                                                                   DTSBD610
00372      05  CURR-YEAR-CERT-REC-CNT          PIC S9(07)      COMP-3.  DTSBD610
00373                                                                   DTSBD610
00374      05  HOLD-REPLY-REC                  PIC  X(326).             DTSBD610
00375                                                                   DTSBD610
00376      05  ZERO-FILL-SIC                   PIC 9.                   DTSBD610
00377                                                                   DTSBD610
00378      05  WRK-DATE-9                      PIC  9(08).              DTSBD610
00379      05  WRK-DATE-X REDEFINES WRK-DATE-9.                         DTSBD610
00380          10  WRK-YR                      PIC  9(04).              DTSBD610
00381          10  WRK-MO                      PIC  9(02).              DTSBD610
00382          10  WRK-DA                      PIC  9(02).              DTSBD610
00383                                                                   DTSBD610
00384      05  WRK-QTR-9                       PIC  9(05).              DTSBD610
00385      05  WRK-QTR-X REDEFINES WRK-QTR-9.                           DTSBD610
00386          10  WRK-QTR-YR                  PIC  9(04).              DTSBD610
00387          10  WRK-QTR-Q                   PIC  9(01).              DTSBD610
00388                                                                   DTSBD610
00389                                                                   DTSBD610
00390      05  WRK-CERT-YEAR-MONTH.                                     DTSBD610
00391          10  WRK-CERT-YEAR               PIC  9(04).              DTSBD610
00392          10  WRK-CERT-MONTH              PIC  9(02).              DTSBD610
00393                                                                   DTSBD610
00394      05  WRK-CERT-FEB-1-DATE             PIC S9(09)      COMP-3.  DTSBD610
00395                                                                   DTSBD610
00396      05  WRK-CERT-FEB-10-DATE            PIC S9(09)      COMP-3.  DTSBD610
00397                                                                   DTSBD610
00398      05  WRK-CERT-APR-15-DATE            PIC S9(09)      COMP-3.  DTSBD610
00399                                                                   DTSBD610
00400                                                                   DTSBD610
00401      05  RATE-CNT                        PIC S9(04)  COMP.        DTSBD610
00402                                                                   DTSBD610
00403      05  RATE-SUB                        PIC S9(04)  COMP.        DTSBD610
00404                                                                   DTSBD610
00405      05  RATE-MATCH                      PIC  X(01).              DTSBD610
00406                                                                   DTSBD610
00407                                                                   DTSBD610
00408      05  WRK-PAID-PRIOR-2-1              PIC S9(09)V9(02) COMP-3. DTSBD610
00409                                                                   DTSBD610
00410      05  WRK-PAID-2-1-THRU-2-10          PIC S9(09)V9(02) COMP-3. DTSBD610
00411                                                                   DTSBD610
00412      05  WRK-PAID-AFTER-2-10             PIC S9(09)V9(02) COMP-3. DTSBD610
00413                                                                   DTSBD610
00414      05  WRK-PAID-THRU-4-15              PIC S9(09)V9(02) COMP-3. DTSBD610
00415                                                                   DTSBD610
00416      05  WRK-PAID-AFTER-4-15             PIC S9(09)V9(02) COMP-3. DTSBD610
00417                                                                   DTSBD610
00418                                                                   DTSBD610
00419      05  WRK-YRQ-SUB                     PIC S9(04)  COMP.        DTSBD610
00420                                                                   DTSBD610
00421      05  WRK-YRQ-AREA OCCURS 4 TIMES                              DTSBD610
00422                       INDEXED BY WRK-YRQ-IDX.                     DTSBD610
00423          10  WRK-YRQ                     PIC S9(05)       COMP-3. DTSBD610
00424          10  WRK-YRQ-LIABLE-IND          PIC  X(01).              DTSBD610
00425          10  WRK-RPT-FILED-IND           PIC  X(01).              DTSBD610
00426          10  WRK-RATE                    PIC S9(01)V9(04) COMP-3. DTSBD610
00427          10  WRK-TAXABLE-WAGES           PIC S9(11)V9(02) COMP-3. DTSBD610
00428                                                                   DTSBD610
00429                                                                   DTSBD610
00430      05  WRK-REQUEST-EMP-NO-AREA.                                 DTSBD610
00431          10  WRK-REQUEST-EMP-NO          PIC  9(06).              DTSBD610
00432          10  FILLER REDEFINES WRK-REQUEST-EMP-NO.                 DTSBD610
00433              15  WRK-REQUEST-EMP-NO-CHAR                          DTSBD610
00434                  OCCURS 6 TIMES          PIC  X(01).              DTSBD610
00435                                                                   DTSBD610
00436          10  WRK-REQUEST-EMP-NO-CHAR-SUB PIC S9(04)  COMP.        DTSBD610
00437                                                                   DTSBD610
00438          10  REQUEST-EMP-NO-CHAR-SUB     PIC S9(04)  COMP.        DTSBD610
00439      EJECT                                                        DTSBD610
00440  01  MSG-AREA.                                                    DTSBD610
00441      05  MSG01-NO-MATCH.                                          DTSBD610
00442          10  FILLER                      PIC  X(40)               DTSBD610
00443                VALUE 'NO MATCH ON FEIN OR EMP NO              '.  DTSBD610
00444          10  FILLER                      PIC  X(40)               DTSBD610
00445                VALUE '                                        '.  DTSBD610
00446                                                                   DTSBD610
00447      05  MSG02-MULTIPLE-EMP.                                      DTSBD610
00448          10  FILLER                      PIC  X(40)               DTSBD610
00449                VALUE 'MULTIPLE EMPLOYERS WITH SAME FEIN ACTIVE'.  DTSBD610
00450          10  FILLER                      PIC  X(40)               DTSBD610
00451                VALUE 'DURING REPORT PERIOD                    '.  DTSBD610
00452                                                                   DTSBD610
00453 *****05  MSG03-NOT-LIABLE.                                        DTSBD610
00454 *********10  FILLER                      PIC  X(40)               DTSBD610
00455 ***************VALUE 'EMPLOYER NOT LIABLE DURING CERTIFICATION'.  DTSBD610
00456 *********10  FILLER                      PIC  X(40)               DTSBD610
00457 ***************VALUE 'PERIOD                                  '.  DTSBD610
00458                                                                   DTSBD610
00459      05  MSG04-INFO-NOT-AVAILABLE.                                DTSBD610
00460          10  FILLER                      PIC  X(40)               DTSBD610
00461                VALUE 'INFORMATION NOT AVAILABLE               '.  DTSBD610
00462          10  FILLER                      PIC  X(40)               DTSBD610
00463                VALUE '                                        '.  DTSBD610
00464                                                                   DTSBD610
00465 *****05  MSG05-NO-RPTS-FILED.                                     DTSBD610
00466 *********10  FILLER                      PIC  X(40)               DTSBD610
00467 ***************VALUE 'EMPLOYER HAS NOT FILED ANY REPORTS COVER'.  DTSBD610
00468 *********10  FILLER                      PIC  X(40)               DTSBD610
00469 ***************VALUE 'ING CERTIFICATION PERIOD                '.  DTSBD610
00470                                                                   DTSBD610
00471      05  MSG06-SELF-INSURED.                                      DTSBD610
00472          10  FILLER                      PIC  X(40)               DTSBD610
00473                VALUE 'CERTIFICATION REQUESTED FOR SELF INSURED'.  DTSBD610
00474          10  FILLER                      PIC  X(40)               DTSBD610
00475                VALUE ' EMPLOYER                               '.  DTSBD610
00476                                                                   DTSBD610
00477      05  MSG07-MULTIPLE-INACT.                                    DTSBD610
00478          10  FILLER                      PIC  X(40)               DTSBD610
00479                VALUE 'MULTIPLE EMPLOYERS FOR FEIN DURING      '.  DTSBD610
00480          10  FILLER                      PIC  X(40)               DTSBD610
00481                VALUE 'REPORT PERIOD - ALL ARE INACTIVE        '.  DTSBD610
00482                                                                   DTSBD610
00483      05  MSG08-DUP-FEIN-AND-TAX-PERIOD.                           DTSBD610
00484          10  FILLER                      PIC  X(40)               DTSBD610
00485                VALUE 'DUPLICATE FEIN + TAX PERIOD             '.  DTSBD610
00486          10  FILLER                      PIC  X(40)               DTSBD610
00487                VALUE '                                        '.  DTSBD610
00488      EJECT                                                        DTSBD610
00489  01  L910-LINK-AREA.                                              DTSBD610
00490  ++INCLUDE DTSIL910                                               DTSBD610
00491      SKIP3                                                        DTSBD610
00492  01  MSKL-REC.                                                    DTSBD610
00493  ++INCLUDE DTSIMSKL                                               DTSBD610
00494      SKIP3                                                        DTSBD610
00495  01  MHDR-REC.                                                    DTSBD610
00496  ++INCLUDE DTSIMHDR                                               DTSBD610
00497      SKIP3                                                        DTSBD610
00498  01  MPRF-REC.                                                    DTSBD610
00499  ++INCLUDE DTSIMPRF                                               DTSBD610
00500      SKIP3                                                        DTSBD610
00501  01  MSOL-REC.                                                    DTSBD610
00502  ++INCLUDE DTSIMSOL                                               DTSBD610
00503      SKIP3                                                        DTSBD610
00504  01  MQTR-REC.                                                    DTSBD610
00505  ++INCLUDE DTSIMQTR                                               DTSBD610
00506      SKIP3                                                        DTSBD610
00507  01  MDST-REC.                                                    DTSBD610
00508  ++INCLUDE DTSIMDST                                               DTSBD610
00509      EJECT                                                        DTSBD610
00510  01  L921-LINK-AREA.                                              DTSBD610
00511  ++INCLUDE DTSIL921                                               DTSBD610
00512      SKIP3                                                        DTSBD610
00513  01  ISKL-REC.                                                    DTSBD610
00514  ++INCLUDE DTSIISKL                                               DTSBD610
00515      SKIP3                                                        DTSBD610
00516  01  IEIN-REC.                                                    DTSBD610
00517  ++INCLUDE DTSIIEIN                                               DTSBD610
00518      EJECT                                                        DTSBD610
00519  01  L931-LINK-AREA.                                              DTSBD610
00520  ++INCLUDE DTSIL931                                               DTSBD610
00521      SKIP3                                                        DTSBD610
00522  01  FSKL-REC.                                                    DTSBD610
00523  ++INCLUDE DTSIFSKL                                               DTSBD610
00524      EJECT                                                        DTSBD610
00525  01  RSK1-REC.                                                    DTSBD610
00526  ++INCLUDE DTSIRSK1                                               DTSBD610
00527      SKIP3                                                        DTSBD610
00528  01  R704-REC.                                                    DTSBD610
00529  ++INCLUDE DTSIR704                                               DTSBD610
00530      EJECT                                                        DTSBD610
00531  01  R705-REC.                                                    DTSBD610
00532  ++INCLUDE DTSIR705                                               DTSBD610
00533      EJECT                                                        DTSBD610
00534  01  L007-LINK-AREA.                                              DTSBD610
00535  ++INCLUDE DTSIL007                                               DTSBD610
00536      EJECT                                                        DTSBD610
00537  01  L516-LINK-AREA.                                              DTSBD610
00538  ++INCLUDE DTSIL516                                               DTSBD610
00539      EJECT                                                        DTSBD610
00540  LINKAGE SECTION.                                                 DTSBD610
00541                                                                   DTSBD610
00542  01  PARM-AREA.                                                   DTSBD610
00543      05  PARM-LENGTH                PIC S9(04)  COMP.             DTSBD610
00544      05  PARM-CERT-CURRENT-YEAR     PIC  X(02).                   DTSBD610
00545      EJECT                                                        DTSBD610
00546  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD610
00547                                                                   DTSBD610
00548                                                                   DTSBD610
00549      PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT.                 DTSBD610
00550                                                                   DTSBD610
00551                                                                   DTSBD610
00552      PERFORM I2000-INIT-FILES-AND-COUNTS THRU I2000-EXIT.         DTSBD610
00553                                                                   DTSBD610
00554                                                                   DTSBD610
00555      PERFORM I3000-EDIT-CERT-CURRENT-YEAR THRU I3000-EXIT.        DTSBD610
00556                                                                   DTSBD610
00557                                                                   DTSBD610
00558      MOVE 'N' TO CERT-REQUEST-EOF-IND.                            DTSBD610
00559                                                                   DTSBD610
00560      PERFORM P0000-CERT-REQUEST THRU P0000-EXIT                   DTSBD610
00561          UNTIL CERT-REQUEST-EOF-IND = 'Y'.                        DTSBD610
00562                                                                   DTSBD610
00563                                                                   DTSBD610
00564      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD610
00565                                                                   DTSBD610
00566                                                                   DTSBD610
00567      GOBACK.                                                      DTSBD610
00568      EJECT                                                        DTSBD610
00569  I1000-PROCESS-PARMS.                                             DTSBD610
00570      IF PARM-LENGTH = +2                                          DTSBD610
00571          NEXT SENTENCE                                            DTSBD610
00572      ELSE                                                         DTSBD610
00573          DISPLAY 'PARM-LENGTH NOT EQUAL TO 2'                     DTSBD610
00574          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
00575                                                                   DTSBD610
00576                                                                   DTSBD610
00577      IF PARM-CERT-CURRENT-YEAR NOT NUMERIC                        DTSBD610
00578          DISPLAY 'PARM-CERT-CURRENT-YEAR NOT NUMERIC'             DTSBD610
00579          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
00580                                                                   DTSBD610
00581                                                                   DTSBD610
00582      MOVE PARM-CERT-CURRENT-YEAR TO L007-YR-2-X.                  DTSBD610
00583                                                                   DTSBD610
00584      PERFORM S007-FROM-YEAR-2 THRU S007-EXIT.                     DTSBD610
00585                                                                   DTSBD610
00586      IF L007-NOT-VALID-YR                                         DTSBD610
00587          DISPLAY 'PARM-CERT-CURRENT-YEAR NOT VALID'               DTSBD610
00588          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
00589                                                                   DTSBD610
00590      MOVE L007-YR-4-9 TO WRK-PARM-CURRENT-YEAR.                   DTSBD610
00591  I1000-EXIT.                                                      DTSBD610
00592      EXIT.                                                        DTSBD610
00593      EJECT                                                        DTSBD610
00594  I2000-INIT-FILES-AND-COUNTS.                                     DTSBD610
00595      MOVE 'N' TO L910-TRACE-IND                                   DTSBD610
00596                  L921-TRACE-IND                                   DTSBD610
00597                  L921-TRACE-IND                                   DTSBD610
00598                  L516-TRACE-IND.                                  DTSBD610
00599                                                                   DTSBD610
00600      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBD610
00601                           L921-MOD-NAME                           DTSBD610
00602                           L931-MOD-NAME.                          DTSBD610
00603                                                                   DTSBD610
00604                                                                   DTSBD610
00605      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD610
00606                                                                   DTSBD610
00607      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD610
00608                                                                   DTSBD610
00609      PERFORM S931-OPEN-READ THRU S931-EXIT.                       DTSBD610
00610                                                                   DTSBD610
00611      OPEN INPUT CERT-REQUEST-FILE.                                DTSBD610
00612                                                                   DTSBD610
00613      OPEN OUTPUT CERT-REPLY-FILE                                  DTSBD610
00614                  ZERO-CERT-REPLY-FILE                             DTSBD610
00615                  NON-ZERO-CERT-REPLY-FILE                         DTSBD610
00616                  CURRENT-YEAR-CERT-FILE.                          DTSBD610
00617                                                                   DTSBD610
00618                                                                   DTSBD610
00619      MOVE +0 TO CERT-REQUEST-REC-CNT                              DTSBD610
00620                 CERT-REPLY-MATCHED-REC-CNT                        DTSBD610
00621                 CERT-REPLY-NOT-ONLINE-REC-CNT                     DTSBD610
00622                 CERT-REPLY-UNMATCHED-REC-CNT                      DTSBD610
00623                 CERT-REPLY-TOT-REC-CNT                            DTSBD610
00624                 CURR-YEAR-CERT-REC-CNT                            DTSBD610
00625                 ZERO-CERT-REPLY-CNT                               DTSBD610
00626                 ZERO-FILL-SIC                                     DTSBD610
00627                 NON-ZERO-CERT-REPLY-CNT.                          DTSBD610
00628                                                                   DTSBD610
00629                                                                   DTSBD610
00630      MOVE SPACES TO WRK-PREV-REQUEST-FEIN-X                       DTSBD610
00631                     WRK-PREV-REQUEST-TAX-PERIOD-X.                DTSBD610
00632                                                                   DTSBD610
00633                                                                   DTSBD610
00634      MOVE LENGTH OF R704-REC TO R704-LENGTH.                      DTSBD610
00635                                                                   DTSBD610
00636      MOVE LENGTH OF R705-REC TO R705-LENGTH.                      DTSBD610
00637  I2000-EXIT.                                                      DTSBD610
00638      EXIT.                                                        DTSBD610
00639      EJECT                                                        DTSBD610
00640  I3000-EDIT-CERT-CURRENT-YEAR.                                    DTSBD610
00641      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD610
00642                                                                   DTSBD610
00643      MOVE +0 TO MSKL-EMP-NO.                                      DTSBD610
00644                                                                   DTSBD610
00645      SET MSKL-HDR-88 TO TRUE.                                     DTSBD610
00646                                                                   DTSBD610
00647      PERFORM S910-READ THRU S910-EXIT.                            DTSBD610
00648                                                                   DTSBD610
00649      IF L910-NO-REC-88                                            DTSBD610
00650          DISPLAY 'MASTER HEADER RECORD NOT FOUND'                 DTSBD610
00651          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
00652                                                                   DTSBD610
00653                                                                   DTSBD610
00654      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD610
00655                                                                   DTSBD610
00656                                                                   DTSBD610
00657      MOVE WRK-PARM-CURRENT-YEAR TO WRK-QTR-YR.                    DTSBD610
00658                                                                   DTSBD610
00659      MOVE 4 TO WRK-QTR-Q.                                         DTSBD610
00660                                                                   DTSBD610
00661      IF WRK-QTR-9 > MHDR-LAST-UC30-DEL-MAIL-YRQ                   DTSBD610
00662          DISPLAY 'TOO EARLY TO CERTIFY SPECIFIED YEAR'            DTSBD610
00663          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
00664  I3000-EXIT.                                                      DTSBD610
00665      EXIT.                                                        DTSBD610
00666      EJECT                                                        DTSBD610
00667  P0000-CERT-REQUEST.                                              DTSBD610
00668      READ CERT-REQUEST-FILE                                       DTSBD610
00669          AT END                                                   DTSBD610
00670              MOVE 'Y' TO CERT-REQUEST-EOF-IND                     DTSBD610
00671              GO TO P0000-EXIT.                                    DTSBD610
00672                                                                   DTSBD610
00673                                                                   DTSBD610
00674      ADD +1 TO CERT-REQUEST-REC-CNT.                              DTSBD610
00675                                                                   DTSBD610
00676                                                                   DTSBD610
00677      PERFORM P1100-INIT-WRK THRU P1100-EXIT.                      DTSBD610
00678                                                                   DTSBD610
00679      PERFORM P1200-INIT-REPLY THRU P1200-EXIT.                    DTSBD610
00680                                                                   DTSBD610
00681      PERFORM P1300-INIT-R704 THRU P1300-EXIT.                     DTSBD610
00682                                                                   DTSBD610
00683      PERFORM P1400-INIT-R705 THRU P1400-EXIT.                     DTSBD610
00684                                                                   DTSBD610
00685                                                                   DTSBD610
00686      MOVE +0 TO WRK-EMP-NO WRK-FEIN.                              DTSBD610
00687                                                                   DTSBD610
00688      MOVE 'N' TO WRK-EMP-CLASS-RATED-IND.                         DTSBD610
00689                                                                   DTSBD610
00690      PERFORM P3000-DETERMINE-EMP-NO THRU P3000-EXIT.              DTSBD610
00691                                                                   DTSBD610
00692      IF WRK-EMP-NO NOT = +0                                       DTSBD610
00693          PERFORM P5000-PROCESS-EMP-NO THRU P5000-EXIT.            DTSBD610
00694                                                                   DTSBD610
00695                                                                   DTSBD610
00696      PERFORM P6100-WRITE-REPLY THRU P6100-EXIT.                   DTSBD610
00697                                                                   DTSBD610
00698                                                                   DTSBD610
00699      IF R705-MSG-TEXT = SPACES                                    DTSBD610
00700          MOVE WRK-EMP-NO TO R704-EMP-NO                           DTSBD610
00701          IF WRK-FEIN NOT = +0                                     DTSBD610
00702              MOVE WRK-FEIN TO R704-FEIN                           DTSBD610
00703          END-IF                                                   DTSBD610
00704          MOVE WRK-PAID-PRIOR-2-1 TO R704-ONTIME                   DTSBD610
00705          MOVE WRK-PAID-2-1-THRU-2-10 TO R704-GRACE                DTSBD610
00706          MOVE WRK-PAID-AFTER-2-10 TO R704-LATE                    DTSBD610
00707          MOVE WRK-PAID-THRU-4-15 TO R704-ONTIME-SCHED-H           DTSBD610
00708          MOVE WRK-PAID-AFTER-4-15 TO R704-LATE-SCHED-H            DTSBD610
00709          MOVE RATE-CNT TO R704-WAGE-RATE-CNT                      DTSBD610
00710          PERFORM S946-WRITE-R704 THRU S946-EXIT                   DTSBD610
00711      ELSE                                                         DTSBD610
00712          MOVE WRK-EMP-NO TO R705-EMP-NO                           DTSBD610
00713          PERFORM S946-WRITE-R705 THRU S946-EXIT.                  DTSBD610
00714                                                                   DTSBD610
00715                                                                   DTSBD610
00716      MOVE REQUEST-FEIN-X TO WRK-PREV-REQUEST-FEIN-X.              DTSBD610
00717                                                                   DTSBD610
00718      MOVE REQUEST-TAX-PERIOD-X TO WRK-PREV-REQUEST-TAX-PERIOD-X.  DTSBD610
00719                                                                   DTSBD610
00720                                                                   DTSBD610
00721 *&                                                                DTSBD610
00722      IF MPRF-EMP-NO NUMERIC                                       DTSBD610
00723         IF MPRF-EMP-NO = 073415                                   DTSBD610
00724            DISPLAY 'P0000 ONTIME ' R704-ONTIME                    DTSBD610
00725               '  GRACE ' R704-GRACE                               DTSBD610
00726               '  LATE ' R704-LATE.                                DTSBD610
00727 *&                                                                DTSBD610
00728  P0000-EXIT.                                                      DTSBD610
00729      EXIT.                                                        DTSBD610
00730      EJECT                                                        DTSBD610
00731  P1100-INIT-WRK.                                                  DTSBD610
00732      MOVE REQUEST-TAX-YEAR TO L007-YR-4-X.                        DTSBD610
00733                                                                   DTSBD610
00734      PERFORM S007-FROM-YEAR-4 THRU S007-EXIT.                     DTSBD610
00735                                                                   DTSBD610
00736      MOVE L007-YR-4-9 TO WRK-CERT-YEAR                            DTSBD610
00737                                                                   DTSBD610
00738      MOVE REQUEST-TAX-MONTH TO WRK-CERT-MONTH.                    DTSBD610
00739                                                                   DTSBD610
00740                                                                   DTSBD610
00741      MOVE WRK-CERT-YEAR-MONTH TO WRK-DATE-X.                      DTSBD610
00742                                                                   DTSBD610
00743      ADD  +1 TO WRK-YR.                                           DTSBD610
00744                                                                   DTSBD610
00745      MOVE 02 TO WRK-MO.                                           DTSBD610
00746                                                                   DTSBD610
00747      MOVE 01 TO WRK-DA.                                           DTSBD610
00748                                                                   DTSBD610
00749      MOVE WRK-DATE-9 TO WRK-CERT-FEB-1-DATE.                      DTSBD610
00750                                                                   DTSBD610
00751      MOVE 10 TO WRK-DA.                                           DTSBD610
00752                                                                   DTSBD610
00753      MOVE WRK-DATE-9 TO WRK-CERT-FEB-10-DATE.                     DTSBD610
00754                                                                   DTSBD610
00755      MOVE 04 TO WRK-MO.                                           DTSBD610
00756                                                                   DTSBD610
00757      MOVE 15 TO WRK-DA.                                           DTSBD610
00758                                                                   DTSBD610
00759      MOVE WRK-DATE-9 TO WRK-CERT-APR-15-DATE.                     DTSBD610
00760                                                                   DTSBD610
00761                                                                   DTSBD610
00762      PERFORM P1110-INIT-WRK-YRQ THRU P1110-EXIT                   DTSBD610
00763          VARYING WRK-YRQ-SUB FROM 1 BY 1                          DTSBD610
00764          UNTIL WRK-YRQ-SUB > 4.                                   DTSBD610
00765                                                                   DTSBD610
00766      MOVE +0 TO WRK-PAID-PRIOR-2-1                                DTSBD610
00767                 WRK-PAID-2-1-THRU-2-10                            DTSBD610
00768                 WRK-PAID-AFTER-2-10                               DTSBD610
00769                 WRK-PAID-THRU-4-15                                DTSBD610
00770                 WRK-PAID-AFTER-4-15.                              DTSBD610
00771  P1100-EXIT.                                                      DTSBD610
00772      EXIT.                                                        DTSBD610
00773      SKIP3                                                        DTSBD610
00774  P1110-INIT-WRK-YRQ.                                              DTSBD610
00775      MOVE WRK-CERT-YEAR TO WRK-QTR-YR.                            DTSBD610
00776                                                                   DTSBD610
00777      MOVE WRK-YRQ-SUB TO WRK-QTR-Q.                               DTSBD610
00778                                                                   DTSBD610
00779      MOVE WRK-QTR-9 TO WRK-YRQ (WRK-YRQ-SUB).                     DTSBD610
00780                                                                   DTSBD610
00781      MOVE 'N' TO WRK-YRQ-LIABLE-IND (WRK-YRQ-SUB)                 DTSBD610
00782                  WRK-RPT-FILED-IND (WRK-YRQ-SUB).                 DTSBD610
00783                                                                   DTSBD610
00784      MOVE +0 TO WRK-RATE (WRK-YRQ-SUB)                            DTSBD610
00785                 WRK-TAXABLE-WAGES (WRK-YRQ-SUB).                  DTSBD610
00786  P1110-EXIT.                                                      DTSBD610
00787      EXIT.                                                        DTSBD610
00788      EJECT                                                        DTSBD610
00789  P1200-INIT-REPLY.                                                DTSBD610
00790      MOVE ZEROS TO REPLY-REC.                                     DTSBD610
00791                                                                   DTSBD610
00792                                                                   DTSBD610
00793      MOVE WRK-REPLY-CHAR-CNT TO REPLY-CHAR-CNT.                   DTSBD610
00794                                                                   DTSBD610
00795      MOVE +0 TO REPLY-HEX-ZERO.                                   DTSBD610
00796                                                                   DTSBD610
00797      MOVE 'DC' TO REPLY-STATE-CD.                                 DTSBD610
00798                                                                   DTSBD610
00799      MOVE REQUEST-FEIN-X TO REPLY-FEIN-X.                         DTSBD610
00800                                                                   DTSBD610
00801      MOVE REQUEST-DOC-LOC-NUMBER TO REPLY-DOC-LOC-NUMBER.         DTSBD610
00802                                                                   DTSBD610
00803      MOVE REQUEST-TAX-PERIOD TO REPLY-TAX-PERIOD.                 DTSBD610
00804                                                                   DTSBD610
00805      MOVE REQUEST-CHECK-DIGIT TO REPLY-CHECK-DIGIT.               DTSBD610
00806                                                                   DTSBD610
00807      MOVE SPACE TO REPLY-RESPONSE-IND                             DTSBD610
00808                    REPLY-EMP-NO-AREA.                             DTSBD610
00809                                                                   DTSBD610
00810      MOVE REQUEST-NAME-CONTROL TO REPLY-NAME-CONTROL.             DTSBD610
00811                                                                   DTSBD610
00812      MOVE REQUEST-FORM-INDICATOR TO REPLY-FORM-INDICATOR.         DTSBD610
00813                                                                   DTSBD610
00814                                                                   DTSBD610
00815 *****                                                             DTSBD610
00816 *    THE TAX YEAR 1997 IRS SPECIFICATION STATES "COPY             DTSBD610
00817 *    POSITIONS 269-277 OF THE FUTA IDENTIFICATION                 DTSBD610
00818 *    RECORD".                                                     DTSBD610
00819 *****                                                             DTSBD610
00820                                                                   DTSBD610
00821      MOVE REQUEST-XREF-FEIN TO REPLY-XREF-FEIN-X.                 DTSBD610
00822  P1200-EXIT.                                                      DTSBD610
00823      EXIT.                                                        DTSBD610
00824      SKIP3                                                        DTSBD610
00825  P1300-INIT-R704.                                                 DTSBD610
00826      IF REQUEST-FEIN NUMERIC                                      DTSBD610
00827          MOVE REQUEST-FEIN TO R704-FEIN                           DTSBD610
00828      ELSE                                                         DTSBD610
00829          MOVE +0 TO R704-FEIN.                                    DTSBD610
00830                                                                   DTSBD610
00831      MOVE WRK-CERT-YEAR-MONTH    TO R704-TAX-YEAR-MONTH.          DTSBD610
00832                                                                   DTSBD610
00833                                                                   DTSBD610
00834      INITIALIZE R704-DATA-AREA.                                   DTSBD610
00835                                                                   DTSBD610
00836                                                                   DTSBD610
00837      MOVE REQUEST-DOC-LOC-NUMBER TO R704-DOC-LOC-NO.              DTSBD610
00838                                                                   DTSBD610
00839      MOVE REQUEST-CHECK-DIGIT TO R704-CHECK-DIGIT.                DTSBD610
00840                                                                   DTSBD610
00841      MOVE REQUEST-FORM-INDICATOR TO R704-FORM-INDICATOR.          DTSBD610
00842  P1300-EXIT.                                                      DTSBD610
00843      EXIT.                                                        DTSBD610
00844      SKIP3                                                        DTSBD610
00845  P1400-INIT-R705.                                                 DTSBD610
00846      IF REQUEST-FEIN NUMERIC                                      DTSBD610
00847          MOVE REQUEST-FEIN TO R705-FEIN                           DTSBD610
00848      ELSE                                                         DTSBD610
00849          MOVE +0 TO R705-FEIN.                                    DTSBD610
00850                                                                   DTSBD610
00851      MOVE WRK-CERT-YEAR-MONTH TO R705-TAX-YEAR-MONTH.             DTSBD610
00852                                                                   DTSBD610
00853                                                                   DTSBD610
00854      INITIALIZE R705-DATA-AREA.                                   DTSBD610
00855                                                                   DTSBD610
00856                                                                   DTSBD610
00857      MOVE REQUEST-ADDRESS-AREA TO R705-ADDRESS-AREA.              DTSBD610
00858                                                                   DTSBD610
00859      MOVE REQUEST-XREF-FEIN TO R705-XREF-FEIN.                    DTSBD610
00860                                                                   DTSBD610
00861      MOVE REQUEST-NAME-CONTROL TO R705-NAME-CONTROL.              DTSBD610
00862  P1400-EXIT.                                                      DTSBD610
00863      EXIT.                                                        DTSBD610
00864      EJECT                                                        DTSBD610
00865  P3000-DETERMINE-EMP-NO.                                          DTSBD610
00866      IF (REQUEST-FEIN-X = WRK-PREV-REQUEST-FEIN-X)                DTSBD610
00867             AND                                                   DTSBD610
00868         (REQUEST-TAX-PERIOD-X = WRK-PREV-REQUEST-TAX-PERIOD-X)    DTSBD610
00869          MOVE MSG08-DUP-FEIN-AND-TAX-PERIOD TO R705-MSG-TEXT      DTSBD610
00870          GO TO P3000-EXIT.                                        DTSBD610
00871                                                                   DTSBD610
00872                                                                   DTSBD610
00873      MOVE +0 TO WRK-LIAB-CNT                                      DTSBD610
00874                 WRK-NOT-LIAB-CNT.                                 DTSBD610
00875                                                                   DTSBD610
00876      IF REQUEST-FEIN NOT NUMERIC                                  DTSBD610
00877              OR                                                   DTSBD610
00878         REQUEST-FEIN = 0                                          DTSBD610
00879          PERFORM P3110-CHECK-REQUEST-EMP-NO THRU P3110-EXIT       DTSBD610
00880      ELSE                                                         DTSBD610
00881          MOVE LOW-VALUE TO IEIN-KEY-AREA                          DTSBD610
00882          SET IEIN-EIN-88 TO TRUE                                  DTSBD610
00883          MOVE REQUEST-FEIN TO IEIN-FEIN                           DTSBD610
00884          MOVE +0 TO IEIN-EMP-NO                                   DTSBD610
00885          MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA                      DTSBD610
00886          PERFORM S921-START-BROWSE THRU S921-EXIT                 DTSBD610
00887          MOVE ISKL-REC TO IEIN-REC                                DTSBD610
00888          PERFORM P3300-IEIN-BROWSE THRU P3300-EXIT                DTSBD610
00889                      UNTIL L921-NO-REC-88                         DTSBD610
00890                                OR                                 DTSBD610
00891                            IEIN-FEIN NOT = REQUEST-FEIN           DTSBD610
00892          PERFORM P3100-CHECK-LIAB-MULTIPLE THRU P3100-EXIT.       DTSBD610
00893  P3000-EXIT.                                                      DTSBD610
00894      EXIT.                                                        DTSBD610
00895      EJECT                                                        DTSBD610
00896  P3100-CHECK-LIAB-MULTIPLE.                                       DTSBD610
00897 *****DISPLAY                                                      DTSBD610
00898 ********' P3100 REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT : '        DTSBD610
00899 ********REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT.                   DTSBD610
00900                                                                   DTSBD610
00901      IF WRK-LIAB-CNT = +1                                         DTSBD610
00902          IF WRK-EMP-CLASS-RATED-IND = 'N'                         DTSBD610
00903              MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT             DTSBD610
00904          ELSE                                                     DTSBD610
00905              NEXT SENTENCE                                        DTSBD610
00906      ELSE                                                         DTSBD610
00907      IF WRK-LIAB-CNT > +1                                         DTSBD610
00908          MOVE +0 TO WRK-EMP-NO                                    DTSBD610
00909          MOVE MSG02-MULTIPLE-EMP TO R705-MSG-TEXT                 DTSBD610
00910      ELSE                                                         DTSBD610
00911      IF WRK-NOT-LIAB-CNT = +1                                     DTSBD610
00912          IF WRK-EMP-CLASS-RATED-IND = 'N'                         DTSBD610
00913              MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT             DTSBD610
00914          ELSE                                                     DTSBD610
00915              NEXT SENTENCE                                        DTSBD610
00916      ELSE                                                         DTSBD610
00917      IF WRK-NOT-LIAB-CNT > +1                                     DTSBD610
00918          MOVE +0 TO WRK-EMP-NO                                    DTSBD610
00919          MOVE MSG07-MULTIPLE-INACT TO R705-MSG-TEXT               DTSBD610
00920      ELSE                                                         DTSBD610
00921      IF R705-MSG-TEXT = SPACES                                    DTSBD610
00922          PERFORM P3110-CHECK-REQUEST-EMP-NO THRU P3110-EXIT.      DTSBD610
00923  P3100-EXIT.                                                      DTSBD610
00924      EXIT.                                                        DTSBD610
00925      EJECT                                                        DTSBD610
00926  P3110-CHECK-REQUEST-EMP-NO.                                      DTSBD610
00927      MOVE ZERO TO WRK-REQUEST-EMP-NO.                             DTSBD610
00928                                                                   DTSBD610
00929      MOVE +7 TO WRK-REQUEST-EMP-NO-CHAR-SUB.                      DTSBD610
00930                                                                   DTSBD610
00931      PERFORM P3111-EXAMINE-CHARACTER THRU P3111-EXIT              DTSBD610
00932          VARYING REQUEST-EMP-NO-CHAR-SUB FROM 15 BY -1            DTSBD610
00933          UNTIL REQUEST-EMP-NO-CHAR-SUB < +1.                      DTSBD610
00934                                                                   DTSBD610
00935      IF WRK-REQUEST-EMP-NO = ZERO                                 DTSBD610
00936          MOVE MSG01-NO-MATCH TO R705-MSG-TEXT                     DTSBD610
00937          GO TO P3110-EXIT.                                        DTSBD610
00938                                                                   DTSBD610
00939                                                                   DTSBD610
00940      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD610
00941                                                                   DTSBD610
00942      MOVE WRK-REQUEST-EMP-NO TO MSKL-EMP-NO.                      DTSBD610
00943                                                                   DTSBD610
00944      SET MSKL-PRF-88 TO TRUE.                                     DTSBD610
00945                                                                   DTSBD610
00946      PERFORM S910-READ THRU S910-EXIT.                            DTSBD610
00947                                                                   DTSBD610
00948      IF L910-NO-REC-88                                            DTSBD610
00949          MOVE MSG01-NO-MATCH TO R705-MSG-TEXT                     DTSBD610
00950          GO TO P3110-EXIT.                                        DTSBD610
00951                                                                   DTSBD610
00952                                                                   DTSBD610
00953      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD610
00954                                                                   DTSBD610
00955                                                                   DTSBD610
00956      IF MPRF-PRIMARY-NAME (1:4)                                   DTSBD610
00957            = REQUEST-NAME-1 (1:4)                                 DTSBD610
00958                OR REQUEST-NAME-CONTROL                            DTSBD610
00959          MOVE WRK-REQUEST-EMP-NO TO WRK-BROWSE-EMP-NO             DTSBD610
00960          PERFORM P3400-BROWSE-MASTER THRU P3400-EXIT              DTSBD610
00961          PERFORM P3200-CHECK-LIAB-SINGLE THRU P3200-EXIT          DTSBD610
00962 ******** DISPLAY 'REQUEST-FEIN-X = '                              DTSBD610
00963 *****************REQUEST-FEIN-X                                   DTSBD610
00964 *****************'     WRK-REQUEST-EMP-NO = '                     DTSBD610
00965 *****************WRK-REQUEST-EMP-NO                               DTSBD610
00966      ELSE                                                         DTSBD610
00967          MOVE MSG01-NO-MATCH TO R705-MSG-TEXT.                    DTSBD610
00968  P3110-EXIT.                                                      DTSBD610
00969      EXIT.                                                        DTSBD610
00970      SKIP3                                                        DTSBD610
00971  P3111-EXAMINE-CHARACTER.                                         DTSBD610
00972      IF REQUEST-EMP-NO-AREA (REQUEST-EMP-NO-CHAR-SUB:1) NUMERIC   DTSBD610
00973          CONTINUE                                                 DTSBD610
00974      ELSE                                                         DTSBD610
00975          GO TO P3111-EXIT.                                        DTSBD610
00976                                                                   DTSBD610
00977      SUBTRACT 1 FROM WRK-REQUEST-EMP-NO-CHAR-SUB.                 DTSBD610
00978                                                                   DTSBD610
00979      IF WRK-REQUEST-EMP-NO-CHAR-SUB < +1                          DTSBD610
00980          GO TO P3111-EXIT.                                        DTSBD610
00981                                                                   DTSBD610
00982      MOVE REQUEST-EMP-NO-AREA (REQUEST-EMP-NO-CHAR-SUB:1)         DTSBD610
00983        TO WRK-REQUEST-EMP-NO-CHAR (WRK-REQUEST-EMP-NO-CHAR-SUB).  DTSBD610
00984  P3111-EXIT.                                                      DTSBD610
00985      EXIT.                                                        DTSBD610
00986      EJECT                                                        DTSBD610
00987  P3200-CHECK-LIAB-SINGLE.                                         DTSBD610
00988 *****DISPLAY                                                      DTSBD610
00989 ********' P3200 REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT : '        DTSBD610
00990 ********REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT.                   DTSBD610
00991                                                                   DTSBD610
00992      IF WRK-LIAB-CNT = +1                                         DTSBD610
00993          IF WRK-EMP-CLASS-RATED-IND = 'N'                         DTSBD610
00994              MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT             DTSBD610
00995          ELSE                                                     DTSBD610
00996              NEXT SENTENCE                                        DTSBD610
00997      ELSE                                                         DTSBD610
00998      IF WRK-NOT-LIAB-CNT = +1                                     DTSBD610
00999          IF WRK-EMP-CLASS-RATED-IND = 'N'                         DTSBD610
01000              MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT             DTSBD610
01001          ELSE                                                     DTSBD610
01002              NEXT SENTENCE                                        DTSBD610
01003      ELSE                                                         DTSBD610
01004      IF R705-MSG-TEXT = SPACES                                    DTSBD610
01005          MOVE MSG01-NO-MATCH TO R705-MSG-TEXT.                    DTSBD610
01006  P3200-EXIT.                                                      DTSBD610
01007      EXIT.                                                        DTSBD610
01008      EJECT                                                        DTSBD610
01009  P3300-IEIN-BROWSE.                                               DTSBD610
01010      MOVE IEIN-EMP-NO TO WRK-BROWSE-EMP-NO.                       DTSBD610
01011                                                                   DTSBD610
01012      PERFORM P3400-BROWSE-MASTER THRU P3400-EXIT.                 DTSBD610
01013                                                                   DTSBD610
01014      MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA.                         DTSBD610
01015                                                                   DTSBD610
01016      PERFORM S921-READ THRU S921-EXIT.                            DTSBD610
01017                                                                   DTSBD610
01018      IF L921-NO-REC-88                                            DTSBD610
01019          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
01020                                                                   DTSBD610
01021      PERFORM S921-READ-NEXT THRU S921-EXIT.                       DTSBD610
01022                                                                   DTSBD610
01023      MOVE ISKL-REC TO IEIN-REC.                                   DTSBD610
01024  P3300-EXIT.                                                      DTSBD610
01025      EXIT.                                                        DTSBD610
01026      EJECT                                                        DTSBD610
01027  P3400-BROWSE-MASTER.                                             DTSBD610
01028      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD610
01029                                                                   DTSBD610
01030      MOVE WRK-BROWSE-EMP-NO TO MSKL-EMP-NO.                       DTSBD610
01031                                                                   DTSBD610
01032      SET MSKL-PRF-88 TO TRUE.                                     DTSBD610
01033                                                                   DTSBD610
01034      PERFORM S910-READ THRU S910-EXIT.                            DTSBD610
01035                                                                   DTSBD610
01036      IF L910-NO-REC-88                                            DTSBD610
01037          GO TO P3400-EXIT.                                        DTSBD610
01038                                                                   DTSBD610
01039      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD610
01040                                                                   DTSBD610
01041                                                                   DTSBD610
01042      MOVE 'N' TO WRK-LIABLE-IND.                                  DTSBD610
01043                                                                   DTSBD610
01044      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD610
01045                                                                   DTSBD610
01046      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD610
01047                                                                   DTSBD610
01048      SET MSKL-SOL-88 TO TRUE.                                     DTSBD610
01049                                                                   DTSBD610
01050      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD610
01051                                                                   DTSBD610
01052      MOVE MSKL-REC TO MSOL-REC.                                   DTSBD610
01053                                                                   DTSBD610
01054      PERFORM UNTIL L910-NO-REC-88                                 DTSBD610
01055              OR    WRK-LIABLE-IND = 'Y'                           DTSBD610
01056          IF WRK-YRQ (4) < MSOL-FIRST-LIAB-YRQ                     DTSBD610
01057          OR WRK-YRQ (1) > MSOL-LAST-LIAB-YRQ                      DTSBD610
01058              PERFORM S910-READ-NEXT THRU S910-EXIT                DTSBD610
01059              MOVE MSKL-REC TO MSOL-REC                            DTSBD610
01060          ELSE                                                     DTSBD610
01061              MOVE 'Y' TO WRK-LIABLE-IND                           DTSBD610
01062          END-IF                                                   DTSBD610
01063      END-PERFORM.                                                 DTSBD610
01064                                                                   DTSBD610
01065      IF WRK-LIABLE-IND = 'Y'                                      DTSBD610
01066          ADD +1 TO WRK-LIAB-CNT                                   DTSBD610
01067          MOVE MPRF-EMP-NO TO WRK-EMP-NO                           DTSBD610
01068          PERFORM P3410-EMP-CLASS THRU P3410-EXIT                  DTSBD610
01069      ELSE                                                         DTSBD610
01070          ADD +1 TO WRK-NOT-LIAB-CNT                               DTSBD610
01071          IF WRK-EMP-NO = +0                                       DTSBD610
01072              MOVE MPRF-EMP-NO TO WRK-EMP-NO                       DTSBD610
01073              PERFORM P3410-EMP-CLASS THRU P3410-EXIT.             DTSBD610
01074  P3400-EXIT.                                                      DTSBD610
01075      EXIT.                                                        DTSBD610
01076      SKIP3                                                        DTSBD610
01077  P3410-EMP-CLASS.                                                 DTSBD610
01078      IF NOT MPRF-CLASS-RATED-88                                   DTSBD610
01079          MOVE 'N' TO WRK-EMP-CLASS-RATED-IND                      DTSBD610
01080      ELSE                                                         DTSBD610
01081          MOVE 'Y' TO WRK-EMP-CLASS-RATED-IND.                     DTSBD610
01082  P3410-EXIT.                                                      DTSBD610
01083      EXIT.                                                        DTSBD610
01084      EJECT                                                        DTSBD610
01085  P5000-PROCESS-EMP-NO.                                            DTSBD610
01086      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD610
01087                                                                   DTSBD610
01088      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSBD610
01089                                                                   DTSBD610
01090      SET MSKL-PRF-88 TO TRUE.                                     DTSBD610
01091                                                                   DTSBD610
01092      PERFORM S910-READ THRU S910-EXIT.                            DTSBD610
01093                                                                   DTSBD610
01094      IF L910-NO-REC-88                                            DTSBD610
01095          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD610
01096                                                                   DTSBD610
01097                                                                   DTSBD610
01098      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD610
01099                                                                   DTSBD610
01100                                                                   DTSBD610
01101      MOVE MPRF-FEIN TO WRK-FEIN.                                  DTSBD610
01102                                                                   DTSBD610
01103                                                                   DTSBD610
01104      PERFORM P5100-SET-YRQ-LIABLE THRU P5100-EXIT                 DTSBD610
01105          VARYING WRK-YRQ-IDX FROM 1 BY 1                          DTSBD610
01106          UNTIL WRK-YRQ-IDX > 4.                                   DTSBD610
01107                                                                   DTSBD610
01108                                                                   DTSBD610
01109      IF R705-MSG-TEXT NOT = SPACES                                DTSBD610
01110          GO TO P5000-EXIT.                                        DTSBD610
01111                                                                   DTSBD610
01112                                                                   DTSBD610
01113      PERFORM P5200-MQTR-READ THRU P5200-EXIT                      DTSBD610
01114          VARYING WRK-YRQ-IDX FROM 1 BY 1                          DTSBD610
01115          UNTIL WRK-YRQ-IDX > 4.                                   DTSBD610
01116                                                                   DTSBD610
01117                                                                   DTSBD610
01118      MOVE LOW-VALUE TO MDST-KEY-AREA.                             DTSBD610
01119                                                                   DTSBD610
01120      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBD610
01121                                                                   DTSBD610
01122      SET MDST-DST-88 TO TRUE.                                     DTSBD610
01123                                                                   DTSBD610
01124      MOVE WRK-YRQ (1) TO MDST-YRQ.                                DTSBD610
01125                                                                   DTSBD610
01126      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD610
01127                                                                   DTSBD610
01128      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD610
01129                                                                   DTSBD610
01130      MOVE MSKL-REC TO MDST-REC.                                   DTSBD610
01131                                                                   DTSBD610
01132      PERFORM P5300-MDST-BROWSE THRU P5300-EXIT                    DTSBD610
01133          UNTIL L910-NO-REC-88                                     DTSBD610
01134                     OR                                            DTSBD610
01135                MDST-YRQ > WRK-YRQ (4).                            DTSBD610
01136  P5000-EXIT.                                                      DTSBD610
01137      EXIT.                                                        DTSBD610
01138      SKIP3                                                        DTSBD610
01139  P5100-SET-YRQ-LIABLE.                                            DTSBD610
01140      MOVE WRK-YRQ (WRK-YRQ-IDX) TO L516-YRQ.                      DTSBD610
01141                                                                   DTSBD610
01142      IF MPRF-CLASS-SUB-88                                         DTSBD610
01143          PERFORM S516-LIABILITY THRU S516-EXIT                    DTSBD610
01144      ELSE                                                         DTSBD610
01145          SET L516-NOT-LIABLE-88 TO TRUE                           DTSBD610
01146          SET L516-NO-RATE-88 TO TRUE                              DTSBD610
01147          MOVE +0 TO L516-DEFAULT-TAX-DUE-DATE                     DTSBD610
01148                     L516-DEFAULT-RPT-DUE-DATE                     DTSBD610
01149                     L516-UI-RATE.                                 DTSBD610
01150                                                                   DTSBD610
01151      IF L516-LIABLE-88                                            DTSBD610
01152          IF WRK-YRQ (WRK-YRQ-IDX) NOT > MPRF-LAST-ARCHIVED-YRQ    DTSBD610
01153                 OR                                                DTSBD610
01154             WRK-YRQ (WRK-YRQ-IDX) > MHDR-LAST-UC30-DEL-MAIL-YRQ   DTSBD610
01155              MOVE MSG04-INFO-NOT-AVAILABLE TO R705-MSG-TEXT       DTSBD610
01156              MOVE '3' TO REPLY-RESPONSE-IND                       DTSBD610
01157          ELSE                                                     DTSBD610
01158              MOVE 'Y' TO WRK-YRQ-LIABLE-IND (WRK-YRQ-IDX).        DTSBD610
01159  P5100-EXIT.                                                      DTSBD610
01160      EXIT.                                                        DTSBD610
01161      SKIP3                                                        DTSBD610
01162  P5200-MQTR-READ.                                                 DTSBD610
01163 *&                                                                DTSBD610
01164      IF MPRF-EMP-NO NUMERIC                                       DTSBD610
01165         IF MPRF-EMP-NO = 073415                                   DTSBD610
01166            DISPLAY 'P5200'.                                       DTSBD610
01167 *&                                                                DTSBD610
01168      IF WRK-YRQ-LIABLE-IND (WRK-YRQ-IDX) = 'N'                    DTSBD610
01169          GO TO P5200-EXIT.                                        DTSBD610
01170                                                                   DTSBD610
01171                                                                   DTSBD610
01172      MOVE LOW-VALUE TO MQTR-KEY-AREA.                             DTSBD610
01173                                                                   DTSBD610
01174      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD610
01175                                                                   DTSBD610
01176      SET MQTR-QTR-88 TO TRUE.                                     DTSBD610
01177                                                                   DTSBD610
01178      MOVE WRK-YRQ (WRK-YRQ-IDX) TO MQTR-YRQ.                      DTSBD610
01179                                                                   DTSBD610
01180      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD610
01181                                                                   DTSBD610
01182      PERFORM S910-READ THRU S910-EXIT.                            DTSBD610
01183                                                                   DTSBD610
01184      IF L910-NO-REC-88                                            DTSBD610
01185          GO TO P5200-EXIT.                                        DTSBD610
01186                                                                   DTSBD610
01187                                                                   DTSBD610
01188      MOVE MSKL-REC TO MQTR-REC.                                   DTSBD610
01189                                                                   DTSBD610
01190                                                                   DTSBD610
01191      IF NOT MQTR-CURR-RCVD-88                                     DTSBD610
01192          GO TO P5200-EXIT.                                        DTSBD610
01193                                                                   DTSBD610
01194                                                                   DTSBD610
01195      MOVE 'Y' TO WRK-RPT-FILED-IND (WRK-YRQ-IDX).                 DTSBD610
01196                                                                   DTSBD610
01197                                                                   DTSBD610
01198 *** NOTE ZERO RATE AS EXCEPTIONAL CONDITION TO THE FEDS.          DTSBD610
01199 *****IF MQTR-UI-RATE = +0                                         DTSBD610
01200 *********MOVE '1' TO REPLY-ZERO-IND (1).                          DTSBD610
01201                                                                   DTSBD610
01202                                                                   DTSBD610
01203      MOVE MQTR-UI-RATE TO WRK-RATE (WRK-YRQ-IDX).                 DTSBD610
01204                                                                   DTSBD610
01205                                                                   DTSBD610
01206      MOVE MQTR-TAX-WAGE TO WRK-TAXABLE-WAGES (WRK-YRQ-IDX).       DTSBD610
01207  P5200-EXIT.                                                      DTSBD610
01208      EXIT.                                                        DTSBD610
01209      SKIP3                                                        DTSBD610
01210  P5300-MDST-BROWSE.                                               DTSBD610
01211 *&                                                                DTSBD610
01212      IF MPRF-EMP-NO NUMERIC                                       DTSBD610
01213         IF MPRF-EMP-NO = 073415                                   DTSBD610
01214            DISPLAY 'P5300'.                                       DTSBD610
01215 *&                                                                DTSBD610
01216      MOVE MDST-YRQ TO WRK-QTR-9.                                  DTSBD610
01217                                                                   DTSBD610
01218      IF WRK-RPT-FILED-IND (WRK-QTR-Q) = 'Y'                       DTSBD610
01219          PERFORM P5310-DSTRB-DATA-LOOP THRU P5310-EXIT            DTSBD610
01220              VARYING MDST-ACCT-IDX FROM 1 BY 1                    DTSBD610
01221              UNTIL   MDST-ACCT-IDX > MDST-ACCT-CNT.               DTSBD610
01222                                                                   DTSBD610
01223      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD610
01224                                                                   DTSBD610
01225      MOVE MSKL-REC TO MDST-REC.                                   DTSBD610
01226  P5300-EXIT.                                                      DTSBD610
01227      EXIT.                                                        DTSBD610
01228      SKIP3                                                        DTSBD610
01229  P5310-DSTRB-DATA-LOOP.                                           DTSBD610
01230      IF NOT MDST-ACCT-UI-88 (MDST-ACCT-IDX)                       DTSBD610
01231          GO TO P5310-EXIT.                                        DTSBD610
01232                                                                   DTSBD610
01233 *&                                                                DTSBD610
01234      IF MPRF-EMP-NO NUMERIC                                       DTSBD610
01235         IF MPRF-EMP-NO = 073415                                   DTSBD610
01236             DISPLAY 'P5310 FORM IND ' REQUEST-FORM-INDICATOR      DTSBD610
01237               '  MDST RCVD ' MDST-RECEIVED-DATE                   DTSBD610
01238               '  WRK APR15 ' WRK-CERT-APR-15-DATE                 DTSBD610
01239               '  WRK FEB   ' WRK-CERT-FEB-1-DATE                  DTSBD610
01240               '  MDST AMT ' MDST-AMT (MDST-ACCT-IDX).             DTSBD610
01241 *&                                                                DTSBD610
01242      IF REQUEST-FORM-INDICATOR = '2' OR '3'                       DTSBD610
01243          IF MDST-RECEIVED-DATE > WRK-CERT-APR-15-DATE             DTSBD610
01244              ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-AFTER-4-15  DTSBD610
01245          ELSE                                                     DTSBD610
01246              ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-THRU-4-15   DTSBD610
01247      ELSE                                                         DTSBD610
01248          IF MDST-RECEIVED-DATE < WRK-CERT-FEB-1-DATE              DTSBD610
01249              ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-PRIOR-2-1   DTSBD610
01250          ELSE                                                     DTSBD610
01251          IF MDST-RECEIVED-DATE > WRK-CERT-FEB-10-DATE             DTSBD610
01252              ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-AFTER-2-10  DTSBD610
01253          ELSE                                                     DTSBD610
01254              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBD610
01255               TO WRK-PAID-2-1-THRU-2-10.                          DTSBD610
01256 *&                                                                DTSBD610
01257      IF MPRF-EMP-NO NUMERIC                                       DTSBD610
01258         IF MPRF-EMP-NO = 073415                                   DTSBD610
01259            DISPLAY 'P5310 PRIOR ' WRK-PAID-PRIOR-2-1              DTSBD610
01260               '  AFTER ' WRK-PAID-AFTER-2-10                      DTSBD610
01261               '  THRU ' WRK-PAID-2-1-THRU-2-10.                   DTSBD610
01262 *&                                                                DTSBD610
01263  P5310-EXIT.                                                      DTSBD610
01264      EXIT.                                                        DTSBD610
01265      EJECT                                                        DTSBD610
01266  P6100-WRITE-REPLY.                                               DTSBD610
01267      ADD +1 TO CERT-REPLY-TOT-REC-CNT.                            DTSBD610
01268                                                                   DTSBD610
01269                                                                   DTSBD610
01270      PERFORM P6125-ZERO-FILL-REPLY-SIC-AREA THRU P6125-EXIT       DTSBD610
01271         VARYING ZERO-FILL-SIC FROM 1 BY 1                         DTSBD610
01272            UNTIL ZERO-FILL-SIC > 5.                               DTSBD610
01273                                                                   DTSBD610
01274      IF R705-MSG-TEXT = SPACE                                     DTSBD610
01275          NEXT SENTENCE                                            DTSBD610
01276      ELSE                                                         DTSBD610
01277          IF REPLY-RESPONSE-IND = '3'                              DTSBD610
01278              ADD +1 TO CERT-REPLY-NOT-ONLINE-REC-CNT              DTSBD610
01279          ELSE                                                     DTSBD610
01280              ADD +1 TO CERT-REPLY-UNMATCHED-REC-CNT               DTSBD610
01281          END-IF                                                   DTSBD610
01282          MOVE REPLY-REC TO HOLD-REPLY-REC                         DTSBD610
01283          WRITE REPLY-REC                                          DTSBD610
01284          IF ZERO-CERT-REPLY-CNT < +50                             DTSBD610
01285              ADD +1 TO ZERO-CERT-REPLY-CNT                        DTSBD610
01286              WRITE ZERO-CERT-REPLY-REC FROM HOLD-REPLY-REC        DTSBD610
01287          END-IF                                                   DTSBD610
01288          GO TO P6100-EXIT.                                        DTSBD610
01289                                                                   DTSBD610
01290                                                                   DTSBD610
01291      MOVE +0 TO RATE-CNT.                                         DTSBD610
01292                                                                   DTSBD610
01293      PERFORM P6110-WRK-YRQ-LOOP THRU P6110-EXIT                   DTSBD610
01294          VARYING WRK-YRQ-IDX FROM 1 BY 1                          DTSBD610
01295          UNTIL WRK-YRQ-IDX > +4.                                  DTSBD610
01296                                                                   DTSBD610
01297      MOVE WRK-PAID-PRIOR-2-1 TO REPLY-PAID-PRIOR-2-1.             DTSBD610
01298                                                                   DTSBD610
01299      MOVE WRK-PAID-2-1-THRU-2-10 TO REPLY-PAID-2-1-THRU-2-10.     DTSBD610
01300                                                                   DTSBD610
01301      MOVE WRK-PAID-AFTER-2-10 TO REPLY-PAID-AFTER-2-10.           DTSBD610
01302                                                                   DTSBD610
01303      MOVE WRK-PAID-THRU-4-15 TO REPLY-PAID-THRU-4-15.             DTSBD610
01304                                                                   DTSBD610
01305      MOVE WRK-PAID-AFTER-4-15 TO REPLY-PAID-AFTER-4-15.           DTSBD610
01306                                                                   DTSBD610
01307      MOVE WRK-EMP-NO TO REPLY-EMP-NO.                             DTSBD610
01308                                                                   DTSBD610
01309                                                                   DTSBD610
01310 *****                                                             DTSBD610
01311 *    THE TAX YEAR 1997 IRS SPECIFICATION STATES "COPY             DTSBD610
01312 *    POSITIONS 269-277 OF THE FUTA IDENTIFICATION                 DTSBD610
01313 *    RECORD".  HENCE THE FOLLOWING SENTENCE IS COMMENTED OUT.     DTSBD610
01314 *****                                                             DTSBD610
01315                                                                   DTSBD610
01316 *****IF WRK-FEIN NOT = +0                                         DTSBD610
01317 *********MOVE WRK-FEIN TO REPLY-XREF-FEIN.                        DTSBD610
01318                                                                   DTSBD610
01319                                                                   DTSBD610
01320      ADD +1 TO CERT-REPLY-MATCHED-REC-CNT.                        DTSBD610
01321                                                                   DTSBD610
01322                                                                   DTSBD610
01323      MOVE REPLY-REC TO HOLD-REPLY-REC.                            DTSBD610
01324                                                                   DTSBD610
01325      PERFORM P6115-FIRST-50-RECORDS THRU P6115-EXIT.              DTSBD610
01326                                                                   DTSBD610
01327                                                                   DTSBD610
01328      WRITE REPLY-REC.                                             DTSBD610
01329                                                                   DTSBD610
01330                                                                   DTSBD610
01331      PERFORM P6120-WRITE-CURR-YR-CERT THRU P6120-EXIT.            DTSBD610
01332  P6100-EXIT.                                                      DTSBD610
01333      EXIT.                                                        DTSBD610
01334      SKIP3                                                        DTSBD610
01335  P6110-WRK-YRQ-LOOP.                                              DTSBD610
01336      IF WRK-RPT-FILED-IND (WRK-YRQ-IDX) = 'N'                     DTSBD610
01337               OR                                                  DTSBD610
01338         WRK-TAXABLE-WAGES (WRK-YRQ-IDX) = +0                      DTSBD610
01339          GO TO P6110-EXIT.                                        DTSBD610
01340                                                                   DTSBD610
01341                                                                   DTSBD610
01342      MOVE 'N' TO RATE-MATCH.                                      DTSBD610
01343                                                                   DTSBD610
01344      PERFORM VARYING RATE-SUB FROM 1 BY 1                         DTSBD610
01345              UNTIL RATE-SUB > RATE-CNT                            DTSBD610
01346                        OR                                         DTSBD610
01347                    RATE-MATCH = 'Y'                               DTSBD610
01348          IF WRK-RATE (WRK-YRQ-IDX) = REPLY-RATE (RATE-SUB)        DTSBD610
01349              MOVE 'Y' TO RATE-MATCH                               DTSBD610
01350          END-IF                                                   DTSBD610
01351      END-PERFORM.                                                 DTSBD610
01352                                                                   DTSBD610
01353      IF RATE-MATCH = 'Y'                                          DTSBD610
01354          SUBTRACT 1 FROM RATE-SUB                                 DTSBD610
01355          ADD WRK-TAXABLE-WAGES (WRK-YRQ-IDX)                      DTSBD610
01356           TO REPLY-TAXABLE-WAGES (RATE-SUB)                       DTSBD610
01357              R704-TAXABLE-WAGES (RATE-SUB)                        DTSBD610
01358      ELSE                                                         DTSBD610
01359          ADD +1 TO RATE-CNT                                       DTSBD610
01360          MOVE WRK-RATE (WRK-YRQ-IDX)                              DTSBD610
01361            TO REPLY-RATE (RATE-CNT)                               DTSBD610
01362               R704-RATE (RATE-CNT)                                DTSBD610
01363          MOVE WRK-TAXABLE-WAGES (WRK-YRQ-IDX)                     DTSBD610
01364            TO REPLY-TAXABLE-WAGES (RATE-CNT)                      DTSBD610
01365               R704-TAXABLE-WAGES (RATE-CNT).                      DTSBD610
01366  P6110-EXIT.                                                      DTSBD610
01367      EXIT.                                                        DTSBD610
01368                                                                   DTSBD610
01369                                                                   DTSBD610
01370                                                                   DTSBD610
01371  P6115-FIRST-50-RECORDS.                                          DTSBD610
01372      IF (REPLY-TAXABLE-WAGES (1) = ZERO)                          DTSBD610
01373             AND                                                   DTSBD610
01374         (REPLY-TAXABLE-WAGES (2) = ZERO)                          DTSBD610
01375             AND                                                   DTSBD610
01376         (REPLY-TAXABLE-WAGES (3) = ZERO)                          DTSBD610
01377             AND                                                   DTSBD610
01378         (REPLY-TAXABLE-WAGES (4) = ZERO)                          DTSBD610
01379          IF ZERO-CERT-REPLY-CNT < +50                             DTSBD610
01380              ADD +1 TO ZERO-CERT-REPLY-CNT                        DTSBD610
01381              WRITE ZERO-CERT-REPLY-REC FROM HOLD-REPLY-REC        DTSBD610
01382          ELSE                                                     DTSBD610
01383              NEXT SENTENCE                                        DTSBD610
01384      ELSE                                                         DTSBD610
01385          IF NON-ZERO-CERT-REPLY-CNT < +50                         DTSBD610
01386              ADD +1 TO NON-ZERO-CERT-REPLY-CNT                    DTSBD610
01387              WRITE NON-ZERO-CERT-REPLY-REC FROM HOLD-REPLY-REC    DTSBD610
01388          ELSE                                                     DTSBD610
01389              NEXT SENTENCE.                                       DTSBD610
01390  P6115-EXIT.                                                      DTSBD610
01391      EXIT.                                                        DTSBD610
01392      EJECT                                                        DTSBD610
01393  P6120-WRITE-CURR-YR-CERT.                                        DTSBD610
01394      IF WRK-CERT-YEAR = WRK-PARM-CURRENT-YEAR                     DTSBD610
01395          MOVE WRK-EMP-NO TO X971-EMP-NO                           DTSBD610
01396          MOVE WRK-PARM-CURRENT-YEAR TO X971-CERT-YEAR             DTSBD610
01397          WRITE CURRENT-YEAR-CERT-REC                              DTSBD610
01398          ADD +1 TO CURR-YEAR-CERT-REC-CNT.                        DTSBD610
01399  P6120-EXIT.                                                      DTSBD610
01400      EXIT.                                                        DTSBD610
01401  P6125-ZERO-FILL-REPLY-SIC-AREA.                                  DTSBD610
01402      MOVE ZEROS TO REPLY-SIC-AREA (ZERO-FILL-SIC).                DTSBD610
01403  P6125-EXIT.                                                      DTSBD610
01404      EXIT.                                                        DTSBD610
01405      EJECT                                                        DTSBD610
01406  T0000-TERMINATE.                                                 DTSBD610
01407      MOVE +0 TO X971-EMP-NO.                                      DTSBD610
01408                                                                   DTSBD610
01409      MOVE WRK-PARM-CURRENT-YEAR TO X971-CERT-YEAR.                DTSBD610
01410                                                                   DTSBD610
01411      WRITE CURRENT-YEAR-CERT-REC.                                 DTSBD610
01412                                                                   DTSBD610
01413      ADD +1 TO CURR-YEAR-CERT-REC-CNT.                            DTSBD610
01414                                                                   DTSBD610
01415                                                                   DTSBD610
01416      DISPLAY ' '.                                                 DTSBD610
01417                                                                   DTSBD610
01418      DISPLAY '*** DTSBD610 TERMINATION STATISTICS'.               DTSBD610
01419                                                                   DTSBD610
01420      DISPLAY ' '.                                                 DTSBD610
01421                                                                   DTSBD610
01422      DISPLAY '*** '                                               DTSBD610
01423              CERT-REQUEST-REC-CNT                                 DTSBD610
01424              ' CERTIFICATION REQUEST RECORDS RECEIVED FROM IRS'.  DTSBD610
01425                                                                   DTSBD610
01426      DISPLAY '*** '.                                              DTSBD610
01427                                                                   DTSBD610
01428      DISPLAY '*** '                                               DTSBD610
01429              CERT-REPLY-MATCHED-REC-CNT                           DTSBD610
01430              ' A. MATCHED RECORDS RETURNED TO MCC'.               DTSBD610
01431                                                                   DTSBD610
01432      DISPLAY '*** '.                                              DTSBD610
01433                                                                   DTSBD610
01434      DISPLAY '*** '                                               DTSBD610
01435              CERT-REPLY-NOT-ONLINE-REC-CNT                        DTSBD610
01436              ' B. UNMATCHED RECORDS RETURNED - RATE IND 1 OR 3'.  DTSBD610
01437                                                                   DTSBD610
01438      DISPLAY '*** '.                                              DTSBD610
01439                                                                   DTSBD610
01440      DISPLAY '*** '                                               DTSBD610
01441              CERT-REPLY-UNMATCHED-REC-CNT                         DTSBD610
01442              ' C. UNMATCHED RECORDS RETURNED - RATE IND BLANK'.   DTSBD610
01443                                                                   DTSBD610
01444      DISPLAY '*** '.                                              DTSBD610
01445                                                                   DTSBD610
01446      DISPLAY '*** '                                               DTSBD610
01447              CERT-REPLY-TOT-REC-CNT                               DTSBD610
01448              ' D. TOTAL IDENTIFICATION RECORDS RETURNED TO MCC'.  DTSBD610
01449                                                                   DTSBD610
01450      DISPLAY '*** '.                                              DTSBD610
01451                                                                   DTSBD610
01452      DISPLAY '*** '.                                              DTSBD610
01453                                                                   DTSBD610
01454      DISPLAY '*** '                                               DTSBD610
01455              CURR-YEAR-CERT-REC-CNT                               DTSBD610
01456              ' CURRENT YEAR CERTIFICATION RECORDS WRITTEN'.       DTSBD610
01457                                                                   DTSBD610
01458                                                                   DTSBD610
01459      CLOSE CERT-REQUEST-FILE                                      DTSBD610
01460            CERT-REPLY-FILE                                        DTSBD610
01461            ZERO-CERT-REPLY-FILE                                   DTSBD610
01462            NON-ZERO-CERT-REPLY-FILE                               DTSBD610
01463            CURRENT-YEAR-CERT-FILE.                                DTSBD610
01464                                                                   DTSBD610
01465      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD610
01466                                                                   DTSBD610
01467      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD610
01468                                                                   DTSBD610
01469      PERFORM S931-CLOSE THRU S931-EXIT.                           DTSBD610
01470                                                                   DTSBD610
01471      MOVE -1 TO RSK1-LENGTH.                                      DTSBD610
01472                                                                   DTSBD610
01473      PERFORM S946-WRITE-RSK1 THRU S946-EXIT.                      DTSBD610
01474  T0000-EXIT.                                                      DTSBD610
01475      EXIT.                                                        DTSBD610
01476      EJECT                                                        DTSBD610
01477  S007-FROM-YEAR-2.                                                DTSBD610
01478      SET L007-FROM-YR-2 TO TRUE.                                  DTSBD610
01479      GO TO S007-YEAR.                                             DTSBD610
01480                                                                   DTSBD610
01481  S007-FROM-YEAR-4.                                                DTSBD610
01482      SET L007-FROM-YR-4 TO TRUE.                                  DTSBD610
01483      GO TO S007-YEAR.                                             DTSBD610
01484                                                                   DTSBD610
01485  S007-YEAR.                                                       DTSBD610
01486      CALL 'DTSBU007' USING L007-LINK-AREA.                        DTSBD610
01487  S007-EXIT.                                                       DTSBD610
01488      EXIT.                                                        DTSBD610
01489      SKIP3                                                        DTSBD610
01490  S516-LIABILITY.                                                  DTSBD610
01491      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBD610
01492                            MPRF-REC.                              DTSBD610
01493  S516-EXIT.                                                       DTSBD610
01494      EXIT.                                                        DTSBD610
01495      SKIP3                                                        DTSBD610
01496  S910-OPEN-READ.                                                  DTSBD610
01497      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD610
01498      GO TO S910-MSTR-IO.                                          DTSBD610
01499                                                                   DTSBD610
01500  S910-READ.                                                       DTSBD610
01501      SET L910-READ-88 TO TRUE.                                    DTSBD610
01502      GO TO S910-MSTR-IO.                                          DTSBD610
01503                                                                   DTSBD610
01504  S910-START-BROWSE.                                               DTSBD610
01505      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD610
01506      GO TO S910-MSTR-IO.                                          DTSBD610
01507                                                                   DTSBD610
01508  S910-READ-NEXT.                                                  DTSBD610
01509      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD610
01510      GO TO S910-MSTR-IO.                                          DTSBD610
01511                                                                   DTSBD610
01512 *S910-COUNT.                                                      DTSBD610
01513 *****SET L910-COUNT-88 TO TRUE.                                   DTSBD610
01514 *****GO TO S910-MSTR-IO.                                          DTSBD610
01515                                                                   DTSBD610
01516  S910-CLOSE.                                                      DTSBD610
01517      SET L910-CLOSE-88 TO TRUE.                                   DTSBD610
01518      GO TO S910-MSTR-IO.                                          DTSBD610
01519                                                                   DTSBD610
01520  S910-MSTR-IO.                                                    DTSBD610
01521      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD610
01522                            MSKL-REC.                              DTSBD610
01523  S910-EXIT.                                                       DTSBD610
01524      EXIT.                                                        DTSBD610
01525      SKIP3                                                        DTSBD610
01526  S921-OPEN-READ.                                                  DTSBD610
01527      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD610
01528      GO TO S921-AIX-IO.                                           DTSBD610
01529                                                                   DTSBD610
01530  S921-READ.                                                       DTSBD610
01531      SET L921-READ-88 TO TRUE.                                    DTSBD610
01532      GO TO S921-AIX-IO.                                           DTSBD610
01533                                                                   DTSBD610
01534  S921-START-BROWSE.                                               DTSBD610
01535      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD610
01536      GO TO S921-AIX-IO.                                           DTSBD610
01537                                                                   DTSBD610
01538  S921-READ-NEXT.                                                  DTSBD610
01539      SET L921-READ-NEXT-88 TO TRUE.                               DTSBD610
01540      GO TO S921-AIX-IO.                                           DTSBD610
01541                                                                   DTSBD610
01542  S921-CLOSE.                                                      DTSBD610
01543      SET L921-CLOSE-88 TO TRUE.                                   DTSBD610
01544      GO TO S921-AIX-IO.                                           DTSBD610
01545                                                                   DTSBD610
01546  S921-AIX-IO.                                                     DTSBD610
01547      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD610
01548                            ISKL-REC.                              DTSBD610
01549  S921-EXIT.                                                       DTSBD610
01550      EXIT.                                                        DTSBD610
01551      SKIP3                                                        DTSBD610
01552  S931-OPEN-READ.                                                  DTSBD610
01553      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD610
01554      GO TO S931-REF-IO.                                           DTSBD610
01555                                                                   DTSBD610
01556  S931-CLOSE.                                                      DTSBD610
01557      SET L931-CLOSE-88 TO TRUE.                                   DTSBD610
01558      GO TO S931-REF-IO.                                           DTSBD610
01559                                                                   DTSBD610
01560  S931-REF-IO.                                                     DTSBD610
01561      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD610
01562                            FSKL-REC.                              DTSBD610
01563  S931-EXIT.                                                       DTSBD610
01564      EXIT.                                                        DTSBD610
01565      SKIP3                                                        DTSBD610
01566  S946-WRITE-RSK1.                                                 DTSBD610
01567      CALL 'DTSBU946' USING RSK1-REC.                              DTSBD610
01568      GO TO S946-EXIT.                                             DTSBD610
01569                                                                   DTSBD610
01570  S946-WRITE-R704.                                                 DTSBD610
01571      CALL 'DTSBU946' USING R704-REC.                              DTSBD610
01572      GO TO S946-EXIT.                                             DTSBD610
01573                                                                   DTSBD610
01574  S946-WRITE-R705.                                                 DTSBD610
01575      CALL 'DTSBU946' USING R705-REC.                              DTSBD610
01576      GO TO S946-EXIT.                                             DTSBD610
01577                                                                   DTSBD610
01578  S946-EXIT.                                                       DTSBD610
01579      EXIT.                                                        DTSBD610
01580      SKIP3                                                        DTSBD610
01581  S999-ABEND.                                                      DTSBD610
01582      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD610
01583  S999-EXIT.                                                       DTSBD610
01584      EXIT.                                                        DTSBD610
