00001 IDENTIFICATION DIVISION. 04/24/17 00002 PROGRAM-ID. DTSBD591. DTSBD591 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. DECEMBER 1998. DTSBD591 00005 DATE-COMPILED. DTSBD591 00006 SKIP3 DTSBD591 00007 ***** DTSBD591 00008 * FUNCTION: PROCESS FISCAL AGENT BENEFIT CHARGE CLIENT DTSBD591 00009 * DATA AND MAINTAIN BENEFIT CHARGE MFAE RECORDS DTSBD591 00010 ***** DTSBD591 00011 SKIP3 DTSBD591 00012 ENVIRONMENT DIVISION. DTSBD591 00013 DTSBD591 00014 INPUT-OUTPUT SECTION. DTSBD591 00015 FILE-CONTROL. DTSBD591 00016 SELECT FISCAL-AGENT-FILE DTSBD591 00017 ASSIGN TO FAFILE DTSBD591 00018 FILE STATUS IS FA-STATUS. DTSBD591 00019 DTSBD591 00020 DATA DIVISION. DTSBD591 00021 SKIP3 DTSBD591 00022 FILE SECTION. DTSBD591 00023 FD FISCAL-AGENT-FILE DTSBD591 00024 LABEL RECORDS ARE STANDARD DTSBD591 00025 DATA RECORD IS CHGIM006. DTSBD591 00026 DTSBD591 00027 01 FISCAL-AGENT-REC. DTSBD591 00028 ++INCLUDE CHGIM006 DTSBD591 00029 DTSBD591 00030 EJECT DTSBD591 00031 WORKING-STORAGE SECTION. DTSBD591 000315 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD591 04/24/17'. DTSBD591 00032 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD591 10/08/02'. DTSBD591 00033 SKIP3 DTSBD591 00034 01 WRK-AREA. DTSBD591 00035 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +591.DTSBD591 00036 DTSBD591 00037 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD591'.DTSBD591 00038 DTSBD591 00039 05 WRK-FA-READ-CNT PIC S9(07) COMP-3. DTSBD591 00040 05 WRK-ERROR-CNT PIC S9(07) COMP-3. DTSBD591 00041 05 WRK-MFAE-ADDED-CNT PIC S9(07) COMP-3. DTSBD591 00042 05 WRK-MFAE-DELETED-CNT PIC S9(07) COMP-3. DTSBD591 00043 DTSBD591 00044 05 FA-STATUS PIC X(02). DTSBD591 00045 88 FA-STAT-OK-88 VALUE '00', '97'. DTSBD591 00046 88 FA-STAT-EOF-88 VALUE '10'. DTSBD591 00047 DTSBD591 00048 05 WRK-ERROR-IND PIC X(01). DTSBD591 00049 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBD591 00050 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBD591 00051 DTSBD591 00052 05 WRK-EMP-NO-IND PIC X(01). DTSBD591 00053 88 WRK-EMP-NO-INVALID-88 VALUE 'N'. DTSBD591 00054 88 WRK-EMP-NO-VALID-88 VALUE 'Y'. DTSBD591 00055 DTSBD591 00056 05 WRK-FISC-AGNT-IND PIC X(01). DTSBD591 00057 88 WRK-FISC-AGNT-VALID-88 VALUE 'Y'. DTSBD591 00058 88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'. DTSBD591 00059 DTSBD591 00060 05 WRK-WRITE-MFAE-IND PIC X(01). DTSBD591 00061 88 WRK-WRITE-MFAE-YES-88 VALUE 'Y'. DTSBD591 00062 88 WRK-WRITE-MFAE-NO-88 VALUE 'N'. DTSBD591 00063 DTSBD591 00064 05 WRK-UPDATE-MPRF-IND PIC X(01). DTSBD591 00065 88 WRK-UPDATE-MPRF-YES-88 VALUE 'Y'. DTSBD591 00066 88 WRK-UPDATE-MPRF-NO-88 VALUE 'N'. DTSBD591 00067 DTSBD591 00068 05 WRK-FISCAL-AGENT-NAME PIC X(35). DTSBD591 00069 DTSBD591 00070 05 WRK-CURR-EMP-NO PIC X(06). DTSBD591 00071 05 WRK-CURR-EMP-NO-9 REDEFINES WRK-CURR-EMP-NO DTSBD591 00072 PIC 9(06). DTSBD591 00073 05 FILLER PIC X(01) VALUE SPACES.DTSBD591 00074 05 WRK-CURR-EMPLOYER-NAME PIC X(39) VALUE SPACES.DTSBD591 00075 05 WRK-CURR-FISC-AGNT-NAME PIC X(35) VALUE SPACES.DTSBD591 00076 05 WRK-CURR-EMP-DUP-IND PIC X(01). DTSBD591 00077 88 WRK-CURR-EMP-DUP-YES-88 VALUE 'Y'. DTSBD591 00078 88 WRK-CURR-EMP-DUP-NO-88 VALUE 'N'. DTSBD591 00079 DTSBD591 00080 05 WRK-NEW-EMP-NO PIC X(06). DTSBD591 00081 05 WRK-NEW-FISC-AGNT-NAME PIC X(35). DTSBD591 00082 05 FILLER PIC X(01) VALUE SPACES.DTSBD591 00083 05 WRK-NEW-EMPLOYER-NAME PIC X(39). DTSBD591 00084 DTSBD591 00085 05 WRK-FISCAL-AGENT-CD PIC X(03). DTSBD591 00086 DTSBD591 00087 05 WRK-TRACE-IND PIC X(01). DTSBD591 00088 DTSBD591 00089 01 L910-LINK-AREA. DTSBD591 00090 ++INCLUDE DTSIL910 DTSBD591 00091 EJECT DTSBD591 00092 01 MSKL-REC. DTSBD591 00093 ++INCLUDE DTSIMSKL DTSBD591 00094 EJECT DTSBD591 00095 01 MHDR-REC. DTSBD591 00096 ++INCLUDE DTSIMHDR DTSBD591 00097 EJECT DTSBD591 00098 01 MPRF-REC. DTSBD591 00099 ++INCLUDE DTSIMPRF DTSBD591 00100 EJECT DTSBD591 00101 01 MFAE-REC. DTSBD591 00102 ++INCLUDE DTSIMFAE DTSBD591 00103 EJECT DTSBD591 00104 01 R591-REC. DTSBD591 00105 ++INCLUDE DTSIR591 DTSBD591 00106 EJECT DTSBD591 00107 01 L921-LINK-AREA. DTSBD591 00108 ++INCLUDE DTSIL921 DTSBD591 00109 EJECT DTSBD591 00110 01 ISKL-REC. DTSBD591 00111 ++INCLUDE DTSIISKL DTSBD591 00112 EJECT DTSBD591 00113 01 FISCAL-AGENT-TABLE-AREA. DTSBD591 00114 ++INCLUDE CHGIC001 DTSBD591 00115 EJECT DTSBD591 00116 01 L600-LINK-AREA. DTSBD591 00117 ++INCLUDE DTSIL600 DTSBD591 00118 EJECT DTSBD591 00119 PROCEDURE DIVISION. DTSBD591 00120 DTSBD591 00121 DTSBD591-MAIN. DTSBD591 00122 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD591 00123 IF WRK-ERROR-YES-88 DTSBD591 00124 GO TO DTSBD591-MAIN-EXIT. DTSBD591 00125 DTSBD591 00126 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD591 00127 DTSBD591 00128 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD591 00129 DTSBD591 00130 DTSBD591-MAIN-EXIT. DTSBD591 00131 GOBACK. DTSBD591 00132 EJECT DTSBD591 00133 I0000-INITIATE. DTSBD591 00134 MOVE +0 TO WRK-FA-READ-CNT DTSBD591 00135 WRK-ERROR-CNT DTSBD591 00136 WRK-MFAE-ADDED-CNT DTSBD591 00137 WRK-MFAE-DELETED-CNT. DTSBD591 00138 DTSBD591 00139 SET WRK-ERROR-NO-88 TO TRUE. DTSBD591 00140 DTSBD591 00141 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD591 00142 IF WRK-ERROR-YES-88 DTSBD591 00143 GO TO I0000-EXIT. DTSBD591 00144 DTSBD591 00145 PERFORM I2000-READ-MHDR THRU I2000-EXIT. DTSBD591 00146 DTSBD591 00147 PERFORM I3000-DELETE-MFAE THRU I3000-EXIT. DTSBD591 00148 MOVE LENGTH OF R591-REC TO R591-LENGTH. DTSBD591 00149 MOVE '591' TO R591-REC-TYPE. DTSBD591 00150 SKIP2 DTSBD591 00151 I0000-EXIT. DTSBD591 00152 EXIT. DTSBD591 00153 I1000-OPEN-FILES. DTSBD591 00154 PERFORM S950-OPEN-FA-FILE THRU S950-EXIT. DTSBD591 00155 IF NOT FA-STAT-OK-88 DTSBD591 00156 DISPLAY 'CANNOT OPEN FISCAL AGENT FILE ' FA-STATUS DTSBD591 00157 SET WRK-ERROR-YES-88 TO TRUE DTSBD591 00158 GO TO I1000-EXIT. DTSBD591 00159 DTSBD591 00160 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBD591 00161 DTSBD591 00162 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD591 00163 DTSBD591 00164 *** PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD591 00165 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. DTSBD591 00166 DTSBD591 00167 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD591 00168 DTSBD591 00169 I1000-EXIT. DTSBD591 00170 EXIT. DTSBD591 00171 DTSBD591 00172 I2000-READ-MHDR. DTSBD591 00173 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD591 00174 MOVE +0 TO MHDR-EMP-NO. DTSBD591 00175 SET MHDR-HDR-88 TO TRUE. DTSBD591 00176 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD591 00177 PERFORM S910-READ THRU S910-EXIT. DTSBD591 00178 DTSBD591 00179 IF L910-NO-REC-88 DTSBD591 00180 DISPLAY 'MHDR RECORD NOT FOUND' DTSBD591 00181 SET WRK-ERROR-YES-88 TO TRUE DTSBD591 00182 GO TO I2000-EXIT. DTSBD591 00183 DTSBD591 00184 MOVE MSKL-REC TO MHDR-REC. DTSBD591 00185 DTSBD591 00186 I2000-EXIT. DTSBD591 00187 EXIT. DTSBD591 00188 DTSBD591 00189 I3000-DELETE-MFAE. DTSBD591 00190 MOVE LOW-VALUE TO MSKL-REC. DTSBD591 00191 MOVE +0 TO MSKL-EMP-NO. DTSBD591 00192 SET MSKL-PRF-88 TO TRUE. DTSBD591 00193 DTSBD591 00194 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD591 00195 DTSBD591 00196 PERFORM I3100-MPRF-SCAN THRU I3100-EXIT DTSBD591 00197 UNTIL L910-NO-REC-88. DTSBD591 00198 DTSBD591 00199 I3000-EXIT. DTSBD591 00200 EXIT. DTSBD591 00201 DTSBD591 00202 I3100-MPRF-SCAN. DTSBD591 00203 MOVE MSKL-REC TO MPRF-REC. DTSBD591 00204 DTSBD591 00205 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD591 00206 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD591 00207 SET MSKL-FAE-88 TO TRUE. DTSBD591 00208 DTSBD591 00209 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD591 00210 PERFORM DTSBD591 00211 UNTIL L910-NO-REC-88 DTSBD591 00212 MOVE MSKL-REC TO MFAE-REC DTSBD591 00213 IF MFAE-SERVICE-BEN-CHG-88 DTSBD591 00214 PERFORM S910-DELETE THRU S910-EXIT DTSBD591 00215 ADD +1 TO WRK-MFAE-DELETED-CNT DTSBD591 00216 END-IF DTSBD591 00217 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD591 00218 END-PERFORM. DTSBD591 00219 DTSBD591 00220 MOVE MPRF-REC TO MSKL-REC. DTSBD591 00221 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD591 00222 DTSBD591 00223 I3100-EXIT. DTSBD591 00224 EXIT. DTSBD591 00225 DTSBD591 00226 EJECT DTSBD591 00227 P0000-PROCESS. DTSBD591 00228 DISPLAY 'MAINTAIN FISCAL AGENT/EMPLOYER RECORDS FOR'. DTSBD591 00229 DISPLAY ' BENEFIT CHARGE SERVICES'. DTSBD591 00230 DISPLAY SPACE. DTSBD591 00231 DTSBD591 00232 PERFORM P0100-READ-FIRST THRU P0100-EXIT. DTSBD591 00233 IF WRK-ERROR-YES-88 DTSBD591 00234 GO TO P0000-EXIT. DTSBD591 00235 DTSBD591 00236 PERFORM P1000-PROCESS-FA-FILE THRU P1000-EXIT DTSBD591 00237 UNTIL NOT FA-STAT-OK-88. DTSBD591 00238 DTSBD591 00239 PERFORM P3000-CHK-LAST-REC THRU P3000-EXIT. DTSBD591 00240 DTSBD591 00241 P0000-EXIT. DTSBD591 00242 EXIT. DTSBD591 00243 DTSBD591 00244 P0100-READ-FIRST. DTSBD591 00245 PERFORM S951-READ-FA-FILE THRU S951-EXIT. DTSBD591 00246 IF NOT FA-STAT-OK-88 DTSBD591 00247 DISPLAY 'CANNOT READ FISCAL AGENT FILE ' FA-STATUS DTSBD591 00248 SET WRK-ERROR-YES-88 TO TRUE DTSBD591 00249 GO TO P0100-EXIT DTSBD591 00250 ELSE DTSBD591 00251 ADD +1 TO WRK-FA-READ-CNT DTSBD591 00252 END-IF. DTSBD591 00253 DTSBD591 00254 MOVE CHG6-EMP-NO TO WRK-CURR-EMP-NO. DTSBD591 00255 MOVE CHG6-FISCAL-AGENT-NAME TO WRK-CURR-FISC-AGNT-NAME. DTSBD591 00256 MOVE CHG6-EMPLOYER-NAME TO WRK-CURR-EMPLOYER-NAME. DTSBD591 00257 SET WRK-CURR-EMP-DUP-NO-88 TO TRUE. DTSBD591 00258 DTSBD591 00259 P0100-EXIT. DTSBD591 00260 EXIT. DTSBD591 00261 DTSBD591 00262 ************************************************************** DTSBD591 00263 * THIS PARAGRAPH READS THROUGH THE INPUT FILE AND CHECKS FOR DTSBD591 00264 * DUPLICATES - EMPLOYERS LISTED WITH MORE THAN ONE FISCAL DTSBD591 00265 * AGENT. DTSBD591 00266 * DTSBD591 00267 * THE FIRST READ (P0100) HAS PLACED THE FIRST RECORD DTSBD591 00268 * IN THE 'CURRENT' AREA (WRK-CURR-EMP-NO). DTSBD591 00269 * DTSBD591 00270 * THE NEXT READ PLACES A NEW RECORD IN THE 'NEW' AREA DTSBD591 00271 * (WRK-NEW-EMP-NO). IF THE CURRENT AND NEW ARE NOT EQUAL DTSBD591 00272 * DTSBD591 00273 * THE PROCESS COMPLETES EDITS ON THE CURRENT EMPLOYER AND DTSBD591 00274 * WRITES THE MFAE RECORD. THE NEW RECORD THEN BECOMES THE DTSBD591 00275 * CURRENT AND THE PROCESS CONTINUES. DTSBD591 00276 ************************************************************** DTSBD591 00277 P1000-PROCESS-FA-FILE. DTSBD591 00278 PERFORM P1100-READ-NEW THRU P1100-EXIT. DTSBD591 00279 IF NOT FA-STAT-OK-88 DTSBD591 00280 GO TO P1000-EXIT. DTSBD591 00281 DTSBD591 00282 IF WRK-NEW-EMP-NO NOT = WRK-CURR-EMP-NO DTSBD591 00283 IF WRK-CURR-EMP-DUP-YES-88 DTSBD591 00284 PERFORM P1110-CURR-ERROR THRU P1110-EXIT DTSBD591 00285 MOVE WRK-NEW-EMP-NO TO WRK-CURR-EMP-NO DTSBD591 00286 MOVE WRK-NEW-FISC-AGNT-NAME TO WRK-CURR-FISC-AGNT-NAME DTSBD591 00287 MOVE WRK-NEW-EMPLOYER-NAME TO WRK-CURR-EMPLOYER-NAME DTSBD591 00288 SET WRK-CURR-EMP-DUP-NO-88 TO TRUE DTSBD591 00289 ELSE DTSBD591 00290 PERFORM P2000-PROCESS-CURR THRU P2000-EXIT DTSBD591 00291 MOVE WRK-NEW-EMP-NO TO WRK-CURR-EMP-NO DTSBD591 00292 MOVE WRK-NEW-FISC-AGNT-NAME TO WRK-CURR-FISC-AGNT-NAME DTSBD591 00293 MOVE WRK-NEW-EMPLOYER-NAME TO WRK-CURR-EMPLOYER-NAME DTSBD591 00294 SET WRK-CURR-EMP-DUP-NO-88 TO TRUE DTSBD591 00295 END-IF DTSBD591 00296 ELSE DTSBD591 00297 PERFORM P1120-NEW-ERROR THRU P1120-EXIT DTSBD591 00298 SET WRK-CURR-EMP-DUP-YES-88 TO TRUE DTSBD591 00299 END-IF. DTSBD591 00300 DTSBD591 00301 P1000-EXIT. DTSBD591 00302 EXIT. DTSBD591 00303 DTSBD591 00304 P1100-READ-NEW. DTSBD591 00305 PERFORM S951-READ-FA-FILE THRU S951-EXIT. DTSBD591 00306 IF FA-STAT-OK-88 DTSBD591 00307 ADD +1 TO WRK-FA-READ-CNT DTSBD591 00308 MOVE CHG6-EMP-NO TO WRK-NEW-EMP-NO DTSBD591 00309 MOVE CHG6-FISCAL-AGENT-NAME TO WRK-NEW-FISC-AGNT-NAME DTSBD591 00310 MOVE CHG6-EMPLOYER-NAME TO WRK-NEW-EMPLOYER-NAME DTSBD591 00311 ELSE DTSBD591 00312 IF FA-STAT-EOF-88 DTSBD591 00313 DISPLAY 'FA EOF ' FA-STATUS DTSBD591 00314 ELSE DTSBD591 00315 DISPLAY '*** UNEXPECTED FA FILE STATUS ' DTSBD591 00316 FA-STATUS DTSBD591 00317 GO TO P1100-EXIT DTSBD591 00318 END-IF DTSBD591 00319 END-IF. DTSBD591 00320 DTSBD591 00321 P1100-EXIT. DTSBD591 00322 EXIT. DTSBD591 00323 DTSBD591 00324 P1110-CURR-ERROR. DTSBD591 00325 ADD +1 TO WRK-ERROR-CNT. DTSBD591 00326 MOVE 'DUPLICATE ACCOUNT ' TO R591-MESSAGE DTSBD591 00327 DTSBD591 00328 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT. DTSBD591 00329 DTSBD591 00330 P1110-EXIT. DTSBD591 00331 EXIT. DTSBD591 00332 DTSBD591 00333 P1120-NEW-ERROR. DTSBD591 00334 ADD +1 TO WRK-ERROR-CNT. DTSBD591 00335 MOVE 'DUPLICATE ACCOUNT ' TO R591-MESSAGE DTSBD591 00336 DTSBD591 00337 PERFORM P4000-WRITE-591-NEW-ERROR THRU P4000-EXIT. DTSBD591 00338 DTSBD591 00339 P1120-EXIT. DTSBD591 00340 EXIT. DTSBD591 00341 DTSBD591 00342 P2000-PROCESS-CURR. DTSBD591 00343 PERFORM P2100-EDIT THRU P2100-EXIT. DTSBD591 00344 IF WRK-EMP-NO-VALID-88 DTSBD591 00345 PERFORM P2200-BUILD-MFAE THRU P2200-EXIT. DTSBD591 00346 DTSBD591 00347 P2000-EXIT. DTSBD591 00348 EXIT. DTSBD591 00349 DTSBD591 00350 P2100-EDIT. DTSBD591 00351 SET WRK-EMP-NO-VALID-88 TO TRUE. DTSBD591 00352 DTSBD591 00353 PERFORM P2110-EDIT-EMP-NO THRU P2110-EXIT. DTSBD591 00354 IF WRK-EMP-NO-VALID-88 DTSBD591 00355 MOVE WRK-CURR-FISC-AGNT-NAME TO WRK-FISCAL-AGENT-NAME DTSBD591 00356 PERFORM P2120-VALIDATE-FISC-AGNT THRU P2120-EXIT DTSBD591 00357 IF WRK-FISC-AGNT-VALID-88 DTSBD591 00358 PERFORM P2130-EMP-STATUS THRU P2130-EXIT. DTSBD591 00359 DTSBD591 00360 P2100-EXIT. DTSBD591 00361 EXIT. DTSBD591 00362 DTSBD591 00363 P2110-EDIT-EMP-NO. DTSBD591 00364 IF WRK-CURR-EMP-NO NUMERIC DTSBD591 00365 IF WRK-CURR-EMP-NO > ZERO DTSBD591 00366 NEXT SENTENCE DTSBD591 00367 ELSE DTSBD591 00368 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD591 00369 ELSE DTSBD591 00370 SET WRK-EMP-NO-INVALID-88 TO TRUE. DTSBD591 00371 DTSBD591 00372 IF WRK-EMP-NO-INVALID-88 DTSBD591 00373 MOVE 'INVALID ACCOUNT NO ' TO R591-MESSAGE DTSBD591 00374 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT DTSBD591 00375 ADD +1 TO WRK-ERROR-CNT. DTSBD591 00376 DTSBD591 00377 P2110-EXIT. DTSBD591 00378 EXIT. DTSBD591 00379 DTSBD591 00380 P2120-VALIDATE-FISC-AGNT. DTSBD591 00381 *& DTSBD591 00382 * DISPLAY 'P2120 CURR NAME ' WRK-CURR-FISC-AGNT-NAME. DTSBD591 00383 *& DTSBD591 00384 SET WRK-FISC-AGNT-INVALID-88 TO TRUE. DTSBD591 00385 MOVE SPACES TO WRK-FISCAL-AGENT-CD. DTSBD591 00386 DTSBD591 00387 PERFORM DTSBD591 00388 VARYING FISCAL-AGENT-IDX FROM +1 BY +1 DTSBD591 00389 UNTIL WRK-FISC-AGNT-VALID-88 DTSBD591 00390 OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT DTSBD591 00391 OR FISCAL-AGENT-NAME (FISCAL-AGENT-IDX) DTSBD591 00392 = SPACE DTSBD591 00393 DTSBD591 00394 *** DISPLAY '1-TBL-FA-NAME: ', DTSBD591 00395 *** FISCAL-AGENT-NAME (FISCAL-AGENT-IDX) DTSBD591 00396 *** DISPLAY '2-WRK-FA-NAME: ', DTSBD591 00397 *** WRK-FISCAL-AGENT-NAME DTSBD591 00398 DTSBD591 00399 IF WRK-FISCAL-AGENT-NAME = DTSBD591 00400 FISCAL-AGENT-NAME (FISCAL-AGENT-IDX) DTSBD591 00401 SET WRK-FISC-AGNT-VALID-88 TO TRUE DTSBD591 00402 MOVE FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) TO DTSBD591 00403 WRK-FISCAL-AGENT-CD DTSBD591 00404 END-IF DTSBD591 00405 END-PERFORM. DTSBD591 00406 DTSBD591 00407 IF WRK-FISC-AGNT-INVALID-88 DTSBD591 00408 DISPLAY 'INVALID FISCAL AGENT CD ' WRK-FISCAL-AGENT-NAME DTSBD591 00409 ADD +1 TO WRK-ERROR-CNT. DTSBD591 00410 *& DTSBD591 00411 * DISPLAY 'P2120 FA CODE ' WRK-FISCAL-AGENT-CD. DTSBD591 00412 *& DTSBD591 00413 DTSBD591 00414 P2120-EXIT. DTSBD591 00415 EXIT. DTSBD591 00416 DTSBD591 00417 P2130-EMP-STATUS. DTSBD591 00418 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD591 00419 MOVE WRK-CURR-EMP-NO-9 TO MSKL-EMP-NO. DTSBD591 00420 SET MSKL-PRF-88 TO TRUE. DTSBD591 00421 DTSBD591 00422 PERFORM S910-READ THRU S910-EXIT. DTSBD591 00423 IF NOT L910-OK-88 DTSBD591 00424 ADD +1 TO WRK-ERROR-CNT DTSBD591 00425 MOVE 'ACCOUNT NOT FOUND ' TO R591-MESSAGE DTSBD591 00426 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT DTSBD591 00427 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD591 00428 GO TO P2130-EXIT DTSBD591 00429 ELSE DTSBD591 00430 MOVE MSKL-REC TO MPRF-REC DTSBD591 00431 PERFORM P2131-MPRF-EDITS THRU P2131-EXIT DTSBD591 00432 IF WRK-EMP-NO-VALID-88 DTSBD591 00433 PERFORM P2132-CHK-SUCCESSOR THRU P2132-EXIT. DTSBD591 00434 DTSBD591 00435 P2130-EXIT. DTSBD591 00436 EXIT. DTSBD591 00437 DTSBD591 00438 P2131-MPRF-EDITS. DTSBD591 00439 IF MPRF-CLASS-SELF-INS-88 DTSBD591 00440 ADD +1 TO WRK-ERROR-CNT DTSBD591 00441 MOVE 'SELF-INSURED EMPLOYER ' TO R591-MESSAGE DTSBD591 00442 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT DTSBD591 00443 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD591 00444 ELSE DTSBD591 00445 IF MPRF-CLASS-CHG-ONLY-88 DTSBD591 00446 ADD +1 TO WRK-ERROR-CNT DTSBD591 00447 MOVE 'CHARGE ONLY ACCOUNT ' TO R591-MESSAGE DTSBD591 00448 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT DTSBD591 00449 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD591 00450 END-IF DTSBD591 00451 END-IF. DTSBD591 00452 DTSBD591 00453 P2131-EXIT. DTSBD591 00454 EXIT. DTSBD591 00455 DTSBD591 00456 P2132-CHK-SUCCESSOR. DTSBD591 00457 MOVE MPRF-EMP-NO TO L600-EMP-NO. DTSBD591 00458 PERFORM S600-SUCCESSOR THRU S600-EXIT. DTSBD591 00459 IF L600-SUCCESSOR-FOUND-88 DTSBD591 00460 ADD +1 TO WRK-ERROR-CNT DTSBD591 00461 MOVE 'EMPLOYER HAS BEEN SUCCEEDED ' TO R591-MESSAGE DTSBD591 00462 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT DTSBD591 00463 SET WRK-EMP-NO-INVALID-88 TO TRUE DTSBD591 00464 END-IF. DTSBD591 00465 DTSBD591 00466 P2132-EXIT. DTSBD591 00467 EXIT. DTSBD591 00468 DTSBD591 00469 P2200-BUILD-MFAE. DTSBD591 00470 INITIALIZE MFAE-REC. DTSBD591 00471 DTSBD591 00472 MOVE WRK-CURR-EMP-NO-9 TO MFAE-EMP-NO. DTSBD591 00473 SET MFAE-FAE-88 TO TRUE. DTSBD591 00474 SET MFAE-SERVICE-BEN-CHG-88 TO TRUE. DTSBD591 00475 MOVE ZERO TO MFAE-PURGE-DATE. DTSBD591 00476 MOVE WRK-FISCAL-AGENT-CD TO MFAE-FISCAL-AGENT-CD. DTSBD591 00477 SET MFAE-NOT-CONVERTED-88 TO TRUE. DTSBD591 00478 MOVE MHDR-CURR-RUN-DATE TO MFAE-ESTB-DATE DTSBD591 00479 MFAE-CHNG-DATE. DTSBD591 00480 DTSBD591 00481 DISPLAY 'MFAE ' MFAE-REC. CL**2 00482 MOVE MFAE-REC TO MSKL-REC. CL**2 00483 *& DTSBD591 00484 PERFORM S910-WRITE THRU S910-EXIT. DTSBD591 00485 ADD +1 TO WRK-MFAE-ADDED-CNT. DTSBD591 00486 DTSBD591 00487 P2200-EXIT. DTSBD591 00488 EXIT. DTSBD591 00489 DTSBD591 00490 P3000-CHK-LAST-REC. DTSBD591 00491 IF WRK-CURR-EMP-DUP-YES-88 DTSBD591 00492 MOVE 'DUPLICATE ACCOUNT ' TO R591-MESSAGE DTSBD591 00493 PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT DTSBD591 00494 ELSE DTSBD591 00495 PERFORM P2100-EDIT THRU P2100-EXIT DTSBD591 00496 IF WRK-EMP-NO-VALID-88 DTSBD591 00497 PERFORM P2200-BUILD-MFAE THRU P2200-EXIT DTSBD591 00498 END-IF DTSBD591 00499 END-IF. DTSBD591 00500 DTSBD591 00501 P3000-EXIT. DTSBD591 00502 EXIT. DTSBD591 00503 P4000-WRITE-591-CURR-ERROR. DTSBD591 00504 MOVE WRK-CURR-EMP-NO TO R591-EMP-NO. DTSBD591 00505 MOVE WRK-CURR-FISC-AGNT-NAME TO WRK-FISCAL-AGENT-NAME. DTSBD591 00506 MOVE WRK-CURR-EMPLOYER-NAME TO R591-EMPLOYER-NAME. DTSBD591 00507 GO TO P4000-FISCAL-AGENT. DTSBD591 00508 DTSBD591 00509 P4000-WRITE-591-NEW-ERROR. DTSBD591 00510 MOVE WRK-NEW-EMP-NO TO R591-EMP-NO. DTSBD591 00511 MOVE WRK-NEW-FISC-AGNT-NAME TO WRK-FISCAL-AGENT-NAME. DTSBD591 00512 MOVE WRK-NEW-EMPLOYER-NAME TO R591-EMPLOYER-NAME. DTSBD591 00513 GO TO P4000-FISCAL-AGENT. DTSBD591 00514 DTSBD591 00515 P4000-FISCAL-AGENT. DTSBD591 00516 PERFORM P2120-VALIDATE-FISC-AGNT THRU P2120-EXIT. DTSBD591 00517 DTSBD591 00518 IF WRK-FISC-AGNT-INVALID-88 DTSBD591 00519 GO TO P4000-EXIT. DTSBD591 00520 MOVE SPACES TO R591-EMP-STATUS-CODE. DTSBD591 00521 SET R591-ERROR-88 TO TRUE. DTSBD591 00522 MOVE WRK-FISCAL-AGENT-CD TO R591-FISCAL-AGENT-CD. DTSBD591 00523 DTSBD591 00524 CALL 'DTSBU946' USING R591-REC. DTSBD591 00525 DTSBD591 00526 P4000-EXIT. DTSBD591 00527 EXIT. DTSBD591 00528 DTSBD591 00529 T0000-TERMINATE. DTSBD591 00530 DTSBD591 00531 DISPLAY ' '. DTSBD591 00532 DTSBD591 00533 DISPLAY '*** DTSBD591 TERMINATION STATISTICS ***'. DTSBD591 00534 DTSBD591 00535 DISPLAY ' '. DTSBD591 00536 DTSBD591 00537 DISPLAY 'NUMBER OF MFAE RECORDS DELETED : 'DTSBD591 00538 WRK-MFAE-DELETED-CNT. DTSBD591 00539 DTSBD591 00540 DISPLAY 'NUMBER OF FISCAL AGENT RECORDS ENCOUNTERED: 'DTSBD591 00541 WRK-FA-READ-CNT. DTSBD591 00542 DTSBD591 00543 DISPLAY 'NUMBER OF R591 ERRORS WRITTEN : 'DTSBD591 00544 WRK-ERROR-CNT. DTSBD591 00545 DTSBD591 00546 DISPLAY 'NUMBER OF MASTER FILE RECORDS UPDATED: 'DTSBD591 00547 WRK-MFAE-ADDED-CNT. DTSBD591 00548 DTSBD591 00549 DTSBD591 00550 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD591 00551 DTSBD591 00552 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD591 00553 DTSBD591 00554 PERFORM S952-CLOSE-FA-FILE THRU S952-EXIT. DTSBD591 00555 DTSBD591 00556 T0000-EXIT. DTSBD591 00557 EXIT. DTSBD591 00558 EJECT DTSBD591 00559 S600-SUCCESSOR. DTSBD591 00560 CALL 'DTSBU600' USING L600-LINK-AREA. DTSBD591 00561 DTSBD591 00562 S600-EXIT. DTSBD591 00563 EXIT. DTSBD591 00564 DTSBD591 00565 S910-OPEN-READ. DTSBD591 00566 SET L910-OPEN-READ-88 TO TRUE. DTSBD591 00567 GO TO S910-MSTR-IO. DTSBD591 00568 DTSBD591 00569 S910-OPEN-UPDATE-NO-AIX. DTSBD591 00570 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBD591 00571 GO TO S910-MSTR-IO. DTSBD591 00572 DTSBD591 00573 S910-READ. DTSBD591 00574 SET L910-READ-88 TO TRUE. DTSBD591 00575 GO TO S910-MSTR-IO. DTSBD591 00576 DTSBD591 00577 S910-START-BROWSE. DTSBD591 00578 SET L910-START-BROWSE-88 TO TRUE. DTSBD591 00579 GO TO S910-MSTR-IO. DTSBD591 00580 DTSBD591 00581 S910-READ-NEXT. DTSBD591 00582 SET L910-READ-NEXT-88 TO TRUE. DTSBD591 00583 GO TO S910-MSTR-IO. DTSBD591 00584 DTSBD591 00585 S910-COUNT. DTSBD591 00586 SET L910-COUNT-88 TO TRUE. DTSBD591 00587 GO TO S910-MSTR-IO. DTSBD591 00588 DTSBD591 00589 S910-WRITE. DTSBD591 00590 SET L910-WRITE-88 TO TRUE. DTSBD591 00591 GO TO S910-MSTR-IO. DTSBD591 00592 DTSBD591 00593 S910-REWRITE. DTSBD591 00594 SET L910-REWRITE-88 TO TRUE. DTSBD591 00595 GO TO S910-MSTR-IO. DTSBD591 00596 DTSBD591 00597 S910-DELETE. DTSBD591 00598 SET L910-DELETE-88 TO TRUE. DTSBD591 00599 GO TO S910-MSTR-IO. DTSBD591 00600 DTSBD591 00601 S910-CLOSE. DTSBD591 00602 SET L910-CLOSE-88 TO TRUE. DTSBD591 00603 GO TO S910-MSTR-IO. DTSBD591 00604 DTSBD591 00605 S910-MSTR-IO. DTSBD591 00606 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD591 00607 MSKL-REC. DTSBD591 00608 S910-EXIT. DTSBD591 00609 EXIT. DTSBD591 00610 DTSBD591 00611 S921-OPEN-READ. DTSBD591 00612 SET L921-OPEN-READ-88 TO TRUE. DTSBD591 00613 GO TO S921-AIX-IO. DTSBD591 00614 DTSBD591 00615 S921-CLOSE. DTSBD591 00616 SET L921-CLOSE-88 TO TRUE. DTSBD591 00617 GO TO S921-AIX-IO. DTSBD591 00618 DTSBD591 00619 S921-AIX-IO. DTSBD591 00620 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD591 00621 ISKL-REC. DTSBD591 00622 S921-EXIT. DTSBD591 00623 EXIT. DTSBD591 00624 DTSBD591 00625 S950-OPEN-FA-FILE. DTSBD591 00626 OPEN INPUT FISCAL-AGENT-FILE. DTSBD591 00627 DTSBD591 00628 S950-EXIT. DTSBD591 00629 EXIT. DTSBD591 00630 DTSBD591 00631 S951-READ-FA-FILE. DTSBD591 00632 READ FISCAL-AGENT-FILE. DTSBD591 00633 DTSBD591 00634 S951-EXIT. DTSBD591 00635 EXIT. DTSBD591 00636 DTSBD591 00637 S952-CLOSE-FA-FILE. DTSBD591 00638 CLOSE FISCAL-AGENT-FILE. DTSBD591 00639 DTSBD591 00640 S952-EXIT. DTSBD591 00641 EXIT. DTSBD591 00642 DTSBD591 00643 SKIP3 DTSBD591 00644 S999-ABEND. DTSBD591 00645 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD591 00646 S999-EXIT. DTSBD591 00647 EXIT. DTSBD591