649 lines
51 KiB
COBOL
649 lines
51 KiB
COBOL
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
|