870 lines
69 KiB
COBOL
870 lines
69 KiB
COBOL
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
|