00001  IDENTIFICATION DIVISION.                                         12/18/13
00002  PROGRAM-ID.             DTSBD350.                                DTSBD350
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV040
00004  DATE-WRITTEN.           JANUARY 1991.                            DTSBD350
00005  DATE-COMPILED.                                                   DTSBD350
00006      SKIP3                                                        DTSBD350
00007 *****                                                             DTSBD350
00008 *                                                                 DTSBD350
00009 *    FUNCTION:  AUTOMATIC QUARTER EVALUATION/PROCESSING.          DTSBD350
00010 *                                                                 DTSBD350
00011 *                                                                 DTSBD350
00012 *    MODIFICATION LOG:                                            DTSBD350
00013 *                                                                 DTSBD350
00014 *    01/25/92  INITIAL DEVELOPMENT.                               DTSBD350
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD350
00016 *                                                                 DTSBD350
00017 *    06/21/95  INSERT MSG8-ESTIMATED-WITHDRAWAL.                  DTSBD350
00018 *              WORK ORDER: CR066                PROGRAMMER: EHH   DTSBD350
00019 *                                                                 DTSBD350
00020 *    01/12/1999  REVIEWED AND MODIFIED FOR DC.                    DTSBD350
00021 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD350
00022 *                                                                 DTSBD350
00023 *    02/27/1999  MODIFIED FOR DC SELF INSURED DEFAULT TAX DUE     DTSBD350
00024 *                DATE REQUIREMENT.                                DTSBD350
00025 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD350
00026 *                                                                 DTSBD350
00027 *    05/13/1999  BYPASS PROCESSING WHEN YEAR/QUARTER IS LESS      DTSBD350
00028 *                THAN OR EQUAL TO LBCM-PICKUP-YRQ.                DTSBD350
00029 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSBD350
00030 *                                                                 DTSBD350
00031 *    11/08/2001  MODIFIED FOR HOUSEHOLD ANNUAL REPORTING. CALL    DTSBD350
00032 *                DTSBU415 TO FIND LAST YEAR DECLARED DELINQUENT   DTSBD350
00033 *                FOR ANNUAL FILERS, AND USE THIS YEAR TO          DTSBD350
00034 *                DETERMINE WHTHER TO ANALYZE A QUARTER OR NOT     DTSBD350
00035 *                IF THE EMPLOYER FILES THE SUBJECT QUARTER        DTSBD350
00036 *                ANNUALLY.  SEE I1000, P2000.                     DTSBD350
00037 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD350
00038 *                                                                 DTSBD350
00039 *    12/11/2003  CORRECTED PROBLEM WITH WRITE TO WTC - SEQUENCE   DTSBD350
00040 *                NBR WAS INITIALIZED IN WRONG PLACE.              DTSBD350
00041 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD350
00042 *                                                                 DTSBD350
00043 *                                                                 DTSBD350
00044 *    04/06/2004  REMOVED DISPLAYS                                 DTSBD350
00045 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD350
00046 *                                                                 DTSBD350
00047 *    12/01/2004  MODIFIED TO INITIALIZE NEW AADJ FIELDS FOR       DTSBD350
00048 *                COMPROMISE SETTLEMENTS.                          DTSBD350
00049 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD350
00050 *                                                                 DTSBD350
00051 *    06/21/2005  WITHDRAWN MISSING REPORT PENALTY WHEN SPAN OF    DTSBD350
00052 *                LIABILITY CHANGES (P3230, S1700).                DTSBD350
00053 *                REFERENCE: PENALTY             PROGRAMMER: GD    DTSBD350
00054 *                                                                 DTSBD350
00055 *    07/06/2005  CORRECTED ERROR WITH PENALTY WITHDRAWAL.         DTSBD350
00056 *                REWRITE OF MQTR IN P3210 OVERWRITES UPDATES      DTSBD350
00057 *                PRODUCED IN BD373. CHANGED TO RE-READ MQTR       DTSBD350
00058 *                AFTER ADJUSTING PENALTY IN P3230.                DTSBD350
00059 *                REFERENCE: PENALTY             PROGRAMMER: GD    DTSBD350
00060 *                                                                 DTSBD350
00061 *    07/18/2005  CORRECTION TO CODE THAT REWRITES MQTR. THE       DTSBD350
00062 *                RECORD UPDATED IN BD373 WAS NOT MOVED FROM       DTSBD350
00063 *                MSKL TO MQTR.                                    DTSBD350
00064 *                REFERENCE: PENALTY             PROGRAMMER: GD    DTSBD350
00065 *                                                                 DTSBD350
00066 *    10/07/2005  MODIFIED S1100 TO INITIALIZE ARPT-STATUS-CHNG-INDDTSBD350
00067 *                REFERENCE:                     PROGRAMMER: GD    DTSBD350
00068 *                                                                 DTSBD350
00069 *    09/27/2006  MODIFIED HANDLING OF ANNUAL REPORTS: P3100 CALLS DTSBD350
00070 *                S1500 TO WITHDRAW REPORT WHEN FILING SCHEDULE    DTSBD350
00071 *                CHANGES. THIS DEPENDS ON A PREVIOUS CALL TO      DTSBD350
00072 *                P2400 TO SET THE QUARTERS INVOLVED, BUT P2400    DTSBD350
00073 *                IS ONLY CALLED WHEN THE CURRENT STATUS IS        DTSBD350
00074 *                ANNUAL. P2000 CHANGED TO CALL P2400 FOR EVERY    DTSBD350
00075 *                QUARTER PROCESSED.                               DTSBD350
00076 *                REFERENCE: PRODUCTION PROBLEM  PROGRAMMER: GD    DTSBD350
00077 *                                                                 DTSBD350
00078 *    08/07/2012  EXTENSIVE REVISIONS FOR ANNUAL REPORTS.          DTSBD350
00079 *                REFERENCE:                     PROGRAMMER: GD    DTSBD350
00080 *                                                                 DTSBD350
00081 *    09/27/2013  MODIFIED PROCESSES THAT SET THE QUARTER STATUS   DTSBD350
00082 *                FOR ANNUAL FILERS. THE NEW ANNUAL LIABILITY      DTSBD350
00083 *                FIELD RETURNED BY BU516 WILL HELP TO SET THIS    DTSBD350
00084 *                MORE ACCURATELY.                                 DTSBD350
00085 *                REFERENCE: TICKET 2081         PROGRAMMER: GD    DTSBD350
00086 *                                                                 DTSBD350
00087 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD350
00088 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD350
00089 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD350
00090 *                                                                 DTSBD350
00091 *                                                                 DTSBD350
00092 *  DESCRIPTION:                                                   DTSBD350
00093 *                                                                 DTSBD350
00094 *      EVALUATES THE CONSISTENCY OF ACCOUNTING, LIABILITY, AND    DTSBD350
00095 *      RATES FOR A RANGE OF QUARTERS.  GENERATES ACCOUNTING       DTSBD350
00096 *      TRANSACTIONS AS NECESSARY.                                 DTSBD350
00097 *                                                                 DTSBD350
00098 *                                                                 DTSBD350
00099 *      DETERMINE WRK-START-YRQ:                                   DTSBD350
00100 *                                                                 DTSBD350
00101 *        IF T031-START-YRQ NOT = 0                                DTSBD350
00102 *          MOVE T031-START-YRQ TO WRK-START-YRQ                   DTSBD350
00103 *        ELSE                                                     DTSBD350
00104 *          MOVE SMALLEST OF MSOL-LIAB-YRQ OR MQTR-YRQ             DTSBD350
00105 *            TO WRK-START-YRQ.                                    DTSBD350
00106 *                                                                 DTSBD350
00107 *                                                                 DTSBD350
00108 *      DETERMINE WRK-END-YRQ:                                     DTSBD350
00109 *                                                                 DTSBD350
00110 *        IF T031-END-YRQ NOT = 0 OR 99999                         DTSBD350
00111 *          MOVE T031-END-YRQ TO WRK-END-YRQ                       DTSBD350
00112 *        ELSE                                                     DTSBD350
00113 *          MOVE LARGEST OF CLOSED LIABILITY SPAN MSOL-INACT-YRQ   DTSBD350
00114 *            OR MQTR-YRQ OR (IF AN OPEN LIABILITY SPAN EXISTS)    DTSBD350
00115 *            LBCM-LAST-UC30-MASS-MAIL-YRQ PLUS ONE QUARTER.       DTSBD350
00116 *                                                                 DTSBD350
00117 *        FOR HOUSEHOLD EMPLOYERS WHOSE MOST RECENT FILING         DTSBD350
00118 *        SCHEDULE IS ANNUAL, CALL DTSBU415 TO FIND MOST RECENT    DTSBD350
00119 *        YEAR DECLARED DELINQUENT FOR ANNUAL REPORTS.             DTSBD350
00120 *        USE THIS DATE INSTEAD OF LBCM-LAST-UC30-MASS-MAIL-YRQ    DTSBD350
00121 *        TO SET WRK-END-YRQ.                                      DTSBD350
00122 *                                                                 DTSBD350
00123 *        IF WRK-END-YRQ < WRK-START-YRQ                           DTSBD350
00124 *          MOVE WRK-START-YRQ TO WRK-END-YRQ.                     DTSBD350
00125 *                                                                 DTSBD350
00126 *                                                                 DTSBD350
00127 *      FOR EACH YRQ IN THE WRK-START-YRQ THRU WRK-END-YRQ RANGE   DTSBD350
00128 *      CARRY OUT AN ANALYSIS OF THE QUARTER'S ACCOUNTING,         DTSBD350
00129 *      LIABILITY, AND RATING INFORMATION.  THE FOLLOWING ACTIONS  DTSBD350
00130 *      MAY, AS A RESULT OF THE ANALYSIS, BE NECESSARY:            DTSBD350
00131 *                                                                 DTSBD350
00132 *        .  DELETE MTCK (TYPE = 'LTE') RECORDS REFLECTING         DTSBD350
00133 *           QUARTER EVALUATION TO OCCUR FOR THE SUBJECT QUARTER.  DTSBD350
00134 *                                                                 DTSBD350
00135 *        .  GENERATE RPT ACCOUNTING TRANSACTIONS TO WITHDRAW      DTSBD350
00136 *           REPORTS.                                              DTSBD350
00137 *                                                                 DTSBD350
00138 *        .  GENERATE RPT ACCOUNTING TRANSACTIONS TO REFLECT       DTSBD350
00139 *           CHANGED UI RATE.                                      DTSBD350
00140 *                                                                 DTSBD350
00141 *        .  GENERATE ADJ ACCOUNTING TRANSACTIONS TO REFLECT       DTSBD350
00142 *           CHANGED TAX DUE DATE OR CHANGED REPORT DUE DATE.      DTSBD350
00143 *                                                                 DTSBD350
00144 *        .  UPDATE MQTR-CURR-RPT-TYPE.                            DTSBD350
00145 *                                                                 DTSBD350
00146 *        .  WRITE A R501 RECORD TO INDICATE MISSING RATES.        DTSBD350
00147 *                                                                 DTSBD350
00148 *        .  ESTABLISH MTCK (TYPE = 'LTE') RECORD REFLECTING       DTSBD350
00149 *           QUARTER EVALUATION TO OCCUR IN THE FUTURE FOR         DTSBD350
00150 *           SUBJECT YRQ.                                          DTSBD350
00151 *                                                                 DTSBD350
00152 *        NOTE: WHEN GENERATING ACCOUNTING TRANSACTIONS, DO NOT    DTSBD350
00153 *              CONSTRUCT A***-DOC-NO.  DTSBU501 WILL CONSTRUCT    DTSBD350
00154 *              A***-DOC-NO.                                       DTSBD350
00155 *                                                                 DTSBD350
00156 *                                                                 DTSBD350
00157 *      MASTER FILE RECORDS READ:                                  DTSBD350
00158 *                                                                 DTSBD350
00159 *        MQTR                                                     DTSBD350
00160 *        MSOL                                                     DTSBD350
00161 *                                                                 DTSBD350
00162 *                                                                 DTSBD350
00163 *      MASTER FILE RECORDS UPDATED:                               DTSBD350
00164 *                                                                 DTSBD350
00165 *        MQTR (WRITE, REWRITE)                                    DTSBD350
00166 *        MTCK (WRITE)                                             DTSBD350
00167 *                                                                 DTSBD350
00168 *                                                                 DTSBD350
00169 *      REPORT RECORDS WRITTEN:                                    DTSBD350
00170 *                                                                 DTSBD350
00171 *        R907  ERROR.                                             DTSBD350
00172 *                                                                 DTSBD350
00173 *                                                                 DTSBD350
00174 *      MODULES CALLED:                                            DTSBD350
00175 *                                                                 DTSBD350
00176 *        DTSBU501 INTERNALLY GENERATED ACCOUNTING TRANSACTION     DTSBD350
00177 *                 DRIVER.                                         DTSBD350
00178 *        DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE FOR A   DTSBD350
00179 *                 GIVEN QUARTER.                                  DTSBD350
00180 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD350
00181 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBD350
00182 *                                                                 DTSBD350
00183 *                                                                 DTSBD350
00184 *****                                                             DTSBD350
00185      SKIP3                                                        DTSBD350
00186  ENVIRONMENT DIVISION.                                            DTSBD350
00187      EJECT                                                        DTSBD350
00188  DATA DIVISION.                                                   DTSBD350
00189      SKIP3                                                        DTSBD350
00190  WORKING-STORAGE SECTION.                                         DTSBD350
001905 77  PAN-VALET PICTURE X(24) VALUE '040DTSBD350  12/18/13'.       DTSBD350
00191  77  PAN-VALET PICTURE X(24) VALUE '009DTSBD350  12/04/13'.       DTSBD350
00192  77  PAN-VALET PICTURE X(24) VALUE '038DTSBD350  05/20/13'.       DTSBD350
00193  77  PAN-VALET PICTURE X(24) VALUE '020DTSBD350  05/13/13'.       DTSBD350
00194      SKIP3                                                        DTSBD350
00195  01  WRK-AREA.                                                    DTSBD350
00196      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +350.DTSBD350
00197                                                                   DTSBD350
00198      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD350'.DTSBD350
00199                                                                   DTSBD350
00200      05  FIRST-TIME-IND              PIC  X(01)        VALUE 'Y'. DTSBD350
00201                                                                   DTSBD350
00202      05  YRQ-NINES-LIT               PIC S9(05)        COMP-3     DTSBD350
00203                                         VALUE +99999.             DTSBD350
00204                                                                   DTSBD350
00205      05  ALL-NINES-DATE              PIC S9(09)        COMP-3     DTSBD350
00206                                         VALUE +999999999.         DTSBD350
00207                                                                   DTSBD350
00208      05  ALL-NINES-EMPL-CNT          PIC S9(07)        COMP-3     DTSBD350
00209                                         VALUE +9999999.           DTSBD350
00210                                                                   DTSBD350
00211      05  WRK-FIRST-ANN-YR            PIC  9(04)                   DTSBD350
00212                                         VALUE 2002.               DTSBD350
00213                                                                   DTSBD350
00214      05  WRK-NO-UI-RATE              PIC S9(01)V9(04)  COMP-3     DTSBD350
00215                                         VALUE -9.9999.            DTSBD350
00216                                                                   DTSBD350
00217      05  HOLD-EMP-NO                     PIC S9(07)       COMP-3. DTSBD350
00218                                                                   DTSBD350
00219      05  WRK-NULL-DOC-NO.                                         DTSBD350
00220          10  WRK-NULL-BATCH-NO           PIC S9(05)       COMP-3. DTSBD350
00221          10  WRK-NULL-ITEM-NO            PIC S9(03)       COMP-3. DTSBD350
00222                                                                   DTSBD350
00223      05  WRK-START-YRQ                   PIC S9(05)       COMP-3. DTSBD350
00224                                                                   DTSBD350
00225      05  WRK-END-YRQ                     PIC S9(05)       COMP-3. DTSBD350
00226                                                                   DTSBD350
00227      05  WRK-ABS-YRQ                     PIC S9(04)       COMP.   DTSBD350
00228                                                                   DTSBD350
00229      05  WRK-YRQ                         PIC S9(05)       COMP-3. DTSBD350
00230                                                                   DTSBD350
00231      05  WRK-YRQ-DISP                    PIC  9(05).              DTSBD350
00232      05  FILLER REDEFINES WRK-YRQ-DISP.                           DTSBD350
00233          10  WRK-YRQ-DISP-YR             PIC  9(04).              DTSBD350
00234          10  WRK-YRQ-DISP-Q              PIC  9(01).              DTSBD350
00235                                                                   DTSBD350
00236      05  WRK-FSC-YRQ                     PIC S9(05)       COMP-3. DTSBD350
00237                                                                   DTSBD350
00238      05  WRK-END-ABS-YRQ                 PIC S9(04)       COMP.   DTSBD350
00239                                                                   DTSBD350
00240      05  WRK-MQTR-EXISTS-IND             PIC  X(01).              DTSBD350
00241                                                                   DTSBD350
00242      05  WRK-RPT-TYPE                    PIC  X(02).              DTSBD350
00243                                                                   DTSBD350
00244      05  WRK-TRIGGER-DATE                PIC S9(09)       COMP-3. DTSBD350
00245                                                                   DTSBD350
00246      05  WRK-CURR-WAGE                   PIC S9(09)V9(02) COMP-3. DTSBD350
00247                                                                   DTSBD350
00248      05  WRK-PEN-CHG                     PIC S9(09)V9(02) COMP-3. DTSBD350
00249      05  AMT-DISP1                       PIC --------9.99.        DTSBD350
00250                                                                   DTSBD350
00251      05  HOLD-CURR-RPT-TYPE              PIC  X(02).              DTSBD350
00252                                                                   DTSBD350
00253      05  LIAB-WITHDRAWN-IND              PIC  X(01).              DTSBD350
00254                                                                   DTSBD350
00255      05  WRK-PURSUED-RPT-IND             PIC  X(01).              DTSBD350
00256                                                                   DTSBD350
00257      05  TAX-PAID-IND                    PIC  X(01).              DTSBD350
00258                                                                   DTSBD350
00259      05  WRK-END-YRQ-ANN-IND             PIC  X(01).              DTSBD350
00260          88  WRK-END-YRQ-ANN-NO-88     VALUE 'N'.                 DTSBD350
00261          88  WRK-END-YRQ-ANN-YES-88    VALUE 'Y'.                 DTSBD350
00262                                                                   DTSBD350
00263      05  WRK-MSG10-NEEDED-IND            PIC  X(01).              DTSBD350
00264          88  WRK-MSG10-NEEDED-YES-88   VALUE 'Y'.                 DTSBD350
00265          88  WRK-MSG10-NEEDED-NO-88    VALUE 'N'.                 DTSBD350
00266                                                                   DTSBD350
00267      05  WRK-ANN-LIABLE-IND              PIC  X(01).              DTSBD350
00268          88  WRK-ANN-LIABLE-NO-88      VALUE 'N'.                 DTSBD350
00269          88  WRK-ANN-LIABLE-YES-88     VALUE 'Y'.                 DTSBD350
00270                                                                   DTSBD350
00271      05  WRK-UC30H-DEL-YRQ               PIC S9(05)  COMP-3.      DTSBD350
00272      05  WRK-LAST-DEL-MAIL-YRQ           PIC S9(05)  COMP-3.      DTSBD350
00273      05  WRK-L004-QTR-DUE-DATE           PIC S9(09)  COMP-3.      DTSBD350
00274      05  WRK-SEQ-NO                      PIC S9(07)  COMP-3.      DTSBD350
00275      05  WRK-TOT-WAGE                    PIC S9(09)V99 COMP-3.    DTSBD350
00276      05  WRK-TAX-WAGE                    PIC S9(09)V99 COMP-3.    DTSBD350
00277                                                                   DTSBD350
00278      05  SUB                             PIC S9(04)       COMP.   DTSBD350
00279                                                                   DTSBD350
00280      05  WRK-ANN-YRQ                     PIC  9(05) VALUE ZERO.   DTSBD350
00281      05  FILLER REDEFINES WRK-ANN-YRQ.                            DTSBD350
00282          10  WRK-ANN-YRQ-YR              PIC  9(04).              DTSBD350
00283          10  WRK-ANN-YRQ-Q               PIC  9(01).              DTSBD350
00284                                                                   DTSBD350
00285 *****************                                                 DTSBD350
00286 *  THE FOLLOWING 2 FIELDS CONTROL GENERATION OF AATX REPORTS      DTSBD350
00287 *  FOR ANNUAL FILERS TO MODIFY THE UI RATE OR THE REPORT OR       DTSBD350
00288 *  TAX DUE DATES.  THE PROGRAM WRITES ONE AATX RECORD WHEN IT     DTSBD350
00289 *  FINDS THE FIRST QUARTER FILED ANNUALLY.                        DTSBD350
00290 *****************                                                 DTSBD350
00291      05  WRK-CURR-YEAR                   PIC  9(04) VALUE ZERO.   DTSBD350
00292      05  WRK-ANN-DELINQ-IND              PIC  X(01).              DTSBD350
00293          88  WRK-ANN-DELINQ-YES-88         VALUE 'Y'.             DTSBD350
00294          88  WRK-ANN-DELINQ-NO-88          VALUE 'N'.             DTSBD350
00295 *****************                                                 DTSBD350
00296                                                                   DTSBD350
00297      05  WRK-FIND-WAGES-IND              PIC  X(01).              DTSBD350
00298          88  WRK-FIND-WAGES-YES-88        VALUE 'Y'.              DTSBD350
00299          88  WRK-FIND-WAGES-NO-88         VALUE 'N'.              DTSBD350
00300                                                                   DTSBD350
00301 *****************                                                 DTSBD350
00302 *  THE FOLLOWING FIELD CONTROLS THE UPDATING OF THE               DTSBD350
00303 *  MPRF-PURSUED-RPT-CNT. THE PROGRAM ADDS OR SUBTRACTS ONE        DTSBD350
00304 *  FOR EACH ANNUAL REPORT, RATHER THAN ADDING OR SUBTRACTING      DTSBD350
00305 *  FOR EACH QUARTER.                                              DTSBD350
00306 *****************                                                 DTSBD350
00307      05  WRK-PURSUED-YEAR                PIC  9(04) VALUE ZERO.   DTSBD350
00308                                                                   DTSBD350
00309      05  WRK-ANNUAL-QTR-AREA.                                     DTSBD350
00310          10  WRK-QTR1                    PIC S9(09) COMP-3.       DTSBD350
00311          10  WRK-QTR1-TOT-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00312          10  WRK-QTR1-TAX-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00313          10  WRK-QTR2                    PIC S9(09) COMP-3.       DTSBD350
00314          10  WRK-QTR2-TOT-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00315          10  WRK-QTR2-TAX-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00316          10  WRK-QTR3                    PIC S9(09) COMP-3.       DTSBD350
00317          10  WRK-QTR3-TOT-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00318          10  WRK-QTR3-TAX-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00319          10  WRK-QTR4                    PIC S9(09) COMP-3.       DTSBD350
00320          10  WRK-QTR4-TOT-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00321          10  WRK-QTR4-TAX-WAGE           PIC S9(09)V99 COMP-3.    DTSBD350
00322                                                                   DTSBD350
00323      EJECT                                                        DTSBD350
00324  01  MSG-TABLE.                                                   DTSBD350
00325      05  MSG1-INVALID-TRN-CD.                                     DTSBD350
00326          10  MSG1-ID.                                             DTSBD350
00327              15  MSG1-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00328              15  MSG1-ID2    PIC  X(03)  VALUE '905'.             DTSBD350
00329          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'INVALID TRN CD'.  DTSBD350
00330          10  MSG1-LONG-TEXT.                                      DTSBD350
00331              15  FILLER      PIC  X(30)                           DTSBD350
00332                    VALUE 'TRANSACTION FAILED - TRANSACTI'.        DTSBD350
00333              15  FILLER      PIC  X(30)                           DTSBD350
00334                    VALUE 'ON CODE NOT VALID             '.        DTSBD350
00335                                                                   DTSBD350
00336      05  MSG2-CHG-ONLY.                                           DTSBD350
00337          10  MSG2-ID.                                             DTSBD350
00338              15  MSG2-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00339              15  MSG2-ID2    PIC  X(03)  VALUE '301'.             DTSBD350
00340          10  MSG2-SHORT-TEXT PIC  X(20)  VALUE 'CHARGING ONLY '.  DTSBD350
00341          10  MSG2-LONG-TEXT.                                      DTSBD350
00342              15  FILLER      PIC  X(30)                           DTSBD350
00343                    VALUE 'TRANSACTION FAILED - CHARGING '.        DTSBD350
00344              15  FILLER      PIC  X(30)                           DTSBD350
00345                    VALUE 'ONLY EMPLOYER                 '.        DTSBD350
00346                                                                   DTSBD350
00347      05  MSG3-MISSING-RATE.                                       DTSBD350
00348          10  MSG3-ID.                                             DTSBD350
00349              15  MSG3-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00350              15  MSG3-ID2    PIC  X(03)  VALUE '381'.             DTSBD350
00351          10  MSG3-SHORT-TEXT PIC  X(20)  VALUE 'MISSING RATE  '.  DTSBD350
00352          10  MSG3-LONG-TEXT.                                      DTSBD350
00353              15  FILLER      PIC  X(30)                           DTSBD350
00354                    VALUE 'AUTOMATIC QUARTER PROCESSING F'.        DTSBD350
00355              15  FILLER      PIC  X(34)                           DTSBD350
00356                    VALUE 'AILED DUE TO MISSING RATE.  YRQ = '.    DTSBD350
00357              15  MSG3-SLASH-QTR          PIC  X(04).              DTSBD350
00358                                                                   DTSBD350
00359      05  MSG4-WRITTEN-OFF.                                        DTSBD350
00360          10  MSG4-ID.                                             DTSBD350
00361              15  MSG4-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00362              15  MSG4-ID2    PIC  X(03)  VALUE '382'.             DTSBD350
00363          10  MSG4-SHORT-TEXT PIC  X(20)  VALUE 'WRITTEN OFF'.     DTSBD350
00364          10  MSG4-LONG-TEXT.                                      DTSBD350
00365              15  FILLER      PIC  X(35)                           DTSBD350
00366                    VALUE 'AUTO QUARTER PROCESSING BYPASSED.  '.   DTSBD350
00367              15  FILLER      PIC  X(32)                           DTSBD350
00368                    VALUE 'COLLECTIONS WRITTEN OFF.  YRQ = '.      DTSBD350
00369              15  MSG4-SLASH-QTR  PIC  X(04).                      DTSBD350
00370              15  FILLER          PIC  X(11)  VALUE '  ORIGIN = '. DTSBD350
00371              15  MSG4-ORIGIN     PIC  XXXXXXXXBXX.                DTSBD350
00372                                                                   DTSBD350
00373      05  MSG5-WITHDRAWAL.                                         DTSBD350
00374          10  MSG5-ID.                                             DTSBD350
00375              15  MSG5-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00376              15  MSG5-ID2    PIC  X(03)  VALUE '383'.             DTSBD350
00377          10  MSG5-SHORT-TEXT PIC  X(20)  VALUE 'AUTO WITHDRAW '.  DTSBD350
00378          10  MSG5-LONG-TEXT.                                      DTSBD350
00379              15  FILLER      PIC  X(35)                           DTSBD350
00380                    VALUE 'AUTOMATIC REPORT WITHDRAWAL.  YRQ ='.   DTSBD350
00381              15  FILLER      PIC  X(01)                           DTSBD350
00382                    VALUE ' '.                                     DTSBD350
00383              15  MSG5-SLASH-QTR  PIC  X(04).                      DTSBD350
00384                                                                   DTSBD350
00385      05  MSG6-TRANSFER.                                           DTSBD350
00386          10  MSG6-ID.                                             DTSBD350
00387              15  MSG6-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00388              15  MSG6-ID2    PIC  X(03)  VALUE '384'.             DTSBD350
00389          10  MSG6-SHORT-TEXT PIC  X(20)  VALUE 'TRANSFER TO SUC'. DTSBD350
00390          10  MSG6-LONG-TEXT.                                      DTSBD350
00391              15  FILLER      PIC  X(28)                           DTSBD350
00392                    VALUE 'POSSIBLE TRANSFER OF REPORT '.          DTSBD350
00393              15  FILLER      PIC  X(29)                           DTSBD350
00394                    VALUE 'TO SUCCESSOR ACCOUNT.  YRQ = '.         DTSBD350
00395              15  MSG6-SLASH-QTR    PIC  X(04).                    DTSBD350
00396                                                                   DTSBD350
00397      05  MSG7-TAX-DUE-DATE-TO-AUTO.                               DTSBD350
00398          10  MSG7-ID.                                             DTSBD350
00399              15  MSG7-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00400              15  MSG7-ID2    PIC  X(03)  VALUE '385'.             DTSBD350
00401          10  MSG7-SHORT-TEXT PIC  X(20)  VALUE 'EXTEND TAX DUE'.  DTSBD350
00402          10  MSG7-LONG-TEXT.                                      DTSBD350
00403              15  FILLER      PIC  X(20)                           DTSBD350
00404                    VALUE 'MANUAL TAX DUE DATE '.                  DTSBD350
00405              15  MSG7-TAX-DUE-DATE                                DTSBD350
00406                              PIC  X(08).                          DTSBD350
00407              15  FILLER      PIC  X(13)                           DTSBD350
00408                    VALUE ' FOR QUARTER '.                         DTSBD350
00409              15  MSG7-SLASH-QTR    PIC  X(04).                    DTSBD350
00410              15  FILLER      PIC  X(34)                           DTSBD350
00411                    VALUE ' NO LONGER VALID - REVERTS TO AUTO'.    DTSBD350
00412                                                                   DTSBD350
00413      05  MSG8-ESTIMATED-WITHDRAWAL.                               DTSBD350
00414          10  MSG8-ID.                                             DTSBD350
00415              15  MSG8-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00416              15  MSG8-ID2    PIC  X(03)  VALUE '386'.             DTSBD350
00417          10  MSG8-SHORT-TEXT PIC  X(20)                           DTSBD350
00418                VALUE 'AUTO ESTIM WITHDRW  '.                      DTSBD350
00419          10  MSG8-LONG-TEXT.                                      DTSBD350
00420              15  FILLER      PIC  X(20)                           DTSBD350
00421                    VALUE 'AUTOMATIC ESTIMATED '.                  DTSBD350
00422              15  FILLER      PIC  X(26)                           DTSBD350
00423                    VALUE 'REPORT WITHDRAWAL.  YRQ = '.            DTSBD350
00424              15  MSG8-SLASH-QTR    PIC  X(04).                    DTSBD350
00425                                                                   DTSBD350
00426      05  MSG9-ESTIMATED-RATE.                                     DTSBD350
00427          10  MSG9-ID.                                             DTSBD350
00428              15  MSG9-ID1    PIC  X(08)  VALUE 'DTSBD350'.        DTSBD350
00429              15  MSG9-ID2    PIC  X(03)  VALUE '387'.             DTSBD350
00430          10  MSG9-SHORT-TEXT PIC  X(20)  VALUE 'ESTIM RATE    '.  DTSBD350
00431          10  MSG9-LONG-TEXT.                                      DTSBD350
00432              15  FILLER      PIC  X(30)                           DTSBD350
00433                    VALUE 'AUTOMATIC QUARTER PROCESSING F'.        DTSBD350
00434              15  FILLER      PIC  X(34)                           DTSBD350
00435                    VALUE 'AILED: ESTIMATED RATE.      YRQ = '.    DTSBD350
00436              15  MSG9-SLASH-QTR          PIC  X(04).              DTSBD350
00437                                                                   DTSBD350
00438      05  MSG10-QTRLY-TO-ANN.                                      DTSBD350
00439          10  MSG10-ID.                                            DTSBD350
00440              15  MSG10-ID1    PIC  X(08)  VALUE 'DTSBD350'.       DTSBD350
00441              15  MSG10-ID2    PIC  X(03)  VALUE '388'.            DTSBD350
00442          10  MSG10-SHORT-TEXT PIC  X(20)  VALUE 'QTRLY TO ANN '.  DTSBD350
00443          10  MSG10-LONG-TEXT.                                     DTSBD350
00444              15  FILLER      PIC  X(30)                           DTSBD350
00445                    VALUE 'QTRLY REPORTS WITHDRAWN - ANNU'.        DTSBD350
00446              15  FILLER      PIC  X(34)                           DTSBD350
00447                    VALUE 'AL REPORT MUST BE ENTERED.  YRQ = '.    DTSBD350
00448              15  MSG10-SLASH-QTR          PIC  X(04).             DTSBD350
00449                                                                   DTSBD350
00450      EJECT                                                        DTSBD350
00451  01  ASKL-REC.                                                    DTSBD350
00452  ++INCLUDE DTSIASKL                                               DTSBD350
00453      SKIP3                                                        DTSBD350
00454  01  ARPT-REC REDEFINES ASKL-REC.                                 DTSBD350
00455  ++INCLUDE DTSIARPT                                               DTSBD350
00456      SKIP3                                                        DTSBD350
00457  01  AADJ-REC REDEFINES ASKL-REC.                                 DTSBD350
00458  ++INCLUDE DTSIAADJ                                               DTSBD350
00459                                                                   DTSBD350
00460  01  AADTXREC REDEFINES ASKL-REC.                                 DTSBD350
00461  ++INCLUDE DTSIAATX                                               DTSBD350
00462      EJECT                                                        DTSBD350
00463  01  R907-REC.                                                    DTSBD350
00464  ++INCLUDE DTSIR907                                               DTSBD350
00465      EJECT                                                        DTSBD350
00466  01  L910-LINK-AREA.                                              DTSBD350
00467  ++INCLUDE DTSIL910                                               DTSBD350
00468      SKIP3                                                        DTSBD350
00469  01  MSKL-REC.                                                    DTSBD350
00470  ++INCLUDE DTSIMSKL                                               DTSBD350
00471      SKIP3                                                        DTSBD350
00472  01  MQTR-REC.                                                    DTSBD350
00473  ++INCLUDE DTSIMQTR                                               DTSBD350
00474      SKIP3                                                        DTSBD350
00475  01  MSOL-REC.                                                    DTSBD350
00476  ++INCLUDE DTSIMSOL                                               DTSBD350
00477      SKIP3                                                        DTSBD350
00478  01  MTCK-REC.                                                    DTSBD350
00479  ++INCLUDE DTSIMTCK                                               DTSBD350
00480                                                                   DTSBD350
00481  01  MFSC-REC.                                                    DTSBD350
00482  ++INCLUDE DTSIMFSC                                               DTSBD350
00483      EJECT                                                        DTSBD350
00484  01  L921-LINK-AREA.                                              DTSBD350
00485  ++INCLUDE DTSIL921                                               DTSBD350
00486      SKIP3                                                        DTSBD350
00487  01  ISKL-REC.                                                    DTSBD350
00488  ++INCLUDE DTSIISKL                                               DTSBD350
00489      SKIP3                                                        DTSBD350
00490  01  IPES-REC.                                                    DTSBD350
00491  ++INCLUDE DTSIIPES                                               DTSBD350
00492      EJECT                                                        DTSBD350
00493  01  L983-LINK-AREA.                                              DTSBD350
00494  ++INCLUDE DTSIL983                                               DTSBD350
00495      SKIP3                                                        DTSBD350
00496  01  WSKL-REC.                                                    DTSBD350
00497  ++INCLUDE DTSIWSKL                                               DTSBD350
00498      SKIP3                                                        DTSBD350
00499  01  W001-REC.                                                    DTSBD350
00500  ++INCLUDE DTSIW001                                               DTSBD350
00501                                                                   DTSBD350
00502  01  L001-LINK-AREA.                                              DTSBD350
00503  ++INCLUDE DTSIL001                                               DTSBD350
00504      SKIP3                                                        DTSBD350
00505  01  L004-LINK-AREA.                                              DTSBD350
00506  ++INCLUDE DTSIL004                                               DTSBD350
00507      SKIP3                                                        DTSBD350
00508  01  L410-LINK-AREA.                                              DTSBD350
00509  ++INCLUDE DTSIL410                                               DTSBD350
00510      SKIP3                                                        DTSBD350
00511  01  L415-LINK-AREA.                                              DTSBD350
00512  ++INCLUDE DTSIL415                                               DTSBD350
00513      SKIP3                                                        DTSBD350
00514  01  L421-LINK-AREA.                                              DTSBD350
00515  ++INCLUDE DTSIL421                                               DTSBD350
00516      SKIP3                                                        DTSBD350
00517  01  L501-LINK-AREA.                                              DTSBD350
00518  ++INCLUDE DTSIL501                                               DTSBD350
00519      SKIP3                                                        DTSBD350
00520  01  L516-LINK-AREA.                                              DTSBD350
00521  ++INCLUDE DTSIL516                                               DTSBD350
00522      SKIP3                                                        DTSBD350
00523  01  L590-LINK-AREA.                                              DTSBD350
00524  ++INCLUDE DTSIL590                                               DTSBD350
00525      EJECT                                                        DTSBD350
00526  01  CACT-LITERALS.                                               DTSBD350
00527  ++INCLUDE DTSICACT                                               DTSBD350
00528      EJECT                                                        DTSBD350
00529  LINKAGE SECTION.                                                 DTSBD350
00530      SKIP3                                                        DTSBD350
00531  01  LBCM-LINK-AREA.                                              DTSBD350
00532  ++INCLUDE DTSILBCM                                               DTSBD350
00533      EJECT                                                        DTSBD350
00534  01  MPRF-REC.                                                    DTSBD350
00535  ++INCLUDE DTSIMPRF                                               DTSBD350
00536      EJECT                                                        DTSBD350
00537  01  T031-REC.                                                    DTSBD350
00538  ++INCLUDE DTSIT031                                               DTSBD350
00539      EJECT                                                        DTSBD350
00540  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD350
00541                           MPRF-REC                                DTSBD350
00542                           T031-REC.                               DTSBD350
00543                                                                   DTSBD350
00544                                                                   DTSBD350
00545      IF FIRST-TIME-IND = 'Y'                                      DTSBD350
00546          PERFORM I0000-FIRST-TIME THRU I0000-EXIT                 DTSBD350
00547          MOVE 'N' TO FIRST-TIME-IND.                              DTSBD350
00548                                                                   DTSBD350
00549                                                                   DTSBD350
00550      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD350
00551                                                                   DTSBD350
00552                                                                   DTSBD350
00553      GOBACK.                                                      DTSBD350
00554      EJECT                                                        DTSBD350
00555  I0000-FIRST-TIME.                                                DTSBD350
00556      MOVE LBCM-TRACE-IND TO L910-TRACE-IND                        DTSBD350
00557                             L921-TRACE-IND                        DTSBD350
00558                             L516-TRACE-IND.                       DTSBD350
00559                                                                   DTSBD350
00560      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBD350
00561                           L921-MOD-NAME                           DTSBD350
00562                           R907-MODULE-NAME.                       DTSBD350
00563                                                                   DTSBD350
00564      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBD350
00565                                                                   DTSBD350
00566      MOVE +0 TO WRK-NULL-BATCH-NO                                 DTSBD350
00567                 WRK-NULL-ITEM-NO.                                 DTSBD350
00568                                                                   DTSBD350
00569      MOVE WRK-MOD-NAME TO L501-ORIGIN.                            DTSBD350
00570                                                                   DTSBD350
00571      MOVE +0 TO HOLD-EMP-NO.                                      DTSBD350
00572                                                                   DTSBD350
00573      MOVE ZERO          TO WRK-CURR-YEAR                          DTSBD350
00574                            WRK-PURSUED-YEAR.                      DTSBD350
00575                                                                   DTSBD350
00576      SET L415-MODE-MOST-RECENT-88 TO TRUE.                        DTSBD350
00577      PERFORM S415-HOUSEHOLD-DATES   THRU S415-EXIT.               DTSBD350
00578      MOVE L415-UC30H-FIRST-DEL-END-YRQ TO WRK-UC30H-DEL-YRQ.      DTSBD350
00579                                                                   DTSBD350
00580  I0000-EXIT.                                                      DTSBD350
00581      EXIT.                                                        DTSBD350
00582      EJECT                                                        DTSBD350
00583  P0000-PROCESS.                                                   DTSBD350
00584      MOVE MPRF-EMP-NO TO R907-EMP-NO.                             DTSBD350
00585                                                                   DTSBD350
00586      MOVE ZERO TO WRK-SEQ-NO.                                     DTSBD350
00587                                                                   DTSBD350
00588      SET WRK-ANN-DELINQ-NO-88     TO TRUE.                        DTSBD350
00589                                                                   DTSBD350
00590      IF NOT T031-AUTO-PROCESS                                     DTSBD350
00591          MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA            DTSBD350
00592          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD350
00593          GO TO P0000-EXIT.                                        DTSBD350
00594                                                                   DTSBD350
00595                                                                   DTSBD350
00596      IF MPRF-CLASS-CHG-ONLY-88                                    DTSBD350
00597          MOVE MSG2-CHG-ONLY TO LBCM-TRN-MSG-AREA                  DTSBD350
00598          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD350
00599          GO TO P0000-EXIT.                                        DTSBD350
00600                                                                   DTSBD350
00601                                                                   DTSBD350
00602      IF MPRF-EMP-NO NOT = HOLD-EMP-NO                             DTSBD350
00603          PERFORM P9000-EMP-NO-BREAK THRU P9000-EXIT               DTSBD350
00604          MOVE MPRF-EMP-NO TO HOLD-EMP-NO.                         DTSBD350
00605                                                                   DTSBD350
00606                                                                   DTSBD350
00607      PERFORM P1000-SET-YRQ-RANGE THRU P1000-EXIT.                 DTSBD350
00608                                                                   DTSBD350
00609      IF WRK-START-YRQ = +0                                        DTSBD350
00610          GO TO P0000-EXIT.                                        DTSBD350
00611                                                                   DTSBD350
00612      MOVE WRK-START-YRQ TO L004-QTR-5-9.                          DTSBD350
00613                                                                   DTSBD350
00614      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD350
00615                                                                   DTSBD350
00616      MOVE L004-ABS-QTR TO WRK-ABS-YRQ.                            DTSBD350
00617                                                                   DTSBD350
00618      MOVE WRK-END-YRQ TO L004-QTR-5-9.                            DTSBD350
00619                                                                   DTSBD350
00620      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD350
00621                                                                   DTSBD350
00622      MOVE L004-ABS-QTR TO WRK-END-ABS-YRQ.                        DTSBD350
00623                                                                   DTSBD350
00624      PERFORM P2000-PROCESS-YRQ THRU P2000-EXIT                    DTSBD350
00625          VARYING WRK-ABS-YRQ FROM WRK-ABS-YRQ BY 1                DTSBD350
00626          UNTIL WRK-ABS-YRQ > WRK-END-ABS-YRQ.                     DTSBD350
00627  P0000-EXIT.                                                      DTSBD350
00628      EXIT.                                                        DTSBD350
00629      EJECT                                                        DTSBD350
00630  P1000-SET-YRQ-RANGE.                                             DTSBD350
00631      MOVE +0 TO WRK-START-YRQ.                                    DTSBD350
00632                                                                   DTSBD350
00633      PERFORM P1100-SET-START-YRQ THRU P1100-EXIT.                 DTSBD350
00634                                                                   DTSBD350
00635                                                                   DTSBD350
00636      MOVE +0 TO WRK-END-YRQ.                                      DTSBD350
00637                                                                   DTSBD350
00638      PERFORM P1200-SET-END-YRQ THRU P1200-EXIT.                   DTSBD350
00639                                                                   DTSBD350
00640                                                                   DTSBD350
00641      PERFORM P1300-CHK-ANNUAL-YRQ THRU P1300-EXIT.                DTSBD350
00642                                                                   DTSBD350
00643      IF WRK-END-YRQ-ANN-YES-88                                    DTSBD350
00644         NEXT SENTENCE                                             DTSBD350
00645      ELSE                                                         DTSBD350
00646      IF MPRF-STATUS-ACT-88                                        DTSBD350
00647          MOVE LBCM-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9        DTSBD350
00648          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSBD350
00649          ADD +1 TO L004-ABS-QTR                                   DTSBD350
00650          PERFORM S004-FROM-ABS THRU S004-EXIT                     DTSBD350
00651          IF L004-QTR-5-9 > WRK-END-YRQ                            DTSBD350
00652              MOVE L004-QTR-5-9 TO WRK-END-YRQ.                    DTSBD350
00653      IF WRK-END-YRQ < WRK-START-YRQ                               DTSBD350
00654          MOVE WRK-START-YRQ TO WRK-END-YRQ.                       DTSBD350
00655  P1000-EXIT.                                                      DTSBD350
00656      EXIT.                                                        DTSBD350
00657      EJECT                                                        DTSBD350
00658  P1100-SET-START-YRQ.                                             DTSBD350
00659      IF (T031-START-YRQ = +0)                                     DTSBD350
00660             OR                                                    DTSBD350
00661         (T031-START-YRQ = YRQ-NINES-LIT)                          DTSBD350
00662          NEXT SENTENCE                                            DTSBD350
00663      ELSE                                                         DTSBD350
00664          MOVE T031-START-YRQ TO WRK-START-YRQ                     DTSBD350
00665          GO TO P1100-EXIT.                                        DTSBD350
00666                                                                   DTSBD350
00667                                                                   DTSBD350
00668      MOVE YRQ-NINES-LIT TO WRK-START-YRQ.                         DTSBD350
00669                                                                   DTSBD350
00670                                                                   DTSBD350
00671      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD350
00672                                                                   DTSBD350
00673      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD350
00674                                                                   DTSBD350
00675      SET MQTR-QTR-88 TO TRUE.                                     DTSBD350
00676                                                                   DTSBD350
00677      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
00678                                                                   DTSBD350
00679      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD350
00680                                                                   DTSBD350
00681      IF L910-OK-88                                                DTSBD350
00682          MOVE MSKL-REC TO MQTR-REC                                DTSBD350
00683          MOVE MQTR-YRQ TO WRK-START-YRQ.                          DTSBD350
00684                                                                   DTSBD350
00685                                                                   DTSBD350
00686      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBD350
00687                                                                   DTSBD350
00688      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBD350
00689                                                                   DTSBD350
00690      SET MSOL-SOL-88 TO TRUE.                                     DTSBD350
00691                                                                   DTSBD350
00692      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
00693                                                                   DTSBD350
00694      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD350
00695                                                                   DTSBD350
00696      PERFORM P1110-BROWSE-MSOL THRU P1110-EXIT                    DTSBD350
00697          UNTIL L910-NO-REC-88.                                    DTSBD350
00698                                                                   DTSBD350
00699                                                                   DTSBD350
00700      IF WRK-START-YRQ = YRQ-NINES-LIT                             DTSBD350
00701          MOVE +0 TO WRK-START-YRQ.                                DTSBD350
00702  P1100-EXIT.                                                      DTSBD350
00703      EXIT.                                                        DTSBD350
00704      SKIP3                                                        DTSBD350
00705  P1110-BROWSE-MSOL.                                               DTSBD350
00706      MOVE MSKL-REC TO MSOL-REC.                                   DTSBD350
00707                                                                   DTSBD350
00708      IF MSOL-FIRST-LIAB-YRQ NOT = 0                               DTSBD350
00709          IF MSOL-FIRST-LIAB-YRQ < WRK-START-YRQ                   DTSBD350
00710              MOVE MSOL-FIRST-LIAB-YRQ TO WRK-START-YRQ.           DTSBD350
00711                                                                   DTSBD350
00712      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD350
00713  P1110-EXIT.                                                      DTSBD350
00714      EXIT.                                                        DTSBD350
00715      EJECT                                                        DTSBD350
00716  P1200-SET-END-YRQ.                                               DTSBD350
00717      IF (T031-END-YRQ = +0)                                       DTSBD350
00718             OR                                                    DTSBD350
00719         (T031-END-YRQ = YRQ-NINES-LIT)                            DTSBD350
00720          NEXT SENTENCE                                            DTSBD350
00721      ELSE                                                         DTSBD350
00722          MOVE T031-END-YRQ TO WRK-END-YRQ                         DTSBD350
00723          GO TO P1200-EXIT.                                        DTSBD350
00724                                                                   DTSBD350
00725                                                                   DTSBD350
00726      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBD350
00727                                                                   DTSBD350
00728      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBD350
00729                                                                   DTSBD350
00730      SET MSOL-SOL-88 TO TRUE.                                     DTSBD350
00731                                                                   DTSBD350
00732      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
00733                                                                   DTSBD350
00734      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD350
00735                                                                   DTSBD350
00736      PERFORM P1210-BROWSE-MSOL THRU P1210-EXIT                    DTSBD350
00737          UNTIL L910-NO-REC-88.                                    DTSBD350
00738                                                                   DTSBD350
00739                                                                   DTSBD350
00740      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD350
00741                                                                   DTSBD350
00742      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD350
00743                                                                   DTSBD350
00744      SET MQTR-QTR-88 TO TRUE.                                     DTSBD350
00745                                                                   DTSBD350
00746      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
00747                                                                   DTSBD350
00748      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD350
00749                                                                   DTSBD350
00750      PERFORM P1220-BROWSE-MQTR THRU P1220-EXIT                    DTSBD350
00751          UNTIL L910-NO-REC-88.                                    DTSBD350
00752                                                                   DTSBD350
00753                                                                   DTSBD350
00754  P1200-EXIT.                                                      DTSBD350
00755      EXIT.                                                        DTSBD350
00756      SKIP3                                                        DTSBD350
00757  P1210-BROWSE-MSOL.                                               DTSBD350
00758      MOVE MSKL-REC TO MSOL-REC.                                   DTSBD350
00759                                                                   DTSBD350
00760      IF MSOL-LAST-LIAB-YRQ = YRQ-NINES-LIT                        DTSBD350
00761          NEXT SENTENCE                                            DTSBD350
00762      ELSE                                                         DTSBD350
00763          IF MSOL-LAST-LIAB-YRQ > WRK-END-YRQ                      DTSBD350
00764              MOVE MSOL-LAST-LIAB-YRQ TO WRK-END-YRQ.              DTSBD350
00765                                                                   DTSBD350
00766      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD350
00767  P1210-EXIT.                                                      DTSBD350
00768      EXIT.                                                        DTSBD350
00769      SKIP3                                                        DTSBD350
00770  P1220-BROWSE-MQTR.                                               DTSBD350
00771      MOVE MSKL-REC TO MQTR-REC.                                   DTSBD350
00772                                                                   DTSBD350
00773      IF MQTR-YRQ > WRK-END-YRQ                                    DTSBD350
00774          MOVE MQTR-YRQ TO WRK-END-YRQ.                            DTSBD350
00775                                                                   DTSBD350
00776      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD350
00777  P1220-EXIT.                                                      DTSBD350
00778      EXIT.                                                        DTSBD350
00779                                                                   DTSBD350
00780 ****************************************************************  DTSBD350
00781 *  THIS PARAGRAPH ENSURES THAT IF ANY QUARTER REPORTED ANNUALLY   DTSBD350
00782 *  IS INCLUDED IN THE EVALUATION PROCESS, ALL 4 QUARTERS OF THE   DTSBD350
00783 *  YEAR WILL BE INCLUDED.                                         DTSBD350
00784 ****************************************************************  DTSBD350
00785  P1300-CHK-ANNUAL-YRQ.                                            DTSBD350
00786 *&                                                                DTSBD350
00787      DISPLAY 'BD350 P1300 - 1 ' MPRF-EMP-NO                       DTSBD350
00788         '  START ' WRK-START-YRQ                                  DTSBD350
00789         '  END ' WRK-END-YRQ.                                     DTSBD350
00790 *&                                                                DTSBD350
00791      SET WRK-END-YRQ-ANN-NO-88  TO TRUE.                          DTSBD350
00792                                                                   DTSBD350
00793      MOVE WRK-START-YRQ   TO WRK-YRQ-DISP.                        DTSBD350
00794      IF WRK-YRQ-DISP-YR < WRK-FIRST-ANN-YR                        DTSBD350
00795         NEXT SENTENCE                                             DTSBD350
00796      ELSE                                                         DTSBD350
00797         SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSBD350
00798         MOVE MPRF-EMP-NO    TO L410-EMP-NO                        DTSBD350
00799         MOVE WRK-START-YRQ  TO L410-YRQ                           DTSBD350
00800         PERFORM S410-FILING-SCHED  THRU S410-EXIT                 DTSBD350
00801         IF L410-ANN-SCHED-88                                      DTSBD350
00802            IF WRK-YRQ-DISP-Q NOT = 1                              DTSBD350
00803               MOVE 1 TO WRK-YRQ-DISP-Q                            DTSBD350
00804               MOVE WRK-YRQ-DISP  TO WRK-START-YRQ.                DTSBD350
00805                                                                   DTSBD350
00806      MOVE WRK-END-YRQ   TO WRK-YRQ-DISP.                          DTSBD350
00807      IF WRK-YRQ-DISP-YR < WRK-FIRST-ANN-YR                        DTSBD350
00808         NEXT SENTENCE                                             DTSBD350
00809      ELSE                                                         DTSBD350
00810         SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSBD350
00811         MOVE MPRF-EMP-NO    TO L410-EMP-NO                        DTSBD350
00812         MOVE WRK-END-YRQ    TO L410-YRQ                           DTSBD350
00813         PERFORM S410-FILING-SCHED  THRU S410-EXIT                 DTSBD350
00814         IF L410-ANN-SCHED-88                                      DTSBD350
00815            SET WRK-END-YRQ-ANN-YES-88 TO TRUE                     DTSBD350
00816            IF WRK-YRQ-DISP-Q NOT = 4                              DTSBD350
00817               MOVE 4 TO WRK-YRQ-DISP-Q                            DTSBD350
00818               MOVE WRK-YRQ-DISP  TO WRK-END-YRQ.                  DTSBD350
00819                                                                   DTSBD350
00820      PERFORM P1320-WAIVER-DATES  THRU P1320-EXIT.                 DTSBD350
00821                                                                   DTSBD350
00822 *&                                                                DTSBD350
00823      DISPLAY 'BD350 P1300 - 2 ' MPRF-EMP-NO                       DTSBD350
00824         '  START ' WRK-START-YRQ                                  DTSBD350
00825         '  END ' WRK-END-YRQ.                                     DTSBD350
00826 *&                                                                DTSBD350
00827  P1300-EXIT.                                                      DTSBD350
00828      EXIT.                                                        DTSBD350
00829                                                                   DTSBD350
00830  P1320-WAIVER-DATES.                                              DTSBD350
00831      IF T031-WAIVER-START-YRQ > ZERO                              DTSBD350
00832      OR T031-WAIVER-END-YRQ > ZERO                                DTSBD350
00833         NEXT SENTENCE                                             DTSBD350
00834      ELSE                                                         DTSBD350
00835         GO TO P1320-EXIT.                                         DTSBD350
00836                                                                   DTSBD350
00837      MOVE T031-WAIVER-START-YRQ   TO WRK-YRQ-DISP.                DTSBD350
00838      IF WRK-YRQ-DISP-YR < WRK-FIRST-ANN-YR                        DTSBD350
00839         NEXT SENTENCE                                             DTSBD350
00840      ELSE                                                         DTSBD350
00841         SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSBD350
00842         MOVE MPRF-EMP-NO    TO L410-EMP-NO                        DTSBD350
00843         MOVE T031-WAIVER-START-YRQ  TO L410-YRQ                   DTSBD350
00844         PERFORM S410-FILING-SCHED  THRU S410-EXIT                 DTSBD350
00845         IF L410-ANN-SCHED-88                                      DTSBD350
00846            IF WRK-YRQ-DISP-Q NOT = 1                              DTSBD350
00847               MOVE 1 TO WRK-YRQ-DISP-Q                            DTSBD350
00848               MOVE WRK-YRQ-DISP  TO T031-WAIVER-START-YRQ.        DTSBD350
00849                                                                   DTSBD350
00850      MOVE T031-WAIVER-END-YRQ   TO WRK-YRQ-DISP.                  DTSBD350
00851      IF WRK-YRQ-DISP-YR < WRK-FIRST-ANN-YR                        DTSBD350
00852         NEXT SENTENCE                                             DTSBD350
00853      ELSE                                                         DTSBD350
00854         SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSBD350
00855         MOVE MPRF-EMP-NO    TO L410-EMP-NO                        DTSBD350
00856         MOVE T031-WAIVER-END-YRQ   TO L410-YRQ                    DTSBD350
00857         PERFORM S410-FILING-SCHED  THRU S410-EXIT                 DTSBD350
00858         IF L410-ANN-SCHED-88                                      DTSBD350
00859            IF WRK-YRQ-DISP-Q NOT = 4                              DTSBD350
00860               MOVE 4 TO WRK-YRQ-DISP-Q                            DTSBD350
00861               MOVE WRK-YRQ-DISP  TO T031-WAIVER-END-YRQ.          DTSBD350
00862                                                                   DTSBD350
00863                                                                   DTSBD350
00864  P1320-EXIT.                                                      DTSBD350
00865      EXIT.                                                        DTSBD350
00866                                                                   DTSBD350
00867  P2000-PROCESS-YRQ.                                               DTSBD350
00868 *&                                                                DTSBD350
00869      DISPLAY 'BD350 P2000: ' MPRF-EMP-NO '  ' WRK-YRQ.            DTSBD350
00870 *&                                                                DTSBD350
00871      MOVE WRK-ABS-YRQ TO L004-ABS-QTR.                            DTSBD350
00872                                                                   DTSBD350
00873      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD350
00874                                                                   DTSBD350
00875      MOVE L004-QTR-5-9 TO WRK-YRQ.                                DTSBD350
00876                                                                   DTSBD350
00877                                                                   DTSBD350
00878      PERFORM P2100-MTCK-DELETE THRU P2100-EXIT.                   DTSBD350
00879                                                                   DTSBD350
00880                                                                   DTSBD350
00881      IF WRK-YRQ <= LBCM-PICKUP-YRQ                                DTSBD350
00882          GO TO P2000-EXIT.                                        DTSBD350
00883                                                                   DTSBD350
00884                                                                   DTSBD350
00885      MOVE 'N' TO WRK-MQTR-EXISTS-IND.                             DTSBD350
00886                                                                   DTSBD350
00887      PERFORM P2200-MQTR-READ THRU P2200-EXIT.                     DTSBD350
00888                                                                   DTSBD350
00889                                                                   DTSBD350
00890      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSBD350
00891          NEXT SENTENCE                                            DTSBD350
00892      ELSE                                                         DTSBD350
00893          PERFORM P2300-WRITE-OFF-MESSAGE THRU P2300-EXIT          DTSBD350
00894          GO TO P2000-EXIT.                                        DTSBD350
00895                                                                   DTSBD350
00896                                                                   DTSBD350
00897      MOVE WRK-YRQ TO L516-YRQ.                                    DTSBD350
00898                                                                   DTSBD350
00899      PERFORM S516-LIABILITY-INFO THRU S516-EXIT.                  DTSBD350
00900      DISPLAY 'BD350 P2000 516: ' L516-LIABLE-IND                  DTSBD350
00901         '  ' L516-FILING-SCHED-CD                                 DTSBD350
00902         '  ' L516-ANN-LIABLE-IND.                                 DTSBD350
00903                                                                   DTSBD350
00904      IF L516-ANN-SCHED-88                                         DTSBD350
00905         MOVE WRK-UC30H-DEL-YRQ        TO                          DTSBD350
00906                        WRK-LAST-DEL-MAIL-YRQ                      DTSBD350
00907         MOVE L004-ANN-DEFAULT-DUE-DATE TO                         DTSBD350
00908                        WRK-L004-QTR-DUE-DATE                      DTSBD350
00909      ELSE                                                         DTSBD350
00910         MOVE LBCM-LAST-UC30-DEL-MAIL-YRQ TO                       DTSBD350
00911                        WRK-LAST-DEL-MAIL-YRQ                      DTSBD350
00912         MOVE L004-QTR-DEFAULT-DUE-DATE TO                         DTSBD350
00913                        WRK-L004-QTR-DUE-DATE                      DTSBD350
00914      END-IF.                                                      DTSBD350
00915                                                                   DTSBD350
00916      PERFORM P2400-SET-QTRS  THRU P2400-EXIT.                     DTSBD350
00917                                                                   DTSBD350
00918      IF WRK-MQTR-EXISTS-IND = 'Y'                                 DTSBD350
00919          PERFORM P3000-MQTR-EXISTS THRU P3000-EXIT                DTSBD350
00920      ELSE                                                         DTSBD350
00921          PERFORM P4000-NO-MQTR-EXISTS THRU P4000-EXIT.            DTSBD350
00922                                                                   DTSBD350
00923  P2000-EXIT.                                                      DTSBD350
00924      EXIT.                                                        DTSBD350
00925      SKIP3                                                        DTSBD350
00926  P2100-MTCK-DELETE.                                               DTSBD350
00927      MOVE LOW-VALUES TO MTCK-KEY-AREA.                            DTSBD350
00928                                                                   DTSBD350
00929      MOVE MPRF-EMP-NO TO MTCK-EMP-NO.                             DTSBD350
00930                                                                   DTSBD350
00931      SET MTCK-TCK-88 TO TRUE.                                     DTSBD350
00932                                                                   DTSBD350
00933      MOVE MTCK-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
00934                                                                   DTSBD350
00935      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD350
00936                                                                   DTSBD350
00937      PERFORM P2110-MTCK-BROWSE THRU P2110-EXIT                    DTSBD350
00938          UNTIL L910-NO-REC-88.                                    DTSBD350
00939  P2100-EXIT.                                                      DTSBD350
00940      EXIT.                                                        DTSBD350
00941      SKIP3                                                        DTSBD350
00942  P2110-MTCK-BROWSE.                                               DTSBD350
00943      MOVE MSKL-REC TO MTCK-REC.                                   DTSBD350
00944                                                                   DTSBD350
00945      IF (MTCK-TYPE-CHK-LATE-88)                                   DTSBD350
00946             AND                                                   DTSBD350
00947         (MTCK-LTE-YRQ = WRK-YRQ)                                  DTSBD350
00948          PERFORM S910-DELETE THRU S910-EXIT.                      DTSBD350
00949                                                                   DTSBD350
00950      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD350
00951  P2110-EXIT.                                                      DTSBD350
00952      EXIT.                                                        DTSBD350
00953      SKIP3                                                        DTSBD350
00954  P2200-MQTR-READ.                                                 DTSBD350
00955      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD350
00956                                                                   DTSBD350
00957      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD350
00958                                                                   DTSBD350
00959      SET MQTR-QTR-88 TO TRUE.                                     DTSBD350
00960                                                                   DTSBD350
00961      MOVE WRK-YRQ TO MQTR-YRQ.                                    DTSBD350
00962                                                                   DTSBD350
00963      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
00964                                                                   DTSBD350
00965      PERFORM S910-READ THRU S910-EXIT.                            DTSBD350
00966                                                                   DTSBD350
00967      IF L910-OK-88                                                DTSBD350
00968          MOVE MSKL-REC TO MQTR-REC                                DTSBD350
00969          MOVE 'Y' TO WRK-MQTR-EXISTS-IND.                         DTSBD350
00970  P2200-EXIT.                                                      DTSBD350
00971      EXIT.                                                        DTSBD350
00972      SKIP3                                                        DTSBD350
00973  P2300-WRITE-OFF-MESSAGE.                                         DTSBD350
00974      MOVE L004-SLASH-QTR TO MSG4-SLASH-QTR.                       DTSBD350
00975                                                                   DTSBD350
00976      MOVE T031-ORIGIN TO MSG4-ORIGIN.                             DTSBD350
00977                                                                   DTSBD350
00978      MOVE MSG4-ID2 TO R907-MSG-ID.                                DTSBD350
00979                                                                   DTSBD350
00980      MOVE MSG4-LONG-TEXT TO R907-MSG-TEXT.                        DTSBD350
00981                                                                   DTSBD350
00982      PERFORM S946-R907-WRITE THRU S946-EXIT.                      DTSBD350
00983  P2300-EXIT.                                                      DTSBD350
00984      EXIT.                                                        DTSBD350
00985                                                                   DTSBD350
00986  P2400-SET-QTRS.                                                  DTSBD350
00987      MOVE MQTR-YRQ                 TO L004-QTR-5-9.               DTSBD350
00988      MOVE 1                        TO L004-QTR-5-Q.               DTSBD350
00989      MOVE L004-QTR-5-9             TO WRK-QTR1.                   DTSBD350
00990      MOVE 2                        TO L004-QTR-5-Q.               DTSBD350
00991      MOVE L004-QTR-5-9             TO WRK-QTR2.                   DTSBD350
00992      MOVE 3                        TO L004-QTR-5-Q.               DTSBD350
00993      MOVE L004-QTR-5-9             TO WRK-QTR3.                   DTSBD350
00994      MOVE 4                        TO L004-QTR-5-Q.               DTSBD350
00995      MOVE L004-QTR-5-9             TO WRK-QTR4.                   DTSBD350
00996                                                                   DTSBD350
00997      MOVE ZERO                     TO WRK-QTR1-TOT-WAGE           DTSBD350
00998                                       WRK-QTR1-TAX-WAGE           DTSBD350
00999                                       WRK-QTR2-TOT-WAGE           DTSBD350
01000                                       WRK-QTR2-TAX-WAGE           DTSBD350
01001                                       WRK-QTR3-TOT-WAGE           DTSBD350
01002                                       WRK-QTR3-TAX-WAGE           DTSBD350
01003                                       WRK-QTR4-TOT-WAGE           DTSBD350
01004                                       WRK-QTR4-TAX-WAGE.          DTSBD350
01005                                                                   DTSBD350
01006  P2400-EXIT.                                                      DTSBD350
01007      EXIT.                                                        DTSBD350
01008                                                                   DTSBD350
01009  P3000-MQTR-EXISTS.                                               DTSBD350
01010      IF MQTR-CURR-RCVD-88                                         DTSBD350
01011      OR MQTR-CURR-ESTIM-88                                        DTSBD350
01012      OR MQTR-CURR-ORIG-ANN-NL-88                                  DTSBD350
01013         PERFORM P3100-RPT-EXISTS    THRU P3100-EXIT               DTSBD350
01014      ELSE                                                         DTSBD350
01015         PERFORM P3200-NO-RPT-EXISTS THRU P3200-EXIT               DTSBD350
01016      END-IF.                                                      DTSBD350
01017                                                                   DTSBD350
01018  P3000-EXIT.                                                      DTSBD350
01019      EXIT.                                                        DTSBD350
01020      EJECT                                                        DTSBD350
01021  P3100-RPT-EXISTS.                                                DTSBD350
01022 *&                                                                DTSBD350
01023 **   IF MPRF-EMP-NO = 085854                                      DTSBD350
01024         DISPLAY 'BD350 P3100 - 1 ' MPRF-EMP-NO '  ' WRK-YRQ.      DTSBD350
01025 *&                                                                DTSBD350
01026      SET WRK-MSG10-NEEDED-NO-88 TO TRUE.                          DTSBD350
01027                                                                   DTSBD350
01028      IF (WRK-YRQ < T031-WAIVER-START-YRQ)                         DTSBD350
01029             OR                                                    DTSBD350
01030         (WRK-YRQ > T031-WAIVER-END-YRQ)                           DTSBD350
01031          NEXT SENTENCE                                            DTSBD350
01032      ELSE                                                         DTSBD350
01033          PERFORM P3110-WAIVER-SPAN THRU P3110-EXIT.               DTSBD350
01034                                                                   DTSBD350
01035      IF L516-NOT-LIABLE-88                                        DTSBD350
01036         IF L516-ANN-SCHED-88                                      DTSBD350
01037            IF L516-ANN-LIABLE-88                                  DTSBD350
01038               NEXT SENTENCE                                       DTSBD350
01039            ELSE                                                   DTSBD350
01040               PERFORM P3120-WITHDRAW-RPT   THRU P3120-EXIT        DTSBD350
01041               GO TO P3100-EXIT                                    DTSBD350
01042            END-IF                                                 DTSBD350
01043         ELSE                                                      DTSBD350
01044            PERFORM P3120-WITHDRAW-RPT      THRU P3120-EXIT        DTSBD350
01045            GO TO P3100-EXIT                                       DTSBD350
01046         END-IF                                                    DTSBD350
01047      END-IF.                                                      DTSBD350
01048                                                                   DTSBD350
01049 **   IF L516-NOT-LIABLE-88                                        DTSBD350
01050 *       IF L516-ANN-SCHED-88                                      DTSBD350
01051 *          PERFORM P3130-ANN-LIABILITY     THRU P3130-EXIT        DTSBD350
01052 *          IF WRK-ANN-LIABLE-NO-88                                DTSBD350
01053 *             PERFORM P3120-WITHDRAW-RPT   THRU P3120-EXIT        DTSBD350
01054 *             GO TO P3100-EXIT                                    DTSBD350
01055 *          END-IF                                                 DTSBD350
01056 *       ELSE                                                      DTSBD350
01057 *          PERFORM P3120-WITHDRAW-RPT      THRU P3120-EXIT        DTSBD350
01058 *          GO TO P3100-EXIT                                       DTSBD350
01059 *       END-IF                                                    DTSBD350
01060 **   END-IF.                                                      DTSBD350
01061                                                                   DTSBD350
01062 **   IF L516-NOT-LIABLE-88                                        DTSBD350
01063 *    AND NOT L516-ANN-SCHED-88                                    DTSBD350
01064 *       PERFORM P3120-WITHDRAW-RPT      THRU P3120-EXIT           DTSBD350
01065 *       GO TO P3100-EXIT                                          DTSBD350
01066 **   END-IF.                                                      DTSBD350
01067                                                                   DTSBD350
01068 **   IF L516-ANN-SCHED-88                                         DTSBD350
01069 *       IF NOT MQTR-ANNUAL-YES-88                                 DTSBD350
01070 *          SET WRK-MSG10-NEEDED-YES-88     TO TRUE                DTSBD350
01071 *          PERFORM P3121-WITHDRAW-MESSAGES THRU P3121-EXIT        DTSBD350
01072 *          SET ARPT-WITHDRW-88             TO TRUE                DTSBD350
01073 *          MOVE ARPT-RPT-TYPE              TO WRK-RPT-TYPE        DTSBD350
01074 *          PERFORM S1100-GENERATE-ARPT     THRU S1100-EXIT        DTSBD350
01075 *          PERFORM P2200-MQTR-READ         THRU P2200-EXIT        DTSBD350
01076 *          PERFORM P3200-NO-RPT-EXISTS     THRU P3200-EXIT        DTSBD350
01077 *          GO TO P3100-EXIT.                                      DTSBD350
01078 *                                                                 DTSBD350
01079 *    IF NOT L516-ANN-SCHED-88                                     DTSBD350
01080 *       IF MQTR-ANNUAL-YES-88                                     DTSBD350
01081 *          PERFORM P3121-WITHDRAW-MESSAGES THRU P3121-EXIT        DTSBD350
01082 *          SET AATX-WITHDRW-88             TO TRUE                DTSBD350
01083 *          MOVE AATX-RPT-TYPE              TO WRK-RPT-TYPE        DTSBD350
01084 *          PERFORM S1500-GENERATE-AATX     THRU S1500-EXIT        DTSBD350
01085 *          SET ARPT-ORIG-88                TO TRUE                DTSBD350
01086 *          MOVE ARPT-RPT-TYPE              TO WRK-RPT-TYPE        DTSBD350
01087 *          PERFORM S1100-GENERATE-ARPT     THRU S1100-EXIT        DTSBD350
01088 **         GO TO P3100-EXIT.                                      DTSBD350
01089                                                                   DTSBD350
01090      IF MPRF-CLASS-SELF-INS-88                                    DTSBD350
01091          NEXT SENTENCE                                            DTSBD350
01092      ELSE                                                         DTSBD350
01093          IF L516-NO-RATE-88                                       DTSBD350
01094              MOVE L004-SLASH-QTR TO MSG3-SLASH-QTR                DTSBD350
01095              MOVE MSG3-ID2 TO R907-MSG-ID                         DTSBD350
01096              MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT                 DTSBD350
01097              PERFORM S946-R907-WRITE THRU S946-EXIT               DTSBD350
01098              GO TO P3100-EXIT.                                    DTSBD350
01099                                                                   DTSBD350
01100      IF (MQTR-TAX-DUE-DATE-MANUAL-88)                             DTSBD350
01101               AND                                                 DTSBD350
01102         (MQTR-TAX-DUE-DATE > L516-DEFAULT-TAX-DUE-DATE)           DTSBD350
01103          PERFORM S1400-TAX-DUE-DATE-TO-AUTO THRU S1400-EXIT.      DTSBD350
01104                                                                   DTSBD350
01105 *&                                                                DTSBD350
01106      DISPLAY 'BD350 P3100 - 2 ' MPRF-EMP-NO                       DTSBD350
01107         WRK-YRQ  '  L516: ' L516-LIABLE-IND                       DTSBD350
01108         '  MQTR: ' MQTR-ANNUAL-IND '  L516: '                     DTSBD350
01109           L516-FILING-SCHED-CD.                                   DTSBD350
01110 *&                                                                DTSBD350
01111      IF (L516-ANN-SCHED-88 AND NOT MQTR-ANNUAL-YES-88)            DTSBD350
01112      OR (NOT L516-ANN-SCHED-88 AND MQTR-ANNUAL-YES-88)            DTSBD350
01113      OR (L516-ANN-SCHED-88     AND L516-NOT-LIABLE-88)            DTSBD350
01114         NEXT SENTENCE                                             DTSBD350
01115      ELSE                                                         DTSBD350
01116         IF (L516-UI-RATE = MQTR-UI-RATE)                          DTSBD350
01117         AND ((MQTR-RPT-DUE-DATE-MANUAL-88)                        DTSBD350
01118          OR (MQTR-RPT-DUE-DATE = L516-DEFAULT-RPT-DUE-DATE))      DTSBD350
01119         AND ((MQTR-TAX-DUE-DATE-MANUAL-88)                        DTSBD350
01120          OR (MQTR-TAX-DUE-DATE = L516-DEFAULT-TAX-DUE-DATE))      DTSBD350
01121              GO TO P3100-EXIT                                     DTSBD350
01122         END-IF                                                    DTSBD350
01123      END-IF.                                                      DTSBD350
01124                                                                   DTSBD350
01125      IF MQTR-CURR-ESTIM-88                                        DTSBD350
01126         SET ARPT-ESTIM-88          TO TRUE                        DTSBD350
01127      ELSE                                                         DTSBD350
01128         SET ARPT-ADMIN-CORR-88     TO TRUE                        DTSBD350
01129      END-IF.                                                      DTSBD350
01130                                                                   DTSBD350
01131      MOVE ARPT-RPT-TYPE            TO WRK-RPT-TYPE.               DTSBD350
01132      PERFORM S1100-GENERATE-ARPT   THRU S1100-EXIT.               DTSBD350
01133                                                                   DTSBD350
01134 **   IF L516-ANN-SCHED-88                                         DTSBD350
01135 *       IF MQTR-CURR-ESTIM-88                                     DTSBD350
01136 *          SET AATX-ESTIM-88 TO TRUE                              DTSBD350
01137 *       ELSE                                                      DTSBD350
01138 *          SET AATX-ADMIN-CORR-88 TO TRUE                         DTSBD350
01139 *       END-IF                                                    DTSBD350
01140 *       MOVE AATX-RPT-TYPE TO WRK-RPT-TYPE                        DTSBD350
01141 *       PERFORM S1500-GENERATE-AATX THRU S1500-EXIT               DTSBD350
01142 *    ELSE                                                         DTSBD350
01143 *       IF MQTR-CURR-ESTIM-88                                     DTSBD350
01144 *          SET ARPT-ESTIM-88 TO TRUE                              DTSBD350
01145 *       ELSE                                                      DTSBD350
01146 *          SET ARPT-ADMIN-CORR-88 TO TRUE                         DTSBD350
01147 *       END-IF                                                    DTSBD350
01148 *       MOVE ARPT-RPT-TYPE TO WRK-RPT-TYPE                        DTSBD350
01149 *       PERFORM S1100-GENERATE-ARPT THRU S1100-EXIT               DTSBD350
01150 **   END-IF.                                                      DTSBD350
01151                                                                   DTSBD350
01152  P3100-EXIT.                                                      DTSBD350
01153      EXIT.                                                        DTSBD350
01154      SKIP3                                                        DTSBD350
01155  P3110-WAIVER-SPAN.                                               DTSBD350
01156      IF T031-WAIVER-EXT-DATE > L516-DEFAULT-RPT-DUE-DATE          DTSBD350
01157          PERFORM S1210-EXT-RPT-DATE THRU S1210-EXIT.              DTSBD350
01158                                                                   DTSBD350
01159                                                                   DTSBD350
01160      IF T031-WAIVER-EXT-DATE > L516-DEFAULT-TAX-DUE-DATE          DTSBD350
01161          PERFORM S1220-GEN-WAIVER-SPANS THRU S1220-EXIT.          DTSBD350
01162                                                                   DTSBD350
01163                                                                   DTSBD350
01164      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
01165                                                                   DTSBD350
01166      PERFORM S910-READ THRU S910-EXIT.                            DTSBD350
01167                                                                   DTSBD350
01168      IF L910-NO-REC-88                                            DTSBD350
01169          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD350
01170                                                                   DTSBD350
01171      MOVE MSKL-REC TO MQTR-REC.                                   DTSBD350
01172  P3110-EXIT.                                                      DTSBD350
01173      EXIT.                                                        DTSBD350
01174                                                                   DTSBD350
01175  P3120-WITHDRAW-RPT.                                              DTSBD350
01176 *&                                                                DTSBD350
01177      DISPLAY 'BD350 P3120 ' MPRF-EMP-NO '  ' MQTR-YRQ             DTSBD350
01178         '  SCHED ' L516-FILING-SCHED-CD                           DTSBD350
01179         '  QTR ' MQTR-ANNUAL-IND.                                 DTSBD350
01180 *&                                                                DTSBD350
01181      PERFORM P3121-WITHDRAW-MESSAGES THRU P3121-EXIT.             DTSBD350
01182                                                                   DTSBD350
01183      SET ARPT-WITHDRW-88                  TO TRUE.                DTSBD350
01184      MOVE ARPT-RPT-TYPE                   TO WRK-RPT-TYPE.        DTSBD350
01185      PERFORM S1100-GENERATE-ARPT          THRU S1100-EXIT.        DTSBD350
01186                                                                   DTSBD350
01187 **   IF L516-ANN-SCHED-88                                         DTSBD350
01188 *       PERFORM P3130-ANN-LIABILITY       THRU P3130-EXIT         DTSBD350
01189 *       IF MQTR-ANNUAL-YES-88                                     DTSBD350
01190 *          PERFORM P3122-UPD-ANN-RPT      THRU P3122-EXIT         DTSBD350
01191 *       ELSE                                                      DTSBD350
01192 *          PERFORM P3123-ANN-FILED-QTRLY  THRU P3123-EXIT         DTSBD350
01193 *       END-IF                                                    DTSBD350
01194 *    ELSE                                                         DTSBD350
01195 *       IF MQTR-ANNUAL-YES-88                                     DTSBD350
01196 *          SET AATX-WITHDRW-88             TO TRUE                DTSBD350
01197 *          MOVE AATX-RPT-TYPE              TO WRK-RPT-TYPE        DTSBD350
01198 *          PERFORM S1500-GENERATE-AATX     THRU S1500-EXIT        DTSBD350
01199 *       ELSE                                                      DTSBD350
01200 *          SET ARPT-WITHDRW-88 TO TRUE                            DTSBD350
01201 *          MOVE ARPT-RPT-TYPE TO WRK-RPT-TYPE                     DTSBD350
01202 *          PERFORM S1100-GENERATE-ARPT THRU S1100-EXIT            DTSBD350
01203 *       END-IF                                                    DTSBD350
01204 **   END-IF.                                                      DTSBD350
01205                                                                   DTSBD350
01206  P3120-EXIT.                                                      DTSBD350
01207      EXIT.                                                        DTSBD350
01208                                                                   DTSBD350
01209  P3121-WITHDRAW-MESSAGES.                                         DTSBD350
01210      IF MQTR-CURR-ESTIM-88                                        DTSBD350
01211          MOVE L004-SLASH-QTR TO MSG8-SLASH-QTR                    DTSBD350
01212          MOVE MSG8-ID2 TO R907-MSG-ID                             DTSBD350
01213          MOVE MSG8-LONG-TEXT TO R907-MSG-TEXT                     DTSBD350
01214          PERFORM S946-R907-WRITE THRU S946-EXIT                   DTSBD350
01215      ELSE                                                         DTSBD350
01216          IF WRK-MSG10-NEEDED-NO-88                                DTSBD350
01217             MOVE L004-SLASH-QTR TO MSG5-SLASH-QTR                 DTSBD350
01218             MOVE MSG5-ID2 TO R907-MSG-ID                          DTSBD350
01219             MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT                  DTSBD350
01220             PERFORM S946-R907-WRITE THRU S946-EXIT                DTSBD350
01221          ELSE                                                     DTSBD350
01222             MOVE L004-SLASH-QTR TO MSG10-SLASH-QTR                DTSBD350
01223             MOVE MSG10-ID2 TO R907-MSG-ID                         DTSBD350
01224             MOVE MSG10-LONG-TEXT TO R907-MSG-TEXT                 DTSBD350
01225             PERFORM S946-R907-WRITE THRU S946-EXIT.               DTSBD350
01226                                                                   DTSBD350
01227      MOVE LOW-VALUES TO IPES-KEY-AREA.                            DTSBD350
01228                                                                   DTSBD350
01229      SET IPES-PES-88 TO TRUE.                                     DTSBD350
01230                                                                   DTSBD350
01231      MOVE MPRF-EMP-NO TO IPES-PRED-EMP-NO.                        DTSBD350
01232                                                                   DTSBD350
01233      MOVE IPES-KEY-AREA TO ISKL-KEY-AREA.                         DTSBD350
01234                                                                   DTSBD350
01235      PERFORM S921-START-BROWSE THRU S921-EXIT.                    DTSBD350
01236                                                                   DTSBD350
01237      IF L921-NO-REC-88                                            DTSBD350
01238          GO TO P3121-EXIT.                                        DTSBD350
01239                                                                   DTSBD350
01240      MOVE ISKL-REC TO IPES-REC.                                   DTSBD350
01241                                                                   DTSBD350
01242      IF MPRF-EMP-NO = IPES-PRED-EMP-NO                            DTSBD350
01243          MOVE L004-SLASH-QTR TO MSG6-SLASH-QTR                    DTSBD350
01244          MOVE MSG6-ID2 TO R907-MSG-ID                             DTSBD350
01245          MOVE MSG6-LONG-TEXT TO R907-MSG-TEXT                     DTSBD350
01246          PERFORM S946-R907-WRITE THRU S946-EXIT.                  DTSBD350
01247  P3121-EXIT.                                                      DTSBD350
01248      EXIT.                                                        DTSBD350
01249                                                                   DTSBD350
01250 *P3122-UPD-ANN-RPT.                                               DTSBD350
01251 *&                                                                DTSBD350
01252 *    DISPLAY 'BD350 P3122 ' MPRF-EMP-NO                           DTSBD350
01253 *       '  ANN LIABLE ' WRK-ANN-LIABLE-IND.                       DTSBD350
01254 *&                                                                DTSBD350
01255 *    IF WRK-ANN-LIABLE-YES-88                                     DTSBD350
01256 *       SET AATX-ADMIN-CORR-88          TO TRUE                   DTSBD350
01257 *    ELSE                                                         DTSBD350
01258 *       SET AATX-WITHDRW-88             TO TRUE                   DTSBD350
01259 *    END-IF.                                                      DTSBD350
01260 *                                                                 DTSBD350
01261 *    MOVE AATX-RPT-TYPE                 TO WRK-RPT-TYPE.          DTSBD350
01262 *    PERFORM S1500-GENERATE-AATX        THRU S1500-EXIT.          DTSBD350
01263 *                                                                 DTSBD350
01264 *P3122-EXIT.                                                      DTSBD350
01265 *    EXIT.                                                        DTSBD350
01266 *                                                                 DTSBD350
01267 *P3123-ANN-FILED-QTRLY.                                           DTSBD350
01268 *    SET ARPT-WITHDRW-88 TO TRUE.                                 DTSBD350
01269 *    MOVE ARPT-RPT-TYPE TO WRK-RPT-TYPE.                          DTSBD350
01270 *    PERFORM S1100-GENERATE-ARPT THRU S1100-EXIT.                 DTSBD350
01271 *                                                                 DTSBD350
01272 *    IF WRK-ANN-LIABLE-YES-88                                     DTSBD350
01273 *       SET AATX-ADMIN-CORR-88          TO TRUE                   DTSBD350
01274 *       MOVE AATX-RPT-TYPE              TO WRK-RPT-TYPE           DTSBD350
01275 *       PERFORM S1500-GENERATE-AATX     THRU S1500-EXIT           DTSBD350
01276 *    ELSE                                                         DTSBD350
01277 *       PERFORM P2200-MQTR-READ         THRU P2200-EXIT           DTSBD350
01278 *       PERFORM P3200-NO-RPT-EXISTS     THRU P3200-EXIT           DTSBD350
01279 *    END-IF.                                                      DTSBD350
01280 *                                                                 DTSBD350
01281 *P3123-EXIT.                                                      DTSBD350
01282 *    EXIT.                                                        DTSBD350
01283 *                                                                 DTSBD350
01284 *P3130-ANN-LIABILITY.                                             DTSBD350
01285 ***********                                                       DTSBD350
01286 * WRK-ANN-LIABLE-YES-88 WILL BE TRUE IF ANY QUARTER WITHIN        DTSBD350
01287 * THE ANNUAL REPORT FALLS WITHIN THE SPAN OF LIABILITY.           DTSBD350
01288 * IF THE INDICATOR REMAINS SET TO NO, THE EMPLOYER IS NOT         DTSBD350
01289 * LIABLE DURING ANY QUARTER WITHIN THE ANNUAL REPORT, AND         DTSBD350
01290 * THE REPORT SHOULD BE WITHDRAWN.  OTHERWISE, THE REPORT          DTSBD350
01291 * WILL REMAIN ON FILE, THE WAGES WILL BE REVERSED, AND THE        DTSBD350
01292 * QUARTER STATUS WILL BE SET TO MQTR-CURR-ORIG-ANN-NL-88.         DTSBD350
01293 **********                                                        DTSBD350
01294 *    SET WRK-ANN-LIABLE-NO-88    TO TRUE.                         DTSBD350
01295 *                                                                 DTSBD350
01296 *    MOVE LOW-VALUES             TO MSOL-KEY-AREA.                DTSBD350
01297 *    MOVE MPRF-EMP-NO            TO MSOL-EMP-NO.                  DTSBD350
01298 *    SET MSOL-SOL-88             TO TRUE.                         DTSBD350
01299 *    MOVE MSOL-KEY-AREA          TO MSKL-KEY-AREA.                DTSBD350
01300 *                                                                 DTSBD350
01301 *    PERFORM S910-START-BROWSE        THRU S910-EXIT.             DTSBD350
01302 *                                                                 DTSBD350
01303 *    PERFORM UNTIL L910-NO-REC-88                                 DTSBD350
01304 *       MOVE MSKL-REC                 TO MSOL-REC                 DTSBD350
01305 *                                                                 DTSBD350
01306 *       IF MSOL-LAST-LIAB-YRQ >= WRK-QTR1                         DTSBD350
01307 *       AND MSOL-FIRST-LIAB-YRQ <= WRK-QTR4                       DTSBD350
01308 *          SET WRK-ANN-LIABLE-YES-88  TO TRUE                     DTSBD350
01309 *          SET L910-NO-REC-88         TO TRUE                     DTSBD350
01310 *       ELSE                                                      DTSBD350
01311 *          PERFORM S910-READ-NEXT     THRU S910-EXIT              DTSBD350
01312 *       END-IF                                                    DTSBD350
01313 *    END-PERFORM.                                                 DTSBD350
01314 *                                                                 DTSBD350
01315 *P3130-EXIT.                                                      DTSBD350
01316 *    EXIT.                                                        DTSBD350
01317                                                                   DTSBD350
01318 *P3130-CHECK-SOL.                                                 DTSBD350
01319 *    SET WRK-ANN-RPT-WTHDRW-ALL-88  TO TRUE.                      DTSBD350
01320 *                                                                 DTSBD350
01321 *    MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBD350
01322 *                                                                 DTSBD350
01323 *    MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBD350
01324 *                                                                 DTSBD350
01325 *    SET MSOL-SOL-88 TO TRUE.                                     DTSBD350
01326 *                                                                 DTSBD350
01327 *    MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
01328 *                                                                 DTSBD350
01329 *    PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD350
01330 *                                                                 DTSBD350
01331 *    PERFORM P3131-BROWSE-MSOL THRU P3131-EXIT                    DTSBD350
01332 *        UNTIL L910-NO-REC-88.                                    DTSBD350
01333 *                                                                 DTSBD350
01334 *                                                                 DTSBD350
01335 *P3130-EXIT.                                                      DTSBD350
01336 *    EXIT.                                                        DTSBD350
01337 *P3131-BROWSE-MSOL.                                               DTSBD350
01338 *    MOVE MSKL-REC TO MSOL-REC.                                   DTSBD350
01339 *                                                                 DTSBD350
01340 *    IF MSOL-LAST-LIAB-YRQ >= WRK-QTR1                            DTSBD350
01341 *    AND MSOL-FIRST-LIAB-YRQ <= WRK-QTR4                          DTSBD350
01342 *       SET WRK-ANN-RPT-WTHDRW-QTR-88  TO TRUE.                   DTSBD350
01343 *                                                                 DTSBD350
01344 *    PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD350
01345 *P3131-EXIT.                                                      DTSBD350
01346 *    EXIT.                                                        DTSBD350
01347                                                                   DTSBD350
01348  P3200-NO-RPT-EXISTS.                                             DTSBD350
01349 *&                                                                DTSBD350
01350 ***  IF MPRF-EMP-NO = 120293                                      DTSBD350
01351 *    IF L516-NOT-LIABLE-88                                        DTSBD350
01352         DISPLAY 'BD350 P3200 ' MPRF-EMP-NO '  ' WRK-YRQ           DTSBD350
01353            '  ' L516-LIABLE-IND                                   DTSBD350
01354 *    END-IF.                                                      DTSBD350
01355 *&                                                                DTSBD350
01356      IF L516-NOT-LIABLE-88                                        DTSBD350
01357         IF L516-ANN-SCHED-88                                      DTSBD350
01358         AND L516-ANN-LIABLE-88                                    DTSBD350
01359            NEXT SENTENCE                                          DTSBD350
01360         ELSE                                                      DTSBD350
01361            PERFORM P3230-CHK-PENALTY       THRU P3230-EXIT        DTSBD350
01362         END-IF                                                    DTSBD350
01363      END-IF.                                                      DTSBD350
01364                                                                   DTSBD350
01365      IF (WRK-YRQ < T031-WAIVER-START-YRQ)                         DTSBD350
01366            OR                                                     DTSBD350
01367         (WRK-YRQ > T031-WAIVER-END-YRQ)                           DTSBD350
01368          PERFORM P3210-NO-WAIVER-SPAN THRU P3210-EXIT             DTSBD350
01369      ELSE                                                         DTSBD350
01370          PERFORM P3220-WAIVER-SPAN THRU P3220-EXIT.               DTSBD350
01371  P3200-EXIT.                                                      DTSBD350
01372      EXIT.                                                        DTSBD350
01373      SKIP3                                                        DTSBD350
01374  P3210-NO-WAIVER-SPAN.                                            DTSBD350
01375      IF MQTR-TAX-DUE-DATE-AUTO-88                                 DTSBD350
01376          IF L516-DEFAULT-TAX-DUE-DATE = MQTR-TAX-DUE-DATE         DTSBD350
01377              NEXT SENTENCE                                        DTSBD350
01378          ELSE                                                     DTSBD350
01379              PERFORM S1300-TAX-DUE-DATE THRU S1300-EXIT.          DTSBD350
01380                                                                   DTSBD350
01381      IF (MQTR-TAX-DUE-DATE-MANUAL-88)                             DTSBD350
01382               AND                                                 DTSBD350
01383         (MQTR-TAX-DUE-DATE > L516-DEFAULT-TAX-DUE-DATE)           DTSBD350
01384          PERFORM S1400-TAX-DUE-DATE-TO-AUTO THRU S1400-EXIT.      DTSBD350
01385                                                                   DTSBD350
01386      IF MQTR-RPT-DUE-DATE-AUTO-88                                 DTSBD350
01387          MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE.     DTSBD350
01388                                                                   DTSBD350
01389      IF MPRF-CLASS-SELF-INS-88                                    DTSBD350
01390          NEXT SENTENCE                                            DTSBD350
01391      ELSE                                                         DTSBD350
01392          IF L516-RATE-NOT-FOUND-88                                DTSBD350
01393              MOVE L004-SLASH-QTR TO MSG3-SLASH-QTR                DTSBD350
01394              MOVE MSG3-ID2 TO R907-MSG-ID                         DTSBD350
01395              MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT                 DTSBD350
01396              PERFORM S946-R907-WRITE THRU S946-EXIT               DTSBD350
01397              GO TO P3210-EXIT                                     DTSBD350
01398          ELSE                                                     DTSBD350
01399              IF L516-ESTIMATED-RATE-88                            DTSBD350
01400                  MOVE L004-SLASH-QTR TO MSG9-SLASH-QTR            DTSBD350
01401                  MOVE MSG9-ID2 TO R907-MSG-ID                     DTSBD350
01402                  MOVE MSG9-LONG-TEXT TO R907-MSG-TEXT             DTSBD350
01403                  PERFORM S946-R907-WRITE THRU S946-EXIT           DTSBD350
01404                  GO TO P3210-EXIT.                                DTSBD350
01405                                                                   DTSBD350
01406      MOVE L516-UI-RATE TO MQTR-UI-RATE.                           DTSBD350
01407                                                                   DTSBD350
01408      PERFORM S2100-CURR-RPT-TYPE THRU S2100-EXIT.                 DTSBD350
01409                                                                   DTSBD350
01410      PERFORM S2200-PURSUED-RPT-IND THRU S2200-EXIT.               DTSBD350
01411                                                                   DTSBD350
01412      MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE.                   DTSBD350
01413                                                                   DTSBD350
01414      IF L516-ANN-SCHED-88                                         DTSBD350
01415         SET MQTR-ANNUAL-YES-88 TO TRUE                            DTSBD350
01416      ELSE                                                         DTSBD350
01417         SET MQTR-ANNUAL-NO-88 TO TRUE.                            DTSBD350
01418                                                                   DTSBD350
01419      MOVE MQTR-REC TO MSKL-REC.                                   DTSBD350
01420                                                                   DTSBD350
01421      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD350
01422  P3210-EXIT.                                                      DTSBD350
01423      EXIT.                                                        DTSBD350
01424      SKIP3                                                        DTSBD350
01425  P3220-WAIVER-SPAN.                                               DTSBD350
01426      IF MQTR-TAX-DUE-DATE-AUTO-88                                 DTSBD350
01427          IF L516-DEFAULT-TAX-DUE-DATE = MQTR-TAX-DUE-DATE         DTSBD350
01428              NEXT SENTENCE                                        DTSBD350
01429          ELSE                                                     DTSBD350
01430              PERFORM S1300-TAX-DUE-DATE THRU S1300-EXIT.          DTSBD350
01431                                                                   DTSBD350
01432      IF (MQTR-TAX-DUE-DATE-MANUAL-88)                             DTSBD350
01433               AND                                                 DTSBD350
01434         (MQTR-TAX-DUE-DATE > L516-DEFAULT-TAX-DUE-DATE)           DTSBD350
01435          PERFORM S1400-TAX-DUE-DATE-TO-AUTO THRU S1400-EXIT.      DTSBD350
01436                                                                   DTSBD350
01437      IF MQTR-RPT-DUE-DATE-AUTO-88                                 DTSBD350
01438          MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE.     DTSBD350
01439                                                                   DTSBD350
01440      IF MPRF-CLASS-SELF-INS-88                                    DTSBD350
01441          NEXT SENTENCE                                            DTSBD350
01442      ELSE                                                         DTSBD350
01443          IF L516-RATE-NOT-FOUND-88                                DTSBD350
01444              MOVE L004-SLASH-QTR TO MSG3-SLASH-QTR                DTSBD350
01445              MOVE MSG3-ID2 TO R907-MSG-ID                         DTSBD350
01446              MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT                 DTSBD350
01447              PERFORM S946-R907-WRITE THRU S946-EXIT               DTSBD350
01448              GO TO P3220-EXIT                                     DTSBD350
01449          ELSE                                                     DTSBD350
01450              IF L516-ESTIMATED-RATE-88                            DTSBD350
01451                  MOVE L004-SLASH-QTR TO MSG9-SLASH-QTR            DTSBD350
01452                  MOVE MSG9-ID2 TO R907-MSG-ID                     DTSBD350
01453                  MOVE MSG9-LONG-TEXT TO R907-MSG-TEXT             DTSBD350
01454                  PERFORM S946-R907-WRITE THRU S946-EXIT           DTSBD350
01455                  GO TO P3220-EXIT.                                DTSBD350
01456                                                                   DTSBD350
01457      MOVE L516-UI-RATE TO MQTR-UI-RATE.                           DTSBD350
01458                                                                   DTSBD350
01459      PERFORM S2100-CURR-RPT-TYPE THRU S2100-EXIT.                 DTSBD350
01460                                                                   DTSBD350
01461      PERFORM S2200-PURSUED-RPT-IND THRU S2200-EXIT.               DTSBD350
01462                                                                   DTSBD350
01463      MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE.                   DTSBD350
01464                                                                   DTSBD350
01465      IF L516-ANN-SCHED-88                                         DTSBD350
01466         SET MQTR-ANNUAL-YES-88 TO TRUE                            DTSBD350
01467      ELSE                                                         DTSBD350
01468         SET MQTR-ANNUAL-NO-88 TO TRUE.                            DTSBD350
01469                                                                   DTSBD350
01470      MOVE MQTR-REC TO MSKL-REC.                                   DTSBD350
01471                                                                   DTSBD350
01472      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD350
01473                                                                   DTSBD350
01474                                                                   DTSBD350
01475      IF T031-WAIVER-EXT-DATE > L516-DEFAULT-RPT-DUE-DATE          DTSBD350
01476          PERFORM S1210-EXT-RPT-DATE THRU S1210-EXIT.              DTSBD350
01477                                                                   DTSBD350
01478                                                                   DTSBD350
01479      IF T031-WAIVER-EXT-DATE > L516-DEFAULT-TAX-DUE-DATE          DTSBD350
01480          PERFORM S1220-GEN-WAIVER-SPANS THRU S1220-EXIT.          DTSBD350
01481  P3220-EXIT.                                                      DTSBD350
01482      EXIT.                                                        DTSBD350
01483                                                                   DTSBD350
01484  P3230-CHK-PENALTY.                                               DTSBD350
01485      MOVE ZERO              TO WRK-PEN-CHG.                       DTSBD350
01486                                                                   DTSBD350
01487      PERFORM                                                      DTSBD350
01488        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSBD350
01489        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBD350
01490          IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)                 DTSBD350
01491              ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                 DTSBD350
01492                  TO WRK-PEN-CHG                                   DTSBD350
01493          END-IF                                                   DTSBD350
01494      END-PERFORM.                                                 DTSBD350
01495                                                                   DTSBD350
01496 *&                                                                DTSBD350
01497 *       MOVE WRK-PEN-CHG  TO AMT-DISP1                            DTSBD350
01498 *       DISPLAY 'BD350 P3230 - 1 ' MPRF-EMP-NO '  ' WRK-YRQ       DTSBD350
01499 *          '  ' AMT-DISP1.                                        DTSBD350
01500 */&                                                               DTSBD350
01501      IF WRK-PEN-CHG > ZERO                                        DTSBD350
01502         PERFORM S1700-REV-PENALTY       THRU S1700-EXIT           DTSBD350
01503 ***  REREAD MQTR TO GET COPY OF DATA UPDATED IN BD373  ***        DTSBD350
01504         MOVE LOW-VALUES TO MQTR-KEY-AREA                          DTSBD350
01505         MOVE MPRF-EMP-NO TO MQTR-EMP-NO                           DTSBD350
01506         SET MQTR-QTR-88 TO TRUE                                   DTSBD350
01507         MOVE WRK-YRQ TO MQTR-YRQ                                  DTSBD350
01508         MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA                       DTSBD350
01509         PERFORM S910-READ THRU S910-EXIT                          DTSBD350
01510         MOVE MSKL-REC         TO MQTR-REC                         DTSBD350
01511      END-IF.                                                      DTSBD350
01512                                                                   DTSBD350
01513 *&                                                                DTSBD350
01514 *    MOVE ZERO              TO WRK-PEN-CHG.                       DTSBD350
01515 *    PERFORM                                                      DTSBD350
01516 *      VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSBD350
01517 *      UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBD350
01518 *        IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)                 DTSBD350
01519 *            ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                 DTSBD350
01520 *                TO WRK-PEN-CHG                                   DTSBD350
01521 *        END-IF                                                   DTSBD350
01522 *    END-PERFORM.                                                 DTSBD350
01523 *       MOVE WRK-PEN-CHG  TO AMT-DISP1                            DTSBD350
01524 *       DISPLAY 'BD350 P3230 - 2 ' MPRF-EMP-NO '  ' WRK-YRQ       DTSBD350
01525 *          '  ' AMT-DISP1.                                        DTSBD350
01526 */&                                                               DTSBD350
01527  P3230-EXIT.                                                      DTSBD350
01528      EXIT.                                                        DTSBD350
01529      EJECT                                                        DTSBD350
01530  P4000-NO-MQTR-EXISTS.                                            DTSBD350
01531 *&                                                                DTSBD350
01532 *    IF MPRF-EMP-NO = 085854 OR 133947                            DTSBD350
01533 *       DISPLAY 'BD350 P4000 ' MPRF-EMP-NO '  ' WRK-YRQ.          DTSBD350
01534 *&                                                                DTSBD350
01535      IF (WRK-YRQ < T031-WAIVER-START-YRQ)                         DTSBD350
01536              OR                                                   DTSBD350
01537         (WRK-YRQ > T031-WAIVER-END-YRQ)                           DTSBD350
01538          PERFORM P4100-NO-WAIVER-SPAN THRU P4100-EXIT             DTSBD350
01539      ELSE                                                         DTSBD350
01540          PERFORM P4100-NO-WAIVER-SPAN THRU P4100-EXIT             DTSBD350
01541          PERFORM P4200-WAIVER-SPAN THRU P4200-EXIT.               DTSBD350
01542  P4000-EXIT.                                                      DTSBD350
01543      EXIT.                                                        DTSBD350
01544      SKIP3                                                        DTSBD350
01545  P4100-NO-WAIVER-SPAN.                                            DTSBD350
01546 *&                                                                DTSBD350
01547 *    IF MPRF-EMP-NO = 085854 OR 133947                            DTSBD350
01548         DISPLAY 'BD350 P4100 ' MPRF-EMP-NO '  ' WRK-YRQ           DTSBD350
01549            '  ' WRK-LAST-DEL-MAIL-YRQ.                            DTSBD350
01550 *&                                                                DTSBD350
01551      IF L516-NOT-LIABLE-88                                        DTSBD350
01552         IF L516-ANN-SCHED-88                                      DTSBD350
01553         AND L516-ANN-LIABLE-88                                    DTSBD350
01554            NEXT SENTENCE                                          DTSBD350
01555         ELSE                                                      DTSBD350
01556            GO TO P4100-EXIT                                       DTSBD350
01557         END-IF                                                    DTSBD350
01558      END-IF.                                                      DTSBD350
01559                                                                   DTSBD350
01560 **   IF L516-ANN-SCHED-88                                         DTSBD350
01561 *       NEXT SENTENCE                                             DTSBD350
01562 *    ELSE                                                         DTSBD350
01563 *       IF L516-NOT-LIABLE-88                                     DTSBD350
01564 **          GO TO P4100-EXIT.                                     DTSBD350
01565                                                                   DTSBD350
01566      IF WRK-YRQ > MPRF-LAST-ARCHIVED-YRQ                          DTSBD350
01567          NEXT SENTENCE                                            DTSBD350
01568      ELSE                                                         DTSBD350
01569          GO TO P4100-EXIT.                                        DTSBD350
01570                                                                   DTSBD350
01571      IF L516-DEFAULT-RPT-DUE-DATE = WRK-L004-QTR-DUE-DATE         DTSBD350
01572          IF WRK-YRQ > WRK-LAST-DEL-MAIL-YRQ                       DTSBD350
01573              NEXT SENTENCE                                        DTSBD350
01574          ELSE                                                     DTSBD350
01575              PERFORM P4110-ESTB-MQTR THRU P4110-EXIT              DTSBD350
01576      ELSE                                                         DTSBD350
01577         DISPLAY '*&* DTSBD350 P4100 '                             DTSBD350
01578            '  L516 DUE ' L516-DEFAULT-RPT-DUE-DATE                DTSBD350
01579            '  L004 DUE ' WRK-L004-QTR-DUE-DATE                    DTSBD350
01580          IF L516-DEFAULT-RPT-DUE-DATE > LBCM-CURR-RUN-DATE        DTSBD350
01581              MOVE L516-DEFAULT-RPT-DUE-DATE TO WRK-TRIGGER-DATE   DTSBD350
01582              PERFORM S3000-ESTB-MTCK THRU S3000-EXIT              DTSBD350
01583          ELSE                                                     DTSBD350
01584              PERFORM P4110-ESTB-MQTR THRU P4110-EXIT.             DTSBD350
01585  P4100-EXIT.                                                      DTSBD350
01586      EXIT.                                                        DTSBD350
01587      SKIP3                                                        DTSBD350
01588  P4110-ESTB-MQTR.                                                 DTSBD350
01589 *&                                                                DTSBD350
01590 *    IF MPRF-EMP-NO = 085854 OR 133947                            DTSBD350
01591 *       DISPLAY 'BD350 P4110 ' MPRF-EMP-NO '  ' WRK-YRQ.          DTSBD350
01592 *&                                                                DTSBD350
01593      PERFORM S511-INITIALIZE-MQTR THRU S511-EXIT.                 DTSBD350
01594                                                                   DTSBD350
01595      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD350
01596                                                                   DTSBD350
01597      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD350
01598                                                                   DTSBD350
01599      SET MQTR-QTR-88 TO TRUE.                                     DTSBD350
01600                                                                   DTSBD350
01601      MOVE WRK-YRQ TO MQTR-YRQ.                                    DTSBD350
01602                                                                   DTSBD350
01603      MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE                    DTSBD350
01604                                 MQTR-ESTB-DATE.                   DTSBD350
01605                                                                   DTSBD350
01606      IF WRK-YRQ > WRK-LAST-DEL-MAIL-YRQ                           DTSBD350
01607          SET MQTR-MISS-NOT-YET-RUN-88 TO TRUE                     DTSBD350
01608      ELSE                                                         DTSBD350
01609          SET MQTR-MISS-NOT-LIABLE-88 TO TRUE.                     DTSBD350
01610                                                                   DTSBD350
01611      IF MPRF-CLASS-SELF-INS-88                                    DTSBD350
01612          NEXT SENTENCE                                            DTSBD350
01613      ELSE                                                         DTSBD350
01614          IF L516-RATE-NOT-FOUND-88                                DTSBD350
01615              MOVE L004-SLASH-QTR TO MSG3-SLASH-QTR                DTSBD350
01616              MOVE MSG3-ID2 TO R907-MSG-ID                         DTSBD350
01617              MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT                 DTSBD350
01618              PERFORM S946-R907-WRITE THRU S946-EXIT               DTSBD350
01619              GO TO P4110-EXIT                                     DTSBD350
01620          ELSE                                                     DTSBD350
01621              IF L516-ESTIMATED-RATE-88                            DTSBD350
01622                  MOVE L004-SLASH-QTR TO MSG9-SLASH-QTR            DTSBD350
01623                  MOVE MSG9-ID2 TO R907-MSG-ID                     DTSBD350
01624                  MOVE MSG9-LONG-TEXT TO R907-MSG-TEXT             DTSBD350
01625                  PERFORM S946-R907-WRITE THRU S946-EXIT           DTSBD350
01626                  GO TO P4110-EXIT.                                DTSBD350
01627                                                                   DTSBD350
01628      MOVE L516-UI-RATE TO MQTR-UI-RATE.                           DTSBD350
01629                                                                   DTSBD350
01630      MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE          DTSBD350
01631                                                                   DTSBD350
01632      MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE.         DTSBD350
01633                                                                   DTSBD350
01634      PERFORM S2100-CURR-RPT-TYPE THRU S2100-EXIT.                 DTSBD350
01635                                                                   DTSBD350
01636      PERFORM S2200-PURSUED-RPT-IND THRU S2200-EXIT.               DTSBD350
01637                                                                   DTSBD350
01638      IF L516-ANN-SCHED-88                                         DTSBD350
01639         SET MQTR-ANNUAL-YES-88 TO TRUE                            DTSBD350
01640      ELSE                                                         DTSBD350
01641         SET MQTR-ANNUAL-NO-88 TO TRUE.                            DTSBD350
01642                                                                   DTSBD350
01643      MOVE MQTR-REC TO MSKL-REC.                                   DTSBD350
01644                                                                   DTSBD350
01645      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBD350
01646  P4110-EXIT.                                                      DTSBD350
01647      EXIT.                                                        DTSBD350
01648      SKIP3                                                        DTSBD350
01649  P4200-WAIVER-SPAN.                                               DTSBD350
01650 *&                                                                DTSBD350
01651 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
01652         DISPLAY 'BD350 P4200 ' WRK-YRQ.                           DTSBD350
01653 *&                                                                DTSBD350
01654      IF T031-WAIVER-EXT-DATE > L516-DEFAULT-RPT-DUE-DATE          DTSBD350
01655          PERFORM S1210-EXT-RPT-DATE THRU S1210-EXIT.              DTSBD350
01656                                                                   DTSBD350
01657                                                                   DTSBD350
01658      IF T031-WAIVER-EXT-DATE > L516-DEFAULT-TAX-DUE-DATE          DTSBD350
01659          PERFORM S1220-GEN-WAIVER-SPANS THRU S1220-EXIT.          DTSBD350
01660  P4200-EXIT.                                                      DTSBD350
01661      EXIT.                                                        DTSBD350
01662                                                                   DTSBD350
01663                                                                   DTSBD350
01664  P9000-EMP-NO-BREAK.                                              DTSBD350
01665      MOVE ZERO       TO WRK-CURR-YEAR.                            DTSBD350
01666                                                                   DTSBD350
01667  P9000-EXIT.                                                      DTSBD350
01668      EXIT.                                                        DTSBD350
01669      EJECT                                                        DTSBD350
01670  S1100-GENERATE-ARPT.                                             DTSBD350
01671 *&                                                                DTSBD350
01672 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
01673         DISPLAY 'BD350 S1100 ' WRK-YRQ                            DTSBD350
01674            '  RPT TYPE ' WRK-RPT-TYPE.                            DTSBD350
01675 *&                                                                DTSBD350
01676      MOVE LOW-VALUES                 TO ASKL-REC.                 DTSBD350
01677      MOVE WRK-NULL-DOC-NO            TO ARPT-DOC-NO.              DTSBD350
01678      SET ARPT-RPT-88                 TO TRUE.                     DTSBD350
01679      MOVE MPRF-PRIMARY-NAME          TO ARPT-NAME-CHECK.          DTSBD350
01680      MOVE MPRF-EMP-NO                TO ARPT-EMP-NO.              DTSBD350
01681      MOVE WRK-RPT-TYPE               TO ARPT-RPT-TYPE.            DTSBD350
01682      MOVE WRK-YRQ                    TO ARPT-YRQ.                 DTSBD350
01683                                                                   DTSBD350
01684      EVALUATE TRUE                                                DTSBD350
01685        WHEN ARPT-WITHDRW-88                                       DTSBD350
01686          PERFORM S1110-WITHDRW-WAGES THRU S1110-EXIT              DTSBD350
01687                                                                   DTSBD350
01688        WHEN ARPT-ORIG-88 OR ARPT-ESTIM-88                         DTSBD350
01689          MOVE MQTR-TOT-WAGE          TO ARPT-TOT-WAGE             DTSBD350
01690          MOVE MQTR-EXCESS-WAGE       TO ARPT-EXCESS-WAGE          DTSBD350
01691          MOVE MQTR-TAX-WAGE          TO ARPT-TAX-WAGE             DTSBD350
01692                                                                   DTSBD350
01693        WHEN ARPT-ADMIN-CORR-88                                    DTSBD350
01694          IF L516-NOT-LIABLE-88                                    DTSBD350
01695          AND L516-ANN-SCHED-88                                    DTSBD350
01696             PERFORM S1110-WITHDRW-WAGES THRU S1110-EXIT           DTSBD350
01697          ELSE                                                     DTSBD350
01698             MOVE +0                  TO ARPT-TOT-WAGE             DTSBD350
01699                                         ARPT-EXCESS-WAGE          DTSBD350
01700                                         ARPT-TAX-WAGE             DTSBD350
01701          END-IF                                                   DTSBD350
01702      END-EVALUATE.                                                DTSBD350
01703                                                                   DTSBD350
01704      MOVE +0                         TO ARPT-REMIT-AMT.           DTSBD350
01705                                                                   DTSBD350
01706      SET ARPT-WAGE-RPT-NO-ENTRY-88   TO TRUE.                     DTSBD350
01707                                                                   DTSBD350
01708      SET ARPT-WAIVE-BOTH-NO-88       TO TRUE.                     DTSBD350
01709                                                                   DTSBD350
01710      SET ARPT-WAIVE-INT-NO-88        TO TRUE.                     DTSBD350
01711                                                                   DTSBD350
01712      SET ARPT-WAIVE-LATE-PEN-NO-88   TO TRUE.                     DTSBD350
01713                                                                   DTSBD350
01714      SET ARPT-TOTAL-NO-ENTRY-88      TO TRUE.                     DTSBD350
01715                                                                   DTSBD350
01716      SET ARPT-1ST-MTH-NO-ENTRY-88    TO TRUE.                     DTSBD350
01717                                                                   DTSBD350
01718      SET ARPT-2ND-MTH-NO-ENTRY-88    TO TRUE.                     DTSBD350
01719                                                                   DTSBD350
01720      SET ARPT-3RD-MTH-NO-ENTRY-88    TO TRUE.                     DTSBD350
01721                                                                   DTSBD350
01722      SET ARPT-VERIFIED-NO-88         TO TRUE.                     DTSBD350
01723                                                                   DTSBD350
01724      MOVE LBCM-RECEIVED-DATE         TO ARPT-RECEIVED-DATE.       DTSBD350
01725                                                                   DTSBD350
01726      MOVE LBCM-DEPOSIT-DATE          TO ARPT-DEPOSIT-DATE.        DTSBD350
01727                                                                   DTSBD350
01728      MOVE 'SYS'               TO ARPT-RESPONSIBLE-ACTIVITY.       DTSBD350
01729                                                                   DTSBD350
01730      MOVE 'SYSTEM'            TO ARPT-RESPONSIBLE-OP-ID.          DTSBD350
01731                                                                   DTSBD350
01732      MOVE 'N'                 TO ARPT-DISREGARD-EDITS-IND.        DTSBD350
01733                                                                   DTSBD350
01734      SET ARPT-STATUS-CHNG-NO-88        TO TRUE.                   DTSBD350
01735                                                                   DTSBD350
01736      SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE.                   DTSBD350
01737                                                                   DTSBD350
01738      SET ARPT-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
01739                                                                   DTSBD350
01740                                                                   DTSBD350
01741      SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
01742                                                                   DTSBD350
01743      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
01744  S1100-EXIT.                                                      DTSBD350
01745      EXIT.                                                        DTSBD350
01746      SKIP3                                                        DTSBD350
01747  S1110-WITHDRW-WAGES.                                             DTSBD350
01748      IF MQTR-TOT-WAGE = +0                                        DTSBD350
01749          MOVE +0 TO ARPT-TOT-WAGE                                 DTSBD350
01750      ELSE                                                         DTSBD350
01751          COMPUTE ARPT-TOT-WAGE = MQTR-TOT-WAGE * -1.              DTSBD350
01752                                                                   DTSBD350
01753      IF MQTR-EXCESS-WAGE = +0                                     DTSBD350
01754          MOVE +0 TO ARPT-EXCESS-WAGE                              DTSBD350
01755      ELSE                                                         DTSBD350
01756          COMPUTE ARPT-EXCESS-WAGE = MQTR-EXCESS-WAGE * -1.        DTSBD350
01757                                                                   DTSBD350
01758      IF MQTR-TAX-WAGE = +0                                        DTSBD350
01759          MOVE +0 TO ARPT-TAX-WAGE                                 DTSBD350
01760      ELSE                                                         DTSBD350
01761          COMPUTE ARPT-TAX-WAGE = MQTR-TAX-WAGE * -1.              DTSBD350
01762  S1110-EXIT.                                                      DTSBD350
01763      EXIT.                                                        DTSBD350
01764      EJECT                                                        DTSBD350
01765  S1210-EXT-RPT-DATE.                                              DTSBD350
01766      MOVE LOW-VALUES TO ASKL-REC.                                 DTSBD350
01767                                                                   DTSBD350
01768      MOVE WRK-NULL-DOC-NO TO AADJ-DOC-NO.                         DTSBD350
01769                                                                   DTSBD350
01770      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD350
01771                                                                   DTSBD350
01772      MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK.                   DTSBD350
01773                                                                   DTSBD350
01774      MOVE MPRF-EMP-NO TO AADJ-EMP-NO.                             DTSBD350
01775                                                                   DTSBD350
01776      SET AADJ-DUE-DATE-88 TO TRUE.                                DTSBD350
01777                                                                   DTSBD350
01778      MOVE +0 TO AADJ-AMT.                                         DTSBD350
01779                                                                   DTSBD350
01780      MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE.               DTSBD350
01781                                                                   DTSBD350
01782      MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE.                 DTSBD350
01783                                                                   DTSBD350
01784      MOVE WRK-YRQ TO AADJ-APPLIC-YRQ.                             DTSBD350
01785                                                                   DTSBD350
01786      MOVE SPACES TO AADJ-APPLIC-IND.                              DTSBD350
01787                                                                   DTSBD350
01788      MOVE WRK-NULL-DOC-NO TO AADJ-APPLIC-DOC-NO.                  DTSBD350
01789                                                                   DTSBD350
01790      MOVE T031-WAIVER-EXT-DATE TO AADJ-DATE-1.                    DTSBD350
01791                                                                   DTSBD350
01792      MOVE +0 TO AADJ-DATE-2.                                      DTSBD350
01793                                                                   DTSBD350
01794      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD350
01795                                                                   DTSBD350
01796      MOVE WRK-NO-UI-RATE TO AADJ-INT-RATE.                        DTSBD350
01797                                                                   DTSBD350
01798      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD350
01799                                                                   DTSBD350
01800      MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY.                     DTSBD350
01801                                                                   DTSBD350
01802      MOVE ZERO     TO AADJ-CMP-ESTB-ABSTIME.                      DTSBD350
01803                                                                   DTSBD350
01804      MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID.                     DTSBD350
01805                                                                   DTSBD350
01806      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
01807                                                                   DTSBD350
01808                                                                   DTSBD350
01809      SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
01810                                                                   DTSBD350
01811      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
01812  S1210-EXIT.                                                      DTSBD350
01813      EXIT.                                                        DTSBD350
01814      SKIP3                                                        DTSBD350
01815  S1220-GEN-WAIVER-SPANS.                                          DTSBD350
01816      MOVE LOW-VALUES TO ASKL-REC.                                 DTSBD350
01817                                                                   DTSBD350
01818      MOVE WRK-NULL-DOC-NO TO AADJ-DOC-NO.                         DTSBD350
01819                                                                   DTSBD350
01820      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD350
01821                                                                   DTSBD350
01822      MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK.                   DTSBD350
01823                                                                   DTSBD350
01824      MOVE MPRF-EMP-NO TO AADJ-EMP-NO.                             DTSBD350
01825                                                                   DTSBD350
01826      SET AADJ-WAIVE-DATE-88 TO TRUE.                              DTSBD350
01827                                                                   DTSBD350
01828      MOVE +0 TO AADJ-AMT.                                         DTSBD350
01829                                                                   DTSBD350
01830      MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE.               DTSBD350
01831                                                                   DTSBD350
01832      MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE.                 DTSBD350
01833                                                                   DTSBD350
01834      MOVE WRK-YRQ TO AADJ-APPLIC-YRQ.                             DTSBD350
01835                                                                   DTSBD350
01836      SET AADJ-LP-INT-88 TO TRUE.                                  DTSBD350
01837                                                                   DTSBD350
01838      MOVE WRK-NULL-DOC-NO TO AADJ-APPLIC-DOC-NO.                  DTSBD350
01839                                                                   DTSBD350
01840      MOVE L516-DEFAULT-TAX-DUE-DATE TO L001-FED-8-DATE-9.         DTSBD350
01841                                                                   DTSBD350
01842      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBD350
01843                                                                   DTSBD350
01844      ADD +1 TO L001-JUL-ABS-DAY.                                  DTSBD350
01845                                                                   DTSBD350
01846      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBD350
01847                                                                   DTSBD350
01848      MOVE L001-FED-8-DATE-9 TO AADJ-DATE-1.                       DTSBD350
01849                                                                   DTSBD350
01850      MOVE T031-WAIVER-EXT-DATE TO AADJ-DATE-2.                    DTSBD350
01851                                                                   DTSBD350
01852      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD350
01853                                                                   DTSBD350
01854      MOVE WRK-NO-UI-RATE TO AADJ-INT-RATE.                        DTSBD350
01855                                                                   DTSBD350
01856      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD350
01857                                                                   DTSBD350
01858      MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY.                     DTSBD350
01859                                                                   DTSBD350
01860      MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID.                     DTSBD350
01861                                                                   DTSBD350
01862      MOVE ZERO     TO AADJ-CMP-ESTB-ABSTIME.                      DTSBD350
01863                                                                   DTSBD350
01864      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
01865                                                                   DTSBD350
01866                                                                   DTSBD350
01867      SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
01868                                                                   DTSBD350
01869      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
01870  S1220-EXIT.                                                      DTSBD350
01871      EXIT.                                                        DTSBD350
01872      EJECT                                                        DTSBD350
01873  S1300-TAX-DUE-DATE.                                              DTSBD350
01874      MOVE 'N' TO TAX-PAID-IND.                                    DTSBD350
01875                                                                   DTSBD350
01876      PERFORM                                                      DTSBD350
01877        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSBD350
01878        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBD350
01879          IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                      DTSBD350
01880              IF MQTR-PAID-AMT (MQTR-ACCT-IDX) > +0                DTSBD350
01881                  MOVE 'Y' TO TAX-PAID-IND                         DTSBD350
01882              END-IF                                               DTSBD350
01883          END-IF                                                   DTSBD350
01884      END-PERFORM.                                                 DTSBD350
01885                                                                   DTSBD350
01886      IF TAX-PAID-IND = 'N'                                        DTSBD350
01887          MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE      DTSBD350
01888          GO TO S1300-EXIT.                                        DTSBD350
01889                                                                   DTSBD350
01890      MOVE LOW-VALUES TO ASKL-REC.                                 DTSBD350
01891                                                                   DTSBD350
01892      MOVE WRK-NULL-DOC-NO TO AADJ-DOC-NO.                         DTSBD350
01893                                                                   DTSBD350
01894      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD350
01895                                                                   DTSBD350
01896      MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK.                   DTSBD350
01897                                                                   DTSBD350
01898      MOVE MPRF-EMP-NO TO AADJ-EMP-NO.                             DTSBD350
01899                                                                   DTSBD350
01900      SET AADJ-DUE-DATE-88 TO TRUE.                                DTSBD350
01901                                                                   DTSBD350
01902      MOVE +0 TO AADJ-AMT.                                         DTSBD350
01903                                                                   DTSBD350
01904      MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE.               DTSBD350
01905                                                                   DTSBD350
01906      MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE.                 DTSBD350
01907                                                                   DTSBD350
01908      MOVE WRK-YRQ TO AADJ-APPLIC-YRQ.                             DTSBD350
01909                                                                   DTSBD350
01910      MOVE SPACES TO AADJ-APPLIC-IND.                              DTSBD350
01911                                                                   DTSBD350
01912      MOVE WRK-NULL-DOC-NO TO AADJ-APPLIC-DOC-NO.                  DTSBD350
01913                                                                   DTSBD350
01914      MOVE +0 TO AADJ-DATE-1.                                      DTSBD350
01915                                                                   DTSBD350
01916      MOVE L516-DEFAULT-TAX-DUE-DATE TO AADJ-DATE-2.               DTSBD350
01917                                                                   DTSBD350
01918      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD350
01919                                                                   DTSBD350
01920      MOVE WRK-NO-UI-RATE TO AADJ-INT-RATE.                        DTSBD350
01921                                                                   DTSBD350
01922      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD350
01923                                                                   DTSBD350
01924      MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY.                     DTSBD350
01925                                                                   DTSBD350
01926      MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID.                     DTSBD350
01927                                                                   DTSBD350
01928      MOVE ZERO     TO AADJ-CMP-ESTB-ABSTIME.                      DTSBD350
01929                                                                   DTSBD350
01930      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
01931                                                                   DTSBD350
01932                                                                   DTSBD350
01933      SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
01934                                                                   DTSBD350
01935      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
01936                                                                   DTSBD350
01937                                                                   DTSBD350
01938      MOVE ALL-NINES-DATE TO AADJ-DATE-2.                          DTSBD350
01939                                                                   DTSBD350
01940      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
01941                                                                   DTSBD350
01942                                                                   DTSBD350
01943      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
01944                                                                   DTSBD350
01945                                                                   DTSBD350
01946                                                                   DTSBD350
01947      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
01948                                                                   DTSBD350
01949      PERFORM S910-READ THRU S910-EXIT.                            DTSBD350
01950                                                                   DTSBD350
01951      IF L910-NO-REC-88                                            DTSBD350
01952          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD350
01953                                                                   DTSBD350
01954      MOVE MSKL-REC TO MQTR-REC.                                   DTSBD350
01955  S1300-EXIT.                                                      DTSBD350
01956      EXIT.                                                        DTSBD350
01957      EJECT                                                        DTSBD350
01958  S1400-TAX-DUE-DATE-TO-AUTO.                                      DTSBD350
01959      MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9.                 DTSBD350
01960                                                                   DTSBD350
01961      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBD350
01962                                                                   DTSBD350
01963      MOVE L001-SLASH-DATE TO MSG7-TAX-DUE-DATE.                   DTSBD350
01964                                                                   DTSBD350
01965      MOVE L004-SLASH-QTR TO MSG7-SLASH-QTR.                       DTSBD350
01966                                                                   DTSBD350
01967      MOVE MSG7-ID2 TO R907-MSG-ID.                                DTSBD350
01968                                                                   DTSBD350
01969      MOVE MSG7-LONG-TEXT TO R907-MSG-TEXT.                        DTSBD350
01970                                                                   DTSBD350
01971      PERFORM S946-R907-WRITE THRU S946-EXIT.                      DTSBD350
01972                                                                   DTSBD350
01973                                                                   DTSBD350
01974      MOVE LOW-VALUES TO ASKL-REC.                                 DTSBD350
01975                                                                   DTSBD350
01976      MOVE WRK-NULL-DOC-NO TO AADJ-DOC-NO.                         DTSBD350
01977                                                                   DTSBD350
01978      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD350
01979                                                                   DTSBD350
01980      MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK.                   DTSBD350
01981                                                                   DTSBD350
01982      MOVE MPRF-EMP-NO TO AADJ-EMP-NO.                             DTSBD350
01983                                                                   DTSBD350
01984      SET AADJ-DUE-DATE-88 TO TRUE.                                DTSBD350
01985                                                                   DTSBD350
01986      MOVE +0 TO AADJ-AMT.                                         DTSBD350
01987                                                                   DTSBD350
01988      MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE.               DTSBD350
01989                                                                   DTSBD350
01990      MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE.                 DTSBD350
01991                                                                   DTSBD350
01992      MOVE WRK-YRQ TO AADJ-APPLIC-YRQ.                             DTSBD350
01993                                                                   DTSBD350
01994      MOVE SPACES TO AADJ-APPLIC-IND.                              DTSBD350
01995                                                                   DTSBD350
01996      MOVE WRK-NULL-DOC-NO TO AADJ-APPLIC-DOC-NO.                  DTSBD350
01997                                                                   DTSBD350
01998      MOVE +0 TO AADJ-DATE-1.                                      DTSBD350
01999                                                                   DTSBD350
02000      MOVE ALL-NINES-DATE TO AADJ-DATE-2.                          DTSBD350
02001                                                                   DTSBD350
02002      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD350
02003                                                                   DTSBD350
02004      MOVE WRK-NO-UI-RATE TO AADJ-INT-RATE.                        DTSBD350
02005                                                                   DTSBD350
02006      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD350
02007                                                                   DTSBD350
02008      MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY.                     DTSBD350
02009                                                                   DTSBD350
02010      MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID.                     DTSBD350
02011                                                                   DTSBD350
02012      MOVE ZERO     TO AADJ-CMP-ESTB-ABSTIME.                      DTSBD350
02013                                                                   DTSBD350
02014      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
02015                                                                   DTSBD350
02016                                                                   DTSBD350
02017      SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
02018                                                                   DTSBD350
02019      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
02020                                                                   DTSBD350
02021                                                                   DTSBD350
02022                                                                   DTSBD350
02023      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD350
02024                                                                   DTSBD350
02025      PERFORM S910-READ THRU S910-EXIT.                            DTSBD350
02026                                                                   DTSBD350
02027      IF L910-NO-REC-88                                            DTSBD350
02028          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD350
02029                                                                   DTSBD350
02030      MOVE MSKL-REC TO MQTR-REC.                                   DTSBD350
02031  S1400-EXIT.                                                      DTSBD350
02032      EXIT.                                                        DTSBD350
02033      EJECT                                                        DTSBD350
02034 *S1500-GENERATE-AATX.                                             DTSBD350
02035 *&                                                                DTSBD350
02036 *    IF MPRF-EMP-NO = 078836                                      DTSBD350
02037 *       DISPLAY 'BD350 S1500 ' MPRF-EMP-NO '  ' WRK-YRQ           DTSBD350
02038 *          '  RPT TYPE ' WRK-RPT-TYPE.                            DTSBD350
02039 *&                                                                DTSBD350
02040 ***********************************************************       DTSBD350
02041 ** GENERATE A WITHDRAWAL TRANSACTION FOR THE ANNUAL REPORT        DTSBD350
02042 ** IF THE EMPLOYER IS NOT LIABLE DURING ANY QUARTER OF            DTSBD350
02043 ** THE YEAR (WRK-ANN-LIABLE-NO-88 IS TRUE - THIS INDICATOR        DTSBD350
02044 ** IS SET IN P3130).                                              DTSBD350
02045 *  IF THE EMPLOYER IS NOT LIABLE FOR THIS QUARTER ONLY,           DTSBD350
02046 *  GENERATE AN ADMINISTRATIVE CORRECTION REPORT WITHDRAWING       DTSBD350
02047 *  WAGES FROM THIS QUARTER.                                       DTSBD350
02048 *                                                                 DTSBD350
02049 *  FOR CHANGES IN UI RATE OR REPORT AND TAX DUE DATES,            DTSBD350
02050 *  GENERATE ONLY ONE TRANSACTION FOR THE WHOLE YEAR.              DTSBD350
02051 ***********************************************************       DTSBD350
02052 *    MOVE WRK-YRQ TO WRK-ANN-YRQ.                                 DTSBD350
02053 *    IF WRK-ANN-YRQ-YR NOT = WRK-CURR-YEAR                        DTSBD350
02054 *       MOVE WRK-ANN-YRQ-YR TO WRK-CURR-YEAR                      DTSBD350
02055 *       MOVE LOW-VALUES TO ASKL-REC                               DTSBD350
02056 *       MOVE +0 TO AATX-TOT-WAGE                                  DTSBD350
02057 *                   AATX-EXCESS-WAGE                              DTSBD350
02058 *                   AATX-TAX-WAGE                                 DTSBD350
02059 *       SET WRK-FIND-WAGES-YES-88  TO TRUE                        DTSBD350
02060 *    ELSE                                                         DTSBD350
02061 *       SET WRK-FIND-WAGES-NO-88   TO TRUE                        DTSBD350
02062 *    END-IF.                                                      DTSBD350
02063 *                                                                 DTSBD350
02064 *                                                                 DTSBD350
02065 *    MOVE WRK-RPT-TYPE      TO AATX-RPT-TYPE.                     DTSBD350
02066 **                                                                DTSBD350
02067 *    EVALUATE TRUE                                                DTSBD350
02068 *      WHEN WRK-ANN-RPT-WTHDRW-ALL-88                             DTSBD350
02069 *        SET AATX-WITHDRW-88           TO TRUE                    DTSBD350
02070 *                                                                 DTSBD350
02071 *      WHEN WRK-ANN-RPT-WTHDRW-QTR-88                             DTSBD350
02072 *        SET AATX-ADMIN-CORR-88        TO TRUE                    DTSBD350
02073 *                                                                 DTSBD350
02074 *      WHEN WRK-ANN-RPT-ADMIN-88                                  DTSBD350
02075 *        SET AATX-ADMIN-CORR-88        TO TRUE                    DTSBD350
02076 *                                                                 DTSBD350
02077 *      WHEN WRK-ANN-RPT-ESTIM-88                                  DTSBD350
02078 *        SET AATX-ESTIM-88             TO TRUE                    DTSBD350
02079 *    END-EVALUATE.                                                DTSBD350
02080 *                                                                 DTSBD350
02081 *                                                                 DTSBD350
02082 *    MOVE WRK-NULL-DOC-NO TO AATX-DOC-NO.                         DTSBD350
02083 *                                                                 DTSBD350
02084 *    SET AATX-ATX-88 TO TRUE.                                     DTSBD350
02085 *                                                                 DTSBD350
02086 *    MOVE MPRF-PRIMARY-NAME TO AATX-NAME-CHECK.                   DTSBD350
02087 *                                                                 DTSBD350
02088 *    MOVE MPRF-EMP-NO TO AATX-EMP-NO.                             DTSBD350
02089 *                                                                 DTSBD350
02090 *    MOVE WRK-YRQ       TO L004-QTR-5-9.                          DTSBD350
02091 *    MOVE 1             TO L004-QTR-5-Q.                          DTSBD350
02092 *    MOVE L004-QTR-5-9  TO AATX-YRQ.                              DTSBD350
02093 *                                                                 DTSBD350
02094 *    IF AATX-WITHDRW-88                                           DTSBD350
02095 *        PERFORM S1510-WITHDRW-FROM-AATX   THRU S1510-EXIT        DTSBD350
02096 *        PERFORM S1520-WITHDRAW-FROM-WAGE  THRU S1520-EXIT        DTSBD350
02097 *    ELSE                                                         DTSBD350
02098 *    IF AATX-ESTIM-88                                             DTSBD350
02099 *        MOVE MQTR-TOT-WAGE TO AATX-TOT-WAGE                      DTSBD350
02100 *        MOVE MQTR-EXCESS-WAGE TO AATX-EXCESS-WAGE                DTSBD350
02101 *        MOVE MQTR-TAX-WAGE TO AATX-TAX-WAGE                      DTSBD350
02102 *    ELSE                                                         DTSBD350
02103 *    IF AATX-ADMIN-CORR-88                                        DTSBD350
02104 *        MOVE +0 TO AATX-TOT-WAGE                                 DTSBD350
02105 *                   AATX-EXCESS-WAGE                              DTSBD350
02106 *                   AATX-TAX-WAGE.                                DTSBD350
02107 *                                                                 DTSBD350
02108 *    MOVE +0 TO AATX-REMIT-AMT.                                   DTSBD350
02109 *                                                                 DTSBD350
02110 *    SET AATX-WAIVE-BOTH-NO-88 TO TRUE.                           DTSBD350
02111 *                                                                 DTSBD350
02112 *    SET AATX-WAIVE-INT-NO-88 TO TRUE.                            DTSBD350
02113 *                                                                 DTSBD350
02114 *    SET AATX-WAIVE-LATE-PEN-NO-88 TO TRUE.                       DTSBD350
02115 *                                                                 DTSBD350
02116 *    SET AATX-TOTAL-NO-ENTRY-88 TO TRUE.                          DTSBD350
02117 *                                                                 DTSBD350
02118 *    SET AATX-JAN-NO-ENTRY-88 TO TRUE.                            DTSBD350
02119 *                                                                 DTSBD350
02120 *    SET AATX-FEB-NO-ENTRY-88 TO TRUE.                            DTSBD350
02121 *                                                                 DTSBD350
02122 *    SET AATX-MAR-NO-ENTRY-88 TO TRUE.                            DTSBD350
02123 *                                                                 DTSBD350
02124 *    SET AATX-APR-NO-ENTRY-88 TO TRUE.                            DTSBD350
02125 *                                                                 DTSBD350
02126 *    SET AATX-MAY-NO-ENTRY-88 TO TRUE.                            DTSBD350
02127 *                                                                 DTSBD350
02128 *    SET AATX-JUN-NO-ENTRY-88 TO TRUE.                            DTSBD350
02129 *                                                                 DTSBD350
02130 *    SET AATX-JUL-NO-ENTRY-88 TO TRUE.                            DTSBD350
02131 *                                                                 DTSBD350
02132 *    SET AATX-AUG-NO-ENTRY-88 TO TRUE.                            DTSBD350
02133 *                                                                 DTSBD350
02134 *    SET AATX-SEP-NO-ENTRY-88 TO TRUE.                            DTSBD350
02135 *                                                                 DTSBD350
02136 *    SET AATX-OCT-NO-ENTRY-88 TO TRUE.                            DTSBD350
02137 *                                                                 DTSBD350
02138 *    SET AATX-NOV-NO-ENTRY-88 TO TRUE.                            DTSBD350
02139 *                                                                 DTSBD350
02140 *    SET AATX-DEC-NO-ENTRY-88 TO TRUE.                            DTSBD350
02141 *                                                                 DTSBD350
02142 *    SET AATX-VERIFIED-NO-88 TO TRUE.                             DTSBD350
02143 *                                                                 DTSBD350
02144 *    MOVE LBCM-RECEIVED-DATE TO AATX-RECEIVED-DATE.               DTSBD350
02145 *                                                                 DTSBD350
02146 *    MOVE LBCM-DEPOSIT-DATE TO AATX-DEPOSIT-DATE.                 DTSBD350
02147 *                                                                 DTSBD350
02148 *    MOVE 'SYS' TO AATX-RESPONSIBLE-ACTIVITY.                     DTSBD350
02149 *                                                                 DTSBD350
02150 *    MOVE 'SYSTEM' TO AATX-RESPONSIBLE-OP-ID.                     DTSBD350
02151 *                                                                 DTSBD350
02152 *    MOVE 'N' TO AATX-DISREGARD-EDITS-IND.                        DTSBD350
02153 *                                                                 DTSBD350
02154 *    SET AATX-PASSED-FULL-EDITS-YES-88 TO TRUE.                   DTSBD350
02155 *                                                                 DTSBD350
02156 *    SET AATX-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
02157 *                                                                 DTSBD350
02158 *    MOVE WRK-YRQ        TO L004-QTR-5-9.                         DTSBD350
02159 *    IF L004-QTR-5-Q = 4                                          DTSBD350
02160 *       SET L501-EXT-TO-ACCT-88 TO TRUE                           DTSBD350
02161 *       PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT         DTSBD350
02162 *    END-IF.                                                      DTSBD350
02163 *                                                                 DTSBD350
02164 *S1500-EXIT.                                                      DTSBD350
02165 *    EXIT.                                                        DTSBD350
02166 *                                                                 DTSBD350
02167 *S1510-WITHDRW-FROM-AATX.                                         DTSBD350
02168 *&                                                                DTSBD350
02169 *    DISPLAY 'BD350 S1510 - 1 ' MPRF-EMP-NO '  ' WRK-YRQ.         DTSBD350
02170 *&                                                                DTSBD350
02171 *    IF WRK-FIND-WAGES-YES-88                                     DTSBD350
02172 *       PERFORM S1511-FIND-WAGES  THRU S1511-EXIT                 DTSBD350
02173 *    END-IF.                                                      DTSBD350
02174 *                                                                 DTSBD350
02175 *    MOVE ZERO                     TO WRK-TOT-WAGE                DTSBD350
02176 *                                     WRK-TAX-WAGE.               DTSBD350
02177 *                                                                 DTSBD350
02178 *    IF AATX-WITHDRW-88                                           DTSBD350
02179 *       PERFORM S1511-ANN-WAGE-SUM   THRU S1511-EXIT              DTSBD350
02180 *    ELSE                                                         DTSBD350
02181 *       PERFORM S1512-QTR-WAGE-SUM   THRU S1512-EXIT.             DTSBD350
02182 *                                                                 DTSBD350
02183 *&                                                                DTSBD350
02184 *    DISPLAY 'BD350 S1510 - 2 ' AATX-TOT-WAGE                     DTSBD350
02185 *       '  ' AATX-TAX-WAGE.                                       DTSBD350
02186 *&                                                                DTSBD350
02187 *    IF MQTR-TOT-WAGE = +0                                        DTSBD350
02188 *        NEXT SENTENCE                                            DTSBD350
02189 *    ELSE                                                         DTSBD350
02190 *        COMPUTE AATX-TOT-WAGE =                                  DTSBD350
02191 *           (AATX-TOT-WAGE + (MQTR-TOT-WAGE * -1)).               DTSBD350
02192 *                                                                 DTSBD350
02193 *    IF MQTR-EXCESS-WAGE = +0                                     DTSBD350
02194 *        NEXT SENTENCE                                            DTSBD350
02195 *    ELSE                                                         DTSBD350
02196 *        COMPUTE AATX-EXCESS-WAGE =                               DTSBD350
02197 *           (AATX-EXCESS-WAGE + (MQTR-EXCESS-WAGE * -1)).         DTSBD350
02198 *                                                                 DTSBD350
02199 *    IF MQTR-TAX-WAGE = +0                                        DTSBD350
02200 *        NEXT SENTENCE                                            DTSBD350
02201 *    ELSE                                                         DTSBD350
02202 *        COMPUTE AATX-TAX-WAGE =                                  DTSBD350
02203 *           ( AATX-TAX-WAGE + (MQTR-TAX-WAGE * -1)).              DTSBD350
02204 *                                                                 DTSBD350
02205 *&                                                                DTSBD350
02206 *    DISPLAY 'BD350 S1510 - 3 ' AATX-TOT-WAGE                     DTSBD350
02207 *       '  ' AATX-TAX-WAGE.                                       DTSBD350
02208 *&                                                                DTSBD350
02209 *    PERFORM S1512-QTR-WAGE-SUM   THRU S1512-EXIT.                DTSBD350
02210 *                                                                 DTSBD350
02211 *    EVALUATE TRUE                                                DTSBD350
02212 *      WHEN WRK-YRQ = WRK-QTR1                                    DTSBD350
02213 *         COMPUTE AATX-TOT-WAGE = WRK-QTR1-TOT-WAGE * -1          DTSBD350
02214 *         COMPUTE AATX-TAX-WAGE = WRK-QTR1-TAX-WAGE * -1          DTSBD350
02215 *                                                                 DTSBD350
02216 *      WHEN WRK-YRQ = WRK-QTR2                                    DTSBD350
02217 *         COMPUTE AATX-TOT-WAGE = WRK-QTR2-TOT-WAGE * -1          DTSBD350
02218 *         COMPUTE AATX-TAX-WAGE = WRK-QTR2-TAX-WAGE * -1          DTSBD350
02219 *                                                                 DTSBD350
02220 *      WHEN WRK-YRQ = WRK-QTR3                                    DTSBD350
02221 *         COMPUTE AATX-TOT-WAGE = WRK-QTR3-TOT-WAGE * -1          DTSBD350
02222 *         COMPUTE AATX-TAX-WAGE = WRK-QTR3-TAX-WAGE * -1          DTSBD350
02223 *                                                                 DTSBD350
02224 *      WHEN WRK-YRQ = WRK-QTR4                                    DTSBD350
02225 *         COMPUTE AATX-TOT-WAGE = WRK-QTR4-TOT-WAGE * -1          DTSBD350
02226 *         COMPUTE AATX-TAX-WAGE = WRK-QTR4-TAX-WAGE * -1          DTSBD350
02227 *                                                                 DTSBD350
02228 *    END-EVALUATE.                                                DTSBD350
02229 *                                                                 DTSBD350
02230 *    COMPUTE AATX-EXCESS-WAGE =                                   DTSBD350
02231 *      (AATX-TOT-WAGE - AATX-TAX-WAGE).                           DTSBD350
02232 *                                                                 DTSBD350
02233 *S1510-EXIT.                                                      DTSBD350
02234 *    EXIT.                                                        DTSBD350
02235 *                                                                 DTSBD350
02236 *S1511-FIND-WAGES.                                                DTSBD350
02237 *    SET L421-RPT-TYPE-SUPPL-88    TO TRUE.                       DTSBD350
02238 *    MOVE MPRF-EMP-NO              TO L421-EMP-NO.                DTSBD350
02239 *    MOVE WRK-QTR1                 TO L421-QTR1.                  DTSBD350
02240 *    MOVE WRK-QTR2                 TO L421-QTR2.                  DTSBD350
02241 *    MOVE WRK-QTR3                 TO L421-QTR3.                  DTSBD350
02242 *    MOVE WRK-QTR4                 TO L421-QTR4.                  DTSBD350
02243 *                                                                 DTSBD350
02244 *    PERFORM S421-FIND-WAGES       THRU S421-EXIT.                DTSBD350
02245 *                                                                 DTSBD350
02246 *S1511-EXIT.                                                      DTSBD350
02247 *    EXIT.                                                        DTSBD350
02248 *                                                                 DTSBD350
02249 *S1511-ANN-WAGE-SUM.                                              DTSBD350
02250 *    PERFORM                                                      DTSBD350
02251 *       VARYING SUB FROM +1 BY +1                                 DTSBD350
02252 *       UNTIL SUB > L421-WAGE-TBL-CNT                             DTSBD350
02253 *          ADD L421-QTR1-CURR-WAGE (SUB) TO WRK-TOT-WAGE          DTSBD350
02254 *          ADD L421-QTR1-TAX-WAGE (SUB)  TO WRK-TAX-WAGE          DTSBD350
02255 *          ADD L421-QTR2-CURR-WAGE (SUB) TO WRK-TOT-WAGE          DTSBD350
02256 *          ADD L421-QTR2-TAX-WAGE (SUB)  TO WRK-TAX-WAGE          DTSBD350
02257 *          ADD L421-QTR3-CURR-WAGE (SUB) TO WRK-TOT-WAGE          DTSBD350
02258 *          ADD L421-QTR3-TAX-WAGE (SUB)  TO WRK-TAX-WAGE          DTSBD350
02259 *          ADD L421-QTR4-CURR-WAGE (SUB) TO WRK-TOT-WAGE          DTSBD350
02260 *          ADD L421-QTR4-TAX-WAGE (SUB)  TO WRK-TAX-WAGE          DTSBD350
02261 *    END-PERFORM.                                                 DTSBD350
02262 *                                                                 DTSBD350
02263 *S1511-EXIT.                                                      DTSBD350
02264 *    EXIT.                                                        DTSBD350
02265 *                                                                 DTSBD350
02266 *S1512-QTR-WAGE-SUM.                                              DTSBD350
02267 *    PERFORM                                                      DTSBD350
02268 *      VARYING SUB FROM +1 BY +1                                  DTSBD350
02269 *      UNTIL SUB > L421-WAGE-TBL-CNT                              DTSBD350
02270 *         ADD L421-QTR1-CURR-WAGE (SUB) TO WRK-QTR1-TOT-WAGE      DTSBD350
02271 *         ADD L421-QTR1-TAX-WAGE (SUB)  TO WRK-QTR1-TAX-WAGE      DTSBD350
02272 *         ADD L421-QTR2-CURR-WAGE (SUB) TO WRK-QTR2-TOT-WAGE      DTSBD350
02273 *         ADD L421-QTR2-TAX-WAGE (SUB)  TO WRK-QTR2-TAX-WAGE      DTSBD350
02274 *         ADD L421-QTR3-CURR-WAGE (SUB) TO WRK-QTR3-TOT-WAGE      DTSBD350
02275 *         ADD L421-QTR3-TAX-WAGE (SUB)  TO WRK-QTR3-TAX-WAGE      DTSBD350
02276 *         ADD L421-QTR4-CURR-WAGE (SUB) TO WRK-QTR4-TOT-WAGE      DTSBD350
02277 *         ADD L421-QTR4-TAX-WAGE (SUB)  TO WRK-QTR4-TAX-WAGE      DTSBD350
02278 *    END-PERFORM.                                                 DTSBD350
02279 *                                                                 DTSBD350
02280 *&                                                                DTSBD350
02281 *    DISPLAY 'BD350 S1512 QTR 1 TOT ' WRK-QTR1-TOT-WAGE           DTSBD350
02282 *       '  QTR1 TAX ' WRK-QTR1-TAX-WAGE.                          DTSBD350
02283 *    DISPLAY '   QTR 2 TOT ' WRK-QTR2-TOT-WAGE                    DTSBD350
02284 *       '  QTR2 TAX ' WRK-QTR2-TAX-WAGE.                          DTSBD350
02285 *    DISPLAY '   QTR 3 TOT ' WRK-QTR3-TOT-WAGE                    DTSBD350
02286 *       '  QTR3 TAX ' WRK-QTR3-TAX-WAGE.                          DTSBD350
02287 *    DISPLAY '   QTR 4 TOT ' WRK-QTR4-TOT-WAGE                    DTSBD350
02288 *       '  QTR4 TAX ' WRK-QTR4-TAX-WAGE.                          DTSBD350
02289 *&                                                                DTSBD350
02290 *S1512-EXIT.                                                      DTSBD350
02291 *    EXIT.                                                        DTSBD350
02292 *                                                                 DTSBD350
02293 *S1520-WITHDRAW-FROM-WAGE.                                        DTSBD350
02294 *                                                                 DTSBD350
02295 ***  MOVE ZERO TO WRK-SEQ-NO.                                     DTSBD350
02296 *                                                                 DTSBD350
02297 *    PERFORM S1521-ADD-W001       THRU S1521-EXIT                 DTSBD350
02298 *       VARYING SUB FROM +1 BY +1                                 DTSBD350
02299 *       UNTIL SUB > L421-WAGE-TBL-CNT.                            DTSBD350
02300 *                                                                 DTSBD350
02301 *S1520-EXIT.                                                      DTSBD350
02302 *    EXIT.                                                        DTSBD350
02303 *                                                                 DTSBD350
02304 *S1521-ADD-W001.                                                  DTSBD350
02305 *    MOVE LOW-VALUES TO W001-REC.                                 DTSBD350
02306 *                                                                 DTSBD350
02307 *    MOVE LBCM-LAST-BATCH-NO TO W001-BATCH-NO.                    DTSBD350
02308 *                                                                 DTSBD350
02309 *    MOVE LBCM-LAST-USED-ITEM-NO TO W001-ITEM-NO.                 DTSBD350
02310 *    ADD +1                      TO W001-ITEM-NO.                 DTSBD350
02311 *                                                                 DTSBD350
02312 *    MOVE MPRF-EMP-NO TO W001-EMP-NO.                             DTSBD350
02313 *                                                                 DTSBD350
02314 *    MOVE L421-SSN (SUB) TO W001-SSN.                             DTSBD350
02315 *     SET W001-SSN-VALID-88   TO TRUE.                            DTSBD350
02316 *                                                                 DTSBD350
02317 *    MOVE SPACES              TO W001-NAME.                       DTSBD350
02318 *    SET W001-NAME-VALID-88   TO TRUE.                            DTSBD350
02319 *                                                                 DTSBD350
02320 *    MOVE LBCM-RECEIVED-DATE TO W001-RECEIVED-DATE.               DTSBD350
02321 *                                                                 DTSBD350
02322 *    MOVE LBCM-SYS-TIME      TO W001-RECEIVED-TIME.               DTSBD350
02323 *                                                                 DTSBD350
02324 *    MOVE 'SYSTEM'           TO W001-RESPONSIBLE-OP-ID.           DTSBD350
02325 *                                                                 DTSBD350
02326 *    SET W001-SOURCE-RPT-88        TO TRUE.                       DTSBD350
02327 **                                                                DTSBD350
02328 *    IF WRK-ANN-RPT-WTHDRW-ALL-88                                 DTSBD350
02329 *       PERFORM S1521A-WRITE-QTR1      THRU S1521A-EXIT           DTSBD350
02330 *       PERFORM S1521B-WRITE-QTR2      THRU S1521B-EXIT           DTSBD350
02331 *       PERFORM S1521C-WRITE-QTR3      THRU S1521C-EXIT           DTSBD350
02332 *       PERFORM S1521D-WRITE-QTR4      THRU S1521D-EXIT           DTSBD350
02333 *    ELSE                                                         DTSBD350
02334 *       EVALUATE TRUE                                             DTSBD350
02335 *         WHEN WRK-YRQ = WRK-QTR1                                 DTSBD350
02336 *            MOVE 1                     TO L004-QTR-5-Q           DTSBD350
02337 *            COMPUTE WRK-CURR-WAGE =                              DTSBD350
02338 *               (L421-QTR1-CURR-WAGE (SUB) * -1)                  DTSBD350
02339 *           PERFORM S1521A-WRITE        THRU S1521A-EXIT          DTSBD350
02340 *                                                                 DTSBD350
02341 *         WHEN WRK-YRQ = WRK-QTR2                                 DTSBD350
02342 *            MOVE 2                     TO L004-QTR-5-Q           DTSBD350
02343 *            COMPUTE WRK-CURR-WAGE =                              DTSBD350
02344 *               (L421-QTR2-CURR-WAGE (SUB) * -1)                  DTSBD350
02345 *           PERFORM S1521A-WRITE        THRU S1521A-EXIT          DTSBD350
02346 *                                                                 DTSBD350
02347 *         WHEN WRK-YRQ = WRK-QTR3                                 DTSBD350
02348 *            MOVE 3                     TO L004-QTR-5-Q           DTSBD350
02349 *            COMPUTE WRK-CURR-WAGE =                              DTSBD350
02350 *               (L421-QTR3-CURR-WAGE (SUB) * -1)                  DTSBD350
02351 *           PERFORM S1521A-WRITE        THRU S1521A-EXIT          DTSBD350
02352 *                                                                 DTSBD350
02353 *         WHEN WRK-YRQ = WRK-QTR4                                 DTSBD350
02354 *            MOVE 4                     TO L004-QTR-5-Q           DTSBD350
02355 *            COMPUTE WRK-CURR-WAGE =                              DTSBD350
02356 *               (L421-QTR4-CURR-WAGE (SUB) * -1)                  DTSBD350
02357 *           PERFORM S1521A-WRITE        THRU S1521A-EXIT          DTSBD350
02358 *       END-EVALUATE.                                             DTSBD350
02359 *    END-IF.                                                      DTSBD350
02360 *                                                                 DTSBD350
02361 *                                                                 DTSBD350
02362 *                                                                 DTSBD350
02363 *S1521-EXIT.                                                      DTSBD350
02364 *    EXIT.                                                        DTSBD350
02365 *                                                                 DTSBD350
02366 *S1521A-WRITE.                                                    DTSBD350
02367 *    MOVE WRK-CURR-WAGE                TO W001-WAGE-CHNG.         DTSBD350
02368 *    MOVE ZERO                         TO W001-CURR-WAGE          DTSBD350
02369 *                                         W001-TAX-WAGE           DTSBD350
02370 *                                         W001-PRIOR-WAGE.        DTSBD350
02371 *    SET W001-WAGE-VALID-88            TO TRUE.                   DTSBD350
02372 *    ADD +1                            TO WRK-SEQ-NO              DTSBD350
02373 *    MOVE WRK-SEQ-NO                   TO W001-SEQ-NO.            DTSBD350
02374 *    MOVE L004-QTR-5-9                 TO W001-YRQ.               DTSBD350
02375 *    MOVE W001-REC                     TO WSKL-REC.               DTSBD350
02376 *    PERFORM S983-WRITE                THRU S983-EXIT.            DTSBD350
02377 *                                                                 DTSBD350
02378 *S1521A-EXIT.                                                     DTSBD350
02379 *    EXIT.                                                        DTSBD350
02380 *                                                                 DTSBD350
02381 *S1600-GENERATE-AATX.                                             DTSBD350
02382 *&                                                                DTSBD350
02383 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02384 *       DISPLAY 'BD350 S1600 ' WRK-YRQ                            DTSBD350
02385 *          '  ANN IND ' WRK-ANN-RPT-TYPE-IND.                     DTSBD350
02386 *&                                                                DTSBD350
02387 ***********************************************************       DTSBD350
02388 ** GENERATE AN ADMINISTRATIVE CORRECTION ANNUAL REPORT            DTSBD350
02389 ** TO CORRECT THE UI RATE OR THE REPORT OR TAX DUE DATES.         DTSBD350
02390 ***********************************************************       DTSBD350
02391 *                                                                 DTSBD350
02392 *    MOVE LOW-VALUES TO ASKL-REC.                                 DTSBD350
02393 *                                                                 DTSBD350
02394 *    EVALUATE TRUE                                                DTSBD350
02395 *      WHEN WRK-ANN-RPT-WTHDRW-ALL-88                             DTSBD350
02396 *        SET AATX-WITHDRW-88           TO TRUE                    DTSBD350
02397 *                                                                 DTSBD350
02398 *      WHEN WRK-ANN-RPT-WTHDRW-QTR-88                             DTSBD350
02399 *        SET AATX-ADMIN-CORR-88        TO TRUE                    DTSBD350
02400 *                                                                 DTSBD350
02401 *      WHEN WRK-ANN-RPT-ADMIN-88                                  DTSBD350
02402 *        SET AATX-ADMIN-CORR-88        TO TRUE                    DTSBD350
02403 *                                                                 DTSBD350
02404 *      WHEN WRK-ANN-RPT-ESTIM-88                                  DTSBD350
02405 *        SET AATX-ESTIM-88             TO TRUE                    DTSBD350
02406 *    END-EVALUATE.                                                DTSBD350
02407 *                                                                 DTSBD350
02408 *                                                                 DTSBD350
02409 *    MOVE WRK-NULL-DOC-NO TO AATX-DOC-NO.                         DTSBD350
02410 *                                                                 DTSBD350
02411 *    SET AATX-ATX-88 TO TRUE.                                     DTSBD350
02412 *                                                                 DTSBD350
02413 *    MOVE MPRF-PRIMARY-NAME TO AATX-NAME-CHECK.                   DTSBD350
02414 *                                                                 DTSBD350
02415 *    MOVE MPRF-EMP-NO TO AATX-EMP-NO.                             DTSBD350
02416 *                                                                 DTSBD350
02417 *    MOVE WRK-YRQ TO AATX-YRQ.                                    DTSBD350
02418 *                                                                 DTSBD350
02419 *    IF WRK-ANN-RPT-WITHDRAW-88                                   DTSBD350
02420 *        PERFORM S1610-WITHDRW-FROM-AATX   THRU S1610-EXIT        DTSBD350
02421 *        PERFORM S1620-WITHDRAW-FROM-WAGE  THRU S1620-EXIT        DTSBD350
02422 *    ELSE                                                         DTSBD350
02423 *    IF AATX-ORIG-88 OR AATX-ESTIM-88                             DTSBD350
02424 *        MOVE MQTR-TOT-WAGE TO AATX-TOT-WAGE                      DTSBD350
02425 *        MOVE MQTR-EXCESS-WAGE TO AATX-EXCESS-WAGE                DTSBD350
02426 *        MOVE MQTR-TAX-WAGE TO AATX-TAX-WAGE                      DTSBD350
02427 *    ELSE                                                         DTSBD350
02428 *    IF AATX-ADMIN-CORR-88                                        DTSBD350
02429 *        MOVE +0 TO AATX-TOT-WAGE                                 DTSBD350
02430 *                   AATX-EXCESS-WAGE                              DTSBD350
02431 *                   AATX-TAX-WAGE.                                DTSBD350
02432 *                                                                 DTSBD350
02433 *    MOVE +0 TO AATX-REMIT-AMT.                                   DTSBD350
02434 *                                                                 DTSBD350
02435 *    SET AATX-WAIVE-BOTH-NO-88 TO TRUE.                           DTSBD350
02436 *                                                                 DTSBD350
02437 *    SET AATX-WAIVE-INT-NO-88 TO TRUE.                            DTSBD350
02438 *                                                                 DTSBD350
02439 *    SET AATX-WAIVE-LATE-PEN-NO-88 TO TRUE.                       DTSBD350
02440 *                                                                 DTSBD350
02441 *    SET AATX-TOTAL-NO-ENTRY-88 TO TRUE.                          DTSBD350
02442 *                                                                 DTSBD350
02443 *    SET AATX-JAN-NO-ENTRY-88 TO TRUE.                            DTSBD350
02444 *                                                                 DTSBD350
02445 *    SET AATX-FEB-NO-ENTRY-88 TO TRUE.                            DTSBD350
02446 *                                                                 DTSBD350
02447 *    SET AATX-MAR-NO-ENTRY-88 TO TRUE.                            DTSBD350
02448 *                                                                 DTSBD350
02449 *    SET AATX-APR-NO-ENTRY-88 TO TRUE.                            DTSBD350
02450 *                                                                 DTSBD350
02451 *    SET AATX-MAY-NO-ENTRY-88 TO TRUE.                            DTSBD350
02452 *                                                                 DTSBD350
02453 *    SET AATX-JUN-NO-ENTRY-88 TO TRUE.                            DTSBD350
02454 *                                                                 DTSBD350
02455 *    SET AATX-JUL-NO-ENTRY-88 TO TRUE.                            DTSBD350
02456 *                                                                 DTSBD350
02457 *    SET AATX-AUG-NO-ENTRY-88 TO TRUE.                            DTSBD350
02458 *                                                                 DTSBD350
02459 *    SET AATX-SEP-NO-ENTRY-88 TO TRUE.                            DTSBD350
02460 *                                                                 DTSBD350
02461 *    SET AATX-OCT-NO-ENTRY-88 TO TRUE.                            DTSBD350
02462 *                                                                 DTSBD350
02463 *    SET AATX-NOV-NO-ENTRY-88 TO TRUE.                            DTSBD350
02464 *                                                                 DTSBD350
02465 *    SET AATX-DEC-NO-ENTRY-88 TO TRUE.                            DTSBD350
02466 *                                                                 DTSBD350
02467 *    SET AATX-VERIFIED-NO-88 TO TRUE.                             DTSBD350
02468 *                                                                 DTSBD350
02469 *    MOVE LBCM-RECEIVED-DATE TO AATX-RECEIVED-DATE.               DTSBD350
02470 *                                                                 DTSBD350
02471 *    MOVE LBCM-DEPOSIT-DATE TO AATX-DEPOSIT-DATE.                 DTSBD350
02472 *                                                                 DTSBD350
02473 *    MOVE 'SYS' TO AATX-RESPONSIBLE-ACTIVITY.                     DTSBD350
02474 *                                                                 DTSBD350
02475 *    MOVE 'SYSTEM' TO AATX-RESPONSIBLE-OP-ID.                     DTSBD350
02476 *                                                                 DTSBD350
02477 *    MOVE 'N' TO AATX-DISREGARD-EDITS-IND.                        DTSBD350
02478 *                                                                 DTSBD350
02479 *    SET AATX-PASSED-FULL-EDITS-YES-88 TO TRUE.                   DTSBD350
02480 *                                                                 DTSBD350
02481 *    SET AATX-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
02482 *                                                                 DTSBD350
02483 *                                                                 DTSBD350
02484 *    SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
02485 *                                                                 DTSBD350
02486 *    PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
02487 *                                                                 DTSBD350
02488 *                                                                 DTSBD350
02489 *S1600-EXIT.                                                      DTSBD350
02490 *    EXIT.                                                        DTSBD350
02491 *    SKIP3                                                        DTSBD350
02492  S1700-REV-PENALTY.                                               DTSBD350
02493      MOVE LOW-VALUES TO ASKL-REC.                                 DTSBD350
02494                                                                   DTSBD350
02495      MOVE WRK-NULL-DOC-NO TO AADJ-DOC-NO.                         DTSBD350
02496                                                                   DTSBD350
02497      SET AADJ-ADJ-88 TO TRUE.                                     DTSBD350
02498                                                                   DTSBD350
02499      MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK.                   DTSBD350
02500                                                                   DTSBD350
02501      MOVE MPRF-EMP-NO TO AADJ-EMP-NO.                             DTSBD350
02502                                                                   DTSBD350
02503      SET AADJ-CHARGE-88   TO TRUE.                                DTSBD350
02504                                                                   DTSBD350
02505      COMPUTE AADJ-AMT =                                           DTSBD350
02506         (WRK-PEN-CHG * -1).                                       DTSBD350
02507                                                                   DTSBD350
02508      MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE.               DTSBD350
02509                                                                   DTSBD350
02510      MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE.                 DTSBD350
02511                                                                   DTSBD350
02512      MOVE WRK-YRQ TO AADJ-APPLIC-YRQ.                             DTSBD350
02513                                                                   DTSBD350
02514      SET AADJ-LATE-PEN-88  TO TRUE.                               DTSBD350
02515                                                                   DTSBD350
02516      MOVE WRK-NULL-DOC-NO TO AADJ-APPLIC-DOC-NO.                  DTSBD350
02517                                                                   DTSBD350
02518      MOVE +0 TO AADJ-DATE-1                                       DTSBD350
02519                 AADJ-DATE-2.                                      DTSBD350
02520                                                                   DTSBD350
02521      MOVE SPACE TO AADJ-INT-SPAN-IND.                             DTSBD350
02522                                                                   DTSBD350
02523      MOVE ZERO           TO AADJ-INT-RATE.                        DTSBD350
02524                                                                   DTSBD350
02525      MOVE 'N' TO AADJ-DISREGARD-EDITS-IND.                        DTSBD350
02526                                                                   DTSBD350
02527      MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY.                     DTSBD350
02528                                                                   DTSBD350
02529      MOVE ZERO     TO AADJ-CMP-ESTB-ABSTIME.                      DTSBD350
02530                                                                   DTSBD350
02531      MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID.                     DTSBD350
02532                                                                   DTSBD350
02533      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSBD350
02534                                                                   DTSBD350
02535                                                                   DTSBD350
02536      SET L501-EXT-TO-ACCT-88 TO TRUE.                             DTSBD350
02537                                                                   DTSBD350
02538      PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT.           DTSBD350
02539 *&                                                                DTSBD350
02540         MOVE AADJ-AMT     TO AMT-DISP1                            DTSBD350
02541         DISPLAY 'BD350 S1700 ' MPRF-EMP-NO '  ' WRK-YRQ           DTSBD350
02542            '  ' AMT-DISP1.                                        DTSBD350
02543 *&                                                                DTSBD350
02544  S1700-EXIT.                                                      DTSBD350
02545      EXIT.                                                        DTSBD350
02546      SKIP3                                                        DTSBD350
02547  S2100-CURR-RPT-TYPE.                                             DTSBD350
02548 *&                                                                DTSBD350
02549 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02550         DISPLAY 'BD350 S2100 ' WRK-YRQ                            DTSBD350
02551           '  TYPE ' MQTR-CURR-RPT-TYPE                            DTSBD350
02552           '  LIAB ' L516-LIABLE-IND                               DTSBD350
02553           '  IND ' WRK-ANN-DELINQ-IND.                            DTSBD350
02554 *&                                                                DTSBD350
02555 **   IF L516-NOT-LIABLE-88                                        DTSBD350
02556 *       IF L516-ANN-SCHED-88                                      DTSBD350
02557 *       AND L516-ANN-LIABLE-88                                    DTSBD350
02558 *          SET MQTR-CURR-ORIG-ANN-NL-88  TO TRUE                  DTSBD350
02559 *       ELSE                                                      DTSBD350
02560 *          SET MQTR-CURR-NOT-LIABLE-88 TO TRUE                    DTSBD350
02561 **      END-IF                                                    DTSBD350
02562      IF L516-NOT-LIABLE-88                                        DTSBD350
02563            SET MQTR-CURR-NOT-LIABLE-88 TO TRUE                    DTSBD350
02564      ELSE                                                         DTSBD350
02565          IF MQTR-RPT-DUE-DATE = WRK-L004-QTR-DUE-DATE             DTSBD350
02566              IF WRK-YRQ > WRK-LAST-DEL-MAIL-YRQ                   DTSBD350
02567                  SET MQTR-CURR-NOT-DUE-88 TO TRUE                 DTSBD350
02568              ELSE                                                 DTSBD350
02569                  SET MQTR-CURR-DELINQ-88 TO TRUE                  DTSBD350
02570          ELSE                                                     DTSBD350
02571              IF MQTR-RPT-DUE-DATE > LBCM-CURR-RUN-DATE            DTSBD350
02572                  SET MQTR-CURR-NOT-DUE-88 TO TRUE                 DTSBD350
02573                  MOVE MQTR-RPT-DUE-DATE TO WRK-TRIGGER-DATE       DTSBD350
02574                  PERFORM S3000-ESTB-MTCK THRU S3000-EXIT          DTSBD350
02575              ELSE                                                 DTSBD350
02576                  SET MQTR-CURR-DELINQ-88 TO TRUE.                 DTSBD350
02577                                                                   DTSBD350
02578      IF L516-ANN-SCHED-88                                         DTSBD350
02579         IF MQTR-CURR-DELINQ-88                                    DTSBD350
02580            SET WRK-ANN-DELINQ-YES-88     TO TRUE                  DTSBD350
02581         END-IF                                                    DTSBD350
02582      END-IF.                                                      DTSBD350
02583 *&                                                                DTSBD350
02584 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02585         DISPLAY 'BD350 S2100 ' WRK-YRQ                            DTSBD350
02586           '  TYPE ' MQTR-CURR-RPT-TYPE                            DTSBD350
02587           '  IND ' WRK-ANN-DELINQ-IND.                            DTSBD350
02588 *&                                                                DTSBD350
02589  S2100-EXIT.                                                      DTSBD350
02590      EXIT.                                                        DTSBD350
02591      EJECT                                                        DTSBD350
02592  S2200-PURSUED-RPT-IND.                                           DTSBD350
02593 *&                                                                DTSBD350
02594 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02595         DISPLAY 'BD350 S2200 ' WRK-YRQ                            DTSBD350
02596           '  YEAR ' WRK-PURSUED-YEAR                              DTSBD350
02597           '  CNT ' MPRF-PURSUED-RPT-CNT                           DTSBD350
02598           '  PRS ' MQTR-PURSUED-RPT-IND                           DTSBD350
02599           '  IND ' WRK-ANN-DELINQ-IND.                            DTSBD350
02600 *&                                                                DTSBD350
02601                                                                   DTSBD350
02602      IF L516-ANN-SCHED-88                                         DTSBD350
02603         MOVE MQTR-YRQ    TO WRK-ANN-YRQ                           DTSBD350
02604         IF WRK-ANN-YRQ-YR = WRK-PURSUED-YEAR                      DTSBD350
02605         AND WRK-ANN-YRQ-Q = 4                                     DTSBD350
02606            PERFORM S2210-DECR-PURSUED-CNT THRU S2210-EXIT         DTSBD350
02607         END-IF                                                    DTSBD350
02608      ELSE                                                         DTSBD350
02609         PERFORM S2210-DECR-PURSUED-CNT       THRU S2210-EXIT      DTSBD350
02610      END-IF.                                                      DTSBD350
02611                                                                   DTSBD350
02612 **   IF L516-ANN-SCHED-88                                         DTSBD350
02613 *       MOVE MQTR-YRQ    TO WRK-ANN-YRQ                           DTSBD350
02614 *       IF WRK-ANN-YRQ-YR = WRK-PURSUED-YEAR                      DTSBD350
02615 *          NEXT SENTENCE                                          DTSBD350
02616 *       ELSE                                                      DTSBD350
02617 *          PERFORM S2210-DECR-PURSUED-CNT THRU S2210-EXIT         DTSBD350
02618 *       END-IF                                                    DTSBD350
02619 *    ELSE                                                         DTSBD350
02620 *       PERFORM S2210-DECR-PURSUED-CNT THRU S2210-EXIT            DTSBD350
02621 **   END-IF.                                                      DTSBD350
02622                                                                   DTSBD350
02623      MOVE MQTR-PURSUED-RPT-IND TO WRK-PURSUED-RPT-IND.            DTSBD350
02624                                                                   DTSBD350
02625      SET MQTR-RPT-NOT-PURSUED-88 TO TRUE.                         DTSBD350
02626                                                                   DTSBD350
02627      IF (MPRF-NOT-WRITTEN-OFF-88)                                 DTSBD350
02628                AND                                                DTSBD350
02629         (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88)               DTSBD350
02630                AND                                                DTSBD350
02631         (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ)               DTSBD350
02632          SET MQTR-RPT-IS-PURSUED-88 TO TRUE.                      DTSBD350
02633                                                                   DTSBD350
02634      IF L516-ANN-SCHED-88                                         DTSBD350
02635         IF WRK-ANN-DELINQ-YES-88                                  DTSBD350
02636            IF WRK-ANN-YRQ-YR = WRK-PURSUED-YEAR                   DTSBD350
02637            AND WRK-ANN-YRQ-Q = 4                                  DTSBD350
02638            PERFORM S2220-INCR-PURSUED-CNT  THRU S2220-EXIT        DTSBD350
02639         END-IF                                                    DTSBD350
02640      ELSE                                                         DTSBD350
02641         PERFORM S2220-INCR-PURSUED-CNT     THRU S2220-EXIT        DTSBD350
02642      END-IF.                                                      DTSBD350
02643                                                                   DTSBD350
02644 **   IF L516-ANN-SCHED-88                                         DTSBD350
02645 *       MOVE MQTR-YRQ             TO WRK-ANN-YRQ                  DTSBD350
02646 *       IF WRK-ANN-YRQ-YR = WRK-PURSUED-YEAR                      DTSBD350
02647 *          NEXT SENTENCE                                          DTSBD350
02648 *       ELSE                                                      DTSBD350
02649 *          PERFORM S2220-INCR-PURSUED-CNT  THRU S2220-EXIT        DTSBD350
02650 *       END-IF                                                    DTSBD350
02651 *    ELSE                                                         DTSBD350
02652 *       PERFORM S2220-INCR-PURSUED-CNT  THRU S2220-EXIT           DTSBD350
02653 **   END-IF.                                                      DTSBD350
02654                                                                   DTSBD350
02655      IF L516-ANN-SCHED-88                                         DTSBD350
02656         MOVE WRK-ANN-YRQ-YR  TO WRK-PURSUED-YEAR.                 DTSBD350
02657                                                                   DTSBD350
02658 *&                                                                DTSBD350
02659 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02660         DISPLAY 'BD350 S2200 ' WRK-YRQ                            DTSBD350
02661           '  YEAR ' WRK-PURSUED-YEAR                              DTSBD350
02662           '  CNT ' MPRF-PURSUED-RPT-CNT                           DTSBD350
02663           '  PRS ' MQTR-PURSUED-RPT-IND                           DTSBD350
02664           '  IND ' WRK-ANN-DELINQ-IND.                            DTSBD350
02665 *&                                                                DTSBD350
02666  S2200-EXIT.                                                      DTSBD350
02667      EXIT.                                                        DTSBD350
02668                                                                   DTSBD350
02669  S2210-DECR-PURSUED-CNT.                                          DTSBD350
02670      IF MPRF-PURSUED-RPT-CNT = 0                                  DTSBD350
02671         NEXT SENTENCE                                             DTSBD350
02672      ELSE                                                         DTSBD350
02673         IF MQTR-RPT-IS-PURSUED-88                                 DTSBD350
02674            SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT                   DTSBD350
02675         END-IF                                                    DTSBD350
02676      END-IF.                                                      DTSBD350
02677                                                                   DTSBD350
02678  S2210-EXIT.                                                      DTSBD350
02679      EXIT.                                                        DTSBD350
02680                                                                   DTSBD350
02681  S2220-INCR-PURSUED-CNT.                                          DTSBD350
02682 *&                                                                DTSBD350
02683 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02684 *       DISPLAY 'BD350 S2220 ' WRK-YRQ                            DTSBD350
02685 *         '  CNT ' MPRF-PURSUED-RPT-CNT                           DTSBD350
02686 *         '  WRK ' WRK-PURSUED-RPT-IND                            DTSBD350
02687 *         '  IND ' MQTR-PURSUED-RPT-IND.                          DTSBD350
02688 *&                                                                DTSBD350
02689      IF MQTR-RPT-IS-PURSUED-88                                    DTSBD350
02690         ADD +1 TO MPRF-PURSUED-RPT-CNT                            DTSBD350
02691      END-IF.                                                      DTSBD350
02692                                                                   DTSBD350
02693      IF (WRK-PURSUED-RPT-IND = 'N')                               DTSBD350
02694      AND (MQTR-RPT-IS-PURSUED-88)                                 DTSBD350
02695         PERFORM S590-QTR-PURSUED THRU S590-EXIT                   DTSBD350
02696      END-IF.                                                      DTSBD350
02697                                                                   DTSBD350
02698 *&                                                                DTSBD350
02699 *    IF MPRF-EMP-NO = 085854                                      DTSBD350
02700 *       DISPLAY 'BD350 S2220 ' WRK-YRQ                            DTSBD350
02701 *         '  CNT ' MPRF-PURSUED-RPT-CNT                           DTSBD350
02702 *         '  IND ' MQTR-PURSUED-RPT-IND.                          DTSBD350
02703 *&                                                                DTSBD350
02704  S2220-EXIT.                                                      DTSBD350
02705      EXIT.                                                        DTSBD350
02706      EJECT                                                        DTSBD350
02707  S3000-ESTB-MTCK.                                                 DTSBD350
02708      MOVE LOW-VALUES TO MTCK-REC.                                 DTSBD350
02709                                                                   DTSBD350
02710                                                                   DTSBD350
02711      MOVE MPRF-EMP-NO TO MTCK-EMP-NO.                             DTSBD350
02712                                                                   DTSBD350
02713      SET MTCK-TCK-88 TO TRUE.                                     DTSBD350
02714                                                                   DTSBD350
02715      ADD +1 TO LBCM-EMP-ABSTIME.                                  DTSBD350
02716                                                                   DTSBD350
02717      MOVE LBCM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME.                  DTSBD350
02718                                                                   DTSBD350
02719      MOVE +0 TO MTCK-PURGE-DATE.                                  DTSBD350
02720                                                                   DTSBD350
02721      MOVE +0 TO MTCK-TEXT-CNT.                                    DTSBD350
02722                                                                   DTSBD350
02723      SET MTCK-TYPE-CHK-LATE-88 TO TRUE.                           DTSBD350
02724                                                                   DTSBD350
02725      MOVE WRK-TRIGGER-DATE TO MTCK-TRIGGER-DATE.                  DTSBD350
02726                                                                   DTSBD350
02727      MOVE +0 TO MTCK-ACKNOWLEDGED-DATE.                           DTSBD350
02728                                                                   DTSBD350
02729      SET MTCK-SOURCE-SYSTEM-88 TO TRUE.                           DTSBD350
02730                                                                   DTSBD350
02731      SET MTCK-DEST-SYSTEM-88 TO TRUE.                             DTSBD350
02732                                                                   DTSBD350
02733      MOVE WRK-YRQ TO MTCK-LTE-YRQ.                                DTSBD350
02734                                                                   DTSBD350
02735      SET MTCK-NOT-CONVERTED-88 TO TRUE.                           DTSBD350
02736                                                                   DTSBD350
02737      MOVE LBCM-CURR-RUN-DATE TO MTCK-ESTB-DATE                    DTSBD350
02738                                 MTCK-CHNG-DATE.                   DTSBD350
02739                                                                   DTSBD350
02740                                                                   DTSBD350
02741      MOVE MTCK-REC TO MSKL-REC.                                   DTSBD350
02742                                                                   DTSBD350
02743      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBD350
02744  S3000-EXIT.                                                      DTSBD350
02745      EXIT.                                                        DTSBD350
02746      EJECT                                                        DTSBD350
02747  S001-FROM-FED-8.                                                 DTSBD350
02748      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD350
02749      GO TO S001-DATE.                                             DTSBD350
02750                                                                   DTSBD350
02751  S001-FROM-ABS-DAY.                                               DTSBD350
02752      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD350
02753      GO TO S001-DATE.                                             DTSBD350
02754                                                                   DTSBD350
02755  S001-DATE.                                                       DTSBD350
02756      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD350
02757  S001-EXIT.                                                       DTSBD350
02758      EXIT.                                                        DTSBD350
02759      SKIP3                                                        DTSBD350
02760  S004-FROM-5.                                                     DTSBD350
02761      SET L004-FROM-5 TO TRUE.                                     DTSBD350
02762      GO TO S004-QTR.                                              DTSBD350
02763                                                                   DTSBD350
02764  S004-FROM-ABS.                                                   DTSBD350
02765      SET L004-FROM-ABS TO TRUE.                                   DTSBD350
02766      GO TO S004-QTR.                                              DTSBD350
02767                                                                   DTSBD350
02768  S004-QTR.                                                        DTSBD350
02769      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD350
02770  S004-EXIT.                                                       DTSBD350
02771      EXIT.                                                        DTSBD350
02772      SKIP3                                                        DTSBD350
02773                                                                   DTSBD350
02774  S410-FILING-SCHED.                                               DTSBD350
02775      CALL 'DTSBU410' USING L410-LINK-AREA.                        DTSBD350
02776  S410-EXIT.                                                       DTSBD350
02777      EXIT.                                                        DTSBD350
02778                                                                   DTSBD350
02779  S415-HOUSEHOLD-DATES.                                            DTSBD350
02780      CALL 'DTSBU415' USING L415-LINK-AREA.                        DTSBD350
02781  S415-EXIT.                                                       DTSBD350
02782      EXIT.                                                        DTSBD350
02783                                                                   DTSBD350
02784  S421-FIND-WAGES.                                                 DTSBD350
02785      CALL 'DTSBU421' USING L421-LINK-AREA.                        DTSBD350
02786  S421-EXIT.                                                       DTSBD350
02787      EXIT.                                                        DTSBD350
02788                                                                   DTSBD350
02789  S501-INTERNAL-ACCT-PROCESS.                                      DTSBD350
02790      CALL 'DTSBU501' USING L501-LINK-AREA                         DTSBD350
02791                            LBCM-LINK-AREA                         DTSBD350
02792                            MPRF-REC                               DTSBD350
02793                            ASKL-REC.                              DTSBD350
02794  S501-EXIT.                                                       DTSBD350
02795      EXIT.                                                        DTSBD350
02796      SKIP3                                                        DTSBD350
02797  S511-INITIALIZE-MQTR.                                            DTSBD350
02798      CALL 'DTSBU511' USING MQTR-REC.                              DTSBD350
02799  S511-EXIT.                                                       DTSBD350
02800      EXIT.                                                        DTSBD350
02801      SKIP3                                                        DTSBD350
02802  S590-QTR-PURSUED.                                                DTSBD350
02803      SET L590-QTR-PURSUED-88 TO TRUE.                             DTSBD350
02804      MOVE MQTR-YRQ TO L590-YRQ.                                   DTSBD350
02805      MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO                      DTSBD350
02806                              L590-TOL-DOC-NO.                     DTSBD350
02807      GO TO S590-EMP-CLEANUP.                                      DTSBD350
02808                                                                   DTSBD350
02809  S590-EMP-CLEANUP.                                                DTSBD350
02810      CALL 'DTSBU590' USING L590-LINK-AREA                         DTSBD350
02811                            LBCM-LINK-AREA                         DTSBD350
02812                            MPRF-REC.                              DTSBD350
02813  S590-EXIT.                                                       DTSBD350
02814      EXIT.                                                        DTSBD350
02815      SKIP3                                                        DTSBD350
02816  S516-LIABILITY-INFO.                                             DTSBD350
02817      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBD350
02818                            MPRF-REC.                              DTSBD350
02819  S516-EXIT.                                                       DTSBD350
02820      EXIT.                                                        DTSBD350
02821      SKIP3                                                        DTSBD350
02822  S910-READ.                                                       DTSBD350
02823      SET L910-READ-88 TO TRUE.                                    DTSBD350
02824      GO TO S910-MSTR-IO.                                          DTSBD350
02825                                                                   DTSBD350
02826  S910-START-BROWSE.                                               DTSBD350
02827      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD350
02828      GO TO S910-MSTR-IO.                                          DTSBD350
02829                                                                   DTSBD350
02830  S910-READ-NEXT.                                                  DTSBD350
02831      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD350
02832      GO TO S910-MSTR-IO.                                          DTSBD350
02833                                                                   DTSBD350
02834 *S910-COUNT.                                                      DTSBD350
02835 *****SET L910-COUNT-88 TO TRUE.                                   DTSBD350
02836 *****GO TO S910-MSTR-IO.                                          DTSBD350
02837                                                                   DTSBD350
02838  S910-WRITE.                                                      DTSBD350
02839      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD350
02840      SET L910-WRITE-88 TO TRUE.                                   DTSBD350
02841      GO TO S910-MSTR-IO.                                          DTSBD350
02842                                                                   DTSBD350
02843  S910-REWRITE.                                                    DTSBD350
02844      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD350
02845      SET L910-REWRITE-88 TO TRUE.                                 DTSBD350
02846      GO TO S910-MSTR-IO.                                          DTSBD350
02847                                                                   DTSBD350
02848  S910-DELETE.                                                     DTSBD350
02849      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD350
02850      SET L910-DELETE-88 TO TRUE.                                  DTSBD350
02851      GO TO S910-MSTR-IO.                                          DTSBD350
02852                                                                   DTSBD350
02853  S910-MSTR-IO.                                                    DTSBD350
02854      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD350
02855                            MSKL-REC.                              DTSBD350
02856  S910-EXIT.                                                       DTSBD350
02857      EXIT.                                                        DTSBD350
02858      SKIP3                                                        DTSBD350
02859 *S921-READ.                                                       DTSBD350
02860 *****SET L921-READ-88 TO TRUE.                                    DTSBD350
02861 *****GO TO S921-AIX-IO.                                           DTSBD350
02862                                                                   DTSBD350
02863  S921-START-BROWSE.                                               DTSBD350
02864      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD350
02865      GO TO S921-AIX-IO.                                           DTSBD350
02866                                                                   DTSBD350
02867 *S921-READ-NEXT.                                                  DTSBD350
02868 *****SET L921-READ-NEXT-88 TO TRUE.                               DTSBD350
02869 *****GO TO S921-AIX-IO.                                           DTSBD350
02870                                                                   DTSBD350
02871  S921-AIX-IO.                                                     DTSBD350
02872      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD350
02873                            ISKL-REC.                              DTSBD350
02874  S921-EXIT.                                                       DTSBD350
02875      EXIT.                                                        DTSBD350
02876      SKIP3                                                        DTSBD350
02877  S946-R907-WRITE.                                                 DTSBD350
02878      CALL 'DTSBU946' USING R907-REC.                              DTSBD350
02879  S946-EXIT.                                                       DTSBD350
02880      EXIT.                                                        DTSBD350
02881      SKIP3                                                        DTSBD350
02882  S983-WRITE.                                                      DTSBD350
02883      SET L983-WRITE-88     TO TRUE.                               DTSBD350
02884      GO TO S983-WAGE-O.                                           DTSBD350
02885                                                                   DTSBD350
02886  S983-WAGE-O.                                                     DTSBD350
02887      CALL 'DTSBU983' USING L983-LINK-AREA                         DTSBD350
02888                            WSKL-REC.                              DTSBD350
02889  S983-EXIT.                                                       DTSBD350
02890      EXIT.                                                        DTSBD350
02891      SKIP3                                                        DTSBD350
02892                                                                   DTSBD350
02893  S999-ABEND.                                                      DTSBD350
02894      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD350
02895  S999-EXIT.                                                       DTSBD350
02896      EXIT.                                                        DTSBD350
