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