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