000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.           PPCAL954.                                  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     'PPCAL954 - W O R K I N G   S T O R A G E'.                  00180006
001900 01  CAL-VERSION                    PIC X(05)  VALUE 'C95.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 01  U1                             PIC S9(04) COMP SYNC.         00240000
002500 01  U2                             PIC S9(04) COMP SYNC.         00250000
002600 01  U3                             PIC S9(04) COMP SYNC.         00260000
002700 01  BLEND-RURAL-PCT                PIC V9(09) COMP SYNC.         00270000
002800                                                                  00280000
002900***************************************************************   00290000
003000*    LAYUP TABLE AREA FOR FY95 RATES                          *   00300000
003100***************************************************************   00310000
003200 01  RATE-TABLE.                                                  00320000
003300     02  RATE-WORK.                                               00330000
003400*RATE   941001 REGION  LABOR AND NON-LABOR RATES                  00340000
003500*               LARGE URBAN /OTHER URBAN & / ALL RURAL            00350000
003600*                           /REFERRAL CTR  /                      00360000
003700         05  FILLER PIC X(06) VALUE '941001'.                     00370000
003800         05  NE01   PIC X(45) VALUE                               00380000
003900            ' 0284062 113784 0279563 111982 0279563 111982'.      00390000
004000         05  MA02   PIC X(45) VALUE                               00400000
004100            ' 0259246 103844 0255142 102200 0255142 102200'.      00410000
004200         05  SA03   PIC X(45) VALUE                               00420000
004300            ' 0265429 106321 0261228 104638 0261228 104638'.      00430000
004400         05  ENS04  PIC X(45) VALUE                               00440000
004500            ' 0289231 115855 0284652 114020 0284652 114020'.      00450000
004600         05  ESC05  PIC X(45) VALUE                               00460000
004700            ' 0250824 100471 0246853 098880 0246853 098880'.      00470000
004800         05  WNC06  PIC X(45) VALUE                               00480000
004900            ' 0271120 108599 0266826 106880 0266826 106880'.      00490000
005000         05  WSC07  PIC X(45) VALUE                               00500000
005100            ' 0263883 105701 0259706 104027 0259706 104027'.      00510000
005200         05  MNT08  PIC X(45) VALUE                               00520000
005300            ' 0262188 105022 0258037 103359 0258037 103359'.      00530000
005400         05  PAC09  PIC X(45) VALUE                               00540000
005500            ' 0268057 107372 0263813 105673 0263813 105673'.      00550000
005600         05  NTL10  PIC X(45) VALUE                               00560000
005700            ' 0270942 108529 0266652 106810 0266652 106810'.      00570000
005800         05  PR11   PIC X(45) VALUE                               00580000
005900            ' 0241627 050353 0237802 049556 0237802 049556'.      00590000
006000         05  NPR12  PIC X(45) VALUE                               00600000
006100            ' 0268296 107469 0268296 107469 0268296 107469'.      00610000
006200     02  RATE-TAB REDEFINES RATE-WORK.                            00620000
006300         05  RATE-PERIOD            OCCURS 1.                     00630000
006400             10  RATE-EFF-DATE      PIC X(06).                    00640000
006500             10  REG-NAT            OCCURS 12.                    00650000
006600                 15  R-URBAN-RURAL  OCCURS 3.                     00660000
006700                     20  FILLER     PIC X(01).                    00670000
006800                     20  REG-LABOR  PIC 9(05)V9(02).              00680000
006900                     20  FILLER     PIC X(01).                    00690000
007000                     20  REG-NLABOR PIC 9(04)V9(02).              00700000
007100                                                                  00710000
007200                                                                  00720000
007300 01  DRG-TABLE.                                                   00730000
007400     05  D-TAB.                                                   00740000
007500      10  FILLER                  PIC X(06) VALUE                 00750000
007600     '941001'.                                                    00760000
007700      10  FILLER                  PIC X(56) VALUE                 00770000
007800     '03156509632135030968098321390303981273512702329207229110'.  00780000
007900      10  FILLER                  PIC X(56) VALUE                 00790000
008000     '01560104426056006339022240320250051013217400918502925047'.  00800000
008100      10  FILLER                  PIC X(56) VALUE                 00810000
008200     '01255306028088012618067290970077340382605500957406328090'.  00820000
008300      10  FILLER                  PIC X(56) VALUE                 00830000
008400     '00781305728072011956064280870069090382604901048805828078'.  00840000
008500      10  FILLER                  PIC X(56) VALUE                 00850000
008600     '00619503526046009126055270720059250372604802082808230117'.  00860000
008700      10  FILLER                  PIC X(56) VALUE                 00870000
008800     '01434206428086007806042260540080040402605600964704827066'.  00880000
008900      10  FILLER                  PIC X(56) VALUE                 00890000
009000     '00551503225041006270028250430134570392607401217005527083'.  00900000
009100      10  FILLER                  PIC X(56) VALUE                 00910000
009200     '00620003225046003687020170200076270402605600463502523034'.  00920000
009300      10  FILLER                  PIC X(56) VALUE                 00930000
009400     '00255901609016010862053270750058660352604900598901508018'.  00940000
009500      10  FILLER                  PIC X(56) VALUE                 00950000
009600     '00808902625039004005020160270050550150901900624102324036'.  00960000
009700      10  FILLER                  PIC X(56) VALUE                 00970000
009800     '00381001607016005687017120220034000302003600575504927060'.  00980000
009900      10  FILLER                  PIC X(56) VALUE                 00990000
010000     '00621103525043007553044260610043310302503900418602925029'.  01000000
010100      10  FILLER                  PIC X(56) VALUE                 01010000
010200     '01710604927068007131019110230068380202203000915202320030'.  01020000
010300      10  FILLER                  PIC X(56) VALUE                 01030000
010400     '00864702224034007176032220320064550182002800768402224031'.  01040000
010500      10  FILLER                  PIC X(56) VALUE                 01050000
010600     '01017403425052003227015040150046020150901900272401504015'.  01060000
010700      10  FILLER                  PIC X(56) VALUE                 01070000
010800     '01001902925051003217013050130110470342505001141905027084'.  01080000
010900      10  FILLER                  PIC X(56) VALUE                 01090000
011000     '00506703022038005076031240390083810382604700710004426054'.  01100000
011100      10  FILLER                  PIC X(56) VALUE                 01110000
011200     '00513303522042005812036240440065080352204200616003125044'.  01120000
011300      10  FILLER                  PIC X(56) VALUE                 01130000
011400     '00761604126055003571021200210305510993212402512610032139'.  01140000
011500      10  FILLER                  PIC X(56) VALUE                 01150000
011600     '01063004026060014211078300920169550833010700925905928074'.  01160000
011700      10  FILLER                  PIC X(56) VALUE                 01170000
011800     '01432305728071013237063280890095300552807200499603225043'.  01180000
011900      10  FILLER                  PIC X(56) VALUE                 01190000
012000     '01189006228082006753038260490133060552707501005305628069'.  01200000
012100      10  FILLER                  PIC X(56) VALUE                 01210000
012200     '01131706529080006924049270570068340382004401208406428081'.  01220000
012300      10  FILLER                  PIC X(56) VALUE                 01230000
012400     '00770004526057012427065280850061460392604900848805227062'.  01240000
012500      10  FILLER                  PIC X(56) VALUE                 01250000
012600     '00612204124049005356031250410070190322504100505102315028'.  01260000
012700      10  FILLER                  PIC X(56) VALUE                 01270000
012800     '00905504627062005339030250401354952544735807607615237180'.  01280000
012900      10  FILLER                  PIC X(56) VALUE                 01290000
013000     '05765611033130056683121341360419740933110406108111433147'.  01300000
013100      10  FILLER                  PIC X(56) VALUE                 01310000
013200     '00000000000000040796091311220230240652807501988103926053'.  01320000
013300      10  FILLER                  PIC X(56) VALUE                 01330000
013400     '02776512735172015385079301090359361043212702451404727065'.  01340000
013500      10  FILLER                  PIC X(56) VALUE                 01350000
013600     '01167103325049015582023240350099490332505601961606328107'.  01360000
013700      10  FILLER                  PIC X(56) VALUE                 01370000
013800     '01602207029086011292049270600142860292505101265704226055'.  01380000
013900      10  FILLER                  PIC X(56) VALUE                 01390000
014000     '00845102423032027724137361840102390552707100782006729075'.  01400000
014100      10  FILLER                  PIC X(56) VALUE                 01410000
014200     '01130802124038009177058280740058890452705600729603626047'.  01420000
014300      10  FILLER                  PIC X(56) VALUE                 01430000
014400     '00534802721035005761035250440085070432605800560002923037'.  01440000
014500      10  FILLER                  PIC X(56) VALUE                 01450000
014600     '00657803325033007964039260520049390262003300625803223040'.  01460000
014700      10  FILLER                  PIC X(56) VALUE                 01470000
014800     '00702503926051005174029210360051690241603001058004527064'.  01480000
014900      10  FILLER                  PIC X(56) VALUE                 01490000
015000     '00615502825037025367107331220154690742808003222012234147'.  01500000
015100      10  FILLER                  PIC X(56) VALUE                 01510000
015200     '01502207626082025652105321280118140552706801782908330097'.  01520000
015300      10  FILLER                  PIC X(56) VALUE                 01530000
015400     '01115106026067041740133351700138980612807200873206028060'.  01540000
015500      10  FILLER                  PIC X(56) VALUE                 01550000
015600     '01032004426061005445023180300110660432605600657402518031'.  01560000
015700      10  FILLER                  PIC X(56) VALUE                 01570000
015800     '00905303225046005156018110220072750392404802164508831102'.  01580000
015900      10  FILLER                  PIC X(56) VALUE                 01590000
016000     '01197605724063013465052270630078280321603701085603525054'.  01600000
016100      10  FILLER                  PIC X(56) VALUE                 01610000
016200     '00614902116027027813098321460106380432605901299006529094'.  01620000
016300      10  FILLER                  PIC X(56) VALUE                 01630000
016400     '00626203225046009726049270620053590331903901043605327069'.  01640000
016500      10  FILLER                  PIC X(56) VALUE                 01650000
016600     '00806204527056005807033190390111430642808200913905227068'.  01660000
016700      10  FILLER                  PIC X(56) VALUE                 01670000
016800     '00497503423042007685043260560053560312203800424002621034'.  01680000
016900      10  FILLER                  PIC X(56) VALUE                 01690000
017000     '00831204126057004282029230290063500282503801020104927068'.  01700000
017100      10  FILLER                  PIC X(56) VALUE                 01710000
017200     '00502702725037006707032250450441761363618201760906929089'.  01720000
017300      10  FILLER                  PIC X(56) VALUE                 01730000
017400     '03149712935157016562073290920245760973211401486106529075'.  01740000
017500      10  FILLER                  PIC X(56) VALUE                 01750000
017600     '02079608130097010930046240530236030993213202969808430131'.  01760000
017700      10  FILLER                  PIC X(56) VALUE                 01770000
017800     '03232212134170013087064280870123840632808901137605728073'.  01780000
017900      10  FILLER                  PIC X(56) VALUE                 01790000
018000     '01228406128084006220034250470100630492706400566102923037'.  01800000
018100      10  FILLER                  PIC X(56) VALUE                 01810000
018200     '02317307729086018427090311060129900702907900908403619041'.  01820000
018300      10  FILLER                  PIC X(56) VALUE                 01830000
018400     '01723408230113019237065280820109770392404802104609331133'.  01840000
018500      10  FILLER                  PIC X(56) VALUE                 01850000
018600     '03008412334189014028057280740091320362304400962605327053'.  01860000
018700      10  FILLER                  PIC X(56) VALUE                 01870000
018800     '01791106729093009852035250470081620251803200693202213027'.  01880000
018900      10  FILLER                  PIC X(56) VALUE                 01890000
019000     '00900603325051013381050270770069990242003200840902324035'.  01900000
019100      10  FILLER                  PIC X(56) VALUE                 01910000
019200     '00596401915025009145035260550112750352505401156003225058'.  01920000
019300      10  FILLER                  PIC X(56) VALUE                 01930000
019400     '01905107429106009529035260480089640572808800777205527076'.  01940000
019500      10  FILLER                  PIC X(56) VALUE                 01950000
019600     '00553503726050014939091311230103380682909001188906428087'.  01960000
019700      10  FILLER                  PIC X(56) VALUE                 01970000
019800     '00583503926052011440070290930071220492706400734604927066'.  01980000
019900      10  FILLER                  PIC X(56) VALUE                 01990000
020000     '00481303425047005529037260480055320332504500711704426058'.  02000000
020100      10  FILLER                  PIC X(56) VALUE                 02010000
020200     '00648603425050006950041260570045100252303400364201815018'.  02020000
020300      10  FILLER                  PIC X(56) VALUE                 02030000
020400     '00761705027070004324032250430048310292502900639703425047'.  02040000
020500      10  FILLER                  PIC X(56) VALUE                 02050000
020600     '00884303520042006989027120310082910282504100584001910022'.  02060000
020700      10  FILLER                  PIC X(56) VALUE                 02070000
020800     '00743202012025006491025250390235401253517601166307129096'.  02080000
020900      10  FILLER                  PIC X(56) VALUE                 02090000
021000     '01395305427083007358029250400069350262504200835602525039'.  02100000
021100      10  FILLER                  PIC X(56) VALUE                 02110000
021200     '01702507429109006610025250360113430763010001007206328082'.  02120000
021300      10  FILLER                  PIC X(56) VALUE                 02130000
021400     '00633904627061011084059280920051320262504100613704026054'.  02140000
021500      10  FILLER                  PIC X(56) VALUE                 02150000
021600     '00880406228076005850048270570067080372204300672904226057'.  02160000
021700      10  FILLER                  PIC X(56) VALUE                 02170000
021800     '00434402925039003566022190220071550482706300434203325043'.  02180000
021900      10  FILLER                  PIC X(56) VALUE                 02190000
022000     '02527012635175022621076300930210351143316401903005828080'.  02200000
022100      10  FILLER                  PIC X(56) VALUE                 02210000
022200     '01006303225046007931024150300051020160902002719710232150'.  02220000
022300      10  FILLER                  PIC X(56) VALUE                 02230000
022400     '01160404727066007463052270650074330392605100917905427074'.  02240000
022500      10  FILLER                  PIC X(56) VALUE                 02250000
022600     '00530503726047005421027250430081180432606101098206328083'.  02260000
022700      10  FILLER                  PIC X(56) VALUE                 02270000
022800     '00600303726049041394126351460257390973211602331308731117'.  02280000
022900      10  FILLER                  PIC X(56) VALUE                 02290000
023000     '01136604526056012101054270730066190301803601446505427081'.  02300000
023100      10  FILLER                  PIC X(56) VALUE                 02310000
023200     '00797102622034009159035250500053950201302500845803526053'.  02320000
023300      10  FILLER                  PIC X(56) VALUE                 02330000
023400     '00477402016026004503023240230203230602810701284005928084'.  02340000
023500      10  FILLER                  PIC X(56) VALUE                 02350000
023600     '00514902825039011196055280810055300242403300945105928074'.  02360000
023700      10  FILLER                  PIC X(56) VALUE                 02370000
023800     '00610904426052005464039250470072210292503900387201912023'.  02380000
023900      10  FILLER                  PIC X(56) VALUE                 02390000
024000     '00647603926052004186026220340072220312503100673203526048'.  02400000
024100      10  FILLER                  PIC X(56) VALUE                 02410000
024200     '00429101915025002903016090160099430512707000601903125043'.  02420000
024300      10  FILLER                  PIC X(56) VALUE                 02430000
024400     '01037704927072017172068240750134470561906100852304023048'.  02440000
024500      10  FILLER                  PIC X(56) VALUE                 02450000
024600     '00613003012033009738037260570082650312504400451602413024'.  02460000
024700      10  FILLER                  PIC X(56) VALUE                 02470000
024800     '01019202924038006689027250410039450170601700994102725036'.  02480000
024900      10  FILLER                  PIC X(56) VALUE                 02490000
025000     '00752103125045009598053270770048990252503700672403726051'.  02500000
025100      10  FILLER                  PIC X(56) VALUE                 02510000
025200     '00409402422032006787045270540034720130501300580703225043'.  02520000
025300      10  FILLER                  PIC X(56) VALUE                 02530000
025400     '01886508030098013747059280690087730401204300716203214036'.  02540000
025500      10  FILLER                  PIC X(56) VALUE                 02550000
025600     '02283408931109011018047200540079870351103800818603522043'.  02560000
025700      10  FILLER                  PIC X(56) VALUE                 02570000
025800     '01104703125048005189014050140064700282103700623902625037'.  02580000
025900      10  FILLER                  PIC X(56) VALUE                 02590000
026000     '01712706328092012111059280910044860232403300970405628073'.  02600000
026100      10  FILLER                  PIC X(56) VALUE                 02610000
026200     '00509502925040008976049240590063400360903800490202717034'.  02620000
026300      10  FILLER                  PIC X(56) VALUE                 02630000
026400     '00338701908022006152024160310071010442604400351302421034'.  02640000
026500      10  FILLER                  PIC X(56) VALUE                 02650000
026600     '00976203425057007052026150300032040211802800348101611021'.  02660000
026700      10  FILLER                  PIC X(56) VALUE                 02670000
026800     '00406301712022001856013050150040600302504000290901915025'.  02680000
026900      10  FILLER                  PIC X(56) VALUE                 02690000
027000     '01274101824018037999179401790190281333513301205308631086'.  02700000
027100      10  FILLER                  PIC X(56) VALUE                 02710000
027200     '01297205628077005385031250480023110311103103202110132132'.  02720000
027300      10  FILLER                  PIC X(56) VALUE                 02730000
027400     '01583909131091015713050270850081180432606000285901713021'.  02740000
027500      10  FILLER                  PIC X(56) VALUE                 02750000
027600     '01249005027069012139058280740067230382604802567407630118'.  02760000
027700      10  FILLER                  PIC X(56) VALUE                 02770000
027800     '02404309231137009212032250480169560742910700757103726052'.  02780000
027900      10  FILLER                  PIC X(56) VALUE                 02790000
028000     '01084004927049026496094311280112620412605301558605027084'.  02800000
028100      10  FILLER                  PIC X(56) VALUE                 02810000
028200     '00978505427077006749027200330044760272503700451502121030'.  02820000
028300      10  FILLER                  PIC X(56) VALUE                 02830000
028400     '01359506829099006704037260540351361343518701492706929095'.  02840000
028500      10  FILLER                  PIC X(56) VALUE                 02850000
028600     '01425005227075009628060280760092930522706600636804026049'.  02860000
028700      10  FILLER                  PIC X(56) VALUE                 02870000
028800     '00686804026051005859034250430158460712910002557313536226'.  02880000
028900      10  FILLER                  PIC X(56) VALUE                 02890000
029000     '00707904126057005960046270650059690442606400752105728094'.  02900000
029100      10  FILLER                  PIC X(56) VALUE                 02910000
029200     '00926907029104008980080301150063160522707600753804627072'.  02920000
029300      10  FILLER                  PIC X(56) VALUE                 02930000
029400     '00335602825041007235049270670043720412605500915614536172'.  02940000
029500      10  FILLER                  PIC X(56) VALUE                 02950000
029600     '00902111534136000000000000000132950562808901749507029112'.  02960000
029700      10  FILLER                  PIC X(56) VALUE                 02970000
029800     '00784002324035020135058280950075470242403300739904627062'.  02980000
029900      10  FILLER                  PIC X(56) VALUE                 02990000
030000     '00464003125040004995024220240046760232003100361402917029'.  03000000
030100      10  FILLER                  PIC X(56) VALUE                 03010000
030200     '00780103526051004168020170270103410211702100857704026056'.  03020000
030300      10  FILLER                  PIC X(56) VALUE                 03030000
030400     '00435502622034008864041260640043790222403202172105227102'.  03040000
030500      10  FILLER                  PIC X(56) VALUE                 03050000
030600     '01630703025056035089140361980175430853012501002305628080'.  03060000
030700      10  FILLER                  PIC X(56) VALUE                 03070000
030800     '00943202524052016623134351670071700452606000474003125041'.  03080000
030900      10  FILLER                  PIC X(56) VALUE                 03090000
031000     '00446402023032005319024240490037220262505103576912434177'.  03100000
031100      10  FILLER                  PIC X(56) VALUE                 03110000
031200     '00000000000000000000000000000374990943111011637515938304'.  03120000
031300      10  FILLER                  PIC X(56) VALUE                 03130000
031400     '03612009331163000000000000000370050953113702232712334156'.  03140000
031500      10  FILLER                  PIC X(56) VALUE                 03150000
031600     '01522105828095022227063280950135030392605118258127149347'.  03160000
031700      10  FILLER                  PIC X(56) VALUE                 03170000
031800     '15307635557394036730130351741687724196454105980712535202'.  03180000
031900      10  FILLER                  PIC X(56) VALUE                 03190000
032000     '03154011433144049514105321680193360692910204385415137215'.  03200000
032100      10  FILLER                  PIC X(56) VALUE                 03210000
032200     '01815808330125010630051270800162350442405303680410733169'.  03220000
032300      10  FILLER                  PIC X(56) VALUE                 03230000
032400     '01581304326061008462017140231283462024226300000000000000'.  03240000
032500     05  DRGX-TAB REDEFINES D-TAB.                                03250000
032600         10  DRGX-PERIOD               OCCURS 1                   03260000
032700                                        INDEXED BY DX5.           03270000
032800             15  DRGX-EFF-DATE         PIC X(06).                 03280000
032900             15  DRG-DATA              OCCURS 496                 03290000
033000                                        INDEXED BY DX6.           03300000
033100                 20  DRG-WT            PIC 9(02)V9(04).           03310000
033200                 20  DRG-ALOS          PIC 9(02)V9(01).           03320000
033300                 20  DRG-DAYS-TRIM     PIC 9(02).                 03330000
033400                 20  DRG-ARITH-ALOS    PIC 9(02)V9(01).           03340000
033500                                                                  03350000
033600 01  HOLD-AREA.                                                   03360000
033700     02  HOLD-DATES.                                              03370000
033800         05  HOLD-BILL-DATE.                                      03380000
033900             10  H-BILL-YY                PIC 9(02).              03390000
034000             10  H-BILL-MM                PIC 9(02).              03400000
034100             10  H-BILL-DD                PIC 9(02).              03410000
034200                                                                  03420000
034300         05  HOLD-FY-BEGIN-DATE.                                  03430000
034400             10  H-FY-BEGIN-YY            PIC 9(02).              03440000
034500             10  H-FY-BEGIN-MM            PIC 9(02).              03450000
034600             10  H-FY-BEGIN-DD            PIC 9(02).              03460000
034700                                                                  03470000
034800         05  HOLD-ADD-FY-BEGN-DATE.                               03480000
034900             10  H-ADD-FY-BEGN-YY            PIC 9(02).           03490000
035000             10  H-ADD-FY-BEGN-MM            PIC 9(02).           03500000
035100             10  H-ADD-FY-BEGN-DD            PIC 9(02).           03510000
035200                                                                  03520000
035300     02  HOLD-PPS-COMPONENTS.                                     03530000
035400         05  H-OPER-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        03540000
035500         05  H-CAPI-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        03550000
035600                                                                  03560000
035700         05  H-OPER-HSP-PART              PIC 9(06)V9(09).        03570000
035800         05  H-CAPI-HSP-PART              PIC 9(06)V9(09).        03580000
035900                                                                  03590000
036000         05  H-OPER-FSP-PART              PIC 9(06)V9(09).        03600000
036100         05  H-CAPI-FSP-PART              PIC 9(06)V9(09).        03610000
036200         05  H-CAPI2-B-FSP-PART           PIC 9(06)V9(09).        03620000
036300                                                                  03630000
036400         05  H-OPER-OUTLIER-PART          PIC 9(07)V9(09).        03640000
036500         05  H-CAPI-OUTLIER-PART          PIC 9(07)V9(09).        03650000
036600         05  H-CAPI2-B-OUTLIER-PART       PIC 9(07)V9(09).        03660000
036700                                                                  03670000
036800         05  H-OPER-OUTDAY-PART           PIC 9(07)V9(09).        03680000
036900         05  H-CAPI-OUTDAY-PART           PIC 9(07)V9(09).        03690000
037000                                                                  03700000
037100         05  H-OPER-OUTCST-PART           PIC 9(07)V9(09).        03710000
037200         05  H-CAPI-OUTCST-PART           PIC 9(07)V9(09).        03720000
037300                                                                  03730000
037400         05  H-OPER-CSTCHG-RATIO          PIC 9(01)V9(03).        03740000
037500         05  H-CAPI-CSTCHG-RATIO          PIC 9(01)V9(03).        03750000
037600                                                                  03760000
037700         05  H-OPER-DSH                   PIC 9(01)V9(04).        03770000
037800         05  H-CAPI-DSH                   PIC 9(01)V9(04).        03780000
037900                                                                  03790000
038000         05  H-OPER-IME-TEACH             PIC 9(06)V9(09).        03800000
038100         05  H-CAPI-PAYCDE-PCT1           PIC 9(01)V9(02).        03810000
038200         05  H-CAPI-PAYCDE-PCT2           PIC 9(01)V9(02).        03820000
038300         05  H-CAPI-HSP-PCT               PIC 9(01)V9(02).        03830000
038400         05  H-CAPI-FSP-PCT               PIC 9(01)V9(04).        03840000
038500         05  H-CAPI-COST-OUTLIER          PIC 9(07)V9(09).        03850000
038600         05  H-CAPI-BILL-COSTS            PIC 9(07)V9(09).        03860000
038700         05  H-CAPI-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        03870000
038800         05  H-CAPI-COLA                  PIC 9(01)V9(03).        03880000
038900         05  H-CAPI-SCH                   PIC 9(05)V9(02).        03890000
039000         05  H-CAPI-BUD-NEUTRALITY        PIC 9(01)V9(04).        03900000
039100         05  H-CAPI-OLD-HARMLESS          PIC 9(09)V9(02).        03910000
039200         05  H-CAPI-FED-RATE              PIC 9(05)V9(04).        03920000
039300         05  H-CAPI-FULL-PROS             PIC 9(05)V9(04).        03930000
039400         05  H-CAPI-LARG-URBAN            PIC 9(01)V9(02).        03940000
039500         05  H-CAPI-GAF                   PIC 9(05)V9(04).        03950000
039600         05  H-WAGE-INDEX                 PIC 9(02)V9(04).        03960000
039700         05  H-COV-DAYS                   PIC 9(3).               03970000
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-NUTR94                PIC 9(01)V9(06).        04090000
041000         05  H-BUDG-NUTR95                PIC 9(01)V9(06).        04100000
041100         05  H-ACCUM-TO-HSP               PIC 9(01)V9(04).        04110000
041200         05  H-PUERTO-RICO-RATE           PIC 9(04)V9(02).        04120000
041300         05  H-FEDERAL-RATE               PIC 9(04)V9(02).        04130000
041400         05  H-LABOR-PCT                  PIC 9(01)V9(04).        04140000
041500         05  H-NLABOR-PCT                 PIC 9(01)V9(04).        04150000
041600         05  H-HSP-RATE                   PIC 9(06)V9(09).        04160000
041700         05  H-FSP-RATE                   PIC 9(06)V9(09).        04170000
041800         05  H-OUTLIER-FACT               PIC 9(01)V9(06).        04180000
041900         05  H-WK-OPER-DSH                PIC 9(01)V9(04).        04190000
042000         05  H-WK-CAPI-IME-TEACH          PIC 9(06)V9(09).        04200000
042100                                                                  04210000
042200                                                                  04220000
042300     02  HOLD-ADDITIONAL-VARIABLES.                               04230000
042400         05  H-OPER-HSP-PCT               PIC 9(01)V9(02).        04240000
042500         05  H-OPER-FSP-PCT               PIC 9(01)V9(02).        04250000
042600         05  H-NAT-PCT                    PIC 9(01)V9(02).        04260000
042700         05  H-REG-PCT                    PIC 9(01)V9(02).        04270000
042800         05  H-CMI-ADJ-CPD                PIC 9(05)V9(02).        04280000
042900         05  H-UPDATE-FACTOR              PIC 9(01)V9(05).        04290000
043000         05  H-DRG-WT                     PIC 9(02)V9(04).        04300000
043100         05  H-NAT-LABOR                  PIC 9(05)V9(02).        04310000
043200         05  H-NAT-NLABOR                 PIC 9(05)V9(02).        04320000
043300         05  H-REG-LABOR                  PIC 9(05)V9(02).        04330000
043400         05  H-REG-NLABOR                 PIC 9(05)V9(02).        04340000
043500         05  H-OPER-COLA                  PIC 9(01)V9(03).        04350000
043600         05  H-INTERN-RATIO               PIC 9(01)V9(04).        04360000
043700         05  H-OPER-COST-OUTLIER          PIC 9(07)V9(09).        04370000
043800         05  H-OPER-BILL-COSTS            PIC 9(07)V9(09).        04380000
043900         05  H-OPER-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        04390000
044000                                                                  04400000
044100     02  HOLD-CAPITAL-VARIABLES.                                  04410000
044200         05  H-CAPI-TOTAL-PAY             PIC 9(07)V9(02).        04420000
044300         05  H-CAPI-HSP                   PIC 9(07)V9(02).        04430000
044400         05  H-CAPI-FSP                   PIC 9(07)V9(02).        04440000
044500         05  H-CAPI-OUTLIER               PIC 9(07)V9(02).        04450000
044600         05  H-CAPI-OLD-HARM              PIC 9(07)V9(02).        04460000
044700         05  H-CAPI-DSH-ADJ               PIC 9(07)V9(02).        04470000
044800         05  H-CAPI-IME-ADJ               PIC 9(07)V9(02).        04480000
044900         05  H-CAPI-EXCEPTIONS            PIC 9(07)V9(02).        04490000
045000                                                                  04500000
045100     02  HOLD-CAPITAL2-VARIABLES.                                 04510000
045200         05  H-CAPI2-PAY-CODE             PIC X(1).               04520000
045300         05  H-CAPI2-B-FSP                PIC 9(07)V9(02).        04530000
045400         05  H-CAPI2-B-OUTLIER            PIC 9(07)V9(02).        04540000
045500                                                                  04550000
045600 LINKAGE SECTION.                                                 04560000
045700***************************************************************   04570000
045800*                 * * * * * * * * *                           *   04580000
045900*    REVIEW CODES ARE USED TO DIRECT THE PPCAL  SUBROUTINE    *   04590000
046000*    IN HOW TO PAY THE BILL.                                  *   04600000
046100*         REVIEW-CODE:                                        *   04610000
046200*            00 = PAY-WITH-OUTLIER.                           *   04620000
046300*                 WILL CALCULATE THE STANDARD PAYMENT.        *   04630000
046400*                 WILL ALSO ATTEMPT TO PAY DAY AND COST       *   04640000
046500*                 OUTLIERS.                                   *   04650000
046600*            03 = PAY-PERDIEM-DAYS.                           *   04660000
046700*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   04670000
046800*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   04680000
046900*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   04690000
047000*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   04700000
047100*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   04710000
047200*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   04720000
047300*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   04730000
047400*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   04740000
047500*                 BILL EXCEED THE COST THRESHOLD.             *   04750000
047600*            06 = PAY-XFER-NO-COST                            *   04760000
047700*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   04770000
047800*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   04780000
047900*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   04790000
048000*                 FOR THE DRG.  IF COVERED DAYS EQUAL OR      *   04800000
048100*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   04810000
048200*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   04820000
048300*                 CALCULATE ANY COST OUTLIER PORTION          *   04830000
048400*                 OF THE PAYMENT.                             *   04840000
048500*            07 = PAY-WITHOUT-COST.                           *   04850000
048600*                 WILL CALCULATE THE STANDARD PAYMENT. WILL   *   04860000
048700*                 ALSO CALCULATE THE DAY OUTLIER PORTION OF   *   04870000
048800*                 THE PAYMENT IF THE COVERED DAYS EXCEED THE  *   04880000
048900*                 OUTLIER CUTOFF FOR THE DRG.                 *   04890000
049000***************************************************************   04900000
049100 01  BILL-DATA.                                                   04910000
049200         10  B-PROVIDER-NO          PIC X(06).                    04920000
049300         10  B-REVIEW-CODE          PIC 9(02).                    04930000
049400             88  VALID-REVIEW-CODE  VALUE 00 03 06 07.            04940000
049500             88  PAY-WITH-OUTLIER   VALUE 00 07.                  04950000
049600             88  PAY-PERDIEM-DAYS   VALUE 03.                     04960000
049700             88  PAY-XFER-NO-COST   VALUE 06.                     04970000
049800             88  PAY-WITHOUT-COST   VALUE 07.                     04980000
049900         10  B-DRG                  PIC 9(03).                    04990000
050000         10  B-LOS                  PIC 9(03).                    05000000
050100         10  B-COVERED-DAYS         PIC 9(03).                    05010000
050200         10  B-LTR-DAYS             PIC 9(02).                    05020000
050300         10  B-DISCHARGE-DATE.                                    05030000
050400             15  B-DISCHG-MM        PIC 9(02).                    05040000
050500             15  B-DISCHG-DD        PIC 9(02).                    05050000
050600             15  B-DISCHG-YY        PIC 9(02).                    05060000
050700         10  B-CHARGES-CLAIMED      PIC 9(07)V9(02).              05070000
050800                                                                  05080000
050900***************************************************************   05090000
051000*    THIS DATA IS CALCULATED BY THIS PPCAL  SUBROUTINE        *   05100000
051100*    AND PASSED BACK TO THE CALLING PROGRAM                   *   05110000
051200*            RETURN CODE VALUES (PPS-RTC)                     *   05120000
051300*                                                             *   05130000
051400*            PPS-RTC 00-49 = HOW THE BILL WAS PAID            *   05140000
051500*              00 = PAID NORMAL DRG PAYMENT                   *   05150000
051600*                                                             *   05160000
051700*              01 = PAID AS A DAY-OUTLIER.                    *   05170000
051800*                                                             *   05180000
051900*              02 = PAID AS A COST-OUTLIER.                   *   05190000
052000*                                                             *   05200000
052100*              03 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   05210000
052200*                   AND INCLUDING THE FULL DRG.               *   05220000
052300*              05 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   05230000
052400*                   AND INCLUDING THE FULL DRG WHICH ALSO     *   05240000
052500*                   QUALIFIED FOR A COST OUTLIER PAYMENT.     *   05250000
052600*              06 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   05260000
052700*                   AND INCLUDING THE FULL DRG. PROVIDER      *   05270000
052800*                   REFUSED COST OUTLIER.                     *   05280000
052900*                                                             *   05290000
053000*            PPS-RTC 50-99 = WHY THE BILL WAS NOT PAID        *   05300000
053100*              51 = NO PROVIDER SPECIFIC INFO FOUND           *   05310000
053200*              52 = INVALID MSA # IN PROVIDER FILE            *   05320000
053300*              53 = WAIVER STATE - NOT CALCULATED BY PPS      *   05330000
053400*              54 = DRG < 001 OR > 495, OR = 109 OR = 438     *   05340000
053500*                                       OR = 469 OR = 470     *   05350000
053600*                                       OR = 474              *   05360000
053700*              55 = DISCHARGE DATE < PROVIDER PPS START DATE  *   05370000
053800*              56 = INVALID LENGTH OF STAY                    *   05380000
053900*              57 = REVIEW CODE INVALID (NOT 00 03 06 07)     *   05390000
054000*              58 = TOTAL CHARGES NOT NUMERIC                 *   05400000
054100*              61 = LIFETIME RESERVE DAYS NOT NUMERIC         *   05410000
054200*              62 = INVALID NUMBER OF COVERED DAYS            *   05420000
054300*              65 = PAY-CODE NOT = A,B OR C ON PROVIDER       *   05430000
054400*                   SPECIFIC FILE FOR CAPITAL                 *   05440000
054500*              66 = THERE ARE NOT AS MANY BENEFIT DAYS        *   05450000
054600*                   AVAILABLE ON THE BILL AS THERE ARE OUTLIER*   05460000
054700*                   DAYS COMPUTED BY PRICER --BENEFITS ARE    *   05470000
054800*                   EXHAUSTED ---                             *   05480000
054900*                   APPORTION THE CORRECT COVERED CHARGES     *   05490000
055000*                   FOR THE MAXIMUM NUMBER OF COVERED DAYS    *   05500000
055100*                   AVAILABLE BEFORE RESUBMITTING THE BILL    *   05510000
055200*                   FOR THE COST OUTLIER PAYMENT.             *   05520000
055300*              98 = CANNOT PROCESS BILL OLDER THAN 5 YEARS    *   05530000
055400***************************************************************   05540000
055500 01  PPS-DATA.                                                    05550000
055600         10  PPS-RTC                PIC 9(02).                    05560000
055700         10  PPS-WAGE-INDX          PIC 9(02)V9(04).              05570000
055800         10  PPS-OUTLIER-DAYS       PIC 9(03).                    05580000
055900         10  PPS-AVG-LOS            PIC 9(02)V9(01).              05590000
056000         10  PPS-DAYS-CUTOFF        PIC 9(02)V9(01).              05600000
056100         10  PPS-OPER-IME-ADJ       PIC 9(06)V9(02).              05610000
056200         10  PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).              05620000
056300         10  PPS-OPER-HSP-PART      PIC 9(06)V9(02).              05630000
056400         10  PPS-OPER-FSP-PART      PIC 9(06)V9(02).              05640000
056500         10  PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).              05650000
056600         10  PPS-REG-DAYS-USED      PIC 9(03).                    05660000
056700         10  PPS-LTR-DAYS-USED      PIC 9(02).                    05670000
056800         10  PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).              05680000
056900         10  PPS-CALC-VERS          PIC X(05).                    05690000
057000                                                                  05700000
057100******************************************************************05710000
057200*            THESE ARE THE VERSIONS OF THE PPCAL                  05720000
057300*           PROGRAMS THAT WILL BE PASSED BACK----                 05730000
057400*          ASSOCIATED WITH THE BILL BEING PROCESSED               05740000
057500******************************************************************05750000
057600 01  PRICER-OPT-VERS-SW.                                          05760000
057700     02  PRICER-OPTION-SW          PIC X(01).                     05770000
057800         88  ALL-TABLES-PASSED          VALUE 'A'.                05780000
057900         88  PROV-RECORD-PASSED         VALUE 'P'.                05790000
058000         88  ADDITIONAL-VARIABLES       VALUE 'M'.                05800000
058100     02  PPS-VERSIONS.                                            05810000
058200         10  PPDRV-VERSION         PIC X(05).                     05820000
058300                                                                  05830000
058400******************************************************************05840000
058500*        THIS IS THE VARIABLES THAT WILL BE PASSED BACK           05850000
058600*          ASSOCIATED WITH THE BILL BEING PROCESSED               05860000
058700******************************************************************05870000
058800 01  PPS-ADDITIONAL-VARIABLES.                                    05880000
058900     05  PPS-HSP-PCT                PIC 9(01)V9(02).              05890000
059000     05  PPS-FSP-PCT                PIC 9(01)V9(02).              05900000
059100     05  PPS-NAT-PCT                PIC 9(01)V9(02).              05910000
059200     05  PPS-REG-PCT                PIC 9(01)V9(02).              05920000
059300     05  PPS-CMI-ADJ-CPD            PIC 9(05)V9(02).              05930000
059400     05  PPS-UPDATE-FACTOR          PIC 9(01)V9(05).              05940000
059500     05  PPS-DRG-WT                 PIC 9(02)V9(04).              05950000
059600     05  PPS-NAT-LABOR              PIC 9(05)V9(02).              05960000
059700     05  PPS-NAT-NLABOR             PIC 9(05)V9(02).              05970000
059800     05  PPS-REG-LABOR              PIC 9(05)V9(02).              05980000
059900     05  PPS-REG-NLABOR             PIC 9(05)V9(02).              05990000
060000     05  PPS-OPER-COLA              PIC 9(01)V9(03).              06000000
060100     05  PPS-INTERN-RATIO           PIC 9(01)V9(04).              06010000
060200     05  PPS-COST-OUTLIER           PIC 9(07)V9(09).              06020000
060300     05  PPS-BILL-COSTS             PIC 9(07)V9(09).              06030000
060400     05  PPS-DOLLAR-THRESHOLD       PIC 9(07)V9(09).              06040000
060500     05  PPS-DSCHG-FRCTN            PIC 9(1)V9999.                06050000
060600     05  PPS-DRG-WT-FRCTN           PIC 9(2)V9999.                06060000
060700     05  PPS-CAPITAL-VARIABLES.                                   06070000
060800         10  PPS-CAPI-TOTAL-PAY           PIC 9(07)V9(02).        06080000
060900         10  PPS-CAPI-HSP                 PIC 9(07)V9(02).        06090000
061000         10  PPS-CAPI-FSP                 PIC 9(07)V9(02).        06100000
061100         10  PPS-CAPI-OUTLIER             PIC 9(07)V9(02).        06110000
061200         10  PPS-CAPI-OLD-HARM            PIC 9(07)V9(02).        06120000
061300         10  PPS-CAPI-DSH-ADJ             PIC 9(07)V9(02).        06130000
061400         10  PPS-CAPI-IME-ADJ             PIC 9(07)V9(02).        06140000
061500         10  PPS-CAPI-EXCEPTIONS          PIC 9(07)V9(02).        06150000
061600     05  PPS-CAPITAL2-VARIABLES.                                  06160000
061700         10  PPS-CAPI2-PAY-CODE             PIC X(1).             06170000
061800         10  PPS-CAPI2-B-FSP                PIC 9(07)V9(02).      06180000
061900         10  PPS-CAPI2-B-OUTLIER            PIC 9(07)V9(02).      06190000
062000                                                                  06200000
062100                                                                  06210000
062200******************************************************************06220000
062300*               THIS IS THE PROVIDER RECORD                       06230000
062400*          ASSOCIATED WITH THE BILL BEING PROCESSED               06240000
062500******************************************************************06250000
062600 01  PROV-HOLD.                                                   06260000
062700     02  PROV-REC-HOLD.                                           06270000
062800         05  P-PROVIDER-NO.                                       06280000
062900             10  P-STATE                PIC 9(02).                06290000
063000             10  FILLER                 PIC X(04).                06300000
063100         05  P-EFF-DATE.                                          06310000
063200             10  P-EFF-YY               PIC 9(02).                06320000
063300             10  P-EFF-MM               PIC 9(02).                06330000
063400             10  P-EFF-DD               PIC 9(02).                06340000
063500         05  P-WAIVER-CODE              PIC X(01).                06350000
063600             88  WAIVER-STATE           VALUE 'Y'.                06360000
063700         05  P-PROVIDER-TYPE            PIC X(02).                06370000
063800             88  REFERRAL-CENTER        VALUE '07' '15' '17' '22'.06380000
063900             88  INDIAN-HEALTH-SERVICE  VALUE '08'.               06390000
064000             88  MDH-REBASED-FY90       VALUE '14' '15'.          06400000
064100             88  MDH-RRC-REBASED-FY90   VALUE '15'.               06410000
064200             88  SCH-REBASED-FY90       VALUE '16' '17'.          06420000
064300             88  SCH-RRC-REBASED-FY90   VALUE '17'.               06430000
064400             88  MEDICAL-ASSIST-FACIL   VALUE '18'.               06440000
064500             88  OTHER-URB-TO-RURAL     VALUE '19'.               06450000
064600             88  LARGE-URB-TO-RURAL     VALUE '20'.               06460000
064700             88  EACH                   VALUE '21' '22'.          06470000
064800             88  EACH-REFERRAL-CENTER   VALUE '22'.               06480000
064900         05  P-CURRENT-CENSUS-DIV       PIC 9(01).                06490000
065000             88  NEW-ENGLAND            VALUE  1.                 06500000
065100             88  MIDDLE-ATLANTIC        VALUE  2.                 06510000
065200             88  SOUTH-ATLANTIC         VALUE  3.                 06520000
065300             88  EAST-NORTH-CENTRAL     VALUE  4.                 06530000
065400             88  EAST-SOUTH-CENTRAL     VALUE  5.                 06540000
065500             88  WEST-NORTH-CENTRAL     VALUE  6.                 06550000
065600             88  WEST-SOUTH-CENTRAL     VALUE  7.                 06560000
065700             88  MOUNTAIN               VALUE  8.                 06570000
065800             88  PACIFIC                VALUE  9.                 06580000
065900         05  P-CENSUS-DIV  REDEFINES                              06590000
066000                    P-CURRENT-CENSUS-DIV       PIC 9(01).         06600000
066100             88  VALID-CENSUS-DIV   VALUE 1 THRU 9.               06610000
066200         05  P-PPS-BLEND-YEAR           PIC 9(01).                06620000
066300             88  VALID-PPS-BLEND-YEAR   VALUE 1 THRU 8.           06630000
066400         05  P-MSA-X.                                             06640000
066500             10  P-MSA-9                PIC X(04).                06650000
066600         05  P-FISCAL-YEAR-END.                                   06660000
066700             10  P-MM                   PIC 9(02).                06670000
066800             10  P-DD                   PIC 9(02).                06680000
066900             10  P-YY                   PIC 9(02).                06690000
067000         05  P-VARIABLES.                                         06700000
067100             10  P-CMI-ADJ-CPD          PIC S9(05)V9(02).         06710000
067200             10  P-COLA                 PIC S9(01)V9(03).         06720000
067300             10  P-INTERN-RATIO         PIC S9(01)V9(04).         06730000
067400             10  PRUP-UPDT-FACTOR       PIC S9(01)V9(05).         06740000
067500             10  P-BED-SIZE             PIC  9(05).               06750000
067600             10  P-DSH-PERCENT          PIC V9(04).               06760000
067700             10  P-OPER-CSTCHG-RATIO    PIC  9(01)V9(03).         06770000
067800             10  P-CMI                  PIC  9(01)V9(04).         06780000
067900             10  FILLER                 PIC  9(01).               06790000
068000             10  P-REPORT-DATE          PIC  9(06).               06800000
068100             10  FILLER                 PIC  9(01).               06810000
068200             10  P-INTER-NO             PIC  9(05).               06820000
068300     02  PROV-REC-HOLD2.                                          06830000
068400         05  P-FY-BEGIN-DATE.                                     06840000
068500             10  P-FY-BEGIN-MM          PIC 9(2).                 06850000
068600             10  P-FY-BEGIN-DD          PIC 9(2).                 06860000
068700             10  P-FY-BEGIN-YY          PIC 9(2).                 06870000
068800         05  P-PASS-AMT-CAPITAL         PIC 9(4)V99.              06880000
068900         05  P-PASS-AMT-DIR-MED-ED      PIC 9(4)V99.              06890000
069000         05  P-PASS-AMT-ORGAN-ACQ       PIC 9(4)V99.              06900000
069100         05  P-PASS-AMT-INCL-MISC       PIC 9(4)V99.              06910000
069200         05  P-SSI-RATIO                PIC V9(4).                06920000
069300         05  P-MEDICAID-RATIO           PIC V9(4).                06930000
069400         05  P-TERMINATION-DATE         PIC X(6).                 06940000
069500         05  P-WAGE-INDEX-LOC-MSA       PIC X(4).                 06950000
069600         05  P-CHG-CODE-INDEX           PIC X.                    06960000
069700         05  P-STAND-AMT-LOC-MSA.                                 06970000
069800             10  P-RURAL-1ST            PIC XX.                   06980000
069900                 88  P-RURAL-CHECK        VALUE '  '.             06990000
070000             10  P-RURAL-2ND            PIC XX.                   07000000
070100         05  P-CAPI-SOL-HOSP-RATE       PIC XX.                   07010000
070200         05  FILLER                     PIC X.                    07020000
070300         05  FILLER                     PIC X(06).                07030000
070400         05  FILLER                     PIC X(18).                07040000
070500     02  PROV-REC-HOLD3.                                          07050000
070600         05  P-CAPI-PPS-PAY-CODE        PIC X.                    07060000
070700         05  P-CAPI-HOSP-SPEC-RATE      PIC 9(4)V99.              07070000
070800         05  P-CAPI-OLD-HARM-RATE       PIC 9(4)V99.              07080000
070900         05  P-CAPI-NEW-HARM-RATIO      PIC 9(1)V9999.            07090000
071000         05  P-CAPI-CSTCHG-RATIO        PIC 9V999.                07100000
071100         05  P-CAPI-NEW-HOSP            PIC X.                    07110000
071200         05  P-CAPI-IME                 PIC 9V9999.               07120000
071300         05  P-CAPI-EXCEPTIONS          PIC 9(4)V99.              07130000
071400         05  FILLER                     PIC X(46).                07140000
071500                                                                  07150000
071600******************************************************************07160000
071700*                   THIS IS THE WAGE-INDEX                        07170000
071800*          ASSOCIATED WITH THE BILL BEING PROCESSED               07180000
071900******************************************************************07190000
072000 01  WAGE-INDEX-RECORD.                                           07200000
072100     05  W-MSA                         PIC X(4).                  07210000
072200     05  W-SIZE                        PIC X.                     07220000
072300         88  LARGE-URBAN       VALUE 'L'.                         07230000
072400         88  OTHER-URBAN       VALUE 'O'.                         07240000
072500         88  ALL-RURAL         VALUE 'R'.                         07250000
072600     05  W-EFF-DATE                    PIC X(6).                  07260000
072700     05  FILLER                        PIC X.                     07270000
072800     05  W-INDEX-RECORD                PIC S9(02)V9(04).          07280000
072900                                                                  07290000
073000                                                                  07300000
073100 PROCEDURE DIVISION  USING BILL-DATA                              07310000
073200                           PPS-DATA                               07320000
073300                           PRICER-OPT-VERS-SW                     07330000
073400                           PPS-ADDITIONAL-VARIABLES               07340000
073500                           PROV-HOLD                              07350000
073600                           WAGE-INDEX-RECORD.                     07360000
073700                                                                  07370000
073800***************************************************************   07380000
073900*    PROCESSING:                                              *   07390000
074000*        A. WILL PROCESS CASES BASED ON DISCHARGE DATE            07400000
074100*        B. INITIALIZE PPCAL  HOLD VARIABLES.                 *   07410000
074200*        C. EDIT THE DATA PASSED FROM THE BILL BEFORE         *   07420000
074300*           ATTEMPTING TO CALCULATE PPS. IF THIS BILL         *   07430000
074400*           CANNOT BE PROCESSED, SET A RETURN CODE AND        *   07440000
074500*           GOBACK.                                           *   07450000
074600*        D. ASSEMBLE PRICING COMPONENTS.                      *   07460000
074700*        E. CALCULATE THE BLENDED PRICE.                      *   07470000
074800***************************************************************   07480000
074900                                                                  07490000
075000     PERFORM 0200-MAINLINE-CONTROL.                               07500000
075100                                                                  07510000
075200     MOVE HOLD-ADDITIONAL-VARIABLES TO  PPS-ADDITIONAL-VARIABLES. 07520000
075300     MOVE H-DSCHG-FRCTN             TO  PPS-DSCHG-FRCTN.          07530000
075400     MOVE H-DRG-WT-FRCTN            TO  PPS-DRG-WT-FRCTN.         07540000
075500     MOVE HOLD-CAPITAL-VARIABLES    TO  PPS-CAPITAL-VARIABLES.    07550000
075600     MOVE HOLD-CAPITAL2-VARIABLES   TO  PPS-CAPITAL2-VARIABLES.   07560000
075700     MOVE CAL-VERSION               TO  PPS-CALC-VERS.            07570000
075800                                                                  07580000
075900     GOBACK.                                                      07590000
076000                                                                  07600000
076100 0200-MAINLINE-CONTROL.                                           07610000
076200     MOVE ALL '0' TO PPS-DATA                                     07620000
076300                     HOLD-PPS-COMPONENTS                          07630000
076400                     HOLD-ADDITIONAL-VARIABLES                    07640000
076500                     HOLD-CAPITAL-VARIABLES                       07650000
076600                     HOLD-CAPITAL2-VARIABLES.                     07660000
076700                                                                  07670000
076800     IF P-CAPI-HOSP-SPEC-RATE NOT NUMERIC                         07680000
076900        MOVE 0 TO P-CAPI-HOSP-SPEC-RATE.                          07690000
077000                                                                  07700000
077100     IF P-CAPI-OLD-HARM-RATE  NOT NUMERIC                         07710000
077200        MOVE 0 TO P-CAPI-OLD-HARM-RATE.                           07720000
077300                                                                  07730000
077400     IF P-CAPI-NEW-HARM-RATIO NOT NUMERIC                         07740000
077500        MOVE 0 TO P-CAPI-NEW-HARM-RATIO.                          07750000
077600                                                                  07760000
077700     IF P-CAPI-CSTCHG-RATIO NOT NUMERIC                           07770000
077800        MOVE 0 TO P-CAPI-CSTCHG-RATIO.                            07780000
077900                                                                  07790000
078000******************************************************************07800000
078100     PERFORM 1000-EDIT-THE-BILL-INFO.                             07810000
078200                                                                  07820000
078300     IF  PPS-RTC = 00                                             07830000
078400         PERFORM 2000-ASSEMBLE-PPS-VARIABLES                      07840000
078500         PERFORM 3000-CALC-BLENDED-PAYMENT.                       07850000
078600                                                                  07860000
078700 1000-EDIT-THE-BILL-INFO.                                         07870000
078800***************************************************************   07880000
078900*    BILL DATA EDITS IF ANY FAIL SET PPS-RTC                  *   07890000
079000*    AND DO NOT ATTEMPT TO PRICE.                             *   07900000
079100***************************************************************   07910000
079200                                                                  07920000
079300     MOVE B-DISCHG-YY TO H-BILL-YY.                               07930000
079400     MOVE B-DISCHG-MM TO H-BILL-MM.                               07940000
079500     MOVE B-DISCHG-DD TO H-BILL-DD.                               07950000
079600                                                                  07960000
079700     MOVE P-FY-BEGIN-YY TO H-FY-BEGIN-YY.                         07970000
079800     MOVE P-FY-BEGIN-MM TO H-FY-BEGIN-MM.                         07980000
079900     MOVE P-FY-BEGIN-DD TO H-FY-BEGIN-DD.                         07990000
080000                                                                  08000000
080100     IF HOLD-FY-BEGIN-DATE < 941001                               08010000
080200        MOVE .30 TO H-CAPI-PAYCDE-PCT1                            08020000
080300        MOVE .70 TO H-CAPI-PAYCDE-PCT2                            08030000
080400     ELSE                                                         08040000
080500        IF (HOLD-FY-BEGIN-DATE < HOLD-BILL-DATE) OR               08050000
080600           (HOLD-FY-BEGIN-DATE = HOLD-BILL-DATE)                  08060000
080700              MOVE .40 TO H-CAPI-PAYCDE-PCT1                      08070000
080800              MOVE .60 TO H-CAPI-PAYCDE-PCT2                      08080000
080900        ELSE                                                      08090000
081000              MOVE .30 TO H-CAPI-PAYCDE-PCT1                      08100000
081100              MOVE .70 TO H-CAPI-PAYCDE-PCT2.                     08110000
081200                                                                  08120000
081300     IF  PPS-RTC = 00                                             08130000
081400         IF  WAIVER-STATE                                         08140000
081500             MOVE 53 TO PPS-RTC.                                  08150000
081600                                                                  08160000
081700     IF  PPS-RTC = 00                                             08170000
081800         IF  B-DRG < 001 OR > 495 OR = 109 OR = 438               08180000
081900                                  OR = 469 OR = 470               08190000
082000                                  OR = 474                        08200000
082100             MOVE 54 TO PPS-RTC.                                  08210000
082200                                                                  08220000
082300     IF  PPS-RTC = 00                                             08230000
082400         IF  HOLD-BILL-DATE < P-EFF-DATE                          08240000
082500             MOVE 55 TO PPS-RTC.                                  08250000
082600                                                                  08260000
082700     IF  PPS-RTC = 00                                             08261000
082800         IF  B-REVIEW-CODE NOT NUMERIC                            08262000
082900             MOVE 57 TO PPS-RTC.                                  08263000
083000     IF  PPS-RTC = 00                                             08270000
083100         IF  B-LOS NOT NUMERIC                                    08280000
083200             MOVE 56 TO PPS-RTC                                   08290000
083300         ELSE                                                     08300000
083400         IF  B-LOS = 0                                            08310000
083500             IF B-REVIEW-CODE NOT = 03 AND                        08320000
083600                              NOT = 06                            08330000
083700             MOVE 56 TO PPS-RTC.                                  08340000
083800                                                                  08350000
083900     IF  PPS-RTC = 00                                             08360000
084000         IF  B-LTR-DAYS NOT NUMERIC OR B-LTR-DAYS > 60            08370000
084100             MOVE 61 TO PPS-RTC                                   08380000
084200         ELSE                                                     08390000
084300             MOVE B-LTR-DAYS TO H-LTR-DAYS.                       08400000
084400                                                                  08410000
084500     IF  PPS-RTC = 00                                             08420000
084600         IF  B-COVERED-DAYS NOT NUMERIC                           08430000
084700             MOVE 62 TO PPS-RTC                                   08440000
084800         ELSE                                                     08450000
084900         IF  B-COVERED-DAYS = 0 AND B-LOS > 0                     08460000
085000             MOVE 62 TO PPS-RTC                                   08470000
085100         ELSE                                                     08480000
085200             MOVE B-COVERED-DAYS TO H-COV-DAYS.                   08490000
085300                                                                  08500000
085400     IF  PPS-RTC = 00                                             08510000
085500         IF  H-LTR-DAYS  > H-COV-DAYS                             08520000
085600             MOVE 62 TO PPS-RTC                                   08530000
085700         ELSE                                                     08540000
085800             COMPUTE H-REG-DAYS = H-COV-DAYS - H-LTR-DAYS.        08550000
085900                                                                  08560000
086000     IF  PPS-RTC = 00                                             08570000
086100         IF  NOT VALID-REVIEW-CODE                                08580000
086200             MOVE 57 TO PPS-RTC.                                  08590000
086300                                                                  08600000
086400     IF  PPS-RTC = 00                                             08610000
086500         IF  B-CHARGES-CLAIMED NOT NUMERIC                        08620000
086600             MOVE 58 TO PPS-RTC.                                  08630000
086700                                                                  08640000
086800     IF PPS-RTC = 00                                              08650000
086900        IF NOT INDIAN-HEALTH-SERVICE                              08660000
087000           IF P-CAPI-NEW-HOSP NOT = 'Y'                           08670000
087100                 IF P-CAPI-PPS-PAY-CODE NOT = 'A' AND             08680000
087200                                        NOT = 'B' AND             08690000
087300                                        NOT = 'C'                 08700000
087400                 MOVE 65 TO PPS-RTC.                              08710000
087500                                                                  08720000
087600 2000-ASSEMBLE-PPS-VARIABLES.                                     08730000
087700***************************************************************   08740000
087800*    THE APPROPRIATE SET OF THESE PPS VARIABLES ARE SELECTED  *   08750000
087900*    DEPENDING ON THE BILL DISCHARGE DATE AND EFFECTIVE DATE  *   08760000
088000*    OF THAT VARIABLE.                                        *   08770000
088100***************************************************************   08780000
088200***  GET THE PROVIDER SPECIFIC VARIABLES.                         08790000
088300                                                                  08800000
088400     MOVE P-CMI-ADJ-CPD  TO H-CMI-ADJ-CPD.                        08810000
088500     MOVE P-INTERN-RATIO TO H-INTERN-RATIO.                       08820000
088600                                                                  08830000
088700     IF  NOT (P-STATE = 02 OR 12)                                 08840000
088800         MOVE 1 TO H-OPER-COLA                                    08850000
088900     ELSE                                                         08860000
089000         MOVE P-COLA TO H-OPER-COLA.                              08870000
089100                                                                  08880000
089200***************************************************************   08890000
089300***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              08900000
089400                                                                  08910000
089500     PERFORM 2600-GET-DRG-WEIGHT                                  08920000
089600             VARYING DX5 FROM 1 BY 1 UNTIL DX5 > 1.               08930000
089700                                                                  08940000
089800***************************************************************   08950000
089900***  GET THE WAGE-INDEX                                           08960000
090000                                                                  08970000
090100     MOVE W-INDEX-RECORD TO H-WAGE-INDEX.                         08980000
090200                                                                  08990000
090300***************************************************************   09000000
090400***  GET THE LABOR, NON-LABOR STANDARD RATES                      09010000
090500                                                                  09020000
090600     IF  VALID-CENSUS-DIV                                         09030000
090700         MOVE P-CURRENT-CENSUS-DIV TO R2                          09040000
090800     ELSE                                                         09050000
090900         MOVE 10 TO R2.                                           09060000
091000                                                                  09070000
091100     MOVE 10 TO R4.                                               09080000
091200                                                                  09090000
091300     IF  P-STATE = 40                                             09100000
091400         MOVE 11 TO R2                                            09110000
091500         MOVE 12 TO R4.                                           09120000
091600                                                                  09130000
091700     IF  LARGE-URBAN                                              09140000
091800         MOVE 1 TO R3                                             09150000
091900     ELSE                                                         09160000
092000     IF  OTHER-URBAN OR REFERRAL-CENTER                           09170000
092100         MOVE 2 TO R3                                             09180000
092200     ELSE                                                         09190000
092300         MOVE 3 TO R3.                                            09200000
092400                                                                  09210000
092500     PERFORM 2300-GET-LABOR-NLABOR-RATES                          09220000
092600             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 09230000
092700                                                                  09240000
092800***************************************************************   09250000
092900***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               09260000
093000                                                                  09270000
093100     MOVE 0.00  TO H-OPER-HSP-PCT.                                09280000
093200     MOVE 1.00  TO H-OPER-FSP-PCT.                                09290000
093300                                                                  09300000
093400***************************************************************   09310000
093500***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     09320000
093600                                                                  09330000
093700      MOVE 1.00 TO H-NAT-PCT.                                     09340000
093800      MOVE 0.00 TO H-REG-PCT.                                     09350000
093900                                                                  09360000
094000***************************************************************   09370000
094100*    REGIONAL FLOOR                                               09380000
094200                                                                  09390000
094300     IF  (H-REG-LABOR + H-REG-NLABOR) >                           09400000
094400         (H-NAT-LABOR + H-NAT-NLABOR)                             09410000
094500           MOVE 0.85 TO H-NAT-PCT                                 09420000
094600           MOVE 0.15 TO H-REG-PCT.                                09430000
094700                                                                  09440000
094800     IF  P-STATE = 40                                             09450000
094900         MOVE 0.25 TO H-NAT-PCT                                   09460000
095000         MOVE 0.75 TO H-REG-PCT.                                  09470000
095100                                                                  09480000
095200     IF  SCH-REBASED-FY90 OR EACH                                 09490000
095300         MOVE 1.00 TO H-OPER-HSP-PCT.                             09500000
095400                                                                  09510000
095500                                                                  09520000
095600 2300-GET-LABOR-NLABOR-RATES.                                     09530000
095700                                                                  09540000
095800     IF  HOLD-BILL-DATE NOT < RATE-EFF-DATE (R1)                  09550000
095900         MOVE REG-LABOR  (R1 R2 R3) TO H-REG-LABOR                09560000
096000         MOVE REG-NLABOR (R1 R2 R3) TO H-REG-NLABOR               09570000
096100         MOVE REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR                09580000
096200         MOVE REG-NLABOR (R1 R4 R3) TO H-NAT-NLABOR               09590000
096300         IF OTHER-URB-TO-RURAL OR LARGE-URB-TO-RURAL              09600000
096400            PERFORM 2350-BLEND-RURAL-RATES.                       09610000
096500                                                                  09620000
096600 2350-BLEND-RURAL-RATES.                                          09630000
096700      COMPUTE BLEND-RURAL-PCT ROUNDED = 1 / 3.                    09640000
096800                                                                  09650000
096900      IF OTHER-URB-TO-RURAL                                       09660000
097000         COMPUTE H-REG-LABOR  ROUNDED =                           09670000
097100             (REG-LABOR  (R1 R2 2) - REG-LABOR  (R1 R2 3))        09680000
097200               * BLEND-RURAL-PCT   +  REG-LABOR  (R1 R2 3)        09690000
097300                                                                  09700000
097400         COMPUTE H-REG-NLABOR ROUNDED =                           09710000
097500             (REG-NLABOR (R1 R2 2) - REG-NLABOR (R1 R2 3))        09720000
097600               * BLEND-RURAL-PCT   +  REG-NLABOR (R1 R2 3)        09730000
097700                                                                  09740000
097800         COMPUTE H-NAT-LABOR  ROUNDED =                           09750000
097900             (REG-LABOR  (R1 R4 2) - REG-LABOR  (R1 R4 3))        09760000
098000               * BLEND-RURAL-PCT   +  REG-LABOR  (R1 R4 3)        09770000
098100                                                                  09780000
098200         COMPUTE H-NAT-NLABOR ROUNDED =                           09790000
098300             (REG-NLABOR (R1 R4 2) - REG-NLABOR (R1 R4 3))        09800000
098400               * BLEND-RURAL-PCT   +  REG-NLABOR (R1 R4 3).       09810000
098500                                                                  09820000
098600                                                                  09830000
098700      IF LARGE-URB-TO-RURAL                                       09840000
098800         COMPUTE H-REG-LABOR  ROUNDED =                           09850000
098900             (REG-LABOR  (R1 R2 1) - REG-LABOR  (R1 R2 3))        09860000
099000               * BLEND-RURAL-PCT   +  REG-LABOR  (R1 R2 3)        09870000
099100                                                                  09880000
099200         COMPUTE H-REG-NLABOR ROUNDED =                           09890000
099300             (REG-NLABOR (R1 R2 1) - REG-NLABOR (R1 R2 3))        09900000
099400               * BLEND-RURAL-PCT   +  REG-NLABOR (R1 R2 3)        09910000
099500                                                                  09920000
099600         COMPUTE H-NAT-LABOR  ROUNDED =                           09930000
099700             (REG-LABOR  (R1 R4 1) - REG-LABOR  (R1 R4 3))        09940000
099800               * BLEND-RURAL-PCT   +  REG-LABOR  (R1 R4 3)        09950000
099900                                                                  09960000
100000         COMPUTE H-NAT-NLABOR ROUNDED =                           09970000
100100             (REG-NLABOR (R1 R4 1) - REG-NLABOR (R1 R4 3))        09980000
100200               * BLEND-RURAL-PCT   +  REG-NLABOR (R1 R4 3).       09990000
100300                                                                  10000000
100400 2600-GET-DRG-WEIGHT.                                             10010000
100500     IF  HOLD-BILL-DATE NOT < DRGX-EFF-DATE (DX5)                 10020000
100600         SET DX6 TO B-DRG                                         10030000
100700         MOVE DRG-WT (DX5 DX6)         TO H-DRG-WT                10040000
100800         MOVE DRG-ALOS (DX5 DX6)       TO H-ALOS                  10050000
100900         MOVE DRG-DAYS-TRIM (DX5 DX6)  TO H-DAYS-CUTOFF           10060000
101000         MOVE DRG-ARITH-ALOS (DX5 DX6) TO H-ARITH-ALOS.           10070000
101100                                                                  10080000
101200 3000-CALC-BLENDED-PAYMENT.                                       10090000
101300***************************************************************   10100000
101400*    IF THE BILL DATA HAS PASSED ALL EDITS (RTC=00)           *   10110000
101500*        CALCULATE COVERED DAYS UTILIZATION.                  *   10120000
101600*        CALCULATE THE FEDERAL PORTION.                       *   10130000
101700*        CALCULATE THE HOSPITAL PORTION.                      *   10140000
101800*        CALCULATE THE DAYS-OUTLIER PORTION.                  *   10150000
101900*        CALCULATE THE COST-OUTLIER PORTION.                  *   10160000
102000*        CALCULATE THE TOTAL PAYMENT (BLENDED)                *   10170000
102100*        CALCULATE THE DSH ADJUSTMENT.                        *   10180000
102200***************************************************************   10190000
102300     PERFORM 3100-CALC-STAY-UTILIZATION.                          10200000
102400     PERFORM 3300-CALC-OPER-FSP-AMT.                              10210000
102500     PERFORM 3900-CALC-OPER-DSH.                                  10220000
102600***********************************************************       10230000
102700***  OPERATING IME CALCULATION                                    10240000
102800                                                                  10250000
102900         COMPUTE H-OPER-IME-TEACH =                               10260000
103000            1.89 * ((1 + H-INTERN-RATIO) ** .405  - 1).           10270000
103100                                                                  10280000
103200***********************************************************       10290000
103300                                                                  10300000
103400     IF  SCH-REBASED-FY90 OR EACH                                 10310000
103500         PERFORM 3450-CALC-ADDITIONAL-HSP.                        10320000
103600                                                                  10330000
103700     MOVE 00                 TO  PPS-RTC.                         10340000
103800     MOVE H-WAGE-INDEX       TO  PPS-WAGE-INDX.                   10350000
103900     MOVE H-ALOS             TO  PPS-AVG-LOS.                     10360000
104000     MOVE H-DAYS-CUTOFF      TO  PPS-DAYS-CUTOFF.                 10370000
104100                                                                  10380000
104200     PERFORM 3600-CALC-OUTLIER.                                   10390000
104300                                                                  10400000
104400     IF PAY-PERDIEM-DAYS                                          10410000
104500         IF  B-LOS < H-ALOS                                       10420000
104600             IF  NOT (B-DRG = 385 OR 456)                         10430000
104700                 PERFORM 3500-CALC-PERDIEM-AMT                    10440000
104800                 MOVE 03 TO PPS-RTC.                              10450000
104900                                                                  10460000
105000     IF  PAY-PERDIEM-DAYS                                         10470000
105100         IF  H-OPER-OUTCST-PART > 0                               10480000
105200             MOVE H-OPER-OUTCST-PART TO                           10490000
105300                  H-OPER-OUTLIER-PART                             10500000
105400             MOVE 05 TO PPS-RTC                                   10510000
105500         ELSE                                                     10520000
105600         IF  PPS-RTC NOT = 03                                     10530000
105700             MOVE 00 TO PPS-RTC                                   10540000
105800             MOVE 0  TO H-OPER-OUTLIER-PART.                      10550000
105900                                                                  10560000
106000     IF  PAY-PERDIEM-DAYS                                         10570000
106100         IF  H-CAPI-OUTCST-PART > 0                               10580000
106200             MOVE H-CAPI-OUTCST-PART TO                           10590000
106300                  H-CAPI-OUTLIER-PART                             10600000
106400             MOVE 05 TO PPS-RTC                                   10610000
106500         ELSE                                                     10620000
106600         IF  PPS-RTC NOT = 03                                     10630000
106700             MOVE 0  TO H-CAPI-OUTLIER-PART.                      10640000
106800                                                                  10650000
106900     IF  PAY-XFER-NO-COST                                         10660000
107000         MOVE 0  TO H-OPER-OUTLIER-PART                           10670000
107100                    H-CAPI-OUTLIER-PART                           10680000
107200         MOVE 00 TO PPS-RTC                                       10690000
107300         IF B-LOS < H-ALOS                                        10700000
107400            IF  NOT (B-DRG = 385 OR 456)                          10710000
107500                PERFORM 3500-CALC-PERDIEM-AMT                     10720000
107600                MOVE 06 TO PPS-RTC.                               10730000
107700                                                                  10740000
107800     MOVE 1 TO H-DSCHG-FRCTN.                                     10750000
107900                                                                  10760000
108000     IF  (PAY-PERDIEM-DAYS OR                                     10770000
108100          PAY-XFER-NO-COST)                                       10780000
108200          COMPUTE H-DSCHG-FRCTN = H-COV-DAYS / H-ALOS             10790000
108300          IF H-DSCHG-FRCTN > 1                                    10800000
108400             MOVE 1 TO H-DSCHG-FRCTN.                             10810000
108500                                                                  10820000
108600     COMPUTE H-DRG-WT-FRCTN = H-DSCHG-FRCTN * H-DRG-WT.           10830000
108700                                                                  10840000
108800***********************************************************       10850000
108900***  DETERMINES THE FEDERAL AMOUNT THAT WOULD BE PAID IF          10860000
109000***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          10870000
109100                                                                  10880000
109200     COMPUTE H-CAPI2-B-FSP-PART = H-CAPI-FSP-PART.                10890000
109300                                                                  10900000
109400***********************************************************       10910000
109500     IF  PPS-RTC < 50                                             10920000
109600         PERFORM 3800-CALC-TOT-AMT                                10930000
109700     ELSE                                                         10940000
109800         MOVE 0 TO PPS-OPER-HSP-PART                              10950000
109900                   PPS-OPER-FSP-PART                              10960000
110000                   PPS-OPER-OUTLIER-PART                          10970000
110100                   PPS-OUTLIER-DAYS                               10980000
110200                   PPS-REG-DAYS-USED                              10990000
110300                   PPS-LTR-DAYS-USED                              11000000
110400                   PPS-TOTAL-PAYMENT                              11010000
110500                   PPS-OPER-DSH-ADJ                               11020000
110600                   PPS-OPER-IME-ADJ                               11030000
110700                   H-DSCHG-FRCTN                                  11040000
110800                   H-DRG-WT-FRCTN                                 11050000
110900                   HOLD-CAPITAL-VARIABLES                         11060000
111000                   HOLD-CAPITAL2-VARIABLES.                       11070000
111100                                                                  11080000
111200 3100-CALC-STAY-UTILIZATION.                                      11090000
111300     IF  H-REG-DAYS > 0                                           11100000
111400         IF  H-REG-DAYS < H-DAYS-CUTOFF                           11110000
111500             MOVE H-REG-DAYS TO PPS-REG-DAYS-USED                 11120000
111600             MOVE 0          TO H-REG-DAYS                        11130000
111700         ELSE                                                     11140000
111800             MOVE H-DAYS-CUTOFF TO PPS-REG-DAYS-USED              11150000
111900             SUBTRACT H-DAYS-CUTOFF FROM H-REG-DAYS               11160000
112000     ELSE                                                         11170000
112100     IF  H-LTR-DAYS < H-DAYS-CUTOFF                               11180000
112200         MOVE H-LTR-DAYS TO PPS-LTR-DAYS-USED                     11190000
112300         MOVE 0          TO H-LTR-DAYS                            11200000
112400     ELSE                                                         11210000
112500         MOVE H-DAYS-CUTOFF TO PPS-LTR-DAYS-USED                  11220000
112600         SUBTRACT H-DAYS-CUTOFF FROM H-LTR-DAYS.                  11230000
112700                                                                  11240000
112800     IF  B-LOS > H-DAYS-CUTOFF                                    11250000
112900         PERFORM 3200-CALC-OUTLIER-UTILIZATION.                   11260000
113000                                                                  11270000
113100 3200-CALC-OUTLIER-UTILIZATION.                                   11280000
113200     COMPUTE PPS-OUTLIER-DAYS =                                   11290000
113300         B-LOS - H-DAYS-CUTOFF.                                   11300000
113400                                                                  11310000
113500     IF  (H-REG-DAYS + H-LTR-DAYS) < PPS-OUTLIER-DAYS             11320000
113600         COMPUTE PPS-OUTLIER-DAYS =                               11330000
113700             H-REG-DAYS + H-LTR-DAYS                              11340000
113800         ADD H-REG-DAYS TO PPS-REG-DAYS-USED                      11350000
113900         ADD H-LTR-DAYS TO PPS-LTR-DAYS-USED                      11360000
114000     ELSE                                                         11370000
114100     IF  H-REG-DAYS < PPS-OUTLIER-DAYS                            11380000
114200         ADD H-REG-DAYS TO PPS-REG-DAYS-USED                      11390000
114300         COMPUTE PPS-LTR-DAYS-USED =                              11400000
114400             PPS-LTR-DAYS-USED + (PPS-OUTLIER-DAYS -              11410000
114500                                  H-REG-DAYS)                     11420000
114600     ELSE                                                         11430000
114700         ADD PPS-OUTLIER-DAYS TO PPS-REG-DAYS-USED.               11440000
114800                                                                  11450000
114900     IF  B-REVIEW-CODE = 03                                       11460000
115000         IF  PPS-REG-DAYS-USED > 0                                11470000
115100             MOVE 0 TO PPS-LTR-DAYS-USED.                         11480000
115200                                                                  11490000
115300 3300-CALC-OPER-FSP-AMT.                                          11500000
115400***********************************************************       11510000
115500***  OPERATING FSP CALCULATION                                    11520000
115600                                                                  11530000
115700     COMPUTE H-OPER-FSP-PART ROUNDED =                            11540000
115800         (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +               11550000
115900         H-NAT-NLABOR * H-OPER-COLA) * H-DRG-WT)                  11560000
116000                           +                                      11570000
116100         (H-REG-PCT * (H-REG-LABOR * H-WAGE-INDEX +               11580000
116200         H-REG-NLABOR * H-OPER-COLA) * H-DRG-WT).                 11590000
116300                                                                  11600000
116400 3450-CALC-ADDITIONAL-HSP.                                        11610000
116500***********************************************************       11620000
116600*    OBRA 89 CALCULATE ADDITIONAL HSP PAYMENT FOR                 11630000
116700*    SOLE COMMUNITY                                               11640000
116800*    AND ESSENTIAL ACCESS COMMUNITY HOSPITALS (EACH)              11650000
116900*    NOW REIMBURSED WITH 100% NATIONAL FEDERAL RATES              11660000
117000***********************************************************       11670000
117100**** CHANGE ESTIMATED OUTLIER FACTORS WHEN FED RATES CHANGE       11680000
117200****    USE ACTUAL FEDERAL REGISTER NUMBER                        11690000
117300                                                                  11700000
117400     MOVE 0.948940 TO H-OUTLIER-FACT.                             11710000
117500***************************************************************   11720000
117600***         GET THE UPDATING FACTOR                               11730000
117700                                                                  11740000
117800     MOVE 0.999003 TO H-BUDG-NUTR94.                              11750000
117900     MOVE 0.998050 TO H-BUDG-NUTR95.                              11760000
118000                                                                  11770000
118100     COMPUTE H-UPDATE-FACTOR ROUNDED =                            11780000
118200        (1.014 * H-BUDG-NUTR94 * H-BUDG-NUTR95 * 0.999851).       11790000
118300                                                                  11800000
118400     COMPUTE H-HSP-RATE ROUNDED =                                 11810000
118500         H-CMI-ADJ-CPD * H-UPDATE-FACTOR.                         11820000
118600                                                                  11830000
118700     COMPUTE H-FSP-RATE ROUNDED =                                 11840000
118800         ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +              11850000
118900         H-NAT-NLABOR * H-OPER-COLA))                             11860000
119000                           +                                      11870000
119100          (H-REG-PCT * (H-REG-LABOR * H-WAGE-INDEX +              11880000
119200         H-REG-NLABOR * H-OPER-COLA)))                            11890000
119300                           *                                      11900000
119400       ((1 + H-OPER-IME-TEACH + H-OPER-DSH) / H-OUTLIER-FACT).    11910000
119500                                                                  11920000
119600     IF  H-HSP-RATE > H-FSP-RATE                                  11930000
119700           COMPUTE H-OPER-HSP-PART =                              11940000
119800             (H-HSP-RATE - H-FSP-RATE) * H-DRG-WT                 11950000
119900     ELSE                                                         11960000
120000         MOVE 0 TO H-OPER-HSP-PART.                               11970000
120100                                                                  11980000
120200***************************************************************   11990000
120300***        IF MDH IS REVIVED --- REPLACE THIS CODE                12000000
120400***  IF  H-HSP-RATE > H-FSP-RATE                                  12010000
120500***      IF P-PROVIDER-TYPE = '14' OR '15'                        12020000
120600***         COMPUTE H-OPER-HSP-PART =                             12030000
120700***            (H-HSP-RATE - H-FSP-RATE) * H-DRG-WT * .5.         12040000
120800***************************************************************   12050000
120900                                                                  12060000
121000 3500-CALC-PERDIEM-AMT.                                           12070000
121100     MOVE B-LOS TO H-COV-DAYS.                                    12080000
121200     IF  H-COV-DAYS = 0                                           12090000
121300         MOVE 1 TO H-COV-DAYS.                                    12100000
121400***********************************************************       12110000
121500***  OPERATING PERDIEM-AMT CALCULATION                            12120000
121600***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              12130000
121700                                                                  12140000
121800     COMPUTE H-OPER-HSP-PART ROUNDED =                            12150000
121900        H-OPER-HSP-PART / H-ALOS * H-COV-DAYS                     12160000
122000        ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART.                  12170000
122100                                                                  12180000
122200     COMPUTE H-OPER-FSP-PART ROUNDED =                            12190000
122300        H-OPER-FSP-PART / H-ALOS * H-COV-DAYS                     12200000
122400        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  12210000
122500                                                                  12220000
122600***********************************************************       12230000
122700***  CAPITAL PERDIEM-AMT CALCULATION                              12240000
122800***  CAPITAL HSP AND FSP CALCULATION FOR TRANSFERS                12250000
122900                                                                  12260000
123000     COMPUTE H-CAPI-HSP-PART ROUNDED =                            12270000
123100        H-CAPI-HSP-PART / H-ALOS * H-COV-DAYS                     12280000
123200        ON SIZE ERROR MOVE 0 TO H-CAPI-HSP-PART.                  12290000
123300                                                                  12300000
123400     COMPUTE H-CAPI-FSP-PART ROUNDED =                            12310000
123500        H-CAPI-FSP-PART / H-ALOS * H-COV-DAYS                     12320000
123600        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  12330000
123700                                                                  12340000
123800***********************************************************       12350000
123900***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                12360000
124000                                                                  12370000
124100     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        12380000
124200        H-CAPI-OLD-HARMLESS / H-ALOS * H-COV-DAYS                 12390000
124300        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              12400000
124400                                                                  12410000
124500 3600-CALC-OUTLIER.                                               12420000
124600     MOVE 0.47 TO H-DAYOUT-PCT.                                   12430000
124700                                                                  12440000
124800     MOVE 0.80 TO H-CSTOUT-PCT.                                   12450000
124900                                                                  12460000
125000     IF  B-DRG = 456 OR 457 OR 458 OR 459 OR 460 OR 472           12470000
125100             MOVE 0.90 TO H-CSTOUT-PCT.                           12480000
125200                                                                  12490000
125300     MOVE 0.7140   TO H-LABOR-PCT.                                12500000
125400     MOVE 0.2860   TO H-NLABOR-PCT.                               12510000
125500                                                                  12520000
125600     IF  P-OPER-CSTCHG-RATIO NUMERIC                              12530000
125700             MOVE P-OPER-CSTCHG-RATIO TO H-OPER-CSTCHG-RATIO      12540000
125800     ELSE                                                         12550000
125900             MOVE 0.000 TO H-OPER-CSTCHG-RATIO.                   12560000
126000                                                                  12570000
126100     IF P-CAPI-CSTCHG-RATIO NUMERIC                               12580000
126200             MOVE P-CAPI-CSTCHG-RATIO TO H-CAPI-CSTCHG-RATIO      12590000
126300     ELSE                                                         12600000
126400             MOVE 0.000 TO H-CAPI-CSTCHG-RATIO.                   12610000
126500                                                                  12620000
126600***********************************************************       12630000
126700***  OPERATING DAY OUTLIER CALCULATION                            12640000
126800                                                                  12650000
126900     IF  PPS-OUTLIER-DAYS > 0                                     12660000
127000        COMPUTE H-OPER-OUTDAY-PART =                              12670000
127100            H-DAYOUT-PCT *  H-OPER-FSP-PART / H-ARITH-ALOS        12680000
127200                                       * PPS-OUTLIER-DAYS         12690000
127300            ON SIZE ERROR MOVE 0 TO H-OPER-OUTDAY-PART.           12700000
127400                                                                  12710000
127500***********************************************************       12720000
127600***********************************************************       12730000
127700***  CAPITAL PAYMENT METHOD B                                     12740000
127800                                                                  12750000
127900     IF W-SIZE = 'L'                                              12760000
128000        MOVE 1.03 TO H-CAPI-LARG-URBAN                            12770000
128100     ELSE                                                         12780000
128200        MOVE 1.00 TO H-CAPI-LARG-URBAN                            12790000
128300        IF LARGE-URB-TO-RURAL                                     12800000
128400           MOVE 1.01 TO H-CAPI-LARG-URBAN.                        12810000
128500                                                                  12820000
128600                                                                  12830000
128700     COMPUTE H-CAPI-GAF = (H-WAGE-INDEX ** .6848).                12840000
128800                                                                  12850000
128900     COMPUTE H-CAPI-COLA =                                        12860000
129000                     (.3152 * (H-OPER-COLA - 1) + 1).             12870000
129100                                                                  12880000
129200     MOVE 0289.87 TO H-PUERTO-RICO-RATE.                          12890000
129300     MOVE 0376.83 TO H-FEDERAL-RATE.                              12900000
129400                                                                  12910000
129500     IF P-STATE = 40                                              12920000
129600        COMPUTE  H-CAPI-FED-RATE =                                12930000
129700                      (.75 * H-PUERTO-RICO-RATE) +                12940000
129800                      (.25 * H-FEDERAL-RATE)                      12950000
129900     ELSE                                                         12960000
130000        MOVE H-FEDERAL-RATE TO H-CAPI-FED-RATE.                   12970000
130100                                                                  12980000
130200***********************************************************       12990000
130300***  CAPITAL HSP CALCULATION                                      13000000
130400                                                                  13010000
130500     COMPUTE H-ACCUM-TO-HSP = 0.9784 * 1.0005.                    13020000
130600     COMPUTE H-CAPI-HSP-PART = (H-DRG-WT *                        13030000
130700                   P-CAPI-HOSP-SPEC-RATE * H-ACCUM-TO-HSP).       13040000
130800***********************************************************       13050000
130900***  CAPITAL FSP CALCULATION                                      13060000
131000                                                                  13070000
131100     COMPUTE H-CAPI-FSP-PART = H-DRG-WT * H-CAPI-FED-RATE *       13080000
131200                               H-CAPI-COLA * H-CAPI-GAF *         13090000
131300                               H-CAPI-LARG-URBAN.                 13100000
131400                                                                  13110000
131500***********************************************************       13120000
131600***  CAPITAL PAYMENT METHOD A                                     13130000
131700                                                                  13140000
131800     IF SCH-REBASED-FY90 OR EACH                                  13150000
131900        MOVE 1.00 TO H-CAPI-SCH                                   13160000
132000     ELSE                                                         13170000
132100        MOVE 0.85 TO H-CAPI-SCH.                                  13180000
132200                                                                  13190000
132300***********************************************************       13200000
132400***********  CAPITAL OLD-HARMLESS CALCULATION ***********         13210000
132500                                                                  13220000
132600     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        13230000
132700                    (P-CAPI-OLD-HARM-RATE *                       13240000
132800                    H-CAPI-SCH).                                  13250000
132900                                                                  13260000
133000***********************************************************       13270000
133100***********************************************************       13280000
133200***  CAPITAL DAY OUTLIER CALCULATION                              13290000
133300                                                                  13300000
133400     IF  PPS-OUTLIER-DAYS > 0                                     13310000
133500         COMPUTE H-CAPI-OUTDAY-PART =                             13320000
133600            H-DAYOUT-PCT * H-CAPI-FSP-PART / H-ARITH-ALOS         13330000
133700                                       * PPS-OUTLIER-DAYS         13340000
133800            ON SIZE ERROR MOVE 0 TO H-CAPI-OUTDAY-PART.           13350000
133900                                                                  13360000
134000     IF  H-CAPI-OUTDAY-PART  > 0                                  13370000
134100         IF P-CAPI-PPS-PAY-CODE = 'A'                             13380000
134200             COMPUTE H-CAPI-OUTDAY-PART =                         13390000
134300                 H-CAPI-OUTDAY-PART * P-CAPI-NEW-HARM-RATIO       13400000
134400             ON SIZE ERROR MOVE 0 TO H-CAPI-OUTDAY-PART.          13410000
134500                                                                  13420000
134600     IF  H-CAPI-OUTDAY-PART  > 0                                  13430000
134700         IF P-CAPI-PPS-PAY-CODE = 'C'                             13440000
134800             COMPUTE H-CAPI-OUTDAY-PART =                         13450000
134900                    (H-CAPI-OUTDAY-PART * H-CAPI-PAYCDE-PCT1)     13460000
135000             ON SIZE ERROR MOVE 0 TO H-CAPI-OUTDAY-PART.          13470000
135100                                                                  13480000
135200***********************************************************       13490000
135300***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               13500000
135400                                                                  13510000
135500     IF H-CAPI-CSTCHG-RATIO > 0 OR                                13520000
135600       H-OPER-CSTCHG-RATIO > 0                                    13530000
135700        COMPUTE H-OPER-SHARE-DOLL-THRESHOLD =                     13540000
135800                H-OPER-CSTCHG-RATIO /                             13550000
135900               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        13560000
136000        COMPUTE H-CAPI-SHARE-DOLL-THRESHOLD =                     13570000
136100                H-CAPI-CSTCHG-RATIO /                             13580000
136200               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        13590000
136300     ELSE                                                         13600000
136400         MOVE 0 TO H-OPER-SHARE-DOLL-THRESHOLD                    13610000
136500                   H-CAPI-SHARE-DOLL-THRESHOLD.                   13620000
136600                                                                  13630000
136700     MOVE 20500.00 TO H-CST-THRESH.                               13640000
136800     MOVE 18800.00 TO H-PRE-CAPI-THRESH.                          13650000
136900                                                                  13660000
137000     COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                    13670000
137100        ((H-CST-THRESH * H-LABOR-PCT  * H-WAGE-INDEX) +           13680000
137200         (H-CST-THRESH * H-NLABOR-PCT * H-OPER-COLA)) *           13690000
137300          H-OPER-SHARE-DOLL-THRESHOLD.                            13700000
137400                                                                  13710000
137500***********************************************************       13720000
137600***  DIFFERENT THRESHOLD   PRE-CAPITAL                            13730000
137700                                                                  13740000
137800     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          13750000
137900        COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                 13760000
138000        (H-PRE-CAPI-THRESH * H-LABOR-PCT * H-WAGE-INDEX) +        13770000
138100        (H-PRE-CAPI-THRESH * H-NLABOR-PCT * H-OPER-COLA).         13780000
138200***********************************************************       13790000
138300                                                                  13800000
138400     COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                    13810000
138500          H-CST-THRESH * H-CAPI-GAF * H-CAPI-LARG-URBAN *         13820000
138600          H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA.              13830000
138700                                                                  13840000
138800     COMPUTE H-OPER-COST-OUTLIER ROUNDED =                        13850000
138900          H-OPER-FSP-PART + H-OPER-DOLLAR-THRESHOLD.              13860000
139000                                                                  13870000
139100     COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                        13880000
139200          H-CAPI-FSP-PART + H-CAPI-DOLLAR-THRESHOLD.              13890000
139300                                                                  13900000
139400     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          13910000
139500         MOVE 0 TO H-CAPI-COST-OUTLIER.                           13920000
139600                                                                  13930000
139700     IF B-REVIEW-CODE = '03'  AND H-COV-DAYS < H-ALOS             13940000
139800        COMPUTE H-OPER-COST-OUTLIER ROUNDED =                     13950000
139900                (H-OPER-COST-OUTLIER * H-COV-DAYS / H-ALOS)       13960000
140000                ON SIZE ERROR MOVE 0 TO H-OPER-COST-OUTLIER.      13970000
140100                                                                  13980000
140200     IF B-REVIEW-CODE = '03'  AND H-COV-DAYS < H-ALOS             13990000
140300        COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                     14000000
140400                (H-CAPI-COST-OUTLIER * H-COV-DAYS / H-ALOS)       14010000
140500                ON SIZE ERROR MOVE 0 TO H-CAPI-COST-OUTLIER.      14020000
140600                                                                  14030000
140700***********************************************************       14040000
140800***  CAPITAL DSH CALCULATION                                      14050000
140900     MOVE 0 TO H-CAPI-DSH.                                        14060000
141000                                                                  14070000
141100     IF P-BED-SIZE NOT NUMERIC                                    14080000
141200         MOVE 0 TO P-BED-SIZE.                                    14090000
141300                                                                  14100000
141400     IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE > 99                 14110000
141500         COMPUTE H-CAPI-DSH ROUNDED = 2.7183 **                   14120000
141600                  (.2025 * (P-SSI-RATIO                           14130000
141700                          + P-MEDICAID-RATIO)) - 1.               14140000
141800                                                                  14150000
141900     IF W-SIZE = 'R' AND P-BED-SIZE > 99                          14160000
142000                     AND (OTHER-URB-TO-RURAL OR                   14170000
142100                          LARGE-URB-TO-RURAL)                     14180000
142200         COMPUTE H-CAPI-DSH ROUNDED =                             14190000
142300                 1 / 3 * (2.7183 **                               14200000
142400                  (.2025 * (P-SSI-RATIO                           14210000
142500                          + P-MEDICAID-RATIO)) - 1).              14220000
142600                                                                  14230000
142700***********************************************************       14240000
142800***  OPERATING COST CALCULATION                                   14250000
142900                                                                  14260000
143000     COMPUTE H-OPER-BILL-COSTS ROUNDED =                          14270000
143100         B-CHARGES-CLAIMED * H-OPER-CSTCHG-RATIO /                14280000
143200         (1 + H-OPER-IME-TEACH + H-OPER-DSH)                      14290000
143300         ON SIZE ERROR MOVE 0 TO H-OPER-BILL-COSTS.               14300000
143400                                                                  14310000
143500     IF  H-OPER-BILL-COSTS > H-OPER-COST-OUTLIER                  14320000
143600         COMPUTE H-OPER-OUTCST-PART =                             14330000
143700         H-CSTOUT-PCT * (H-OPER-BILL-COSTS -                      14340000
143800                         H-OPER-COST-OUTLIER).                    14350000
143900                                                                  14360000
144000     IF PAY-WITHOUT-COST                                          14370000
144100         MOVE 0 TO H-OPER-OUTCST-PART.                            14380000
144200                                                                  14390000
144300***********************************************************       14400000
144400***  CAPITAL IME TEACH CALCULATION                                14410000
144500                                                                  14420000
144600     MOVE 0 TO H-WK-CAPI-IME-TEACH.                               14430000
144700                                                                  14440000
144800     IF P-CAPI-IME NUMERIC                                        14450000
144900        COMPUTE H-WK-CAPI-IME-TEACH =                             14460000
145000          (2.7183 ** (.2822 * P-CAPI-IME)) - 1.                   14470000
145100                                                                  14480000
145200***********************************************************       14490000
145300***  CAPITAL COST CALCULATION                                     14500000
145400                                                                  14510000
145500     COMPUTE H-CAPI-BILL-COSTS ROUNDED =                          14520000
145600             B-CHARGES-CLAIMED * H-CAPI-CSTCHG-RATIO /            14530000
145700            (1 + H-WK-CAPI-IME-TEACH + H-CAPI-DSH)                14540000
145800         ON SIZE ERROR MOVE 0 TO H-CAPI-BILL-COSTS.               14550000
145900                                                                  14560000
146000     IF  H-CAPI-BILL-COSTS > H-CAPI-COST-OUTLIER                  14570000
146100         COMPUTE H-CAPI-OUTCST-PART =                             14580000
146200         H-CSTOUT-PCT * (H-CAPI-BILL-COSTS -                      14590000
146300                         H-CAPI-COST-OUTLIER).                    14600000
146400                                                                  14610000
146500     IF P-CAPI-PPS-PAY-CODE = 'A'                                 14620000
146600       COMPUTE H-CAPI-OUTCST-PART =                               14630000
146700              (H-CAPI-OUTCST-PART * P-CAPI-NEW-HARM-RATIO).       14640000
146800                                                                  14650000
146900     IF P-CAPI-PPS-PAY-CODE = 'C'                                 14660000
147000        COMPUTE H-CAPI-OUTCST-PART =                              14670000
147100               (H-CAPI-OUTCST-PART * H-CAPI-PAYCDE-PCT1).         14680000
147200                                                                  14690000
147300     IF (H-CAPI-BILL-COSTS   + H-OPER-BILL-COSTS) <               14700000
147400        (H-CAPI-COST-OUTLIER + H-OPER-COST-OUTLIER)               14710000
147500        MOVE 0 TO H-CAPI-OUTCST-PART                              14720000
147600                  H-OPER-OUTCST-PART.                             14730000
147700                                                                  14740000
147800     IF PAY-WITHOUT-COST                                          14750000
147900         MOVE 0 TO H-CAPI-OUTCST-PART.                            14760000
148000                                                                  14770000
148100***********************************************************       14780000
148200***  DETERMINES THE BILL TO BE EITHER COST OR DAY OUTLIER         14790000
148300***     GREATER OF DAY OR COST OPERATING AND CAPITAL              14800000
148400                                                                  14810000
148500     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          14820000
148600         MOVE 0 TO H-CAPI-OUTDAY-PART                             14830000
148700                   H-CAPI-OUTCST-PART.                            14840000
148800                                                                  14850000
148900      IF (H-OPER-OUTDAY-PART + H-CAPI-OUTDAY-PART) > 0 OR         14860000
149000         (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0            14870000
149100         IF (H-OPER-OUTDAY-PART + H-CAPI-OUTDAY-PART) >           14880000
149200            (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART)             14890000
149300                 MOVE H-OPER-OUTDAY-PART TO                       14900000
149400                      H-OPER-OUTLIER-PART                         14910000
149500                 MOVE H-CAPI-OUTDAY-PART TO                       14920000
149600                      H-CAPI-OUTLIER-PART                         14930000
149700                 MOVE 01 TO PPS-RTC                               14940000
149800             ELSE                                                 14950000
149900                 MOVE H-OPER-OUTCST-PART TO                       14960000
150000                      H-OPER-OUTLIER-PART                         14970000
150100                 MOVE H-CAPI-OUTCST-PART TO                       14980000
150200                      H-CAPI-OUTLIER-PART                         14990000
150300                 MOVE 02 TO PPS-RTC                               15000000
150400                 IF B-COVERED-DAYS > H-DAYS-CUTOFF                15010000
150500                    IF (H-REG-DAYS                                15020000
150600                            +                                     15030000
150700                        H-LTR-DAYS)   <                           15040000
150800                       (B-COVERED-DAYS - H-DAYS-CUTOFF)           15050000
150900                       MOVE 66 TO PPS-RTC.                        15060000
151000                                                                  15070000
151100***********************************************************       15080000
151200***  DETERMINES THE OUTLIER AMOUNT THAT WOULD BE PAID IF          15090000
151300***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          15100000
151400                                                                  15110000
151500     IF P-CAPI-PPS-PAY-CODE = 'A'                                 15120000
151600        COMPUTE H-CAPI2-B-OUTLIER-PART =                          15130000
151700                H-CAPI-OUTLIER-PART / P-CAPI-NEW-HARM-RATIO       15140000
151800         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          15150000
151900                                                                  15160000
152000     IF P-CAPI-PPS-PAY-CODE = 'B'                                 15170000
152100        COMPUTE H-CAPI2-B-OUTLIER-PART =                          15180000
152200                H-CAPI-OUTLIER-PART.                              15190000
152300                                                                  15200000
152400     IF P-CAPI-PPS-PAY-CODE = 'C'                                 15210000
152500        COMPUTE H-CAPI2-B-OUTLIER-PART =                          15220000
152600                H-CAPI-OUTLIER-PART / H-CAPI-PAYCDE-PCT1          15230000
152700         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          15240000
152800***********************************************************       15250000
152900                                                                  15260000
153000 3800-CALC-TOT-AMT.                                               15270000
153100                                                                  15280000
153200***********************************************************       15290000
153300***  CALCULATE FINAL TOTALS FOR OPERATING                         15300000
153400                                                                  15310000
153500     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          15320000
153600         H-OPER-HSP-PCT * H-OPER-HSP-PART.                        15330000
153700                                                                  15340000
153800     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          15350000
153900         H-OPER-FSP-PCT * H-OPER-FSP-PART.                        15360000
154000                                                                  15370000
154100     COMPUTE PPS-OPER-OUTLIER-PART ROUNDED =                      15380000
154200             H-OPER-FSP-PCT * H-OPER-OUTLIER-PART.                15390000
154300                                                                  15400000
154400     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               15410000
154500                                                                  15420000
154600     IF  H-OPER-DSH NUMERIC                                       15430000
154700             COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                   15440000
154800             (PPS-OPER-FSP-PART + PPS-OPER-OUTLIER-PART)          15450000
154900              * H-OPER-DSH.                                       15460000
155000                                                                  15470000
155100     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           15480000
155200         (PPS-OPER-FSP-PART + PPS-OPER-OUTLIER-PART) *            15490000
155300                 H-OPER-IME-TEACH.                                15500000
155400                                                                  15510000
155500***********************************************************       15520000
155600***  CALCULATE FINAL TOTALS FOR CAPITAL                           15530000
155700                                                                  15540000
155800     MOVE P-CAPI-PPS-PAY-CODE  TO H-CAPI2-PAY-CODE.               15550000
155900                                                                  15560000
156000     IF P-CAPI-PPS-PAY-CODE = 'A'                                 15570000
156100        MOVE P-CAPI-NEW-HARM-RATIO TO H-CAPI-FSP-PCT              15580000
156200        MOVE 0.00 TO H-CAPI-HSP-PCT.                              15590000
156300                                                                  15600000
156400     IF P-CAPI-PPS-PAY-CODE = 'B'                                 15610000
156500        MOVE 0    TO H-CAPI-OLD-HARMLESS                          15620000
156600        MOVE 1.00 TO H-CAPI-FSP-PCT                               15630000
156700        MOVE 0.00 TO H-CAPI-HSP-PCT.                              15640000
156800                                                                  15650000
156900     IF P-CAPI-PPS-PAY-CODE = 'C'                                 15660000
157000        MOVE 0    TO H-CAPI-OLD-HARMLESS                          15670000
157100        MOVE H-CAPI-PAYCDE-PCT1 TO H-CAPI-FSP-PCT                 15680000
157200        MOVE H-CAPI-PAYCDE-PCT2 TO H-CAPI-HSP-PCT.                15690000
157300                                                                  15700000
157400     COMPUTE H-CAPI-HSP ROUNDED =                                 15710000
157500         H-CAPI-HSP-PCT * H-CAPI-HSP-PART.                        15720000
157600                                                                  15730000
157700     COMPUTE H-CAPI-FSP ROUNDED =                                 15740000
157800         H-CAPI-FSP-PCT * H-CAPI-FSP-PART.                        15750000
157900                                                                  15760000
158000     MOVE P-CAPI-EXCEPTIONS TO H-CAPI-EXCEPTIONS.                 15770000
158100                                                                  15780000
158200     COMPUTE H-CAPI-OUTLIER ROUNDED =                             15790000
158300             1.00 * H-CAPI-OUTLIER-PART.                          15800000
158400                                                                  15810000
158500     COMPUTE H-CAPI2-B-OUTLIER ROUNDED =                          15820000
158600             1.00 * H-CAPI2-B-OUTLIER-PART.                       15830000
158700                                                                  15840000
158800     COMPUTE H-CAPI2-B-FSP ROUNDED =                              15850000
158900             1.00 * H-CAPI2-B-FSP-PART.                           15860000
159000                                                                  15870000
159100     MOVE H-CAPI-OLD-HARMLESS TO H-CAPI-OLD-HARM.                 15880000
159200                                                                  15890000
159300     COMPUTE H-CAPI-DSH-ADJ ROUNDED =                             15900000
159400             (H-CAPI-FSP + H-CAPI-OUTLIER-PART)                   15910000
159500              * H-CAPI-DSH.                                       15920000
159600                                                                  15930000
159700     COMPUTE H-CAPI-IME-ADJ ROUNDED =                             15940000
159800         (H-CAPI-FSP + H-CAPI-OUTLIER-PART) *                     15950000
159900                 H-WK-CAPI-IME-TEACH.                             15960000
160000                                                                  15970000
160100***********************************************************       15980000
160200***  IF CAPITAL IS NOT IN EFFECT FOR GIVEN PROVIDER               15990000
160300***        THIS ZEROES OUT ALL CAPITAL DATA                       16000000
160400                                                                  16010000
160500     IF (P-CAPI-NEW-HOSP = 'Y') OR INDIAN-HEALTH-SERVICE          16020000
160600        MOVE ALL '0' TO HOLD-CAPITAL-VARIABLES.                   16030000
160700                                                                  16040000
160800     COMPUTE H-CAPI-TOTAL-PAY =                                   16050000
160900             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        16060000
161000             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    16070000
161100             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM.                    16080000
161200                                                                  16090000
161300***********************************************************       16100000
161400***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             16110000
161500                                                                  16120000
161600     COMPUTE PPS-TOTAL-PAYMENT =                                  16130000
161700             PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +              16140000
161800             PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +           16150000
161900             PPS-OPER-IME-ADJ                                     16160000
162000                           +                                      16170000
162100                  H-CAPI-TOTAL-PAY.                               16180000
162200                                                                  16190000
162300 3900-CALC-OPER-DSH.                                              16200000
162400***********************************************************       16210000
162500***  OPERATING DSH CALCULATION                                    16220000
162600                                                                  16230000
162700      MOVE .00 TO H-OPER-DSH.                                     16240000
162800                                                                  16250000
162900      COMPUTE H-WK-OPER-DSH = (P-SSI-RATIO                        16260000
163000                                     + P-MEDICAID-RATIO).         16270000
163100                                                                  16280000
163200      IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE < 100               16290000
163300                               AND H-WK-OPER-DSH > .3999          16300000
163400        MOVE .05 TO H-OPER-DSH.                                   16310000
163500                                                                  16320000
163600      IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE > 99                16330000
163700                               AND H-WK-OPER-DSH > .1499          16340000
163800                               AND H-WK-OPER-DSH < .2021          16350000
163900        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        16360000
164000                                      * .65 + .025.               16370000
164100                                                                  16380000
164200      IF W-SIZE = 'R'          AND P-BED-SIZE > 499               16390000
164300                               AND H-WK-OPER-DSH > .1499          16400000
164400                               AND H-WK-OPER-DSH < .2021          16410000
164500        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        16420000
164600                                 * .65 + .025.                    16430000
164700                                                                  16440000
164800      IF (W-SIZE = 'O' OR 'L') AND P-BED-SIZE > 99                16450000
164900                               AND H-WK-OPER-DSH > .202           16460000
165000        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       16470000
165100                                 * .825 + .0588.                  16480000
165200                                                                  16490000
165300      IF W-SIZE = 'R'          AND P-BED-SIZE > 499               16500000
165400                               AND H-WK-OPER-DSH > .202           16510000
165500        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       16520000
165600                                 * .825 + .0588.                  16530000
165700                                                                  16540000
165800      IF W-SIZE = 'R'          AND P-BED-SIZE < 101               16550000
165900                               AND H-WK-OPER-DSH > .4499          16560000
166000        MOVE .04 TO H-OPER-DSH.                                   16570000
166100                                                                  16580000
166200      IF W-SIZE = 'R'          AND P-BED-SIZE > 100               16590000
166300                               AND P-BED-SIZE < 500               16600000
166400                               AND H-WK-OPER-DSH > .2999          16610000
166500        MOVE .04 TO H-OPER-DSH.                                   16620000
166600                                                                  16630000
166700      IF W-SIZE = 'R'                                             16640000
166800         IF (P-PROVIDER-TYPE = '16' OR '21')                      16650000
166900                               AND H-WK-OPER-DSH > .2999          16660000
167000                               AND P-BED-SIZE < 500               16670000
167100            MOVE .10 TO H-OPER-DSH.                               16680000
167200                                                                  16690000
167300      IF W-SIZE = 'R'                                             16700000
167400         IF (P-PROVIDER-TYPE = '07')                              16710000
167500                               AND H-WK-OPER-DSH > .2999          16720000
167600                               AND P-BED-SIZE > 100               16730000
167700                               AND P-BED-SIZE < 500               16740000
167800            COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .3)     16750000
167900                                 * .6 + .04.                      16760000
168000                                                                  16770000
168100      IF W-SIZE = 'R'                                             16780000
168200         IF (P-PROVIDER-TYPE = '17' OR '22')                      16790000
168300                               AND H-WK-OPER-DSH > .2999          16800000
168400                               AND P-BED-SIZE < 500               16810000
168500            COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .3)     16820000
168600                                 * .6 + .04.                      16830000
168700                                                                  16840000
168800      IF W-SIZE = 'R'                                             16850000
168900         IF (P-PROVIDER-TYPE = '17' OR '22')                      16860000
169000                               AND H-WK-OPER-DSH > .2999          16870000
169100                               AND P-BED-SIZE < 500               16880000
169200                               AND H-OPER-DSH < .10               16890000
169300            MOVE .10 TO H-OPER-DSH.                               16900000
169400                                                                  16910000
169500      IF (P-PROVIDER-TYPE = '19' OR '20')                         16920000
169600          IF P-BED-SIZE < 100 AND H-WK-OPER-DSH > .3999           16930000
169700             COMPUTE H-OPER-DSH ROUNDED = (2 / 3 * H-OPER-DSH) +  16940000
169800                    (1 / 3 * .05).                                16950000
169900                                                                  16960000
170000      IF (P-PROVIDER-TYPE = '19' OR '20')                         16970000
170100          IF P-BED-SIZE > 99                                      16980000
170200                               AND H-WK-OPER-DSH > .1499          16990000
170300                               AND H-WK-OPER-DSH < .2021          17000000
170400             COMPUTE H-OPER-DSH ROUNDED = (2 / 3 * H-OPER-DSH) +  17010000
170500            (1 / 3 * ((H-WK-OPER-DSH - .15) * .65 + .025)).       17020000
170600                                                                  17030000
170700      IF (P-PROVIDER-TYPE = '19' OR '20')                         17040000
170800          IF P-BED-SIZE > 99                                      17050000
170900                               AND H-WK-OPER-DSH > .202           17060000
171000             COMPUTE H-OPER-DSH ROUNDED = (2 / 3 * H-OPER-DSH) +  17070000
171100            (1 / 3 * ((H-WK-OPER-DSH - .202) * .825 + .0588)).    17080000
171200                                                                  17090000
171300******        L A S T   S O U R C E   S T A T E M E N T   *****   17100000
