00001 IDENTIFICATION DIVISION. 12/03/09 00002 PROGRAM-ID. DTSBU620. DTSBU620 00003 AUTHOR. TRW/TDI OUTSOURCE. LV007 00004 DATE-WRITTEN. APRIL 2000. DTSBU620 00005 DATE-COMPILED. DTSBU620 00006 SKIP3 DTSBU620 00007 ***** DTSBU620 00008 * DTSBU620 00009 * FUNCTION: FISCAL AGENT UC-30 FILE CONVERSION TO DTSBU620 00010 * NEW FORMAT. DTSBU620 00011 * DTSBU620 00012 * DTSBU620 00013 ***** DTSBU620 00014 SKIP3 DTSBU620 00015 ENVIRONMENT DIVISION. DTSBU620 00016 SKIP2 DTSBU620 00017 INPUT-OUTPUT SECTION. DTSBU620 00018 FILE-CONTROL. DTSBU620 00019 DTSBU620 00020 SELECT FISCAL-AGENT-FILE1 DTSBU620 00021 ASSIGN TO FAFILEI DTSBU620 00022 FILE STATUS IS FA-STATUS. DTSBU620 00023 DTSBU620 00024 SELECT FISCAL-AGENT-FILE2 DTSBU620 00025 ASSIGN TO FAFILEO DTSBU620 00026 FILE STATUS IS FA2-STATUS. DTSBU620 00027 DTSBU620 00028 SELECT PARM-FILE ASSIGN TO SYSIN DTSBU620 00029 FILE STATUS IS PARM-STATUS. DTSBU620 00030 DTSBU620 00031 DATA DIVISION. DTSBU620 00032 SKIP3 DTSBU620 00033 FILE SECTION. DTSBU620 00034 DTSBU620 00035 FD FISCAL-AGENT-FILE1 DTSBU620 00036 LABEL RECORDS ARE STANDARD DTSBU620 00037 DATA RECORD IS FISCAL-AGET-INREC. DTSBU620 00038 DTSBU620 00039 01 FISCAL-AGENT-INREC. DTSBU620 00040 05 XFARI-EMP-NO PIC X(06). DTSBU620 00041 05 XFARI-EMP-FEIN PIC X(09). DTSBU620 00042 05 XFARI-FILLER PIC X(65). DTSBU620 00043 DTSBU620 00044 FD FISCAL-AGENT-FILE2 DTSBU620 00045 LABEL RECORDS ARE STANDARD DTSBU620 00046 DATA RECORD IS DTSIXFAQ. DTSBU620 00047 DTSBU620 00048 01 FISCAL-AGENT-REC2. DTSBU620 00049 ++INCLUDE DTSIXFAQ DTSBU620 00050 DTSBU620 00051 FD PARM-FILE DTSBU620 00052 RECORDING MODE IS F DTSBU620 00053 BLOCK CONTAINS 0 CHARACTERS DTSBU620 00054 DATA RECORD IS PARM-REC. DTSBU620 00055 DTSBU620 00056 01 PARM-REC. DTSBU620 00057 05 PARM-RUN-FISCAL-AGENT-CD PIC X(03). DTSBU620 00058 05 FILLER PIC X(77). DTSBU620 00059 DTSBU620 00060 EJECT DTSBU620 00061 WORKING-STORAGE SECTION. DTSBU620 000615 77 PAN-VALET PICTURE X(24) VALUE '007DTSBU620 12/03/09'. DTSBU620 00062 SKIP3 DTSBU620 00063 01 WRK-FISCAL-AGENT-REC2. DTSBU620 00064 10 WRK-XFAQ-KEY-AREA. DTSBU620 00065 15 WRK-XFAQ-REC-TYPE PIC X(06). DTSBU620 00066 88 FISCAL-AGENT-UC30 VALUE 'UC30 '. DTSBU620 00067 15 WRK-XFAQ-FISCAL-AGENT-CD PIC X(03). DTSBU620 00068 15 WRK-XFAQ-EMP-NO PIC X(06) VALUE SPACE.DTSBU620 00069 15 WRK-XFAQ-EMP-NO-9 REDEFINES WRK-XFAQ-EMP-NO DTSBU620 00070 PIC 9(06). DTSBU620 00071 15 WRK-XFAQ-EMP-FEIN PIC X(09) VALUE SPACE.DTSBU620 00072 15 WRK-XFAQ-EMP-FEIN-9 REDEFINES WRK-XFAQ-EMP-FEIN DTSBU620 00073 PIC 9(09). DTSBU620 00074 DTSBU620 00075 10 WRK-XFAQ-DATA-AREA. DTSBU620 00076 15 WRK-XFAQ-FILLLER PIC X(56) VALUE SPACES. DTSBU620 00077 DTSBU620 00078 01 WRK-AREA. DTSBU620 00079 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +30. DTSBU620 00080 DTSBU620 00081 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU620'.DTSBU620 00082 DTSBU620 00083 05 WRK-FA-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU620 00084 05 WRK-FA-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU620 00085 05 WRK-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU620 00086 DTSBU620 00087 05 FA-STATUS PIC X(02). DTSBU620 00088 88 FA-STAT-OK-88 VALUE '00', '97'. DTSBU620 00089 88 FA-STAT-EOF-88 VALUE '10'. DTSBU620 00090 DTSBU620 00091 05 FA2-STATUS PIC X(02). DTSBU620 00092 88 FA2-STAT-OK-88 VALUE '00', '97'. DTSBU620 00093 88 FA2-STAT-EOF-88 VALUE '10'. DTSBU620 00094 DTSBU620 00095 05 PARM-STATUS PIC X(02) VALUE SPACES. DTSBU620 00096 88 PARM-FILE-OK-88 VALUE ZEROS. DTSBU620 00097 88 PARM-FILE-EOF-88 VALUE '10'. DTSBU620 00098 DTSBU620 00099 05 WRK-ERROR-IND PIC X(01). DTSBU620 00100 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBU620 00101 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBU620 00102 DTSBU620 00103 05 WRK-EMP-NO-IND PIC X(01). DTSBU620 00104 88 WRK-EMP-NO-INVALID-88 VALUE 'N'. DTSBU620 00105 88 WRK-EMP-NO-VALID-88 VALUE 'Y'. DTSBU620 00106 DTSBU620 00107 05 WRK-FISC-AGNT-IND PIC X(01). DTSBU620 00108 88 WRK-FISC-AGNT-VALID-88 VALUE 'Y'. DTSBU620 00109 88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'. DTSBU620 00110 DTSBU620 00111 05 WRK-CURR-EMP-NO PIC X(06) VALUE SPACES. DTSBU620 00112 05 WRK-CURR-EMP-NO-9 REDEFINES WRK-CURR-EMP-NO DTSBU620 00113 PIC 9(06). DTSBU620 00114 05 WRK-CURR-FISC-AGNT-NAME PIC X(35) VALUE SPACES. DTSBU620 00115 DTSBU620 00116 05 WRK-NEW-EMP-NO PIC X(06) VALUE SPACES. DTSBU620 00117 05 WRK-NEW-FISC-AGNT-NAME PIC X(35) VALUE SPACES. DTSBU620 00118 DTSBU620 00119 05 WRK-FISCAL-AGENT-CD PIC X(03) VALUE SPACES. DTSBU620 00120 DTSBU620 00121 EJECT DTSBU620 00122 DTSBU620 00123 PROCEDURE DIVISION. DTSBU620 00124 DTSBU620 00125 DTSBD591-MAIN. DTSBU620 00126 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBU620 00127 IF WRK-ERROR-YES-88 DTSBU620 00128 GO TO DTSBD591-MAIN-EXIT. DTSBU620 00129 DTSBU620 00130 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU620 00131 DTSBU620 00132 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBU620 00133 DTSBU620 00134 DTSBD591-MAIN-EXIT. DTSBU620 00135 GOBACK. DTSBU620 00136 EJECT DTSBU620 00137 DTSBU620 00138 I0000-INITIATE. DTSBU620 00139 MOVE +0 TO WRK-FA-READ-CNT DTSBU620 00140 WRK-ERROR-CNT. DTSBU620 00141 DTSBU620 00142 SET WRK-ERROR-NO-88 TO TRUE. DTSBU620 00143 DTSBU620 00144 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBU620 00145 IF WRK-ERROR-YES-88 DTSBU620 00146 GO TO I0000-EXIT. DTSBU620 00147 DTSBU620 00148 I0000-EXIT. DTSBU620 00149 EXIT. DTSBU620 00150 DTSBU620 00151 I1000-OPEN-FILES. DTSBU620 00152 PERFORM S950-OPEN-FA-FILE THRU S950-EXIT. DTSBU620 00153 IF NOT FA-STAT-OK-88 DTSBU620 00154 DISPLAY 'CANNOT OPEN FISCAL AGENT FILE ' FA-STATUS DTSBU620 00155 SET WRK-ERROR-YES-88 TO TRUE DTSBU620 00156 GO TO I1000-EXIT. DTSBU620 00157 DTSBU620 00158 PERFORM S960-OPEN-OUTPUT-FA-FILE THRU S960-EXIT. DTSBU620 00159 IF NOT FA2-STAT-OK-88 DTSBU620 00160 DISPLAY 'CANNOT OPEN OUTPUT FISCAL AGENT FILE ' FA2-STATUSDTSBU620 00161 SET WRK-ERROR-YES-88 TO TRUE DTSBU620 00162 GO TO I1000-EXIT. DTSBU620 00163 DTSBU620 00164 OPEN INPUT PARM-FILE. DTSBU620 00165 IF NOT PARM-FILE-OK-88 DTSBU620 00166 DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS DTSBU620 00167 SET WRK-ERROR-YES-88 TO TRUE DTSBU620 00168 GO TO I1000-EXIT. DTSBU620 00169 DTSBU620 00170 READ PARM-FILE. DTSBU620 00171 IF NOT PARM-FILE-OK-88 DTSBU620 00172 DISPLAY 'PARM FILE READ ERROR: ' PARM-STATUS DTSBU620 00173 SET WRK-ERROR-YES-88 TO TRUE DTSBU620 00174 GO TO I1000-EXIT. DTSBU620 00175 DTSBU620 00176 DISPLAY '***** DTSBU620 PARM RECORD *****'. DTSBU620 00177 DISPLAY PARM-REC. DTSBU620 00178 DISPLAY SPACE. DTSBU620 00179 DISPLAY '***** DTSBU620 EDITED PARMS ****'. DTSBU620 00180 DISPLAY SPACE. DTSBU620 00181 DTSBU620 00182 PERFORM I1100-EDIT-PARM-RUN-AGENT-CD THRU I1100-EXIT. DTSBU620 00183 CLOSE PARM-FILE. DTSBU620 00184 DTSBU620 00185 I1000-EXIT. DTSBU620 00186 EXIT. DTSBU620 00187 DTSBU620 00188 I1100-EDIT-PARM-RUN-AGENT-CD. DTSBU620 00189 IF PARM-RUN-FISCAL-AGENT-CD = 'ADP' DTSBU620 00190 MOVE 'ADP' TO WRK-FISCAL-AGENT-CD DTSBU620 00191 ELSE DTSBU620 00192 IF PARM-RUN-FISCAL-AGENT-CD = 'CER' DTSBU620 00193 MOVE 'CER' TO WRK-FISCAL-AGENT-CD DTSBU620 00194 ELSE DTSBU620 00195 IF PARM-RUN-FISCAL-AGENT-CD = 'PB ' DTSBU620 00196 MOVE 'PB ' TO WRK-FISCAL-AGENT-CD DTSBU620 00197 ELSE DTSBU620 00198 IF PARM-RUN-FISCAL-AGENT-CD = 'PAI' DTSBU620 00199 MOVE 'PAI' TO WRK-FISCAL-AGENT-CD DTSBU620 00200 ELSE DTSBU620 00201 IF PARM-RUN-FISCAL-AGENT-CD = 'PC ' DTSBU620 00202 MOVE 'PC ' TO WRK-FISCAL-AGENT-CD DTSBU620 00203 ELSE DTSBU620 00204 IF PARM-RUN-FISCAL-AGENT-CD = 'ADA' DTSBU620 00205 MOVE 'ADA' TO WRK-FISCAL-AGENT-CD DTSBU620 00206 ELSE DTSBU620 00207 IF PARM-RUN-FISCAL-AGENT-CD = 'PER' DTSBU620 00208 MOVE 'PER' TO WRK-FISCAL-AGENT-CD DTSBU620 00209 ELSE DTSBU620 00210 IF PARM-RUN-FISCAL-AGENT-CD = 'PP ' DTSBU620 00211 MOVE 'PP ' TO WRK-FISCAL-AGENT-CD DTSBU620 00212 ELSE DTSBU620 00213 DISPLAY 'INVALID PARM RUN FISCAL AGENT CD' DTSBU620 00214 PERFORM S999-ABEND THRU S999-EXIT DTSBU620 00215 GO TO I1100-EXIT. DTSBU620 00216 DTSBU620 00217 I1100-EXIT. DTSBU620 00218 EXIT. DTSBU620 00219 DTSBU620 00220 P0000-PROCESS. DTSBU620 00221 DISPLAY 'MAINTAIN FISCAL AGENT/EMPLOYER RECORDS'. DTSBU620 00222 DISPLAY SPACE. DTSBU620 00223 DTSBU620 00224 PERFORM P1000-PROCESS-FA-FILE THRU P1000-EXIT DTSBU620 00225 UNTIL NOT FA-STAT-OK-88. DTSBU620 00226 DTSBU620 00227 P0000-EXIT. DTSBU620 00228 EXIT. DTSBU620 00229 DTSBU620 00230 P1000-PROCESS-FA-FILE. DTSBU620 00231 PERFORM S951-READ-FA-FILE THRU S951-EXIT. DTSBU620 00232 IF FA-STAT-OK-88 DTSBU620 00233 ADD +1 TO WRK-FA-READ-CNT DTSBU620 00234 ELSE DTSBU620 00235 IF FA-STAT-EOF-88 DTSBU620 00236 DISPLAY 'FA EOF ' FA-STATUS DTSBU620 00237 GO TO P1000-EXIT DTSBU620 00238 ELSE DTSBU620 00239 DISPLAY 'UNEXPECTED FA INPUT FILE STATUS ' FA-STATUS DTSBU620 00240 GO TO P1000-EXIT DTSBU620 00241 END-IF DTSBU620 00242 END-IF. DTSBU620 00243 DTSBU620 00244 PERFORM P1200-OUTPUT-RECORDS THRU P1200-EXIT. DTSBU620 00245 DTSBU620 00246 P1000-EXIT. DTSBU620 00247 EXIT. DTSBU620 00248 DTSBU620 00249 P1200-OUTPUT-RECORDS. DTSBU620 00250 DTSBU620 00251 SET WRK-EMP-NO-INVALID-88 TO TRUE. DTSBU620 00252 DTSBU620 00253 MOVE 'UC30 ' TO WRK-XFAQ-REC-TYPE. DTSBU620 00254 MOVE XFARI-EMP-NO TO WRK-XFAQ-EMP-NO. DTSBU620 00255 MOVE XFARI-EMP-FEIN TO WRK-XFAQ-EMP-FEIN. DTSBU620 00256 MOVE WRK-FISCAL-AGENT-CD TO WRK-XFAQ-FISCAL-AGENT-CD. DTSBU620 00257 PERFORM S961-WRITE-FA-FILE THRU S961-EXIT DTSBU620 00258 DTSBU620 00259 IF FA2-STAT-OK-88 DTSBU620 00260 NEXT SENTENCE DTSBU620 00261 ELSE DTSBU620 00262 DISPLAY 'UNEXPECTED FA OUTPUT FILE STATUS ' FA2-STATUS DTSBU620 00263 PERFORM S999-ABEND THRU S999-EXIT DTSBU620 00264 END-IF. DTSBU620 00265 DTSBU620 00266 P1200-EXIT. DTSBU620 00267 EXIT. DTSBU620 00268 DTSBU620 00269 T0000-TERMINATE. DTSBU620 00270 DTSBU620 00271 DISPLAY ' '. DTSBU620 00272 DTSBU620 00273 DISPLAY '*** DTSBU620 TERMINATION STATISTICS ***'. DTSBU620 00274 DTSBU620 00275 DISPLAY ' '. DTSBU620 00276 DTSBU620 00277 DISPLAY 'NUMBER OF FISCAL AGENT INPUT RECORDS READ: 'DTSBU620 00278 WRK-FA-READ-CNT. DTSBU620 00279 DTSBU620 00280 DISPLAY 'NUMBER OF UC30 FA OUTPUT RECORDS WRITTEN: 'DTSBU620 00281 WRK-FA-WRITE-CNT. DTSBU620 00282 DTSBU620 00283 DISPLAY 'NUMBER OF INPUT ERRORS: 'DTSBU620 00284 WRK-ERROR-CNT. DTSBU620 00285 DTSBU620 00286 PERFORM S952-CLOSE-FA-FILE THRU S952-EXIT. DTSBU620 00287 PERFORM S962-CLOSE-FA-FILE THRU S962-EXIT. DTSBU620 00288 DTSBU620 00289 T0000-EXIT. DTSBU620 00290 EXIT. DTSBU620 00291 EJECT DTSBU620 00292 DTSBU620 00293 S950-OPEN-FA-FILE. DTSBU620 00294 OPEN INPUT FISCAL-AGENT-FILE1. DTSBU620 00295 DTSBU620 00296 S950-EXIT. DTSBU620 00297 EXIT. DTSBU620 00298 DTSBU620 00299 S951-READ-FA-FILE. DTSBU620 00300 READ FISCAL-AGENT-FILE1 AT END DTSBU620 00301 SET FA-STAT-EOF-88 TO TRUE. DTSBU620 00302 DTSBU620 00303 S951-EXIT. DTSBU620 00304 EXIT. DTSBU620 00305 DTSBU620 00306 S952-CLOSE-FA-FILE. DTSBU620 00307 CLOSE FISCAL-AGENT-FILE1. DTSBU620 00308 DTSBU620 00309 S952-EXIT. DTSBU620 00310 EXIT. DTSBU620 00311 DTSBU620 00312 S960-OPEN-OUTPUT-FA-FILE. DTSBU620 00313 OPEN OUTPUT FISCAL-AGENT-FILE2. DTSBU620 00314 DTSBU620 00315 S960-EXIT. DTSBU620 00316 EXIT. DTSBU620 00317 DTSBU620 00318 S961-WRITE-FA-FILE. DTSBU620 00319 WRITE FISCAL-AGENT-REC2 FROM DTSBU620 00320 WRK-FISCAL-AGENT-REC2. DTSBU620 00321 ADD 1 TO WRK-FA-WRITE-CNT. DTSBU620 00322 DTSBU620 00323 S961-EXIT. DTSBU620 00324 EXIT. DTSBU620 00325 DTSBU620 00326 S962-CLOSE-FA-FILE. DTSBU620 00327 CLOSE FISCAL-AGENT-FILE2. DTSBU620 00328 DTSBU620 00329 S962-EXIT. DTSBU620 00330 EXIT. DTSBU620 00331 DTSBU620 00332 S999-ABEND. DTSBU620 00333 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU620 00334 S999-EXIT. DTSBU620 00335 EXIT. DTSBU620