337 lines
27 KiB
COBOL
337 lines
27 KiB
COBOL
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
|