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