2898 lines
229 KiB
COBOL
2898 lines
229 KiB
COBOL
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
|