1299 lines
103 KiB
COBOL
1299 lines
103 KiB
COBOL
00001 IDENTIFICATION DIVISION. 06/12/20
|
|
00002 PROGRAM-ID. CHGBD210. CHGBD210
|
|
00003 *AUTHOR. TRW. LV010
|
|
00004 *DATE-WRITTEN. JUNE 2001. CHGBD210
|
|
00005 DATE-COMPILED. CHGBD210
|
|
00006 SKIP3 CHGBD210
|
|
00007 ***** CHGBD210
|
|
00008 * CHGBD210
|
|
00009 * FUNCTION: CHGBD210
|
|
00010 * CHGBD210
|
|
00011 * READ CHARGE RECORDS EXTRACTED BY CHGBD205. CHGBD210
|
|
00012 * CHGBD210
|
|
00013 * FIND EMPLOYER ACCOUNT NUMBER OF SUCCESSOR, IF ANY, CHGBD210
|
|
00014 * AND REPLACE PREDECESSOR ACCOUNT NUMBER WITH ACCOUNT CHGBD210
|
|
00015 * NUMBER OF PREDECESSOR. CHGBD210
|
|
00016 * CHGBD210
|
|
00017 * FOR DC GOVERNMENT CHARGES UNDER ACCOUNT NUMBER 998888,CHGBD210
|
|
00018 * READ DC WAGE FILE TO FIND THE AGENCY RESPONSIBLE FOR CHGBD210
|
|
00019 * THE CHARGES, AND WRITE CHARGE SEPARATE OUTPUT RECORDS CHGBD210
|
|
00020 * FOR EACH AGENCY WITH BASE PERIOD WAGES. CHGBD210
|
|
00021 * CHGBD210
|
|
00022 * READ MASTER FILE FOR ADDRESS AND FISCAL AGENT DATA CHGBD210
|
|
00023 * CHGBD210
|
|
00024 * WRITE CHG4 OUTPUT RECORD. CHGBD210
|
|
00025 * CHGBD210
|
|
00026 * INPUT: CHGBD210
|
|
00027 * CHGBD210
|
|
00028 * BD205CHG - CHARGE REPORT RECORDS GENERATED BY CHGBD210
|
|
00029 * CHGBD205. CHGBD210
|
|
00030 * CHGBD210
|
|
00031 * CHGPARM - PARAMETER DATA INPUT FROM CHGBD205 CHGBD210
|
|
00032 * CHGBD210
|
|
00033 * OUTPUT: CHGBD210
|
|
00034 * CHGBD210
|
|
00035 * BD210CHG - CHARGE RECORDS SELECTED IN CHGBD210
|
|
00036 * CHGBD210. CHGBD210
|
|
00037 * CHGBD210
|
|
00038 * CHGBD210
|
|
00039 * CHGBD210
|
|
00040 ***** CHGBD210
|
|
00041 CHGBD210
|
|
00042 ******************************************************************CHGBD210
|
|
00043 * MODIFICATION HISTORY: *CHGBD210
|
|
00044 * *CHGBD210
|
|
00045 * 02-02-1999 INITIAL DEVELOPMENT *CHGBD210
|
|
00046 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD210
|
|
00047 * *CHGBD210
|
|
00048 * 06-21-2001 MODIFIED FOR NEW CHARGE PROCESS CHGBD210
|
|
00049 * REFERENCE RFP #**** AUTHOR OF CHANGE - GD *CHGBD210
|
|
00050 * *CHGBD210
|
|
00051 * 04-23-2002 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT CHGBD210
|
|
00052 * REFERENCE RFP #**** AUTHOR OF CHANGE - RW1 *CHGBD210
|
|
00053 * *CHGBD210
|
|
00054 * 09-04-2003 MODIFIED TO ALLOCATE DC GOVERNMENT CHARGES TO CHGBD210
|
|
00055 * THE SPECIFIC AGENCY RESPONSIBLE. *CHGBD210
|
|
00056 * REFERENCE DIR 100 AUTHOR OF CHANGE - GD *CHGBD210
|
|
00057 * *CHGBD210
|
|
00058 * 01-26-2004 ADDED TEST FOR ZERO WAGE AMOUNT IN CHG10 FILE. CHGBD210
|
|
00059 * CAUSED DIVISION BY ZERO ERROR. *CHGBD210
|
|
00060 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD210
|
|
00061 * *CHGBD210
|
|
00062 * 06-29-2004 ADDED EMP-TYPE 17 - DOMESTIC VIOLENCE. CHGBD210
|
|
00063 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD210
|
|
00064 * *CHGBD210
|
|
00065 * 07-06-2004 CORRECTED PROBLEM WITH HANDLING SSN. THE PROGRAM *CHGBD210
|
|
00066 * WAS MOVING THE 10 DIGIT CHG2-SSN TO THE 9 DIGIT *CHGBD210
|
|
00067 * L081-CLAIMAINT-SSN. *CHGBD210
|
|
00068 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD210
|
|
00069 * *CHGBD210
|
|
00070 * 01-03-2008 MODIFIED FOR NEW VERSION OF CHGIM004. *CHGBD210
|
|
00071 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD210
|
|
00072 * *CHGBD210
|
|
00073 * 04-03-2009 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004. *CHGBD210
|
|
00074 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD210
|
|
00075 * *CHGBD210
|
|
00076 * 07-07-2009 ADDED P2120 TO HANDLE RELATIONSHIPS AMONG FEDRAL *CHGBD210
|
|
00077 * AGENCIES. CHARGES POSTED TO THE OLD ACCOUNT NUMBER *CHGBD210
|
|
00078 * WILL BE REPORTED UNDER THE NEW ACCOUNT NUMBER. *CHGBD210
|
|
00079 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD210
|
|
00080 * *CHGBD210
|
|
00081 * *CHGBD210
|
|
00082 * 05-04-2010 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004. *CHGBD210
|
|
00083 * REFERENCE AUTHOR OF CHANGE - ZL1 *CHGBD210
|
|
00084 * *CHGBD210
|
|
00085 * *CHGBD210
|
|
00086 * 09-26-2013 MODIFIED TO MERGE TWO FED ACCOUTS INTO ONE, REPORT *CHGBD210
|
|
00087 * ALL CHARGES FOR 000012 UNDER 000030 START 2013/3 *CHGBD210
|
|
00088 * REFERENCE AUTHOR OF CHANGE - ZL1 *CHGBD210
|
|
00089 * *CHGBD210
|
|
00090 * 10-04-2014 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004. *CHGBD210
|
|
00091 * REFERENCE: UCPIA AUTHOR OF CHANGE - ZL1 *CHGBD210
|
|
00092 * *CHGBD210
|
|
00093 * *CHGBD210
|
|
00094 * 08-16-2017 CHECK FOR THE PRESENCE OF A BENEFITS ADDRESS BEFORE *CHGBD210
|
|
00095 * USING MAILING ADDRESS. *CHGBD210
|
|
00096 * REFERENCE: KACE TICKET AUTHOR OF CHANGE - ZL1 *CHGBD210
|
|
00097 * *CHGBD210
|
|
00098 * * CL**2
|
|
00099 * 04-18-2020 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004. * CL**2
|
|
00100 * REFERENCE: PUA FPUC FRUR AUTHOR OF CHANGE - ZL1 * CL**2
|
|
00101 * * CL**2
|
|
00102 * *CHGBD210
|
|
00103 * *CHGBD210
|
|
00104 * 05-08-2019 MODIFIED TO MERGE TWO FED ACCOUTS INTO ONE, REPORT *CHGBD210
|
|
00105 * ALL CHARGES FOR 000913 UNDER 000914 START 2019/1 *CHGBD210
|
|
00106 * REFERENCE AUTHOR OF CHANGE - ZL1 *CHGBD210
|
|
00107 * *CHGBD210
|
|
00108 * * CL**7
|
|
00109 * 05-01-2020 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004. * CL**7
|
|
00110 * REFERENCE: PUA FPUC FRUR FPUC CHANGE - ZL1 * CL**7
|
|
00111 * * CL**7
|
|
00112 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD210
|
|
00113 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD210
|
|
00114 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD210
|
|
00115 ******************************************************************CHGBD210
|
|
00116 CHGBD210
|
|
00117 SKIP3 CHGBD210
|
|
00118 ENVIRONMENT DIVISION. CHGBD210
|
|
00119 SKIP3 CHGBD210
|
|
00120 INPUT-OUTPUT SECTION. CHGBD210
|
|
00121 SKIP3 CHGBD210
|
|
00122 FILE-CONTROL. CHGBD210
|
|
00123 SELECT CHG-PARM-FILE ASSIGN TO CHGPARM CHGBD210
|
|
00124 FILE STATUS IS CHG-PARM-STATUS. CHGBD210
|
|
00125 CHGBD210
|
|
00126 SELECT BD205-CHG-FILE-IN ASSIGN TO BD205CHG CHGBD210
|
|
00127 FILE STATUS IS BD205-CHG-STATUS. CHGBD210
|
|
00128 CHGBD210
|
|
00129 SELECT BD210-CHG-FILE-OUT ASSIGN TO BD210CHG CHGBD210
|
|
00130 FILE STATUS IS BD210-CHG-STATUS. CHGBD210
|
|
00131 CHGBD210
|
|
00132 SELECT DC-WAGE-FILE ASSIGN TO DTSWGHDC CHGBD210
|
|
00133 ORGANIZATION IS INDEXED CHGBD210
|
|
00134 ACCESS MODE IS DYNAMIC CHGBD210
|
|
00135 RECORD KEY IS CHG10-KEY-AREA CHGBD210
|
|
00136 FILE STATUS IS DC-WAGE-STATUS. CHGBD210
|
|
00137 CHGBD210
|
|
00138 EJECT CHGBD210
|
|
00139 DATA DIVISION. CHGBD210
|
|
00140 CHGBD210
|
|
00141 FILE SECTION. CHGBD210
|
|
00142 FD CHG-PARM-FILE CHGBD210
|
|
00143 LABEL RECORDS ARE STANDARD CHGBD210
|
|
00144 BLOCK CONTAINS 0 CHARACTERS. CHGBD210
|
|
00145 SKIP1 CHGBD210
|
|
00146 01 CHG-PARM-REC. CHGBD210
|
|
00147 ++INCLUDE CHGIM003 CHGBD210
|
|
00148 CHGBD210
|
|
00149 FD BD205-CHG-FILE-IN CHGBD210
|
|
00150 RECORD CONTAINS 64 CHARACTERS CHGBD210
|
|
00151 DATA RECORD IS BD205-CHG-REC. CHGBD210
|
|
00152 01 BD205-CHG-REC. CHGBD210
|
|
00153 ++INCLUDE CHGIM002 CHGBD210
|
|
00154 CHGBD210
|
|
00155 FD BD210-CHG-FILE-OUT CHGBD210
|
|
00156 LABEL RECORDS ARE STANDARD CHGBD210
|
|
00157 BLOCK CONTAINS 0 CHARACTERS. CHGBD210
|
|
00158 SKIP1 CHGBD210
|
|
00159 01 BD210-CHG-REC. CHGBD210
|
|
00160 ++INCLUDE CHGIM004 CHGBD210
|
|
00161 CHGBD210
|
|
00162 FD DC-WAGE-FILE CHGBD210
|
|
00163 RECORD CONTAINS 20 CHARACTERS CHGBD210
|
|
00164 DATA RECORD IS DC-WAGE-REC. CHGBD210
|
|
00165 SKIP1 CHGBD210
|
|
00166 01 DC-WAGE-REC. CHGBD210
|
|
00167 ++INCLUDE CHGIM010 CHGBD210
|
|
00168 CHGBD210
|
|
00169 EJECT CHGBD210
|
|
00170 WORKING-STORAGE SECTION. CHGBD210
|
|
001705 77 PAN-VALET PICTURE X(24) VALUE '010CHGBD210 06/12/20'. CHGBD210
|
|
00171 77 PAN-VALET PICTURE X(24) VALUE '163CHGBD210 05/15/19'. CHGBD210
|
|
00172 77 PAN-VALET PICTURE X(24) VALUE '006CHGBD210 05/13/19'. CHGBD210
|
|
00173 77 PAN-VALET PICTURE X(24) VALUE '161CHGBD210 10/08/13'. CHGBD210
|
|
00174 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD210 09/26/13'. CHGBD210
|
|
00175 77 PAN-VALET PICTURE X(24) VALUE '159CHGBD210 05/25/10'. CHGBD210
|
|
00176 CHGBD210
|
|
00177 01 WRK-AREA. CHGBD210
|
|
00178 *& CHGBD210
|
|
00179 05 WRK-DISP-AREA. CHGBD210
|
|
00180 10 WRK-DATE PIC 9999B99B99. CHGBD210
|
|
00181 10 FILLER PIC X(02) VALUE SPACES. CHGBD210
|
|
00182 10 WRK-EMP-DISP PIC 9(06). CHGBD210
|
|
00183 10 FILLER PIC X(02) VALUE SPACES. CHGBD210
|
|
00184 10 WRK-SSN-DISP PIC 9(10). CHGBD210
|
|
00185 10 FILLER PIC X(02) VALUE SPACES. CHGBD210
|
|
00186 10 WRK-CHG-AMT-DISP PIC Z(08)9.99-. CHGBD210
|
|
00187 CHGBD210
|
|
00188 05 WRK-TOT-CHG PIC S9(09)V99 COMP-3 CHGBD210
|
|
00189 VALUE +0. CHGBD210
|
|
00190 05 WRK-TOT-CHG-DISP PIC Z(08)9.99-. CHGBD210
|
|
00191 05 WRK-CHG-AMT PIC S9(09)V99 COMP-3. CHGBD210
|
|
00192 *& CHGBD210
|
|
00193 05 ABEND-CODE PIC S9(04) COMP CHGBD210
|
|
00194 VALUE +210. CHGBD210
|
|
00195 05 ABEND-MOD PIC X(08) CHGBD210
|
|
00196 VALUE 'DTSBU999'. CHGBD210
|
|
00197 05 ABEND-MSG PIC X(60). CHGBD210
|
|
00198 CHGBD210
|
|
00199 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. CHGBD210
|
|
00200 88 CHG-PARM-FILE-OK-88 VALUE ZERO. CHGBD210
|
|
00201 88 CHG-PARM-FILE-EOF-88 VALUE '10'. CHGBD210
|
|
00202 CHGBD210
|
|
00203 05 BD205-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD210
|
|
00204 88 BD205-FILE-OK-88 VALUE ZERO. CHGBD210
|
|
00205 88 BD205-FILE-EOF-88 VALUE '10'. CHGBD210
|
|
00206 CHGBD210
|
|
00207 05 BD210-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD210
|
|
00208 88 BD210-FILE-OK-88 VALUE ZERO. CHGBD210
|
|
00209 88 BD210-FILE-EOF-88 VALUE '10'. CHGBD210
|
|
00210 CHGBD210
|
|
00211 05 DC-WAGE-STATUS PIC X(02) VALUE SPACES. CHGBD210
|
|
00212 88 DC-WAGE-FILE-OK-88 VALUE ZERO. CHGBD210
|
|
00213 88 DC-WAGE-FILE-EOF-88 VALUE '10'. CHGBD210
|
|
00214 CHGBD210
|
|
00215 05 WRK-ERROR-IND PIC X(01). CHGBD210
|
|
00216 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD210
|
|
00217 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD210
|
|
00218 CHGBD210
|
|
00219 05 WRK-EMP-VALID-IND PIC X(01). CHGBD210
|
|
00220 88 WRK-EMP-VALID-YES-88 VALUE 'Y'. CHGBD210
|
|
00221 88 WRK-EMP-VALID-NO-88 VALUE 'N'. CHGBD210
|
|
00222 CHGBD210
|
|
00223 CHGBD210
|
|
00224 05 WRK-REC-SELECTED-IND PIC X(01). CHGBD210
|
|
00225 88 WRK-REC-SELECTED-YES-88 VALUE 'Y'. CHGBD210
|
|
00226 88 WRK-REC-SELECTED-NO-88 VALUE 'N'. CHGBD210
|
|
00227 CHGBD210
|
|
00228 05 WRK-DEFAULT-DC-ACCT-IND PIC X(01). CHGBD210
|
|
00229 88 WRK-DEFAULT-DC-ACCT-YES-88 VALUE 'Y'. CHGBD210
|
|
00230 88 WRK-DEFAULT-DC-ACCT-NO-88 VALUE 'N'. CHGBD210
|
|
00231 CHGBD210
|
|
00232 05 WRK-KEY PIC 9(10). CHGBD210
|
|
00233 05 FILLER REDEFINES WRK-KEY. CHGBD210
|
|
00234 10 WRK-SSN PIC 9(09). CHGBD210
|
|
00235 10 WRK-SSN-SEQ PIC 9(01). CHGBD210
|
|
00236 CHGBD210
|
|
00237 05 WRK-LAST-DC-SSN PIC 9(09) VALUE ZERO. CHGBD210
|
|
00238 05 WRK-DC-GOV-ACCT PIC S9(07) COMP-3 CHGBD210
|
|
00239 VALUE +998888. CHGBD210
|
|
00240 05 WRK-LAST-EMP-CHECKED PIC S9(07) COMP-3 CHGBD210
|
|
00241 VALUE +0. CHGBD210
|
|
00242 05 WRK-BP-START PIC S9(09) COMP-3. CHGBD210
|
|
00243 05 WRK-BP-END PIC S9(09) COMP-3. CHGBD210
|
|
00244 CHGBD210
|
|
00245 05 WRK-RPT-TYPE PIC 9(02) VALUE ZERO. CHGBD210
|
|
00246 88 WRK-RPT-TYPE-RATED-88 VALUE 00. CHGBD210
|
|
00247 88 WRK-RPT-TYPE-FED-88 VALUE 01, 02. CHGBD210
|
|
00248 88 WRK-RPT-TYPE-CWC-88 VALUE 04. CHGBD210
|
|
00249 88 WRK-RPT-TYPE-SELF-INS-88 VALUE 08. CHGBD210
|
|
00250 88 WRK-RPT-TYPE-DC-88 VALUE 10. CHGBD210
|
|
00251 88 WRK-RPT-TYPE-TEUC-88 VALUE 16. CHGBD210
|
|
00252 88 WRK-RPT-TYPE-FPUC-88 VALUE 29, 32, 33, 34, 35. CL*10
|
|
00253 CHGBD210
|
|
00254 05 WRK-EMPLOYER-DATA-AREA. CHGBD210
|
|
00255 10 WRK-FISCAL-AGENT-CD PIC X(03). CHGBD210
|
|
00256 88 WRK-FISC-AG-NONE-88 VALUE SPACES. CHGBD210
|
|
00257 10 WRK-FMT-ADDR. CHGBD210
|
|
00258 15 WRK-FMT-LINE OCCURS 5 TIMES CHGBD210
|
|
00259 PIC X(40). CHGBD210
|
|
00260 15 WRK-ZIP PIC X(10). CHGBD210
|
|
00261 15 WRK-ADVANCED-BARCODE PIC X(14). CHGBD210
|
|
00262 10 WRK-EMP-NAME-CHK PIC X(04). CHGBD210
|
|
00263 CHGBD210
|
|
00264 05 WRK-CHG2-CURR-BEN-AMT PIC S9(08)V99 COMP-3 CHGBD210
|
|
00265 VALUE 0. CHGBD210
|
|
00266 05 WRK-CHG2-CURR-ADJ-AMT PIC S9(08)V99 COMP-3 CHGBD210
|
|
00267 VALUE 0. CHGBD210
|
|
00268 05 WRK-BD205-CHG-READ PIC 9(09) COMP-3 CHGBD210
|
|
00269 VALUE 0. CHGBD210
|
|
00270 05 WRK-BD210-WRITE PIC 9(09) COMP-3 CHGBD210
|
|
00271 VALUE 0. CHGBD210
|
|
00272 05 WRK-BD205-CHG-DELETE PIC 9(09) COMP-3 CHGBD210
|
|
00273 VALUE 0. CHGBD210
|
|
00274 05 WRK-BD205-NOT-LIAB-CNT PIC 9(09) COMP-3 CHGBD210
|
|
00275 VALUE 0. CHGBD210
|
|
00276 05 WRK-BD205-NOT-SELECTED PIC 9(09) COMP-3 CHGBD210
|
|
00277 VALUE 0. CHGBD210
|
|
00278 05 WRK-DC-GOV-INPUT-CNT PIC 9(09) COMP-3 CHGBD210
|
|
00279 VALUE 0. CHGBD210
|
|
00280 05 WRK-DC-DEFAULT-CNT PIC 9(09) COMP-3 CHGBD210
|
|
00281 VALUE 0. CHGBD210
|
|
00282 05 WRK-DC-WRITE-CNT PIC 9(09) COMP-3 CHGBD210
|
|
00283 VALUE 0. CHGBD210
|
|
00284 CHGBD210
|
|
00285 05 WRK-DC-TOT-WAGE-AMT PIC 9(11) COMP-3 CHGBD210
|
|
00286 VALUE 0. CHGBD210
|
|
00287 CHGBD210
|
|
00288 01 WRK-DC-AGENCY-TBL-AREA. CHGBD210
|
|
00289 05 WRK-DC-TBL-MAX PIC S9(04) COMP VALUE +32. CHGBD210
|
|
00290 05 WRK-DC-TBL-LAST PIC S9(04) COMP. CHGBD210
|
|
00291 05 DC-SUB PIC S9(04) COMP. CHGBD210
|
|
00292 05 DC-NDX PIC S9(04) COMP. CHGBD210
|
|
00293 05 WRK-DC-AGENCY OCCURS 32 TIMES. CHGBD210
|
|
00294 10 WRK-DC-CODE PIC X(02). CHGBD210
|
|
00295 10 WRK-DC-EMP-NO PIC S9(07) COMP-3. CHGBD210
|
|
00296 10 WRK-DC-WAGE-AMT PIC S9(09)V99 COMP-3. CHGBD210
|
|
00297 10 WRK-DC-PCT PIC S99V9999 COMP-3. CHGBD210
|
|
00298 CHGBD210
|
|
00299 ** ADD ERROR MSG TABLE SET UP CHGBD210
|
|
00300 01 MSG-TABLE. CHGBD210
|
|
00301 05 MSG1-NO-MPRF. CHGBD210
|
|
00302 10 MSG1-ID. CHGBD210
|
|
00303 15 MSG1-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD210
|
|
00304 15 MSG1-ID2 PIC X(03) VALUE '210'. CHGBD210
|
|
00305 10 MSG1-SHORT-TEXT PIC X(20) CHGBD210
|
|
00306 VALUE 'EMP NOT ON FILE : '. CHGBD210
|
|
00307 10 MSG1-LONG-TEXT. CHGBD210
|
|
00308 15 FILLER PIC X(29) CHGBD210
|
|
00309 VALUE 'EMPLOYER NOT ON MASTER FILE '. CHGBD210
|
|
00310 15 FILLER PIC X(32) VALUE SPACES. CHGBD210
|
|
00311 CHGBD210
|
|
00312 05 MSG2-NOT-LIABLE. CHGBD210
|
|
00313 10 MSG2-ID. CHGBD210
|
|
00314 15 MSG2-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD210
|
|
00315 15 MSG2-ID2 PIC X(03) VALUE '210'. CHGBD210
|
|
00316 10 MSG2-SHORT-TEXT PIC X(20) CHGBD210
|
|
00317 VALUE 'EMP NOT LIABLE : '. CHGBD210
|
|
00318 10 MSG2-LONG-TEXT. CHGBD210
|
|
00319 15 FILLER PIC X(29) CHGBD210
|
|
00320 VALUE 'EMPLOYER IS NOT LIABLE '. CHGBD210
|
|
00321 15 FILLER PIC X(32) VALUE SPACES. CHGBD210
|
|
00322 CHGBD210
|
|
00323 05 MSG4-PRINTING-TURNED-OFF. CHGBD210
|
|
00324 10 MSG4-ID. CHGBD210
|
|
00325 15 MSG4-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD210
|
|
00326 15 MSG4-ID2 PIC X(03) VALUE '210'. CHGBD210
|
|
00327 10 MSG4-SHORT-TEXT PIC X(20) CHGBD210
|
|
00328 VALUE 'CHG STMT PRINT OFF: '. CHGBD210
|
|
00329 10 MSG4-LONG-TEXT. CHGBD210
|
|
00330 15 FILLER PIC X(36) CHGBD210
|
|
00331 VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'. CHGBD210
|
|
00332 15 FILLER PIC X(25) VALUE SPACES. CHGBD210
|
|
00333 CHGBD210
|
|
00334 05 MSG5-NO-ADDRESS. CHGBD210
|
|
00335 10 MSG5-ID. CHGBD210
|
|
00336 15 MSG5-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD210
|
|
00337 15 MSG5-ID2 PIC X(03) VALUE '210'. CHGBD210
|
|
00338 10 MSG5-SHORT-TEXT PIC X(20) CHGBD210
|
|
00339 VALUE 'NO ADDRESS FOUND: '. CHGBD210
|
|
00340 10 MSG5-LONG-TEXT. CHGBD210
|
|
00341 15 FILLER PIC X(29) CHGBD210
|
|
00342 VALUE 'ADDRESS NOT FOUND '. CHGBD210
|
|
00343 15 FILLER PIC X(25) CHGBD210
|
|
00344 VALUE ' MPRF EMPLOYER NUMBER = '. CHGBD210
|
|
00345 15 MSG5-EMP-NO PIC 9(07). CHGBD210
|
|
00346 CHGBD210
|
|
00347 05 MSG6-INVALID-EMP-NO. CHGBD210
|
|
00348 10 MSG6-ID. CHGBD210
|
|
00349 15 MSG6-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD210
|
|
00350 15 MSG6-ID2 PIC X(03) VALUE '210'. CHGBD210
|
|
00351 10 MSG6-SHORT-TEXT PIC X(20) CHGBD210
|
|
00352 VALUE 'INVALID EMP NO: '. CHGBD210
|
|
00353 10 MSG6-LONG-TEXT. CHGBD210
|
|
00354 15 FILLER PIC X(29) CHGBD210
|
|
00355 VALUE 'INVALID EMPLOYER NUMBER: '. CHGBD210
|
|
00356 15 MSG6-EMP-NO PIC 9(07). CHGBD210
|
|
00357 15 FILLER PIC X(25) CHGBD210
|
|
00358 VALUE ' EMP TYPE = '. CHGBD210
|
|
00359 15 MSG6-EMP-TYPE PIC 9(02). CHGBD210
|
|
00360 CHGBD210
|
|
00361 ** REPORT I-O SKELETAL RECORD CHGBD210
|
|
00362 01 RSKL-REC. CHGBD210
|
|
00363 ++INCLUDE DTSIRSK1 CHGBD210
|
|
00364 CHGBD210
|
|
00365 ** MAILING LABEL RECORD CHGBD210
|
|
00366 01 R901-REC. CHGBD210
|
|
00367 ++INCLUDE DTSIR901 CHGBD210
|
|
00368 CHGBD210
|
|
00369 ** ERROR MSG OUTPUT RECORD CHGBD210
|
|
00370 01 R907-REC. CHGBD210
|
|
00371 ++INCLUDE DTSIR907 CHGBD210
|
|
00372 CHGBD210
|
|
00373 01 L910-LINK-AREA. CHGBD210
|
|
00374 ++INCLUDE DTSIL910 CHGBD210
|
|
00375 CHGBD210
|
|
00376 01 MSKL-REC. CHGBD210
|
|
00377 ++INCLUDE DTSIMSKL CHGBD210
|
|
00378 CHGBD210
|
|
00379 01 MHDR-REC. CHGBD210
|
|
00380 ++INCLUDE DTSIMHDR CHGBD210
|
|
00381 CHGBD210
|
|
00382 01 MFAE-REC. CHGBD210
|
|
00383 ++INCLUDE DTSIMFAE CHGBD210
|
|
00384 CHGBD210
|
|
00385 01 MPRF-REC. CHGBD210
|
|
00386 ++INCLUDE DTSIMPRF CHGBD210
|
|
00387 CHGBD210
|
|
00388 01 L921-LINK-AREA. CHGBD210
|
|
00389 ++INCLUDE DTSIL921 CHGBD210
|
|
00390 CHGBD210
|
|
00391 01 ISKL-REC. CHGBD210
|
|
00392 ++INCLUDE DTSIISKL CHGBD210
|
|
00393 CHGBD210
|
|
00394 01 L001-LINK-AREA. CHGBD210
|
|
00395 ++INCLUDE DTSIL001 CHGBD210
|
|
00396 CHGBD210
|
|
00397 01 L004-LINK-AREA. CHGBD210
|
|
00398 ++INCLUDE DTSIL004 CHGBD210
|
|
00399 CHGBD210
|
|
00400 01 L081-LINK-AREA. CHGBD210
|
|
00401 ++INCLUDE DTSIL081 CHGBD210
|
|
00402 CHGBD210
|
|
00403 01 L100-LINK-AREA. CHGBD210
|
|
00404 ++INCLUDE CHGIL100 CHGBD210
|
|
00405 CHGBD210
|
|
00406 01 L111-LINK-AREA. CHGBD210
|
|
00407 ++INCLUDE DTSIL111 CHGBD210
|
|
00408 CHGBD210
|
|
00409 01 L112-LINK-AREA. CHGBD210
|
|
00410 ++INCLUDE DTSIL112 CHGBD210
|
|
00411 CHGBD210
|
|
00412 EJECT CHGBD210
|
|
00413 PROCEDURE DIVISION. CHGBD210
|
|
00414 SKIP2 CHGBD210
|
|
00415 CHGBD210-MAIN. CHGBD210
|
|
00416 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD210
|
|
00417 IF WRK-ERROR-YES-88 CHGBD210
|
|
00418 GO TO CHGBD210-EXIT. CHGBD210
|
|
00419 CHGBD210
|
|
00420 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD210
|
|
00421 CHGBD210
|
|
00422 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD210
|
|
00423 CHGBD210
|
|
00424 CHGBD210-EXIT. CHGBD210
|
|
00425 STOP RUN. CHGBD210
|
|
00426 EJECT CHGBD210
|
|
00427 I0000-INITIATE. CHGBD210
|
|
00428 SET WRK-ERROR-NO-88 TO TRUE. CHGBD210
|
|
00429 CHGBD210
|
|
00430 MOVE LENGTH OF R901-REC TO R901-LENGTH. CHGBD210
|
|
00431 CHGBD210
|
|
00432 MOVE MSG1-ID1 TO R907-MODULE-NAME. CHGBD210
|
|
00433 MOVE LENGTH OF R907-REC TO R907-LENGTH. CHGBD210
|
|
00434 CHGBD210
|
|
00435 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. CHGBD210
|
|
00436 CHGBD210
|
|
00437 CHGBD210
|
|
00438 I0000-EXIT. CHGBD210
|
|
00439 EXIT. CHGBD210
|
|
00440 CHGBD210
|
|
00441 I1000-OPEN-FILES. CHGBD210
|
|
00442 OPEN INPUT CHG-PARM-FILE. CHGBD210
|
|
00443 IF NOT CHG-PARM-FILE-OK-88 CHGBD210
|
|
00444 DISPLAY 'PARM5 FILE OPEN ERROR: ' CHG-PARM-STATUS CHGBD210
|
|
00445 PERFORM S999-ABEND THRU S999-EXIT. CHGBD210
|
|
00446 CHGBD210
|
|
00447 READ CHG-PARM-FILE. CHGBD210
|
|
00448 IF NOT CHG-PARM-FILE-OK-88 CHGBD210
|
|
00449 DISPLAY 'PARM FILE READ ERROR: ' CHG-PARM-STATUS CHGBD210
|
|
00450 PERFORM S999-ABEND THRU S999-EXIT. CHGBD210
|
|
00451 CHGBD210
|
|
00452 OPEN INPUT BD205-CHG-FILE-IN. CHGBD210
|
|
00453 IF NOT BD205-FILE-OK-88 CHGBD210
|
|
00454 DISPLAY 'BD205 FILE OPEN ERROR: ' BD205-CHG-STATUS CHGBD210
|
|
00455 PERFORM S999-ABEND THRU S999-EXIT. CHGBD210
|
|
00456 CHGBD210
|
|
00457 OPEN OUTPUT BD210-CHG-FILE-OUT. CHGBD210
|
|
00458 IF NOT BD210-FILE-OK-88 CHGBD210
|
|
00459 DISPLAY 'BD210 FILE OPEN ERROR: ' BD210-CHG-STATUS CHGBD210
|
|
00460 PERFORM S999-ABEND THRU S999-EXIT. CHGBD210
|
|
00461 CHGBD210
|
|
00462 OPEN INPUT DC-WAGE-FILE. CHGBD210
|
|
00463 IF NOT DC-WAGE-FILE-OK-88 CHGBD210
|
|
00464 DISPLAY 'DC WAGE FILE OPEN ERROR: ' DC-WAGE-STATUS CHGBD210
|
|
00465 PERFORM S999-ABEND THRU S999-EXIT. CHGBD210
|
|
00466 CHGBD210
|
|
00467 PERFORM S910-OPEN-READ THRU S910-EXIT. CHGBD210
|
|
00468 CHGBD210
|
|
00469 PERFORM S921-OPEN-READ THRU S921-EXIT. CHGBD210
|
|
00470 CHGBD210
|
|
00471 I1000-EXIT. CHGBD210
|
|
00472 EXIT. CHGBD210
|
|
00473 CHGBD210
|
|
00474 P0000-PROCESS. CHGBD210
|
|
00475 PERFORM P1000-READ-CHARGES THRU P1000-EXIT CHGBD210
|
|
00476 UNTIL BD205-FILE-EOF-88 CHGBD210
|
|
00477 OR WRK-ERROR-YES-88. CHGBD210
|
|
00478 CHGBD210
|
|
00479 P0000-EXIT. CHGBD210
|
|
00480 EXIT. CHGBD210
|
|
00481 CHGBD210
|
|
00482 P1000-READ-CHARGES. CHGBD210
|
|
00483 READ BD205-CHG-FILE-IN. CHGBD210
|
|
00484 CHGBD210
|
|
00485 IF BD205-FILE-EOF-88 CHGBD210
|
|
00486 GO TO P1000-EXIT CHGBD210
|
|
00487 ELSE CHGBD210
|
|
00488 IF NOT BD205-FILE-OK-88 CHGBD210
|
|
00489 DISPLAY 'BD205 FILE READ ERROR: ' BD205-CHG-STATUS CHGBD210
|
|
00490 SET WRK-ERROR-YES-88 TO TRUE CHGBD210
|
|
00491 GO TO P1000-EXIT. CHGBD210
|
|
00492 CHGBD210
|
|
00493 ADD 1 TO WRK-BD205-CHG-READ. CHGBD210
|
|
00494 CHGBD210
|
|
00495 CHGBD210
|
|
00496 MOVE CHG2-SSN TO WRK-KEY. CHGBD210
|
|
00497 IF WRK-SSN = 162564856 CL**8
|
|
00498 MOVE CHG2-CHARGE-DATE TO WRK-DATE CHGBD210
|
|
00499 MOVE CHG2-EMP-NO TO WRK-EMP-DISP CHGBD210
|
|
00500 MOVE CHG2-SSN TO WRK-SSN-DISP CHGBD210
|
|
00501 COMPUTE WRK-CHG-AMT-DISP = CHGBD210
|
|
00502 CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT CHGBD210
|
|
00503 DISPLAY 'P1000 ' WRK-DISP-AREA. CHGBD210
|
|
00504 CHGBD210
|
|
00505 CHGBD210
|
|
00506 IF CHG2-EMP-NO = WRK-DC-GOV-ACCT CHGBD210
|
|
00507 ADD +1 TO WRK-DC-GOV-INPUT-CNT CHGBD210
|
|
00508 SET WRK-REC-SELECTED-NO-88 TO TRUE CHGBD210
|
|
00509 PERFORM P4000-SELECT THRU P4000-EXIT CHGBD210
|
|
00510 IF WRK-REC-SELECTED-YES-88 CHGBD210
|
|
00511 PERFORM P6000-DC-CHARGES THRU P6000-EXIT CHGBD210
|
|
00512 GO TO P1000-EXIT CHGBD210
|
|
00513 ELSE CHGBD210
|
|
00514 ADD +1 TO WRK-BD205-NOT-SELECTED CHGBD210
|
|
00515 GO TO P1000-EXIT CHGBD210
|
|
00516 END-IF CHGBD210
|
|
00517 ELSE CHGBD210
|
|
00518 IF CHG2-EMP-NO NOT = WRK-LAST-EMP-CHECKED CHGBD210
|
|
00519 PERFORM P2000-EDIT-EMP THRU P2000-EXIT CHGBD210
|
|
00520 ELSE CHGBD210
|
|
00521 PERFORM P3000-UPDATE-EMP-DATA THRU P3000-EXIT. CHGBD210
|
|
00522 CHGBD210
|
|
00523 IF WRK-EMP-VALID-NO-88 CHGBD210
|
|
00524 ADD +1 TO WRK-BD205-CHG-DELETE CHGBD210
|
|
00525 GO TO P1000-EXIT. CHGBD210
|
|
00526 CHGBD210
|
|
00527 SET WRK-REC-SELECTED-NO-88 TO TRUE. CHGBD210
|
|
00528 PERFORM P4000-SELECT THRU P4000-EXIT. CHGBD210
|
|
00529 CHGBD210
|
|
00530 IF WRK-REC-SELECTED-YES-88 CHGBD210
|
|
00531 PERFORM P5000-BUILD-CHG4-REC THRU P5000-EXIT CHGBD210
|
|
00532 PERFORM S1100-WRITE-BD210 THRU S1100-EXIT CHGBD210
|
|
00533 ELSE CHGBD210
|
|
00534 ADD +1 TO WRK-BD205-NOT-SELECTED. CHGBD210
|
|
00535 CHGBD210
|
|
00536 P1000-EXIT. CHGBD210
|
|
00537 EXIT. CHGBD210
|
|
00538 CHGBD210
|
|
00539 P2000-EDIT-EMP. CHGBD210
|
|
00540 MOVE CHG2-EMP-NO TO WRK-LAST-EMP-CHECKED. CHGBD210
|
|
00541 CHGBD210
|
|
00542 PERFORM P2100-CHECK-STATUS THRU P2100-EXIT. CHGBD210
|
|
00543 IF L100-NO-REC-FOUND-88 CHGBD210
|
|
00544 PERFORM P2010-NO-EMP-ERR THRU P2010-EXIT CHGBD210
|
|
00545 GO TO P2000-EXIT CHGBD210
|
|
00546 ELSE CHGBD210
|
|
00547 IF WRK-EMP-VALID-NO-88 CHGBD210
|
|
00548 GO TO P2000-EXIT. CHGBD210
|
|
00549 CHGBD210
|
|
00550 PERFORM P2300-GET-ADDRESS THRU P2300-EXIT. CHGBD210
|
|
00551 CHGBD210
|
|
00552 P2000-EXIT. CHGBD210
|
|
00553 EXIT. CHGBD210
|
|
00554 CHGBD210
|
|
00555 P2010-NO-EMP-ERR. CHGBD210
|
|
00556 MOVE MSG1-ID2 TO R907-MSG-ID. CHGBD210
|
|
00557 MOVE CHG2-EMP-NO TO R907-EMP-NO. CHGBD210
|
|
00558 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT. CHGBD210
|
|
00559 MOVE R907-REC TO RSKL-REC. CHGBD210
|
|
00560 PERFORM S946-RPT-REC-O THRU S946-EXIT. CHGBD210
|
|
00561 CHGBD210
|
|
00562 P2010-EXIT. CHGBD210
|
|
00563 EXIT. CHGBD210
|
|
00564 CHGBD210
|
|
00565 P2100-CHECK-STATUS. CHGBD210
|
|
00566 SET WRK-EMP-VALID-NO-88 TO TRUE. CHGBD210
|
|
00567 SET WRK-FISC-AG-NONE-88 TO TRUE. CHGBD210
|
|
00568 MOVE CHG2-EMP-NO TO L100-EMP-NO. CHGBD210
|
|
00569 PERFORM S100-CALL-CHGBU100 THRU S100-EXIT. CHGBD210
|
|
00570 IF L100-OK-88 CHGBD210
|
|
00571 IF L100-NOT-LIABLE-88 CHGBD210
|
|
00572 ADD 1 TO WRK-BD205-NOT-LIAB-CNT CHGBD210
|
|
00573 ELSE CHGBD210
|
|
00574 MOVE L100-EMP-TYPE TO CHG2-EMP-TYPE CHGBD210
|
|
00575 MOVE L100-FISCAL-AGENT-CD TO WRK-FISCAL-AGENT-CD CHGBD210
|
|
00576 SET WRK-EMP-VALID-YES-88 TO TRUE CHGBD210
|
|
00577 END-IF CHGBD210
|
|
00578 ELSE CHGBD210
|
|
00579 SET WRK-EMP-VALID-NO-88 TO TRUE CHGBD210
|
|
00580 PERFORM P2110-INVALID-EMP THRU P2110-EXIT CHGBD210
|
|
00581 END-IF. CHGBD210
|
|
00582 CHGBD210
|
|
00583 * IF CHG2-EMP-TYPE-UCX-88 CHGBD210
|
|
00584 * OR CHG2-EMP-TYPE-UCFE-88 CHGBD210
|
|
00585 * PERFORM P2120-CHG-TRANSFER THRU P2120-EXIT CHGBD210
|
|
00586 * END-IF. CHGBD210
|
|
00587 CHGBD210
|
|
00588 P2100-EXIT. CHGBD210
|
|
00589 EXIT. CHGBD210
|
|
00590 CHGBD210
|
|
00591 P2110-INVALID-EMP. CHGBD210
|
|
00592 MOVE MSG6-ID2 TO R907-MSG-ID. CHGBD210
|
|
00593 MOVE CHG2-EMP-NO TO R907-EMP-NO CHGBD210
|
|
00594 MSG6-EMP-NO. CHGBD210
|
|
00595 MOVE CHG2-EMP-TYPE TO MSG6-EMP-TYPE. CHGBD210
|
|
00596 MOVE MSG6-LONG-TEXT TO R907-MSG-TEXT. CHGBD210
|
|
00597 MOVE R907-REC TO RSKL-REC. CHGBD210
|
|
00598 PERFORM S946-RPT-REC-O THRU S946-EXIT. CHGBD210
|
|
00599 CHGBD210
|
|
00600 P2110-EXIT. CHGBD210
|
|
00601 EXIT. CHGBD210
|
|
00602 CHGBD210
|
|
00603 *P2120-CHG-TRANSFER. CHGBD210
|
|
00604 * IF CHG2-EMP-NO = 000467 OR 000579 CHGBD210
|
|
00605 * DISPLAY 'P2120 - 1 ' CHG2-EMP-NO CHGBD210
|
|
00606 * END-IF. CHGBD210
|
|
00607 * CHGBD210
|
|
00608 * EVALUATE TRUE CHGBD210
|
|
00609 * WHEN CHG2-EMP-NO = 000467 CHGBD210
|
|
00610 * MOVE 000380 TO CHG2-EMP-NO CHGBD210
|
|
00611 * CHGBD210
|
|
00612 * WHEN CHG2-EMP-NO = 000579 CHGBD210
|
|
00613 * MOVE 000380 TO CHG2-EMP-NO CHGBD210
|
|
00614 * CHGBD210
|
|
00615 * END-EVALUATE. CHGBD210
|
|
00616 * CHGBD210
|
|
00617 * IF CHG2-EMP-NO = 000380 CHGBD210
|
|
00618 * DISPLAY 'P2120 - 2 ' CHG2-EMP-NO CHGBD210
|
|
00619 * END-IF. CHGBD210
|
|
00620 *P2120-EXIT. CHGBD210
|
|
00621 * EXIT. CHGBD210
|
|
00622 CHGBD210
|
|
00623 CHGBD210
|
|
00624 P2300-GET-ADDRESS. CHGBD210
|
|
00625 PERFORM P2320-FIND-ADDRESS THRU P2320-EXIT CHGBD210
|
|
00626 IF WRK-EMP-VALID-YES-88 CHGBD210
|
|
00627 PERFORM P2330-FORMAT-ADDRESS THRU P2330-EXIT. CHGBD210
|
|
00628 CHGBD210
|
|
00629 P2300-EXIT. CHGBD210
|
|
00630 EXIT. CHGBD210
|
|
00631 CHGBD210
|
|
00632 CHGBD210
|
|
00633 P2320-FIND-ADDRESS. CHGBD210
|
|
00634 MOVE CHG2-EMP-NO TO L111-EMP-NO. CHGBD210
|
|
00635 SET L111-LOOKUP-BAA-88 TO TRUE. CHGBD210
|
|
00636 SET L111-ID-NO-BAA-PRIM-88 TO TRUE. CHGBD210
|
|
00637 PERFORM S111-LOOKUP-ADDRESS THRU S111-EXIT. CHGBD210
|
|
00638 IF L111-ADDR-NOT-FOUND-88 CHGBD210
|
|
00639 SET L111-LOOKUP-TAD-88 TO TRUE CHGBD210
|
|
00640 SET L111-ID-NO-TAD-MAIL-88 TO TRUE CHGBD210
|
|
00641 PERFORM S111-LOOKUP-ADDRESS THRU S111-EXIT CHGBD210
|
|
00642 IF L111-ADDR-NOT-FOUND-88 CHGBD210
|
|
00643 SET WRK-EMP-VALID-NO-88 TO TRUE CHGBD210
|
|
00644 MOVE MSG5-ID2 TO R907-MSG-ID CHGBD210
|
|
00645 MOVE CHG2-EMP-NO TO MSG5-EMP-NO CHGBD210
|
|
00646 R907-EMP-NO CHGBD210
|
|
00647 MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT CHGBD210
|
|
00648 MOVE R907-REC TO RSKL-REC CHGBD210
|
|
00649 PERFORM S946-RPT-REC-O THRU S946-EXIT CHGBD210
|
|
00650 END-IF CHGBD210
|
|
00651 ELSE CHGBD210
|
|
00652 DISPLAY ' BUSINESS ADDRESS FOUND - ' CHG2-EMP-NO CHGBD210
|
|
00653 END-IF. CHGBD210
|
|
00654 CHGBD210
|
|
00655 P2320-EXIT. CHGBD210
|
|
00656 EXIT. CHGBD210
|
|
00657 CHGBD210
|
|
00658 P2330-FORMAT-ADDRESS. CHGBD210
|
|
00659 SET L112-TAD-ADDR-88 TO TRUE. CHGBD210
|
|
00660 SET L112-ANCHOR-LAST-88 TO TRUE. CHGBD210
|
|
00661 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. CHGBD210
|
|
00662 MOVE L100-PRIMARY-NAME TO L112-PRIMARY-NAME CHGBD210
|
|
00663 WRK-EMP-NAME-CHK. CHGBD210
|
|
00664 PERFORM S112-FORMAT-ADDRESS THRU S112-EXIT. CHGBD210
|
|
00665 CHGBD210
|
|
00666 MOVE L112-MAILING-ADDRESS TO WRK-FMT-ADDR. CHGBD210
|
|
00667 MOVE L111-ZIP TO WRK-ZIP. CHGBD210
|
|
00668 MOVE L111-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. CHGBD210
|
|
00669 CHGBD210
|
|
00670 P2330-EXIT. CHGBD210
|
|
00671 EXIT. CHGBD210
|
|
00672 CHGBD210
|
|
00673 P3000-UPDATE-EMP-DATA. CHGBD210
|
|
00674 MOVE L100-EMP-TYPE TO CHG2-EMP-TYPE. CHGBD210
|
|
00675 MOVE L100-FISCAL-AGENT-CD TO WRK-FISCAL-AGENT-CD. CHGBD210
|
|
00676 CHGBD210
|
|
00677 P3000-EXIT. CHGBD210
|
|
00678 EXIT. CHGBD210
|
|
00679 CHGBD210
|
|
00680 P4000-SELECT. CHGBD210
|
|
00681 DISPLAY 'P4000 CHG3 RUN TYPE: ' CHG3-RUN-TYPE. CL**9
|
|
00682 EVALUATE TRUE CHGBD210
|
|
00683 WHEN CHG3-RUN-TYPE-EMP-88 CHGBD210
|
|
00684 PERFORM P4100-SELECT-BY-EMP THRU P4100-EXIT CHGBD210
|
|
00685 CHGBD210
|
|
00686 WHEN CHG3-RUN-TYPE-MON-EMP-88 CHGBD210
|
|
00687 PERFORM P4100-SELECT-BY-EMP THRU P4100-EXIT CHGBD210
|
|
00688 CHGBD210
|
|
00689 WHEN CHG3-RUN-TYPE-WK-EMP-88 CHGBD210
|
|
00690 PERFORM P4100-SELECT-BY-EMP THRU P4100-EXIT CHGBD210
|
|
00691 CHGBD210
|
|
00692 WHEN CHG3-RUN-TYPE-RPTS-88 CHGBD210
|
|
00693 PERFORM P4200-SELECT-BY-RPT THRU P4200-EXIT CHGBD210
|
|
00694 CHGBD210
|
|
00695 WHEN CHG3-RUN-TYPE-TEUC-88 CHGBD210
|
|
00696 PERFORM P4200-SELECT-BY-RPT THRU P4200-EXIT CHGBD210
|
|
00697 CHGBD210
|
|
00698 WHEN CHG3-RUN-TYPE-QTR-88 CHGBD210
|
|
00699 PERFORM P4300-SELECT-QTR THRU P4300-EXIT CHGBD210
|
|
00700 CHGBD210
|
|
00701 WHEN CHG3-RUN-TYPE-ANNUAL-88 CHGBD210
|
|
00702 PERFORM P4400-SELECT-ANNUAL THRU P4400-EXIT CHGBD210
|
|
00703 CHGBD210
|
|
00704 WHEN CHG3-RUN-TYPE-AGENT-88 CHGBD210
|
|
00705 PERFORM P4500-SELECT-AGENTS THRU P4500-EXIT CHGBD210
|
|
00706 CL**6
|
|
00707 WHEN CHG3-RUN-TYPE-FPUC-88 CL**6
|
|
00708 PERFORM P4200-SELECT-BY-RPT THRU P4200-EXIT CL**6
|
|
00709 CHGBD210
|
|
00710 END-EVALUATE. CHGBD210
|
|
00711 CHGBD210
|
|
00712 P4000-EXIT. CHGBD210
|
|
00713 EXIT. CHGBD210
|
|
00714 CHGBD210
|
|
00715 P4100-SELECT-BY-EMP. CHGBD210
|
|
00716 DISPLAY 'P4100 CHG2-EMP: ' CHG2-EMP-NO CL**8
|
|
00717 DISPLAY 'P4100 CHG3-EMP: ' CHG3-EMP-NO CL**8
|
|
00718 IF CHG2-EMP-NO = CHG3-EMP-NO CL**8
|
|
00719 SET WRK-REC-SELECTED-YES-88 TO TRUE CHGBD210
|
|
00720 END-IF. CHGBD210
|
|
00721 CHGBD210
|
|
00722 P4100-EXIT. CHGBD210
|
|
00723 EXIT. CHGBD210
|
|
00724 CHGBD210
|
|
00725 P4200-SELECT-BY-RPT. CHGBD210
|
|
00726 MOVE CHG2-EMP-TYPE TO WRK-RPT-TYPE. CHGBD210
|
|
00727 CHGBD210
|
|
00728 IF (CHG3-RPT-TYPE-RATED-88 CHGBD210
|
|
00729 AND WRK-RPT-TYPE-RATED-88) CHGBD210
|
|
00730 SET WRK-REC-SELECTED-YES-88 TO TRUE CHGBD210
|
|
00731 ELSE CHGBD210
|
|
00732 IF (CHG3-RPT-TYPE-FED-88 CHGBD210
|
|
00733 AND WRK-RPT-TYPE-FED-88) CHGBD210
|
|
00734 SET WRK-REC-SELECTED-YES-88 TO TRUE CHGBD210
|
|
00735 ELSE CHGBD210
|
|
00736 IF (CHG3-RPT-TYPE-CWC-88 CHGBD210
|
|
00737 AND WRK-RPT-TYPE-CWC-88) CHGBD210
|
|
00738 SET WRK-REC-SELECTED-YES-88 TO TRUE CHGBD210
|
|
00739 ELSE CHGBD210
|
|
00740 IF (CHG3-RPT-TYPE-SELF-INS-88 CHGBD210
|
|
00741 AND WRK-RPT-TYPE-SELF-INS-88) CHGBD210
|
|
00742 SET WRK-REC-SELECTED-YES-88 TO TRUE CHGBD210
|
|
00743 ELSE CHGBD210
|
|
00744 IF (CHG3-RPT-TYPE-TEUC-88 CHGBD210
|
|
00745 AND WRK-RPT-TYPE-TEUC-88) CHGBD210
|
|
00746 SET WRK-REC-SELECTED-YES-88 TO TRUE CHGBD210
|
|
00747 ELSE CHGBD210
|
|
00748 IF (CHG3-RPT-TYPE-DC-88 CHGBD210
|
|
00749 AND WRK-RPT-TYPE-DC-88) CHGBD210
|
|
00750 SET WRK-REC-SELECTED-YES-88 TO TRUE CL**4
|
|
00751 ELSE CL**4
|
|
00752 IF (CHG3-RPT-TYPE-FPUC-88 CL**4
|
|
00753 AND WRK-RPT-TYPE-FPUC-88) CL**4
|
|
00754 SET WRK-REC-SELECTED-YES-88 TO TRUE. CL**4
|
|
00755 CHGBD210
|
|
00756 P4200-EXIT. CHGBD210
|
|
00757 EXIT. CHGBD210
|
|
00758 CHGBD210
|
|
00759 P4300-SELECT-QTR. CHGBD210
|
|
00760 MOVE CHG2-EMP-TYPE TO WRK-RPT-TYPE. CHGBD210
|
|
00761 CHGBD210
|
|
00762 IF (WRK-RPT-TYPE-RATED-88 CHGBD210
|
|
00763 OR WRK-RPT-TYPE-FED-88 CHGBD210
|
|
00764 OR WRK-RPT-TYPE-CWC-88 CHGBD210
|
|
00765 OR WRK-RPT-TYPE-SELF-INS-88 CHGBD210
|
|
00766 OR WRK-RPT-TYPE-DC-88 CL**5
|
|
00767 OR WRK-RPT-TYPE-FPUC-88) CL**4
|
|
00768 SET WRK-REC-SELECTED-YES-88 TO TRUE. CHGBD210
|
|
00769 CHGBD210
|
|
00770 P4300-EXIT. CHGBD210
|
|
00771 EXIT. CHGBD210
|
|
00772 CHGBD210
|
|
00773 P4400-SELECT-ANNUAL. CHGBD210
|
|
00774 MOVE CHG2-EMP-TYPE TO WRK-RPT-TYPE. CHGBD210
|
|
00775 CHGBD210
|
|
00776 IF WRK-RPT-TYPE-RATED-88 CHGBD210
|
|
00777 IF CHG3-RUN-TYPE-ANN-EMP-88 CHGBD210
|
|
00778 PERFORM P4410-SELECT-EMP THRU P4410-EXIT CHGBD210
|
|
00779 ELSE CHGBD210
|
|
00780 SET WRK-REC-SELECTED-YES-88 TO TRUE. CHGBD210
|
|
00781 CHGBD210
|
|
00782 P4400-EXIT. CHGBD210
|
|
00783 EXIT. CHGBD210
|
|
00784 CHGBD210
|
|
00785 P4410-SELECT-EMP. CHGBD210
|
|
00786 DISPLAY 'P4410 CHG2-EMP: ' CHG2-EMP-NO CL**8
|
|
00787 DISPLAY 'P4410 CHG3-EMP: ' CHG3-EMP-NO CL**8
|
|
00788 IF CHG2-EMP-NO = CHG3-EMP-NO CL**8
|
|
00789 SET WRK-REC-SELECTED-YES-88 TO TRUE. CHGBD210
|
|
00790 CHGBD210
|
|
00791 P4410-EXIT. CHGBD210
|
|
00792 EXIT. CHGBD210
|
|
00793 CHGBD210
|
|
00794 P4500-SELECT-AGENTS. CHGBD210
|
|
00795 MOVE CHG2-EMP-TYPE TO WRK-RPT-TYPE. CHGBD210
|
|
00796 CHGBD210
|
|
00797 IF WRK-RPT-TYPE-RATED-88 CHGBD210
|
|
00798 SET WRK-REC-SELECTED-YES-88 TO TRUE. CHGBD210
|
|
00799 CHGBD210
|
|
00800 P4500-EXIT. CHGBD210
|
|
00801 EXIT. CHGBD210
|
|
00802 CHGBD210
|
|
00803 P5000-BUILD-CHG4-REC. CHGBD210
|
|
00804 ** IF CHG2-EMP-NO = 000467 OR 000579 CHGBD210
|
|
00805 * DISPLAY 'P5000 - 1 ' CHG2-EMP-NO CHGBD210
|
|
00806 ** END-IF. CHGBD210
|
|
00807 CHGBD210
|
|
00808 *& CHGBD210
|
|
00809 COMPUTE WRK-TOT-CHG = WRK-TOT-CHG CHGBD210
|
|
00810 + CHG2-CURR-BEN-AMT CHGBD210
|
|
00811 + CHG2-CURR-ADJ-AMT. CHGBD210
|
|
00812 *& CHGBD210
|
|
00813 MOVE CHG2-EMP-TYPE TO WRK-RPT-TYPE. CHGBD210
|
|
00814 CHGBD210
|
|
00815 EVALUATE TRUE CHGBD210
|
|
00816 WHEN WRK-RPT-TYPE-RATED-88 CHGBD210
|
|
00817 MOVE '1' TO CHG4-REPORT-TYPE CHGBD210
|
|
00818 CHGBD210
|
|
00819 WHEN WRK-RPT-TYPE-SELF-INS-88 CHGBD210
|
|
00820 MOVE '2' TO CHG4-REPORT-TYPE CHGBD210
|
|
00821 CHGBD210
|
|
00822 WHEN WRK-RPT-TYPE-FED-88 CHGBD210
|
|
00823 MOVE '4' TO CHG4-REPORT-TYPE CHGBD210
|
|
00824 CHGBD210
|
|
00825 WHEN WRK-RPT-TYPE-TEUC-88 CHGBD210
|
|
00826 MOVE '5' TO CHG4-REPORT-TYPE CHGBD210
|
|
00827 CHGBD210
|
|
00828 WHEN WRK-RPT-TYPE-CWC-88 CHGBD210
|
|
00829 MOVE '3' TO CHG4-REPORT-TYPE CHGBD210
|
|
00830 CHGBD210
|
|
00831 WHEN WRK-RPT-TYPE-DC-88 CHGBD210
|
|
00832 MOVE '6' TO CHG4-REPORT-TYPE CHGBD210
|
|
00833 CL**4
|
|
00834 WHEN WRK-RPT-TYPE-FPUC-88 CL**4
|
|
00835 MOVE '7' TO CHG4-REPORT-TYPE CL**4
|
|
00836 CHGBD210
|
|
00837 END-EVALUATE. CHGBD210
|
|
00838 CHGBD210
|
|
00839 MOVE CHG2-EMP-NO TO CHG4-EMP-NO. CHGBD210
|
|
00840 CHGBD210
|
|
00841 EVALUATE TRUE CHGBD210
|
|
00842 WHEN CHG4-EMP-NO = 000467 CHGBD210
|
|
00843 MOVE 000380 TO CHG4-EMP-NO CHGBD210
|
|
00844 CHGBD210
|
|
00845 WHEN CHG4-EMP-NO = 000579 CHGBD210
|
|
00846 MOVE 000380 TO CHG4-EMP-NO CHGBD210
|
|
00847 CHGBD210
|
|
00848 WHEN CHG4-EMP-NO = 000012 CHGBD210
|
|
00849 MOVE 000030 TO CHG4-EMP-NO CHGBD210
|
|
00850 CHGBD210
|
|
00851 WHEN CHG4-EMP-NO = 000913 CHGBD210
|
|
00852 MOVE 000914 TO CHG4-EMP-NO CHGBD210
|
|
00853 CHGBD210
|
|
00854 END-EVALUATE. CHGBD210
|
|
00855 CHGBD210
|
|
00856 IF CHG2-EMP-NO = 005029 CL**6
|
|
00857 DISPLAY 'P5000 - 2 ' CHG2-EMP-NO CL**6
|
|
00858 END-IF. CL**6
|
|
00859 CL**6
|
|
00860 MOVE CHG2-SSN TO WRK-KEY. CHGBD210
|
|
00861 MOVE WRK-SSN TO CHG4-SSN. CHGBD210
|
|
00862 MOVE CHG2-BYE TO CHG4-BYE. CHGBD210
|
|
00863 MOVE CHG2-PROGRAM TO CHG4-PROGRAM. CHGBD210
|
|
00864 CHGBD210
|
|
00865 MOVE WRK-SSN TO L081-CLAIMANT-SSN. CHGBD210
|
|
00866 PERFORM S081-CLAIMANT-NAME THRU S081-EXIT. CHGBD210
|
|
00867 * DISPLAY ' S081 RETURN CODE ' L081-RESULT-IND CHGBD210
|
|
00868 * DISPLAY ' S081 MSG AREA ' L081-MSG-AREA CHGBD210
|
|
00869 * DISPLAY ' S081 NAME ' L081-CLAIMANT-NAME CHGBD210
|
|
00870 IF L081-NAME-FOUND CHGBD210
|
|
00871 MOVE L081-CLAIMANT-NAME TO CHG4-CLMNT-NAME CHGBD210
|
|
00872 ELSE CHGBD210
|
|
00873 PERFORM S083-IB6-CLMNT-NAME THRU S083-EXIT CHGBD210
|
|
00874 * DISPLAY ' S083 RETURN CODE ' L081-RESULT-IND CHGBD210
|
|
00875 * DISPLAY ' S083 MSG AREA ' L081-MSG-AREA CHGBD210
|
|
00876 * DISPLAY ' S083 NAME ' L081-CLAIMANT-NAME CHGBD210
|
|
00877 MOVE L081-CLAIMANT-NAME TO CHG4-CLMNT-NAME. CHGBD210
|
|
00878 CHGBD210
|
|
00879 MOVE CHG2-EMP-TYPE TO CHG4-EMP-TYPE. CHGBD210
|
|
00880 MOVE CHG2-CURR-BEN-AMT TO CHG4-CURR-BEN-AMT. CHGBD210
|
|
00881 MOVE CHG2-CURR-ADJ-AMT TO CHG4-CURR-ADJ-AMT. CHGBD210
|
|
00882 MOVE CHG2-TOT-BEN-AMT TO CHG4-TOT-BEN-AMT. CHGBD210
|
|
00883 MOVE CHG2-TOT-ADJ-AMT TO CHG4-TOT-ADJ-AMT. CHGBD210
|
|
00884 MOVE CHG2-OP-RECOVER-AMT TO CHG4-OP-RECOVER-AMT. CHGBD210
|
|
00885 MOVE CHG2-OP-RECOVER-AMT TO CHG4-OP-RECOVER-AMT. CHGBD210
|
|
00886 CHGBD210
|
|
00887 MOVE WRK-FISCAL-AGENT-CD TO CHG4-FISCAL-AGENT-CD. CHGBD210
|
|
00888 MOVE WRK-FMT-ADDR TO CHG4-FMT-ADDR. CHGBD210
|
|
00889 MOVE WRK-ZIP TO CHG4-ZIP. CHGBD210
|
|
00890 MOVE WRK-ADVANCED-BARCODE TO CHG4-ADVANCED-BARCODE. CHGBD210
|
|
00891 MOVE WRK-EMP-NAME-CHK TO CHG4-EMP-NAME-CHK. CHGBD210
|
|
00892 CHGBD210
|
|
00893 MOVE ZERO TO CHG4-SUCC-EMP-NO CHGBD210
|
|
00894 CHG4-PRED-EMP-NO CHGBD210
|
|
00895 CHG4-PERCENT-XFER. CHGBD210
|
|
00896 CHGBD210
|
|
00897 MOVE SPACE TO CHG4-DATA-FILLER. CHGBD210
|
|
00898 CHGBD210
|
|
00899 *& CHGBD210
|
|
00900 * MOVE CHG2-SSN TO WRK-KEY. CHGBD210
|
|
00901 * IF WRK-SSN = 220947300 CHGBD210
|
|
00902 * MOVE CHG2-CHARGE-DATE TO WRK-DATE CHGBD210
|
|
00903 * MOVE CHG2-EMP-NO TO WRK-EMP-DISP CHGBD210
|
|
00904 * MOVE CHG2-SSN TO WRK-SSN-DISP CHGBD210
|
|
00905 * COMPUTE WRK-CHG-AMT-DISP = CHGBD210
|
|
00906 * CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT CHGBD210
|
|
00907 * DISPLAY 'P5000 ' WRK-DISP-AREA. CHGBD210
|
|
00908 *& CHGBD210
|
|
00909 P5000-EXIT. CHGBD210
|
|
00910 EXIT. CHGBD210
|
|
00911 CHGBD210
|
|
00912 P6000-DC-CHARGES. CHGBD210
|
|
00913 SET WRK-DEFAULT-DC-ACCT-NO-88 TO TRUE. CHGBD210
|
|
00914 CHGBD210
|
|
00915 MOVE CHG2-SSN TO WRK-KEY. CHGBD210
|
|
00916 IF WRK-SSN = WRK-LAST-DC-SSN CHGBD210
|
|
00917 PERFORM P6300-ALLOCATE-CHARGES THRU P6300-EXIT CHGBD210
|
|
00918 ELSE CHGBD210
|
|
00919 PERFORM P6100-CALC-BASE-PERIOD THRU P6100-EXIT CHGBD210
|
|
00920 PERFORM P6200-BUILD-DC-TABLE THRU P6200-EXIT CHGBD210
|
|
00921 PERFORM P6300-ALLOCATE-CHARGES THRU P6300-EXIT CHGBD210
|
|
00922 END-IF. CHGBD210
|
|
00923 CHGBD210
|
|
00924 P6000-EXIT. CHGBD210
|
|
00925 EXIT. CHGBD210
|
|
00926 CHGBD210
|
|
00927 P6100-CALC-BASE-PERIOD. CHGBD210
|
|
00928 MOVE CHG2-BYE TO L001-FED-8-DATE-9. CHGBD210
|
|
00929 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD210
|
|
00930 IF L001-INVALID-DATE CHGBD210
|
|
00931 SET WRK-DEFAULT-DC-ACCT-YES-88 TO TRUE CHGBD210
|
|
00932 GO TO P6100-EXIT CHGBD210
|
|
00933 ELSE CHGBD210
|
|
00934 SUBTRACT +363 FROM L001-JUL-ABS-DAY CHGBD210
|
|
00935 PERFORM S001-FROM-ABS THRU S001-EXIT CHGBD210
|
|
00936 IF NOT L001-SATURDAY CHGBD210
|
|
00937 SUBTRACT +1 FROM L001-JUL-ABS-DAY CHGBD210
|
|
00938 PERFORM S001-FROM-ABS THRU S001-EXIT CHGBD210
|
|
00939 END-IF CHGBD210
|
|
00940 END-IF. CHGBD210
|
|
00941 CHGBD210
|
|
00942 * NOTE: THIS PROCESS IGNORES LAG QUARTER WAGES CHGBD210
|
|
00943 * USED IN ALTERNATE BASE CLAIMS CHGBD210
|
|
00944 MOVE L001-FED-8-DATE-9 TO L004-DATE. CHGBD210
|
|
00945 PERFORM S004-FROM-DATE THRU S004-EXIT. CHGBD210
|
|
00946 SUBTRACT +3 FROM L004-ABS-QTR. CHGBD210
|
|
00947 PERFORM S004-FROM-ABS THRU S004-EXIT. CHGBD210
|
|
00948 MOVE L004-QTR-5-9 TO WRK-BP-END. CHGBD210
|
|
00949 SUBTRACT +2 FROM L004-ABS-QTR. CHGBD210
|
|
00950 PERFORM S004-FROM-ABS THRU S004-EXIT. CHGBD210
|
|
00951 MOVE L004-QTR-5-9 TO WRK-BP-START. CHGBD210
|
|
00952 CHGBD210
|
|
00953 P6100-EXIT. CHGBD210
|
|
00954 EXIT. CHGBD210
|
|
00955 CHGBD210
|
|
00956 P6200-BUILD-DC-TABLE. CHGBD210
|
|
00957 PERFORM P6210-INIT-TABLE THRU P6210-EXIT. CHGBD210
|
|
00958 CHGBD210
|
|
00959 IF WRK-DEFAULT-DC-ACCT-YES-88 CHGBD210
|
|
00960 PERFORM P6220-DEFAULT-ACCT THRU P6220-EXIT CHGBD210
|
|
00961 GO TO P6200-EXIT. CHGBD210
|
|
00962 CHGBD210
|
|
00963 MOVE WRK-SSN TO CHG10-SSN CHGBD210
|
|
00964 WRK-LAST-DC-SSN. CHGBD210
|
|
00965 MOVE WRK-BP-START TO CHG10-YRQ. CHGBD210
|
|
00966 MOVE SPACES TO CHG10-DC-AGENCY-CD. CHGBD210
|
|
00967 START DC-WAGE-FILE CHGBD210
|
|
00968 KEY IS >= CHG10-KEY-AREA. CHGBD210
|
|
00969 CHGBD210
|
|
00970 IF NOT DC-WAGE-FILE-OK-88 CHGBD210
|
|
00971 PERFORM P6220-DEFAULT-ACCT THRU P6220-EXIT CHGBD210
|
|
00972 GO TO P6200-EXIT CHGBD210
|
|
00973 ELSE CHGBD210
|
|
00974 READ DC-WAGE-FILE NEXT CHGBD210
|
|
00975 IF CHG10-SSN NOT = WRK-SSN CHGBD210
|
|
00976 OR CHG10-YRQ > WRK-BP-END CHGBD210
|
|
00977 PERFORM P6220-DEFAULT-ACCT THRU P6220-EXIT CHGBD210
|
|
00978 GO TO P6200-EXIT CHGBD210
|
|
00979 END-IF CHGBD210
|
|
00980 END-IF. CHGBD210
|
|
00981 CHGBD210
|
|
00982 *& CHGBD210
|
|
00983 * DISPLAY 'NO DEFAULT ' WRK-SSN ' ' CHG2-EMP-NO ' ' CHGBD210
|
|
00984 * CHG2-CURR-BEN-AMT ' ' CHG2-CURR-ADJ-AMT. CHGBD210
|
|
00985 *& CHGBD210
|
|
00986 PERFORM CHGBD210
|
|
00987 UNTIL CHG10-SSN NOT = WRK-SSN CHGBD210
|
|
00988 OR CHG10-YRQ > WRK-BP-END CHGBD210
|
|
00989 OR DC-WAGE-FILE-EOF-88 CHGBD210
|
|
00990 IF CHG10-WAGES NOT = ZERO CHGBD210
|
|
00991 PERFORM P6230-FIND-INDEX THRU P6230-EXIT CHGBD210
|
|
00992 IF DC-NDX > ZERO CHGBD210
|
|
00993 PERFORM P6240-ADD-WAGES THRU P6240-EXIT CHGBD210
|
|
00994 ELSE CHGBD210
|
|
00995 IF WRK-DC-TBL-LAST < WRK-DC-TBL-MAX CHGBD210
|
|
00996 ADD +1 TO WRK-DC-TBL-LAST CHGBD210
|
|
00997 ELSE CHGBD210
|
|
00998 DISPLAY 'DC TBL LENGTH EXCEEDED ' CHG2-SSN CHGBD210
|
|
00999 PERFORM S999-ABEND THRU S999-EXIT CHGBD210
|
|
01000 END-IF CHGBD210
|
|
01001 MOVE WRK-DC-TBL-LAST TO DC-NDX CHGBD210
|
|
01002 PERFORM P6240-ADD-WAGES THRU P6240-EXIT CHGBD210
|
|
01003 END-IF CHGBD210
|
|
01004 END-IF CHGBD210
|
|
01005 READ DC-WAGE-FILE NEXT CHGBD210
|
|
01006 END-PERFORM. CHGBD210
|
|
01007 CHGBD210
|
|
01008 PERFORM P6250-CALC-PCT THRU P6250-EXIT. CHGBD210
|
|
01009 IF WRK-DC-TOT-WAGE-AMT = ZERO CHGBD210
|
|
01010 PERFORM P6220-DEFAULT-ACCT THRU P6220-EXIT CHGBD210
|
|
01011 GO TO P6200-EXIT CHGBD210
|
|
01012 END-IF. CHGBD210
|
|
01013 CHGBD210
|
|
01014 P6200-EXIT. CHGBD210
|
|
01015 EXIT. CHGBD210
|
|
01016 CHGBD210
|
|
01017 P6210-INIT-TABLE. CHGBD210
|
|
01018 MOVE +0 TO WRK-DC-TBL-LAST CHGBD210
|
|
01019 DC-NDX. CHGBD210
|
|
01020 PERFORM CHGBD210
|
|
01021 VARYING DC-SUB FROM +1 BY +1 CHGBD210
|
|
01022 UNTIL DC-SUB > WRK-DC-TBL-MAX CHGBD210
|
|
01023 MOVE SPACES TO WRK-DC-CODE (DC-SUB) CHGBD210
|
|
01024 MOVE +0 TO WRK-DC-EMP-NO (DC-SUB) CHGBD210
|
|
01025 WRK-DC-WAGE-AMT (DC-SUB) CHGBD210
|
|
01026 WRK-DC-PCT (DC-SUB) CHGBD210
|
|
01027 END-PERFORM. CHGBD210
|
|
01028 CHGBD210
|
|
01029 P6210-EXIT. CHGBD210
|
|
01030 EXIT. CHGBD210
|
|
01031 CHGBD210
|
|
01032 P6220-DEFAULT-ACCT. CHGBD210
|
|
01033 *& CHGBD210
|
|
01034 * DISPLAY 'DC DEFAULT ' WRK-SSN ' ' CHGBD210
|
|
01035 * CHG2-CURR-BEN-AMT ' ' CHG2-CURR-ADJ-AMT. CHGBD210
|
|
01036 *& CHGBD210
|
|
01037 ADD +1 TO WRK-DC-DEFAULT-CNT. CHGBD210
|
|
01038 MOVE WRK-DC-GOV-ACCT TO WRK-DC-EMP-NO (1). CHGBD210
|
|
01039 MOVE +1 TO WRK-DC-PCT (1). CHGBD210
|
|
01040 MOVE +1 TO WRK-DC-TBL-LAST. CHGBD210
|
|
01041 CHGBD210
|
|
01042 P6220-EXIT. CHGBD210
|
|
01043 EXIT. CHGBD210
|
|
01044 CHGBD210
|
|
01045 P6230-FIND-INDEX. CHGBD210
|
|
01046 MOVE +0 TO DC-NDX. CHGBD210
|
|
01047 PERFORM CHGBD210
|
|
01048 VARYING DC-SUB FROM +1 BY +1 CHGBD210
|
|
01049 UNTIL DC-SUB > WRK-DC-TBL-LAST CHGBD210
|
|
01050 OR DC-NDX > ZERO CHGBD210
|
|
01051 IF WRK-DC-CODE (DC-SUB) = CHG10-DC-AGENCY-CD CHGBD210
|
|
01052 MOVE DC-SUB TO DC-NDX CHGBD210
|
|
01053 END-IF CHGBD210
|
|
01054 END-PERFORM. CHGBD210
|
|
01055 CHGBD210
|
|
01056 P6230-EXIT. CHGBD210
|
|
01057 EXIT. CHGBD210
|
|
01058 CHGBD210
|
|
01059 P6240-ADD-WAGES. CHGBD210
|
|
01060 *& CHGBD210
|
|
01061 * DISPLAY 'P6240 ' WRK-SSN ' ' CHG10-EMP-NO ' ' CHGBD210
|
|
01062 * CHG10-WAGES ' ' DC-NDX. CHGBD210
|
|
01063 *& CHGBD210
|
|
01064 MOVE CHG10-EMP-NO TO WRK-DC-EMP-NO (DC-NDX). CHGBD210
|
|
01065 ADD CHG10-WAGES TO WRK-DC-WAGE-AMT (DC-NDX). CHGBD210
|
|
01066 CHGBD210
|
|
01067 P6240-EXIT. CHGBD210
|
|
01068 EXIT. CHGBD210
|
|
01069 CHGBD210
|
|
01070 P6250-CALC-PCT. CHGBD210
|
|
01071 PERFORM P6251-TOTAL-WAGE THRU P6251-EXIT. CHGBD210
|
|
01072 PERFORM P6252-PERCENT THRU P6252-EXIT. CHGBD210
|
|
01073 CHGBD210
|
|
01074 P6250-EXIT. CHGBD210
|
|
01075 EXIT. CHGBD210
|
|
01076 CHGBD210
|
|
01077 P6251-TOTAL-WAGE. CHGBD210
|
|
01078 MOVE ZERO TO WRK-DC-TOT-WAGE-AMT. CHGBD210
|
|
01079 PERFORM CHGBD210
|
|
01080 VARYING DC-SUB FROM +1 BY +1 CHGBD210
|
|
01081 UNTIL DC-SUB > WRK-DC-TBL-LAST CHGBD210
|
|
01082 COMPUTE WRK-DC-TOT-WAGE-AMT = WRK-DC-TOT-WAGE-AMT + CHGBD210
|
|
01083 WRK-DC-WAGE-AMT (DC-SUB) CHGBD210
|
|
01084 END-PERFORM. CHGBD210
|
|
01085 CHGBD210
|
|
01086 P6251-EXIT. CHGBD210
|
|
01087 EXIT. CHGBD210
|
|
01088 CHGBD210
|
|
01089 P6252-PERCENT. CHGBD210
|
|
01090 IF WRK-DC-TOT-WAGE-AMT = ZERO CHGBD210
|
|
01091 DISPLAY 'CHGBD210: TOT WAGE = ZERO, USING DEFAULT ' CHGBD210
|
|
01092 WRK-SSN CHGBD210
|
|
01093 ELSE CHGBD210
|
|
01094 PERFORM CHGBD210
|
|
01095 VARYING DC-SUB FROM +1 BY +1 CHGBD210
|
|
01096 UNTIL DC-SUB > WRK-DC-TBL-LAST CHGBD210
|
|
01097 COMPUTE WRK-DC-PCT (DC-SUB) = CHGBD210
|
|
01098 (WRK-DC-WAGE-AMT (DC-SUB) / WRK-DC-TOT-WAGE-AMT) CHGBD210
|
|
01099 END-PERFORM CHGBD210
|
|
01100 END-IF. CHGBD210
|
|
01101 CHGBD210
|
|
01102 P6252-EXIT. CHGBD210
|
|
01103 EXIT. CHGBD210
|
|
01104 CHGBD210
|
|
01105 P6300-ALLOCATE-CHARGES. CHGBD210
|
|
01106 MOVE CHG2-CURR-BEN-AMT TO WRK-CHG2-CURR-BEN-AMT. CHGBD210
|
|
01107 MOVE CHG2-CURR-ADJ-AMT TO WRK-CHG2-CURR-ADJ-AMT. CHGBD210
|
|
01108 CHGBD210
|
|
01109 PERFORM CHGBD210
|
|
01110 VARYING DC-SUB FROM +1 BY +1 CHGBD210
|
|
01111 UNTIL DC-SUB > WRK-DC-TBL-LAST CHGBD210
|
|
01112 COMPUTE CHG2-CURR-BEN-AMT = CHGBD210
|
|
01113 (WRK-CHG2-CURR-BEN-AMT * WRK-DC-PCT (DC-SUB)) CHGBD210
|
|
01114 COMPUTE CHG2-CURR-ADJ-AMT = CHGBD210
|
|
01115 (WRK-CHG2-CURR-ADJ-AMT * WRK-DC-PCT (DC-SUB)) CHGBD210
|
|
01116 MOVE WRK-DC-EMP-NO (DC-SUB) TO CHG2-EMP-NO CHGBD210
|
|
01117 PERFORM P5000-BUILD-CHG4-REC THRU P5000-EXIT CHGBD210
|
|
01118 PERFORM S1100-WRITE-BD210 THRU S1100-EXIT CHGBD210
|
|
01119 ADD +1 TO WRK-DC-WRITE-CNT CHGBD210
|
|
01120 *& CHGBD210
|
|
01121 * DISPLAY 'P6300 ' WRK-SSN ' ' CHG2-EMP-NO CHGBD210
|
|
01122 * ' ' CHG2-CURR-BEN-AMT ' ' CHG2-CURR-ADJ-AMT CHGBD210
|
|
01123 *& CHGBD210
|
|
01124 END-PERFORM. CHGBD210
|
|
01125 P6300-EXIT. CHGBD210
|
|
01126 EXIT. CHGBD210
|
|
01127 CHGBD210
|
|
01128 S1100-WRITE-BD210. CHGBD210
|
|
01129 WRITE BD210-CHG-REC. CHGBD210
|
|
01130 IF BD210-FILE-OK-88 CHGBD210
|
|
01131 ADD 1 TO WRK-BD210-WRITE. CHGBD210
|
|
01132 CHGBD210
|
|
01133 S1100-EXIT. CHGBD210
|
|
01134 EXIT. CHGBD210
|
|
01135 CHGBD210
|
|
01136 S001-FROM-FED-8. CHGBD210
|
|
01137 SET L001-FROM-FED-8 TO TRUE. CHGBD210
|
|
01138 GO TO S001-DATE. CHGBD210
|
|
01139 CHGBD210
|
|
01140 S001-FROM-ABS. CHGBD210
|
|
01141 SET L001-FROM-ABS-DAY TO TRUE. CHGBD210
|
|
01142 GO TO S001-DATE. CHGBD210
|
|
01143 CHGBD210
|
|
01144 S001-DATE. CHGBD210
|
|
01145 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD210
|
|
01146 S001-EXIT. EXIT. CHGBD210
|
|
01147 CHGBD210
|
|
01148 S004-FROM-DATE. CHGBD210
|
|
01149 SET L004-FROM-DATE TO TRUE. CHGBD210
|
|
01150 GO TO S004-YRQ. CHGBD210
|
|
01151 CHGBD210
|
|
01152 S004-FROM-ABS. CHGBD210
|
|
01153 SET L004-FROM-ABS TO TRUE. CHGBD210
|
|
01154 GO TO S004-YRQ. CHGBD210
|
|
01155 CHGBD210
|
|
01156 S004-YRQ. CHGBD210
|
|
01157 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD210
|
|
01158 S004-EXIT. EXIT. CHGBD210
|
|
01159 CHGBD210
|
|
01160 S081-CLAIMANT-NAME. CHGBD210
|
|
01161 CALL 'DTSBU081' USING L081-LINK-AREA. CHGBD210
|
|
01162 S081-EXIT. EXIT. CHGBD210
|
|
01163 CHGBD210
|
|
01164 S083-IB6-CLMNT-NAME. CHGBD210
|
|
01165 CALL 'DTSBU083' USING L081-LINK-AREA. CHGBD210
|
|
01166 S083-EXIT. EXIT. CHGBD210
|
|
01167 CHGBD210
|
|
01168 S100-CALL-CHGBU100. CHGBD210
|
|
01169 CALL 'CHGBU100' USING L100-LINK-AREA. CHGBD210
|
|
01170 S100-EXIT. EXIT. CHGBD210
|
|
01171 CHGBD210
|
|
01172 S111-LOOKUP-ADDRESS. CHGBD210
|
|
01173 CALL 'DTSBU111' USING L111-LINK-AREA. CHGBD210
|
|
01174 S111-EXIT. EXIT. CHGBD210
|
|
01175 CHGBD210
|
|
01176 S112-FORMAT-ADDRESS. CHGBD210
|
|
01177 CALL 'DTSBU112' USING L112-LINK-AREA. CHGBD210
|
|
01178 S112-EXIT. EXIT. CHGBD210
|
|
01179 CHGBD210
|
|
01180 S910-OPEN-READ. CHGBD210
|
|
01181 SET L910-OPEN-READ-88 TO TRUE. CHGBD210
|
|
01182 GO TO S910-MSTR-IO. CHGBD210
|
|
01183 CHGBD210
|
|
01184 *S910-READ. CHGBD210
|
|
01185 ** SET L910-READ-88 TO TRUE. CHGBD210
|
|
01186 ** GO TO S910-MSTR-IO. CHGBD210
|
|
01187 ** CHGBD210
|
|
01188 S910-CLOSE. CHGBD210
|
|
01189 SET L910-CLOSE-88 TO TRUE. CHGBD210
|
|
01190 GO TO S910-MSTR-IO. CHGBD210
|
|
01191 CHGBD210
|
|
01192 S910-MSTR-IO. CHGBD210
|
|
01193 CALL 'DTSBU910' USING L910-LINK-AREA CHGBD210
|
|
01194 MSKL-REC. CHGBD210
|
|
01195 CHGBD210
|
|
01196 S910-EXIT. CHGBD210
|
|
01197 EXIT. CHGBD210
|
|
01198 CHGBD210
|
|
01199 S921-OPEN-READ. CHGBD210
|
|
01200 SET L921-OPEN-READ-88 TO TRUE. CHGBD210
|
|
01201 GO TO S921-AIX-IO. CHGBD210
|
|
01202 CHGBD210
|
|
01203 S921-CLOSE. CHGBD210
|
|
01204 SET L921-CLOSE-88 TO TRUE. CHGBD210
|
|
01205 GO TO S921-AIX-IO. CHGBD210
|
|
01206 CHGBD210
|
|
01207 S921-AIX-IO. CHGBD210
|
|
01208 CALL 'DTSBU921' USING L921-LINK-AREA CHGBD210
|
|
01209 ISKL-REC. CHGBD210
|
|
01210 CHGBD210
|
|
01211 S921-EXIT. CHGBD210
|
|
01212 EXIT. CHGBD210
|
|
01213 CHGBD210
|
|
01214 ** REPORT RECORD I-O CHGBD210
|
|
01215 S946-RPT-REC-O. CHGBD210
|
|
01216 CALL 'DTSBU946' USING RSKL-REC. CHGBD210
|
|
01217 CHGBD210
|
|
01218 S946-EXIT. CHGBD210
|
|
01219 EXIT. CHGBD210
|
|
01220 CHGBD210
|
|
01221 T0000-TERMINATE. CHGBD210
|
|
01222 IF CHG3-RUN-TYPE-EMP-88 CHGBD210
|
|
01223 IF CHG3-RUN-TYPE-MON-EMP-88 CHGBD210
|
|
01224 IF CHG3-RUN-TYPE-WK-EMP-88 CHGBD210
|
|
01225 IF WRK-BD210-WRITE = ZERO CHGBD210
|
|
01226 PERFORM T1000-WRITE-DUMMY THRU T1000-EXIT CHGBD210
|
|
01227 END-IF CHGBD210
|
|
01228 END-IF. CHGBD210
|
|
01229 CHGBD210
|
|
01230 CLOSE BD205-CHG-FILE-IN CHGBD210
|
|
01231 BD210-CHG-FILE-OUT CHGBD210
|
|
01232 DC-WAGE-FILE. CHGBD210
|
|
01233 CHGBD210
|
|
01234 PERFORM S910-CLOSE THRU S910-EXIT. CHGBD210
|
|
01235 CHGBD210
|
|
01236 PERFORM S921-CLOSE THRU S921-EXIT. CHGBD210
|
|
01237 CHGBD210
|
|
01238 DISPLAY '***********************************************'. CHGBD210
|
|
01239 DISPLAY '*** CHGBD210 COUNTS *** '. CHGBD210
|
|
01240 DISPLAY '***'. CHGBD210
|
|
01241 CHGBD210
|
|
01242 DISPLAY ' CHGBD210 CHARGE RECORD READ: ' CHGBD210
|
|
01243 WRK-BD205-CHG-READ. CHGBD210
|
|
01244 CHGBD210
|
|
01245 DISPLAY ' CHGBD210 CHARGE RECORDS WRITTEN: ' CHGBD210
|
|
01246 WRK-BD210-WRITE. CHGBD210
|
|
01247 CHGBD210
|
|
01248 DISPLAY ' CHGBD210 CHARGE RECORDS BYPASSED: ' CHGBD210
|
|
01249 WRK-BD205-CHG-DELETE. CHGBD210
|
|
01250 CHGBD210
|
|
01251 DISPLAY ' CHGBD210 CHARGE REC NOT SELECTED: ' CHGBD210
|
|
01252 WRK-BD205-NOT-SELECTED. CHGBD210
|
|
01253 CHGBD210
|
|
01254 DISPLAY SPACE. CHGBD210
|
|
01255 CHGBD210
|
|
01256 DISPLAY ' CHGBD210 NOT LIABLE RECORDS PASSED: ' CHGBD210
|
|
01257 WRK-BD205-NOT-LIAB-CNT. CHGBD210
|
|
01258 CHGBD210
|
|
01259 DISPLAY SPACE. CHGBD210
|
|
01260 CHGBD210
|
|
01261 DISPLAY ' DC GOV CHARGE RECORDS FOUND : ' CHGBD210
|
|
01262 WRK-DC-GOV-INPUT-CNT. CHGBD210
|
|
01263 CHGBD210
|
|
01264 DISPLAY ' DC GOV DEFAULT ACCT USED : ' CHGBD210
|
|
01265 WRK-DC-DEFAULT-CNT. CHGBD210
|
|
01266 CHGBD210
|
|
01267 DISPLAY ' DC GOV AGENCY RECORDS WRITTEN : ' CHGBD210
|
|
01268 WRK-DC-WRITE-CNT. CHGBD210
|
|
01269 CHGBD210
|
|
01270 MOVE WRK-TOT-CHG TO WRK-TOT-CHG-DISP. CHGBD210
|
|
01271 DISPLAY SPACE. CHGBD210
|
|
01272 DISPLAY 'CHGBD210 TOT CHG ' WRK-TOT-CHG-DISP. CHGBD210
|
|
01273 DISPLAY '***********************************************'. CHGBD210
|
|
01274 CHGBD210
|
|
01275 T0000-EXIT. CHGBD210
|
|
01276 EXIT. CHGBD210
|
|
01277 CHGBD210
|
|
01278 T1000-WRITE-DUMMY. CHGBD210
|
|
01279 CHGBD210
|
|
01280 INITIALIZE BD210-CHG-REC. CHGBD210
|
|
01281 SET CHG4-RPT-TYPE-NULL-88 TO TRUE. CHGBD210
|
|
01282 MOVE CHG3-EMP-NO TO CHG4-EMP-NO. CHGBD210
|
|
01283 CHGBD210
|
|
01284 WRITE BD210-CHG-REC. CHGBD210
|
|
01285 ADD 1 TO WRK-BD210-WRITE. CHGBD210
|
|
01286 CHGBD210
|
|
01287 T1000-EXIT. CHGBD210
|
|
01288 EXIT. CHGBD210
|
|
01289 CHGBD210
|
|
01290 S999-ABEND. CHGBD210
|
|
01291 DISPLAY '**** CHGBD210 ABENDING ' CHGBD210
|
|
01292 ABEND-MSG. CHGBD210
|
|
01293 CALL ABEND-MOD USING ABEND-CODE. CHGBD210
|
|
01294 CHGBD210
|
|
01295 S999-EXIT. CHGBD210
|
|
01296 EXIT. CHGBD210
|
|
01297 CHGBD210
|