1148 lines
91 KiB
COBOL
1148 lines
91 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/03/09
|
|
00002 PROGRAM-ID. DTSBD590. DTSBD590
|
|
00003 AUTHOR. TRW/BDM. LV021
|
|
00004 DATE-WRITTEN. FEBRUARY 2000. DTSBD590
|
|
00005 DATE-COMPILED. DTSBD590
|
|
00006 SKIP3 DTSBD590
|
|
00007 ***** DTSBD590
|
|
00008 * DTSBD590
|
|
00009 * FUNCTION: PROCESS FISCAL AGENT UC30 CLIENTS DATA AND DTSBD590
|
|
00010 * MAINTAIN UC30 MFAE RECORDS. DTSBD590
|
|
00011 * DTSBD590
|
|
00012 * DTSBD590
|
|
00013 * MODIFICATION LOG: DTSBD590
|
|
00014 * DTSBD590
|
|
00015 * 08/14/2002 RECOMPILED FOR NEW VERSION OF MRTE RECORD. DTSBD590
|
|
00016 * THE PROGRAM WILL DISPLAY THE ACCOUNT NUMBERS DTSBD590
|
|
00017 * OF ANY EMPLOYERS WITH ESTIMATED RATES, AND DTSBD590
|
|
00018 * WILL DISPLAY A COUNT OF THE NUMBER OF DTSBD590
|
|
00019 * ESTIMATED RATES FOUND AT THE END OF THE RUN. DTSBD590
|
|
00020 * IF THERE ARE ANY ESTIMATED RATES, THE OUTPUT DTSBD590
|
|
00021 * OF THE JOB SHOULD BE DISCARDED AND THE RATES DTSBD590
|
|
00022 * CORRECTED BEFORE RERUNNING. DTSBD590
|
|
00023 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD590
|
|
00024 * DTSBD590
|
|
00025 * 12/31/2003 USING THE INPUT DATA SET YEAR QUARTER FROM JCL DTSBD590
|
|
00026 * TO SET THE PARM INPUT TO DETERMINE WHETHER THE DTSBD590
|
|
00027 * EMPLOYER IS LIABLE. IT ALSO DELETED THE FUIR DTSBD590
|
|
00028 * AND MRTE RECORDS FOR DETERMINING THR EMPLOYER'S DTSBD590
|
|
00029 * GB RATE. SINCE BU516 WILL FIND THE EMPLOYER'RATE DTSBD590
|
|
00030 * DIRECTLY. IT IS NOT NECESSARY TO READ THE FUIR DTSBD590
|
|
00031 * AND MRTE RECORDS SEPARATELY. DTSBD590
|
|
00032 * REFERENCE: HOUSEHOLD PROGRAMMER: RW1 DTSBD590
|
|
00033 * DTSBD590
|
|
00034 * 01/10/2006 ADDED .002 SURTAX TO COMPUTE WRK-UI-RATE DTSBD590
|
|
00035 * IN P3100-EDIT-MPRF PARAGRAPH DTSBD590
|
|
00036 * DTSBD590
|
|
00037 * FISCAL AGENT PRIME PAY (PP) IS PASSED THE REGULAR UI RATE ONLDTSBD590
|
|
00038 ** PER A REQUEST FROM THEIR REPRESENTATIVE ELISA LYONS DTSBD590
|
|
00039 ** ALL OTHERS ARE PASSED REGULAR RATE + .002 SURTAX DTSBD590
|
|
00040 ** PROGRAMMER: G. BROWN DTSBD590
|
|
00041 ***** DTSBD590
|
|
00042 * DTSBD590
|
|
00043 * FISCAL AGENT PAYCHEX (PC) IS PASSED THE REGULAR UI RATE ONLY DTSBD590
|
|
00044 ** PER A REQUEST FROM THEIR REPRESENTATIVE JENINE CAMELIO DTSBD590
|
|
00045 ** ALL OTHERS ARE PASSED REGULAR RATE + .002 SURTAX DTSBD590
|
|
00046 ** PROGRAMMER: G. BROWN DTSBD590
|
|
00047 ***** DTSBD590
|
|
00048 ***** DTSBD590
|
|
00049 SKIP3 DTSBD590
|
|
00050 ENVIRONMENT DIVISION. DTSBD590
|
|
00051 SKIP2 DTSBD590
|
|
00052 INPUT-OUTPUT SECTION. DTSBD590
|
|
00053 FILE-CONTROL. DTSBD590
|
|
00054 SELECT FISCAL-AGENT-IFILE DTSBD590
|
|
00055 ASSIGN TO FAIFILE DTSBD590
|
|
00056 FILE STATUS IS XFAQ-STATUS. DTSBD590
|
|
00057 DTSBD590
|
|
00058 DATA DIVISION. DTSBD590
|
|
00059 SKIP3 DTSBD590
|
|
00060 FILE SECTION. DTSBD590
|
|
00061 DTSBD590
|
|
00062 FD FISCAL-AGENT-IFILE DTSBD590
|
|
00063 LABEL RECORDS ARE STANDARD. DTSBD590
|
|
00064 01 FISCAL-AGENT-REC PIC X(080). DTSBD590
|
|
00065 EJECT DTSBD590
|
|
00066 WORKING-STORAGE SECTION. DTSBD590
|
|
000665 77 PAN-VALET PICTURE X(24) VALUE '021DTSBD590 12/03/09'. DTSBD590
|
|
00067 SKIP3 DTSBD590
|
|
00068 01 WRK-AREA. DTSBD590
|
|
00069 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +590.DTSBD590
|
|
00070 DTSBD590
|
|
00071 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD590'.DTSBD590
|
|
00072 DTSBD590
|
|
00073 05 WRK-ESTIM-RATE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00074 05 WRK-FA-ACCT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00075 05 WRK-FA-DUP-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00076 05 WRK-FA-FEIN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00077 05 WRK-FN-FEIN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00078 05 WRK-FA-READ-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00079 05 WRK-FA-WRITE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00080 05 WRK-FN-WRITE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00081 05 WRK-FE-WRITE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00082 05 WRK-MFAE-ADDED-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00083 05 WRK-MFAE-DUPL-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00084 05 WRK-MFAE-DELETED-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD590
|
|
00085 DTSBD590
|
|
00086 05 XFAQ-STATUS PIC X(02). DTSBD590
|
|
00087 88 XFAQ-STAT-OK-88 VALUE '00', '97'. DTSBD590
|
|
00088 88 XFAQ-STAT-EOF-88 VALUE '10'. DTSBD590
|
|
00089 DTSBD590
|
|
00090 05 WRK-ERROR-IND PIC X(01). DTSBD590
|
|
00091 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBD590
|
|
00092 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBD590
|
|
00093 DTSBD590
|
|
00094 05 WRK-EMP-NO PIC 9(06) VALUE 0. DTSBD590
|
|
00095 88 WRK-EMP-NO-INVALID-88 VALUE ZERO. DTSBD590
|
|
00096 DTSBD590
|
|
00097 05 WRK-FEIN-NO PIC 9(09) VALUE 0. DTSBD590
|
|
00098 88 WRK-FEIN-NO-INVALID-88 VALUE ZERO. DTSBD590
|
|
00099 DTSBD590
|
|
00100 05 WRK-MESSAGE PIC X(40) VALUE SPACES.DTSBD590
|
|
00101 05 WRK-FISC-AGNT-IND PIC X(01). DTSBD590
|
|
00102 88 WRK-FISC-AGNT-VALID-88 VALUE 'Y'. DTSBD590
|
|
00103 88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'. DTSBD590
|
|
00104 DTSBD590
|
|
00105 05 WRK-FAE-DUP-IND PIC X(01). DTSBD590
|
|
00106 88 WRK-FAE-YES-DUP-88 VALUE 'Y'. DTSBD590
|
|
00107 88 WRK-FAE-NO-DUP-88 VALUE 'N'. DTSBD590
|
|
00108 DTSBD590
|
|
00109 05 WRK-FA-DUP-REC-IND PIC X(01). DTSBD590
|
|
00110 88 WRK-FA-DUP-REC-YES-88 VALUE 'Y'. DTSBD590
|
|
00111 88 WRK-FA-DUP-REC-NO-88 VALUE 'N'. DTSBD590
|
|
00112 DTSBD590
|
|
00113 05 DEFAULT-RATE-QTR PIC 9(01) VALUE 1. DTSBD590
|
|
00114 DTSBD590
|
|
00115 05 WRK-YRQ PIC 9(05). DTSBD590
|
|
00116 05 FILLER REDEFINES WRK-YRQ. DTSBD590
|
|
00117 10 WRK-RATE-YYYY PIC 9(04). DTSBD590
|
|
00118 10 WRK-RATE-Q PIC 9(01). DTSBD590
|
|
00119 DTSBD590
|
|
00120 05 WRK-CURR-DATE PIC 9(08). DTSBD590
|
|
00121 05 FILLER REDEFINES WRK-CURR-DATE. DTSBD590
|
|
00122 10 WRK-CURR-YYYY PIC 9(04). DTSBD590
|
|
00123 10 FILLER PIC X(04). DTSBD590
|
|
00124 05 WRK-UI-RATE-IND PIC X(01). DTSBD590
|
|
00125 88 WRK-UI-RATE-OK-88 VALUE 'Y'. DTSBD590
|
|
00126 88 WRK-UI-RATE-NOT-OK-88 VALUE 'N'. DTSBD590
|
|
00127 05 WRK-UI-RATE PIC S9(03)V9(4) VALUE 0. DTSBD590
|
|
00128 DTSBD590
|
|
00129 05 CURR-XFAQ-KEY-AREA. DTSBD590
|
|
00130 10 CURR-FA-REC-TYPE PIC X(06) VALUE SPACE. DTSBD590
|
|
00131 10 CURR-FA-CD PIC X(03) VALUE SPACE. DTSBD590
|
|
00132 10 CURR-FA-EMP-NO PIC 9(06) VALUE 0. DTSBD590
|
|
00133 10 CURR-FA-FEIN-NO PIC 9(09) VALUE 0. DTSBD590
|
|
00134 DTSBD590
|
|
00135 05 WRK-XFAQ-KEY-AREA. DTSBD590
|
|
00136 10 WRK-FA-REC-TYPE PIC X(06) VALUE SPACE. DTSBD590
|
|
00137 10 WRK-FA-CD PIC X(03) VALUE SPACE. DTSBD590
|
|
00138 10 WRK-FA-EMP-NO PIC 9(06) VALUE 0. DTSBD590
|
|
00139 10 WRK-FA-FEIN-NO PIC 9(09) VALUE 0. DTSBD590
|
|
00140 DTSBD590
|
|
00141 05 WRK-MPRF-FEIN-NO PIC 9(09) VALUE 0. DTSBD590
|
|
00142 05 WRK-XFAQ-EMP-FEIN PIC 9(09) VALUE 0. DTSBD590
|
|
00143 DTSBD590
|
|
00144 05 WRK-IEIN-EMP-NO PIC 9(06) VALUE 0. DTSBD590
|
|
00145 05 WRK-LIAB-EMP-NO PIC 9(06) VALUE 0. DTSBD590
|
|
00146 DTSBD590
|
|
00147 05 WRK-LIAB-DATE PIC S9(09) VALUE 0. DTSBD590
|
|
00148 DTSBD590
|
|
00149 05 WRK-TRACE-IND PIC X(01) VALUE SPACES.DTSBD590
|
|
00150 05 WRK-FISCAL-AGENT-CD PIC X(03) VALUE SPACES.DTSBD590
|
|
00151 05 WRK-FISC-AGNT-NAME PIC X(35) VALUE SPACES.DTSBD590
|
|
00152 DTSBD590
|
|
00153 01 FISCAL-AGENT-INREC. DTSBD590
|
|
00154 ++INCLUDE DTSIXFAQ DTSBD590
|
|
00155 DTSBD590
|
|
00156 01 R590-REC. DTSBD590
|
|
00157 ++INCLUDE DTSIR590 DTSBD590
|
|
00158 DTSBD590
|
|
00159 01 L004-LINK-AREA. DTSBD590
|
|
00160 ++INCLUDE DTSIL004 DTSBD590
|
|
00161 EJECT DTSBD590
|
|
00162 01 L006-LINK-AREA. DTSBD590
|
|
00163 ++INCLUDE DTSIL006 DTSBD590
|
|
00164 EJECT DTSBD590
|
|
00165 01 L516-LINK-AREA. DTSBD590
|
|
00166 ++INCLUDE DTSIL516 DTSBD590
|
|
00167 EJECT DTSBD590
|
|
00168 01 L600-LINK-AREA. DTSBD590
|
|
00169 ++INCLUDE DTSIL600 DTSBD590
|
|
00170 EJECT DTSBD590
|
|
00171 01 L910-LINK-AREA. DTSBD590
|
|
00172 ++INCLUDE DTSIL910 DTSBD590
|
|
00173 EJECT DTSBD590
|
|
00174 01 MSKL-REC. DTSBD590
|
|
00175 ++INCLUDE DTSIMSKL DTSBD590
|
|
00176 EJECT DTSBD590
|
|
00177 01 MHDR-REC. DTSBD590
|
|
00178 ++INCLUDE DTSIMHDR DTSBD590
|
|
00179 EJECT DTSBD590
|
|
00180 01 MPRF-REC. DTSBD590
|
|
00181 ++INCLUDE DTSIMPRF DTSBD590
|
|
00182 EJECT DTSBD590
|
|
00183 01 MFAE-REC. DTSBD590
|
|
00184 ++INCLUDE DTSIMFAE DTSBD590
|
|
00185 EJECT DTSBD590
|
|
00186 01 MSOL-REC. DTSBD590
|
|
00187 ++INCLUDE DTSIMSOL DTSBD590
|
|
00188 EJECT DTSBD590
|
|
00189 *01 MRTE-REC. DTSBD590
|
|
00190 ***INCLUDE DTSIMRTE DTSBD590
|
|
00191 * EJECT DTSBD590
|
|
00192 01 L921-LINK-AREA. DTSBD590
|
|
00193 ++INCLUDE DTSIL921 DTSBD590
|
|
00194 EJECT DTSBD590
|
|
00195 01 ISKL-REC. DTSBD590
|
|
00196 ++INCLUDE DTSIISKL DTSBD590
|
|
00197 EJECT DTSBD590
|
|
00198 01 IEIN-REC. DTSBD590
|
|
00199 ++INCLUDE DTSIIEIN DTSBD590
|
|
00200 EJECT DTSBD590
|
|
00201 01 L931-LINK-AREA. DTSBD590
|
|
00202 ++INCLUDE DTSIL931 DTSBD590
|
|
00203 EJECT DTSBD590
|
|
00204 01 FSKL-REC. DTSBD590
|
|
00205 ++INCLUDE DTSIFSKL DTSBD590
|
|
00206 EJECT DTSBD590
|
|
00207 *01 FUIR-REC. DTSBD590
|
|
00208 ***INCLUDE DTSIFUIR DTSBD590
|
|
00209 * EJECT DTSBD590
|
|
00210 01 FISCAL-AGENT-TABLE-AREA. DTSBD590
|
|
00211 ++INCLUDE CHGIC001 DTSBD590
|
|
00212 EJECT DTSBD590
|
|
00213 LINKAGE SECTION. DTSBD590
|
|
00214 01 PARM-AREA. DTSBD590
|
|
00215 05 PARM-LENGTH PIC S9(04) COMP. DTSBD590
|
|
00216 05 PARM-RATE-YRQ PIC 9(05). DTSBD590
|
|
00217 05 PARM-RATE-YRQ-X DTSBD590
|
|
00218 REDEFINES PARM-RATE-YRQ PIC X(05). DTSBD590
|
|
00219 EJECT DTSBD590
|
|
00220 PROCEDURE DIVISION USING PARM-AREA. DTSBD590
|
|
00221 DTSBD590
|
|
00222 DTSBD590-MAIN. DTSBD590
|
|
00223 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD590
|
|
00224 IF WRK-ERROR-YES-88 DTSBD590
|
|
00225 GO TO DTSBD590-MAIN-EXIT. DTSBD590
|
|
00226 DTSBD590
|
|
00227 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD590
|
|
00228 UNTIL NOT XFAQ-STAT-OK-88. DTSBD590
|
|
00229 DTSBD590
|
|
00230 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD590
|
|
00231 DTSBD590
|
|
00232 DTSBD590-MAIN-EXIT. DTSBD590
|
|
00233 GOBACK. DTSBD590
|
|
00234 EJECT DTSBD590
|
|
00235 I0000-INITIATE. DTSBD590
|
|
00236 MOVE +0 TO WRK-FA-READ-CNT DTSBD590
|
|
00237 WRK-MFAE-DELETED-CNT DTSBD590
|
|
00238 WRK-MFAE-ADDED-CNT DTSBD590
|
|
00239 WRK-YRQ. DTSBD590
|
|
00240 DTSBD590
|
|
00241 SET WRK-ERROR-NO-88 TO TRUE. DTSBD590
|
|
00242 SET WRK-FA-DUP-REC-NO-88 TO TRUE. DTSBD590
|
|
00243 DTSBD590
|
|
00244 DTSBD590
|
|
00245 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD590
|
|
00246 DTSBD590
|
|
00247 PERFORM I2000-READ-MHDR THRU I2000-EXIT. DTSBD590
|
|
00248 DTSBD590
|
|
00249 PERFORM I3000-EDIT-PARM THRU I3000-EXIT. DTSBD590
|
|
00250 DTSBD590
|
|
00251 PERFORM I4000-DELETE-MFAE THRU I4000-EXIT. DTSBD590
|
|
00252 DTSBD590
|
|
00253 MOVE LENGTH OF R590-REC TO R590-LENGTH. DTSBD590
|
|
00254 MOVE '590' TO R590-REC-TYPE. DTSBD590
|
|
00255 DTSBD590
|
|
00256 DTSBD590
|
|
00257 SKIP2 DTSBD590
|
|
00258 I0000-EXIT. DTSBD590
|
|
00259 EXIT. DTSBD590
|
|
00260 I1000-OPEN-FILES. DTSBD590
|
|
00261 PERFORM S950-OPEN-FA-FILE THRU S950-EXIT. DTSBD590
|
|
00262 IF NOT XFAQ-STAT-OK-88 DTSBD590
|
|
00263 DISPLAY 'CANNOT OPEN FISCAL AGENT FILE ' XFAQ-STATUS DTSBD590
|
|
00264 SET WRK-ERROR-YES-88 TO TRUE DTSBD590
|
|
00265 GO TO I1000-EXIT. DTSBD590
|
|
00266 DTSBD590
|
|
00267 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBD590
|
|
00268 DTSBD590
|
|
00269 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD590
|
|
00270 DTSBD590
|
|
00271 * PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD590
|
|
00272 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD590
|
|
00273 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD590
|
|
00274 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. DTSBD590
|
|
00275 DTSBD590
|
|
00276 I1000-EXIT. DTSBD590
|
|
00277 EXIT. DTSBD590
|
|
00278 DTSBD590
|
|
00279 I2000-READ-MHDR. DTSBD590
|
|
00280 MOVE LOW-VALUE TO MHDR-KEY-AREA. DTSBD590
|
|
00281 DTSBD590
|
|
00282 MOVE +0 TO MHDR-EMP-NO. DTSBD590
|
|
00283 DTSBD590
|
|
00284 SET MHDR-HDR-88 TO TRUE. DTSBD590
|
|
00285 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD590
|
|
00286 PERFORM S910-READ THRU S910-EXIT. DTSBD590
|
|
00287 DTSBD590
|
|
00288 IF L910-NO-REC-88 DTSBD590
|
|
00289 DISPLAY ' NO HEADER REC FOUND' DTSBD590
|
|
00290 SET WRK-ERROR-YES-88 TO TRUE DTSBD590
|
|
00291 GO TO I2000-EXIT. DTSBD590
|
|
00292 DTSBD590
|
|
00293 MOVE MSKL-REC TO MHDR-REC. DTSBD590
|
|
00294 DTSBD590
|
|
00295 I2000-EXIT. DTSBD590
|
|
00296 EXIT. DTSBD590
|
|
00297 DTSBD590
|
|
00298 I3000-EDIT-PARM. DTSBD590
|
|
00299 DTSBD590
|
|
00300 DISPLAY 'DTSBD590 PARM LENGTH ' PARM-LENGTH. DTSBD590
|
|
00301 DISPLAY 'DTSBD590 PARM ' PARM-RATE-YRQ-X. DTSBD590
|
|
00302 DTSBD590
|
|
00303 IF PARM-RATE-YRQ-X = SPACES OR LOW-VALUES OR ZEROS DTSBD590
|
|
00304 PERFORM I3100-DEFAULT-RATE-YRQ THRU I3100-EXIT DTSBD590
|
|
00305 ELSE DTSBD590
|
|
00306 PERFORM I3200-PARM-RATE-YRQ THRU I3200-EXIT. DTSBD590
|
|
00307 DTSBD590
|
|
00308 I3000-EXIT. DTSBD590
|
|
00309 EXIT. DTSBD590
|
|
00310 DTSBD590
|
|
00311 I3100-DEFAULT-RATE-YRQ. DTSBD590
|
|
00312 DTSBD590
|
|
00313 MOVE MHDR-CMPL-QTR-BEGIN-DATE TO L004-DATE. DTSBD590
|
|
00314 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBD590
|
|
00315 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBD590
|
|
00316 DTSBD590
|
|
00317 DISPLAY 'DTSBD590 DEFAULT YEAR QTR ' WRK-YRQ. DTSBD590
|
|
00318 DTSBD590
|
|
00319 I3100-EXIT. DTSBD590
|
|
00320 EXIT. DTSBD590
|
|
00321 DTSBD590
|
|
00322 I3200-PARM-RATE-YRQ. DTSBD590
|
|
00323 MOVE PARM-RATE-YRQ TO L004-QTR-5-X. DTSBD590
|
|
00324 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD590
|
|
00325 IF L004-VALID-QTR DTSBD590
|
|
00326 IF L004-QTR-5-9 <= MHDR-LAST-RATE-END-YRQ DTSBD590
|
|
00327 NEXT SENTENCE DTSBD590
|
|
00328 ELSE DTSBD590
|
|
00329 DISPLAY '**** >>> DTSBD590 ABENDING <<< ****' DTSBD590
|
|
00330 DISPLAY 'PARM-YRQ > MOST RECENT RATE YEAR: ' DTSBD590
|
|
00331 PARM-RATE-YRQ-X DTSBD590
|
|
00332 PERFORM S999-ABEND THRU S999-EXIT DTSBD590
|
|
00333 END-IF DTSBD590
|
|
00334 ELSE DTSBD590
|
|
00335 DISPLAY '**** >>> DTSBD590 ABENDING <<< ****' DTSBD590
|
|
00336 DISPLAY 'PARM-YRQ IS INVALID: ' PARM-RATE-YRQ-X DTSBD590
|
|
00337 PERFORM S999-ABEND THRU S999-EXIT DTSBD590
|
|
00338 END-IF. DTSBD590
|
|
00339 DTSBD590
|
|
00340 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBD590
|
|
00341 DISPLAY 'DTSBD590 PARM INPUT YEAR QTR ' WRK-YRQ. DTSBD590
|
|
00342 DTSBD590
|
|
00343 I3200-EXIT. DTSBD590
|
|
00344 EXIT. DTSBD590
|
|
00345 DTSBD590
|
|
00346 *I3210-FIND-RATE-TABLE. DTSBD590
|
|
00347 * MOVE LOW-VALUE TO FUIR-KEY-AREA. DTSBD590
|
|
00348 * SET FUIR-UIR-88 TO TRUE. DTSBD590
|
|
00349 * MOVE L006-RTE-YR-START-YRQ TO FUIR-EFF-YRQ. DTSBD590
|
|
00350 * MOVE FUIR-REC TO FSKL-REC. DTSBD590
|
|
00351 * DTSBD590
|
|
00352 * PERFORM S931-READ THRU S931-EXIT. DTSBD590
|
|
00353 * IF L931-OK-88 DTSBD590
|
|
00354 * MOVE L006-RTE-YR-START-YRQ TO WRK-YRQ. DTSBD590
|
|
00355 * DTSBD590
|
|
00356 *I3210-EXIT. DTSBD590
|
|
00357 * EXIT. DTSBD590
|
|
00358 DTSBD590
|
|
00359 I4000-DELETE-MFAE. DTSBD590
|
|
00360 MOVE LOW-VALUE TO MSKL-REC. DTSBD590
|
|
00361 MOVE +0 TO MSKL-EMP-NO. DTSBD590
|
|
00362 SET MSKL-PRF-88 TO TRUE. DTSBD590
|
|
00363 DTSBD590
|
|
00364 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD590
|
|
00365 DTSBD590
|
|
00366 PERFORM I4100-MPRF-SCAN THRU I4100-EXIT DTSBD590
|
|
00367 UNTIL L910-NO-REC-88. DTSBD590
|
|
00368 DTSBD590
|
|
00369 I4000-EXIT. DTSBD590
|
|
00370 EXIT. DTSBD590
|
|
00371 DTSBD590
|
|
00372 I4100-MPRF-SCAN. DTSBD590
|
|
00373 MOVE MSKL-REC TO MPRF-REC. DTSBD590
|
|
00374 DTSBD590
|
|
00375 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD590
|
|
00376 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD590
|
|
00377 SET MSKL-FAE-88 TO TRUE. DTSBD590
|
|
00378 DTSBD590
|
|
00379 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD590
|
|
00380 PERFORM DTSBD590
|
|
00381 UNTIL L910-NO-REC-88 DTSBD590
|
|
00382 MOVE MSKL-REC TO MFAE-REC DTSBD590
|
|
00383 IF MFAE-SERVICE-UC30-88 DTSBD590
|
|
00384 PERFORM S910-DELETE THRU S910-EXIT DTSBD590
|
|
00385 ADD +1 TO WRK-MFAE-DELETED-CNT DTSBD590
|
|
00386 END-IF DTSBD590
|
|
00387 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD590
|
|
00388 END-PERFORM. DTSBD590
|
|
00389 MOVE MPRF-REC TO MSKL-REC. DTSBD590
|
|
00390 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD590
|
|
00391 DTSBD590
|
|
00392 I4100-EXIT. DTSBD590
|
|
00393 EXIT. DTSBD590
|
|
00394 DTSBD590
|
|
00395 P0000-PROCESS. DTSBD590
|
|
00396 SET WRK-EMP-NO-INVALID-88 TO TRUE. DTSBD590
|
|
00397 DTSBD590
|
|
00398 PERFORM S951-READ-FA-FILE THRU S951-EXIT. DTSBD590
|
|
00399 DTSBD590
|
|
00400 IF NOT XFAQ-STAT-OK-88 DTSBD590
|
|
00401 GO TO P0000-PROCESS-CONTINUE. DTSBD590
|
|
00402 DTSBD590
|
|
00403 ADD +1 TO WRK-FA-READ-CNT. DTSBD590
|
|
00404 DTSBD590
|
|
00405 IF WRK-FA-READ-CNT = 1 DTSBD590
|
|
00406 MOVE XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA DTSBD590
|
|
00407 GO TO P0000-EXIT. DTSBD590
|
|
00408 DTSBD590
|
|
00409 MOVE XFAQ-KEY-AREA TO CURR-XFAQ-KEY-AREA. DTSBD590
|
|
00410 DTSBD590
|
|
00411 IF XFAQ-EMP-FEIN = WRK-FA-FEIN-NO AND XFAQ-EMP-FEIN > ZEROS DTSBD590
|
|
00412 IF XFAQ-FISCAL-AGENT-CD NOT = WRK-FA-CD DTSBD590
|
|
00413 * MOVE WRK-XFAQ-KEY-AREA TO XFAQ-KEY-AREA DTSBD590
|
|
00414 MOVE 'DUPLICATE FEIN WITH OTHER FISCAL AGENT' TO DTSBD590
|
|
00415 WRK-MESSAGE DTSBD590
|
|
00416 PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT DTSBD590
|
|
00417 MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA DTSBD590
|
|
00418 ADD 1 TO WRK-FA-DUP-CNT DTSBD590
|
|
00419 SET WRK-FA-DUP-REC-YES-88 TO TRUE DTSBD590
|
|
00420 GO TO P0000-EXIT DTSBD590
|
|
00421 END-IF DTSBD590
|
|
00422 END-IF. DTSBD590
|
|
00423 DTSBD590
|
|
00424 IF XFAQ-EMP-NO = WRK-FA-EMP-NO AND XFAQ-EMP-NO > ZEROS DTSBD590
|
|
00425 IF XFAQ-FISCAL-AGENT-CD NOT = WRK-FA-CD DTSBD590
|
|
00426 * MOVE WRK-XFAQ-KEY-AREA TO XFAQ-KEY-AREA DTSBD590
|
|
00427 MOVE 'DUPLICATE EMP-NO WITH OTHER FISCAL AGENT' TO DTSBD590
|
|
00428 WRK-MESSAGE DTSBD590
|
|
00429 PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT DTSBD590
|
|
00430 MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA DTSBD590
|
|
00431 ADD 1 TO WRK-FA-DUP-CNT DTSBD590
|
|
00432 SET WRK-FA-DUP-REC-YES-88 TO TRUE DTSBD590
|
|
00433 GO TO P0000-EXIT DTSBD590
|
|
00434 END-IF DTSBD590
|
|
00435 END-IF. DTSBD590
|
|
00436 DTSBD590
|
|
00437 P0000-PROCESS-CONTINUE. DTSBD590
|
|
00438 DTSBD590
|
|
00439 IF WRK-FA-DUP-REC-YES-88 DTSBD590
|
|
00440 MOVE 'DUPLICATE INPUT REC WITH OTHER FISC-AGNT' TO DTSBD590
|
|
00441 WRK-MESSAGE DTSBD590
|
|
00442 PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT DTSBD590
|
|
00443 MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA DTSBD590
|
|
00444 ADD 1 TO WRK-FA-DUP-CNT DTSBD590
|
|
00445 SET WRK-FA-DUP-REC-NO-88 TO TRUE DTSBD590
|
|
00446 GO TO P0000-EXIT. DTSBD590
|
|
00447 DTSBD590
|
|
00448 PERFORM P1000-FIND-ACCT-NUM THRU P1000-EXIT. DTSBD590
|
|
00449 IF WRK-EMP-NO NOT = ZERO DTSBD590
|
|
00450 ADD +1 TO WRK-FA-ACCT-CNT DTSBD590
|
|
00451 PERFORM P3000-BUILD-OUTPUT THRU P3000-EXIT DTSBD590
|
|
00452 ELSE DTSBD590
|
|
00453 PERFORM P2000-FIND-FEIN-NUM THRU P2000-EXIT DTSBD590
|
|
00454 IF WRK-EMP-NO NOT = ZERO DTSBD590
|
|
00455 ADD +1 TO WRK-FA-FEIN-CNT DTSBD590
|
|
00456 PERFORM P3000-BUILD-OUTPUT THRU P3000-EXIT DTSBD590
|
|
00457 *RW1 DTSBD590
|
|
00458 MOVE 'PLEASE UPDATE YOUR ACCOUNT # USING FEIN' DTSBD590
|
|
00459 TO WRK-MESSAGE DTSBD590
|
|
00460 *RW2 DTSBD590
|
|
00461 PERFORM P4070-FEIN-ACCT THRU P4070-EXIT DTSBD590
|
|
00462 ELSE DTSBD590
|
|
00463 MOVE 'EMPLOYER NOT ON FILE' TO WRK-MESSAGE DTSBD590
|
|
00464 PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT DTSBD590
|
|
00465 END-IF DTSBD590
|
|
00466 END-IF. DTSBD590
|
|
00467 DTSBD590
|
|
00468 MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA. DTSBD590
|
|
00469 DTSBD590
|
|
00470 P0000-EXIT. DTSBD590
|
|
00471 EXIT. DTSBD590
|
|
00472 EJECT DTSBD590
|
|
00473 P1000-FIND-ACCT-NUM. DTSBD590
|
|
00474 PERFORM P1100-EDIT-EMP-NO THRU P1100-EXIT. DTSBD590
|
|
00475 DTSBD590
|
|
00476 IF WRK-EMP-NO-INVALID-88 DTSBD590
|
|
00477 GO TO P1000-EXIT. DTSBD590
|
|
00478 DTSBD590
|
|
00479 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD590
|
|
00480 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSBD590
|
|
00481 SET MSKL-PRF-88 TO TRUE. DTSBD590
|
|
00482 DTSBD590
|
|
00483 PERFORM S910-READ THRU S910-EXIT. DTSBD590
|
|
00484 IF NOT L910-OK-88 DTSBD590
|
|
00485 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00486 GO TO P1000-EXIT. DTSBD590
|
|
00487 DTSBD590
|
|
00488 MOVE MSKL-REC TO MPRF-REC. DTSBD590
|
|
00489 DTSBD590
|
|
00490 MOVE MPRF-EMP-NO TO WRK-EMP-NO. DTSBD590
|
|
00491 DTSBD590
|
|
00492 P1000-EXIT. DTSBD590
|
|
00493 EXIT. DTSBD590
|
|
00494 DTSBD590
|
|
00495 P1100-EDIT-EMP-NO. DTSBD590
|
|
00496 SET WRK-EMP-NO-INVALID-88 TO TRUE. DTSBD590
|
|
00497 DTSBD590
|
|
00498 IF WRK-FA-EMP-NO NUMERIC DTSBD590
|
|
00499 IF WRK-FA-EMP-NO > ZERO DTSBD590
|
|
00500 MOVE WRK-FA-EMP-NO TO WRK-EMP-NO DTSBD590
|
|
00501 ELSE DTSBD590
|
|
00502 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00503 ELSE DTSBD590
|
|
00504 SET WRK-EMP-NO-INVALID-88 TO TRUE. DTSBD590
|
|
00505 DTSBD590
|
|
00506 P1100-EXIT. DTSBD590
|
|
00507 EXIT. DTSBD590
|
|
00508 DTSBD590
|
|
00509 P2000-FIND-FEIN-NUM. DTSBD590
|
|
00510 PERFORM P2100-EDIT-FEIN-NO THRU P2100-EXIT. DTSBD590
|
|
00511 DTSBD590
|
|
00512 IF WRK-FEIN-NO-INVALID-88 DTSBD590
|
|
00513 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00514 GO TO P2000-EXIT. DTSBD590
|
|
00515 DTSBD590
|
|
00516 DTSBD590
|
|
00517 MOVE ZEROS TO WRK-LIAB-DATE DTSBD590
|
|
00518 WRK-LIAB-EMP-NO DTSBD590
|
|
00519 WRK-IEIN-EMP-NO. DTSBD590
|
|
00520 DTSBD590
|
|
00521 MOVE LOW-VALUE TO IEIN-KEY-AREA. DTSBD590
|
|
00522 SET IEIN-EIN-88 TO TRUE. DTSBD590
|
|
00523 MOVE WRK-FEIN-NO TO IEIN-FEIN. DTSBD590
|
|
00524 MOVE +0 TO IEIN-EMP-NO. DTSBD590
|
|
00525 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA. DTSBD590
|
|
00526 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBD590
|
|
00527 DTSBD590
|
|
00528 MOVE ISKL-REC TO IEIN-REC. DTSBD590
|
|
00529 IF L921-NO-REC-88 OR DTSBD590
|
|
00530 IEIN-FEIN NOT = WRK-FEIN-NO DTSBD590
|
|
00531 MOVE ZEROS TO WRK-FEIN-NO DTSBD590
|
|
00532 SET WRK-FEIN-NO-INVALID-88 TO TRUE DTSBD590
|
|
00533 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00534 ELSE DTSBD590
|
|
00535 PERFORM P2200-FEIN-BROWSE THRU P2200-EXIT DTSBD590
|
|
00536 UNTIL L921-NO-REC-88 OR DTSBD590
|
|
00537 IEIN-FEIN NOT = WRK-FEIN-NO OR DTSBD590
|
|
00538 WRK-EMP-NO NOT = ZERO. DTSBD590
|
|
00539 DTSBD590
|
|
00540 P2000-EXIT. DTSBD590
|
|
00541 EXIT. DTSBD590
|
|
00542 DTSBD590
|
|
00543 P2100-EDIT-FEIN-NO. DTSBD590
|
|
00544 MOVE ZEROS TO WRK-FEIN-NO. DTSBD590
|
|
00545 DTSBD590
|
|
00546 IF WRK-FA-FEIN-NO NUMERIC DTSBD590
|
|
00547 IF WRK-FA-FEIN-NO > ZERO DTSBD590
|
|
00548 MOVE WRK-FA-FEIN-NO TO WRK-FEIN-NO DTSBD590
|
|
00549 ELSE DTSBD590
|
|
00550 SET WRK-FEIN-NO-INVALID-88 TO TRUE DTSBD590
|
|
00551 ELSE DTSBD590
|
|
00552 SET WRK-FEIN-NO-INVALID-88 TO TRUE. DTSBD590
|
|
00553 DTSBD590
|
|
00554 P2100-EXIT. DTSBD590
|
|
00555 EXIT. DTSBD590
|
|
00556 DTSBD590
|
|
00557 P2200-FEIN-BROWSE. DTSBD590
|
|
00558 MOVE ZEROS TO WRK-EMP-NO. DTSBD590
|
|
00559 MOVE IEIN-EMP-NO TO WRK-IEIN-EMP-NO. DTSBD590
|
|
00560 PERFORM P2210-READ-MPRF THRU P2210-EXIT. DTSBD590
|
|
00561 DTSBD590
|
|
00562 IF WRK-EMP-NO NOT = ZERO DTSBD590
|
|
00563 GO TO P2200-EXIT. DTSBD590
|
|
00564 DTSBD590
|
|
00565 PERFORM S921-READ-NEXT THRU S921-EXIT. DTSBD590
|
|
00566 DTSBD590
|
|
00567 IF L910-NO-REC-88 DTSBD590
|
|
00568 GO TO P2200-EXIT. DTSBD590
|
|
00569 DTSBD590
|
|
00570 MOVE ISKL-REC TO IEIN-REC. DTSBD590
|
|
00571 P2200-EXIT. DTSBD590
|
|
00572 EXIT. DTSBD590
|
|
00573 EJECT DTSBD590
|
|
00574 DTSBD590
|
|
00575 P2210-READ-MPRF. DTSBD590
|
|
00576 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD590
|
|
00577 DTSBD590
|
|
00578 MOVE WRK-IEIN-EMP-NO TO MSKL-EMP-NO. DTSBD590
|
|
00579 DTSBD590
|
|
00580 SET MSKL-PRF-88 TO TRUE. DTSBD590
|
|
00581 DTSBD590
|
|
00582 PERFORM S910-READ THRU S910-EXIT. DTSBD590
|
|
00583 DTSBD590
|
|
00584 IF L910-NO-REC-88 DTSBD590
|
|
00585 GO TO P2210-EXIT. DTSBD590
|
|
00586 DTSBD590
|
|
00587 MOVE MSKL-REC TO MPRF-REC. DTSBD590
|
|
00588 DTSBD590
|
|
00589 *** END THE SEARCH WITH THE FIRST IEIN RECORD WHERE THE DTSBD590
|
|
00590 *** EMPLOYER IS ACTIVE. THERE IS ONLY ONE ACTIVE ACCOUNT DTSBD590
|
|
00591 *** FOR A GIVEN FEIN. DTSBD590
|
|
00592 DTSBD590
|
|
00593 IF MPRF-STATUS-ACT-88 DTSBD590
|
|
00594 MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBD590
|
|
00595 ELSE DTSBD590
|
|
00596 SET WRK-EMP-NO-INVALID-88 TO TRUE. DTSBD590
|
|
00597 DTSBD590
|
|
00598 DTSBD590
|
|
00599 P2210-EXIT. DTSBD590
|
|
00600 EXIT. DTSBD590
|
|
00601 DTSBD590
|
|
00602 P3000-BUILD-OUTPUT. DTSBD590
|
|
00603 PERFORM P3100-EDIT-MPRF THRU P3100-EXIT. DTSBD590
|
|
00604 IF WRK-EMP-NO-INVALID-88 DTSBD590
|
|
00605 GO TO P3000-EXIT. DTSBD590
|
|
00606 DTSBD590
|
|
00607 MOVE MPRF-FEIN TO WRK-MPRF-FEIN-NO. DTSBD590
|
|
00608 DTSBD590
|
|
00609 IF WRK-MPRF-FEIN-NO > 0 AND WRK-FA-FEIN-NO > 0 DTSBD590
|
|
00610 IF WRK-MPRF-FEIN-NO NOT = WRK-FA-FEIN-NO DTSBD590
|
|
00611 *RW1 DTSBD590
|
|
00612 MOVE 'PLEASE UPDATE YOUR FEIN USING ACCOUNT #' DTSBD590
|
|
00613 TO WRK-MESSAGE DTSBD590
|
|
00614 PERFORM P4070-FEIN-ACCT THRU P4070-EXIT DTSBD590
|
|
00615 *RW2 DTSBD590
|
|
00616 END-IF DTSBD590
|
|
00617 ELSE DTSBD590
|
|
00618 IF WRK-EMP-NO > 0 AND WRK-FA-EMP-NO > 0 DTSBD590
|
|
00619 IF WRK-EMP-NO NOT = WRK-FA-EMP-NO DTSBD590
|
|
00620 MOVE 'ACCT# NOT ON FILE ' TO WRK-MESSAGE DTSBD590
|
|
00621 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00622 END-IF DTSBD590
|
|
00623 END-IF DTSBD590
|
|
00624 END-IF. DTSBD590
|
|
00625 DTSBD590
|
|
00626 PERFORM P3210-VALIDATE-FISC-AGENT THRU P3210-EXIT. DTSBD590
|
|
00627 DTSBD590
|
|
00628 PERFORM P3300-FORMAT-OUTPUT THRU P3300-EXIT. DTSBD590
|
|
00629 DTSBD590
|
|
00630 PERFORM P3310-BUILD-MFAE THRU P3310-EXIT. DTSBD590
|
|
00631 DTSBD590
|
|
00632 PERFORM S952-WRITE-590-FILE THRU S952-EXIT. DTSBD590
|
|
00633 ADD +1 TO WRK-FA-WRITE-CNT. DTSBD590
|
|
00634 DTSBD590
|
|
00635 P3000-EXIT. DTSBD590
|
|
00636 EXIT. DTSBD590
|
|
00637 DTSBD590
|
|
00638 P3100-EDIT-MPRF. DTSBD590
|
|
00639 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD590
|
|
00640 DTSBD590
|
|
00641 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSBD590
|
|
00642 DTSBD590
|
|
00643 SET MSKL-PRF-88 TO TRUE. DTSBD590
|
|
00644 DTSBD590
|
|
00645 PERFORM S910-READ THRU S910-EXIT. DTSBD590
|
|
00646 DTSBD590
|
|
00647 IF L910-NO-REC-88 DTSBD590
|
|
00648 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00649 GO TO P3100-EXIT DTSBD590
|
|
00650 END-IF. DTSBD590
|
|
00651 DTSBD590
|
|
00652 MOVE MSKL-REC TO MPRF-REC. DTSBD590
|
|
00653 DTSBD590
|
|
00654 IF MPRF-CLASS-SELF-INS-88 DTSBD590
|
|
00655 MOVE ' *** SELF INSURED ACCT ' TO WRK-MESSAGE DTSBD590
|
|
00656 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00657 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00658 GO TO P3100-EXIT DTSBD590
|
|
00659 END-IF. DTSBD590
|
|
00660 DTSBD590
|
|
00661 IF MPRF-STATUS-NEVERSUB-88 DTSBD590
|
|
00662 MOVE 'ACCT IS NEVER SUBJECT ' TO WRK-MESSAGE DTSBD590
|
|
00663 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00664 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00665 GO TO P3100-EXIT DTSBD590
|
|
00666 END-IF. DTSBD590
|
|
00667 DTSBD590
|
|
00668 MOVE MPRF-EMP-NO TO L600-EMP-NO. DTSBD590
|
|
00669 PERFORM S600-SUCCESSOR THRU S600-EXIT. DTSBD590
|
|
00670 IF L600-SUCCESSOR-FOUND-88 DTSBD590
|
|
00671 MOVE 'ACCT SUCCEEDED ' TO WRK-MESSAGE DTSBD590
|
|
00672 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00673 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00674 GO TO P3100-EXIT DTSBD590
|
|
00675 END-IF. DTSBD590
|
|
00676 DTSBD590
|
|
00677 IF MPRF-STATUS-INACT-88 DTSBD590
|
|
00678 MOVE 'ACCT IS INACTIVE ' TO WRK-MESSAGE DTSBD590
|
|
00679 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00680 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00681 GO TO P3100-EXIT DTSBD590
|
|
00682 END-IF. DTSBD590
|
|
00683 DTSBD590
|
|
00684 * MOVE WRK-RATE-YRQ TO L516-YRQ. DTSBD590
|
|
00685 MOVE WRK-YRQ TO L516-YRQ. DTSBD590
|
|
00686 PERFORM S516-DETERMINE-LIABILITY THRU S516-EXIT. DTSBD590
|
|
00687 IF L516-NOT-LIABLE-88 DTSBD590
|
|
00688 MOVE 'ACCT NOT LIABLE ' TO WRK-MESSAGE DTSBD590
|
|
00689 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00690 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00691 GO TO P3100-EXIT DTSBD590
|
|
00692 ELSE DTSBD590
|
|
00693 IF L516-ESTIMATED-RATE-88 DTSBD590
|
|
00694 ADD +1 TO WRK-ESTIM-RATE-CNT DTSBD590
|
|
00695 DISPLAY '*** >> ESTIMATED RATE FOUND: ' MPRF-EMP-NO DTSBD590
|
|
00696 MOVE 'ESTIMATED RATE ' TO WRK-MESSAGE DTSBD590
|
|
00697 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00698 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00699 GO TO P3100-EXIT DTSBD590
|
|
00700 ELSE DTSBD590
|
|
00701 IF L516-NO-RATE-88 DTSBD590
|
|
00702 MOVE 'NO RATE ASSIGNED ' TO WRK-MESSAGE DTSBD590
|
|
00703 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00704 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00705 GO TO P3100-EXIT DTSBD590
|
|
00706 END-IF DTSBD590
|
|
00707 END-IF DTSBD590
|
|
00708 END-IF. DTSBD590
|
|
00709 DTSBD590
|
|
00710 ****************************************************** DTSBD590
|
|
00711 ** SURTAX OF .002 ADDED TO COMPUTE STATEMENT ON 1/10/06 GB DTSBD590
|
|
00712 ** SURTAX OF .002 NOT ADDED FOR PAYCHEX ON 1/10/06 GB DTSBD590
|
|
00713 DTSBD590
|
|
00714 DISPLAY ' FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD DTSBD590
|
|
00715 DTSBD590
|
|
00716 IF XFAQ-FISCAL-AGENT-CD = 'PC ' DTSBD590
|
|
00717 COMPUTE WRK-UI-RATE = L516-UI-RATE * 100 DTSBD590
|
|
00718 DISPLAY '7031PAY FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD DTSBD590
|
|
00719 GO TO P3100-EXIT. DTSBD590
|
|
00720 DTSBD590
|
|
00721 IF XFAQ-FISCAL-AGENT-CD = 'PP ' DTSBD590
|
|
00722 COMPUTE WRK-UI-RATE = L516-UI-RATE * 100 DTSBD590
|
|
00723 DISPLAY '7031PAY FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD DTSBD590
|
|
00724 GO TO P3100-EXIT. DTSBD590
|
|
00725 DTSBD590
|
|
00726 DISPLAY '7035 FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD DTSBD590
|
|
00727 COMPUTE WRK-UI-RATE = (L516-UI-RATE + .002) * 100. DTSBD590
|
|
00728 DTSBD590
|
|
00729 P3100-EXIT. DTSBD590
|
|
00730 EXIT. DTSBD590
|
|
00731 DTSBD590
|
|
00732 *P3200-FIND-MRTE. DTSBD590
|
|
00733 * MOVE ZERO TO WRK-UI-RATE. DTSBD590
|
|
00734 * DTSBD590
|
|
00735 * MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBD590
|
|
00736 * MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBD590
|
|
00737 * SET MRTE-RTE-88 TO TRUE. DTSBD590
|
|
00738 * MOVE WRK-RATE-YRQ TO MRTE-EFF-YRQ. DTSBD590
|
|
00739 * DTSBD590
|
|
00740 * MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD590
|
|
00741 * PERFORM S910-READ THRU S910-EXIT. DTSBD590
|
|
00742 * DTSBD590
|
|
00743 * IF L910-NO-REC-88 DTSBD590
|
|
00744 * SET WRK-UI-RATE-NOT-OK-88 TO TRUE DTSBD590
|
|
00745 * MOVE 'NO RATE ASSIGNED ' TO WRK-MESSAGE DTSBD590
|
|
00746 * PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00747 * GO TO P3200-EXIT. DTSBD590
|
|
00748 * DTSBD590
|
|
00749 * MOVE MSKL-REC TO MRTE-REC. DTSBD590
|
|
00750 * DTSBD590
|
|
00751 * IF MRTE-RATE-TYPE-ESTIM-88 DTSBD590
|
|
00752 * ADD +1 TO WRK-ESTIM-RATE-CNT DTSBD590
|
|
00753 * DISPLAY '*** >> ESTIMATED RATE FOUND: ' MPRF-EMP-NO. DTSBD590
|
|
00754 * DTSBD590
|
|
00755 * IF MRTE-UI-RATE > 0 DTSBD590
|
|
00756 * COMPUTE WRK-UI-RATE = (MRTE-UI-RATE + .002) * 100 DTSBD590
|
|
00757 * ELSE DTSBD590
|
|
00758 * SET WRK-UI-RATE-NOT-OK-88 TO TRUE DTSBD590
|
|
00759 * MOVE 'NO RATE ASSIGNED ' TO WRK-MESSAGE DTSBD590
|
|
00760 * PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00761 * GO TO P3200-EXIT. DTSBD590
|
|
00762 * DTSBD590
|
|
00763 *P3200-EXIT. DTSBD590
|
|
00764 * EXIT. DTSBD590
|
|
00765 DTSBD590
|
|
00766 P3210-VALIDATE-FISC-AGENT. DTSBD590
|
|
00767 DTSBD590
|
|
00768 SET WRK-FISC-AGNT-INVALID-88 TO TRUE DTSBD590
|
|
00769 DTSBD590
|
|
00770 PERFORM VARYING FISCAL-AGENT-IDX FROM 1 BY 1 DTSBD590
|
|
00771 UNTIL WRK-FISC-AGNT-VALID-88 DTSBD590
|
|
00772 OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT DTSBD590
|
|
00773 OR FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBD590
|
|
00774 = SPACE DTSBD590
|
|
00775 IF WRK-FA-CD = FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBD590
|
|
00776 SET WRK-FISC-AGNT-VALID-88 TO TRUE DTSBD590
|
|
00777 MOVE FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBD590
|
|
00778 TO WRK-FISCAL-AGENT-CD DTSBD590
|
|
00779 END-IF DTSBD590
|
|
00780 END-PERFORM. DTSBD590
|
|
00781 DTSBD590
|
|
00782 IF WRK-FISC-AGNT-INVALID-88 DTSBD590
|
|
00783 MOVE 'INVALID FISCAL AGENT' TO WRK-MESSAGE DTSBD590
|
|
00784 PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT DTSBD590
|
|
00785 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD590
|
|
00786 GO TO P3210-EXIT. DTSBD590
|
|
00787 DTSBD590
|
|
00788 P3210-EXIT. DTSBD590
|
|
00789 EXIT. DTSBD590
|
|
00790 DTSBD590
|
|
00791 P3300-FORMAT-OUTPUT. DTSBD590
|
|
00792 SET R590-UPDATE-88 TO TRUE. DTSBD590
|
|
00793 MOVE MPRF-EMP-NO TO R590-EMP-NO. DTSBD590
|
|
00794 DTSBD590
|
|
00795 IF MPRF-FEIN = ZEROS DTSBD590
|
|
00796 MOVE WRK-FA-FEIN-NO TO R590-EMP-FEIN DTSBD590
|
|
00797 ELSE DTSBD590
|
|
00798 MOVE MPRF-FEIN TO R590-EMP-FEIN. DTSBD590
|
|
00799 DTSBD590
|
|
00800 MOVE MPRF-PRIMARY-NAME TO R590-EMP-NAME. DTSBD590
|
|
00801 MOVE MPRF-ENTITY-NAME TO R590-EMP-NAME-A. DTSBD590
|
|
00802 MOVE MPRF-SIC-CD TO R590-SIC-CODE. DTSBD590
|
|
00803 MOVE MPRF-EMP-STATUS TO R590-EMP-STATUS-CODE. DTSBD590
|
|
00804 DTSBD590
|
|
00805 DISPLAY 'MPRF-EMP-NO ' MPRF-EMP-NO. DTSBD590
|
|
00806 DISPLAY 'AGENT CODE ' XFAQ-FISCAL-AGENT-CD DTSBD590
|
|
00807 DISPLAY 'L516-UI-RATE' L516-UI-RATE. DTSBD590
|
|
00808 DISPLAY 'WRK-UI-RATE ' WRK-UI-RATE. DTSBD590
|
|
00809 DTSBD590
|
|
00810 MOVE WRK-UI-RATE TO R590-EMP-CONTR-RATE. DTSBD590
|
|
00811 DTSBD590
|
|
00812 MOVE WRK-FISCAL-AGENT-CD TO R590-FISCAL-AGENT-CD. DTSBD590
|
|
00813 MOVE SPACES TO WRK-MESSAGE. DTSBD590
|
|
00814 MOVE WRK-MESSAGE TO R590-MESSAGE. DTSBD590
|
|
00815 P3300-EXIT. DTSBD590
|
|
00816 EXIT. DTSBD590
|
|
00817 DTSBD590
|
|
00818 P3310-BUILD-MFAE. DTSBD590
|
|
00819 DTSBD590
|
|
00820 PERFORM P3320-DUP-MFAE-CHECK THRU P3320-EXIT. DTSBD590
|
|
00821 DTSBD590
|
|
00822 IF WRK-FAE-YES-DUP-88 DTSBD590
|
|
00823 GO TO P3310-EXIT. DTSBD590
|
|
00824 DTSBD590
|
|
00825 INITIALIZE MFAE-REC. DTSBD590
|
|
00826 DTSBD590
|
|
00827 MOVE MPRF-EMP-NO TO MFAE-EMP-NO. DTSBD590
|
|
00828 SET MFAE-FAE-88 TO TRUE. DTSBD590
|
|
00829 SET MFAE-SERVICE-UC30-88 TO TRUE. DTSBD590
|
|
00830 MOVE ZEROS TO MFAE-PURGE-DATE. DTSBD590
|
|
00831 MOVE WRK-FISCAL-AGENT-CD TO MFAE-FISCAL-AGENT-CD. DTSBD590
|
|
00832 SET MFAE-NOT-CONVERTED-88 TO TRUE. DTSBD590
|
|
00833 MOVE MHDR-CURR-RUN-DATE TO MFAE-ESTB-DATE DTSBD590
|
|
00834 MFAE-CHNG-DATE. DTSBD590
|
|
00835 MOVE MFAE-REC TO MSKL-REC. DTSBD590
|
|
00836 DTSBD590
|
|
00837 DTSBD590
|
|
00838 PERFORM S910-WRITE THRU S910-EXIT. DTSBD590
|
|
00839 DTSBD590
|
|
00840 ADD +1 TO WRK-MFAE-ADDED-CNT. DTSBD590
|
|
00841 DTSBD590
|
|
00842 P3310-EXIT. DTSBD590
|
|
00843 EXIT. DTSBD590
|
|
00844 DTSBD590
|
|
00845 P3320-DUP-MFAE-CHECK. DTSBD590
|
|
00846 DTSBD590
|
|
00847 SET WRK-FAE-NO-DUP-88 TO TRUE. DTSBD590
|
|
00848 DTSBD590
|
|
00849 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSBD590
|
|
00850 MOVE MPRF-EMP-NO TO MFAE-EMP-NO. DTSBD590
|
|
00851 SET MFAE-FAE-88 TO TRUE. DTSBD590
|
|
00852 SET MFAE-SERVICE-UC30-88 TO TRUE. DTSBD590
|
|
00853 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSBD590
|
|
00854 DTSBD590
|
|
00855 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD590
|
|
00856 DTSBD590
|
|
00857 IF L910-NO-REC-88 DTSBD590
|
|
00858 GO TO P3320-EXIT DTSBD590
|
|
00859 END-IF. DTSBD590
|
|
00860 DTSBD590
|
|
00861 MOVE MSKL-REC TO MFAE-REC. DTSBD590
|
|
00862 DTSBD590
|
|
00863 IF MFAE-SERVICE-UC30-88 DTSBD590
|
|
00864 SET WRK-FAE-YES-DUP-88 TO TRUE DTSBD590
|
|
00865 END-IF. DTSBD590
|
|
00866 DTSBD590
|
|
00867 P3320-EXIT. DTSBD590
|
|
00868 EXIT. DTSBD590
|
|
00869 DTSBD590
|
|
00870 P4000-FAERROR-OUTPUT. DTSBD590
|
|
00871 DTSBD590
|
|
00872 SET R590-ERROR-88 TO TRUE. DTSBD590
|
|
00873 MOVE WRK-FA-CD TO R590-FISCAL-AGENT-CD. DTSBD590
|
|
00874 MOVE SPACES TO R590-FIL1. DTSBD590
|
|
00875 MOVE WRK-FA-EMP-NO TO R590-EMP-NO. DTSBD590
|
|
00876 MOVE WRK-FA-FEIN-NO TO R590-EMP-FEIN. DTSBD590
|
|
00877 MOVE SPACES TO R590-EMP-NAME. DTSBD590
|
|
00878 MOVE SPACES TO R590-EMP-NAME-A. DTSBD590
|
|
00879 MOVE ZEROS TO R590-EMP-CONTR-RATE. DTSBD590
|
|
00880 MOVE ZEROS TO R590-SIC-CODE. DTSBD590
|
|
00881 MOVE SPACES TO R590-EMP-STATUS-CODE. DTSBD590
|
|
00882 MOVE WRK-MESSAGE TO R590-MESSAGE. DTSBD590
|
|
00883 DTSBD590
|
|
00884 PERFORM S952-WRITE-590-FILE THRU S952-EXIT. DTSBD590
|
|
00885 ADD +1 TO WRK-FE-WRITE-CNT. DTSBD590
|
|
00886 DTSBD590
|
|
00887 P4000-EXIT. DTSBD590
|
|
00888 EXIT. DTSBD590
|
|
00889 P4050-DCERROR-OUTPUT. DTSBD590
|
|
00890 DTSBD590
|
|
00891 SET R590-ERROR-88 TO TRUE. DTSBD590
|
|
00892 MOVE SPACES TO R590-FIL1. DTSBD590
|
|
00893 MOVE WRK-FA-CD TO R590-FISCAL-AGENT-CD. DTSBD590
|
|
00894 MOVE WRK-EMP-NO TO R590-EMP-NO. DTSBD590
|
|
00895 * MOVE WRK-FEIN-NO TO R590-EMP-FEIN. DTSBD590
|
|
00896 *RW1 DTSBD590
|
|
00897 IF MPRF-EMP-STATUS = 'A' OR 'I' OR 'N' OR 'U' DTSBD590
|
|
00898 MOVE MPRF-FEIN TO R590-EMP-FEIN DTSBD590
|
|
00899 ELSE DTSBD590
|
|
00900 MOVE WRK-XFAQ-EMP-FEIN TO R590-EMP-FEIN. DTSBD590
|
|
00901 *RW2 DTSBD590
|
|
00902 MOVE ZEROS TO R590-EMP-CONTR-RATE. DTSBD590
|
|
00903 MOVE MPRF-PRIMARY-NAME TO R590-EMP-NAME. DTSBD590
|
|
00904 MOVE SPACES TO R590-EMP-NAME-A. DTSBD590
|
|
00905 MOVE MPRF-SIC-CD TO R590-SIC-CODE. DTSBD590
|
|
00906 MOVE MPRF-EMP-STATUS TO R590-EMP-STATUS-CODE. DTSBD590
|
|
00907 MOVE WRK-MESSAGE TO R590-MESSAGE. DTSBD590
|
|
00908 PERFORM S952-WRITE-590-FILE THRU S952-EXIT. DTSBD590
|
|
00909 ADD +1 TO WRK-FE-WRITE-CNT. DTSBD590
|
|
00910 DTSBD590
|
|
00911 P4050-EXIT. DTSBD590
|
|
00912 EXIT. DTSBD590
|
|
00913 P4070-FEIN-ACCT. DTSBD590
|
|
00914 DTSBD590
|
|
00915 SET R590-FEIN-ACCT-88 TO TRUE. DTSBD590
|
|
00916 MOVE SPACES TO R590-FIL1. DTSBD590
|
|
00917 MOVE WRK-FA-CD TO R590-FISCAL-AGENT-CD. DTSBD590
|
|
00918 MOVE MPRF-EMP-NO TO R590-EMP-NO. DTSBD590
|
|
00919 * MOVE WRK-FEIN-NO TO R590-EMP-FEIN. DTSBD590
|
|
00920 *RW1 DTSBD590
|
|
00921 MOVE MPRF-FEIN TO R590-EMP-FEIN. DTSBD590
|
|
00922 *RW2 DTSBD590
|
|
00923 MOVE ZEROS TO R590-EMP-CONTR-RATE. DTSBD590
|
|
00924 MOVE MPRF-PRIMARY-NAME TO R590-EMP-NAME. DTSBD590
|
|
00925 MOVE SPACES TO R590-EMP-NAME-A. DTSBD590
|
|
00926 MOVE MPRF-SIC-CD TO R590-SIC-CODE. DTSBD590
|
|
00927 MOVE MPRF-EMP-STATUS TO R590-EMP-STATUS-CODE. DTSBD590
|
|
00928 MOVE WRK-MESSAGE TO R590-MESSAGE. DTSBD590
|
|
00929 PERFORM S952-WRITE-590-FILE THRU S952-EXIT. DTSBD590
|
|
00930 ADD +1 TO WRK-FN-FEIN-CNT. DTSBD590
|
|
00931 DTSBD590
|
|
00932 P4070-EXIT. DTSBD590
|
|
00933 EXIT. DTSBD590
|
|
00934 T0000-TERMINATE. DTSBD590
|
|
00935 DTSBD590
|
|
00936 DISPLAY ' '. DTSBD590
|
|
00937 DTSBD590
|
|
00938 DISPLAY '*** DTSBD590 TERMINATION STATISTICS ***'. DTSBD590
|
|
00939 DTSBD590
|
|
00940 DISPLAY ' '. DTSBD590
|
|
00941 DTSBD590
|
|
00942 IF WRK-ESTIM-RATE-CNT > ZERO DTSBD590
|
|
00943 DISPLAY '**************************************' DTSBD590
|
|
00944 DISPLAY '* *' DTSBD590
|
|
00945 DISPLAY '* ESTIMATED RATES FOUND ' WRK-ESTIM-RATE-CNT DTSBD590
|
|
00946 DISPLAY '* DISCARD OUTPUT, CORRECT RATES *' DTSBD590
|
|
00947 DISPLAY '* AND RERUN THIS JOB. *' DTSBD590
|
|
00948 DISPLAY '**************************************'. DTSBD590
|
|
00949 DTSBD590
|
|
00950 DISPLAY 'NUMBER OF FISCAL AGENT RECORDS ENCOUNTERED: 'DTSBD590
|
|
00951 WRK-FA-READ-CNT. DTSBD590
|
|
00952 DTSBD590
|
|
00953 DISPLAY 'NUMBER OF FISCAL AGENT RECORDS DUPLICATED : 'DTSBD590
|
|
00954 WRK-FA-DUP-CNT. DTSBD590
|
|
00955 DTSBD590
|
|
00956 DISPLAY 'NUMBER OF FISCAL AGENT EMPLOYER ACCT FOUND: 'DTSBD590
|
|
00957 WRK-FA-ACCT-CNT. DTSBD590
|
|
00958 DTSBD590
|
|
00959 DISPLAY 'NUMBER OF FISCAL AGENT EMPLOYER FEIN FOUND: 'DTSBD590
|
|
00960 WRK-FA-FEIN-CNT. DTSBD590
|
|
00961 DTSBD590
|
|
00962 DISPLAY 'NUMBER OF MSTB-MFAE RECORDS ADDED : 'DTSBD590
|
|
00963 WRK-MFAE-ADDED-CNT. DTSBD590
|
|
00964 DTSBD590
|
|
00965 DISPLAY 'NUMBER OF MSTB-MFAE RECORDS DELETED: 'DTSBD590
|
|
00966 WRK-MFAE-DELETED-CNT. DTSBD590
|
|
00967 DTSBD590
|
|
00968 DISPLAY 'NUMBER OF MSTB-MFAE RECORDS DUPLICATE: 'DTSBD590
|
|
00969 WRK-MFAE-DUPL-CNT. DTSBD590
|
|
00970 DTSBD590
|
|
00971 DISPLAY ' '. DTSBD590
|
|
00972 DTSBD590
|
|
00973 DISPLAY 'NUMBER OF FISCAL AGENT OUTPUT RECORDS WRITTEN: 'DTSBD590
|
|
00974 DTSBD590
|
|
00975 DISPLAY 'NUMBER OF TYPE #3 RECORDS WRITTEN: 'DTSBD590
|
|
00976 WRK-FN-FEIN-CNT. DTSBD590
|
|
00977 DTSBD590
|
|
00978 DISPLAY 'NUMBER OF FA TAPE RECORDS WRITTEN: 'DTSBD590
|
|
00979 WRK-FA-WRITE-CNT. DTSBD590
|
|
00980 DTSBD590
|
|
00981 DISPLAY 'NUMBER OF FISCAL AGENT ERRORS RECORDS : 'DTSBD590
|
|
00982 WRK-FE-WRITE-CNT. DTSBD590
|
|
00983 DTSBD590
|
|
00984 DTSBD590
|
|
00985 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD590
|
|
00986 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD590
|
|
00987 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD590
|
|
00988 DTSBD590
|
|
00989 PERFORM S953-CLOSE-FA-FILE THRU S953-EXIT. DTSBD590
|
|
00990 DTSBD590
|
|
00991 T0000-EXIT. DTSBD590
|
|
00992 EXIT. DTSBD590
|
|
00993 EJECT DTSBD590
|
|
00994 DTSBD590
|
|
00995 S004-FROM-5. DTSBD590
|
|
00996 SET L004-FROM-5 TO TRUE. DTSBD590
|
|
00997 GO TO S004-QTR. DTSBD590
|
|
00998 DTSBD590
|
|
00999 S004-FROM-DATE. DTSBD590
|
|
01000 SET L004-FROM-DATE TO TRUE. DTSBD590
|
|
01001 GO TO S004-QTR. DTSBD590
|
|
01002 DTSBD590
|
|
01003 S004-QTR. DTSBD590
|
|
01004 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD590
|
|
01005 DTSBD590
|
|
01006 S004-EXIT. DTSBD590
|
|
01007 EXIT. DTSBD590
|
|
01008 DTSBD590
|
|
01009 S006-FROM-QTR. DTSBD590
|
|
01010 SET L006-FROM-QTR TO TRUE. DTSBD590
|
|
01011 GO TO S006-UI-RATE-YEAR. DTSBD590
|
|
01012 DTSBD590
|
|
01013 S006-UI-RATE-YEAR. DTSBD590
|
|
01014 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD590
|
|
01015 DTSBD590
|
|
01016 S006-EXIT. DTSBD590
|
|
01017 EXIT. DTSBD590
|
|
01018 DTSBD590
|
|
01019 S516-DETERMINE-LIABILITY. DTSBD590
|
|
01020 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD590
|
|
01021 MPRF-REC. DTSBD590
|
|
01022 S516-EXIT. DTSBD590
|
|
01023 EXIT. DTSBD590
|
|
01024 DTSBD590
|
|
01025 S600-SUCCESSOR. DTSBD590
|
|
01026 CALL 'DTSBU600' USING L600-LINK-AREA. DTSBD590
|
|
01027 DTSBD590
|
|
01028 S600-EXIT. DTSBD590
|
|
01029 EXIT. DTSBD590
|
|
01030 DTSBD590
|
|
01031 S910-OPEN-UPDATE-NO-AIX. DTSBD590
|
|
01032 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBD590
|
|
01033 GO TO S910-MSTR-IO. DTSBD590
|
|
01034 DTSBD590
|
|
01035 S910-READ. DTSBD590
|
|
01036 SET L910-READ-88 TO TRUE. DTSBD590
|
|
01037 GO TO S910-MSTR-IO. DTSBD590
|
|
01038 DTSBD590
|
|
01039 S910-DELETE. DTSBD590
|
|
01040 SET L910-DELETE-88 TO TRUE. DTSBD590
|
|
01041 GO TO S910-MSTR-IO. DTSBD590
|
|
01042 DTSBD590
|
|
01043 S910-WRITE. DTSBD590
|
|
01044 SET L910-WRITE-88 TO TRUE. DTSBD590
|
|
01045 GO TO S910-MSTR-IO. DTSBD590
|
|
01046 DTSBD590
|
|
01047 S910-START-BROWSE. DTSBD590
|
|
01048 SET L910-START-BROWSE-88 TO TRUE. DTSBD590
|
|
01049 GO TO S910-MSTR-IO. DTSBD590
|
|
01050 DTSBD590
|
|
01051 S910-READ-NEXT. DTSBD590
|
|
01052 SET L910-READ-NEXT-88 TO TRUE. DTSBD590
|
|
01053 GO TO S910-MSTR-IO. DTSBD590
|
|
01054 DTSBD590
|
|
01055 S910-REWRITE. DTSBD590
|
|
01056 SET L910-REWRITE-88 TO TRUE. DTSBD590
|
|
01057 GO TO S910-MSTR-IO. DTSBD590
|
|
01058 DTSBD590
|
|
01059 S910-CLOSE. DTSBD590
|
|
01060 SET L910-CLOSE-88 TO TRUE. DTSBD590
|
|
01061 GO TO S910-MSTR-IO. DTSBD590
|
|
01062 DTSBD590
|
|
01063 S910-MSTR-IO. DTSBD590
|
|
01064 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD590
|
|
01065 MSKL-REC. DTSBD590
|
|
01066 S910-EXIT. DTSBD590
|
|
01067 EXIT. DTSBD590
|
|
01068 DTSBD590
|
|
01069 SKIP3 DTSBD590
|
|
01070 S921-OPEN-READ. DTSBD590
|
|
01071 SET L921-OPEN-READ-88 TO TRUE. DTSBD590
|
|
01072 GO TO S921-AIX-IO. DTSBD590
|
|
01073 DTSBD590
|
|
01074 S921-READ. DTSBD590
|
|
01075 SET L921-READ-88 TO TRUE. DTSBD590
|
|
01076 GO TO S921-AIX-IO. DTSBD590
|
|
01077 DTSBD590
|
|
01078 S921-START-BROWSE. DTSBD590
|
|
01079 SET L921-START-BROWSE-88 TO TRUE. DTSBD590
|
|
01080 GO TO S921-AIX-IO. DTSBD590
|
|
01081 DTSBD590
|
|
01082 S921-READ-NEXT. DTSBD590
|
|
01083 SET L921-READ-NEXT-88 TO TRUE. DTSBD590
|
|
01084 GO TO S921-AIX-IO. DTSBD590
|
|
01085 DTSBD590
|
|
01086 S921-CLOSE. DTSBD590
|
|
01087 SET L921-CLOSE-88 TO TRUE. DTSBD590
|
|
01088 GO TO S921-AIX-IO. DTSBD590
|
|
01089 DTSBD590
|
|
01090 S921-AIX-IO. DTSBD590
|
|
01091 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD590
|
|
01092 ISKL-REC. DTSBD590
|
|
01093 S921-EXIT. DTSBD590
|
|
01094 EXIT. DTSBD590
|
|
01095 S931-OPEN-READ. DTSBD590
|
|
01096 SET L931-OPEN-READ-88 TO TRUE. DTSBD590
|
|
01097 GO TO S931-REF-IO. DTSBD590
|
|
01098 DTSBD590
|
|
01099 S931-OPEN-UPDATE. DTSBD590
|
|
01100 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBD590
|
|
01101 GO TO S931-REF-IO. DTSBD590
|
|
01102 DTSBD590
|
|
01103 S931-READ. DTSBD590
|
|
01104 SET L931-READ-88 TO TRUE. DTSBD590
|
|
01105 GO TO S931-REF-IO. DTSBD590
|
|
01106 DTSBD590
|
|
01107 S931-CLOSE. DTSBD590
|
|
01108 SET L931-CLOSE-88 TO TRUE. DTSBD590
|
|
01109 GO TO S931-REF-IO. DTSBD590
|
|
01110 DTSBD590
|
|
01111 S931-REF-IO. DTSBD590
|
|
01112 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD590
|
|
01113 FSKL-REC. DTSBD590
|
|
01114 S931-EXIT. DTSBD590
|
|
01115 EXIT. DTSBD590
|
|
01116 S950-OPEN-FA-FILE. DTSBD590
|
|
01117 OPEN INPUT FISCAL-AGENT-IFILE. DTSBD590
|
|
01118 DTSBD590
|
|
01119 S950-EXIT. DTSBD590
|
|
01120 EXIT. DTSBD590
|
|
01121 DTSBD590
|
|
01122 S951-READ-FA-FILE. DTSBD590
|
|
01123 READ FISCAL-AGENT-IFILE INTO FISCAL-AGENT-INREC. DTSBD590
|
|
01124 MOVE XFAQ-EMP-FEIN TO WRK-XFAQ-EMP-FEIN. DTSBD590
|
|
01125 DTSBD590
|
|
01126 S951-EXIT. DTSBD590
|
|
01127 EXIT. DTSBD590
|
|
01128 DTSBD590
|
|
01129 S952-WRITE-590-FILE. DTSBD590
|
|
01130 CALL 'DTSBU946' USING R590-REC. DTSBD590
|
|
01131 DTSBD590
|
|
01132 S952-EXIT. DTSBD590
|
|
01133 EXIT. DTSBD590
|
|
01134 DTSBD590
|
|
01135 S953-CLOSE-FA-FILE. DTSBD590
|
|
01136 CLOSE FISCAL-AGENT-IFILE. DTSBD590
|
|
01137 DTSBD590
|
|
01138 S953-EXIT. DTSBD590
|
|
01139 EXIT. DTSBD590
|
|
01140 DTSBD590
|
|
01141 DTSBD590
|
|
01142 SKIP3 DTSBD590
|
|
01143 S999-ABEND. DTSBD590
|
|
01144 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD590
|
|
01145 S999-EXIT. DTSBD590
|
|
01146 EXIT. DTSBD590
|