DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
869
Batch/DESBD420.cob
Normal file
869
Batch/DESBD420.cob
Normal file
@ -0,0 +1,869 @@
|
||||
00001 IDENTIFICATION DIVISION. 11/01/13
|
||||
00002 PROGRAM-ID. DESBD420. DESBD420
|
||||
00003 AUTHOR. NGC. LV003
|
||||
00004 DATE-WRITTEN. NOVEMBER 2011. DESBD420
|
||||
00005 DATE-COMPILED. DESBD420
|
||||
00006 DESBD420
|
||||
00007 ***** DESBD420
|
||||
00008 * DESBD420
|
||||
00009 * DESBD420
|
||||
00010 * FUNCTION: EDIT DATA FROM DAILY W4 TRANSACTIONS. DESBD420
|
||||
00011 * IF ALL RECORDS PASS THE EDITS, THE FILE DESBD420
|
||||
00012 * IS FORWARDED TO DESBD421, WHICH LOCATES DESBD420
|
||||
00013 * THE TAX REPORT AND RELEASES THE WAGES. DESBD420
|
||||
00014 * DESBD420
|
||||
00015 * MODIFICATION HISTORY: DESBD420
|
||||
00016 * DESBD420
|
||||
00017 * 11/22/2011 INITIAL DEVELOPMENT DESBD420
|
||||
00018 * REFERENCE: PROGRAMMER: GD DESBD420
|
||||
00019 * DESBD420
|
||||
00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD420
|
||||
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD420
|
||||
00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD420
|
||||
00023 * DESBD420
|
||||
00024 * DESCRIPTION: DESBD420
|
||||
00025 * DESBD420
|
||||
00026 * DESBD420
|
||||
00027 * RECORDS READ: DESBD420
|
||||
00028 * W4 TRANSACTIONS FROM TDEC. DESBD420
|
||||
00029 * DESBD420
|
||||
00030 * PRINTED OUTPUTS: DESBD420
|
||||
00031 * NONE DESBD420
|
||||
00032 * DESBD420
|
||||
00033 * RECORDS WRITTEN: DESBD420
|
||||
00034 * W001 WAGE RECORD DESBD420
|
||||
00035 * WXXX MISSING SSN RECORD DESBD420
|
||||
00036 * DESBD420
|
||||
00037 * MODULES CALLED: DESBD420
|
||||
00038 * NONE DESBD420
|
||||
00039 * DESBD420
|
||||
00040 ***** DESBD420
|
||||
00041 DESBD420
|
||||
00042 ENVIRONMENT DIVISION. DESBD420
|
||||
00043 SKIP2 DESBD420
|
||||
00044 INPUT-OUTPUT SECTION. DESBD420
|
||||
00045 SKIP3 DESBD420
|
||||
00046 FILE-CONTROL. DESBD420
|
||||
00047 SELECT TDEC-TRAN-IN ASSIGN TO DTSFTDIN DESBD420
|
||||
00048 FILE STATUS IS TDEC-IN-STATUS. DESBD420
|
||||
00049 DESBD420
|
||||
00050 SELECT TDEC-TRAN-OUT ASSIGN TO DTSFTDO DESBD420
|
||||
00051 FILE STATUS IS TDEC-OUT-STATUS. DESBD420
|
||||
00052 DESBD420
|
||||
00053 DATA DIVISION. DESBD420
|
||||
00054 DESBD420
|
||||
00055 FILE SECTION. DESBD420
|
||||
00056 DESBD420
|
||||
00057 FD TDEC-TRAN-IN DESBD420
|
||||
00058 RECORDING MODE IS F DESBD420
|
||||
00059 LABEL RECORDS ARE STANDARD DESBD420
|
||||
00060 BLOCK CONTAINS 0 CHARACTERS. DESBD420
|
||||
00061 SKIP1 DESBD420
|
||||
00062 01 TDEC-TRAN-IN-REC. DESBD420
|
||||
00063 ++INCLUDE DTSIX154 DESBD420
|
||||
00064 DESBD420
|
||||
00065 FD TDEC-TRAN-OUT DESBD420
|
||||
00066 RECORDING MODE IS F DESBD420
|
||||
00067 LABEL RECORDS ARE STANDARD DESBD420
|
||||
00068 BLOCK CONTAINS 0 CHARACTERS. DESBD420
|
||||
00069 SKIP1 DESBD420
|
||||
00070 01 TDEC-TRAN-OUT-REC PIC X(106). DESBD420
|
||||
00071 DESBD420
|
||||
00072 WORKING-STORAGE SECTION. DESBD420
|
||||
000725 77 PAN-VALET PICTURE X(24) VALUE '003DESBD420 11/01/13'. DESBD420
|
||||
00073 77 PAN-VALET PICTURE X(24) VALUE '003DESBD420 10/30/13'. DESBD420
|
||||
00074 77 PAN-VALET PICTURE X(24) VALUE '001DESBD420 02/08/13'. DESBD420
|
||||
00075 77 PAN-VALET PICTURE X(24) VALUE '057DESBD420 01/14/13'. DESBD420
|
||||
00076 SKIP3 DESBD420
|
||||
00077 01 W-AREA. DESBD420
|
||||
00078 05 W-MOD-NAME PIC X(08) VALUE 'DESBD420'. DESBD420
|
||||
00079 05 WRK-ABEND-CD PIC X(03) VALUE '420'. DESBD420
|
||||
00080 05 W-TRACE-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00081 DESBD420
|
||||
00082 05 W-ERROR-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00083 88 W-ERROR-YES-88 VALUE 'Y'. DESBD420
|
||||
00084 88 W-ERROR-NO-88 VALUE 'N'. DESBD420
|
||||
00085 DESBD420
|
||||
00086 05 TDEC-IN-STATUS PIC X(02) VALUE SPACES. DESBD420
|
||||
00087 88 TDEC-IN-OK-88 VALUE '00'. DESBD420
|
||||
00088 88 TDEC-IN-EOF-88 VALUE '10'. DESBD420
|
||||
00089 DESBD420
|
||||
00090 05 WRK-RUN-TYPE PIC X(01). DESBD420
|
||||
00091 88 WRK-RUN-ONTIME-88 VALUE 'O'. DESBD420
|
||||
00092 88 WRK-RUN-DELINQ-88 VALUE 'D'. DESBD420
|
||||
00093 DESBD420
|
||||
00094 05 TDEC-OUT-STATUS PIC X(02) VALUE SPACES. DESBD420
|
||||
00095 88 TDEC-OUT-OK-88 VALUE '00'. DESBD420
|
||||
00096 DESBD420
|
||||
00097 05 W-WAGE-REC-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00098 88 W-WAGE-REC-ERR-YES-88 VALUE 'Y'. DESBD420
|
||||
00099 88 W-WAGE-REC-ERR-NO-88 VALUE 'N'. DESBD420
|
||||
00100 DESBD420
|
||||
00101 05 W-EMP-NBR-ERR-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00102 88 W-EMP-NBR-ERR-YES-88 VALUE 'Y'. DESBD420
|
||||
00103 88 W-EMP-NBR-ERR-NO-88 VALUE 'N'. DESBD420
|
||||
00104 DESBD420
|
||||
00105 05 W-QTR-ERR-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00106 88 W-QTR-ERR-YES-88 VALUE 'Y'. DESBD420
|
||||
00107 88 W-QTR-ERR-NO-88 VALUE 'N'. DESBD420
|
||||
00108 DESBD420
|
||||
00109 05 W-SSN-ERR-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00110 88 W-SSN-ERR-YES-88 VALUE 'Y'. DESBD420
|
||||
00111 88 W-SSN-ERR-NO-88 VALUE 'N'. DESBD420
|
||||
00112 DESBD420
|
||||
00113 05 W-BATCH-ERR-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00114 88 W-BATCH-ERR-YES-88 VALUE 'Y'. DESBD420
|
||||
00115 88 W-BATCH-ERR-NO-88 VALUE 'N'. DESBD420
|
||||
00116 DESBD420
|
||||
00117 05 W-EMP-NBR-CHNG-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00118 88 W-EMP-NBR-CHNG-YES-88 VALUE 'Y'. DESBD420
|
||||
00119 88 W-EMP-NBR-CHNG-NO-88 VALUE 'N'. DESBD420
|
||||
00120 DESBD420
|
||||
00121 05 W-WAGE-ERR-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00122 88 W-WAGE-ERR-YES-88 VALUE 'Y'. DESBD420
|
||||
00123 88 W-WAGE-ERR-NO-88 VALUE 'N'. DESBD420
|
||||
00124 DESBD420
|
||||
00125 05 W-WAGE-ON-FILE-IND PIC X(01) VALUE 'N'. DESBD420
|
||||
00126 88 W-WAGE-ON-FILE-YES-88 VALUE 'Y'. DESBD420
|
||||
00127 88 W-WAGE-ON-FILE-NO-88 VALUE 'N'. DESBD420
|
||||
00128 DESBD420
|
||||
00129 05 WRK-RETURN-CODE PIC S9(04) COMP-3 VALUE +0. DESBD420
|
||||
00130 05 W-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00131 05 W-FEIN-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00132 05 W-LAST-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00133 05 W-ESTB-DATE PIC S9(09) COMP-3 VALUE +0. DESBD420
|
||||
00134 DESBD420
|
||||
00135 05 W-YRQ PIC S9(05) COMP-3 VALUE +0. DESBD420
|
||||
00136 DESBD420
|
||||
00137 05 W-CURR-YRQ PIC S9(05) COMP-3 VALUE +0. DESBD420
|
||||
00138 DESBD420
|
||||
00139 05 SUB2 PIC S9(04) COMP VALUE +0. DESBD420
|
||||
00140 05 W-ACCT-NBR-LEN PIC S9(04) COMP VALUE +6. DESBD420
|
||||
00141 05 W-ACCT-NBR-IN. DESBD420
|
||||
00142 10 W-ACCT-NBR-IN-X OCCURS 6 TIMES DESBD420
|
||||
00143 PIC X(01). DESBD420
|
||||
00144 05 W-ACCT-NBR-9 REDEFINES W-ACCT-NBR-IN DESBD420
|
||||
00145 PIC 9(06). DESBD420
|
||||
00146 DESBD420
|
||||
00147 05 W-SSN-LEN PIC S9(04) COMP VALUE +9. DESBD420
|
||||
00148 05 W-SSN-IN. DESBD420
|
||||
00149 10 W-SSN-IN-X OCCURS 9 TIMES DESBD420
|
||||
00150 PIC X(01). DESBD420
|
||||
00151 05 W-SSN-9 REDEFINES W-SSN-IN DESBD420
|
||||
00152 PIC 9(09). DESBD420
|
||||
00153 DESBD420
|
||||
00154 05 W-ALL-NINES PIC 9(09) VALUE 999999999. DESBD420
|
||||
00155 DESBD420
|
||||
00156 05 W-TDEC-IN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00157 05 W-TDEC-OUT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00158 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00159 05 W-REPORT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00160 05 W-SSN-ON-FILE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420
|
||||
00161 DESBD420
|
||||
00162 05 AMT-DISP1 PIC ----------9.99. DESBD420
|
||||
00163 05 AMT-DISP2 PIC ----------9.99. DESBD420
|
||||
00164 05 AMT-DISP3 PIC ----------9.99. DESBD420
|
||||
00165 05 AMT-DISP4 PIC ----------9.99. DESBD420
|
||||
00166 DESBD420
|
||||
00167 01 W001-REC. DESBD420
|
||||
00168 ++INCLUDE DTSIW001 DESBD420
|
||||
00169 DESBD420
|
||||
00170 DESBD420
|
||||
00171 01 L001-LINK-AREA. DESBD420
|
||||
00172 ++INCLUDE DTSIL001 DESBD420
|
||||
00173 DESBD420
|
||||
00174 01 L004-LINK-AREA. DESBD420
|
||||
00175 ++INCLUDE DTSIL004 DESBD420
|
||||
00176 DESBD420
|
||||
00177 01 L005-LINK-AREA. DESBD420
|
||||
00178 ++INCLUDE DTSIL005 DESBD420
|
||||
00179 DESBD420
|
||||
00180 01 L516-LINK-AREA. DESBD420
|
||||
00181 ++INCLUDE DTSIL516 DESBD420
|
||||
00182 DESBD420
|
||||
00183 01 L910-LINK-AREA. DESBD420
|
||||
00184 ++INCLUDE DTSIL910 DESBD420
|
||||
00185 DESBD420
|
||||
00186 01 MSKL-REC. DESBD420
|
||||
00187 ++INCLUDE DTSIMSKL DESBD420
|
||||
00188 DESBD420
|
||||
00189 01 MHDR-REC. DESBD420
|
||||
00190 ++INCLUDE DTSIMHDR DESBD420
|
||||
00191 DESBD420
|
||||
00192 01 MPRF-REC. DESBD420
|
||||
00193 ++INCLUDE DTSIMPRF DESBD420
|
||||
00194 DESBD420
|
||||
00195 01 MRPT-REC. DESBD420
|
||||
00196 ++INCLUDE DTSIMRPT DESBD420
|
||||
00197 DESBD420
|
||||
00198 01 MPAY-REC. DESBD420
|
||||
00199 ++INCLUDE DTSIMPAY DESBD420
|
||||
00200 DESBD420
|
||||
00201 01 L923-LINK-AREA. DESBD420
|
||||
00202 ++INCLUDE DTSIL923 DESBD420
|
||||
00203 DESBD420
|
||||
00204 01 ASKL-REC. DESBD420
|
||||
00205 ++INCLUDE DTSIASKL DESBD420
|
||||
00206 DESBD420
|
||||
00207 01 AHDR-REC. DESBD420
|
||||
00208 ++INCLUDE DTSIAHDR DESBD420
|
||||
00209 DESBD420
|
||||
00210 01 ARPT-REC. DESBD420
|
||||
00211 ++INCLUDE DTSIARPT DESBD420
|
||||
00212 EJECT DESBD420
|
||||
00213 01 AATX-REC. DESBD420
|
||||
00214 ++INCLUDE DTSIAATX DESBD420
|
||||
00215 DESBD420
|
||||
00216 01 APAY-REC. DESBD420
|
||||
00217 ++INCLUDE DTSIAPAY DESBD420
|
||||
00218 DESBD420
|
||||
00219 01 L921-LINK-AREA. DESBD420
|
||||
00220 ++INCLUDE DTSIL921 DESBD420
|
||||
00221 SKIP3 DESBD420
|
||||
00222 01 ISKL-REC. DESBD420
|
||||
00223 ++INCLUDE DTSIISKL DESBD420
|
||||
00224 SKIP3 DESBD420
|
||||
00225 01 IEIN-REC. DESBD420
|
||||
00226 ++INCLUDE DTSIIEIN DESBD420
|
||||
00227 DESBD420
|
||||
00228 01 L981-LINK-AREA. DESBD420
|
||||
00229 ++INCLUDE DTSIL981 DESBD420
|
||||
00230 SKIP3 DESBD420
|
||||
00231 01 WWGH-REC. DESBD420
|
||||
00232 ++INCLUDE DTSIWWGH DESBD420
|
||||
00233 LINKAGE SECTION. DESBD420
|
||||
00234 DESBD420
|
||||
00235 01 PARM-AREA. DESBD420
|
||||
00236 05 PARM-LENGTH PIC S9(04) COMP. DESBD420
|
||||
00237 DESBD420
|
||||
00238 05 PARM-DATA. DESBD420
|
||||
00239 10 PARM-RUN-TYPE PIC X(06). DESBD420
|
||||
00240 88 PARM-RUN-ONTIME-88 VALUE 'ONTIME'. DESBD420
|
||||
00241 88 PARM-RUN-DELINQ-88 VALUE 'DELINQ'. DESBD420
|
||||
00242 DESBD420
|
||||
00243 DESBD420
|
||||
00244 PROCEDURE DIVISION USING PARM-AREA. DESBD420
|
||||
00245 DESBD420
|
||||
00246 DESBD420-MAIN. DESBD420
|
||||
00247 PERFORM I0000-INIT THRU I0000-EXIT. DESBD420
|
||||
00248 IF W-ERROR-YES-88 DESBD420
|
||||
00249 GO TO DESBD420-MAIN-EXIT. DESBD420
|
||||
00250 DESBD420
|
||||
00251 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD420
|
||||
00252 DESBD420
|
||||
00253 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD420
|
||||
00254 MOVE WRK-RETURN-CODE TO RETURN-CODE. DESBD420
|
||||
00255 DESBD420-MAIN-EXIT. DESBD420
|
||||
00256 GOBACK. DESBD420
|
||||
00257 DESBD420
|
||||
00258 I0000-INIT. DESBD420
|
||||
00259 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD420
|
||||
00260 MOVE L005-DATE TO L004-DATE. DESBD420
|
||||
00261 PERFORM S004-FROM-DATE THRU S004-EXIT. DESBD420
|
||||
00262 MOVE L004-QTR-5-9 TO W-CURR-YRQ. DESBD420
|
||||
00263 DESBD420
|
||||
00264 IF PARM-LENGTH = +6 DESBD420
|
||||
00265 NEXT SENTENCE DESBD420
|
||||
00266 ELSE DESBD420
|
||||
00267 DISPLAY 'PARM-LENGTH NOT EQUAL TO 6 ' PARM-LENGTH DESBD420
|
||||
00268 PERFORM S999-ABEND THRU S999-EXIT DESBD420
|
||||
00269 END-IF. DESBD420
|
||||
00270 DESBD420
|
||||
00271 IF PARM-RUN-ONTIME-88 DESBD420
|
||||
00272 OR PARM-RUN-DELINQ-88 DESBD420
|
||||
00273 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DESBD420
|
||||
00274 ELSE DESBD420
|
||||
00275 DISPLAY 'INVALID PARM TYPE ' PARM-RUN-TYPE DESBD420
|
||||
00276 PERFORM S999-ABEND THRU S999-EXIT. DESBD420
|
||||
00277 DESBD420
|
||||
00278 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD420
|
||||
00279 DESBD420
|
||||
00280 I0000-EXIT. DESBD420
|
||||
00281 EXIT. DESBD420
|
||||
00282 DESBD420
|
||||
00283 I2000-OPEN-FILES. DESBD420
|
||||
00284 PERFORM S1000-OPEN-TDEC-IN THRU S1000-EXIT. DESBD420
|
||||
00285 IF W-ERROR-YES-88 DESBD420
|
||||
00286 GO TO I2000-EXIT DESBD420
|
||||
00287 END-IF. DESBD420
|
||||
00288 DESBD420
|
||||
00289 PERFORM S1100-OPEN-TDEC-OUT THRU S1100-EXIT. DESBD420
|
||||
00290 IF W-ERROR-YES-88 DESBD420
|
||||
00291 GO TO I2000-EXIT DESBD420
|
||||
00292 END-IF. DESBD420
|
||||
00293 DESBD420
|
||||
00294 PERFORM S910A-OPEN-READ THRU S910A-EXIT. DESBD420
|
||||
00295 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD420
|
||||
00296 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DESBD420
|
||||
00297 DESBD420
|
||||
00298 I2000-EXIT. DESBD420
|
||||
00299 EXIT. DESBD420
|
||||
00300 DESBD420
|
||||
00301 P0000-PROCESS. DESBD420
|
||||
00302 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT. DESBD420
|
||||
00303 IF TDEC-IN-EOF-88 DESBD420
|
||||
00304 DISPLAY 'WAGE INPUT FILE IS EMPTY ' DESBD420
|
||||
00305 MOVE +3 TO WRK-RETURN-CODE DESBD420
|
||||
00306 GO TO P0000-EXIT DESBD420
|
||||
00307 END-IF. DESBD420
|
||||
00308 DESBD420
|
||||
00309 PERFORM UNTIL TDEC-IN-EOF-88 DESBD420
|
||||
00310 PERFORM P1000-WAGE-EDIT THRU P1000-EXIT DESBD420
|
||||
00311 IF W-WAGE-REC-ERR-NO-88 DESBD420
|
||||
00312 PERFORM S1120-WRITE-TDEC-OUT THRU S1120-EXIT DESBD420
|
||||
00313 END-IF DESBD420
|
||||
00314 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT DESBD420
|
||||
00315 END-PERFORM. DESBD420
|
||||
00316 DESBD420
|
||||
00317 DESBD420
|
||||
00318 P0000-EXIT. DESBD420
|
||||
00319 EXIT. DESBD420
|
||||
00320 DESBD420
|
||||
00321 P1000-WAGE-EDIT. DESBD420
|
||||
00322 SET W-WAGE-REC-ERR-NO-88 TO TRUE. DESBD420
|
||||
00323 DESBD420
|
||||
00324 PERFORM P1100-EDIT-EMP-NBR THRU P1100-EXIT. DESBD420
|
||||
00325 PERFORM P1200-EDIT-QTR THRU P1200-EXIT. DESBD420
|
||||
00326 PERFORM P1300-EDIT-SSN THRU P1300-EXIT. DESBD420
|
||||
00327 PERFORM P1400-EDIT-WAGES THRU P1400-EXIT. DESBD420
|
||||
00328 PERFORM P1500-EDIT-BATCH THRU P1500-EXIT. DESBD420
|
||||
00329 DESBD420
|
||||
00330 *** PERFORM P1600-WAGES-ON-FILE THRU P1600-EXIT. DESBD420
|
||||
00331 DESBD420
|
||||
00332 IF W-EMP-NBR-ERR-YES-88 DESBD420
|
||||
00333 OR W-QTR-ERR-YES-88 DESBD420
|
||||
00334 OR W-SSN-ERR-YES-88 DESBD420
|
||||
00335 OR W-WAGE-ERR-YES-88 DESBD420
|
||||
00336 ** OR W-WAGE-ON-FILE-YES-88 DESBD420
|
||||
00337 SET W-WAGE-REC-ERR-YES-88 TO TRUE DESBD420
|
||||
00338 ADD +1 TO W-ERROR-CNT DESBD420
|
||||
00339 DISPLAY 'ERROR: ' X154-EMP-NO ' ' X154-QUARTER DESBD420
|
||||
00340 MOVE +2 TO WRK-RETURN-CODE DESBD420
|
||||
00341 END-IF. DESBD420
|
||||
00342 DESBD420
|
||||
00343 IF W-EMP-NBR-ERR-NO-88 DESBD420
|
||||
00344 AND W-QTR-ERR-NO-88 DESBD420
|
||||
00345 IF X154-EMP-NO = W-EMP-NO DESBD420
|
||||
00346 AND X154-QUARTER = W-YRQ DESBD420
|
||||
00347 NEXT SENTENCE DESBD420
|
||||
00348 ELSE DESBD420
|
||||
00349 ADD +1 TO W-REPORT-CNT DESBD420
|
||||
00350 MOVE X154-EMP-NO TO W-EMP-NO DESBD420
|
||||
00351 MOVE X154-QUARTER TO W-YRQ DESBD420
|
||||
00352 END-IF DESBD420
|
||||
00353 END-IF. DESBD420
|
||||
00354 DESBD420
|
||||
00355 P1000-EXIT. DESBD420
|
||||
00356 EXIT. DESBD420
|
||||
00357 DESBD420
|
||||
00358 P1100-EDIT-EMP-NBR. DESBD420
|
||||
00359 SET W-EMP-NBR-ERR-NO-88 TO TRUE. DESBD420
|
||||
00360 DESBD420
|
||||
00361 INSPECT X154-EMP-NO REPLACING ALL SPACES BY ZEROS. DESBD420
|
||||
00362 DESBD420
|
||||
00363 MOVE X154-EMP-NO TO W-ACCT-NBR-IN. DESBD420
|
||||
00364 DESBD420
|
||||
00365 PERFORM DESBD420
|
||||
00366 VARYING SUB2 FROM +1 BY +1 DESBD420
|
||||
00367 UNTIL SUB2 > W-ACCT-NBR-LEN DESBD420
|
||||
00368 IF W-ACCT-NBR-IN-X (SUB2) < '0' DESBD420
|
||||
00369 OR W-ACCT-NBR-IN-X (SUB2) > '9' DESBD420
|
||||
00370 SET W-EMP-NBR-ERR-YES-88 TO TRUE DESBD420
|
||||
00371 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420
|
||||
00372 DISPLAY 'INVALID EMPLOYER NBR: ' X154-EMP-NO DESBD420
|
||||
00373 ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420
|
||||
00374 END-IF DESBD420
|
||||
00375 END-PERFORM. DESBD420
|
||||
00376 DESBD420
|
||||
00377 IF W-EMP-NBR-ERR-NO-88 DESBD420
|
||||
00378 IF X154-EMP-NO = ZERO DESBD420
|
||||
00379 PERFORM P1110-FROM-FEIN THRU P1110-EXIT DESBD420
|
||||
00380 MOVE W-FEIN-EMP-NO TO X154-EMP-NO DESBD420
|
||||
00381 ELSE DESBD420
|
||||
00382 GO TO P1100-EXIT DESBD420
|
||||
00383 END-IF DESBD420
|
||||
00384 END-IF. DESBD420
|
||||
00385 DESBD420
|
||||
00386 IF W-FEIN-EMP-NO = ZERO DESBD420
|
||||
00387 IF X154-ITEM > 0 DESBD420
|
||||
00388 NEXT SENTENCE DESBD420
|
||||
00389 ELSE DESBD420
|
||||
00390 * SET W-EMP-NBR-ERR-YES-88 TO TRUE DESBD420
|
||||
00391 DISPLAY 'NO EMP NBR, NO FEIN, NO ITEM: ' DESBD420
|
||||
00392 ' ' X154-EMP-NO ' ' X154-FEIN ' ' X154-ITEM DESBD420
|
||||
00393 END-IF DESBD420
|
||||
00394 END-IF. DESBD420
|
||||
00395 DESBD420
|
||||
00396 P1100-EXIT. DESBD420
|
||||
00397 EXIT. DESBD420
|
||||
00398 DESBD420
|
||||
00399 P1110-FROM-FEIN. DESBD420
|
||||
00400 MOVE +0 TO W-FEIN-EMP-NO DESBD420
|
||||
00401 W-LAST-EMP-NO DESBD420
|
||||
00402 W-ESTB-DATE. DESBD420
|
||||
00403 DESBD420
|
||||
00404 MOVE LOW-VALUE TO IEIN-KEY-AREA DESBD420
|
||||
00405 SET IEIN-EIN-88 TO TRUE DESBD420
|
||||
00406 MOVE X154-FEIN TO IEIN-FEIN DESBD420
|
||||
00407 MOVE +0 TO IEIN-EMP-NO DESBD420
|
||||
00408 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DESBD420
|
||||
00409 PERFORM S921-START-BROWSE THRU S921-EXIT DESBD420
|
||||
00410 MOVE ISKL-REC TO IEIN-REC DESBD420
|
||||
00411 DESBD420
|
||||
00412 PERFORM DESBD420
|
||||
00413 UNTIL L921-NO-REC-88 DESBD420
|
||||
00414 OR W-FEIN-EMP-NO > ZERO DESBD420
|
||||
00415 IF IEIN-FEIN = X154-FEIN DESBD420
|
||||
00416 PERFORM P1111-FIND-MPRF THRU P1111-EXIT DESBD420
|
||||
00417 IF W-FEIN-EMP-NO = ZERO DESBD420
|
||||
00418 PERFORM S921-READ-NEXT THRU S921-EXIT DESBD420
|
||||
00419 MOVE ISKL-REC TO IEIN-REC DESBD420
|
||||
00420 END-IF DESBD420
|
||||
00421 ELSE DESBD420
|
||||
00422 SET L921-NO-REC-88 TO TRUE DESBD420
|
||||
00423 END-IF DESBD420
|
||||
00424 END-PERFORM. DESBD420
|
||||
00425 DESBD420
|
||||
00426 IF W-FEIN-EMP-NO = +0 DESBD420
|
||||
00427 IF W-LAST-EMP-NO > ZERO DESBD420
|
||||
00428 MOVE W-LAST-EMP-NO TO W-FEIN-EMP-NO DESBD420
|
||||
00429 END-IF DESBD420
|
||||
00430 END-IF. DESBD420
|
||||
00431 DESBD420
|
||||
00432 P1110-EXIT. DESBD420
|
||||
00433 EXIT. DESBD420
|
||||
00434 DESBD420
|
||||
00435 P1111-FIND-MPRF. DESBD420
|
||||
00436 MOVE LOW-VALUES TO MPRF-KEY-AREA. DESBD420
|
||||
00437 MOVE IEIN-EMP-NO TO MPRF-EMP-NO. DESBD420
|
||||
00438 SET MPRF-PRF-88 TO TRUE. DESBD420
|
||||
00439 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DESBD420
|
||||
00440 PERFORM S910F-READ THRU S910F-EXIT. DESBD420
|
||||
00441 IF L910-OK-88 DESBD420
|
||||
00442 MOVE MSKL-REC TO MPRF-REC DESBD420
|
||||
00443 IF MPRF-STATUS-ACT-88 DESBD420
|
||||
00444 MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DESBD420
|
||||
00445 ELSE DESBD420
|
||||
00446 IF MPRF-ESTB-DATE > W-ESTB-DATE DESBD420
|
||||
00447 MOVE MPRF-ESTB-DATE TO W-ESTB-DATE DESBD420
|
||||
00448 MOVE MPRF-EMP-NO TO W-LAST-EMP-NO DESBD420
|
||||
00449 END-IF DESBD420
|
||||
00450 END-IF DESBD420
|
||||
00451 END-IF. DESBD420
|
||||
00452 DESBD420
|
||||
00453 P1111-EXIT. DESBD420
|
||||
00454 EXIT. DESBD420
|
||||
00455 DESBD420
|
||||
00456 P1200-EDIT-QTR. DESBD420
|
||||
00457 SET W-QTR-ERR-NO-88 TO TRUE. DESBD420
|
||||
00458 DESBD420
|
||||
00459 MOVE X154-QUARTER TO L004-QTR-5-X. DESBD420
|
||||
00460 PERFORM S004-FROM-5 THRU S004-EXIT. DESBD420
|
||||
00461 IF L004-INVALID-QTR DESBD420
|
||||
00462 DISPLAY 'BAD QUARTER : ' X154-QUARTER DESBD420
|
||||
00463 SET W-WAGE-REC-ERR-YES-88 TO TRUE DESBD420
|
||||
00464 ELSE DESBD420
|
||||
00465 IF L004-QTR-5-9 > W-CURR-YRQ DESBD420
|
||||
00466 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420
|
||||
00467 DISPLAY 'FUTURE QUARTER : ' X154-EMP-NO DESBD420
|
||||
00468 ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420
|
||||
00469 SET W-QTR-ERR-YES-88 TO TRUE DESBD420
|
||||
00470 * ELSE DESBD420
|
||||
00471 * IF PARM-RUN-ONTIME-88 AND DESBD420
|
||||
00472 * L004-QTR-5-9 NOT = W-CURR-YRQ DESBD420
|
||||
00473 * MOVE X154-EARNINGS TO AMT-DISP1 DESBD420
|
||||
00474 * DISPLAY 'NOT ONTIME QUARTER : ' X154-EMP-NO DESBD420
|
||||
00475 * ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420
|
||||
00476 * ELSE DESBD420
|
||||
00477 * IF PARM-RUN-DELINQ-88 AND DESBD420
|
||||
00478 * L004-QTR-5-9 = W-CURR-YRQ DESBD420
|
||||
00479 * MOVE X154-EARNINGS TO AMT-DISP1 DESBD420
|
||||
00480 * DISPLAY 'NOT DELINQ QUARTER : ' X154-EMP-NO DESBD420
|
||||
00481 * ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420
|
||||
00482 * END-IF DESBD420
|
||||
00483 * END-IF DESBD420
|
||||
00484 END-IF DESBD420
|
||||
00485 END-IF. DESBD420
|
||||
00486 DESBD420
|
||||
00487 P1200-EXIT. DESBD420
|
||||
00488 EXIT. DESBD420
|
||||
00489 DESBD420
|
||||
00490 P1300-EDIT-SSN. DESBD420
|
||||
00491 SET W-SSN-ERR-NO-88 TO TRUE. DESBD420
|
||||
00492 DESBD420
|
||||
00493 MOVE X154-SSN TO W-SSN-IN. DESBD420
|
||||
00494 DESBD420
|
||||
00495 PERFORM DESBD420
|
||||
00496 VARYING SUB2 FROM +1 BY +1 DESBD420
|
||||
00497 UNTIL SUB2 > W-SSN-LEN DESBD420
|
||||
00498 IF W-SSN-IN-X (SUB2) < '0' DESBD420
|
||||
00499 AND W-SSN-IN-X (SUB2) > '9' DESBD420
|
||||
00500 SET W-SSN-ERR-YES-88 TO TRUE DESBD420
|
||||
00501 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420
|
||||
00502 DISPLAY 'INVALID SSN : ' X154-EMP-NO DESBD420
|
||||
00503 ' ' X154-SSN ' ' AMT-DISP1 DESBD420
|
||||
00504 END-IF DESBD420
|
||||
00505 END-PERFORM. DESBD420
|
||||
00506 DESBD420
|
||||
00507 IF X154-SSN = W-ALL-NINES DESBD420
|
||||
00508 OR X154-SSN = ZERO DESBD420
|
||||
00509 PERFORM P1310-CHECK-NAME THRU P1310-EXIT DESBD420
|
||||
00510 END-IF. DESBD420
|
||||
00511 DESBD420
|
||||
00512 P1300-EXIT. DESBD420
|
||||
00513 EXIT. DESBD420
|
||||
00514 DESBD420
|
||||
00515 P1310-CHECK-NAME. DESBD420
|
||||
00516 IF X154-LAST-NAME NOT > SPACES DESBD420
|
||||
00517 SET W-SSN-ERR-YES-88 TO TRUE DESBD420
|
||||
00518 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420
|
||||
00519 DISPLAY 'MISSING SSN - NO NAME: ' X154-EMP-NO DESBD420
|
||||
00520 ' ' X154-SSN ' ' X154-LAST-NAME DESBD420
|
||||
00521 ' ' X154-FIRST-NAME ' ' AMT-DISP1 DESBD420
|
||||
00522 END-IF. DESBD420
|
||||
00523 P1310-EXIT. DESBD420
|
||||
00524 EXIT. DESBD420
|
||||
00525 DESBD420
|
||||
00526 P1400-EDIT-WAGES. DESBD420
|
||||
00527 SET W-WAGE-ERR-NO-88 TO TRUE. DESBD420
|
||||
00528 DESBD420
|
||||
00529 IF X154-EARNINGS NOT NUMERIC DESBD420
|
||||
00530 DISPLAY 'NON-NUMERIC EARNINGS: ' X154-EMP-NO DESBD420
|
||||
00531 ' ' X154-EARNINGS DESBD420
|
||||
00532 SET W-WAGE-ERR-YES-88 TO TRUE DESBD420
|
||||
00533 END-IF. DESBD420
|
||||
00534 DESBD420
|
||||
00535 P1400-EXIT. DESBD420
|
||||
00536 EXIT. DESBD420
|
||||
00537 DESBD420
|
||||
00538 P1500-EDIT-BATCH. DESBD420
|
||||
00539 SET W-WAGE-ERR-NO-88 TO TRUE. DESBD420
|
||||
00540 DESBD420
|
||||
00541 IF X154-BATCH NOT NUMERIC DESBD420
|
||||
00542 DISPLAY 'NON-NUMERIC BATCH: ' X154-EMP-NO DESBD420
|
||||
00543 ' ' X154-BATCH DESBD420
|
||||
00544 SET W-WAGE-ERR-YES-88 TO TRUE DESBD420
|
||||
00545 END-IF. DESBD420
|
||||
00546 DESBD420
|
||||
00547 DESBD420
|
||||
00548 P1500-EXIT. DESBD420
|
||||
00549 EXIT. DESBD420
|
||||
00550 DESBD420
|
||||
00551 *P1700-WAGES-ON-FILE. DESBD420
|
||||
00552 * SET W-WAGE-ON-FILE-NO-88 TO TRUE. DESBD420
|
||||
00553 * DESBD420
|
||||
00554 * MOVE LOW-VALUES TO WWGH-KEY-AREA. DESBD420
|
||||
00555 * MOVE W-EMP-NO TO WWGH-EMP-NO. DESBD420
|
||||
00556 * MOVE W-YRQ TO WWGH-YRQ. DESBD420
|
||||
00557 * MOVE T-IN-SSN TO WWGH-SSN. DESBD420
|
||||
00558 * DESBD420
|
||||
00559 * PERFORM S981F-READ THRU S981F-EXIT. DESBD420
|
||||
00560 * DESBD420
|
||||
00561 * IF L981-OK-88 DESBD420
|
||||
00562 * SET W-WAGE-ON-FILE-YES-88 TO TRUE DESBD420
|
||||
00563 * ADD +1 TO W-SSN-ON-FILE-CNT DESBD420
|
||||
00564 * DISPLAY 'SSN ON FILE ' T-IN-SSN DESBD420
|
||||
00565 * ' ' W-EMP-NO ' ' W-YRQ DESBD420
|
||||
00566 * ' ' T-IN-EARNINGS DESBD420
|
||||
00567 * ' ' WWGH-EARNINGS DESBD420
|
||||
00568 * END-IF. DESBD420
|
||||
00569 * DESBD420
|
||||
00570 *P1700-EXIT. DESBD420
|
||||
00571 * EXIT. DESBD420
|
||||
00572 DESBD420
|
||||
00573 P2000-WRITE-TDEC-OUT. DESBD420
|
||||
00574 WRITE TDEC-TRAN-OUT-REC FROM TDEC-TRAN-IN-REC. DESBD420
|
||||
00575 DESBD420
|
||||
00576 P2000-EXIT. DESBD420
|
||||
00577 EXIT. DESBD420
|
||||
00578 DESBD420
|
||||
00579 T0000-TERMINATE. DESBD420
|
||||
00580 DESBD420
|
||||
00581 DISPLAY ' '. DESBD420
|
||||
00582 DISPLAY ' '. DESBD420
|
||||
00583 DESBD420
|
||||
00584 DISPLAY '*** DESBD420 TERMINATION STATISTICS ***'. DESBD420
|
||||
00585 DESBD420
|
||||
00586 DISPLAY ' '. DESBD420
|
||||
00587 DESBD420
|
||||
00588 DISPLAY ' '. DESBD420
|
||||
00589 DISPLAY 'W4 TRANSACTIONS READ : 'DESBD420
|
||||
00590 W-TDEC-IN-CNT. DESBD420
|
||||
00591 DESBD420
|
||||
00592 DISPLAY ' '. DESBD420
|
||||
00593 DISPLAY 'ERRORS FOUND : 'DESBD420
|
||||
00594 W-ERROR-CNT. DESBD420
|
||||
00595 DESBD420
|
||||
00596 DISPLAY ' '. DESBD420
|
||||
00597 DISPLAY 'TRANSACTIONS WRITTEN : 'DESBD420
|
||||
00598 W-TDEC-OUT-CNT. DESBD420
|
||||
00599 DESBD420
|
||||
00600 DESBD420
|
||||
00601 PERFORM S1020-CLOSE-TDEC-IN THRU S1020-EXIT. DESBD420
|
||||
00602 PERFORM S1130-CLOSE-TDEC-OUT THRU S1130-EXIT. DESBD420
|
||||
00603 DESBD420
|
||||
00604 PERFORM S910C-CLOSE THRU S910C-EXIT. DESBD420
|
||||
00605 PERFORM S981C-CLOSE THRU S981C-EXIT. DESBD420
|
||||
00606 PERFORM S921-CLOSE THRU S921-EXIT. DESBD420
|
||||
00607 DESBD420
|
||||
00608 T0000-EXIT. DESBD420
|
||||
00609 EXIT. DESBD420
|
||||
00610 DESBD420
|
||||
00611 S001-FROM-FED-8. DESBD420
|
||||
00612 SET L001-FROM-FED-8 TO TRUE. DESBD420
|
||||
00613 GO TO S001-DATE. DESBD420
|
||||
00614 DESBD420
|
||||
00615 S001-FROM-CAL-8. DESBD420
|
||||
00616 SET L001-FROM-CAL-8 TO TRUE. DESBD420
|
||||
00617 GO TO S001-DATE. DESBD420
|
||||
00618 DESBD420
|
||||
00619 S001-FROM-ABS-DAY. DESBD420
|
||||
00620 SET L001-FROM-ABS-DAY TO TRUE. DESBD420
|
||||
00621 GO TO S001-DATE. DESBD420
|
||||
00622 DESBD420
|
||||
00623 S001-DATE. DESBD420
|
||||
00624 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD420
|
||||
00625 S001-EXIT. DESBD420
|
||||
00626 EXIT. DESBD420
|
||||
00627 DESBD420
|
||||
00628 S004-FROM-DATE. DESBD420
|
||||
00629 SET L004-FROM-DATE TO TRUE. DESBD420
|
||||
00630 GO TO S004-QTR. DESBD420
|
||||
00631 DESBD420
|
||||
00632 S004-FROM-5. DESBD420
|
||||
00633 SET L004-FROM-5 TO TRUE. DESBD420
|
||||
00634 GO TO S004-QTR. DESBD420
|
||||
00635 DESBD420
|
||||
00636 S004-FROM-ABS. DESBD420
|
||||
00637 SET L004-FROM-ABS TO TRUE. DESBD420
|
||||
00638 GO TO S004-QTR. DESBD420
|
||||
00639 DESBD420
|
||||
00640 S004-FROM-3. DESBD420
|
||||
00641 SET L004-FROM-3 TO TRUE. DESBD420
|
||||
00642 GO TO S004-QTR. DESBD420
|
||||
00643 DESBD420
|
||||
00644 S004-QTR. DESBD420
|
||||
00645 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD420
|
||||
00646 S004-EXIT. DESBD420
|
||||
00647 DESBD420
|
||||
00648 S005-FROM-SYS. DESBD420
|
||||
00649 SET L005-FROM-SYS TO TRUE. DESBD420
|
||||
00650 GO TO S005-ABSTIME. DESBD420
|
||||
00651 DESBD420
|
||||
00652 S005-ABSTIME. DESBD420
|
||||
00653 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD420
|
||||
00654 S005-EXIT. DESBD420
|
||||
00655 EXIT. DESBD420
|
||||
00656 DESBD420
|
||||
00657 S516-LIABILITY-INFO. DESBD420
|
||||
00658 CALL 'DTSBU516' USING L516-LINK-AREA DESBD420
|
||||
00659 MPRF-REC. DESBD420
|
||||
00660 S516-EXIT. DESBD420
|
||||
00661 EXIT. DESBD420
|
||||
00662 DESBD420
|
||||
00663 S910A-OPEN-READ. DESBD420
|
||||
00664 SET L910-OPEN-READ-88 TO TRUE. DESBD420
|
||||
00665 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420
|
||||
00666 DESBD420
|
||||
00667 S910A-EXIT. DESBD420
|
||||
00668 EXIT. DESBD420
|
||||
00669 DESBD420
|
||||
00670 S910C-CLOSE. DESBD420
|
||||
00671 SET L910-CLOSE-88 TO TRUE. DESBD420
|
||||
00672 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420
|
||||
00673 DESBD420
|
||||
00674 S910C-EXIT. DESBD420
|
||||
00675 EXIT. DESBD420
|
||||
00676 DESBD420
|
||||
00677 S910D-START-BROWSE. DESBD420
|
||||
00678 SET L910-START-BROWSE-88 TO TRUE. DESBD420
|
||||
00679 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420
|
||||
00680 DESBD420
|
||||
00681 S910D-EXIT. DESBD420
|
||||
00682 EXIT. DESBD420
|
||||
00683 DESBD420
|
||||
00684 S910E-READ-NEXT. DESBD420
|
||||
00685 SET L910-READ-NEXT-88 TO TRUE. DESBD420
|
||||
00686 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420
|
||||
00687 DESBD420
|
||||
00688 S910E-EXIT. DESBD420
|
||||
00689 EXIT. DESBD420
|
||||
00690 DESBD420
|
||||
00691 S910F-READ. DESBD420
|
||||
00692 SET L910-READ-88 TO TRUE. DESBD420
|
||||
00693 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420
|
||||
00694 DESBD420
|
||||
00695 S910F-EXIT. DESBD420
|
||||
00696 EXIT. DESBD420
|
||||
00697 DESBD420
|
||||
00698 S910Z-MSTR-I. DESBD420
|
||||
00699 CALL 'DTSBU910' USING L910-LINK-AREA DESBD420
|
||||
00700 MSKL-REC. DESBD420
|
||||
00701 S910Z-EXIT. DESBD420
|
||||
00702 EXIT. DESBD420
|
||||
00703 DESBD420
|
||||
00704 S921-OPEN-READ. DESBD420
|
||||
00705 SET L921-OPEN-READ-88 TO TRUE. DESBD420
|
||||
00706 GO TO S921-AIX-IO. DESBD420
|
||||
00707 DESBD420
|
||||
00708 S921-READ. DESBD420
|
||||
00709 SET L921-READ-88 TO TRUE. DESBD420
|
||||
00710 GO TO S921-AIX-IO. DESBD420
|
||||
00711 DESBD420
|
||||
00712 S921-START-BROWSE. DESBD420
|
||||
00713 SET L921-START-BROWSE-88 TO TRUE. DESBD420
|
||||
00714 GO TO S921-AIX-IO. DESBD420
|
||||
00715 DESBD420
|
||||
00716 S921-READ-NEXT. DESBD420
|
||||
00717 SET L921-READ-NEXT-88 TO TRUE. DESBD420
|
||||
00718 GO TO S921-AIX-IO. DESBD420
|
||||
00719 DESBD420
|
||||
00720 S921-CLOSE. DESBD420
|
||||
00721 SET L921-CLOSE-88 TO TRUE. DESBD420
|
||||
00722 GO TO S921-AIX-IO. DESBD420
|
||||
00723 DESBD420
|
||||
00724 S921-AIX-IO. DESBD420
|
||||
00725 CALL 'DTSBU921' USING L921-LINK-AREA DESBD420
|
||||
00726 ISKL-REC. DESBD420
|
||||
00727 S921-EXIT. DESBD420
|
||||
00728 EXIT. DESBD420
|
||||
00729 DESBD420
|
||||
00730 S923A-OPEN-READ. DESBD420
|
||||
00731 SET L923-OPEN-READ-88 TO TRUE. DESBD420
|
||||
00732 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420
|
||||
00733 DESBD420
|
||||
00734 S923A-EXIT. DESBD420
|
||||
00735 EXIT. DESBD420
|
||||
00736 DESBD420
|
||||
00737 S923B-START-BROWSE. DESBD420
|
||||
00738 SET L923-START-BROWSE-88 TO TRUE. DESBD420
|
||||
00739 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420
|
||||
00740 DESBD420
|
||||
00741 S923B-EXIT. DESBD420
|
||||
00742 EXIT. DESBD420
|
||||
00743 DESBD420
|
||||
00744 S923C-READ-NEXT. DESBD420
|
||||
00745 SET L923-READ-NEXT-88 TO TRUE. DESBD420
|
||||
00746 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420
|
||||
00747 DESBD420
|
||||
00748 S923C-EXIT. DESBD420
|
||||
00749 EXIT. DESBD420
|
||||
00750 DESBD420
|
||||
00751 S923D-CLOSE. DESBD420
|
||||
00752 SET L923-CLOSE-88 TO TRUE. DESBD420
|
||||
00753 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420
|
||||
00754 DESBD420
|
||||
00755 S923D-EXIT. DESBD420
|
||||
00756 EXIT. DESBD420
|
||||
00757 DESBD420
|
||||
00758 DESBD420
|
||||
00759 S923Z-ATC-IO. DESBD420
|
||||
00760 CALL 'DTSBU923' USING L923-LINK-AREA DESBD420
|
||||
00761 ASKL-REC. DESBD420
|
||||
00762 S923Z-EXIT. DESBD420
|
||||
00763 EXIT. DESBD420
|
||||
00764 DESBD420
|
||||
00765 S981A-OPEN-READ. DESBD420
|
||||
00766 SET L981-OPEN-READ-88 TO TRUE. DESBD420
|
||||
00767 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420
|
||||
00768 DESBD420
|
||||
00769 S981A-EXIT. DESBD420
|
||||
00770 EXIT. DESBD420
|
||||
00771 DESBD420
|
||||
00772 S981C-CLOSE. DESBD420
|
||||
00773 SET L981-CLOSE-88 TO TRUE. DESBD420
|
||||
00774 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420
|
||||
00775 DESBD420
|
||||
00776 S981C-EXIT. DESBD420
|
||||
00777 EXIT. DESBD420
|
||||
00778 DESBD420
|
||||
00779 S981D-START-BROWSE. DESBD420
|
||||
00780 SET L981-START-BROWSE-88 TO TRUE. DESBD420
|
||||
00781 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420
|
||||
00782 DESBD420
|
||||
00783 S981D-EXIT. DESBD420
|
||||
00784 EXIT. DESBD420
|
||||
00785 DESBD420
|
||||
00786 S981E-READ-NEXT. DESBD420
|
||||
00787 SET L981-READ-NEXT-88 TO TRUE. DESBD420
|
||||
00788 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420
|
||||
00789 DESBD420
|
||||
00790 S981E-EXIT. DESBD420
|
||||
00791 EXIT. DESBD420
|
||||
00792 DESBD420
|
||||
00793 S981F-READ. DESBD420
|
||||
00794 SET L981-READ-88 TO TRUE. DESBD420
|
||||
00795 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420
|
||||
00796 DESBD420
|
||||
00797 S981F-EXIT. DESBD420
|
||||
00798 EXIT. DESBD420
|
||||
00799 DESBD420
|
||||
00800 S981Z-WAGE-I. DESBD420
|
||||
00801 CALL 'DTSBU981' USING L981-LINK-AREA DESBD420
|
||||
00802 WWGH-REC. DESBD420
|
||||
00803 S981Z-EXIT. DESBD420
|
||||
00804 EXIT. DESBD420
|
||||
00805 DESBD420
|
||||
00806 S1000-OPEN-TDEC-IN. DESBD420
|
||||
00807 OPEN INPUT TDEC-TRAN-IN. DESBD420
|
||||
00808 IF NOT TDEC-IN-OK-88 DESBD420
|
||||
00809 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS DESBD420
|
||||
00810 SET W-ERROR-YES-88 TO TRUE DESBD420
|
||||
00811 END-IF. DESBD420
|
||||
00812 DESBD420
|
||||
00813 S1000-EXIT. DESBD420
|
||||
00814 EXIT. DESBD420
|
||||
00815 DESBD420
|
||||
00816 S1010-READ-TDEC-IN. DESBD420
|
||||
00817 DESBD420
|
||||
00818 READ TDEC-TRAN-IN. DESBD420
|
||||
00819 IF TDEC-IN-OK-88 DESBD420
|
||||
00820 ADD +1 TO W-TDEC-IN-CNT DESBD420
|
||||
00821 ELSE DESBD420
|
||||
00822 IF TDEC-IN-EOF-88 DESBD420
|
||||
00823 DISPLAY 'EOF' DESBD420
|
||||
00824 ELSE DESBD420
|
||||
00825 DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS DESBD420
|
||||
00826 END-IF DESBD420
|
||||
00827 END-IF. DESBD420
|
||||
00828 DESBD420
|
||||
00829 S1010-EXIT. DESBD420
|
||||
00830 EXIT. DESBD420
|
||||
00831 DESBD420
|
||||
00832 S1020-CLOSE-TDEC-IN. DESBD420
|
||||
00833 CLOSE TDEC-TRAN-IN. DESBD420
|
||||
00834 DESBD420
|
||||
00835 S1020-EXIT. DESBD420
|
||||
00836 EXIT. DESBD420
|
||||
00837 DESBD420
|
||||
00838 S1100-OPEN-TDEC-OUT. DESBD420
|
||||
00839 OPEN OUTPUT TDEC-TRAN-OUT DESBD420
|
||||
00840 IF NOT TDEC-OUT-OK-88 DESBD420
|
||||
00841 DISPLAY 'CANNOT OPEN TDEC-TRAN-OUT ' TDEC-OUT-STATUS DESBD420
|
||||
00842 SET W-ERROR-YES-88 TO TRUE DESBD420
|
||||
00843 END-IF. DESBD420
|
||||
00844 DESBD420
|
||||
00845 S1100-EXIT. DESBD420
|
||||
00846 EXIT. DESBD420
|
||||
00847 DESBD420
|
||||
00848 S1120-WRITE-TDEC-OUT. DESBD420
|
||||
00849 WRITE TDEC-TRAN-OUT-REC FROM TDEC-TRAN-IN-REC. DESBD420
|
||||
00850 IF NOT TDEC-OUT-OK-88 DESBD420
|
||||
00851 DISPLAY 'CANNOT WRITE TDEC-TRAN-OUT ' TDEC-OUT-STATUS DESBD420
|
||||
00852 SET W-ERROR-YES-88 TO TRUE DESBD420
|
||||
00853 ELSE DESBD420
|
||||
00854 ADD +1 TO W-TDEC-OUT-CNT DESBD420
|
||||
00855 END-IF. DESBD420
|
||||
00856 DESBD420
|
||||
00857 S1120-EXIT. DESBD420
|
||||
00858 EXIT. DESBD420
|
||||
00859 DESBD420
|
||||
00860 S1130-CLOSE-TDEC-OUT. DESBD420
|
||||
00861 CLOSE TDEC-TRAN-OUT. DESBD420
|
||||
00862 DESBD420
|
||||
00863 S1130-EXIT. DESBD420
|
||||
00864 EXIT. DESBD420
|
||||
00865 S999-ABEND. DESBD420
|
||||
00866 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD420
|
||||
00867 S999-EXIT. DESBD420
|
||||
00868 EXIT. DESBD420
|
||||
Reference in New Issue
Block a user