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