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