000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.      HHCAL015.                                       00020003
000300*AUTHOR.          DAVE PANUSKA                                    00030000
000400*REMARKS.         (HEALTH CARE FINANCING ADMINISTRATION)          00040000
000500*REMARKS. A). NATIONAL HHA PRICER                                 00050000
000600***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2000            00060000
000700***       C). HHA PRICER REFERS TO A PROGRAM WHICH WILL           00070000
000800***           CALCULATE THE HRG'S,REVENUE CODES AND               00080000
000900***           TYPE OF BILLS.                                      00090000
001000*REMARKS.                                                         00100000
001100*     HHCAL010   NATIONAL HHA FOR OCT 1, 2000                     00110000
001200*     HHCAL012   NEW RATE EFFECTIVE APR 1, 2001                   00120002
001300*     HHCAL013   CORRECT CALCULATIONS FOR PEP ADJUSTMENTS         00130002
001400*     HHCAL014 EXPAND BILLING RECORD TO 500 BYTES - BEATA VERSION 00131010
001500*     HHCAL015 INCREASE PROV-PAYMET-TOTAL TO  PIC 9(09)V9(02)     00132010
001600******************************************************************00140000
001700******************************************************************00150000
001800******************************************************************00160000
001900*            RETURN CODE VALUES (HHA-RTC)                         00170000
002000*                                                                 00180000
002100*        HHA-RTC  WITH PAYMENTS RETURNED                          00190000
002200*                                                                 00200000
002300*     RETURN CODES                                                00210000
002400*          00 = FINAL PAYMENT                                     00220000
002500*               TOB = 329,339,327,337                             00230000
002600*                  OR 32G OR 33G OR 32I OR 33I                    00240000
002700*                  OR 32J OR 33J OR 32M OR 33M                    00250000
002800*                  OR 32F OR 32K OR 32P OR 32H                    00260000
002900*                  OR 33F OR 33K OR 33P OR 33H                    00270000
003000*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00280000
003100*          01 = FINAL PAYMENT                                     00290000
003200*               TOB = 329,339,327,337                             00300000
003300*                  OR 32G OR 33G OR 32I OR 33I                    00310000
003400*                  OR 32J OR 33J OR 32M OR 33M                    00320000
003500*                  OR 32F OR 32K OR 32P OR 32H                    00330000
003600*                  OR 33F OR 33K OR 33P OR 33H                    00340000
003700*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00350000
003800*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00360000
003900*               TOB = 332 AND 322                                 00370000
004000*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00380000
004100*               TOB = 332 AND 322                                 00390000
004200*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00400000
004300*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00410000
004400*               TOB = 332 AND 322                                 00420000
004500*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00430000
004600*          06 = LUPA PAYMENT ONLY                                 00440000
004700*               TOB = 329,339,327,337                             00450000
004800*                  OR 32G OR 33G OR 32I OR 33I                    00460000
004900*                  OR 32J OR 33J OR 32M OR 33M                    00470000
005000*                  OR 32F OR 32K OR 32P OR 32H                    00480000
005100*                  OR 33F OR 33K OR 33P OR 33H                    00490000
005200*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00500000
005300*                                                             *   00510000
005400*            HHA-RTC   NO PAYMENTS RETURNED                   *   00520000
005500*                                                             *   00530000
005600*              10 = INVALID TOB                               *   00540000
005700*                                                             *   00550000
005800*              15 = INVALID PEP DAYS                          *   00560000
005900*                   FOR SHORTENED EPISODE                     *   00570000
006000*                                                             *   00580000
006100*              20 = INVALID PEP INDICATOR                     *   00590000
006200*                                                             *   00600000
006300*              25 = INVALID MED REVIEW INDICATOR              *   00610000
006400*                                                             *   00620000
006500*              30 = INVALID MSA CODE                          *   00630000
006600*                                                             *   00640000
006700*              35 = INVALID INITIAL PAYMENT INDICATOR         *   00650000
006800*                        0 = MAKE NORMAL INITIAL PAYMENT      *   00660000
006900*                        1 = MAKE ZERO PAYMANT                *   00670000
007000*                                                             *   00680000
007100*              40 = FROM DATE  < OCT 1, 2000 OR INVALID       *   00690000
007200*                   THRU DATE  < OCT 1, 2000 OR INVALID       *   00700000
007300*                   ADMIT DATE < OCT 1, 2000 OR INVALID       *   00710000
007400*                                                             *   00720000
007500*              70 = INVALID OR NO HRG CODE PRESENT            *   00730000
007600*                                                             *   00740000
007700*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   00750000
007800*                   REVENUE-QTY-COV-VISITS > 4  AND           *   00760000
007900*                       TOB = 329,339,327,337                 *   00770000
008000*                          OR 32G OR 33G OR 32I OR 33I        *   00780000
008100*                          OR 32J OR 33J OR 32M OR 33M        *   00790000
008200*                          OR 32F OR 32K OR 32P OR 32H            00800000
008300*                          OR 33F OR 33K OR 33P OR 33H            00810000
008400*                                                             *   00820000
008500*              80 = INVALID REVENUE CODE                      *   00830000
008600*                                                             *   00840000
008700*              85 = NO REVENUE CODE PRESENT                   *   00850000
008800*                   WITH TOB 329 OR 339 OR 327 OR 337         *   00860000
008900*                         OR 32G OR 33G OR 32I OR 33I         *   00870000
009000*                         OR 32J OR 33J OR 32M OR 33M         *   00880000
009100*                         OR 32F OR 32K OR 32P OR 32H             00890000
009200*                         OR 33F OR 33K OR 33P OR 33H             00900000
009300*                                                             *   00910000
009400***************************************************************   00920000
009500***************************************************************   00930000
009600***************************************************************   00940000
009700 DATE-COMPILED.                                                   00950000
009800 ENVIRONMENT DIVISION.                                            00960000
009900 CONFIGURATION SECTION.                                           00970000
010000 SOURCE-COMPUTER.            IBM-370.                             00980000
010100 OBJECT-COMPUTER.            IBM-370.                             00990000
010200 INPUT-OUTPUT  SECTION.                                           01000000
010300 FILE-CONTROL.                                                    01010000
010400                                                                  01020000
010500 DATA DIVISION.                                                   01030000
010600 FILE SECTION.                                                    01040000
010700                                                                  01050000
010800 WORKING-STORAGE SECTION.                                         01060000
010900 01  W-STORAGE-REF                  PIC X(46)  VALUE              01070000
011000     'HHCAL015      - W O R K I N G   S T O R A G E'.             01080003
011100 01  CAL-VERSION                    PIC X(07)  VALUE 'C2001.4'.   01090003
011200 01  CO1                            PIC S9(04) COMP SYNC.         01100000
011300 01  SUB1                           PIC S9(04) COMP SYNC.         01110000
011400 01  R1                             PIC S9(04) COMP SYNC.         01120000
011500 01  R2                             PIC S9(04) COMP SYNC.         01130000
011600 01  R3                             PIC S9(04) COMP SYNC.         01140000
011700                                                                  01150000
011800 01  LABOR-NLABOR-PERCENT.                                        01160000
011900     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.77668.          01170000
012000     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.22332.          01180000
012100                                                                  01190000
012200 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01200000
012300 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01210000
012400***************************************************************** 01220000
012500***    EXAMPLE    *********************************************** 01230000
012600*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01240000
012700******  2115.30 TIMES 1.13  = 2390.29  ROUNDED UP  ************** 01250000
012800***************************************************************** 01260000
012900 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01270000
013000                                                                  01280000
013100 01  WK-HRG-NO-OF-DAYS            PIC S9(03)V9(07) VALUE 0.       01290000
013200 01  WK-PEP-DAYS                  PIC S9(03)V9(07) VALUE 0.       01300000
013300                                                                  01310000
013400 01  WK-ALL-TOTALS.                                               01320000
013500     05  FED-ADJ                        PIC S9(07)V9(02).         01330000
013600     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01340000
013700     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01350000
013800     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01360000
013900     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01370000
014000     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01380000
014100     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01390000
014200     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01400000
014300     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01410000
014400     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01420000
014500     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01430000
014600     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01440000
014700     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01450000
014800     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01460000
014900     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               01470000
015000     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         01480000
015100     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         01490000
015200     05  WK-7000-CALC                   PIC S9(07)V9(02).         01500000
015300     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         01510000
015400     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         01520000
015500                                                                  01530000
015600                                                                  01540000
015700                                                                  01550000
015800*******************************************************           01560000
015900 01  HOLD-HHA-DATA.                                               01570000
016000     05  H-HHA-INPUT-DATA.                                        01580000
016100         10  H-HHA-NPI                 PIC X(10).                 01590000
016200         10  H-HHA-HIC                 PIC X(12).                 01600000
016300         10  H-HHA-PROV-NO             PIC X(06).                 01610000
016400         10  H-HHA-TOB                 PIC XXX.                   01620000
016500         10  H-HHA-PEP-INDICATOR       PIC X.                     01630000
016600         10  H-HHA-PEP-DAYS            PIC 999.                   01640000
016700         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     01650000
016800         10  FILLER                    PIC X(07).                 01660000
016900         10  H-HHA-MSA1                PIC 9(07)V9(02).           01670000
017000         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                01680000
017100             15  FILLER             PIC XXX.                      01690000
017200             15  H-HHA-MSA2           PIC XXXX.                   01700000
017300             15  FILLER             PIC XX.                       01710000
017400         10  H-HHA-SERV-FROM-DATE.                                01720000
017500             15  H-HHA-FROM-CC         PIC XX.                    01730000
017600             15  H-HHA-FROM-YYMMDD.                               01740000
017700                 25  H-HHA-FROM-YY     PIC XX.                    01750000
017800                 25  H-HHA-FROM-MM     PIC XX.                    01760000
017900                 25  H-HHA-FROM-DD     PIC XX.                    01770000
018000         10  H-HHA-SERV-THRU-DATE.                                01780000
018100             15  H-HHA-THRU-CC         PIC XX.                    01790000
018200             15  H-HHA-THRU-YYMMDD.                               01800000
018300                 25  H-HHA-THRU-YY     PIC XX.                    01810000
018400                 25  H-HHA-THRU-MM     PIC XX.                    01820000
018500                 25  H-HHA-THRU-DD     PIC XX.                    01830000
018600         10  H-HHA-ADMIT-DATE.                                    01840000
018700             15  H-HHA-ADMIT-CC        PIC XX.                    01850000
018800             15  H-HHA-ADMIT-YYMMDD.                              01860000
018900                 25  H-HHA-ADMIT-YY    PIC XX.                    01870000
019000                 25  H-HHA-ADMIT-MM    PIC XX.                    01880000
019100                 25  H-HHA-ADMIT-DD    PIC XX.                    01890000
019200         10  H-HHA-HRG-DATA      OCCURS 6.                        01900000
019300             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                01910000
019400             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            01920000
019500             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            01930000
019600             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            01940000
019700             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      01950000
019800             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      01960000
019900         10  H-HHA-REVENUE-DATA     OCCURS 6.                     01970000
020000             15  H-HHA-REVENUE-CODE       PIC X(04).              01980000
020100             15  H-HHA-REVENUE-QTY-COV-VISITS PIC 9(03).          01990000
020200             15  H-HHA-REVENUE-DOLL-RATE  PIC 9(07)V9(02).        02000000
020300             15  H-HHA-REVENUE-COST       PIC 9(07)V9(02).        02010000
020400     05  H-HHA-PASSBACK-DATA.                                     02020000
020500         10  H-HHA-PAY-RTC                PIC 99.                 02030000
020600         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02040000
020700         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02050000
020800         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02060000
020900         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02070000
021000     05  H-HHA-CASE-MIX-DATA.                                     02071006
021100         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02072006
021200         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02073006
021300         10  H-HHA-RECODE-IND             PIC X.                  02074006
021400         10  H-HHA-EPISODE-TIMING         PIC 9.                  02075006
021500         10  H-HHA-SEVERITY-POINTS.                               02076006
021600             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02077006
021700             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02078006
021800             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02079006
021900             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02079106
022000             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02079206
022100             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02079306
022200             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02079406
022300             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02079506
022400     05  H-HHA-PROV-TOTAL-DATA.                                   02079606
022500         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        02079706
022600         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        02079808
022700     05  FILLER                           PIC X(33).              02079908
022800**==================================================***           02080006
022900                                                                  02090000
023000***************************************************************   02100000
023100                                                                  02110000
023200 LINKAGE SECTION.                                                 02120000
023300***************************************************************   02130000
023400*                 * * * * * * * * *                           *   02140000
023500***************************************************************   02150000
023600***************************************************************   02160000
023700*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02170000
023800*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02180000
023900***************************************************************   02190000
024000 01  HHA-INPUT-DATA.                                              02200000
024100     05  HHA-DATA.                                                02210000
024200         10  HHA-NPI                 PIC X(10).                   02220000
024300         10  HHA-HIC                 PIC X(12).                   02230000
024400         10  HHA-PROV-NO             PIC X(06).                   02240000
024500         10  HHA-TOB                 PIC XXX.                     02250000
024600         10  HHA-PEP-INDICATOR       PIC X.                       02260000
024700         10  HHA-PEP-DAYS            PIC 999.                     02270000
024800         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02280000
024900         10  FILLER                  PIC X(07).                   02290000
025000         10  HHA-MSA1                PIC 9(07)V9(02).             02300000
025100         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02310000
025200             15  FILLER             PIC XXX.                      02320000
025300             15  HHA-MSA2.                                        02330000
025400                 25  HHA-MSA2-RURAL-1ST.                          02340000
025500                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02350000
025600                     30  HHA-RURAL-MSA         PIC XX.            02360000
025700                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02370000
025800             15  FILLER             PIC XX.                       02380000
025900         10  HHA-SERV-FROM-DATE.                                  02390000
026000             15  HHA-FROM-CC         PIC XX.                      02400000
026100             15  HHA-FROM-YYMMDD.                                 02410000
026200                 25  HHA-FROM-YY     PIC XX.                      02420000
026300                 25  HHA-FROM-MM     PIC XX.                      02430000
026400                 25  HHA-FROM-DD     PIC XX.                      02440000
026500         10  HHA-SERV-THRU-DATE.                                  02450000
026600             15  HHA-THRU-CC         PIC XX.                      02460000
026700             15  HHA-THRU-YYMMDD.                                 02470000
026800                 25  HHA-THRU-YY     PIC XX.                      02480000
026900                 25  HHA-THRU-MM     PIC XX.                      02490000
027000                 25  HHA-THRU-DD     PIC XX.                      02500000
027100         10  HHA-ADMIT-DATE.                                      02510000
027200             15  HHA-ADMIT-CC        PIC XX.                      02520000
027300             15  HHA-ADMIT-YYMMDD.                                02530000
027400                 25  HHA-ADMIT-YY    PIC XX.                      02540000
027500                 25  HHA-ADMIT-MM    PIC XX.                      02550000
027600                 25  HHA-ADMIT-DD    PIC XX.                      02560000
027700         10  HHA-HRG-DATA      OCCURS 6.                          02570000
027800             15  HHA-MED-REVIEW-INDICATOR PIC X.                  02580000
027900             15  HHA-HRG-INPUT-CODE       PIC X(05).              02590000
028000             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              02600000
028100             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              02610000
028200             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        02620000
028300             15  HHA-HRG-PAY              PIC 9(07)V9(02).        02630000
028400         10  HHA-REVENUE-DATA     OCCURS 6.                       02640000
028500             15  HHA-REVENUE-CODE       PIC X(04).                02650000
028600             15  HHA-REVENUE-QTY-COV-VISITS PIC 9(03).            02660000
028700             15  HHA-REVENUE-DOLL-RATE  PIC 9(07)V9(02).          02670000
028800             15  HHA-REVENUE-COST       PIC 9(07)V9(02).          02680000
028900     05  HHA-PASSBACK-DATA.                                       02690000
029000         10  HHA-PAY-RTC                PIC 99.                   02700000
029100         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                02710000
029200         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                02720000
029300         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          02730000
029400         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          02740000
029500     05  HHA-CASE-MIX-DATA.                                       02741006
029600         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).          02742006
029700         10  HHA-LUPA-SRC-ADM           PIC X.                    02743006
029800         10  HHA-RECODE-IND             PIC X.                    02744006
029900         10  HHA-EPISODE-TIMING         PIC 9.                    02745006
030000         10  HHA-SEVERITY-POINTS.                                 02746006
030100             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).                02747006
030200             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).                02748006
030300             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).                02749006
030400             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).                02749106
030500             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).                02749206
030600             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).                02749306
030700             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).                02749406
030800             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).                02749506
030900     05  HHA-PROV-TOTAL-DATA.                                     02749606
031000         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          02749706
031100         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          02749808
031200     05  FILLER                         PIC X(33).                02749908
031300**==================================================***           02750006
031400*    05  FILLER                         PIC X(20).                02751006
031500**==================================================***           02752006
031600                                                                  02760000
031700 01  HOLD-VARIABLES-DATA.                                         02770000
031800     02  HOLD-VAR-DATA.                                           02780000
031900         05  PRICER-OPTION-SW                   PIC X(01).        02790000
032000         05  HHDRV-VERSION                      PIC X(07).        02800000
032100         05  HHCAL-VERSION                      PIC X(07).        02810000
032200         05  FILLER                             PIC X(20).        02820000
032300                                                                  02830000
032400 01  WAGE-INDEX-DATA.                                             02840000
032500     02  HOLD-WIR-DATA.                                           02850000
032600         05  WIR-MSA                        PIC X(04).            02860000
032700         05  WIR-EFFDATE                    PIC X(08).            02870000
032800         05  WIR-AREA-WAGEIND               PIC 9(02)V9(04).      02880000
032900                                                                  02890000
033000 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         02900000
033100                           HOLD-VARIABLES-DATA                    02910000
033200                           WAGE-INDEX-DATA.                       02920000
033300                                                                  02930000
033400***************************************************************   02940000
033500*    PROCESSING:                                              *   02950000
033600*        A. WILL PROCESS NATIONAL HHA FOR FY 2001             *   02960000
033700*                STARTING OCT 1, 2000                         *   02970000
033800***************************************************************   02980000
033900                                                                  02990000
034000     MOVE CAL-VERSION TO HHCAL-VERSION.                           03000000
034100                                                                  03010000
034200     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03020000
034300                                                                  03030000
034400     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03040000
034500                                                                  03050000
034600     GOBACK.                                                      03060000
034700                                                                  03070000
034800 200-MAINLINE-CONTROL.                                            03080000
034900                                                                  03090000
035000     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03100000
035100                                                                  03110000
035200     MOVE ALL '0' TO                                              03120000
035300                     WK-ALL-TOTALS                                03130000
035400                     WK-HRG-NO-OF-DAYS                            03140000
035500                     WK-PEP-DAYS                                  03150000
035600                     H-HHA-PASSBACK-DATA                          03160000
035700                     H-HHA-HRG-PAY (1)                            03170000
035800                     H-HHA-HRG-PAY (2)                            03180000
035900                     H-HHA-HRG-PAY (3)                            03190000
036000                     H-HHA-HRG-PAY (4)                            03200000
036100                     H-HHA-HRG-PAY (5)                            03210000
036200                     H-HHA-HRG-PAY (6)                            03220000
036300                     H-HHA-REVENUE-COST (1)                       03230000
036400                     H-HHA-REVENUE-COST (2)                       03240000
036500                     H-HHA-REVENUE-COST (3)                       03250000
036600                     H-HHA-REVENUE-COST (4)                       03260000
036700                     H-HHA-REVENUE-COST (5)                       03270000
036800                     H-HHA-REVENUE-COST (6).                      03280000
036900                                                                  03290000
037000     IF  H-HHA-PAY-RTC = 00                                       03300000
037100         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  03310000
037200                                                                  03320000
037300 200-EXIT.   EXIT.                                                03330000
037400                                                                  03340000
037500 400-CALC-THE-HHA.                                                03350000
037600                                                                  03360000
037700     IF H-HHA-SERV-FROM-DATE < 20001001 OR                        03370000
037800        H-HHA-SERV-THRU-DATE < 20001001 OR                        03380000
037900        H-HHA-ADMIT-DATE < 20001001                               03390000
038000         MOVE '40' TO H-HHA-PAY-RTC                               03400000
038100         GO TO 400-EXIT.                                          03410000
038200                                                                  03420000
038300     IF H-HHA-ADMIT-DATE >                                        03430000
038400        H-HHA-SERV-FROM-DATE                                      03440000
038500         MOVE '40' TO H-HHA-PAY-RTC                               03450000
038600         GO TO 400-EXIT.                                          03460000
038700                                                                  03470000
038800     IF ((H-HHA-TOB = '332' OR '322') AND                         03480000
038900        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       03490000
039000        MOVE '70' TO H-HHA-PAY-RTC                                03500000
039100        GO TO 400-EXIT.                                           03510000
039200                                                                  03520000
039300     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         03530000
039400                      '32G' OR '33G' OR '32I' OR '33I' OR         03540000
039500                      '32F' OR '32K' OR '32P' OR '32H' OR         03550000
039600                      '33F' OR '33K' OR '33P' OR '33H' OR         03560000
039700                      '32J' OR '33J' OR '32M' OR '33M') AND       03570000
039800         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  03580000
039900         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      03590000
040000        MOVE '75' TO H-HHA-PAY-RTC                                03600000
040100        GO TO 400-EXIT.                                           03610000
040200                                                                  03620000
040300     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         03630000
040400                      '32G' OR '33G' OR '32I' OR '33I' OR         03640000
040500                      '32F' OR '32K' OR '32P' OR '32H' OR         03650000
040600                      '33F' OR '33K' OR '33P' OR '33H' OR         03660000
040700                      '32J' OR '33J' OR '32M' OR '33M') AND       03670000
040800         (H-HHA-REVENUE-CODE (1) = SPACE))                        03680000
040900        MOVE '85' TO H-HHA-PAY-RTC                                03690000
041000        GO TO 400-EXIT.                                           03700000
041100                                                                  03710000
041200     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         03720000
041300                      '32G' OR '33G' OR '32I' OR '33I' OR         03730000
041400                      '32F' OR '32K' OR '32P' OR '32H' OR         03740000
041500                      '33F' OR '33K' OR '33P' OR '33H' OR         03750000
041600                      '32J' OR '33J' OR '32M' OR '33M') AND       03760000
041700         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              03770000
041800         (H-HHA-PEP-INDICATOR = 'Y') AND                          03780000
041900         (H-HHA-PEP-DAYS NOT NUMERIC OR                           03790000
042000          H-HHA-PEP-DAYS = ZEROES))                               03800000
042100        MOVE '15' TO H-HHA-PAY-RTC                                03810000
042200        GO TO 400-EXIT.                                           03820000
042300                                                                  03830000
042400     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    03840000
042500                                                                  03850000
042600***************************************************************   03860000
042700*    EFFECTIVE OCT 1, 2000                                    *   03870000
042800*        THESE RATES & THRESHOLDS ARE APPLIED                 *   03880000
042900***************************************************************   03890000
043000     MOVE 02115.30 TO   FED-EPISODE-RATE-AMT                      03900000
043100     MOVE 02390.29 TO   OUTLIER-THRESHOLD-AMT.                    03910000
043200***************************************************************   03920000
043300*    EFFECTIVE APR 1, 2001                                    *   03930000
043400* FOR NON-RURAL --   THESE RATES & THRESHOLDS ARE APPLIED     *   03940000
043500***************************************************************   03950000
043600     IF H-HHA-SERV-THRU-DATE > 20010331                           03960000
043700        MOVE 02161.84 TO   FED-EPISODE-RATE-AMT                   03970000
043800        MOVE 02442.88 TO   OUTLIER-THRESHOLD-AMT.                 03980000
043900***************************************************************   03990000
044000*    EFFECTIVE APR 1, 2001                                    *   04000000
044100* FOR RURAL  -- THESE RATES & THRESHOLDS ARE APPLIED          *   04010000
044200***************************************************************   04020000
044300     IF H-HHA-SERV-THRU-DATE > 20010331 AND                       04030000
044400        HHA-MSA-RURAL-CHECK                                       04040000
044500           MOVE 02378.02 TO   FED-EPISODE-RATE-AMT                04050000
044600           MOVE 02687.16 TO   OUTLIER-THRESHOLD-AMT.              04060000
044700***************************************************************   04070000
044800                                                                  04080000
044900     IF H-HHA-TOB = '322' OR '332'                                04090000
045000        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04100000
045100        GO TO 400-EXIT.                                           04110000
045200                                                                  04120000
045300     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04130000
045400                    '32G' OR '33G' OR '32I' OR '33I' OR           04140000
045500                    '32F' OR '32K' OR '32P' OR '32H' OR           04150000
045600                    '33F' OR '33K' OR '33P' OR '33H' OR           04160000
045700                    '32J' OR '33J' OR '32M' OR '33M'              04170000
045800        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04180000
045900        GO TO 400-EXIT.                                           04190000
046000                                                                  04200000
046100     MOVE '10' TO H-HHA-PAY-RTC.                                  04210000
046200                                                                  04220000
046300                                                                  04230000
046400 400-EXIT.   EXIT.                                                04240000
046500                                                                  04250000
046600 500-INITIAL-PAYMENT.                                             04260000
046700                                                                  04270000
046800***************************************************************   04280000
046900*            TOB = 322 OR 332 INITIAL PAYMENT                     04290000
047000***************************************************************   04300000
047100                                                                  04310000
047200     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '0'                   04320000
047300         NEXT SENTENCE                                            04330000
047400     ELSE                                                         04340000
047500         MOVE '35' TO H-HHA-PAY-RTC                               04350000
047600         GO TO 500-EXIT.                                          04360000
047700                                                                  04370000
047800     IF  H-HHA-INIT-PAY-INDICATOR  = '1'                          04380000
047900         MOVE '03' TO H-HHA-PAY-RTC                               04390000
048000         GO TO 500-EXIT.                                          04400000
048100                                                                  04410000
048200     COMPUTE FED-ADJ ROUNDED =                                    04420000
048300               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04430000
048400                                                                  04440000
048500     COMPUTE FED-LABOR-ADJ ROUNDED =                              04450000
048600             WIR-AREA-WAGEIND *                                   04460000
048700             LABOR-PERCENT *                                      04470000
048800             FED-ADJ.                                             04480000
048900                                                                  04490000
049000     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          04500000
049100               NONLABOR-PERCENT * FED-ADJ.                        04510000
049200                                                                  04520000
049300     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   04530000
049400        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     04540000
049500                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .6         04550000
049600        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             04560000
049700        MOVE '05' TO H-HHA-PAY-RTC                                04570000
049800     ELSE                                                         04580000
049900        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     04590000
050000                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .5         04600000
050100        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             04610000
050200        MOVE '04' TO H-HHA-PAY-RTC.                               04620000
050300                                                                  04630000
050400 500-EXIT.   EXIT.                                                04640000
050500                                                                  04650000
050600 1000-FINAL-PAYMENT.                                              04660000
050700                                                                  04670000
050800     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              04680000
050900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          04690000
051000     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              04700000
051100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          04710000
051200     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              04720000
051300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          04730000
051400     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              04740000
051500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          04750000
051600     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              04760000
051700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          04770000
051800     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              04780000
051900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          04790000
052000                                                                  04800000
052100     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               04810000
052200             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   04820000
052300             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   04830000
052400             H-HHA-REVENUE-QTY-COV-VISITS (3).                    04840000
052500     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               04850000
052600             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   04860000
052700             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   04870000
052800             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   04880000
052900             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   04890000
053000             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   04900000
053100             H-HHA-REVENUE-QTY-COV-VISITS (6).                    04910000
053200                                                                  04920000
053300     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          04930000
053400        PERFORM 1050-LUPA THRU 1050-EXIT                          04940000
053500            VARYING SUB1 FROM 1 BY 1 UNTIL                        04950000
053600***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                04960000
053700             SUB1 > 6                                             04970000
053800        MOVE '06' TO H-HHA-PAY-RTC                                04980000
053900        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   04990000
054000                H-HHA-REVENUE-COST (1) +                          05000000
054100                H-HHA-REVENUE-COST (2) +                          05010000
054200                H-HHA-REVENUE-COST (3) +                          05020000
054300                H-HHA-REVENUE-COST (4) +                          05030000
054400                H-HHA-REVENUE-COST (5) +                          05040000
054500                H-HHA-REVENUE-COST (6)                            05050000
054600        GO TO 1000-EXIT.                                          05060000
054700                                                                  05070000
054800     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05080000
054900         MOVE '20' TO H-HHA-PAY-RTC                               05090000
055000         GO TO 1000-EXIT.                                         05100000
055100                                                                  05110000
055200*********  HRG  PAYMENT   *******************                     05120000
055300                                                                  05130000
055400***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05140000
055500        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05150000
055600           IF H-HHA-PEP-INDICATOR = 'N'                           05160000
055700              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05170000
055800                  VARYING CO1 FROM 1 BY 1 UNTIL                   05180000
055900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05190000
056000                   CO1 > 6                                        05200000
056100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05210000
056200               GO TO 1000-EXIT.                                   05220000
056300                                                                  05230000
056400                                                                  05240000
056500***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05250000
056600        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05260000
056700           IF H-HHA-PEP-INDICATOR = 'Y'                           05270000
056800              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            05280000
056900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05290000
057000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05300000
057100                   CO1 > 6                                        05310000
057200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05320000
057300               GO TO 1000-EXIT.                                   05330000
057400                                                                  05340000
057500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05350000
057600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05360000
057700           IF H-HHA-PEP-INDICATOR = 'N'                           05370000
057800              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            05380000
057900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05390000
058000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05400000
058100                   CO1 > 6                                        05410000
058200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05420000
058300               GO TO 1000-EXIT.                                   05430000
058400                                                                  05440000
058500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05450000
058600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05460000
058700           IF H-HHA-PEP-INDICATOR = 'Y'                           05470000
058800              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            05480000
058900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05490000
059000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05500000
059100                   CO1 > 6                                        05510000
059200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05520000
059300               GO TO 1000-EXIT.                                   05530000
059400                                                                  05540000
059500                                                                  05550000
059600      MOVE '20' TO H-HHA-PAY-RTC.                                 05560000
059700                                                                  05570000
059800 1000-EXIT.  EXIT.                                                05580000
059900 1050-LUPA.                                                       05590000
060000                                                                  05600000
060100***************************************************************   05610000
060200*                    LUPA PAYMENT                                 05620000
060300***************************************************************   05630000
060400                                                                  05640000
060500     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        05650000
060600        MOVE 6 TO SUB1                                            05660000
060700        GO TO 1050-EXIT.                                          05670000
060800                                                                  05680000
060900     COMPUTE FED-ADJ ROUNDED =                                    05690000
061000             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                05700000
061100             H-HHA-REVENUE-DOLL-RATE (SUB1).                      05710000
061200                                                                  05720000
061300     COMPUTE FED-LABOR-ADJ ROUNDED =                              05730000
061400             WIR-AREA-WAGEIND *                                   05740000
061500             LABOR-PERCENT *                                      05750000
061600             FED-ADJ.                                             05760000
061700                                                                  05770000
061800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05780000
061900             NONLABOR-PERCENT *                                   05790000
062000             FED-ADJ.                                             05800000
062100                                                                  05810000
062200     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  05820000
062300             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 05830000
062400                                                                  05840000
062500 1050-EXIT.   EXIT.                                               05850000
062600                                                                  05860000
062700                                                                  05870000
062800 3000-PEP-N-ADJUST.                                               05880000
062900                                                                  05890000
063000***************************************************************   05900000
063100*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  05910000
063200***************************************************************   05920000
063300                                                                  05930000
063400     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       05940000
063500        MOVE 6 TO SUB1                                            05950000
063600        GO TO 3000-EXIT.                                          05960000
063700                                                                  05970000
063800     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        05980001
063900                                                                  05990000
064000     COMPUTE FED-ADJ ROUNDED =                                    06000000
064100               (WK-HRG-NO-OF-DAYS / 60) *                         06010000
064200               H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT.       06020000
064300                                                                  06030000
064400     COMPUTE FED-LABOR-ADJ ROUNDED =                              06040000
064500               WIR-AREA-WAGEIND *                                 06050000
064600               LABOR-PERCENT * FED-ADJ.                           06060000
064700                                                                  06070000
064800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06080000
064900               NONLABOR-PERCENT * FED-ADJ.                        06090000
065000                                                                  06100000
065100     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06110000
065200              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06120000
065300                                                                  06130000
065400     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06140000
065500             WK-3000-PEP-N-PAYMENT.                               06150000
065600                                                                  06160000
065700     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   06170000
065800             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    06180000
065900                                                                  06190000
066000                                                                  06200000
066100 3000-EXIT.   EXIT.                                               06210000
066200                                                                  06220000
066300 4000-PEP-Y-ADJUST.                                               06230000
066400                                                                  06240000
066500***************************************************************   06250000
066600*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  06260000
066700***************************************************************   06270000
066800                                                                  06280000
066900     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06290000
067000        MOVE 6 TO SUB1                                            06300000
067100        GO TO 4000-EXIT.                                          06310000
067200                                                                  06320000
067300     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06330001
067400                                                                  06340000
067500     COMPUTE FED-ADJ ROUNDED =                                    06350000
067600               (WK-HRG-NO-OF-DAYS / 60) *                         06360000
067700               H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT.       06370000
067800                                                                  06380000
067900     COMPUTE FED-LABOR-ADJ ROUNDED =                              06390000
068000               WIR-AREA-WAGEIND *                                 06400000
068100               LABOR-PERCENT * FED-ADJ.                           06410000
068200                                                                  06420000
068300     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06430000
068400               NONLABOR-PERCENT * FED-ADJ.                        06440000
068500                                                                  06450000
068600     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      06460000
068700              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06470000
068800                                                                  06480000
068900     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06490000
069000             WK-4000-PEP-Y-PAYMENT.                               06500000
069100                                                                  06510000
069200                                                                  06520000
069300     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   06530000
069400             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    06540000
069500                                                                  06550000
069600                                                                  06560000
069700                                                                  06570000
069800 4000-EXIT.   EXIT.                                               06580000
069900 5000-PEP-N-ADJUST.                                               06590000
070000                                                                  06600000
070100***************************************************************   06610000
070200*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  06620000
070300***************************************************************   06630000
070400                                                                  06640000
070500     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06650000
070600        MOVE 6 TO SUB1                                            06660000
070700        GO TO 5000-EXIT.                                          06670000
070800                                                                  06680000
070900     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06690001
071000                                                                  06700000
071100     COMPUTE FED-ADJ ROUNDED =                                    06710000
071200               (WK-HRG-NO-OF-DAYS / 60) *                         06720000
071300               H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT.       06730000
071400                                                                  06740000
071500     COMPUTE FED-LABOR-ADJ ROUNDED =                              06750000
071600               WIR-AREA-WAGEIND *                                 06760000
071700               LABOR-PERCENT * FED-ADJ.                           06770000
071800                                                                  06780000
071900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06790000
072000               NONLABOR-PERCENT * FED-ADJ.                        06800000
072100                                                                  06810000
072200     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      06820000
072300              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06830000
072400                                                                  06840000
072500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06850000
072600             WK-5000-PEP-N-PAYMENT.                               06860000
072700                                                                  06870000
072800                                                                  06880000
072900     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   06890000
073000             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    06900000
073100                                                                  06910000
073200                                                                  06920000
073300 5000-EXIT.   EXIT.                                               06930000
073400 6000-PEP-Y-ADJUST.                                               06940000
073500                                                                  06950000
073600***************************************************************   06960000
073700*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           06970000
073800***************************************************************   06980000
073900                                                                  06990000
074000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07000000
074100        MOVE 6 TO SUB1                                            07010000
074200        GO TO 6000-EXIT.                                          07020000
074300                                                                  07030000
074400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07040001
074500     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07050000
074600                                                                  07060000
074700     COMPUTE FED-ADJ ROUNDED =                                    07070000
074800         (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07080000
074900                                 *                                07090000
075000                     ((WK-PEP-DAYS / 60)                          07100000
075100                                 *                                07110000
075200           (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        07120000
075300                                                                  07130000
075400                                                                  07140000
075500     COMPUTE FED-LABOR-ADJ ROUNDED =                              07150000
075600               WIR-AREA-WAGEIND *                                 07160000
075700               LABOR-PERCENT * FED-ADJ.                           07170000
075800                                                                  07180000
075900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07190000
076000               NONLABOR-PERCENT * FED-ADJ.                        07200000
076100                                                                  07210000
076200     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      07220000
076300              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07230000
076400                                                                  07240000
076500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07250000
076600             WK-6000-PEP-Y-PAYMENT.                               07260000
076700                                                                  07270000
076800     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   07280000
076900             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    07290000
077000                                                                  07300000
077100                                                                  07310000
077200 6000-EXIT.   EXIT.                                               07320000
077300                                                                  07330000
077400 7000-OUTLIER-PAYMENT.                                            07340000
077500                                                                  07350000
077600***************************************************************   07360000
077700*                    OUTLIER PAYMENT                              07370000
077800***************************************************************   07380000
077900     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        07390000
078000               WIR-AREA-WAGEIND *                                 07400000
078100               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             07410000
078200                                                                  07420000
078300     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    07430000
078400               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          07440000
078500                                                                  07450000
078600     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         07460000
078700             (OUT-THRES-LABOR-ADJ +                               07470000
078800              OUT-THRES-NON-LABOR-ADJ).                           07480000
078900                                                                  07490000
079000      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   07500000
079100              OUT-THRES-AMT-ADJ +                                 07510000
079200             WK-3000-PEP-N-PRETOT-PAY +                           07520000
079300             WK-4000-PEP-Y-PRETOT-PAY +                           07530000
079400             WK-5000-PEP-N-PRETOT-PAY +                           07540000
079500             WK-6000-PEP-Y-PRETOT-PAY.                            07550000
079600                                                                  07560000
079700      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    07570000
079800                  VARYING CO1 FROM 1 BY 1 UNTIL                   07580000
079900                   CO1 > 6.                                       07590000
080000                                                                  07600000
080100      COMPUTE WK-7000-AB-DIFF ROUNDED =                           07610000
080200              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  07620000
080300                                                                  07630000
080400      IF WK-7000-AB-DIFF > ZERO                                   07640000
080500         COMPUTE WK-7000-CALC ROUNDED =                           07650000
080600               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     07660000
080700         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  07670000
080800               WK-7000-CALC                                       07680000
080900         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    07690000
081000                (WK-7000-CALC +                                   07700000
081100                 WK-3000-PEP-N-PRETOT-PAY +                       07710000
081200                 WK-4000-PEP-Y-PRETOT-PAY +                       07720000
081300                 WK-5000-PEP-N-PRETOT-PAY +                       07730000
081400                 WK-6000-PEP-Y-PRETOT-PAY)                        07740000
081500          MOVE '01' TO H-HHA-PAY-RTC                              07750000
081600      ELSE                                                        07760000
081700         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    07770000
081800                (WK-3000-PEP-N-PRETOT-PAY +                       07780000
081900                 WK-4000-PEP-Y-PRETOT-PAY +                       07790000
082000                 WK-5000-PEP-N-PRETOT-PAY +                       07800000
082100                 WK-6000-PEP-Y-PRETOT-PAY)                        07810000
082200          MOVE '00' TO H-HHA-PAY-RTC.                             07820000
082300                                                                  07830000
082400                                                                  07840000
082500 7000-EXIT.   EXIT.                                               07850000
082600 8000-ADD-REV-DOLL.                                               07860000
082700                                                                  07870000
082800***************************************************************   07880000
082900*        ADD ALL REVENUE DOLLARS                                  07890000
083000***************************************************************   07900000
083100                                                                  07910000
083200     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         07920000
083300        MOVE 6 TO SUB1                                            07930000
083400        GO TO 8000-EXIT.                                          07940000
083500                                                                  07950000
083600     COMPUTE FED-ADJ ROUNDED =                                    07960000
083700                H-HHA-REVENUE-DOLL-RATE (CO1) *                   07970000
083800                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               07980000
083900                                                                  07990000
084000     COMPUTE FED-LABOR-ADJ ROUNDED =                              08000000
084100               WIR-AREA-WAGEIND *                                 08010000
084200               LABOR-PERCENT * FED-ADJ.                           08020000
084300                                                                  08030000
084400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08040000
084500               NONLABOR-PERCENT * FED-ADJ.                        08050000
084600                                                                  08060000
084700     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   08070000
084800              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                08080000
084900                                                                  08090000
085000                                                                  08100000
085100     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   08110000
085200               WK-8000-OUTLIER-LAB-NLAB.                          08120000
085300                                                                  08130000
085400     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    08140000
085500             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  08150000
085600                                                                  08160000
085700 8000-EXIT.   EXIT.                                               08170000
085800                                                                  08180000
085900******        L A S T   S O U R C E   S T A T E M E N T   *****   08190000
