DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
851
Batch/DTSBU420.cob
Normal file
851
Batch/DTSBU420.cob
Normal file
@ -0,0 +1,851 @@
|
||||
00001 IDENTIFICATION DIVISION. 06/19/13
|
||||
00002 PROGRAM-ID. DTSBU420. DTSBU420
|
||||
00003 AUTHOR. TRW. LV027
|
||||
00004 DATE-WRITTEN. FEBRUARY 2002. DTSBU420
|
||||
00005 DATE-COMPILED. DTSBU420
|
||||
00006 SKIP3 DTSBU420
|
||||
00007 ***** DTSBU420
|
||||
00008 * DTSBU420
|
||||
00009 * FUNCTION: FORMAT W4 TRANSACTIONS FROM W001 TRANSACTIONS, DTSBU420
|
||||
00010 * AND ADD WWGH WAGE HISTORY RECORDS. DTSBU420
|
||||
00011 * DELETE W001 TRANSACTIONS WHEN THE BATCH IS DTSBU420
|
||||
00012 * DELETED. DTSBU420
|
||||
00013 * DTSBU420
|
||||
00014 * DTSBU420
|
||||
00015 * MODIFICATION LOG: DTSBU420
|
||||
00016 * DTSBU420
|
||||
00017 * 02/07/2002 INITIAL DEVELOPMENT. DTSBU420
|
||||
00018 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00019 * DTSBU420
|
||||
00020 * 03/18/2004 MODIFIED FOR ELECTRONIC FILING AND PAYMENT DTSBU420
|
||||
00021 * PROCESS. DTSBU420
|
||||
00022 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00023 * DTSBU420
|
||||
00024 * 08/24/2004 REMOVED DISPLAYS DTSBU420
|
||||
00025 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00026 * DTSBU420
|
||||
00027 * 06/13/2007 MODIFIED TO USE L420-EMP-NO, PASSED FROM DTSBU420
|
||||
00028 * BD371, INSTEAD OF W001-EMP-NO. DTSBU420
|
||||
00029 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00030 * DTSBU420
|
||||
00031 * 11/14/2011 MODIFIED TO WRITE X148 WAGE RECORDS AND X153 DTSBU420
|
||||
00032 * MISSING SSN RECORDS TO PASS TO THE SERVER DTSBU420
|
||||
00033 * DATABASE. THE NEW WAGE RECORD INCLUDES DTSBU420
|
||||
00034 * THE ACCOUNTING BATCH AND ITEM NUMBERS. DTSBU420
|
||||
00035 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00036 * DTSBU420
|
||||
00037 * 03/02/2012 MODIFIED TO USE THE QUARTER PASSED THROUGH DTSBU420
|
||||
00038 * THE L420 LINKAGE. IF THE QUARTER HAS BEEN DTSBU420
|
||||
00039 * CHANGED, THE WAGES WILL BE POSTED TO THE DTSBU420
|
||||
00040 * CORRECT QUARTER. DTSBU420
|
||||
00041 * ANNUAL REPORTS CONTINUE TO USE W001-YRQ. DTSBU420
|
||||
00042 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00043 * DTSBU420
|
||||
00044 * 04/19/2012 MODIFIED P1400 TO CHECK FOR COMMAS EMBEDDED IN DTSBU420
|
||||
00045 * NAMES. DTSBU420
|
||||
00046 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00047 * DTSBU420
|
||||
00048 * 06/22/2012 CORRECTED DELETION PARAGRAPH: START BROWSE SHOULDDTSBU420
|
||||
00049 * USE PSEUDO BATCH, NOT REGULAR BATCH. DTSBU420
|
||||
00050 * WORK ORDER: PROGRAMMER: GD DTSBU420
|
||||
00051 * DTSBU420
|
||||
00052 * 04/05/2013 UPDATED WAGE EXTRACT FOR SERVER. DTSBU420
|
||||
00053 * WORK ORDER: TKT 1653 PROGRAMMER: GD DTSBU420
|
||||
00054 * DTSBU420
|
||||
00055 * 05/22/2013 ADDED A CHECK FOR NON-NUMERIC SSNS. CORRUPTED DTSBU420
|
||||
00056 * SSNS CAUSED A SYSTEM PROBLEM ON 5/21. THIS WILL DTSBU420
|
||||
00057 * PROTECT THE WAGE PROCESS UNTIL THE ORIGINAL DTSBU420
|
||||
00058 * CAUSE OF THE PROBLEM IS IDENTIFIED AND DTSBU420
|
||||
00059 * FIXED. DTSBU420
|
||||
00060 * WORK ORDER: TKT 1848 PROGRAMMER: GD DTSBU420
|
||||
00061 * DTSBU420
|
||||
00062 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU420
|
||||
00063 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU420
|
||||
00064 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU420
|
||||
00065 * DTSBU420
|
||||
00066 * DTSBU420
|
||||
00067 * DESCRIPTION: DTSBU420
|
||||
00068 * DTSBU420
|
||||
00069 * DTSBD371 CALLS THIS PROGRAM WHEN AN ELECTRONIC REPORT DTSBU420
|
||||
00070 * TRANSACTION HAS PROCESSED SUCCESSFULLY. DTSBU420
|
||||
00071 * DTSBD374 CALLS THIS PROGRAM WHEN AN ANNUAL REPORT DTSBU420
|
||||
00072 * TRANSACTION HAS PROCESSED SUCCESSFULLY. DTSBU420
|
||||
00073 * DTSBU420 THEN FORMATS W4 TRANSACTIONS FROM W001 DTSBU420
|
||||
00074 * TRANSACTIONS, AND WRITES WWGH WAGE HISTORY RECORDS. DTSBU420
|
||||
00075 * DTSBU420
|
||||
00076 * DTSBD180 CALLS THIS PROGRAM WHEN IT DELETES A BATCH DTSBU420
|
||||
00077 * AFTER ALL TRANSACTIONS HAVE BEEN PROCESSED. DTSBU420 DTSBU420
|
||||
00078 * THEN DELETES ALL THE W001 TRANSACTIONS ASSOCIATED WITH DTSBU420
|
||||
00079 * THE BATCH. DTSBU420
|
||||
00080 * DTSBU420
|
||||
00081 * GENERAL SPECIFICATIONS: DTSBU420
|
||||
00082 * DTSBU420
|
||||
00083 * ALL COMMANDS ARE VALID. DTSBU420
|
||||
00084 * DTSBU420
|
||||
00085 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSBU420
|
||||
00086 * MODULE. DTSBU420
|
||||
00087 * DTSBU420
|
||||
00088 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DTSBU420
|
||||
00089 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DTSBU420
|
||||
00090 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DTSBU420
|
||||
00091 * DTSBU420
|
||||
00092 * DTSBU420
|
||||
00093 * DTSBU420
|
||||
00094 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU420
|
||||
00095 * DTSBU420
|
||||
00096 * OPEN-READ DTSBU420
|
||||
00097 * OPEN INPUT. DTSBU420
|
||||
00098 * DTSBU420
|
||||
00099 * OPEN-UPDATE DTSBU420
|
||||
00100 * OPEN I-O. DTSBU420
|
||||
00101 * DTSBU420
|
||||
00102 * CLOSE DTSBU420
|
||||
00103 * DTSBU420
|
||||
00104 * READ DTSBU420
|
||||
00105 * DTSBU420
|
||||
00106 * START BROWSE DTSBU420
|
||||
00107 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DTSBU420
|
||||
00108 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DTSBU420
|
||||
00109 * A RECORD. DTSBU420
|
||||
00110 * DTSBU420
|
||||
00111 * READ NEXT DTSBU420
|
||||
00112 * DTSBU420
|
||||
00113 * WRITE DTSBU420
|
||||
00114 * DTSBU420
|
||||
00115 * REWRITE DTSBU420
|
||||
00116 * DTSBU420
|
||||
00117 * DELETE DTSBU420
|
||||
00118 * DTSBU420
|
||||
00119 * DTSBU420
|
||||
00120 ***** DTSBU420
|
||||
00121 SKIP3 DTSBU420
|
||||
00122 ENVIRONMENT DIVISION. DTSBU420
|
||||
00123 SKIP2 DTSBU420
|
||||
00124 INPUT-OUTPUT SECTION. DTSBU420
|
||||
00125 DTSBU420
|
||||
00126 FILE-CONTROL. DTSBU420
|
||||
00127 SELECT WAGE-TRANS-FILE ASSIGN TO DTSFWTRN DTSBU420
|
||||
00128 FILE STATUS IS WAGE-TRANS-STATUS. DTSBU420
|
||||
00129 DTSBU420
|
||||
00130 SELECT WAGE-X148-FILE ASSIGN TO DTSFW148 DTSBU420
|
||||
00131 FILE STATUS IS WAGE-X148-STATUS. DTSBU420
|
||||
00132 DTSBU420
|
||||
00133 SELECT WAGE-X153-FILE ASSIGN TO DTSFW153 DTSBU420
|
||||
00134 FILE STATUS IS WAGE-X153-STATUS. DTSBU420
|
||||
00135 DTSBU420
|
||||
00136 DATA DIVISION. DTSBU420
|
||||
00137 SKIP3 DTSBU420
|
||||
00138 FILE SECTION. DTSBU420
|
||||
00139 DTSBU420
|
||||
00140 FD WAGE-TRANS-FILE DTSBU420
|
||||
00141 RECORDING MODE IS F DTSBU420
|
||||
00142 BLOCK CONTAINS 0 RECORDS. DTSBU420
|
||||
00143 DTSBU420
|
||||
00144 01 WAGE-TRANS-REC PIC X(80). DTSBU420
|
||||
00145 DTSBU420
|
||||
00146 FD WAGE-X148-FILE DTSBU420
|
||||
00147 RECORDING MODE IS F DTSBU420
|
||||
00148 BLOCK CONTAINS 0 RECORDS. DTSBU420
|
||||
00149 DTSBU420
|
||||
00150 01 WAGE-X148-REC PIC X(134). DTSBU420
|
||||
00151 DTSBU420
|
||||
00152 FD WAGE-X153-FILE DTSBU420
|
||||
00153 RECORDING MODE IS F DTSBU420
|
||||
00154 BLOCK CONTAINS 0 RECORDS. DTSBU420
|
||||
00155 DTSBU420
|
||||
00156 01 WAGE-X153-REC PIC X(93). DTSBU420
|
||||
00157 DTSBU420
|
||||
00158 WORKING-STORAGE SECTION. DTSBU420
|
||||
001585 77 PAN-VALET PICTURE X(24) VALUE '027DTSBU420 06/19/13'. DTSBU420
|
||||
00159 77 PAN-VALET PICTURE X(24) VALUE '007DTSBU420 05/29/13'. DTSBU420
|
||||
00160 77 PAN-VALET PICTURE X(24) VALUE '025DTSBU420 04/11/13'. DTSBU420
|
||||
00161 77 PAN-VALET PICTURE X(24) VALUE '011DTSBU420 04/05/13'. DTSBU420
|
||||
00162 77 PAN-VALET PICTURE X(24) VALUE '021DTSBU420 08/07/12'. DTSBU420
|
||||
00163 SKIP3 DTSBU420
|
||||
00164 01 WRK-AREA. DTSBU420
|
||||
00165 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +420. DTSBU420
|
||||
00166 DTSBU420
|
||||
00167 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU420'. DTSBU420
|
||||
00168 DTSBU420
|
||||
00169 05 WRK-QTR-9 PIC 9(05). DTSBU420
|
||||
00170 05 WRK-QTR-X REDEFINES WRK-QTR-9. DTSBU420
|
||||
00171 10 WRK-QTR-YR PIC 9(04). DTSBU420
|
||||
00172 10 WRK-QTR-Q PIC 9(01). DTSBU420
|
||||
00173 DTSBU420
|
||||
00174 05 WRK-W2-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU420
|
||||
00175 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU420
|
||||
00176 05 WRK-WNAM-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU420
|
||||
00177 05 WRK-WWGH-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU420
|
||||
00178 05 WRK-X148-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU420
|
||||
00179 05 WRK-X153-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU420
|
||||
00180 05 AMT-DISP1 PIC Z(06)9. DTSBU420
|
||||
00181 05 AMT-DISP2 PIC Z(06)9. DTSBU420
|
||||
00182 05 AMT-DISP3 PIC Z(06)9. DTSBU420
|
||||
00183 05 AMT-DISP4 PIC Z(06)9.99-. DTSBU420
|
||||
00184 05 AMT-DISP5 PIC ---------9.99. DTSBU420
|
||||
00185 05 AMT-DISP6 PIC ---------9.99. DTSBU420
|
||||
00186 05 AMT-DISP7 PIC ---------9.99. DTSBU420
|
||||
00187 DTSBU420
|
||||
00188 05 WRK-NET-WAGE PIC S9(11)V99 COMP-3 DTSBU420
|
||||
00189 VALUE +0. DTSBU420
|
||||
00190 DTSBU420
|
||||
00191 05 WAGE-TRANS-STATUS PIC X(02). DTSBU420
|
||||
00192 88 WAGE-TRANS-FILE-OK-88 VALUE '00'. DTSBU420
|
||||
00193 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DTSBU420
|
||||
00194 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DTSBU420
|
||||
00195 DTSBU420
|
||||
00196 05 WAGE-X148-STATUS PIC X(02). DTSBU420
|
||||
00197 88 WAGE-X148-FILE-OK-88 VALUE '00'. DTSBU420
|
||||
00198 88 WAGE-X148-FILE-VERIFY-88 VALUE '97'. DTSBU420
|
||||
00199 DTSBU420
|
||||
00200 05 WAGE-X153-STATUS PIC X(02). DTSBU420
|
||||
00201 88 WAGE-X153-FILE-OK-88 VALUE '00'. DTSBU420
|
||||
00202 88 WAGE-X153-FILE-VERIFY-88 VALUE '97'. DTSBU420
|
||||
00203 DTSBU420
|
||||
00204 05 WRK-SYS-DATE PIC S9(09) COMP-3. DTSBU420
|
||||
00205 DTSBU420
|
||||
00206 01 WAGE-TRANS-AREA. DTSBU420
|
||||
00207 05 ESP-TRANSACTION-AREA PIC X(80). DTSBU420
|
||||
00208 ++INCLUDE EWGTRNW2 DTSBU420
|
||||
00209 ++INCLUDE EWGTRNW4 DTSBU420
|
||||
00210 EJECT DTSBU420
|
||||
00211 01 L983-LINK-AREA. DTSBU420
|
||||
00212 ++INCLUDE DTSIL983 DTSBU420
|
||||
00213 DTSBU420
|
||||
00214 01 WSKL-REC. DTSBU420
|
||||
00215 ++INCLUDE DTSIWSKL DTSBU420
|
||||
00216 DTSBU420
|
||||
00217 01 W001-REC. DTSBU420
|
||||
00218 ++INCLUDE DTSIW001 DTSBU420
|
||||
00219 DTSBU420
|
||||
00220 01 L981-LINK-AREA. DTSBU420
|
||||
00221 ++INCLUDE DTSIL981 DTSBU420
|
||||
00222 DTSBU420
|
||||
00223 01 WWGH-REC. DTSBU420
|
||||
00224 ++INCLUDE DTSIWWGH DTSBU420
|
||||
00225 DTSBU420
|
||||
00226 01 L982-LINK-AREA. DTSBU420
|
||||
00227 ++INCLUDE DTSIL982 DTSBU420
|
||||
00228 DTSBU420
|
||||
00229 01 WNAM-REC. DTSBU420
|
||||
00230 ++INCLUDE DTSIWNAM DTSBU420
|
||||
00231 DTSBU420
|
||||
00232 01 L004-LINK-AREA. DTSBU420
|
||||
00233 ++INCLUDE DTSIL004 DTSBU420
|
||||
00234 DTSBU420
|
||||
00235 01 L005-LINK-AREA. DTSBU420
|
||||
00236 ++INCLUDE DTSIL005 DTSBU420
|
||||
00237 DTSBU420
|
||||
00238 01 WRK-X148-REC. DTSBU420
|
||||
00239 ++INCLUDE DTSIX148 DTSBU420
|
||||
00240 DTSBU420
|
||||
00241 01 WRK-X153-REC. DTSBU420
|
||||
00242 ++INCLUDE DTSIX153 DTSBU420
|
||||
00243 DTSBU420
|
||||
00244 LINKAGE SECTION. DTSBU420
|
||||
00245 SKIP3 DTSBU420
|
||||
00246 01 L420-LINK-AREA. DTSBU420
|
||||
00247 ++INCLUDE DTSIL420 DTSBU420
|
||||
00248 EJECT DTSBU420
|
||||
00249 PROCEDURE DIVISION USING L420-LINK-AREA. DTSBU420
|
||||
00250 DTSBU420
|
||||
00251 EVALUATE TRUE DTSBU420
|
||||
00252 WHEN L420-CMND-OPEN-88 DTSBU420
|
||||
00253 PERFORM I0000-INIT THRU I0000-EXIT DTSBU420
|
||||
00254 DTSBU420
|
||||
00255 WHEN L420-CMND-UPDATE-88 DTSBU420
|
||||
00256 PERFORM P1000-UPDATE THRU P1000-EXIT DTSBU420
|
||||
00257 DTSBU420
|
||||
00258 WHEN L420-CMND-DELETE-88 DTSBU420
|
||||
00259 PERFORM P2000-DELETE THRU P2000-EXIT DTSBU420
|
||||
00260 DTSBU420
|
||||
00261 WHEN L420-CMND-CLOSE-88 DTSBU420
|
||||
00262 PERFORM T0000-TERM THRU T0000-EXIT DTSBU420
|
||||
00263 DTSBU420
|
||||
00264 END-EVALUATE. DTSBU420
|
||||
00265 DTSBU420
|
||||
00266 GOBACK. DTSBU420
|
||||
00267 EJECT DTSBU420
|
||||
00268 I0000-INIT. DTSBU420
|
||||
00269 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBU420
|
||||
00270 MOVE L005-DATE TO WRK-SYS-DATE. DTSBU420
|
||||
00271 DTSBU420
|
||||
00272 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBU420
|
||||
00273 DTSBU420
|
||||
00274 I0000-EXIT. DTSBU420
|
||||
00275 EXIT. DTSBU420
|
||||
00276 DTSBU420
|
||||
00277 I2000-OPEN-FILES. DTSBU420
|
||||
00278 OPEN OUTPUT WAGE-TRANS-FILE. DTSBU420
|
||||
00279 IF WAGE-TRANS-FILE-OK-88 DTSBU420
|
||||
00280 OR WAGE-TRANS-FILE-VERIFY-88 DTSBU420
|
||||
00281 NEXT SENTENCE DTSBU420
|
||||
00282 ELSE DTSBU420
|
||||
00283 PERFORM S999-ABEND THRU S999-EXIT DTSBU420
|
||||
00284 END-IF. DTSBU420
|
||||
00285 DTSBU420
|
||||
00286 OPEN OUTPUT WAGE-X148-FILE. DTSBU420
|
||||
00287 IF WAGE-X148-FILE-OK-88 DTSBU420
|
||||
00288 OR WAGE-X148-FILE-VERIFY-88 DTSBU420
|
||||
00289 NEXT SENTENCE DTSBU420
|
||||
00290 ELSE DTSBU420
|
||||
00291 PERFORM S999-ABEND THRU S999-EXIT DTSBU420
|
||||
00292 END-IF. DTSBU420
|
||||
00293 DTSBU420
|
||||
00294 OPEN OUTPUT WAGE-X153-FILE. DTSBU420
|
||||
00295 IF WAGE-X153-FILE-OK-88 DTSBU420
|
||||
00296 OR WAGE-X153-FILE-VERIFY-88 DTSBU420
|
||||
00297 NEXT SENTENCE DTSBU420
|
||||
00298 ELSE DTSBU420
|
||||
00299 PERFORM S999-ABEND THRU S999-EXIT DTSBU420
|
||||
00300 END-IF. DTSBU420
|
||||
00301 DTSBU420
|
||||
00302 I2000-EXIT. DTSBU420
|
||||
00303 EXIT. DTSBU420
|
||||
00304 DTSBU420
|
||||
00305 P1000-UPDATE. DTSBU420
|
||||
00306 DISPLAY 'BU420 P1000 ' L420-EMP-NO ' ' L420-PSEUDO-BATCH-NO DTSBU420
|
||||
00307 ' ' L420-PSEUDO-ITEM-NO ' ' L420-BATCH-NO DTSBU420
|
||||
00308 ' ' L420-ITEM-NO ' ' L420-YRQ. DTSBU420
|
||||
00309 DTSBU420
|
||||
00310 MOVE LOW-VALUE TO WSKL-REC. DTSBU420
|
||||
00311 MOVE L420-PSEUDO-BATCH-NO TO WSKL-BATCH-NO. DTSBU420
|
||||
00312 MOVE L420-PSEUDO-ITEM-NO TO WSKL-ITEM-NO. DTSBU420
|
||||
00313 PERFORM S983-START-BROWSE THRU S983-EXIT. DTSBU420
|
||||
00314 DTSBU420
|
||||
00315 PERFORM DTSBU420
|
||||
00316 UNTIL L983-NO-REC-88 DTSBU420
|
||||
00317 OR WSKL-BATCH-NO NOT = L420-PSEUDO-BATCH-NO DTSBU420
|
||||
00318 OR WSKL-ITEM-NO NOT = L420-PSEUDO-ITEM-NO DTSBU420
|
||||
00319 MOVE WSKL-REC TO W001-REC DTSBU420
|
||||
00320 IF W001-WAGE-CHNG NOT = ZERO DTSBU420
|
||||
00321 *& DTSBU420
|
||||
00322 IF W001-SSN NOT NUMERIC DTSBU420
|
||||
00323 DISPLAY '>>> NON-NUMERIC SSN ' L420-EMP-NO DTSBU420
|
||||
00324 ' ' L420-YRQ ' ' L420-BATCH-NO ' ' L420-ITEM-NO DTSBU420
|
||||
00325 ELSE DTSBU420
|
||||
00326 *& DTSBU420
|
||||
00327 PERFORM P1200-WRITE-WAGE-TRANS THRU P1200-EXIT DTSBU420
|
||||
00328 PERFORM P1300-UPDATE-NAME THRU P1300-EXIT DTSBU420
|
||||
00329 END-IF DTSBU420
|
||||
00330 END-IF DTSBU420
|
||||
00331 PERFORM S983-READ-NEXT THRU S983-EXIT DTSBU420
|
||||
00332 END-PERFORM. DTSBU420
|
||||
00333 DTSBU420
|
||||
00334 DTSBU420
|
||||
00335 P1000-EXIT. DTSBU420
|
||||
00336 EXIT. DTSBU420
|
||||
00337 DTSBU420
|
||||
00338 P1200-WRITE-WAGE-TRANS. DTSBU420
|
||||
00339 DTSBU420
|
||||
00340 PERFORM P1290-NAME-CHECK THRU P1290-EXIT. DTSBU420
|
||||
00341 DTSBU420
|
||||
00342 IF L420-RPT-TYPE-ORIG-88 DTSBU420
|
||||
00343 PERFORM P1210-WRITE-W4 THRU P1210-EXIT DTSBU420
|
||||
00344 ELSE DTSBU420
|
||||
00345 IF L420-RPT-TYPE-WITHDRW-88 DTSBU420
|
||||
00346 PERFORM P1220-WRITE-W2 THRU P1220-EXIT DTSBU420
|
||||
00347 ELSE DTSBU420
|
||||
00348 PERFORM P1240-SUPPLEMENTAL THRU P1240-EXIT. DTSBU420
|
||||
00349 P1200-EXIT. DTSBU420
|
||||
00350 EXIT. DTSBU420
|
||||
00351 DTSBU420
|
||||
00352 P1210-WRITE-W4. DTSBU420
|
||||
00353 IF W001-SSN = ZERO DTSBU420
|
||||
00354 PERFORM P1500-MISSING-SSN THRU P1500-EXIT DTSBU420
|
||||
00355 GO TO P1210-EXIT DTSBU420
|
||||
00356 END-IF. DTSBU420
|
||||
00357 DTSBU420
|
||||
00358 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSBU420
|
||||
00359 MOVE W001-SSN TO W4-SSN. DTSBU420
|
||||
00360 MOVE 'W4' TO W4-TRAN-ID. DTSBU420
|
||||
00361 MOVE '00044001' TO W4-TRAN-OPER-ID. DTSBU420
|
||||
00362 MOVE L420-RECEIVED-DATE TO W4-DATE-ENTERED. DTSBU420
|
||||
00363 MOVE W001-RECEIVED-TIME TO W4-TIME-ENTERED. DTSBU420
|
||||
00364 MOVE W001-NAME TO W4-NAME-CHECK. DTSBU420
|
||||
00365 DTSBU420
|
||||
00366 IF W001-ANNUAL-RPT-88 DTSBU420
|
||||
00367 PERFORM S2000-SET-YRQ THRU S2000-EXIT DTSBU420
|
||||
00368 MOVE WRK-QTR-9 TO W4-QUARTER DTSBU420
|
||||
00369 ELSE DTSBU420
|
||||
00370 MOVE L420-YRQ TO W4-QUARTER DTSBU420
|
||||
00371 END-IF. DTSBU420
|
||||
00372 DTSBU420
|
||||
00373 MOVE W001-WAGE-CHNG TO W4-QUARTER-EARNINGS. DTSBU420
|
||||
00374 MOVE 2 TO W4-AFFI-CODE. DTSBU420
|
||||
00375 MOVE L420-EMP-NO TO W4-ACCOUNT. DTSBU420
|
||||
00376 MOVE L420-EMP-NAME TO W4-EMP-NAME. DTSBU420
|
||||
00377 PERFORM S1000-WRITE-WAGE-TRANS THRU S1000-EXIT. DTSBU420
|
||||
00378 ADD +1 TO WRK-W4-CNT. DTSBU420
|
||||
00379 DTSBU420
|
||||
00380 MOVE W001-WAGE-CHNG TO WRK-NET-WAGE. DTSBU420
|
||||
00381 PERFORM P1400-WRITE-X148 THRU P1400-EXIT. DTSBU420
|
||||
00382 DTSBU420
|
||||
00383 * DISPLAY 'BU420 WRITE ' W4-ACCOUNT ' ' W4-QUARTER DTSBU420
|
||||
00384 * ' ' W4-SSN. DTSBU420
|
||||
00385 P1210-EXIT. DTSBU420
|
||||
00386 EXIT. DTSBU420
|
||||
00387 DTSBU420
|
||||
00388 P1220-WRITE-W2. DTSBU420
|
||||
00389 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSBU420
|
||||
00390 MOVE W001-SSN TO W2-SSN. DTSBU420
|
||||
00391 MOVE 'W2' TO W2-TRAN-ID. DTSBU420
|
||||
00392 MOVE '00044001' TO W2-OPER-ID. DTSBU420
|
||||
00393 MOVE L420-RECEIVED-DATE TO W2-DATE-ENTERED. DTSBU420
|
||||
00394 MOVE W001-RECEIVED-TIME TO W2-TIME-ENTERED. DTSBU420
|
||||
00395 MOVE W001-NAME TO W2-NAME. DTSBU420
|
||||
00396 MOVE L420-YRQ TO W2-QTR. DTSBU420
|
||||
00397 MOVE L420-EMP-NO TO W2-ACCOUNT-NUMBER. DTSBU420
|
||||
00398 PERFORM S1000-WRITE-WAGE-TRANS THRU S1000-EXIT. DTSBU420
|
||||
00399 ADD +1 TO WRK-W2-CNT. DTSBU420
|
||||
00400 DTSBU420
|
||||
00401 P1220-EXIT. DTSBU420
|
||||
00402 EXIT. DTSBU420
|
||||
00403 DTSBU420
|
||||
00404 P1240-SUPPLEMENTAL. DTSBU420
|
||||
00405 DTSBU420
|
||||
00406 MOVE ZERO TO WRK-NET-WAGE. DTSBU420
|
||||
00407 DTSBU420
|
||||
00408 MOVE LOW-VALUE TO WWGH-REC. DTSBU420
|
||||
00409 MOVE L420-EMP-NO TO WWGH-EMP-NO. DTSBU420
|
||||
00410 DISPLAY 'P1240 SRC ' W001-SOURCE ' ' W001-YRQ DTSBU420
|
||||
00411 ' ' L420-YRQ. DTSBU420
|
||||
00412 IF W001-ANNUAL-RPT-88 DTSBU420
|
||||
00413 PERFORM S2000-SET-YRQ THRU S2000-EXIT DTSBU420
|
||||
00414 MOVE WRK-QTR-9 TO W4-QUARTER DTSBU420
|
||||
00415 ELSE DTSBU420
|
||||
00416 MOVE L420-YRQ TO WWGH-YRQ DTSBU420
|
||||
00417 END-IF. DTSBU420
|
||||
00418 MOVE W001-SSN TO WWGH-SSN. DTSBU420
|
||||
00419 DTSBU420
|
||||
00420 DISPLAY 'BU420 AMEND ' WWGH-EMP-NO ' ' WWGH-YRQ DTSBU420
|
||||
00421 ' ' WWGH-SSN. DTSBU420
|
||||
00422 PERFORM S981D-READ THRU S981D-EXIT. DTSBU420
|
||||
00423 DTSBU420
|
||||
00424 IF L981-OK-88 DTSBU420
|
||||
00425 COMPUTE WRK-NET-WAGE = DTSBU420
|
||||
00426 (W001-WAGE-CHNG - WWGH-EARNINGS) DTSBU420
|
||||
00427 ELSE DTSBU420
|
||||
00428 COMPUTE WRK-NET-WAGE = W001-WAGE-CHNG DTSBU420
|
||||
00429 END-IF. DTSBU420
|
||||
00430 DTSBU420
|
||||
00431 MOVE W001-WAGE-CHNG TO AMT-DISP5 DTSBU420
|
||||
00432 MOVE WWGH-EARNINGS TO AMT-DISP6 DTSBU420
|
||||
00433 MOVE WRK-NET-WAGE TO AMT-DISP7. DTSBU420
|
||||
00434 DISPLAY ' W001: ' AMT-DISP5 ' WGH: ' AMT-DISP6 DTSBU420
|
||||
00435 ' NET: ' AMT-DISP7. DTSBU420
|
||||
00436 DTSBU420
|
||||
00437 PERFORM P1242-WRITE-W4 THRU P1242-EXIT. DTSBU420
|
||||
00438 DTSBU420
|
||||
00439 P1240-EXIT. DTSBU420
|
||||
00440 EXIT. DTSBU420
|
||||
00441 DTSBU420
|
||||
00442 P1242-WRITE-W4. DTSBU420
|
||||
00443 ************************************************************** DTSBU420
|
||||
00444 * DO NOT WRITE A W4 IF THE DIFFERENCE BETWEEN WHAT IS ON FILE DTSBU420
|
||||
00445 * AND THE NEW WAGE AMOUNT IS < $1.00 - SINCE THE PENNIES ARE DTSBU420
|
||||
00446 * NOT SAVED ON THE DOCS FILE, THE AMOUNT WILL NOT CHANGE. DTSBU420
|
||||
00447 * DTSBU420
|
||||
00448 * FOR AN AMENDED REPORT, THE AMOUNT IN THE W4 TRANSACTION IS DTSBU420
|
||||
00449 * THE NEW AMOUNT: IT WILL REPLACE WHAT IS ALREADY ON FILE. DTSBU420
|
||||
00450 ************************************************************** DTSBU420
|
||||
00451 IF WRK-NET-WAGE <= +0.99 DTSBU420
|
||||
00452 AND WRK-NET-WAGE >= -0.99 DTSBU420
|
||||
00453 GO TO P1242-EXIT DTSBU420
|
||||
00454 END-IF. DTSBU420
|
||||
00455 DTSBU420
|
||||
00456 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSBU420
|
||||
00457 MOVE W001-SSN TO W4-SSN. DTSBU420
|
||||
00458 MOVE 'W4' TO W4-TRAN-ID. DTSBU420
|
||||
00459 MOVE '00044001' TO W4-TRAN-OPER-ID. DTSBU420
|
||||
00460 MOVE L420-RECEIVED-DATE TO W4-DATE-ENTERED. DTSBU420
|
||||
00461 MOVE W001-RECEIVED-TIME TO W4-TIME-ENTERED. DTSBU420
|
||||
00462 MOVE W001-NAME TO W4-NAME-CHECK. DTSBU420
|
||||
00463 DISPLAY 'P1242 SRC ' W001-SOURCE ' ' W001-YRQ DTSBU420
|
||||
00464 ' ' L420-YRQ. DTSBU420
|
||||
00465 IF W001-ANNUAL-RPT-88 DTSBU420
|
||||
00466 PERFORM S2000-SET-YRQ THRU S2000-EXIT DTSBU420
|
||||
00467 MOVE WRK-QTR-9 TO W4-QUARTER DTSBU420
|
||||
00468 ELSE DTSBU420
|
||||
00469 MOVE L420-YRQ TO W4-QUARTER DTSBU420
|
||||
00470 END-IF. DTSBU420
|
||||
00471 DISPLAY ' ' W4-QUARTER. DTSBU420
|
||||
00472 MOVE W001-WAGE-CHNG TO W4-QUARTER-EARNINGS. DTSBU420
|
||||
00473 MOVE 2 TO W4-AFFI-CODE. DTSBU420
|
||||
00474 MOVE L420-EMP-NO TO W4-ACCOUNT. DTSBU420
|
||||
00475 MOVE L420-EMP-NAME TO W4-EMP-NAME. DTSBU420
|
||||
00476 PERFORM S1000-WRITE-WAGE-TRANS THRU S1000-EXIT. DTSBU420
|
||||
00477 ADD +1 TO WRK-W4-CNT. DTSBU420
|
||||
00478 DTSBU420
|
||||
00479 MOVE W001-WAGE-CHNG TO WRK-NET-WAGE. DTSBU420
|
||||
00480 PERFORM P1400-WRITE-X148 THRU P1400-EXIT. DTSBU420
|
||||
00481 DTSBU420
|
||||
00482 P1242-EXIT. DTSBU420
|
||||
00483 EXIT. DTSBU420
|
||||
00484 DTSBU420
|
||||
00485 P1290-NAME-CHECK. DTSBU420
|
||||
00486 IF L420-NAME-TYPE-FULL-88 DTSBU420
|
||||
00487 GO TO P1290-EXIT. DTSBU420
|
||||
00488 DTSBU420
|
||||
00489 MOVE LOW-VALUE TO WNAM-REC. DTSBU420
|
||||
00490 MOVE W001-SSN TO WNAM-SSN. DTSBU420
|
||||
00491 DTSBU420
|
||||
00492 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DTSBU420
|
||||
00493 DTSBU420
|
||||
00494 IF L982-OK-88 DTSBU420
|
||||
00495 IF WNAM-SSN = W001-SSN DTSBU420
|
||||
00496 MOVE WNAM-NAME TO W001-NAME. DTSBU420
|
||||
00497 DTSBU420
|
||||
00498 P1290-EXIT. DTSBU420
|
||||
00499 EXIT. DTSBU420
|
||||
00500 DTSBU420
|
||||
00501 P1300-UPDATE-NAME. DTSBU420
|
||||
00502 *& DTSBU420
|
||||
00503 * DISPLAY 'DTSBU420 P1300 ' W001-SSN ' ' W001-NAME. DTSBU420
|
||||
00504 *& DTSBU420
|
||||
00505 MOVE LOW-VALUE TO WNAM-REC. DTSBU420
|
||||
00506 MOVE W001-SSN TO WNAM-SSN. DTSBU420
|
||||
00507 DTSBU420
|
||||
00508 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DTSBU420
|
||||
00509 DTSBU420
|
||||
00510 IF NOT L982-OK-88 DTSBU420
|
||||
00511 PERFORM P1310-ADD-NAME THRU P1310-EXIT DTSBU420
|
||||
00512 GO TO P1300-EXIT DTSBU420
|
||||
00513 END-IF. DTSBU420
|
||||
00514 DTSBU420
|
||||
00515 IF WNAM-NAME = W001-NAME DTSBU420
|
||||
00516 GO TO P1300-EXIT DTSBU420
|
||||
00517 END-IF. DTSBU420
|
||||
00518 DTSBU420
|
||||
00519 IF WNAM-TYPE-3CHAR-88 DTSBU420
|
||||
00520 IF L420-NAME-TYPE-FULL-88 DTSBU420
|
||||
00521 PERFORM P1320-REWRITE-NAME THRU P1320-EXIT DTSBU420
|
||||
00522 END-IF DTSBU420
|
||||
00523 ELSE DTSBU420
|
||||
00524 PERFORM P1310-ADD-NAME THRU P1310-EXIT DTSBU420
|
||||
00525 END-IF. DTSBU420
|
||||
00526 DTSBU420
|
||||
00527 P1300-EXIT. DTSBU420
|
||||
00528 EXIT. DTSBU420
|
||||
00529 DTSBU420
|
||||
00530 P1310-ADD-NAME. DTSBU420
|
||||
00531 *& DTSBU420
|
||||
00532 * DISPLAY 'DTSBU420 P1310 ' W001-LAST-NAME. DTSBU420
|
||||
00533 *& DTSBU420
|
||||
00534 MOVE W001-SSN TO WNAM-SSN. DTSBU420
|
||||
00535 ADD +1 TO L420-ABSTIME. DTSBU420
|
||||
00536 MOVE L420-ABSTIME TO L005-ABSTIME. DTSBU420
|
||||
00537 PERFORM S005-FROM-ABS THRU S005-EXIT. DTSBU420
|
||||
00538 MOVE L005-NINES-COMPLEMENT-ABSTIME DTSBU420
|
||||
00539 TO WNAM-NINES-COMPLEMENT-ABSTIME. DTSBU420
|
||||
00540 MOVE W001-LAST-NAME TO WNAM-LAST-NAME. DTSBU420
|
||||
00541 MOVE W001-FIRST-NAME TO WNAM-FIRST-NAME. DTSBU420
|
||||
00542 MOVE W001-MID-INIT TO WNAM-MID-INIT. DTSBU420
|
||||
00543 MOVE L420-NAME-TYPE TO WNAM-NAME-TYPE. DTSBU420
|
||||
00544 DTSBU420
|
||||
00545 PERFORM S982C-WRITE THRU S982C-EXIT. DTSBU420
|
||||
00546 DTSBU420
|
||||
00547 ADD +1 TO WRK-WNAM-CNT. DTSBU420
|
||||
00548 DTSBU420
|
||||
00549 P1310-EXIT. DTSBU420
|
||||
00550 EXIT. DTSBU420
|
||||
00551 DTSBU420
|
||||
00552 P1320-REWRITE-NAME. DTSBU420
|
||||
00553 *& DTSBU420
|
||||
00554 * DISPLAY 'DTSBU420 P1320 ' W001-LAST-NAME. DTSBU420
|
||||
00555 *& DTSBU420
|
||||
00556 MOVE W001-LAST-NAME TO WNAM-LAST-NAME. DTSBU420
|
||||
00557 MOVE W001-FIRST-NAME TO WNAM-FIRST-NAME. DTSBU420
|
||||
00558 MOVE W001-MID-INIT TO WNAM-MID-INIT. DTSBU420
|
||||
00559 MOVE L420-NAME-TYPE TO WNAM-NAME-TYPE. DTSBU420
|
||||
00560 DTSBU420
|
||||
00561 PERFORM S982D-REWRITE THRU S982D-EXIT. DTSBU420
|
||||
00562 DTSBU420
|
||||
00563 ADD +1 TO WRK-WNAM-CNT. DTSBU420
|
||||
00564 DTSBU420
|
||||
00565 P1320-EXIT. DTSBU420
|
||||
00566 EXIT. DTSBU420
|
||||
00567 DTSBU420
|
||||
00568 P1400-WRITE-X148. DTSBU420
|
||||
00569 MOVE L420-EMP-NO TO X148-EMP-NO. DTSBU420
|
||||
00570 IF W001-ANNUAL-RPT-88 DTSBU420
|
||||
00571 PERFORM S2000-SET-YRQ THRU S2000-EXIT DTSBU420
|
||||
00572 MOVE WRK-QTR-9 TO W4-QUARTER DTSBU420
|
||||
00573 ELSE DTSBU420
|
||||
00574 MOVE L420-YRQ TO L004-QTR-5-9 DTSBU420
|
||||
00575 END-IF. DTSBU420
|
||||
00576 PERFORM S004-FROM-5 THRU S004-EXIT DTSBU420
|
||||
00577 IF NOT L004-VALID-QTR DTSBU420
|
||||
00578 DISPLAY 'DTSBU420: INVALID QUARTER ' DTSBU420
|
||||
00579 L420-BATCH-NO ' ' L420-ITEM-NO DTSBU420
|
||||
00580 GO TO P1400-EXIT DTSBU420
|
||||
00581 ELSE DTSBU420
|
||||
00582 MOVE L004-SLASH-5-QTR TO X148-QUARTER DTSBU420
|
||||
00583 END-IF. DTSBU420
|
||||
00584 MOVE W001-SSN TO X148-SSN. DTSBU420
|
||||
00585 MOVE W001-SOURCE TO X148-WAGE-SOURCE. DTSBU420
|
||||
00586 MOVE WRK-NET-WAGE TO X148-EARNINGS. DTSBU420
|
||||
00587 MOVE W001-LAST-NAME TO X148-LAST-NAME. DTSBU420
|
||||
00588 MOVE W001-FIRST-NAME TO X148-FIRST-NAME. DTSBU420
|
||||
00589 MOVE W001-MID-INIT TO X148-MID-INIT. DTSBU420
|
||||
00590 INSPECT X148-LAST-NAME REPLACING ALL ',' BY ' '. DTSBU420
|
||||
00591 INSPECT X148-FIRST-NAME REPLACING ALL ',' BY ' '. DTSBU420
|
||||
00592 INSPECT X148-MID-INIT REPLACING ALL ',' BY ' '. DTSBU420
|
||||
00593 MOVE L420-BATCH-NO TO X148-BATCH. DTSBU420
|
||||
00594 MOVE L420-ITEM-NO TO X148-ITEM. DTSBU420
|
||||
00595 MOVE L420-SYS-DATE TO X148-DATE. DTSBU420
|
||||
00596 MOVE SPACES TO X148-OPID. DTSBU420
|
||||
00597 DTSBU420
|
||||
00598 WRITE WAGE-X148-REC FROM WRK-X148-REC. DTSBU420
|
||||
00599 IF WAGE-X148-FILE-OK-88 DTSBU420
|
||||
00600 ADD +1 TO WRK-X148-CNT DTSBU420
|
||||
00601 DISPLAY 'BU420 X148: ' X148-EMP-NO ' ' X148-BATCH DTSBU420
|
||||
00602 ' ' X148-ITEM ' ' X148-QUARTER DTSBU420
|
||||
00603 ELSE DTSBU420
|
||||
00604 DISPLAY 'CANNOT WRITE TO X148 FILE: ' WAGE-X148-STATUS DTSBU420
|
||||
00605 END-IF. DTSBU420
|
||||
00606 DTSBU420
|
||||
00607 P1400-EXIT. DTSBU420
|
||||
00608 EXIT. DTSBU420
|
||||
00609 DTSBU420
|
||||
00610 P1500-MISSING-SSN. DTSBU420
|
||||
00611 MOVE L420-EMP-NO TO X153-EMP-NO. DTSBU420
|
||||
00612 IF W001-ANNUAL-RPT-88 DTSBU420
|
||||
00613 PERFORM S2000-SET-YRQ THRU S2000-EXIT DTSBU420
|
||||
00614 MOVE WRK-QTR-9 TO W4-QUARTER DTSBU420
|
||||
00615 ELSE DTSBU420
|
||||
00616 MOVE L420-YRQ TO L004-QTR-5-9 DTSBU420
|
||||
00617 END-IF. DTSBU420
|
||||
00618 PERFORM S004-FROM-5 THRU S004-EXIT DTSBU420
|
||||
00619 IF NOT L004-VALID-QTR DTSBU420
|
||||
00620 DISPLAY 'DTSBU420: INVALID QUARTER ' DTSBU420
|
||||
00621 L420-BATCH-NO ' ' L420-ITEM-NO DTSBU420
|
||||
00622 GO TO P1500-EXIT DTSBU420
|
||||
00623 ELSE DTSBU420
|
||||
00624 MOVE L004-SLASH-5-QTR TO X153-QUARTER DTSBU420
|
||||
00625 END-IF. DTSBU420
|
||||
00626 MOVE W001-WAGE-CHNG TO X153-EARNINGS. DTSBU420
|
||||
00627 MOVE L420-BATCH-NO TO X153-BATCH. DTSBU420
|
||||
00628 MOVE L420-ITEM-NO TO X153-ITEM. DTSBU420
|
||||
00629 MOVE W001-SOURCE TO X153-WAGE-SOURCE. DTSBU420
|
||||
00630 MOVE W001-LAST-NAME TO X153-LAST-NAME. DTSBU420
|
||||
00631 MOVE W001-FIRST-NAME TO X153-FIRST-NAME. DTSBU420
|
||||
00632 MOVE W001-MID-INIT TO X153-MID-INIT. DTSBU420
|
||||
00633 INSPECT X153-LAST-NAME REPLACING ALL ',' BY ' '. DTSBU420
|
||||
00634 INSPECT X153-FIRST-NAME REPLACING ALL ',' BY ' '. DTSBU420
|
||||
00635 INSPECT X153-MID-INIT REPLACING ALL ',' BY ' '. DTSBU420
|
||||
00636 MOVE L420-SYS-DATE TO X153-DATE. DTSBU420
|
||||
00637 DTSBU420
|
||||
00638 WRITE WAGE-X153-REC FROM WRK-X153-REC. DTSBU420
|
||||
00639 IF WAGE-X153-FILE-OK-88 DTSBU420
|
||||
00640 ADD +1 TO WRK-X153-CNT DTSBU420
|
||||
00641 ELSE DTSBU420
|
||||
00642 DISPLAY 'CANNOT WRITE TO X153 FILE: ' WAGE-X153-STATUS DTSBU420
|
||||
00643 END-IF. DTSBU420
|
||||
00644 DTSBU420
|
||||
00645 P1500-EXIT. DTSBU420
|
||||
00646 EXIT. DTSBU420
|
||||
00647 DTSBU420
|
||||
00648 P2000-DELETE. DTSBU420
|
||||
00649 MOVE LOW-VALUE TO WSKL-REC. DTSBU420
|
||||
00650 MOVE L420-PSEUDO-BATCH-NO TO WSKL-BATCH-NO. DTSBU420
|
||||
00651 MOVE L420-PSEUDO-ITEM-NO TO WSKL-ITEM-NO. DTSBU420
|
||||
00652 PERFORM S983-START-BROWSE THRU S983-EXIT. DTSBU420
|
||||
00653 DTSBU420
|
||||
00654 PERFORM DTSBU420
|
||||
00655 UNTIL L983-NO-REC-88 DTSBU420
|
||||
00656 OR WSKL-BATCH-NO NOT = L420-PSEUDO-BATCH-NO DTSBU420
|
||||
00657 OR WSKL-ITEM-NO NOT = L420-PSEUDO-ITEM-NO DTSBU420
|
||||
00658 PERFORM S983-DELETE THRU S983-EXIT DTSBU420
|
||||
00659 PERFORM S983-READ-NEXT THRU S983-EXIT DTSBU420
|
||||
00660 END-PERFORM. DTSBU420
|
||||
00661 DTSBU420
|
||||
00662 P2000-EXIT. DTSBU420
|
||||
00663 EXIT. DTSBU420
|
||||
00664 DTSBU420
|
||||
00665 T0000-TERM. DTSBU420
|
||||
00666 CLOSE WAGE-TRANS-FILE DTSBU420
|
||||
00667 WAGE-X148-FILE DTSBU420
|
||||
00668 WAGE-X153-FILE. DTSBU420
|
||||
00669 DTSBU420
|
||||
00670 MOVE WRK-W2-CNT TO AMT-DISP1. DTSBU420
|
||||
00671 MOVE WRK-W4-CNT TO AMT-DISP2. DTSBU420
|
||||
00672 MOVE WRK-WWGH-CNT TO AMT-DISP3. DTSBU420
|
||||
00673 DTSBU420
|
||||
00674 DISPLAY '******************************************' DTSBU420
|
||||
00675 DISPLAY '** DTSBU420 TERMINATION STATISTICS **'. DTSBU420
|
||||
00676 DISPLAY '** W2 TRANSACTIONS WRITTEN: ' DTSBU420
|
||||
00677 DISPLAY AMT-DISP1 ' **'. DTSBU420
|
||||
00678 DISPLAY '** W4 TRANSACTIONS WRITTEN: ' DTSBU420
|
||||
00679 DISPLAY AMT-DISP2 ' **'. DTSBU420
|
||||
00680 DISPLAY '** WWGH TRANSACTIONS WRITTEN: ' DTSBU420
|
||||
00681 DISPLAY AMT-DISP3 ' **'. DTSBU420
|
||||
00682 DISPLAY '** X148 TRANSACTIONS WRITTEN: ' DTSBU420
|
||||
00683 DISPLAY WRK-X148-CNT ' **'. DTSBU420
|
||||
00684 DISPLAY '** X153 TRANSACTIONS WRITTEN: ' DTSBU420
|
||||
00685 DISPLAY WRK-X153-CNT ' **'. DTSBU420
|
||||
00686 DISPLAY '******************************************'. DTSBU420
|
||||
00687 DTSBU420
|
||||
00688 T0000-EXIT. DTSBU420
|
||||
00689 EXIT. DTSBU420
|
||||
00690 DTSBU420
|
||||
00691 S004-FROM-5. DTSBU420
|
||||
00692 SET L004-FROM-5 TO TRUE. DTSBU420
|
||||
00693 GO TO S004-YRQ. DTSBU420
|
||||
00694 DTSBU420
|
||||
00695 S004-FROM-DATE. DTSBU420
|
||||
00696 SET L004-FROM-DATE TO TRUE. DTSBU420
|
||||
00697 GO TO S004-YRQ. DTSBU420
|
||||
00698 DTSBU420
|
||||
00699 S004-FROM-ABS. DTSBU420
|
||||
00700 SET L004-FROM-ABS TO TRUE. DTSBU420
|
||||
00701 GO TO S004-YRQ. DTSBU420
|
||||
00702 DTSBU420
|
||||
00703 S004-YRQ. DTSBU420
|
||||
00704 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU420
|
||||
00705 DTSBU420
|
||||
00706 S004-EXIT. DTSBU420
|
||||
00707 EXIT. DTSBU420
|
||||
00708 DTSBU420
|
||||
00709 S005-FROM-SYS. DTSBU420
|
||||
00710 SET L005-FROM-SYS TO TRUE. DTSBU420
|
||||
00711 GO S005-ABSTIME. DTSBU420
|
||||
00712 DTSBU420
|
||||
00713 S005-FROM-ABS. DTSBU420
|
||||
00714 SET L005-FROM-ABSTIME TO TRUE. DTSBU420
|
||||
00715 GO S005-ABSTIME. DTSBU420
|
||||
00716 DTSBU420
|
||||
00717 S005-ABSTIME. DTSBU420
|
||||
00718 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBU420
|
||||
00719 DTSBU420
|
||||
00720 S005-EXIT. DTSBU420
|
||||
00721 EXIT. DTSBU420
|
||||
00722 DTSBU420
|
||||
00723 S983-START-BROWSE. DTSBU420
|
||||
00724 SET L983-START-BROWSE-88 TO TRUE. DTSBU420
|
||||
00725 GO TO S983-WAGE-I. DTSBU420
|
||||
00726 DTSBU420
|
||||
00727 S983-READ-NEXT. DTSBU420
|
||||
00728 SET L983-READ-NEXT-88 TO TRUE. DTSBU420
|
||||
00729 GO TO S983-WAGE-I. DTSBU420
|
||||
00730 DTSBU420
|
||||
00731 S983-DELETE. DTSBU420
|
||||
00732 SET L983-DELETE-88 TO TRUE. DTSBU420
|
||||
00733 GO TO S983-WAGE-I. DTSBU420
|
||||
00734 DTSBU420
|
||||
00735 S983-WAGE-I. DTSBU420
|
||||
00736 CALL 'DTSBU983' USING L983-LINK-AREA DTSBU420
|
||||
00737 WSKL-REC. DTSBU420
|
||||
00738 S983-EXIT. DTSBU420
|
||||
00739 EXIT. DTSBU420
|
||||
00740 DTSBU420
|
||||
00741 S981A-START-BROWSE. DTSBU420
|
||||
00742 SET L981-START-BROWSE-88 TO TRUE. DTSBU420
|
||||
00743 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU420
|
||||
00744 DTSBU420
|
||||
00745 S981A-EXIT. DTSBU420
|
||||
00746 EXIT. DTSBU420
|
||||
00747 DTSBU420
|
||||
00748 S981B-READ-NEXT. DTSBU420
|
||||
00749 SET L981-READ-NEXT-88 TO TRUE. DTSBU420
|
||||
00750 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU420
|
||||
00751 DTSBU420
|
||||
00752 S981B-EXIT. DTSBU420
|
||||
00753 EXIT. DTSBU420
|
||||
00754 DTSBU420
|
||||
00755 S981C-WRITE. DTSBU420
|
||||
00756 SET L981-WRITE-88 TO TRUE. DTSBU420
|
||||
00757 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU420
|
||||
00758 DTSBU420
|
||||
00759 S981C-EXIT. DTSBU420
|
||||
00760 EXIT. DTSBU420
|
||||
00761 DTSBU420
|
||||
00762 S981D-READ. DTSBU420
|
||||
00763 SET L981-READ-88 TO TRUE. DTSBU420
|
||||
00764 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU420
|
||||
00765 DTSBU420
|
||||
00766 S981D-EXIT. DTSBU420
|
||||
00767 EXIT. DTSBU420
|
||||
00768 DTSBU420
|
||||
00769 S981Z-WWGH-IO. DTSBU420
|
||||
00770 CALL 'DTSBU981' USING L981-LINK-AREA DTSBU420
|
||||
00771 WWGH-REC. DTSBU420
|
||||
00772 S981Z-EXIT. DTSBU420
|
||||
00773 EXIT. DTSBU420
|
||||
00774 DTSBU420
|
||||
00775 S982A-START-BROWSE. DTSBU420
|
||||
00776 SET L982-START-BROWSE-88 TO TRUE. DTSBU420
|
||||
00777 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBU420
|
||||
00778 DTSBU420
|
||||
00779 S982A-EXIT. DTSBU420
|
||||
00780 EXIT. DTSBU420
|
||||
00781 DTSBU420
|
||||
00782 S982B-READ-NEXT. DTSBU420
|
||||
00783 SET L982-READ-NEXT-88 TO TRUE. DTSBU420
|
||||
00784 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBU420
|
||||
00785 DTSBU420
|
||||
00786 S982B-EXIT. DTSBU420
|
||||
00787 EXIT. DTSBU420
|
||||
00788 DTSBU420
|
||||
00789 S982C-WRITE. DTSBU420
|
||||
00790 SET L982-WRITE-88 TO TRUE. DTSBU420
|
||||
00791 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBU420
|
||||
00792 DTSBU420
|
||||
00793 S982C-EXIT. DTSBU420
|
||||
00794 EXIT. DTSBU420
|
||||
00795 DTSBU420
|
||||
00796 S982D-REWRITE. DTSBU420
|
||||
00797 SET L982-REWRITE-88 TO TRUE. DTSBU420
|
||||
00798 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBU420
|
||||
00799 DTSBU420
|
||||
00800 S982D-EXIT. DTSBU420
|
||||
00801 EXIT. DTSBU420
|
||||
00802 DTSBU420
|
||||
00803 S982F-CLOSE. DTSBU420
|
||||
00804 SET L982-CLOSE-88 TO TRUE. DTSBU420
|
||||
00805 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBU420
|
||||
00806 DTSBU420
|
||||
00807 S982F-EXIT. DTSBU420
|
||||
00808 EXIT. DTSBU420
|
||||
00809 DTSBU420
|
||||
00810 S982Z-WNAM-IO. DTSBU420
|
||||
00811 CALL 'DTSBU982' USING L982-LINK-AREA DTSBU420
|
||||
00812 WNAM-REC. DTSBU420
|
||||
00813 S982Z-EXIT. DTSBU420
|
||||
00814 EXIT. DTSBU420
|
||||
00815 DTSBU420
|
||||
00816 S1000-WRITE-WAGE-TRANS. DTSBU420
|
||||
00817 MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. DTSBU420
|
||||
00818 DTSBU420
|
||||
00819 WRITE WAGE-TRANS-REC. DTSBU420
|
||||
00820 DTSBU420
|
||||
00821 IF WAGE-TRANS-FILE-OK-88 DTSBU420
|
||||
00822 NEXT SENTENCE DTSBU420
|
||||
00823 ELSE DTSBU420
|
||||
00824 PERFORM S999-ABEND THRU S999-EXIT. DTSBU420
|
||||
00825 S1000-EXIT. DTSBU420
|
||||
00826 EXIT. DTSBU420
|
||||
00827 DTSBU420
|
||||
00828 S2000-SET-YRQ. DTSBU420
|
||||
00829 MOVE L420-YRQ TO L004-QTR-5-9. DTSBU420
|
||||
00830 MOVE L004-QTR-5-YR TO WRK-QTR-YR. DTSBU420
|
||||
00831 DTSBU420
|
||||
00832 MOVE W001-YRQ TO L004-QTR-5-9. DTSBU420
|
||||
00833 MOVE L004-QTR-5-Q TO WRK-QTR-Q. DTSBU420
|
||||
00834 DTSBU420
|
||||
00835 S2000-EXIT. DTSBU420
|
||||
00836 EXIT. DTSBU420
|
||||
00837 DTSBU420
|
||||
00838 S999-ABEND. DTSBU420
|
||||
00839 DISPLAY '*** I/O MODULE ABENDING'. DTSBU420
|
||||
00840 DTSBU420
|
||||
00841 DISPLAY '*** CMND-CD = ' L983-CMND-CD. DTSBU420
|
||||
00842 DTSBU420
|
||||
00843 DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS. DTSBU420
|
||||
00844 DTSBU420
|
||||
00845 DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME. DTSBU420
|
||||
00846 DTSBU420
|
||||
00847 DTSBU420
|
||||
00848 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU420
|
||||
00849 S999-EXIT. DTSBU420
|
||||
00850 EXIT. DTSBU420
|
||||
Reference in New Issue
Block a user