000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.           PPCAL964.                                  00020006
000300*AUTHOR.            DDS TEAM.                                     00030000
000400*REMARKS.                HCFA.                                    00040000
000500 DATE-COMPILED.                                                   00050000
000600 ENVIRONMENT DIVISION.                                            00060000
000700 CONFIGURATION SECTION.                                           00070000
000800 SOURCE-COMPUTER.            IBM-370.                             00080000
000900 OBJECT-COMPUTER.            IBM-370.                             00090000
001000 INPUT-OUTPUT  SECTION.                                           00100000
001100 FILE-CONTROL.                                                    00110000
001200                                                                  00120000
001300 DATA DIVISION.                                                   00130000
001400 FILE SECTION.                                                    00140000
001500                                                                  00150000
001600 WORKING-STORAGE SECTION.                                         00160000
001700 01  W-STORAGE-REF                  PIC X(46)  VALUE              00170000
001800     'PPCAL964 - W O R K I N G   S T O R A G E'.                  00180006
001900 01  CAL-VERSION                    PIC X(05)  VALUE 'C96.4'.     00190006
002000 01  R1                             PIC S9(04) COMP SYNC.         00200000
002100 01  R2                             PIC S9(04) COMP SYNC.         00210000
002200 01  R3                             PIC S9(04) COMP SYNC.         00220000
002300 01  R4                             PIC S9(04) COMP SYNC.         00230000
002400                                                                  00240000
002500***************************************************************   00250000
002600*    LAYUP TABLE AREA FOR FY96 RATES                          *   00260001
002700***************************************************************   00270000
002800 01  RATE-TABLE.                                                  00280000
002900     02  RATE-WORK.                                               00290000
003000*RATE   951001 REGION  LABOR AND NON-LABOR RATES                  00300001
003100*               LARGE URBAN /OTHER URBAN & / ALL RURAL            00310000
003200*                           /REFERRAL CTR  /                      00320000
003300         05  FILLER PIC X(06) VALUE '951001'.                     00330001
003400         05  NE01   PIC X(45) VALUE                               00340000
003500            ' 0287414 115127 0282862 113304 0282862 113304'.      00350001
003600         05  MA02   PIC X(45) VALUE                               00360000
003700            ' 0262306 105069 0258153 103406 0258153 103406'.      00370001
003800         05  SA03   PIC X(45) VALUE                               00380000
003900            ' 0268562 107575 0264311 105872 0264311 105872'.      00390001
004000         05  ENC04  PIC X(45) VALUE                               00400001
004100            ' 0292645 117222 0288012 115366 0288012 115366'.      00410001
004200         05  ESC05  PIC X(45) VALUE                               00420000
004300            ' 0253785 101656 0249767 100047 0249767 100047'.      00430001
004400         05  WNC06  PIC X(45) VALUE                               00440000
004500            ' 0274319 109881 0269976 108141 0269976 108141'.      00450001
004600         05  WSC07  PIC X(45) VALUE                               00460000
004700            ' 0266998 106949 0262771 105255 0262771 105255'.      00470001
004800         05  MNT08  PIC X(45) VALUE                               00480000
004900            ' 0265282 106262 0261082 104579 0261082 104579'.      00490001
005000         05  PAC09  PIC X(45) VALUE                               00500000
005100            ' 0271220 108640 0266927 106920 0266927 106920'.      00510001
005200         05  NTL10  PIC X(45) VALUE                               00520000
005300            ' 0274139 109809 0269799 108071 0269799 108071'.      00530001
005400         05  PR11   PIC X(45) VALUE                               00540000
005500            ' 0244477 050950 0240607 050143 0240607 050143'.      00550001
005600         05  NPR12  PIC X(45) VALUE                               00560000
005700            ' 0271463 108737 0271463 108737 0271463 108737'.      00570001
005800     02  RATE-TAB REDEFINES RATE-WORK.                            00580000
005900         05  RATE-PERIOD            OCCURS 1.                     00590000
006000             10  RATE-EFF-DATE      PIC X(06).                    00600000
006100             10  REG-NAT            OCCURS 12.                    00610000
006200                 15  R-URBAN-RURAL  OCCURS 3.                     00620000
006300                     20  FILLER     PIC X(01).                    00630000
006400                     20  REG-LABOR  PIC 9(05)V9(02).              00640000
006500                     20  FILLER     PIC X(01).                    00650000
006600                     20  REG-NLABOR PIC 9(04)V9(02).              00660000
006700                                                                  00670000
006800                                                                  00680000
006900***************************************************************   00690001
007000*    LAYUP TABLE AREA FOR FY96 DRGS                           *   00700001
007100***************************************************************   00710001
007200 01  DRG-TABLE.                                                   00720000
007300     05  D-TAB.                                                   00730000
007400      10  FILLER                  PIC X(06) VALUE                 00740001
007500     '951001'.                                                    00750001
007600      10  FILLER                  PIC X(56) VALUE                 00760001
007700     '03093208732124030095090321260188481273612702329606529100'.  00770001
007800      10  FILLER                  PIC X(56) VALUE                 00780001
007900     '01579804027052008124024250400260170933214701179403126046'.  00790001
008000      10  FILLER                  PIC X(56) VALUE                 00800001
008100     '01304705729085012299062290890080000382705300989106029087'.  00810001
008200      10  FILLER                  PIC X(56) VALUE                 00820001
008300     '00785805428069012065060290820072270382704901063905428074'.  00830001
008400      10  FILLER                  PIC X(56) VALUE                 00840001
008500     '00602603226043009242051280690059900362704702115708331115'.  00850001
008600      10  FILLER                  PIC X(56) VALUE                 00860001
008700     '01535006530087008127040270510080900392705500990804628065'.  00870001
008800      10  FILLER                  PIC X(56) VALUE                 00880001
008900     '00568103126041008993031260450134760392707201200105228079'.  00890001
009000      10  FILLER                  PIC X(56) VALUE                 00900001
009100     '00621703126044003187020170200079340382705700481902422033'.  00910001
009200      10  FILLER                  PIC X(56) VALUE                 00920001
009300     '00200301609016010569049280690059140342604800593001407017'.  00930001
009400      10  FILLER                  PIC X(56) VALUE                 00940001
009500     '00882102626041004243020170270050360150901900700002325036'.  00950001
009600      10  FILLER                  PIC X(56) VALUE                 00960001
009700     '00324401607016005615016120220036650302503800615004828059'.  00970001
009800      10  FILLER                  PIC X(56) VALUE                 00980001
009900     '00646003425043007593042270590045390302604000285902926029'.  00990001
010000      10  FILLER                  PIC X(56) VALUE                 01000001
010100     '01770104728070007522018120240073250202303000849202425034'.  01010001
010200      10  FILLER                  PIC X(56) VALUE                 01020001
010300     '00939202325037004634032220320072380192203000819502121030'.  01030001
010400      10  FILLER                  PIC X(56) VALUE                 01040001
010500     '01045003226049002631015040150059630211902900200401504015'.  01050001
010600      10  FILLER                  PIC X(56) VALUE                 01060001
010700     '01222103126059002837013050130114620332604901188705128082'.  01070001
010800      10  FILLER                  PIC X(56) VALUE                 01080001
010900     '00516202922037005306030240390080600342504300709404227052'.  01090001
011000      10  FILLER                  PIC X(56) VALUE                 01100001
011100     '00527003421041003129024170300072060362504400641903026047'.  01110001
011200      10  FILLER                  PIC X(56) VALUE                 01120001
011300     '00773004027054003223021200210310340933211902560109633134'.  01130001
011400      10  FILLER                  PIC X(56) VALUE                 01140001
011500     '01121903927059014136074300880166250783110100950805729072'.  01150001
011600      10  FILLER                  PIC X(56) VALUE                 01160001
011700     '00955804728067013166060290840095570522806900500203025042'.  01170001
011800      10  FILLER                  PIC X(56) VALUE                 01180001
011900     '01191705929079006848036270460135890532807301001805328066'.  01190001
012000      10  FILLER                  PIC X(56) VALUE                 01200001
012100     '01121106229076006996047260550083660442706001200006029077'.  01210001
012200      10  FILLER                  PIC X(56) VALUE                 01220001
012300     '00755004227053012378062290810062420382604700839004928059'.  01230001
012400      10  FILLER                  PIC X(56) VALUE                 01240001
012500     '00608903823046006696042270510069590292603900503402114026'.  01250001
012600      10  FILLER                  PIC X(56) VALUE                 01260001
012700     '00912004527060005595029260401382732745039107314313336160'.  01270001
012800      10  FILLER                  PIC X(56) VALUE                 01280001
012900     '05631010033120056187112341270418030863209805945510533135'.  01290001
013000      10  FILLER                  PIC X(56) VALUE                 01300001
013100     '00000000000000041308087321160225840632907201992203627050'.  01310001
013200      10  FILLER                  PIC X(56) VALUE                 01320001
013300     '02753611635160015383074301050355130953311802394904227059'.  01330001
013400      10  FILLER                  PIC X(56) VALUE                 01340001
013500     '01145403026045015260022250340112470342605901953105829101'.  01350001
013600      10  FILLER                  PIC X(56) VALUE                 01360001
013700     '01645907030084011614049280580143700282604901293304027053'.  01370001
013800      10  FILLER                  PIC X(56) VALUE                 01380001
013900     '00876702422032026049123351630103020522806700792906329072'.  01390001
014000      10  FILLER                  PIC X(56) VALUE                 01400001
014100     '01137602125037009384056290720060020452705500686103123040'.  01410001
014200      10  FILLER                  PIC X(56) VALUE                 01420001
014300     '00534702518031005800033250420089880412705700578902822036'.  01430001
014400      10  FILLER                  PIC X(56) VALUE                 01440001
014500     '00786603326033008049037270500049450251803200631203122038'.  01450001
014600      10  FILLER                  PIC X(56) VALUE                 01460001
014700     '00714903727050005216027200350051590231502801068904327061'.  01470001
014800      10  FILLER                  PIC X(56) VALUE                 01480001
014900     '00620402722035025898102331180153680722907903326411735142'.  01490001
015000      10  FILLER                  PIC X(56) VALUE                 01500001
015100     '01565407426081026561101331240126060552906801886008031097'.  01510001
015200      10  FILLER                  PIC X(56) VALUE                 01520001
015300     '01125705726064042102126361610138850542806700810106029060'.  01530001
015400      10  FILLER                  PIC X(56) VALUE                 01540001
015500     '01104804327061005789023180300117070412705600674602517031'.  01550001
015600      10  FILLER                  PIC X(56) VALUE                 01560001
015700     '00955403126045005365018110220075780352705002237408531099'.  01570001
015800      10  FILLER                  PIC X(56) VALUE                 01580001
015900     '01236505325061013695049280610078920301603601176103627056'.  01590001
016000      10  FILLER                  PIC X(56) VALUE                 01600001
016100     '00643402017027027116091321330116280442706201289806129088'.  01610001
016200      10  FILLER                  PIC X(56) VALUE                 01620001
016300     '00656903226046009880047280600054570311903801056305028065'.  01630001
016400      10  FILLER                  PIC X(56) VALUE                 01640001
016500     '00827004427054005990032210390109930602907800924005028065'.  01650001
016600      10  FILLER                  PIC X(56) VALUE                 01660001
016700     '00523103423042007794041270540054800302203700391002518031'.  01670001
016800      10  FILLER                  PIC X(56) VALUE                 01680001
016900     '00889204127058003088029230290064730282603801045804728066'.  01690001
017000      10  FILLER                  PIC X(56) VALUE                 01700001
017100     '00543802826038012379046280650444951293617501710306429083'.  01710001
017200      10  FILLER                  PIC X(56) VALUE                 01720001
017300     '03213112335149016937069300860261470943211201569506229072'.  01730001
017400      10  FILLER                  PIC X(56) VALUE                 01740001
017500     '02203407931097011355046240540233090923212403015807931127'.  01750001
017600      10  FILLER                  PIC X(56) VALUE                 01760001
017700     '03295111735161013177061290830121870592908301202005528072'.  01770001
017800      10  FILLER                  PIC X(56) VALUE                 01780001
017900     '01227605829080006801036270500102870472806200594302823036'.  01790001
018000      10  FILLER                  PIC X(56) VALUE                 01800001
018100     '02270706827076018616082310980128930632807201129604327052'.  01810001
018200      10  FILLER                  PIC X(56) VALUE                 01820001
018300     '01719607631106019184057290740109240352204202107508632122'.  01830001
018400      10  FILLER                  PIC X(56) VALUE                 01840001
018500     '02897511134171014231053280690091790342204100561105328053'.  01850001
018600      10  FILLER                  PIC X(56) VALUE                 01860001
018700     '01846306329088009747033260420083640231703000698302011024'.  01870001
018800      10  FILLER                  PIC X(56) VALUE                 01880001
018900     '00950403326051013656047280730072730242003200931502425038'.  01890001
019000      10  FILLER                  PIC X(56) VALUE                 01900001
019100     '00596501814024010399035270560121310352605501057802626045'.  01910001
019200      10  FILLER                  PIC X(56) VALUE                 01920001
019300     '01927506830098010039033260450085010522807800781805228071'.  01930001
019400      10  FILLER                  PIC X(56) VALUE                 01940001
019500     '00571103727049014356084311150102190632908401190005929081'.  01950001
019600      10  FILLER                  PIC X(56) VALUE                 01960001
019700     '00598603827049011295067300900072480472806100744604628064'.  01970001
019800      10  FILLER                  PIC X(56) VALUE                 01980001
019900     '00505003426046005646037270470055340312604300727504127057'.  01990001
020000      10  FILLER                  PIC X(56) VALUE                 02000001
020100     '00655803126047007193039270570044230242103200243801815018'.  02010001
020200      10  FILLER                  PIC X(56) VALUE                 02020001
020300     '00763704728066004365030260410028380292602900641903226044'.  02030001
020400      10  FILLER                  PIC X(56) VALUE                 02040001
020500     '00899703120039006965024110280087650262604100574901708020'.  02050001
020600      10  FILLER                  PIC X(56) VALUE                 02060001
020700     '00808001913026007115026260400223441123415801163306730092'.  02070001
020800      10  FILLER                  PIC X(56) VALUE                 02080001
020900     '01413104928079007451028260390080220282604400906802726044'.  02090001
021000      10  FILLER                  PIC X(56) VALUE                 02100001
021100     '01649506730100006796024250360111570723009501020806129081'.  02110001
021200      10  FILLER                  PIC X(56) VALUE                 02120001
021300     '00640304527061010741055280810048450242503500641804227054'.  02130001
021400      10  FILLER                  PIC X(56) VALUE                 02140001
021500     '00870305929073005822046270550070700422705900684704027056'.  02150001
021600      10  FILLER                  PIC X(56) VALUE                 02160001
021700     '00452302826039002467022190220071710442706000430703126041'.  02170001
021800      10  FILLER                  PIC X(56) VALUE                 02180001
021900     '02388011034154023163069300900211261073415502039705929080'.  02190001
022000      10  FILLER                  PIC X(56) VALUE                 02200001
022100     '01038503026045008537023160300046570140601602630109232135'.  02210001
022200      10  FILLER                  PIC X(56) VALUE                 02220001
022300     '01186604628064007579047280620076340372705100916605128070'.  02230001
022400      10  FILLER                  PIC X(56) VALUE                 02240001
022500     '00535303527046004756028260380097900422706201091905829079'.  02250001
022600      10  FILLER                  PIC X(56) VALUE                 02260001
022700     '00618103627048041370119351400261710913211002371508131111'.  02270001
022800      10  FILLER                  PIC X(56) VALUE                 02280001
022900     '01160004227054012441049280710066390271703301484805028075'.  02290001
023000      10  FILLER                  PIC X(56) VALUE                 02300001
023100     '00806102521032009694033260490054860191202400889103326051'.  02310001
023200      10  FILLER                  PIC X(56) VALUE                 02320001
023300     '00500801915026004756023250230206120572910301299605729081'.  02330001
023400      10  FILLER                  PIC X(56) VALUE                 02340001
023500     '00655602726041011007052280760054320222503400932005629071'.  02350001
023600      10  FILLER                  PIC X(56) VALUE                 02360001
023700     '00610404225051006651039270540072810282603800399201811023'.  02370001
023800      10  FILLER                  PIC X(56) VALUE                 02380001
023900     '00643603727049004233026210340023020312603100667203226044'.  02390001
024000      10  FILLER                  PIC X(56) VALUE                 02400001
024100     '00423301913023003063016090160101220492806800617603126042'.  02410001
024200      10  FILLER                  PIC X(56) VALUE                 02420001
024300     '00870104227060016948061250690130440482005300880203625046'.  02430001
024400      10  FILLER                  PIC X(56) VALUE                 02440001
024500     '00612802612030010260037270570093300312604700272302413024'.  02450001
024600      10  FILLER                  PIC X(56) VALUE                 02460001
024700     '01069902625037007360028260420014790170601701020902425035'.  02470001
024800      10  FILLER                  PIC X(56) VALUE                 02480001
024900     '00843503026046009626051280750048530252503600710603827053'.  02490001
025000      10  FILLER                  PIC X(56) VALUE                 02500001
025100     '00424102322031006810043270530022710130501300593203126042'.  02510001
025200      10  FILLER                  PIC X(56) VALUE                 02520001
025300     '01948307530094014609056290680088810381204100732302913033'.  02530001
025400      10  FILLER                  PIC X(56) VALUE                 02540001
025500     '02367908531106011458043200510080720321003500873903323042'.  02550001
025600      10  FILLER                  PIC X(56) VALUE                 02560001
025700     '01198403226050002902014050140068810272203700666702626038'.  02570001
025800      10  FILLER                  PIC X(56) VALUE                 02580001
025900     '01773906029087011405055290820051790252503700984105529071'.  02590001
026000      10  FILLER                  PIC X(56) VALUE                 02600001
026100     '00513002726039009573045260570065310341103800555802620035'.  02610001
026200      10  FILLER                  PIC X(56) VALUE                 02620001
026300     '00344601808021006721023130280065870442704400441802526037'.  02630001
026400      10  FILLER                  PIC X(56) VALUE                 02640001
026500     '00818102826043007409024140280039620222503400374201609020'.  02650001
026600      10  FILLER                  PIC X(56) VALUE                 02660001
026700     '00467301511021001922012070190045870312604400281801610021'.  02670001
026800      10  FILLER                  PIC X(56) VALUE                 02680001
026900     '01321901825018043591179411790297721333613301796408632086'.  02690001
027000      10  FILLER                  PIC X(56) VALUE                 02700001
027100     '02378507831103006218027260440014650311103103190809332120'.  02710001
027200      10  FILLER                  PIC X(56) VALUE                 02720001
027300     '01294909132091016252049280850083590412705800598002826042'.  02730001
027400      10  FILLER                  PIC X(56) VALUE                 02740001
027500     '01282504828066012360056290720069340382704702603407230112'.  02750001
027600      10  FILLER                  PIC X(56) VALUE                 02760001
027700     '02453309032131009428031260460168230693010000814003827054'.  02770001
027800      10  FILLER                  PIC X(56) VALUE                 02780001
027900     '01835804928049026558086321200116260402705101684005228088'.  02790001
028000      10  FILLER                  PIC X(56) VALUE                 02800001
028100     '00947504928070007172026200330050150252503400453002124029'.  02810001
028200      10  FILLER                  PIC X(56) VALUE                 02820001
028300     '01342206429092007285039270590347691243517301477006530089'.  02830001
028400      10  FILLER                  PIC X(56) VALUE                 02840001
028500     '00876404828061009777057290730092230482806200625803825046'.  02850001
028600      10  FILLER                  PIC X(56) VALUE                 02860001
028700     '00698203827049005446033260430158280683009402454312135200'.  02870001
028800      10  FILLER                  PIC X(56) VALUE                 02880001
028900     '00712903927055005949045270630057940412705900684705228081'.  02890001
029000      10  FILLER                  PIC X(56) VALUE                 02900001
029100     '00953706630104008670075301070063620532807600701804227066'.  02910001
029200      10  FILLER                  PIC X(56) VALUE                 02920001
029300     '00308002626037007373047280640042490392705100838412636157'.  02930001
029400      10  FILLER                  PIC X(56) VALUE                 02940001
029500     '00797209933118000000000000000165990562909301779207030110'.  02950001
029600      10  FILLER                  PIC X(56) VALUE                 02960001
029700     '00878502325043020836057290910081300242503400729004427058'.  02970001
029800      10  FILLER                  PIC X(56) VALUE                 02980001
029900     '00466402926039002846024220240049760232003100089601001010'.  02990001
030000      10  FILLER                  PIC X(56) VALUE                 03000001
030100     '00788603326048004329019150260025270211702100912703927056'.  03010001
030200      10  FILLER                  PIC X(56) VALUE                 03020001
030300     '00475202624035008906038270610046890232503501941004227082'.  03030001
030400      10  FILLER                  PIC X(56) VALUE                 03040001
030500     '01584902526051034645128361840193980823113200936905128073'.  03050001
030600      10  FILLER                  PIC X(56) VALUE                 03060001
030700     '01010402626054014731118351470074160422705900497203026040'.  03070001
030800      10  FILLER                  PIC X(56) VALUE                 03080001
030900     '00436201920029005601025260460042910262605003539111434165'.  03090001
031000      10  FILLER                  PIC X(56) VALUE                 03100001
031100     '00000000000000000000000000000364580803109610699314337314'.  03110001
031200      10  FILLER                  PIC X(56) VALUE                 03120001
031300     '03479708932153000000000000000370150913213102270311535151'.  03130001
031400      10  FILLER                  PIC X(56) VALUE                 03140001
031500     '01568205829094022709060290900138640372705016306624447338'.  03150001
031600      10  FILLER                  PIC X(56) VALUE                 03160001
031700     '11679627250312036620124351631610903826149705448810934171'.  03170001
031800      10  FILLER                  PIC X(56) VALUE                 03180001
031900     '03261010533134048763096331510199320683010104217713937190'.  03190001
032000      10  FILLER                  PIC X(56) VALUE                 03200001
032100     '01785607831117010476047280730160880402204804152911835184'.  03210001
032200      10  FILLER                  PIC X(56) VALUE                 03220001
032300     '01650104327062008769018150240956781824123200000000000000'.  03230001
032400     05  DRGX-TAB REDEFINES D-TAB.                                03240000
032500         10  DRGX-PERIOD               OCCURS 1                   03250000
032600                                        INDEXED BY DX5.           03260000
032700             15  DRGX-EFF-DATE         PIC X(06).                 03270000
032800             15  DRG-DATA              OCCURS 496                 03280000
032900                                        INDEXED BY DX6.           03290000
033000                 20  DRG-WT            PIC 9(02)V9(04).           03300000
033100                 20  DRG-ALOS          PIC 9(02)V9(01).           03310000
033200                 20  DRG-DAYS-TRIM     PIC 9(02).                 03320000
033300                 20  DRG-ARITH-ALOS    PIC 9(02)V9(01).           03330000
033400                                                                  03340000
033500 01  HOLD-AREA.                                                   03350000
033600     02  HOLD-DATES.                                              03360000
033700         05  HOLD-BILL-DATE.                                      03370000
033800             10  H-BILL-YY                PIC 9(02).              03380000
033900             10  H-BILL-MM                PIC 9(02).              03390000
034000             10  H-BILL-DD                PIC 9(02).              03400000
034100                                                                  03410000
034200         05  HOLD-FY-BEGIN-DATE.                                  03420000
034300             10  H-FY-BEGIN-YY            PIC 9(02).              03430000
034400             10  H-FY-BEGIN-MM            PIC 9(02).              03440000
034500             10  H-FY-BEGIN-DD            PIC 9(02).              03450000
034600                                                                  03460000
034700         05  HOLD-ADD-FY-BEGN-DATE.                               03470000
034800             10  H-ADD-FY-BEGN-YY            PIC 9(02).           03480000
034900             10  H-ADD-FY-BEGN-MM            PIC 9(02).           03490000
035000             10  H-ADD-FY-BEGN-DD            PIC 9(02).           03500000
035100                                                                  03510000
035200     02  HOLD-PPS-COMPONENTS.                                     03520000
035300         05  H-OPER-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        03530000
035400         05  H-CAPI-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        03540000
035500                                                                  03550000
035600         05  H-OPER-HSP-PART              PIC 9(06)V9(09).        03560000
035700         05  H-CAPI-HSP-PART              PIC 9(06)V9(09).        03570000
035800                                                                  03580000
035900         05  H-OPER-FSP-PART              PIC 9(06)V9(09).        03590000
036000         05  H-CAPI-FSP-PART              PIC 9(06)V9(09).        03600000
036100         05  H-CAPI2-B-FSP-PART           PIC 9(06)V9(09).        03610000
036200                                                                  03620000
036300         05  H-OPER-OUTLIER-PART          PIC 9(07)V9(09).        03630000
036400         05  H-CAPI-OUTLIER-PART          PIC 9(07)V9(09).        03640000
036500         05  H-CAPI2-B-OUTLIER-PART       PIC 9(07)V9(09).        03650000
036600                                                                  03660000
036700         05  H-OPER-OUTDAY-PART           PIC 9(07)V9(09).        03670000
036800         05  H-CAPI-OUTDAY-PART           PIC 9(07)V9(09).        03680000
036900                                                                  03690000
037000         05  H-OPER-OUTCST-PART           PIC 9(07)V9(09).        03700000
037100         05  H-CAPI-OUTCST-PART           PIC 9(07)V9(09).        03710000
037200                                                                  03720000
037300         05  H-OPER-CSTCHG-RATIO          PIC 9(01)V9(03).        03730000
037400         05  H-CAPI-CSTCHG-RATIO          PIC 9(01)V9(03).        03740000
037500                                                                  03750000
037600         05  H-OPER-DSH                   PIC 9(01)V9(04).        03760000
037700         05  H-CAPI-DSH                   PIC 9(01)V9(04).        03770000
037800                                                                  03780000
037900         05  H-OPER-IME-TEACH             PIC 9(06)V9(09).        03790000
038000         05  H-CAPI-PAYCDE-PCT1           PIC 9(01)V9(02).        03800000
038100         05  H-CAPI-PAYCDE-PCT2           PIC 9(01)V9(02).        03810000
038200         05  H-CAPI-HSP-PCT               PIC 9(01)V9(02).        03820000
038300         05  H-CAPI-FSP-PCT               PIC 9(01)V9(04).        03830000
038400         05  H-CAPI-COST-OUTLIER          PIC 9(07)V9(09).        03840000
038500         05  H-CAPI-BILL-COSTS            PIC 9(07)V9(09).        03850000
038600         05  H-CAPI-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        03860000
038700         05  H-CAPI-COLA                  PIC 9(01)V9(03).        03870000
038800         05  H-CAPI-SCH                   PIC 9(05)V9(02).        03880000
038900         05  H-CAPI-BUD-NEUTRALITY        PIC 9(01)V9(04).        03890000
039000         05  H-CAPI-OLD-HARMLESS          PIC 9(09)V9(02).        03900000
039100         05  H-CAPI-FED-RATE              PIC 9(05)V9(04).        03910000
039200         05  H-CAPI-FULL-PROS             PIC 9(05)V9(04).        03920000
039300         05  H-CAPI-LARG-URBAN            PIC 9(01)V9(02).        03930000
039400         05  H-CAPI-GAF                   PIC 9(05)V9(04).        03940000
039500         05  H-WAGE-INDEX                 PIC 9(02)V9(04).        03950000
039600         05  H-COV-DAYS                   PIC 9(3).               03960000
039700         05  H-PERDIEM-DAYS               PIC 9(3).               03970001
039800         05  H-REG-DAYS                   PIC 9(3).               03980000
039900         05  H-LTR-DAYS                   PIC 9(3).               03990000
040000         05  H-DSCHG-FRCTN                PIC 9(1)V9999.          04000000
040100         05  H-DRG-WT-FRCTN               PIC 9(2)V9999.          04010000
040200         05  H-ALOS                       PIC 9(02)V9(01).        04020000
040300         05  H-ARITH-ALOS                 PIC 9(02)V9(01).        04030000
040400         05  H-DAYS-CUTOFF                PIC 9(02)V9(01).        04040000
040500         05  H-DAYOUT-PCT                 PIC 9(01)V9(02).        04050000
040600         05  H-CSTOUT-PCT                 PIC 9(01)V9(02).        04060000
040700         05  H-CST-THRESH                 PIC 9(05)V9(02).        04070000
040800         05  H-PRE-CAPI-THRESH            PIC 9(05)V9(02).        04080000
040900         05  H-BUDG-NUTR93                PIC 9(01)V9(06).        04090001
041000         05  H-BUDG-NUTR94                PIC 9(01)V9(06).        04100001
041100         05  H-BUDG-NUTR95                PIC 9(01)V9(06).        04110000
041200         05  H-BUDG-NUTR96                PIC 9(01)V9(06).        04120001
041300         05  H-ACCUM-TO-HSP               PIC 9(01)V9(04).        04130000
041400         05  H-HSP-UPDATE94               PIC 9(01)V9(04).        04140001
041500         05  H-HSP-UPDATE95               PIC 9(01)V9(04).        04150001
041600         05  H-HSP-UPDATE96               PIC 9(01)V9(04).        04160001
041700         05  H-PUERTO-RICO-RATE           PIC 9(04)V9(02).        04170000
041800         05  H-FEDERAL-RATE               PIC 9(04)V9(02).        04180000
041900         05  H-LABOR-PCT                  PIC 9(01)V9(04).        04190000
042000         05  H-NLABOR-PCT                 PIC 9(01)V9(04).        04200000
042100         05  H-HSP-RATE                   PIC 9(06)V9(09).        04210000
042200         05  H-FSP-RATE                   PIC 9(06)V9(09).        04220000
042300         05  H-OUTLIER-FACT               PIC 9(01)V9(06).        04230000
042400         05  H-WK-OPER-DSH                PIC 9(01)V9(04).        04240000
042500         05  H-WK-CAPI-IME-TEACH          PIC 9(06)V9(09).        04250000
042600                                                                  04260000
042700                                                                  04270000
042800     02  HOLD-ADDITIONAL-VARIABLES.                               04280000
042900         05  H-OPER-HSP-PCT               PIC 9(01)V9(02).        04290000
043000         05  H-OPER-FSP-PCT               PIC 9(01)V9(02).        04300000
043100         05  H-NAT-PCT                    PIC 9(01)V9(02).        04310000
043200         05  H-REG-PCT                    PIC 9(01)V9(02).        04320000
043300         05  H-CMI-ADJ-CPD                PIC 9(05)V9(02).        04330000
043400         05  H-UPDATE-FACTOR              PIC 9(01)V9(05).        04340000
043500         05  H-DRG-WT                     PIC 9(02)V9(04).        04350000
043600         05  H-NAT-LABOR                  PIC 9(05)V9(02).        04360000
043700         05  H-NAT-NLABOR                 PIC 9(05)V9(02).        04370000
043800         05  H-REG-LABOR                  PIC 9(05)V9(02).        04380000
043900         05  H-REG-NLABOR                 PIC 9(05)V9(02).        04390000
044000         05  H-OPER-COLA                  PIC 9(01)V9(03).        04400000
044100         05  H-INTERN-RATIO               PIC 9(01)V9(04).        04410000
044200         05  H-OPER-COST-OUTLIER          PIC 9(07)V9(09).        04420000
044300         05  H-OPER-BILL-COSTS            PIC 9(07)V9(09).        04430000
044400         05  H-OPER-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        04440000
044500                                                                  04450000
044600     02  HOLD-CAPITAL-VARIABLES.                                  04460000
044700         05  H-CAPI-TOTAL-PAY             PIC 9(07)V9(02).        04470000
044800         05  H-CAPI-HSP                   PIC 9(07)V9(02).        04480000
044900         05  H-CAPI-FSP                   PIC 9(07)V9(02).        04490000
045000         05  H-CAPI-OUTLIER               PIC 9(07)V9(02).        04500000
045100         05  H-CAPI-OLD-HARM              PIC 9(07)V9(02).        04510000
045200         05  H-CAPI-DSH-ADJ               PIC 9(07)V9(02).        04520000
045300         05  H-CAPI-IME-ADJ               PIC 9(07)V9(02).        04530000
045400         05  H-CAPI-EXCEPTIONS            PIC 9(07)V9(02).        04540000
045500                                                                  04550000
045600     02  HOLD-CAPITAL2-VARIABLES.                                 04560000
045700         05  H-CAPI2-PAY-CODE             PIC X(1).               04570000
045800         05  H-CAPI2-B-FSP                PIC 9(07)V9(02).        04580000
045900         05  H-CAPI2-B-OUTLIER            PIC 9(07)V9(02).        04590000
046000                                                                  04600000
046100 LINKAGE SECTION.                                                 04610000
046200***************************************************************   04620000
046300*                 * * * * * * * * *                           *   04630000
046400*    REVIEW CODES ARE USED TO DIRECT THE PPCAL  SUBROUTINE    *   04640000
046500*    IN HOW TO PAY THE BILL.                                  *   04650000
046600*         REVIEW-CODE:                                        *   04660000
046700*            00 = PAY-WITH-OUTLIER.                           *   04670000
046800*                 WILL CALCULATE THE STANDARD PAYMENT.        *   04680000
046900*                 WILL ALSO ATTEMPT TO PAY DAY AND COST       *   04690000
047000*                 OUTLIERS.                                   *   04700000
047100*            03 = PAY-PERDIEM-DAYS.                           *   04710000
047200*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   04720000
047300*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   04730000
047400*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   04740000
047500*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   04750000
047600*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   04760000
047700*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   04770000
047800*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   04780000
047900*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   04790000
048000*                 BILL EXCEED THE COST THRESHOLD.             *   04800000
048100*            06 = PAY-XFER-NO-COST                            *   04810000
048200*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   04820000
048300*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   04830000
048400*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   04840000
048500*                 FOR THE DRG.  IF COVERED DAYS EQUAL OR      *   04850000
048600*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   04860000
048700*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   04870000
048800*                 CALCULATE ANY COST OUTLIER PORTION          *   04880000
048900*                 OF THE PAYMENT.                             *   04890000
049000*            07 = PAY-WITHOUT-COST.                           *   04900000
049100*                 WILL CALCULATE THE STANDARD PAYMENT. WILL   *   04910000
049200*                 ALSO CALCULATE THE DAY OUTLIER PORTION OF   *   04920000
049300*                 THE PAYMENT IF THE COVERED DAYS EXCEED THE  *   04930000
049400*                 OUTLIER CUTOFF FOR THE DRG.                 *   04940000
049500***************************************************************   04950000
049600 01  BILL-DATA.                                                   04960000
049700         10  B-PROVIDER-NO          PIC X(06).                    04970000
049800         10  B-REVIEW-CODE          PIC 9(02).                    04980000
049900             88  VALID-REVIEW-CODE  VALUE 00 03 06 07.            04990000
050000             88  PAY-WITH-OUTLIER   VALUE 00 07.                  05000000
050100             88  PAY-PERDIEM-DAYS   VALUE 03.                     05010000
050200             88  PAY-XFER-NO-COST   VALUE 06.                     05020000
050300             88  PAY-WITHOUT-COST   VALUE 07.                     05030000
050400         10  B-DRG                  PIC 9(03).                    05040000
050500         10  B-LOS                  PIC 9(03).                    05050000
050600         10  B-COVERED-DAYS         PIC 9(03).                    05060000
050700         10  B-LTR-DAYS             PIC 9(02).                    05070000
050800         10  B-DISCHARGE-DATE.                                    05080000
050900             15  B-DISCHG-MM        PIC 9(02).                    05090000
051000             15  B-DISCHG-DD        PIC 9(02).                    05100000
051100             15  B-DISCHG-YY        PIC 9(02).                    05110000
051200         10  B-CHARGES-CLAIMED      PIC 9(07)V9(02).              05120000
051300                                                                  05130000
051400***************************************************************   05140000
051500*    THIS DATA IS CALCULATED BY THIS PPCAL  SUBROUTINE        *   05150000
051600*    AND PASSED BACK TO THE CALLING PROGRAM                   *   05160000
051700*            RETURN CODE VALUES (PPS-RTC)                     *   05170000
051800*                                                             *   05180000
051900*            PPS-RTC 00-49 = HOW THE BILL WAS PAID            *   05190000
052000*              00 = PAID NORMAL DRG PAYMENT                   *   05200000
052100*                                                             *   05210000
052200*              01 = PAID AS A DAY-OUTLIER.                    *   05220000
052300*                                                             *   05230000
052400*              02 = PAID AS A COST-OUTLIER.                   *   05240000
052500*                                                             *   05250000
052600*              03 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   05260000
052700*                   AND INCLUDING THE FULL DRG.               *   05270000
052800*              05 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   05280000
052900*                   AND INCLUDING THE FULL DRG WHICH ALSO     *   05290000
053000*                   QUALIFIED FOR A COST OUTLIER PAYMENT.     *   05300000
053100*              06 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   05310000
053200*                   AND INCLUDING THE FULL DRG. PROVIDER      *   05320000
053300*                   REFUSED COST OUTLIER.                     *   05330000
053400*                                                             *   05340000
053500*            PPS-RTC 50-99 = WHY THE BILL WAS NOT PAID        *   05350000
053600*              51 = NO PROVIDER SPECIFIC INFO FOUND           *   05360000
053700*              52 = INVALID MSA # IN PROVIDER FILE            *   05370000
053800*              53 = WAIVER STATE - NOT CALCULATED BY PPS      *   05380000
053900*              54 = DRG < 001 OR > 495, OR = 109 OR = 438     *   05390000
054000*                                       OR = 469 OR = 470     *   05400000
054100*                                       OR = 474              *   05410000
054200*              55 = DISCHARGE DATE < PROVIDER PPS START DATE  *   05420000
054300*              56 = INVALID LENGTH OF STAY                    *   05430000
054400*              57 = REVIEW CODE INVALID (NOT 00 03 06 07)     *   05440000
054500*              58 = TOTAL CHARGES NOT NUMERIC                 *   05450000
054600*              61 = LIFETIME RESERVE DAYS NOT NUMERIC         *   05460000
054700*              62 = INVALID NUMBER OF COVERED DAYS            *   05470000
054800*              65 = PAY-CODE NOT = A,B OR C ON PROVIDER       *   05480000
054900*                   SPECIFIC FILE FOR CAPITAL                 *   05490000
055000*              66 = THERE ARE NOT AS MANY BENEFIT DAYS        *   05500000
055100*                   AVAILABLE ON THE BILL AS THERE ARE OUTLIER*   05510000
055200*                   DAYS COMPUTED BY PRICER --BENEFITS ARE    *   05520000
055300*                   EXHAUSTED ---                             *   05530000
055400*                   APPORTION THE CORRECT COVERED CHARGES     *   05540000
055500*                   FOR THE MAXIMUM NUMBER OF COVERED DAYS    *   05550000
055600*                   AVAILABLE BEFORE RESUBMITTING THE BILL    *   05560000
055700*                   FOR THE COST OUTLIER PAYMENT.             *   05570000
055800*              98 = CANNOT PROCESS BILL OLDER THAN 5 YEARS    *   05580000
055900***************************************************************   05590000
056000 01  PPS-DATA.                                                    05600000
056100         10  PPS-RTC                PIC 9(02).                    05610000
056200         10  PPS-WAGE-INDX          PIC 9(02)V9(04).              05620000
056300         10  PPS-OUTLIER-DAYS       PIC 9(03).                    05630000
056400         10  PPS-AVG-LOS            PIC 9(02)V9(01).              05640000
056500         10  PPS-DAYS-CUTOFF        PIC 9(02)V9(01).              05650000
056600         10  PPS-OPER-IME-ADJ       PIC 9(06)V9(02).              05660000
056700         10  PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).              05670000
056800         10  PPS-OPER-HSP-PART      PIC 9(06)V9(02).              05680000
056900         10  PPS-OPER-FSP-PART      PIC 9(06)V9(02).              05690000
057000         10  PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).              05700000
057100         10  PPS-REG-DAYS-USED      PIC 9(03).                    05710000
057200         10  PPS-LTR-DAYS-USED      PIC 9(02).                    05720000
057300         10  PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).              05730000
057400         10  PPS-CALC-VERS          PIC X(05).                    05740000
057500                                                                  05750000
057600******************************************************************05760000
057700*            THESE ARE THE VERSIONS OF THE PPCAL                  05770000
057800*           PROGRAMS THAT WILL BE PASSED BACK----                 05780000
057900*          ASSOCIATED WITH THE BILL BEING PROCESSED               05790000
058000******************************************************************05800000
058100 01  PRICER-OPT-VERS-SW.                                          05810000
058200     02  PRICER-OPTION-SW          PIC X(01).                     05820000
058300         88  ALL-TABLES-PASSED          VALUE 'A'.                05830000
058400         88  PROV-RECORD-PASSED         VALUE 'P'.                05840000
058500         88  ADDITIONAL-VARIABLES       VALUE 'M'.                05850000
058600     02  PPS-VERSIONS.                                            05860000
058700         10  PPDRV-VERSION         PIC X(05).                     05870000
058800                                                                  05880000
058900******************************************************************05890000
059000*        THIS IS THE VARIABLES THAT WILL BE PASSED BACK           05900000
059100*          ASSOCIATED WITH THE BILL BEING PROCESSED               05910000
059200******************************************************************05920000
059300 01  PPS-ADDITIONAL-VARIABLES.                                    05930000
059400     05  PPS-HSP-PCT                PIC 9(01)V9(02).              05940000
059500     05  PPS-FSP-PCT                PIC 9(01)V9(02).              05950000
059600     05  PPS-NAT-PCT                PIC 9(01)V9(02).              05960000
059700     05  PPS-REG-PCT                PIC 9(01)V9(02).              05970000
059800     05  PPS-CMI-ADJ-CPD            PIC 9(05)V9(02).              05980000
059900     05  PPS-UPDATE-FACTOR          PIC 9(01)V9(05).              05990000
060000     05  PPS-DRG-WT                 PIC 9(02)V9(04).              06000000
060100     05  PPS-NAT-LABOR              PIC 9(05)V9(02).              06010000
060200     05  PPS-NAT-NLABOR             PIC 9(05)V9(02).              06020000
060300     05  PPS-REG-LABOR              PIC 9(05)V9(02).              06030000
060400     05  PPS-REG-NLABOR             PIC 9(05)V9(02).              06040000
060500     05  PPS-OPER-COLA              PIC 9(01)V9(03).              06050000
060600     05  PPS-INTERN-RATIO           PIC 9(01)V9(04).              06060000
060700     05  PPS-COST-OUTLIER           PIC 9(07)V9(09).              06070000
060800     05  PPS-BILL-COSTS             PIC 9(07)V9(09).              06080000
060900     05  PPS-DOLLAR-THRESHOLD       PIC 9(07)V9(09).              06090000
061000     05  PPS-DSCHG-FRCTN            PIC 9(1)V9999.                06100000
061100     05  PPS-DRG-WT-FRCTN           PIC 9(2)V9999.                06110000
061200     05  PPS-CAPITAL-VARIABLES.                                   06120000
061300         10  PPS-CAPI-TOTAL-PAY           PIC 9(07)V9(02).        06130000
061400         10  PPS-CAPI-HSP                 PIC 9(07)V9(02).        06140000
061500         10  PPS-CAPI-FSP                 PIC 9(07)V9(02).        06150000
061600         10  PPS-CAPI-OUTLIER             PIC 9(07)V9(02).        06160000
061700         10  PPS-CAPI-OLD-HARM            PIC 9(07)V9(02).        06170000
061800         10  PPS-CAPI-DSH-ADJ             PIC 9(07)V9(02).        06180000
061900         10  PPS-CAPI-IME-ADJ             PIC 9(07)V9(02).        06190000
062000         10  PPS-CAPI-EXCEPTIONS          PIC 9(07)V9(02).        06200000
062100     05  PPS-CAPITAL2-VARIABLES.                                  06210000
062200         10  PPS-CAPI2-PAY-CODE             PIC X(1).             06220000
062300         10  PPS-CAPI2-B-FSP                PIC 9(07)V9(02).      06230000
062400         10  PPS-CAPI2-B-OUTLIER            PIC 9(07)V9(02).      06240000
062500                                                                  06250000
062600                                                                  06260000
062700******************************************************************06270000
062800*               THIS IS THE PROVIDER RECORD                       06280000
062900*          ASSOCIATED WITH THE BILL BEING PROCESSED               06290000
063000******************************************************************06300000
063100 01  PROV-HOLD.                                                   06310000
063200     02  PROV-REC-HOLD.                                           06320000
063300         05  P-PROVIDER-NO.                                       06330000
063400             10  P-STATE                PIC 9(02).                06340000
063500             10  FILLER                 PIC X(04).                06350000
063600         05  P-EFF-DATE.                                          06360000
063700             10  P-EFF-YY               PIC 9(02).                06370000
063800             10  P-EFF-MM               PIC 9(02).                06380000
063900             10  P-EFF-DD               PIC 9(02).                06390000
064000         05  P-WAIVER-CODE              PIC X(01).                06400000
064100             88  WAIVER-STATE           VALUE 'Y'.                06410000
064200         05  P-PROVIDER-TYPE            PIC X(02).                06420000
064300             88  REFERRAL-CENTER        VALUE '07' '15' '17' '22'.06430000
064400             88  INDIAN-HEALTH-SERVICE  VALUE '08'.               06440000
064500             88  MDH-REBASED-FY90       VALUE '14' '15'.          06450000
064600             88  MDH-RRC-REBASED-FY90   VALUE '15'.               06460000
064700             88  SCH-REBASED-FY90       VALUE '16' '17'.          06470000
064800             88  SCH-RRC-REBASED-FY90   VALUE '17'.               06480000
064900             88  MEDICAL-ASSIST-FACIL   VALUE '18'.               06490000
065000             88  EACH                   VALUE '21' '22'.          06500000
065100             88  EACH-REFERRAL-CENTER   VALUE '22'.               06510000
065200         05  P-CURRENT-CENSUS-DIV       PIC 9(01).                06520000
065300             88  NEW-ENGLAND            VALUE  1.                 06530000
065400             88  MIDDLE-ATLANTIC        VALUE  2.                 06540000
065500             88  SOUTH-ATLANTIC         VALUE  3.                 06550000
065600             88  EAST-NORTH-CENTRAL     VALUE  4.                 06560000
065700             88  EAST-SOUTH-CENTRAL     VALUE  5.                 06570000
065800             88  WEST-NORTH-CENTRAL     VALUE  6.                 06580000
065900             88  WEST-SOUTH-CENTRAL     VALUE  7.                 06590000
066000             88  MOUNTAIN               VALUE  8.                 06600000
066100             88  PACIFIC                VALUE  9.                 06610000
066200         05  P-CENSUS-DIV  REDEFINES                              06620000
066300                    P-CURRENT-CENSUS-DIV       PIC 9(01).         06630000
066400             88  VALID-CENSUS-DIV   VALUE 1 THRU 9.               06640000
066500         05  P-PPS-BLEND-YEAR           PIC 9(01).                06650000
066600             88  VALID-PPS-BLEND-YEAR   VALUE 1 THRU 8.           06660000
066700         05  P-MSA-X.                                             06670000
066800             10  P-MSA-9                PIC X(04).                06680000
066900         05  P-FISCAL-YEAR-END.                                   06690000
067000             10  P-MM                   PIC 9(02).                06700000
067100             10  P-DD                   PIC 9(02).                06710000
067200             10  P-YY                   PIC 9(02).                06720000
067300         05  P-VARIABLES.                                         06730000
067400             10  P-CMI-ADJ-CPD          PIC S9(05)V9(02).         06740000
067500             10  P-COLA                 PIC S9(01)V9(03).         06750000
067600             10  P-INTERN-RATIO         PIC S9(01)V9(04).         06760000
067700             10  PRUP-UPDT-FACTOR       PIC S9(01)V9(05).         06770000
067800             10  P-BED-SIZE             PIC  9(05).               06780000
067900             10  P-DSH-PERCENT          PIC V9(04).               06790000
068000             10  P-OPER-CSTCHG-RATIO    PIC  9(01)V9(03).         06800000
068100             10  P-CMI                  PIC  9(01)V9(04).         06810000
068200             10  FILLER                 PIC  9(01).               06820000
068300             10  P-REPORT-DATE          PIC  9(06).               06830000
068400             10  FILLER                 PIC  9(01).               06840000
068500             10  P-INTER-NO             PIC  9(05).               06850000
068600     02  PROV-REC-HOLD2.                                          06860000
068700         05  P-FY-BEGIN-DATE.                                     06870000
068800             10  P-FY-BEGIN-MM          PIC 9(2).                 06880000
068900             10  P-FY-BEGIN-DD          PIC 9(2).                 06890000
069000             10  P-FY-BEGIN-YY          PIC 9(2).                 06900000
069100         05  P-PASS-AMT-CAPITAL         PIC 9(4)V99.              06910000
069200         05  P-PASS-AMT-DIR-MED-ED      PIC 9(4)V99.              06920000
069300         05  P-PASS-AMT-ORGAN-ACQ       PIC 9(4)V99.              06930000
069400         05  P-PASS-AMT-INCL-MISC       PIC 9(4)V99.              06940000
069500         05  P-SSI-RATIO                PIC V9(4).                06950000
069600         05  P-MEDICAID-RATIO           PIC V9(4).                06960000
069700         05  P-TERMINATION-DATE         PIC X(6).                 06970000
069800         05  P-WAGE-INDEX-LOC-MSA       PIC X(4).                 06980000
069900         05  P-CHG-CODE-INDEX           PIC X.                    06990000
070000         05  P-STAND-AMT-LOC-MSA.                                 07000000
070100             10  P-RURAL-1ST            PIC XX.                   07010000
070200                 88  P-RURAL-CHECK        VALUE '  '.             07020000
070300             10  P-RURAL-2ND            PIC XX.                   07030000
070400         05  P-CAPI-SOL-HOSP-RATE       PIC XX.                   07040000
070500         05  FILLER                     PIC X.                    07050000
070600         05  FILLER                     PIC X(06).                07060000
070700         05  FILLER                     PIC X(18).                07070000
070800     02  PROV-REC-HOLD3.                                          07080000
070900         05  P-CAPI-PPS-PAY-CODE        PIC X.                    07090000
071000         05  P-CAPI-HOSP-SPEC-RATE      PIC 9(4)V99.              07100000
071100         05  P-CAPI-OLD-HARM-RATE       PIC 9(4)V99.              07110000
071200         05  P-CAPI-NEW-HARM-RATIO      PIC 9(1)V9999.            07120000
071300         05  P-CAPI-CSTCHG-RATIO        PIC 9V999.                07130000
071400         05  P-CAPI-NEW-HOSP            PIC X.                    07140000
071500         05  P-CAPI-IME                 PIC 9V9999.               07150000
071600         05  P-CAPI-EXCEPTIONS          PIC 9(4)V99.              07160000
071700         05  FILLER                     PIC X(46).                07170000
071800                                                                  07180000
071900******************************************************************07190000
072000*                   THIS IS THE WAGE-INDEX                        07200000
072100*          ASSOCIATED WITH THE BILL BEING PROCESSED               07210000
072200******************************************************************07220000
072300 01  WAGE-INDEX-RECORD.                                           07230000
072400     05  W-MSA                         PIC X(4).                  07240000
072500     05  W-SIZE                        PIC X.                     07250000
072600         88  LARGE-URBAN       VALUE 'L'.                         07260000
072700         88  OTHER-URBAN       VALUE 'O'.                         07270000
072800         88  ALL-RURAL         VALUE 'R'.                         07280000
072900     05  W-EFF-DATE                    PIC X(6).                  07290000
073000     05  FILLER                        PIC X.                     07300000
073100     05  W-INDEX-RECORD                PIC S9(02)V9(04).          07310000
073200                                                                  07320000
073300                                                                  07330000
073400 PROCEDURE DIVISION  USING BILL-DATA                              07340000
073500                           PPS-DATA                               07350000
073600                           PRICER-OPT-VERS-SW                     07360000
073700                           PPS-ADDITIONAL-VARIABLES               07370000
073800                           PROV-HOLD                              07380000
073900                           WAGE-INDEX-RECORD.                     07390000
074000                                                                  07400000
074100***************************************************************   07410000
074200*    PROCESSING:                                              *   07420000
074300*        A. WILL PROCESS CASES BASED ON DISCHARGE DATE            07430000
074400*        B. INITIALIZE PPCAL  HOLD VARIABLES.                 *   07440000
074500*        C. EDIT THE DATA PASSED FROM THE BILL BEFORE         *   07450000
074600*           ATTEMPTING TO CALCULATE PPS. IF THIS BILL         *   07460000
074700*           CANNOT BE PROCESSED, SET A RETURN CODE AND        *   07470000
074800*           GOBACK.                                           *   07480000
074900*        D. ASSEMBLE PRICING COMPONENTS.                      *   07490000
075000*        E. CALCULATE THE BLENDED PRICE.                      *   07500000
075100***************************************************************   07510000
075200                                                                  07520000
075300     PERFORM 0200-MAINLINE-CONTROL.                               07530000
075400                                                                  07540000
075500     MOVE HOLD-ADDITIONAL-VARIABLES TO  PPS-ADDITIONAL-VARIABLES. 07550000
075600     MOVE H-DSCHG-FRCTN             TO  PPS-DSCHG-FRCTN.          07560000
075700     MOVE H-DRG-WT-FRCTN            TO  PPS-DRG-WT-FRCTN.         07570000
075800     MOVE HOLD-CAPITAL-VARIABLES    TO  PPS-CAPITAL-VARIABLES.    07580000
075900     MOVE HOLD-CAPITAL2-VARIABLES   TO  PPS-CAPITAL2-VARIABLES.   07590000
076000     MOVE CAL-VERSION               TO  PPS-CALC-VERS.            07600000
076100                                                                  07610000
076200     GOBACK.                                                      07620000
076300                                                                  07630000
076400 0200-MAINLINE-CONTROL.                                           07640000
076500     MOVE ALL '0' TO PPS-DATA                                     07650000
076600                     HOLD-PPS-COMPONENTS                          07660000
076700                     HOLD-ADDITIONAL-VARIABLES                    07670000
076800                     HOLD-CAPITAL-VARIABLES                       07680000
076900                     HOLD-CAPITAL2-VARIABLES.                     07690000
077000                                                                  07700000
077100     IF P-CAPI-HOSP-SPEC-RATE NOT NUMERIC                         07710000
077200        MOVE 0 TO P-CAPI-HOSP-SPEC-RATE.                          07720000
077300                                                                  07730000
077400     IF P-CAPI-OLD-HARM-RATE  NOT NUMERIC                         07740000
077500        MOVE 0 TO P-CAPI-OLD-HARM-RATE.                           07750000
077600                                                                  07760000
077700     IF P-CAPI-NEW-HARM-RATIO NOT NUMERIC                         07770000
077800        MOVE 0 TO P-CAPI-NEW-HARM-RATIO.                          07780000
077900                                                                  07790000
078000     IF P-CAPI-CSTCHG-RATIO NOT NUMERIC                           07800000
078100        MOVE 0 TO P-CAPI-CSTCHG-RATIO.                            07810000
078200                                                                  07820000
078300******************************************************************07830000
078400     PERFORM 1000-EDIT-THE-BILL-INFO.                             07840000
078500                                                                  07850000
078600     IF  PPS-RTC = 00                                             07860000
078700         PERFORM 2000-ASSEMBLE-PPS-VARIABLES                      07870000
078800         PERFORM 3000-CALC-BLENDED-PAYMENT.                       07880000
078900                                                                  07890000
079000 1000-EDIT-THE-BILL-INFO.                                         07900000
079100***************************************************************   07910000
079200*    BILL DATA EDITS IF ANY FAIL SET PPS-RTC                  *   07920000
079300*    AND DO NOT ATTEMPT TO PRICE.                             *   07930000
079400***************************************************************   07940000
079500                                                                  07950000
079600     MOVE B-DISCHG-YY TO H-BILL-YY.                               07960000
079700     MOVE B-DISCHG-MM TO H-BILL-MM.                               07970000
079800     MOVE B-DISCHG-DD TO H-BILL-DD.                               07980000
079900                                                                  07990000
080000     MOVE P-FY-BEGIN-YY TO H-FY-BEGIN-YY.                         08000000
080100     MOVE P-FY-BEGIN-MM TO H-FY-BEGIN-MM.                         08010000
080200     MOVE P-FY-BEGIN-DD TO H-FY-BEGIN-DD.                         08020000
080300                                                                  08030000
080400     IF HOLD-FY-BEGIN-DATE < 951001                               08040001
080500        MOVE .40 TO H-CAPI-PAYCDE-PCT1                            08050001
080600        MOVE .60 TO H-CAPI-PAYCDE-PCT2                            08060001
080700     ELSE                                                         08070000
080800        IF (HOLD-FY-BEGIN-DATE < HOLD-BILL-DATE) OR               08080000
080900           (HOLD-FY-BEGIN-DATE = HOLD-BILL-DATE)                  08090000
081000              MOVE .50 TO H-CAPI-PAYCDE-PCT1                      08100001
081100              MOVE .50 TO H-CAPI-PAYCDE-PCT2                      08110001
081200        ELSE                                                      08120000
081300              MOVE .40 TO H-CAPI-PAYCDE-PCT1                      08130001
081400              MOVE .60 TO H-CAPI-PAYCDE-PCT2.                     08140001
081500                                                                  08150000
081600     IF  PPS-RTC = 00                                             08160000
081700         IF  WAIVER-STATE                                         08170000
081800             MOVE 53 TO PPS-RTC.                                  08180000
081900                                                                  08190000
082000     IF  PPS-RTC = 00                                             08200000
082100         IF  B-DRG < 001 OR > 495 OR = 109 OR = 438               08210000
082200                                  OR = 469 OR = 470               08220000
082300                                  OR = 474                        08230000
082400             MOVE 54 TO PPS-RTC.                                  08240000
082500                                                                  08250000
082600     IF  PPS-RTC = 00                                             08260000
082700         IF  HOLD-BILL-DATE < P-EFF-DATE                          08270000
082800             MOVE 55 TO PPS-RTC.                                  08280000
082900                                                                  08290000
083000     IF  PPS-RTC = 00                                             08291000
083100         IF  B-REVIEW-CODE NOT NUMERIC                            08292000
083200             MOVE 57 TO PPS-RTC.                                  08293000
083300     IF  PPS-RTC = 00                                             08300000
083400         IF  B-LOS NOT NUMERIC                                    08310000
083500             MOVE 56 TO PPS-RTC                                   08320000
083600         ELSE                                                     08330000
083700         IF  B-LOS = 0                                            08340000
083800             IF B-REVIEW-CODE NOT = 03 AND                        08350000
083900                              NOT = 06                            08360000
084000             MOVE 56 TO PPS-RTC.                                  08370000
084100                                                                  08380000
084200     IF  PPS-RTC = 00                                             08390000
084300         IF  B-LTR-DAYS NOT NUMERIC OR B-LTR-DAYS > 60            08400000
084400             MOVE 61 TO PPS-RTC                                   08410000
084500         ELSE                                                     08420000
084600             MOVE B-LTR-DAYS TO H-LTR-DAYS.                       08430000
084700                                                                  08440000
084800     IF  PPS-RTC = 00                                             08450000
084900         IF  B-COVERED-DAYS NOT NUMERIC                           08460000
085000             MOVE 62 TO PPS-RTC                                   08470000
085100         ELSE                                                     08480000
085200         IF  B-COVERED-DAYS = 0 AND B-LOS > 0                     08490000
085300             MOVE 62 TO PPS-RTC                                   08500000
085400         ELSE                                                     08510000
085500             MOVE B-COVERED-DAYS TO H-COV-DAYS.                   08520000
085600                                                                  08530000
085700     IF  PPS-RTC = 00                                             08540000
085800         IF  H-LTR-DAYS  > H-COV-DAYS                             08550000
085900             MOVE 62 TO PPS-RTC                                   08560000
086000         ELSE                                                     08570000
086100             COMPUTE H-REG-DAYS = H-COV-DAYS - H-LTR-DAYS.        08580000
086200                                                                  08590000
086300     IF  PPS-RTC = 00                                             08600000
086400         IF  NOT VALID-REVIEW-CODE                                08610000
086500             MOVE 57 TO PPS-RTC.                                  08620000
086600                                                                  08630000
086700     IF  PPS-RTC = 00                                             08640000
086800         IF  B-CHARGES-CLAIMED NOT NUMERIC                        08650000
086900             MOVE 58 TO PPS-RTC.                                  08660000
087000                                                                  08670000
087100     IF PPS-RTC = 00                                              08680000
087200        IF NOT INDIAN-HEALTH-SERVICE                              08690000
087300           IF P-CAPI-NEW-HOSP NOT = 'Y'                           08700000
087400                 IF P-CAPI-PPS-PAY-CODE NOT = 'A' AND             08710000
087500                                        NOT = 'B' AND             08720000
087600                                        NOT = 'C'                 08730000
087700                 MOVE 65 TO PPS-RTC.                              08740000
087800                                                                  08750000
087900 2000-ASSEMBLE-PPS-VARIABLES.                                     08760000
088000***************************************************************   08770000
088100*    THE APPROPRIATE SET OF THESE PPS VARIABLES ARE SELECTED  *   08780000
088200*    DEPENDING ON THE BILL DISCHARGE DATE AND EFFECTIVE DATE  *   08790000
088300*    OF THAT VARIABLE.                                        *   08800000
088400***************************************************************   08810000
088500***  GET THE PROVIDER SPECIFIC VARIABLES.                         08820000
088600                                                                  08830000
088700     MOVE P-CMI-ADJ-CPD  TO H-CMI-ADJ-CPD.                        08840000
088800     MOVE P-INTERN-RATIO TO H-INTERN-RATIO.                       08850000
088900                                                                  08860000
089000     IF  NOT (P-STATE = 02 OR 12)                                 08870000
089100         MOVE 1 TO H-OPER-COLA                                    08880000
089200     ELSE                                                         08890000
089300         MOVE P-COLA TO H-OPER-COLA.                              08900000
089400                                                                  08910000
089500***************************************************************   08920000
089600***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              08930000
089700                                                                  08940000
089800     PERFORM 2600-GET-DRG-WEIGHT                                  08950000
089900             VARYING DX5 FROM 1 BY 1 UNTIL DX5 > 1.               08960000
090000                                                                  08970000
090100***************************************************************   08980000
090200***  GET THE WAGE-INDEX                                           08990000
090300                                                                  09000000
090400     MOVE W-INDEX-RECORD TO H-WAGE-INDEX.                         09010000
090500                                                                  09020000
090600***************************************************************   09030000
090700***  GET THE LABOR, NON-LABOR STANDARD RATES                      09040000
090800                                                                  09050000
090900     IF  VALID-CENSUS-DIV                                         09060000
091000         MOVE P-CURRENT-CENSUS-DIV TO R2                          09070000
091100     ELSE                                                         09080000
091200         MOVE 10 TO R2.                                           09090000
091300                                                                  09100000
091400     MOVE 10 TO R4.                                               09110000
091500                                                                  09120000
091600     IF  P-STATE = 40                                             09130000
091700         MOVE 11 TO R2                                            09140000
091800         MOVE 12 TO R4.                                           09150000
091900                                                                  09160000
092000     IF  LARGE-URBAN                                              09170000
092100         MOVE 1 TO R3                                             09180000
092200     ELSE                                                         09190000
092300     IF  OTHER-URBAN OR REFERRAL-CENTER                           09200000
092400         MOVE 2 TO R3                                             09210000
092500     ELSE                                                         09220000
092600         MOVE 3 TO R3.                                            09230000
092700                                                                  09240000
092800     PERFORM 2300-GET-LABOR-NLABOR-RATES                          09250000
092900             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 09260000
093000                                                                  09270000
093100***************************************************************   09280000
093200***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               09290000
093300                                                                  09300000
093400     MOVE 0.00  TO H-OPER-HSP-PCT.                                09310000
093500     MOVE 1.00  TO H-OPER-FSP-PCT.                                09320000
093600                                                                  09330000
093700***************************************************************   09340000
093800***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     09350000
093900                                                                  09360000
094000      MOVE 1.00 TO H-NAT-PCT.                                     09370000
094100      MOVE 0.00 TO H-REG-PCT.                                     09380000
094200                                                                  09390000
094300***************************************************************   09400000
094400*    REGIONAL FLOOR                                               09410000
094500                                                                  09420000
094600     IF  (H-REG-LABOR + H-REG-NLABOR) >                           09430000
094700         (H-NAT-LABOR + H-NAT-NLABOR)                             09440000
094800           MOVE 0.85 TO H-NAT-PCT                                 09450000
094900           MOVE 0.15 TO H-REG-PCT.                                09460000
095000                                                                  09470000
095100     IF  P-STATE = 40                                             09480000
095200         MOVE 0.25 TO H-NAT-PCT                                   09490000
095300         MOVE 0.75 TO H-REG-PCT.                                  09500000
095400                                                                  09510000
095500     IF  SCH-REBASED-FY90 OR EACH                                 09520000
095600         MOVE 1.00 TO H-OPER-HSP-PCT.                             09530000
095700                                                                  09540000
095800 2300-GET-LABOR-NLABOR-RATES.                                     09550000
095900                                                                  09560000
096000     IF  HOLD-BILL-DATE NOT < RATE-EFF-DATE (R1)                  09570000
096100         MOVE REG-LABOR  (R1 R2 R3) TO H-REG-LABOR                09580000
096200         MOVE REG-NLABOR (R1 R2 R3) TO H-REG-NLABOR               09590000
096300         MOVE REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR                09600000
096400         MOVE REG-NLABOR (R1 R4 R3) TO H-NAT-NLABOR.              09610001
096500                                                                  09620000
096600 2600-GET-DRG-WEIGHT.                                             09630000
096700     IF  HOLD-BILL-DATE NOT < DRGX-EFF-DATE (DX5)                 09640000
096800         SET DX6 TO B-DRG                                         09650000
096900         MOVE DRG-WT (DX5 DX6)         TO H-DRG-WT                09660000
097000         MOVE DRG-ALOS (DX5 DX6)       TO H-ALOS                  09670000
097100         MOVE DRG-DAYS-TRIM (DX5 DX6)  TO H-DAYS-CUTOFF           09680000
097200         MOVE DRG-ARITH-ALOS (DX5 DX6) TO H-ARITH-ALOS.           09690000
097300                                                                  09700000
097400 3000-CALC-BLENDED-PAYMENT.                                       09710000
097500***************************************************************   09720000
097600*    IF THE BILL DATA HAS PASSED ALL EDITS (RTC=00)           *   09730000
097700*        CALCULATE COVERED DAYS UTILIZATION.                  *   09740000
097800*        CALCULATE THE FEDERAL PORTION.                       *   09750000
097900*        CALCULATE THE HOSPITAL PORTION.                      *   09760000
098000*        CALCULATE THE DAYS-OUTLIER PORTION.                  *   09770000
098100*        CALCULATE THE COST-OUTLIER PORTION.                  *   09780000
098200*        CALCULATE THE TOTAL PAYMENT (BLENDED)                *   09790000
098300*        CALCULATE THE DSH ADJUSTMENT.                        *   09800000
098400***************************************************************   09810000
098500     PERFORM 3100-CALC-STAY-UTILIZATION.                          09820000
098600     PERFORM 3300-CALC-OPER-FSP-AMT.                              09830000
098700     PERFORM 3900-CALC-OPER-DSH.                                  09840000
098800***********************************************************       09850000
098900***  OPERATING IME CALCULATION                                    09860000
099000                                                                  09870000
099100         COMPUTE H-OPER-IME-TEACH =                               09880000
099200            1.89 * ((1 + H-INTERN-RATIO) ** .405  - 1).           09890000
099300                                                                  09900000
099400***********************************************************       09910000
099500                                                                  09920000
099600     IF  SCH-REBASED-FY90 OR EACH                                 09930000
099700         PERFORM 3450-CALC-ADDITIONAL-HSP.                        09940000
099800                                                                  09950000
099900     MOVE 00                 TO  PPS-RTC.                         09960000
100000     MOVE H-WAGE-INDEX       TO  PPS-WAGE-INDX.                   09970000
100100     MOVE H-ALOS             TO  PPS-AVG-LOS.                     09980000
100200     MOVE H-DAYS-CUTOFF      TO  PPS-DAYS-CUTOFF.                 09990000
100300                                                                  10000000
100400     MOVE B-LOS TO H-PERDIEM-DAYS.                                10010001
100500     IF H-PERDIEM-DAYS < 1                                        10020001
100600         MOVE 1 TO H-PERDIEM-DAYS.                                10030001
100700     ADD 1 TO H-PERDIEM-DAYS.                                     10040001
100800                                                                  10050001
100900     PERFORM 3600-CALC-OUTLIER.                                   10060001
101000                                                                  10070001
101100     IF PAY-PERDIEM-DAYS                                          10080000
101200         IF  H-PERDIEM-DAYS < H-ALOS                              10090001
101300             IF  NOT (B-DRG = 385 OR 456)                         10100000
101400                 PERFORM 3500-CALC-PERDIEM-AMT                    10110000
101500                 MOVE 03 TO PPS-RTC.                              10120000
101600                                                                  10130000
101700     IF  PAY-PERDIEM-DAYS                                         10140000
101800         IF  H-OPER-OUTCST-PART > 0                               10150000
101900             MOVE H-OPER-OUTCST-PART TO                           10160000
102000                  H-OPER-OUTLIER-PART                             10170000
102100             MOVE 05 TO PPS-RTC                                   10180000
102200         ELSE                                                     10190000
102300         IF  PPS-RTC NOT = 03                                     10200000
102400             MOVE 00 TO PPS-RTC                                   10210000
102500             MOVE 0  TO H-OPER-OUTLIER-PART.                      10220000
102600                                                                  10230000
102700     IF  PAY-PERDIEM-DAYS                                         10240000
102800         IF  H-CAPI-OUTCST-PART > 0                               10250000
102900             MOVE H-CAPI-OUTCST-PART TO                           10260000
103000                  H-CAPI-OUTLIER-PART                             10270000
103100             MOVE 05 TO PPS-RTC                                   10280000
103200         ELSE                                                     10290000
103300         IF  PPS-RTC NOT = 03                                     10300000
103400             MOVE 0  TO H-CAPI-OUTLIER-PART.                      10310000
103500                                                                  10320000
103600     IF  PAY-XFER-NO-COST                                         10330000
103700         MOVE 0  TO H-OPER-OUTLIER-PART                           10340000
103800                    H-CAPI-OUTLIER-PART                           10350000
103900         MOVE 00 TO PPS-RTC                                       10360000
104000         IF H-PERDIEM-DAYS < H-ALOS                               10370001
104100            IF  NOT (B-DRG = 385 OR 456)                          10380000
104200                PERFORM 3500-CALC-PERDIEM-AMT                     10390000
104300                MOVE 06 TO PPS-RTC.                               10400000
104400                                                                  10410000
104500     MOVE 1 TO H-DSCHG-FRCTN.                                     10420000
104600                                                                  10430000
104700     IF  (PAY-PERDIEM-DAYS OR                                     10440000
104800          PAY-XFER-NO-COST)                                       10450000
104900          COMPUTE H-DSCHG-FRCTN = H-PERDIEM-DAYS / H-ALOS         10460001
105000          IF H-DSCHG-FRCTN > 1                                    10470000
105100             MOVE 1 TO H-DSCHG-FRCTN.                             10480000
105200                                                                  10490000
105300     COMPUTE H-DRG-WT-FRCTN = H-DSCHG-FRCTN * H-DRG-WT.           10500000
105400                                                                  10510000
105500***********************************************************       10520000
105600***  DETERMINES THE FEDERAL AMOUNT THAT WOULD BE PAID IF          10530000
105700***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          10540000
105800                                                                  10550000
105900     COMPUTE H-CAPI2-B-FSP-PART = H-CAPI-FSP-PART.                10560000
106000                                                                  10570000
106100***********************************************************       10580000
106200     IF  PPS-RTC < 50                                             10590000
106300         PERFORM 3800-CALC-TOT-AMT                                10600000
106400     ELSE                                                         10610000
106500         MOVE 0 TO PPS-OPER-HSP-PART                              10620000
106600                   PPS-OPER-FSP-PART                              10630000
106700                   PPS-OPER-OUTLIER-PART                          10640000
106800                   PPS-OUTLIER-DAYS                               10650000
106900                   PPS-REG-DAYS-USED                              10660000
107000                   PPS-LTR-DAYS-USED                              10670000
107100                   PPS-TOTAL-PAYMENT                              10680000
107200                   PPS-OPER-DSH-ADJ                               10690000
107300                   PPS-OPER-IME-ADJ                               10700000
107400                   H-DSCHG-FRCTN                                  10710000
107500                   H-DRG-WT-FRCTN                                 10720000
107600                   HOLD-CAPITAL-VARIABLES                         10730000
107700                   HOLD-CAPITAL2-VARIABLES.                       10740000
107800                                                                  10750000
107900 3100-CALC-STAY-UTILIZATION.                                      10760000
108000     IF  H-REG-DAYS > 0                                           10770000
108100         IF  H-REG-DAYS < H-DAYS-CUTOFF                           10780000
108200             MOVE H-REG-DAYS TO PPS-REG-DAYS-USED                 10790000
108300             MOVE 0          TO H-REG-DAYS                        10800000
108400         ELSE                                                     10810000
108500             MOVE H-DAYS-CUTOFF TO PPS-REG-DAYS-USED              10820000
108600             SUBTRACT H-DAYS-CUTOFF FROM H-REG-DAYS               10830000
108700     ELSE                                                         10840000
108800     IF  H-LTR-DAYS < H-DAYS-CUTOFF                               10850000
108900         MOVE H-LTR-DAYS TO PPS-LTR-DAYS-USED                     10860000
109000         MOVE 0          TO H-LTR-DAYS                            10870000
109100     ELSE                                                         10880000
109200         MOVE H-DAYS-CUTOFF TO PPS-LTR-DAYS-USED                  10890000
109300         SUBTRACT H-DAYS-CUTOFF FROM H-LTR-DAYS.                  10900000
109400                                                                  10910000
109500     IF  B-LOS > H-DAYS-CUTOFF                                    10920000
109600         PERFORM 3200-CALC-OUTLIER-UTILIZATION.                   10930000
109700                                                                  10940000
109800 3200-CALC-OUTLIER-UTILIZATION.                                   10950000
109900     COMPUTE PPS-OUTLIER-DAYS =                                   10960000
110000         B-LOS - H-DAYS-CUTOFF.                                   10970000
110100                                                                  10980000
110200     IF  (H-REG-DAYS + H-LTR-DAYS) < PPS-OUTLIER-DAYS             10990000
110300         COMPUTE PPS-OUTLIER-DAYS =                               11000000
110400             H-REG-DAYS + H-LTR-DAYS                              11010000
110500         ADD H-REG-DAYS TO PPS-REG-DAYS-USED                      11020000
110600         ADD H-LTR-DAYS TO PPS-LTR-DAYS-USED                      11030000
110700     ELSE                                                         11040000
110800     IF  H-REG-DAYS < PPS-OUTLIER-DAYS                            11050000
110900         ADD H-REG-DAYS TO PPS-REG-DAYS-USED                      11060000
111000         COMPUTE PPS-LTR-DAYS-USED =                              11070000
111100             PPS-LTR-DAYS-USED + (PPS-OUTLIER-DAYS -              11080000
111200                                  H-REG-DAYS)                     11090000
111300     ELSE                                                         11100000
111400         ADD PPS-OUTLIER-DAYS TO PPS-REG-DAYS-USED.               11110000
111500                                                                  11120000
111600     IF  B-REVIEW-CODE = 03                                       11130000
111700         IF  PPS-REG-DAYS-USED > 0                                11140000
111800             MOVE 0 TO PPS-LTR-DAYS-USED.                         11150000
111900                                                                  11160000
112000 3300-CALC-OPER-FSP-AMT.                                          11170000
112100***********************************************************       11180000
112200***  OPERATING FSP CALCULATION                                    11190000
112300                                                                  11200000
112400     COMPUTE H-OPER-FSP-PART ROUNDED =                            11210000
112500         (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +               11220000
112600         H-NAT-NLABOR * H-OPER-COLA) * H-DRG-WT)                  11230000
112700                           +                                      11240000
112800         (H-REG-PCT * (H-REG-LABOR * H-WAGE-INDEX +               11250000
112900         H-REG-NLABOR * H-OPER-COLA) * H-DRG-WT).                 11260000
113000                                                                  11270001
113100                                                                  11280001
113200 3450-CALC-ADDITIONAL-HSP.                                        11290000
113300***********************************************************       11300000
113400*    OBRA 89 CALCULATE ADDITIONAL HSP PAYMENT FOR                 11310000
113500*    SOLE COMMUNITY                                               11320000
113600*    AND ESSENTIAL ACCESS COMMUNITY HOSPITALS (EACH)              11330000
113700*    NOW REIMBURSED WITH 100% NATIONAL FEDERAL RATES              11340000
113800***********************************************************       11350000
113900**** CHANGE ESTIMATED OUTLIER FACTORS WHEN FED RATES CHANGE       11360000
114000****    USE ACTUAL FEDERAL REGISTER NUMBER                        11370000
114100                                                                  11380000
114200     MOVE 0.948950 TO H-OUTLIER-FACT.                             11390001
114300***************************************************************   11400000
114400***         GET THE UPDATING FACTOR                               11410000
114500                                                                  11420000
114600     MOVE 0.999851 TO H-BUDG-NUTR93.                              11430001
114700     MOVE 0.999003 TO H-BUDG-NUTR94.                              11440001
114800     MOVE 0.998050 TO H-BUDG-NUTR95.                              11450000
114900     MOVE 0.999306 TO H-BUDG-NUTR96.                              11460001
115000                                                                  11470000
115100     COMPUTE H-UPDATE-FACTOR ROUNDED =                            11480000
115200        (1.014 * H-BUDG-NUTR93 * H-BUDG-NUTR94 *                  11490001
115300                 H-BUDG-NUTR95 * H-BUDG-NUTR96 * 1.015).          11500001
115400                                                                  11510000
115500     COMPUTE H-HSP-RATE ROUNDED =                                 11520000
115600         H-CMI-ADJ-CPD * H-UPDATE-FACTOR.                         11530000
115700                                                                  11540000
115800     COMPUTE H-FSP-RATE ROUNDED =                                 11550000
115900         ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +              11560000
116000         H-NAT-NLABOR * H-OPER-COLA))                             11570000
116100                           +                                      11580000
116200          (H-REG-PCT * (H-REG-LABOR * H-WAGE-INDEX +              11590000
116300         H-REG-NLABOR * H-OPER-COLA)))                            11600000
116400                           *                                      11610000
116500       ((1 + H-OPER-IME-TEACH + H-OPER-DSH) / H-OUTLIER-FACT).    11620000
116600                                                                  11630000
116700     IF  H-HSP-RATE > H-FSP-RATE                                  11640000
116800           COMPUTE H-OPER-HSP-PART =                              11650000
116900             (H-HSP-RATE - H-FSP-RATE) * H-DRG-WT                 11660000
117000     ELSE                                                         11670000
117100         MOVE 0 TO H-OPER-HSP-PART.                               11680000
117200                                                                  11690000
117300***************************************************************   11700000
117400***        IF MDH IS REVIVED --- REPLACE THIS CODE                11710000
117500***  IF  H-HSP-RATE > H-FSP-RATE                                  11720000
117600***      IF P-PROVIDER-TYPE = '14' OR '15'                        11730000
117700***         COMPUTE H-OPER-HSP-PART =                             11740000
117800***            (H-HSP-RATE - H-FSP-RATE) * H-DRG-WT * .5.         11750000
117900***************************************************************   11760000
118000                                                                  11770000
118100 3500-CALC-PERDIEM-AMT.                                           11780000
118200***********************************************************       11790000
118300***  OPERATING PERDIEM-AMT CALCULATION                            11800000
118400***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              11810000
118500                                                                  11820000
118600     COMPUTE H-OPER-HSP-PART ROUNDED =                            11830000
118700        H-OPER-HSP-PART / H-ALOS * H-PERDIEM-DAYS                 11840001
118800        ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART.                  11850000
118900                                                                  11860000
119000     COMPUTE H-OPER-FSP-PART ROUNDED =                            11870000
119100        H-OPER-FSP-PART / H-ALOS * H-PERDIEM-DAYS                 11880001
119200        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  11890000
119300                                                                  11900000
119400***********************************************************       11910000
119500***  CAPITAL PERDIEM-AMT CALCULATION                              11920000
119600***  CAPITAL HSP AND FSP CALCULATION FOR TRANSFERS                11930000
119700                                                                  11940000
119800     COMPUTE H-CAPI-HSP-PART ROUNDED =                            11950000
119900        H-CAPI-HSP-PART / H-ALOS * H-PERDIEM-DAYS                 11960001
120000        ON SIZE ERROR MOVE 0 TO H-CAPI-HSP-PART.                  11970000
120100                                                                  11980000
120200     COMPUTE H-CAPI-FSP-PART ROUNDED =                            11990000
120300        H-CAPI-FSP-PART / H-ALOS * H-PERDIEM-DAYS                 12000001
120400        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  12010000
120500                                                                  12020000
120600***********************************************************       12030000
120700***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                12040000
120800                                                                  12050000
120900     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        12060000
121000        H-CAPI-OLD-HARMLESS / H-ALOS * H-PERDIEM-DAYS             12070001
121100        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              12080000
121200                                                                  12090000
121300 3600-CALC-OUTLIER.                                               12100000
121400     MOVE 0.44 TO H-DAYOUT-PCT.                                   12110001
121500                                                                  12120000
121600     MOVE 0.80 TO H-CSTOUT-PCT.                                   12130000
121700                                                                  12140000
121800     IF  B-DRG = 456 OR 457 OR 458 OR 459 OR 460 OR 472           12150000
121900             MOVE 0.90 TO H-CSTOUT-PCT.                           12160000
122000                                                                  12170000
122100     MOVE 0.7140   TO H-LABOR-PCT.                                12180000
122200     MOVE 0.2860   TO H-NLABOR-PCT.                               12190000
122300                                                                  12200000
122400     IF  P-OPER-CSTCHG-RATIO NUMERIC                              12210000
122500             MOVE P-OPER-CSTCHG-RATIO TO H-OPER-CSTCHG-RATIO      12220000
122600     ELSE                                                         12230000
122700             MOVE 0.000 TO H-OPER-CSTCHG-RATIO.                   12240000
122800                                                                  12250000
122900     IF P-CAPI-CSTCHG-RATIO NUMERIC                               12260000
123000             MOVE P-CAPI-CSTCHG-RATIO TO H-CAPI-CSTCHG-RATIO      12270000
123100     ELSE                                                         12280000
123200             MOVE 0.000 TO H-CAPI-CSTCHG-RATIO.                   12290000
123300                                                                  12300000
123400***********************************************************       12310000
123500***  OPERATING DAY OUTLIER CALCULATION                            12320000
123600                                                                  12330000
123700     IF  PPS-OUTLIER-DAYS > 0                                     12340000
123800        COMPUTE H-OPER-OUTDAY-PART =                              12350000
123900            H-DAYOUT-PCT *  H-OPER-FSP-PART / H-ARITH-ALOS        12360000
124000                                       * PPS-OUTLIER-DAYS         12370000
124100            ON SIZE ERROR MOVE 0 TO H-OPER-OUTDAY-PART.           12380000
124200                                                                  12390000
124300***********************************************************       12400000
124400***********************************************************       12410000
124500***  CAPITAL PAYMENT METHOD B                                     12420000
124600                                                                  12430000
124700     IF W-SIZE = 'L'                                              12440000
124800        MOVE 1.03 TO H-CAPI-LARG-URBAN                            12450000
124900     ELSE                                                         12460000
125000        MOVE 1.00 TO H-CAPI-LARG-URBAN.                           12470001
125100                                                                  12480000
125200     COMPUTE H-CAPI-GAF = (H-WAGE-INDEX ** .6848).                12490000
125300                                                                  12500000
125400     COMPUTE H-CAPI-COLA =                                        12510000
125500                     (.3152 * (H-OPER-COLA - 1) + 1).             12520000
125600                                                                  12530000
125700     MOVE 0355.35 TO H-PUERTO-RICO-RATE.                          12540001
125800     MOVE 0461.96 TO H-FEDERAL-RATE.                              12550001
125900                                                                  12560000
126000     IF P-STATE = 40                                              12570000
126100        COMPUTE  H-CAPI-FED-RATE =                                12580000
126200                      (.75 * H-PUERTO-RICO-RATE) +                12590000
126300                      (.25 * H-FEDERAL-RATE)                      12600000
126400     ELSE                                                         12610000
126500        MOVE H-FEDERAL-RATE TO H-CAPI-FED-RATE.                   12620000
126600                                                                  12630000
126700***********************************************************       12640000
126800***  CAPITAL HSP CALCULATION                                      12650000
126900                                                                  12660000
127000     MOVE 0.9784 TO H-HSP-UPDATE94.                               12670001
127100     MOVE 1.0005 TO H-HSP-UPDATE95.                               12680001
127200     MOVE 1.2110 TO H-HSP-UPDATE96.                               12690001
127300                                                                  12700001
127400     COMPUTE H-ACCUM-TO-HSP = (H-HSP-UPDATE94 *                   12710001
127500                               H-HSP-UPDATE95 *                   12720001
127600                               H-HSP-UPDATE96).                   12730001
127700                                                                  12740001
127800     COMPUTE H-CAPI-HSP-PART = (H-DRG-WT *                        12750000
127900                   P-CAPI-HOSP-SPEC-RATE * H-ACCUM-TO-HSP).       12760000
128000***********************************************************       12770000
128100***  CAPITAL FSP CALCULATION                                      12780000
128200                                                                  12790000
128300     COMPUTE H-CAPI-FSP-PART = H-DRG-WT * H-CAPI-FED-RATE *       12800000
128400                               H-CAPI-COLA * H-CAPI-GAF *         12810000
128500                               H-CAPI-LARG-URBAN.                 12820000
128600                                                                  12830000
128700***********************************************************       12840000
128800***  CAPITAL PAYMENT METHOD A                                     12850000
128900                                                                  12860000
129000     IF SCH-REBASED-FY90 OR EACH                                  12870000
129100        MOVE 1.00 TO H-CAPI-SCH                                   12880000
129200     ELSE                                                         12890000
129300        MOVE 0.85 TO H-CAPI-SCH.                                  12900000
129400                                                                  12910000
129500***********************************************************       12920000
129600***********  CAPITAL OLD-HARMLESS CALCULATION ***********         12930000
129700                                                                  12940000
129800     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        12950000
129900                    (P-CAPI-OLD-HARM-RATE *                       12960000
130000                    H-CAPI-SCH).                                  12970000
130100                                                                  12980000
130200***********************************************************       12990000
130300***********************************************************       13000000
130400***  CAPITAL DAY OUTLIER CALCULATION                              13010000
130500                                                                  13020000
130600     IF  PPS-OUTLIER-DAYS > 0                                     13030000
130700         COMPUTE H-CAPI-OUTDAY-PART =                             13040000
130800            H-DAYOUT-PCT * H-CAPI-FSP-PART / H-ARITH-ALOS         13050000
130900                                       * PPS-OUTLIER-DAYS         13060000
131000            ON SIZE ERROR MOVE 0 TO H-CAPI-OUTDAY-PART.           13070000
131100                                                                  13080000
131200     IF  H-CAPI-OUTDAY-PART  > 0                                  13090000
131300         IF P-CAPI-PPS-PAY-CODE = 'A'                             13100000
131400             COMPUTE H-CAPI-OUTDAY-PART =                         13110000
131500                 H-CAPI-OUTDAY-PART * P-CAPI-NEW-HARM-RATIO       13120000
131600             ON SIZE ERROR MOVE 0 TO H-CAPI-OUTDAY-PART.          13130000
131700                                                                  13140000
131800     IF  H-CAPI-OUTDAY-PART  > 0                                  13150000
131900         IF P-CAPI-PPS-PAY-CODE = 'C'                             13160000
132000             COMPUTE H-CAPI-OUTDAY-PART =                         13170000
132100                    (H-CAPI-OUTDAY-PART * H-CAPI-PAYCDE-PCT1)     13180000
132200             ON SIZE ERROR MOVE 0 TO H-CAPI-OUTDAY-PART.          13190000
132300                                                                  13200000
132400***********************************************************       13210000
132500***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               13220000
132600                                                                  13230000
132700     IF H-CAPI-CSTCHG-RATIO > 0 OR                                13240000
132800       H-OPER-CSTCHG-RATIO > 0                                    13250000
132900        COMPUTE H-OPER-SHARE-DOLL-THRESHOLD =                     13260000
133000                H-OPER-CSTCHG-RATIO /                             13270000
133100               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        13280000
133200        COMPUTE H-CAPI-SHARE-DOLL-THRESHOLD =                     13290000
133300                H-CAPI-CSTCHG-RATIO /                             13300000
133400               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        13310000
133500     ELSE                                                         13320000
133600         MOVE 0 TO H-OPER-SHARE-DOLL-THRESHOLD                    13330000
133700                   H-CAPI-SHARE-DOLL-THRESHOLD.                   13340000
133800                                                                  13350000
133900     MOVE 15150.00 TO H-CST-THRESH.                               13360001
134000     MOVE 13800.00 TO H-PRE-CAPI-THRESH.                          13370001
134100                                                                  13380000
134200     COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                    13390000
134300        ((H-CST-THRESH * H-LABOR-PCT  * H-WAGE-INDEX) +           13400000
134400         (H-CST-THRESH * H-NLABOR-PCT * H-OPER-COLA)) *           13410000
134500          H-OPER-SHARE-DOLL-THRESHOLD.                            13420000
134600                                                                  13430000
134700***********************************************************       13440000
134800***  DIFFERENT THRESHOLD   PRE-CAPITAL                            13450000
134900                                                                  13460000
135000     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          13470000
135100        COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                 13480000
135200        (H-PRE-CAPI-THRESH * H-LABOR-PCT * H-WAGE-INDEX) +        13490000
135300        (H-PRE-CAPI-THRESH * H-NLABOR-PCT * H-OPER-COLA).         13500000
135400***********************************************************       13510000
135500                                                                  13520000
135600     COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                    13530000
135700          H-CST-THRESH * H-CAPI-GAF * H-CAPI-LARG-URBAN *         13540000
135800          H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA.              13550000
135900                                                                  13560000
136000     COMPUTE H-OPER-COST-OUTLIER ROUNDED =                        13570000
136100          H-OPER-FSP-PART + H-OPER-DOLLAR-THRESHOLD.              13580000
136200                                                                  13590000
136300     COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                        13600000
136400          H-CAPI-FSP-PART + H-CAPI-DOLLAR-THRESHOLD.              13610000
136500                                                                  13620000
136600     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          13630000
136700         MOVE 0 TO H-CAPI-COST-OUTLIER.                           13640000
136800                                                                  13650000
136900     IF B-REVIEW-CODE = '03'  AND H-PERDIEM-DAYS < H-ALOS         13660001
137000        COMPUTE H-OPER-COST-OUTLIER ROUNDED =                     13670000
137100                (H-OPER-COST-OUTLIER * H-PERDIEM-DAYS / H-ALOS)   13680001
137200                ON SIZE ERROR MOVE 0 TO H-OPER-COST-OUTLIER.      13690000
137300                                                                  13700000
137400     IF B-REVIEW-CODE = '03'  AND H-PERDIEM-DAYS < H-ALOS         13710001
137500        COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                     13720000
137600                (H-CAPI-COST-OUTLIER * H-PERDIEM-DAYS / H-ALOS)   13730001
137700                ON SIZE ERROR MOVE 0 TO H-CAPI-COST-OUTLIER.      13740000
137800                                                                  13750000
137900***********************************************************       13760000
138000***  CAPITAL DSH CALCULATION                                      13770000
138100     MOVE 0 TO H-CAPI-DSH.                                        13780000
138200                                                                  13790000
138300     IF P-BED-SIZE NOT NUMERIC                                    13800000
138400         MOVE 0 TO P-BED-SIZE.                                    13810000
138500                                                                  13820000
138600     IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE > 99                 13830000
138700         COMPUTE H-CAPI-DSH ROUNDED = 2.7183 **                   13840000
138800                  (.2025 * (P-SSI-RATIO                           13850000
138900                          + P-MEDICAID-RATIO)) - 1.               13860000
139000                                                                  13870000
139100***********************************************************       13880000
139200***  OPERATING COST CALCULATION                                   13890000
139300                                                                  13900000
139400     COMPUTE H-OPER-BILL-COSTS ROUNDED =                          13910000
139500         B-CHARGES-CLAIMED * H-OPER-CSTCHG-RATIO /                13920000
139600         (1 + H-OPER-IME-TEACH + H-OPER-DSH)                      13930000
139700         ON SIZE ERROR MOVE 0 TO H-OPER-BILL-COSTS.               13940000
139800                                                                  13950000
139900     IF  H-OPER-BILL-COSTS > H-OPER-COST-OUTLIER                  13960000
140000         COMPUTE H-OPER-OUTCST-PART =                             13970000
140100         H-CSTOUT-PCT * (H-OPER-BILL-COSTS -                      13980000
140200                         H-OPER-COST-OUTLIER).                    13990000
140300                                                                  14000000
140400     IF PAY-WITHOUT-COST                                          14010000
140500         MOVE 0 TO H-OPER-OUTCST-PART.                            14020000
140600                                                                  14030000
140700***********************************************************       14040000
140800***  CAPITAL IME TEACH CALCULATION                                14050000
140900                                                                  14060000
141000     MOVE 0 TO H-WK-CAPI-IME-TEACH.                               14070000
141100                                                                  14080000
141200     IF P-CAPI-IME NUMERIC                                        14090000
141300        COMPUTE H-WK-CAPI-IME-TEACH =                             14100000
141400          (2.7183 ** (.2822 * P-CAPI-IME)) - 1.                   14110000
141500                                                                  14120000
141600***********************************************************       14130000
141700***  CAPITAL COST CALCULATION                                     14140000
141800                                                                  14150000
141900     COMPUTE H-CAPI-BILL-COSTS ROUNDED =                          14160000
142000             B-CHARGES-CLAIMED * H-CAPI-CSTCHG-RATIO /            14170000
142100            (1 + H-WK-CAPI-IME-TEACH + H-CAPI-DSH)                14180000
142200         ON SIZE ERROR MOVE 0 TO H-CAPI-BILL-COSTS.               14190000
142300                                                                  14200000
142400     IF  H-CAPI-BILL-COSTS > H-CAPI-COST-OUTLIER                  14210000
142500         COMPUTE H-CAPI-OUTCST-PART =                             14220000
142600         H-CSTOUT-PCT * (H-CAPI-BILL-COSTS -                      14230000
142700                         H-CAPI-COST-OUTLIER).                    14240000
142800                                                                  14250000
142900     IF P-CAPI-PPS-PAY-CODE = 'A'                                 14260000
143000       COMPUTE H-CAPI-OUTCST-PART =                               14270000
143100              (H-CAPI-OUTCST-PART * P-CAPI-NEW-HARM-RATIO).       14280000
143200                                                                  14290000
143300     IF P-CAPI-PPS-PAY-CODE = 'C'                                 14300000
143400        COMPUTE H-CAPI-OUTCST-PART =                              14310000
143500               (H-CAPI-OUTCST-PART * H-CAPI-PAYCDE-PCT1).         14320000
143600                                                                  14330000
143700     IF (H-CAPI-BILL-COSTS   + H-OPER-BILL-COSTS) <               14340000
143800        (H-CAPI-COST-OUTLIER + H-OPER-COST-OUTLIER)               14350000
143900        MOVE 0 TO H-CAPI-OUTCST-PART                              14360000
144000                  H-OPER-OUTCST-PART.                             14370000
144100                                                                  14380000
144200     IF PAY-WITHOUT-COST                                          14390000
144300         MOVE 0 TO H-CAPI-OUTCST-PART.                            14400000
144400                                                                  14410000
144500***********************************************************       14420000
144600***  DETERMINES THE BILL TO BE EITHER COST OR DAY OUTLIER         14430000
144700***     GREATER OF DAY OR COST OPERATING AND CAPITAL              14440000
144800                                                                  14450000
144900     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          14460000
145000         MOVE 0 TO H-CAPI-OUTDAY-PART                             14470000
145100                   H-CAPI-OUTCST-PART.                            14480000
145200                                                                  14490000
145300      IF (H-OPER-OUTDAY-PART + H-CAPI-OUTDAY-PART) > 0 OR         14500000
145400         (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0            14510000
145500         IF (H-OPER-OUTDAY-PART + H-CAPI-OUTDAY-PART) >           14520000
145600            (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART)             14530000
145700                 MOVE H-OPER-OUTDAY-PART TO                       14540000
145800                      H-OPER-OUTLIER-PART                         14550000
145900                 MOVE H-CAPI-OUTDAY-PART TO                       14560000
146000                      H-CAPI-OUTLIER-PART                         14570000
146100                 MOVE 01 TO PPS-RTC                               14580000
146200             ELSE                                                 14590000
146300                 MOVE H-OPER-OUTCST-PART TO                       14600000
146400                      H-OPER-OUTLIER-PART                         14610000
146500                 MOVE H-CAPI-OUTCST-PART TO                       14620000
146600                      H-CAPI-OUTLIER-PART                         14630000
146700                 MOVE 02 TO PPS-RTC                               14640000
146800                 IF B-COVERED-DAYS > H-DAYS-CUTOFF                14650000
146900                    IF (H-REG-DAYS                                14660000
147000                            +                                     14670000
147100                        H-LTR-DAYS)   <                           14680000
147200                       (B-COVERED-DAYS - H-DAYS-CUTOFF)           14690000
147300                       MOVE 66 TO PPS-RTC.                        14700000
147400                                                                  14710000
147500***********************************************************       14720000
147600***  DETERMINES THE OUTLIER AMOUNT THAT WOULD BE PAID IF          14730000
147700***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          14740000
147800                                                                  14750000
147900     IF P-CAPI-PPS-PAY-CODE = 'A'                                 14760000
148000        COMPUTE H-CAPI2-B-OUTLIER-PART =                          14770000
148100                H-CAPI-OUTLIER-PART / P-CAPI-NEW-HARM-RATIO       14780000
148200         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          14790000
148300                                                                  14800000
148400     IF P-CAPI-PPS-PAY-CODE = 'B'                                 14810000
148500        COMPUTE H-CAPI2-B-OUTLIER-PART =                          14820000
148600                H-CAPI-OUTLIER-PART.                              14830000
148700                                                                  14840000
148800     IF P-CAPI-PPS-PAY-CODE = 'C'                                 14850000
148900        COMPUTE H-CAPI2-B-OUTLIER-PART =                          14860000
149000                H-CAPI-OUTLIER-PART / H-CAPI-PAYCDE-PCT1          14870000
149100         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          14880000
149200***********************************************************       14890000
149300                                                                  14900000
149400 3800-CALC-TOT-AMT.                                               14910000
149500                                                                  14920000
149600***********************************************************       14930000
149700***  CALCULATE FINAL TOTALS FOR OPERATING                         14940000
149800                                                                  14950000
149900     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          14960000
150000         H-OPER-HSP-PCT * H-OPER-HSP-PART.                        14970000
150100                                                                  14980000
150200     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          14990000
150300         H-OPER-FSP-PCT * H-OPER-FSP-PART.                        15000000
150400                                                                  15010000
150500     COMPUTE PPS-OPER-OUTLIER-PART ROUNDED =                      15020000
150600             H-OPER-FSP-PCT * H-OPER-OUTLIER-PART.                15030000
150700                                                                  15040000
150800     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               15050000
150900                                                                  15060000
151000     IF  H-OPER-DSH NUMERIC                                       15070000
151100             COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                   15080000
151200             (PPS-OPER-FSP-PART + PPS-OPER-OUTLIER-PART)          15090000
151300              * H-OPER-DSH.                                       15100000
151400                                                                  15110000
151500     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           15120000
151600         (PPS-OPER-FSP-PART + PPS-OPER-OUTLIER-PART) *            15130000
151700                 H-OPER-IME-TEACH.                                15140000
151800                                                                  15150000
151900***********************************************************       15160000
152000***  CALCULATE FINAL TOTALS FOR CAPITAL                           15170000
152100                                                                  15180000
152200     MOVE P-CAPI-PPS-PAY-CODE  TO H-CAPI2-PAY-CODE.               15190000
152300                                                                  15200000
152400     IF P-CAPI-PPS-PAY-CODE = 'A'                                 15210000
152500        MOVE P-CAPI-NEW-HARM-RATIO TO H-CAPI-FSP-PCT              15220000
152600        MOVE 0.00 TO H-CAPI-HSP-PCT.                              15230000
152700                                                                  15240000
152800     IF P-CAPI-PPS-PAY-CODE = 'B'                                 15250000
152900        MOVE 0    TO H-CAPI-OLD-HARMLESS                          15260000
153000        MOVE 1.00 TO H-CAPI-FSP-PCT                               15270000
153100        MOVE 0.00 TO H-CAPI-HSP-PCT.                              15280000
153200                                                                  15290000
153300     IF P-CAPI-PPS-PAY-CODE = 'C'                                 15300000
153400        MOVE 0    TO H-CAPI-OLD-HARMLESS                          15310000
153500        MOVE H-CAPI-PAYCDE-PCT1 TO H-CAPI-FSP-PCT                 15320000
153600        MOVE H-CAPI-PAYCDE-PCT2 TO H-CAPI-HSP-PCT.                15330000
153700                                                                  15340000
153800     COMPUTE H-CAPI-HSP ROUNDED =                                 15350000
153900         H-CAPI-HSP-PCT * H-CAPI-HSP-PART.                        15360000
154000                                                                  15370000
154100     COMPUTE H-CAPI-FSP ROUNDED =                                 15380000
154200         H-CAPI-FSP-PCT * H-CAPI-FSP-PART.                        15390000
154300                                                                  15400000
154400     MOVE P-CAPI-EXCEPTIONS TO H-CAPI-EXCEPTIONS.                 15410000
154500                                                                  15420000
154600     COMPUTE H-CAPI-OUTLIER ROUNDED =                             15430000
154700             1.00 * H-CAPI-OUTLIER-PART.                          15440000
154800                                                                  15450000
154900     COMPUTE H-CAPI2-B-OUTLIER ROUNDED =                          15460000
155000             1.00 * H-CAPI2-B-OUTLIER-PART.                       15470000
155100                                                                  15480000
155200     COMPUTE H-CAPI2-B-FSP ROUNDED =                              15490000
155300             1.00 * H-CAPI2-B-FSP-PART.                           15500000
155400                                                                  15510000
155500     MOVE H-CAPI-OLD-HARMLESS TO H-CAPI-OLD-HARM.                 15520000
155600                                                                  15530000
155700     COMPUTE H-CAPI-DSH-ADJ ROUNDED =                             15540000
155800             (H-CAPI-FSP + H-CAPI-OUTLIER-PART)                   15550000
155900              * H-CAPI-DSH.                                       15560000
156000                                                                  15570000
156100     COMPUTE H-CAPI-IME-ADJ ROUNDED =                             15580000
156200         (H-CAPI-FSP + H-CAPI-OUTLIER-PART) *                     15590000
156300                 H-WK-CAPI-IME-TEACH.                             15600000
156400                                                                  15610000
156500***********************************************************       15620000
156600***  IF CAPITAL IS NOT IN EFFECT FOR GIVEN PROVIDER               15630000
156700***        THIS ZEROES OUT ALL CAPITAL DATA                       15640000
156800                                                                  15650000
156900     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          15660000
157000        MOVE ALL '0' TO HOLD-CAPITAL-VARIABLES.                   15670000
157100                                                                  15680000
157200     COMPUTE H-CAPI-TOTAL-PAY =                                   15690000
157300             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        15700000
157400             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    15710000
157500             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM.                    15720000
157600                                                                  15730000
157700***********************************************************       15740000
157800***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             15750000
157900                                                                  15760000
158000     COMPUTE PPS-TOTAL-PAYMENT =                                  15770000
158100             PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +              15780000
158200             PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +           15790000
158300             PPS-OPER-IME-ADJ                                     15800000
158400                           +                                      15810000
158500                  H-CAPI-TOTAL-PAY.                               15820000
158600                                                                  15830000
158700 3900-CALC-OPER-DSH.                                              15840000
158800***********************************************************       15850000
158900***  OPERATING DSH CALCULATION                                    15860000
159000                                                                  15870000
159100      MOVE .00 TO H-OPER-DSH.                                     15880000
159200                                                                  15890000
159300      COMPUTE H-WK-OPER-DSH = (P-SSI-RATIO                        15900000
159400                                     + P-MEDICAID-RATIO).         15910000
159500                                                                  15920000
159600      IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE < 100               15930000
159700                               AND H-WK-OPER-DSH > .3999          15940000
159800        MOVE .05 TO H-OPER-DSH.                                   15950000
159900                                                                  15960000
160000      IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE > 99                15970000
160100                               AND H-WK-OPER-DSH > .1499          15980000
160200                               AND H-WK-OPER-DSH < .2021          15990000
160300        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        16000000
160400                                      * .65 + .025.               16010000
160500                                                                  16020000
160600      IF W-SIZE = 'R'          AND P-BED-SIZE > 499               16030000
160700                               AND H-WK-OPER-DSH > .1499          16040000
160800                               AND H-WK-OPER-DSH < .2021          16050000
160900        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        16060000
161000                                 * .65 + .025.                    16070000
161100                                                                  16080000
161200      IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE > 99                16090000
161300                               AND H-WK-OPER-DSH > .202           16100000
161400        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       16110000
161500                                 * .825 + .0588.                  16120000
161600                                                                  16130000
161700      IF W-SIZE = 'R'          AND P-BED-SIZE > 499               16140000
161800                               AND H-WK-OPER-DSH > .202           16150000
161900        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       16160000
162000                                 * .825 + .0588.                  16170000
162100                                                                  16180000
162200      IF W-SIZE = 'R'          AND P-BED-SIZE < 101               16190000
162300                               AND H-WK-OPER-DSH > .4499          16200000
162400        MOVE .04 TO H-OPER-DSH.                                   16210000
162500                                                                  16220000
162600      IF W-SIZE = 'R'          AND P-BED-SIZE > 100               16230000
162700                               AND P-BED-SIZE < 500               16240000
162800                               AND H-WK-OPER-DSH > .2999          16250000
162900        MOVE .04 TO H-OPER-DSH.                                   16260000
163000                                                                  16270000
163100      IF W-SIZE = 'R'                                             16280000
163200         IF (P-PROVIDER-TYPE = '16' OR '21')                      16290000
163300                               AND H-WK-OPER-DSH > .2999          16300000
163400                               AND P-BED-SIZE < 500               16310000
163500            MOVE .10 TO H-OPER-DSH.                               16320000
163600                                                                  16330000
163700      IF W-SIZE = 'R'                                             16340000
163800         IF (P-PROVIDER-TYPE = '07')                              16350000
163900                               AND H-WK-OPER-DSH > .2999          16360000
164000                               AND P-BED-SIZE > 100               16370000
164100                               AND P-BED-SIZE < 500               16380000
164200            COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .3)     16390000
164300                                 * .6 + .04.                      16400000
164400                                                                  16410000
164500      IF W-SIZE = 'R'                                             16420000
164600         IF (P-PROVIDER-TYPE = '17' OR '22')                      16430000
164700                               AND H-WK-OPER-DSH > .2999          16440000
164800                               AND P-BED-SIZE < 500               16450000
164900            COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .3)     16460000
165000                                 * .6 + .04.                      16470000
165100                                                                  16480000
165200      IF W-SIZE = 'R'                                             16490000
165300         IF (P-PROVIDER-TYPE = '17' OR '22')                      16500000
165400                               AND H-WK-OPER-DSH > .2999          16510000
165500                               AND P-BED-SIZE < 500               16520000
165600                               AND H-OPER-DSH < .10               16530000
165700            MOVE .10 TO H-OPER-DSH.                               16540000
165800                                                                  16550000
165900******        L A S T   S O U R C E   S T A T E M E N T   *****   16560000
