1733 lines
137 KiB
COBOL
1733 lines
137 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/03/21
|
|
00002 PROGRAM-ID. DTSBE321. DTSBE321
|
|
00003 AUTHOR. TRW. LV062
|
|
00004 DATE-WRITTEN. SEPTEMBER 2002. DTSBE321
|
|
00005 DATE-COMPILED. DTSBE321
|
|
00006 SKIP3 DTSBE321
|
|
00007 ****** DTSBE321
|
|
00008 * *** ANNUAL FILER PENALTY PROCESS *** DTSBE321
|
|
00009 * DTSBE321
|
|
00010 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321
|
|
00011 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321
|
|
00012 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321
|
|
00013 * DTSBE321
|
|
00014 * THE PENALTY ASSESSMENT PROCESS IS DESIGNED TO BE RUN DTSBE321
|
|
00015 * IMMEDIATELY PRIOR TO A DAILY UPDATE RUN. DTSBE321
|
|
00016 * DTSBE321
|
|
00017 * IF THE PENALTY ASSESSMENT PROCESS IS RUN IMMEDIATELY DTSBE321
|
|
00018 * AFTER A DAILY UPDATE RUN, NOTHING TOO TERRIBLE WILL DTSBE321
|
|
00019 * OCCUR. THE BTC RECORDS GENERATED BY DTSBE321 WILL NOT DTSBE321
|
|
00020 * BE CONVERTED TO TAX ACCOUNTING ADJUSTMENT TRANSACTIONS DTSBE321
|
|
00021 * AND THE TAX ACCOUNTING ADJUSTMENT TRANSACTIONS POSTED DTSBE321
|
|
00022 * TO THE EMPLOYER ACCOUNTS UNTIL THE FOLLOWING WORK DAY. DTSBE321
|
|
00023 * THUS, DURING THE NEXT WORK DAY, STAFF USING CICS TO DTSBE321
|
|
00024 * DISPLAY EMPLOYER ACCOUNT INFORMATION WILL NOT SEE THE DTSBE321
|
|
00025 * PENALTY CHARGED AMOUNTS ASSESSED BY DTSBE321. DTSBE321
|
|
00026 * DTSBE321
|
|
00027 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321
|
|
00028 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321
|
|
00029 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321
|
|
00030 * DTSBE321
|
|
00031 * DTSBE321
|
|
00032 * FUNCTION: ANNUAL PENALTY ASSESSMENT. DTSBE321
|
|
00033 * DTSBE321
|
|
00034 * DTSBE321
|
|
00035 * MODIFICATION LOG: DTSBE321
|
|
00036 * DTSBE321
|
|
00037 * 05/15/2002 INITIAL DEVELOPMENT. COPIED FROM DTSBE320. DTSBE321
|
|
00038 * REFERENCE: HOUSEHOLD PROGRAMM: ZL1 DTSBE321
|
|
00039 * DTSBE321
|
|
00040 * 05/06/2004 UPDATED FOR NEW VERSION OF DTSIL102 DTSBE321
|
|
00041 * REFERENCE: PROGRAMM: GD DTSBE321
|
|
00042 * DTSBE321
|
|
00043 * 06/08/2005 UPDATED FOR NEW PENALTY PROCESS. DTSBE321
|
|
00044 * REFERENCE: DIR 107 PROGRAMM: GD DTSBE321
|
|
00045 * DTSBE321
|
|
00046 * 09/10/2007 UPDATED P2000 TO PASS LECM-CURR-RUN-DATE TO DTSBE321
|
|
00047 * 09/10/2007 NEW FIELD L102-CURR-RUN-DATE DTSBE321
|
|
00048 * REFERENCE: PROGRAMM: ZL1 DTSBE321
|
|
00049 * DTSBE321
|
|
00050 * 03/10/2013 UPDATED TO INCLUDE TIMELY PAYMENTS FOR DTSBE321
|
|
00051 * CALCULATIONS INSTEAD OF BALANCE DUE AMT DTSBE321
|
|
00052 * REFERENCE: PROGRAMM: ZL1 DTSBE321
|
|
00053 * DTSBE321
|
|
00054 * DTSBE321
|
|
00055 * 03/15/2014 UPDATED TO INCLUDE PRINTING LATE PENALTY DTSBE321
|
|
00056 * NOTICES AND MISSING REPORTS NOTICES ALSO DTSBE321
|
|
00057 * ADD EVENT LOG RECORD FOR EACH OCCURANCE DTSBE321
|
|
00058 * AND READ TRANSACTION FILE FOR ANY REPORT DTSBE321
|
|
00059 * WAITING TO BE PROCESSED. DTSBE321
|
|
00060 * REFERENCE: PROGRAMM: ZL1 DTSBE321
|
|
00061 * DTSBE321
|
|
00062 * 06/19/2014 THIS PROGRAM RUNS BEFORE THE DAILY UPDATES TO CL**2
|
|
00063 * CREATE TRANSACTIONS FOR PENALTY AND MISSING CL**2
|
|
00064 * REPORTS. ANY ICESA SUBMITTIONS PROCESSED DURING CL**2
|
|
00065 * THE DAY WERE BEING MISSED AS THE TRANSACTION WERE CL**2
|
|
00066 * NOT YET PROCESSED BY THE DAILY UPDATE THERFORE CL**2
|
|
00067 * THIS PROGRAM COUNTED AS MISSING AND GENERATED A CL**2
|
|
00068 * MISSING REPORT NOTICE ALONG WITH A PENALTY. TO CL**2
|
|
00069 * RESOLVE THIS ISSUE MODIFIED PROGRAM TO READ THE CL**2
|
|
00070 * REPORT FILE BX212 CREATED BY THE ICESA UPLOAD CL**2
|
|
00071 * TO BYPASS ANY EMPLOYER FOUND ON THE ICESA FILE CL**2
|
|
00072 * AND NOT GENERATE ANY MISSING REPORT NOTICE. CL**2
|
|
00073 * REFERENCE: PROGRAMMER: ZL1 CL**2
|
|
00074 * CL**3
|
|
00075 * 04/15/2015 MODIFIED PROGRAM TO CHECKFOR LIABILE QUARTERS CL**3
|
|
00076 * ONLY. IF ALL LIABLE QUARTERS ARE FILED FOR CL**3
|
|
00077 * ANNUAL FILERS A COMPLETE REPORT IS MARKED. CL**3
|
|
00078 * CHANGED YEAR IN PROGRAM FOR EACH RUN. CL*28
|
|
00079 * REFERENCE: PROGRAMM: ZL1 CL**3
|
|
00080 * CL**3
|
|
00081 * 05/05/2020 MODIFIED PROGRAM TO CHECK SOL RECORDS FOR THE CL*61
|
|
00082 * FIRST LIAB QUARTER. IF THE FIRST LIAB QUARTER CL*61
|
|
00083 * IS GREATER THAN THE CURRENT QTR DO NOT INCLUDE CL*61
|
|
00084 * IN THIS RUN. CL*61
|
|
00085 * REFERENCE: PROGRAMM: ZL1 CL*61
|
|
00086 * CL*61
|
|
00087 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00088 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE321
|
|
00089 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE321
|
|
00090 * DTSBE321
|
|
00091 * DTSBE321
|
|
00092 * DESCRIPTION: DTSBE321
|
|
00093 * DTSBE321
|
|
00094 * SEE SECTION 3.3.3.4 OF DC REQUIREMENTS. DTSBE321
|
|
00095 * DTSBE321
|
|
00096 * DTSBE321
|
|
00097 * RECORDS READ: DTSBE321
|
|
00098 * DTSBE321
|
|
00099 * MASTER: DTSBE321
|
|
00100 * DTSBE321
|
|
00101 * MHDR DTSBE321
|
|
00102 * MQTR DTSBE321
|
|
00103 * MRPT DTSBE321
|
|
00104 * DTSBE321
|
|
00105 * DTSBE321
|
|
00106 * ALTERNATE INDEX: DTSBE321
|
|
00107 * DTSBE321
|
|
00108 * NONE. DTSBE321
|
|
00109 * DTSBE321
|
|
00110 * DTSBE321
|
|
00111 * REFERENCE: DTSBE321
|
|
00112 * DTSBE321
|
|
00113 * FQTR DTSBE321
|
|
00114 * DTSBE321
|
|
00115 * DTSBE321
|
|
00116 * RECORDS UPDATED: DTSBE321
|
|
00117 * DTSBE321
|
|
00118 * MHDR (REWRITE) DTSBE321
|
|
00119 * DTSBE321
|
|
00120 * DTSBE321
|
|
00121 * REPORT RECORDS WRITTEN: DTSBE321
|
|
00122 * DTSBE321
|
|
00123 * NONE. DTSBE321
|
|
00124 * DTSBE321
|
|
00125 * DTSBE321
|
|
00126 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE321
|
|
00127 * DTSBE321
|
|
00128 * T026. DTSBE321
|
|
00129 * DTSBE321
|
|
00130 * DTSBE321
|
|
00131 * MODULES CALLED: DTSBE321
|
|
00132 * DTSBE321
|
|
00133 * DTSBU001 DATE CONVERSION/EDIT. DTSBE321
|
|
00134 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE321
|
|
00135 * DTSBU103 PENALTY CHARGE CALCULATION (ANNUAL). DTSBE321
|
|
00136 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE321
|
|
00137 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE321
|
|
00138 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE321
|
|
00139 * DTSBU947 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 2. DTSBE321
|
|
00140 * DTSBE321
|
|
00141 ****** DTSBE321
|
|
00142 DTSBE321
|
|
00143 DTSBE321
|
|
00144 ENVIRONMENT DIVISION. DTSBE321
|
|
00145 INPUT-OUTPUT SECTION. DTSBE321
|
|
00146 FILE-CONTROL. DTSBE321
|
|
00147 SELECT PENALTY-FILE ASSIGN TO DTSFTPEN DTSBE321
|
|
00148 FILE STATUS IS PENALTY-STATUS. DTSBE321
|
|
00149 CL**2
|
|
00150 SELECT EMP-RPT-FILE ASSIGN TO DTSBX212 CL**2
|
|
00151 FILE STATUS IS PENALTY-STATUS. CL**2
|
|
00152 DTSBE321
|
|
00153 DATA DIVISION. DTSBE321
|
|
00154 FILE SECTION. DTSBE321
|
|
00155 DTSBE321
|
|
00156 FD PENALTY-FILE DTSBE321
|
|
00157 RECORDING MODE IS F DTSBE321
|
|
00158 LABEL RECORDS ARE STANDARD DTSBE321
|
|
00159 BLOCK CONTAINS 0 CHARACTERS. DTSBE321
|
|
00160 SKIP1 DTSBE321
|
|
00161 01 PENALTY-REC PIC X(130). CL*34
|
|
00162 FD EMP-RPT-FILE CL**2
|
|
00163 RECORDING MODE IS F CL**2
|
|
00164 BLOCK CONTAINS 0 RECORDS CL**2
|
|
00165 LABEL RECORDS ARE OMITTED. CL**2
|
|
00166 CL**2
|
|
00167 01 EMP-RPT-REC PIC X(106). CL**2
|
|
00168 CL**2
|
|
00169 DTSBE321
|
|
00170 WORKING-STORAGE SECTION. DTSBE321
|
|
001705 77 PAN-VALET PICTURE X(24) VALUE '062DTSBE321 05/03/21'. DTSBE321
|
|
00171 77 PAN-VALET PICTURE X(24) VALUE '009DTSBE321 04/25/14'. DTSBE321
|
|
00172 77 PAN-VALET PICTURE X(24) VALUE '176DTSBE321 04/24/14'. DTSBE321
|
|
00173 77 PAN-VALET PICTURE X(24) VALUE '007DTSBE321 08/18/08'. DTSBE321
|
|
00174 DTSBE321
|
|
00175 01 WRK-AREA. DTSBE321
|
|
00176 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +321.DTSBE321
|
|
00177 DTSBE321
|
|
00178 05 ABEND-MSG PIC X(60). DTSBE321
|
|
00179 DTSBE321
|
|
00180 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE321'.DTSBE321
|
|
00181 DTSBE321
|
|
00182 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBE321
|
|
00183 VALUE +999999999. DTSBE321
|
|
00184 DTSBE321
|
|
00185 05 WS-LIAB-QTR-RPT-MISSING PIC 9(05) VALUE 0. CL**5
|
|
00186 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE321
|
|
00187 05 WRK-END-SUBJECT-YRQ PIC S9(05) COMP-3 CL*51
|
|
00188 VALUE +20204. CL*62
|
|
00189 05 WRK-SUBJECT-SLASH-QTR PIC X(04). DTSBE321
|
|
00190 DTSBE321
|
|
00191 05 WRK-UC30H-DEL-YRQ PIC S9(05) COMP-3. DTSBE321
|
|
00192 05 WRK-MSOL-CNT PIC S9(05) VALUE 0. CL*54
|
|
00193 05 WRK-SUB-YRQ PIC 9(05) VALUE 0. CL*60
|
|
00194 DTSBE321
|
|
00195 05 WRK-FIRST-YRQ PIC S9(05) COMP-3 CL*55
|
|
00196 VALUE +0. CL*55
|
|
00197 CL*53
|
|
00198 05 WRK-FIRST-ANN-YRQ PIC S9(05) COMP-3 CL*53
|
|
00199 VALUE +20021. DTSBE321
|
|
00200 DTSBE321
|
|
00201 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 CL*23
|
|
00202 VALUE +0. CL*23
|
|
00203 05 WRK-YRQ PIC S9(05) COMP-3. DTSBE321
|
|
00204 05 WRK-TOLERANCE-AMT PIC S9(09)V99 COMP-3 CL*39
|
|
00205 * VALUE +100.00. CL*39
|
|
00206 VALUE +50.00. CL*39
|
|
00207 DTSBE321
|
|
00208 05 WRK-YRQ1-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26
|
|
00209 05 WRK-YRQ2-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26
|
|
00210 05 WRK-YRQ3-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26
|
|
00211 05 WRK-YRQ4-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26
|
|
00212 CL**4
|
|
00213 05 WRK-ERROR-IND PIC X(01). DTSBE321
|
|
00214 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBE321
|
|
00215 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBE321
|
|
00216 05 WRK-MSOL-IND PIC X(01). CL*53
|
|
00217 88 WRK-MSOL-OK VALUE 'Y'. CL*53
|
|
00218 88 WRK-MSOL-NO-REC VALUE 'N'. CL*53
|
|
00219 DTSBE321
|
|
00220 05 WRK-REPORT-IND PIC X(01). DTSBE321
|
|
00221 88 WRK-REPORT-FOUND-NO-88 VALUE 'N'. DTSBE321
|
|
00222 88 WRK-REPORT-FOUND-YES-88 VALUE 'Y'. DTSBE321
|
|
00223 DTSBE321
|
|
00224 05 GENERATE-LTR-IND PIC X(01). DTSBE321
|
|
00225 88 GENERATE-NO-LTR-88 VALUE '0'. DTSBE321
|
|
00226 88 GENERATE-MISS-RPT-YES-88 VALUE '1'. DTSBE321
|
|
00227 88 GENERATE-MISS-RPT-NO-88 VALUE 'N'. DTSBE321
|
|
00228 88 GENERATE-LATE-PEN-LTR-88 VALUE '2'. DTSBE321
|
|
00229 88 GENERATE-MISS-QTR-YES-88 VALUE '3'. CL**5
|
|
00230 88 GENERATE-MISS-QTR-NO-88 VALUE 'B'. CL**5
|
|
00231 DTSBE321
|
|
00232 05 PENALTY-STATUS PIC X(02) VALUE SPACES. DTSBE321
|
|
00233 88 PENALTY-OK-88 VALUE '00'. DTSBE321
|
|
00234 DTSBE321
|
|
00235 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBE321
|
|
00236 05 WRK-EMP-NO PIC S9(07) COMP-3 CL**2
|
|
00237 VALUE +0. CL**2
|
|
00238 CL**2
|
|
00239 05 WRK-ICESA-YRQ. CL**2
|
|
00240 10 WRK-ICESA-CCYY PIC 9999. CL**2
|
|
00241 10 FILLER PIC X. CL**2
|
|
00242 10 WRK-ICESA-QTR PIC 9. CL**2
|
|
00243 CL**2
|
|
00244 05 WRK-RPT. CL**2
|
|
00245 10 WRK-RPT-CCYY PIC 9999. CL**2
|
|
00246 10 WRK-RPT-QTR PIC 9. CL**2
|
|
00247 05 WRK-RPT-WS REDEFINES WRK-RPT PIC 9(5). CL**2
|
|
00248 CL**2
|
|
00249 05 WRK-RPT-YRQ PIC S9(5) COMP-3 CL**2
|
|
00250 VALUE +0. CL**2
|
|
00251 CL**2
|
|
00252 DTSBE321
|
|
00253 05 WRK-DOMESTIC-CNT PIC S9(07) COMP-3 VALUE +0. CL**5
|
|
00254 05 WRK-ANN-FILER-CNT PIC S9(07) COMP-3 VALUE +0. CL**5
|
|
00255 05 WRK-PENALTY-CNT PIC S9(07) COMP-3 VALUE +0. CL**4
|
|
00256 05 WRK-T026-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*20
|
|
00257 05 WRK-T026-MIS-CNT PIC S9(07) COMP-3 VALUE +0. CL*20
|
|
00258 05 WRK-TF-TABLE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321
|
|
00259 05 WRK-REP-FND-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321
|
|
00260 05 WRK-PAR-FND-CNT PIC S9(07) COMP-3 VALUE +0. CL**5
|
|
00261 05 WRK-BYPASS-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321
|
|
00262 05 WRK-LATE-LTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321
|
|
00263 05 WRK-MISS-LTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321
|
|
00264 DTSBE321
|
|
00265 05 AMT-DISP1 PIC --------9.99. DTSBE321
|
|
00266 05 AMT-DISP2 PIC --------9.99. CL*40
|
|
00267 05 AMT-DISP3 PIC --------9.99. CL*40
|
|
00268 DTSBE321
|
|
00269 05 WRK-TIMELY-PAYMENTS PIC S9(09)V9(02) COMP-3. DTSBE321
|
|
00270 * 05 WRK-TOLERANCE-AMT PIC S9(09)V9(02) COMP-3. CL*40
|
|
00271 05 TF-SUB PIC S9(07) COMP-3. DTSBE321
|
|
00272 05 TF-MAX PIC S9(07) COMP-3 DTSBE321
|
|
00273 VALUE +999999. DTSBE321
|
|
00274 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. DTSBE321
|
|
00275 10 TRANS-FILE-RPT-IND PIC X(01). DTSBE321
|
|
00276 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. DTSBE321
|
|
00277 88 TF-RPT-FOUND-NO-88 VALUE 'N'. DTSBE321
|
|
00278 10 TRANS-BYPASSED-IND PIC X(01). DTSBE321
|
|
00279 88 TF-BYPASSED-YES-88 VALUE 'Y'. DTSBE321
|
|
00280 88 TF-BYPASSED-NO-88 VALUE 'N'. DTSBE321
|
|
00281 DTSBE321
|
|
00282 05 W-PENALTY-REC. DTSBE321
|
|
00283 10 W-EMP-NO PIC 9(06). CL*34
|
|
00284 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00285 10 W-FEIN-NO PIC 9(09). CL*34
|
|
00286 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00287 10 W-NAME PIC X(30). CL*34
|
|
00288 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00289 10 W-CHG PIC --------9.99. CL*34
|
|
00290 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00291 10 W-PAID PIC --------9.99. CL*34
|
|
00292 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00293 10 W-BAL PIC --------9.99. CL*34
|
|
00294 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00295 10 W-PEN PIC ------9.99. CL*34
|
|
00296 10 FILLER PIC X(01) VALUE ','. CL*34
|
|
00297 10 W-NOTE PIC X(30). CL*34
|
|
00298 DTSBE321
|
|
00299 01 EVL-LOG-AREA. DTSBE321
|
|
00300 10 EVL-TEXT PIC X(27) DTSBE321
|
|
00301 VALUE 'NOTICE OF LATE PENALTY FOR '. DTSBE321
|
|
00302 10 EVL-SLASH-QTR PIC X(4). DTSBE321
|
|
00303 10 FILLER PIC X(9) DTSBE321
|
|
00304 VALUE ' MAILED '. DTSBE321
|
|
00305 10 EVL-ADDR-TYPE PIC X(04). DTSBE321
|
|
00306 10 EVL-ADDR-ID-NO PIC XXX. DTSBE321
|
|
00307 10 FILLER PIC X(03) VALUE SPACE. DTSBE321
|
|
00308 01 EVL-TEXT-MISS-LTR. DTSBE321
|
|
00309 10 FILLER PIC X(27) DTSBE321
|
|
00310 VALUE 'MISSING REPORT NOTICE FOR '. DTSBE321
|
|
00311 01 EVL-TEXT-MISS-QTR-LTR. CL**5
|
|
00312 10 FILLER PIC X(29) CL**6
|
|
00313 VALUE 'INCOMPLETE REPORT FILED FOR '. CL**5
|
|
00314 01 EVL-TEXT-PEN-LTR. DTSBE321
|
|
00315 10 FILLER PIC X(27) DTSBE321
|
|
00316 VALUE 'NOTICE OF LATE PENALTY FOR '. DTSBE321
|
|
00317 EJECT DTSBE321
|
|
00318 01 MSG-AREA. DTSBE321
|
|
00319 05 MSG1-AREA. DTSBE321
|
|
00320 10 MSG1-ID PIC X(03) VALUE '321'. DTSBE321
|
|
00321 10 MSG1-TEXT. DTSBE321
|
|
00322 15 FILLER PIC X(40) DTSBE321
|
|
00323 VALUE 'ANNUAL FILER: QUARTERLY REPORT ON FILE '. DTSBE321
|
|
00324 15 FILLER PIC X(40) DTSBE321
|
|
00325 VALUE ' '. DTSBE321
|
|
00326 EJECT DTSBE321
|
|
00327 01 W-EMP-RPT-REC. CL**2
|
|
00328 ++INCLUDE DTSIX212 CL**2
|
|
00329 CL**2
|
|
00330 01 L001-LINK-AREA. DTSBE321
|
|
00331 ++INCLUDE DTSIL001 DTSBE321
|
|
00332 EJECT DTSBE321
|
|
00333 01 L004-LINK-AREA. DTSBE321
|
|
00334 ++INCLUDE DTSIL004 DTSBE321
|
|
00335 EJECT DTSBE321
|
|
00336 01 L005-LINK-AREA. DTSBE321
|
|
00337 ++INCLUDE DTSIL005 DTSBE321
|
|
00338 EJECT DTSBE321
|
|
00339 01 L102-LINK-AREA. DTSBE321
|
|
00340 ++INCLUDE DTSIL102 DTSBE321
|
|
00341 EJECT DTSBE321
|
|
00342 01 L101-LINK-AREA. DTSBE321
|
|
00343 ++INCLUDE DTSIL101 DTSBE321
|
|
00344 EJECT DTSBE321
|
|
00345 01 L109-LINK-AREA. DTSBE321
|
|
00346 ++INCLUDE DTSIL109 DTSBE321
|
|
00347 EJECT DTSBE321
|
|
00348 01 L111-LINK-AREA. DTSBE321
|
|
00349 ++INCLUDE DTSIL111 DTSBE321
|
|
00350 EJECT DTSBE321
|
|
00351 01 L112-LINK-AREA. DTSBE321
|
|
00352 ++INCLUDE DTSIL112 DTSBE321
|
|
00353 EJECT DTSBE321
|
|
00354 01 L410-LINK-AREA. DTSBE321
|
|
00355 ++INCLUDE DTSIL410 DTSBE321
|
|
00356 EJECT DTSBE321
|
|
00357 01 L415-LINK-AREA. DTSBE321
|
|
00358 ++INCLUDE DTSIL415 DTSBE321
|
|
00359 EJECT DTSBE321
|
|
00360 01 L516-LINK-AREA. CL**6
|
|
00361 ++INCLUDE DTSIL516 CL**6
|
|
00362 EJECT CL**6
|
|
00363 01 L910-LINK-AREA. DTSBE321
|
|
00364 ++INCLUDE DTSIL910 DTSBE321
|
|
00365 SKIP3 DTSBE321
|
|
00366 01 MSKL-REC. DTSBE321
|
|
00367 ++INCLUDE DTSIMSKL DTSBE321
|
|
00368 SKIP3 DTSBE321
|
|
00369 01 R321-REC. DTSBE321
|
|
00370 ++INCLUDE DTSIR321 DTSBE321
|
|
00371 SKIP3 DTSBE321
|
|
00372 01 FAFD-REC. DTSBE321
|
|
00373 ++INCLUDE DTSIFAFD DTSBE321
|
|
00374 SKIP3 DTSBE321
|
|
00375 01 MQTR-REC. DTSBE321
|
|
00376 ++INCLUDE DTSIMQTR DTSBE321
|
|
00377 01 MEVL-REC. DTSBE321
|
|
00378 ++INCLUDE DTSIMEVL DTSBE321
|
|
00379 01 MSOL-REC. CL*53
|
|
00380 ++INCLUDE DTSIMSOL CL*53
|
|
00381 SKIP3 DTSBE321
|
|
00382 01 L923-LINK-AREA. DTSBE321
|
|
00383 ++INCLUDE DTSIL923 DTSBE321
|
|
00384 EJECT DTSBE321
|
|
00385 01 ASKL-REC. DTSBE321
|
|
00386 ++INCLUDE DTSIASKL DTSBE321
|
|
00387 EJECT DTSBE321
|
|
00388 01 ARPT-REC. DTSBE321
|
|
00389 ++INCLUDE DTSIARPT DTSBE321
|
|
00390 SKIP3 DTSBE321
|
|
00391 01 MRPT-REC. DTSBE321
|
|
00392 ++INCLUDE DTSIMRPT DTSBE321
|
|
00393 SKIP3 DTSBE321
|
|
00394 01 MDST-REC. DTSBE321
|
|
00395 ++INCLUDE DTSIMDST DTSBE321
|
|
00396 EJECT DTSBE321
|
|
00397 01 L931-LINK-AREA. DTSBE321
|
|
00398 ++INCLUDE DTSIL931 DTSBE321
|
|
00399 SKIP3 DTSBE321
|
|
00400 01 FSKL-REC. DTSBE321
|
|
00401 ++INCLUDE DTSIFSKL DTSBE321
|
|
00402 SKIP3 DTSBE321
|
|
00403 01 FQTR-REC. DTSBE321
|
|
00404 ++INCLUDE DTSIFQTR DTSBE321
|
|
00405 EJECT DTSBE321
|
|
00406 01 R907-REC. DTSBE321
|
|
00407 ++INCLUDE DTSIR907 DTSBE321
|
|
00408 EJECT DTSBE321
|
|
00409 01 L927-LINK-AREA. DTSBE321
|
|
00410 ++INCLUDE DTSIL927 DTSBE321
|
|
00411 SKIP3 DTSBE321
|
|
00412 01 T026-REC. DTSBE321
|
|
00413 ++INCLUDE DTSIT026 DTSBE321
|
|
00414 EJECT DTSBE321
|
|
00415 01 CACT-LITERALS. DTSBE321
|
|
00416 ++INCLUDE DTSICACT DTSBE321
|
|
00417 EJECT DTSBE321
|
|
00418 LINKAGE SECTION. DTSBE321
|
|
00419 SKIP3 DTSBE321
|
|
00420 01 LECM-LINK-AREA. DTSBE321
|
|
00421 ++INCLUDE DTSILECM DTSBE321
|
|
00422 SKIP3 DTSBE321
|
|
00423 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE321
|
|
00424 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE321
|
|
00425 15 FILLER PIC X(65). DTSBE321
|
|
00426 EJECT DTSBE321
|
|
00427 01 MPRF-LINK-REC. DTSBE321
|
|
00428 ++INCLUDE DTSIMPRF DTSBE321
|
|
00429 EJECT DTSBE321
|
|
00430 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE321
|
|
00431 MPRF-LINK-REC. DTSBE321
|
|
00432 DTSBE321
|
|
00433 EVALUATE TRUE DTSBE321
|
|
00434 WHEN LECM-PROCESS-88 DTSBE321
|
|
00435 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE321
|
|
00436 DTSBE321
|
|
00437 WHEN LECM-INITIALIZE-88 DTSBE321
|
|
00438 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE321
|
|
00439 DTSBE321
|
|
00440 WHEN LECM-TERMINATE-88 DTSBE321
|
|
00441 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE321
|
|
00442 DTSBE321
|
|
00443 WHEN OTHER DTSBE321
|
|
00444 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE321
|
|
00445 TO ABEND-MSG DTSBE321
|
|
00446 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321
|
|
00447 DTSBE321
|
|
00448 DTSBE321
|
|
00449 GOBACK. DTSBE321
|
|
00450 EJECT DTSBE321
|
|
00451 I0000-INITIALIZE. DTSBE321
|
|
00452 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE321
|
|
00453 L931-TRACE-IND. DTSBE321
|
|
00454 DTSBE321
|
|
00455 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE321
|
|
00456 L931-MOD-NAME DTSBE321
|
|
00457 R907-MODULE-NAME. DTSBE321
|
|
00458 DTSBE321
|
|
00459 DTSBE321
|
|
00460 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE321
|
|
00461 DTSBE321
|
|
00462 MOVE '907' TO R907-REC-TYPE. DTSBE321
|
|
00463 DTSBE321
|
|
00464 MOVE LENGTH OF T026-REC TO T026-LENGTH. DTSBE321
|
|
00465 DTSBE321
|
|
00466 MOVE '026' TO T026-REC-TYPE. DTSBE321
|
|
00467 DTSBE321
|
|
00468 MOVE LENGTH OF R321-REC TO R321-LENGTH. DTSBE321
|
|
00469 DTSBE321
|
|
00470 MOVE '321' TO R321-REC-TYPE. DTSBE321
|
|
00471 DTSBE321
|
|
00472 MOVE WRK-MOD-NAME TO T026-ORIGIN. DTSBE321
|
|
00473 DTSBE321
|
|
00474 MOVE LECM-SYS-DATE TO T026-SYS-DATE. DTSBE321
|
|
00475 DTSBE321
|
|
00476 MOVE LECM-SYS-TIME TO T026-SYS-TIME. DTSBE321
|
|
00477 DTSBE321
|
|
00478 DTSBE321
|
|
00479 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE321
|
|
00480 DTSBE321
|
|
00481 DTSBE321
|
|
00482 IF WRK-PARM-SUBJECT-YRQ > WRK-UC30H-DEL-YRQ DTSBE321
|
|
00483 MOVE WRK-PARM-SUBJECT-YRQ DTSBE321
|
|
00484 TO WRK-UC30H-DEL-YRQ. DTSBE321
|
|
00485 DTSBE321
|
|
00486 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBE321
|
|
00487 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBE321
|
|
00488 DTSBE321
|
|
00489 OPEN OUTPUT PENALTY-FILE DTSBE321
|
|
00490 IF NOT PENALTY-OK-88 DTSBE321
|
|
00491 DISPLAY 'CANNOT OPEN PENALTY FILE- PROGRAM WILL DIE ' CL**9
|
|
00492 PENALTY-STATUS DTSBE321
|
|
00493 PERFORM S999-ABEND THRU S999-EXIT CL**9
|
|
00494 END-IF. DTSBE321
|
|
00495 CL**2
|
|
00496 OPEN INPUT EMP-RPT-FILE CL**2
|
|
00497 IF NOT PENALTY-OK-88 CL**2
|
|
00498 DISPLAY 'CANNOT OPEN ICESA FILE- PROGRAM WILL DIE ' CL**9
|
|
00499 PENALTY-STATUS CL**2
|
|
00500 PERFORM S999-ABEND THRU S999-EXIT CL**9
|
|
00501 END-IF. CL**2
|
|
00502 CL**2
|
|
00503 DTSBE321
|
|
00504 PERFORM I3000-TRANS-FILE-RPTS THRU I3000-EXIT. DTSBE321
|
|
00505 DTSBE321
|
|
00506 ** SET LECM-MST-OPEN-UPDATE-HDR-88 TO TRUE. DTSBE321
|
|
00507 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE321
|
|
00508 DTSBE321
|
|
00509 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE321
|
|
00510 DTSBE321
|
|
00511 I0000-EXIT. DTSBE321
|
|
00512 EXIT. DTSBE321
|
|
00513 SKIP3 DTSBE321
|
|
00514 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE321
|
|
00515 SET L415-MODE-MOST-RECENT-88 TO TRUE. DTSBE321
|
|
00516 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT. DTSBE321
|
|
00517 IF L415-OK-88 DTSBE321
|
|
00518 MOVE L415-UC30H-FIRST-DEL-STRT-YRQ DTSBE321
|
|
00519 TO WRK-UC30H-DEL-YRQ DTSBE321
|
|
00520 ELSE DTSBE321
|
|
00521 MOVE ZEROS TO WRK-UC30H-DEL-YRQ. DTSBE321
|
|
00522 DTSBE321
|
|
00523 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE321
|
|
00524 AND WRK-UC30H-DEL-YRQ = ZEROS DTSBE321
|
|
00525 MOVE 'PARM-SUBJECT-YRQ REQUIRED ' TO ABEND-MSG DTSBE321
|
|
00526 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321
|
|
00527 DTSBE321
|
|
00528 DTSBE321
|
|
00529 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE321
|
|
00530 MOVE WRK-UC30H-DEL-YRQ TO L004-QTR-5-9 DTSBE321
|
|
00531 ADD 1 TO L004-QTR-5-YR DTSBE321
|
|
00532 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE321
|
|
00533 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE321
|
|
00534 ELSE DTSBE321
|
|
00535 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X DTSBE321
|
|
00536 MOVE '1' TO L004-QTR-3-Q-X DTSBE321
|
|
00537 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE321
|
|
00538 IF L004-VALID-QTR DTSBE321
|
|
00539 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE321
|
|
00540 ELSE DTSBE321
|
|
00541 MOVE 'PARM-SUBJECT-YRQ NOT VALID' DTSBE321
|
|
00542 TO ABEND-MSG DTSBE321
|
|
00543 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321
|
|
00544 DTSBE321
|
|
00545 DISPLAY 'BE321 SUBJECT START YRQ ' WRK-PARM-SUBJECT-YRQ CL*49
|
|
00546 DISPLAY SPACE. DTSBE321
|
|
00547 MOVE WRK-PARM-SUBJECT-YRQ TO WRK-SUB-YRQ. CL*60
|
|
00548 MOVE WRK-SUB-YRQ TO L004-QTR-5-AREA CL*60
|
|
00549 MOVE '4' TO L004-QTR-5-Q CL*53
|
|
00550 DISPLAY ' SUB YRQ ' WRK-SUB-YRQ CL*60
|
|
00551 DISPLAY ' ZND YRQ ' L004-QTR-5-9 CL*60
|
|
00552 PERFORM S004-FROM-5 THRU S004-EXIT CL*53
|
|
00553 IF L004-VALID-QTR CL*53
|
|
00554 MOVE L004-QTR-5-9 TO WRK-END-SUBJECT-YRQ CL*53
|
|
00555 ELSE CL*53
|
|
00556 DISPLAY ' END YRQ ' L004-QTR-5-9 CL*56
|
|
00557 MOVE 'END-SUBJECT-YRQ NOT VALID' CL*53
|
|
00558 TO ABEND-MSG CL*53
|
|
00559 PERFORM S999-ABEND THRU S999-EXIT. CL*53
|
|
00560 CL*49
|
|
00561 DISPLAY 'BE321 SUBJECT ENDIN YRQ ' WRK-END-SUBJECT-YRQ CL*51
|
|
00562 DISPLAY SPACE. CL*49
|
|
00563 DTSBE321
|
|
00564 IF WRK-UC30H-DEL-YRQ = ZEROS DTSBE321
|
|
00565 GO TO I1000-EXIT. DTSBE321
|
|
00566 DTSBE321
|
|
00567 MOVE WRK-UC30H-DEL-YRQ TO L004-QTR-5-9. DTSBE321
|
|
00568 ADD 1 TO L004-QTR-5-YR. DTSBE321
|
|
00569 DTSBE321
|
|
00570 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321
|
|
00571 DTSBE321
|
|
00572 IF L004-QTR-5-9 = WRK-PARM-SUBJECT-YRQ DTSBE321
|
|
00573 NEXT SENTENCE DTSBE321
|
|
00574 ELSE DTSBE321
|
|
00575 DISPLAY 'BE321 UC30H +1 YRQ ' L004-QTR-5-9 DTSBE321
|
|
00576 DISPLAY 'BE321 WRK PARM YRQ ' WRK-PARM-SUBJECT-YRQ DTSBE321
|
|
00577 MOVE DTSBE321
|
|
00578 'PARM-SUBJECT-YRQ NOT COMPATIBLE WITH WRK-UC30-DEL-YRQ' DTSBE321
|
|
00579 TO ABEND-MSG DTSBE321
|
|
00580 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321
|
|
00581 I1000-EXIT. DTSBE321
|
|
00582 EXIT. DTSBE321
|
|
00583 EJECT DTSBE321
|
|
00584 I3000-TRANS-FILE-RPTS. DTSBE321
|
|
00585 PERFORM DTSBE321
|
|
00586 VARYING TF-SUB FROM +1 BY +1 DTSBE321
|
|
00587 UNTIL TF-SUB > TF-MAX DTSBE321
|
|
00588 SET TF-RPT-FOUND-NO-88 (TF-SUB) TO TRUE DTSBE321
|
|
00589 SET TF-BYPASSED-NO-88 (TF-SUB) TO TRUE DTSBE321
|
|
00590 END-PERFORM. DTSBE321
|
|
00591 DTSBE321
|
|
00592 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBE321
|
|
00593 DTSBE321
|
|
00594 MOVE ZERO TO ASKL-BATCH-NO DTSBE321
|
|
00595 ASKL-ITEM-NO. DTSBE321
|
|
00596 DTSBE321
|
|
00597 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBE321
|
|
00598 PERFORM UNTIL L923-NO-REC-88 DTSBE321
|
|
00599 IF ASKL-RPT-88 DTSBE321
|
|
00600 MOVE ASKL-REC TO ARPT-REC DTSBE321
|
|
00601 * PERFORM I3300-TRANS-ARPT THRU I3300-EXIT CL*27
|
|
00602 IF (ARPT-ORIG-88 DTSBE321
|
|
00603 AND ARPT-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE321
|
|
00604 AND ARPT-NOT-PROCESSED-88) DTSBE321
|
|
00605 IF NOT ARPT-EMP-NO-NO-ENTRY-88 DTSBE321
|
|
00606 SET TF-RPT-FOUND-YES-88 (ARPT-EMP-NO) TO TRUE DTSBE321
|
|
00607 ADD +1 TO WRK-TF-TABLE-CNT DTSBE321
|
|
00608 * DISPLAY 'I3 ' ARPT-EMP-NO ' ' ARPT-BATCH-NO CL*27
|
|
00609 * ' ' ARPT-ITEM-NO CL*27
|
|
00610 END-IF DTSBE321
|
|
00611 END-IF DTSBE321
|
|
00612 END-IF DTSBE321
|
|
00613 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBE321
|
|
00614 END-PERFORM. DTSBE321
|
|
00615 DTSBE321
|
|
00616 PERFORM S923-CLOSE THRU S923-EXIT. DTSBE321
|
|
00617 PERFORM I4000-TRANS-ICESA THRU I4000-EXIT. CL**2
|
|
00618 CL**2
|
|
00619 I3000-EXIT. CL**2
|
|
00620 EXIT. CL**2
|
|
00621 I3300-TRANS-ARPT. CL*10
|
|
00622 DISPLAY ARPT-BATCH-NO ' ' ARPT-ITEM-NO ' ' CL*10
|
|
00623 ARPT-YRQ ' ' ARPT-EMP-NO ' ' CL*10
|
|
00624 ARPT-RECEIVED-DATE ' ' CL*10
|
|
00625 ARPT-DEPOSIT-DATE ' ' CL*10
|
|
00626 ARPT-REMIT-AMT. CL*10
|
|
00627 I3300-EXIT. CL*11
|
|
00628 EXIT. CL*10
|
|
00629 CL*10
|
|
00630 I4000-TRANS-ICESA. CL**2
|
|
00631 READ EMP-RPT-FILE INTO W-EMP-RPT-REC AT END CL**2
|
|
00632 GO TO I4000-EXIT. CL**2
|
|
00633 MOVE X212-EMP-NBR TO WRK-EMP-NO CL**2
|
|
00634 MOVE '2020/1' TO WRK-ICESA-YRQ CL*62
|
|
00635 MOVE WRK-ICESA-CCYY TO WRK-RPT-CCYY CL**2
|
|
00636 MOVE WRK-ICESA-QTR TO WRK-RPT-QTR CL**2
|
|
00637 CL**2
|
|
00638 MOVE WRK-RPT-WS TO WRK-RPT-YRQ. CL**2
|
|
00639 * CL*15
|
|
00640 * FOR ANNAUL FILERS ALWAYS SET QTR TO 1 CL*15
|
|
00641 * CL*15
|
|
00642 IF WRK-RPT-YRQ = WRK-PARM-SUBJECT-YRQ CL**2
|
|
00643 SET TF-RPT-FOUND-YES-88 (WRK-EMP-NO) TO TRUE CL**2
|
|
00644 DISPLAY 'EMPLR BYPASSED: ' WRK-EMP-NO ' ' WRK-RPT-YRQ CL*19
|
|
00645 ADD +1 TO WRK-TF-TABLE-CNT. CL**2
|
|
00646 CL**2
|
|
00647 GO TO I4000-TRANS-ICESA. CL**2
|
|
00648 I4000-EXIT. CL**2
|
|
00649 EXIT. CL**2
|
|
00650 P0000-PROCESS. DTSBE321
|
|
00651 DTSBE321
|
|
00652 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE321
|
|
00653 IF MPRF-STATUS-ACT-88 CL*25
|
|
00654 IF MPRF-STATUS-SUB-88 DTSBE321
|
|
00655 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBE321
|
|
00656 NEXT SENTENCE DTSBE321
|
|
00657 ELSE DTSBE321
|
|
00658 GO TO P0000-EXIT DTSBE321
|
|
00659 ELSE DTSBE321
|
|
00660 GO TO P0000-EXIT CL*25
|
|
00661 ELSE CL*25
|
|
00662 GO TO P0000-EXIT. CL*25
|
|
00663 CL**3
|
|
00664 MOVE ZEROS TO WS-LIAB-QTR-RPT-MISSING CL**4
|
|
00665 SET GENERATE-NO-LTR-88 TO TRUE DTSBE321
|
|
00666 SET GENERATE-MISS-RPT-NO-88 TO TRUE DTSBE321
|
|
00667 SET GENERATE-MISS-QTR-NO-88 TO TRUE CL**4
|
|
00668 SET WRK-REPORT-FOUND-NO-88 TO TRUE. DTSBE321
|
|
00669 DTSBE321
|
|
00670 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBE321
|
|
00671 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBE321
|
|
00672 MOVE WRK-PARM-SUBJECT-YRQ TO L410-YRQ DTSBE321
|
|
00673 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBE321
|
|
00674 DTSBE321
|
|
00675 IF NOT L410-ANN-SCHED-88 DTSBE321
|
|
00676 ADD 1 TO WRK-DOMESTIC-CNT CL**4
|
|
00677 GO TO P0000-EXIT. DTSBE321
|
|
00678 CL*53
|
|
00679 PERFORM P0900-LIABLE-MSOL THRU P0900-EXIT. CL*53
|
|
00680 CL*49
|
|
00681 IF WRK-FIRST-YRQ > WRK-END-SUBJECT-YRQ CL*53
|
|
00682 ADD 1 TO WRK-DOMESTIC-CNT CL*49
|
|
00683 DISPLAY ' LIABILITY STARTS NEXT YEAR: ' MPRF-EMP-NO CL*50
|
|
00684 ' ' WRK-FIRST-YRQ CL*53
|
|
00685 GO TO P0000-EXIT. CL*49
|
|
00686 CL*49
|
|
00687 ADD 1 TO WRK-ANN-FILER-CNT. CL**3
|
|
00688 CL**3
|
|
00689 * DISPLAY ' EMP ANNUAL FILER: ' MPRF-EMP-NO CL*36
|
|
00690 CL*34
|
|
00691 MOVE ZEROS TO L102-TAX-BALANCE-AMT CL*34
|
|
00692 L102-LATE-PEN-CHARGE-CHNG CL*34
|
|
00693 L102-TAX-CHARGED-AMT CL*34
|
|
00694 WRK-TIMELY-PAYMENTS. CL*34
|
|
00695 CL*34
|
|
00696 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) CL*20
|
|
00697 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE CL*20
|
|
00698 ADD +1 TO WRK-BYPASS-CNT CL*20
|
|
00699 DISPLAY ' ANNUAL REPORT FOUND IN TRANS ' MPRF-EMP-NO CL*20
|
|
00700 GO TO P0000-EXIT. CL*20
|
|
00701 CL**3
|
|
00702 PERFORM P1000-LIABLE-QTRS THRU P1000-EXIT. DTSBE321
|
|
00703 DTSBE321
|
|
00704 IF WRK-REPORT-FOUND-NO-88 DTSBE321
|
|
00705 ADD 1 TO WRK-MISS-LTR-CNT DTSBE321
|
|
00706 SET GENERATE-MISS-RPT-YES-88 TO TRUE DTSBE321
|
|
00707 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT DTSBE321
|
|
00708 PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT DTSBE321
|
|
00709 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT DTSBE321
|
|
00710 MOVE 100.00 TO W-PEN CL*34
|
|
00711 MOVE ' *** MISSING REPORT' TO W-NOTE CL*34
|
|
00712 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*34
|
|
00713 GO TO P0000-EXIT. CL*30
|
|
00714 * ELSE CL*30
|
|
00715 * DISPLAY ' ANNUAL FILER REPORT FOUND ' MPRF-EMP-NO. CL*30
|
|
00716 CL**4
|
|
00717 IF WS-LIAB-QTR-RPT-MISSING > 0 CL**4
|
|
00718 ADD +1 TO WRK-PAR-FND-CNT CL**7
|
|
00719 * DISPLAY ' PARTIAL REPORT FILED ' MPRF-EMP-NO CL*34
|
|
00720 SET GENERATE-MISS-QTR-YES-88 TO TRUE CL**4
|
|
00721 PERFORM P2550-GEN-MISS-QTR-R321 THRU P2550-EXIT CL**4
|
|
00722 PERFORM P2650-GEN-MISS-ELOG THRU P2650-EXIT CL**4
|
|
00723 MOVE ' *** PARTIAL REPORT' TO W-NOTE CL*34
|
|
00724 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*34
|
|
00725 * GO TO P0000-EXIT CL*41
|
|
00726 ELSE CL**4
|
|
00727 * DISPLAY MPRF-EMP-NO ' ' MPRF-FEIN ' ' MPRF-PRIMARY-NAME CL*33
|
|
00728 * ' *** REPORT FILED ' CL*33
|
|
00729 ADD +1 TO WRK-REP-FND-CNT. DTSBE321
|
|
00730 DTSBE321
|
|
00731 IF WRK-ERROR-YES-88 DTSBE321
|
|
00732 DISPLAY ' ANN EMP FILED QTRLY RPT: ' MPRF-EMP-NO CL**3
|
|
00733 GO TO P0000-EXIT. DTSBE321
|
|
00734 DTSBE321
|
|
00735 IF WRK-LAST-LIAB-YRQ = ZERO DTSBE321
|
|
00736 DISPLAY ' EMP LAST LIAB QTR = 0 ' MPRF-EMP-NO DTSBE321
|
|
00737 GO TO P0000-EXIT. DTSBE321
|
|
00738 DTSBE321
|
|
00739 PERFORM P2000-INITIALIZE-L102 THRU P2000-EXIT. DTSBE321
|
|
00740 CL*39
|
|
00741 IF L102-TAX-CHARGED-AMT = ZEROS OR CL*39
|
|
00742 L102-TAX-BALANCE-AMT = ZEROS OR CL*39
|
|
00743 L102-LATE-PEN-CHARGED-AMT > ZEROS CL*39
|
|
00744 GO TO P0000-EXIT. CL*39
|
|
00745 CL*39
|
|
00746 MOVE L102-TAX-CHARGED-AMT TO AMT-DISP3 CL*39
|
|
00747 MOVE L102-TAX-BALANCE-AMT TO AMT-DISP1 CL*39
|
|
00748 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP2 CL*39
|
|
00749 DISPLAY 'PEN YR20 ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*62
|
|
00750 ' RCVD ' L102-OR-RECEIVED-DATE CL*39
|
|
00751 ' CHRG ' AMT-DISP3 CL*39
|
|
00752 ' PAID ' AMT-DISP2 CL*39
|
|
00753 ' BALN ' AMT-DISP1 CL*39
|
|
00754 CL*39
|
|
00755 IF L102-TAX-BALANCE-AMT < WRK-TOLERANCE-AMT AND CL*39
|
|
00756 WRK-TIMELY-PAYMENTS > ZEROS CL*39
|
|
00757 MOVE 100 TO L102-LATE-PEN-CHARGE-CHNG CL*39
|
|
00758 MOVE L102-LATE-PEN-CHARGE-CHNG TO CL*39
|
|
00759 L102-LATE-PEN-WAIVE-CHNG CL*39
|
|
00760 MOVE L102-TAX-BALANCE-AMT TO AMT-DISP2 CL*39
|
|
00761 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP1 CL*39
|
|
00762 DISPLAY 'PEN WAIVE ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*39
|
|
00763 ' RCVD ' L102-OR-RECEIVED-DATE CL*39
|
|
00764 ' BAL ' AMT-DISP2 CL*39
|
|
00765 ' PAID ' AMT-DISP1 CL*39
|
|
00766 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39
|
|
00767 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT CL*39
|
|
00768 MOVE ' *** PENALTY WAIVED ' TO W-NOTE CL*42
|
|
00769 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*42
|
|
00770 GO TO P0000-EXIT. CL*39
|
|
00771 CL*39
|
|
00772 IF L102-TAX-BALANCE-AMT < WRK-TOLERANCE-AMT AND CL*39
|
|
00773 WRK-TIMELY-PAYMENTS = ZEROS CL*39
|
|
00774 MOVE 100 TO L102-LATE-PEN-CHARGE-CHNG CL*39
|
|
00775 MOVE L102-TAX-CHARGED-AMT TO AMT-DISP2 CL*39
|
|
00776 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP1 CL*39
|
|
00777 DISPLAY 'PEN GIVEN ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*40
|
|
00778 ' RCVD ' L102-OR-RECEIVED-DATE CL*39
|
|
00779 ' CHRG ' AMT-DISP2 CL*39
|
|
00780 ' PAID ' AMT-DISP1 CL*39
|
|
00781 SET GENERATE-LATE-PEN-LTR-88 TO TRUE CL*39
|
|
00782 * ADD 1 TO WRK-PEN-LTR-CNT CL*40
|
|
00783 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39
|
|
00784 PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT CL*39
|
|
00785 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT CL*39
|
|
00786 MOVE ' *** PENALTY GIVEN ' TO W-NOTE CL*42
|
|
00787 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*42
|
|
00788 GO TO P0000-EXIT. CL*39
|
|
00789 CL*39
|
|
00790 DTSBE321
|
|
00791 * DISPLAY ' ORIG REC DATE ' L102-OR-RECEIVED-DATE CL*31
|
|
00792 * ' DUE DATE ' L102-RPT-DUE-DATE CL*31
|
|
00793 DTSBE321
|
|
00794 DTSBE321
|
|
00795 PERFORM S102A-PEN-ASSESSMENT-RUN THRU S102A-EXIT. DTSBE321
|
|
00796 DTSBE321
|
|
00797 MOVE L102-LATE-PEN-CHARGE-CHNG TO AMT-DISP1. DTSBE321
|
|
00798 CL*39
|
|
00799 IF L102-LATE-PEN-CHARGE-CHNG > +0 CL*39
|
|
00800 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) CL*39
|
|
00801 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE CL*39
|
|
00802 ADD +1 TO WRK-BYPASS-CNT CL*39
|
|
00803 GO TO P0000-EXIT CL*39
|
|
00804 ELSE CL*39
|
|
00805 MOVE L102-TAX-CHARGED-AMT TO AMT-DISP2 CL*39
|
|
00806 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP1 CL*39
|
|
00807 DISPLAY 'PEN-102 ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*39
|
|
00808 ' RCVD ' L102-OR-RECEIVED-DATE CL*39
|
|
00809 ' CHRG ' AMT-DISP2 CL*39
|
|
00810 ' PAID ' AMT-DISP1 CL*39
|
|
00811 SET GENERATE-LATE-PEN-LTR-88 TO TRUE CL*39
|
|
00812 * ADD 1 TO WRK-PEN-LTR-CNT CL*40
|
|
00813 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39
|
|
00814 PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT CL*39
|
|
00815 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT CL*39
|
|
00816 * GO TO P0000-EXIT CL*42
|
|
00817 END-IF. CL*39
|
|
00818 DTSBE321
|
|
00819 * IF L102-LATE-PEN-CHARGE-CHNG > +0 CL*39
|
|
00820 * PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39
|
|
00821 * PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT CL*39
|
|
00822 * PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT. CL*39
|
|
00823 DTSBE321
|
|
00824 * DISPLAY 'BE321 PENALTY ' MPRF-EMP-NO ' ' AMT-DISP1 CL*33
|
|
00825 * ' ' MPRF-PRIMARY-NAME. CL*33
|
|
00826 IF L102-LATE-PEN-CHARGE-CHNG > 0 CL*43
|
|
00827 * DISPLAY MPRF-EMP-NO ' ' MPRF-FEIN ' ' MPRF-PRIMARY-NAME CL*34
|
|
00828 * ' ' L102-TAX-CHARGED-AMT CL*34
|
|
00829 * ' ' WRK-TIMELY-PAYMENTS CL*34
|
|
00830 * ' ' L102-TAX-BALANCE-AMT CL*34
|
|
00831 * ' ' L102-LATE-PEN-CHARGED-AMT CL*34
|
|
00832 * ' *** PENALTY ASSESSED ' CL*34
|
|
00833 MOVE ' *** PENALTY ASSESSED' TO W-NOTE CL*34
|
|
00834 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*34
|
|
00835 ELSE CL*33
|
|
00836 * DISPLAY MPRF-EMP-NO ' ' MPRF-FEIN ' ' MPRF-PRIMARY-NAME CL*34
|
|
00837 * ' ' L102-TAX-CHARGED-AMT CL*34
|
|
00838 * ' ' WRK-TIMELY-PAYMENTS CL*34
|
|
00839 * ' ' L102-TAX-BALANCE-AMT CL*34
|
|
00840 * ' ' L102-LATE-PEN-CHARGED-AMT. CL*34
|
|
00841 * MOVE ' ' TO W-NOTE CL*42
|
|
00842 MOVE ' *** NO PENALTY ASSED' TO W-NOTE CL*42
|
|
00843 PERFORM P4000-WRITE-RPT THRU P4000-EXIT. CL*34
|
|
00844 * DISPLAY ' TIMLY-PYMT ' WRK-TIMELY-PAYMENTS. CL*31
|
|
00845 * DISPLAY ' TAX-BAL-AMT ' L102-TAX-BALANCE-AMT. CL*31
|
|
00846 * DISPLAY ' TAX-CHG-AMT ' L102-TAX-CHARGED-AMT. CL*31
|
|
00847 * DISPLAY ' LATE-PEN-MT ' L102-LATE-PEN-CHARGED-AMT. CL*31
|
|
00848 * DISPLAY ' TOL-AMT ' WRK-TOLERANCE-AMT. CL*31
|
|
00849 CL*39
|
|
00850 DISPLAY '*NO-PEN ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*39
|
|
00851 ' RCVD ' L102-OR-RECEIVED-DATE CL*39
|
|
00852 ' CHRG ' AMT-DISP2 CL*39
|
|
00853 ' PAID ' AMT-DISP1. CL*39
|
|
00854 DTSBE321
|
|
00855 P0000-EXIT. DTSBE321
|
|
00856 EXIT. DTSBE321
|
|
00857 DTSBE321
|
|
00858 P0900-LIABLE-MSOL. CL*53
|
|
00859 MOVE ZERO TO WRK-FIRST-YRQ CL*53
|
|
00860 WRK-MSOL-CNT. CL*53
|
|
00861 CL*53
|
|
00862 * SET WRK-MSOL-NO-REC TO TRUE CL*53
|
|
00863 * SET WRK-WITHDRAWN-NO TO TRUE CL*54
|
|
00864 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*53
|
|
00865 CL*53
|
|
00866 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. CL*53
|
|
00867 CL*53
|
|
00868 SET MSKL-SOL-88 TO TRUE. CL*53
|
|
00869 CL*53
|
|
00870 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*53
|
|
00871 PERFORM UNTIL L910-NO-REC-88 CL*53
|
|
00872 MOVE MSKL-REC TO MSOL-REC CL*53
|
|
00873 IF MSOL-INACT-ACTIVE-88 CL*53
|
|
00874 IF MSOL-FIRST-LIAB-YRQ > WRK-FIRST-YRQ CL*53
|
|
00875 MOVE MSOL-FIRST-LIAB-YRQ TO WRK-FIRST-YRQ CL*53
|
|
00876 END-IF CL*53
|
|
00877 END-IF CL*53
|
|
00878 PERFORM S910-READ-NEXT THRU S910-EXIT CL*53
|
|
00879 END-PERFORM. CL*53
|
|
00880 CL*53
|
|
00881 P0900-EXIT. CL*53
|
|
00882 EXIT. CL*53
|
|
00883 DTSBE321
|
|
00884 P1000-LIABLE-QTRS. DTSBE321
|
|
00885 MOVE +0 TO L102-TAX-CHARGED-AMT DTSBE321
|
|
00886 L102-TAX-BALANCE-AMT DTSBE321
|
|
00887 L102-LATE-PEN-CHARGED-AMT DTSBE321
|
|
00888 L102-LATE-PEN-CHARGE-CHNG CL*24
|
|
00889 L101-INT-CHARGE-CHNG CL*12
|
|
00890 L101-INT-WAIVE-CHNG CL*12
|
|
00891 L101-INT-PER-MONTH CL*12
|
|
00892 WRK-TOLERANCE-AMT DTSBE321
|
|
00893 WRK-TIMELY-PAYMENTS. DTSBE321
|
|
00894 DTSBE321
|
|
00895 SET WRK-ERROR-NO-88 TO TRUE. DTSBE321
|
|
00896 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE321
|
|
00897 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE321
|
|
00898 SET MQTR-QTR-88 TO TRUE. DTSBE321
|
|
00899 DTSBE321
|
|
00900 MOVE WRK-PARM-SUBJECT-YRQ TO WRK-YRQ. DTSBE321
|
|
00901 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321
|
|
00902 IF WRK-ERROR-YES-88 DTSBE321
|
|
00903 GO TO P1000-EXIT. DTSBE321
|
|
00904 DTSBE321
|
|
00905 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBE321
|
|
00906 MOVE 2 TO L004-QTR-5-Q. DTSBE321
|
|
00907 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321
|
|
00908 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBE321
|
|
00909 DTSBE321
|
|
00910 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321
|
|
00911 IF WRK-ERROR-YES-88 DTSBE321
|
|
00912 GO TO P1000-EXIT. DTSBE321
|
|
00913 DTSBE321
|
|
00914 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBE321
|
|
00915 MOVE 3 TO L004-QTR-5-Q. DTSBE321
|
|
00916 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321
|
|
00917 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBE321
|
|
00918 DTSBE321
|
|
00919 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321
|
|
00920 IF WRK-ERROR-YES-88 DTSBE321
|
|
00921 GO TO P1000-EXIT. DTSBE321
|
|
00922 DTSBE321
|
|
00923 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBE321
|
|
00924 MOVE 4 TO L004-QTR-5-Q. DTSBE321
|
|
00925 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321
|
|
00926 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBE321
|
|
00927 DTSBE321
|
|
00928 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321
|
|
00929 IF WRK-ERROR-YES-88 DTSBE321
|
|
00930 GO TO P1000-EXIT. DTSBE321
|
|
00931 DTSBE321
|
|
00932 DTSBE321
|
|
00933 P1000-EXIT. DTSBE321
|
|
00934 EXIT. DTSBE321
|
|
00935 P1100-CHK-MQTR. DTSBE321
|
|
00936 MOVE WRK-YRQ TO MQTR-YRQ. DTSBE321
|
|
00937 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE321
|
|
00938 PERFORM S910-READ THRU S910-EXIT. DTSBE321
|
|
00939 IF L910-NO-REC-88 DTSBE321
|
|
00940 PERFORM P1150-LIABLE-QTR THRU P1150-EXIT CL**3
|
|
00941 GO TO P1100-EXIT DTSBE321
|
|
00942 ELSE DTSBE321
|
|
00943 SET WRK-REPORT-FOUND-YES-88 TO TRUE DTSBE321
|
|
00944 MOVE MSKL-REC TO MQTR-REC. DTSBE321
|
|
00945 DTSBE321
|
|
00946 IF MQTR-CURR-RCVD-88 DTSBE321
|
|
00947 IF MQTR-ANNUAL-YES-88 DTSBE321
|
|
00948 MOVE MQTR-YRQ TO WRK-LAST-LIAB-YRQ DTSBE321
|
|
00949 ELSE DTSBE321
|
|
00950 DISPLAY 'MQTR RPT TYPE NOT ANNUAL: ' MQTR-EMP-NO CL**3
|
|
00951 ' ' MQTR-CURR-RPT-TYPE CL**3
|
|
00952 SET WRK-ERROR-YES-88 TO TRUE DTSBE321
|
|
00953 PERFORM P1110-ERR-RPT THRU P1110-EXIT DTSBE321
|
|
00954 GO TO P1100-EXIT DTSBE321
|
|
00955 END-IF DTSBE321
|
|
00956 ELSE DTSBE321
|
|
00957 DISPLAY 'MQTR RPT TYPE: ' MQTR-EMP-NO ' ' MQTR-CURR-RPT-TYPE CL**3
|
|
00958 SET WRK-REPORT-FOUND-NO-88 TO TRUE CL**3
|
|
00959 GO TO P1100-EXIT CL**3
|
|
00960 END-IF. DTSBE321
|
|
00961 DTSBE321
|
|
00962 PERFORM DTSBE321
|
|
00963 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE321
|
|
00964 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE321
|
|
00965 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE321
|
|
00966 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
00967 TO L102-LATE-PEN-CHARGED-AMT DTSBE321
|
|
00968 END-IF DTSBE321
|
|
00969 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE321
|
|
00970 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
00971 TO L102-TAX-CHARGED-AMT DTSBE321
|
|
00972 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
00973 * TO WRK-TAX-BALANCE-AMT DTSBE321
|
|
00974 END-IF DTSBE321
|
|
00975 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE321
|
|
00976 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE321
|
|
00977 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
00978 TO L102-TAX-CHARGED-AMT DTSBE321
|
|
00979 END-IF DTSBE321
|
|
00980 END-IF DTSBE321
|
|
00981 IF MQTR-TOLER-AMT (MQTR-ACCT-IDX) > 0 DTSBE321
|
|
00982 ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
00983 TO WRK-TOLERANCE-AMT DTSBE321
|
|
00984 END-IF DTSBE321
|
|
00985 DTSBE321
|
|
00986 END-PERFORM. DTSBE321
|
|
00987 PERFORM P1200-PAYMENTS THRU P1200-EXIT. DTSBE321
|
|
00988 COMPUTE L102-TAX-BALANCE-AMT = DTSBE321
|
|
00989 (L102-TAX-CHARGED-AMT - WRK-TIMELY-PAYMENTS). DTSBE321
|
|
00990 DTSBE321
|
|
00991 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBE321
|
|
00992 DTSBE321
|
|
00993 DTSBE321
|
|
00994 P1100-EXIT. DTSBE321
|
|
00995 EXIT. DTSBE321
|
|
00996 SKIP3 DTSBE321
|
|
00997 DTSBE321
|
|
00998 P1110-ERR-RPT. DTSBE321
|
|
00999 MOVE MSG1-ID TO R907-MSG-ID DTSBE321
|
|
01000 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBE321
|
|
01001 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE321
|
|
01002 EXIT. DTSBE321
|
|
01003 SKIP3 DTSBE321
|
|
01004 P1110-EXIT. DTSBE321
|
|
01005 EXIT. DTSBE321
|
|
01006 SKIP3 DTSBE321
|
|
01007 CL**3
|
|
01008 P1150-LIABLE-QTR. CL**3
|
|
01009 MOVE WRK-YRQ TO L516-YRQ. CL**3
|
|
01010 PERFORM S516-LIABILITY THRU S516-EXIT. CL**3
|
|
01011 IF L516-NOT-LIABLE-88 CL**4
|
|
01012 GO TO P1150-EXIT. CL**4
|
|
01013 CL**4
|
|
01014 ADD 1 TO WS-LIAB-QTR-RPT-MISSING. CL*29
|
|
01015 DISPLAY 'LIABLE QTR REPORT NOT FILED: ' MPRF-EMP-NO ' ' CL**4
|
|
01016 WRK-YRQ. CL**3
|
|
01017 IF WRK-YRQ = 20201 CL*62
|
|
01018 MOVE WRK-YRQ TO WRK-YRQ1-MISSING CL**6
|
|
01019 ELSE CL**4
|
|
01020 IF WRK-YRQ = 20202 CL*62
|
|
01021 MOVE WRK-YRQ TO WRK-YRQ2-MISSING CL**6
|
|
01022 ELSE CL**4
|
|
01023 IF WRK-YRQ = 20203 CL*62
|
|
01024 MOVE WRK-YRQ TO WRK-YRQ3-MISSING CL**6
|
|
01025 ELSE CL**4
|
|
01026 MOVE WRK-YRQ TO WRK-YRQ4-MISSING. CL**6
|
|
01027 P1150-EXIT. CL**3
|
|
01028 EXIT. CL**3
|
|
01029 SKIP3 CL**3
|
|
01030 CL**3
|
|
01031 P1200-PAYMENTS. DTSBE321
|
|
01032 ********************************************************** DTSBE321
|
|
01033 * INCLUDE ONLY PAYMENTS OF UI TAX IN TIMELY PAYMENT TOTAL. DTSBE321
|
|
01034 ********************************************************** DTSBE321
|
|
01035 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBE321
|
|
01036 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE321
|
|
01037 SET MDST-DST-88 TO TRUE. DTSBE321
|
|
01038 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE321
|
|
01039 DTSBE321
|
|
01040 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE321
|
|
01041 IF L910-OK-88 DTSBE321
|
|
01042 PERFORM P1210-SCAN-MDST THRU P1210-EXIT DTSBE321
|
|
01043 UNTIL L910-NO-REC-88. DTSBE321
|
|
01044 DTSBE321
|
|
01045 P1200-EXIT. DTSBE321
|
|
01046 EXIT. DTSBE321
|
|
01047 SKIP3 DTSBE321
|
|
01048 P1210-SCAN-MDST. DTSBE321
|
|
01049 MOVE MSKL-REC TO MDST-REC. DTSBE321
|
|
01050 DTSBE321
|
|
01051 IF (MDST-YRQ = MQTR-YRQ DTSBE321
|
|
01052 AND MDST-RECEIVED-DATE <= MQTR-TAX-DUE-DATE) DTSBE321
|
|
01053 PERFORM DTSBE321
|
|
01054 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBE321
|
|
01055 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBE321
|
|
01056 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBE321
|
|
01057 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE321
|
|
01058 TO WRK-TIMELY-PAYMENTS DTSBE321
|
|
01059 END-IF DTSBE321
|
|
01060 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBE321
|
|
01061 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE321
|
|
01062 TO WRK-TIMELY-PAYMENTS DTSBE321
|
|
01063 END-IF DTSBE321
|
|
01064 END-PERFORM DTSBE321
|
|
01065 END-IF. DTSBE321
|
|
01066 DTSBE321
|
|
01067 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE321
|
|
01068 DTSBE321
|
|
01069 DTSBE321
|
|
01070 DTSBE321
|
|
01071 P1210-EXIT. DTSBE321
|
|
01072 EXIT. DTSBE321
|
|
01073 SKIP3 DTSBE321
|
|
01074 DTSBE321
|
|
01075 P2000-INITIALIZE-L102. DTSBE321
|
|
01076 *& DTSBE321
|
|
01077 * DISPLAY 'BU322 P2000 LAST LIAB YRQ ' DTSBE321
|
|
01078 * WRK-LAST-LIAB-YRQ. DTSBE321
|
|
01079 *& DTSBE321
|
|
01080 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE321
|
|
01081 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE321
|
|
01082 SET MQTR-QTR-88 TO TRUE. DTSBE321
|
|
01083 MOVE WRK-LAST-LIAB-YRQ TO MQTR-YRQ. DTSBE321
|
|
01084 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE321
|
|
01085 PERFORM S910-READ THRU S910-EXIT. DTSBE321
|
|
01086 IF L910-NO-REC-88 DTSBE321
|
|
01087 MOVE 'CANNOT READ LAST LIABLE QUARTER ' DTSBE321
|
|
01088 TO ABEND-MSG DTSBE321
|
|
01089 PERFORM S999-ABEND THRU S999-EXIT DTSBE321
|
|
01090 ELSE DTSBE321
|
|
01091 MOVE MSKL-REC TO MQTR-REC. DTSBE321
|
|
01092 DTSBE321
|
|
01093 MOVE MPRF-EMP-CLASS TO L102-EMP-CLASS. DTSBE321
|
|
01094 DTSBE321
|
|
01095 MOVE +0 TO L102-TRAN-RECEIVED-DATE. DTSBE321
|
|
01096 DTSBE321
|
|
01097 MOVE +0 TO L102-LATE-PEN-CHARGE-CHNG. DTSBE321
|
|
01098 DTSBE321
|
|
01099 SET L102-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBE321
|
|
01100 DTSBE321
|
|
01101 MOVE WRK-LAST-LIAB-YRQ TO L102-LAST-PEN-ASSESSED-YRQ. DTSBE321
|
|
01102 DTSBE321
|
|
01103 MOVE +0 TO L102-OR-RECEIVED-DATE. DTSBE321
|
|
01104 DTSBE321
|
|
01105 MOVE LECM-CURR-RUN-DATE TO L102-CURR-RUN-DATE. DTSBE321
|
|
01106 DTSBE321
|
|
01107 IF MQTR-CURR-RCVD-88 DTSBE321
|
|
01108 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBE321
|
|
01109 MOVE MPRF-EMP-NO TO MRPT-EMP-NO DTSBE321
|
|
01110 SET MRPT-RPT-88 TO TRUE DTSBE321
|
|
01111 * MOVE WRK-LAST-LIAB-YRQ TO MRPT-YRQ DTSBE321
|
|
01112 MOVE MQTR-YRQ TO MRPT-YRQ DTSBE321
|
|
01113 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA DTSBE321
|
|
01114 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE321
|
|
01115 PERFORM P2100-MRPT-SCAN THRU P2100-EXIT DTSBE321
|
|
01116 UNTIL L910-NO-REC-88. DTSBE321
|
|
01117 DTSBE321
|
|
01118 MOVE WRK-LAST-LIAB-YRQ TO L102-MQTR-YRQ. DTSBE321
|
|
01119 DTSBE321
|
|
01120 MOVE MQTR-TAX-DUE-DATE TO L102-TAX-DUE-DATE DTSBE321
|
|
01121 R321-TAX-DUE-DATE. DTSBE321
|
|
01122 MOVE MQTR-RPT-DUE-DATE TO L102-RPT-DUE-DATE DTSBE321
|
|
01123 R321-RPT-DUE-DATE. DTSBE321
|
|
01124 DTSBE321
|
|
01125 * MOVE WRK-LATE-PEN-CHARGED-AMT DTSBE321
|
|
01126 * TO L102-LATE-PEN-CHARGED-AMT. DTSBE321
|
|
01127 * MOVE WRK-TAX-CHARGED-AMT DTSBE321
|
|
01128 * TO L102-TAX-CHARGED-AMT. DTSBE321
|
|
01129 * MOVE WRK-TAX-BALANCE-AMT DTSBE321
|
|
01130 * TO L102-TAX-BALANCE-AMT. DTSBE321
|
|
01131 * DTSBE321
|
|
01132 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBE321
|
|
01133 DTSBE321
|
|
01134 * MOVE ZERO TO L102-TIMELY-SI-PAY-AMT. DTSBE321
|
|
01135 DTSBE321
|
|
01136 *& DTSBE321
|
|
01137 DISPLAY 'BU322 ' MPRF-EMP-NO CL*44
|
|
01138 ' LAST LIAB YRQ ' WRK-LAST-LIAB-YRQ. CL*44
|
|
01139 DISPLAY ' PEN ' L102-LATE-PEN-CHARGED-AMT. CL*44
|
|
01140 DISPLAY ' TAX CHG ' L102-TAX-CHARGED-AMT. CL*44
|
|
01141 DISPLAY ' TAX BAL ' L102-TAX-BALANCE-AMT. CL*44
|
|
01142 DISPLAY ' INT BAL ' L101-INT-CHARGE-CHNG. CL*44
|
|
01143 *& DTSBE321
|
|
01144 P2000-EXIT. DTSBE321
|
|
01145 EXIT. DTSBE321
|
|
01146 SKIP3 DTSBE321
|
|
01147 DTSBE321
|
|
01148 P2100-MRPT-SCAN. DTSBE321
|
|
01149 MOVE MSKL-REC TO MRPT-REC. DTSBE321
|
|
01150 DTSBE321
|
|
01151 IF MRPT-YRQ NOT = MQTR-YRQ DTSBE321
|
|
01152 * IF MRPT-YRQ NOT = WRK-LAST-LIAB-YRQ DTSBE321
|
|
01153 SET L910-NO-REC-88 TO TRUE DTSBE321
|
|
01154 GO TO P2100-EXIT. DTSBE321
|
|
01155 DTSBE321
|
|
01156 IF MRPT-ORIG-88 DTSBE321
|
|
01157 **** IF MRPT-RECEIVED-DATE > L102-OR-RECEIVED-DATE DTSBE321
|
|
01158 MOVE MRPT-RECEIVED-DATE TO L102-OR-RECEIVED-DATE. DTSBE321
|
|
01159 DTSBE321
|
|
01160 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE321
|
|
01161 P2100-EXIT. DTSBE321
|
|
01162 EXIT. DTSBE321
|
|
01163 P2500-GEN-MISS-R321. DTSBE321
|
|
01164 MOVE MPRF-EMP-NO TO R321-EMP-NO. DTSBE321
|
|
01165 ** MOVE WRK-PARM-SUBJECT-YRQ TO WRK-SUBJECT-SLASH-QTR DTSBE321
|
|
01166 DISPLAY 'MQTR-YRQ ' MQTR-YRQ DTSBE321
|
|
01167 MOVE MQTR-YRQ TO R321-YRQ. DTSBE321
|
|
01168 DTSBE321
|
|
01169 MOVE LECM-CURR-RUN-DATE TO R321-MAIL-DATE. DTSBE321
|
|
01170 DTSBE321
|
|
01171 MOVE +0 TO R321-UI-TAX-CHARGED-AMT DTSBE321
|
|
01172 R321-PEN-CHARGED-AMT DTSBE321
|
|
01173 R321-UI-TAX-PAID-AMT DTSBE321
|
|
01174 R321-INT-COMP-DATE DTSBE321
|
|
01175 R321-UI-TOL-AMT DTSBE321
|
|
01176 R321-INT-CHARGED-AMT. DTSBE321
|
|
01177 DTSBE321
|
|
01178 IF GENERATE-MISS-RPT-YES-88 DTSBE321
|
|
01179 CL**3
|
|
01180 SET R321-GENERATE-MISS-RPT-LTR-88 TO TRUE DTSBE321
|
|
01181 MOVE ZERO TO R321-INT-COMP-DATE DTSBE321
|
|
01182 GO TO P2500-GENERATE-R321-CONTINUE DTSBE321
|
|
01183 END-IF. DTSBE321
|
|
01184 DTSBE321
|
|
01185 SET R321-GENERATE-LATE-PEN-LTR-88 TO TRUE. DTSBE321
|
|
01186 DTSBE321
|
|
01187 MOVE R321-MAIL-DATE TO L001-FED-8-DATE-9 DTSBE321
|
|
01188 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE321
|
|
01189 ADD +14 TO L001-JUL-ABS-DAY DTSBE321
|
|
01190 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE321
|
|
01191 MOVE L001-FED-8-DATE-9 TO R321-INT-COMP-DATE. DTSBE321
|
|
01192 MOVE L102-LATE-PEN-CHARGE-CHNG TO R321-PEN-CHARGED-AMT. DTSBE321
|
|
01193 MOVE L102-TAX-CHARGED-AMT TO R321-UI-TAX-CHARGED-AMT. DTSBE321
|
|
01194 MOVE WRK-TIMELY-PAYMENTS TO R321-UI-TAX-PAID-AMT. DTSBE321
|
|
01195 MOVE +0 TO L101-PAID-CHNG. DTSBE321
|
|
01196 MOVE R321-INT-COMP-DATE TO L101-RECEIVED-DATE DTSBE321
|
|
01197 MOVE WRK-TOLERANCE-AMT TO R321-UI-TOL-AMT. DTSBE321
|
|
01198 MOVE MQTR-RPT-DUE-DATE TO R321-RPT-DUE-DATE. DTSBE321
|
|
01199 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSBE321
|
|
01200 R321-TAX-DUE-DATE. DTSBE321
|
|
01201 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE321
|
|
01202 PERFORM P2510-MQTR-ACCT-LOOP THRU P2510-EXIT DTSBE321
|
|
01203 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE321
|
|
01204 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBE321
|
|
01205 DTSBE321
|
|
01206 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBE321
|
|
01207 DTSBE321
|
|
01208 ADD L101-INT-CHARGE-CHNG TO R321-INT-CHARGED-AMT. DTSBE321
|
|
01209 DTSBE321
|
|
01210 P2500-GENERATE-R321-CONTINUE. DTSBE321
|
|
01211 DTSBE321
|
|
01212 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE321
|
|
01213 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE321
|
|
01214 DTSBE321
|
|
01215 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE321
|
|
01216 DTSBE321
|
|
01217 IF L111-ADDR-FOUND-88 DTSBE321
|
|
01218 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE DTSBE321
|
|
01219 SET L112-ANCHOR-LAST-88 TO TRUE DTSBE321
|
|
01220 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBE321
|
|
01221 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE321
|
|
01222 PERFORM S112-FORMAT-ADDR THRU S112-EXIT DTSBE321
|
|
01223 ELSE DTSBE321
|
|
01224 MOVE ALL '?' TO L112-ADDRESS DTSBE321
|
|
01225 L112-MAILING-ADDRESS. DTSBE321
|
|
01226 MOVE L112-MAILING-ADDRESS TO R321-FMT-ADDR. DTSBE321
|
|
01227 DTSBE321
|
|
01228 MOVE L112-ZIP TO R321-ZIP. DTSBE321
|
|
01229 MOVE L112-ADVANCED-BARCODE TO R321-ADVANCED-BARCODE. DTSBE321
|
|
01230 DTSBE321
|
|
01231 PERFORM S946-WRITE-R321 THRU S946-EXIT. DTSBE321
|
|
01232 DTSBE321
|
|
01233 P2500-EXIT. DTSBE321
|
|
01234 EXIT. DTSBE321
|
|
01235 EJECT DTSBE321
|
|
01236 P2550-GEN-MISS-QTR-R321. CL**4
|
|
01237 MOVE MPRF-EMP-NO TO R321-EMP-NO. CL**4
|
|
01238 ** MOVE WRK-PARM-SUBJECT-YRQ TO WRK-SUBJECT-SLASH-QTR CL**4
|
|
01239 DISPLAY 'MQTR-YRQ ' MQTR-YRQ CL**4
|
|
01240 MOVE MQTR-YRQ TO R321-YRQ. CL**4
|
|
01241 CL**4
|
|
01242 MOVE MQTR-RPT-DUE-DATE TO R321-RPT-DUE-DATE. CL**7
|
|
01243 IF WRK-YRQ1-MISSING > 0 CL**7
|
|
01244 MOVE WRK-YRQ1-MISSING TO R321-YRQ1-MISSING CL**7
|
|
01245 ELSE CL**7
|
|
01246 MOVE ZEROS TO R321-YRQ1-MISSING. CL**8
|
|
01247 IF WRK-YRQ2-MISSING > 0 CL**7
|
|
01248 MOVE WRK-YRQ2-MISSING TO R321-YRQ2-MISSING CL**7
|
|
01249 ELSE CL**7
|
|
01250 MOVE ZEROS TO R321-YRQ2-MISSING. CL**8
|
|
01251 IF WRK-YRQ3-MISSING > 0 CL**7
|
|
01252 MOVE WRK-YRQ3-MISSING TO R321-YRQ3-MISSING CL**7
|
|
01253 ELSE CL**7
|
|
01254 MOVE ZEROS TO R321-YRQ3-MISSING. CL**8
|
|
01255 IF WRK-YRQ4-MISSING > 0 CL**7
|
|
01256 MOVE WRK-YRQ4-MISSING TO R321-YRQ4-MISSING CL**7
|
|
01257 ELSE CL**7
|
|
01258 MOVE ZEROS TO R321-YRQ4-MISSING. CL**8
|
|
01259 CL**7
|
|
01260 MOVE LECM-CURR-RUN-DATE TO R321-MAIL-DATE. CL**4
|
|
01261 CL**4
|
|
01262 MOVE +0 TO R321-UI-TAX-CHARGED-AMT CL**4
|
|
01263 R321-PEN-CHARGED-AMT CL**4
|
|
01264 R321-UI-TAX-PAID-AMT CL**4
|
|
01265 R321-INT-COMP-DATE CL**4
|
|
01266 R321-UI-TOL-AMT CL**4
|
|
01267 R321-INT-CHARGED-AMT. CL**4
|
|
01268 CL**4
|
|
01269 SET R321-GENERATE-MISS-QTR-LTR-88 TO TRUE CL**4
|
|
01270 MOVE ZERO TO R321-INT-COMP-DATE CL**4
|
|
01271 CL**4
|
|
01272 CL**4
|
|
01273 SET L111-LOOKUP-TAD-88 TO TRUE. CL**4
|
|
01274 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. CL**4
|
|
01275 CL**4
|
|
01276 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. CL**4
|
|
01277 CL**4
|
|
01278 IF L111-ADDR-FOUND-88 CL**4
|
|
01279 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE CL**4
|
|
01280 SET L112-ANCHOR-LAST-88 TO TRUE CL**4
|
|
01281 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME CL**4
|
|
01282 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA CL**4
|
|
01283 PERFORM S112-FORMAT-ADDR THRU S112-EXIT CL**4
|
|
01284 ELSE CL**4
|
|
01285 MOVE ALL '?' TO L112-ADDRESS CL**4
|
|
01286 L112-MAILING-ADDRESS. CL**4
|
|
01287 MOVE L112-MAILING-ADDRESS TO R321-FMT-ADDR. CL**4
|
|
01288 CL**4
|
|
01289 MOVE L112-ZIP TO R321-ZIP. CL**4
|
|
01290 MOVE L112-ADVANCED-BARCODE TO R321-ADVANCED-BARCODE. CL**4
|
|
01291 CL**4
|
|
01292 PERFORM S946-WRITE-R321 THRU S946-EXIT. CL**4
|
|
01293 CL**4
|
|
01294 P2550-EXIT. CL**6
|
|
01295 EXIT. CL**4
|
|
01296 P2510-MQTR-ACCT-LOOP. DTSBE321
|
|
01297 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE321
|
|
01298 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
01299 ** TO R321-UI-TAX-PAID-AMT DTSBE321
|
|
01300 TO WRK-TIMELY-PAYMENTS DTSBE321
|
|
01301 ELSE DTSBE321
|
|
01302 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE321
|
|
01303 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
01304 TO L101-PAID-CHNG DTSBE321
|
|
01305 ELSE DTSBE321
|
|
01306 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE321
|
|
01307 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE321
|
|
01308 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
01309 TO L101-PAID-CHNG DTSBE321
|
|
01310 END-IF DTSBE321
|
|
01311 ELSE DTSBE321
|
|
01312 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE321
|
|
01313 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
01314 TO L101-INT-CHARGE-CHNG DTSBE321
|
|
01315 DISPLAY 'L101-INT-CHARGE-CHNG' L101-INT-CHARGE-CHNG CL*48
|
|
01316 DISPLAY 'MPRF-EMP-NO ' MPRF-EMP-NO CL*46
|
|
01317 ELSE DTSBE321
|
|
01318 IF (MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)) DTSBE321
|
|
01319 OR DTSBE321
|
|
01320 (MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)) DTSBE321
|
|
01321 OR DTSBE321
|
|
01322 (MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)) DTSBE321
|
|
01323 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321
|
|
01324 TO L102-LATE-PEN-CHARGE-CHNG. DTSBE321
|
|
01325 P2510-EXIT. DTSBE321
|
|
01326 EXIT. DTSBE321
|
|
01327 EJECT DTSBE321
|
|
01328 P2600-GENERATE-ELOG. DTSBE321
|
|
01329 DTSBE321
|
|
01330 MOVE LOW-VALUES TO MEVL-REC. DTSBE321
|
|
01331 MOVE WRK-PARM-SUBJECT-YRQ TO EVL-SLASH-QTR DTSBE321
|
|
01332 MOVE SPACES TO EVL-ADDR-TYPE DTSBE321
|
|
01333 MOVE SPACES TO EVL-ADDR-ID-NO DTSBE321
|
|
01334 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE321
|
|
01335 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE321
|
|
01336 DTSBE321
|
|
01337 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE321
|
|
01338 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE321
|
|
01339 DTSBE321
|
|
01340 SET MEVL-EVL-88 TO TRUE. DTSBE321
|
|
01341 MOVE L005-DATE TO MEVL-DATE. DTSBE321
|
|
01342 DTSBE321
|
|
01343 MOVE L005-TIME TO MEVL-TIME. DTSBE321
|
|
01344 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE321
|
|
01345 DTSBE321
|
|
01346 IF R321-GENERATE-MISS-RPT-LTR-88 DTSBE321
|
|
01347 MOVE EVL-TEXT-MISS-LTR TO EVL-TEXT DTSBE321
|
|
01348 ELSE DTSBE321
|
|
01349 MOVE EVL-TEXT-PEN-LTR TO EVL-TEXT DTSBE321
|
|
01350 ADD +1 TO WRK-LATE-LTR-CNT DTSBE321
|
|
01351 END-IF. DTSBE321
|
|
01352 DTSBE321
|
|
01353 MOVE EVL-LOG-AREA TO MEVL-TEXT. DTSBE321
|
|
01354 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE321
|
|
01355 DTSBE321
|
|
01356 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE321
|
|
01357 DTSBE321
|
|
01358 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE321
|
|
01359 MEVL-CHNG-DATE. DTSBE321
|
|
01360 MOVE MEVL-REC TO MSKL-REC. DTSBE321
|
|
01361 PERFORM S910-WRITE THRU S910-EXIT. DTSBE321
|
|
01362 P2600-EXIT. DTSBE321
|
|
01363 EXIT. DTSBE321
|
|
01364 EJECT DTSBE321
|
|
01365 DTSBE321
|
|
01366 P2650-GEN-MISS-ELOG. CL**4
|
|
01367 CL**4
|
|
01368 MOVE LOW-VALUES TO MEVL-REC. CL**4
|
|
01369 MOVE WRK-PARM-SUBJECT-YRQ TO EVL-SLASH-QTR CL**4
|
|
01370 MOVE SPACES TO EVL-ADDR-TYPE CL**4
|
|
01371 MOVE SPACES TO EVL-ADDR-ID-NO CL**4
|
|
01372 ADD +1000 TO LECM-EMP-ABSTIME. CL**4
|
|
01373 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. CL**4
|
|
01374 CL**4
|
|
01375 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. CL**4
|
|
01376 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL**4
|
|
01377 CL**4
|
|
01378 SET MEVL-EVL-88 TO TRUE. CL**4
|
|
01379 MOVE L005-DATE TO MEVL-DATE. CL**4
|
|
01380 CL**4
|
|
01381 MOVE L005-TIME TO MEVL-TIME. CL**4
|
|
01382 MOVE ZEROS TO MEVL-PURGE-DATE. CL**4
|
|
01383 CL**4
|
|
01384 MOVE EVL-TEXT-MISS-QTR-LTR TO EVL-TEXT CL**6
|
|
01385 CL**4
|
|
01386 MOVE EVL-LOG-AREA TO MEVL-TEXT. CL**4
|
|
01387 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL**4
|
|
01388 CL**4
|
|
01389 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL**4
|
|
01390 CL**4
|
|
01391 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL**4
|
|
01392 MEVL-CHNG-DATE. CL**4
|
|
01393 MOVE MEVL-REC TO MSKL-REC. CL**4
|
|
01394 PERFORM S910-WRITE THRU S910-EXIT. CL**4
|
|
01395 P2650-EXIT. CL**4
|
|
01396 EXIT. CL**4
|
|
01397 EJECT CL**4
|
|
01398 CL**4
|
|
01399 P3000-GENERATE-T026. DTSBE321
|
|
01400 DTSBE321
|
|
01401 MOVE MPRF-EMP-NO TO T026-EMP-NO. DTSBE321
|
|
01402 DTSBE321
|
|
01403 SET T026-LATE-PEN-CHG TO TRUE. DTSBE321
|
|
01404 DTSBE321
|
|
01405 MOVE MPRF-PRIMARY-NAME TO T026-NAME-CHECK. DTSBE321
|
|
01406 CL*16
|
|
01407 IF GENERATE-MISS-RPT-YES-88 CL*18
|
|
01408 ADD +1 TO WRK-T026-MIS-CNT CL*20
|
|
01409 MOVE 100.00 TO T026-AMT DTSBE321
|
|
01410 W-PEN CL*35
|
|
01411 ELSE DTSBE321
|
|
01412 DISPLAY ' LATE PEN: ' MPRF-EMP-NO CL*37
|
|
01413 ADD +1 TO WRK-T026-PEN-CNT CL*20
|
|
01414 MOVE L102-LATE-PEN-CHARGE-CHNG TO T026-AMT CL*19
|
|
01415 W-PEN CL*35
|
|
01416 END-IF. CL*19
|
|
01417 CL*19
|
|
01418 MOVE +0 TO T026-RECEIVED-DATE. DTSBE321
|
|
01419 DTSBE321
|
|
01420 IF WRK-LAST-LIAB-YRQ = 0 DTSBE321
|
|
01421 MOVE WRK-PARM-SUBJECT-YRQ TO T026-APPLIC-YRQ DTSBE321
|
|
01422 ELSE DTSBE321
|
|
01423 MOVE WRK-LAST-LIAB-YRQ TO T026-APPLIC-YRQ. DTSBE321
|
|
01424 DTSBE321
|
|
01425 MOVE CACT-APPLIC-LATE-PEN TO T026-APPLIC-IND. DTSBE321
|
|
01426 DTSBE321
|
|
01427 MOVE +0 TO T026-APPLIC-BATCH-NO DTSBE321
|
|
01428 T026-APPLIC-ITEM-NO. DTSBE321
|
|
01429 DTSBE321
|
|
01430 MOVE +0 TO T026-DATE-1 DTSBE321
|
|
01431 T026-DATE-2. DTSBE321
|
|
01432 DTSBE321
|
|
01433 MOVE SPACE TO T026-INT-SPAN-IND. DTSBE321
|
|
01434 DTSBE321
|
|
01435 SET T026-NO-INT-RATE-88 TO TRUE. DTSBE321
|
|
01436 DTSBE321
|
|
01437 MOVE 'SYS' TO T026-RESPONSIBLE-ACTIVITY. DTSBE321
|
|
01438 DTSBE321
|
|
01439 MOVE SPACES TO T026-RESPONSIBLE-OP-ID. DTSBE321
|
|
01440 DTSBE321
|
|
01441 PERFORM S927-WRITE-T026 THRU S927-EXIT. DTSBE321
|
|
01442 DTSBE321
|
|
01443 CL*34
|
|
01444 P3000-EXIT. DTSBE321
|
|
01445 EXIT. DTSBE321
|
|
01446 P4000-WRITE-RPT. CL*34
|
|
01447 MOVE MPRF-EMP-NO TO W-EMP-NO. CL*34
|
|
01448 MOVE MPRF-FEIN TO W-FEIN-NO. CL*34
|
|
01449 MOVE MPRF-PRIMARY-NAME TO W-NAME. CL*34
|
|
01450 MOVE L102-TAX-BALANCE-AMT TO W-BAL. CL*34
|
|
01451 MOVE L102-LATE-PEN-CHARGE-CHNG TO W-PEN. CL*34
|
|
01452 MOVE L102-TAX-CHARGED-AMT TO W-CHG. CL*34
|
|
01453 MOVE WRK-TIMELY-PAYMENTS TO W-PAID. CL*34
|
|
01454 CL*34
|
|
01455 WRITE PENALTY-REC FROM W-PENALTY-REC. CL*34
|
|
01456 P4000-EXIT. CL*34
|
|
01457 EXIT. CL*34
|
|
01458 T0000-TERMINATE. DTSBE321
|
|
01459 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSBE321
|
|
01460 DTSBE321
|
|
01461 SET FAFD-AFD-88 TO TRUE. DTSBE321
|
|
01462 DTSBE321
|
|
01463 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9 DTSBE321
|
|
01464 MOVE L004-QTR-5-YR TO FAFD-YR. DTSBE321
|
|
01465 DTSBE321
|
|
01466 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSBE321
|
|
01467 DTSBE321
|
|
01468 PERFORM S931-READ THRU S931-EXIT. DTSBE321
|
|
01469 DTSBE321
|
|
01470 IF L931-NO-REC-88 DTSBE321
|
|
01471 MOVE LOW-VALUES TO FAFD-DATA-AREA DTSBE321
|
|
01472 MOVE LECM-CURR-RUN-DATE DTSBE321
|
|
01473 TO FAFD-LATE-PEN-ASSESSED-DATE DTSBE321
|
|
01474 MOVE +0 TO FAFD-UC30H-FIRST-DEL-DATE DTSBE321
|
|
01475 FAFD-UC30H-ESTIMATED-DATE DTSBE321
|
|
01476 FAFD-UC30H-FINAL-ACTION-DATE DTSBE321
|
|
01477 FAFD-UC30H-MASS-MAIL-DATE DTSBE321
|
|
01478 FAFD-UC30H-RPT-DUE-DATE DTSBE321
|
|
01479 MOVE LECM-CURR-RUN-DATE DTSBE321
|
|
01480 TO FAFD-ESTB-DATE DTSBE321
|
|
01481 FAFD-CHNG-DATE DTSBE321
|
|
01482 MOVE FAFD-REC TO FSKL-REC DTSBE321
|
|
01483 PERFORM S931-WRITE THRU S931-EXIT DTSBE321
|
|
01484 ELSE DTSBE321
|
|
01485 MOVE FSKL-REC TO FAFD-REC DTSBE321
|
|
01486 MOVE LECM-CURR-RUN-DATE DTSBE321
|
|
01487 TO FAFD-LATE-PEN-ASSESSED-DATE DTSBE321
|
|
01488 MOVE LECM-CURR-RUN-DATE DTSBE321
|
|
01489 TO FAFD-CHNG-DATE DTSBE321
|
|
01490 MOVE FAFD-REC TO FSKL-REC DTSBE321
|
|
01491 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE321
|
|
01492 DTSBE321
|
|
01493 DISPLAY '***** **** BE321 TERMINATION **********'. CL**6
|
|
01494 DISPLAY ' '. CL**3
|
|
01495 DISPLAY 'DOMESTIC ANNUAL MISSING REPORTS/LATE PENALTY RUN '. CL**3
|
|
01496 DISPLAY ' '. CL**3
|
|
01497 DISPLAY 'TOTAL DOMESTIC FILERS READ: ' WRK-DOMESTIC-CNT. CL**5
|
|
01498 DISPLAY ' ANNUAL FILERS READ: ' WRK-ANN-FILER-CNT. CL**5
|
|
01499 DISPLAY ' COMPLETE REPORTS FILED: ' WRK-REP-FND-CNT. CL**4
|
|
01500 DISPLAY ' LATE PENALTIES NOT PAID: ' WRK-T026-PEN-CNT. CL*20
|
|
01501 DISPLAY ' PARTIAL REPORTS FILED: ' WRK-PAR-FND-CNT. CL**4
|
|
01502 DISPLAY ' ACCOUNTS BYPASSED: ' WRK-BYPASS-CNT. CL**3
|
|
01503 DISPLAY ' COMPLETE REPORT MISSNG: ' WRK-MISS-LTR-CNT. CL**4
|
|
01504 DISPLAY ' LATE PENALTIES MISS RPT: ' WRK-T026-MIS-CNT. CL*20
|
|
01505 DISPLAY ' '. CL**3
|
|
01506 DISPLAY SPACE. DTSBE321
|
|
01507 CLOSE PENALTY-FILE EMP-RPT-FILE. CL**2
|
|
01508 CL**4
|
|
01509 DTSBE321
|
|
01510 T0000-EXIT. DTSBE321
|
|
01511 EXIT. DTSBE321
|
|
01512 EJECT DTSBE321
|
|
01513 S001-FROM-FED-8. DTSBE321
|
|
01514 SET L001-FROM-FED-8 TO TRUE. DTSBE321
|
|
01515 GO TO S001-DATE. DTSBE321
|
|
01516 DTSBE321
|
|
01517 S001-FROM-CAL-6. DTSBE321
|
|
01518 SET L001-FROM-CAL-6 TO TRUE. DTSBE321
|
|
01519 GO TO S001-DATE. DTSBE321
|
|
01520 DTSBE321
|
|
01521 S001-FROM-ABS-DAY. DTSBE321
|
|
01522 SET L001-FROM-ABS-DAY TO TRUE. DTSBE321
|
|
01523 GO TO S001-DATE. DTSBE321
|
|
01524 DTSBE321
|
|
01525 S001-DATE. DTSBE321
|
|
01526 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE321
|
|
01527 S001-EXIT. DTSBE321
|
|
01528 EXIT. DTSBE321
|
|
01529 SKIP3 DTSBE321
|
|
01530 S004-FROM-5. DTSBE321
|
|
01531 SET L004-FROM-5 TO TRUE. DTSBE321
|
|
01532 GO TO S004-QTR. DTSBE321
|
|
01533 DTSBE321
|
|
01534 S004-FROM-ABS. DTSBE321
|
|
01535 SET L004-FROM-ABS TO TRUE. DTSBE321
|
|
01536 GO TO S004-QTR. DTSBE321
|
|
01537 DTSBE321
|
|
01538 S004-FROM-3. DTSBE321
|
|
01539 SET L004-FROM-3 TO TRUE. DTSBE321
|
|
01540 GO TO S004-QTR. DTSBE321
|
|
01541 DTSBE321
|
|
01542 S004-QTR. DTSBE321
|
|
01543 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE321
|
|
01544 S004-EXIT. DTSBE321
|
|
01545 EXIT. DTSBE321
|
|
01546 SKIP3 DTSBE321
|
|
01547 S005-FROM-ABSTIME. DTSBE321
|
|
01548 SET L005-FROM-ABSTIME TO TRUE. DTSBE321
|
|
01549 GO TO S005-ABSTIME. DTSBE321
|
|
01550 DTSBE321
|
|
01551 S005-ABSTIME. DTSBE321
|
|
01552 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE321
|
|
01553 S005-EXIT. DTSBE321
|
|
01554 EXIT. DTSBE321
|
|
01555 S101-PER-MONTH-NO. DTSBE321
|
|
01556 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE321
|
|
01557 GO TO S101-INT-COMP. DTSBE321
|
|
01558 DTSBE321
|
|
01559 S101-INT-COMP. DTSBE321
|
|
01560 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE321
|
|
01561 S101-EXIT. DTSBE321
|
|
01562 EXIT. DTSBE321
|
|
01563 S102A-PEN-ASSESSMENT-RUN. DTSBE321
|
|
01564 SET L102-PEN-ASSESSMENT-RUN-88 TO TRUE. DTSBE321
|
|
01565 PERFORM S102Z-PEN-COMP THRU S102Z-EXIT. DTSBE321
|
|
01566 DTSBE321
|
|
01567 S102A-EXIT. DTSBE321
|
|
01568 EXIT. DTSBE321
|
|
01569 S102Z-PEN-COMP. DTSBE321
|
|
01570 CALL 'DTSBU102' USING L102-LINK-AREA. DTSBE321
|
|
01571 S102Z-EXIT. DTSBE321
|
|
01572 EXIT. DTSBE321
|
|
01573 SKIP3 DTSBE321
|
|
01574 S109-FIRST-PEN-INT-YRQ. DTSBE321
|
|
01575 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBE321
|
|
01576 GO TO S109-SUR-RATE. DTSBE321
|
|
01577 DTSBE321
|
|
01578 S109-SUR-RATE. DTSBE321
|
|
01579 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE321
|
|
01580 S109-EXIT. DTSBE321
|
|
01581 EXIT. DTSBE321
|
|
01582 DTSBE321
|
|
01583 S111-LOOKUP-ADDR. DTSBE321
|
|
01584 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE321
|
|
01585 DTSBE321
|
|
01586 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE321
|
|
01587 S111-EXIT. DTSBE321
|
|
01588 EXIT. DTSBE321
|
|
01589 SKIP3 DTSBE321
|
|
01590 S112-FORMAT-ADDR. DTSBE321
|
|
01591 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE321
|
|
01592 S112-EXIT. DTSBE321
|
|
01593 EXIT. DTSBE321
|
|
01594 SKIP3 DTSBE321
|
|
01595 S410-FILE-SCHED. DTSBE321
|
|
01596 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE321
|
|
01597 S410-EXIT. DTSBE321
|
|
01598 EXIT. DTSBE321
|
|
01599 SKIP3 DTSBE321
|
|
01600 S415-HOUSEHOLD-DATES. DTSBE321
|
|
01601 CALL 'DTSBU415' USING L415-LINK-AREA. DTSBE321
|
|
01602 S415-EXIT. DTSBE321
|
|
01603 EXIT. DTSBE321
|
|
01604 SKIP3 DTSBE321
|
|
01605 S511-MQTR-INIT. DTSBE321
|
|
01606 CALL 'DTSBU511' USING MQTR-REC. DTSBE321
|
|
01607 S511-EXIT. DTSBE321
|
|
01608 EXIT. DTSBE321
|
|
01609 SKIP3 DTSBE321
|
|
01610 S516-LIABILITY. CL**5
|
|
01611 CALL 'DTSBU516' USING L516-LINK-AREA CL**5
|
|
01612 MPRF-LINK-REC. CL**6
|
|
01613 CL**5
|
|
01614 S516-EXIT. CL**5
|
|
01615 EXIT. CL**5
|
|
01616 SKIP3 CL**5
|
|
01617 S910-READ. DTSBE321
|
|
01618 SET L910-READ-88 TO TRUE. DTSBE321
|
|
01619 GO TO S910-MSTR-IO. DTSBE321
|
|
01620 DTSBE321
|
|
01621 S910-START-BROWSE. DTSBE321
|
|
01622 SET L910-START-BROWSE-88 TO TRUE. DTSBE321
|
|
01623 GO TO S910-MSTR-IO. DTSBE321
|
|
01624 DTSBE321
|
|
01625 S910-READ-NEXT. DTSBE321
|
|
01626 SET L910-READ-NEXT-88 TO TRUE. DTSBE321
|
|
01627 GO TO S910-MSTR-IO. DTSBE321
|
|
01628 DTSBE321
|
|
01629 *S910-COUNT. DTSBE321
|
|
01630 *****SET L910-COUNT-88 TO TRUE. DTSBE321
|
|
01631 *****GO TO S910-MSTR-IO. DTSBE321
|
|
01632 DTSBE321
|
|
01633 S910-WRITE. DTSBE321
|
|
01634 SET L910-WRITE-88 TO TRUE. DTSBE321
|
|
01635 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE321
|
|
01636 GO TO S910-MSTR-IO. DTSBE321
|
|
01637 DTSBE321
|
|
01638 S910-REWRITE. DTSBE321
|
|
01639 SET L910-REWRITE-88 TO TRUE. DTSBE321
|
|
01640 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE321
|
|
01641 GO TO S910-MSTR-IO. DTSBE321
|
|
01642 DTSBE321
|
|
01643 *S910-DELETE. DTSBE321
|
|
01644 *****SET L910-DELETE-88 TO TRUE. DTSBE321
|
|
01645 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE321
|
|
01646 *****GO TO S910-MSTR-IO. DTSBE321
|
|
01647 DTSBE321
|
|
01648 S910-MSTR-IO. DTSBE321
|
|
01649 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE321
|
|
01650 MSKL-REC. DTSBE321
|
|
01651 S910-EXIT. DTSBE321
|
|
01652 EXIT. DTSBE321
|
|
01653 SKIP3 DTSBE321
|
|
01654 S923-OPEN-READ. DTSBE321
|
|
01655 SET L923-OPEN-READ-88 TO TRUE. DTSBE321
|
|
01656 GO TO S923-ATC-IO. DTSBE321
|
|
01657 DTSBE321
|
|
01658 S923-START-BROWSE. DTSBE321
|
|
01659 SET L923-START-BROWSE-88 TO TRUE. DTSBE321
|
|
01660 GO TO S923-ATC-IO. DTSBE321
|
|
01661 DTSBE321
|
|
01662 S923-READ-NEXT. DTSBE321
|
|
01663 SET L923-READ-NEXT-88 TO TRUE. DTSBE321
|
|
01664 GO TO S923-ATC-IO. DTSBE321
|
|
01665 S923-CLOSE. DTSBE321
|
|
01666 SET L923-CLOSE-88 TO TRUE. DTSBE321
|
|
01667 GO TO S923-ATC-IO. DTSBE321
|
|
01668 DTSBE321
|
|
01669 S923-ATC-IO. DTSBE321
|
|
01670 CALL 'DTSBU923' USING L923-LINK-AREA DTSBE321
|
|
01671 ASKL-REC. DTSBE321
|
|
01672 S923-EXIT. DTSBE321
|
|
01673 EXIT. DTSBE321
|
|
01674 S931-READ. DTSBE321
|
|
01675 SET L931-READ-88 TO TRUE. DTSBE321
|
|
01676 GO TO S931-REF-I. DTSBE321
|
|
01677 DTSBE321
|
|
01678 *S931-START-BROWSE. DTSBE321
|
|
01679 *****SET L931-START-BROWSE-88 TO TRUE. DTSBE321
|
|
01680 *****GO TO S931-REF-I. DTSBE321
|
|
01681 DTSBE321
|
|
01682 *S931-READ-NEXT. DTSBE321
|
|
01683 *****SET L931-READ-NEXT-88 TO TRUE. DTSBE321
|
|
01684 *****GO TO S931-REF-I. DTSBE321
|
|
01685 DTSBE321
|
|
01686 S931-WRITE. DTSBE321
|
|
01687 SET L931-WRITE-88 TO TRUE. DTSBE321
|
|
01688 GO TO S931-REF-I. DTSBE321
|
|
01689 DTSBE321
|
|
01690 S931-REWRITE. DTSBE321
|
|
01691 SET L931-REWRITE-88 TO TRUE. DTSBE321
|
|
01692 GO TO S931-REF-I. DTSBE321
|
|
01693 DTSBE321
|
|
01694 *S931-DELETE. DTSBE321
|
|
01695 *****SET L931-DELETE-88 TO TRUE. DTSBE321
|
|
01696 *****GO TO S931-REF-I. DTSBE321
|
|
01697 DTSBE321
|
|
01698 S931-REF-I. DTSBE321
|
|
01699 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE321
|
|
01700 FSKL-REC. DTSBE321
|
|
01701 S931-EXIT. DTSBE321
|
|
01702 EXIT. DTSBE321
|
|
01703 SKIP3 DTSBE321
|
|
01704 S946-WRITE-R907. DTSBE321
|
|
01705 DTSBE321
|
|
01706 CALL 'DTSBU946' USING R907-REC. DTSBE321
|
|
01707 GO TO S946-EXIT. DTSBE321
|
|
01708 S946-WRITE-R321. DTSBE321
|
|
01709 DTSBE321
|
|
01710 CALL 'DTSBU946' USING R321-REC. DTSBE321
|
|
01711 GO TO S946-EXIT. DTSBE321
|
|
01712 DTSBE321
|
|
01713 S946-EXIT. DTSBE321
|
|
01714 EXIT. DTSBE321
|
|
01715 SKIP3 DTSBE321
|
|
01716 S927-WRITE-T026. DTSBE321
|
|
01717 SET L927-WRITE-88 TO TRUE. DTSBE321
|
|
01718 CALL 'DTSBU927' USING L927-LINK-AREA DTSBE321
|
|
01719 T026-REC. DTSBE321
|
|
01720 GO TO S927-EXIT. DTSBE321
|
|
01721 DTSBE321
|
|
01722 S927-EXIT. DTSBE321
|
|
01723 EXIT. DTSBE321
|
|
01724 SKIP3 DTSBE321
|
|
01725 S999-ABEND. DTSBE321
|
|
01726 DISPLAY '*** DTSBE321 ABENDING. ' DTSBE321
|
|
01727 ABEND-MSG. DTSBE321
|
|
01728 DTSBE321
|
|
01729 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE321
|
|
01730 S999-EXIT. DTSBE321
|
|
01731 EXIT. DTSBE321
|