1118 lines
88 KiB
COBOL
1118 lines
88 KiB
COBOL
00001 IDENTIFICATION DIVISION. 06/23/14
|
|
00002 PROGRAM-ID. DTSBZ500. DTSBX500
|
|
00003 AUTHOR. NORTHROP GRUMMAN CORP. LV007
|
|
00004 DATE-WRITTEN. AUGUST 2005. DTSBX500
|
|
00005 DATE-COMPILED. DTSBX500
|
|
00006 DTSBX500
|
|
00007 ***** DTSBX500
|
|
00008 * DTSBX500
|
|
00009 * FUNCTION: CREATE A WAGE AND EMPLOYER FILE FOR EACH QUATER DTSBX500
|
|
00010 * TO BE LOADED INTO THE SDDS SYSTEM. EVERY QUATER DTSBX500
|
|
00011 * OF WAGE RECORD DATA MUST HAVE A CORRESPONDING DTSBX500
|
|
00012 * QUATER OF EMPLOYER DATA. THIS SYSTEM REQUIRS A DTSBX500
|
|
00013 * MINIMUN OF THREE YEARS OF DATA TO BE LOADED INTO DTSBX500
|
|
00014 * THE SYSTEM. DTSBX500
|
|
00015 ***** DTSBX500
|
|
00016 DTSBX500
|
|
00017 ENVIRONMENT DIVISION. DTSBX500
|
|
00018 DTSBX500
|
|
00019 CONFIGURATION SECTION. DTSBX500
|
|
00020 DTSBX500
|
|
00021 INPUT-OUTPUT SECTION. DTSBX500
|
|
00022 DTSBX500
|
|
00023 FILE-CONTROL. DTSBX500
|
|
00024 SELECT WAGE-FILE ASSIGN TO DTSWAGE DTSBX500
|
|
00025 FILE STATUS IS WAGEFILE-STATUS. DTSBX500
|
|
00026 DTSBX500
|
|
00027 SELECT EMPL-FILE ASSIGN TO DTSEMPL DTSBX500
|
|
00028 FILE STATUS IS EMPFILE-STATUS. DTSBX500
|
|
00029 DTSBX500
|
|
00030 SELECT TAX-FILE ASSIGN TO DTSTAX DTSBX500
|
|
00031 FILE STATUS IS TAXFILE-STATUS. DTSBX500
|
|
00032 DTSBX500
|
|
00033 SELECT CONTACT-FILE ASSIGN TO DTSCONT DTSBX500
|
|
00034 FILE STATUS IS CONTFILE-STATUS. DTSBX500
|
|
00035 DTSBX500
|
|
00036 DATA DIVISION. DTSBX500
|
|
00037 DTSBX500
|
|
00038 FILE SECTION. DTSBX500
|
|
00039 DTSBX500
|
|
00040 FD WAGE-FILE DTSBX500
|
|
00041 RECORDING MODE IS F. DTSBX500
|
|
00042 01 WAGE-RECORD PIC X(086). DTSBX500
|
|
00043 DTSBX500
|
|
00044 FD EMPL-FILE DTSBX500
|
|
00045 RECORDING MODE IS F. DTSBX500
|
|
00046 01 EMPL-RECORD PIC X(340). DTSBX500
|
|
00047 DTSBX500
|
|
00048 FD TAX-FILE DTSBX500
|
|
00049 RECORDING MODE IS F. DTSBX500
|
|
00050 01 TAX-RECORD PIC X(72). DTSBX500
|
|
00051 DTSBX500
|
|
00052 FD CONTACT-FILE DTSBX500
|
|
00053 RECORDING MODE IS F. DTSBX500
|
|
00054 01 CONTACT-RECORD PIC X(101). DTSBX500
|
|
00055 EJECT DTSBX500
|
|
00056 DTSBX500
|
|
00057 WORKING-STORAGE SECTION. DTSBX500
|
|
000575 77 PAN-VALET PICTURE X(24) VALUE '007DTSBX500 06/23/14'. DTSBX500
|
|
00058 DTSBX500
|
|
00059 01 WRK-AREA. DTSBX500
|
|
00060 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +500.DTSBX500
|
|
00061 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBX500
|
|
00062 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBX500
|
|
00063 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ500'.DTSBX500
|
|
00064 DTSBX500
|
|
00065 05 DISP-DATE PIC X(10). DTSBX500
|
|
00066 05 DISP-TIME PIC X(08). DTSBX500
|
|
00067 05 DISP-ABSTIME PIC X(16). DTSBX500
|
|
00068 DTSBX500
|
|
00069 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00070 05 WRK-MPRF-ZERO-FEIN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00071 05 WRK-MPRF-ACT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00072 05 WRK-MPRF-ACT-NO-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00073 05 WRK-TAX-ADDR-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00074 05 WRK-PHY-ADDR-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00075 05 WRK-PHY-TAX-ADDR-SAME-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00076 05 WRK-ADDR-SELECT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00077 05 WRK-ADDR-FOUND-NO-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00078 05 WRK-WWGH-READ-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00079 05 WRK-WWGH-EMP-NO-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00080 05 WRK-WWGH-ACCT-INVALID PIC S9(07) COMP-3 VALUE 0. DTSBX500
|
|
00081 05 WRK-WAGE-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00082 05 WRK-EMPL-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00083 05 WRK-TAX-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00084 05 WRK-CONTACT-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00085 05 WRK-MQTR-REC-NOT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00086 05 WRK-LIABLE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00087 05 WRK-NOT-LIABLE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500
|
|
00088 05 WRK-DISPLAY-CNT PIC 9(06) VALUE 0. DTSBX500
|
|
00089 DTSBX500
|
|
00090 05 WRK-WWGH-EMP-NO PIC S9(07) VALUE +0. DTSBX500
|
|
00091 05 WRK-MQTR-EMP-NO PIC 9(06) VALUE 0. DTSBX500
|
|
00092 05 WRK-EMP-NO PIC 9(06) VALUE 0. DTSBX500
|
|
00093 05 WRK-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX500
|
|
00094 05 WRK-YEAR-QTR PIC 9(05). DTSBX500
|
|
00095 05 FILLER REDEFINES WRK-YEAR-QTR. DTSBX500
|
|
00096 10 WRK-YRQ-YEAR PIC 9(4). DTSBX500
|
|
00097 10 WRK-YRQ-QTR PIC 9(1). DTSBX500
|
|
00098 05 WRK-SSN PIC 9(09) VALUE 0. DTSBX500
|
|
00099 05 WRK-MOPO-SSN PIC 9(09) VALUE 0. DTSBX500
|
|
00100 05 WRK-FEIN PIC 9(09) VALUE 0. DTSBX500
|
|
00101 05 WRK-EARNINGS PIC 9(10) VALUE 0. DTSBX500
|
|
00102 DTSBX500
|
|
00103 05 WRK-QTR-PAID-AMT PIC ZZZZZ9.99. DTSBX500
|
|
00104 05 WRK-QTR-TOT-WAGE PIC ZZZZZZZ9.99. DTSBX500
|
|
00105 05 WRK-QTR-TAX-WAGE PIC ZZZZZZZ9.99. DTSBX500
|
|
00106 05 WRK-QTR-UI-RATE PIC 9.9999. DTSBX500
|
|
00107 05 WRK-QTR-MON1-EMP-CNT PIC 9(06). DTSBX500
|
|
00108 05 WRK-QTR-MON2-EMP-CNT PIC 9(06). DTSBX500
|
|
00109 05 WRK-QTR-MON3-EMP-CNT PIC 9(06). DTSBX500
|
|
00110 DTSBX500
|
|
00111 05 WAGEFILE-STATUS PIC X(02). DTSBX500
|
|
00112 88 WAGEFILE-OK-88 VALUE '00'. DTSBX500
|
|
00113 DTSBX500
|
|
00114 05 EMPFILE-STATUS PIC X(02). DTSBX500
|
|
00115 88 EMPFILE-OK-88 VALUE '00'. DTSBX500
|
|
00116 DTSBX500
|
|
00117 05 TAXFILE-STATUS PIC X(02). DTSBX500
|
|
00118 88 TAXFILE-OK-88 VALUE '00'. DTSBX500
|
|
00119 DTSBX500
|
|
00120 05 CONTFILE-STATUS PIC X(02). DTSBX500
|
|
00121 88 CONTFILE-OK-88 VALUE '00'. DTSBX500
|
|
00122 DTSBX500
|
|
00123 05 WRK-ERROR-IND PIC X(01). DTSBX500
|
|
00124 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX500
|
|
00125 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX500
|
|
00126 DTSBX500
|
|
00127 05 WRK-SUBJECT-IND PIC X(01) VALUE 'N'. DTSBX500
|
|
00128 88 WRK-SUBJECT-YES-88 VALUE 'Y'. DTSBX500
|
|
00129 88 WRK-SUBJECT-NO-88 VALUE 'N'. DTSBX500
|
|
00130 DTSBX500
|
|
00131 05 WRK-LIABLE-IND PIC X(01) VALUE 'N'. DTSBX500
|
|
00132 88 WRK-LIABLE-YES-88 VALUE 'Y'. DTSBX500
|
|
00133 88 WRK-LIABLE-NO-88 VALUE 'N'. DTSBX500
|
|
00134 DTSBX500
|
|
00135 05 WRK-EMP-NO-IND PIC X(01) VALUE SPACE. DTSBX500
|
|
00136 88 WRK-EMP-NO-INVALID-88 VALUE 'N'. DTSBX500
|
|
00137 88 WRK-EMP-NO-VALID-88 VALUE 'Y'. DTSBX500
|
|
00138 DTSBX500
|
|
00139 05 WRK-EMP-SELECTED-IND PIC X(01). DTSBX500
|
|
00140 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSBX500
|
|
00141 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSBX500
|
|
00142 DTSBX500
|
|
00143 05 WS-MAILING-ADDRESS-1 PIC X(35) VALUE SPACES. DTSBX500
|
|
00144 05 WS-MAILING-ADDRESS-2 PIC X(35) VALUE SPACES. DTSBX500
|
|
00145 05 WS-CITY-1 PIC X(30) VALUE SPACES. DTSBX500
|
|
00146 05 WS-STATE-1 PIC X(02) VALUE SPACES. DTSBX500
|
|
00147 DTSBX500
|
|
00148 05 WS-ZIP-1. DTSBX500
|
|
00149 10 WS-ZIP-1-5 PIC X(05). DTSBX500
|
|
00150 10 FILLER PIC X(01) VALUE SPACE. DTSBX500
|
|
00151 10 WS-ZIP-1-4 PIC X(04). DTSBX500
|
|
00152 DTSBX500
|
|
00153 05 WS-ZIP-2. DTSBX500
|
|
00154 10 WS-ZIP-2-5 PIC X(05). DTSBX500
|
|
00155 10 FILLER PIC X(01) VALUE SPACE. DTSBX500
|
|
00156 10 WS-ZIP-2-4 PIC X(04). DTSBX500
|
|
00157 DTSBX500
|
|
00158 05 WS-VOICE-1. DTSBX500
|
|
00159 10 WS-VOICE-1-AREA-CD PIC X(03). DTSBX500
|
|
00160 10 WS-VOICE-1-PREFIX PIC X(03). DTSBX500
|
|
00161 10 WS-VOICE-1-SUFFIX PIC X(04). DTSBX500
|
|
00162 DTSBX500
|
|
00163 05 WRK-VOICE-1. DTSBX500
|
|
00164 10 WRK-VOICE-1-AREA-CD PIC X(03). DTSBX500
|
|
00165 10 WRK-VOICE-1-PREFIX PIC X(03). DTSBX500
|
|
00166 10 WRK-VOICE-1-SUFFIX PIC X(04). DTSBX500
|
|
00167 DTSBX500
|
|
00168 01 WR-WAGE-RECORD. DTSBX500
|
|
00169 05 WR-SSN PIC X(09) VALUE SPACES. DTSBX500
|
|
00170 05 WR-FIRST-NAME PIC X(15) VALUE SPACES. DTSBX500
|
|
00171 05 WR-M-I PIC X(01) VALUE SPACE. DTSBX500
|
|
00172 05 WR-LAST-NAME PIC X(20) VALUE SPACES. DTSBX500
|
|
00173 05 WR-STATE-CODE PIC X(02) VALUE '11'. DTSBX500
|
|
00174 05 WR-UI-ACCT-NO. DTSBX500
|
|
00175 10 WR-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500
|
|
00176 10 WR-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500
|
|
00177 05 WR-RPT-UNIT-NO PIC X(05) VALUE '00000'. DTSBX500
|
|
00178 05 WR-EIN PIC X(09) VALUE SPACES. DTSBX500
|
|
00179 05 WR-YEAR PIC X(04) VALUE SPACES. DTSBX500
|
|
00180 05 WR-QUARTER PIC X(01) VALUE SPACE. DTSBX500
|
|
00181 05 WR-WAGE PIC X(10) VALUE SPACES. DTSBX500
|
|
00182 DTSBX500
|
|
00183 01 ER-EMPL-RECORD. DTSBX500
|
|
00184 05 ER-STATE-CODE PIC X(02) VALUE '11'. DTSBX500
|
|
00185 05 ER-UI-ACCT-NO. DTSBX500
|
|
00186 10 ER-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500
|
|
00187 10 ER-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500
|
|
00188 05 ER-EIN PIC X(09) VALUE SPACES. DTSBX500
|
|
00189 05 ER-YEAR PIC X(04) VALUE SPACES. DTSBX500
|
|
00190 05 ER-QUARTER PIC X(01) VALUE SPACE. DTSBX500
|
|
00191 05 ER-EMP-PRIMARY-NAME PIC X(35) VALUE SPACES. DTSBX500
|
|
00192 05 ER-EMP-ENTITY-NAME PIC X(35) VALUE SPACES. DTSBX500
|
|
00193 05 ER-MAILING-ADDRESS-1 PIC X(35) VALUE SPACES. DTSBX500
|
|
00194 05 ER-MAILING-ADDRESS-2 PIC X(35) VALUE SPACES. DTSBX500
|
|
00195 05 ER-CITY-1 PIC X(30) VALUE SPACES. DTSBX500
|
|
00196 05 ER-STATE-1 PIC X(02) VALUE SPACES. DTSBX500
|
|
00197 05 ER-ZIP-1-5 PIC X(05) VALUE SPACES. DTSBX500
|
|
00198 05 ER-ZIP-1-4 PIC X(04) VALUE SPACES. DTSBX500
|
|
00199 05 ER-PHYSICAL-ADDRESS-1 PIC X(35) VALUE SPACES. DTSBX500
|
|
00200 05 ER-PHYSICAL-ADDRESS-2 PIC X(35) VALUE SPACES. DTSBX500
|
|
00201 05 ER-CITY-2 PIC X(30) VALUE SPACES. DTSBX500
|
|
00202 05 ER-STATE-2 PIC X(02) VALUE SPACES. DTSBX500
|
|
00203 05 ER-ZIP-2-5 PIC X(05) VALUE SPACES. DTSBX500
|
|
00204 05 ER-ZIP-2-4 PIC X(04) VALUE SPACES. DTSBX500
|
|
00205 05 ER-PHONE PIC X(10) VALUE SPACES. DTSBX500
|
|
00206 05 ER-OWNERSHIP-CODE PIC X(02) VALUE SPACES. DTSBX500
|
|
00207 05 ER-SIC-CODE PIC X(04) VALUE SPACES. DTSBX500
|
|
00208 05 ER-NAICS-CODE PIC X(06) VALUE SPACES. DTSBX500
|
|
00209 DTSBX500
|
|
00210 01 TX-TAX-RECORD. DTSBX500
|
|
00211 05 TX-STATE-CODE PIC X(02) VALUE '11'. DTSBX500
|
|
00212 05 TX-UI-ACCT-NO. DTSBX500
|
|
00213 10 TX-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500
|
|
00214 10 TX-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500
|
|
00215 05 TX-YEAR PIC X(04) VALUE SPACES. DTSBX500
|
|
00216 05 TX-QUARTER PIC X(01) VALUE SPACE. DTSBX500
|
|
00217 05 TX-TAX-PAID PIC X(09) VALUE SPACES. DTSBX500
|
|
00218 05 TX-TOT-WAGE PIC X(11) VALUE SPACES. DTSBX500
|
|
00219 05 TX-TAX-WAGE PIC X(11) VALUE SPACES. DTSBX500
|
|
00220 05 TX-UI-RATE PIC X(06) VALUE SPACES. DTSBX500
|
|
00221 05 TX-MON1-EMP-CNT PIC X(06) VALUE SPACES. DTSBX500
|
|
00222 05 TX-MON2-EMP-CNT PIC X(06) VALUE SPACES. DTSBX500
|
|
00223 05 TX-MON3-EMP-CNT PIC X(06) VALUE SPACES. DTSBX500
|
|
00224 DTSBX500
|
|
00225 01 CT-CONTACT-RECORD. DTSBX500
|
|
00226 05 CT-STATE-CODE PIC X(02) VALUE '11'. DTSBX500
|
|
00227 05 CT-UI-ACCT-NO. DTSBX500
|
|
00228 10 CT-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500
|
|
00229 10 CT-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500
|
|
00230 05 CT-YEAR PIC X(04) VALUE SPACES. DTSBX500
|
|
00231 05 CT-QUARTER PIC X(01) VALUE SPACE. DTSBX500
|
|
00232 05 CT-CONTACT-NAME PIC X(35) VALUE SPACES. DTSBX500
|
|
00233 05 CT-PHONE PIC X(10) VALUE SPACES. DTSBX500
|
|
00234 05 CT-SSN PIC X(09) VALUE SPACES. DTSBX500
|
|
00235 05 CT-CONTACT-TITLE PIC X(30) VALUE SPACES. DTSBX500
|
|
00236 DTSBX500
|
|
00237 EJECT DTSBX500
|
|
00238 01 L005-COMM-AREA. DTSBX500
|
|
00239 ++INCLUDE DTSIL005 DTSBX500
|
|
00240 EJECT DTSBX500
|
|
00241 01 L071-LINK-AREA. DTSBX500
|
|
00242 ++INCLUDE DTSIL071 DTSBX500
|
|
00243 EJECT DTSBX500
|
|
00244 01 L910-LINK-AREA. DTSBX500
|
|
00245 ++INCLUDE DTSIL910 DTSBX500
|
|
00246 EJECT DTSBX500
|
|
00247 01 L921-LINK-AREA. DTSBX500
|
|
00248 ++INCLUDE DTSIL921 DTSBX500
|
|
00249 EJECT DTSBX500
|
|
00250 01 ISKL-REC. DTSBX500
|
|
00251 ++INCLUDE DTSIISKL DTSBX500
|
|
00252 EJECT DTSBX500
|
|
00253 01 IEIN-REC. DTSBX500
|
|
00254 ++INCLUDE DTSIIEIN DTSBX500
|
|
00255 EJECT DTSBX500
|
|
00256 01 MSKL-REC. DTSBX500
|
|
00257 ++INCLUDE DTSIMSKL DTSBX500
|
|
00258 EJECT DTSBX500
|
|
00259 01 MPRF-REC. DTSBX500
|
|
00260 ++INCLUDE DTSIMPRF DTSBX500
|
|
00261 EJECT DTSBX500
|
|
00262 01 MTAD-REC. DTSBX500
|
|
00263 ++INCLUDE DTSIMTAD DTSBX500
|
|
00264 EJECT DTSBX500
|
|
00265 01 MQTR-REC. DTSBX500
|
|
00266 ++INCLUDE DTSIMQTR DTSBX500
|
|
00267 EJECT DTSBX500
|
|
00268 01 MOPO-REC. DTSBX500
|
|
00269 ++INCLUDE DTSIMOPO DTSBX500
|
|
00270 EJECT DTSBX500
|
|
00271 ** DTSBX500
|
|
00272 01 L981-LINK-AREA. DTSBX500
|
|
00273 ++INCLUDE DTSIL981 DTSBX500
|
|
00274 SKIP3 DTSBX500
|
|
00275 01 WWGH-REC. DTSBX500
|
|
00276 ++INCLUDE DTSIWWGH DTSBX500
|
|
00277 EJECT DTSBX500
|
|
00278 01 L982-LINK-AREA. DTSBX500
|
|
00279 ++INCLUDE DTSIL982 DTSBX500
|
|
00280 SKIP3 DTSBX500
|
|
00281 01 WNAM-REC. DTSBX500
|
|
00282 ++INCLUDE DTSIWNAM DTSBX500
|
|
00283 EJECT DTSBX500
|
|
00284 ** DTSBX500
|
|
00285 LINKAGE SECTION. DTSBX500
|
|
00286 DTSBX500
|
|
00287 01 PARM-AREA. DTSBX500
|
|
00288 05 PARM-LENGTH PIC S9(04) COMP. DTSBX500
|
|
00289 05 PARM-DATA. DTSBX500
|
|
00290 10 PARM-YEAR-QTR PIC 9(05). DTSBX500
|
|
00291 10 PARM-YEAR-QTR-X REDEFINES PARM-YEAR-QTR DTSBX500
|
|
00292 PIC X(05). DTSBX500
|
|
00293 EJECT DTSBX500
|
|
00294 PROCEDURE DIVISION USING PARM-AREA. DTSBX500
|
|
00295 DTSBX500
|
|
00296 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX500
|
|
00297 DTSBX500
|
|
00298 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX500
|
|
00299 DTSBX500
|
|
00300 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX500
|
|
00301 DTSBX500
|
|
00302 GOBACK. DTSBX500
|
|
00303 EJECT DTSBX500
|
|
00304 I0000-INITIATE. DTSBX500
|
|
00305 DTSBX500
|
|
00306 MOVE 'N' TO WRK-TRACE-IND. DTSBX500
|
|
00307 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBX500
|
|
00308 PERFORM I2000-SYS-DATE THRU I2000-EXIT. DTSBX500
|
|
00309 PERFORM I3000-OPEN-FILES THRU I3000-EXIT. DTSBX500
|
|
00310 DTSBX500
|
|
00311 I0000-EXIT. DTSBX500
|
|
00312 EXIT. DTSBX500
|
|
00313 DTSBX500
|
|
00314 I1000-PROCESS-PARMS. DTSBX500
|
|
00315 DTSBX500
|
|
00316 DISPLAY '*** ' DTSBX500
|
|
00317 WRK-MOD-NAME DTSBX500
|
|
00318 ' PARAMETERS: ' DTSBX500
|
|
00319 PARM-DATA. DTSBX500
|
|
00320 DTSBX500
|
|
00321 IF PARM-LENGTH = +5 DTSBX500
|
|
00322 NEXT SENTENCE DTSBX500
|
|
00323 ELSE DTSBX500
|
|
00324 MOVE 'PARM-LENGTH NOT EQUAL TO 5' DTSBX500
|
|
00325 TO WRK-ABEND-MSG DTSBX500
|
|
00326 PERFORM S999-ABEND THRU S999-EXIT. DTSBX500
|
|
00327 DTSBX500
|
|
00328 IF PARM-YEAR-QTR = ZEROS OR PARM-YEAR-QTR-X = SPACES DTSBX500
|
|
00329 MOVE 'PARM-YEAR-QTR NOT VALID' TO WRK-ABEND-MSG DTSBX500
|
|
00330 PERFORM S999-ABEND THRU S999-EXIT. DTSBX500
|
|
00331 DTSBX500
|
|
00332 MOVE PARM-YEAR-QTR TO WRK-YRQ WRK-YEAR-QTR. DTSBX500
|
|
00333 DTSBX500
|
|
00334 I1000-EXIT. DTSBX500
|
|
00335 EXIT. DTSBX500
|
|
00336 DTSBX500
|
|
00337 I2000-SYS-DATE. DTSBX500
|
|
00338 SET L005-FROM-SYS TO TRUE. DTSBX500
|
|
00339 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBX500
|
|
00340 MOVE L005-DATE TO DISP-DATE. DTSBX500
|
|
00341 MOVE L005-TIME TO DISP-TIME. DTSBX500
|
|
00342 MOVE L005-ABSTIME TO DISP-ABSTIME. DTSBX500
|
|
00343 DTSBX500
|
|
00344 DISPLAY ' '. DTSBX500
|
|
00345 DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME DTSBX500
|
|
00346 ' L005-ABSTIME ' DISP-ABSTIME. DTSBX500
|
|
00347 DTSBX500
|
|
00348 I2000-EXIT. DTSBX500
|
|
00349 EXIT. DTSBX500
|
|
00350 DTSBX500
|
|
00351 I3000-OPEN-FILES. DTSBX500
|
|
00352 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX500
|
|
00353 DTSBX500
|
|
00354 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX500
|
|
00355 MOVE WRK-MOD-NAME TO L981-MOD-NAME. DTSBX500
|
|
00356 MOVE WRK-MOD-NAME TO L982-MOD-NAME. DTSBX500
|
|
00357 DTSBX500
|
|
00358 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX500
|
|
00359 * PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX500
|
|
00360 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DTSBX500
|
|
00361 PERFORM S982E-OPEN-READ THRU S982E-EXIT. DTSBX500
|
|
00362 DTSBX500
|
|
00363 OPEN OUTPUT WAGE-FILE. DTSBX500
|
|
00364 IF NOT WAGEFILE-OK-88 DTSBX500
|
|
00365 DISPLAY 'CANNOT OPEN WAGE FILE ' WAGEFILE-STATUS DTSBX500
|
|
00366 MOVE 'CANNOT OPEN WAGE REC FILE ' TO WRK-ABEND-MSG DTSBX500
|
|
00367 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00368 END-IF. DTSBX500
|
|
00369 DTSBX500
|
|
00370 OPEN OUTPUT EMPL-FILE. DTSBX500
|
|
00371 IF NOT EMPFILE-OK-88 DTSBX500
|
|
00372 DISPLAY 'CANNOT OPEN EMP FILE ' EMPFILE-STATUS DTSBX500
|
|
00373 MOVE 'CANNOT OPEN EMPLOYER FILE ' TO WRK-ABEND-MSG DTSBX500
|
|
00374 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00375 END-IF. DTSBX500
|
|
00376 DTSBX500
|
|
00377 OPEN OUTPUT TAX-FILE. DTSBX500
|
|
00378 IF NOT TAXFILE-OK-88 DTSBX500
|
|
00379 DISPLAY 'CANNOT OPEN TAX FILE ' TAXFILE-STATUS DTSBX500
|
|
00380 MOVE 'CANNOT OPEN TAX OUTPUT FILE ' TO WRK-ABEND-MSG DTSBX500
|
|
00381 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00382 END-IF. DTSBX500
|
|
00383 DTSBX500
|
|
00384 OPEN OUTPUT CONTACT-FILE. DTSBX500
|
|
00385 IF NOT CONTFILE-OK-88 DTSBX500
|
|
00386 DISPLAY 'CANNOT OPEN CONTACT FILE ' CONTFILE-STATUS DTSBX500
|
|
00387 MOVE 'CANNOT OPEN CONTACT OUTPUT FILE ' TO WRK-ABEND-MSG DTSBX500
|
|
00388 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00389 END-IF. DTSBX500
|
|
00390 DTSBX500
|
|
00391 I3000-EXIT. DTSBX500
|
|
00392 EXIT. DTSBX500
|
|
00393 EJECT DTSBX500
|
|
00394 DTSBX500
|
|
00395 P0000-PROCESS. DTSBX500
|
|
00396 DTSBX500
|
|
00397 SET WRK-LIABLE-NO-88 TO TRUE. DTSBX500
|
|
00398 MOVE LOW-VALUES TO WWGH-REC. DTSBX500
|
|
00399 MOVE ZERO TO WWGH-EMP-NO DTSBX500
|
|
00400 WWGH-YRQ DTSBX500
|
|
00401 WWGH-SSN. DTSBX500
|
|
00402 DTSBX500
|
|
00403 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DTSBX500
|
|
00404 IF L981-NO-REC-88 DTSBX500
|
|
00405 MOVE '1ST BROWSE WWGH FIND NO REC ' TO WRK-ABEND-MSG DTSBX500
|
|
00406 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00407 GO TO P0000-EXIT DTSBX500
|
|
00408 ELSE DTSBX500
|
|
00409 PERFORM P1000-SCAN-WAGES THRU P1000-EXIT DTSBX500
|
|
00410 UNTIL L981-NO-REC-88. DTSBX500
|
|
00411 DTSBX500
|
|
00412 P0000-EXIT. DTSBX500
|
|
00413 EXIT. DTSBX500
|
|
00414 DTSBX500
|
|
00415 ************************************************************** DTSBX500
|
|
00416 * SELECT VSAM-WGH RECORDS FROM YRQ INPUT PARAMETER AND * DTSBX500
|
|
00417 * OUTPUT THE WAGE RECORD FILE. * DTSBX500
|
|
00418 ************************************************************** DTSBX500
|
|
00419 DTSBX500
|
|
00420 P1000-SCAN-WAGES. DTSBX500
|
|
00421 DTSBX500
|
|
00422 ADD +1 TO WRK-WWGH-READ-CNT. DTSBX500
|
|
00423 DTSBX500
|
|
00424 IF WWGH-EMP-NO = ZERO DTSBX500
|
|
00425 * NEXT SENTENCE DTSBX500
|
|
00426 ADD +1 TO WRK-WWGH-ACCT-INVALID DTSBX500
|
|
00427 ELSE DTSBX500
|
|
00428 PERFORM P2000-CHECK-YEAR-QTR THRU P2000-EXIT DTSBX500
|
|
00429 END-IF. DTSBX500
|
|
00430 DTSBX500
|
|
00431 PERFORM S981E-READ-NEXT THRU S981E-EXIT. DTSBX500
|
|
00432 DTSBX500
|
|
00433 P1000-EXIT. DTSBX500
|
|
00434 EXIT. DTSBX500
|
|
00435 DTSBX500
|
|
00436 ************************************************************** DTSBX500
|
|
00437 * CREATE WAGE OUTPUT RECORDS, BASED ON YEAR-QUARTER * DTSBX500
|
|
00438 ************************************************************** DTSBX500
|
|
00439 DTSBX500
|
|
00440 P2000-CHECK-YEAR-QTR. DTSBX500
|
|
00441 * DTSBX500
|
|
00442 IF WWGH-YRQ = WRK-YRQ DTSBX500
|
|
00443 *RW IF WWGH-EMP-NO NOT = WRK-WWGH-EMP-NO DTSBX500
|
|
00444 IF WWGH-EMP-NO NOT = WRK-EMP-NO DTSBX500
|
|
00445 PERFORM P4000-READ-MQTR THRU P4000-EXIT DTSBX500
|
|
00446 IF WRK-LIABLE-YES-88 DTSBX500
|
|
00447 PERFORM P2100-READ-MPRF THRU P2100-EXIT DTSBX500
|
|
00448 ** IF WRK-SUBJECT-YES-88 DTSBX500
|
|
00449 *RW1 DTSBX500
|
|
00450 ADD +1 TO WRK-WWGH-EMP-NO-CNT DTSBX500
|
|
00451 *RW2 DTSBX500
|
|
00452 PERFORM P2300-WRITE-EMPL-RECORD THRU P2300-EXIT DTSBX500
|
|
00453 ** PERFORM P4000-READ-MQTR THRU P4000-EXIT DTSBX500
|
|
00454 PERFORM P5000-READ-MOPO THRU P5000-EXIT DTSBX500
|
|
00455 END-IF DTSBX500
|
|
00456 END-IF DTSBX500
|
|
00457 ELSE DTSBX500
|
|
00458 GO TO P2000-EXIT. DTSBX500
|
|
00459 DTSBX500
|
|
00460 ** IF WRK-SUBJECT-YES-88 DTSBX500
|
|
00461 IF WRK-LIABLE-YES-88 DTSBX500
|
|
00462 PERFORM P2200-WRITE-WAGE-RECORD THRU P2200-EXIT DTSBX500
|
|
00463 END-IF. DTSBX500
|
|
00464 DTSBX500
|
|
00465 P2000-EXIT. DTSBX500
|
|
00466 EXIT. DTSBX500
|
|
00467 DTSBX500
|
|
00468 P2100-READ-MPRF. DTSBX500
|
|
00469 ** SET WRK-SUBJECT-NO-88 TO TRUE. DTSBX500
|
|
00470 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX500
|
|
00471 MOVE WWGH-EMP-NO TO MSKL-EMP-NO. DTSBX500
|
|
00472 SET MSKL-PRF-88 TO TRUE. DTSBX500
|
|
00473 DTSBX500
|
|
00474 PERFORM S910-READ THRU S910-EXIT. DTSBX500
|
|
00475 IF L910-OK-88 DTSBX500
|
|
00476 MOVE MSKL-REC TO MPRF-REC DTSBX500
|
|
00477 IF MPRF-STATUS-SUB-88 DTSBX500
|
|
00478 ADD +1 TO WRK-MPRF-READ-CNT DTSBX500
|
|
00479 IF MPRF-STATUS-ACT-88 DTSBX500
|
|
00480 ** MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBX500
|
|
00481 *RW WRK-WWGH-EMP-NO DTSBX500
|
|
00482 ** SET WRK-SUBJECT-YES-88 TO TRUE DTSBX500
|
|
00483 ADD +1 TO WRK-MPRF-ACT-CNT DTSBX500
|
|
00484 ELSE DTSBX500
|
|
00485 ** MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBX500
|
|
00486 *RW WRK-WWGH-EMP-NO DTSBX500
|
|
00487 ** SET WRK-SUBJECT-YES-88 TO TRUE DTSBX500
|
|
00488 ADD +1 TO WRK-MPRF-ACT-NO-CNT DTSBX500
|
|
00489 * DISPLAY 'INACTIVE MPRF-EMP-NO = ' MPRF-EMP-NO ' ' DTSBX500
|
|
00490 * 'WWGH-EMP-NO = ' WWGH-EMP-NO DTSBX500
|
|
00491 END-IF DTSBX500
|
|
00492 END-IF DTSBX500
|
|
00493 ELSE DTSBX500
|
|
00494 DISPLAY 'WAGE FILE EMP-NO INVALID ' WWGH-EMP-NO DTSBX500
|
|
00495 ADD +1 TO WRK-WWGH-ACCT-INVALID DTSBX500
|
|
00496 END-IF. DTSBX500
|
|
00497 DTSBX500
|
|
00498 P2100-EXIT. DTSBX500
|
|
00499 EXIT. DTSBX500
|
|
00500 DTSBX500
|
|
00501 P2200-WRITE-WAGE-RECORD. DTSBX500
|
|
00502 DTSBX500
|
|
00503 SET WRK-ERROR-NO-88 TO TRUE. DTSBX500
|
|
00504 MOVE LOW-VALUE TO WNAM-REC. DTSBX500
|
|
00505 MOVE WWGH-SSN TO WNAM-SSN. DTSBX500
|
|
00506 DTSBX500
|
|
00507 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DTSBX500
|
|
00508 DTSBX500
|
|
00509 IF L982-OK-88 DTSBX500
|
|
00510 IF NOT WNAM-TYPE-3CHAR-88 DTSBX500
|
|
00511 MOVE WNAM-FIRST-NAME TO WR-FIRST-NAME DTSBX500
|
|
00512 MOVE WNAM-MID-INIT TO WR-M-I DTSBX500
|
|
00513 MOVE WNAM-LAST-NAME TO WR-LAST-NAME DTSBX500
|
|
00514 ELSE DTSBX500
|
|
00515 MOVE SPACES TO WR-FIRST-NAME DTSBX500
|
|
00516 MOVE SPACES TO WR-M-I CL**5
|
|
00517 MOVE SPACES TO WR-LAST-NAME DTSBX500
|
|
00518 END-IF DTSBX500
|
|
00519 ELSE DTSBX500
|
|
00520 MOVE SPACES TO WR-FIRST-NAME DTSBX500
|
|
00521 MOVE SPACES TO WR-M-I CL**5
|
|
00522 MOVE SPACES TO WR-LAST-NAME DTSBX500
|
|
00523 END-IF. CL**7
|
|
00524 CL**7
|
|
00525 IF WR-M-I = LOW-VALUES CL**7
|
|
00526 MOVE SPACES TO WR-M-I CL**7
|
|
00527 END-IF. CL**7
|
|
00528 CL**7
|
|
00529 MOVE WWGH-SSN TO WRK-SSN. DTSBX500
|
|
00530 MOVE WRK-SSN TO WR-SSN. DTSBX500
|
|
00531 DTSBX500
|
|
00532 MOVE WRK-EMP-NO TO WR-ACCT-NO-LAST-6. DTSBX500
|
|
00533 DTSBX500
|
|
00534 MOVE MPRF-FEIN TO WRK-FEIN. DTSBX500
|
|
00535 MOVE WRK-FEIN TO WR-EIN. DTSBX500
|
|
00536 DTSBX500
|
|
00537 MOVE WRK-YRQ-YEAR TO WR-YEAR. DTSBX500
|
|
00538 MOVE WRK-YRQ-QTR TO WR-QUARTER. DTSBX500
|
|
00539 DTSBX500
|
|
00540 MOVE WWGH-EARNINGS TO WRK-EARNINGS. DTSBX500
|
|
00541 MOVE WRK-EARNINGS TO WR-WAGE. DTSBX500
|
|
00542 DTSBX500
|
|
00543 WRITE WAGE-RECORD FROM WR-WAGE-RECORD. DTSBX500
|
|
00544 IF WAGEFILE-OK-88 DTSBX500
|
|
00545 ADD +1 TO WRK-WAGE-REC-WRITE-CNT DTSBX500
|
|
00546 *RW1 DTSBX500
|
|
00547 * IF WRK-WAGE-REC-WRITE-CNT < 2000 DTSBX500
|
|
00548 * DISPLAY ' WWGH-EMP-NO = ' WRK-EMP-NO ' ' WRK-SSN DTSBX500
|
|
00549 * END-IF DTSBX500
|
|
00550 *RW2 DTSBX500
|
|
00551 ELSE DTSBX500
|
|
00552 DISPLAY 'CANNOT WRITE WAGE REC, WWGH-EMP-NO = ' WRK-EMP-NODTSBX500
|
|
00553 DISPLAY 'THE WAGE FILE STATUS = ' WAGEFILE-STATUS DTSBX500
|
|
00554 DISPLAY ' ' DTSBX500
|
|
00555 SET WRK-ERROR-YES-88 TO TRUE DTSBX500
|
|
00556 MOVE 'CANNOT WRITE WAGE FILE RECS ' TO WRK-ABEND-MSG DTSBX500
|
|
00557 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00558 END-IF. DTSBX500
|
|
00559 DTSBX500
|
|
00560 P2200-EXIT. DTSBX500
|
|
00561 EXIT. DTSBX500
|
|
00562 DTSBX500
|
|
00563 P2300-WRITE-EMPL-RECORD. DTSBX500
|
|
00564 DTSBX500
|
|
00565 MOVE WRK-EMP-NO TO ER-ACCT-NO-LAST-6. DTSBX500
|
|
00566 MOVE WRK-FEIN TO ER-EIN. DTSBX500
|
|
00567 DTSBX500
|
|
00568 MOVE WRK-YRQ-YEAR TO ER-YEAR. DTSBX500
|
|
00569 MOVE WRK-YRQ-QTR TO ER-QUARTER. DTSBX500
|
|
00570 DTSBX500
|
|
00571 MOVE MPRF-OWN-CD TO ER-OWNERSHIP-CODE. DTSBX500
|
|
00572 MOVE MPRF-SIC-CD TO ER-SIC-CODE. DTSBX500
|
|
00573 MOVE MPRF-NAICS-CD TO ER-NAICS-CODE. DTSBX500
|
|
00574 DTSBX500
|
|
00575 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBX500
|
|
00576 MOVE MPRF-PRIMARY-NAME TO ER-EMP-PRIMARY-NAME DTSBX500
|
|
00577 MOVE MPRF-PRIMARY-NAME TO ER-EMP-ENTITY-NAME DTSBX500
|
|
00578 ELSE DTSBX500
|
|
00579 MOVE MPRF-PRIMARY-NAME TO ER-EMP-PRIMARY-NAME DTSBX500
|
|
00580 IF MPRF-ENTITY-NAME = LOW-VALUES CL**2
|
|
00581 MOVE SPACES TO ER-EMP-ENTITY-NAME CL**2
|
|
00582 DISPLAY 'P2300 - LOW-VALUES IN ENTITY ' MPRF-EMP-NO CL**3
|
|
00583 ELSE CL**2
|
|
00584 MOVE MPRF-ENTITY-NAME TO ER-EMP-ENTITY-NAME CL**2
|
|
00585 END-IF CL**2
|
|
00586 END-IF. CL**2
|
|
00587 DTSBX500
|
|
00588 PERFORM P3000-FIND-ADDRESS THRU P3000-EXIT DTSBX500
|
|
00589 DTSBX500
|
|
00590 WRITE EMPL-RECORD FROM ER-EMPL-RECORD. DTSBX500
|
|
00591 IF EMPFILE-OK-88 DTSBX500
|
|
00592 ADD +1 TO WRK-EMPL-REC-WRITE-CNT DTSBX500
|
|
00593 ELSE DTSBX500
|
|
00594 DISPLAY 'CANNOT WRITE EMPL REC, MPRF-EMP-NO = ' WRK-EMP-NODTSBX500
|
|
00595 DISPLAY 'THE EMPL FILE STATUS = ' EMPFILE-STATUS DTSBX500
|
|
00596 DISPLAY ' ' DTSBX500
|
|
00597 MOVE 'CANNOT WRITE EMPLOYER FILE RECS ' TO WRK-ABEND-MSG DTSBX500
|
|
00598 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00599 END-IF. DTSBX500
|
|
00600 DTSBX500
|
|
00601 P2300-EXIT. DTSBX500
|
|
00602 EXIT. DTSBX500
|
|
00603 DTSBX500
|
|
00604 P3000-FIND-ADDRESS. DTSBX500
|
|
00605 DTSBX500
|
|
00606 MOVE LOW-VALUE TO MTAD-REC. DTSBX500
|
|
00607 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX500
|
|
00608 SET MTAD-TAD-88 TO TRUE. DTSBX500
|
|
00609 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBX500
|
|
00610 PERFORM P3100-GET-MAILING-DATA THRU P3100-EXIT. DTSBX500
|
|
00611 DTSBX500
|
|
00612 MOVE LOW-VALUE TO MTAD-REC. DTSBX500
|
|
00613 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX500
|
|
00614 SET MTAD-TAD-88 TO TRUE. DTSBX500
|
|
00615 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBX500
|
|
00616 PERFORM P3200-GET-PHYSICAL-DATA THRU P3200-EXIT. DTSBX500
|
|
00617 DTSBX500
|
|
00618 SET WRK-EMP-SELECTED-YES TO TRUE. DTSBX500
|
|
00619 ADD +1 TO WRK-ADDR-SELECT-CNT. DTSBX500
|
|
00620 DTSBX500
|
|
00621 P3000-EXIT. DTSBX500
|
|
00622 EXIT. DTSBX500
|
|
00623 DTSBX500
|
|
00624 P3100-GET-MAILING-DATA. DTSBX500
|
|
00625 DTSBX500
|
|
00626 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX500
|
|
00627 PERFORM S910-READ THRU S910-EXIT. DTSBX500
|
|
00628 IF L910-NO-REC-88 DTSBX500
|
|
00629 ADD +1 TO WRK-ADDR-FOUND-NO-CNT DTSBX500
|
|
00630 GO TO P3100-EXIT. DTSBX500
|
|
00631 DTSBX500
|
|
00632 MOVE MSKL-REC TO MTAD-REC. DTSBX500
|
|
00633 DTSBX500
|
|
00634 ADD +1 TO WRK-TAX-ADDR-CNT. DTSBX500
|
|
00635 MOVE MTAD-DELIV-LINE-2 TO ER-MAILING-ADDRESS-1 DTSBX500
|
|
00636 WS-MAILING-ADDRESS-1. DTSBX500
|
|
00637 MOVE MTAD-DELIV-LINE-1 TO ER-MAILING-ADDRESS-2 DTSBX500
|
|
00638 WS-MAILING-ADDRESS-2. DTSBX500
|
|
00639 MOVE MTAD-CITY TO ER-CITY-1 DTSBX500
|
|
00640 WS-CITY-1. DTSBX500
|
|
00641 MOVE MTAD-ST TO ER-STATE-1 DTSBX500
|
|
00642 WS-STATE-1. DTSBX500
|
|
00643 MOVE MTAD-ZIP TO WS-ZIP-1. DTSBX500
|
|
00644 MOVE WS-ZIP-1-5 TO ER-ZIP-1-5. DTSBX500
|
|
00645 MOVE WS-ZIP-1-4 TO ER-ZIP-1-4. DTSBX500
|
|
00646 MOVE MTAD-VOICE-1-AREA-CD TO WS-VOICE-1-AREA-CD. DTSBX500
|
|
00647 MOVE MTAD-VOICE-1-PREFIX TO WS-VOICE-1-PREFIX. DTSBX500
|
|
00648 MOVE MTAD-VOICE-1-SUFFIX TO WS-VOICE-1-SUFFIX. DTSBX500
|
|
00649 MOVE WS-VOICE-1 TO ER-PHONE. DTSBX500
|
|
00650 DTSBX500
|
|
00651 P3100-EXIT. DTSBX500
|
|
00652 EXIT. DTSBX500
|
|
00653 DTSBX500
|
|
00654 P3200-GET-PHYSICAL-DATA. DTSBX500
|
|
00655 DTSBX500
|
|
00656 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX500
|
|
00657 PERFORM S910-READ THRU S910-EXIT. DTSBX500
|
|
00658 IF L910-NO-REC-88 DTSBX500
|
|
00659 ADD +1 TO WRK-PHY-TAX-ADDR-SAME-CNT DTSBX500
|
|
00660 MOVE WS-MAILING-ADDRESS-1 TO ER-PHYSICAL-ADDRESS-1 DTSBX500
|
|
00661 MOVE WS-MAILING-ADDRESS-2 TO ER-PHYSICAL-ADDRESS-2 DTSBX500
|
|
00662 MOVE WS-CITY-1 TO ER-CITY-2 DTSBX500
|
|
00663 MOVE WS-STATE-1 TO ER-STATE-2 DTSBX500
|
|
00664 MOVE WS-ZIP-1-5 TO ER-ZIP-2-5 DTSBX500
|
|
00665 MOVE WS-ZIP-1-4 TO ER-ZIP-2-4 DTSBX500
|
|
00666 GO TO P3200-EXIT. DTSBX500
|
|
00667 DTSBX500
|
|
00668 MOVE MSKL-REC TO MTAD-REC. DTSBX500
|
|
00669 DTSBX500
|
|
00670 ADD +1 TO WRK-PHY-ADDR-CNT. DTSBX500
|
|
00671 MOVE MTAD-DELIV-LINE-2 TO ER-PHYSICAL-ADDRESS-1. DTSBX500
|
|
00672 MOVE MTAD-DELIV-LINE-1 TO ER-PHYSICAL-ADDRESS-2. DTSBX500
|
|
00673 MOVE MTAD-CITY TO ER-CITY-2. DTSBX500
|
|
00674 MOVE MTAD-ST TO ER-STATE-2. DTSBX500
|
|
00675 MOVE MTAD-ZIP TO WS-ZIP-2. DTSBX500
|
|
00676 MOVE WS-ZIP-2-5 TO ER-ZIP-2-5. DTSBX500
|
|
00677 MOVE WS-ZIP-2-4 TO ER-ZIP-2-4. DTSBX500
|
|
00678 DTSBX500
|
|
00679 P3200-EXIT. DTSBX500
|
|
00680 EXIT. DTSBX500
|
|
00681 DTSBX500
|
|
00682 P4000-READ-MQTR. DTSBX500
|
|
00683 DTSBX500
|
|
00684 SET WRK-LIABLE-NO-88 TO TRUE. DTSBX500
|
|
00685 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBX500
|
|
00686 ** MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX500
|
|
00687 MOVE WWGH-EMP-NO TO MQTR-EMP-NO. DTSBX500
|
|
00688 SET MQTR-QTR-88 TO TRUE. DTSBX500
|
|
00689 MOVE WRK-YRQ TO MQTR-YRQ. DTSBX500
|
|
00690 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX500
|
|
00691 PERFORM S910-READ THRU S910-EXIT. DTSBX500
|
|
00692 DTSBX500
|
|
00693 IF L910-OK-88 DTSBX500
|
|
00694 MOVE MSKL-REC TO MQTR-REC DTSBX500
|
|
00695 *RW3 DTSBX500
|
|
00696 IF MQTR-CURR-NOT-LIABLE-88 DTSBX500
|
|
00697 ADD +1 TO WRK-NOT-LIABLE-REC-CNT DTSBX500
|
|
00698 ** GO TO P4000-EXIT DTSBX500
|
|
00699 ELSE DTSBX500
|
|
00700 SET WRK-LIABLE-YES-88 TO TRUE DTSBX500
|
|
00701 ADD +1 TO WRK-LIABLE-REC-CNT DTSBX500
|
|
00702 *RW4 DTSBX500
|
|
00703 PERFORM P4100-WRITE-TAX-RECORD THRU P4100-EXIT DTSBX500
|
|
00704 ELSE DTSBX500
|
|
00705 ADD +1 TO WRK-MQTR-REC-NOT-FOUND-CNT DTSBX500
|
|
00706 DISPLAY 'MQTR REC NOT FOUND - WWGH-EMP-NO = ' DTSBX500
|
|
00707 WWGH-EMP-NO DTSBX500
|
|
00708 END-IF. DTSBX500
|
|
00709 DTSBX500
|
|
00710 MOVE WWGH-EMP-NO TO WRK-EMP-NO. DTSBX500
|
|
00711 DTSBX500
|
|
00712 P4000-EXIT. DTSBX500
|
|
00713 EXIT. DTSBX500
|
|
00714 DTSBX500
|
|
00715 P4100-WRITE-TAX-RECORD. DTSBX500
|
|
00716 DTSBX500
|
|
00717 MOVE ZEROS TO WRK-QTR-PAID-AMT DTSBX500
|
|
00718 WRK-QTR-TOT-WAGE DTSBX500
|
|
00719 WRK-QTR-TAX-WAGE. DTSBX500
|
|
00720 DTSBX500
|
|
00721 ** MOVE WRK-EMP-NO TO TX-ACCT-NO-LAST-6. DTSBX500
|
|
00722 MOVE MQTR-EMP-NO TO WRK-MQTR-EMP-NO. DTSBX500
|
|
00723 MOVE WRK-MQTR-EMP-NO TO TX-ACCT-NO-LAST-6. DTSBX500
|
|
00724 DTSBX500
|
|
00725 MOVE WRK-YRQ-YEAR TO TX-YEAR. DTSBX500
|
|
00726 MOVE WRK-YRQ-QTR TO TX-QUARTER. DTSBX500
|
|
00727 DTSBX500
|
|
00728 PERFORM DTSBX500
|
|
00729 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBX500
|
|
00730 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBX500
|
|
00731 DTSBX500
|
|
00732 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBX500
|
|
00733 MOVE MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-QTR-PAID-AMTDTSBX500
|
|
00734 * SET MQTR-ACCT-IDX TO MQTR-ACT-CNT DTSBX500
|
|
00735 END-IF DTSBX500
|
|
00736 END-PERFORM. DTSBX500
|
|
00737 DTSBX500
|
|
00738 MOVE WRK-QTR-PAID-AMT TO TX-TAX-PAID. DTSBX500
|
|
00739 DTSBX500
|
|
00740 MOVE MQTR-TOT-WAGE TO WRK-QTR-TOT-WAGE. DTSBX500
|
|
00741 MOVE WRK-QTR-TOT-WAGE TO TX-TOT-WAGE. DTSBX500
|
|
00742 DTSBX500
|
|
00743 MOVE MQTR-TAX-WAGE TO WRK-QTR-TAX-WAGE. DTSBX500
|
|
00744 MOVE WRK-QTR-TAX-WAGE TO TX-TAX-WAGE. DTSBX500
|
|
00745 DTSBX500
|
|
00746 IF MQTR-UI-RATE = -9.9999 DTSBX500
|
|
00747 MOVE SPACE TO TX-UI-RATE DTSBX500
|
|
00748 ELSE DTSBX500
|
|
00749 MOVE MQTR-UI-RATE TO WRK-QTR-UI-RATE DTSBX500
|
|
00750 MOVE WRK-QTR-UI-RATE TO TX-UI-RATE DTSBX500
|
|
00751 END-IF. DTSBX500
|
|
00752 DTSBX500
|
|
00753 IF MQTR-1ST-MTH-EMPL-CNT = +9999999 DTSBX500
|
|
00754 MOVE '000000' TO TX-MON1-EMP-CNT DTSBX500
|
|
00755 ELSE DTSBX500
|
|
00756 MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-QTR-MON1-EMP-CNT DTSBX500
|
|
00757 MOVE WRK-QTR-MON1-EMP-CNT TO TX-MON1-EMP-CNT DTSBX500
|
|
00758 END-IF. DTSBX500
|
|
00759 DTSBX500
|
|
00760 IF MQTR-2ND-MTH-EMPL-CNT = +9999999 DTSBX500
|
|
00761 MOVE '000000' TO TX-MON2-EMP-CNT DTSBX500
|
|
00762 ELSE DTSBX500
|
|
00763 MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-QTR-MON2-EMP-CNT DTSBX500
|
|
00764 MOVE WRK-QTR-MON2-EMP-CNT TO TX-MON2-EMP-CNT DTSBX500
|
|
00765 END-IF. DTSBX500
|
|
00766 DTSBX500
|
|
00767 IF MQTR-3RD-MTH-EMPL-CNT = +9999999 DTSBX500
|
|
00768 MOVE '000000' TO TX-MON3-EMP-CNT DTSBX500
|
|
00769 ELSE DTSBX500
|
|
00770 MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-QTR-MON3-EMP-CNT DTSBX500
|
|
00771 MOVE WRK-QTR-MON3-EMP-CNT TO TX-MON3-EMP-CNT DTSBX500
|
|
00772 END-IF. DTSBX500
|
|
00773 DTSBX500
|
|
00774 WRITE TAX-RECORD FROM TX-TAX-RECORD. DTSBX500
|
|
00775 IF TAXFILE-OK-88 DTSBX500
|
|
00776 ADD +1 TO WRK-TAX-REC-WRITE-CNT DTSBX500
|
|
00777 ELSE DTSBX500
|
|
00778 DISPLAY 'CANNOT WRITE TAX REC, MPRF-EMP-NO = ' WRK-EMP-NO DTSBX500
|
|
00779 DISPLAY 'THE TAX FILE STATUS = ' TAXFILE-STATUS DTSBX500
|
|
00780 DISPLAY ' ' DTSBX500
|
|
00781 MOVE 'CANNOT WRITE TAX FILE RECS ' TO WRK-ABEND-MSG DTSBX500
|
|
00782 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00783 END-IF. DTSBX500
|
|
00784 DTSBX500
|
|
00785 P4100-EXIT. DTSBX500
|
|
00786 EXIT. DTSBX500
|
|
00787 DTSBX500
|
|
00788 P5000-READ-MOPO. DTSBX500
|
|
00789 DTSBX500
|
|
00790 MOVE LOW-VALUE TO MOPO-KEY-AREA. DTSBX500
|
|
00791 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBX500
|
|
00792 SET MOPO-OPO-88 TO TRUE. DTSBX500
|
|
00793 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBX500
|
|
00794 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX500
|
|
00795 IF L910-NO-REC-88 DTSBX500
|
|
00796 NEXT SENTENCE DTSBX500
|
|
00797 ELSE DTSBX500
|
|
00798 PERFORM DTSBX500
|
|
00799 UNTIL L910-NO-REC-88 DTSBX500
|
|
00800 MOVE MSKL-REC TO MOPO-REC DTSBX500
|
|
00801 IF MOPO-TYPE-OPO-88 DTSBX500
|
|
00802 * DISPLAY 'MOPO-EMP-NO = ' MOPO-EMP-NO DTSBX500
|
|
00803 * DISPLAY 'CONTACT - MOPO NAME FOUND ' MOPO-NAME DTSBX500
|
|
00804 PERFORM P5100-WRITE-CONTACT-RECORD DTSBX500
|
|
00805 THRU P5100-EXIT DTSBX500
|
|
00806 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX500
|
|
00807 ELSE DTSBX500
|
|
00808 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX500
|
|
00809 END-IF DTSBX500
|
|
00810 END-PERFORM DTSBX500
|
|
00811 END-IF. DTSBX500
|
|
00812 DTSBX500
|
|
00813 P5000-EXIT. DTSBX500
|
|
00814 EXIT. DTSBX500
|
|
00815 DTSBX500
|
|
00816 P5100-WRITE-CONTACT-RECORD. DTSBX500
|
|
00817 MOVE SPACES TO WRK-VOICE-1. DTSBX500
|
|
00818 MOVE ZEROS TO WRK-MOPO-SSN. DTSBX500
|
|
00819 DTSBX500
|
|
00820 MOVE WRK-EMP-NO TO CT-ACCT-NO-LAST-6. DTSBX500
|
|
00821 DTSBX500
|
|
00822 MOVE WRK-YRQ-YEAR TO CT-YEAR. DTSBX500
|
|
00823 MOVE WRK-YRQ-QTR TO CT-QUARTER. DTSBX500
|
|
00824 DTSBX500
|
|
00825 INSPECT MOPO-NAME REPLACING ALL LOW-VALUE BY SPACE. DTSBX500
|
|
00826 MOVE MOPO-NAME TO L071-NAM. DTSBX500
|
|
00827 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSBX500
|
|
00828 PERFORM S071-DESLASH-NAME THRU S071-EXIT. DTSBX500
|
|
00829 MOVE L071-NAM TO CT-CONTACT-NAME. DTSBX500
|
|
00830 * DISPLAY 'MOPO-EMP-NO = ' MOPO-EMP-NO. DTSBX500
|
|
00831 * DISPLAY 'CONTACT - MOPO NAME FOUND ' L071-NAM. DTSBX500
|
|
00832 DTSBX500
|
|
00833 MOVE MOPO-VOICE-1-AREA-CD TO WRK-VOICE-1-AREA-CD. DTSBX500
|
|
00834 MOVE MOPO-VOICE-1-PREFIX TO WRK-VOICE-1-PREFIX. DTSBX500
|
|
00835 MOVE MOPO-VOICE-1-SUFFIX TO WRK-VOICE-1-SUFFIX. DTSBX500
|
|
00836 MOVE WRK-VOICE-1 TO CT-PHONE. DTSBX500
|
|
00837 DTSBX500
|
|
00838 MOVE MOPO-SSN TO WRK-MOPO-SSN. DTSBX500
|
|
00839 MOVE WRK-MOPO-SSN TO CT-SSN. DTSBX500
|
|
00840 DTSBX500
|
|
00841 MOVE MOPO-TITLE TO CT-CONTACT-TITLE DTSBX500
|
|
00842 DTSBX500
|
|
00843 WRITE CONTACT-RECORD FROM CT-CONTACT-RECORD. DTSBX500
|
|
00844 IF CONTFILE-OK-88 DTSBX500
|
|
00845 ADD +1 TO WRK-CONTACT-REC-WRITE-CNT DTSBX500
|
|
00846 ELSE DTSBX500
|
|
00847 DISPLAY 'CANNOT WRITE CONTACT REC, MPRF-EMP-NO = ' DTSBX500
|
|
00848 WRK-EMP-NO DTSBX500
|
|
00849 DISPLAY 'THE CONTACT FILE STATUS = ' CONTFILE-STATUS DTSBX500
|
|
00850 DISPLAY ' ' DTSBX500
|
|
00851 MOVE 'CANNOT WRITE CONTACT FILE RECS ' TO WRK-ABEND-MSG DTSBX500
|
|
00852 PERFORM S999-ABEND THRU S999-EXIT DTSBX500
|
|
00853 END-IF. DTSBX500
|
|
00854 DTSBX500
|
|
00855 P5100-EXIT. DTSBX500
|
|
00856 EXIT. DTSBX500
|
|
00857 DTSBX500
|
|
00858 T0000-TERMINATE. DTSBX500
|
|
00859 DTSBX500
|
|
00860 DISPLAY ' '. DTSBX500
|
|
00861 DTSBX500
|
|
00862 DISPLAY '*** DTSBZ500 TERMINATION STATISTICS ***'. DTSBX500
|
|
00863 DTSBX500
|
|
00864 DISPLAY ' '. DTSBX500
|
|
00865 DTSBX500
|
|
00866 DISPLAY 'VSAM WAGE FILE INPUT REC READ COUNT : ' DTSBX500
|
|
00867 WRK-WWGH-READ-CNT. DTSBX500
|
|
00868 DTSBX500
|
|
00869 DISPLAY 'VSAM WAGE FILE ACCOUNT INVALID COUNT : ' DTSBX500
|
|
00870 WRK-WWGH-ACCT-INVALID. DTSBX500
|
|
00871 DTSBX500
|
|
00872 DISPLAY ' '. DTSBX500
|
|
00873 DTSBX500
|
|
00874 DISPLAY 'MPRF MASTER FILE SUBJ STATUS ACCT RECS READ : ' DTSBX500
|
|
00875 WRK-MPRF-READ-CNT. DTSBX500
|
|
00876 DTSBX500
|
|
00877 DISPLAY ' MPRF MASTER FILE ACT STATUS ACCT RECS READ : ' DTSBX500
|
|
00878 WRK-MPRF-ACT-CNT. DTSBX500
|
|
00879 DTSBX500
|
|
00880 DISPLAY ' MPRF MASTER FILE INACTIVE STATUS ACCT READ : ' DTSBX500
|
|
00881 WRK-MPRF-ACT-NO-CNT. DTSBX500
|
|
00882 DTSBX500
|
|
00883 DISPLAY ' '. DTSBX500
|
|
00884 DTSBX500
|
|
00885 DISPLAY 'NUMBER OF TAX MAILING ADDRESSES FOUND COUNT : ' DTSBX500
|
|
00886 WRK-TAX-ADDR-CNT. DTSBX500
|
|
00887 DTSBX500
|
|
00888 DISPLAY 'NUMBER OF PHYSICAL ADDRESSES FOUND COUNT : ' DTSBX500
|
|
00889 WRK-PHY-ADDR-CNT. DTSBX500
|
|
00890 DTSBX500
|
|
00891 DISPLAY 'NUMBER OF PHYSICAL AND MAILING ADDR SAME CNT : ' DTSBX500
|
|
00892 WRK-PHY-TAX-ADDR-SAME-CNT DTSBX500
|
|
00893 DTSBX500
|
|
00894 DISPLAY ' '. DTSBX500
|
|
00895 DTSBX500
|
|
00896 DISPLAY 'NUMBER OF EMPLOYERS WAGES ACCOUNT COUNT : ' DTSBX500
|
|
00897 WRK-WWGH-EMP-NO-CNT. DTSBX500
|
|
00898 DTSBX500
|
|
00899 DISPLAY 'NUMBER OF SS WAGE RECORDS WRITTEN COUNT : ' DTSBX500
|
|
00900 WRK-WAGE-REC-WRITE-CNT. DTSBX500
|
|
00901 DTSBX500
|
|
00902 DISPLAY ' '. DTSBX500
|
|
00903 DTSBX500
|
|
00904 DISPLAY 'NUMBER OF EMPL RECORDS WRITTEN COUNT : ' DTSBX500
|
|
00905 WRK-EMPL-REC-WRITE-CNT. DTSBX500
|
|
00906 DTSBX500
|
|
00907 DISPLAY ' '. DTSBX500
|
|
00908 DTSBX500
|
|
00909 DISPLAY ' NUMBER OF TAX RECORDS WRITTEN COUNT : ' DTSBX500
|
|
00910 WRK-TAX-REC-WRITE-CNT. DTSBX500
|
|
00911 DTSBX500
|
|
00912 DISPLAY 'NUMBER OF YEAR-QTR MQTR REC NOT FOUND : ' DTSBX500
|
|
00913 WRK-MQTR-REC-NOT-FOUND-CNT. DTSBX500
|
|
00914 DTSBX500
|
|
00915 DISPLAY ' '. DTSBX500
|
|
00916 DTSBX500
|
|
00917 DISPLAY ' NUMBER OF CONTACT REC WRITTEN COUNT : ' DTSBX500
|
|
00918 WRK-CONTACT-REC-WRITE-CNT. DTSBX500
|
|
00919 DTSBX500
|
|
00920 DISPLAY ' '. DTSBX500
|
|
00921 DTSBX500
|
|
00922 DISPLAY ' NUMBER OF LIABLE RECORDS COUNT : ' DTSBX500
|
|
00923 WRK-LIABLE-REC-CNT. DTSBX500
|
|
00924 DTSBX500
|
|
00925 DISPLAY ' NUMBER OF NOT-LIABLE RECORDS COUNT : ' DTSBX500
|
|
00926 WRK-NOT-LIABLE-REC-CNT. DTSBX500
|
|
00927 DTSBX500
|
|
00928 DISPLAY ' '. DTSBX500
|
|
00929 DTSBX500
|
|
00930 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX500
|
|
00931 PERFORM S981C-CLOSE THRU S981C-EXIT. DTSBX500
|
|
00932 PERFORM S982F-CLOSE THRU S982F-EXIT. DTSBX500
|
|
00933 DTSBX500
|
|
00934 CLOSE WAGE-FILE TAX-FILE CONTACT-FILE EMPL-FILE. DTSBX500
|
|
00935 DTSBX500
|
|
00936 T0000-EXIT. DTSBX500
|
|
00937 EXIT. DTSBX500
|
|
00938 EJECT DTSBX500
|
|
00939 DTSBX500
|
|
00940 S005-SYS-DATE. DTSBX500
|
|
00941 CALL 'DTSBU005' USING L005-COMM-AREA. DTSBX500
|
|
00942 DTSBX500
|
|
00943 S005-EXIT. DTSBX500
|
|
00944 EXIT. DTSBX500
|
|
00945 DTSBX500
|
|
00946 S071-DESLASH-NAME. DTSBX500
|
|
00947 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBX500
|
|
00948 S071-EXIT. DTSBX500
|
|
00949 EXIT. DTSBX500
|
|
00950 EJECT DTSBX500
|
|
00951 DTSBX500
|
|
00952 S910-OPEN-READ. DTSBX500
|
|
00953 SET L910-OPEN-READ-88 TO TRUE. DTSBX500
|
|
00954 GO TO S910-MSTR-IO. DTSBX500
|
|
00955 DTSBX500
|
|
00956 S910-OPEN-UPDATE-NO-AIX. DTSBX500
|
|
00957 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX500
|
|
00958 GO TO S910-MSTR-IO. DTSBX500
|
|
00959 DTSBX500
|
|
00960 S910-READ. DTSBX500
|
|
00961 SET L910-READ-88 TO TRUE. DTSBX500
|
|
00962 GO TO S910-MSTR-IO. DTSBX500
|
|
00963 DTSBX500
|
|
00964 S910-START-BROWSE. DTSBX500
|
|
00965 SET L910-START-BROWSE-88 TO TRUE. DTSBX500
|
|
00966 GO TO S910-MSTR-IO. DTSBX500
|
|
00967 DTSBX500
|
|
00968 S910-READ-NEXT. DTSBX500
|
|
00969 SET L910-READ-NEXT-88 TO TRUE. DTSBX500
|
|
00970 GO TO S910-MSTR-IO. DTSBX500
|
|
00971 DTSBX500
|
|
00972 S910-COUNT. DTSBX500
|
|
00973 SET L910-COUNT-88 TO TRUE. DTSBX500
|
|
00974 GO TO S910-MSTR-IO. DTSBX500
|
|
00975 DTSBX500
|
|
00976 S910-WRITE. DTSBX500
|
|
00977 SET L910-WRITE-88 TO TRUE. DTSBX500
|
|
00978 GO TO S910-MSTR-IO. DTSBX500
|
|
00979 DTSBX500
|
|
00980 S910-REWRITE. DTSBX500
|
|
00981 SET L910-REWRITE-88 TO TRUE. DTSBX500
|
|
00982 GO TO S910-MSTR-IO. DTSBX500
|
|
00983 DTSBX500
|
|
00984 S910-CLOSE. DTSBX500
|
|
00985 SET L910-CLOSE-88 TO TRUE. DTSBX500
|
|
00986 GO TO S910-MSTR-IO. DTSBX500
|
|
00987 DTSBX500
|
|
00988 S910-MSTR-IO. DTSBX500
|
|
00989 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX500
|
|
00990 MSKL-REC. DTSBX500
|
|
00991 S910-EXIT. DTSBX500
|
|
00992 EXIT. DTSBX500
|
|
00993 DTSBX500
|
|
00994 S921-OPEN-READ. DTSBX500
|
|
00995 SET L921-OPEN-READ-88 TO TRUE. DTSBX500
|
|
00996 GO TO S921-AIX-IO. DTSBX500
|
|
00997 DTSBX500
|
|
00998 S921-OPEN-UPDATE. DTSBX500
|
|
00999 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX500
|
|
01000 GO TO S921-AIX-IO. DTSBX500
|
|
01001 DTSBX500
|
|
01002 S921-READ. DTSBX500
|
|
01003 SET L921-READ-88 TO TRUE. DTSBX500
|
|
01004 GO TO S921-AIX-IO. DTSBX500
|
|
01005 DTSBX500
|
|
01006 S921-START-BROWSE. DTSBX500
|
|
01007 SET L921-START-BROWSE-88 TO TRUE. DTSBX500
|
|
01008 GO TO S921-AIX-IO. DTSBX500
|
|
01009 DTSBX500
|
|
01010 S921-READ-NEXT. DTSBX500
|
|
01011 SET L921-READ-NEXT-88 TO TRUE. DTSBX500
|
|
01012 GO TO S921-AIX-IO. DTSBX500
|
|
01013 DTSBX500
|
|
01014 S921-CLOSE. DTSBX500
|
|
01015 SET L921-CLOSE-88 TO TRUE. DTSBX500
|
|
01016 GO TO S921-AIX-IO. DTSBX500
|
|
01017 DTSBX500
|
|
01018 S921-AIX-IO. DTSBX500
|
|
01019 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX500
|
|
01020 ISKL-REC. DTSBX500
|
|
01021 S921-EXIT. DTSBX500
|
|
01022 EXIT. DTSBX500
|
|
01023 ** DTSBX500
|
|
01024 S981A-OPEN-READ. DTSBX500
|
|
01025 SET L981-OPEN-READ-88 TO TRUE. DTSBX500
|
|
01026 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500
|
|
01027 DTSBX500
|
|
01028 S981A-EXIT. DTSBX500
|
|
01029 EXIT. DTSBX500
|
|
01030 DTSBX500
|
|
01031 S981C-CLOSE. DTSBX500
|
|
01032 SET L981-CLOSE-88 TO TRUE. DTSBX500
|
|
01033 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500
|
|
01034 DTSBX500
|
|
01035 S981C-EXIT. DTSBX500
|
|
01036 EXIT. DTSBX500
|
|
01037 DTSBX500
|
|
01038 S981D-START-BROWSE. DTSBX500
|
|
01039 SET L981-START-BROWSE-88 TO TRUE. DTSBX500
|
|
01040 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500
|
|
01041 DTSBX500
|
|
01042 S981D-EXIT. DTSBX500
|
|
01043 EXIT. DTSBX500
|
|
01044 DTSBX500
|
|
01045 S981E-READ-NEXT. DTSBX500
|
|
01046 SET L981-READ-NEXT-88 TO TRUE. DTSBX500
|
|
01047 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500
|
|
01048 DTSBX500
|
|
01049 S981E-EXIT. DTSBX500
|
|
01050 EXIT. DTSBX500
|
|
01051 DTSBX500
|
|
01052 S981Z-WAGE-I. DTSBX500
|
|
01053 CALL 'DTSBU981' USING L981-LINK-AREA DTSBX500
|
|
01054 WWGH-REC. DTSBX500
|
|
01055 S981Z-EXIT. DTSBX500
|
|
01056 EXIT. DTSBX500
|
|
01057 ** DTSBX500
|
|
01058 DTSBX500
|
|
01059 S982A-START-BROWSE. DTSBX500
|
|
01060 SET L982-START-BROWSE-88 TO TRUE. DTSBX500
|
|
01061 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500
|
|
01062 DTSBX500
|
|
01063 S982A-EXIT. DTSBX500
|
|
01064 EXIT. DTSBX500
|
|
01065 DTSBX500
|
|
01066 S982B-READ-NEXT. DTSBX500
|
|
01067 SET L982-READ-NEXT-88 TO TRUE. DTSBX500
|
|
01068 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500
|
|
01069 DTSBX500
|
|
01070 S982B-EXIT. DTSBX500
|
|
01071 EXIT. DTSBX500
|
|
01072 DTSBX500
|
|
01073 S982C-WRITE. DTSBX500
|
|
01074 SET L982-WRITE-88 TO TRUE. DTSBX500
|
|
01075 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500
|
|
01076 DTSBX500
|
|
01077 S982C-EXIT. DTSBX500
|
|
01078 EXIT. DTSBX500
|
|
01079 DTSBX500
|
|
01080 S982D-REWRITE. DTSBX500
|
|
01081 SET L982-REWRITE-88 TO TRUE. DTSBX500
|
|
01082 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500
|
|
01083 DTSBX500
|
|
01084 S982D-EXIT. DTSBX500
|
|
01085 EXIT. DTSBX500
|
|
01086 DTSBX500
|
|
01087 S982E-OPEN-READ. DTSBX500
|
|
01088 SET L982-OPEN-READ-88 TO TRUE. DTSBX500
|
|
01089 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500
|
|
01090 DTSBX500
|
|
01091 S982E-EXIT. DTSBX500
|
|
01092 EXIT. DTSBX500
|
|
01093 DTSBX500
|
|
01094 S982F-CLOSE. DTSBX500
|
|
01095 SET L982-CLOSE-88 TO TRUE. DTSBX500
|
|
01096 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500
|
|
01097 DTSBX500
|
|
01098 S982F-EXIT. DTSBX500
|
|
01099 EXIT. DTSBX500
|
|
01100 DTSBX500
|
|
01101 S982Z-WNAM-IO. DTSBX500
|
|
01102 CALL 'DTSBU982' USING L982-LINK-AREA DTSBX500
|
|
01103 WNAM-REC. DTSBX500
|
|
01104 S982Z-EXIT. DTSBX500
|
|
01105 EXIT. DTSBX500
|
|
01106 ** DTSBX500
|
|
01107 DTSBX500
|
|
01108 S999-ABEND. DTSBX500
|
|
01109 DTSBX500
|
|
01110 DISPLAY '**** DTSBZ500 ABENDING ' DTSBX500
|
|
01111 WRK-ABEND-MSG. DTSBX500
|
|
01112 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX500
|
|
01113 DTSBX500
|
|
01114 S999-EXIT. DTSBX500
|
|
01115 EXIT. DTSBX500
|
|
01116 DTSBX500
|