3941 lines
312 KiB
COBOL
3941 lines
312 KiB
COBOL
00001 IDENTIFICATION DIVISION. 10/17/24
|
|
00002 PROGRAM-ID. DTSBE770. DTSBE770
|
|
00003 AUTHOR. TRW. LV031
|
|
00004 DATE-WRITTEN. DECEMBER 2002. DTSBE770
|
|
00005 DATE-COMPILED. DTSBE770
|
|
00006 SKIP3 DTSBE770
|
|
00007 ***** DTSBE770
|
|
00008 * DTSBE770
|
|
00009 * FUNCTION: EXTRACT DATA FOR ETA581 DATA VALIDATION PROCESS. DTSBE770
|
|
00010 * DTSBE770
|
|
00011 * DTSBE770
|
|
00012 * MODIFICATION LOG: DTSBE770
|
|
00013 * DTSBE770
|
|
00014 * 10/25/2002 INITIAL DEVELOPMENT. DTSBE770
|
|
00015 * REFERENCE: DATA VALIDATION PROGRAMMER: GD DTSBE770
|
|
00016 * DTSBE770
|
|
00017 * 01/08/2003 PARAGRAPH P5000 COMPILES DATA ABOUT EMPLOYER DTSBE770
|
|
00018 * AUDITS FOR THE ETA581 REPORT AND WRITES DTSIY775 DTSBE770
|
|
00019 * OUTPUT RECORDS FOR EACH AUDIT SELECTED. DTSBE770
|
|
00020 * REFERENCE: PROGRAMMER: RW1 DTSBE770
|
|
00021 * DTSBE770
|
|
00022 * 05/27/2003 MODIFIED P1000 TO COMPLY WITH CHANGED DTSBE770
|
|
00023 * DEFINITIONS OF LIABILITY DATE AND REOPEN DATE DTSBE770
|
|
00024 * IN DOL DOCUMENTATION DATED 5/22/2003. DTSBE770
|
|
00025 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00026 * DTSBE770
|
|
00027 * 05/13/2005 MODIFIED I2600 TO SET THE DELINQUENCY DATE DTSBE770
|
|
00028 * BASED ON QTR1 INSTEAD OF QTR2. IT SHOULD BE DTSBE770
|
|
00029 * THE DELINQUENCY DATE OF THE QUARTER PRIOR TO DTSBE770
|
|
00030 * THE SUBJECT QUARTER. DTSBE770
|
|
00031 * REFERENCE: CORRECT ERROR PROGRAMMER: GD DTSBE770
|
|
00032 * DTSBE770
|
|
00033 * 05/15/2008 MODIFIED P1000: EXIT IF NOT REPORTS FILED DTSBE770
|
|
00034 * DURING THE 8 QUARTER PERIOD. DTSBE770
|
|
00035 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00036 * DTSBE770
|
|
00037 * 05/16/2008 MODIFIED P3310: USE REACTIVATION ENTERED DTSBE770
|
|
00038 * DATE FOR THE ACTIVATION DATE FOR DTSBE770
|
|
00039 * REACTIVATIONS. USING THE ORIGINAL LIABILITY DTSBE770
|
|
00040 * ENTERED DATE PRODUCES ERROR IN THE DATA DTSBE770
|
|
00041 * VALIDATION SOFTWARE. DTSBE770
|
|
00042 * SAME CHANGE MADE IN P3313 - INACT REVERSAL. DTSBE770
|
|
00043 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00044 * DTSBE770
|
|
00045 * 05/19/2008 MODIFIED P1200 AND P1210 - DELINQUENT DTSBE770
|
|
00046 * QUARTERS SHOULD BE COUNTED AS LIABLE. DTSBE770
|
|
00047 * IF A QUARTER IS NOT LIABLE, RESET THE COUNT DTSBE770
|
|
00048 * OF LIABLE QUARTERS TO ZERO - ONLY DTSBE770
|
|
00049 * CONSECUTIVELY LIABLE QUARTERS SHOULD BE DTSBE770
|
|
00050 * COUNTED. DTSBE770
|
|
00051 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00052 * DTSBE770
|
|
00053 * 05/20/2008 TEMPORARY CHANGE - FOR SUCCESSORS, USE DTSBE770
|
|
00054 * RELATIONSHIP EFF DATE AS ACTIVATION DATE. DTSBE770
|
|
00055 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00056 * DTSBE770
|
|
00057 * 07/11/2008 CORRECTION FOR AUDIT COUNTS: REMOVED CHECK DTSBE770
|
|
00058 * OF MPRF-MFAS-IND. A VALUE OF 'N' DOES NOT DTSBE770
|
|
00059 * MEAN THERE IS NO AUDIT ASSIGNMENT. DTSBE770
|
|
00060 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00061 * DTSBE770
|
|
00062 * 01/16/2008 CORRECTION FOR ITEM 12 - COUNT OF OUTSTANDING DTSBE770
|
|
00063 * QTRS. ESTIMATED QTRS SHOULD BE EXCLUDED DTSBE770
|
|
00064 * EXCEPT FOR THE QTR PRIOR TO THE SUBJECT QTR. DTSBE770
|
|
00065 * P9000. DTSBE770
|
|
00066 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00067 * DTSBE770
|
|
00068 * 03/31/2009 ADDED PROCESSING FOR TPS STATUS DATA. THIS DTSBE770
|
|
00069 * DATA WAS FORMERLY GENERATED BY DTSBE715. DTSBE770
|
|
00070 * THE EXTRACT WAS MOVED TO THE ETA-581/DATA DTSBE770
|
|
00071 * VALIDATIONPROCESS TO ENSURE CONSISTENCY DTSBE770
|
|
00072 * WITH THE ETA-581 DATA. DTSBE770
|
|
00073 * DTSBE770 WAS MODIFIED BY ADDING A NEW OUTPUT DTSBE770
|
|
00074 * FILE (TPS-STATUS-FILE), A NEW OUTPUT RECORD DTSBE770
|
|
00075 * (TPS-TRANS-REC), AND ADDITIONAL PROCESSING DTSBE770
|
|
00076 * ADDED TO P3900 TO WRITE THE TPS RECORDS. DTSBE770
|
|
00077 * A NEW PROGRAM, DTSBX777, PRODUCES THE DTSBE770
|
|
00078 * TPS REPORTS. DTSBE770
|
|
00079 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00080 * DTSBE770
|
|
00081 * 05/01/2009 MODIFIED PROCESS FOR STATUS COUNTS (P3000). DTSBE770
|
|
00082 * TIME LAPSE CALCULATION WAS INCORRECT FOR DTSBE770
|
|
00083 * REACTIVATIONS - CHANGED TO USE REOPEN DATE. DTSBE770
|
|
00084 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00085 * DTSBE770
|
|
00086 * 01/26/2010 BASED ON CLARIFICATION FROM DOL, REVERSAL DTSBE770
|
|
00087 * OF AN INACTIVATION IS NOT COUNTED AS DTSBE770
|
|
00088 * A DETERMINATION. DTSBE770
|
|
00089 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00090 * DTSBE770
|
|
00091 * 10/01/2010 ADDED CALL TO DTSBU430 TO RETURN COUNT OF DTSBE770
|
|
00092 * WAGE ITEMS (ITEM 5 ON ETA 581). DTSBE770
|
|
00093 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00094 * DTSBE770
|
|
00095 * 01/12/2011 REINSERTED PROCESS TO DEFAULT ANNUAL REPORTS. DTSBE770
|
|
00096 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00097 * DTSBE770
|
|
00098 * 02/11/2011 VARIOUS CHANGES TO POPULATION 2 TO CORRECT DTSBE770
|
|
00099 * ERRORS IN COUNTING ANNUAL FILERS. ANNUAL DTSBE770
|
|
00100 * COUNTS WILL NOW BE DEFAULTED FOR EVERY QUARTER. DTSBE770
|
|
00101 * THE DELINQUENCY RATE IS SO HIGH THE ACTUAL COUNT DTSBE770
|
|
00102 * RESULTS IN CROSS EDIT FAILURES IN THE SUN SYSTEM.DTSBE770
|
|
00103 * REFERENCE: PROGRAMMER: GD DTSBE770
|
|
00104 * DTSBE770
|
|
00105 * 04/15/2013 ADDED CODE TO P9100 TO EXTRACT SUTA DUMPING DTSBE770
|
|
00106 * NUMBERS. DTSBE770
|
|
00107 * REFERENCE: TICKET 1780 PROGRAMMER: GD DTSBE770
|
|
00108 * DTSBE770
|
|
00109 * 10/04/2013 CORRECTED P9120 TO SEARCH FOR UI TAX CHARGES DTSBE770
|
|
00110 * STARTING WITH THE EARLIEST DATE ON WHICH DTSBE770
|
|
00111 * A RATE WAS CHANGED. DTSBE770
|
|
00112 * REFERENCE: TICKET 2095 PROGRAMMER: GD DTSBE770
|
|
00113 * DTSBE770
|
|
00114 * 10/23/2013 CREATED A SINGLE PROCESS FOR PRODUCING THE DTSBE770
|
|
00115 * DEFAULT COUNT OF ANNUAL REPORTS. THE DTSBE770
|
|
00116 * PARAGRAPHS THAT PRODUCED NUMBERS FOR THE DTSBE770
|
|
00117 * 581 AND FOR DATA VALIDATION WERE SLIGHTLY DTSBE770
|
|
00118 * DIFFERENT, AND PRODUCED DIFFERENT RESULTS. DTSBE770
|
|
00119 * REFERENCE: TICKET 9999 PROGRAMMER: GD DTSBE770
|
|
00120 * DTSBE770
|
|
00121 * 06/11/2014 MODIFYING THE CALCULATION FOR PRE AND POST DTSBE770
|
|
00122 * AMOUNTS - PRIOR PROCESS MOVED ZERO WHEN THE DTSBE770
|
|
00123 * PRE AND POST AMOUNTS WERE THE SAME SHOULD BE DTSBE770
|
|
00124 * MOVING THE ORIGINAL AMOUNTS INSTEAD DTSBE770
|
|
00125 * REFERENCE: TICKET 9999 PROGRAMMER: NH DTSBE770
|
|
00126 * DTSBE770
|
|
00127 * 10/16/2024 MODIFYING CODE TO ADD NEW EMPLOYEE CNT TO CL*30
|
|
00128 * MISCLASIFIED WORKES ON ITEM52 ON ETA581 CL*30
|
|
00129 * REFERENCE: TICKET 9999 PROGRAMMER: ZL1 CL*30
|
|
00130 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE770
|
|
00131 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE770
|
|
00132 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE770
|
|
00133 * DTSBE770
|
|
00134 * DESCRIPTION: DTSBE770
|
|
00135 * DTSBE770
|
|
00136 * DTSBE770
|
|
00137 * INITIATION: DTSBE770
|
|
00138 * DTSBE770
|
|
00139 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE770
|
|
00140 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE770
|
|
00141 * DTSBE770
|
|
00142 * EDIT AND DEFAULT PARAMETERS. DTSBE770
|
|
00143 * DTSBE770
|
|
00144 * DTSBE770
|
|
00145 * PROCESSING: DTSBE770
|
|
00146 * DTSBE770
|
|
00147 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (DTSIX771) DTSBE770
|
|
00148 * DTSBE770
|
|
00149 * DTSBE770
|
|
00150 * TERMINATION: DTSBE770
|
|
00151 * DTSBE770
|
|
00152 * DTSBE770
|
|
00153 * DTSBE770
|
|
00154 * RECORDS READ: DTSBE770
|
|
00155 * DTSBE770
|
|
00156 * MASTER: DTSBE770
|
|
00157 * DTSBE770
|
|
00158 * MSOL DTSBE770
|
|
00159 * MQTR DTSBE770
|
|
00160 * DTSBE770
|
|
00161 * DTSBE770
|
|
00162 * ALTERNATE INDEX: DTSBE770
|
|
00163 * DTSBE770
|
|
00164 * NONE. DTSBE770
|
|
00165 * DTSBE770
|
|
00166 * DTSBE770
|
|
00167 * REFERENCE: DTSBE770
|
|
00168 * DTSBE770
|
|
00169 * DTSBE770
|
|
00170 * DTSBE770
|
|
00171 * RECORDS UPDATED: DTSBE770
|
|
00172 * DTSBE770
|
|
00173 * NONE DTSBE770
|
|
00174 * DTSBE770
|
|
00175 * DTSBE770
|
|
00176 * OUTPUT RECORDS WRITTEN: DTSBE770
|
|
00177 * DTSBE770
|
|
00178 * DTSIX771 POPULATION 1 DOWNLOAD DTSBE770
|
|
00179 * DTSBE770
|
|
00180 * DTSBE770
|
|
00181 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE770
|
|
00182 * DTSBE770
|
|
00183 * NONE. DTSBE770
|
|
00184 * DTSBE770
|
|
00185 * DTSBE770
|
|
00186 * MODULES CALLED: DTSBE770
|
|
00187 * DTSBE770
|
|
00188 * DTSBU001 DATE EDIT/CONVERSION. DTSBE770
|
|
00189 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBE770
|
|
00190 * DTSBU910 MASTER FILE I/O. DTSBE770
|
|
00191 * DTSBE770
|
|
00192 * DTSBE770
|
|
00193 * DTSBE770
|
|
00194 ***** DTSBE770
|
|
00195 SKIP3 DTSBE770
|
|
00196 ENVIRONMENT DIVISION. DTSBE770
|
|
00197 INPUT-OUTPUT SECTION. DTSBE770
|
|
00198 FILE-CONTROL. DTSBE770
|
|
00199 SELECT ETA581-PARM-FILE ASSIGN TO BE770PRM DTSBE770
|
|
00200 FILE STATUS IS BE770-STATUS. DTSBE770
|
|
00201 DTSBE770
|
|
00202 SELECT TPS-STATUS-QTR1 ASSIGN TO TPSSTAT1 DTSBE770
|
|
00203 FILE STATUS IS TPS-STAT-STATUS. DTSBE770
|
|
00204 DTSBE770
|
|
00205 SELECT TPS-STATUS-QTR2 ASSIGN TO TPSSTAT2 DTSBE770
|
|
00206 FILE STATUS IS TPS-STAT-STATUS. DTSBE770
|
|
00207 DTSBE770
|
|
00208 SELECT TPS-STATUS-QTR3 ASSIGN TO TPSSTAT3 DTSBE770
|
|
00209 FILE STATUS IS TPS-STAT-STATUS. DTSBE770
|
|
00210 DTSBE770
|
|
00211 SELECT TPS-STATUS-QTR4 ASSIGN TO TPSSTAT4 DTSBE770
|
|
00212 FILE STATUS IS TPS-STAT-STATUS. DTSBE770
|
|
00213 DTSBE770
|
|
00214 DATA DIVISION. DTSBE770
|
|
00215 FILE SECTION. DTSBE770
|
|
00216 FD ETA581-PARM-FILE DTSBE770
|
|
00217 RECORDING MODE IS F DTSBE770
|
|
00218 LABEL RECORDS ARE STANDARD DTSBE770
|
|
00219 BLOCK CONTAINS 0 CHARACTERS. DTSBE770
|
|
00220 DTSBE770
|
|
00221 01 ETA581-PARM-REC. DTSBE770
|
|
00222 ++INCLUDE DTSIX770 DTSBE770
|
|
00223 DTSBE770
|
|
00224 FD TPS-STATUS-QTR1 DTSBE770
|
|
00225 RECORDING MODE IS F DTSBE770
|
|
00226 LABEL RECORDS ARE STANDARD DTSBE770
|
|
00227 BLOCK CONTAINS 0 CHARACTERS. DTSBE770
|
|
00228 DTSBE770
|
|
00229 01 TPS-STATUS-QTR1-REC PIC X(56). DTSBE770
|
|
00230 DTSBE770
|
|
00231 FD TPS-STATUS-QTR2 DTSBE770
|
|
00232 RECORDING MODE IS F DTSBE770
|
|
00233 LABEL RECORDS ARE STANDARD DTSBE770
|
|
00234 BLOCK CONTAINS 0 CHARACTERS. DTSBE770
|
|
00235 DTSBE770
|
|
00236 01 TPS-STATUS-QTR2-REC PIC X(56). DTSBE770
|
|
00237 DTSBE770
|
|
00238 FD TPS-STATUS-QTR3 DTSBE770
|
|
00239 RECORDING MODE IS F DTSBE770
|
|
00240 LABEL RECORDS ARE STANDARD DTSBE770
|
|
00241 BLOCK CONTAINS 0 CHARACTERS. DTSBE770
|
|
00242 DTSBE770
|
|
00243 01 TPS-STATUS-QTR3-REC PIC X(56). DTSBE770
|
|
00244 DTSBE770
|
|
00245 FD TPS-STATUS-QTR4 DTSBE770
|
|
00246 RECORDING MODE IS F DTSBE770
|
|
00247 LABEL RECORDS ARE STANDARD DTSBE770
|
|
00248 BLOCK CONTAINS 0 CHARACTERS. DTSBE770
|
|
00249 DTSBE770
|
|
00250 01 TPS-STATUS-QTR4-REC PIC X(56). DTSBE770
|
|
00251 DTSBE770
|
|
00252 WORKING-STORAGE SECTION. DTSBE770
|
|
002525 77 PAN-VALET PICTURE X(24) VALUE '031DTSBE770 10/17/24'. DTSBE770
|
|
00253 77 PAN-VALET PICTURE X(24) VALUE '012DTSBE770 07/28/14'. DTSBE770
|
|
00254 77 PAN-VALET PICTURE X(24) VALUE '026DTSBE770 04/10/14'. DTSBE770
|
|
00255 77 PAN-VALET PICTURE X(24) VALUE '009DTSBE770 04/06/14'. DTSBE770
|
|
00256 77 PAN-VALET PICTURE X(24) VALUE '024DTSBE770 12/02/13'. DTSBE770
|
|
00257 77 PAN-VALET PICTURE X(24) VALUE '004DTSBE770 10/28/13'. DTSBE770
|
|
00258 77 PAN-VALET PICTURE X(24) VALUE '022DTSBE770 10/08/13'. DTSBE770
|
|
00259 77 PAN-VALET PICTURE X(24) VALUE '008DTSBE770 10/04/13'. DTSBE770
|
|
00260 77 PAN-VALET PICTURE X(24) VALUE '020DTSBE770 06/19/13'. DTSBE770
|
|
00261 77 PAN-VALET PICTURE X(24) VALUE '013DTSBE770 05/17/13'. DTSBE770
|
|
00262 SKIP3 DTSBE770
|
|
00263 01 WRK-AREA. DTSBE770
|
|
00264 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +770.DTSBE770
|
|
00265 DTSBE770
|
|
00266 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE770'.DTSBE770
|
|
00267 DTSBE770
|
|
00268 05 ABEND-MSG PIC X(60). DTSBE770
|
|
00269 DTSBE770
|
|
00270 05 BE770-STATUS PIC X(02). DTSBE770
|
|
00271 88 BE770-STATUS-OK-88 VALUE '00'. DTSBE770
|
|
00272 05 TPS-STAT-STATUS PIC X(02). DTSBE770
|
|
00273 88 TPS-STAT-STATUS-OK-88 VALUE '00'. DTSBE770
|
|
00274 DTSBE770
|
|
00275 05 WRK-0-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00276 05 WRK-NOT-LIAB-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00277 05 WRK-DELINQ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00278 05 WRK-ACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00279 05 WRK-TOT-RPT-RCVD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00280 DTSBE770
|
|
00281 05 WRK-SUBJECT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00282 05 WRK-RPT-QTR PIC 9(05) VALUE ZERO. DTSBE770
|
|
00283 05 FILLER REDEFINES WRK-RPT-QTR. DTSBE770
|
|
00284 10 WRK-RPT-QTR-CCYY PIC 9(04). DTSBE770
|
|
00285 10 WRK-RPT-QTR-Q PIC 9(01). DTSBE770
|
|
00286 05 WRK-SUBJECT-QTR-START PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00287 05 WRK-SUBJECT-QTR-END PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00288 05 WRK-QTR PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00289 05 WRK-QTR-START PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00290 05 WRK-QTR-END PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00291 05 WRK-ANN-START PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00292 05 WRK-ANN-END PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00293 05 WRK-ANN-DUE-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00294 05 WRK-FIRST-ANN-QTR PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00295 05 WRK-LAST-ANN-QTR PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00296 05 WRK-MRPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00297 05 WRK-ANN-TIMELY-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00298 05 WRK-ANN-SECURED-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00299 DTSBE770
|
|
00300 05 WRK-PARM-TIMING-EDITS-IND PIC X(01). DTSBE770
|
|
00301 88 WRK-PARM-TIMING-EDITS-YES-88 VALUE 'Y'. DTSBE770
|
|
00302 88 WRK-PARM-TIMING-EDITS-NO-88 VALUE 'N'. DTSBE770
|
|
00303 DTSBE770
|
|
00304 SKIP3 DTSBE770
|
|
00305 05 WRK-QTR1 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00306 05 WRK-QTR1-START PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00307 05 WRK-QTR1-END PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00308 05 WRK-QTR1-DUE-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00309 05 WRK-QTR1-ANN-TIMELY PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00310 05 WRK-QTR1-ANN-SECURED PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00311 05 WRK-QTR2 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00312 05 WRK-QTR2-START PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00313 05 WRK-QTR2-END PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00314 05 WRK-QTR2-DUE-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00315 05 WRK-QTR2-ANN-TIMELY PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00316 05 WRK-QTR2-ANN-SECURED PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00317 05 WRK-QTR3 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00318 05 WRK-QTR3-START PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00319 05 WRK-QTR3-END PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00320 05 WRK-QTR4 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00321 05 WRK-QTR5 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00322 05 WRK-QTR6 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00323 05 WRK-QTR7 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00324 05 WRK-QTR8 PIC S9(05) COMP-3 VALUE +0. DTSBE770
|
|
00325 DTSBE770
|
|
00326 05 WRK-SELECT-IND PIC X(01). DTSBE770
|
|
00327 88 WRK-SELECT-NO-88 VALUE '0'. DTSBE770
|
|
00328 88 WRK-SELECT-RCVD-88 VALUE '1'. DTSBE770
|
|
00329 88 WRK-SELECT-ESTIM-88 VALUE '2'. DTSBE770
|
|
00330 88 WRK-SELECT-MISSING-88 VALUE '3'. DTSBE770
|
|
00331 88 WRK-SELECT-INACT-CHNG-88 VALUE '4'. DTSBE770
|
|
00332 88 WRK-SELECT-LIAB-CHNG-88 VALUE '5'. DTSBE770
|
|
00333 88 WRK-SELECT-WITHDRAW-88 VALUE '6'. DTSBE770
|
|
00334 88 WRK-SELECT-581-ONLY-88 VALUE '7'. DTSBE770
|
|
00335 DTSBE770
|
|
00336 05 WRK-ANN-RPT-RCVD-IND PIC X(01). DTSBE770
|
|
00337 88 WRK-ANN-RPT-RCVD-YES-88 VALUE 'Y'. DTSBE770
|
|
00338 88 WRK-ANN-RPT-RCVD-NO-88 VALUE 'N'. DTSBE770
|
|
00339 DTSBE770
|
|
00340 05 WRK-ANN-RPT-ESTIM-IND PIC X(01). DTSBE770
|
|
00341 88 WRK-ANN-RPT-ESTIM-YES-88 VALUE 'Y'. DTSBE770
|
|
00342 88 WRK-ANN-RPT-ESTIM-NO-88 VALUE 'N'. DTSBE770
|
|
00343 DTSBE770
|
|
00344 05 WRK-ANN-RPT-MISSING-IND PIC X(01). DTSBE770
|
|
00345 88 WRK-ANN-RPT-MISSING-YES-88 VALUE 'Y'. DTSBE770
|
|
00346 88 WRK-ANN-RPT-MISSING-NO-88 VALUE 'N'. DTSBE770
|
|
00347 DTSBE770
|
|
00348 05 WRK-ANN-RESOLVED-IND PIC X(01). DTSBE770
|
|
00349 88 WRK-ANN-RESOLVED-YES-88 VALUE 'Y'. DTSBE770
|
|
00350 88 WRK-ANN-RESOLVED-NO-88 VALUE 'N'. DTSBE770
|
|
00351 DTSBE770
|
|
00352 05 WRK-ANN-DEFAULT-IND PIC X(01). DTSBE770
|
|
00353 88 WRK-ANN-DEFAULT-YES-88 VALUE 'Y'. DTSBE770
|
|
00354 88 WRK-ANN-DEFAULT-NO-88 VALUE 'N'. DTSBE770
|
|
00355 DTSBE770
|
|
00356 05 WRK-ORIG-RPT-RCVD-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00357 05 WRK-ORIG-RPT-ESTB-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00358 05 WRK-ORIG-RPT-CHNG-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00359 05 WRK-ESTIM-RPT-RCVD-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00360 05 WRK-P2310-LIAB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00361 05 WRK-P2411-LIAB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00362 05 WRK-P2411-INACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00363 05 WRK-P2411-INACT-ENTER-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00364 05 WRK-P2412-LIAB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00365 05 WRK-P2412-INACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00366 05 WRK-P2412-INACT-ENTER-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00367 05 WRK-P2413-LIAB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00368 05 WRK-DELINQUENT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00369 05 WRK-QTR-DELINQUENT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00370 05 WRK-ANN-DELINQUENT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00371 05 WRK-MSOL-LIAB-CHNG-IND PIC X(01). DTSBE770
|
|
00372 88 WRK-MSOL-LIAB-CHNG-YES-88 VALUE 'Y'. DTSBE770
|
|
00373 88 WRK-MSOL-LIAB-CHNG-NO-88 VALUE 'N'. DTSBE770
|
|
00374 05 WRK-MSOL-INACT-CHNG-IND PIC X(01). DTSBE770
|
|
00375 88 WRK-MSOL-INACT-CHNG-YES-88 VALUE 'Y'. DTSBE770
|
|
00376 88 WRK-MSOL-INACT-CHNG-NO-88 VALUE 'N'. DTSBE770
|
|
00377 05 WRK-MSOL-WITHDRAWN-IND PIC X(01). DTSBE770
|
|
00378 88 WRK-MSOL-WITHDRAWN-YES-88 VALUE 'Y'. DTSBE770
|
|
00379 88 WRK-MSOL-WITHDRAWN-NO-88 VALUE 'N'. DTSBE770
|
|
00380 DTSBE770
|
|
00381 ** 05 WRK-SCAN-COMPLETE-IND PIC X(01). DTSBE770
|
|
00382 ** 88 WRK-SCAN-COMPLETE-YES-88 VALUE 'Y'. DTSBE770
|
|
00383 ** 88 WRK-SCAN-COMPLETE-NO-88 VALUE 'N'. DTSBE770
|
|
00384 05 WRK-QTR-WAGE-TOT PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00385 05 WGE-SUB PIC S9(04) COMP. DTSBE770
|
|
00386 05 WRK-QTR-WAGES. DTSBE770
|
|
00387 10 WRK-QTR1-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00388 10 WRK-QTR1-STATUS PIC X(01). DTSBE770
|
|
00389 88 WRK-QTR1-RCVD-88 VALUE '0'. DTSBE770
|
|
00390 88 WRK-QTR1-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00391 88 WRK-QTR1-DELINQ-88 VALUE '2'. DTSBE770
|
|
00392 10 WRK-QTR2-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00393 10 WRK-QTR2-STATUS PIC X(01). DTSBE770
|
|
00394 88 WRK-QTR2-RCVD-88 VALUE '0'. DTSBE770
|
|
00395 88 WRK-QTR2-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00396 88 WRK-QTR2-DELINQ-88 VALUE '2'. DTSBE770
|
|
00397 10 WRK-QTR3-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00398 10 WRK-QTR3-STATUS PIC X(01). DTSBE770
|
|
00399 88 WRK-QTR3-RCVD-88 VALUE '0'. DTSBE770
|
|
00400 88 WRK-QTR3-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00401 88 WRK-QTR3-DELINQ-88 VALUE '2'. DTSBE770
|
|
00402 10 WRK-QTR4-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00403 10 WRK-QTR4-STATUS PIC X(01). DTSBE770
|
|
00404 88 WRK-QTR4-RCVD-88 VALUE '0'. DTSBE770
|
|
00405 88 WRK-QTR4-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00406 88 WRK-QTR4-DELINQ-88 VALUE '2'. DTSBE770
|
|
00407 10 WRK-QTR5-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00408 10 WRK-QTR5-STATUS PIC X(01). DTSBE770
|
|
00409 88 WRK-QTR5-RCVD-88 VALUE '0'. DTSBE770
|
|
00410 88 WRK-QTR5-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00411 88 WRK-QTR5-DELINQ-88 VALUE '2'. DTSBE770
|
|
00412 10 WRK-QTR6-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00413 10 WRK-QTR6-STATUS PIC X(01). DTSBE770
|
|
00414 88 WRK-QTR6-RCVD-88 VALUE '0'. DTSBE770
|
|
00415 88 WRK-QTR6-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00416 88 WRK-QTR6-DELINQ-88 VALUE '2'. DTSBE770
|
|
00417 10 WRK-QTR7-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00418 10 WRK-QTR7-STATUS PIC X(01). DTSBE770
|
|
00419 88 WRK-QTR7-RCVD-88 VALUE '0'. DTSBE770
|
|
00420 88 WRK-QTR7-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00421 88 WRK-QTR7-DELINQ-88 VALUE '2'. DTSBE770
|
|
00422 10 WRK-QTR8-WAGES PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00423 10 WRK-QTR8-STATUS PIC X(01). DTSBE770
|
|
00424 88 WRK-QTR8-RCVD-88 VALUE '0'. DTSBE770
|
|
00425 88 WRK-QTR8-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00426 88 WRK-QTR8-DELINQ-88 VALUE '2'. DTSBE770
|
|
00427 05 FILLER REDEFINES WRK-QTR-WAGES. DTSBE770
|
|
00428 10 WRK-QTR-ENTRY OCCURS 8 TIMES. DTSBE770
|
|
00429 15 WRK-QTR-WAGE-AMT PIC S9(11)V99 COMP-3. DTSBE770
|
|
00430 15 WRK-QTR-STATUS PIC X(01). DTSBE770
|
|
00431 88 WRK-QTR-RCVD-88 VALUE '0'. DTSBE770
|
|
00432 88 WRK-QTR-NOT-LIAB-88 VALUE '1'. DTSBE770
|
|
00433 88 WRK-QTR-DELINQ-88 VALUE '2'. DTSBE770
|
|
00434 DTSBE770
|
|
00435 05 WRK-PRE-AUDIT-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00436 05 WRK-POST-AUDIT-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00437 05 WRK-OVER-RPT-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00438 05 WRK-UNDER-RPT-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00439 05 WRK-PRE-AUDIT-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00440 05 WRK-POST-AUDIT-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00441 05 WRK-OVER-RPT-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00442 05 WRK-UNDER-RPT-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00443 05 WRK-PRE-AUDIT-CONTRIB PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00444 05 WRK-POST-AUDIT-CONTRIB PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00445 05 WRK-OVER-RPT-CONTRIB PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00446 05 WRK-UNDER-RPT-CONTRIB PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00447 05 WRK-CHANGE-AUDIT-IND PIC X(01) VALUE SPACE. DTSBE770
|
|
00448 DTSBE770
|
|
00449 05 WRK-AUDIT-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00450 05 WRK-AUDIT-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00451 05 WRK-AUDIT-UI-CHG PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00452 05 WRK-ORIG-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00453 05 WRK-ORIG-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00454 05 WRK-ORIG-UI-CHG PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00455 DTSBE770
|
|
00456 05 WRK-LIAB-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00457 05 WRK-RPT-RCVD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00458 05 WRK-ZERO-WAGE-CNT PIC S9(02) COMP-3 VALUE +0. DTSBE770
|
|
00459 05 WRK-ANNUAL-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00460 DTSBE770
|
|
00461 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBE770
|
|
00462 VALUE +999999999. DTSBE770
|
|
00463 05 WRK-LIAB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00464 05 WRK-REOPEN-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00465 05 WRK-LIAB-PROCESS-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00466 05 WRK-REOPEN-PROCESS-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00467 05 WRK-LAST-INACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00468 05 WRK-LAST-INACT-ENTER-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00469 DTSBE770
|
|
00470 05 WRK-CURR-ESTB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00471 05 WRK-CURR-INACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00472 05 WRK-CURR-INACT-REV-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00473 05 WRK-STATUS-DETERM-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00474 05 WRK-STATUS-LIAB-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00475 05 WRK-STATUS-ACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00476 05 WRK-STATUS-REACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00477 05 WRK-STATUS-INACT-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00478 05 WRK-STATUS-SUCC-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00479 05 CURR-DETERM-TABLE. DTSBE770
|
|
00480 10 CURR-DETERM-ESTB-IND PIC X(01). DTSBE770
|
|
00481 88 CURR-DETERM-ESTB-YES-88 VALUE 'Y'. DTSBE770
|
|
00482 88 CURR-DETERM-ESTB-NO-88 VALUE 'N'. DTSBE770
|
|
00483 10 CURR-DETERM-INACT-IND PIC X(01). DTSBE770
|
|
00484 88 CURR-DETERM-INACT-YES-88 VALUE 'Y'. DTSBE770
|
|
00485 88 CURR-DETERM-INACT-NO-88 VALUE 'N'. DTSBE770
|
|
00486 10 CURR-DETERM-REV-IND PIC X(01). DTSBE770
|
|
00487 88 CURR-DETERM-REV-YES-88 VALUE 'Y'. DTSBE770
|
|
00488 88 CURR-DETERM-REV-NO-88 VALUE 'N'. DTSBE770
|
|
00489 ** 05 CURR-DETERM REDEFINES CURR-DETERM-TABLE DTSBE770
|
|
00490 * PIC X(03). DTSBE770
|
|
00491 * 88 CURR-DETERM-NEW-88 VALUE 'YNN' 'YNY' 'NNY'. DTSBE770
|
|
00492 ** 88 CURR-DETERM-INACT-88 VALUE 'YYN' 'NYN'. DTSBE770
|
|
00493 05 WRK-DETERM-TYPE-IND PIC X(01). DTSBE770
|
|
00494 88 WRK-DETERM-NULL-88 VALUE '0'. DTSBE770
|
|
00495 88 WRK-DETERM-ORIG-88 VALUE '1'. DTSBE770
|
|
00496 88 WRK-DETERM-REACT-88 VALUE '2'. DTSBE770
|
|
00497 88 WRK-DETERM-SUC-88 VALUE '3'. DTSBE770
|
|
00498 88 WRK-DETERM-INACT-88 VALUE '4'. DTSBE770
|
|
00499 DTSBE770
|
|
00500 05 WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
00501 PIC X(01). DTSBE770
|
|
00502 DTSBE770
|
|
00503 05 WRK-PREV-INACTIVE-IND PIC X(01). DTSBE770
|
|
00504 88 WRK-PREV-INACTIVE-YES-88 VALUE 'Y'. DTSBE770
|
|
00505 88 WRK-PREV-INACTIVE-NO-88 VALUE 'N'. DTSBE770
|
|
00506 DTSBE770
|
|
00507 05 WRK-8-QTRS-ZERO-WAGES-IND PIC X(01). DTSBE770
|
|
00508 88 WRK-8-QTRS-ZERO-WAGES-YES VALUE 'Y'. DTSBE770
|
|
00509 88 WRK-8-QTRS-ZERO-WAGES-NO VALUE 'N'. DTSBE770
|
|
00510 DTSBE770
|
|
00511 05 WRK-PRED-EMP-NO PIC S9(07) COMP-3. DTSBE770
|
|
00512 DTSBE770
|
|
00513 05 WRK-FIRST-SUB PIC S9(04) COMP VALUE +400. DTSBE770
|
|
00514 05 WRK-LAST-SUB PIC S9(04) COMP VALUE +0. DTSBE770
|
|
00515 05 WRK-TBL-CNT PIC S9(04) COMP VALUE +0. DTSBE770
|
|
00516 05 QTR-SUB PIC S9(04) COMP. DTSBE770
|
|
00517 05 WRK-JRN-TABLE OCCURS 400 TIMES. DTSBE770
|
|
00518 10 WRK-JRN-YRQ PIC S9(05) COMP-3. DTSBE770
|
|
00519 10 WRK-BAL-DUE-IND PIC X(01). DTSBE770
|
|
00520 88 WRK-BAL-DUE-YES-88 VALUE 'Y'. DTSBE770
|
|
00521 88 WRK-BAL-DUE-NO-88 VALUE 'N'. DTSBE770
|
|
00522 10 WRK-JRN-PAID PIC S9(09)V99 COMP-3. DTSBE770
|
|
00523 10 WRK-JRN-CHG PIC S9(09)V99 COMP-3. DTSBE770
|
|
00524 10 WRK-TAX-DUE-DATE PIC S9(09) COMP-3. DTSBE770
|
|
00525 DTSBE770
|
|
00526 05 WRK-RATE-FOUND-IND PIC X(01). DTSBE770
|
|
00527 88 WRK-RATE-FOUND-YES-88 VALUE 'Y'. DTSBE770
|
|
00528 88 WRK-RATE-FOUND-NO-88 VALUE 'N'. DTSBE770
|
|
00529 DTSBE770
|
|
00530 05 WRK-SUTA-DUMPING-AREA. DTSBE770
|
|
00531 10 WRK-EFF-DATE PIC S9(09) COMP-3 DTSBE770
|
|
00532 VALUE +0. DTSBE770
|
|
00533 10 WRK-RATE-CHNG-DATE PIC S9(09) COMP-3 DTSBE770
|
|
00534 VALUE +999999999. DTSBE770
|
|
00535 88 RATE-CHNG-DATE-NULL-88 VALUE +999999999. DTSBE770
|
|
00536 DTSBE770
|
|
00537 10 WRK-SUTA-SUCC-EMP PIC S9(07) COMP-3 DTSBE770
|
|
00538 VALUE +0. DTSBE770
|
|
00539 10 WRK-SUTA-PRED-EMP PIC S9(07) COMP-3 DTSBE770
|
|
00540 VALUE +0. DTSBE770
|
|
00541 10 WRK-MANDATORY-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00542 VALUE +0. DTSBE770
|
|
00543 10 WRK-PROHIBITED-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00544 VALUE +0. DTSBE770
|
|
00545 10 WRK-SUTA-DMP-AMT PIC S9(11)V99 COMP-3 DTSBE770
|
|
00546 VALUE +0. DTSBE770
|
|
00547 10 WRK-SUTA-DMP-TOT PIC S9(11)V99 COMP-3 DTSBE770
|
|
00548 VALUE +0. DTSBE770
|
|
00549 10 SUB PIC S9(04) COMP. DTSBE770
|
|
00550 DTSBE770
|
|
00551 05 WRK-MJRN-READ-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00552 VALUE +0. DTSBE770
|
|
00553 DTSBE770
|
|
00554 05 WRK-UI-CHG PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00555 05 WRK-OUTSTANDING-BAL PIC S9(11)V99 COMP-3 VALUE +0. DTSBE770
|
|
00556 05 WRK-OUTSTANDING-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00557 05 WRK-WAGE-ITEM-CNT PIC S9(09) COMP-3 VALUE +0. DTSBE770
|
|
00558 05 WRK-ITEM13-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE770
|
|
00559 DTSBE770
|
|
00560 05 WRK-AMT PIC S9(09)V99 COMP-3. DTSBE770
|
|
00561 DTSBE770
|
|
00562 05 WRK-TOT-CON-BAL PIC S9(11)V99 COMP-3 DTSBE770
|
|
00563 VALUE +0. DTSBE770
|
|
00564 05 WRK-TOT-REIMB-BAL PIC S9(11)V99 COMP-3 DTSBE770
|
|
00565 VALUE +0. DTSBE770
|
|
00566 05 TPS-TRANS-REC. DTSBE770
|
|
00567 ++INCLUDE DTSIM715 DTSBE770
|
|
00568 DTSBE770
|
|
00569 05 WRK-Y771-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00570 VALUE +0. DTSBE770
|
|
00571 05 WRK-Y772-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00572 VALUE +0. DTSBE770
|
|
00573 05 WRK-Y773-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00574 VALUE +0. DTSBE770
|
|
00575 05 WRK-TPS-STATUS-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00576 VALUE +0. DTSBE770
|
|
00577 05 WRK-Y774-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00578 VALUE +0. DTSBE770
|
|
00579 05 WRK-Y775-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00580 VALUE +0. DTSBE770
|
|
00581 DTSBE770
|
|
00582 05 WRK-CNT1 PIC S9(07) COMP-3 DTSBE770
|
|
00583 VALUE +0. DTSBE770
|
|
00584 05 WRK-CNT2 PIC S9(07) COMP-3 DTSBE770
|
|
00585 VALUE +0. DTSBE770
|
|
00586 05 WRK-CNT3 PIC S9(07) COMP-3 DTSBE770
|
|
00587 VALUE +0. DTSBE770
|
|
00588 05 WRK-CNT4 PIC S9(07) COMP-3 DTSBE770
|
|
00589 VALUE +0. DTSBE770
|
|
00590 DTSBE770
|
|
00591 05 WRK-ANN-FILER-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00592 VALUE +0. DTSBE770
|
|
00593 DTSBE770
|
|
00594 ** 05 WRK-P2600-DFLT-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00595 * VALUE +0. DTSBE770
|
|
00596 * DTSBE770
|
|
00597 * 05 WRK-P2600-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00598 ** VALUE +0. DTSBE770
|
|
00599 05 WRK-P2610-QTR-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00600 VALUE +0. DTSBE770
|
|
00601 DTSBE770
|
|
00602 05 WRK-P2100-DFLT-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00603 VALUE +0. DTSBE770
|
|
00604 DTSBE770
|
|
00605 05 WRK-P2100-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00606 VALUE +0. DTSBE770
|
|
00607 05 WRK-P2100-RCVD-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00608 VALUE +0. DTSBE770
|
|
00609 05 WRK-P2100-MISS-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00610 VALUE +0. DTSBE770
|
|
00611 DTSBE770
|
|
00612 05 WRK-P2100-QTR-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00613 VALUE +0. DTSBE770
|
|
00614 DTSBE770
|
|
00615 05 WRK-P2500-QTR-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00616 VALUE +0. DTSBE770
|
|
00617 05 WRK-P2500-ANN-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00618 VALUE +0. DTSBE770
|
|
00619 05 WRK-P2500-581-QTR-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00620 VALUE +0. DTSBE770
|
|
00621 05 WRK-P2210-RES-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00622 VALUE +0. DTSBE770
|
|
00623 05 WRK-P2210-SEC-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00624 VALUE +0. DTSBE770
|
|
00625 05 WRK-P2210-TIMELY-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00626 VALUE +0. DTSBE770
|
|
00627 05 WRK-P2510-DFLT-TIMELY-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00628 VALUE +0. DTSBE770
|
|
00629 05 WRK-P2220-RES-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00630 VALUE +0. DTSBE770
|
|
00631 05 WRK-P2220-SEC-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00632 VALUE +0. DTSBE770
|
|
00633 05 WRK-P2220-TIMELY-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00634 VALUE +0. DTSBE770
|
|
00635 05 WRK-P2520-DFLT-TIMELY-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00636 VALUE +0. DTSBE770
|
|
00637 DTSBE770
|
|
00638 DTSBE770
|
|
00639 05 WRK-MISSING-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00640 VALUE +0. DTSBE770
|
|
00641 DTSBE770
|
|
00642 05 WRK-SELECT-581-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00643 VALUE +0. DTSBE770
|
|
00644 DTSBE770
|
|
00645 05 WRK-NOT-SELECTED-CNT PIC S9(07) COMP-3 DTSBE770
|
|
00646 VALUE +0. DTSBE770
|
|
00647 DTSBE770
|
|
00648 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBE770
|
|
00649 VALUE +010169. DTSBE770
|
|
00650 DTSBE770
|
|
00651 05 DISPLAY-CNT PIC Z(06)9. DTSBE770
|
|
00652 DTSBE770
|
|
00653 05 DISPLAY-AMT-X PIC X(15). DTSBE770
|
|
00654 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBE770
|
|
00655 PIC ZZZ,ZZZ,ZZ9.99-. DTSBE770
|
|
00656 05 AMT-DISP1 PIC --,---,---,--9.99. DTSBE770
|
|
00657 EJECT DTSBE770
|
|
00658 01 L001-LINK-AREA. DTSBE770
|
|
00659 ++INCLUDE DTSIL001 DTSBE770
|
|
00660 EJECT DTSBE770
|
|
00661 01 L004-LINK-AREA. DTSBE770
|
|
00662 ++INCLUDE DTSIL004 DTSBE770
|
|
00663 EJECT DTSBE770
|
|
00664 01 L005-LINK-AREA. DTSBE770
|
|
00665 ++INCLUDE DTSIL005 DTSBE770
|
|
00666 EJECT DTSBE770
|
|
00667 01 L410-LINK-AREA. DTSBE770
|
|
00668 ++INCLUDE DTSIL410 DTSBE770
|
|
00669 SKIP3 DTSBE770
|
|
00670 01 L415-LINK-AREA. DTSBE770
|
|
00671 ++INCLUDE DTSIL415 DTSBE770
|
|
00672 DTSBE770
|
|
00673 01 L430-LINK-AREA. DTSBE770
|
|
00674 ++INCLUDE DTSIL430 DTSBE770
|
|
00675 DTSBE770
|
|
00676 01 L910-LINK-AREA. DTSBE770
|
|
00677 ++INCLUDE DTSIL910 DTSBE770
|
|
00678 SKIP3 DTSBE770
|
|
00679 01 MSKL-REC. DTSBE770
|
|
00680 ++INCLUDE DTSIMSKL DTSBE770
|
|
00681 SKIP3 DTSBE770
|
|
00682 01 MSOL-REC. DTSBE770
|
|
00683 ++INCLUDE DTSIMSOL DTSBE770
|
|
00684 SKIP3 DTSBE770
|
|
00685 01 MQTR-REC. DTSBE770
|
|
00686 ++INCLUDE DTSIMQTR DTSBE770
|
|
00687 SKIP3 DTSBE770
|
|
00688 01 MRPT-REC. DTSBE770
|
|
00689 ++INCLUDE DTSIMRPT DTSBE770
|
|
00690 SKIP3 DTSBE770
|
|
00691 01 MERD-REC. DTSBE770
|
|
00692 ++INCLUDE DTSIMERD DTSBE770
|
|
00693 SKIP3 DTSBE770
|
|
00694 01 MREL-REC. DTSBE770
|
|
00695 ++INCLUDE DTSIMREL DTSBE770
|
|
00696 SKIP3 DTSBE770
|
|
00697 01 MRTE-REC. DTSBE770
|
|
00698 ++INCLUDE DTSIMRTE DTSBE770
|
|
00699 SKIP3 DTSBE770
|
|
00700 01 MJRN-REC. DTSBE770
|
|
00701 ++INCLUDE DTSIMJRN DTSBE770
|
|
00702 SKIP3 DTSBE770
|
|
00703 *01 F581-REC. DTSBE770
|
|
00704 ***INCLUDE DTSIF581 DTSBE770
|
|
00705 * SKIP3 DTSBE770
|
|
00706 01 MFAS-REC. DTSBE770
|
|
00707 ++INCLUDE DTSIMFAS DTSBE770
|
|
00708 SKIP3 DTSBE770
|
|
00709 01 MAUR-REC. DTSBE770
|
|
00710 ++INCLUDE DTSIMAUR DTSBE770
|
|
00711 SKIP3 DTSBE770
|
|
00712 01 MAUY-REC. DTSBE770
|
|
00713 ++INCLUDE DTSIMAUY DTSBE770
|
|
00714 EJECT DTSBE770
|
|
00715 01 L931-LINK-AREA. DTSBE770
|
|
00716 ++INCLUDE DTSIL931 DTSBE770
|
|
00717 SKIP3 DTSBE770
|
|
00718 01 FSKL-REC. DTSBE770
|
|
00719 ++INCLUDE DTSIFSKL DTSBE770
|
|
00720 SKIP3 DTSBE770
|
|
00721 01 FQTR-REC. DTSBE770
|
|
00722 ++INCLUDE DTSIFQTR DTSBE770
|
|
00723 SKIP3 DTSBE770
|
|
00724 01 L927-LINK-AREA. DTSBE770
|
|
00725 ++INCLUDE DTSIL927 DTSBE770
|
|
00726 DTSBE770
|
|
00727 01 RSKL-REC. DTSBE770
|
|
00728 ++INCLUDE DTSIRSK1 DTSBE770
|
|
00729 DTSBE770
|
|
00730 01 Y771-REC. DTSBE770
|
|
00731 ++INCLUDE DTSIY771 DTSBE770
|
|
00732 DTSBE770
|
|
00733 01 Y772-REC. DTSBE770
|
|
00734 ++INCLUDE DTSIY772 DTSBE770
|
|
00735 DTSBE770
|
|
00736 01 Y773-REC. DTSBE770
|
|
00737 ++INCLUDE DTSIY773 DTSBE770
|
|
00738 DTSBE770
|
|
00739 01 Y774-REC. DTSBE770
|
|
00740 ++INCLUDE DTSIY774 DTSBE770
|
|
00741 DTSBE770
|
|
00742 01 Y775-REC. DTSBE770
|
|
00743 ++INCLUDE DTSIY775 DTSBE770
|
|
00744 DTSBE770
|
|
00745 01 Y779-REC. DTSBE770
|
|
00746 ++INCLUDE DTSIY779 DTSBE770
|
|
00747 DTSBE770
|
|
00748 01 MMAX-LITERALS. DTSBE770
|
|
00749 ++INCLUDE DTSIMMAX DTSBE770
|
|
00750 EJECT DTSBE770
|
|
00751 LINKAGE SECTION. DTSBE770
|
|
00752 SKIP3 DTSBE770
|
|
00753 01 LECM-LINK-AREA. DTSBE770
|
|
00754 ++INCLUDE DTSILECM DTSBE770
|
|
00755 SKIP3 DTSBE770
|
|
00756 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE770
|
|
00757 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE770
|
|
00758 15 FILLER PIC X(65). DTSBE770
|
|
00759 EJECT DTSBE770
|
|
00760 01 MPRF-LINK-REC. DTSBE770
|
|
00761 ++INCLUDE DTSIMPRF DTSBE770
|
|
00762 EJECT DTSBE770
|
|
00763 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE770
|
|
00764 MPRF-LINK-REC. DTSBE770
|
|
00765 DTSBE770
|
|
00766 * IF LECM-PROCESS-88 DTSBE770
|
|
00767 * PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE770
|
|
00768 * ELSE DTSBE770
|
|
00769 * IF LECM-INITIALIZE-88 DTSBE770
|
|
00770 * PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE770
|
|
00771 * ELSE DTSBE770
|
|
00772 * IF LECM-TERMINATE-88 DTSBE770
|
|
00773 * PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE770
|
|
00774 * ELSE DTSBE770
|
|
00775 * MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE770
|
|
00776 * TO ABEND-MSG DTSBE770
|
|
00777 * PERFORM S999-ABEND THRU S999-EXIT. DTSBE770
|
|
00778 SKIP2 DTSBE770
|
|
00779 GOBACK. DTSBE770
|
|
00780 EJECT DTSBE770
|
|
00781 I0000-INITIALIZE. DTSBE770
|
|
00782 SKIP2 DTSBE770
|
|
00783 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE770
|
|
00784 DTSBE770
|
|
00785 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE770
|
|
00786 DTSBE770
|
|
00787 DTSBE770
|
|
00788 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE770
|
|
00789 DTSBE770
|
|
00790 PERFORM I2100-PERIOD-DATES THRU I2100-EXIT. DTSBE770
|
|
00791 DTSBE770
|
|
00792 PERFORM I2200-TIMING-EDITS THRU I2200-EXIT. DTSBE770
|
|
00793 DTSBE770
|
|
00794 PERFORM I2400-SET-WAGE-QTRS THRU I2400-EXIT. DTSBE770
|
|
00795 DTSBE770
|
|
00796 PERFORM I2500-ANNUAL-RPT-DATES THRU I2500-EXIT. DTSBE770
|
|
00797 DTSBE770
|
|
00798 PERFORM I2600-DELINQUENCY-DATES THRU I2600-EXIT. DTSBE770
|
|
00799 DTSBE770
|
|
00800 PERFORM I3000-WRITE-PARM THRU I3000-EXIT. DTSBE770
|
|
00801 DTSBE770
|
|
00802 PERFORM I3100-OPEN-FILES THRU I3100-EXIT. DTSBE770
|
|
00803 DTSBE770
|
|
00804 PERFORM I4100-DISPLAY THRU I4100-EXIT. DTSBE770
|
|
00805 DTSBE770
|
|
00806 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE770
|
|
00807 DTSBE770
|
|
00808 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE770
|
|
00809 DTSBE770
|
|
00810 I0000-EXIT. DTSBE770
|
|
00811 EXIT. DTSBE770
|
|
00812 EJECT DTSBE770
|
|
00813 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE770
|
|
00814 PERFORM I1100-SUBJECT-YRQ THRU I1100-EXIT. DTSBE770
|
|
00815 DTSBE770
|
|
00816 I1000-EXIT. DTSBE770
|
|
00817 EXIT. DTSBE770
|
|
00818 SKIP3 DTSBE770
|
|
00819 I1100-SUBJECT-YRQ. DTSBE770
|
|
00820 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE770
|
|
00821 IF LECM-QTR-END DTSBE770
|
|
00822 MOVE LECM-PERIOD-END-DATE TO L004-DATE DTSBE770
|
|
00823 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBE770
|
|
00824 MOVE L004-QTR-5-9 TO WRK-SUBJECT-QTR DTSBE770
|
|
00825 ELSE DTSBE770
|
|
00826 MOVE 'LECM-PARM-SUBJECT-YRQ SPACES AND NOT LECM-QTR-END' DTSBE770
|
|
00827 TO ABEND-MSG DTSBE770
|
|
00828 PERFORM S999-ABEND THRU S999-EXIT DTSBE770
|
|
00829 ELSE DTSBE770
|
|
00830 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X DTSBE770
|
|
00831 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE770
|
|
00832 IF L004-INVALID-QTR DTSBE770
|
|
00833 MOVE 'LECM-PARM-SUBJECT-YRQ NOT VALID' DTSBE770
|
|
00834 TO ABEND-MSG DTSBE770
|
|
00835 PERFORM S999-ABEND THRU S999-EXIT DTSBE770
|
|
00836 ELSE DTSBE770
|
|
00837 MOVE L004-QTR-5-9 TO WRK-SUBJECT-QTR. DTSBE770
|
|
00838 DTSBE770
|
|
00839 MOVE WRK-SUBJECT-QTR TO WRK-RPT-QTR. DTSBE770
|
|
00840 DTSBE770
|
|
00841 I1100-EXIT. DTSBE770
|
|
00842 EXIT. DTSBE770
|
|
00843 SKIP3 DTSBE770
|
|
00844 I2100-PERIOD-DATES. DTSBE770
|
|
00845 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
00846 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
00847 MOVE L004-QTR-START-DATE TO WRK-SUBJECT-QTR-START. DTSBE770
|
|
00848 MOVE L004-QTR-END-DATE TO WRK-SUBJECT-QTR-END. DTSBE770
|
|
00849 DTSBE770
|
|
00850 IF WRK-SUBJECT-QTR-START > LECM-LAST-MJRN-PURGE-DATE DTSBE770
|
|
00851 NEXT SENTENCE DTSBE770
|
|
00852 ELSE DTSBE770
|
|
00853 MOVE DTSBE770
|
|
00854 'PERIOD-START-DATE NOT GREATER THAN LAST-MJRN-PURGE-DATE' DTSBE770
|
|
00855 TO ABEND-MSG DTSBE770
|
|
00856 PERFORM S999-ABEND THRU S999-EXIT. DTSBE770
|
|
00857 DTSBE770
|
|
00858 I2100-EXIT. DTSBE770
|
|
00859 EXIT. DTSBE770
|
|
00860 EJECT DTSBE770
|
|
00861 I2200-TIMING-EDITS. DTSBE770
|
|
00862 IF (LECM-PRIOR-RUN-DATE NOT > WRK-SUBJECT-QTR-END) DTSBE770
|
|
00863 AND DTSBE770
|
|
00864 (LECM-CURR-RUN-DATE > WRK-SUBJECT-QTR-END) DTSBE770
|
|
00865 NEXT SENTENCE DTSBE770
|
|
00866 ELSE DTSBE770
|
|
00867 MOVE 'TIMING OF RUN IS NOT VALID' DTSBE770
|
|
00868 TO ABEND-MSG DTSBE770
|
|
00869 PERFORM S999-ABEND THRU S999-EXIT. DTSBE770
|
|
00870 I2200-EXIT. DTSBE770
|
|
00871 EXIT. DTSBE770
|
|
00872 EJECT DTSBE770
|
|
00873 I2400-SET-WAGE-QTRS. DTSBE770
|
|
00874 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
00875 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
00876 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00877 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00878 MOVE L004-QTR-5-9 TO WRK-QTR1. DTSBE770
|
|
00879 MOVE L004-QTR-START-DATE TO WRK-QTR1-START. DTSBE770
|
|
00880 MOVE L004-QTR-END-DATE TO WRK-QTR1-END. DTSBE770
|
|
00881 MOVE L004-QTR-DEFAULT-DUE-DATE TO WRK-QTR1-DUE-DATE DTSBE770
|
|
00882 WRK-QTR1-ANN-TIMELY. DTSBE770
|
|
00883 MOVE L004-QTR-DEFAULT-DUE-DATE TO L004-DATE. DTSBE770
|
|
00884 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE770
|
|
00885 MOVE L004-QTR-END-DATE TO WRK-QTR1-ANN-SECURED. DTSBE770
|
|
00886 DTSBE770
|
|
00887 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
00888 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
00889 SUBTRACT 2 FROM L004-ABS-QTR. DTSBE770
|
|
00890 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00891 MOVE L004-QTR-5-9 TO WRK-QTR2. DTSBE770
|
|
00892 MOVE L004-QTR-START-DATE TO WRK-QTR2-START. DTSBE770
|
|
00893 MOVE L004-QTR-END-DATE TO WRK-QTR2-END. DTSBE770
|
|
00894 MOVE L004-QTR-DEFAULT-DUE-DATE TO WRK-QTR2-DUE-DATE DTSBE770
|
|
00895 WRK-QTR2-ANN-TIMELY. DTSBE770
|
|
00896 MOVE L004-QTR-DEFAULT-DUE-DATE TO L004-DATE. DTSBE770
|
|
00897 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE770
|
|
00898 MOVE L004-QTR-END-DATE TO WRK-QTR2-ANN-SECURED. DTSBE770
|
|
00899 DTSBE770
|
|
00900 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
00901 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
00902 SUBTRACT 3 FROM L004-ABS-QTR. DTSBE770
|
|
00903 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00904 MOVE L004-QTR-5-9 TO WRK-QTR3. DTSBE770
|
|
00905 MOVE L004-QTR-START-DATE TO WRK-QTR3-START. DTSBE770
|
|
00906 MOVE L004-QTR-END-DATE TO WRK-QTR3-END. DTSBE770
|
|
00907 DTSBE770
|
|
00908 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00909 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00910 MOVE L004-QTR-5-9 TO WRK-QTR4. DTSBE770
|
|
00911 DTSBE770
|
|
00912 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00913 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00914 MOVE L004-QTR-5-9 TO WRK-QTR5. DTSBE770
|
|
00915 DTSBE770
|
|
00916 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00917 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00918 MOVE L004-QTR-5-9 TO WRK-QTR6. DTSBE770
|
|
00919 DTSBE770
|
|
00920 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00921 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00922 MOVE L004-QTR-5-9 TO WRK-QTR7. DTSBE770
|
|
00923 DTSBE770
|
|
00924 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00925 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00926 MOVE L004-QTR-5-9 TO WRK-QTR8. DTSBE770
|
|
00927 DTSBE770
|
|
00928 I2400-EXIT. DTSBE770
|
|
00929 EXIT. DTSBE770
|
|
00930 DTSBE770
|
|
00931 I2500-ANNUAL-RPT-DATES. DTSBE770
|
|
00932 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
00933 SUBTRACT 1 FROM L004-QTR-5-YR. DTSBE770
|
|
00934 MOVE 1 TO L004-QTR-5-Q. DTSBE770
|
|
00935 MOVE L004-QTR-5-9 TO WRK-FIRST-ANN-QTR. DTSBE770
|
|
00936 DTSBE770
|
|
00937 MOVE L004-QTR-5-YR TO L001-FED-8-YR. DTSBE770
|
|
00938 MOVE 01 TO L001-FED-8-MO. DTSBE770
|
|
00939 MOVE 01 TO L001-FED-8-DA. DTSBE770
|
|
00940 MOVE L001-FED-8-DATE-9 TO WRK-ANN-START. DTSBE770
|
|
00941 DTSBE770
|
|
00942 MOVE 4 TO L004-QTR-5-Q. DTSBE770
|
|
00943 MOVE L004-QTR-5-9 TO WRK-LAST-ANN-QTR. DTSBE770
|
|
00944 DTSBE770
|
|
00945 MOVE 12 TO L001-FED-8-MO. DTSBE770
|
|
00946 MOVE 31 TO L001-FED-8-DA. DTSBE770
|
|
00947 MOVE L001-FED-8-DATE-9 TO WRK-ANN-END. DTSBE770
|
|
00948 DTSBE770
|
|
00949 * MOVE WRK-QTR1-DUE-DATE TO L001-FED-8-DATE-9. DTSBE770
|
|
00950 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE770
|
|
00951 * ADD +1 TO L001-JUL-ABS-DAY. DTSBE770
|
|
00952 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE770
|
|
00953 * MOVE L001-FED-8-DATE-9 TO WRK-ANN-QTR1-LATE-DATE. DTSBE770
|
|
00954 * DTSBE770
|
|
00955 * MOVE WRK-QTR2-DUE-DATE TO L001-FED-8-DATE-9. DTSBE770
|
|
00956 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE770
|
|
00957 * ADD +1 TO L001-JUL-ABS-DAY. DTSBE770
|
|
00958 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE770
|
|
00959 * MOVE L001-FED-8-DATE-9 TO WRK-ANN-QTR2-LATE-DATE. DTSBE770
|
|
00960 DTSBE770
|
|
00961 MOVE WRK-FIRST-ANN-QTR TO L004-QTR-5-9. DTSBE770
|
|
00962 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
00963 MOVE L004-ANN-DEFAULT-DUE-DATE DTSBE770
|
|
00964 TO WRK-ANN-DUE-DATE DTSBE770
|
|
00965 L004-DATE. DTSBE770
|
|
00966 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE770
|
|
00967 MOVE L004-QTR-END-DATE TO WRK-ANN-SECURED-DATE. DTSBE770
|
|
00968 DTSBE770
|
|
00969 * SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00970 * PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00971 * MOVE L004-QTR-DEFAULT-DUE-DATE DTSBE770
|
|
00972 * TO WRK-ANN-PSEUDO-TIMELY-DT1. DTSBE770
|
|
00973 * MOVE L004-QTR-END-DATE TO WRK-ANN-PSEUDO-SECURD-DT2. DTSBE770
|
|
00974 * DTSBE770
|
|
00975 * SUBTRACT 1 FROM L004-ABS-QTR. DTSBE770
|
|
00976 * PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE770
|
|
00977 * MOVE L004-QTR-DEFAULT-DUE-DATE DTSBE770
|
|
00978 * TO WRK-ANN-PSEUDO-TIMELY-DT2. DTSBE770
|
|
00979 DTSBE770
|
|
00980 DISPLAY SPACE. DTSBE770
|
|
00981 DISPLAY 'FIRST ANNUAL QTR : ' WRK-FIRST-ANN-QTR. DTSBE770
|
|
00982 DISPLAY 'LAST ANNUAL QTR : ' WRK-LAST-ANN-QTR. DTSBE770
|
|
00983 DISPLAY 'ANNUAL START DATE : ' WRK-ANN-START. DTSBE770
|
|
00984 DISPLAY 'ANNUAL END DATE : ' WRK-ANN-END. DTSBE770
|
|
00985 DISPLAY 'ANNUAL DUE DATE : ' WRK-ANN-DUE-DATE. DTSBE770
|
|
00986 DISPLAY 'ANNUAL SECURED DATE : ' WRK-ANN-SECURED-DATE. DTSBE770
|
|
00987 DISPLAY 'QTR1 ANN TIMELY : ' DTSBE770
|
|
00988 WRK-QTR1-ANN-TIMELY. DTSBE770
|
|
00989 DISPLAY 'QTR1 ANN SECURED : ' DTSBE770
|
|
00990 WRK-QTR1-ANN-SECURED. DTSBE770
|
|
00991 DISPLAY 'QTR2 ANN TIMELY : ' DTSBE770
|
|
00992 WRK-QTR2-ANN-TIMELY. DTSBE770
|
|
00993 DISPLAY 'QTR2 ANN SECURED : ' DTSBE770
|
|
00994 WRK-QTR2-ANN-SECURED. DTSBE770
|
|
00995 DTSBE770
|
|
00996 I2500-EXIT. DTSBE770
|
|
00997 EXIT. DTSBE770
|
|
00998 DTSBE770
|
|
00999 I2600-DELINQUENCY-DATES. DTSBE770
|
|
01000 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSBE770
|
|
01001 MOVE WRK-QTR1 TO FQTR-YRQ. DTSBE770
|
|
01002 SET FQTR-QTR-88 TO TRUE. DTSBE770
|
|
01003 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. DTSBE770
|
|
01004 PERFORM S931-READ THRU S931-EXIT. DTSBE770
|
|
01005 DTSBE770
|
|
01006 IF L931-NO-REC-88 DTSBE770
|
|
01007 DISPLAY 'CANNOT FIND FQTR REC ' DTSBE770
|
|
01008 PERFORM S999-ABEND THRU S999-EXIT DTSBE770
|
|
01009 ELSE DTSBE770
|
|
01010 MOVE FSKL-REC TO FQTR-REC DTSBE770
|
|
01011 IF FQTR-UC30-FIRST-DEL-DATE > ZERO DTSBE770
|
|
01012 MOVE FQTR-UC30-FIRST-DEL-DATE DTSBE770
|
|
01013 TO WRK-QTR-DELINQUENT-DATE DTSBE770
|
|
01014 ELSE DTSBE770
|
|
01015 MOVE WRK-QTR2 TO L004-QTR-5-9 DTSBE770
|
|
01016 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE770
|
|
01017 MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9 DTSBE770
|
|
01018 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE770
|
|
01019 ADD +30 TO L001-JUL-ABS-DAY DTSBE770
|
|
01020 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE770
|
|
01021 MOVE L001-FED-8-DATE-9 TO WRK-QTR-DELINQUENT-DATE. DTSBE770
|
|
01022 DTSBE770
|
|
01023 SET L415-MODE-MOST-RECENT-88 TO TRUE. DTSBE770
|
|
01024 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT. DTSBE770
|
|
01025 ** DISPLAY 'I2600 L415 RET ' L415-RETURN-CD DTSBE770
|
|
01026 ** ' ANN START ' WRK-ANN-START. DTSBE770
|
|
01027 IF L415-OK-88 DTSBE770
|
|
01028 IF L415-UC30H-FIRST-DEL-DATE NOT = ZERO DTSBE770
|
|
01029 MOVE L415-UC30H-FIRST-DEL-DATE TO DTSBE770
|
|
01030 WRK-ANN-DELINQUENT-DATE DTSBE770
|
|
01031 ELSE DTSBE770
|
|
01032 PERFORM I2610-ANN-DEL-DATE THRU I2610-EXIT DTSBE770
|
|
01033 END-IF DTSBE770
|
|
01034 ELSE DTSBE770
|
|
01035 PERFORM I2610-ANN-DEL-DATE THRU I2610-EXIT DTSBE770
|
|
01036 END-IF. DTSBE770
|
|
01037 DTSBE770
|
|
01038 DISPLAY 'ANNUAL DELINQUENT DATE : ' DTSBE770
|
|
01039 WRK-ANN-DELINQUENT-DATE. DTSBE770
|
|
01040 DTSBE770
|
|
01041 I2600-EXIT. DTSBE770
|
|
01042 EXIT. DTSBE770
|
|
01043 DTSBE770
|
|
01044 I2610-ANN-DEL-DATE. DTSBE770
|
|
01045 MOVE WRK-ANN-START TO L001-FED-8-DATE-9 DTSBE770
|
|
01046 ADD 1 TO L001-FED-8-YR DTSBE770
|
|
01047 MOVE 05 TO L001-FED-8-MO DTSBE770
|
|
01048 MOVE 31 TO L001-FED-8-DA DTSBE770
|
|
01049 ** DISPLAY 'I2600 FED DATE ' L001-FED-8-DATE-9 DTSBE770
|
|
01050 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE770
|
|
01051 MOVE L001-FED-8-DATE-9 TO WRK-ANN-DELINQUENT-DATE. DTSBE770
|
|
01052 DTSBE770
|
|
01053 I2610-EXIT. DTSBE770
|
|
01054 EXIT. DTSBE770
|
|
01055 DTSBE770
|
|
01056 I3000-WRITE-PARM. DTSBE770
|
|
01057 OPEN OUTPUT ETA581-PARM-FILE. DTSBE770
|
|
01058 IF NOT BE770-STATUS-OK-88 DTSBE770
|
|
01059 DISPLAY 'CANNOT OPEN PARM FILE ' BE770-STATUS DTSBE770
|
|
01060 PERFORM S999-ABEND THRU S999-EXIT. DTSBE770
|
|
01061 DTSBE770
|
|
01062 MOVE WRK-SUBJECT-QTR TO X770-SUBJECT-QTR. DTSBE770
|
|
01063 MOVE WRK-SUBJECT-QTR-START TO X770-SUBJECT-QTR-START. DTSBE770
|
|
01064 MOVE WRK-SUBJECT-QTR-END TO X770-SUBJECT-QTR-END. DTSBE770
|
|
01065 MOVE LECM-CURR-RUN-DATE TO X770-CURR-RUN-DATE. DTSBE770
|
|
01066 MOVE WRK-QTR1 TO X770-QTR1. DTSBE770
|
|
01067 MOVE WRK-QTR1-START TO X770-QTR1-START. DTSBE770
|
|
01068 MOVE WRK-QTR1-END TO X770-QTR1-END. DTSBE770
|
|
01069 MOVE WRK-QTR1-DUE-DATE TO X770-QTR1-DUE-DATE. DTSBE770
|
|
01070 MOVE WRK-QTR2 TO X770-QTR2. DTSBE770
|
|
01071 MOVE WRK-QTR2-START TO X770-QTR2-START. DTSBE770
|
|
01072 MOVE WRK-QTR2-END TO X770-QTR2-END. DTSBE770
|
|
01073 MOVE WRK-QTR2-DUE-DATE TO X770-QTR2-DUE-DATE. DTSBE770
|
|
01074 MOVE WRK-QTR3 TO X770-QTR3. DTSBE770
|
|
01075 MOVE WRK-QTR4 TO X770-QTR4. DTSBE770
|
|
01076 MOVE WRK-QTR5 TO X770-QTR5. DTSBE770
|
|
01077 MOVE WRK-QTR6 TO X770-QTR6. DTSBE770
|
|
01078 MOVE WRK-QTR7 TO X770-QTR7. DTSBE770
|
|
01079 MOVE WRK-QTR8 TO X770-QTR8. DTSBE770
|
|
01080 MOVE WRK-QTR-DELINQUENT-DATE TO X770-DELINQUENT-DATE. DTSBE770
|
|
01081 DTSBE770
|
|
01082 WRITE ETA581-PARM-REC. DTSBE770
|
|
01083 IF NOT BE770-STATUS-OK-88 DTSBE770
|
|
01084 DISPLAY 'CANNOT WRITE PARM RECORD ' BE770-STATUS DTSBE770
|
|
01085 PERFORM S999-ABEND THRU S999-EXIT. DTSBE770
|
|
01086 DTSBE770
|
|
01087 CLOSE ETA581-PARM-FILE. DTSBE770
|
|
01088 DTSBE770
|
|
01089 I3000-EXIT. DTSBE770
|
|
01090 EXIT. DTSBE770
|
|
01091 DTSBE770
|
|
01092 I3100-OPEN-FILES. DTSBE770
|
|
01093 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
01094 DTSBE770
|
|
01095 EVALUATE TRUE DTSBE770
|
|
01096 WHEN L004-QTR-5-Q = 1 DTSBE770
|
|
01097 OPEN OUTPUT TPS-STATUS-QTR1 DTSBE770
|
|
01098 DISPLAY 'OPENING TPS QTR 1 FILE' DTSBE770
|
|
01099 DTSBE770
|
|
01100 WHEN L004-QTR-5-Q = 2 DTSBE770
|
|
01101 OPEN OUTPUT TPS-STATUS-QTR2 DTSBE770
|
|
01102 DISPLAY 'OPENING TPS QTR 2 FILE' DTSBE770
|
|
01103 DTSBE770
|
|
01104 WHEN L004-QTR-5-Q = 3 DTSBE770
|
|
01105 OPEN OUTPUT TPS-STATUS-QTR3 DTSBE770
|
|
01106 DISPLAY 'OPENING TPS QTR 3 FILE' DTSBE770
|
|
01107 DTSBE770
|
|
01108 WHEN L004-QTR-5-Q = 4 DTSBE770
|
|
01109 OPEN OUTPUT TPS-STATUS-QTR4 DTSBE770
|
|
01110 DISPLAY 'OPENING TPS QTR 4 FILE' DTSBE770
|
|
01111 DTSBE770
|
|
01112 END-EVALUATE. DTSBE770
|
|
01113 DTSBE770
|
|
01114 IF NOT TPS-STAT-STATUS-OK-88 DTSBE770
|
|
01115 DISPLAY 'CANNOT OPEN TPS STATUS FILE ' TPS-STAT-STATUS DTSBE770
|
|
01116 ' ' WRK-SUBJECT-QTR DTSBE770
|
|
01117 PERFORM S999-ABEND THRU S999-EXIT DTSBE770
|
|
01118 END-IF. DTSBE770
|
|
01119 DTSBE770
|
|
01120 I3100-EXIT. DTSBE770
|
|
01121 EXIT. DTSBE770
|
|
01122 DTSBE770
|
|
01123 I4100-DISPLAY. DTSBE770
|
|
01124 DISPLAY ' WRK-SUBJECT-QTR: ' DTSBE770
|
|
01125 WRK-SUBJECT-QTR. DTSBE770
|
|
01126 DISPLAY ' WRK-RPT-QTR: ' DTSBE770
|
|
01127 WRK-RPT-QTR. DTSBE770
|
|
01128 DISPLAY ' SUBJECT QTR START : ' DTSBE770
|
|
01129 WRK-SUBJECT-QTR-START. DTSBE770
|
|
01130 DISPLAY ' SUBJECT QTR END : ' DTSBE770
|
|
01131 WRK-SUBJECT-QTR-END. DTSBE770
|
|
01132 DTSBE770
|
|
01133 DISPLAY ' FIRST WAGE QUARTER: ' DTSBE770
|
|
01134 WRK-QTR1. DTSBE770
|
|
01135 DTSBE770
|
|
01136 DISPLAY ' QTR1 DUE DATE : ' DTSBE770
|
|
01137 WRK-QTR1-DUE-DATE. DTSBE770
|
|
01138 DTSBE770
|
|
01139 DISPLAY ' SECOND WAGE QUARTER: ' DTSBE770
|
|
01140 WRK-QTR2. DTSBE770
|
|
01141 DTSBE770
|
|
01142 DISPLAY ' QTR2 DUE DATE : ' DTSBE770
|
|
01143 WRK-QTR2-DUE-DATE. DTSBE770
|
|
01144 DTSBE770
|
|
01145 DISPLAY ' THIRD WAGE QUARTER: ' DTSBE770
|
|
01146 WRK-QTR3. DTSBE770
|
|
01147 DTSBE770
|
|
01148 DISPLAY ' FOURTH WAGE QUARTER: ' DTSBE770
|
|
01149 WRK-QTR4. DTSBE770
|
|
01150 DTSBE770
|
|
01151 DISPLAY ' FIFTH WAGE QUARTER: ' DTSBE770
|
|
01152 WRK-QTR5. DTSBE770
|
|
01153 DTSBE770
|
|
01154 DISPLAY ' SIXTH WAGE QUARTER: ' DTSBE770
|
|
01155 WRK-QTR6. DTSBE770
|
|
01156 DTSBE770
|
|
01157 DISPLAY ' SEVENTH WAGE QUARTER: ' DTSBE770
|
|
01158 WRK-QTR7. DTSBE770
|
|
01159 DTSBE770
|
|
01160 DISPLAY ' EIGHTH WAGE QUARTER: ' DTSBE770
|
|
01161 WRK-QTR8. DTSBE770
|
|
01162 I4100-EXIT. DTSBE770
|
|
01163 EXIT. DTSBE770
|
|
01164 EJECT DTSBE770
|
|
01165 P0000-PROCESS. DTSBE770
|
|
01166 IF MPRF-CLASS-SUB-88 DTSBE770
|
|
01167 NEXT SENTENCE DTSBE770
|
|
01168 ELSE DTSBE770
|
|
01169 GO TO P0000-EXIT. DTSBE770
|
|
01170 DTSBE770
|
|
01171 PERFORM P1000-ACTIVE-EMPLOYERS THRU P1000-EXIT. DTSBE770
|
|
01172 DTSBE770
|
|
01173 PERFORM P2000-REPORT-FILING THRU P2000-EXIT. DTSBE770
|
|
01174 DTSBE770
|
|
01175 PERFORM P3000-STATUS-DETERMINATIONS THRU P3000-EXIT. DTSBE770
|
|
01176 DTSBE770
|
|
01177 PERFORM P4000-ACCTS-RECEIVABLE THRU P4000-EXIT. DTSBE770
|
|
01178 DTSBE770
|
|
01179 PERFORM P5000-AUDIT-ACTIVITY THRU P5000-EXIT. DTSBE770
|
|
01180 DTSBE770
|
|
01181 PERFORM P9000-OUTSTANDING-QTRS THRU P9000-EXIT. DTSBE770
|
|
01182 DTSBE770
|
|
01183 PERFORM P9100-SUTA-DUMPING THRU P9100-EXIT. DTSBE770
|
|
01184 DTSBE770
|
|
01185 P0000-EXIT. DTSBE770
|
|
01186 EXIT. DTSBE770
|
|
01187 DTSBE770
|
|
01188 P1000-ACTIVE-EMPLOYERS. DTSBE770
|
|
01189 MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND. DTSBE770
|
|
01190 **** MOVE WRK-ALL-NINES-DATE TO WRK-LIAB-DATE. DTSBE770
|
|
01191 MOVE ZERO TO WRK-LIAB-DATE DTSBE770
|
|
01192 WRK-LAST-INACT-DATE DTSBE770
|
|
01193 **** WRK-REOPEN-DATE DTSBE770
|
|
01194 WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01195 WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
01196 WRK-LIAB-QTR-CNT DTSBE770
|
|
01197 WRK-RPT-RCVD-CNT DTSBE770
|
|
01198 WRK-ZERO-WAGE-CNT DTSBE770
|
|
01199 WRK-QTR-WAGE-TOT. DTSBE770
|
|
01200 DTSBE770
|
|
01201 SET WRK-8-QTRS-ZERO-WAGES-YES TO TRUE. DTSBE770
|
|
01202 SET WRK-PREV-INACTIVE-NO-88 TO TRUE. DTSBE770
|
|
01203 DTSBE770
|
|
01204 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
01205 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
01206 SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
01207 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01208 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
01209 PERFORM P1100-SCAN-MSOL THRU P1100-EXIT DTSBE770
|
|
01210 UNTIL (L910-NO-REC-88). DTSBE770
|
|
01211 DTSBE770
|
|
01212 IF WRK-ACTIVE-DURING-PERIOD-IND = 'N' DTSBE770
|
|
01213 GO TO P1000-EXIT DTSBE770
|
|
01214 ELSE DTSBE770
|
|
01215 ADD +1 TO WRK-ACT-CNT DTSBE770
|
|
01216 END-IF. DTSBE770
|
|
01217 DTSBE770
|
|
01218 IF WRK-LAST-INACT-DATE > ZERO DTSBE770
|
|
01219 IF WRK-REOPEN-PROCESS-DATE = ZERO DTSBE770
|
|
01220 MOVE WRK-LIAB-PROCESS-DATE TO DTSBE770
|
|
01221 WRK-REOPEN-PROCESS-DATE. DTSBE770
|
|
01222 DTSBE770
|
|
01223 PERFORM P1200-WAGES THRU P1200-EXIT. DTSBE770
|
|
01224 DTSBE770
|
|
01225 IF WRK-ZERO-WAGE-CNT > +7 DTSBE770
|
|
01226 ADD +1 TO WRK-0-WAGE-CNT DTSBE770
|
|
01227 GO TO P1000-EXIT DTSBE770
|
|
01228 END-IF. DTSBE770
|
|
01229 DTSBE770
|
|
01230 IF WRK-LIAB-QTR-CNT = 0 DTSBE770
|
|
01231 ADD +1 TO WRK-NOT-LIAB-CNT DTSBE770
|
|
01232 GO TO P1000-EXIT DTSBE770
|
|
01233 END-IF. DTSBE770
|
|
01234 DTSBE770
|
|
01235 IF WRK-RPT-RCVD-CNT = 0 DTSBE770
|
|
01236 ADD +1 TO WRK-DELINQ-CNT DTSBE770
|
|
01237 GO TO P1000-EXIT DTSBE770
|
|
01238 END-IF. DTSBE770
|
|
01239 DTSBE770
|
|
01240 PERFORM P1400-WRITE-Y771 THRU P1400-EXIT. DTSBE770
|
|
01241 DTSBE770
|
|
01242 P1000-EXIT. DTSBE770
|
|
01243 EXIT. DTSBE770
|
|
01244 DTSBE770
|
|
01245 P1100-SCAN-MSOL. DTSBE770
|
|
01246 MOVE MSKL-REC TO MSOL-REC. DTSBE770
|
|
01247 DTSBE770
|
|
01248 ***** DTSBE770
|
|
01249 * DTSBE770
|
|
01250 * TO BE COUNTED AS ACTIVE, THE EMPLOYER MUST BE ACTIVE DTSBE770
|
|
01251 * ON THE LAST DAY OF THE REPORTING PERIOD. DTSBE770
|
|
01252 * DTSBE770
|
|
01253 ***** DTSBE770
|
|
01254 DTSBE770
|
|
01255 IF MSOL-INACT-WITHDRAWN-88 DTSBE770
|
|
01256 NEXT SENTENCE DTSBE770
|
|
01257 ELSE DTSBE770
|
|
01258 PERFORM P1110-CHECK-DATES THRU P1110-EXIT DTSBE770
|
|
01259 END-IF. DTSBE770
|
|
01260 DTSBE770
|
|
01261 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
01262 P1100-EXIT. DTSBE770
|
|
01263 EXIT. DTSBE770
|
|
01264 DTSBE770
|
|
01265 P1110-CHECK-DATES. DTSBE770
|
|
01266 IF MSOL-INACT-INACTIVE-88 DTSBE770
|
|
01267 IF MSOL-INACT-DATE <= WRK-SUBJECT-QTR-START DTSBE770
|
|
01268 IF MSOL-INACT-DATE > WRK-LAST-INACT-DATE DTSBE770
|
|
01269 MOVE MSOL-INACT-DATE TO WRK-LAST-INACT-DATE DTSBE770
|
|
01270 END-IF DTSBE770
|
|
01271 END-IF DTSBE770
|
|
01272 GO TO P1110-EXIT DTSBE770
|
|
01273 END-IF. DTSBE770
|
|
01274 DTSBE770
|
|
01275 IF MSOL-INACT-DATE < WRK-SUBJECT-QTR-START DTSBE770
|
|
01276 OR MSOL-LIAB-DATE > WRK-SUBJECT-QTR-END DTSBE770
|
|
01277 NEXT SENTENCE DTSBE770
|
|
01278 ELSE DTSBE770
|
|
01279 MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01280 IF MSOL-LIAB-DATE > WRK-LIAB-DATE DTSBE770
|
|
01281 MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE DTSBE770
|
|
01282 IF MSOL-ESTB-DATE = ZERO DTSBE770
|
|
01283 MOVE MSOL-LIAB-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01284 ELSE DTSBE770
|
|
01285 IF MSOL-LIAB-DATE > MSOL-ESTB-DATE DTSBE770
|
|
01286 MOVE MSOL-CHNG-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01287 ELSE DTSBE770
|
|
01288 MOVE MSOL-ESTB-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01289 END-IF DTSBE770
|
|
01290 END-IF DTSBE770
|
|
01291 IF MSOL-INACT-REVERSE-DATE > MSOL-LIAB-DATE DTSBE770
|
|
01292 MOVE MSOL-INACT-REVERSE-DATE TO DTSBE770
|
|
01293 WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01294 WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
01295 END-IF DTSBE770
|
|
01296 END-IF DTSBE770
|
|
01297 END-IF. DTSBE770
|
|
01298 DTSBE770
|
|
01299 *** IF MSOL-INACT-INACTIVE-88 DTSBE770
|
|
01300 * IF MSOL-INACT-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
01301 * IF MSOL-INACT-DATE > WRK-LAST-INACT-DATE DTSBE770
|
|
01302 * MOVE MSOL-INACT-DATE TO WRK-LAST-INACT-DATE DTSBE770
|
|
01303 * END-IF DTSBE770
|
|
01304 * END-IF DTSBE770
|
|
01305 * GO TO P1110-EXIT DTSBE770
|
|
01306 * END-IF. DTSBE770
|
|
01307 * DTSBE770
|
|
01308 * IF MSOL-INACT-DATE < WRK-SUBJECT-QTR-END DTSBE770
|
|
01309 * OR MSOL-LIAB-DATE > WRK-SUBJECT-QTR-END DTSBE770
|
|
01310 * NEXT SENTENCE DTSBE770
|
|
01311 * ELSE DTSBE770
|
|
01312 * MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01313 * IF MSOL-LIAB-DATE > WRK-LIAB-DATE DTSBE770
|
|
01314 * MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE DTSBE770
|
|
01315 * IF MSOL-ESTB-DATE = ZERO DTSBE770
|
|
01316 * MOVE MSOL-LIAB-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01317 * ELSE DTSBE770
|
|
01318 * IF MSOL-LIAB-DATE > MSOL-ESTB-DATE DTSBE770
|
|
01319 * MOVE MSOL-CHNG-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01320 * ELSE DTSBE770
|
|
01321 * MOVE MSOL-ESTB-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01322 * END-IF DTSBE770
|
|
01323 * END-IF DTSBE770
|
|
01324 * IF MSOL-INACT-REVERSE-DATE > MSOL-LIAB-DATE DTSBE770
|
|
01325 * MOVE MSOL-INACT-REVERSE-DATE TO DTSBE770
|
|
01326 * WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01327 * WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
01328 * END-IF DTSBE770
|
|
01329 * END-IF DTSBE770
|
|
01330 *** END-IF. DTSBE770
|
|
01331 DTSBE770
|
|
01332 P1110-EXIT. DTSBE770
|
|
01333 EXIT. DTSBE770
|
|
01334 DTSBE770
|
|
01335 P1200-WAGES. DTSBE770
|
|
01336 PERFORM DTSBE770
|
|
01337 VARYING WGE-SUB FROM +1 BY +1 DTSBE770
|
|
01338 UNTIL WGE-SUB > +8 DTSBE770
|
|
01339 MOVE ZERO TO WRK-QTR-WAGE-AMT (WGE-SUB) DTSBE770
|
|
01340 SET WRK-QTR-NOT-LIAB-88 (WGE-SUB) TO TRUE DTSBE770
|
|
01341 END-PERFORM. DTSBE770
|
|
01342 DTSBE770
|
|
01343 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
01344 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
01345 SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
01346 ** MOVE WRK-QTR8 TO MQTR-YRQ. DTSBE770
|
|
01347 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01348 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
01349 PERFORM DTSBE770
|
|
01350 UNTIL L910-NO-REC-88 DTSBE770
|
|
01351 MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
01352 IF MQTR-YRQ > WRK-QTR1 DTSBE770
|
|
01353 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
01354 ELSE DTSBE770
|
|
01355 PERFORM P1210-MOVE-WAGES THRU P1210-EXIT DTSBE770
|
|
01356 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
01357 END-IF DTSBE770
|
|
01358 END-PERFORM. DTSBE770
|
|
01359 DTSBE770
|
|
01360 IF WRK-QTR-WAGE-TOT = ZERO DTSBE770
|
|
01361 ADD +1 TO WRK-QTR-WAGE-AMT (1) DTSBE770
|
|
01362 END-IF. DTSBE770
|
|
01363 ** SET WRK-SCAN-COMPLETE-NO-88 TO TRUE. DTSBE770
|
|
01364 PERFORM DTSBE770
|
|
01365 VARYING WGE-SUB FROM +1 BY +1 DTSBE770
|
|
01366 UNTIL WGE-SUB > +8 DTSBE770
|
|
01367 ADD WRK-QTR-WAGE-AMT (WGE-SUB) TO WRK-QTR-WAGE-TOT DTSBE770
|
|
01368 DTSBE770
|
|
01369 IF WRK-QTR-RCVD-88 (WGE-SUB) DTSBE770
|
|
01370 ADD 1 TO WRK-RPT-RCVD-CNT DTSBE770
|
|
01371 IF WRK-QTR-WAGE-AMT (WGE-SUB) = ZERO DTSBE770
|
|
01372 ADD 1 TO WRK-ZERO-WAGE-CNT DTSBE770
|
|
01373 END-IF DTSBE770
|
|
01374 END-IF DTSBE770
|
|
01375 *** IF WRK-QTR-RCVD-88 (WGE-SUB) DTSBE770
|
|
01376 * ADD 1 TO WRK-LIAB-QTR-CNT DTSBE770
|
|
01377 * ADD 1 TO WRK-RPT-RCVD-CNT DTSBE770
|
|
01378 * IF WRK-QTR-WAGE-AMT (WGE-SUB) = ZERO DTSBE770
|
|
01379 * ADD 1 TO WRK-ZERO-WAGE-CNT DTSBE770
|
|
01380 * END-IF DTSBE770
|
|
01381 * ELSE DTSBE770
|
|
01382 * IF WRK-QTR-NOT-LIAB-88 (WGE-SUB) DTSBE770
|
|
01383 * MOVE +0 TO WRK-LIAB-QTR-CNT DTSBE770
|
|
01384 * ELSE DTSBE770
|
|
01385 * IF WRK-QTR-DELINQ-88 (WGE-SUB) DTSBE770
|
|
01386 * ADD 1 TO WRK-LIAB-QTR-CNT DTSBE770
|
|
01387 * END-IF DTSBE770
|
|
01388 ** END-IF DTSBE770
|
|
01389 *** END-IF DTSBE770
|
|
01390 ** IF WRK-QTR-RCVD-88 (WGE-SUB) DTSBE770
|
|
01391 * IF WRK-SCAN-COMPLETE-NO-88 DTSBE770
|
|
01392 * ADD 1 TO WRK-LIAB-QTR-CNT DTSBE770
|
|
01393 * END-IF DTSBE770
|
|
01394 * IF WRK-QTR-WAGE-AMT (WGE-SUB) = ZERO DTSBE770
|
|
01395 * ADD 1 TO WRK-ZERO-WAGE-CNT DTSBE770
|
|
01396 * END-IF DTSBE770
|
|
01397 * ELSE DTSBE770
|
|
01398 * SET WRK-SCAN-COMPLETE-YES-88 TO TRUE DTSBE770
|
|
01399 ** END-IF DTSBE770
|
|
01400 END-PERFORM. DTSBE770
|
|
01401 DTSBE770
|
|
01402 P1200-EXIT. DTSBE770
|
|
01403 EXIT. DTSBE770
|
|
01404 DTSBE770
|
|
01405 P1210-MOVE-WAGES. DTSBE770
|
|
01406 IF MQTR-YRQ < WRK-QTR8 DTSBE770
|
|
01407 GO TO P1210-EXIT DTSBE770
|
|
01408 END-IF. DTSBE770
|
|
01409 DTSBE770
|
|
01410 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01411 OR MQTR-CURR-MISSING-88 DTSBE770
|
|
01412 ADD 1 TO WRK-LIAB-QTR-CNT DTSBE770
|
|
01413 ELSE DTSBE770
|
|
01414 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01415 MOVE +0 TO WRK-LIAB-QTR-CNT DTSBE770
|
|
01416 END-IF DTSBE770
|
|
01417 END-IF. DTSBE770
|
|
01418 DTSBE770
|
|
01419 EVALUATE TRUE DTSBE770
|
|
01420 WHEN MQTR-YRQ = WRK-QTR1 DTSBE770
|
|
01421 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01422 MOVE MQTR-TOT-WAGE TO WRK-QTR1-WAGES DTSBE770
|
|
01423 SET WRK-QTR1-RCVD-88 TO TRUE DTSBE770
|
|
01424 ADD +1 TO WRK-TOT-RPT-RCVD-CNT DTSBE770
|
|
01425 ELSE DTSBE770
|
|
01426 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01427 SET WRK-QTR1-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01428 ELSE DTSBE770
|
|
01429 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01430 SET WRK-QTR1-DELINQ-88 TO TRUE DTSBE770
|
|
01431 END-IF DTSBE770
|
|
01432 END-IF DTSBE770
|
|
01433 END-IF DTSBE770
|
|
01434 DTSBE770
|
|
01435 WHEN MQTR-YRQ = WRK-QTR2 DTSBE770
|
|
01436 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01437 MOVE MQTR-TOT-WAGE TO WRK-QTR2-WAGES DTSBE770
|
|
01438 SET WRK-QTR2-RCVD-88 TO TRUE DTSBE770
|
|
01439 ELSE DTSBE770
|
|
01440 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01441 SET WRK-QTR2-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01442 ELSE DTSBE770
|
|
01443 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01444 SET WRK-QTR2-DELINQ-88 TO TRUE DTSBE770
|
|
01445 END-IF DTSBE770
|
|
01446 END-IF DTSBE770
|
|
01447 END-IF DTSBE770
|
|
01448 DTSBE770
|
|
01449 WHEN MQTR-YRQ = WRK-QTR3 DTSBE770
|
|
01450 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01451 MOVE MQTR-TOT-WAGE TO WRK-QTR3-WAGES DTSBE770
|
|
01452 SET WRK-QTR3-RCVD-88 TO TRUE DTSBE770
|
|
01453 ELSE DTSBE770
|
|
01454 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01455 SET WRK-QTR3-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01456 ELSE DTSBE770
|
|
01457 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01458 SET WRK-QTR3-DELINQ-88 TO TRUE DTSBE770
|
|
01459 END-IF DTSBE770
|
|
01460 END-IF DTSBE770
|
|
01461 END-IF DTSBE770
|
|
01462 DTSBE770
|
|
01463 WHEN MQTR-YRQ = WRK-QTR4 DTSBE770
|
|
01464 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01465 MOVE MQTR-TOT-WAGE TO WRK-QTR4-WAGES DTSBE770
|
|
01466 SET WRK-QTR4-RCVD-88 TO TRUE DTSBE770
|
|
01467 ELSE DTSBE770
|
|
01468 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01469 SET WRK-QTR4-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01470 ELSE DTSBE770
|
|
01471 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01472 SET WRK-QTR4-DELINQ-88 TO TRUE DTSBE770
|
|
01473 END-IF DTSBE770
|
|
01474 END-IF DTSBE770
|
|
01475 END-IF DTSBE770
|
|
01476 DTSBE770
|
|
01477 WHEN MQTR-YRQ = WRK-QTR5 DTSBE770
|
|
01478 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01479 MOVE MQTR-TOT-WAGE TO WRK-QTR5-WAGES DTSBE770
|
|
01480 SET WRK-QTR5-RCVD-88 TO TRUE DTSBE770
|
|
01481 ELSE DTSBE770
|
|
01482 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01483 SET WRK-QTR5-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01484 ELSE DTSBE770
|
|
01485 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01486 SET WRK-QTR5-DELINQ-88 TO TRUE DTSBE770
|
|
01487 END-IF DTSBE770
|
|
01488 END-IF DTSBE770
|
|
01489 END-IF DTSBE770
|
|
01490 DTSBE770
|
|
01491 WHEN MQTR-YRQ = WRK-QTR6 DTSBE770
|
|
01492 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01493 MOVE MQTR-TOT-WAGE TO WRK-QTR6-WAGES DTSBE770
|
|
01494 SET WRK-QTR6-RCVD-88 TO TRUE DTSBE770
|
|
01495 ELSE DTSBE770
|
|
01496 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01497 SET WRK-QTR6-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01498 ELSE DTSBE770
|
|
01499 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01500 SET WRK-QTR6-DELINQ-88 TO TRUE DTSBE770
|
|
01501 END-IF DTSBE770
|
|
01502 END-IF DTSBE770
|
|
01503 END-IF DTSBE770
|
|
01504 DTSBE770
|
|
01505 WHEN MQTR-YRQ = WRK-QTR7 DTSBE770
|
|
01506 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01507 MOVE MQTR-TOT-WAGE TO WRK-QTR7-WAGES DTSBE770
|
|
01508 SET WRK-QTR7-RCVD-88 TO TRUE DTSBE770
|
|
01509 ELSE DTSBE770
|
|
01510 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01511 SET WRK-QTR7-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01512 ELSE DTSBE770
|
|
01513 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01514 SET WRK-QTR7-DELINQ-88 TO TRUE DTSBE770
|
|
01515 END-IF DTSBE770
|
|
01516 END-IF DTSBE770
|
|
01517 END-IF DTSBE770
|
|
01518 DTSBE770
|
|
01519 WHEN MQTR-YRQ = WRK-QTR8 DTSBE770
|
|
01520 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01521 MOVE MQTR-TOT-WAGE TO WRK-QTR8-WAGES DTSBE770
|
|
01522 SET WRK-QTR8-RCVD-88 TO TRUE DTSBE770
|
|
01523 ELSE DTSBE770
|
|
01524 IF MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01525 SET WRK-QTR8-NOT-LIAB-88 TO TRUE DTSBE770
|
|
01526 ELSE DTSBE770
|
|
01527 IF MQTR-CURR-MISSING-88 DTSBE770
|
|
01528 SET WRK-QTR8-DELINQ-88 TO TRUE DTSBE770
|
|
01529 END-IF DTSBE770
|
|
01530 END-IF DTSBE770
|
|
01531 END-IF DTSBE770
|
|
01532 DTSBE770
|
|
01533 END-EVALUATE. DTSBE770
|
|
01534 DTSBE770
|
|
01535 ** WHEN MQTR-YRQ = WRK-QTR1 DTSBE770
|
|
01536 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01537 * MOVE MQTR-TOT-WAGE TO WRK-QTR1-WAGES DTSBE770
|
|
01538 * SET WRK-QTR1-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01539 * END-IF DTSBE770
|
|
01540 * DTSBE770
|
|
01541 * WHEN MQTR-YRQ = WRK-QTR2 DTSBE770
|
|
01542 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01543 * MOVE MQTR-TOT-WAGE TO WRK-QTR2-WAGES DTSBE770
|
|
01544 * SET WRK-QTR2-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01545 * END-IF DTSBE770
|
|
01546 * DTSBE770
|
|
01547 * WHEN MQTR-YRQ = WRK-QTR3 DTSBE770
|
|
01548 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01549 * MOVE MQTR-TOT-WAGE TO WRK-QTR3-WAGES DTSBE770
|
|
01550 * SET WRK-QTR3-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01551 * END-IF DTSBE770
|
|
01552 * DTSBE770
|
|
01553 * WHEN MQTR-YRQ = WRK-QTR4 DTSBE770
|
|
01554 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01555 * MOVE MQTR-TOT-WAGE TO WRK-QTR4-WAGES DTSBE770
|
|
01556 * SET WRK-QTR4-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01557 * END-IF DTSBE770
|
|
01558 * DTSBE770
|
|
01559 * WHEN MQTR-YRQ = WRK-QTR5 DTSBE770
|
|
01560 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01561 * MOVE MQTR-TOT-WAGE TO WRK-QTR5-WAGES DTSBE770
|
|
01562 * SET WRK-QTR5-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01563 * END-IF DTSBE770
|
|
01564 * DTSBE770
|
|
01565 * WHEN MQTR-YRQ = WRK-QTR6 DTSBE770
|
|
01566 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01567 * MOVE MQTR-TOT-WAGE TO WRK-QTR6-WAGES DTSBE770
|
|
01568 * SET WRK-QTR6-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01569 * END-IF DTSBE770
|
|
01570 * DTSBE770
|
|
01571 * WHEN MQTR-YRQ = WRK-QTR7 DTSBE770
|
|
01572 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01573 * MOVE MQTR-TOT-WAGE TO WRK-QTR7-WAGES DTSBE770
|
|
01574 * SET WRK-QTR7-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01575 * END-IF DTSBE770
|
|
01576 * DTSBE770
|
|
01577 * WHEN MQTR-YRQ = WRK-QTR8 DTSBE770
|
|
01578 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01579 * MOVE MQTR-TOT-WAGE TO WRK-QTR8-WAGES DTSBE770
|
|
01580 * SET WRK-QTR8-STATUS-RCVD-88 TO TRUE DTSBE770
|
|
01581 * END-IF DTSBE770
|
|
01582 * DTSBE770
|
|
01583 ** END-EVALUATE. DTSBE770
|
|
01584 DTSBE770
|
|
01585 P1210-EXIT. DTSBE770
|
|
01586 EXIT. DTSBE770
|
|
01587 DTSBE770
|
|
01588 P1400-WRITE-Y771. DTSBE770
|
|
01589 MOVE LENGTH OF Y771-REC TO Y771-LENGTH. DTSBE770
|
|
01590 SET Y771-REC-TYPE-771-88 TO TRUE. DTSBE770
|
|
01591 DTSBE770
|
|
01592 ADD +1 TO WRK-Y771-CNT. DTSBE770
|
|
01593 DTSBE770
|
|
01594 MOVE MPRF-EMP-NO TO Y771-EMP-NO. DTSBE770
|
|
01595 SET Y771-STATUS-ACTIVE-88 TO TRUE. DTSBE770
|
|
01596 DTSBE770
|
|
01597 IF MPRF-CLASS-RATED-88 DTSBE770
|
|
01598 SET Y771-CLASS-RATED-88 TO TRUE DTSBE770
|
|
01599 ELSE DTSBE770
|
|
01600 IF MPRF-CLASS-SELF-INS-88 DTSBE770
|
|
01601 SET Y771-CLASS-SELF-INS-88 TO TRUE DTSBE770
|
|
01602 ELSE DTSBE770
|
|
01603 DISPLAY 'INVALID EMPLOYER CLASS ' MPRF-EMP-NO DTSBE770
|
|
01604 ' CLASS: ' MPRF-EMP-CLASS DTSBE770
|
|
01605 GO TO P1400-EXIT. DTSBE770
|
|
01606 DTSBE770
|
|
01607 IF WRK-LIAB-PROCESS-DATE = ZERO DTSBE770
|
|
01608 MOVE WRK-LIAB-DATE TO WRK-LIAB-PROCESS-DATE. DTSBE770
|
|
01609 DTSBE770
|
|
01610 ***************************************************************** DTSBE770
|
|
01611 * EDIT TO CORRECT LIABILITY DETERMINATIONS ENTERED WITH FUTURE DTSBE770
|
|
01612 * LIABILITY DATES. DTSBE770
|
|
01613 ********************** DTSBE770
|
|
01614 IF WRK-LIAB-DATE > WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01615 ADD +1 TO WRK-CNT1 DTSBE770
|
|
01616 MOVE WRK-LIAB-DATE TO WRK-LIAB-PROCESS-DATE. DTSBE770
|
|
01617 DTSBE770
|
|
01618 IF WRK-REOPEN-PROCESS-DATE > ZERO DTSBE770
|
|
01619 IF WRK-LIAB-DATE > WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
01620 ADD +1 TO WRK-CNT2 DTSBE770
|
|
01621 MOVE WRK-LIAB-DATE TO WRK-REOPEN-PROCESS-DATE. DTSBE770
|
|
01622 ********************** DTSBE770
|
|
01623 DTSBE770
|
|
01624 MOVE WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
01625 TO Y771-REOPEN-PROCESS-DATE DTSBE770
|
|
01626 MOVE WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01627 TO Y771-PROCESS-DATE. DTSBE770
|
|
01628 DTSBE770
|
|
01629 MOVE WRK-LIAB-DATE TO Y771-LIAB-DATE. DTSBE770
|
|
01630 DTSBE770
|
|
01631 **** MOVE WRK-REOPEN-DATE TO Y771-REOPEN-DATE. DTSBE770
|
|
01632 DTSBE770
|
|
01633 DTSBE770
|
|
01634 * IF WRK-REOPEN-PROCESS-DATE = ZERO DTSBE770
|
|
01635 * MOVE WRK-REOPEN-DATE TO WRK-REOPEN-PROCESS-DATE. DTSBE770
|
|
01636 DTSBE770
|
|
01637 * IF WRK-REOPEN-DATE NOT = WRK-LIAB-DATE DTSBE770
|
|
01638 * IF WRK-REOPEN-PROCESS-DATE < WRK-REOPEN-DATE DTSBE770
|
|
01639 * MOVE WRK-REOPEN-DATE DTSBE770
|
|
01640 * TO Y771-PROCESS-DATE DTSBE770
|
|
01641 * ELSE DTSBE770
|
|
01642 * MOVE WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
01643 * TO Y771-PROCESS-DATE DTSBE770
|
|
01644 * END-IF DTSBE770
|
|
01645 * ELSE DTSBE770
|
|
01646 * IF WRK-LIAB-PROCESS-DATE < WRK-LIAB-DATE DTSBE770
|
|
01647 * MOVE WRK-LIAB-DATE DTSBE770
|
|
01648 * TO Y771-PROCESS-DATE DTSBE770
|
|
01649 * ELSE DTSBE770
|
|
01650 * MOVE WRK-LIAB-PROCESS-DATE DTSBE770
|
|
01651 * TO Y771-PROCESS-DATE DTSBE770
|
|
01652 * END-IF DTSBE770
|
|
01653 * END-IF. DTSBE770
|
|
01654 DTSBE770
|
|
01655 MOVE WRK-LAST-INACT-DATE TO Y771-INACTIVE-DATE. DTSBE770
|
|
01656 DTSBE770
|
|
01657 IF WRK-LIAB-QTR-CNT > +8 DTSBE770
|
|
01658 MOVE 8 TO Y771-LIAB-QTR-CNT DTSBE770
|
|
01659 ELSE DTSBE770
|
|
01660 MOVE WRK-LIAB-QTR-CNT TO Y771-LIAB-QTR-CNT. DTSBE770
|
|
01661 DTSBE770
|
|
01662 MOVE WRK-QTR1-WAGES TO Y771-QTR1-WAGES. DTSBE770
|
|
01663 MOVE WRK-QTR2-WAGES TO Y771-QTR2-WAGES. DTSBE770
|
|
01664 MOVE WRK-QTR3-WAGES TO Y771-QTR3-WAGES. DTSBE770
|
|
01665 MOVE WRK-QTR4-WAGES TO Y771-QTR4-WAGES. DTSBE770
|
|
01666 MOVE WRK-QTR5-WAGES TO Y771-QTR5-WAGES. DTSBE770
|
|
01667 MOVE WRK-QTR6-WAGES TO Y771-QTR6-WAGES. DTSBE770
|
|
01668 MOVE WRK-QTR7-WAGES TO Y771-QTR7-WAGES. DTSBE770
|
|
01669 MOVE WRK-QTR8-WAGES TO Y771-QTR8-WAGES. DTSBE770
|
|
01670 DTSBE770
|
|
01671 PERFORM S771-WRITE-R771 THRU S771-EXIT. DTSBE770
|
|
01672 DTSBE770
|
|
01673 DTSBE770
|
|
01674 P1400-EXIT. DTSBE770
|
|
01675 EXIT. DTSBE770
|
|
01676 DTSBE770
|
|
01677 P2000-REPORT-FILING. DTSBE770
|
|
01678 SET WRK-SELECT-NO-88 TO TRUE. DTSBE770
|
|
01679 SET WRK-ANN-DEFAULT-NO-88 TO TRUE. DTSBE770
|
|
01680 SET WRK-ANN-RESOLVED-NO-88 TO TRUE. DTSBE770
|
|
01681 SET WRK-MSOL-LIAB-CHNG-NO-88 TO TRUE. DTSBE770
|
|
01682 SET WRK-MSOL-INACT-CHNG-NO-88 TO TRUE. DTSBE770
|
|
01683 SET WRK-MSOL-WITHDRAWN-NO-88 TO TRUE. DTSBE770
|
|
01684 DTSBE770
|
|
01685 MOVE ZERO TO WRK-P2310-LIAB-DATE DTSBE770
|
|
01686 WRK-P2411-LIAB-DATE DTSBE770
|
|
01687 WRK-P2411-INACT-DATE DTSBE770
|
|
01688 WRK-P2411-INACT-ENTER-DATE DTSBE770
|
|
01689 WRK-P2412-LIAB-DATE DTSBE770
|
|
01690 WRK-P2412-INACT-DATE DTSBE770
|
|
01691 WRK-P2412-INACT-ENTER-DATE DTSBE770
|
|
01692 WRK-P2413-LIAB-DATE DTSBE770
|
|
01693 WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
01694 WRK-ESTIM-RPT-RCVD-DATE. DTSBE770
|
|
01695 DTSBE770
|
|
01696 MOVE WRK-QTR2 TO WRK-QTR. DTSBE770
|
|
01697 MOVE WRK-QTR2-START TO WRK-QTR-START. DTSBE770
|
|
01698 MOVE WRK-QTR2-END TO WRK-QTR-END. DTSBE770
|
|
01699 SET L410-NULL-SCHED-88 TO TRUE. DTSBE770
|
|
01700 PERFORM P2100-SELECT-EMP THRU P2100-EXIT. DTSBE770
|
|
01701 DTSBE770
|
|
01702 EVALUATE TRUE DTSBE770
|
|
01703 WHEN (WRK-SELECT-RCVD-88 DTSBE770
|
|
01704 OR WRK-SELECT-ESTIM-88) DTSBE770
|
|
01705 PERFORM P2200-GET-RPT-DATES THRU P2200-EXIT DTSBE770
|
|
01706 PERFORM P2300-LIAB-DATE THRU P2300-EXIT DTSBE770
|
|
01707 PERFORM P2500-BUILD-Y772 THRU P2500-EXIT DTSBE770
|
|
01708 DTSBE770
|
|
01709 WHEN WRK-SELECT-MISSING-88 DTSBE770
|
|
01710 PERFORM P2400-MSOL-CHANGE THRU P2400-EXIT DTSBE770
|
|
01711 IF WRK-SELECT-MISSING-88 DTSBE770
|
|
01712 ADD +1 TO WRK-MISSING-CNT DTSBE770
|
|
01713 ELSE DTSBE770
|
|
01714 PERFORM P2500-BUILD-Y772 THRU P2500-EXIT DTSBE770
|
|
01715 END-IF DTSBE770
|
|
01716 DTSBE770
|
|
01717 END-EVALUATE. DTSBE770
|
|
01718 DTSBE770
|
|
01719 IF WRK-SELECT-NO-88 DTSBE770
|
|
01720 ADD +1 TO WRK-NOT-SELECTED-CNT. DTSBE770
|
|
01721 DTSBE770
|
|
01722 MOVE WRK-QTR1 TO WRK-QTR. DTSBE770
|
|
01723 MOVE WRK-QTR1-START TO WRK-QTR-START. DTSBE770
|
|
01724 MOVE WRK-QTR1-END TO WRK-QTR-END. DTSBE770
|
|
01725 PERFORM P2600-ETA581-ONLY THRU P2600-EXIT. DTSBE770
|
|
01726 IF WRK-SELECT-581-ONLY-88 DTSBE770
|
|
01727 ADD +1 TO WRK-SELECT-581-CNT DTSBE770
|
|
01728 PERFORM P2200-GET-RPT-DATES THRU P2200-EXIT DTSBE770
|
|
01729 PERFORM P2500-BUILD-Y772 THRU P2500-EXIT DTSBE770
|
|
01730 END-IF. DTSBE770
|
|
01731 DTSBE770
|
|
01732 DTSBE770
|
|
01733 P2000-EXIT. DTSBE770
|
|
01734 EXIT. DTSBE770
|
|
01735 DTSBE770
|
|
01736 P2100-SELECT-EMP. DTSBE770
|
|
01737 SET WRK-ANN-RPT-RCVD-NO-88 TO TRUE. DTSBE770
|
|
01738 SET WRK-ANN-RPT-ESTIM-NO-88 TO TRUE. DTSBE770
|
|
01739 SET WRK-ANN-RPT-MISSING-NO-88 TO TRUE. DTSBE770
|
|
01740 DTSBE770
|
|
01741 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBE770
|
|
01742 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBE770
|
|
01743 MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBE770
|
|
01744 MOVE WRK-QTR TO L410-YRQ DTSBE770
|
|
01745 PERFORM S410-FILE-SCHED THRU S410-EXIT DTSBE770
|
|
01746 IF L410-ANN-SCHED-88 DTSBE770
|
|
01747 ADD +1 TO WRK-ANN-FILER-CNT DTSBE770
|
|
01748 PERFORM P2122-ANN-DEFAULT THRU P2122-EXIT DTSBE770
|
|
01749 *** PERFORM P2120-ANNUAL THRU P2120-EXIT DTSBE770
|
|
01750 ELSE DTSBE770
|
|
01751 PERFORM P2110-QTRLY THRU P2110-EXIT DTSBE770
|
|
01752 END-IF DTSBE770
|
|
01753 ELSE DTSBE770
|
|
01754 PERFORM P2110-QTRLY THRU P2110-EXIT DTSBE770
|
|
01755 END-IF. DTSBE770
|
|
01756 DTSBE770
|
|
01757 *** ANNUAL FILERS NOT COUNTED FOR THE RESOLVED QUARTER. DTSBE770
|
|
01758 *** THEY ARE COUNTED ONLY DURING THE SECURED QUARTER. DTSBE770
|
|
01759 ** IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBE770
|
|
01760 * SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBE770
|
|
01761 * MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBE770
|
|
01762 * MOVE WRK-FIRST-ANN-QTR TO L410-YRQ DTSBE770
|
|
01763 * PERFORM S410-FILE-SCHED THRU S410-EXIT DTSBE770
|
|
01764 * IF L410-ANN-SCHED-88 DTSBE770
|
|
01765 * ADD +1 TO WRK-ANN-FILER-CNT DTSBE770
|
|
01766 * PERFORM P2120-ANNUAL THRU P2120-EXIT DTSBE770
|
|
01767 * ELSE DTSBE770
|
|
01768 * PERFORM P2110-QTRLY THRU P2110-EXIT DTSBE770
|
|
01769 * END-IF DTSBE770
|
|
01770 * ELSE DTSBE770
|
|
01771 * PERFORM P2110-QTRLY THRU P2110-EXIT DTSBE770
|
|
01772 ** END-IF. DTSBE770
|
|
01773 DTSBE770
|
|
01774 P2100-EXIT. DTSBE770
|
|
01775 EXIT. DTSBE770
|
|
01776 DTSBE770
|
|
01777 P2110-QTRLY. DTSBE770
|
|
01778 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
01779 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
01780 SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
01781 MOVE WRK-QTR TO MQTR-YRQ. DTSBE770
|
|
01782 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01783 PERFORM S910-READ THRU S910-EXIT. DTSBE770
|
|
01784 IF L910-NO-REC-88 DTSBE770
|
|
01785 GO TO P2110-EXIT. DTSBE770
|
|
01786 DTSBE770
|
|
01787 MOVE MSKL-REC TO MQTR-REC. DTSBE770
|
|
01788 DTSBE770
|
|
01789 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01790 SET WRK-SELECT-RCVD-88 TO TRUE DTSBE770
|
|
01791 ADD +1 TO WRK-P2100-QTR-CNT DTSBE770
|
|
01792 ELSE DTSBE770
|
|
01793 IF MQTR-CURR-ESTIM-88 DTSBE770
|
|
01794 SET WRK-SELECT-ESTIM-88 TO TRUE DTSBE770
|
|
01795 ELSE DTSBE770
|
|
01796 IF (MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01797 AND (MQTR-MISS-NO-LTR-ADDR-88 DTSBE770
|
|
01798 OR MQTR-MISS-NO-LTR-OTHER-88 DTSBE770
|
|
01799 OR MQTR-MISS-LETTER-SENT-88 DTSBE770
|
|
01800 OR MQTR-MISS-TIMELY-88 DTSBE770
|
|
01801 OR MQTR-MISS-UNTIMELY-88)) DTSBE770
|
|
01802 SET WRK-SELECT-MISSING-88 TO TRUE. DTSBE770
|
|
01803 DTSBE770
|
|
01804 P2110-EXIT. DTSBE770
|
|
01805 EXIT. DTSBE770
|
|
01806 DTSBE770
|
|
01807 *P2120-ANNUAL. DTSBE770
|
|
01808 * IF WRK-RPT-QTR-Q = 2 DTSBE770
|
|
01809 * NEXT SENTENCE DTSBE770
|
|
01810 * ELSE DTSBE770
|
|
01811 * PERFORM P2122-ANN-DEFAULT THRU P2122-EXIT DTSBE770
|
|
01812 * GO TO P2120-EXIT. DTSBE770
|
|
01813 * DTSBE770
|
|
01814 * MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
01815 * MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
01816 * SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
01817 * MOVE WRK-FIRST-ANN-QTR TO MQTR-YRQ. DTSBE770
|
|
01818 * MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01819 * PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
01820 * IF L910-NO-REC-88 DTSBE770
|
|
01821 * NEXT SENTENCE DTSBE770
|
|
01822 * ELSE DTSBE770
|
|
01823 * PERFORM P2121-ANALYZE THRU P2121-EXIT DTSBE770
|
|
01824 * END-IF. DTSBE770
|
|
01825 * DTSBE770
|
|
01826 ** IF L910-NO-REC-88 DTSBE770
|
|
01827 * NEXT SENTENCE DTSBE770
|
|
01828 * ELSE DTSBE770
|
|
01829 * PERFORM P2121-SCAN-QTR THRU P2121-EXIT DTSBE770
|
|
01830 * UNTIL L910-NO-REC-88 DTSBE770
|
|
01831 * OR MQTR-YRQ > WRK-LAST-ANN-QTR DTSBE770
|
|
01832 ** END-IF. DTSBE770
|
|
01833 * DTSBE770
|
|
01834 * IF WRK-ANN-RPT-RCVD-YES-88 DTSBE770
|
|
01835 * ADD +1 TO WRK-P2100-CNT DTSBE770
|
|
01836 * ADD +1 TO WRK-P2100-RCVD-CNT DTSBE770
|
|
01837 * SET WRK-SELECT-RCVD-88 TO TRUE DTSBE770
|
|
01838 * END-IF. DTSBE770
|
|
01839 * DTSBE770
|
|
01840 ** SET WRK-ANN-RESOLVED-YES-88 TO TRUE DTSBE770
|
|
01841 * ELSE DTSBE770
|
|
01842 * IF WRK-ANN-RPT-ESTIM-YES-88 DTSBE770
|
|
01843 * ADD +1 TO WRK-P2100-CNT DTSBE770
|
|
01844 * SET WRK-SELECT-ESTIM-88 TO TRUE DTSBE770
|
|
01845 * SET WRK-ANN-RESOLVED-YES-88 TO TRUE DTSBE770
|
|
01846 * ELSE DTSBE770
|
|
01847 * IF WRK-ANN-RPT-MISSING-YES-88 DTSBE770
|
|
01848 * ADD +1 TO WRK-P2100-CNT DTSBE770
|
|
01849 * ADD +1 TO WRK-P2100-MISS-CNT DTSBE770
|
|
01850 * SET WRK-SELECT-MISSING-88 TO TRUE DTSBE770
|
|
01851 * SET WRK-ANN-RESOLVED-YES-88 TO TRUE. DTSBE770
|
|
01852 ** DTSBE770
|
|
01853 *P2120-EXIT. DTSBE770
|
|
01854 * EXIT. DTSBE770
|
|
01855 * DTSBE770
|
|
01856 *P2121-ANALYZE. DTSBE770
|
|
01857 * MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
01858 * DTSBE770
|
|
01859 * IF MQTR-YRQ < WRK-FIRST-ANN-QTR DTSBE770
|
|
01860 * OR MQTR-YRQ > WRK-LAST-ANN-QTR DTSBE770
|
|
01861 * DISPLAY 'P2121 NO ANN MQTR ' MPRF-EMP-NO DTSBE770
|
|
01862 * GO TO P2121-EXIT DTSBE770
|
|
01863 * END-IF. DTSBE770
|
|
01864 * DTSBE770
|
|
01865 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01866 * OR MQTR-CURR-ORIG-ANN-NL-88 DTSBE770
|
|
01867 * SET WRK-ANN-RPT-RCVD-YES-88 TO TRUE DTSBE770
|
|
01868 ** ELSE DTSBE770
|
|
01869 * IF MQTR-CURR-ESTIM-88 DTSBE770
|
|
01870 * SET WRK-ANN-RPT-ESTIM-YES-88 TO TRUE DTSBE770
|
|
01871 * ELSE DTSBE770
|
|
01872 * IF (MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01873 * AND (MQTR-MISS-NO-LTR-ADDR-88 DTSBE770
|
|
01874 * OR MQTR-MISS-NO-LTR-OTHER-88 DTSBE770
|
|
01875 * OR MQTR-MISS-LETTER-SENT-88)) DTSBE770
|
|
01876 * SET WRK-ANN-RPT-MISSING-YES-88 TO TRUE DTSBE770
|
|
01877 * END-IF DTSBE770
|
|
01878 ** END-IF DTSBE770
|
|
01879 * END-IF. DTSBE770
|
|
01880 * DTSBE770
|
|
01881 *P2121-EXIT. DTSBE770
|
|
01882 * EXIT. DTSBE770
|
|
01883 DTSBE770
|
|
01884 *P2121-SCAN-QTR. DTSBE770
|
|
01885 * MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
01886 * DTSBE770
|
|
01887 * IF MQTR-CURR-RCVD-88 DTSBE770
|
|
01888 * SET WRK-ANN-RPT-RCVD-YES-88 TO TRUE DTSBE770
|
|
01889 * ELSE DTSBE770
|
|
01890 * IF MQTR-CURR-ESTIM-88 DTSBE770
|
|
01891 * SET WRK-ANN-RPT-ESTIM-YES-88 TO TRUE DTSBE770
|
|
01892 * ELSE DTSBE770
|
|
01893 * IF (MQTR-CURR-NOT-LIABLE-88 DTSBE770
|
|
01894 * AND (MQTR-MISS-NO-LTR-ADDR-88 DTSBE770
|
|
01895 * OR MQTR-MISS-NO-LTR-OTHER-88 DTSBE770
|
|
01896 * OR MQTR-MISS-LETTER-SENT-88)) DTSBE770
|
|
01897 * SET WRK-ANN-RPT-MISSING-YES-88 TO TRUE DTSBE770
|
|
01898 * END-IF DTSBE770
|
|
01899 * END-IF DTSBE770
|
|
01900 * END-IF. DTSBE770
|
|
01901 * DTSBE770
|
|
01902 * PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
01903 * DTSBE770
|
|
01904 *P2121-EXIT. DTSBE770
|
|
01905 * EXIT. DTSBE770
|
|
01906 DTSBE770
|
|
01907 P2122-ANN-DEFAULT. DTSBE770
|
|
01908 ** DISPLAY 'P2122 ANN DEFAULT ' MPRF-EMP-NO DTSBE770
|
|
01909 ** ' WRK-QTR ' WRK-QTR. DTSBE770
|
|
01910 DTSBE770
|
|
01911 MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND. DTSBE770
|
|
01912 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
01913 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
01914 SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
01915 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01916 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
01917 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
01918 MOVE MSKL-REC TO MSOL-REC DTSBE770
|
|
01919 IF MSOL-INACT-WITHDRAWN-88 DTSBE770
|
|
01920 MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01921 ELSE DTSBE770
|
|
01922 IF MSOL-INACT-DATE < WRK-SUBJECT-QTR-START DTSBE770
|
|
01923 OR MSOL-LIAB-DATE > WRK-SUBJECT-QTR-END DTSBE770
|
|
01924 NEXT SENTENCE DTSBE770
|
|
01925 ELSE DTSBE770
|
|
01926 MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01927 END-IF DTSBE770
|
|
01928 END-IF DTSBE770
|
|
01929 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
01930 END-PERFORM. DTSBE770
|
|
01931 * MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND. DTSBE770
|
|
01932 * MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
01933 * MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
01934 * SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
01935 * MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01936 * PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
01937 * PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
01938 * MOVE MSKL-REC TO MSOL-REC DTSBE770
|
|
01939 * IF MSOL-INACT-WITHDRAWN-88 DTSBE770
|
|
01940 * MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01941 * ELSE DTSBE770
|
|
01942 ** DISPLAY 'MSOL FIRST ' MSOL-FIRST-LIAB-YRQ DTSBE770
|
|
01943 ** ' LAST ' MSOL-LAST-LIAB-YRQ DTSBE770
|
|
01944 * IF MSOL-LAST-LIAB-YRQ < WRK-QTR DTSBE770
|
|
01945 * OR MSOL-FIRST-LIAB-YRQ > WRK-QTR DTSBE770
|
|
01946 * NEXT SENTENCE DTSBE770
|
|
01947 * ELSE DTSBE770
|
|
01948 * MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01949 * END-IF DTSBE770
|
|
01950 * END-IF DTSBE770
|
|
01951 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
01952 * END-PERFORM. DTSBE770
|
|
01953 DTSBE770
|
|
01954 ** DISPLAY 'P2122 - 2 ' MPRF-EMP-NO DTSBE770
|
|
01955 ** ' ' WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
01956 IF WRK-ACTIVE-DURING-PERIOD-IND = 'N' DTSBE770
|
|
01957 NEXT SENTENCE DTSBE770
|
|
01958 ELSE DTSBE770
|
|
01959 SET WRK-SELECT-RCVD-88 TO TRUE DTSBE770
|
|
01960 SET WRK-ANN-DEFAULT-YES-88 TO TRUE DTSBE770
|
|
01961 ADD +1 TO WRK-P2100-DFLT-CNT DTSBE770
|
|
01962 END-IF. DTSBE770
|
|
01963 DTSBE770
|
|
01964 P2122-EXIT. DTSBE770
|
|
01965 EXIT. DTSBE770
|
|
01966 DTSBE770
|
|
01967 P2200-GET-RPT-DATES. DTSBE770
|
|
01968 IF WRK-ANN-DEFAULT-YES-88 DTSBE770
|
|
01969 PERFORM P2220-DEFAULT-ANN THRU P2220-EXIT DTSBE770
|
|
01970 GO TO P2200-EXIT DTSBE770
|
|
01971 END-IF. DTSBE770
|
|
01972 DTSBE770
|
|
01973 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBE770
|
|
01974 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE770
|
|
01975 SET MRPT-RPT-88 TO TRUE. DTSBE770
|
|
01976 IF L410-ANN-SCHED-88 DTSBE770
|
|
01977 MOVE WRK-FIRST-ANN-QTR TO MRPT-YRQ DTSBE770
|
|
01978 WRK-MRPT-QTR DTSBE770
|
|
01979 ELSE DTSBE770
|
|
01980 MOVE WRK-QTR TO MRPT-YRQ DTSBE770
|
|
01981 WRK-MRPT-QTR. DTSBE770
|
|
01982 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
01983 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
01984 IF L410-ANN-SCHED-88 DTSBE770
|
|
01985 PERFORM P2211-SCAN-ANN-MRPT THRU P2211-EXIT DTSBE770
|
|
01986 UNTIL L910-NO-REC-88 DTSBE770
|
|
01987 ELSE DTSBE770
|
|
01988 PERFORM P2210-SCAN-MRPT THRU P2210-EXIT DTSBE770
|
|
01989 UNTIL L910-NO-REC-88 DTSBE770
|
|
01990 END-IF. DTSBE770
|
|
01991 DTSBE770
|
|
01992 IF L410-ANN-SCHED-88 DTSBE770
|
|
01993 PERFORM P2230-NON-DEFAULT-ANN THRU P2230-EXIT. DTSBE770
|
|
01994 *& DTSBE770
|
|
01995 * IF WRK-MRPT-QTR = 20024 DTSBE770
|
|
01996 * IF WRK-ORIG-RPT-RCVD-DATE > ZERO DTSBE770
|
|
01997 * IF (WRK-ORIG-RPT-ESTB-DATE > 20030331 DTSBE770
|
|
01998 * OR WRK-ORIG-RPT-CHNG-DATE > 20030331) DTSBE770
|
|
01999 * DISPLAY 'EXCLUDE ' MPRF-EMP-NO DTSBE770
|
|
02000 * ' RCV ' WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02001 * ' ESTB ' WRK-ORIG-RPT-ESTB-DATE DTSBE770
|
|
02002 * ' CHNG ' WRK-ORIG-RPT-CHNG-DATE DTSBE770
|
|
02003 ADD +1 TO WRK-CNT4. DTSBE770
|
|
02004 *& DTSBE770
|
|
02005 P2200-EXIT. DTSBE770
|
|
02006 EXIT. DTSBE770
|
|
02007 DTSBE770
|
|
02008 P2210-SCAN-MRPT. DTSBE770
|
|
02009 MOVE MSKL-REC TO MRPT-REC. DTSBE770
|
|
02010 DTSBE770
|
|
02011 IF MRPT-YRQ = WRK-MRPT-QTR DTSBE770
|
|
02012 IF MRPT-ORIG-88 DTSBE770
|
|
02013 MOVE MRPT-RECEIVED-DATE TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02014 MOVE MRPT-ESTB-DATE TO WRK-ORIG-RPT-ESTB-DATE DTSBE770
|
|
02015 MOVE MRPT-CHNG-DATE TO WRK-ORIG-RPT-CHNG-DATE DTSBE770
|
|
02016 ELSE DTSBE770
|
|
02017 IF MRPT-ESTIM-88 DTSBE770
|
|
02018 MOVE MRPT-RECEIVED-DATE TO WRK-ESTIM-RPT-RCVD-DATE DTSBE770
|
|
02019 END-IF DTSBE770
|
|
02020 END-IF DTSBE770
|
|
02021 ELSE DTSBE770
|
|
02022 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
02023 GO TO P2210-EXIT DTSBE770
|
|
02024 END-IF. DTSBE770
|
|
02025 DTSBE770
|
|
02026 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
02027 DTSBE770
|
|
02028 P2210-EXIT. DTSBE770
|
|
02029 EXIT. DTSBE770
|
|
02030 DTSBE770
|
|
02031 P2211-SCAN-ANN-MRPT. DTSBE770
|
|
02032 MOVE MSKL-REC TO MRPT-REC. DTSBE770
|
|
02033 DTSBE770
|
|
02034 IF MRPT-YRQ > WRK-LAST-ANN-QTR DTSBE770
|
|
02035 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
02036 GO TO P2211-EXIT DTSBE770
|
|
02037 END-IF. DTSBE770
|
|
02038 DTSBE770
|
|
02039 IF MRPT-ORIG-88 DTSBE770
|
|
02040 MOVE MRPT-RECEIVED-DATE TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02041 MOVE MRPT-ESTB-DATE TO WRK-ORIG-RPT-ESTB-DATE DTSBE770
|
|
02042 MOVE MRPT-CHNG-DATE TO WRK-ORIG-RPT-CHNG-DATE DTSBE770
|
|
02043 END-IF. DTSBE770
|
|
02044 DTSBE770
|
|
02045 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
02046 DTSBE770
|
|
02047 P2211-EXIT. DTSBE770
|
|
02048 EXIT. DTSBE770
|
|
02049 DTSBE770
|
|
02050 P2220-DEFAULT-ANN. DTSBE770
|
|
02051 IF WRK-QTR = WRK-QTR2 DTSBE770
|
|
02052 MOVE WRK-QTR2-ANN-TIMELY TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02053 ELSE DTSBE770
|
|
02054 IF WRK-QTR = WRK-QTR1 DTSBE770
|
|
02055 MOVE WRK-QTR1-ANN-TIMELY TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02056 END-IF DTSBE770
|
|
02057 END-IF. DTSBE770
|
|
02058 DTSBE770
|
|
02059 P2220-EXIT. DTSBE770
|
|
02060 EXIT. DTSBE770
|
|
02061 DTSBE770
|
|
02062 P2230-NON-DEFAULT-ANN. DTSBE770
|
|
02063 ** IF WRK-RPT-QTR-Q = 2 DTSBE770
|
|
02064 * MOVE WRK-QTR1-ANN-TIMELY TO WRK-ANN-TIMELY-DATE DTSBE770
|
|
02065 * MOVE WRK-QTR1-ANN-SECURED TO WRK-ANN-SECURED-DATE DTSBE770
|
|
02066 * ELSE DTSBE770
|
|
02067 * IF WRK-RPT-QTR-Q = 3 DTSBE770
|
|
02068 * MOVE WRK-QTR2-ANN-TIMELY TO WRK-ANN-TIMELY-DATE DTSBE770
|
|
02069 * MOVE WRK-QTR2-ANN-SECURED TO WRK-ANN-SECURED-DATE DTSBE770
|
|
02070 * END-IF DTSBE770
|
|
02071 ** END-IF. DTSBE770
|
|
02072 DTSBE770
|
|
02073 IF WRK-QTR = WRK-QTR1 DTSBE770
|
|
02074 MOVE WRK-QTR1-ANN-TIMELY TO WRK-ANN-TIMELY-DATE DTSBE770
|
|
02075 MOVE WRK-QTR1-ANN-SECURED TO WRK-ANN-SECURED-DATE DTSBE770
|
|
02076 ELSE DTSBE770
|
|
02077 MOVE WRK-QTR2-ANN-TIMELY TO WRK-ANN-TIMELY-DATE DTSBE770
|
|
02078 MOVE WRK-QTR2-ANN-SECURED TO WRK-ANN-SECURED-DATE DTSBE770
|
|
02079 END-IF. DTSBE770
|
|
02080 DTSBE770
|
|
02081 IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE DTSBE770
|
|
02082 IF WRK-ORIG-RPT-RCVD-DATE <= WRK-ANN-SECURED-DATE DTSBE770
|
|
02083 MOVE WRK-ANN-SECURED-DATE DTSBE770
|
|
02084 TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02085 ADD +1 TO WRK-P2220-SEC-CNT DTSBE770
|
|
02086 END-IF DTSBE770
|
|
02087 ELSE DTSBE770
|
|
02088 MOVE WRK-ANN-TIMELY-DATE TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02089 ADD +1 TO WRK-P2220-TIMELY-CNT DTSBE770
|
|
02090 END-IF. DTSBE770
|
|
02091 DTSBE770
|
|
02092 ** IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE DTSBE770
|
|
02093 * IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-SECURED-DATE DTSBE770
|
|
02094 * ADD +1 TO WRK-P2220-RES-CNT DTSBE770
|
|
02095 * ELSE DTSBE770
|
|
02096 * MOVE WRK-ANN-SECURED-DATE DTSBE770
|
|
02097 * TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02098 * ADD +1 TO WRK-P2220-SEC-CNT DTSBE770
|
|
02099 * END-IF DTSBE770
|
|
02100 * ELSE DTSBE770
|
|
02101 * MOVE WRK-ANN-TIMELY-DATE TO WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02102 * ADD +1 TO WRK-P2220-TIMELY-CNT DTSBE770
|
|
02103 ** END-IF. DTSBE770
|
|
02104 DTSBE770
|
|
02105 P2230-EXIT. DTSBE770
|
|
02106 EXIT. DTSBE770
|
|
02107 DTSBE770
|
|
02108 P2300-LIAB-DATE. DTSBE770
|
|
02109 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
02110 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
02111 SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
02112 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02113 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02114 PERFORM P2310-SCAN-MSOL THRU P2310-EXIT DTSBE770
|
|
02115 UNTIL L910-NO-REC-88. DTSBE770
|
|
02116 DTSBE770
|
|
02117 P2300-EXIT. DTSBE770
|
|
02118 EXIT. DTSBE770
|
|
02119 DTSBE770
|
|
02120 P2310-SCAN-MSOL. DTSBE770
|
|
02121 MOVE MSKL-REC TO MSOL-REC. DTSBE770
|
|
02122 DTSBE770
|
|
02123 IF MSOL-INACT-WITHDRAWN-88 DTSBE770
|
|
02124 NEXT SENTENCE DTSBE770
|
|
02125 ELSE DTSBE770
|
|
02126 IF L410-ANN-SCHED-88 DTSBE770
|
|
02127 IF WRK-FIRST-ANN-QTR <= MSOL-LAST-LIAB-YRQ DTSBE770
|
|
02128 AND WRK-LAST-ANN-QTR >= MSOL-FIRST-LIAB-YRQ DTSBE770
|
|
02129 MOVE MSOL-LIAB-DATE TO WRK-P2310-LIAB-DATE DTSBE770
|
|
02130 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
02131 GO TO P2310-EXIT DTSBE770
|
|
02132 END-IF DTSBE770
|
|
02133 ELSE DTSBE770
|
|
02134 IF WRK-QTR <= MSOL-LAST-LIAB-YRQ DTSBE770
|
|
02135 AND WRK-QTR >= MSOL-FIRST-LIAB-YRQ DTSBE770
|
|
02136 MOVE MSOL-LIAB-DATE TO WRK-P2310-LIAB-DATE DTSBE770
|
|
02137 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
02138 GO TO P2310-EXIT DTSBE770
|
|
02139 END-IF DTSBE770
|
|
02140 END-IF. DTSBE770
|
|
02141 DTSBE770
|
|
02142 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
02143 DTSBE770
|
|
02144 P2310-EXIT. DTSBE770
|
|
02145 EXIT. DTSBE770
|
|
02146 DTSBE770
|
|
02147 P2400-MSOL-CHANGE. DTSBE770
|
|
02148 IF L410-ANN-SCHED-88 DTSBE770
|
|
02149 MOVE WRK-ANN-DELINQUENT-DATE TO WRK-DELINQUENT-DATE DTSBE770
|
|
02150 ELSE DTSBE770
|
|
02151 MOVE WRK-QTR-DELINQUENT-DATE TO WRK-DELINQUENT-DATE. DTSBE770
|
|
02152 DTSBE770
|
|
02153 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
02154 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
02155 SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
02156 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02157 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02158 PERFORM P2410-SCAN-MSOL THRU P2410-EXIT DTSBE770
|
|
02159 UNTIL L910-NO-REC-88. DTSBE770
|
|
02160 DTSBE770
|
|
02161 IF WRK-MSOL-INACT-CHNG-YES-88 DTSBE770
|
|
02162 SET WRK-SELECT-INACT-CHNG-88 TO TRUE DTSBE770
|
|
02163 ELSE DTSBE770
|
|
02164 IF WRK-MSOL-LIAB-CHNG-YES-88 DTSBE770
|
|
02165 SET WRK-SELECT-LIAB-CHNG-88 TO TRUE DTSBE770
|
|
02166 ELSE DTSBE770
|
|
02167 IF WRK-MSOL-WITHDRAWN-YES-88 DTSBE770
|
|
02168 SET WRK-SELECT-WITHDRAW-88 TO TRUE DTSBE770
|
|
02169 END-IF DTSBE770
|
|
02170 END-IF DTSBE770
|
|
02171 END-IF. DTSBE770
|
|
02172 DTSBE770
|
|
02173 P2400-EXIT. DTSBE770
|
|
02174 EXIT. DTSBE770
|
|
02175 DTSBE770
|
|
02176 P2410-SCAN-MSOL. DTSBE770
|
|
02177 MOVE MSKL-REC TO MSOL-REC. DTSBE770
|
|
02178 DTSBE770
|
|
02179 IF (MSOL-CHNG-DATE > WRK-DELINQUENT-DATE) DTSBE770
|
|
02180 IF MSOL-INACT-WITHDRAWN-88 DTSBE770
|
|
02181 PERFORM P2411-WITHDRAWN THRU P2411-EXIT DTSBE770
|
|
02182 ELSE DTSBE770
|
|
02183 IF MSOL-INACT-INACTIVE-88 DTSBE770
|
|
02184 PERFORM P2412-INACTIVE THRU P2412-EXIT DTSBE770
|
|
02185 ELSE DTSBE770
|
|
02186 PERFORM P2413-ACTIVE THRU P2413-EXIT DTSBE770
|
|
02187 END-IF DTSBE770
|
|
02188 END-IF DTSBE770
|
|
02189 END-IF. DTSBE770
|
|
02190 DTSBE770
|
|
02191 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
02192 DTSBE770
|
|
02193 P2410-EXIT. DTSBE770
|
|
02194 EXIT. DTSBE770
|
|
02195 DTSBE770
|
|
02196 P2411-WITHDRAWN. DTSBE770
|
|
02197 ******************************************************** DTSBE770
|
|
02198 * THE DATA VALIDATION SOFTWARE EXPECTS THE INACTIVE DATE DTSBE770
|
|
02199 * TO EQUAL THE LIABILITY DATE WHEN THE SPAN OF LIABILITY DTSBE770
|
|
02200 * HAS BEEN WITHDRAWN. SINCE THIS IS NOT ALWAYS THE CASE DTSBE770
|
|
02201 * IN THE TAX SYSTEM, THE CODE BELOW MAKES THE TWO DATES DTSBE770
|
|
02202 * EQUAL. DTSBE770
|
|
02203 ******************************************************** DTSBE770
|
|
02204 IF L410-ANN-SCHED-88 DTSBE770
|
|
02205 IF MSOL-LIAB-DATE <= WRK-ANN-END DTSBE770
|
|
02206 MOVE MSOL-LIAB-DATE TO WRK-P2411-LIAB-DATE DTSBE770
|
|
02207 WRK-P2411-INACT-DATE DTSBE770
|
|
02208 MOVE MSOL-CHNG-DATE TO WRK-P2411-INACT-ENTER-DATE DTSBE770
|
|
02209 SET WRK-MSOL-WITHDRAWN-YES-88 TO TRUE DTSBE770
|
|
02210 END-IF DTSBE770
|
|
02211 ELSE DTSBE770
|
|
02212 IF MSOL-LIAB-DATE <= WRK-QTR-END DTSBE770
|
|
02213 MOVE MSOL-LIAB-DATE TO WRK-P2411-LIAB-DATE DTSBE770
|
|
02214 WRK-P2411-INACT-DATE DTSBE770
|
|
02215 MOVE MSOL-CHNG-DATE TO WRK-P2411-INACT-ENTER-DATE DTSBE770
|
|
02216 SET WRK-MSOL-WITHDRAWN-YES-88 TO TRUE DTSBE770
|
|
02217 END-IF DTSBE770
|
|
02218 END-IF. DTSBE770
|
|
02219 DTSBE770
|
|
02220 P2411-EXIT. DTSBE770
|
|
02221 EXIT. DTSBE770
|
|
02222 DTSBE770
|
|
02223 P2412-INACTIVE. DTSBE770
|
|
02224 IF L410-ANN-SCHED-88 DTSBE770
|
|
02225 IF MSOL-INACT-DATE < WRK-ANN-START DTSBE770
|
|
02226 MOVE MSOL-LIAB-DATE TO WRK-P2412-LIAB-DATE DTSBE770
|
|
02227 MOVE MSOL-INACT-DATE TO WRK-P2412-INACT-DATE DTSBE770
|
|
02228 MOVE MSOL-CHNG-DATE TO WRK-P2412-INACT-ENTER-DATE DTSBE770
|
|
02229 SET WRK-MSOL-INACT-CHNG-YES-88 TO TRUE DTSBE770
|
|
02230 END-IF DTSBE770
|
|
02231 ELSE DTSBE770
|
|
02232 IF MSOL-INACT-DATE < WRK-QTR-START DTSBE770
|
|
02233 MOVE MSOL-LIAB-DATE TO WRK-P2412-LIAB-DATE DTSBE770
|
|
02234 MOVE MSOL-INACT-DATE TO WRK-P2412-INACT-DATE DTSBE770
|
|
02235 MOVE MSOL-CHNG-DATE TO WRK-P2412-INACT-ENTER-DATE DTSBE770
|
|
02236 SET WRK-MSOL-INACT-CHNG-YES-88 TO TRUE DTSBE770
|
|
02237 END-IF DTSBE770
|
|
02238 END-IF. DTSBE770
|
|
02239 DTSBE770
|
|
02240 P2412-EXIT. DTSBE770
|
|
02241 EXIT. DTSBE770
|
|
02242 DTSBE770
|
|
02243 P2413-ACTIVE. DTSBE770
|
|
02244 IF WRK-MSOL-LIAB-CHNG-YES-88 DTSBE770
|
|
02245 NEXT SENTENCE DTSBE770
|
|
02246 ELSE DTSBE770
|
|
02247 IF L410-ANN-SCHED-88 DTSBE770
|
|
02248 IF MSOL-LIAB-DATE > WRK-ANN-END DTSBE770
|
|
02249 MOVE MSOL-LIAB-DATE TO WRK-P2413-LIAB-DATE DTSBE770
|
|
02250 SET WRK-MSOL-LIAB-CHNG-YES-88 TO TRUE DTSBE770
|
|
02251 END-IF DTSBE770
|
|
02252 ELSE DTSBE770
|
|
02253 IF MSOL-LIAB-DATE > WRK-QTR-END DTSBE770
|
|
02254 MOVE MSOL-LIAB-DATE TO WRK-P2413-LIAB-DATE DTSBE770
|
|
02255 SET WRK-MSOL-LIAB-CHNG-YES-88 TO TRUE DTSBE770
|
|
02256 END-IF DTSBE770
|
|
02257 END-IF. DTSBE770
|
|
02258 DTSBE770
|
|
02259 P2413-EXIT. DTSBE770
|
|
02260 EXIT. DTSBE770
|
|
02261 DTSBE770
|
|
02262 P2500-BUILD-Y772. DTSBE770
|
|
02263 MOVE LENGTH OF Y772-REC TO Y772-LENGTH. DTSBE770
|
|
02264 SET Y772-REC-TYPE-772-88 TO TRUE. DTSBE770
|
|
02265 DTSBE770
|
|
02266 ADD +1 TO WRK-Y772-CNT. DTSBE770
|
|
02267 DTSBE770
|
|
02268 MOVE MPRF-EMP-NO TO Y772-EMP-NO. DTSBE770
|
|
02269 DTSBE770
|
|
02270 MOVE WRK-QTR TO Y772-RPT-YRQ DTSBE770
|
|
02271 DTSBE770
|
|
02272 MOVE MPRF-EMP-CLASS TO Y772-EMP-CLASS. DTSBE770
|
|
02273 DTSBE770
|
|
02274 MOVE ZERO TO Y772-RECEIVED-DATE DTSBE770
|
|
02275 Y772-LIAB-DATE DTSBE770
|
|
02276 Y772-FINAL-ASSESS-DATE DTSBE770
|
|
02277 Y772-INACTIVE-DATE DTSBE770
|
|
02278 Y772-INACT-PROCESS-DATE. DTSBE770
|
|
02279 DTSBE770
|
|
02280 EVALUATE TRUE DTSBE770
|
|
02281 WHEN WRK-SELECT-RCVD-88 DTSBE770
|
|
02282 SET Y772-RPT-RCVD-88 TO TRUE DTSBE770
|
|
02283 MOVE WRK-ORIG-RPT-RCVD-DATE TO Y772-RECEIVED-DATE DTSBE770
|
|
02284 *& IF L410-ANN-SCHED-88 DTSBE770
|
|
02285 * PERFORM P2520-ANN-RCVD THRU P2520-EXIT DTSBE770
|
|
02286 * ELSE DTSBE770
|
|
02287 * MOVE WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02288 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02289 * ADD +1 TO WRK-P2500-QTR-CNT DTSBE770
|
|
02290 *& END-IF DTSBE770
|
|
02291 MOVE WRK-P2310-LIAB-DATE TO Y772-LIAB-DATE DTSBE770
|
|
02292 DTSBE770
|
|
02293 WHEN WRK-SELECT-ESTIM-88 DTSBE770
|
|
02294 SET Y772-RPT-ESTIM-88 TO TRUE DTSBE770
|
|
02295 MOVE WRK-ESTIM-RPT-RCVD-DATE TO Y772-FINAL-ASSESS-DATE DTSBE770
|
|
02296 MOVE WRK-P2310-LIAB-DATE TO Y772-LIAB-DATE DTSBE770
|
|
02297 DTSBE770
|
|
02298 WHEN WRK-SELECT-INACT-CHNG-88 DTSBE770
|
|
02299 SET Y772-RPT-INACT-88 TO TRUE DTSBE770
|
|
02300 MOVE WRK-P2412-LIAB-DATE TO Y772-LIAB-DATE DTSBE770
|
|
02301 MOVE WRK-P2412-INACT-DATE TO Y772-INACTIVE-DATE DTSBE770
|
|
02302 MOVE WRK-P2412-INACT-ENTER-DATE DTSBE770
|
|
02303 TO Y772-INACT-PROCESS-DATE DTSBE770
|
|
02304 DTSBE770
|
|
02305 WHEN WRK-SELECT-LIAB-CHNG-88 DTSBE770
|
|
02306 SET Y772-RPT-LIAB-88 TO TRUE DTSBE770
|
|
02307 MOVE WRK-P2413-LIAB-DATE TO Y772-LIAB-DATE DTSBE770
|
|
02308 DTSBE770
|
|
02309 WHEN WRK-SELECT-WITHDRAW-88 DTSBE770
|
|
02310 SET Y772-RPT-WITHDRW-88 TO TRUE DTSBE770
|
|
02311 MOVE WRK-P2411-LIAB-DATE TO Y772-LIAB-DATE DTSBE770
|
|
02312 MOVE WRK-P2411-INACT-DATE TO Y772-INACTIVE-DATE DTSBE770
|
|
02313 MOVE WRK-P2411-INACT-ENTER-DATE DTSBE770
|
|
02314 TO Y772-INACT-PROCESS-DATE DTSBE770
|
|
02315 DTSBE770
|
|
02316 WHEN WRK-SELECT-581-ONLY-88 DTSBE770
|
|
02317 SET Y772-RPT-581-ONLY-88 TO TRUE DTSBE770
|
|
02318 MOVE WRK-ORIG-RPT-RCVD-DATE TO Y772-RECEIVED-DATE DTSBE770
|
|
02319 *& IF L410-ANN-SCHED-88 DTSBE770
|
|
02320 * PERFORM P2510-ANN-ETA581 THRU P2510-EXIT DTSBE770
|
|
02321 * ELSE DTSBE770
|
|
02322 * MOVE WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02323 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02324 * ADD +1 TO WRK-P2500-581-QTR-CNT DTSBE770
|
|
02325 *& END-IF DTSBE770
|
|
02326 DTSBE770
|
|
02327 END-EVALUATE. DTSBE770
|
|
02328 DTSBE770
|
|
02329 PERFORM S772-WRITE-R772 THRU S772-EXIT. DTSBE770
|
|
02330 DTSBE770
|
|
02331 P2500-EXIT. DTSBE770
|
|
02332 EXIT. DTSBE770
|
|
02333 DTSBE770
|
|
02334 *P2510-ANN-ETA581. DTSBE770
|
|
02335 * IF WRK-ANN-DEFAULT-YES-88 DTSBE770
|
|
02336 * PERFORM P2511-DEFAULT THRU P2511-EXIT DTSBE770
|
|
02337 * ELSE DTSBE770
|
|
02338 * PERFORM P2512-NO-DEFAULT THRU P2512-EXIT DTSBE770
|
|
02339 * END-IF. DTSBE770
|
|
02340 * DTSBE770
|
|
02341 *P2510-EXIT. DTSBE770
|
|
02342 * EXIT. DTSBE770
|
|
02343 DTSBE770
|
|
02344 *P2511-DEFAULT. DTSBE770
|
|
02345 * ADD +1 TO WRK-P2510-DFLT-TIMELY-CNT. DTSBE770
|
|
02346 * MOVE WRK-ANN-PSEUDO-TIMELY-DT1 TO Y772-RECEIVED-DATE. DTSBE770
|
|
02347 * DTSBE770
|
|
02348 *P2511-EXIT. DTSBE770
|
|
02349 * EXIT. DTSBE770
|
|
02350 * DTSBE770
|
|
02351 *P2512-NO-DEFAULT. DTSBE770
|
|
02352 * IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE DTSBE770
|
|
02353 * IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-SECURED-DATE DTSBE770
|
|
02354 * MOVE WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02355 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02356 * ADD +1 TO WRK-P2510-RES-CNT DTSBE770
|
|
02357 * ELSE DTSBE770
|
|
02358 * MOVE WRK-ANN-SECURED-DATE DTSBE770
|
|
02359 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02360 * ADD +1 TO WRK-P2510-SEC-CNT DTSBE770
|
|
02361 * END-IF DTSBE770
|
|
02362 * ELSE DTSBE770
|
|
02363 * MOVE WRK-ANN-PSEUDO-TIMELY-DT1 DTSBE770
|
|
02364 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02365 * ADD +1 TO WRK-P2510-TIMELY-CNT DTSBE770
|
|
02366 * END-IF. DTSBE770
|
|
02367 * DTSBE770
|
|
02368 *P2512-EXIT. DTSBE770
|
|
02369 * EXIT. DTSBE770
|
|
02370 DTSBE770
|
|
02371 *P2520-ANN-RCVD. DTSBE770
|
|
02372 * IF WRK-ANN-DEFAULT-YES-88 DTSBE770
|
|
02373 * PERFORM P2521-DEFAULT THRU P2521-EXIT DTSBE770
|
|
02374 * ELSE DTSBE770
|
|
02375 * PERFORM P2522-NOT-DEFAULT THRU P2522-EXIT DTSBE770
|
|
02376 * END-IF. DTSBE770
|
|
02377 * DTSBE770
|
|
02378 *P2520-EXIT. DTSBE770
|
|
02379 * EXIT. DTSBE770
|
|
02380 * DTSBE770
|
|
02381 * DTSBE770
|
|
02382 *P2521-DEFAULT. DTSBE770
|
|
02383 * ADD +1 TO WRK-P2520-DFLT-TIMELY-CNT. DTSBE770
|
|
02384 * MOVE WRK-ANN-PSEUDO-TIMELY-DT2 TO Y772-RECEIVED-DATE. DTSBE770
|
|
02385 * DTSBE770
|
|
02386 *P2521-EXIT. DTSBE770
|
|
02387 * EXIT. DTSBE770
|
|
02388 * DTSBE770
|
|
02389 *P2522-NOT-DEFAULT. DTSBE770
|
|
02390 * IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE DTSBE770
|
|
02391 * IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-SECURED-DATE DTSBE770
|
|
02392 * MOVE WRK-ORIG-RPT-RCVD-DATE DTSBE770
|
|
02393 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02394 * ADD +1 TO WRK-P2520-RES-CNT DTSBE770
|
|
02395 * ELSE DTSBE770
|
|
02396 * MOVE WRK-ANN-PSEUDO-SECURD-DT2 DTSBE770
|
|
02397 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02398 * ADD +1 TO WRK-P2520-SEC-CNT DTSBE770
|
|
02399 * END-IF DTSBE770
|
|
02400 * ELSE DTSBE770
|
|
02401 * MOVE WRK-ANN-PSEUDO-TIMELY-DT2 DTSBE770
|
|
02402 * TO Y772-RECEIVED-DATE DTSBE770
|
|
02403 * ADD +1 TO WRK-P2520-TIMELY-CNT DTSBE770
|
|
02404 * END-IF. DTSBE770
|
|
02405 * DTSBE770
|
|
02406 *P2522-EXIT. DTSBE770
|
|
02407 * EXIT. DTSBE770
|
|
02408 DTSBE770
|
|
02409 ************************************************************* DTSBE770
|
|
02410 * BECAUSE THE DATA VALIDATION SOFTWARE LOOKS AT ONLY ONE DTSBE770
|
|
02411 * QUARTER DURING EACH RUN, COUNTING BOTH SECURED AND DTSBE770
|
|
02412 * RESOLVED REPORTS FOR THE QUARTER, THE FOLLOWING PARAGRAPH DTSBE770
|
|
02413 * IS NEEDED TO GET THE SECURED REPORT COUNTS FOR THE DTSBE770
|
|
02414 * ETA581 REPORTS FOR THE QUARTER PRIOR TO THE REPORT QTR. DTSBE770
|
|
02415 * DTSBE770
|
|
02416 * ANNUAL FILERS: DTSBE770
|
|
02417 * ANNUAL REPORTS RECEIVED DURING THE SECOND QUARTER DTSBE770
|
|
02418 * ARE COUNTED AS TIMELY OR SECURED. DTSBE770
|
|
02419 * FOR ALL OTHER QUARTERS, THE 401 HANDBOOK REQUIRES DTSBE770
|
|
02420 * THAT THEY BE COUNTED AS TIMELY BY DEFAULT. DTSBE770
|
|
02421 ************************************************************* DTSBE770
|
|
02422 P2600-ETA581-ONLY. DTSBE770
|
|
02423 SET WRK-ANN-DEFAULT-NO-88 TO TRUE. DTSBE770
|
|
02424 IF L410-ANN-SCHED-88 DTSBE770
|
|
02425 PERFORM P2630-ANN-DEFAULT THRU P2630-EXIT DTSBE770
|
|
02426 ELSE DTSBE770
|
|
02427 PERFORM P2610-QTRLY THRU P2610-EXIT DTSBE770
|
|
02428 END-IF. DTSBE770
|
|
02429 DTSBE770
|
|
02430 ** IF L410-ANN-SCHED-88 DTSBE770
|
|
02431 * IF WRK-RPT-QTR-Q = 3 DTSBE770
|
|
02432 * PERFORM P2620-ANNUAL THRU P2620-EXIT DTSBE770
|
|
02433 * ELSE DTSBE770
|
|
02434 * PERFORM P2630-ANN-DEFAULT THRU P2630-EXIT DTSBE770
|
|
02435 * END-IF DTSBE770
|
|
02436 * ELSE DTSBE770
|
|
02437 * PERFORM P2610-QTRLY THRU P2610-EXIT DTSBE770
|
|
02438 ** END-IF. DTSBE770
|
|
02439 DTSBE770
|
|
02440 P2600-EXIT. DTSBE770
|
|
02441 EXIT. DTSBE770
|
|
02442 DTSBE770
|
|
02443 P2610-QTRLY. DTSBE770
|
|
02444 SET WRK-SELECT-NO-88 TO TRUE. DTSBE770
|
|
02445 DTSBE770
|
|
02446 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
02447 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
02448 SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
02449 MOVE WRK-QTR TO MQTR-YRQ. DTSBE770
|
|
02450 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02451 PERFORM S910-READ THRU S910-EXIT. DTSBE770
|
|
02452 IF L910-NO-REC-88 DTSBE770
|
|
02453 NEXT SENTENCE DTSBE770
|
|
02454 ELSE DTSBE770
|
|
02455 MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
02456 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
02457 ADD +1 TO WRK-P2610-QTR-CNT DTSBE770
|
|
02458 SET WRK-SELECT-581-ONLY-88 TO TRUE DTSBE770
|
|
02459 END-IF DTSBE770
|
|
02460 END-IF. DTSBE770
|
|
02461 DTSBE770
|
|
02462 P2610-EXIT. DTSBE770
|
|
02463 EXIT. DTSBE770
|
|
02464 DTSBE770
|
|
02465 P2620-ANNUAL. DTSBE770
|
|
02466 SET WRK-SELECT-NO-88 TO TRUE. DTSBE770
|
|
02467 DTSBE770
|
|
02468 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
02469 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
02470 SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
02471 MOVE WRK-FIRST-ANN-QTR TO MQTR-YRQ. DTSBE770
|
|
02472 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02473 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02474 IF L910-NO-REC-88 DTSBE770
|
|
02475 NEXT SENTENCE DTSBE770
|
|
02476 ELSE DTSBE770
|
|
02477 MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
02478 PERFORM DTSBE770
|
|
02479 UNTIL MQTR-CURR-RCVD-88 DTSBE770
|
|
02480 OR L910-NO-REC-88 DTSBE770
|
|
02481 OR MQTR-YRQ > WRK-LAST-ANN-QTR DTSBE770
|
|
02482 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02483 MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
02484 END-PERFORM DTSBE770
|
|
02485 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
02486 SET WRK-SELECT-581-ONLY-88 TO TRUE DTSBE770
|
|
02487 ADD +1 TO WRK-ANNUAL-RPT-CNT DTSBE770
|
|
02488 END-IF DTSBE770
|
|
02489 END-IF. DTSBE770
|
|
02490 DTSBE770
|
|
02491 P2620-EXIT. DTSBE770
|
|
02492 EXIT. DTSBE770
|
|
02493 DTSBE770
|
|
02494 P2630-ANN-DEFAULT. DTSBE770
|
|
02495 *********************** DTSBE770
|
|
02496 * DO NOT COUNT THE EMPLOYER IN THIS PARAGRAPH IF DTSBE770
|
|
02497 * ALREADY COUNTED IN P2100. DTSBE770
|
|
02498 *********************** DTSBE770
|
|
02499 *& IF WRK-ANN-RESOLVED-YES-88 DTSBE770
|
|
02500 *& GO TO P2630-EXIT. DTSBE770
|
|
02501 DTSBE770
|
|
02502 MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND. DTSBE770
|
|
02503 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
02504 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
02505 SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
02506 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02507 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02508 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
02509 MOVE MSKL-REC TO MSOL-REC DTSBE770
|
|
02510 IF MSOL-INACT-WITHDRAWN-88 DTSBE770
|
|
02511 MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
02512 ELSE DTSBE770
|
|
02513 IF MSOL-INACT-DATE < WRK-QTR-START DTSBE770
|
|
02514 OR MSOL-LIAB-DATE > WRK-QTR-END DTSBE770
|
|
02515 NEXT SENTENCE DTSBE770
|
|
02516 ELSE DTSBE770
|
|
02517 MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND DTSBE770
|
|
02518 END-IF DTSBE770
|
|
02519 END-IF DTSBE770
|
|
02520 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02521 END-PERFORM. DTSBE770
|
|
02522 DTSBE770
|
|
02523 IF WRK-ACTIVE-DURING-PERIOD-IND = 'N' DTSBE770
|
|
02524 NEXT SENTENCE DTSBE770
|
|
02525 ELSE DTSBE770
|
|
02526 ADD +1 TO WRK-ANNUAL-RPT-CNT DTSBE770
|
|
02527 SET WRK-SELECT-581-ONLY-88 TO TRUE DTSBE770
|
|
02528 SET WRK-ANN-DEFAULT-YES-88 TO TRUE DTSBE770
|
|
02529 END-IF. DTSBE770
|
|
02530 DTSBE770
|
|
02531 P2630-EXIT. DTSBE770
|
|
02532 EXIT. DTSBE770
|
|
02533 DTSBE770
|
|
02534 P3000-STATUS-DETERMINATIONS. DTSBE770
|
|
02535 SET WRK-DETERM-NULL-88 TO TRUE. DTSBE770
|
|
02536 MOVE WRK-ALL-NINES-DATE TO WRK-LIAB-DATE. DTSBE770
|
|
02537 MOVE ZERO TO WRK-LAST-INACT-DATE DTSBE770
|
|
02538 WRK-LAST-INACT-ENTER-DATE DTSBE770
|
|
02539 WRK-REOPEN-DATE DTSBE770
|
|
02540 WRK-LIAB-PROCESS-DATE DTSBE770
|
|
02541 WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
02542 WRK-PRED-EMP-NO DTSBE770
|
|
02543 WRK-STATUS-SUCC-DATE. DTSBE770
|
|
02544 DTSBE770
|
|
02545 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
02546 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
02547 SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
02548 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02549 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02550 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
02551 MOVE MSKL-REC TO MSOL-REC DTSBE770
|
|
02552 PERFORM P3100-SUBJ-QTR-DETERMS THRU P3100-EXIT DTSBE770
|
|
02553 PERFORM P3200-PRIOR-SOL THRU P3200-EXIT DTSBE770
|
|
02554 PERFORM P3300-BUILD-Y773 THRU P3300-EXIT DTSBE770
|
|
02555 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02556 END-PERFORM. DTSBE770
|
|
02557 DTSBE770
|
|
02558 MOVE ZERO TO WRK-PRED-EMP-NO DTSBE770
|
|
02559 WRK-STATUS-DETERM-DATE DTSBE770
|
|
02560 WRK-STATUS-ACT-DATE DTSBE770
|
|
02561 WRK-STATUS-SUCC-DATE. DTSBE770
|
|
02562 DTSBE770
|
|
02563 PERFORM P3400-CHK-SUCCESSORS THRU P3400-EXIT. DTSBE770
|
|
02564 DTSBE770
|
|
02565 P3000-EXIT. DTSBE770
|
|
02566 EXIT. DTSBE770
|
|
02567 DTSBE770
|
|
02568 P3100-SUBJ-QTR-DETERMS. DTSBE770
|
|
02569 MOVE ZERO TO WRK-CURR-ESTB-DATE DTSBE770
|
|
02570 WRK-CURR-INACT-DATE DTSBE770
|
|
02571 WRK-CURR-INACT-REV-DATE. DTSBE770
|
|
02572 DTSBE770
|
|
02573 SET CURR-DETERM-ESTB-NO-88 TO TRUE. DTSBE770
|
|
02574 SET CURR-DETERM-INACT-NO-88 TO TRUE. DTSBE770
|
|
02575 SET CURR-DETERM-REV-NO-88 TO TRUE. DTSBE770
|
|
02576 DTSBE770
|
|
02577 EVALUATE TRUE DTSBE770
|
|
02578 WHEN (MSOL-ESTB-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02579 AND MSOL-ESTB-DATE >= WRK-SUBJECT-QTR-START) DTSBE770
|
|
02580 SET CURR-DETERM-ESTB-YES-88 TO TRUE DTSBE770
|
|
02581 MOVE MSOL-ESTB-DATE TO WRK-CURR-ESTB-DATE DTSBE770
|
|
02582 DTSBE770
|
|
02583 WHEN (MSOL-INACT-ENTER-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02584 AND MSOL-INACT-ENTER-DATE >= WRK-SUBJECT-QTR-START) DTSBE770
|
|
02585 SET CURR-DETERM-INACT-YES-88 TO TRUE DTSBE770
|
|
02586 MOVE MSOL-INACT-ENTER-DATE TO WRK-CURR-INACT-DATE DTSBE770
|
|
02587 DTSBE770
|
|
02588 ** BASED ON CLARIFICATION FROM DOL, REVERSAL OF AN DTSBE770
|
|
02589 ** INACTIVATION SHOULD NOT BE COUNTED AS A DETERMINATION. DTSBE770
|
|
02590 ** DTSBE770
|
|
02591 ** WHEN (MSOL-INACT-REVERSE-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02592 ** AND MSOL-INACT-REVERSE-DATE >= WRK-SUBJECT-QTR-START) DTSBE770
|
|
02593 ** SET CURR-DETERM-REV-YES-88 TO TRUE DTSBE770
|
|
02594 ** MOVE MSOL-INACT-REVERSE-DATE DTSBE770
|
|
02595 ** TO WRK-CURR-INACT-REV-DATE DTSBE770
|
|
02596 DTSBE770
|
|
02597 END-EVALUATE. DTSBE770
|
|
02598 DTSBE770
|
|
02599 P3100-EXIT. DTSBE770
|
|
02600 EXIT. DTSBE770
|
|
02601 DTSBE770
|
|
02602 P3200-PRIOR-SOL. DTSBE770
|
|
02603 IF MSOL-LIAB-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02604 IF MSOL-LIAB-DATE < WRK-LIAB-DATE DTSBE770
|
|
02605 MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE DTSBE770
|
|
02606 MOVE MSOL-ESTB-DATE TO WRK-LIAB-PROCESS-DATE DTSBE770
|
|
02607 END-IF DTSBE770
|
|
02608 IF MSOL-LIAB-DATE > WRK-REOPEN-DATE DTSBE770
|
|
02609 MOVE MSOL-LIAB-DATE TO WRK-REOPEN-DATE DTSBE770
|
|
02610 MOVE MSOL-ESTB-DATE TO WRK-REOPEN-PROCESS-DATE DTSBE770
|
|
02611 END-IF DTSBE770
|
|
02612 END-IF. DTSBE770
|
|
02613 DTSBE770
|
|
02614 IF MSOL-INACT-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02615 IF MSOL-INACT-DATE > WRK-LAST-INACT-DATE DTSBE770
|
|
02616 MOVE MSOL-INACT-ENTER-DATE DTSBE770
|
|
02617 TO WRK-LAST-INACT-ENTER-DATE DTSBE770
|
|
02618 END-IF DTSBE770
|
|
02619 END-IF. DTSBE770
|
|
02620 P3200-EXIT. DTSBE770
|
|
02621 EXIT. DTSBE770
|
|
02622 DTSBE770
|
|
02623 P3300-BUILD-Y773. DTSBE770
|
|
02624 MOVE ZERO TO WRK-STATUS-DETERM-DATE DTSBE770
|
|
02625 WRK-STATUS-LIAB-DATE DTSBE770
|
|
02626 WRK-STATUS-ACT-DATE DTSBE770
|
|
02627 WRK-STATUS-REACT-DATE DTSBE770
|
|
02628 WRK-STATUS-INACT-DATE. DTSBE770
|
|
02629 DTSBE770
|
|
02630 IF MSOL-INACT-ACTIVE-88 DTSBE770
|
|
02631 IF CURR-DETERM-ESTB-YES-88 DTSBE770
|
|
02632 OR CURR-DETERM-REV-YES-88 DTSBE770
|
|
02633 PERFORM P3310-NEW THRU P3310-EXIT DTSBE770
|
|
02634 END-IF DTSBE770
|
|
02635 ELSE DTSBE770
|
|
02636 IF CURR-DETERM-INACT-YES-88 DTSBE770
|
|
02637 PERFORM P3320-INACT THRU P3320-EXIT DTSBE770
|
|
02638 END-IF DTSBE770
|
|
02639 END-IF. DTSBE770
|
|
02640 DTSBE770
|
|
02641 ** IF CURR-DETERM-NEW-88 DTSBE770
|
|
02642 * PERFORM P3310-NEW THRU P3310-EXIT DTSBE770
|
|
02643 * ELSE DTSBE770
|
|
02644 * IF CURR-DETERM-INACT-88 DTSBE770
|
|
02645 ** PERFORM P3320-INACT THRU P3320-EXIT. DTSBE770
|
|
02646 DTSBE770
|
|
02647 P3300-EXIT. DTSBE770
|
|
02648 EXIT. DTSBE770
|
|
02649 DTSBE770
|
|
02650 P3310-NEW. DTSBE770
|
|
02651 ***************************************************************** DTSBE770
|
|
02652 * EDIT TO CORRECT LIABILITY DETERMINATIONS ENTERED WITH FUTURE DTSBE770
|
|
02653 * LIABILITY DATES. DTSBE770
|
|
02654 ********************** DTSBE770
|
|
02655 IF WRK-CURR-ESTB-DATE < MSOL-LIAB-DATE DTSBE770
|
|
02656 IF MSOL-LIAB-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02657 MOVE MSOL-LIAB-DATE TO WRK-CURR-ESTB-DATE DTSBE770
|
|
02658 *** DISPLAY 'CORRECT DETERM ' MPRF-EMP-NO DTSBE770
|
|
02659 ELSE DTSBE770
|
|
02660 DISPLAY 'CANNOT CORRECT DETERM ' MPRF-EMP-NO DTSBE770
|
|
02661 ' ESTB ' WRK-CURR-ESTB-DATE DTSBE770
|
|
02662 ' LIAB ' MSOL-LIAB-DATE DTSBE770
|
|
02663 GO TO P3310-EXIT. DTSBE770
|
|
02664 ********************** DTSBE770
|
|
02665 DTSBE770
|
|
02666 IF WRK-REOPEN-DATE > WRK-LIAB-DATE DTSBE770
|
|
02667 PERFORM P3311-REOPEN THRU P3311-EXIT DTSBE770
|
|
02668 ELSE DTSBE770
|
|
02669 PERFORM P3312-ORIG THRU P3312-EXIT DTSBE770
|
|
02670 END-IF. DTSBE770
|
|
02671 DTSBE770
|
|
02672 ** BASED ON CLARIFICATION FROM DOL, REVERSAL OF AN DTSBE770
|
|
02673 ** INACTIVATION SHOULD NOT BE COUNTED AS A DETERMINATION. DTSBE770
|
|
02674 ** DTSBE770
|
|
02675 ** IF WRK-CURR-INACT-REV-DATE = ZERO DTSBE770
|
|
02676 * IF WRK-REOPEN-DATE > WRK-LIAB-DATE DTSBE770
|
|
02677 * PERFORM P3311-REOPEN THRU P3311-EXIT DTSBE770
|
|
02678 * ELSE DTSBE770
|
|
02679 * PERFORM P3312-ORIG THRU P3312-EXIT DTSBE770
|
|
02680 * END-IF DTSBE770
|
|
02681 * ELSE DTSBE770
|
|
02682 * PERFORM P3313-INACT-REV THRU P3313-EXIT DTSBE770
|
|
02683 ** END-IF. DTSBE770
|
|
02684 DTSBE770
|
|
02685 P3310-EXIT. DTSBE770
|
|
02686 EXIT. DTSBE770
|
|
02687 DTSBE770
|
|
02688 P3311-REOPEN. DTSBE770
|
|
02689 * DISPLAY 'P3311 ' MPRF-EMP-NO ' ' WRK-LIAB-DATE DTSBE770
|
|
02690 * ' ' WRK-REOPEN-DATE DTSBE770
|
|
02691 * ' ' WRK-LAST-INACT-ENTER-DATE. DTSBE770
|
|
02692 DTSBE770
|
|
02693 SET WRK-DETERM-REACT-88 TO TRUE. DTSBE770
|
|
02694 MOVE WRK-CURR-ESTB-DATE TO WRK-STATUS-DETERM-DATE. DTSBE770
|
|
02695 MOVE WRK-REOPEN-DATE TO WRK-STATUS-LIAB-DATE. DTSBE770
|
|
02696 ** MOVE MSOL-LIAB-DATE TO WRK-STATUS-LIAB-DATE. DTSBE770
|
|
02697 MOVE WRK-LIAB-PROCESS-DATE TO WRK-STATUS-ACT-DATE. DTSBE770
|
|
02698 MOVE WRK-CURR-ESTB-DATE TO WRK-STATUS-REACT-DATE. DTSBE770
|
|
02699 ** WRK-STATUS-ACT-DATE. DTSBE770
|
|
02700 MOVE WRK-LAST-INACT-ENTER-DATE TO WRK-STATUS-INACT-DATE. DTSBE770
|
|
02701 DTSBE770
|
|
02702 PERFORM P3900-WRITE-X773 THRU P3900-EXIT. DTSBE770
|
|
02703 DTSBE770
|
|
02704 * DISPLAY 'REOPEN ' MPRF-EMP-NO DTSBE770
|
|
02705 * ' STATUS ' WRK-CURR-ESTB-DATE DTSBE770
|
|
02706 * DISPLAY ' ACT ' WRK-LIAB-PROCESS-DATE DTSBE770
|
|
02707 * ' REOPEN ' WRK-CURR-ESTB-DATE DTSBE770
|
|
02708 * ' INACT ' WRK-LAST-INACT-ENTER-DATE DTSBE770
|
|
02709 * ' LIAB ' MSOL-LIAB-DATE. DTSBE770
|
|
02710 P3311-EXIT. DTSBE770
|
|
02711 EXIT. DTSBE770
|
|
02712 DTSBE770
|
|
02713 P3312-ORIG. DTSBE770
|
|
02714 SET WRK-DETERM-ORIG-88 TO TRUE. DTSBE770
|
|
02715 MOVE WRK-CURR-ESTB-DATE TO WRK-STATUS-DETERM-DATE. DTSBE770
|
|
02716 MOVE MSOL-LIAB-DATE TO WRK-STATUS-LIAB-DATE. DTSBE770
|
|
02717 MOVE WRK-CURR-ESTB-DATE TO WRK-STATUS-ACT-DATE. DTSBE770
|
|
02718 MOVE ZERO TO WRK-STATUS-REACT-DATE DTSBE770
|
|
02719 WRK-STATUS-INACT-DATE. DTSBE770
|
|
02720 DTSBE770
|
|
02721 PERFORM P3900-WRITE-X773 THRU P3900-EXIT. DTSBE770
|
|
02722 DTSBE770
|
|
02723 * DISPLAY 'NEW ' MPRF-EMP-NO DTSBE770
|
|
02724 * ' STATUS ' WRK-CURR-ESTB-DATE DTSBE770
|
|
02725 * DISPLAY ' ACT ' WRK-CURR-ESTB-DATE DTSBE770
|
|
02726 * ' REOPEN ' DTSBE770
|
|
02727 * ' INACT ' DTSBE770
|
|
02728 * ' LIAB ' MSOL-LIAB-DATE. DTSBE770
|
|
02729 P3312-EXIT. DTSBE770
|
|
02730 EXIT. DTSBE770
|
|
02731 DTSBE770
|
|
02732 *P3313-INACT-REV. DTSBE770
|
|
02733 * SET WRK-DETERM-REACT-88 TO TRUE. DTSBE770
|
|
02734 * MOVE WRK-CURR-INACT-REV-DATE TO WRK-STATUS-DETERM-DATE. DTSBE770
|
|
02735 * MOVE MSOL-LIAB-DATE TO WRK-STATUS-LIAB-DATE. DTSBE770
|
|
02736 ** MOVE MSOL-ESTB-DATE TO WRK-STATUS-ACT-DATE. DTSBE770
|
|
02737 * MOVE WRK-CURR-INACT-REV-DATE TO WRK-STATUS-REACT-DATE DTSBE770
|
|
02738 * WRK-STATUS-ACT-DATE. DTSBE770
|
|
02739 * MOVE MSOL-INACT-ENTER-DATE TO WRK-STATUS-INACT-DATE. DTSBE770
|
|
02740 * DTSBE770
|
|
02741 * PERFORM P3900-WRITE-X773 THRU P3900-EXIT. DTSBE770
|
|
02742 * DTSBE770
|
|
02743 * DISPLAY 'REV ' MPRF-EMP-NO DTSBE770
|
|
02744 * ' STATUS ' WRK-CURR-INACT-REV-DATE DTSBE770
|
|
02745 * DISPLAY ' ACT ' MSOL-ESTB-DATE DTSBE770
|
|
02746 * ' REOPEN ' WRK-CURR-INACT-REV-DATE DTSBE770
|
|
02747 * ' INACT ' MSOL-INACT-ENTER-DATE DTSBE770
|
|
02748 * ' LIAB ' MSOL-LIAB-DATE. DTSBE770
|
|
02749 *P3313-EXIT. DTSBE770
|
|
02750 * EXIT. DTSBE770
|
|
02751 DTSBE770
|
|
02752 P3320-INACT. DTSBE770
|
|
02753 SET WRK-DETERM-INACT-88 TO TRUE. DTSBE770
|
|
02754 MOVE WRK-CURR-INACT-DATE TO WRK-STATUS-DETERM-DATE. DTSBE770
|
|
02755 MOVE MSOL-LIAB-DATE TO WRK-STATUS-LIAB-DATE. DTSBE770
|
|
02756 MOVE ZERO TO WRK-STATUS-ACT-DATE DTSBE770
|
|
02757 WRK-STATUS-REACT-DATE. DTSBE770
|
|
02758 MOVE WRK-CURR-INACT-DATE TO WRK-STATUS-INACT-DATE. DTSBE770
|
|
02759 DTSBE770
|
|
02760 PERFORM P3900-WRITE-X773 THRU P3900-EXIT. DTSBE770
|
|
02761 DTSBE770
|
|
02762 * DISPLAY 'INACT ' MPRF-EMP-NO DTSBE770
|
|
02763 * ' STATUS ' WRK-CURR-INACT-DATE DTSBE770
|
|
02764 * DISPLAY ' ACT ' MSOL-ESTB-DATE DTSBE770
|
|
02765 * ' REOPEN ' DTSBE770
|
|
02766 * ' INACT ' DTSBE770
|
|
02767 * ' LIAB ' MSOL-LIAB-DATE. DTSBE770
|
|
02768 P3320-EXIT. DTSBE770
|
|
02769 EXIT. DTSBE770
|
|
02770 DTSBE770
|
|
02771 P3400-CHK-SUCCESSORS. DTSBE770
|
|
02772 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBE770
|
|
02773 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSBE770
|
|
02774 SET MREL-REL-88 TO TRUE. DTSBE770
|
|
02775 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02776 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02777 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
02778 MOVE MSKL-REC TO MREL-REC DTSBE770
|
|
02779 PERFORM P3410-CHECK-MREL THRU P3410-EXIT DTSBE770
|
|
02780 IF NOT L910-NO-REC-88 DTSBE770
|
|
02781 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02782 END-IF DTSBE770
|
|
02783 END-PERFORM. DTSBE770
|
|
02784 DTSBE770
|
|
02785 IF WRK-PRED-EMP-NO > ZERO DTSBE770
|
|
02786 SET WRK-DETERM-SUC-88 TO TRUE DTSBE770
|
|
02787 PERFORM P3900-WRITE-X773 THRU P3900-EXIT DTSBE770
|
|
02788 ** DISPLAY 'SUCC ' MPRF-EMP-NO DTSBE770
|
|
02789 * ' PRED ' WRK-PRED-EMP-NO DTSBE770
|
|
02790 * ' DETERM ' WRK-STATUS-DETERM-DATE DTSBE770
|
|
02791 ** ' ACT ' WRK-STATUS-ACT-DATE DTSBE770
|
|
02792 END-IF. DTSBE770
|
|
02793 DTSBE770
|
|
02794 P3400-EXIT. DTSBE770
|
|
02795 EXIT. DTSBE770
|
|
02796 DTSBE770
|
|
02797 P3410-CHECK-MREL. DTSBE770
|
|
02798 IF (MREL-ESTB-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02799 AND MREL-ESTB-DATE >= WRK-SUBJECT-QTR-START) DTSBE770
|
|
02800 MOVE MREL-ESTB-DATE TO WRK-STATUS-DETERM-DATE DTSBE770
|
|
02801 WRK-STATUS-SUCC-DATE DTSBE770
|
|
02802 WRK-STATUS-ACT-DATE DTSBE770
|
|
02803 MOVE MREL-EFF-DATE TO WRK-STATUS-LIAB-DATE DTSBE770
|
|
02804 MOVE MREL-PRED-EMP-NO TO WRK-PRED-EMP-NO DTSBE770
|
|
02805 *** PERFORM P3420-FIND-MSOL THRU P3420-EXIT DTSBE770
|
|
02806 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
02807 END-IF. DTSBE770
|
|
02808 DTSBE770
|
|
02809 P3410-EXIT. DTSBE770
|
|
02810 EXIT. DTSBE770
|
|
02811 DTSBE770
|
|
02812 *P3420-FIND-MSOL. DTSBE770
|
|
02813 * MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE770
|
|
02814 * MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE770
|
|
02815 * SET MSOL-SOL-88 TO TRUE. DTSBE770
|
|
02816 * MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02817 * PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02818 * PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
02819 * MOVE MSKL-REC TO MSOL-REC DTSBE770
|
|
02820 * PERFORM P3421-CHECK-MSOL THRU P3421-EXIT DTSBE770
|
|
02821 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02822 * END-PERFORM. DTSBE770
|
|
02823 * DTSBE770
|
|
02824 *P3420-EXIT. DTSBE770
|
|
02825 * EXIT. DTSBE770
|
|
02826 * DTSBE770
|
|
02827 *P3421-CHECK-MSOL. DTSBE770
|
|
02828 * IF (MSOL-ESTB-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
02829 * AND MSOL-ESTB-DATE >= WRK-SUBJECT-QTR-START) DTSBE770
|
|
02830 * MOVE MSOL-ESTB-DATE TO WRK-STATUS-ACT-DATE DTSBE770
|
|
02831 * END-IF. DTSBE770
|
|
02832 ** IF (MREL-EFF-DATE >= MSOL-LIAB-DATE DTSBE770
|
|
02833 * AND MREL-EFF-DATE <= MSOL-INACT-DATE) DTSBE770
|
|
02834 * MOVE MSOL-ESTB-DATE TO WRK-STATUS-ACT-DATE DTSBE770
|
|
02835 ** END-IF. DTSBE770
|
|
02836 * DTSBE770
|
|
02837 *P3421-EXIT. DTSBE770
|
|
02838 * EXIT. DTSBE770
|
|
02839 DTSBE770
|
|
02840 * DTSBE770
|
|
02841 P3900-WRITE-X773. DTSBE770
|
|
02842 MOVE LENGTH OF Y773-REC TO Y773-LENGTH. DTSBE770
|
|
02843 SET Y773-REC-TYPE-773-88 TO TRUE. DTSBE770
|
|
02844 DTSBE770
|
|
02845 ADD +1 TO WRK-Y773-CNT. DTSBE770
|
|
02846 DTSBE770
|
|
02847 MOVE MPRF-EMP-NO TO Y773-EMP-NO. DTSBE770
|
|
02848 DTSBE770
|
|
02849 MOVE MPRF-EMP-CLASS TO Y773-EMP-CLASS. DTSBE770
|
|
02850 DTSBE770
|
|
02851 MOVE WRK-DETERM-TYPE-IND TO Y773-DETERM-TYPE. DTSBE770
|
|
02852 DTSBE770
|
|
02853 MOVE WRK-STATUS-DETERM-DATE TO Y773-STATUS-DETERM-DATE. DTSBE770
|
|
02854 DTSBE770
|
|
02855 MOVE WRK-STATUS-LIAB-DATE TO Y773-LIAB-DATE. DTSBE770
|
|
02856 DTSBE770
|
|
02857 MOVE WRK-STATUS-ACT-DATE TO Y773-ACTIVATION-DATE. DTSBE770
|
|
02858 DTSBE770
|
|
02859 MOVE WRK-STATUS-REACT-DATE TO Y773-REACT-DATE. DTSBE770
|
|
02860 DTSBE770
|
|
02861 MOVE WRK-STATUS-INACT-DATE TO Y773-INACT-DATE. DTSBE770
|
|
02862 DTSBE770
|
|
02863 MOVE WRK-STATUS-SUCC-DATE TO Y773-SUCC-DATE. DTSBE770
|
|
02864 DTSBE770
|
|
02865 MOVE WRK-PRED-EMP-NO TO Y773-PRED-EMP-NO. DTSBE770
|
|
02866 DTSBE770
|
|
02867 PERFORM S773-WRITE-R773 THRU S773-EXIT. DTSBE770
|
|
02868 DTSBE770
|
|
02869 ****************************************************** DTSBE770
|
|
02870 * ADD TPS STATUS UNIVERSE TRANSACTION RECORD DTSBE770
|
|
02871 ****************************************************** DTSBE770
|
|
02872 IF NOT MPRF-CLASS-SUB-88 DTSBE770
|
|
02873 GO TO P3900-EXIT DTSBE770
|
|
02874 END-IF. DTSBE770
|
|
02875 DTSBE770
|
|
02876 SET M715-TYPE-STATUS-88 TO TRUE. DTSBE770
|
|
02877 MOVE MPRF-EMP-NO TO M715-EMP-NO. DTSBE770
|
|
02878 MOVE MPRF-PRIMARY-NAME TO M715-EMP-NAME. DTSBE770
|
|
02879 MOVE WRK-STATUS-DETERM-DATE TO M715-PROCESS-DT. DTSBE770
|
|
02880 EVALUATE TRUE DTSBE770
|
|
02881 WHEN WRK-DETERM-ORIG-88 DTSBE770
|
|
02882 SET M715-DETERM-NEW-88 TO TRUE DTSBE770
|
|
02883 MOVE WRK-STATUS-LIAB-DATE TO M715-EFF-DT DTSBE770
|
|
02884 DTSBE770
|
|
02885 WHEN WRK-DETERM-REACT-88 DTSBE770
|
|
02886 SET M715-DETERM-NEW-88 TO TRUE DTSBE770
|
|
02887 MOVE WRK-STATUS-REACT-DATE TO M715-EFF-DT DTSBE770
|
|
02888 DTSBE770
|
|
02889 WHEN WRK-DETERM-SUC-88 DTSBE770
|
|
02890 SET M715-DETERM-SUCC-88 TO TRUE DTSBE770
|
|
02891 MOVE WRK-STATUS-SUCC-DATE TO M715-EFF-DT DTSBE770
|
|
02892 DTSBE770
|
|
02893 WHEN WRK-DETERM-INACT-88 DTSBE770
|
|
02894 SET M715-DETERM-INACT-88 TO TRUE DTSBE770
|
|
02895 MOVE WRK-STATUS-INACT-DATE TO M715-EFF-DT DTSBE770
|
|
02896 DTSBE770
|
|
02897 END-EVALUATE. DTSBE770
|
|
02898 DTSBE770
|
|
02899 IF WRK-DETERM-NULL-88 DTSBE770
|
|
02900 DISPLAY 'WRK-DETERM-NULL ' MPRF-EMP-NO DTSBE770
|
|
02901 GO TO P3900-EXIT DTSBE770
|
|
02902 END-IF. DTSBE770
|
|
02903 DTSBE770
|
|
02904 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
02905 DTSBE770
|
|
02906 EVALUATE TRUE DTSBE770
|
|
02907 WHEN L004-QTR-5-Q = 1 DTSBE770
|
|
02908 WRITE TPS-STATUS-QTR1-REC FROM TPS-TRANS-REC DTSBE770
|
|
02909 DTSBE770
|
|
02910 WHEN L004-QTR-5-Q = 2 DTSBE770
|
|
02911 WRITE TPS-STATUS-QTR2-REC FROM TPS-TRANS-REC DTSBE770
|
|
02912 DTSBE770
|
|
02913 WHEN L004-QTR-5-Q = 3 DTSBE770
|
|
02914 WRITE TPS-STATUS-QTR3-REC FROM TPS-TRANS-REC DTSBE770
|
|
02915 DTSBE770
|
|
02916 WHEN L004-QTR-5-Q = 4 DTSBE770
|
|
02917 WRITE TPS-STATUS-QTR4-REC FROM TPS-TRANS-REC DTSBE770
|
|
02918 DTSBE770
|
|
02919 END-EVALUATE. DTSBE770
|
|
02920 DTSBE770
|
|
02921 ADD +1 TO WRK-TPS-STATUS-CNT. DTSBE770
|
|
02922 DTSBE770
|
|
02923 P3900-EXIT. DTSBE770
|
|
02924 EXIT. DTSBE770
|
|
02925 DTSBE770
|
|
02926 P4000-ACCTS-RECEIVABLE. DTSBE770
|
|
02927 PERFORM DTSBE770
|
|
02928 VARYING QTR-SUB FROM +1 BY +1 DTSBE770
|
|
02929 UNTIL QTR-SUB > +400 DTSBE770
|
|
02930 MOVE +0 TO WRK-JRN-YRQ (QTR-SUB) DTSBE770
|
|
02931 WRK-JRN-PAID (QTR-SUB) DTSBE770
|
|
02932 WRK-JRN-CHG (QTR-SUB) DTSBE770
|
|
02933 WRK-TAX-DUE-DATE (QTR-SUB) DTSBE770
|
|
02934 END-PERFORM. DTSBE770
|
|
02935 DTSBE770
|
|
02936 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
02937 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
02938 SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
02939 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02940 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02941 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
02942 MOVE MSKL-REC TO MQTR-REC DTSBE770
|
|
02943 PERFORM P4100-MQTR-DUE-DATE THRU P4100-EXIT DTSBE770
|
|
02944 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02945 END-PERFORM. DTSBE770
|
|
02946 DTSBE770
|
|
02947 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE770
|
|
02948 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE770
|
|
02949 SET MJRN-JRN-88 TO TRUE. DTSBE770
|
|
02950 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
02951 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
02952 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
02953 MOVE MSKL-REC TO MJRN-REC DTSBE770
|
|
02954 ADD +1 TO WRK-MJRN-READ-CNT DTSBE770
|
|
02955 PERFORM P4200-ACCT-TABLE THRU P4200-EXIT DTSBE770
|
|
02956 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
02957 END-PERFORM. DTSBE770
|
|
02958 DTSBE770
|
|
02959 DTSBE770
|
|
02960 P4000-EXIT. DTSBE770
|
|
02961 EXIT. DTSBE770
|
|
02962 DTSBE770
|
|
02963 P4100-MQTR-DUE-DATE. DTSBE770
|
|
02964 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE770
|
|
02965 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
02966 MOVE L004-ABS-QTR TO QTR-SUB. DTSBE770
|
|
02967 MOVE MQTR-TAX-DUE-DATE TO DTSBE770
|
|
02968 WRK-TAX-DUE-DATE (QTR-SUB). DTSBE770
|
|
02969 DTSBE770
|
|
02970 P4100-EXIT. DTSBE770
|
|
02971 EXIT. DTSBE770
|
|
02972 DTSBE770
|
|
02973 DTSBE770
|
|
02974 P4200-ACCT-TABLE. DTSBE770
|
|
02975 MOVE +400 TO WRK-FIRST-SUB. DTSBE770
|
|
02976 MOVE +0 TO WRK-LAST-SUB DTSBE770
|
|
02977 WRK-TBL-CNT. DTSBE770
|
|
02978 DTSBE770
|
|
02979 PERFORM DTSBE770
|
|
02980 VARYING QTR-SUB FROM +1 BY +1 DTSBE770
|
|
02981 UNTIL QTR-SUB > +400 DTSBE770
|
|
02982 MOVE +0 TO WRK-JRN-YRQ (QTR-SUB) DTSBE770
|
|
02983 WRK-JRN-PAID (QTR-SUB) DTSBE770
|
|
02984 WRK-JRN-CHG (QTR-SUB) DTSBE770
|
|
02985 END-PERFORM. DTSBE770
|
|
02986 DTSBE770
|
|
02987 IF MJRN-TRAN-CNVR-88 DTSBE770
|
|
02988 GO TO P4200-EXIT. DTSBE770
|
|
02989 DTSBE770
|
|
02990 IF MJRN-ESTB-DATE > WRK-SUBJECT-QTR-END DTSBE770
|
|
02991 GO TO P4200-EXIT. DTSBE770
|
|
02992 DTSBE770
|
|
02993 PERFORM P4210-ACCT-ENTRY THRU P4210-EXIT DTSBE770
|
|
02994 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBE770
|
|
02995 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT. DTSBE770
|
|
02996 DTSBE770
|
|
02997 IF WRK-TBL-CNT > ZERO DTSBE770
|
|
02998 PERFORM P4300-WRITE-OUTPUT THRU P4300-EXIT. DTSBE770
|
|
02999 DTSBE770
|
|
03000 P4200-EXIT. DTSBE770
|
|
03001 EXIT. DTSBE770
|
|
03002 DTSBE770
|
|
03003 P4210-ACCT-ENTRY. DTSBE770
|
|
03004 IF MJRN-YRQ (MJRN-OCC-IDX) = LECM-PICKUP-YRQ DTSBE770
|
|
03005 OR MJRN-YRQ (MJRN-OCC-IDX) > WRK-SUBJECT-QTR DTSBE770
|
|
03006 GO TO P4210-EXIT. DTSBE770
|
|
03007 DTSBE770
|
|
03008 IF MJRN-ROW-UI-88 (MJRN-OCC-IDX) DTSBE770
|
|
03009 NEXT SENTENCE DTSBE770
|
|
03010 ELSE DTSBE770
|
|
03011 GO TO P4210-EXIT. DTSBE770
|
|
03012 DTSBE770
|
|
03013 IF MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBE770
|
|
03014 OR MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE770
|
|
03015 OR MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBE770
|
|
03016 NEXT SENTENCE DTSBE770
|
|
03017 ELSE DTSBE770
|
|
03018 GO TO P4210-EXIT. DTSBE770
|
|
03019 DTSBE770
|
|
03020 ADD +1 TO WRK-TBL-CNT. DTSBE770
|
|
03021 DTSBE770
|
|
03022 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9. DTSBE770
|
|
03023 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE770
|
|
03024 MOVE L004-ABS-QTR TO QTR-SUB. DTSBE770
|
|
03025 MOVE L004-QTR-5-9 TO WRK-JRN-YRQ (QTR-SUB). DTSBE770
|
|
03026 DTSBE770
|
|
03027 IF QTR-SUB < WRK-FIRST-SUB DTSBE770
|
|
03028 MOVE QTR-SUB TO WRK-FIRST-SUB. DTSBE770
|
|
03029 DTSBE770
|
|
03030 IF QTR-SUB > WRK-LAST-SUB DTSBE770
|
|
03031 MOVE QTR-SUB TO WRK-LAST-SUB. DTSBE770
|
|
03032 DTSBE770
|
|
03033 IF WRK-TAX-DUE-DATE (QTR-SUB) = ZERO DTSBE770
|
|
03034 MOVE L004-QTR-DEFAULT-DUE-DATE TO DTSBE770
|
|
03035 WRK-TAX-DUE-DATE (QTR-SUB) DTSBE770
|
|
03036 END-IF. DTSBE770
|
|
03037 DTSBE770
|
|
03038 IF MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBE770
|
|
03039 OR MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBE770
|
|
03040 ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-JRN-PAID (QTR-SUB) DTSBE770
|
|
03041 ELSE DTSBE770
|
|
03042 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE770
|
|
03043 ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-JRN-CHG (QTR-SUB). DTSBE770
|
|
03044 DTSBE770
|
|
03045 P4210-EXIT. DTSBE770
|
|
03046 EXIT. DTSBE770
|
|
03047 DTSBE770
|
|
03048 DTSBE770
|
|
03049 P4300-WRITE-OUTPUT. DTSBE770
|
|
03050 PERFORM P4310-SCAN-QTR-TAB THRU P4310-EXIT DTSBE770
|
|
03051 VARYING QTR-SUB FROM WRK-FIRST-SUB BY +1 DTSBE770
|
|
03052 UNTIL QTR-SUB > WRK-LAST-SUB. DTSBE770
|
|
03053 DTSBE770
|
|
03054 P4300-EXIT. DTSBE770
|
|
03055 EXIT. DTSBE770
|
|
03056 DTSBE770
|
|
03057 P4310-SCAN-QTR-TAB. DTSBE770
|
|
03058 IF WRK-JRN-YRQ (QTR-SUB) = ZERO DTSBE770
|
|
03059 GO TO P4310-EXIT. DTSBE770
|
|
03060 DTSBE770
|
|
03061 COMPUTE WRK-AMT = DTSBE770
|
|
03062 (WRK-JRN-CHG (QTR-SUB) - WRK-JRN-PAID (QTR-SUB)). DTSBE770
|
|
03063 PERFORM P4311-WRITE-Y774 THRU P4311-EXIT. DTSBE770
|
|
03064 DTSBE770
|
|
03065 P4310-EXIT. DTSBE770
|
|
03066 EXIT. DTSBE770
|
|
03067 DTSBE770
|
|
03068 P4311-WRITE-Y774. DTSBE770
|
|
03069 MOVE LENGTH OF Y774-REC TO Y774-LENGTH. DTSBE770
|
|
03070 SET Y774-REC-TYPE-774-88 TO TRUE. DTSBE770
|
|
03071 DTSBE770
|
|
03072 MOVE MPRF-EMP-NO TO Y774-EMP-NO. DTSBE770
|
|
03073 MOVE WRK-JRN-YRQ (QTR-SUB) TO Y774-YRQ. DTSBE770
|
|
03074 MOVE MJRN-ESTB-DATE TO Y774-ESTB-DATE. DTSBE770
|
|
03075 MOVE MJRN-RECEIVED-DATE TO Y774-RCVD-DATE. DTSBE770
|
|
03076 MOVE WRK-TAX-DUE-DATE (QTR-SUB) DTSBE770
|
|
03077 TO Y774-DUE-DATE. DTSBE770
|
|
03078 DTSBE770
|
|
03079 IF WRK-AMT > ZERO DTSBE770
|
|
03080 SET Y774-TYPE-RECEIVABLE-88 TO TRUE DTSBE770
|
|
03081 ELSE DTSBE770
|
|
03082 SET Y774-TYPE-LIQUIDATION-88 TO TRUE. DTSBE770
|
|
03083 DTSBE770
|
|
03084 IF MPRF-CLASS-RATED-88 DTSBE770
|
|
03085 SET Y774-EMP-CLASS-CONTRIB-88 TO TRUE DTSBE770
|
|
03086 ELSE DTSBE770
|
|
03087 IF MPRF-CLASS-SELF-INS-88 DTSBE770
|
|
03088 SET Y774-EMP-CLASS-REIMB-88 TO TRUE DTSBE770
|
|
03089 ELSE DTSBE770
|
|
03090 GO TO P4311-EXIT. DTSBE770
|
|
03091 DTSBE770
|
|
03092 MOVE WRK-AMT TO Y774-AMT. DTSBE770
|
|
03093 DTSBE770
|
|
03094 PERFORM S774-WRITE-R774 THRU S774-EXIT. DTSBE770
|
|
03095 ADD +1 TO WRK-Y774-CNT. DTSBE770
|
|
03096 DTSBE770
|
|
03097 P4311-EXIT. DTSBE770
|
|
03098 EXIT. DTSBE770
|
|
03099 DTSBE770
|
|
03100 P5000-AUDIT-ACTIVITY. DTSBE770
|
|
03101 ** THE INDICATOR BELOW IS ONLY SET WHEN THERE IS A CURRENT DTSBE770
|
|
03102 ** FIELD ASSIGNMENT. IT CANNOT BE USED TO DETERMINE WHETHER DTSBE770
|
|
03103 ** AN AUDIT ASSIGNMENT EXISTS. DTSBE770
|
|
03104 ** IF MPRF-NO-MFAS-88 DTSBE770
|
|
03105 ** GO TO P5000-EXIT. DTSBE770
|
|
03106 DTSBE770
|
|
03107 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSBE770
|
|
03108 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBE770
|
|
03109 SET MFAS-FAS-88 TO TRUE. DTSBE770
|
|
03110 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03111 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03112 PERFORM P5100-SCAN-MFAS THRU P5100-EXIT DTSBE770
|
|
03113 UNTIL L910-NO-REC-88. DTSBE770
|
|
03114 P5000-EXIT. DTSBE770
|
|
03115 EXIT. DTSBE770
|
|
03116 SKIP3 DTSBE770
|
|
03117 P5100-SCAN-MFAS. DTSBE770
|
|
03118 MOVE MSKL-REC TO MFAS-REC. DTSBE770
|
|
03119 DTSBE770
|
|
03120 IF (MFAS-PROCESSED-DATE < WRK-SUBJECT-QTR-START) DTSBE770
|
|
03121 OR DTSBE770
|
|
03122 (MFAS-PROCESSED-DATE > WRK-SUBJECT-QTR-END) DTSBE770
|
|
03123 NEXT SENTENCE DTSBE770
|
|
03124 ELSE DTSBE770
|
|
03125 PERFORM P5110-INIT-RESULTS THRU P5110-EXIT DTSBE770
|
|
03126 PERFORM P5120-AUDIT-RESULTS THRU P5120-EXIT DTSBE770
|
|
03127 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA DTSBE770
|
|
03128 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE770
|
|
03129 IF L910-NO-REC-88 DTSBE770
|
|
03130 MOVE 'LOGIC ERROR IN P5100' TO ABEND-MSG DTSBE770
|
|
03131 PERFORM S999-ABEND THRU S999-EXIT. DTSBE770
|
|
03132 DTSBE770
|
|
03133 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
03134 P5100-EXIT. DTSBE770
|
|
03135 EXIT. DTSBE770
|
|
03136 SKIP3 DTSBE770
|
|
03137 P5110-INIT-RESULTS. DTSBE770
|
|
03138 MOVE ZERO TO WRK-POST-AUDIT-TOT-WAGE DTSBE770
|
|
03139 WRK-PRE-AUDIT-TOT-WAGE DTSBE770
|
|
03140 WRK-OVER-RPT-TOT-WAGE DTSBE770
|
|
03141 WRK-UNDER-RPT-TOT-WAGE DTSBE770
|
|
03142 WRK-POST-AUDIT-TAX-WAGE DTSBE770
|
|
03143 WRK-PRE-AUDIT-TAX-WAGE DTSBE770
|
|
03144 WRK-OVER-RPT-TAX-WAGE DTSBE770
|
|
03145 WRK-UNDER-RPT-TAX-WAGE DTSBE770
|
|
03146 WRK-POST-AUDIT-CONTRIB DTSBE770
|
|
03147 WRK-PRE-AUDIT-CONTRIB DTSBE770
|
|
03148 WRK-UNDER-RPT-CONTRIB DTSBE770
|
|
03149 WRK-OVER-RPT-CONTRIB. DTSBE770
|
|
03150 DTSBE770
|
|
03151 P5110-EXIT. DTSBE770
|
|
03152 EXIT. DTSBE770
|
|
03153 DTSBE770
|
|
03154 P5120-AUDIT-RESULTS. DTSBE770
|
|
03155 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSBE770
|
|
03156 MOVE MPRF-EMP-NO TO MAUR-EMP-NO. DTSBE770
|
|
03157 SET MAUR-AUR-88 TO TRUE. DTSBE770
|
|
03158 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSBE770
|
|
03159 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03160 PERFORM S910-READ THRU S910-EXIT. DTSBE770
|
|
03161 IF L910-NO-REC-88 DTSBE770
|
|
03162 GO TO P5120-EXIT. DTSBE770
|
|
03163 DTSBE770
|
|
03164 MOVE MSKL-REC TO MAUR-REC. DTSBE770
|
|
03165 DTSBE770
|
|
03166 MOVE 'N' TO WRK-CHANGE-AUDIT-IND. DTSBE770
|
|
03167 DTSBE770
|
|
03168 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSBE770
|
|
03169 MOVE MPRF-EMP-NO TO MAUY-EMP-NO. DTSBE770
|
|
03170 SET MAUY-AUY-88 TO TRUE. DTSBE770
|
|
03171 MOVE MFAS-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSBE770
|
|
03172 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03173 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03174 PERFORM P5121-SCAN-MAUY THRU P5121-EXIT DTSBE770
|
|
03175 UNTIL L910-NO-REC-88. DTSBE770
|
|
03176 DTSBE770
|
|
03177 PERFORM P5130-GET-TAX-CONTRB THRU P5130-EXIT. DTSBE770
|
|
03178 DTSBE770
|
|
03179 PERFORM P5200-WRITE-Y775 THRU P5200-EXIT. DTSBE770
|
|
03180 DTSBE770
|
|
03181 P5120-EXIT. DTSBE770
|
|
03182 EXIT. DTSBE770
|
|
03183 SKIP3 DTSBE770
|
|
03184 P5121-SCAN-MAUY. DTSBE770
|
|
03185 MOVE MSKL-REC TO MAUY-REC. DTSBE770
|
|
03186 DTSBE770
|
|
03187 IF MAUY-ASSIGN-NO = MFAS-ASSIGN-NO DTSBE770
|
|
03188 NEXT SENTENCE DTSBE770
|
|
03189 ELSE DTSBE770
|
|
03190 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
03191 GO TO P5121-EXIT. DTSBE770
|
|
03192 DTSBE770
|
|
03193 PERFORM P5121A-QTR-LOOP THRU P5121A-EXIT DTSBE770
|
|
03194 VARYING MAUY-QTR-IDX FROM 1 BY 1 DTSBE770
|
|
03195 UNTIL MAUY-QTR-IDX > MMAX-AUY-QTR-MAX. DTSBE770
|
|
03196 DTSBE770
|
|
03197 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
03198 P5121-EXIT. DTSBE770
|
|
03199 EXIT. DTSBE770
|
|
03200 SKIP3 DTSBE770
|
|
03201 P5121A-QTR-LOOP. DTSBE770
|
|
03202 IF MAUY-QTR-NOT-AUDITED-88 (MAUY-QTR-IDX) DTSBE770
|
|
03203 GO TO P5121A-EXIT. DTSBE770
|
|
03204 DTSBE770
|
|
03205 ADD MAUY-QTR-GROSS-PAYROLL (MAUY-QTR-IDX) DTSBE770
|
|
03206 TO WRK-POST-AUDIT-TOT-WAGE. DTSBE770
|
|
03207 DTSBE770
|
|
03208 IF (MAUY-QTR-UNDER-TOT-WAGE (MAUY-QTR-IDX) = +0) DTSBE770
|
|
03209 AND DTSBE770
|
|
03210 (MAUY-QTR-UNDER-TAX-WAGE (MAUY-QTR-IDX) = +0) DTSBE770
|
|
03211 AND DTSBE770
|
|
03212 (MAUY-QTR-UNDER-CONTRIB (MAUY-QTR-IDX) = +0) DTSBE770
|
|
03213 AND DTSBE770
|
|
03214 (MAUY-QTR-OVER-TOT-WAGE (MAUY-QTR-IDX) = +0) DTSBE770
|
|
03215 AND DTSBE770
|
|
03216 (MAUY-QTR-OVER-TAX-WAGE (MAUY-QTR-IDX) = +0) DTSBE770
|
|
03217 AND DTSBE770
|
|
03218 (MAUY-QTR-OVER-CONTRIB (MAUY-QTR-IDX) = +0) DTSBE770
|
|
03219 NEXT SENTENCE DTSBE770
|
|
03220 ELSE DTSBE770
|
|
03221 MOVE 'Y' TO WRK-CHANGE-AUDIT-IND. DTSBE770
|
|
03222 DTSBE770
|
|
03223 ADD MAUY-QTR-UNDER-TOT-WAGE (MAUY-QTR-IDX) DTSBE770
|
|
03224 TO WRK-UNDER-RPT-TOT-WAGE. DTSBE770
|
|
03225 DTSBE770
|
|
03226 ADD MAUY-QTR-UNDER-TAX-WAGE (MAUY-QTR-IDX) DTSBE770
|
|
03227 TO WRK-UNDER-RPT-TAX-WAGE. DTSBE770
|
|
03228 DTSBE770
|
|
03229 ADD MAUY-QTR-UNDER-CONTRIB (MAUY-QTR-IDX) DTSBE770
|
|
03230 TO WRK-UNDER-RPT-CONTRIB. DTSBE770
|
|
03231 DTSBE770
|
|
03232 ADD MAUY-QTR-OVER-TOT-WAGE (MAUY-QTR-IDX) DTSBE770
|
|
03233 TO WRK-OVER-RPT-TOT-WAGE. DTSBE770
|
|
03234 DTSBE770
|
|
03235 ADD MAUY-QTR-OVER-TAX-WAGE (MAUY-QTR-IDX) DTSBE770
|
|
03236 TO WRK-OVER-RPT-TAX-WAGE. DTSBE770
|
|
03237 DTSBE770
|
|
03238 ADD MAUY-QTR-OVER-CONTRIB (MAUY-QTR-IDX) DTSBE770
|
|
03239 TO WRK-OVER-RPT-CONTRIB. DTSBE770
|
|
03240 DTSBE770
|
|
03241 COMPUTE WRK-PRE-AUDIT-TOT-WAGE DTSBE770
|
|
03242 = WRK-POST-AUDIT-TOT-WAGE DTSBE770
|
|
03243 - WRK-UNDER-RPT-TOT-WAGE DTSBE770
|
|
03244 + WRK-OVER-RPT-TOT-WAGE. DTSBE770
|
|
03245 DTSBE770
|
|
03246 P5121A-EXIT. DTSBE770
|
|
03247 EXIT. DTSBE770
|
|
03248 DTSBE770
|
|
03249 P5130-GET-TAX-CONTRB. DTSBE770
|
|
03250 MOVE ZERO TO WRK-AUDIT-TOT-WAGE DTSBE770
|
|
03251 WRK-AUDIT-TAX-WAGE DTSBE770
|
|
03252 WRK-AUDIT-UI-CHG DTSBE770
|
|
03253 WRK-ORIG-TOT-WAGE DTSBE770
|
|
03254 WRK-ORIG-TAX-WAGE DTSBE770
|
|
03255 WRK-ORIG-UI-CHG. DTSBE770
|
|
03256 DTSBE770
|
|
03257 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBE770
|
|
03258 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE770
|
|
03259 SET MRPT-RPT-88 TO TRUE. DTSBE770
|
|
03260 MOVE MAUR-FIRST-YRQ TO MRPT-YRQ. DTSBE770
|
|
03261 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03262 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03263 PERFORM P5131-SCAN-MRPT THRU P5131-EXIT DTSBE770
|
|
03264 UNTIL L910-NO-REC-88. DTSBE770
|
|
03265 DTSBE770
|
|
03266 DTSBE770
|
|
03267 MOVE WRK-ORIG-TAX-WAGE TO WRK-PRE-AUDIT-TAX-WAGE. DTSBE770
|
|
03268 COMPUTE WRK-POST-AUDIT-TAX-WAGE = DTSBE770
|
|
03269 (WRK-ORIG-TAX-WAGE + WRK-AUDIT-TAX-WAGE). DTSBE770
|
|
03270 DTSBE770
|
|
03271 IF WRK-POST-AUDIT-TAX-WAGE > WRK-PRE-AUDIT-TAX-WAGE DTSBE770
|
|
03272 **NH COMPUTE WRK-UNDER-RPT-TAX-WAGE = DTSBE770
|
|
03273 **NH (WRK-POST-AUDIT-TAX-WAGE - WRK-PRE-AUDIT-TAX-WAGE) DTSBE770
|
|
03274 CONTINUE DTSBE770
|
|
03275 ELSE DTSBE770
|
|
03276 IF WRK-POST-AUDIT-TAX-WAGE < WRK-PRE-AUDIT-TAX-WAGE DTSBE770
|
|
03277 **NH COMPUTE WRK-OVER-RPT-TAX-WAGE = DTSBE770
|
|
03278 **NH (WRK-PRE-AUDIT-TAX-WAGE - WRK-POST-AUDIT-TAX-WAGE) DTSBE770
|
|
03279 CONTINUE DTSBE770
|
|
03280 ELSE DTSBE770
|
|
03281 **NH MOVE ZERO TO WRK-PRE-AUDIT-TAX-WAGE DTSBE770
|
|
03282 **NH WRK-POST-AUDIT-TAX-WAGE DTSBE770
|
|
03283 MOVE ZERO TO WRK-UNDER-RPT-TAX-WAGE DTSBE770
|
|
03284 WRK-OVER-RPT-TAX-WAGE DTSBE770
|
|
03285 END-IF DTSBE770
|
|
03286 END-IF. DTSBE770
|
|
03287 DTSBE770
|
|
03288 MOVE WRK-ORIG-UI-CHG TO WRK-PRE-AUDIT-CONTRIB. DTSBE770
|
|
03289 COMPUTE WRK-POST-AUDIT-CONTRIB = DTSBE770
|
|
03290 (WRK-ORIG-UI-CHG + WRK-AUDIT-UI-CHG). DTSBE770
|
|
03291 DTSBE770
|
|
03292 IF WRK-POST-AUDIT-CONTRIB > WRK-PRE-AUDIT-CONTRIB DTSBE770
|
|
03293 **NH COMPUTE WRK-UNDER-RPT-CONTRIB = DTSBE770
|
|
03294 **NH (WRK-POST-AUDIT-CONTRIB - WRK-PRE-AUDIT-CONTRIB) DTSBE770
|
|
03295 CONTINUE DTSBE770
|
|
03296 ELSE DTSBE770
|
|
03297 IF WRK-POST-AUDIT-CONTRIB < WRK-PRE-AUDIT-CONTRIB DTSBE770
|
|
03298 **NH COMPUTE WRK-OVER-RPT-CONTRIB = DTSBE770
|
|
03299 **NH (WRK-PRE-AUDIT-CONTRIB - WRK-POST-AUDIT-CONTRIB) DTSBE770
|
|
03300 CONTINUE DTSBE770
|
|
03301 ELSE DTSBE770
|
|
03302 *NH MOVE ZERO TO WRK-PRE-AUDIT-CONTRIB DTSBE770
|
|
03303 *NH WRK-POST-AUDIT-CONTRIB DTSBE770
|
|
03304 MOVE ZERO TO WRK-UNDER-RPT-CONTRIB DTSBE770
|
|
03305 WRK-OVER-RPT-CONTRIB DTSBE770
|
|
03306 END-IF DTSBE770
|
|
03307 END-IF. DTSBE770
|
|
03308 DTSBE770
|
|
03309 *& DTSBE770
|
|
03310 * IF MFAS-EMP-NO = 134222 DTSBE770
|
|
03311 * DISPLAY 'P5130 ' MPRF-EMP-NO DTSBE770
|
|
03312 * ' FIRST YRQ ' MAUR-FIRST-YRQ DTSBE770
|
|
03313 * ' LAST YRQ ' MAUR-LAST-YRQ DTSBE770
|
|
03314 * DISPLAY ' ORIG TOT ' WRK-ORIG-TOT-WAGE DTSBE770
|
|
03315 * ' AUDIT TOT ' WRK-AUDIT-TOT-WAGE DTSBE770
|
|
03316 * DISPLAY ' ORIG TAX ' WRK-ORIG-TAX-WAGE DTSBE770
|
|
03317 * ' AUDIT TAX ' WRK-AUDIT-TAX-WAGE DTSBE770
|
|
03318 * DISPLAY ' ORIG CHG ' WRK-ORIG-UI-CHG DTSBE770
|
|
03319 * ' AUDIT CHG ' WRK-AUDIT-UI-CHG DTSBE770
|
|
03320 * DISPLAY 'P5130 PRE AUDIT TOT WAGE ' DTSBE770
|
|
03321 * WRK-PRE-AUDIT-TOT-WAGE DTSBE770
|
|
03322 * END-IF. DTSBE770
|
|
03323 *& DTSBE770
|
|
03324 P5130-EXIT. DTSBE770
|
|
03325 EXIT. DTSBE770
|
|
03326 DTSBE770
|
|
03327 P5131-SCAN-MRPT. DTSBE770
|
|
03328 MOVE MSKL-REC TO MRPT-REC. DTSBE770
|
|
03329 DTSBE770
|
|
03330 IF MRPT-YRQ < MAUR-FIRST-YRQ DTSBE770
|
|
03331 NEXT SENTENCE DTSBE770
|
|
03332 ELSE DTSBE770
|
|
03333 IF MRPT-YRQ > MAUR-LAST-YRQ DTSBE770
|
|
03334 SET L910-NO-REC-88 TO TRUE DTSBE770
|
|
03335 GO TO P5131-EXIT DTSBE770
|
|
03336 ELSE DTSBE770
|
|
03337 IF MRPT-AUDIT-88 DTSBE770
|
|
03338 PERFORM P5131A-SUM-AUDIT-AMTS THRU P5131A-EXIT DTSBE770
|
|
03339 ELSE DTSBE770
|
|
03340 PERFORM P5131B-SUM-ORIG-AMTS THRU P5131B-EXIT DTSBE770
|
|
03341 END-IF DTSBE770
|
|
03342 END-IF DTSBE770
|
|
03343 END-IF. DTSBE770
|
|
03344 DTSBE770
|
|
03345 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
03346 DTSBE770
|
|
03347 P5131-EXIT. DTSBE770
|
|
03348 EXIT. DTSBE770
|
|
03349 DTSBE770
|
|
03350 P5131A-SUM-AUDIT-AMTS. DTSBE770
|
|
03351 ADD MRPT-TOT-WAGE TO WRK-AUDIT-TOT-WAGE. DTSBE770
|
|
03352 ADD MRPT-TAX-WAGE TO WRK-AUDIT-TAX-WAGE. DTSBE770
|
|
03353 ADD MRPT-UI-CHARGED-AMT TO WRK-AUDIT-UI-CHG. DTSBE770
|
|
03354 DTSBE770
|
|
03355 P5131A-EXIT. DTSBE770
|
|
03356 EXIT. DTSBE770
|
|
03357 DTSBE770
|
|
03358 P5131B-SUM-ORIG-AMTS. DTSBE770
|
|
03359 ADD MRPT-TOT-WAGE TO WRK-ORIG-TOT-WAGE. DTSBE770
|
|
03360 ADD MRPT-TAX-WAGE TO WRK-ORIG-TAX-WAGE. DTSBE770
|
|
03361 ADD MRPT-UI-CHARGED-AMT TO WRK-ORIG-UI-CHG. DTSBE770
|
|
03362 DTSBE770
|
|
03363 P5131B-EXIT. DTSBE770
|
|
03364 EXIT. DTSBE770
|
|
03365 DTSBE770
|
|
03366 P5200-WRITE-Y775. DTSBE770
|
|
03367 MOVE LENGTH OF Y775-REC TO Y775-LENGTH. DTSBE770
|
|
03368 SET Y775-REC-TYPE-775-88 TO TRUE. DTSBE770
|
|
03369 DTSBE770
|
|
03370 MOVE MPRF-EMP-NO TO Y775-EMP-NO. DTSBE770
|
|
03371 MOVE MFAS-ASSIGN-NO TO Y775-AUDIT-ID. DTSBE770
|
|
03372 DTSBE770
|
|
03373 MOVE MAUR-EMP-SIZE-IND TO Y775-EMP-SIZE-IND. DTSBE770
|
|
03374 MOVE WRK-CHANGE-AUDIT-IND TO Y775-CHANGE-AUDIT-IND. DTSBE770
|
|
03375 MOVE MFAS-PROCESSED-DATE TO Y775-AUDIT-CMPL-DATE. DTSBE770
|
|
03376 DTSBE770
|
|
03377 MOVE WRK-POST-AUDIT-TOT-WAGE TO Y775-POST-AUDIT-TOT-WAGE. DTSBE770
|
|
03378 MOVE WRK-PRE-AUDIT-TOT-WAGE TO Y775-PRE-AUDIT-TOT-WAGE. DTSBE770
|
|
03379 DTSBE770
|
|
03380 MOVE WRK-UNDER-RPT-TOT-WAGE TO Y775-UNDER-RPT-TOT-WAGE. DTSBE770
|
|
03381 MOVE WRK-OVER-RPT-TOT-WAGE TO Y775-OVER-RPT-TOT-WAGE. DTSBE770
|
|
03382 MOVE WRK-UNDER-RPT-TAX-WAGE TO Y775-UNDER-RPT-TAX-WAGE. DTSBE770
|
|
03383 MOVE WRK-UNDER-RPT-CONTRIB TO Y775-UNDER-RPT-CONTRIB. DTSBE770
|
|
03384 MOVE WRK-OVER-RPT-TAX-WAGE TO Y775-OVER-RPT-TAX-WAGE. DTSBE770
|
|
03385 MOVE WRK-OVER-RPT-CONTRIB TO Y775-OVER-RPT-CONTRIB. DTSBE770
|
|
03386 MOVE WRK-PRE-AUDIT-TAX-WAGE TO Y775-PRE-AUDIT-TAX-WAGE DTSBE770
|
|
03387 MOVE WRK-POST-AUDIT-TAX-WAGE TO Y775-POST-AUDIT-TAX-WAGE DTSBE770
|
|
03388 MOVE WRK-PRE-AUDIT-CONTRIB TO Y775-PRE-AUDIT-CONTRIB DTSBE770
|
|
03389 MOVE WRK-POST-AUDIT-CONTRIB TO Y775-POST-AUDIT-CONTRIB. DTSBE770
|
|
03390 DTSBE770
|
|
03391 MOVE MAUR-QTRS-AUDITED-CNT TO Y775-QTR-CNT. DTSBE770
|
|
03392 MOVE MAUR-AUDIT-HRS TO Y775-HOURS. DTSBE770
|
|
03393 MOVE MAUR-INDCON-TO-EMPL-CNT TO Y775-IND-CON-CNT. DTSBE770
|
|
03394 MOVE MAUR-NEW-EMPLOYEE-CNT TO Y775-NEW-EMPLOYEE-CNT. CL*31
|
|
03395 DTSBE770
|
|
03396 PERFORM S775-WRITE-R775 THRU S775-EXIT. DTSBE770
|
|
03397 ADD +1 TO WRK-Y775-CNT. DTSBE770
|
|
03398 DTSBE770
|
|
03399 P5200-EXIT. DTSBE770
|
|
03400 EXIT. DTSBE770
|
|
03401 DTSBE770
|
|
03402 P9000-OUTSTANDING-QTRS. DTSBE770
|
|
03403 MOVE ZERO TO WRK-UI-CHG. DTSBE770
|
|
03404 DTSBE770
|
|
03405 IF MPRF-CLASS-SELF-INS-88 DTSBE770
|
|
03406 GO TO P9000-EXIT. DTSBE770
|
|
03407 DTSBE770
|
|
03408 IF MPRF-PURSUED-RPT-CNT > +0 DTSBE770
|
|
03409 NEXT SENTENCE DTSBE770
|
|
03410 ELSE DTSBE770
|
|
03411 GO TO P9000-EXIT. DTSBE770
|
|
03412 DTSBE770
|
|
03413 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE770
|
|
03414 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE770
|
|
03415 SET MQTR-QTR-88 TO TRUE. DTSBE770
|
|
03416 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03417 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03418 PERFORM P9010-SCAN-MQTR THRU P9010-EXIT DTSBE770
|
|
03419 UNTIL L910-NO-REC-88. DTSBE770
|
|
03420 DTSBE770
|
|
03421 P9000-EXIT. DTSBE770
|
|
03422 EXIT. DTSBE770
|
|
03423 DTSBE770
|
|
03424 P9010-SCAN-MQTR. DTSBE770
|
|
03425 MOVE MSKL-REC TO MQTR-REC. DTSBE770
|
|
03426 DTSBE770
|
|
03427 IF MQTR-CURR-RCVD-88 DTSBE770
|
|
03428 IF MQTR-TAX-WAGE > ZERO DTSBE770
|
|
03429 AND MQTR-UI-RATE > ZERO DTSBE770
|
|
03430 COMPUTE WRK-UI-CHG = (MQTR-TAX-WAGE * MQTR-UI-RATE) DTSBE770
|
|
03431 END-IF DTSBE770
|
|
03432 ELSE DTSBE770
|
|
03433 IF MQTR-RPT-IS-PURSUED-88 DTSBE770
|
|
03434 IF MQTR-CURR-ESTIM-88 DTSBE770
|
|
03435 IF MQTR-YRQ = WRK-QTR1 DTSBE770
|
|
03436 ADD +1 TO WRK-OUTSTANDING-QTR-CNT DTSBE770
|
|
03437 END-IF DTSBE770
|
|
03438 ELSE DTSBE770
|
|
03439 ADD +1 TO WRK-OUTSTANDING-QTR-CNT DTSBE770
|
|
03440 ADD +1 TO WRK-ITEM13-CNT DTSBE770
|
|
03441 ADD WRK-UI-CHG TO WRK-OUTSTANDING-BAL DTSBE770
|
|
03442 END-IF DTSBE770
|
|
03443 END-IF DTSBE770
|
|
03444 END-IF. DTSBE770
|
|
03445 DTSBE770
|
|
03446 ** IF MQTR-CURR-RCVD-88 DTSBE770
|
|
03447 * IF MQTR-TAX-WAGE > ZERO DTSBE770
|
|
03448 * AND MQTR-UI-RATE > ZERO DTSBE770
|
|
03449 * COMPUTE WRK-UI-CHG = (MQTR-TAX-WAGE * MQTR-UI-RATE) DTSBE770
|
|
03450 * END-IF DTSBE770
|
|
03451 * ELSE DTSBE770
|
|
03452 * IF MQTR-RPT-IS-PURSUED-88 DTSBE770
|
|
03453 * ADD +1 TO WRK-OUTSTANDING-QTR-CNT DTSBE770
|
|
03454 * IF MQTR-CURR-ESTIM-88 DTSBE770
|
|
03455 * NEXT SENTENCE DTSBE770
|
|
03456 * ELSE DTSBE770
|
|
03457 * ADD +1 TO WRK-ITEM13-CNT DTSBE770
|
|
03458 ** ADD WRK-UI-CHG TO WRK-OUTSTANDING-BAL. DTSBE770
|
|
03459 DTSBE770
|
|
03460 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE770
|
|
03461 DTSBE770
|
|
03462 P9010-EXIT. DTSBE770
|
|
03463 EXIT. DTSBE770
|
|
03464 DTSBE770
|
|
03465 P9100-SUTA-DUMPING. DTSBE770
|
|
03466 MOVE +0 TO WRK-EFF-DATE DTSBE770
|
|
03467 WRK-SUTA-PRED-EMP. DTSBE770
|
|
03468 SET RATE-CHNG-DATE-NULL-88 TO TRUE. DTSBE770
|
|
03469 SET WRK-RATE-FOUND-NO-88 TO TRUE. DTSBE770
|
|
03470 DTSBE770
|
|
03471 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBE770
|
|
03472 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSBE770
|
|
03473 SET MREL-REL-88 TO TRUE. DTSBE770
|
|
03474 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03475 DTSBE770
|
|
03476 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03477 PERFORM UNTIL L910-NO-REC-88 OR DTSBE770
|
|
03478 WRK-RATE-FOUND-YES-88 DTSBE770
|
|
03479 MOVE MSKL-REC TO MREL-REC DTSBE770
|
|
03480 IF (MREL-ESTB-DATE >= WRK-SUBJECT-QTR-START DTSBE770
|
|
03481 AND MREL-ESTB-DATE <= WRK-SUBJECT-QTR-END) DTSBE770
|
|
03482 OR (MREL-CHNG-DATE >= WRK-SUBJECT-QTR-START DTSBE770
|
|
03483 AND MREL-CHNG-DATE <= WRK-SUBJECT-QTR-END) DTSBE770
|
|
03484 IF (MREL-XFER-MANDATORY-88 DTSBE770
|
|
03485 OR MREL-XFER-PROHIBITED-88) DTSBE770
|
|
03486 MOVE MREL-EMP-NO TO WRK-SUTA-SUCC-EMP DTSBE770
|
|
03487 MOVE MREL-PRED-EMP-NO TO WRK-SUTA-PRED-EMP DTSBE770
|
|
03488 MOVE MREL-EFF-DATE TO WRK-EFF-DATE DTSBE770
|
|
03489 DISPLAY MREL-EMP-NO ' MREL-EMP-NO' DTSBE770
|
|
03490 DISPLAY MREL-PRED-EMP-NO ' MREL-PRED-EMP-NO' DTSBE770
|
|
03491 DISPLAY MREL-EFF-DATE ' MREL-EFF-DATE' DTSBE770
|
|
03492 PERFORM P9110-FIND-MRTE THRU P9110-EXIT DTSBE770
|
|
03493 IF NOT RATE-CHNG-DATE-NULL-88 DTSBE770
|
|
03494 PERFORM P9120-FIND-AMT THRU P9120-EXIT DTSBE770
|
|
03495 END-IF DTSBE770
|
|
03496 END-IF DTSBE770
|
|
03497 END-IF DTSBE770
|
|
03498 MOVE MREL-REC TO MSKL-REC DTSBE770
|
|
03499 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
03500 END-PERFORM. DTSBE770
|
|
03501 DTSBE770
|
|
03502 DTSBE770
|
|
03503 P9100-EXIT. DTSBE770
|
|
03504 EXIT. DTSBE770
|
|
03505 DTSBE770
|
|
03506 P9110-FIND-MRTE. DTSBE770
|
|
03507 IF MREL-XFER-MANDATORY-88 DTSBE770
|
|
03508 ADD +1 TO WRK-MANDATORY-CNT DTSBE770
|
|
03509 ELSE DTSBE770
|
|
03510 ADD +1 TO WRK-PROHIBITED-CNT DTSBE770
|
|
03511 END-IF. DTSBE770
|
|
03512 DTSBE770
|
|
03513 *** PERFORM P9111-CHK-PREDECESSOR THRU P9111-EXIT DTSBE770
|
|
03514 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBE770
|
|
03515 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBE770
|
|
03516 SET MRTE-RTE-88 TO TRUE. DTSBE770
|
|
03517 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03518 DTSBE770
|
|
03519 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03520 DTSBE770
|
|
03521 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
03522 MOVE MSKL-REC TO MRTE-REC DTSBE770
|
|
03523 IF MRTE-MREL-PRED-NO NOT NUMERIC DTSBE770
|
|
03524 MOVE +0 TO MRTE-MREL-PRED-NO DTSBE770
|
|
03525 END-IF DTSBE770
|
|
03526 IF MRTE-MREL-EFF-DATE NOT NUMERIC DTSBE770
|
|
03527 MOVE +0 TO MRTE-MREL-EFF-DATE DTSBE770
|
|
03528 END-IF DTSBE770
|
|
03529 DISPLAY MRTE-MREL-PRED-NO 'MRTE-MREL-PRED-NO' DTSBE770
|
|
03530 DISPLAY MRTE-MREL-EFF-DATE 'MRTE-MREL-EFF-DATE' DTSBE770
|
|
03531 DISPLAY MRTE-CHNG-DATE 'MRTE-CHNG-DATE' DTSBE770
|
|
03532 IF MRTE-MREL-PRED-NO = WRK-SUTA-PRED-EMP DTSBE770
|
|
03533 AND MRTE-MREL-EFF-DATE = WRK-EFF-DATE DTSBE770
|
|
03534 SET WRK-RATE-FOUND-YES-88 TO TRUE DTSBE770
|
|
03535 IF MRTE-CHNG-DATE < WRK-RATE-CHNG-DATE DTSBE770
|
|
03536 MOVE MRTE-CHNG-DATE TO WRK-RATE-CHNG-DATE DTSBE770
|
|
03537 END-IF DTSBE770
|
|
03538 END-IF DTSBE770
|
|
03539 MOVE MRTE-REC TO MSKL-REC DTSBE770
|
|
03540 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
03541 IF L910-NO-REC-88 AND MPRF-EMP-NO = 156023 DTSBE770
|
|
03542 MOVE 20140331 TO WRK-RATE-CHNG-DATE DTSBE770
|
|
03543 SET WRK-RATE-FOUND-YES-88 TO TRUE DTSBE770
|
|
03544 END-IF DTSBE770
|
|
03545 IF L910-NO-REC-88 AND MPRF-EMP-NO = 202263 DTSBE770
|
|
03546 MOVE 20140130 TO WRK-RATE-CHNG-DATE DTSBE770
|
|
03547 SET WRK-RATE-FOUND-YES-88 TO TRUE DTSBE770
|
|
03548 END-IF DTSBE770
|
|
03549 END-PERFORM. DTSBE770
|
|
03550 DTSBE770
|
|
03551 P9110-EXIT. DTSBE770
|
|
03552 EXIT. DTSBE770
|
|
03553 DTSBE770
|
|
03554 *P9111-CHK-PREDECESSOR. DTSBE770
|
|
03555 *P9111-EXIT. DTSBE770
|
|
03556 * EXIT. DTSBE770
|
|
03557 DTSBE770
|
|
03558 *P9112-CHK-SUCCESSOR. DTSBE770
|
|
03559 *P9112-EXIT. DTSBE770
|
|
03560 * EXIT. DTSBE770
|
|
03561 DTSBE770
|
|
03562 P9120-FIND-AMT. DTSBE770
|
|
03563 MOVE +0 TO WRK-SUTA-DMP-AMT. DTSBE770
|
|
03564 IF MPRF-EMP-NO = 156023 DTSBE770
|
|
03565 MOVE 20140331 TO L005-DATE DTSBE770
|
|
03566 ELSE DTSBE770
|
|
03567 MOVE WRK-RATE-CHNG-DATE TO L005-DATE. DTSBE770
|
|
03568 DTSBE770
|
|
03569 MOVE +0 TO L005-TIME. DTSBE770
|
|
03570 PERFORM S005-FROM-DATE-TIME THRU S005-EXIT. DTSBE770
|
|
03571 DTSBE770
|
|
03572 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE770
|
|
03573 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE770
|
|
03574 SET MJRN-JRN-88 TO TRUE. DTSBE770
|
|
03575 MOVE L005-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBE770
|
|
03576 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE770
|
|
03577 DTSBE770
|
|
03578 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE770
|
|
03579 DTSBE770
|
|
03580 PERFORM UNTIL L910-NO-REC-88 DTSBE770
|
|
03581 MOVE MSKL-REC TO MJRN-REC DTSBE770
|
|
03582 IF MJRN-ESTB-DATE <= WRK-SUBJECT-QTR-END DTSBE770
|
|
03583 *** IF MJRN-ESTB-DATE = WRK-RATE-CHNG-DATE DTSBE770
|
|
03584 AND MJRN-ADMN-CORR-RPT-88 DTSBE770
|
|
03585 DISPLAY MJRN-ESTB-DATE ' MJRN-ESTB-DATE' DTSBE770
|
|
03586 PERFORM P9121-UI-CHG THRU P9121-EXIT DTSBE770
|
|
03587 END-IF DTSBE770
|
|
03588 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE770
|
|
03589 END-PERFORM. DTSBE770
|
|
03590 DTSBE770
|
|
03591 P9120-EXIT. DTSBE770
|
|
03592 EXIT. DTSBE770
|
|
03593 DTSBE770
|
|
03594 P9121-UI-CHG. DTSBE770
|
|
03595 PERFORM DTSBE770
|
|
03596 VARYING SUB FROM +1 BY +1 DTSBE770
|
|
03597 UNTIL SUB > MJRN-OCC-CNT DTSBE770
|
|
03598 IF MJRN-ROW-UI-88 (SUB) DTSBE770
|
|
03599 AND MJRN-COL-CHARGED-88 (SUB) DTSBE770
|
|
03600 ADD MJRN-AMT (SUB) TO WRK-SUTA-DMP-AMT DTSBE770
|
|
03601 WRK-SUTA-DMP-TOT DTSBE770
|
|
03602 END-IF DTSBE770
|
|
03603 END-PERFORM. DTSBE770
|
|
03604 DTSBE770
|
|
03605 MOVE WRK-SUTA-DMP-AMT TO AMT-DISP1. DTSBE770
|
|
03606 DISPLAY 'P9121 ' MPRF-EMP-NO ' ' AMT-DISP1 DTSBE770
|
|
03607 ' ' WRK-RATE-CHNG-DATE. DTSBE770
|
|
03608 P9121-EXIT. DTSBE770
|
|
03609 EXIT. DTSBE770
|
|
03610 DTSBE770
|
|
03611 T0000-TERMINATE. DTSBE770
|
|
03612 PERFORM T1000-WAGE-ITEM-CNT THRU T1000-EXIT. DTSBE770
|
|
03613 PERFORM T2000-WRITE-Y779-REC THRU T2000-EXIT. DTSBE770
|
|
03614 DTSBE770
|
|
03615 DISPLAY '*********************************************'. DTSBE770
|
|
03616 DISPLAY '** DTSBE770 TERMINATION STATISTICS **'. DTSBE770
|
|
03617 DISPLAY '** **'. DTSBE770
|
|
03618 DISPLAY ' ZERO WAGE ' WRK-0-WAGE-CNT. DTSBE770
|
|
03619 DISPLAY ' NOT LIABLE ' WRK-NOT-LIAB-CNT. DTSBE770
|
|
03620 DISPLAY ' DELINQUENT ' WRK-DELINQ-CNT. DTSBE770
|
|
03621 DISPLAY ' ACT CNT ' WRK-ACT-CNT. DTSBE770
|
|
03622 DISPLAY ' RPT RCVD ' WRK-TOT-RPT-RCVD-CNT. DTSBE770
|
|
03623 DISPLAY SPACE. DTSBE770
|
|
03624 DTSBE770
|
|
03625 DISPLAY 'MANDATORY CNT ' WRK-MANDATORY-CNT. DTSBE770
|
|
03626 DISPLAY 'PROHIBITED CNT ' WRK-PROHIBITED-CNT. DTSBE770
|
|
03627 MOVE WRK-SUTA-DMP-TOT TO AMT-DISP1. DTSBE770
|
|
03628 DISPLAY 'SUTA CONTRIB ' AMT-DISP1. DTSBE770
|
|
03629 DTSBE770
|
|
03630 MOVE WRK-Y771-CNT TO DISPLAY-CNT. DTSBE770
|
|
03631 DISPLAY '** Y771 COUNT ' DISPLAY-CNT DTSBE770
|
|
03632 ' **'. DTSBE770
|
|
03633 MOVE WRK-Y772-CNT TO DISPLAY-CNT. DTSBE770
|
|
03634 DISPLAY '** Y772 COUNT ' DISPLAY-CNT DTSBE770
|
|
03635 ' **'. DTSBE770
|
|
03636 MOVE WRK-Y773-CNT TO DISPLAY-CNT. DTSBE770
|
|
03637 DISPLAY '** Y773 COUNT ' DISPLAY-CNT DTSBE770
|
|
03638 ' **'. DTSBE770
|
|
03639 DISPLAY '** TPS STATUS ' WRK-TPS-STATUS-CNT. DTSBE770
|
|
03640 MOVE WRK-Y774-CNT TO DISPLAY-CNT. DTSBE770
|
|
03641 DISPLAY '** Y774 COUNT ' DISPLAY-CNT DTSBE770
|
|
03642 ' **'. DTSBE770
|
|
03643 MOVE WRK-Y775-CNT TO DISPLAY-CNT. DTSBE770
|
|
03644 DISPLAY '** Y775 COUNT ' DISPLAY-CNT DTSBE770
|
|
03645 ' **'. DTSBE770
|
|
03646 MOVE WRK-MISSING-CNT TO DISPLAY-CNT. DTSBE770
|
|
03647 DISPLAY '** MISSING ' DISPLAY-CNT DTSBE770
|
|
03648 ' **'. DTSBE770
|
|
03649 MOVE WRK-NOT-SELECTED-CNT TO DISPLAY-CNT. DTSBE770
|
|
03650 DISPLAY '** NOT SELECTED ' DISPLAY-CNT DTSBE770
|
|
03651 ' **'. DTSBE770
|
|
03652 MOVE WRK-SELECT-581-CNT TO DISPLAY-CNT. DTSBE770
|
|
03653 DISPLAY '** 581 ONLY CNT ' DISPLAY-CNT DTSBE770
|
|
03654 ' **'. DTSBE770
|
|
03655 MOVE WRK-OUTSTANDING-QTR-CNT TO DISPLAY-CNT. DTSBE770
|
|
03656 DISPLAY '** OUTSTANDING QTR ' DISPLAY-CNT DTSBE770
|
|
03657 ' **'. DTSBE770
|
|
03658 MOVE WRK-ITEM13-CNT TO DISPLAY-CNT. DTSBE770
|
|
03659 DISPLAY '** ITEM 13 CNT ' DISPLAY-CNT DTSBE770
|
|
03660 ' **'. DTSBE770
|
|
03661 DISPLAY '** ANN RPT CNT ' WRK-ANNUAL-RPT-CNT DTSBE770
|
|
03662 ' **'. DTSBE770
|
|
03663 MOVE WRK-OUTSTANDING-BAL TO DISPLAY-AMT. DTSBE770
|
|
03664 DISPLAY '** OUTSTANDING BAL ' DISPLAY-AMT DTSBE770
|
|
03665 ' **'. DTSBE770
|
|
03666 * DISPLAY '** CORRECT LIAB DATE ' WRK-CNT1 DTSBE770
|
|
03667 * ' **'. DTSBE770
|
|
03668 * DISPLAY '** CORRECT REOPEN DATE ' WRK-CNT2 DTSBE770
|
|
03669 * ' **'. DTSBE770
|
|
03670 DISPLAY '** P2600 QTR ' WRK-P2610-QTR-CNT DTSBE770
|
|
03671 ' **'. DTSBE770
|
|
03672 DISPLAY '** ANNNUAL FILERS ' WRK-ANN-FILER-CNT DTSBE770
|
|
03673 ' **'. DTSBE770
|
|
03674 ** DISPLAY '** ANN: SCRD P2600 ' WRK-P2600-CNT DTSBE770
|
|
03675 * ' **'. DTSBE770
|
|
03676 * DISPLAY '** ANN: SCRD DFLT P26 ' WRK-P2600-DFLT-CNT DTSBE770
|
|
03677 ** ' **'. DTSBE770
|
|
03678 DISPLAY '** ANN: RESOLVED P21 ' WRK-P2100-CNT DTSBE770
|
|
03679 ' **'. DTSBE770
|
|
03680 DISPLAY '** ANN: P2100 RCVD ' WRK-P2100-RCVD-CNT DTSBE770
|
|
03681 ' **'. DTSBE770
|
|
03682 DISPLAY '** ANN: P2100 MISS ' WRK-P2100-MISS-CNT DTSBE770
|
|
03683 ' **'. DTSBE770
|
|
03684 DISPLAY '** ANN: P2120 DEFAULT ' WRK-P2100-DFLT-CNT DTSBE770
|
|
03685 * ' **'. DTSBE770
|
|
03686 DISPLAY '** QTR: RECEIVED P21 ' WRK-P2100-QTR-CNT DTSBE770
|
|
03687 ' **'. DTSBE770
|
|
03688 * DISPLAY '** ENTERED IN QTR1 ' WRK-CNT4 DTSBE770
|
|
03689 * ' **'. DTSBE770
|
|
03690 DISPLAY '** ANN: RES P2220 ' WRK-P2220-RES-CNT DTSBE770
|
|
03691 ' **'. DTSBE770
|
|
03692 DISPLAY '** ANN: SEC P2220 ' WRK-P2220-SEC-CNT DTSBE770
|
|
03693 ' **'. DTSBE770
|
|
03694 DISPLAY '** ANN: TIMELY P2220 ' WRK-P2220-TIMELY-CNT DTSBE770
|
|
03695 ' **'. DTSBE770
|
|
03696 DISPLAY '** P2510 DFLT TIMELY ' DTSBE770
|
|
03697 WRK-P2510-DFLT-TIMELY-CNT ' **'. DTSBE770
|
|
03698 * DISPLAY '** ANN: RES P2520 ' WRK-P2520-RES-CNT DTSBE770
|
|
03699 * ' **'. DTSBE770
|
|
03700 * DISPLAY '** ANN: SEC P2520 ' WRK-P2520-SEC-CNT DTSBE770
|
|
03701 * ' **'. DTSBE770
|
|
03702 * DISPLAY '** ANN: TIMELY P2520 ' WRK-P2520-TIMELY-CNT DTSBE770
|
|
03703 * ' **'. DTSBE770
|
|
03704 DISPLAY '** P2520 DFLT TIMELY ' DTSBE770
|
|
03705 WRK-P2520-DFLT-TIMELY-CNT ' **'. DTSBE770
|
|
03706 * DISPLAY '** P2500 QTR CNT ' WRK-P2500-QTR-CNT DTSBE770
|
|
03707 * ' **'. DTSBE770
|
|
03708 * DISPLAY '** P2500 ANN CNT ' WRK-P2500-ANN-CNT DTSBE770
|
|
03709 * ' **'. DTSBE770
|
|
03710 * DISPLAY '** P2500 581 QTR CNT ' WRK-P2500-581-QTR-CNT DTSBE770
|
|
03711 * ' **'. DTSBE770
|
|
03712 DISPLAY '** **'. DTSBE770
|
|
03713 DISPLAY '*********************************************'. DTSBE770
|
|
03714 DTSBE770
|
|
03715 MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9. DTSBE770
|
|
03716 DTSBE770
|
|
03717 EVALUATE TRUE DTSBE770
|
|
03718 WHEN L004-QTR-5-Q = 1 DTSBE770
|
|
03719 CLOSE TPS-STATUS-QTR1 DTSBE770
|
|
03720 DTSBE770
|
|
03721 WHEN L004-QTR-5-Q = 2 DTSBE770
|
|
03722 CLOSE TPS-STATUS-QTR2 DTSBE770
|
|
03723 DTSBE770
|
|
03724 WHEN L004-QTR-5-Q = 3 DTSBE770
|
|
03725 CLOSE TPS-STATUS-QTR3 DTSBE770
|
|
03726 DTSBE770
|
|
03727 WHEN L004-QTR-5-Q = 4 DTSBE770
|
|
03728 CLOSE TPS-STATUS-QTR4 DTSBE770
|
|
03729 DTSBE770
|
|
03730 END-EVALUATE. DTSBE770
|
|
03731 DTSBE770
|
|
03732 T0000-EXIT. DTSBE770
|
|
03733 EXIT. DTSBE770
|
|
03734 DTSBE770
|
|
03735 T1000-WAGE-ITEM-CNT. DTSBE770
|
|
03736 INITIALIZE L430-LINK-AREA. DTSBE770
|
|
03737 MOVE WRK-SUBJECT-QTR TO L430-SUBJECT-YRQ. DTSBE770
|
|
03738 DTSBE770
|
|
03739 SET L430-CMND-INITIALIZE-88 TO TRUE. DTSBE770
|
|
03740 CALL 'DTSBU431' USING L430-LINK-AREA. CL*29
|
|
03741 DTSBE770
|
|
03742 SET L430-CMND-PROCESS-88 TO TRUE. DTSBE770
|
|
03743 CALL 'DTSBU431' USING L430-LINK-AREA. CL*29
|
|
03744 MOVE L430-WAGE-ITEM-CNT TO WRK-WAGE-ITEM-CNT. DTSBE770
|
|
03745 DTSBE770
|
|
03746 SET L430-CMND-TERMINATE-88 TO TRUE. DTSBE770
|
|
03747 CALL 'DTSBU431' USING L430-LINK-AREA. CL*29
|
|
03748 DTSBE770
|
|
03749 T1000-EXIT. DTSBE770
|
|
03750 EXIT. DTSBE770
|
|
03751 DTSBE770
|
|
03752 T2000-WRITE-Y779-REC. DTSBE770
|
|
03753 MOVE LENGTH OF Y779-REC TO Y779-LENGTH. DTSBE770
|
|
03754 SET Y779-REC-TYPE-779-88 TO TRUE. DTSBE770
|
|
03755 DTSBE770
|
|
03756 MOVE WRK-OUTSTANDING-QTR-CNT TO Y779-OUTSTANDING-QTR-CNT. DTSBE770
|
|
03757 MOVE WRK-OUTSTANDING-BAL TO Y779-OUTSTANDING-BAL. DTSBE770
|
|
03758 MOVE WRK-WAGE-ITEM-CNT TO Y779-WAGE-ITEM-CNT. DTSBE770
|
|
03759 MOVE WRK-SUTA-DMP-TOT TO Y779-SUTA-CONTRIB-DUE. DTSBE770
|
|
03760 MOVE WRK-MANDATORY-CNT TO Y779-MANDATORY-XFER-CNT. DTSBE770
|
|
03761 MOVE WRK-PROHIBITED-CNT TO Y779-PROHIBITED-XFER-CNT. DTSBE770
|
|
03762 DTSBE770
|
|
03763 PERFORM S779-WRITE-R779 THRU S779-EXIT. DTSBE770
|
|
03764 DTSBE770
|
|
03765 T2000-EXIT. DTSBE770
|
|
03766 EXIT. DTSBE770
|
|
03767 DTSBE770
|
|
03768 S001-FROM-FED-8. DTSBE770
|
|
03769 SET L001-FROM-FED-8 TO TRUE. DTSBE770
|
|
03770 GO TO S001-DATE. DTSBE770
|
|
03771 DTSBE770
|
|
03772 S001-FROM-ABS-DAY. DTSBE770
|
|
03773 SET L001-FROM-ABS-DAY TO TRUE. DTSBE770
|
|
03774 GO TO S001-DATE. DTSBE770
|
|
03775 DTSBE770
|
|
03776 S001-FROM-CAL-6. DTSBE770
|
|
03777 SET L001-FROM-CAL-6 TO TRUE. DTSBE770
|
|
03778 GO TO S001-DATE. DTSBE770
|
|
03779 DTSBE770
|
|
03780 S001-DATE. DTSBE770
|
|
03781 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE770
|
|
03782 S001-EXIT. DTSBE770
|
|
03783 EXIT. DTSBE770
|
|
03784 SKIP3 DTSBE770
|
|
03785 S004-FROM-5. DTSBE770
|
|
03786 SET L004-FROM-5 TO TRUE. DTSBE770
|
|
03787 GO TO S004-QTR. DTSBE770
|
|
03788 DTSBE770
|
|
03789 S004-FROM-ABS. DTSBE770
|
|
03790 SET L004-FROM-ABS TO TRUE. DTSBE770
|
|
03791 GO TO S004-QTR. DTSBE770
|
|
03792 DTSBE770
|
|
03793 S004-FROM-3. DTSBE770
|
|
03794 SET L004-FROM-3 TO TRUE. DTSBE770
|
|
03795 GO TO S004-QTR. DTSBE770
|
|
03796 DTSBE770
|
|
03797 S004-FROM-DATE. DTSBE770
|
|
03798 SET L004-FROM-DATE TO TRUE. DTSBE770
|
|
03799 GO TO S004-QTR. DTSBE770
|
|
03800 DTSBE770
|
|
03801 S004-QTR. DTSBE770
|
|
03802 DTSBE770
|
|
03803 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE770
|
|
03804 DTSBE770
|
|
03805 S004-EXIT. DTSBE770
|
|
03806 EXIT. DTSBE770
|
|
03807 SKIP3 DTSBE770
|
|
03808 S005-FROM-DATE-TIME. DTSBE770
|
|
03809 SET L005-FROM-DATE-TIME TO TRUE DTSBE770
|
|
03810 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE770
|
|
03811 DTSBE770
|
|
03812 S005-EXIT. DTSBE770
|
|
03813 EXIT. DTSBE770
|
|
03814 DTSBE770
|
|
03815 S410-FILE-SCHED. DTSBE770
|
|
03816 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE770
|
|
03817 S410-EXIT. DTSBE770
|
|
03818 EXIT. DTSBE770
|
|
03819 DTSBE770
|
|
03820 S415-HOUSEHOLD-DATES. DTSBE770
|
|
03821 CALL 'DTSBU415' USING L415-LINK-AREA. DTSBE770
|
|
03822 S415-EXIT. DTSBE770
|
|
03823 EXIT. DTSBE770
|
|
03824 DTSBE770
|
|
03825 S910-READ. DTSBE770
|
|
03826 SET L910-READ-88 TO TRUE. DTSBE770
|
|
03827 GO TO S910-MSTR-IO. DTSBE770
|
|
03828 DTSBE770
|
|
03829 S910-START-BROWSE. DTSBE770
|
|
03830 SET L910-START-BROWSE-88 TO TRUE. DTSBE770
|
|
03831 GO TO S910-MSTR-IO. DTSBE770
|
|
03832 DTSBE770
|
|
03833 S910-READ-NEXT. DTSBE770
|
|
03834 SET L910-READ-NEXT-88 TO TRUE. DTSBE770
|
|
03835 GO TO S910-MSTR-IO. DTSBE770
|
|
03836 DTSBE770
|
|
03837 *S910-COUNT. DTSBE770
|
|
03838 *****SET L910-COUNT-88 TO TRUE. DTSBE770
|
|
03839 *****GO TO S910-MSTR-IO. DTSBE770
|
|
03840 DTSBE770
|
|
03841 S910-REWRITE. DTSBE770
|
|
03842 SET L910-REWRITE-88 TO TRUE. DTSBE770
|
|
03843 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE770
|
|
03844 GO TO S910-MSTR-IO. DTSBE770
|
|
03845 DTSBE770
|
|
03846 S910-MSTR-IO. DTSBE770
|
|
03847 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE770
|
|
03848 MSKL-REC. DTSBE770
|
|
03849 S910-EXIT. DTSBE770
|
|
03850 EXIT. DTSBE770
|
|
03851 SKIP3 DTSBE770
|
|
03852 DTSBE770
|
|
03853 S931-READ. DTSBE770
|
|
03854 SET L931-READ-88 TO TRUE. DTSBE770
|
|
03855 GO TO S931-REF-IO. DTSBE770
|
|
03856 DTSBE770
|
|
03857 S931-REF-IO. DTSBE770
|
|
03858 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE770
|
|
03859 FSKL-REC. DTSBE770
|
|
03860 S931-EXIT. DTSBE770
|
|
03861 EXIT. DTSBE770
|
|
03862 DTSBE770
|
|
03863 S771-WRITE-R771. DTSBE770
|
|
03864 MOVE Y771-REC TO RSKL-REC. DTSBE770
|
|
03865 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBE770
|
|
03866 DTSBE770
|
|
03867 S771-EXIT. DTSBE770
|
|
03868 EXIT. DTSBE770
|
|
03869 DTSBE770
|
|
03870 S772-WRITE-R772. DTSBE770
|
|
03871 MOVE Y772-REC TO RSKL-REC. DTSBE770
|
|
03872 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBE770
|
|
03873 DTSBE770
|
|
03874 S772-EXIT. DTSBE770
|
|
03875 EXIT. DTSBE770
|
|
03876 DTSBE770
|
|
03877 S773-WRITE-R773. DTSBE770
|
|
03878 MOVE Y773-REC TO RSKL-REC. DTSBE770
|
|
03879 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBE770
|
|
03880 DTSBE770
|
|
03881 S773-EXIT. DTSBE770
|
|
03882 EXIT. DTSBE770
|
|
03883 DTSBE770
|
|
03884 S774-WRITE-R774. DTSBE770
|
|
03885 MOVE Y774-REC TO RSKL-REC. DTSBE770
|
|
03886 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBE770
|
|
03887 DTSBE770
|
|
03888 S774-EXIT. DTSBE770
|
|
03889 EXIT. DTSBE770
|
|
03890 DTSBE770
|
|
03891 S775-WRITE-R775. DTSBE770
|
|
03892 MOVE Y775-REC TO RSKL-REC. DTSBE770
|
|
03893 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBE770
|
|
03894 DTSBE770
|
|
03895 S775-EXIT. DTSBE770
|
|
03896 EXIT. DTSBE770
|
|
03897 DTSBE770
|
|
03898 S779-WRITE-R779. DTSBE770
|
|
03899 MOVE Y779-REC TO RSKL-REC. DTSBE770
|
|
03900 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBE770
|
|
03901 DTSBE770
|
|
03902 S779-EXIT. DTSBE770
|
|
03903 EXIT. DTSBE770
|
|
03904 DTSBE770
|
|
03905 S927A-OPEN-UPDATE. DTSBE770
|
|
03906 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBE770
|
|
03907 PERFORM S927X-BTC-IO THRU S927X-EXIT. DTSBE770
|
|
03908 DTSBE770
|
|
03909 S927A-EXIT. DTSBE770
|
|
03910 EXIT. DTSBE770
|
|
03911 DTSBE770
|
|
03912 S927B-WRITE. DTSBE770
|
|
03913 SET L927-WRITE-88 TO TRUE. DTSBE770
|
|
03914 PERFORM S927X-BTC-IO THRU S927X-EXIT. DTSBE770
|
|
03915 DTSBE770
|
|
03916 S927B-EXIT. DTSBE770
|
|
03917 EXIT. DTSBE770
|
|
03918 DTSBE770
|
|
03919 S927C-CLOSE. DTSBE770
|
|
03920 SET L927-CLOSE-88 TO TRUE. DTSBE770
|
|
03921 PERFORM S927X-BTC-IO THRU S927X-EXIT. DTSBE770
|
|
03922 DTSBE770
|
|
03923 S927C-EXIT. DTSBE770
|
|
03924 EXIT. DTSBE770
|
|
03925 DTSBE770
|
|
03926 S927X-BTC-IO. DTSBE770
|
|
03927 CALL 'DTSBU927' USING L927-LINK-AREA DTSBE770
|
|
03928 RSKL-REC. DTSBE770
|
|
03929 DTSBE770
|
|
03930 S927X-EXIT. DTSBE770
|
|
03931 EXIT. DTSBE770
|
|
03932 SKIP3 DTSBE770
|
|
03933 S999-ABEND. DTSBE770
|
|
03934 DISPLAY '*** DTSBE770 ABENDING. ' DTSBE770
|
|
03935 ABEND-MSG. DTSBE770
|
|
03936 DTSBE770
|
|
03937 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE770
|
|
03938 S999-EXIT. DTSBE770
|
|
03939 EXIT. DTSBE770
|