1083 lines
86 KiB
COBOL
1083 lines
86 KiB
COBOL
00001 IDENTIFICATION DIVISION. 01/03/13
|
|
00002 PROGRAM-ID. DTSBE352. DTSBE352
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV007
|
|
00004 DATE-WRITTEN. DEC 2001. DTSBE352
|
|
00005 DATE-COMPILED. DTSBE352
|
|
00006 SKIP3 DTSBE352
|
|
00007 ***** DTSBE352
|
|
00008 * DTSBE352
|
|
00009 * FUNCTION: ANNUAL EMPLOYER REPORT MASS MAILING EXTRACT. DTSBE352
|
|
00010 * (FOR HOUSEHOLD EMPLOYERS ONLY) DTSBE352
|
|
00011 * DTSBE352
|
|
00012 * MODIFICATION LOG: DTSBE352
|
|
00013 * DTSBE352
|
|
00014 * 12/11/01 INITIAL DEVELOPMENT COPIED FROM DTSBE351. DTSBE352
|
|
00015 * WORK ORDER: HOUSEHOLD PROGRAMMER: ZLDTSBE352
|
|
00016 * DTSBE352
|
|
00017 * 05/10/02 TEN SOCIAL SECURITY NUMBERS ADDED AND SORTED FOR DTSBE352
|
|
00018 * THE ANNUAL UC30H FORM OUTPUT. DTSBE352
|
|
00019 * WORK ORDER: HOUSEHOLD PROGRAMMER: RWDTSBE352
|
|
00020 * DTSBE352
|
|
00021 * 01/03/03 REMOVE FISCAL AGENT CHECKING - SEND FORMS TO ALL DTSBE352
|
|
00022 * EMPLOYERS DTSBE352
|
|
00023 * WORK ORDER: HOUSEHOLD PROGRAMMER: ZLDTSBE352
|
|
00024 * DTSBE352
|
|
00025 * MM/DD/YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE352
|
|
00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE352
|
|
00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXDTSBE352
|
|
00028 * DTSBE352
|
|
00029 * DTSBE352
|
|
00030 * DESCRIPTION: DTSBE352
|
|
00031 * DTSBE352
|
|
00032 * DTSBE352
|
|
00033 * INITIATION: DTSBE352
|
|
00034 * DTSBE352
|
|
00035 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE352
|
|
00036 * SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE352
|
|
00037 * DTSBE352
|
|
00038 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE352
|
|
00039 * DESCRIPTIONS AND LAYOUTS (902R1 AND 902R2). DTSBE352
|
|
00040 * DTSBE352
|
|
00041 * IF WRK-PARM-SUBJECT-YRQ IS GREATER THAN DTSBE352
|
|
00042 * FAFD-UC30H-MASS-MAIL-DATE THEN MOVE DTSBE352
|
|
00043 * WRK-PARM-SUBJECT-YRQ TO FAFD-UC30H-MASS-MAIL-DATE. DTSBE352
|
|
00044 * DTSBE352
|
|
00045 * READ FCYR RECORD (TO LOOKUP WRK-TAX-WAGE-BASE). DTSBE352
|
|
00046 * DTSBE352
|
|
00047 * DTSBE352
|
|
00048 * PROCESSING: DTSBE352
|
|
00049 * DTSBE352
|
|
00050 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS FOR DTSBE352
|
|
00051 * 902R1, 902R2, AND 908R1. DTSBE352
|
|
00052 * {719R1 DELED AS OF 03/07/02} DTSBE352
|
|
00053 * DTSBE352
|
|
00054 * TERMINATION: DTSBE352
|
|
00055 * DTSBE352
|
|
00056 * READ THE MHDR RECORD. IF WRK-PARM-SUBJECT-YRQ IS DTSBE352
|
|
00057 * GREATER THAN MHDR-LAST-UC30-MASS-MAIL-YRQ THEN MOVE DTSBE352
|
|
00058 * WRK-PARM-SUBJECT-YRQ TO MHDR-LAST-UC30-MASS-MAIL-YRQ DTSBE352
|
|
00059 * AND REWRITE THE MHDR-RECORD. DTSBE352
|
|
00060 * DTSBE352
|
|
00061 * READ FQTR RECORD FOR WRK-PARM-SUBJECT-YRQ. IF FOUND, DTSBE352
|
|
00062 * REWRITE; IF NOT FOUND, CREATE A FAFD RECORD AND WRITE. DTSBE352
|
|
00063 * MOVE LECM-CURR-RUN-DATE TO FAFD-UC30H-MASS-MAIL-DATE. DTSBE352
|
|
00064 * DTSBE352
|
|
00065 * DTSBE352
|
|
00066 * RECORDS READ: DTSBE352
|
|
00067 * DTSBE352
|
|
00068 * MASTER: DTSBE352
|
|
00069 * DTSBE352
|
|
00070 * MHDR DTSBE352
|
|
00071 * MQTR DTSBE352
|
|
00072 * MFAE DTSBE352
|
|
00073 * DTSBE352
|
|
00074 * ALTERNATE INDEX: DTSBE352
|
|
00075 * DTSBE352
|
|
00076 * NONE. DTSBE352
|
|
00077 * DTSBE352
|
|
00078 * DTSBE352
|
|
00079 * REFERENCE: DTSBE352
|
|
00080 * DTSBE352
|
|
00081 * FCYR DTSBE352
|
|
00082 * FAFD DTSBE352
|
|
00083 * DTSBE352
|
|
00084 * DTSBE352
|
|
00085 * RECORDS UPDATED: DTSBE352
|
|
00086 * DTSBE352
|
|
00087 * FAFD (WRITE, REWRITE) DTSBE352
|
|
00088 * DTSBE352
|
|
00089 * DTSBE352
|
|
00090 * REPORT RECORDS WRITTEN: DTSBE352
|
|
00091 * DTSBE352
|
|
00092 * R719 RQC CONTRIBUTION REPORT UNIVERSE. (DEL 03/07/02) DTSBE352
|
|
00093 * R910 EMPLOYER'S ANNUAL WAGE REPORT. DTSBE352
|
|
00094 * R907 UNUSUAL CONDITIONS ENCOUNTERED REPORT. DTSBE352
|
|
00095 * R908 UC-30H COUNTS LIST. DTSBE352
|
|
00096 * DTSBE352
|
|
00097 * DTSBE352
|
|
00098 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE352
|
|
00099 * DTSBE352
|
|
00100 * NONE. DTSBE352
|
|
00101 * DTSBE352
|
|
00102 * DTSBE352
|
|
00103 * MODULES CALLED: DTSBE352
|
|
00104 * DTSBE352
|
|
00105 * DTSBU001 DATE CONVERSION/EDIT. DTSBE352
|
|
00106 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE352
|
|
00107 * DTSBU111 ADDRESS LOOKUP. DTSBE352
|
|
00108 * DTSBU112 ADDRESS FORMAT. DTSBE352
|
|
00109 * DTSBU415 DETERMINE HOUSEHOLD DATES. DTSBE352
|
|
00110 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE DTSBE352
|
|
00111 * FOR A GIVEN QUARTER. DTSBE352
|
|
00112 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE352
|
|
00113 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE352
|
|
00114 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE352
|
|
00115 * DTSBE352
|
|
00116 * DTSBE352
|
|
00117 ***** DTSBE352
|
|
00118 SKIP3 DTSBE352
|
|
00119 ENVIRONMENT DIVISION. DTSBE352
|
|
00120 EJECT DTSBE352
|
|
00121 DATA DIVISION. DTSBE352
|
|
00122 SKIP3 DTSBE352
|
|
00123 WORKING-STORAGE SECTION. DTSBE352
|
|
001235 77 PAN-VALET PICTURE X(24) VALUE '007DTSBE352 01/03/13'. DTSBE352
|
|
00124 77 PAN-VALET PICTURE X(24) VALUE '002DTSBE352 01/03/13'. DTSBE352
|
|
00125 77 PAN-VALET PICTURE X(24) VALUE '005DTSBE352 01/20/04'. DTSBE352
|
|
00126 SKIP3 DTSBE352
|
|
00127 01 WRK-AREA. DTSBE352
|
|
00128 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +352. DTSBE352
|
|
00129 05 TOTAL-MPRFH-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00130 05 TOTAL-NLIAB-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00131 05 TOTAL-SCHED-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00132 05 TOTAL-NCURR-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00133 05 TOTAL-NRATE-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00134 05 TOTAL-MMASS-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00135 05 TOTAL-FFISA-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00136 05 TOTAL-HHOLD-UC30H PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00137 DTSBE352
|
|
00138 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE352'. DTSBE352
|
|
00139 DTSBE352
|
|
00140 05 ABEND-MSG PIC X(60). DTSBE352
|
|
00141 DTSBE352
|
|
00142 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBE352
|
|
00143 DTSBE352
|
|
00144 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE352
|
|
00145 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3. DTSBE352
|
|
00146 05 WRK-QTR1 PIC S9(05) COMP-3. DTSBE352
|
|
00147 05 WRK-QTR4 PIC S9(05) COMP-3. DTSBE352
|
|
00148 DTSBE352
|
|
00149 05 WRK-PARM-PRIOR-YRQ PIC S9(05) COMP-3. DTSBE352
|
|
00150 DTSBE352
|
|
00151 05 WRK-UC30H-MASS-MAIL-YRQ PIC S9(09) COMP-3. DTSBE352
|
|
00152 DTSBE352
|
|
00153 05 WRK-PARM-DISP-CREDIT-IND PIC X(01). DTSBE352
|
|
00154 88 WRK-PARM-DISP-CREDIT-YES-88 VALUE 'Y'. DTSBE352
|
|
00155 88 WRK-PARM-DISP-CREDIT-NO-88 VALUE 'N'. DTSBE352
|
|
00156 88 WRK-PARM-DISP-CREDIT-VALID-88 VALUE 'Y', 'N'. DTSBE352
|
|
00157 DTSBE352
|
|
00158 05 WRK-TAX-WAGE-BASE PIC S9(07)V9(02) COMP-3. DTSBE352
|
|
00159 DTSBE352
|
|
00160 05 WRK-MFAE-IND PIC X(01). DTSBE352
|
|
00161 88 WRK-MFAE-FOUND-88 VALUE 'Y'. DTSBE352
|
|
00162 88 WRK-MFAE-NOT-FOUND-88 VALUE 'N'. DTSBE352
|
|
00163 DTSBE352
|
|
00164 05 WRK-MQTR-IND PIC X(01). DTSBE352
|
|
00165 88 WRK-MQTR-FOUND-88 VALUE 'Y'. DTSBE352
|
|
00166 88 WRK-MQTR-NOT-FOUND-88 VALUE 'N'. DTSBE352
|
|
00167 DTSBE352
|
|
00168 05 WRK-LIAB-IND PIC X(01). DTSBE352
|
|
00169 88 WRK-LIAB-YES-88 VALUE 'Y'. DTSBE352
|
|
00170 88 WRK-LIAB-NO-88 VALUE 'N'. DTSBE352
|
|
00171 DTSBE352
|
|
00172 05 WRK-SSN-ERROR-IND PIC X(01). DTSBE352
|
|
00173 88 WRK-SSN-ERROR-YES-88 VALUE 'Y'. DTSBE352
|
|
00174 88 WRK-SSN-ERROR-NO-88 VALUE 'N'. DTSBE352
|
|
00175 DTSBE352
|
|
00176 05 TBL-SUB PIC S9(04) COMP. DTSBE352
|
|
00177 05 TBL-CNT PIC S9(04) COMP VALUE +0. DTSBE352
|
|
00178 05 TBL-MAX PIC S9(04) COMP DTSBE352
|
|
00179 VALUE +250. DTSBE352
|
|
00180 05 SSN-SUB PIC S9(04) COMP. DTSBE352
|
|
00181 05 NXT-SUB PIC S9(04) COMP. DTSBE352
|
|
00182 05 WRK-MAX-SSN PIC S9(09) COMP-3 VALUE +0. DTSBE352
|
|
00183 DTSBE352
|
|
00184 05 WRK-INDEX-IND PIC X(01). DTSBE352
|
|
00185 88 WRK-INDEX-NULL-88 VALUE '0'. DTSBE352
|
|
00186 88 WRK-INDEX-POSITION-FOUND-88 VALUE '1'. DTSBE352
|
|
00187 88 WRK-INDEX-SSN-FOUND-88 VALUE '2'. DTSBE352
|
|
00188 88 WRK-INDEX-FOUND-88 VALUE '1' '2'. DTSBE352
|
|
00189 DTSBE352
|
|
00190 01 WRK-SSN-TABLE. DTSBE352
|
|
00191 05 WRK-SSN OCCURS 250 TIMES PIC S9(09) COMP-3. DTSBE352
|
|
00192 EJECT DTSBE352
|
|
00193 01 MSG-AREA. DTSBE352
|
|
00194 05 MSG1-AREA. DTSBE352
|
|
00195 10 MSG1-ID PIC X(03) VALUE '393'. DTSBE352
|
|
00196 10 MSG1-TEXT. DTSBE352
|
|
00197 15 FILLER PIC X(40) DTSBE352
|
|
00198 VALUE 'RATE MISSING. NO ANNUAL REPORT PRINT'. DTSBE352
|
|
00199 15 FILLER PIC X(40) DTSBE352
|
|
00200 VALUE 'ED FROM UC-30H MASS MAILING RUN. YRQ = '. DTSBE352
|
|
00201 15 MSG1-SLASHED-YRQ PIC X(04). DTSBE352
|
|
00202 EJECT DTSBE352
|
|
00203 01 L001-LINK-AREA. DTSBE352
|
|
00204 ++INCLUDE DTSIL001 DTSBE352
|
|
00205 EJECT DTSBE352
|
|
00206 01 L004-LINK-AREA. DTSBE352
|
|
00207 ++INCLUDE DTSIL004 DTSBE352
|
|
00208 EJECT DTSBE352
|
|
00209 01 L111-LINK-AREA. DTSBE352
|
|
00210 ++INCLUDE DTSIL111 DTSBE352
|
|
00211 EJECT DTSBE352
|
|
00212 01 L112-LINK-AREA. DTSBE352
|
|
00213 ++INCLUDE DTSIL112 DTSBE352
|
|
00214 EJECT DTSBE352
|
|
00215 01 L415-LINK-AREA. DTSBE352
|
|
00216 ++INCLUDE DTSIL415 DTSBE352
|
|
00217 EJECT DTSBE352
|
|
00218 01 L516-LINK-AREA. DTSBE352
|
|
00219 ++INCLUDE DTSIL516 DTSBE352
|
|
00220 EJECT DTSBE352
|
|
00221 01 L910-LINK-AREA. DTSBE352
|
|
00222 ++INCLUDE DTSIL910 DTSBE352
|
|
00223 SKIP3 DTSBE352
|
|
00224 01 MSKL-REC. DTSBE352
|
|
00225 ++INCLUDE DTSIMSKL DTSBE352
|
|
00226 EJECT DTSBE352
|
|
00227 01 MHDR-REC. DTSBE352
|
|
00228 ++INCLUDE DTSIMHDR DTSBE352
|
|
00229 EJECT DTSBE352
|
|
00230 01 MELF-REC. DTSBE352
|
|
00231 ++INCLUDE DTSIMELF DTSBE352
|
|
00232 EJECT DTSBE352
|
|
00233 01 MQTR-REC. DTSBE352
|
|
00234 ++INCLUDE DTSIMQTR DTSBE352
|
|
00235 EJECT DTSBE352
|
|
00236 01 MSOL-REC. DTSBE352
|
|
00237 ++INCLUDE DTSIMSOL DTSBE352
|
|
00238 EJECT DTSBE352
|
|
00239 01 FAFD-REC. DTSBE352
|
|
00240 ++INCLUDE DTSIFAFD DTSBE352
|
|
00241 EJECT DTSBE352
|
|
00242 01 L931-LINK-AREA. DTSBE352
|
|
00243 ++INCLUDE DTSIL931 DTSBE352
|
|
00244 EJECT DTSBE352
|
|
00245 01 FSKL-REC. DTSBE352
|
|
00246 ++INCLUDE DTSIFSKL DTSBE352
|
|
00247 EJECT DTSBE352
|
|
00248 01 FCYR-REC. DTSBE352
|
|
00249 ++INCLUDE DTSIFCYR DTSBE352
|
|
00250 EJECT DTSBE352
|
|
00251 01 FQTR-REC. DTSBE352
|
|
00252 ++INCLUDE DTSIFQTR DTSBE352
|
|
00253 EJECT DTSBE352
|
|
00254 01 MFAE-REC. DTSBE352
|
|
00255 ++INCLUDE DTSIMFAE DTSBE352
|
|
00256 EJECT DTSBE352
|
|
00257 **** 01 R719-REC. /* HOUSEHOLD EMPLOYERS REPORTING DTSBE352
|
|
00258 **** ++INCLUDE DTSIR719 /* ANNUALLY ARE NOT TO INCLUDED DTSBE352
|
|
00259 **** SKIP3 /* IN THE TPS CONTRIB. RPT. POP. DTSBE352
|
|
00260 01 R910-REC. DTSBE352
|
|
00261 ++INCLUDE DTSIR910 DTSBE352
|
|
00262 SKIP3 DTSBE352
|
|
00263 01 R907-REC. DTSBE352
|
|
00264 ++INCLUDE DTSIR907 DTSBE352
|
|
00265 SKIP3 DTSBE352
|
|
00266 01 R908-REC. DTSBE352
|
|
00267 ++INCLUDE DTSIR908 DTSBE352
|
|
00268 EJECT DTSBE352
|
|
00269 *RW1 DTSBE352
|
|
00270 01 L981-LINK-AREA. DTSBE352
|
|
00271 ++INCLUDE DTSIL981 DTSBE352
|
|
00272 SKIP3 DTSBE352
|
|
00273 01 WWGH-REC. DTSBE352
|
|
00274 ++INCLUDE DTSIWWGH DTSBE352
|
|
00275 EJECT DTSBE352
|
|
00276 *RW2 DTSBE352
|
|
00277 LINKAGE SECTION. DTSBE352
|
|
00278 DTSBE352
|
|
00279 01 LECM-LINK-AREA. DTSBE352
|
|
00280 ++INCLUDE DTSILECM DTSBE352
|
|
00281 DTSBE352
|
|
00282 DTSBE352
|
|
00283 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE352
|
|
00284 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE352
|
|
00285 15 FILLER PIC X(01). DTSBE352
|
|
00286 15 LECM-PARM-DISP-CREDIT-IND PIC X(01). DTSBE352
|
|
00287 88 LECM-PARM-DISP-CREDIT-YES-88 VALUE 'Y'. DTSBE352
|
|
00288 88 LECM-PARM-DISP-CREDIT-NO-88 VALUE 'N'. DTSBE352
|
|
00289 15 FILLER PIC X(63). DTSBE352
|
|
00290 EJECT DTSBE352
|
|
00291 01 MPRF-LINK-REC. DTSBE352
|
|
00292 ++INCLUDE DTSIMPRF DTSBE352
|
|
00293 EJECT DTSBE352
|
|
00294 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE352
|
|
00295 MPRF-LINK-REC. DTSBE352
|
|
00296 DTSBE352
|
|
00297 DTSBE352
|
|
00298 IF LECM-PROCESS-88 DTSBE352
|
|
00299 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE352
|
|
00300 ELSE DTSBE352
|
|
00301 IF LECM-INITIALIZE-88 DTSBE352
|
|
00302 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE352
|
|
00303 ELSE DTSBE352
|
|
00304 IF LECM-TERMINATE-88 DTSBE352
|
|
00305 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE352
|
|
00306 ELSE DTSBE352
|
|
00307 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE352
|
|
00308 TO ABEND-MSG DTSBE352
|
|
00309 PERFORM S999-ABEND THRU S999-EXIT. DTSBE352
|
|
00310 DTSBE352
|
|
00311 DTSBE352
|
|
00312 GOBACK. DTSBE352
|
|
00313 EJECT DTSBE352
|
|
00314 I0000-INITIALIZE. DTSBE352
|
|
00315 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE352
|
|
00316 L931-TRACE-IND DTSBE352
|
|
00317 L516-TRACE-IND. DTSBE352
|
|
00318 DTSBE352
|
|
00319 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE352
|
|
00320 L931-MOD-NAME DTSBE352
|
|
00321 R907-MODULE-NAME. DTSBE352
|
|
00322 *RW1 DTSBE352
|
|
00323 MOVE WRK-MOD-NAME TO L981-MOD-NAME. DTSBE352
|
|
00324 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DTSBE352
|
|
00325 *RW2 DTSBE352
|
|
00326 *** MOVE LENGTH OF R719-REC TO R719-LENGTH. DTSBE352
|
|
00327 DTSBE352
|
|
00328 MOVE LENGTH OF R910-REC TO R910-LENGTH. DTSBE352
|
|
00329 DTSBE352
|
|
00330 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE352
|
|
00331 DTSBE352
|
|
00332 MOVE LENGTH OF R908-REC TO R908-LENGTH. DTSBE352
|
|
00333 DTSBE352
|
|
00334 SET L415-MODE-MOST-RECENT-88 TO TRUE. DTSBE352
|
|
00335 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT. DTSBE352
|
|
00336 MOVE L415-UC30H-MASS-MAIL-STRT-YRQ DTSBE352
|
|
00337 TO WRK-UC30H-MASS-MAIL-YRQ. DTSBE352
|
|
00338 DTSBE352
|
|
00339 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE352
|
|
00340 DTSBE352
|
|
00341 DTSBE352
|
|
00342 IF WRK-PARM-SUBJECT-YRQ > WRK-UC30H-MASS-MAIL-YRQ DTSBE352
|
|
00343 MOVE WRK-PARM-SUBJECT-YRQ DTSBE352
|
|
00344 TO WRK-UC30H-MASS-MAIL-YRQ. DTSBE352
|
|
00345 DTSBE352
|
|
00346 DTSBE352
|
|
00347 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBE352
|
|
00348 DTSBE352
|
|
00349 SET FCYR-CYR-88 TO TRUE. DTSBE352
|
|
00350 DTSBE352
|
|
00351 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE352
|
|
00352 DTSBE352
|
|
00353 MOVE L004-QTR-5-YR TO FCYR-YR. DTSBE352
|
|
00354 DTSBE352
|
|
00355 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBE352
|
|
00356 DTSBE352
|
|
00357 PERFORM S931-READ THRU S931-EXIT. DTSBE352
|
|
00358 DTSBE352
|
|
00359 IF L931-NO-REC-88 DTSBE352
|
|
00360 MOVE 'TAXABLE WAGE BASE NOT FOUND' DTSBE352
|
|
00361 TO ABEND-MSG DTSBE352
|
|
00362 PERFORM S999-ABEND THRU S999-EXIT. DTSBE352
|
|
00363 DTSBE352
|
|
00364 MOVE FSKL-REC TO FCYR-REC. DTSBE352
|
|
00365 DTSBE352
|
|
00366 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE. DTSBE352
|
|
00367 DTSBE352
|
|
00368 DTSBE352
|
|
00369 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE352
|
|
00370 DTSBE352
|
|
00371 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE352
|
|
00372 DTSBE352
|
|
00373 I0000-EXIT. DTSBE352
|
|
00374 EXIT. DTSBE352
|
|
00375 EJECT DTSBE352
|
|
00376 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE352
|
|
00377 PERFORM I1100-SUBJECT-YRQ THRU I1100-EXIT. DTSBE352
|
|
00378 PERFORM I1200-DISPLAY-CREDIT THRU I1200-EXIT. DTSBE352
|
|
00379 I1000-EXIT. DTSBE352
|
|
00380 EXIT. DTSBE352
|
|
00381 SKIP3 DTSBE352
|
|
00382 I1100-SUBJECT-YRQ. DTSBE352
|
|
00383 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE352
|
|
00384 PERFORM I1110-DEFAULT-YRQ THRU I1110-EXIT DTSBE352
|
|
00385 ELSE DTSBE352
|
|
00386 PERFORM I1120-EDIT-PARM-YRQ THRU I1120-EXIT. DTSBE352
|
|
00387 DTSBE352
|
|
00388 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE352
|
|
00389 MOVE 1 TO L004-QTR-5-Q. DTSBE352
|
|
00390 MOVE L004-QTR-5-9 TO WRK-QTR1. DTSBE352
|
|
00391 DTSBE352
|
|
00392 MOVE 4 TO L004-QTR-5-Q. DTSBE352
|
|
00393 MOVE L004-QTR-5-9 TO WRK-QTR4. DTSBE352
|
|
00394 DTSBE352
|
|
00395 SUBTRACT 1 FROM L004-QTR-5-YR. DTSBE352
|
|
00396 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE352
|
|
00397 MOVE L004-QTR-5-9 TO WRK-PARM-PRIOR-YRQ. DTSBE352
|
|
00398 DTSBE352
|
|
00399 DTSBE352
|
|
00400 I1100-EXIT. DTSBE352
|
|
00401 EXIT. DTSBE352
|
|
00402 DTSBE352
|
|
00403 I1110-DEFAULT-YRQ. DTSBE352
|
|
00404 IF WRK-UC30H-MASS-MAIL-YRQ = ZERO DTSBE352
|
|
00405 MOVE 'PARM-SUBJECT-YRQ REQUIRED ' DTSBE352
|
|
00406 TO ABEND-MSG DTSBE352
|
|
00407 PERFORM S999-ABEND THRU S999-EXIT DTSBE352
|
|
00408 ELSE DTSBE352
|
|
00409 MOVE WRK-UC30H-MASS-MAIL-YRQ TO L004-QTR-5-9 DTSBE352
|
|
00410 ADD 1 TO L004-QTR-5-YR DTSBE352
|
|
00411 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE352
|
|
00412 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ. DTSBE352
|
|
00413 DTSBE352
|
|
00414 I1110-EXIT. DTSBE352
|
|
00415 EXIT. DTSBE352
|
|
00416 DTSBE352
|
|
00417 I1120-EDIT-PARM-YRQ. DTSBE352
|
|
00418 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X. DTSBE352
|
|
00419 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBE352
|
|
00420 IF (L004-VALID-QTR) DTSBE352
|
|
00421 AND DTSBE352
|
|
00422 (L004-QTR-5-9 > LECM-PICKUP-YRQ) DTSBE352
|
|
00423 AND DTSBE352
|
|
00424 (L004-QTR-5-Q = 1) DTSBE352
|
|
00425 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE352
|
|
00426 ELSE DTSBE352
|
|
00427 MOVE 'PARM-SUBJECT-YRQ NOT VALID' DTSBE352
|
|
00428 TO ABEND-MSG DTSBE352
|
|
00429 PERFORM S999-ABEND THRU S999-EXIT. DTSBE352
|
|
00430 DTSBE352
|
|
00431 I1120-EXIT. DTSBE352
|
|
00432 EXIT. DTSBE352
|
|
00433 DTSBE352
|
|
00434 I1200-DISPLAY-CREDIT. DTSBE352
|
|
00435 MOVE LECM-PARM-DISP-CREDIT-IND TO DTSBE352
|
|
00436 WRK-PARM-DISP-CREDIT-IND. DTSBE352
|
|
00437 DTSBE352
|
|
00438 IF WRK-PARM-DISP-CREDIT-IND = SPACES DTSBE352
|
|
00439 SET WRK-PARM-DISP-CREDIT-NO-88 TO TRUE. DTSBE352
|
|
00440 DTSBE352
|
|
00441 IF WRK-PARM-DISP-CREDIT-VALID-88 DTSBE352
|
|
00442 NEXT SENTENCE DTSBE352
|
|
00443 ELSE DTSBE352
|
|
00444 MOVE 'PARM-DISP-CREDIT-IND NOT VALID' DTSBE352
|
|
00445 TO ABEND-MSG DTSBE352
|
|
00446 PERFORM S999-ABEND THRU S999-EXIT. DTSBE352
|
|
00447 DTSBE352
|
|
00448 I1200-EXIT. DTSBE352
|
|
00449 EXIT. DTSBE352
|
|
00450 EJECT DTSBE352
|
|
00451 *************************************************************** DTSBE352
|
|
00452 * THIS IS THE PROCESS PARAGRAPH WHICH SETS UP AND PRODUCES DTSBE352
|
|
00453 * THE REPORT EXTRACT RECORDS FOR THE ANNUAL REPORTS. DTSBE352
|
|
00454 * R719 - WRITTEN FOR RATED EMPLOYERS (NOT AS OF 03/07/02) DTSBE352
|
|
00455 * R910 - WRITTEN FOR HOUSEHOLD EMPLOYERS DTSBE352
|
|
00456 * R908 - WRITTEN FOR ALL EMPLOYERS DTSBE352
|
|
00457 * R907 - WRITTEN FOR EMPLOYERS WITH NO RATE (NO UC30H SENT DTSBE352
|
|
00458 * TO THESE EMPLOYERS) DTSBE352
|
|
00459 *************************************************************** DTSBE352
|
|
00460 DTSBE352
|
|
00461 P0000-PROCESS. DTSBE352
|
|
00462 IF MPRF-EMP-NO = 081022 DTSBE352
|
|
00463 DISPLAY ' BYPASSING BAD EMP ' MPRF-EMP-NO DTSBE352
|
|
00464 GO TO P0000-EXIT. DTSBE352
|
|
00465 DTSBE352
|
|
00466 DISPLAY ' PROCESSING EMP ' MPRF-EMP-NO. DTSBE352
|
|
00467 IF MPRF-CLASS-SUB-88 DTSBE352
|
|
00468 NEXT SENTENCE DTSBE352
|
|
00469 ELSE DTSBE352
|
|
00470 GO TO P0000-EXIT. DTSBE352
|
|
00471 DTSBE352
|
|
00472 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBE352
|
|
00473 NEXT SENTENCE DTSBE352
|
|
00474 ELSE DTSBE352
|
|
00475 GO TO P0000-EXIT. DTSBE352
|
|
00476 DTSBE352
|
|
00477 ADD 1 TO TOTAL-MPRFH-UC30H DTSBE352
|
|
00478 PERFORM P0100-LIABILITY THRU P0100-EXIT. DTSBE352
|
|
00479 IF WRK-LIAB-NO-88 DTSBE352
|
|
00480 ADD 1 TO TOTAL-NLIAB-UC30H DTSBE352
|
|
00481 GO TO P0000-EXIT. DTSBE352
|
|
00482 DTSBE352
|
|
00483 DTSBE352
|
|
00484 IF WRK-FIRST-LIAB-YRQ > WRK-PARM-SUBJECT-YRQ DTSBE352
|
|
00485 MOVE WRK-FIRST-LIAB-YRQ TO L516-YRQ DTSBE352
|
|
00486 ELSE DTSBE352
|
|
00487 MOVE WRK-PARM-SUBJECT-YRQ TO L516-YRQ DTSBE352
|
|
00488 END-IF. DTSBE352
|
|
00489 DTSBE352
|
|
00490 PERFORM S516-LIABILITY THRU S516-EXIT. DTSBE352
|
|
00491 DTSBE352
|
|
00492 IF L516-NOT-LIABLE-88 DTSBE352
|
|
00493 GO TO P0000-EXIT. DTSBE352
|
|
00494 DTSBE352
|
|
00495 IF L516-ANN-SCHED-88 DTSBE352
|
|
00496 NEXT SENTENCE DTSBE352
|
|
00497 ELSE DTSBE352
|
|
00498 ADD 1 TO TOTAL-SCHED-UC30H DTSBE352
|
|
00499 GO TO P0000-EXIT. DTSBE352
|
|
00500 DTSBE352
|
|
00501 DTSBE352
|
|
00502 *** MOVE MPRF-EMP-NO TO R719-EMP-NO DTSBE352
|
|
00503 *** MOVE LECM-CURR-RUN-DATE TO R719-RUN-DATE DTSBE352
|
|
00504 *** PERFORM S946-WRITE-R719 THRU S946-EXIT. DTSBE352
|
|
00505 DTSBE352
|
|
00506 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE352
|
|
00507 DTSBE352
|
|
00508 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE352
|
|
00509 DTSBE352
|
|
00510 SET MQTR-QTR-88 TO TRUE. DTSBE352
|
|
00511 DTSBE352
|
|
00512 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ. DTSBE352
|
|
00513 DTSBE352
|
|
00514 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE352
|
|
00515 DTSBE352
|
|
00516 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE352
|
|
00517 DTSBE352
|
|
00518 IF L910-NO-REC-88 DTSBE352
|
|
00519 SET WRK-MQTR-NOT-FOUND-88 TO TRUE DTSBE352
|
|
00520 ELSE DTSBE352
|
|
00521 MOVE MSKL-REC TO MQTR-REC DTSBE352
|
|
00522 IF MQTR-YRQ <= WRK-QTR4 DTSBE352
|
|
00523 SET WRK-MQTR-FOUND-88 TO TRUE DTSBE352
|
|
00524 IF MQTR-CURR-RCVD-88 DTSBE352
|
|
00525 ADD 1 TO TOTAL-NCURR-UC30H DTSBE352
|
|
00526 GO TO P0000-EXIT. DTSBE352
|
|
00527 DTSBE352
|
|
00528 IF L516-NO-RATE-88 DTSBE352
|
|
00529 ADD 1 TO TOTAL-NRATE-UC30H DTSBE352
|
|
00530 PERFORM P1000-WRITE-907 THRU P1000-EXIT DTSBE352
|
|
00531 GO TO P0000-EXIT. DTSBE352
|
|
00532 DTSBE352
|
|
00533 IF MPRF-UC30-MASS-MAIL-NO-88 DTSBE352
|
|
00534 ADD 1 TO TOTAL-MMASS-UC30H DTSBE352
|
|
00535 GO TO P0000-EXIT DTSBE352
|
|
00536 END-IF. DTSBE352
|
|
00537 DTSBE352
|
|
00538 PERFORM P1700-READ-MFAE THRU P1700-EXIT. DTSBE352
|
|
00539 DTSBE352
|
|
00540 IF WRK-MFAE-FOUND-88 DTSBE352
|
|
00541 DISPLAY 'FA EMP - ' MPRF-EMP-NO DTSBE352
|
|
00542 ADD 1 TO TOTAL-FFISA-UC30H DTSBE352
|
|
00543 * GO TO P0000-EXIT DTSBE352
|
|
00544 END-IF. DTSBE352
|
|
00545 DTSBE352
|
|
00546 ADD 1 TO TOTAL-HHOLD-UC30H DTSBE352
|
|
00547 PERFORM P2000-SETUP-BASIC-R910 THRU P2000-EXIT. DTSBE352
|
|
00548 DTSBE352
|
|
00549 PERFORM P3000-GET-SSNS THRU P3000-EXIT. DTSBE352
|
|
00550 DTSBE352
|
|
00551 PERFORM P4000-SETUP-R908 THRU P4000-EXIT. DTSBE352
|
|
00552 DTSBE352
|
|
00553 PERFORM P5000-TO-MTAD-ADDR THRU P5000-EXIT. DTSBE352
|
|
00554 DTSBE352
|
|
00555 IF TBL-CNT < +11 DTSBE352
|
|
00556 PERFORM P6000-PRINT-UC30H-WITH-SSN THRU P6000-EXIT DTSBE352
|
|
00557 ELSE DTSBE352
|
|
00558 PERFORM P7000-PRINT-UC30H-NO-SSN THRU P7000-EXIT. DTSBE352
|
|
00559 DTSBE352
|
|
00560 P0000-EXIT. DTSBE352
|
|
00561 EXIT. DTSBE352
|
|
00562 EJECT DTSBE352
|
|
00563 P0100-LIABILITY. DTSBE352
|
|
00564 SET WRK-LIAB-NO-88 TO TRUE. DTSBE352
|
|
00565 MOVE +0 TO WRK-FIRST-LIAB-YRQ. DTSBE352
|
|
00566 DTSBE352
|
|
00567 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE352
|
|
00568 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE352
|
|
00569 SET MSOL-SOL-88 TO TRUE. DTSBE352
|
|
00570 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE352
|
|
00571 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE352
|
|
00572 DTSBE352
|
|
00573 PERFORM DTSBE352
|
|
00574 UNTIL L910-NO-REC-88 DTSBE352
|
|
00575 MOVE MSKL-REC TO MSOL-REC DTSBE352
|
|
00576 IF MSOL-LAST-LIAB-YRQ >= WRK-QTR1 DTSBE352
|
|
00577 AND MSOL-FIRST-LIAB-YRQ <= WRK-QTR4 DTSBE352
|
|
00578 SET WRK-LIAB-YES-88 TO TRUE DTSBE352
|
|
00579 MOVE MSOL-FIRST-LIAB-YRQ TO WRK-FIRST-LIAB-YRQ DTSBE352
|
|
00580 SET L910-NO-REC-88 TO TRUE DTSBE352
|
|
00581 ELSE DTSBE352
|
|
00582 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE352
|
|
00583 END-IF DTSBE352
|
|
00584 END-PERFORM. DTSBE352
|
|
00585 DTSBE352
|
|
00586 P0100-EXIT. DTSBE352
|
|
00587 EXIT. DTSBE352
|
|
00588 DTSBE352
|
|
00589 P1000-WRITE-907. DTSBE352
|
|
00590 MOVE MSG1-ID TO R907-MSG-ID. DTSBE352
|
|
00591 DTSBE352
|
|
00592 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE352
|
|
00593 DTSBE352
|
|
00594 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE352
|
|
00595 DTSBE352
|
|
00596 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE352
|
|
00597 DTSBE352
|
|
00598 MOVE L004-SLASH-QTR TO MSG1-SLASHED-YRQ. DTSBE352
|
|
00599 DTSBE352
|
|
00600 MOVE MSG1-TEXT TO R907-MSG-TEXT. DTSBE352
|
|
00601 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE352
|
|
00602 P1000-EXIT. DTSBE352
|
|
00603 EXIT. DTSBE352
|
|
00604 EJECT DTSBE352
|
|
00605 P1700-READ-MFAE. DTSBE352
|
|
00606 DTSBE352
|
|
00607 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSBE352
|
|
00608 MOVE MPRF-EMP-NO TO MFAE-EMP-NO. DTSBE352
|
|
00609 SET MFAE-FAE-88 TO TRUE. DTSBE352
|
|
00610 SET MFAE-SERVICE-UC30-88 TO TRUE. DTSBE352
|
|
00611 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSBE352
|
|
00612 DTSBE352
|
|
00613 PERFORM S910-READ THRU S910-EXIT. DTSBE352
|
|
00614 DTSBE352
|
|
00615 IF L910-NO-REC-88 DTSBE352
|
|
00616 SET WRK-MFAE-NOT-FOUND-88 TO TRUE DTSBE352
|
|
00617 ELSE DTSBE352
|
|
00618 SET WRK-MFAE-FOUND-88 TO TRUE. DTSBE352
|
|
00619 DTSBE352
|
|
00620 P1700-EXIT. DTSBE352
|
|
00621 EXIT. DTSBE352
|
|
00622 EJECT. DTSBE352
|
|
00623 DTSBE352
|
|
00624 P2000-SETUP-BASIC-R910. DTSBE352
|
|
00625 *RW1 DTSBE352
|
|
00626 INITIALIZE R910-REC. DTSBE352
|
|
00627 MOVE LENGTH OF R910-REC TO R910-LENGTH. DTSBE352
|
|
00628 MOVE '910' TO R910-REC-TYPE. DTSBE352
|
|
00629 *RW2 DTSBE352
|
|
00630 SET R910-SORT-TYPE-ANN-88 TO TRUE. DTSBE352
|
|
00631 DTSBE352
|
|
00632 MOVE LOW-VALUES TO R910-VAR-SORT-AREA. DTSBE352
|
|
00633 *RW1 DTSBE352
|
|
00634 MOVE MPRF-EMP-NO TO R910-ANNUAL-EMP-NO DTSBE352
|
|
00635 WRK-EMP-NO. DTSBE352
|
|
00636 *RW2 DTSBE352
|
|
00637 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE352
|
|
00638 DTSBE352
|
|
00639 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE352
|
|
00640 DTSBE352
|
|
00641 MOVE L004-SLASH-5-YR TO R910-ANNUAL-YR. DTSBE352
|
|
00642 DTSBE352
|
|
00643 SET R910-ANNUAL-88 TO TRUE. DTSBE352
|
|
00644 DTSBE352
|
|
00645 MOVE MPRF-PRIMARY-NAME TO R910-PRI-NAME-FIRST4. DTSBE352
|
|
00646 DTSBE352
|
|
00647 MOVE WRK-TAX-WAGE-BASE TO R910-TAX-WAGE-BASE. DTSBE352
|
|
00648 DTSBE352
|
|
00649 MOVE L516-UI-RATE TO R910-UI-RATE. DTSBE352
|
|
00650 DTSBE352
|
|
00651 IF (WRK-MQTR-FOUND-88) DTSBE352
|
|
00652 AND DTSBE352
|
|
00653 (MQTR-RPT-DUE-DATE GREATER THAN ZERO) DTSBE352
|
|
00654 MOVE MQTR-RPT-DUE-DATE TO R910-RPT-DUE-DATE DTSBE352
|
|
00655 ELSE DTSBE352
|
|
00656 MOVE L516-DEFAULT-RPT-DUE-DATE DTSBE352
|
|
00657 TO R910-RPT-DUE-DATE. DTSBE352
|
|
00658 DTSBE352
|
|
00659 MOVE MPRF-FEIN TO R910-FEIN. DTSBE352
|
|
00660 DTSBE352
|
|
00661 MOVE +0 TO R910-ANN-CR-AMT. DTSBE352
|
|
00662 DTSBE352
|
|
00663 MOVE +0 TO R910-DAILY-WAIVER-START-YRQ DTSBE352
|
|
00664 R910-DAILY-WAIVER-END-YRQ DTSBE352
|
|
00665 R910-DAILY-WAIVER-DATE. DTSBE352
|
|
00666 DTSBE352
|
|
00667 MOVE 'N' TO R910-DAILY-SUPPLEMENTAL-IND. DTSBE352
|
|
00668 MOVE LOW-VALUES TO MELF-KEY-AREA. DTSBE352
|
|
00669 MOVE MPRF-EMP-NO TO MELF-EMP-NO. DTSBE352
|
|
00670 SET MELF-ELF-88 TO TRUE. DTSBE352
|
|
00671 MOVE MELF-KEY-AREA TO MSKL-KEY-AREA. DTSBE352
|
|
00672 PERFORM S910-READ THRU S910-EXIT. DTSBE352
|
|
00673 DTSBE352
|
|
00674 IF L910-NO-REC-88 DTSBE352
|
|
00675 SET R910-ELECTRNIC-WAGES-NO-88 TO TRUE DTSBE352
|
|
00676 ELSE DTSBE352
|
|
00677 MOVE MSKL-REC TO MELF-REC DTSBE352
|
|
00678 IF MELF-WAGES-YES-88 DTSBE352
|
|
00679 SET R910-ELECTRNIC-WAGES-YES-88 TO TRUE DTSBE352
|
|
00680 ELSE DTSBE352
|
|
00681 SET R910-ELECTRNIC-WAGES-NO-88 TO TRUE. DTSBE352
|
|
00682 P2000-EXIT. DTSBE352
|
|
00683 EXIT. DTSBE352
|
|
00684 EJECT. DTSBE352
|
|
00685 P3000-GET-SSNS. DTSBE352
|
|
00686 MOVE ZERO TO TBL-SUB DTSBE352
|
|
00687 TBL-CNT DTSBE352
|
|
00688 WRK-MAX-SSN. DTSBE352
|
|
00689 SET WRK-SSN-ERROR-NO-88 TO TRUE. DTSBE352
|
|
00690 DTSBE352
|
|
00691 MOVE LOW-VALUES TO WWGH-KEY-AREA. DTSBE352
|
|
00692 MOVE WRK-EMP-NO TO WWGH-EMP-NO. DTSBE352
|
|
00693 MOVE WRK-PARM-PRIOR-YRQ TO WWGH-YRQ. DTSBE352
|
|
00694 DTSBE352
|
|
00695 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DTSBE352
|
|
00696 IF L981-NO-REC-88 DTSBE352
|
|
00697 GO TO P3000-EXIT DTSBE352
|
|
00698 ELSE DTSBE352
|
|
00699 PERFORM P3100-SCAN-WAGES THRU P3100-EXIT DTSBE352
|
|
00700 UNTIL L981-NO-REC-88. DTSBE352
|
|
00701 DTSBE352
|
|
00702 P3000-EXIT. DTSBE352
|
|
00703 EXIT. DTSBE352
|
|
00704 DTSBE352
|
|
00705 P3100-SCAN-WAGES. DTSBE352
|
|
00706 IF WWGH-EMP-NO NOT = WRK-EMP-NO DTSBE352
|
|
00707 SET L981-NO-REC-88 TO TRUE DTSBE352
|
|
00708 GO TO P3100-EXIT DTSBE352
|
|
00709 ELSE DTSBE352
|
|
00710 IF WWGH-SSN < +1000000 DTSBE352
|
|
00711 NEXT SENTENCE DTSBE352
|
|
00712 END-IF DTSBE352
|
|
00713 PERFORM P3110-FIND-INDEX THRU P3110-EXIT DTSBE352
|
|
00714 IF WRK-SSN-ERROR-NO-88 DTSBE352
|
|
00715 IF WRK-INDEX-SSN-FOUND-88 DTSBE352
|
|
00716 NEXT SENTENCE DTSBE352
|
|
00717 ELSE DTSBE352
|
|
00718 MOVE WWGH-SSN TO WRK-SSN (TBL-SUB) DTSBE352
|
|
00719 ELSE DTSBE352
|
|
00720 GO TO P3100-EXIT. DTSBE352
|
|
00721 DTSBE352
|
|
00722 PERFORM S981E-READ-NEXT THRU S981E-EXIT. DTSBE352
|
|
00723 DTSBE352
|
|
00724 P3100-EXIT. DTSBE352
|
|
00725 EXIT. DTSBE352
|
|
00726 DTSBE352
|
|
00727 P3110-FIND-INDEX. DTSBE352
|
|
00728 SET WRK-INDEX-NULL-88 TO TRUE. DTSBE352
|
|
00729 DTSBE352
|
|
00730 IF WWGH-SSN > WRK-MAX-SSN DTSBE352
|
|
00731 IF TBL-CNT < TBL-MAX DTSBE352
|
|
00732 ADD +1 TO TBL-CNT DTSBE352
|
|
00733 MOVE TBL-CNT TO TBL-SUB DTSBE352
|
|
00734 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE DTSBE352
|
|
00735 MOVE WWGH-SSN TO WRK-MAX-SSN DTSBE352
|
|
00736 ELSE DTSBE352
|
|
00737 SET WRK-SSN-ERROR-YES-88 TO TRUE DTSBE352
|
|
00738 END-IF DTSBE352
|
|
00739 ELSE DTSBE352
|
|
00740 PERFORM P3111-SEARCH-TABLE THRU P3111-EXIT DTSBE352
|
|
00741 IF WRK-INDEX-POSITION-FOUND-88 DTSBE352
|
|
00742 IF TBL-CNT < TBL-MAX DTSBE352
|
|
00743 PERFORM P3112-INSERT-SSN THRU P3112-EXIT DTSBE352
|
|
00744 ELSE DTSBE352
|
|
00745 SET WRK-SSN-ERROR-YES-88 TO TRUE DTSBE352
|
|
00746 END-IF DTSBE352
|
|
00747 END-IF DTSBE352
|
|
00748 END-IF. DTSBE352
|
|
00749 P3110-EXIT. DTSBE352
|
|
00750 EXIT. DTSBE352
|
|
00751 DTSBE352
|
|
00752 P3111-SEARCH-TABLE. DTSBE352
|
|
00753 PERFORM DTSBE352
|
|
00754 VARYING SSN-SUB FROM +1 BY +1 DTSBE352
|
|
00755 UNTIL WRK-INDEX-FOUND-88 DTSBE352
|
|
00756 OR SSN-SUB > TBL-CNT DTSBE352
|
|
00757 IF WRK-SSN (SSN-SUB) = WWGH-SSN DTSBE352
|
|
00758 SET WRK-INDEX-SSN-FOUND-88 TO TRUE DTSBE352
|
|
00759 MOVE SSN-SUB TO TBL-SUB DTSBE352
|
|
00760 ELSE DTSBE352
|
|
00761 IF WWGH-SSN < WRK-SSN (SSN-SUB) DTSBE352
|
|
00762 MOVE SSN-SUB TO TBL-SUB DTSBE352
|
|
00763 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE DTSBE352
|
|
00764 END-IF DTSBE352
|
|
00765 END-IF DTSBE352
|
|
00766 END-PERFORM. DTSBE352
|
|
00767 DTSBE352
|
|
00768 P3111-EXIT. DTSBE352
|
|
00769 EXIT. DTSBE352
|
|
00770 DTSBE352
|
|
00771 P3112-INSERT-SSN. DTSBE352
|
|
00772 PERFORM DTSBE352
|
|
00773 VARYING SSN-SUB FROM TBL-CNT BY -1 DTSBE352
|
|
00774 UNTIL SSN-SUB < TBL-SUB DTSBE352
|
|
00775 COMPUTE NXT-SUB = SSN-SUB + 1 DTSBE352
|
|
00776 MOVE WRK-SSN (SSN-SUB) TO WRK-SSN (NXT-SUB) DTSBE352
|
|
00777 END-PERFORM. DTSBE352
|
|
00778 DTSBE352
|
|
00779 ADD +1 TO TBL-CNT. DTSBE352
|
|
00780 DTSBE352
|
|
00781 P3112-EXIT. DTSBE352
|
|
00782 EXIT. DTSBE352
|
|
00783 DTSBE352
|
|
00784 P4000-SETUP-R908. DTSBE352
|
|
00785 MOVE MPRF-EMP-NO TO R908-EMP-NO. DTSBE352
|
|
00786 DTSBE352
|
|
00787 MOVE WRK-PARM-SUBJECT-YRQ TO R908-YRQ. DTSBE352
|
|
00788 DTSBE352
|
|
00789 MOVE MPRF-EMP-CLASS TO R908-EMP-CLASS. DTSBE352
|
|
00790 P4000-EXIT. DTSBE352
|
|
00791 EXIT. DTSBE352
|
|
00792 EJECT DTSBE352
|
|
00793 ************************************************************** DTSBE352
|
|
00794 * THIS PARAGRAPH PROCESSES THE TAX MAILING ADDRESS AND WRITES DTSBE352
|
|
00795 * THE R910 AND R908 EXTRACT RECORDS. DTSBE352
|
|
00796 ************************************************************** DTSBE352
|
|
00797 DTSBE352
|
|
00798 P5000-TO-MTAD-ADDR. DTSBE352
|
|
00799 IF WRK-PARM-DISP-CREDIT-YES-88 DTSBE352
|
|
00800 IF (MPRF-UC30-CREDIT-YES-88) DTSBE352
|
|
00801 AND DTSBE352
|
|
00802 (MPRF-PURSUED-RPT-CNT EQUAL ZERO) DTSBE352
|
|
00803 AND DTSBE352
|
|
00804 (MPRF-TOT-CREDIT-AMT GREATER THAN ZERO) DTSBE352
|
|
00805 MOVE MPRF-TOT-CREDIT-AMT TO R910-ANN-CR-AMT DTSBE352
|
|
00806 ELSE DTSBE352
|
|
00807 MOVE ZERO TO R910-ANN-CR-AMT DTSBE352
|
|
00808 END-IF DTSBE352
|
|
00809 ELSE DTSBE352
|
|
00810 MOVE ZERO TO R910-ANN-CR-AMT DTSBE352
|
|
00811 END-IF. DTSBE352
|
|
00812 DTSBE352
|
|
00813 PERFORM P5100-LOOKUP-ADDR THRU P5100-EXIT. DTSBE352
|
|
00814 DTSBE352
|
|
00815 P5000-EXIT. DTSBE352
|
|
00816 EXIT. DTSBE352
|
|
00817 EJECT DTSBE352
|
|
00818 P5100-LOOKUP-ADDR. DTSBE352
|
|
00819 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE352
|
|
00820 DTSBE352
|
|
00821 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE352
|
|
00822 DTSBE352
|
|
00823 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE352
|
|
00824 DTSBE352
|
|
00825 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE352
|
|
00826 DTSBE352
|
|
00827 IF L111-ADDR-FOUND-88 DTSBE352
|
|
00828 SET L112-TAD-ADDR-88 TO TRUE DTSBE352
|
|
00829 PERFORM P5110-FORMAT-ADDR THRU P5110-EXIT DTSBE352
|
|
00830 ELSE DTSBE352
|
|
00831 MOVE ALL '?' TO R910-ANNUAL-ZIP-CODE DTSBE352
|
|
00832 R910-FMT-ADDR DTSBE352
|
|
00833 R910-ZIP DTSBE352
|
|
00834 R910-ADVANCED-BARCODE. DTSBE352
|
|
00835 P5100-EXIT. DTSBE352
|
|
00836 EXIT. DTSBE352
|
|
00837 SKIP3 DTSBE352
|
|
00838 P5110-FORMAT-ADDR. DTSBE352
|
|
00839 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBE352
|
|
00840 DTSBE352
|
|
00841 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE352
|
|
00842 DTSBE352
|
|
00843 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE352
|
|
00844 DTSBE352
|
|
00845 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE352
|
|
00846 DTSBE352
|
|
00847 MOVE L112-MAILING-ADDRESS TO R910-FMT-ADDR. DTSBE352
|
|
00848 DTSBE352
|
|
00849 MOVE L112-ZIP TO R910-ZIP DTSBE352
|
|
00850 R910-ANNUAL-ZIP-CODE. DTSBE352
|
|
00851 DTSBE352
|
|
00852 MOVE L112-ADVANCED-BARCODE TO R910-ADVANCED-BARCODE. DTSBE352
|
|
00853 P5110-EXIT. DTSBE352
|
|
00854 EXIT. DTSBE352
|
|
00855 DTSBE352
|
|
00856 P6000-PRINT-UC30H-WITH-SSN. DTSBE352
|
|
00857 PERFORM DTSBE352
|
|
00858 VARYING TBL-SUB FROM +1 BY +1 DTSBE352
|
|
00859 UNTIL TBL-SUB > TBL-CNT DTSBE352
|
|
00860 MOVE WRK-SSN (TBL-SUB) TO DTSBE352
|
|
00861 R910-SSN-LINE (TBL-SUB) DTSBE352
|
|
00862 END-PERFORM. DTSBE352
|
|
00863 DTSBE352
|
|
00864 MOVE TBL-CNT TO R910-SSN-LINE-CNT. DTSBE352
|
|
00865 PERFORM S946-WRITE-R910 THRU S946-EXIT. DTSBE352
|
|
00866 DTSBE352
|
|
00867 PERFORM S946-WRITE-R908 THRU S946-EXIT. DTSBE352
|
|
00868 DTSBE352
|
|
00869 P6000-EXIT. DTSBE352
|
|
00870 EXIT. DTSBE352
|
|
00871 DTSBE352
|
|
00872 P7000-PRINT-UC30H-NO-SSN. DTSBE352
|
|
00873 PERFORM DTSBE352
|
|
00874 VARYING TBL-SUB FROM +1 BY +1 DTSBE352
|
|
00875 UNTIL TBL-SUB > 10 DTSBE352
|
|
00876 MOVE ZEROS TO DTSBE352
|
|
00877 R910-SSN-LINE (TBL-SUB) DTSBE352
|
|
00878 END-PERFORM. DTSBE352
|
|
00879 DTSBE352
|
|
00880 MOVE ZEROS TO R910-SSN-LINE-CNT. DTSBE352
|
|
00881 PERFORM S946-WRITE-R910 THRU S946-EXIT. DTSBE352
|
|
00882 DTSBE352
|
|
00883 PERFORM S946-WRITE-R908 THRU S946-EXIT. DTSBE352
|
|
00884 DTSBE352
|
|
00885 P7000-EXIT. DTSBE352
|
|
00886 EXIT. DTSBE352
|
|
00887 DTSBE352
|
|
00888 ************************************************************** DTSBE352
|
|
00889 * THIS PARAGRAPH BROWSE THE SSN FROM THE VSAM WGH FILE DTSBE352
|
|
00890 * AND WRITE THEM TO THE R910 RECORDS. DTSBE352
|
|
00891 ************************************************************** DTSBE352
|
|
00892 DTSBE352
|
|
00893 T0000-TERMINATE. DTSBE352
|
|
00894 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSBE352
|
|
00895 DTSBE352
|
|
00896 SET FAFD-AFD-88 TO TRUE. DTSBE352
|
|
00897 DTSBE352
|
|
00898 MOVE WRK-PARM-SUBJECT-YRQ DTSBE352
|
|
00899 TO L004-QTR-5-9. DTSBE352
|
|
00900 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE352
|
|
00901 MOVE L004-QTR-5-YR TO FAFD-YR. DTSBE352
|
|
00902 DTSBE352
|
|
00903 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSBE352
|
|
00904 DTSBE352
|
|
00905 PERFORM S931-READ THRU S931-EXIT. DTSBE352
|
|
00906 DTSBE352
|
|
00907 IF L931-NO-REC-88 DTSBE352
|
|
00908 MOVE LOW-VALUES TO FAFD-DATA-AREA DTSBE352
|
|
00909 MOVE LECM-CURR-RUN-DATE DTSBE352
|
|
00910 TO FAFD-UC30H-MASS-MAIL-DATE DTSBE352
|
|
00911 MOVE +0 TO FAFD-LATE-PEN-ASSESSED-DATE DTSBE352
|
|
00912 FAFD-UC30H-FIRST-DEL-DATE DTSBE352
|
|
00913 FAFD-UC30H-FINAL-DEL-DATE DTSBE352
|
|
00914 FAFD-UC30H-FINAL-ACTION-DATE DTSBE352
|
|
00915 MOVE L004-ANN-DEFAULT-DUE-DATE TO DTSBE352
|
|
00916 FAFD-UC30H-RPT-DUE-DATE DTSBE352
|
|
00917 MOVE LECM-CURR-RUN-DATE DTSBE352
|
|
00918 TO FAFD-ESTB-DATE DTSBE352
|
|
00919 FAFD-CHNG-DATE DTSBE352
|
|
00920 MOVE FAFD-REC TO FSKL-REC DTSBE352
|
|
00921 PERFORM S931-WRITE THRU S931-EXIT DTSBE352
|
|
00922 ELSE DTSBE352
|
|
00923 MOVE FSKL-REC TO FAFD-REC DTSBE352
|
|
00924 MOVE LECM-CURR-RUN-DATE TO FAFD-UC30H-MASS-MAIL-DATE DTSBE352
|
|
00925 MOVE LECM-CURR-RUN-DATE TO FAFD-CHNG-DATE DTSBE352
|
|
00926 MOVE L004-ANN-DEFAULT-DUE-DATE TO DTSBE352
|
|
00927 FAFD-UC30H-RPT-DUE-DATE DTSBE352
|
|
00928 MOVE FAFD-REC TO FSKL-REC DTSBE352
|
|
00929 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE352
|
|
00930 DTSBE352
|
|
00931 PERFORM S981C-CLOSE THRU S981C-EXIT. DTSBE352
|
|
00932 DTSBE352
|
|
00933 DISPLAY ' TOTAL MPRF-DOMESTIC ' TOTAL-MPRFH-UC30H. DTSBE352
|
|
00934 DISPLAY ' NOT LIABLE ' TOTAL-NLIAB-UC30H. DTSBE352
|
|
00935 DISPLAY ' NOT ANN SCHED ' TOTAL-SCHED-UC30H. DTSBE352
|
|
00936 DISPLAY ' MQTR CURR REV ' TOTAL-NCURR-UC30H. DTSBE352
|
|
00937 DISPLAY ' NO RATE ' TOTAL-NRATE-UC30H. DTSBE352
|
|
00938 DISPLAY ' NO MASS MAIL ' TOTAL-MMASS-UC30H. DTSBE352
|
|
00939 DISPLAY ' FISCAL AGENT ' TOTAL-FFISA-UC30H. DTSBE352
|
|
00940 DISPLAY ' TOTAL UC30H WRITTEN ' TOTAL-HHOLD-UC30H. DTSBE352
|
|
00941 DTSBE352
|
|
00942 DTSBE352
|
|
00943 T0000-EXIT. DTSBE352
|
|
00944 EXIT. DTSBE352
|
|
00945 EJECT DTSBE352
|
|
00946 S004-FROM-5. DTSBE352
|
|
00947 SET L004-FROM-5 TO TRUE. DTSBE352
|
|
00948 GO TO S004-QTR. DTSBE352
|
|
00949 DTSBE352
|
|
00950 S004-FROM-ABS. DTSBE352
|
|
00951 SET L004-FROM-ABS TO TRUE. DTSBE352
|
|
00952 GO TO S004-QTR. DTSBE352
|
|
00953 DTSBE352
|
|
00954 S004-FROM-3. DTSBE352
|
|
00955 SET L004-FROM-3 TO TRUE. DTSBE352
|
|
00956 GO TO S004-QTR. DTSBE352
|
|
00957 DTSBE352
|
|
00958 S004-QTR. DTSBE352
|
|
00959 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE352
|
|
00960 S004-EXIT. DTSBE352
|
|
00961 EXIT. DTSBE352
|
|
00962 SKIP3 DTSBE352
|
|
00963 S111-LOOKUP-ADDR. DTSBE352
|
|
00964 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE352
|
|
00965 S111-EXIT. DTSBE352
|
|
00966 EXIT. DTSBE352
|
|
00967 SKIP3 DTSBE352
|
|
00968 S112-FORMAT-ADDR. DTSBE352
|
|
00969 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE352
|
|
00970 S112-EXIT. DTSBE352
|
|
00971 EXIT. DTSBE352
|
|
00972 SKIP3 DTSBE352
|
|
00973 S415-HOUSEHOLD-DATES. DTSBE352
|
|
00974 CALL 'DTSBU415' USING L415-LINK-AREA. DTSBE352
|
|
00975 S415-EXIT. DTSBE352
|
|
00976 EXIT. DTSBE352
|
|
00977 SKIP3 DTSBE352
|
|
00978 S516-LIABILITY. DTSBE352
|
|
00979 CALL 'DTSBU516' USING L516-LINK-AREA DTSBE352
|
|
00980 MPRF-LINK-REC. DTSBE352
|
|
00981 S516-EXIT. DTSBE352
|
|
00982 EXIT. DTSBE352
|
|
00983 SKIP3 DTSBE352
|
|
00984 S910-READ. DTSBE352
|
|
00985 SET L910-READ-88 TO TRUE. DTSBE352
|
|
00986 GO TO S910-MSTR-IO. DTSBE352
|
|
00987 DTSBE352
|
|
00988 S910-START-BROWSE. DTSBE352
|
|
00989 SET L910-START-BROWSE-88 TO TRUE. DTSBE352
|
|
00990 GO TO S910-MSTR-IO. DTSBE352
|
|
00991 DTSBE352
|
|
00992 S910-READ-NEXT. DTSBE352
|
|
00993 SET L910-READ-NEXT-88 TO TRUE. DTSBE352
|
|
00994 GO TO S910-MSTR-IO. DTSBE352
|
|
00995 DTSBE352
|
|
00996 S910-MSTR-IO. DTSBE352
|
|
00997 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE352
|
|
00998 MSKL-REC. DTSBE352
|
|
00999 S910-EXIT. DTSBE352
|
|
01000 EXIT. DTSBE352
|
|
01001 SKIP3 DTSBE352
|
|
01002 S931-READ. DTSBE352
|
|
01003 SET L931-READ-88 TO TRUE. DTSBE352
|
|
01004 GO TO S931-REF-I. DTSBE352
|
|
01005 DTSBE352
|
|
01006 S931-WRITE. DTSBE352
|
|
01007 SET L931-WRITE-88 TO TRUE. DTSBE352
|
|
01008 GO TO S931-REF-I. DTSBE352
|
|
01009 DTSBE352
|
|
01010 S931-REWRITE. DTSBE352
|
|
01011 SET L931-REWRITE-88 TO TRUE. DTSBE352
|
|
01012 GO TO S931-REF-I. DTSBE352
|
|
01013 DTSBE352
|
|
01014 S931-REF-I. DTSBE352
|
|
01015 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE352
|
|
01016 FSKL-REC. DTSBE352
|
|
01017 S931-EXIT. DTSBE352
|
|
01018 EXIT. DTSBE352
|
|
01019 SKIP3 DTSBE352
|
|
01020 *S946-WRITE-R719. DTSBE352
|
|
01021 ** CALL 'DTSBU946' USING R719-REC. DTSBE352
|
|
01022 ** GO TO S946-EXIT. DTSBE352
|
|
01023 DTSBE352
|
|
01024 S946-WRITE-R910. DTSBE352
|
|
01025 CALL 'DTSBU946' USING R910-REC. DTSBE352
|
|
01026 GO TO S946-EXIT. DTSBE352
|
|
01027 DTSBE352
|
|
01028 S946-WRITE-R907. DTSBE352
|
|
01029 CALL 'DTSBU946' USING R907-REC. DTSBE352
|
|
01030 GO TO S946-EXIT. DTSBE352
|
|
01031 DTSBE352
|
|
01032 S946-WRITE-R908. DTSBE352
|
|
01033 CALL 'DTSBU946' USING R908-REC. DTSBE352
|
|
01034 GO TO S946-EXIT. DTSBE352
|
|
01035 DTSBE352
|
|
01036 S946-EXIT. DTSBE352
|
|
01037 EXIT. DTSBE352
|
|
01038 SKIP3 DTSBE352
|
|
01039 *RW1 DTSBE352
|
|
01040 S981A-OPEN-READ. DTSBE352
|
|
01041 SET L981-OPEN-READ-88 TO TRUE. DTSBE352
|
|
01042 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE352
|
|
01043 DTSBE352
|
|
01044 S981A-EXIT. DTSBE352
|
|
01045 EXIT. DTSBE352
|
|
01046 DTSBE352
|
|
01047 S981C-CLOSE. DTSBE352
|
|
01048 SET L981-CLOSE-88 TO TRUE. DTSBE352
|
|
01049 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE352
|
|
01050 DTSBE352
|
|
01051 S981C-EXIT. DTSBE352
|
|
01052 EXIT. DTSBE352
|
|
01053 DTSBE352
|
|
01054 S981D-START-BROWSE. DTSBE352
|
|
01055 SET L981-START-BROWSE-88 TO TRUE. DTSBE352
|
|
01056 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE352
|
|
01057 DTSBE352
|
|
01058 S981D-EXIT. DTSBE352
|
|
01059 EXIT. DTSBE352
|
|
01060 DTSBE352
|
|
01061 S981E-READ-NEXT. DTSBE352
|
|
01062 SET L981-READ-NEXT-88 TO TRUE. DTSBE352
|
|
01063 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE352
|
|
01064 DTSBE352
|
|
01065 S981E-EXIT. DTSBE352
|
|
01066 EXIT. DTSBE352
|
|
01067 DTSBE352
|
|
01068 S981Z-WAGE-I. DTSBE352
|
|
01069 CALL 'DTSBU981' USING L981-LINK-AREA DTSBE352
|
|
01070 WWGH-REC. DTSBE352
|
|
01071 S981Z-EXIT. DTSBE352
|
|
01072 EXIT. DTSBE352
|
|
01073 *RW2 DTSBE352
|
|
01074 S999-ABEND. DTSBE352
|
|
01075 DISPLAY '*** DTSBE352 ABENDING. ' DTSBE352
|
|
01076 ABEND-MSG. DTSBE352
|
|
01077 DTSBE352
|
|
01078 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE352
|
|
01079 S999-EXIT. DTSBE352
|
|
01080 EXIT. DTSBE352
|
|
01081 DTSBE352
|