DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
648
Batch/DTSBD591.cob
Normal file
648
Batch/DTSBD591.cob
Normal file
@ -0,0 +1,648 @@
|
||||
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
|
||||
Reference in New Issue
Block a user