000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.           PPCAL118.                                  00020000
000300*AUTHOR.            DDS TEAM    .                                 00030000
000400*REMARKS.                CMS.                                     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     'PPCAL118      - W O R K I N G   S T O R A G E'.             00180000
001900 01  CAL-VERSION                    PIC X(05)  VALUE 'C11.8'.     00190000
002000 01  HMO-FLAG                       PIC X      VALUE 'N'.         00200000
002100 01  HMO-TAG                        PIC X      VALUE SPACE.       00210000
002200 01  OUTLIER-RECON-FLAG             PIC X      VALUE 'N'.         00220000
002300 01  TEMP-RELIEF-FLAG               PIC X      VALUE 'N'.         00230000
002400 01  NON-TEMP-RELIEF-PAYMENT        PIC 9(07)V9(02) VALUE ZEROES. 00240000
002500 01  WK-H-OPER-DOLLAR-THRESHOLD     PIC 9(07)V9(09) VALUE ZEROES. 00250000
002600 01  WK-LOW-VOL25PCT                PIC 99V999999 VALUE 01.000.   00260000
002700 01  WK-LOW-VOL-ADDON               PIC 9(07)V9(02).              00260000
002800 01  R1                             PIC S9(04) COMP SYNC.         00270000
002900 01  R2                             PIC S9(04) COMP SYNC.         00280000
003000 01  R3                             PIC S9(04) COMP SYNC.         00290000
003100 01  R4                             PIC S9(04) COMP SYNC.         00300000
003200 01  H-OPER-DSH-SCH                 PIC 9(01)V9(04).              00310000
003300 01  H-OPER-DSH-RRC                 PIC 9(01)V9(04).              00320000
003400                                                                  00330000
003500***************************************************************   00340000
003600**************YEARCHANGE 2011.0 *******************************   00341001
003700* TABLE 1                                                     *   00350000
003800*    (68.8% LABOR SHARE/31.2% NONLABOR SHARE)                 *   00360000
003900*    (FULL UPDATE (.697)                                      *   00370000
004000*    (QUALITY = 1 WAGE INDEX > 1)                             *   00380000
004100***************************************************************   00390000
004200 01  TB1-RATE-TABLE.                                              00400000
004300     02  TB1-RATE-WORK.                                           00410000
004400*RATE 20101001 REGION  LABOR AND NON-LABOR RATES                  00420000
004500*                  R3=1     /     R3=2                            00430000
004600*               LARGE URBAN / OTHER URBAN                         00440000
004700*               LABOR / NON / LABOR / NON                         00450000
004800*                     /LABOR/       /LABOR                        00460000
004900*             --------------------------------------------        00470000
005000         05  FILLER PIC X(08) VALUE '20101001'.                   00480000
005100         05  TB1-NAT    PIC X(30) VALUE                           00490000
005200            ' 0355291 161120 0355291 161120'.                     00500000
005300         05  TB1-PR     PIC X(30) VALUE                           00510000
005400            ' 0151814 092653 0151814 092653'.                     00520000
005500         05  TB1-NATPR  PIC X(30) VALUE                           00530000
005600            ' 0355291 161120 0355291 161120'.                     00540000
005700***************************************************************   00550000
005800     02  TB1-RATE-TAB REDEFINES TB1-RATE-WORK.                    00560000
005900         05  TB1-RATE-PERIOD            OCCURS 1.                 00570000
006000             10  TB1-RATE-EFF-DATE      PIC X(08).                00580000
006100             10  TB1-REG-NAT            OCCURS 3.                 00590000
006200                 15  TB1-LARGE-OTHER    OCCURS 2.                 00600000
006300                     20  FILLER         PIC X(01).                00610000
006400                     20  TB1-REG-LABOR  PIC 9(05)V9(02).          00620000
006500                     20  FILLER         PIC X(01).                00630000
006600                     20  TB1-REG-NLABOR PIC 9(04)V9(02).          00640000
006700                                                                  00650000
006800***************************************************************   00660000
006900************YEARCHANGE 2011.0 *********************************   00670000
007000* TABLE 2                                                     *   00680000
007100*    (68.8% LABOR SHARE/31.2% NONLABOR SHARE)                 *   00690000
007200*    (REDUCED UPDATE (.697)                                   *   00700000
007300*    (QUALITY NOT = 1 WAGE INDEX > 1)                         *   00710000
007400***************************************************************   00720000
007500 01  TB2-RATE-TABLE.                                              00730000
007600     02  TB2-RATE-WORK.                                           00740000
007700*RATE 20101001 REGION  LABOR AND NON-LABOR RATES                  00750000
007800*                  R3=1     /     R3=2                            00760000
007900*               LARGE URBAN / OTHER URBAN                         00770000
008000*               LABOR / NON / LABOR / NON                         00780000
008100*                     /LABOR/       /LABOR                        00790000
008200*             --------------------------------------------        00800000
008300         05  FILLER PIC X(08) VALUE '20101001'.                   00810000
008400         05  TB2-NAT    PIC X(30) VALUE                           00820000
008500            ' 0348349 157972 0348349 157972'.                     00830000
008600         05  TB2-PR     PIC X(30) VALUE                           00840000
008700            ' 0151814 092653 0151814 092653'.                     00850000
008800         05  TB2-NATPR  PIC X(30) VALUE                           00860000
008900            ' 0348349 157972 0348349 157972'.                     00870000
009000***************************************************************   00880000
009100     02  TB2-RATE-TAB REDEFINES TB2-RATE-WORK.                    00890000
009200         05  TB2-RATE-PERIOD             OCCURS 1.                00900000
009300             10  TB2-RATE-EFF-DATE       PIC X(08).               00910000
009400             10  TB2-REG-NAT             OCCURS 3.                00920000
009500                 15  TB2-LARGE-OTHER     OCCURS 2.                00930000
009600                     20  FILLER          PIC X(01).               00940000
009700                     20  TB2-REG-LABOR   PIC 9(05)V9(02).         00950000
009800                     20  FILLER          PIC X(01).               00960000
009900                     20  TB2-REG-NLABOR  PIC 9(04)V9(02).         00970000
010000***************************************************************   00990000
010100************YEARCHANGE 2011.0 *********************************   00991000
010200* TABLE 3                                                     *   01000000
010300*    (62% LABOR SHARE/38% NONLABOR SHARE)                     *   01010000
010400*    (FULL UPDATE (.62%)                                      *   01020000
010500*    (QUALITY = 1 WAGE INDEX <= 1)                            *   01030000
010600***************************************************************   01040000
010700 01  TB3-RATE-TABLE.                                              01050000
010800     02  TB3-RATE-WORK.                                           01060000
010900*RATE 20101001 REGION  LABOR AND NON-LABOR RATES                  01070000
011000*                  R3=1     /     R3=2                            01080000
011100*               LARGE URBAN / OTHER URBAN                         01090000
011200*               LABOR / NON / LABOR / NON                         01100000
011300*                     /LABOR/       /LABOR                        01110000
011400*             --------------------------------------------        01120000
011500         05  FILLER PIC X(08) VALUE '20101001'.                   01130000
011600         05  TB3-NAT    PIC X(30) VALUE                           01140000
011700            ' 0320175 196236 0320175 196236'.                     01150000
011800         05  TB3-PR     PIC X(30) VALUE                           01160000
011900            ' 0151570 092897 0151570 092897'.                           00
012000         05  TB3-NATPR  PIC X(30) VALUE                                 00
012100            ' 0320175 196236 0320175 196236'.                     01200000
012200****************************************************************  01210000
012300     02  TB3-RATE-TAB REDEFINES TB3-RATE-WORK.                    01210000
012400         05  TB3-RATE-PERIOD            OCCURS 1.                 01220000
012500             10  TB3-RATE-EFF-DATE      PIC X(08).                01230000
012600             10  TB3-REG-NAT            OCCURS 3.                 01240000
012700                 15  TB3-LARGE-OTHER    OCCURS 2.                 01250000
012800                     20  FILLER         PIC X(01).                01260000
012900                     20  TB3-REG-LABOR  PIC 9(05)V9(02).          01270000
013000                     20  FILLER         PIC X(01).                01280000
013100                     20  TB3-REG-NLABOR PIC 9(04)V9(02).          01290000
013200                                                                  01300000
013300***************************************************************   01310000
013400**********YEARCHANGE 2011.0 ***********************************   01320001
013500* TABLE 4                                                     *   01330000
013600*    (62% LABOR SHARE/38% NONLABOR SHARE)                     *   01340000
013700*    (REDUCED UPDATE (.62%)                                   *   01350000
013800*    (QUALITY NOT = 1 WAGE INDEX <=1)                         *   01360000
013900***************************************************************   01370000
014000 01  TB4-RATE-TABLE.                                              01380000
014100     02  TB4-RATE-WORK.                                           01390000
014200*RATE 20101001 REGION  LABOR AND NON-LABOR RATES                  01400000
014300*                  R3=1     /     R3=2                            01410000
014400*               LARGE URBAN / OTHER URBAN                         01420000
014500*               LABOR / NON / LABOR / NON                         01430000
014600*                     /LABOR/       /LABOR                        01440000
014700*             --------------------------------------------        01450000
014800         05  FILLER PIC X(08) VALUE '20101001'.                   01460000
014900         05  TB4-NAT    PIC X(30) VALUE                           01470000
015000            ' 0313919 192402 0313919 192402'.                     01480001
015100         05  TB4-PR     PIC X(30) VALUE                           01490000
015200            ' 0151570 092897 0151570 092897'.                     01500000
015300         05  TB4-NATPR  PIC X(30) VALUE                           01510000
015400            ' 0313919 192402 0313919 192402'.                     01520001
015500***************************************************************   01530000
015600     02  TB4-RATE-TAB REDEFINES TB4-RATE-WORK.                    01540000
015700         05  TB4-RATE-PERIOD             OCCURS 1.                01550000
015800             10  TB4-RATE-EFF-DATE       PIC X(08).               01560000
015900             10  TB4-REG-NAT             OCCURS 3.                01570000
016000                 15  TB4-LARGE-OTHER     OCCURS 2.                01580000
016100                     20  FILLER          PIC X(01).               01590000
016200                     20  TB4-REG-LABOR   PIC 9(05)V9(02).         01600000
016300                     20  FILLER          PIC X(01).               01610000
016400                     20  TB4-REG-NLABOR  PIC 9(04)V9(02).         01620000
016500                                                                  01630000
016600 01  DRG-TABLE.                                                   01640000
016700     05  D-TAB.                                                   01650000
016800         10  FILLER                  PIC X(08) VALUE
016900       '20101001'.
017000         10  FILLER                  PIC X(56) VALUE
017100       '26344131600419136127176002261812393010036611240322200271'.
017200         10  FILLER                  PIC X(56) VALUE
017300       '10177114900199048353083000930933501540018604963210100117'.
017400         10  FILLER                  PIC X(56) VALUE
017500       '00000000000000037831086000970476661230015503131108500101'.
017600         10  FILLER                  PIC X(56) VALUE
017700       '01950505700068115947211002820595041670019300000000000000'.
017800         10  FILLER                  PIC X(56) VALUE
017900       '00000000000000000000000000000000000000000008247914100173'.
018000         10  FILLER                  PIC X(56) VALUE
018100       '06288612100139041581067000840508830820011803495205700081'.
018200         10  FILLER                  PIC X(56) VALUE
018300       '04757508800115029825058000730213070300003905354910100131'.
018400         10  FILLER                  PIC X(56) VALUE
018500       '02874104700066016433025000330412610860012301922003600053'.
018600         10  FILLER                  PIC X(56) VALUE
018700       '01362602100026035242047000700214370220003201639001300015'.
018800         10  FILLER                  PIC X(56) VALUE
018900       '03154305700084015462024000350101850140001703935309000121'.
019000         10  FILLER                  PIC X(56) VALUE
019100       '02143005000067016905024000320000000000000000000000000000'.
019200         10  FILLER                  PIC X(56) VALUE
019300       '00000000000000000000000000000000000000000000000000000000'.
019400         10  FILLER                  PIC X(56) VALUE
019500       '00000000000000000000000000000000000000000001610904500067'.
019600         10  FILLER                  PIC X(56) VALUE
019700       '00844102900036014863046000630106490350004601674805500071'.
019800         10  FILLER                  PIC X(56) VALUE
019900       '00935003700048015856054000720098110410004900757803200038'.
020000         10  FILLER                  PIC X(56) VALUE
020100       '02956806400084019479048000560152510340003901867405100069'.
020200         10  FILLER                  PIC X(56) VALUE
020300       '01166704000048008198027000330142310420005500875102700033'.
020400         10  FILLER                  PIC X(56) VALUE
020500       '00731102300028018417056000730110540410005100749902500031'.
020600         10  FILLER                  PIC X(56) VALUE
020700       '01290704200056008606032000410165670550007000905003300039'.
020800         10  FILLER                  PIC X(56) VALUE
020900       '01737605100064010154035000440075330260003101190903600049'.
021000         10  FILLER                  PIC X(56) VALUE
021100       '00739202700034020130035000610132640340004700895902200028'.
021200         10  FILLER                  PIC X(56) VALUE
021300       '02142305200072012051037000460079290230002901487204200055'.
021400         10  FILLER                  PIC X(56) VALUE
021500       '00966702900037006927019000230163180440006200940403300042'.
021600         10  FILLER                  PIC X(56) VALUE
021700       '00682702400029036769089001170239770660008401924704600056'.
021800         10  FILLER                  PIC X(56) VALUE
021900       '03219109000116019106064000790120840410005201510704500060'.
022000         10  FILLER                  PIC X(56) VALUE
022100       '00761902800034010288031000430067010240003000000000000000'.
022200         10  FILLER                  PIC X(56) VALUE
022300       '00000000000000000000000000000000000000000000000000000000'.
022400         10  FILLER                  PIC X(56) VALUE
022500       '00000000000000000000000000000000000000000000000000000000'.
022600         10  FILLER                  PIC X(56) VALUE
022700       '01831103900056008989020000260120840350004601267503000044'.
022800         10  FILLER                  PIC X(56) VALUE
022900       '00730501600020000000000000000000000000000000000000000000'.
023000         10  FILLER                  PIC X(56) VALUE
023100       '00910404100051006522033000400071440220002701190303800053'.
023200         10  FILLER                  PIC X(56) VALUE
023300       '00685902700034000000000000000000000000000000000000000000'.
023400         10  FILLER                  PIC X(56) VALUE
023500       '02234903700052012299023000290209150410005601244702100027'.
023600         10  FILLER                  PIC X(56) VALUE
023700       '01700003600054008514017000210190820430006400975101700023'.
023800         10  FILLER                  PIC X(56) VALUE
023900       '01300703600050007841019000250087560140001800000000000000'.
024000         10  FILLER                  PIC X(56) VALUE
024100       '00000000000000000000000000000000000000000000000000000000'.
024200         10  FILLER                  PIC X(56) VALUE
024300       '00000000000000021886065000910124130410005700806602400033'.
024400         10  FILLER                  PIC X(56) VALUE
024500       '00638902200026012808037000500063930230002900958403300043'.
024600         10  FILLER                  PIC X(56) VALUE
024700       '00629002500031013965043000580090170330004200622602400029'.
024800         10  FILLER                  PIC X(56) VALUE
024900       '01579404800067009027034000440058970220002700000000000000'.
025000         10  FILLER                  PIC X(56) VALUE
025100       '00000000000000000000000000000508281150014002623606200074'.
025200         10  FILLER                  PIC X(56) VALUE
025300       '01775803700044037383095001190205670580007401300803300043'.
025400         10  FILLER                  PIC X(56) VALUE
025500       '00000000000000000000000000000000000000000000000000000000'.
025600         10  FILLER                  PIC X(56) VALUE
025700       '00000000000000000000000000000160960570006801070604200049'.
025800         10  FILLER                  PIC X(56) VALUE
025900       '02066706800085014887056000680098610410005001736105700075'.
026000         10  FILLER                  PIC X(56) VALUE
026100       '01218204200054008096028000370149420520006500975503600043'.
026200         10  FILLER                  PIC X(56) VALUE
026300       '00680302600030015637053000670110270390004900767802800035'.
026400         10  FILLER                  PIC X(56) VALUE
026500       '01280904300055011924045000550097350380004600722003100037'.
026600         10  FILLER                  PIC X(56) VALUE
026700       '01479605300065010152042000500070960310003701606205600069'.
026800         10  FILLER                  PIC X(56) VALUE
026900       '01117604200051008203031000380178950630008001025203700048'.
027000         10  FILLER                  PIC X(56) VALUE
027100       '00721002800036008424034000410060810260003200671402100027'.
027200         10  FILLER                  PIC X(56) VALUE
027300       '01297203900053007575026000330520681260014702263005100070'.
027400         10  FILLER                  PIC X(56) VALUE
027500       '00000000000000000000000000000000000000000000000000000000'.
027600         10  FILLER                  PIC X(56) VALUE
027700       '00000000000000000000000000001260860690012210023814600170'.
027800         10  FILLER                  PIC X(56) VALUE
027900       '06803809800109053293072000800808311080013105378707200080'.
028000         10  FILLER                  PIC X(56) VALUE
028100       '04480105600060085230094001180642500450006207581907700097'.
028200         10  FILLER                  PIC X(56) VALUE
028300       '06020204200053064510050000770519360200003107588111800142'.
028400         10  FILLER                  PIC X(56) VALUE
028500       '04774507200083035451046000550785821090012905818308500094'.
028600         10  FILLER                  PIC X(56) VALUE
028700       '07208112100137048281082000890585300930010803770706000065'.
028800         10  FILLER                  PIC X(56) VALUE
028900       '05190307100101030830029000420455441120014302658907800096'.
029000         10  FILLER                  PIC X(56) VALUE
029100       '01463105000060037277063000810265080390004902039802200028'.
029200         10  FILLER                  PIC X(56) VALUE
029300       '04248602500038031802035000500196910180002302924804400060'.
029400         10  FILLER                  PIC X(56) VALUE
029500       '01773202200028028836050000700179920220003002975405200079'.
029600         10  FILLER                  PIC X(56) VALUE
029700       '02401404400060016152020000270250430700009201596905600070'.
029800         10  FILLER                  PIC X(56) VALUE
029900       '00975003400043028880052000700183340240003203550007700107'.
030000         10  FILLER                  PIC X(56) VALUE
030100       '01646903200045011246020000260175650350005602530505500082'.
030200         10  FILLER                  PIC X(56) VALUE
030300       '02315702300034000000000000000000000000000000000000000000'.
030400         10  FILLER                  PIC X(56) VALUE
030500       '00000000000000000000000000000000000000000000000000000000'.
030600         10  FILLER                  PIC X(56) VALUE
030700       '00000000000000000000000000000000000000000000000000000000'.
030800         10  FILLER                  PIC X(56) VALUE
030900       '00000000000000000000000000000000000000000001850305200066'.
031000         10  FILLER                  PIC X(56) VALUE
031100       '01191203600044008064022000280171510320005100888802100030'.
031200         10  FILLER                  PIC X(56) VALUE
031300       '00571201400018020014048000650108790250003202939708600108'.
031400         10  FILLER                  PIC X(56) VALUE
031500       '01849206400078012959044000560149430480006201030204000049'.
031600         10  FILLER                  PIC X(56) VALUE
031700       '00685302800033010373044000540064030340004001169201800028'.
031800         10  FILLER                  PIC X(56) VALUE
031900       '00679201400017004497011000120140720470006100977603900049'.
032000         10  FILLER                  PIC X(56) VALUE
032100       '00661502800035009755030000400058300200002401026303500046'.
032200         10  FILLER                  PIC X(56) VALUE
032300       '00613802200028014667044000590079740270003401233904000052'.
032400         10  FILLER                  PIC X(56) VALUE
032500       '00838703000037005709021000250050700180002200717202400029'.
032600         10  FILLER                  PIC X(56) VALUE
032700       '00549901700021018145050000680096810330004200614702100026'.
032800         10  FILLER                  PIC X(56) VALUE
032900       '00000000000000000000000000000000000000000000000000000000'.
033000         10  FILLER                  PIC X(56) VALUE
033100       '00000000000000000000000000000000000000000000000000000000'.
033200         10  FILLER                  PIC X(56) VALUE
033300       '00000000000000058142126001620272310690008801429802900038'.
033400         10  FILLER                  PIC X(56) VALUE
033500       '05280712500154025830078000910162670480005304863511800142'.
033600         10  FILLER                  PIC X(56) VALUE
033700       '02496007100081015979042000490427771140013702345607200088'.
033800         10  FILLER                  PIC X(56) VALUE
033900       '01478904000051032115083001000186590560006501239303200037'.
034000         10  FILLER                  PIC X(56) VALUE
034100       '02264304900066013246030000380095680170002003158608900112'.
034200         10  FILLER                  PIC X(56) VALUE
034300       '01703506000070011883042000460241830630008801370504100054'.
034400         10  FILLER                  PIC X(56) VALUE
034500       '00798102300029024877056000790135390350004500862801900024'.
034600         10  FILLER                  PIC X(56) VALUE
034700       '02751006300084015523040000500103290230002804029309200127'.
034800         10  FILLER                  PIC X(56) VALUE
034900       '02146605700074013010030000400000000000000000000000000000'.
035000         10  FILLER                  PIC X(56) VALUE
035100       '00000000000000000000000000000000000000000000000000000000'.
035200         10  FILLER                  PIC X(56) VALUE
035300       '00000000000000000000000000000000000000000001757805100067'.
035400         10  FILLER                  PIC X(56) VALUE
035500       '01077203700045007546026000310209860680008801293505300065'.
035600         10  FILLER                  PIC X(56) VALUE
035700       '00859903900046020674063000840128010440005800847802800036'.
035800         10  FILLER                  PIC X(56) VALUE
035900       '01754105000064010274035000420071460260003001965605800076'.
036000         10  FILLER                  PIC X(56) VALUE
036100       '01120703900048008130029000350119820420005300832603000036'.
036200         10  FILLER                  PIC X(56) VALUE
036300       '01910206300084010435042000530078130320003901645705500072'.
036400         10  FILLER                  PIC X(56) VALUE
036500       '00934403900048006369028000330115500390005100717302800034'.
036600         10  FILLER                  PIC X(56) VALUE
036700       '01659304900068009939037000470067490250003100000000000000'.
036800         10  FILLER                  PIC X(56) VALUE
036900       '00000000000000000000000000000000000000000000000000000000'.
037000         10  FILLER                  PIC X(56) VALUE
037100       '00000000000000000000000000000000000000000000000000000000'.
037200         10  FILLER                  PIC X(56) VALUE
037300       '05574312000158027791065000840186650420005203936811000135'.
037400         10  FILLER                  PIC X(56) VALUE
037500       '02487507400089016114049000580368180990011802491207000083'.
037600         10  FILLER                  PIC X(56) VALUE
037700       '01718004500054036675093001140208970620007301308003700044'.
037800         10  FILLER                  PIC X(56) VALUE
037900       '02502906200078016996044000540116980240003003644309200130'.
038000         10  FILLER                  PIC X(56) VALUE
038100       '01891005100070012742030000410445771090014402433507100091'.
038200         10  FILLER                  PIC X(56) VALUE
038300       '01627304400057000000000000000000000000000000000000000000'.
038400         10  FILLER                  PIC X(56) VALUE
038500       '00000000000000000000000000000000000000000001700105000065'.
038600         10  FILLER                  PIC X(56) VALUE
038700       '00954803600046006152025000320180180560007401221504200055'.
038800         10  FILLER                  PIC X(56) VALUE
038900       '00900402800037018342054000750100890400005000689002900035'.
039000         10  FILLER                  PIC X(56) VALUE
039100       '01824205100071009857037000480066150270003301558604800062'.
039200         10  FILLER                  PIC X(56) VALUE
039300       '01068803600045007411025000310000000000000000000000000000'.
039400         10  FILLER                  PIC X(56) VALUE
039500       '00000000000000000000000000000000000000000000000000000000'.
039600         10  FILLER                  PIC X(56) VALUE
039700       '10265310700135072559055000670543080310003709288510800134'.
039800         10  FILLER                  PIC X(56) VALUE
039900       '06202405900070049379035000400650650740009103871303300039'.
040000         10  FILLER                  PIC X(56) VALUE
040100       '04938506700082033425037000410499831100015102852806900089'.
040200         10  FILLER                  PIC X(56) VALUE
040300       '01790504100053049144073000900323210430005002572803300036'.
040400         10  FILLER                  PIC X(56) VALUE
040500       '03472406700080021039034000370473010660009302772202600038'.
040600         10  FILLER                  PIC X(56) VALUE
040700       '02076801500018034905091001190195940610007700992003200041'.
040800         10  FILLER                  PIC X(56) VALUE
040900       '03328608900111022546053000680163670240003403093907700090'.
041000         10  FILLER                  PIC X(56) VALUE
041100       '01888605100056015372041000450240190300003701955402000022'.
041200         10  FILLER                  PIC X(56) VALUE
041300       '03213109000110020339061000720147240440005101721703800047'.
041400         10  FILLER                  PIC X(56) VALUE
041500       '01214102500029017916030000430099140170002103067006800086'.
041600         10  FILLER                  PIC X(56) VALUE
041700       '01851904200050013140027000320286830760010201620704100054'.
041800         10  FILLER                  PIC X(56) VALUE
041900       '01077002000026019912054000730099170220003003028807600103'.
042000         10  FILLER                  PIC X(56) VALUE
042100       '01584604600060010305023000280228090650008501568505000062'.
042200         10  FILLER                  PIC X(56) VALUE
042300       '01077002500031011815027000380187110340004501395601700021'.
042400         10  FILLER                  PIC X(56) VALUE
042500       '01314802300035021704050000630146900320003901046101800021'.
042600         10  FILLER                  PIC X(56) VALUE
042700       '01300703500048008209021000270318940770009801924404700059'.
042800         10  FILLER                  PIC X(56) VALUE
042900       '01479702600034000000000000000000000000000000000000000000'.
043000         10  FILLER                  PIC X(56) VALUE
043100       '00000000000000000000000000000000000000000000000000000000'.
043200         10  FILLER                  PIC X(56) VALUE
043300       '00000000000000000000000000000000000000000000000000000000'.
043400         10  FILLER                  PIC X(56) VALUE
043500       '00000000000000000000000000000000000000000000000000000000'.
043600         10  FILLER                  PIC X(56) VALUE
043700       '01565704900065007601031000390135270450005800719103200037'.
043800         10  FILLER                  PIC X(56) VALUE
043900       '00827503500041006108026000310204670710009401312605400068'.
044000         10  FILLER                  PIC X(56) VALUE
044100       '00871303700047019521063000830115970450005600777503400041'.
044200         10  FILLER                  PIC X(56) VALUE
044300       '02546706400090011712042000540073480290003601964806700088'.
044400         10  FILLER                  PIC X(56) VALUE
044500       '01203504800061008276033000400163980520006800820403300040'.
044600         10  FILLER                  PIC X(56) VALUE
044700       '01135504300055006812030000370109540360004900656802600032'.
044800         10  FILLER                  PIC X(56) VALUE
044900       '01602105400068008823036000440177170520007201002203600046'.
045000         10  FILLER                  PIC X(56) VALUE
045100       '00621102100026013944045000580071530300003601470204900065'.
045200         10  FILLER                  PIC X(56) VALUE
045300       '00909503800047006625028000340000000000000000000000000000'.
045400         10  FILLER                  PIC X(56) VALUE
045500       '00000000000000000000000000000000000000000000000000000000'.
045600         10  FILLER                  PIC X(56) VALUE
045700       '03246109100125018675067000850108990420005203924809100130'.
045800         10  FILLER                  PIC X(56) VALUE
045900       '01703504100062010416024000330295760770010401495903800054'.
046000         10  FILLER                  PIC X(56) VALUE
046100       '00922301800024010567020000270084540150001701515303500050'.
046200         10  FILLER                  PIC X(56) VALUE
046300       '01041101700022000000000000000000000000000000000000000000'.
046400         10  FILLER                  PIC X(56) VALUE
046500       '00000000000000000000000000000000000000000001766906200082'.
046600         10  FILLER                  PIC X(56) VALUE
046700       '01070904800058007591036000460186900590007800877903700046'.
046800         10  FILLER                  PIC X(56) VALUE
046900       '01559605500075010611041000540062650250003200960204100049'.
047000         10  FILLER                  PIC X(56) VALUE
047100       '00672803000036014748053000670083770380004501236103900052'.
047200         10  FILLER                  PIC X(56) VALUE
047300       '00718202700033013082043000600068570280003700000000000000'.
047400         10  FILLER                  PIC X(56) VALUE
047500       '00000000000000000000000000000000000000000000000000000000'.
047600         10  FILLER                  PIC X(56) VALUE
047700       '00000000000000024554047000650139700250003004493412400156'.
047800         10  FILLER                  PIC X(56) VALUE
047900       '02000606500079012006041000510352140460007401862702600034'.
048000         10  FILLER                  PIC X(56) VALUE
048100       '01474701600019034166094001250185580610007601012203800047'.
048200         10  FILLER                  PIC X(56) VALUE
048300       '02242304600069011701021000300078210120001403381907200106'.
048400         10  FILLER                  PIC X(56) VALUE
048500       '02265006500080014164034000450000000000000000000000000000'.
048600         10  FILLER                  PIC X(56) VALUE
048700       '00000000000000000000000000000000000000000000000000000000'.
048800         10  FILLER                  PIC X(56) VALUE
048900       '01446204500059008306032000400055440230002801140003600051'.
049000         10  FILLER                  PIC X(56) VALUE
049100       '00691602900036010290034000470181590600007601065504200052'.
049200         10  FILLER                  PIC X(56) VALUE
049300       '00719802900036000000000000000000000000000000000000000000'.
049400         10  FILLER                  PIC X(56) VALUE
049500       '00000000000000000000000000000000000000000003044206300074'.
049600         10  FILLER                  PIC X(56) VALUE
049700       '06092913600166030054082000930195670480005603571307700100'.
049800         10  FILLER                  PIC X(56) VALUE
049900       '02000404900059014224030000340349880790010801903004500060'.
050000         10  FILLER                  PIC X(56) VALUE
050100       '01264102400029030158075001070147180360005201107401500019'.
050200         10  FILLER                  PIC X(56) VALUE
050300       '02865308700113016440045000640079190180002402517506600089'.
050400         10  FILLER                  PIC X(56) VALUE
050500       '01259703200044007770018000230144000410005600788501800022'.
050600         10  FILLER                  PIC X(56) VALUE
050700       '02926005900095020934046000670133790160002100000000000000'.
050800         10  FILLER                  PIC X(56) VALUE
050900       '00000000000000000000000000000000000000000000000000000000'.
051000         10  FILLER                  PIC X(56) VALUE
051100       '00000000000000016407051000680102430400004900658702800034'.
051200         10  FILLER                  PIC X(56) VALUE
051300       '00894402500034018238058000780108380380005000647902200028'.
051400         10  FILLER                  PIC X(56) VALUE
051500       '01218504600058007864034000410161560330004301118601800023'.
051600         10  FILLER                  PIC X(56) VALUE
051700       '01350503900052007096021000260120820430005700659002600032'.
051800         10  FILLER                  PIC X(56) VALUE
051900       '00777102400031016098052000680099990370004700675702600032'.
052000         10  FILLER                  PIC X(56) VALUE
052100       '00000000000000000000000000000000000000000000000000000000'.
052200         10  FILLER                  PIC X(56) VALUE
052300       '00000000000000000000000000000177470320004201258101600019'.
052400         10  FILLER                  PIC X(56) VALUE
052500       '01863003400057012712014000170176390520007300808402100027'.
052600         10  FILLER                  PIC X(56) VALUE
052700       '01180202900041006544016000180174330410006000997401200014'.
052800         10  FILLER                  PIC X(56) VALUE
052900       '01613804600064008044020000260000000000000000000000000000'.
053000         10  FILLER                  PIC X(56) VALUE
053100       '00000000000000016891054000770101900390005100621102100027'.
053200         10  FILLER                  PIC X(56) VALUE
053300       '01274204700061007013028000350136570490006400761203300041'.
053400         10  FILLER                  PIC X(56) VALUE
053500       '00989203600047006414023000290000000000000000000000000000'.
053600         10  FILLER                  PIC X(56) VALUE
053700       '00000000000000024364052000700116840220002704394311500140'.
053800         10  FILLER                  PIC X(56) VALUE
053900       '02037505700066012324032000360343000740009801528003800047'.
054000         10  FILLER                  PIC X(56) VALUE
054100       '01097902200026013883032000410090790180002101515104000055'.
054200         10  FILLER                  PIC X(56) VALUE
054300       '00804502000024013373030000420088520150001800916901400017'.
054400         10  FILLER                  PIC X(56) VALUE
054500       '02527506200085009368022000280000000000000000000000000000'.
054600         10  FILLER                  PIC X(56) VALUE
054700       '00000000000000020295064000880114440400005300636102300031'.
054800         10  FILLER                  PIC X(56) VALUE
054900       '01656506000078010963047000570073680330004000838802900038'.
055000         10  FILLER                  PIC X(56) VALUE
055100       '00521901800022000000000000000000000000000000000000000000'.
055200         10  FILLER                  PIC X(56) VALUE
055300       '01126903900049007995029000310091110240002701811204700058'.
055400         10  FILLER                  PIC X(56) VALUE
055500       '02063103500057007017016000210000000000000000000000000000'.
055600         10  FILLER                  PIC X(56) VALUE
055700       '00000000000000006848026000320052560210002300651302600034'.
055800         10  FILLER                  PIC X(56) VALUE
055900       '00740601700021004942021000320053110160002100228401200016'.
056000         10  FILLER                  PIC X(56) VALUE
056100       '00680902700039004744019000260000000000000000000000000000'.
056200         10  FILLER                  PIC X(56) VALUE
056300       '00000000000000000000000000000000000000000000000000000000'.
056400         10  FILLER                  PIC X(56) VALUE
056500       '01487701800018049058179001790335051330013302021608600086'.
056600         10  FILLER                  PIC X(56) VALUE
056700       '03441704700047012181034000340016490310003100000000000000'.
056800         10  FILLER                  PIC X(56) VALUE
056900       '00000000000000000000000000000494341040013502587405900075'.
057000         10  FILLER                  PIC X(56) VALUE
057100       '01558603100039036171085001210189050480006501044602300030'.
057200         10  FILLER                  PIC X(56) VALUE
057300       '00000000000000000000000000000000000000000002147906300082'.
057400         10  FILLER                  PIC X(56) VALUE
057500       '01195104000051009230030000370125440380005200795702800036'.
057600         10  FILLER                  PIC X(56) VALUE
057700       '01437203600050016431050000690100240360004600681802600032'.
057800         10  FILLER                  PIC X(56) VALUE
057900       '00000000000000000000000000000000000000000005711213100172'.
058000         10  FILLER                  PIC X(56) VALUE
058100       '02399805300074012253023000310456401220015902305506600087'.
058200         10  FILLER                  PIC X(56) VALUE
058300       '01241802800040048666112001470214590530006901386103100038'.
058400         10  FILLER                  PIC X(56) VALUE
058500       '02709306300094010976024000320000000000000000000000000000'.
058600         10  FILLER                  PIC X(56) VALUE
058700       '00000000000000049277101001620242840570009201138603000045'.
058800         10  FILLER                  PIC X(56) VALUE
058900       '06659917800235031428081001220128230460005702931707800106'.
059000         10  FILLER                  PIC X(56) VALUE
059100       '01637605100068010389032000420183630600008001194004300056'.
059200         10  FILLER                  PIC X(56) VALUE
059300       '00802902900037021961054000800098600280003400807802400030'.
059400         10  FILLER                  PIC X(56) VALUE
059500       '01262704400061000000000000000000000000000000000000000000'.
059600         10  FILLER                  PIC X(56) VALUE
059700       '05523712000156027883082001000137970390005305129611200150'.
059800         10  FILLER                  PIC X(56) VALUE
059900       '02097506200079013050041000510000000000000000000000000000'.
060000         10  FILLER                  PIC X(56) VALUE
060100       '00000000000000019511058000770097900400004900827603000038'.
060200         10  FILLER                  PIC X(56) VALUE
060300       '01565104500065007462028000350247080670009201161404300054'.
060400         10  FILLER                  PIC X(56) VALUE
060500       '00720703000036058305128001510190740540007201154504500054'.
060600         10  FILLER                  PIC X(56) VALUE
060700       '00000000000000000000000000000000000000000002814308100127'.
060800         10  FILLER                  PIC X(56) VALUE
060900       '00000000000000000000000000000000000000000000616102300030'.
061000         10  FILLER                  PIC X(56) VALUE
061100       '00617803100042006276031000430106940490007700930804000053'.
061200         10  FILLER                  PIC X(56) VALUE
061300       '00904105400074007903038000590078880290004100000000000000'.
061400         10  FILLER                  PIC X(56) VALUE
061500       '00000000000000000000000000000000000000000000000000000000'.
061600         10  FILLER                  PIC X(56) VALUE
061700       '00000000000000004074021000300102750850010901456504700065'.
061800         10  FILLER                  PIC X(56) VALUE
061900       '00651303200040000000000000000000000000000000000000000000'.
062000         10  FILLER                  PIC X(56) VALUE
062100       '03904209100140017922054000750106240330004402933507200109'.
062200         10  FILLER                  PIC X(56) VALUE
062300       '01171403400045010356021000310382680780011101925104700063'.
062400         10  FILLER                  PIC X(56) VALUE
062500       '01155402600034000000000000000000000000000000000000000000'.
062600         10  FILLER                  PIC X(56) VALUE
062700       '01344404000056006994026000320142520360005100486701700021'.
062800         10  FILLER                  PIC X(56) VALUE
062900       '01486803700051006269021000270159030440006200978503200043'.
063000         10  FILLER                  PIC X(56) VALUE
063100       '00621602200028013478038000540068080230003200000000000000'.
063200         10  FILLER                  PIC X(56) VALUE
063300       '00000000000000000000000000001266512180028504772410800148'.
063400         10  FILLER                  PIC X(56) VALUE
063500       '02055705200077000000000000000000000000000000000000000000'.
063600         10  FILLER                  PIC X(56) VALUE
063700       '02197902300051013556041000580129190350005200000000000000'.
063800         10  FILLER                  PIC X(56) VALUE
063900       '00000000000000000000000000000287020690010001679703600054'.
064000         10  FILLER                  PIC X(56) VALUE
064100       '01145702000026000000000000000000000000000000000000000000'.
064200         10  FILLER                  PIC X(56) VALUE
064300       '01279508200101011273066000750109520370004900686502700034'.
064400         10  FILLER                  PIC X(56) VALUE
064500       '01000602600044005040022000280065930220004000000000000000'.
064600         10  FILLER                  PIC X(56) VALUE
064700       '00000000000000000000000000000553360890012603370407000085'.
064800         10  FILLER                  PIC X(56) VALUE
064900       '06251910100142037692075000960232080470005900000000000000'.
065000         10  FILLER                  PIC X(56) VALUE
065100       '00000000000000000000000000000281230600008701490104500056'.
065200         10  FILLER                  PIC X(56) VALUE
065300       '00938603100038000000000000000000000000000000000000000000'.
065400         10  FILLER                  PIC X(56) VALUE
065500       '05507312000171026755063000860000000000000000000000000000'.
065600         10  FILLER                  PIC X(56) VALUE
065700       '00000000000000025849068000960136400510006600897503500044'.
065800         10  FILLER                  PIC X(56) VALUE
065900       '01048603700049000000000000000000000000000000000000000000'.
066000         10  FILLER                  PIC X(56) VALUE
066100       '05063411000141029402068000870177670310004303324210500133'.
066200         10  FILLER                  PIC X(56) VALUE
066300       '02150806800090011140027000400344950930012101873905600074'.
066400         10  FILLER                  PIC X(56) VALUE
066500       '01058902500035000000000000000000000000000000000000000000'.
066600         10  FILLER                  PIC X(56) VALUE
066700       '00000000000000000000000000000000000000000000000000000000'.
066800         10  FILLER                  PIC X(56) VALUE
066900       '00000000000000000000000000000000000000000000000000000000'.
067000     05  DRGX-TAB REDEFINES D-TAB.                                04619000
067100         10  DRGX-PERIOD               OCCURS 1                   04619100
067200                                        INDEXED BY DX5.           04619200
067300             15  DRGX-EFF-DATE         PIC X(08).                 04619300
067400             15  DRG-DATA              OCCURS 1000                04619400
067500                                        INDEXED BY DX6.           04619500
067600                 20  DRG-WT            PIC 9(02)V9(04).           04619600
067700                 20  DRG-ALOS          PIC 9(02)V9(01).           04619700
067800                 20  DRG-DAYS-TRIM     PIC 9(02).                 04619800
067900                 20  DRG-ARITH-ALOS    PIC 9(02)V9(01).           04619900
068000
068100*****YEARCHANGE 2010.0 ************************************       20110000
068200
068300 01  PPS-SSRFBN-TABLE.
068400     02  WK-SSRFBN-DATA.
068500         05  FILLER   PIC X(58)  VALUE
068600     '01  099835  01 ALABAMA                                   '.
068700         05  FILLER   PIC X(58)  VALUE
068800     '02  099835  02 ALASKA                                    '.
068900         05  FILLER   PIC X(58)  VALUE
069000     '03  099835  03 ARIZONA                                   '.
069100         05  FILLER   PIC X(58)  VALUE
069200     '04  099835  04 ARKANSAS                                  '.
069300         05  FILLER   PIC X(58)  VALUE
069400     '05  099317  05 CALIFORNIA                                '.
069500          05  FILLER   PIC X(58)  VALUE
069600     '06  099413  06 COLORADO                                  '.
069700         05  FILLER   PIC X(58)  VALUE
069800     '07  098016  07 CONNECTICUT                               '.
069900         05  FILLER   PIC X(58)  VALUE
070000     '08  099835  08 DELAWARE                                  '.
070100         05  FILLER   PIC X(58)  VALUE
070200     '09  099835  09 DISTRICT OF CO                            '.
070300         05  FILLER   PIC X(58)  VALUE
070400     '10  099756  10 FLORIDA                                   '.
070500         05  FILLER   PIC X(58)  VALUE
070600     '11  099835  11 GEORGIA                                   '.
070700         05  FILLER   PIC X(58)  VALUE
070800     '12  099835  12 HAWAII                                    '.
070900         05  FILLER   PIC X(58)  VALUE
071000     '13  099835  13 IDAHO                                     '.
071100         05  FILLER   PIC X(58)  VALUE
071200     '14  099835  14 ILLINOIS                                  '.
071300         05  FILLER   PIC X(58)  VALUE
071400     '15  099813  15 INDIANA                                   '.
071500         05  FILLER   PIC X(58)  VALUE
071600     '16  099783  16 IOWA                                      '.
071700         05  FILLER   PIC X(58)  VALUE
071800     '17  099827  17 KANSAS                                    '.
071900         05  FILLER   PIC X(58)  VALUE
072000     '18  099835  18 KENTUCKY                                  '.
072100         05  FILLER   PIC X(58)  VALUE
072200     '19  099834  19 LOUISIANA                                 '.
072300         05  FILLER   PIC X(58)  VALUE
072400     '20  099835  20 MAINE                                     '.
072500         05  FILLER   PIC X(58)  VALUE
072600     '21  100000  21 MARYLAND                                  '.
072700         05  FILLER   PIC X(58)  VALUE
072800     '22  099834  22 MASSACHUSETTS                             '.
072900         05  FILLER   PIC X(58)  VALUE
073000     '23  099833  23 MICHIGAN                                  '.
073100         05  FILLER   PIC X(58)  VALUE
073200     '24  099835  24 MINNESOTA                                 '.
073300         05  FILLER   PIC X(58)  VALUE
073400     '25  099834  25 MISSISSIPPI                               '.
073500         05  FILLER   PIC X(58)  VALUE
073600     '26  099835  26 MISSOURI                                  '.
073700         05  FILLER   PIC X(58)  VALUE
073800     '27  099835  27 MONTANA                                   '.
073900         05  FILLER   PIC X(58)  VALUE
074000     '28  099835  28 NEBRASKA                                  '.
074100         05  FILLER   PIC X(58)  VALUE
074200     '29  099835  29 NEVADA                                    '.
074300         05  FILLER   PIC X(58)  VALUE
074400     '30  099699  30 NEW HAMPSHIRE                             '.
074500         05  FILLER   PIC X(58)  VALUE
074600     '31  098587  31 NEW JERSEY                                '.
074700         05  FILLER   PIC X(58)  VALUE
074800     '32  099577  32 NEW MEXICO                                '.
074900         05  FILLER   PIC X(58)  VALUE
075000     '33  099835  33 NEW YORK                                  '.
075100         05  FILLER   PIC X(58)  VALUE
075200     '34  099834  34 NORTH CAROLINA                            '.
075300         05  FILLER   PIC X(58)  VALUE
075400     '35  099833  35 NORTH DAKOTA                              '.
075500         05  FILLER   PIC X(58)  VALUE
075600     '36  099784  36 OHIO                                      '.
075700         05  FILLER   PIC X(58)  VALUE
075800     '37  099835  37 OKLAHOMA                                  '.
075900         05  FILLER   PIC X(58)  VALUE
076000     '38  099708  38 OREGON                                    '.
076100         05  FILLER   PIC X(58)  VALUE
076200     '39  099834  39 PENNSYLVANIA                              '.
076300         05  FILLER   PIC X(58)  VALUE
076400     '40  099835  40 PUERTO RICO                               '.
076500         05  FILLER   PIC X(58)  VALUE
076600     '41  099835  41 RHODE ISLAND                              '.
076700         05  FILLER   PIC X(58)  VALUE
076800     '42  099779  42 SOUTH CAROLINA                            '.
076900         05  FILLER   PIC X(58)  VALUE
077000     '43  099834  43 SOUTH DAKOTA                              '.
077100         05  FILLER   PIC X(58)  VALUE
077200     '44  099690  44 TENNESSEE                                 '.
077300         05  FILLER   PIC X(58)  VALUE
077400     '45  099832  45 TEXAS                                     '.
077500         05  FILLER   PIC X(58)  VALUE
077600     '46  099835  46 UTAH                                      '.
077700         05  FILLER   PIC X(58)  VALUE
077800     '47  099835  47 VERMONT                                   '.
077900         05  FILLER   PIC X(58)  VALUE
078000     '48  100000  48 VIRGIN ISLANDS                            '.
078100         05  FILLER   PIC X(58)  VALUE
078200     '49  099835  49 VIRGINIA                                  '.
078300         05  FILLER   PIC X(58)  VALUE
078400     '50  099792  50 WASHINGTON                                '.
078500         05  FILLER   PIC X(58)  VALUE
078600     '51  099712  51 WEST VIRGINIA                             '.
078700         05  FILLER   PIC X(58)  VALUE
078800     '52  099816  52 WISCONSIN                                 '.
078900         05  FILLER   PIC X(58)  VALUE
079000     '53  099835  53 WYOMING                                   '.
079100         05  FILLER   PIC X(58)  VALUE
079200     '55  099317  55 CALIFORNIA                                '.
079300         05  FILLER   PIC X(58)  VALUE
079400     '56  100000  56 CANADA                                    '.
079500         05  FILLER   PIC X(58)  VALUE
079600     '59  100000  59 MEXICO                                    '.
079700         05  FILLER   PIC X(58)  VALUE
079800     '64  100000  64 AMERICAN SAMOA                            '.
079900         05  FILLER   PIC X(58)  VALUE
080000     '65  100000  65 GUAM                                      '.
080100         05  FILLER   PIC X(58)  VALUE
080200     '66  100000  66 MARIANAS ISLANDS                          '.
080300         05  FILLER   PIC X(58)  VALUE
080400     '67  099832  67 TEXAS                                     '.
080500         05  FILLER   PIC X(58)  VALUE
080600     '68  099756  68 FLORIDA                                   '.
080700         05  FILLER   PIC X(58)  VALUE
080800     '69  099756  69 FLORIDA                                   '.
080900         05  FILLER   PIC X(58)  VALUE
081000     '70  099827  70 KANSAS                                    '.
081100         05  FILLER   PIC X(58)  VALUE
081200     '71  099834  71 LOUISIANA                                 '.
081300         05  FILLER   PIC X(58)  VALUE
081400     '72  099784  72 OHIO                                      '.
081500         05  FILLER   PIC X(58)  VALUE
081600     '73  099834  73 PENNSYLVANIA                              '.
081700         05  FILLER   PIC X(58)  VALUE
081800     '74  099832  74 TEXAS                                     '.
081900         05  FILLER   PIC X(58)  VALUE
082000     '75  099317  75 CALIFORNIA                                '.
082100         05  FILLER   PIC X(58)  VALUE
082200     '76  099783  76 IOWA                                      '.
082300         05  FILLER   PIC X(58)  VALUE
082400     '77  099835  77 MINNESOTA                                 '.
082500         05  FILLER   PIC X(58)  VALUE
082600     '78  099835  78 ILLINOIS                                  '.
082700         05  FILLER   PIC X(58)  VALUE
082800     '80  100000  80 MARYLAND                                  '.
082900      02  WK-SSRFBN-DATA2 REDEFINES WK-SSRFBN-DATA.
083000         05  SSRFBN-TAB OCCURS 72 ASCENDING KEY IS WK-SSRFBN-STATE
083100                               INDEXED BY SSRFBN-IDX.
083200           10  WK-SSRFBN-REASON-ALL.
083300              15 WK-SSRFBN-STATE  PIC 99.
083400              15 FILLER           PIC XX.
083500              15 WK-SSRFBN-RATE   PIC 9(1)V9(5).
083600              15 FILLER           PIC XX.
083700              15 WK-SSRFBN-CODE2  PIC 99.
083800              15 FILLER           PIC XX.
083900              15 WK-SSRFBN-STNAM  PIC X(20).
084000              15 WK-SSRFBN-REST   PIC X(22).
084100
084200*****YEARCHANGE 2010.0 ************************************       20110000
084300                                                                  20110000
084400 01  LOWVOL-PROV-TABLE.
084500     05 LOWVOL-PROV-DISCHG-DATA.
084600         10  FILLER      PIC X(13) VALUE '010007   1325'.
084700         10  FILLER      PIC X(13) VALUE '010008   0389'.
084800         10  FILLER      PIC X(13) VALUE '010009   0884'.
084900         10  FILLER      PIC X(13) VALUE '010015   0560'.
085000         10  FILLER      PIC X(13) VALUE '010018   0067'.
085100         10  FILLER      PIC X(13) VALUE '010021   0897'.
085200         10  FILLER      PIC X(13) VALUE '010022   0618'.
085300         10  FILLER      PIC X(13) VALUE '010025   1511'.
085400         10  FILLER      PIC X(13) VALUE '010027   0462'.
085500         10  FILLER      PIC X(13) VALUE '010032   0413'.
085600         10  FILLER      PIC X(13) VALUE '010034   1047'.
085700         10  FILLER      PIC X(13) VALUE '010043   0295'.
085800         10  FILLER      PIC X(13) VALUE '010044   0636'.
085900         10  FILLER      PIC X(13) VALUE '010045   0877'.
086000         10  FILLER      PIC X(13) VALUE '010047   1049'.
086100         10  FILLER      PIC X(13) VALUE '010050   0727'.
086200         10  FILLER      PIC X(13) VALUE '010051   0324'.
086300         10  FILLER      PIC X(13) VALUE '010052   0618'.
086400         10  FILLER      PIC X(13) VALUE '010058   0147'.
086500         10  FILLER      PIC X(13) VALUE '010059   1075'.
086600         10  FILLER      PIC X(13) VALUE '010062   0978'.
086700         10  FILLER      PIC X(13) VALUE '010064   0132'.
086800         10  FILLER      PIC X(13) VALUE '010066   0323'.
086900         10  FILLER      PIC X(13) VALUE '010069   0754'.
087000         10  FILLER      PIC X(13) VALUE '010073   0925'.
087100         10  FILLER      PIC X(13) VALUE '010086   1238'.
087200         10  FILLER      PIC X(13) VALUE '010087   1379'.
087300         10  FILLER      PIC X(13) VALUE '010091   0328'.
087400         10  FILLER      PIC X(13) VALUE '010095   0374'.
087500         10  FILLER      PIC X(13) VALUE '010097   0761'.
087600         10  FILLER      PIC X(13) VALUE '010099   1278'.
087700         10  FILLER      PIC X(13) VALUE '010101   1392'.
087800         10  FILLER      PIC X(13) VALUE '010102   0129'.
087900         10  FILLER      PIC X(13) VALUE '010108   1217'.
088000         10  FILLER      PIC X(13) VALUE '010109   0781'.
088100         10  FILLER      PIC X(13) VALUE '010110   0526'.
088200         10  FILLER      PIC X(13) VALUE '010112   1487'.
088300         10  FILLER      PIC X(13) VALUE '010120   1115'.
088400         10  FILLER      PIC X(13) VALUE '010125   1380'.
088500         10  FILLER      PIC X(13) VALUE '010126   1042'.
088600         10  FILLER      PIC X(13) VALUE '010128   0528'.
088700         10  FILLER      PIC X(13) VALUE '010129   0511'.
088800         10  FILLER      PIC X(13) VALUE '010130   0527'.
088900         10  FILLER      PIC X(13) VALUE '010137   0495'.
089000         10  FILLER      PIC X(13) VALUE '010138   0319'.
089100         10  FILLER      PIC X(13) VALUE '010143   0724'.
089200         10  FILLER      PIC X(13) VALUE '010145   1556'.
089300         10  FILLER      PIC X(13) VALUE '010146   0762'.
089400         10  FILLER      PIC X(13) VALUE '010148   1286'.
089500         10  FILLER      PIC X(13) VALUE '010150   1043'.
089600         10  FILLER      PIC X(13) VALUE '010152   1259'.
089700         10  FILLER      PIC X(13) VALUE '010157   0677'.
089800         10  FILLER      PIC X(13) VALUE '010158   1473'.
089900         10  FILLER      PIC X(13) VALUE '010167   1105'.
090000         10  FILLER      PIC X(13) VALUE '010169   0797'.
090100         10  FILLER      PIC X(13) VALUE '020006   1469'.
090200         10  FILLER      PIC X(13) VALUE '020008   0488'.
090300         10  FILLER      PIC X(13) VALUE '020012   1134'.
090400         10  FILLER      PIC X(13) VALUE '020017   1563'.
090500         10  FILLER      PIC X(13) VALUE '020018   0262'.
090600         10  FILLER      PIC X(13) VALUE '020024   0849'.
090700         10  FILLER      PIC X(13) VALUE '020026   1357'.
090800         10  FILLER      PIC X(13) VALUE '020027   0304'.
090900         10  FILLER      PIC X(13) VALUE '030001   1493'.
091000         10  FILLER      PIC X(13) VALUE '030022   1444'.
091100         10  FILLER      PIC X(13) VALUE '030033   1520'.
091200         10  FILLER      PIC X(13) VALUE '030062   1244'.
091300         10  FILLER      PIC X(13) VALUE '030067   0524'.
091400         10  FILLER      PIC X(13) VALUE '030068   0662'.
091500         10  FILLER      PIC X(13) VALUE '030071   0456'.
091600         10  FILLER      PIC X(13) VALUE '030073   0771'.
091700         10  FILLER      PIC X(13) VALUE '030074   0070'.
091800         10  FILLER      PIC X(13) VALUE '030077   0022'.
091900         10  FILLER      PIC X(13) VALUE '030078   0230'.
092000         10  FILLER      PIC X(13) VALUE '030084   0476'.
092100         10  FILLER      PIC X(13) VALUE '030099   0001'.
092200         10  FILLER      PIC X(13) VALUE '030100   1547'.
092300         10  FILLER      PIC X(13) VALUE '030107   0428'.
092400         10  FILLER      PIC X(13) VALUE '030108   0268'.
092500         10  FILLER      PIC X(13) VALUE '030112   0283'.
092600         10  FILLER      PIC X(13) VALUE '030113   0238'.
092700         10  FILLER      PIC X(13) VALUE '030118   1431'.
092800         10  FILLER      PIC X(13) VALUE '030120   0548'.
092900         10  FILLER      PIC X(13) VALUE '030123   1544'.
093000         10  FILLER      PIC X(13) VALUE '030124   0012'.
093100         10  FILLER      PIC X(13) VALUE '030125   0006'.
093200         10  FILLER      PIC X(13) VALUE '030126   0740'.
093300         10  FILLER      PIC X(13) VALUE '040001   1141'.
093400         10  FILLER      PIC X(13) VALUE '040002   1026'.
093500         10  FILLER      PIC X(13) VALUE '040011   1283'.
093600         10  FILLER      PIC X(13) VALUE '040015   0507'.
093700         10  FILLER      PIC X(13) VALUE '040018   0938'.
093800         10  FILLER      PIC X(13) VALUE '040019   0759'.
093900         10  FILLER      PIC X(13) VALUE '040047   0611'.
094000         10  FILLER      PIC X(13) VALUE '040050   1028'.
094100         10  FILLER      PIC X(13) VALUE '040051   1179'.
094200         10  FILLER      PIC X(13) VALUE '040067   0819'.
094300         10  FILLER      PIC X(13) VALUE '040069   0587'.
094400         10  FILLER      PIC X(13) VALUE '040072   0955'.
094500         10  FILLER      PIC X(13) VALUE '040074   1028'.
094600         10  FILLER      PIC X(13) VALUE '040076   1212'.
094700         10  FILLER      PIC X(13) VALUE '040080   1233'.
094800         10  FILLER      PIC X(13) VALUE '040081   0326'.
094900         10  FILLER      PIC X(13) VALUE '040085   1066'.
095000         10  FILLER      PIC X(13) VALUE '040091   0868'.
095100         10  FILLER      PIC X(13) VALUE '040132   0004'.
095200         10  FILLER      PIC X(13) VALUE '040137   1314'.
095300         10  FILLER      PIC X(13) VALUE '040142   0883'.
095400         10  FILLER      PIC X(13) VALUE '040145   0048'.
095500         10  FILLER      PIC X(13) VALUE '040147   1306'.
095600         10  FILLER      PIC X(13) VALUE '040152   0023'.
095700         10  FILLER      PIC X(13) VALUE '050008   1319'.
095800         10  FILLER      PIC X(13) VALUE '050014   1166'.
095900         10  FILLER      PIC X(13) VALUE '050016   1341'.
096000         10  FILLER      PIC X(13) VALUE '050028   0786'.
096100         10  FILLER      PIC X(13) VALUE '050040   0756'.
096200         10  FILLER      PIC X(13) VALUE '050046   0368'.
096300         10  FILLER      PIC X(13) VALUE '050054   0960'.
096400         10  FILLER      PIC X(13) VALUE '050055   1158'.
096500         10  FILLER      PIC X(13) VALUE '050067   0640'.
096600         10  FILLER      PIC X(13) VALUE '050070   0236'.
096700         10  FILLER      PIC X(13) VALUE '050090   0778'.
096800         10  FILLER      PIC X(13) VALUE '050091   0715'.
096900         10  FILLER      PIC X(13) VALUE '050096   0111'.
097000         10  FILLER      PIC X(13) VALUE '050110   0979'.
097100         10  FILLER      PIC X(13) VALUE '050113   0531'.
097200         10  FILLER      PIC X(13) VALUE '050127   1363'.
097300         10  FILLER      PIC X(13) VALUE '050131   1027'.
097400         10  FILLER      PIC X(13) VALUE '050136   1267'.
097500         10  FILLER      PIC X(13) VALUE '050158   1490'.
097600         10  FILLER      PIC X(13) VALUE '050159   1427'.
097700         10  FILLER      PIC X(13) VALUE '050167   1003'.
097800         10  FILLER      PIC X(13) VALUE '050173   0405'.
097900         10  FILLER      PIC X(13) VALUE '050188   0620'.
098000         10  FILLER      PIC X(13) VALUE '050189   0353'.
098100         10  FILLER      PIC X(13) VALUE '050192   0397'.
098200         10  FILLER      PIC X(13) VALUE '050193   0812'.
098300         10  FILLER      PIC X(13) VALUE '050196   0727'.
098400         10  FILLER      PIC X(13) VALUE '050205   0546'.
098500         10  FILLER      PIC X(13) VALUE '050211   1330'.
098600         10  FILLER      PIC X(13) VALUE '050219   1200'.
098700         10  FILLER      PIC X(13) VALUE '050234   1357'.
098800         10  FILLER      PIC X(13) VALUE '050248   0802'.
098900         10  FILLER      PIC X(13) VALUE '050257   1290'.
099000         10  FILLER      PIC X(13) VALUE '050276   1239'.
099100         10  FILLER      PIC X(13) VALUE '050279   0994'.
099200         10  FILLER      PIC X(13) VALUE '050296   0861'.
099300         10  FILLER      PIC X(13) VALUE '050298   1111'.
099400         10  FILLER      PIC X(13) VALUE '050301   1583'.
099500         10  FILLER      PIC X(13) VALUE '050315   0798'.
099600         10  FILLER      PIC X(13) VALUE '050320   1259'.
099700         10  FILLER      PIC X(13) VALUE '050325   0032'.
099800         10  FILLER      PIC X(13) VALUE '050342   1526'.
099900         10  FILLER      PIC X(13) VALUE '050349   0085'.
100000         10  FILLER      PIC X(13) VALUE '050352   0781'.
100100         10  FILLER      PIC X(13) VALUE '050357   0669'.
100200         10  FILLER      PIC X(13) VALUE '050366   0827'.
100300         10  FILLER      PIC X(13) VALUE '050376   1468'.
100400         10  FILLER      PIC X(13) VALUE '050378   1212'.
100500         10  FILLER      PIC X(13) VALUE '050385   0705'.
100600         10  FILLER      PIC X(13) VALUE '050397   0200'.
100700         10  FILLER      PIC X(13) VALUE '050407   0944'.
100800         10  FILLER      PIC X(13) VALUE '050417   1135'.
100900         10  FILLER      PIC X(13) VALUE '050423   0443'.
101000         10  FILLER      PIC X(13) VALUE '050430   0004'.
101100         10  FILLER      PIC X(13) VALUE '050434   0472'.
101200         10  FILLER      PIC X(13) VALUE '050435   1146'.
101300         10  FILLER      PIC X(13) VALUE '050448   1030'.
101400         10  FILLER      PIC X(13) VALUE '050478   0183'.
101500         10  FILLER      PIC X(13) VALUE '050517   1270'.
101600         10  FILLER      PIC X(13) VALUE '050526   1572'.
101700         10  FILLER      PIC X(13) VALUE '050528   0508'.
101800         10  FILLER      PIC X(13) VALUE '050531   1089'.
101900         10  FILLER      PIC X(13) VALUE '050537   0957'.
102000         10  FILLER      PIC X(13) VALUE '050543   0473'.
102100         10  FILLER      PIC X(13) VALUE '050545   0047'.
102200         10  FILLER      PIC X(13) VALUE '050547   0084'.
102300         10  FILLER      PIC X(13) VALUE '050548   0029'.
102400         10  FILLER      PIC X(13) VALUE '050552   0253'.
102500         10  FILLER      PIC X(13) VALUE '050568   1184'.
102600         10  FILLER      PIC X(13) VALUE '050588   1577'.
102700         10  FILLER      PIC X(13) VALUE '050608   1032'.
102800         10  FILLER      PIC X(13) VALUE '050618   0165'.
102900         10  FILLER      PIC X(13) VALUE '050641   0781'.
103000         10  FILLER      PIC X(13) VALUE '050660   0708'.
103100         10  FILLER      PIC X(13) VALUE '050662   0003'.
103200         10  FILLER      PIC X(13) VALUE '050667   0048'.
103300         10  FILLER      PIC X(13) VALUE '050668   0058'.
103400         10  FILLER      PIC X(13) VALUE '050680   1453'.
103500         10  FILLER      PIC X(13) VALUE '050682   0001'.
103600         10  FILLER      PIC X(13) VALUE '050684   1465'.
103700         10  FILLER      PIC X(13) VALUE '050688   1251'.
103800         10  FILLER      PIC X(13) VALUE '050693   0412'.
103900         10  FILLER      PIC X(13) VALUE '050694   0186'.
104000         10  FILLER      PIC X(13) VALUE '050697   0089'.
104100         10  FILLER      PIC X(13) VALUE '050708   0888'.
104200         10  FILLER      PIC X(13) VALUE '050714   0196'.
104300         10  FILLER      PIC X(13) VALUE '050717   0238'.
104400         10  FILLER      PIC X(13) VALUE '050722   0079'.
104500         10  FILLER      PIC X(13) VALUE '050723   0391'.
104600         10  FILLER      PIC X(13) VALUE '050725   0166'.
104700         10  FILLER      PIC X(13) VALUE '050726   0390'.
104800         10  FILLER      PIC X(13) VALUE '050727   1236'.
104900         10  FILLER      PIC X(13) VALUE '050732   1256'.
105000         10  FILLER      PIC X(13) VALUE '050733   0347'.
105100         10  FILLER      PIC X(13) VALUE '050736   1334'.
105200         10  FILLER      PIC X(13) VALUE '050738   0875'.
105300         10  FILLER      PIC X(13) VALUE '050744   0675'.
105400         10  FILLER      PIC X(13) VALUE '050745   0638'.
105500         10  FILLER      PIC X(13) VALUE '050747   0706'.
105600         10  FILLER      PIC X(13) VALUE '050748   0243'.
105700         10  FILLER      PIC X(13) VALUE '050749   0215'.
105800         10  FILLER      PIC X(13) VALUE '050751   0097'.
105900         10  FILLER      PIC X(13) VALUE '050754   0064'.
106000         10  FILLER      PIC X(13) VALUE '050758   1178'.
106100         10  FILLER      PIC X(13) VALUE '050760   0241'.
106200         10  FILLER      PIC X(13) VALUE '050762   0021'.
106300         10  FILLER      PIC X(13) VALUE '050763   1172'.
106400         10  FILLER      PIC X(13) VALUE '050765   0591'.
106500         10  FILLER      PIC X(13) VALUE '050766   0052'.
106600         10  FILLER      PIC X(13) VALUE '060004   1196'.
106700         10  FILLER      PIC X(13) VALUE '060006   1291'.
106800         10  FILLER      PIC X(13) VALUE '060008   0908'.
106900         10  FILLER      PIC X(13) VALUE '060016   1059'.
107000         10  FILLER      PIC X(13) VALUE '060018   0001'.
107100         10  FILLER      PIC X(13) VALUE '060036   0931'.
107200         10  FILLER      PIC X(13) VALUE '060043   0159'.
107300         10  FILLER      PIC X(13) VALUE '060044   0524'.
107400         10  FILLER      PIC X(13) VALUE '060049   0435'.
107500         10  FILLER      PIC X(13) VALUE '060054   1024'.
107600         10  FILLER      PIC X(13) VALUE '060071   1492'.
107700         10  FILLER      PIC X(13) VALUE '060075   0741'.
107800         10  FILLER      PIC X(13) VALUE '060076   0790'.
107900         10  FILLER      PIC X(13) VALUE '060096   0353'.
108000         10  FILLER      PIC X(13) VALUE '060103   0705'.
108100         10  FILLER      PIC X(13) VALUE '060107   0004'.
108200         10  FILLER      PIC X(13) VALUE '060115   0013'.
108300         10  FILLER      PIC X(13) VALUE '060116   0701'.
108400         10  FILLER      PIC X(13) VALUE '060117   0153'.
108500         10  FILLER      PIC X(13) VALUE '060118   0186'.
108600         10  FILLER      PIC X(13) VALUE '060121   0060'.
108700         10  FILLER      PIC X(13) VALUE '060123   0159'.
108800         10  FILLER      PIC X(13) VALUE '070004   1197'.
108900         10  FILLER      PIC X(13) VALUE '070008   1441'.
109000         10  FILLER      PIC X(13) VALUE '070012   1563'.
109100         10  FILLER      PIC X(13) VALUE '070015   1223'.
109200         10  FILLER      PIC X(13) VALUE '070038   0005'.
109300         10  FILLER      PIC X(13) VALUE '070039   0622'.
109400         10  FILLER      PIC X(13) VALUE '070040   0238'.
109500         10  FILLER      PIC X(13) VALUE '090008   1502'.
109600         10  FILLER      PIC X(13) VALUE '100024   0279'.
109700         10  FILLER      PIC X(13) VALUE '100048   0688'.
109800         10  FILLER      PIC X(13) VALUE '100054   1257'.
109900         10  FILLER      PIC X(13) VALUE '100069   1432'.
110000         10  FILLER      PIC X(13) VALUE '100079   0452'.
110100         10  FILLER      PIC X(13) VALUE '100081   0601'.
110200         10  FILLER      PIC X(13) VALUE '100106   0570'.
110300         10  FILLER      PIC X(13) VALUE '100130   0473'.
110400         10  FILLER      PIC X(13) VALUE '100134   0008'.
110500         10  FILLER      PIC X(13) VALUE '100139   0209'.
110600         10  FILLER      PIC X(13) VALUE '100140   1142'.
110700         10  FILLER      PIC X(13) VALUE '100142   1517'.
110800         10  FILLER      PIC X(13) VALUE '100150   1226'.
110900         10  FILLER      PIC X(13) VALUE '100160   0444'.
111000         10  FILLER      PIC X(13) VALUE '100175   0984'.
111100         10  FILLER      PIC X(13) VALUE '100211   1584'.
111200         10  FILLER      PIC X(13) VALUE '100240   0068'.
111300         10  FILLER      PIC X(13) VALUE '100277   0216'.
111400         10  FILLER      PIC X(13) VALUE '100298   0033'.
111500         10  FILLER      PIC X(13) VALUE '100308   0001'.
111600         10  FILLER      PIC X(13) VALUE '100309   0007'.
111700         10  FILLER      PIC X(13) VALUE '100310   0029'.
111800         10  FILLER      PIC X(13) VALUE '100311   0022'.
111900         10  FILLER      PIC X(13) VALUE '110015   0976'.
112000         10  FILLER      PIC X(13) VALUE '110023   1579'.
112100         10  FILLER      PIC X(13) VALUE '110026   0600'.
112200         10  FILLER      PIC X(13) VALUE '110027   0739'.
112300         10  FILLER      PIC X(13) VALUE '110032   1559'.
112400         10  FILLER      PIC X(13) VALUE '110040   0648'.
112500         10  FILLER      PIC X(13) VALUE '110041   1179'.
112600         10  FILLER      PIC X(13) VALUE '110042   0984'.
112700         10  FILLER      PIC X(13) VALUE '110044   0857'.
112800         10  FILLER      PIC X(13) VALUE '110045   0812'.
112900         10  FILLER      PIC X(13) VALUE '110046   1428'.
113000         10  FILLER      PIC X(13) VALUE '110050   0614'.
113100         10  FILLER      PIC X(13) VALUE '110051   0961'.
113200         10  FILLER      PIC X(13) VALUE '110059   0626'.
113300         10  FILLER      PIC X(13) VALUE '110071   0673'.
113400         10  FILLER      PIC X(13) VALUE '110073   0929'.
113500         10  FILLER      PIC X(13) VALUE '110086   0729'.
113600         10  FILLER      PIC X(13) VALUE '110092   1197'.
113700         10  FILLER      PIC X(13) VALUE '110100   0664'.
113800         10  FILLER      PIC X(13) VALUE '110101   0616'.
113900         10  FILLER      PIC X(13) VALUE '110104   1431'.
114000         10  FILLER      PIC X(13) VALUE '110109   0903'.
114100         10  FILLER      PIC X(13) VALUE '110111   0538'.
114200         10  FILLER      PIC X(13) VALUE '110112   0275'.
114300         10  FILLER      PIC X(13) VALUE '110113   0747'.
114400         10  FILLER      PIC X(13) VALUE '110121   0496'.
114500         10  FILLER      PIC X(13) VALUE '110130   0254'.
114600         10  FILLER      PIC X(13) VALUE '110132   1068'.
114700         10  FILLER      PIC X(13) VALUE '110135   0829'.
114800         10  FILLER      PIC X(13) VALUE '110142   0734'.
114900         10  FILLER      PIC X(13) VALUE '110146   0492'.
115000         10  FILLER      PIC X(13) VALUE '110153   1123'.
115100         10  FILLER      PIC X(13) VALUE '110183   0828'.
115200         10  FILLER      PIC X(13) VALUE '110187   0749'.
115300         10  FILLER      PIC X(13) VALUE '110189   1218'.
115400         10  FILLER      PIC X(13) VALUE '110190   0406'.
115500         10  FILLER      PIC X(13) VALUE '110194   0759'.
115600         10  FILLER      PIC X(13) VALUE '110200   0695'.
115700         10  FILLER      PIC X(13) VALUE '110203   0630'.
115800         10  FILLER      PIC X(13) VALUE '110205   0542'.
115900         10  FILLER      PIC X(13) VALUE '110209   1174'.
116000         10  FILLER      PIC X(13) VALUE '110212   1042'.
116100         10  FILLER      PIC X(13) VALUE '110225   1340'.
116200         10  FILLER      PIC X(13) VALUE '110226   1137'.
116300         10  FILLER      PIC X(13) VALUE '110230   1365'.
116400         10  FILLER      PIC X(13) VALUE '110231   0019'.
116500         10  FILLER      PIC X(13) VALUE '120004   0840'.
116600         10  FILLER      PIC X(13) VALUE '120010   1283'.
116700         10  FILLER      PIC X(13) VALUE '120014   0891'.
116800         10  FILLER      PIC X(13) VALUE '120019   0599'.
116900         10  FILLER      PIC X(13) VALUE '120028   0353'.
117000         10  FILLER      PIC X(13) VALUE '130024   0810'.
117100         10  FILLER      PIC X(13) VALUE '130025   0782'.
117200         10  FILLER      PIC X(13) VALUE '130063   0093'.
117300         10  FILLER      PIC X(13) VALUE '130065   0261'.
117400         10  FILLER      PIC X(13) VALUE '130066   0156'.
117500         10  FILLER      PIC X(13) VALUE '130067   0007'.
117600         10  FILLER      PIC X(13) VALUE '130069   0011'.
117700         10  FILLER      PIC X(13) VALUE '130070   0011'.
117800         10  FILLER      PIC X(13) VALUE '140001   0915'.
117900         10  FILLER      PIC X(13) VALUE '140019   0758'.
118000         10  FILLER      PIC X(13) VALUE '140033   0010'.
118100         10  FILLER      PIC X(13) VALUE '140059   0883'.
118200         10  FILLER      PIC X(13) VALUE '140066   0193'.
118300         10  FILLER      PIC X(13) VALUE '140068   1294'.
118400         10  FILLER      PIC X(13) VALUE '140075   0001'.
118500         10  FILLER      PIC X(13) VALUE '140077   0638'.
118600         10  FILLER      PIC X(13) VALUE '140089   1270'.
118700         10  FILLER      PIC X(13) VALUE '140094   1444'.
118800         10  FILLER      PIC X(13) VALUE '140095   1364'.
118900         10  FILLER      PIC X(13) VALUE '140100   0289'.
119000         10  FILLER      PIC X(13) VALUE '140110   1432'.
119100         10  FILLER      PIC X(13) VALUE '140137   0512'.
119200         10  FILLER      PIC X(13) VALUE '140143   1547'.
119300         10  FILLER      PIC X(13) VALUE '140145   0958'.
119400         10  FILLER      PIC X(13) VALUE '140147   1116'.
119500         10  FILLER      PIC X(13) VALUE '140151   1504'.
119600         10  FILLER      PIC X(13) VALUE '140161   0903'.
119700         10  FILLER      PIC X(13) VALUE '140167   1372'.
119800         10  FILLER      PIC X(13) VALUE '140207   0071'.
119900         10  FILLER      PIC X(13) VALUE '140210   1261'.
120000         10  FILLER      PIC X(13) VALUE '140294   1057'.
120100         10  FILLER      PIC X(13) VALUE '140300   0940'.
120200         10  FILLER      PIC X(13) VALUE '140301   0269'.
120300         10  FILLER      PIC X(13) VALUE '140303   0379'.
120400         10  FILLER      PIC X(13) VALUE '150022   1123'.
120500         10  FILLER      PIC X(13) VALUE '150038   0803'.
120600         10  FILLER      PIC X(13) VALUE '150045   0645'.
120700         10  FILLER      PIC X(13) VALUE '150057   1367'.
120800         10  FILLER      PIC X(13) VALUE '150061   1024'.
120900         10  FILLER      PIC X(13) VALUE '150064   1243'.
121000         10  FILLER      PIC X(13) VALUE '150065   1356'.
121100         10  FILLER      PIC X(13) VALUE '150072   0820'.
121200         10  FILLER      PIC X(13) VALUE '150076   1197'.
121300         10  FILLER      PIC X(13) VALUE '150091   0575'.
121400         10  FILLER      PIC X(13) VALUE '150097   1334'.
121500         10  FILLER      PIC X(13) VALUE '150101   0559'.
121600         10  FILLER      PIC X(13) VALUE '150102   0519'.
121700         10  FILLER      PIC X(13) VALUE '150104   0913'.
121800         10  FILLER      PIC X(13) VALUE '150129   0818'.
121900         10  FILLER      PIC X(13) VALUE '150133   1570'.
122000         10  FILLER      PIC X(13) VALUE '150146   0749'.
122100         10  FILLER      PIC X(13) VALUE '150149   0083'.
122200         10  FILLER      PIC X(13) VALUE '150150   1080'.
122300         10  FILLER      PIC X(13) VALUE '150160   1053'.
122400         10  FILLER      PIC X(13) VALUE '150163   0811'.
122500         10  FILLER      PIC X(13) VALUE '150164   0831'.
122600         10  FILLER      PIC X(13) VALUE '150165   0440'.
122700         10  FILLER      PIC X(13) VALUE '150166   0256'.
122800         10  FILLER      PIC X(13) VALUE '150167   0633'.
122900         10  FILLER      PIC X(13) VALUE '150168   0759'.
123000         10  FILLER      PIC X(13) VALUE '150170   0011'.
123100         10  FILLER      PIC X(13) VALUE '150172   0053'.
123200         10  FILLER      PIC X(13) VALUE '150174   0014'.
123300         10  FILLER      PIC X(13) VALUE '150175   0492'.
123400         10  FILLER      PIC X(13) VALUE '150176   0005'.
123500         10  FILLER      PIC X(13) VALUE '160001   1344'.
123600         10  FILLER      PIC X(13) VALUE '160005   1057'.
123700         10  FILLER      PIC X(13) VALUE '160008   1372'.
123800         10  FILLER      PIC X(13) VALUE '160013   0695'.
123900         10  FILLER      PIC X(13) VALUE '160032   1049'.
124000         10  FILLER      PIC X(13) VALUE '160040   0645'.
124100         10  FILLER      PIC X(13) VALUE '160101   0381'.
124200         10  FILLER      PIC X(13) VALUE '160104   1516'.
124300         10  FILLER      PIC X(13) VALUE '160112   1460'.
124400         10  FILLER      PIC X(13) VALUE '160122   0975'.
124500         10  FILLER      PIC X(13) VALUE '160124   0772'.
124600         10  FILLER      PIC X(13) VALUE '160147   0892'.
124700         10  FILLER      PIC X(13) VALUE '160156   0030'.
124800         10  FILLER      PIC X(13) VALUE '170001   1542'.
124900         10  FILLER      PIC X(13) VALUE '170009   0906'.
125000         10  FILLER      PIC X(13) VALUE '170010   0597'.
125100         10  FILLER      PIC X(13) VALUE '170014   0768'.
125200         10  FILLER      PIC X(13) VALUE '170017   0810'.
125300         10  FILLER      PIC X(13) VALUE '170023   1009'.
125400         10  FILLER      PIC X(13) VALUE '170027   0898'.
125500         10  FILLER      PIC X(13) VALUE '170033   0693'.
125600         10  FILLER      PIC X(13) VALUE '170039   0364'.
125700         10  FILLER      PIC X(13) VALUE '170058   1112'.
125800         10  FILLER      PIC X(13) VALUE '170068   0749'.
125900         10  FILLER      PIC X(13) VALUE '170074   0687'.
126000         10  FILLER      PIC X(13) VALUE '170075   0191'.
126100         10  FILLER      PIC X(13) VALUE '170094   0688'.
126200         10  FILLER      PIC X(13) VALUE '170105   0637'.
126300         10  FILLER      PIC X(13) VALUE '170109   0388'.
126400         10  FILLER      PIC X(13) VALUE '170110   0213'.
126500         10  FILLER      PIC X(13) VALUE '170120   1301'.
126600         10  FILLER      PIC X(13) VALUE '170133   0660'.
126700         10  FILLER      PIC X(13) VALUE '170150   0498'.
126800         10  FILLER      PIC X(13) VALUE '170166   0605'.
126900         10  FILLER      PIC X(13) VALUE '170175   1073'.
127000         10  FILLER      PIC X(13) VALUE '170183   0652'.
127100         10  FILLER      PIC X(13) VALUE '170186   1473'.
127200         10  FILLER      PIC X(13) VALUE '170187   0305'.
127300         10  FILLER      PIC X(13) VALUE '170188   0260'.
127400         10  FILLER      PIC X(13) VALUE '170190   0081'.
127500         10  FILLER      PIC X(13) VALUE '170191   0288'.
127600         10  FILLER      PIC X(13) VALUE '170194   0389'.
127700         10  FILLER      PIC X(13) VALUE '170195   0340'.
127800         10  FILLER      PIC X(13) VALUE '170196   0590'.
127900         10  FILLER      PIC X(13) VALUE '170198   0093'.
128000         10  FILLER      PIC X(13) VALUE '170199   0002'.
128100         10  FILLER      PIC X(13) VALUE '180004   1184'.
128200         10  FILLER      PIC X(13) VALUE '180016   1586'.
128300         10  FILLER      PIC X(13) VALUE '180019   1482'.
128400         10  FILLER      PIC X(13) VALUE '180020   1184'.
128500         10  FILLER      PIC X(13) VALUE '180024   0901'.
128600         10  FILLER      PIC X(13) VALUE '180025   1299'.
128700         10  FILLER      PIC X(13) VALUE '180043   1443'.
128800         10  FILLER      PIC X(13) VALUE '180046   0501'.
128900         10  FILLER      PIC X(13) VALUE '180049   1287'.
129000         10  FILLER      PIC X(13) VALUE '180053   0927'.
129100         10  FILLER      PIC X(13) VALUE '180064   0836'.
129200         10  FILLER      PIC X(13) VALUE '180066   1103'.
129300         10  FILLER      PIC X(13) VALUE '180070   0960'.
129400         10  FILLER      PIC X(13) VALUE '180079   0860'.
129500         10  FILLER      PIC X(13) VALUE '180087   1387'.
129600         10  FILLER      PIC X(13) VALUE '180092   0863'.
129700         10  FILLER      PIC X(13) VALUE '180095   1110'.
129800         10  FILLER      PIC X(13) VALUE '180101   0946'.
129900         10  FILLER      PIC X(13) VALUE '180105   1232'.
130000         10  FILLER      PIC X(13) VALUE '180106   1235'.
130100         10  FILLER      PIC X(13) VALUE '180115   0822'.
130200         10  FILLER      PIC X(13) VALUE '180117   0632'.
130300         10  FILLER      PIC X(13) VALUE '180128   1496'.
130400         10  FILLER      PIC X(13) VALUE '180138   1402'.
130500         10  FILLER      PIC X(13) VALUE '180149   1123'.
130600         10  FILLER      PIC X(13) VALUE '190001   0926'.
130700         10  FILLER      PIC X(13) VALUE '190003   1164'.
130800         10  FILLER      PIC X(13) VALUE '190005   1268'.
130900         10  FILLER      PIC X(13) VALUE '190006   0640'.
131000         10  FILLER      PIC X(13) VALUE '190007   1241'.
131100         10  FILLER      PIC X(13) VALUE '190009   0203'.
131200         10  FILLER      PIC X(13) VALUE '190011   0717'.
131300         10  FILLER      PIC X(13) VALUE '190014   1086'.
131400         10  FILLER      PIC X(13) VALUE '190025   1080'.
131500         10  FILLER      PIC X(13) VALUE '190034   1044'.
131600         10  FILLER      PIC X(13) VALUE '190037   0001'.
131700         10  FILLER      PIC X(13) VALUE '190044   1524'.
131800         10  FILLER      PIC X(13) VALUE '190050   1229'.
131900         10  FILLER      PIC X(13) VALUE '190078   0995'.
132000         10  FILLER      PIC X(13) VALUE '190079   0413'.
132100         10  FILLER      PIC X(13) VALUE '190081   0794'.
132200         10  FILLER      PIC X(13) VALUE '190088   0674'.
132300         10  FILLER      PIC X(13) VALUE '190090   0681'.
132400         10  FILLER      PIC X(13) VALUE '190099   0916'.
132500         10  FILLER      PIC X(13) VALUE '190106   0642'.
132600         10  FILLER      PIC X(13) VALUE '190114   1034'.
132700         10  FILLER      PIC X(13) VALUE '190116   0784'.
132800         10  FILLER      PIC X(13) VALUE '190118   0736'.
132900         10  FILLER      PIC X(13) VALUE '190122   0455'.
133000         10  FILLER      PIC X(13) VALUE '190128   0295'.
133100         10  FILLER      PIC X(13) VALUE '190131   0108'.
133200         10  FILLER      PIC X(13) VALUE '190133   0193'.
133300         10  FILLER      PIC X(13) VALUE '190135   1153'.
133400         10  FILLER      PIC X(13) VALUE '190140   0814'.
133500         10  FILLER      PIC X(13) VALUE '190145   0747'.
133600         10  FILLER      PIC X(13) VALUE '190151   0584'.
133700         10  FILLER      PIC X(13) VALUE '190161   0138'.
133800         10  FILLER      PIC X(13) VALUE '190167   1498'.
133900         10  FILLER      PIC X(13) VALUE '190175   1311'.
134000         10  FILLER      PIC X(13) VALUE '190183   0711'.
134100         10  FILLER      PIC X(13) VALUE '190184   0380'.
134200         10  FILLER      PIC X(13) VALUE '190190   0490'.
134300         10  FILLER      PIC X(13) VALUE '190191   0486'.
134400         10  FILLER      PIC X(13) VALUE '190196   0055'.
134500         10  FILLER      PIC X(13) VALUE '190199   0019'.
134600         10  FILLER      PIC X(13) VALUE '190201   0261'.
134700         10  FILLER      PIC X(13) VALUE '190208   0452'.
134800         10  FILLER      PIC X(13) VALUE '190218   0675'.
134900         10  FILLER      PIC X(13) VALUE '190241   0070'.
135000         10  FILLER      PIC X(13) VALUE '190242   1010'.
135100         10  FILLER      PIC X(13) VALUE '190245   0118'.
135200         10  FILLER      PIC X(13) VALUE '190246   0239'.
135300         10  FILLER      PIC X(13) VALUE '190250   1329'.
135400         10  FILLER      PIC X(13) VALUE '190251   0065'.
135500         10  FILLER      PIC X(13) VALUE '190255   0012'.
135600         10  FILLER      PIC X(13) VALUE '190256   0023'.
135700         10  FILLER      PIC X(13) VALUE '190257   0213'.
135800         10  FILLER      PIC X(13) VALUE '190258   0035'.
135900         10  FILLER      PIC X(13) VALUE '190259   0220'.
136000         10  FILLER      PIC X(13) VALUE '190261   0011'.
136100         10  FILLER      PIC X(13) VALUE '190263   1372'.
136200         10  FILLER      PIC X(13) VALUE '190266   0157'.
136300         10  FILLER      PIC X(13) VALUE '190267   0079'.
136400         10  FILLER      PIC X(13) VALUE '190268   0038'.
136500         10  FILLER      PIC X(13) VALUE '190270   0304'.
136600         10  FILLER      PIC X(13) VALUE '190272   0155'.
136700         10  FILLER      PIC X(13) VALUE '190273   0049'.
136800         10  FILLER      PIC X(13) VALUE '190278   0208'.
136900         10  FILLER      PIC X(13) VALUE '190297   0246'.
137000         10  FILLER      PIC X(13) VALUE '200002   0926'.
137100         10  FILLER      PIC X(13) VALUE '200018   1146'.
137200         10  FILLER      PIC X(13) VALUE '200025   0814'.
137300         10  FILLER      PIC X(13) VALUE '200031   1074'.
137400         10  FILLER      PIC X(13) VALUE '200032   1199'.
137500         10  FILLER      PIC X(13) VALUE '200037   1406'.
137600         10  FILLER      PIC X(13) VALUE '200040   1369'.
137700         10  FILLER      PIC X(13) VALUE '200041   0719'.
137800         10  FILLER      PIC X(13) VALUE '200050   1591'.
137900         10  FILLER      PIC X(13) VALUE '200052   0783'.
138000         10  FILLER      PIC X(13) VALUE '210017   1242'.
138100         10  FILLER      PIC X(13) VALUE '210045   0440'.
138200         10  FILLER      PIC X(13) VALUE '210060   1251'.
138300         10  FILLER      PIC X(13) VALUE '220019   1158'.
138400         10  FILLER      PIC X(13) VALUE '220025   0226'.
138500         10  FILLER      PIC X(13) VALUE '220050   0846'.
138600         10  FILLER      PIC X(13) VALUE '220051   1325'.
138700         10  FILLER      PIC X(13) VALUE '220058   0469'.
138800         10  FILLER      PIC X(13) VALUE '220075   0378'.
138900         10  FILLER      PIC X(13) VALUE '220083   1481'.
139000         10  FILLER      PIC X(13) VALUE '220095   1524'.
139100         10  FILLER      PIC X(13) VALUE '220098   0969'.
139200         10  FILLER      PIC X(13) VALUE '220162   0276'.
139300         10  FILLER      PIC X(13) VALUE '220177   0168'.
139400         10  FILLER      PIC X(13) VALUE '230003   1057'.
139500         10  FILLER      PIC X(13) VALUE '230013   1077'.
139600         10  FILLER      PIC X(13) VALUE '230015   0779'.
139700         10  FILLER      PIC X(13) VALUE '230034   0866'.
139800         10  FILLER      PIC X(13) VALUE '230035   1315'.
139900         10  FILLER      PIC X(13) VALUE '230037   1505'.
140000         10  FILLER      PIC X(13) VALUE '230040   1513'.
140100         10  FILLER      PIC X(13) VALUE '230055   1520'.
140200         10  FILLER      PIC X(13) VALUE '230060   0745'.
140300         10  FILLER      PIC X(13) VALUE '230071   0386'.
140400         10  FILLER      PIC X(13) VALUE '230078   0450'.
140500         10  FILLER      PIC X(13) VALUE '230080   1538'.
140600         10  FILLER      PIC X(13) VALUE '230085   0365'.
140700         10  FILLER      PIC X(13) VALUE '230093   0856'.
140800         10  FILLER      PIC X(13) VALUE '230095   1573'.
140900         10  FILLER      PIC X(13) VALUE '230096   0865'.
141000         10  FILLER      PIC X(13) VALUE '230100   1398'.
141100         10  FILLER      PIC X(13) VALUE '230101   1269'.
141200         10  FILLER      PIC X(13) VALUE '230106   1362'.
141300         10  FILLER      PIC X(13) VALUE '230108   0773'.
141400         10  FILLER      PIC X(13) VALUE '230110   1283'.
141500         10  FILLER      PIC X(13) VALUE '230118   0747'.
141600         10  FILLER      PIC X(13) VALUE '230133   0753'.
141700         10  FILLER      PIC X(13) VALUE '230135   0223'.
141800         10  FILLER      PIC X(13) VALUE '230174   0905'.
141900         10  FILLER      PIC X(13) VALUE '230180   1281'.
142000         10  FILLER      PIC X(13) VALUE '230208   0627'.
142100         10  FILLER      PIC X(13) VALUE '230212   0636'.
142200         10  FILLER      PIC X(13) VALUE '230217   1400'.
142300         10  FILLER      PIC X(13) VALUE '230239   1262'.
142400         10  FILLER      PIC X(13) VALUE '230241   1231'.
142500         10  FILLER      PIC X(13) VALUE '230257   0151'.
142600         10  FILLER      PIC X(13) VALUE '230259   1135'.
142700         10  FILLER      PIC X(13) VALUE '230264   0018'.
142800         10  FILLER      PIC X(13) VALUE '230275   0074'.
142900         10  FILLER      PIC X(13) VALUE '230279   0174'.
143000         10  FILLER      PIC X(13) VALUE '230297   1370'.
143100         10  FILLER      PIC X(13) VALUE '230301   0217'.
143200         10  FILLER      PIC X(13) VALUE '240006   0479'.
143300         10  FILLER      PIC X(13) VALUE '240014   0739'.
143400         10  FILLER      PIC X(13) VALUE '240018   0710'.
143500         10  FILLER      PIC X(13) VALUE '240019   1118'.
143600         10  FILLER      PIC X(13) VALUE '240020   1352'.
143700         10  FILLER      PIC X(13) VALUE '240022   0529'.
143800         10  FILLER      PIC X(13) VALUE '240040   1516'.
143900         10  FILLER      PIC X(13) VALUE '240043   1467'.
144000         10  FILLER      PIC X(13) VALUE '240044   1399'.
144100         10  FILLER      PIC X(13) VALUE '240050   1322'.
144200         10  FILLER      PIC X(13) VALUE '240052   1318'.
144300         10  FILLER      PIC X(13) VALUE '240059   0805'.
144400         10  FILLER      PIC X(13) VALUE '240064   0929'.
144500         10  FILLER      PIC X(13) VALUE '240069   0921'.
144600         10  FILLER      PIC X(13) VALUE '240071   0739'.
144700         10  FILLER      PIC X(13) VALUE '240076   1164'.
144800         10  FILLER      PIC X(13) VALUE '240084   1015'.
144900         10  FILLER      PIC X(13) VALUE '240088   1532'.
145000         10  FILLER      PIC X(13) VALUE '240101   0861'.
145100         10  FILLER      PIC X(13) VALUE '240117   1458'.
145200         10  FILLER      PIC X(13) VALUE '240141   0863'.
145300         10  FILLER      PIC X(13) VALUE '240166   1038'.
145400         10  FILLER      PIC X(13) VALUE '240187   1009'.
145500         10  FILLER      PIC X(13) VALUE '240196   0177'.
145600         10  FILLER      PIC X(13) VALUE '240206   0097'.
145700         10  FILLER      PIC X(13) VALUE '240211   0002'.
145800         10  FILLER      PIC X(13) VALUE '250002   0976'.
145900         10  FILLER      PIC X(13) VALUE '250006   1310'.
146000         10  FILLER      PIC X(13) VALUE '250010   0520'.
146100         10  FILLER      PIC X(13) VALUE '250012   0420'.
146200         10  FILLER      PIC X(13) VALUE '250017   0668'.
146300         10  FILLER      PIC X(13) VALUE '250018   0020'.
146400         10  FILLER      PIC X(13) VALUE '250020   1121'.
146500         10  FILLER      PIC X(13) VALUE '250023   0050'.
146600         10  FILLER      PIC X(13) VALUE '250027   0354'.
146700         10  FILLER      PIC X(13) VALUE '250035   0233'.
146800         10  FILLER      PIC X(13) VALUE '250036   0957'.
146900         10  FILLER      PIC X(13) VALUE '250038   0538'.
147000         10  FILLER      PIC X(13) VALUE '250043   0588'.
147100         10  FILLER      PIC X(13) VALUE '250044   0902'.
147200         10  FILLER      PIC X(13) VALUE '250049   0771'.
147300         10  FILLER      PIC X(13) VALUE '250050   1051'.
147400         10  FILLER      PIC X(13) VALUE '250051   0174'.
147500         10  FILLER      PIC X(13) VALUE '250057   1429'.
147600         10  FILLER      PIC X(13) VALUE '250059   0933'.
147700         10  FILLER      PIC X(13) VALUE '250060   0273'.
147800         10  FILLER      PIC X(13) VALUE '250061   0641'.
147900         10  FILLER      PIC X(13) VALUE '250067   0934'.
148000         10  FILLER      PIC X(13) VALUE '250077   1071'.
148100         10  FILLER      PIC X(13) VALUE '250079   0204'.
148200         10  FILLER      PIC X(13) VALUE '250081   1384'.
148300         10  FILLER      PIC X(13) VALUE '250084   1319'.
148400         10  FILLER      PIC X(13) VALUE '250085   0871'.
148500         10  FILLER      PIC X(13) VALUE '250095   0744'.
148600         10  FILLER      PIC X(13) VALUE '250112   0145'.
148700         10  FILLER      PIC X(13) VALUE '250117   1006'.
148800         10  FILLER      PIC X(13) VALUE '250124   1133'.
148900         10  FILLER      PIC X(13) VALUE '250126   0700'.
149000         10  FILLER      PIC X(13) VALUE '250127   0030'.
149100         10  FILLER      PIC X(13) VALUE '250128   0947'.
149200         10  FILLER      PIC X(13) VALUE '250134   0136'.
149300         10  FILLER      PIC X(13) VALUE '250136   0096'.
149400         10  FILLER      PIC X(13) VALUE '250149   0358'.
149500         10  FILLER      PIC X(13) VALUE '250151   0120'.
149600         10  FILLER      PIC X(13) VALUE '250152   0010'.
149700         10  FILLER      PIC X(13) VALUE '250162   0826'.
149800         10  FILLER      PIC X(13) VALUE '250163   0002'.
149900         10  FILLER      PIC X(13) VALUE '260004   0241'.
150000         10  FILLER      PIC X(13) VALUE '260015   1464'.
150100         10  FILLER      PIC X(13) VALUE '260021   1003'.
150200         10  FILLER      PIC X(13) VALUE '260024   0555'.
150300         10  FILLER      PIC X(13) VALUE '260034   0889'.
150400         10  FILLER      PIC X(13) VALUE '260050   0690'.
150500         10  FILLER      PIC X(13) VALUE '260057   0885'.
150600         10  FILLER      PIC X(13) VALUE '260059   1335'.
150700         10  FILLER      PIC X(13) VALUE '260061   0528'.
150800         10  FILLER      PIC X(13) VALUE '260070   1348'.
150900         10  FILLER      PIC X(13) VALUE '260074   1305'.
151000         10  FILLER      PIC X(13) VALUE '260080   0586'.
151100         10  FILLER      PIC X(13) VALUE '260097   1114'.
151200         10  FILLER      PIC X(13) VALUE '260102   0902'.
151300         10  FILLER      PIC X(13) VALUE '260115   0790'.
151400         10  FILLER      PIC X(13) VALUE '260116   1507'.
151500         10  FILLER      PIC X(13) VALUE '260142   0933'.
151600         10  FILLER      PIC X(13) VALUE '260147   0437'.
151700         10  FILLER      PIC X(13) VALUE '260160   0834'.
151800         10  FILLER      PIC X(13) VALUE '260175   1317'.
151900         10  FILLER      PIC X(13) VALUE '260178   1065'.
152000         10  FILLER      PIC X(13) VALUE '260195   1365'.
152100         10  FILLER      PIC X(13) VALUE '260207   0616'.
152200         10  FILLER      PIC X(13) VALUE '260209   0393'.
152300         10  FILLER      PIC X(13) VALUE '260211   0461'.
152400         10  FILLER      PIC X(13) VALUE '260214   1001'.
152500         10  FILLER      PIC X(13) VALUE '260219   0799'.
152600         10  FILLER      PIC X(13) VALUE '260221   0013'.
152700         10  FILLER      PIC X(13) VALUE '260222   0036'.
152800         10  FILLER      PIC X(13) VALUE '260223   0048'.
152900         10  FILLER      PIC X(13) VALUE '270002   0726'.
153000         10  FILLER      PIC X(13) VALUE '270032   0873'.
153100         10  FILLER      PIC X(13) VALUE '270074   0241'.
153200         10  FILLER      PIC X(13) VALUE '270086   0232'.
153300         10  FILLER      PIC X(13) VALUE '270087   0301'.
153400         10  FILLER      PIC X(13) VALUE '280105   1449'.
153500         10  FILLER      PIC X(13) VALUE '280111   1149'.
153600         10  FILLER      PIC X(13) VALUE '280119   0069'.
153700         10  FILLER      PIC X(13) VALUE '280127   0314'.
153800         10  FILLER      PIC X(13) VALUE '280129   0568'.
153900         10  FILLER      PIC X(13) VALUE '280131   0211'.
154000         10  FILLER      PIC X(13) VALUE '290002   0140'.
154100         10  FILLER      PIC X(13) VALUE '290006   0907'.
154200         10  FILLER      PIC X(13) VALUE '290008   0758'.
154300         10  FILLER      PIC X(13) VALUE '290020   0064'.
154400         10  FILLER      PIC X(13) VALUE '290027   0080'.
154500         10  FILLER      PIC X(13) VALUE '290032   1337'.
154600         10  FILLER      PIC X(13) VALUE '290049   1504'.
154700         10  FILLER      PIC X(13) VALUE '290051   0383'.
154800         10  FILLER      PIC X(13) VALUE '290055   0032'.
154900         10  FILLER      PIC X(13) VALUE '310058   0781'.
155000         10  FILLER      PIC X(13) VALUE '310088   0700'.
155100         10  FILLER      PIC X(13) VALUE '310118   1323'.
155200         10  FILLER      PIC X(13) VALUE '310120   0770'.
155300         10  FILLER      PIC X(13) VALUE '320003   0906'.
155400         10  FILLER      PIC X(13) VALUE '320011   0747'.
155500         10  FILLER      PIC X(13) VALUE '320013   0980'.
155600         10  FILLER      PIC X(13) VALUE '320014   1012'.
155700         10  FILLER      PIC X(13) VALUE '320016   1173'.
155800         10  FILLER      PIC X(13) VALUE '320017   1278'.
155900         10  FILLER      PIC X(13) VALUE '320022   1569'.
156000         10  FILLER      PIC X(13) VALUE '320030   0403'.
156100         10  FILLER      PIC X(13) VALUE '320033   0461'.
156200         10  FILLER      PIC X(13) VALUE '320037   0260'.
156300         10  FILLER      PIC X(13) VALUE '320038   1072'.
156400         10  FILLER      PIC X(13) VALUE '320057   0076'.
156500         10  FILLER      PIC X(13) VALUE '320058   0037'.
156600         10  FILLER      PIC X(13) VALUE '320059   0772'.
156700         10  FILLER      PIC X(13) VALUE '320060   0126'.
156800         10  FILLER      PIC X(13) VALUE '320061   0681'.
156900         10  FILLER      PIC X(13) VALUE '320062   0194'.
157000         10  FILLER      PIC X(13) VALUE '320065   1068'.
157100         10  FILLER      PIC X(13) VALUE '320067   0114'.
157200         10  FILLER      PIC X(13) VALUE '320069   0560'.
157300         10  FILLER      PIC X(13) VALUE '320070   0127'.
157400         10  FILLER      PIC X(13) VALUE '320074   1302'.
157500         10  FILLER      PIC X(13) VALUE '320084   0559'.
157600         10  FILLER      PIC X(13) VALUE '320086   0624'.
157700         10  FILLER      PIC X(13) VALUE '320087   0087'.
157800         10  FILLER      PIC X(13) VALUE '320088   0053'.
157900         10  FILLER      PIC X(13) VALUE '330008   0706'.
158000         10  FILLER      PIC X(13) VALUE '330010   0010'.
158100         10  FILLER      PIC X(13) VALUE '330025   0377'.
158200         10  FILLER      PIC X(13) VALUE '330029   0112'.
158300         10  FILLER      PIC X(13) VALUE '330033   1064'.
158400         10  FILLER      PIC X(13) VALUE '330036   0496'.
158500         10  FILLER      PIC X(13) VALUE '330037   0724'.
158600         10  FILLER      PIC X(13) VALUE '330041   0102'.
158700         10  FILLER      PIC X(13) VALUE '330049   1429'.
158800         10  FILLER      PIC X(13) VALUE '330053   0931'.
158900         10  FILLER      PIC X(13) VALUE '330075   0421'.
159000         10  FILLER      PIC X(13) VALUE '330079   1233'.
159100         10  FILLER      PIC X(13) VALUE '330084   1214'.
159200         10  FILLER      PIC X(13) VALUE '330088   1014'.
159300         10  FILLER      PIC X(13) VALUE '330096   1036'.
159400         10  FILLER      PIC X(13) VALUE '330100   0200'.
159500         10  FILLER      PIC X(13) VALUE '330111   0771'.
159600         10  FILLER      PIC X(13) VALUE '330115   1252'.
159700         10  FILLER      PIC X(13) VALUE '330132   1419'.
159800         10  FILLER      PIC X(13) VALUE '330144   0619'.
159900         10  FILLER      PIC X(13) VALUE '330151   1188'.
160000         10  FILLER      PIC X(13) VALUE '330166   0070'.
160100         10  FILLER      PIC X(13) VALUE '330177   0488'.
160200         10  FILLER      PIC X(13) VALUE '330189   0004'.
160300         10  FILLER      PIC X(13) VALUE '330197   1552'.
160400         10  FILLER      PIC X(13) VALUE '330205   1186'.
160500         10  FILLER      PIC X(13) VALUE '330211   1551'.
160600         10  FILLER      PIC X(13) VALUE '330213   0743'.
160700         10  FILLER      PIC X(13) VALUE '330223   1379'.
160800         10  FILLER      PIC X(13) VALUE '330229   0948'.
160900         10  FILLER      PIC X(13) VALUE '330238   1024'.
161000         10  FILLER      PIC X(13) VALUE '330249   1192'.
161100         10  FILLER      PIC X(13) VALUE '330263   0541'.
161200         10  FILLER      PIC X(13) VALUE '330268   0418'.
161300         10  FILLER      PIC X(13) VALUE '330276   1401'.
161400         10  FILLER      PIC X(13) VALUE '330385   1201'.
161500         10  FILLER      PIC X(13) VALUE '330403   0004'.
161600         10  FILLER      PIC X(13) VALUE '330404   0743'.
161700         10  FILLER      PIC X(13) VALUE '330405   0497'.
161800         10  FILLER      PIC X(13) VALUE '330406   0369'.
161900         10  FILLER      PIC X(13) VALUE '340011   1379'.
162000         10  FILLER      PIC X(13) VALUE '340012   0281'.
162100         10  FILLER      PIC X(13) VALUE '340035   1250'.
162200         10  FILLER      PIC X(13) VALUE '340036   0862'.
162300         10  FILLER      PIC X(13) VALUE '340037   1023'.
162400         10  FILLER      PIC X(13) VALUE '340038   1496'.
162500         10  FILLER      PIC X(13) VALUE '340049   0513'.
162600         10  FILLER      PIC X(13) VALUE '340055   1323'.
162700         10  FILLER      PIC X(13) VALUE '340084   0607'.
162800         10  FILLER      PIC X(13) VALUE '340085   1592'.
162900         10  FILLER      PIC X(13) VALUE '340087   0895'.
163000         10  FILLER      PIC X(13) VALUE '340120   0806'.
163100         10  FILLER      PIC X(13) VALUE '340121   0691'.
163200         10  FILLER      PIC X(13) VALUE '340127   1044'.
163300         10  FILLER      PIC X(13) VALUE '340133   1512'.
163400         10  FILLER      PIC X(13) VALUE '340138   0036'.
163500         10  FILLER      PIC X(13) VALUE '340148   0372'.
163600         10  FILLER      PIC X(13) VALUE '340156   0221'.
163700         10  FILLER      PIC X(13) VALUE '340159   0887'.
163800         10  FILLER      PIC X(13) VALUE '340160   1576'.
163900         10  FILLER      PIC X(13) VALUE '340166   1576'.
164000         10  FILLER      PIC X(13) VALUE '340168   0036'.
164100         10  FILLER      PIC X(13) VALUE '350003   0680'.
164200         10  FILLER      PIC X(13) VALUE '350009   0287'.
164300         10  FILLER      PIC X(13) VALUE '350063   0042'.
164400         10  FILLER      PIC X(13) VALUE '350064   0006'.
164500         10  FILLER      PIC X(13) VALUE '360002   1405'.
164600         10  FILLER      PIC X(13) VALUE '360013   1347'.
164700         10  FILLER      PIC X(13) VALUE '360014   1236'.
164800         10  FILLER      PIC X(13) VALUE '360029   1581'.
164900         10  FILLER      PIC X(13) VALUE '360032   1453'.
165000         10  FILLER      PIC X(13) VALUE '360038   0871'.
165100         10  FILLER      PIC X(13) VALUE '360044   1501'.
165200         10  FILLER      PIC X(13) VALUE '360046   1081'.
165300         10  FILLER      PIC X(13) VALUE '360058   0815'.
165400         10  FILLER      PIC X(13) VALUE '360071   1100'.
165500         10  FILLER      PIC X(13) VALUE '360080   1437'.
165600         10  FILLER      PIC X(13) VALUE '360089   1309'.
165700         10  FILLER      PIC X(13) VALUE '360092   0470'.
165800         10  FILLER      PIC X(13) VALUE '360107   0932'.
165900         10  FILLER      PIC X(13) VALUE '360109   1356'.
166000         10  FILLER      PIC X(13) VALUE '360116   0712'.
166100         10  FILLER      PIC X(13) VALUE '360130   0489'.
166200         10  FILLER      PIC X(13) VALUE '360148   0555'.
166300         10  FILLER      PIC X(13) VALUE '360153   0426'.
166400         10  FILLER      PIC X(13) VALUE '360156   0909'.
166500         10  FILLER      PIC X(13) VALUE '360170   1076'.
166600         10  FILLER      PIC X(13) VALUE '360189   0470'.
166700         10  FILLER      PIC X(13) VALUE '360197   1304'.
166800         10  FILLER      PIC X(13) VALUE '360210   0868'.
166900         10  FILLER      PIC X(13) VALUE '360245   0359'.
167000         10  FILLER      PIC X(13) VALUE '360247   0140'.
167100         10  FILLER      PIC X(13) VALUE '360261   0019'.
167200         10  FILLER      PIC X(13) VALUE '360263   0286'.
167300         10  FILLER      PIC X(13) VALUE '360266   1487'.
167400         10  FILLER      PIC X(13) VALUE '360269   0101'.
167500         10  FILLER      PIC X(13) VALUE '360270   0821'.
167600         10  FILLER      PIC X(13) VALUE '360271   0023'.
167700         10  FILLER      PIC X(13) VALUE '360274   0176'.
167800         10  FILLER      PIC X(13) VALUE '360347   0383'.
167900         10  FILLER      PIC X(13) VALUE '360348   0943'.
168000         10  FILLER      PIC X(13) VALUE '360349   0012'.
168100         10  FILLER      PIC X(13) VALUE '360350   0091'.
168200         10  FILLER      PIC X(13) VALUE '360351   0346'.
168300         10  FILLER      PIC X(13) VALUE '360352   0019'.
168400         10  FILLER      PIC X(13) VALUE '360354   0428'.
168500         10  FILLER      PIC X(13) VALUE '360355   0020'.
168600         10  FILLER      PIC X(13) VALUE '360356   0001'.
168700         10  FILLER      PIC X(13) VALUE '370002   0970'.
168800         10  FILLER      PIC X(13) VALUE '370004   1586'.
168900         10  FILLER      PIC X(13) VALUE '370007   0316'.
169000         10  FILLER      PIC X(13) VALUE '370011   0440'.
169100         10  FILLER      PIC X(13) VALUE '370015   0562'.
169200         10  FILLER      PIC X(13) VALUE '370019   1025'.
169300         10  FILLER      PIC X(13) VALUE '370029   0726'.
169400         10  FILLER      PIC X(13) VALUE '370030   0555'.
169500         10  FILLER      PIC X(13) VALUE '370036   0436'.
169600         10  FILLER      PIC X(13) VALUE '370039   1306'.
169700         10  FILLER      PIC X(13) VALUE '370040   1241'.
169800         10  FILLER      PIC X(13) VALUE '370041   0190'.
169900         10  FILLER      PIC X(13) VALUE '370048   0982'.
170000         10  FILLER      PIC X(13) VALUE '370049   1552'.
170100         10  FILLER      PIC X(13) VALUE '370051   0376'.
170200         10  FILLER      PIC X(13) VALUE '370054   1122'.
170300         10  FILLER      PIC X(13) VALUE '370057   0554'.
170400         10  FILLER      PIC X(13) VALUE '370065   1013'.
170500         10  FILLER      PIC X(13) VALUE '370072   0431'.
170600         10  FILLER      PIC X(13) VALUE '370080   0361'.
170700         10  FILLER      PIC X(13) VALUE '370083   0629'.
170800         10  FILLER      PIC X(13) VALUE '370084   0499'.
170900         10  FILLER      PIC X(13) VALUE '370097   1546'.
171000         10  FILLER      PIC X(13) VALUE '370099   1191'.
171100         10  FILLER      PIC X(13) VALUE '370100   1136'.
171200         10  FILLER      PIC X(13) VALUE '370103   0400'.
171300         10  FILLER      PIC X(13) VALUE '370105   0161'.
171400         10  FILLER      PIC X(13) VALUE '370112   0420'.
171500         10  FILLER      PIC X(13) VALUE '370113   1519'.
171600         10  FILLER      PIC X(13) VALUE '370138   0349'.
171700         10  FILLER      PIC X(13) VALUE '370139   0381'.
171800         10  FILLER      PIC X(13) VALUE '370148   1262'.
171900         10  FILLER      PIC X(13) VALUE '370153   0557'.
172000         10  FILLER      PIC X(13) VALUE '370156   0786'.
172100         10  FILLER      PIC X(13) VALUE '370158   0697'.
172200         10  FILLER      PIC X(13) VALUE '370166   0806'.
172300         10  FILLER      PIC X(13) VALUE '370169   0086'.
172400         10  FILLER      PIC X(13) VALUE '370170   0062'.
172500         10  FILLER      PIC X(13) VALUE '370171   0458'.
172600         10  FILLER      PIC X(13) VALUE '370172   0252'.
172700         10  FILLER      PIC X(13) VALUE '370173   0205'.
172800         10  FILLER      PIC X(13) VALUE '370178   0992'.
172900         10  FILLER      PIC X(13) VALUE '370180   0435'.
173000         10  FILLER      PIC X(13) VALUE '370183   0501'.
173100         10  FILLER      PIC X(13) VALUE '370190   0263'.
173200         10  FILLER      PIC X(13) VALUE '370192   0153'.
173300         10  FILLER      PIC X(13) VALUE '370199   0014'.
173400         10  FILLER      PIC X(13) VALUE '370201   0108'.
173500         10  FILLER      PIC X(13) VALUE '370203   0648'.
173600         10  FILLER      PIC X(13) VALUE '370206   0310'.
173700         10  FILLER      PIC X(13) VALUE '370210   1245'.
173800         10  FILLER      PIC X(13) VALUE '370211   1117'.
173900         10  FILLER      PIC X(13) VALUE '370212   0097'.
174000         10  FILLER      PIC X(13) VALUE '370214   0033'.
174100         10  FILLER      PIC X(13) VALUE '370216   0664'.
174200         10  FILLER      PIC X(13) VALUE '370218   0854'.
174300         10  FILLER      PIC X(13) VALUE '370220   0122'.
174400         10  FILLER      PIC X(13) VALUE '370222   1530'.
174500         10  FILLER      PIC X(13) VALUE '370225   0006'.
174600         10  FILLER      PIC X(13) VALUE '370227   0470'.
174700         10  FILLER      PIC X(13) VALUE '370228   0491'.
174800         10  FILLER      PIC X(13) VALUE '370229   0432'.
174900         10  FILLER      PIC X(13) VALUE '370231   0015'.
175000         10  FILLER      PIC X(13) VALUE '370232   0172'.
175100         10  FILLER      PIC X(13) VALUE '380001   1020'.
175200         10  FILLER      PIC X(13) VALUE '380005   0550'.
175300         10  FILLER      PIC X(13) VALUE '380021   1331'.
175400         10  FILLER      PIC X(13) VALUE '380022   0852'.
175500         10  FILLER      PIC X(13) VALUE '380029   0428'.
175600         10  FILLER      PIC X(13) VALUE '380033   0619'.
175700         10  FILLER      PIC X(13) VALUE '380037   0815'.
175800         10  FILLER      PIC X(13) VALUE '380038   1447'.
175900         10  FILLER      PIC X(13) VALUE '380040   1083'.
176000         10  FILLER      PIC X(13) VALUE '380052   1374'.
176100         10  FILLER      PIC X(13) VALUE '380056   0438'.
176200         10  FILLER      PIC X(13) VALUE '380082   1314'.
176300         10  FILLER      PIC X(13) VALUE '390003   0979'.
176400         10  FILLER      PIC X(13) VALUE '390008   1310'.
176500         10  FILLER      PIC X(13) VALUE '390019   1180'.
176600         10  FILLER      PIC X(13) VALUE '390025   0048'.
176700         10  FILLER      PIC X(13) VALUE '390035   1054'.
176800         10  FILLER      PIC X(13) VALUE '390043   1114'.
176900         10  FILLER      PIC X(13) VALUE '390056   1030'.
177000         10  FILLER      PIC X(13) VALUE '390061   1442'.
177100         10  FILLER      PIC X(13) VALUE '390062   0809'.
177200         10  FILLER      PIC X(13) VALUE '390068   1043'.
177300         10  FILLER      PIC X(13) VALUE '390071   1022'.
177400         10  FILLER      PIC X(13) VALUE '390084   1439'.
177500         10  FILLER      PIC X(13) VALUE '390095   1289'.
177600         10  FILLER      PIC X(13) VALUE '390104   0671'.
177700         10  FILLER      PIC X(13) VALUE '390112   0813'.
177800         10  FILLER      PIC X(13) VALUE '390117   1171'.
177900         10  FILLER      PIC X(13) VALUE '390122   1040'.
178000         10  FILLER      PIC X(13) VALUE '390130   0593'.
178100         10  FILLER      PIC X(13) VALUE '390131   0812'.
178200         10  FILLER      PIC X(13) VALUE '390146   1366'.
178300         10  FILLER      PIC X(13) VALUE '390150   1216'.
178400         10  FILLER      PIC X(13) VALUE '390169   0727'.
178500         10  FILLER      PIC X(13) VALUE '390176   0023'.
178600         10  FILLER      PIC X(13) VALUE '390183   1232'.
178700         10  FILLER      PIC X(13) VALUE '390184   0748'.
178800         10  FILLER      PIC X(13) VALUE '390189   1598'.
178900         10  FILLER      PIC X(13) VALUE '390192   1155'.
179000         10  FILLER      PIC X(13) VALUE '390194   1353'.
179100         10  FILLER      PIC X(13) VALUE '390198   1124'.
179200         10  FILLER      PIC X(13) VALUE '390199   1235'.
179300         10  FILLER      PIC X(13) VALUE '390236   0684'.
179400         10  FILLER      PIC X(13) VALUE '390266   0968'.
179500         10  FILLER      PIC X(13) VALUE '390272   0144'.
179600         10  FILLER      PIC X(13) VALUE '390278   0594'.
179700         10  FILLER      PIC X(13) VALUE '390307   0050'.
179800         10  FILLER      PIC X(13) VALUE '390312   0233'.
179900         10  FILLER      PIC X(13) VALUE '390313   0716'.
180000         10  FILLER      PIC X(13) VALUE '390314   0398'.
180100         10  FILLER      PIC X(13) VALUE '390316   0227'.
180200         10  FILLER      PIC X(13) VALUE '390317   0002'.
180300         10  FILLER      PIC X(13) VALUE '390318   0178'.
180400         10  FILLER      PIC X(13) VALUE '390319   0130'.
180500         10  FILLER      PIC X(13) VALUE '390320   0025'.
180600         10  FILLER      PIC X(13) VALUE '390321   0019'.
180700         10  FILLER      PIC X(13) VALUE '410010   0684'.
180800         10  FILLER      PIC X(13) VALUE '420005   1240'.
180900         10  FILLER      PIC X(13) VALUE '420006   0001'.
181000         10  FILLER      PIC X(13) VALUE '420011   0574'.
181100         10  FILLER      PIC X(13) VALUE '420016   0339'.
181200         10  FILLER      PIC X(13) VALUE '420019   0906'.
181300         10  FILLER      PIC X(13) VALUE '420033   1418'.
181400         10  FILLER      PIC X(13) VALUE '420037   0775'.
181500         10  FILLER      PIC X(13) VALUE '420038   1276'.
181600         10  FILLER      PIC X(13) VALUE '420039   1123'.
181700         10  FILLER      PIC X(13) VALUE '420053   0998'.
181800         10  FILLER      PIC X(13) VALUE '420054   0639'.
181900         10  FILLER      PIC X(13) VALUE '420056   0526'.
182000         10  FILLER      PIC X(13) VALUE '420057   0327'.
182100         10  FILLER      PIC X(13) VALUE '420062   1271'.
182200         10  FILLER      PIC X(13) VALUE '420066   0516'.
182300         10  FILLER      PIC X(13) VALUE '420069   0943'.
182400         10  FILLER      PIC X(13) VALUE '420072   0483'.
182500         10  FILLER      PIC X(13) VALUE '420089   1598'.
182600         10  FILLER      PIC X(13) VALUE '420101   0453'.
182700         10  FILLER      PIC X(13) VALUE '420102   0557'.
182800         10  FILLER      PIC X(13) VALUE '420103   0302'.
182900         10  FILLER      PIC X(13) VALUE '430008   0585'.
183000         10  FILLER      PIC X(13) VALUE '430013   1442'.
183100         10  FILLER      PIC X(13) VALUE '430015   0837'.
183200         10  FILLER      PIC X(13) VALUE '430048   0663'.
183300         10  FILLER      PIC X(13) VALUE '430060   0021'.
183400         10  FILLER      PIC X(13) VALUE '430064   0030'.
183500         10  FILLER      PIC X(13) VALUE '430081   0144'.
183600         10  FILLER      PIC X(13) VALUE '430082   0006'.
183700         10  FILLER      PIC X(13) VALUE '430083   0028'.
183800         10  FILLER      PIC X(13) VALUE '430084   0165'.
183900         10  FILLER      PIC X(13) VALUE '430089   0382'.
184000         10  FILLER      PIC X(13) VALUE '430090   0358'.
184100         10  FILLER      PIC X(13) VALUE '430091   0504'.
184200         10  FILLER      PIC X(13) VALUE '430092   0206'.
184300         10  FILLER      PIC X(13) VALUE '430093   0080'.
184400         10  FILLER      PIC X(13) VALUE '430094   0032'.
184500         10  FILLER      PIC X(13) VALUE '430096   0156'.
184600         10  FILLER      PIC X(13) VALUE '440001   0907'.
184700         10  FILLER      PIC X(13) VALUE '440007   0851'.
184800         10  FILLER      PIC X(13) VALUE '440008   1059'.
184900         10  FILLER      PIC X(13) VALUE '440010   0541'.
185000         10  FILLER      PIC X(13) VALUE '440016   0613'.
185100         10  FILLER      PIC X(13) VALUE '440020   0973'.
185200         10  FILLER      PIC X(13) VALUE '440031   1278'.
185300         10  FILLER      PIC X(13) VALUE '440032   0764'.
185400         10  FILLER      PIC X(13) VALUE '440040   0711'.
185500         10  FILLER      PIC X(13) VALUE '440047   0410'.
185600         10  FILLER      PIC X(13) VALUE '440050   0987'.
185700         10  FILLER      PIC X(13) VALUE '440051   1080'.
185800         10  FILLER      PIC X(13) VALUE '440052   0647'.
185900         10  FILLER      PIC X(13) VALUE '440054   0891'.
186000         10  FILLER      PIC X(13) VALUE '440056   1301'.
186100         10  FILLER      PIC X(13) VALUE '440057   1249'.
186200         10  FILLER      PIC X(13) VALUE '440060   0265'.
186300         10  FILLER      PIC X(13) VALUE '440061   1507'.
186400         10  FILLER      PIC X(13) VALUE '440064   1088'.
186500         10  FILLER      PIC X(13) VALUE '440067   1374'.
186600         10  FILLER      PIC X(13) VALUE '440068   1236'.
186700         10  FILLER      PIC X(13) VALUE '440070   0740'.
186800         10  FILLER      PIC X(13) VALUE '440081   1260'.
186900         10  FILLER      PIC X(13) VALUE '440083   1567'.
187000         10  FILLER      PIC X(13) VALUE '440084   1573'.
187100         10  FILLER      PIC X(13) VALUE '440102   0820'.
187200         10  FILLER      PIC X(13) VALUE '440105   0051'.
187300         10  FILLER      PIC X(13) VALUE '440109   0703'.
187400         10  FILLER      PIC X(13) VALUE '440110   1068'.
187500         10  FILLER      PIC X(13) VALUE '440111   0642'.
187600         10  FILLER      PIC X(13) VALUE '440115   0510'.
187700         10  FILLER      PIC X(13) VALUE '440130   1254'.
187800         10  FILLER      PIC X(13) VALUE '440131   0701'.
187900         10  FILLER      PIC X(13) VALUE '440137   1586'.
188000         10  FILLER      PIC X(13) VALUE '440141   0541'.
188100         10  FILLER      PIC X(13) VALUE '440148   0858'.
188200         10  FILLER      PIC X(13) VALUE '440153   0950'.
188300         10  FILLER      PIC X(13) VALUE '440159   0891'.
188400         10  FILLER      PIC X(13) VALUE '440168   0395'.
188500         10  FILLER      PIC X(13) VALUE '440174   0756'.
188600         10  FILLER      PIC X(13) VALUE '440180   0945'.
188700         10  FILLER      PIC X(13) VALUE '440181   0352'.
188800         10  FILLER      PIC X(13) VALUE '440182   0683'.
188900         10  FILLER      PIC X(13) VALUE '440184   0746'.
189000         10  FILLER      PIC X(13) VALUE '440186   0948'.
189100         10  FILLER      PIC X(13) VALUE '440192   0780'.
189200         10  FILLER      PIC X(13) VALUE '440200   0399'.
189300         10  FILLER      PIC X(13) VALUE '440218   0494'.
189400         10  FILLER      PIC X(13) VALUE '440225   0011'.
189500         10  FILLER      PIC X(13) VALUE '440227   1450'.
189600         10  FILLER      PIC X(13) VALUE '450005   0829'.
189700         10  FILLER      PIC X(13) VALUE '450008   0486'.
189800         10  FILLER      PIC X(13) VALUE '450018   1362'.
189900         10  FILLER      PIC X(13) VALUE '450032   1457'.
190000         10  FILLER      PIC X(13) VALUE '450052   0540'.
190100         10  FILLER      PIC X(13) VALUE '450055   0749'.
190200         10  FILLER      PIC X(13) VALUE '450073   0516'.
190300         10  FILLER      PIC X(13) VALUE '450078   0455'.
190400         10  FILLER      PIC X(13) VALUE '450080   1469'.
190500         10  FILLER      PIC X(13) VALUE '450082   0832'.
190600         10  FILLER      PIC X(13) VALUE '450085   0540'.
190700         10  FILLER      PIC X(13) VALUE '450090   1093'.
190800         10  FILLER      PIC X(13) VALUE '450099   1045'.
190900         10  FILLER      PIC X(13) VALUE '450108   0625'.
191000         10  FILLER      PIC X(13) VALUE '450123   0626'.
191100         10  FILLER      PIC X(13) VALUE '450143   0507'.
191200         10  FILLER      PIC X(13) VALUE '450144   0282'.
191300         10  FILLER      PIC X(13) VALUE '450154   1119'.
191400         10  FILLER      PIC X(13) VALUE '450155   0234'.
191500         10  FILLER      PIC X(13) VALUE '450162   0674'.
191600         10  FILLER      PIC X(13) VALUE '450165   1139'.
191700         10  FILLER      PIC X(13) VALUE '450177   0954'.
191800         10  FILLER      PIC X(13) VALUE '450178   0391'.
191900         10  FILLER      PIC X(13) VALUE '450187   0746'.
192000         10  FILLER      PIC X(13) VALUE '450188   1109'.
192100         10  FILLER      PIC X(13) VALUE '450191   0084'.
192200         10  FILLER      PIC X(13) VALUE '450192   0974'.
192300         10  FILLER      PIC X(13) VALUE '450194   0991'.
192400         10  FILLER      PIC X(13) VALUE '450210   0656'.
192500         10  FILLER      PIC X(13) VALUE '450214   1163'.
192600         10  FILLER      PIC X(13) VALUE '450219   0602'.
192700         10  FILLER      PIC X(13) VALUE '450221   0472'.
192800         10  FILLER      PIC X(13) VALUE '450224   0502'.
192900         10  FILLER      PIC X(13) VALUE '450234   0862'.
193000         10  FILLER      PIC X(13) VALUE '450235   0550'.
193100         10  FILLER      PIC X(13) VALUE '450236   1354'.
193200         10  FILLER      PIC X(13) VALUE '450239   0502'.
193300         10  FILLER      PIC X(13) VALUE '450241   0262'.
193400         10  FILLER      PIC X(13) VALUE '450243   0190'.
193500         10  FILLER      PIC X(13) VALUE '450253   0428'.
193600         10  FILLER      PIC X(13) VALUE '450270   0577'.
193700         10  FILLER      PIC X(13) VALUE '450283   0509'.
193800         10  FILLER      PIC X(13) VALUE '450292   1320'.
193900         10  FILLER      PIC X(13) VALUE '450293   0259'.
194000         10  FILLER      PIC X(13) VALUE '450296   1110'.
194100         10  FILLER      PIC X(13) VALUE '450306   0172'.
194200         10  FILLER      PIC X(13) VALUE '450315   0039'.
194300         10  FILLER      PIC X(13) VALUE '450347   1426'.
194400         10  FILLER      PIC X(13) VALUE '450348   0448'.
194500         10  FILLER      PIC X(13) VALUE '450351   1194'.
194600         10  FILLER      PIC X(13) VALUE '450369   0549'.
194700         10  FILLER      PIC X(13) VALUE '450370   0573'.
194800         10  FILLER      PIC X(13) VALUE '450372   1513'.
194900         10  FILLER      PIC X(13) VALUE '450373   0326'.
195000         10  FILLER      PIC X(13) VALUE '450379   0829'.
195100         10  FILLER      PIC X(13) VALUE '450395   1439'.
195200         10  FILLER      PIC X(13) VALUE '450399   0500'.
195300         10  FILLER      PIC X(13) VALUE '450400   1056'.
195400         10  FILLER      PIC X(13) VALUE '450411   0747'.
195500         10  FILLER      PIC X(13) VALUE '450419   0816'.
195600         10  FILLER      PIC X(13) VALUE '450422   0007'.
195700         10  FILLER      PIC X(13) VALUE '450438   0607'.
195800         10  FILLER      PIC X(13) VALUE '450446   0474'.
195900         10  FILLER      PIC X(13) VALUE '450451   0453'.
196000         10  FILLER      PIC X(13) VALUE '450460   0517'.
196100         10  FILLER      PIC X(13) VALUE '450465   1116'.
196200         10  FILLER      PIC X(13) VALUE '450475   0946'.
196300         10  FILLER      PIC X(13) VALUE '450488   0036'.
196400         10  FILLER      PIC X(13) VALUE '450489   0236'.
196500         10  FILLER      PIC X(13) VALUE '450497   0589'.
196600         10  FILLER      PIC X(13) VALUE '450498   0373'.
196700         10  FILLER      PIC X(13) VALUE '450539   0661'.
196800         10  FILLER      PIC X(13) VALUE '450547   0729'.
196900         10  FILLER      PIC X(13) VALUE '450565   0903'.
197000         10  FILLER      PIC X(13) VALUE '450573   0779'.
197100         10  FILLER      PIC X(13) VALUE '450578   0095'.
197200         10  FILLER      PIC X(13) VALUE '450580   1180'.
197300         10  FILLER      PIC X(13) VALUE '450584   0386'.
197400         10  FILLER      PIC X(13) VALUE '450586   0420'.
197500         10  FILLER      PIC X(13) VALUE '450591   0811'.
197600         10  FILLER      PIC X(13) VALUE '450596   1124'.
197700         10  FILLER      PIC X(13) VALUE '450597   1160'.
197800         10  FILLER      PIC X(13) VALUE '450605   0411'.
197900         10  FILLER      PIC X(13) VALUE '450615   0964'.
198000         10  FILLER      PIC X(13) VALUE '450620   0257'.
198100         10  FILLER      PIC X(13) VALUE '450641   0453'.
198200         10  FILLER      PIC X(13) VALUE '450653   1238'.
198300         10  FILLER      PIC X(13) VALUE '450654   0900'.
198400         10  FILLER      PIC X(13) VALUE '450658   0520'.
198500         10  FILLER      PIC X(13) VALUE '450661   1388'.
198600         10  FILLER      PIC X(13) VALUE '450674   0199'.
198700         10  FILLER      PIC X(13) VALUE '450683   0911'.
198800         10  FILLER      PIC X(13) VALUE '450690   1511'.
198900         10  FILLER      PIC X(13) VALUE '450694   0474'.
199000         10  FILLER      PIC X(13) VALUE '450698   0358'.
199100         10  FILLER      PIC X(13) VALUE '450730   1409'.
199200         10  FILLER      PIC X(13) VALUE '450746   0119'.
199300         10  FILLER      PIC X(13) VALUE '450749   0302'.
199400         10  FILLER      PIC X(13) VALUE '450754   0973'.
199500         10  FILLER      PIC X(13) VALUE '450755   0408'.
199600         10  FILLER      PIC X(13) VALUE '450770   0602'.
199700         10  FILLER      PIC X(13) VALUE '450774   0147'.
199800         10  FILLER      PIC X(13) VALUE '450780   0141'.
199900         10  FILLER      PIC X(13) VALUE '450795   0155'.
200000         10  FILLER      PIC X(13) VALUE '450796   0057'.
200100         10  FILLER      PIC X(13) VALUE '450797   0007'.
200200         10  FILLER      PIC X(13) VALUE '450803   1298'.
200300         10  FILLER      PIC X(13) VALUE '450804   1018'.
200400         10  FILLER      PIC X(13) VALUE '450808   0181'.
200500         10  FILLER      PIC X(13) VALUE '450813   0408'.
200600         10  FILLER      PIC X(13) VALUE '450822   0925'.
200700         10  FILLER      PIC X(13) VALUE '450825   0310'.
200800         10  FILLER      PIC X(13) VALUE '450827   1008'.
200900         10  FILLER      PIC X(13) VALUE '450830   0017'.
201000         10  FILLER      PIC X(13) VALUE '450831   0078'.
201100         10  FILLER      PIC X(13) VALUE '450833   0988'.
201200         10  FILLER      PIC X(13) VALUE '450834   0198'.
201300         10  FILLER      PIC X(13) VALUE '450839   0468'.
201400         10  FILLER      PIC X(13) VALUE '450840   1000'.
201500         10  FILLER      PIC X(13) VALUE '450841   0364'.
201600         10  FILLER      PIC X(13) VALUE '450845   0416'.
201700         10  FILLER      PIC X(13) VALUE '450848   1156'.
201800         10  FILLER      PIC X(13) VALUE '450851   1215'.
201900         10  FILLER      PIC X(13) VALUE '450853   0473'.
202000         10  FILLER      PIC X(13) VALUE '450856   0308'.
202100         10  FILLER      PIC X(13) VALUE '450860   0101'.
202200         10  FILLER      PIC X(13) VALUE '450864   0748'.
202300         10  FILLER      PIC X(13) VALUE '450865   0144'.
202400         10  FILLER      PIC X(13) VALUE '450867   1599'.
202500         10  FILLER      PIC X(13) VALUE '450871   0358'.
202600         10  FILLER      PIC X(13) VALUE '450872   0582'.
202700         10  FILLER      PIC X(13) VALUE '450874   0052'.
202800         10  FILLER      PIC X(13) VALUE '450875   0521'.
202900         10  FILLER      PIC X(13) VALUE '450877   1103'.
203000         10  FILLER      PIC X(13) VALUE '450880   0320'.
203100         10  FILLER      PIC X(13) VALUE '450883   0051'.
203200         10  FILLER      PIC X(13) VALUE '450884   0516'.
203300         10  FILLER      PIC X(13) VALUE '450886   0037'.
203400         10  FILLER      PIC X(13) VALUE '450888   0192'.
203500         10  FILLER      PIC X(13) VALUE '450889   0025'.
203600         10  FILLER      PIC X(13) VALUE '450891   0089'.
203700         10  FILLER      PIC X(13) VALUE '450893   0143'.
203800         10  FILLER      PIC X(13) VALUE '450894   0129'.
203900         10  FILLER      PIC X(13) VALUE '460003   1451'.
204000         10  FILLER      PIC X(13) VALUE '460007   0888'.
204100         10  FILLER      PIC X(13) VALUE '460011   0664'.
204200         10  FILLER      PIC X(13) VALUE '460013   1060'.
204300         10  FILLER      PIC X(13) VALUE '460014   0577'.
204400         10  FILLER      PIC X(13) VALUE '460015   1373'.
204500         10  FILLER      PIC X(13) VALUE '460017   0247'.
204600         10  FILLER      PIC X(13) VALUE '460018   0038'.
204700         10  FILLER      PIC X(13) VALUE '460019   0306'.
204800         10  FILLER      PIC X(13) VALUE '460023   1310'.
204900         10  FILLER      PIC X(13) VALUE '460026   0316'.
205000         10  FILLER      PIC X(13) VALUE '460030   0364'.
205100         10  FILLER      PIC X(13) VALUE '460033   0113'.
205200         10  FILLER      PIC X(13) VALUE '460035   0187'.
205300         10  FILLER      PIC X(13) VALUE '460039   0135'.
205400         10  FILLER      PIC X(13) VALUE '460041   1256'.
205500         10  FILLER      PIC X(13) VALUE '460042   1561'.
205600         10  FILLER      PIC X(13) VALUE '460043   0005'.
205700         10  FILLER      PIC X(13) VALUE '460044   1358'.
205800         10  FILLER      PIC X(13) VALUE '460049   0671'.
205900         10  FILLER      PIC X(13) VALUE '460052   1138'.
206000         10  FILLER      PIC X(13) VALUE '460054   0268'.
206100         10  FILLER      PIC X(13) VALUE '460056   0012'.
206200         10  FILLER      PIC X(13) VALUE '470001   1397'.
206300         10  FILLER      PIC X(13) VALUE '470011   0833'.
206400         10  FILLER      PIC X(13) VALUE '470024   0925'.
206500         10  FILLER      PIC X(13) VALUE '480001   0917'.
206600         10  FILLER      PIC X(13) VALUE '480002   0893'.
206700         10  FILLER      PIC X(13) VALUE '490002   1463'.
206800         10  FILLER      PIC X(13) VALUE '490012   1596'.
206900         10  FILLER      PIC X(13) VALUE '490027   1168'.
207000         10  FILLER      PIC X(13) VALUE '490033   1006'.
207100         10  FILLER      PIC X(13) VALUE '490038   1251'.
207200         10  FILLER      PIC X(13) VALUE '490084   1068'.
207300         10  FILLER      PIC X(13) VALUE '490088   1006'.
207400         10  FILLER      PIC X(13) VALUE '490089   1185'.
207500         10  FILLER      PIC X(13) VALUE '490092   1319'.
207600         10  FILLER      PIC X(13) VALUE '490094   1126'.
207700         10  FILLER      PIC X(13) VALUE '490097   1409'.
207800         10  FILLER      PIC X(13) VALUE '490104   0019'.
207900         10  FILLER      PIC X(13) VALUE '490105   0021'.
208000         10  FILLER      PIC X(13) VALUE '490106   0002'.
208100         10  FILLER      PIC X(13) VALUE '490108   0362'.
208200         10  FILLER      PIC X(13) VALUE '490109   0093'.
208300         10  FILLER      PIC X(13) VALUE '490111   1193'.
208400         10  FILLER      PIC X(13) VALUE '490114   1349'.
208500         10  FILLER      PIC X(13) VALUE '490117   0572'.
208600         10  FILLER      PIC X(13) VALUE '490123   1219'.
208700         10  FILLER      PIC X(13) VALUE '490127   1126'.
208800         10  FILLER      PIC X(13) VALUE '490134   0016'.
208900         10  FILLER      PIC X(13) VALUE '490135   0192'.
209000         10  FILLER      PIC X(13) VALUE '490140   0495'.
209100         10  FILLER      PIC X(13) VALUE '500007   1316'.
209200         10  FILLER      PIC X(13) VALUE '500033   0938'.
209300         10  FILLER      PIC X(13) VALUE '500037   0409'.
209400         10  FILLER      PIC X(13) VALUE '500049   0720'.
209500         10  FILLER      PIC X(13) VALUE '500052   0003'.
209600         10  FILLER      PIC X(13) VALUE '500060   0811'.
209700         10  FILLER      PIC X(13) VALUE '500084   0619'.
209800         10  FILLER      PIC X(13) VALUE '500138   0120'.
209900         10  FILLER      PIC X(13) VALUE '500143   0110'.
210000         10  FILLER      PIC X(13) VALUE '500148   0290'.
210100         10  FILLER      PIC X(13) VALUE '500151   0876'.
210200         10  FILLER      PIC X(13) VALUE '510018   1139'.
210300         10  FILLER      PIC X(13) VALUE '510026   0750'.
210400         10  FILLER      PIC X(13) VALUE '510038   1496'.
210500         10  FILLER      PIC X(13) VALUE '510053   0521'.
210600         10  FILLER      PIC X(13) VALUE '510072   0742'.
210700         10  FILLER      PIC X(13) VALUE '510077   1193'.
210800         10  FILLER      PIC X(13) VALUE '510082   1018'.
210900         10  FILLER      PIC X(13) VALUE '510085   1430'.
211000         10  FILLER      PIC X(13) VALUE '510086   0328'.
211100         10  FILLER      PIC X(13) VALUE '520011   1347'.
211200         10  FILLER      PIC X(13) VALUE '520017   0965'.
211300         10  FILLER      PIC X(13) VALUE '520019   1531'.
211400         10  FILLER      PIC X(13) VALUE '520028   1406'.
211500         10  FILLER      PIC X(13) VALUE '520033   0951'.
211600         10  FILLER      PIC X(13) VALUE '520034   1319'.
211700         10  FILLER      PIC X(13) VALUE '520038   1213'.
211800         10  FILLER      PIC X(13) VALUE '520041   0900'.
211900         10  FILLER      PIC X(13) VALUE '520044   1276'.
212000         10  FILLER      PIC X(13) VALUE '520057   0915'.
212100         10  FILLER      PIC X(13) VALUE '520063   1408'.
212200         10  FILLER      PIC X(13) VALUE '520064   0743'.
212300         10  FILLER      PIC X(13) VALUE '520071   1366'.
212400         10  FILLER      PIC X(13) VALUE '520076   1072'.
212500         10  FILLER      PIC X(13) VALUE '520091   1322'.
212600         10  FILLER      PIC X(13) VALUE '520095   0931'.
212700         10  FILLER      PIC X(13) VALUE '520109   0900'.
212800         10  FILLER      PIC X(13) VALUE '520116   1289'.
212900         10  FILLER      PIC X(13) VALUE '520194   0037'.
213000         10  FILLER      PIC X(13) VALUE '520196   0161'.
213100         10  FILLER      PIC X(13) VALUE '520199   1017'.
213200         10  FILLER      PIC X(13) VALUE '520204   0186'.
213300         10  FILLER      PIC X(13) VALUE '520205   0010'.
213400         10  FILLER      PIC X(13) VALUE '530002   0813'.
213500         10  FILLER      PIC X(13) VALUE '530006   1062'.
213600         10  FILLER      PIC X(13) VALUE '530008   0611'.
213700         10  FILLER      PIC X(13) VALUE '530009   0449'.
213800         10  FILLER      PIC X(13) VALUE '530010   0642'.
213900         10  FILLER      PIC X(13) VALUE '530011   0565'.
214000         10  FILLER      PIC X(13) VALUE '530015   0657'.
214100         10  FILLER      PIC X(13) VALUE '530017   0029'.
214200         10  FILLER      PIC X(13) VALUE '530025   0735'.
214300         10  FILLER      PIC X(13) VALUE '530032   0291'.
214400         10  FILLER      PIC X(13) VALUE '530033   0300'.
214500         10  FILLER      PIC X(13) VALUE '640001   0277'.
214600         10  FILLER      PIC X(13) VALUE '650001   1587'.
214700         10  FILLER      PIC X(13) VALUE '660001   0356'.
214800         10  FILLER      PIC X(13) VALUE '670002   0858'.
214900         10  FILLER      PIC X(13) VALUE '670004   0934'.
215000         10  FILLER      PIC X(13) VALUE '670005   0022'.
215100         10  FILLER      PIC X(13) VALUE '670006   0461'.
215200         10  FILLER      PIC X(13) VALUE '670008   0215'.
215300         10  FILLER      PIC X(13) VALUE '670010   0004'.
215400         10  FILLER      PIC X(13) VALUE '670011   0421'.
215500         10  FILLER      PIC X(13) VALUE '670012   0798'.
215600         10  FILLER      PIC X(13) VALUE '670018   0126'.
215700         10  FILLER      PIC X(13) VALUE '670019   0557'.
215800         10  FILLER      PIC X(13) VALUE '670025   1531'.
215900         10  FILLER      PIC X(13) VALUE '670027   0037'.
216000         10  FILLER      PIC X(13) VALUE '670029   0099'.
216100         10  FILLER      PIC X(13) VALUE '670031   1485'.
216200         10  FILLER      PIC X(13) VALUE '670033   0006'.
216300         10  FILLER      PIC X(13) VALUE '670034   1582'.
216400         10  FILLER      PIC X(13) VALUE '670040   0003'.
216500         10  FILLER      PIC X(13) VALUE '670041   1568'.
216600         10  FILLER      PIC X(13) VALUE '670042   0002'.
216700         10  FILLER      PIC X(13) VALUE '670043   1069'.
216800         10  FILLER      PIC X(13) VALUE '670044   1120'.
216900         10  FILLER      PIC X(13) VALUE '670046   0198'.
217000         10  FILLER      PIC X(13) VALUE '670048   0097'.
217100         10  FILLER      PIC X(13) VALUE '670049   0142'.
217200         10  FILLER      PIC X(13) VALUE '670050   0186'.
217300         10  FILLER      PIC X(13) VALUE '670051   0025'.
217400         10  FILLER      PIC X(13) VALUE '670052   0502'.
217500         10  FILLER      PIC X(13) VALUE '670053   0877'.
217600         10  FILLER      PIC X(13) VALUE '670054   0101'.
217700         10  FILLER      PIC X(13) VALUE '670055   0987'.
217800         10  FILLER      PIC X(13) VALUE '         1600'.
217900         10  FILLER      PIC X(13) VALUE '         1600'.
218000         10  FILLER      PIC X(13) VALUE '         1600'.
218100      02  WK-LOWVOL-DATA2 REDEFINES LOWVOL-PROV-DISCHG-DATA.
218200         05  LOWVOL-TAB OCCURS 1335
218300                        ASCENDING KEY IS WK-LOWVOL-PROV
218400                        INDEXED BY LOWVOL-IDX.
218500           10  WK-LOWVOL-COUNT-ALL.
218600              15  WK-LOWVOL-PROV           PIC X(6).
218700              15  FILLER                   PIC XXX.
218800              15  WK-LOWVOL-PROV-DISCHG    PIC 9999.
218900
219000                                                                  20110000
219100*****YEARCHANGE 2010.0 ************************************       20110000
219200
219300
219400 01  MES-ADD-PROV                   PIC X(53) VALUE SPACES.
219500 01  MES-CHG-PROV                   PIC X(53) VALUE SPACES.
219600 01  MES-PPS-PROV                   PIC X(06).
219700 01  MES-PPS-STATE                  PIC X(02).
219800 01  MES-INTRO                      PIC X(53) VALUE SPACES.
219900 01  MES-TOT-PAY                    PIC 9(07)V9(02) VALUE 0.
220000 01  MES-SSRFBN.
220100     05 MES-SSRFBN-STATE PIC 99.
220200     05 FILLER           PIC XX.
220300     05 MES-SSRFBN-RATE  PIC 9(1)V9(5).
220400     05 FILLER           PIC XX.
220500     05 MES-SSRFBN-CODE2 PIC 99.
220600     05 FILLER           PIC XX.
220700     05 MES-SSRFBN-STNAM PIC X(20).
220800     05 MES-SSRFBN-REST  PIC X(22).
220900
221000                                                                  04620000
221100 01  MES-LOWVOL.
221200     05  MES-LOWVOL-PROV             PIC X(6).
221300     05  FILLER                      PIC XXX.
221400     05  MESWK-LOWVOL-PROV-DISCHG    PIC 9999.
221500
221600
221700 01  HOLD-AREA.                                                   04630000
221800     02  HOLD-PPS-COMPONENTS.                                     04640000
221900         05  H-OPER-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        04650000
222000         05  H-CAPI-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        04660000
222100                                                                  04670000
222200         05  H-OPER-HSP-PART              PIC 9(06)V9(09).        04680000
222300         05  H-CAPI-HSP-PART              PIC 9(06)V9(09).        04690000
222400                                                                  04700000
222500         05  H-OPER-FSP-PART              PIC 9(06)V9(09).        04710000
222600         05  H-CAPI-FSP-PART              PIC 9(06)V9(09).        04720000
222700         05  H-CAPI2-B-FSP-PART           PIC 9(06)V9(09).        04730000
222800                                                                  04740000
222900         05  H-OPER-OUTLIER-PART          PIC 9(07)V9(09).        04750000
223000         05  H-CAPI-OUTLIER-PART          PIC 9(07)V9(09).        04760000
223100         05  H-CAPI2-B-OUTLIER-PART       PIC 9(07)V9(09).        04770000
223200                                                                  04780000
223300         05  H-OPER-OUTDAY-PART           PIC 9(07)V9(09).        04790000
223400         05  H-CAPI-OUTDAY-PART           PIC 9(07)V9(09).        04800000
223500                                                                  04810000
223600         05  H-OPER-OUTCST-PART           PIC 9(07)V9(09).        04820000
223700         05  H-CAPI-OUTCST-PART           PIC 9(07)V9(09).        04830000
223800                                                                  04840000
223900         05  H-OPER-CSTCHG-RATIO          PIC 9(01)V9(03).        04850000
224000         05  H-CAPI-CSTCHG-RATIO          PIC 9(01)V9(03).        04860000
224100                                                                  04870000
224200         05  H-OPER-IME-TEACH             PIC 9(06)V9(09).        04880000
224300         05  H-CAPI-PAYCDE-PCT1           PIC 9(01)V9(02).        04890000
224400         05  H-CAPI-PAYCDE-PCT2           PIC 9(01)V9(02).        04900000
224500         05  H-CAPI-COST-OUTLIER          PIC 9(07)V9(09).        04910000
224600         05  H-CAPI-BILL-COSTS            PIC 9(07)V9(09).        04920000
224700         05  H-CAPI-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        04930000
224800         05  H-CAPI-COLA                  PIC 9(01)V9(03).        04940000
224900         05  H-CAPI-SCH                   PIC 9(05)V9(02).        04950000
225000         05  H-CAPI-BUD-NEUTRALITY        PIC 9(01)V9(04).        04960000
225100         05  H-CAPI-OLD-HARMLESS          PIC 9(09)V9(02).        04970000
225200         05  H-CAPI-FED-RATE              PIC 9(05)V9(04).        04980000
225300         05  H-CAPI-FULL-PROS             PIC 9(05)V9(04).        04990000
225400         05  H-CAPI-LARG-URBAN            PIC 9(01)V9(02).        05000000
225500         05  H-CAPI-GAF                   PIC 9(05)V9(04).        05010000
225600         05  H-PR-CAPI-GAF                PIC 9(05)V9(04).        05020000
225700         05  H-BLEND-GAF                  PIC 9(05)V9(04).        05030000
225800         05  H-WAGE-INDEX                 PIC 9(02)V9(04).        05040000
225900         05  H-COV-DAYS                   PIC 9(3).               05050000
226000         05  H-PERDIEM-DAYS               PIC 9(3).               05060000
226100         05  H-REG-DAYS                   PIC 9(3).               05070000
226200         05  H-LTR-DAYS                   PIC 9(3).               05080000
226300         05  H-DSCHG-FRCTN                PIC 9(3)V9999.          05090000
226400         05  H-DRG-WT-FRCTN               PIC 9(2)V9999.          05100000
226500         05  H-ALOS                       PIC 9(02)V9(01).        05110000
226600         05  H-DAYS-CUTOFF                PIC 9(02)V9(01).        05120000
226700         05  H-DAYOUT-PCT                 PIC 9(01)V9(02).        05130000
226800         05  H-CSTOUT-PCT                 PIC 9(01)V9(02).        05140000
226900         05  H-CST-THRESH                 PIC 9(05)V9(02).        05150000
227000         05  H-PRE-CAPI-THRESH            PIC 9(05)V9(02).        05160000
227100         05  H-BUDG-NUTR01                PIC 9(01)V9(06).        05170000
227200         05  H-BUDG-NUTR02                PIC 9(01)V9(06).        05180000
227300         05  H-BUDG-NUTR03                PIC 9(01)V9(06).        05190000
227400         05  H-BUDG-NUTR04                PIC 9(01)V9(06).        05200000
227500         05  H-BUDG-NUTR05                PIC 9(01)V9(06).        05210000
227600         05  H-BUDG-NUTR06                PIC 9(01)V9(06).        05220000
227700         05  H-BUDG-NUTR07                PIC 9(01)V9(06).        05230000
227800         05  H-BUDG-NUTR08                PIC 9(01)V9(06).        05240000
227900         05  H-BUDG-NUTR09                PIC 9(01)V9(06).        05240000
228000         05  H-BUDG-NUTR10                PIC 9(01)V9(06).        05240000
228100         05  H-BUDG-NUTR109               PIC 9(01)V9(06).        05240000
228200         05  H-BUDG-NUTR113               PIC 9(01)V9(06).        05240000
228300         05  H-CASE-MIX-ADJ               PIC 9(01)V9(04).        05250000
228400         05  H-UPDATE-01                  PIC 9(01)V9(04).        05250000
228500         05  H-UPDATE-02                  PIC 9(01)V9(04).        05260000
228600         05  H-UPDATE-03                  PIC 9(01)V9(04).        05270000
228700         05  H-UPDATE-04                  PIC 9(01)V9(04).        05280000
228800         05  H-UPDATE-05                  PIC 9(01)V9(04).        05290000
228900         05  H-UPDATE-06                  PIC 9(01)V9(04).        05300000
229000         05  H-UPDATE-07                  PIC 9(01)V9(04).        05310000
229100         05  H-UPDATE-08                  PIC 9(01)V9(04).        05320000
229200         05  H-UPDATE-09                  PIC 9(01)V9(04).        05320000
229300         05  H-UPDATE-10                  PIC 9(01)V9(04).        05320000
229400         05  H-UPDATE-109                 PIC 9(01)V9(04).        05320000
229500         05  H-UPDATE-113                 PIC 9(01)V9(04).        05320000
229600         05  H-ACCUM-TO-HSP               PIC 9(01)V9(04).        05330000
229700         05  H-HSP-UPDATE94               PIC 9(01)V9(04).        05340000
229800         05  H-HSP-UPDATE95               PIC 9(01)V9(04).        05350000
229900         05  H-HSP-UPDATE96               PIC 9(01)V9(04).        05360000
230000         05  H-HSP-UPDATE97               PIC 9(01)V9(04).        05370000
230100         05  H-HSP-UPDATE98               PIC 9(01)V9(04).        05380000
230200         05  H-HSP-UPDATE99               PIC 9(01)V9(04).        05390000
230300         05  H-HSP-UPDATE00               PIC 9(01)V9(04).        05400000
230400         05  H-HSP-UPDATE01               PIC 9(01)V9(04).        05410000
230500         05  H-PUERTO-RICO-RATE           PIC 9(04)V9(02).        05420000
230600         05  H-FEDERAL-RATE               PIC 9(04)V9(02).        05430000
230700         05  H-LABOR-PCT                  PIC 9(01)V9(04).        05440000
230800         05  H-NONLABOR-PCT               PIC 9(01)V9(04).        05450000
230900         05  H-PR-LABOR-PCT               PIC 9(01)V9(04).        05460000
231000         05  H-PR-NONLABOR-PCT            PIC 9(01)V9(04).        05470000
231100         05  H-HSP-RATE                   PIC 9(08)V9(09).        05480000
231200         05  H-FSP-RATE                   PIC 9(08)V9(09).        05490000
231300         05  H-OUTLIER-OFFSET-NAT         PIC 9(01)V9(06).        05500000
231400         05  H-OUTLIER-OFFSET-PR          PIC 9(01)V9(06).        05510000
231500         05  H-WK-OPER-DSH                PIC 9(01)V9(04).        05520000
231600         05  H-WK-CAPI-IME-TEACH          PIC 9(06)V9(09).        05530000
231700         05  H-OPER-PR-DOLLAR-THRESHOLD   PIC 9(07)V9(09).        05540000
231800         05  H-CAPI-PR-DOLLAR-THRESHOLD   PIC 9(07)V9(09).        05550000
231900         05  H-DSH-REDUCT-FACTOR          PIC 9(01)V9(04).        05560000
232000         05  H-WK-PASS-AMT-PLUS-MISC      PIC 9(06)V99.           05570000
232100         05  H-BASE-DRG-PAYMENT           PIC S9(07)V99.          05580000
232200         05  H-NEW-TECH-ADDON-NEURO       PIC S9(07)V99.          05590000
232300         05  H-NEW-TECH-ADDON-GRAFT       PIC S9(07)V99.          05600000
232400         05  H-NEW-TECH-ADDON-X-STOP      PIC S9(07)V99.          05610000
232500         05  H-NEW-TECH-ADDON-HRTIMP-STOP PIC S9(07)V99.          05610000
232600         05  H-NEW-TECH-ADDON-ISLET       PIC S9(07)V99.          05620000
232700         05  H-NEW-TECH-ADDON-SPIRAT-STOP PIC S9(07)V99.          05620000
232800         05  H-NEW-TECH-ADDON-AUTOLITT-STOP PIC S9(07)V99.        05620000
232900         05  H-TECH-ADDON-ISLET-CNTR      PIC S9(02).             05630000
233000         05  H-TECH-ADDON-ISLET-CNTR2     PIC S9(02).             05631000
233100                                                                  05632000
233200         05  H-LESSER-NEURO-1             PIC S9(07)V99.          05633000
233300         05  H-LESSER-NEURO-2             PIC S9(07)V99.          05634000
233400                                                                  05635000
233500         05  H-LESSER-GRAFT-1             PIC S9(07)V99.          05636000
233600         05  H-LESSER-GRAFT-2             PIC S9(07)V99.          05637000
233700                                                                  05638000
233800         05  H-LESSER-X-STOP-1            PIC S9(07)V99.          05639000
233900         05  H-LESSER-X-STOP-2            PIC S9(07)V99.          05640000
234000
234100         05  H-LESSER-HRTIMP-STOP-1       PIC S9(07)V99.
234200         05  H-LESSER-HRTIMP-STOP-2       PIC S9(07)V99.
234300                                                                  05660000
234400         05  H-LESSER-SPIRAT-STOP-1       PIC S9(07)V99.
234500         05  H-LESSER-SPIRAT-STOP-2       PIC S9(07)V99.
234600                                                                  05660000
234700         05  H-LESSER-AUTOLITT-STOP-1     PIC S9(07)V99.
234800         05  H-LESSER-AUTOLITT-STOP-2     PIC S9(07)V99.
234900                                                                  05660000
235000         05  H-CSTMED-NEURO               PIC S9(07)V99.          05670000
235100         05  H-CSTMED-GRAFT               PIC S9(07)V99.          05680000
235200         05  H-CSTMED-X-STOP              PIC S9(07)V99.          05690000
235300         05  H-CSTMED-HRTIMP-STOP         PIC S9(07)V99.          05690000
235400         05  H-CSTMED-SPIRAT-STOP         PIC S9(07)V99.          05690000
235500         05  H-CSTMED-AUTOLITT-STOP       PIC S9(07)V99.          05690000
235600                                                                  05700000
235700                                                                  05710000
235800     02  HOLD-ADDITIONAL-VARIABLES.                               05720000
235900         05  H-OPER-HSP-PCT               PIC 9(01)V9(02).        05730000
236000         05  H-OPER-FSP-PCT               PIC 9(01)V9(02).        05740000
236100         05  H-NAT-PCT                    PIC 9(01)V9(02).        05750000
236200         05  H-REG-PCT                    PIC 9(01)V9(02).        05760000
236300         05  H-FAC-SPEC-RATE              PIC 9(05)V9(02).        05770000
236400         05  H-UPDATE-FACTOR              PIC 9(01)V9(05).        05780000
236500         05  H-DRG-WT                     PIC 9(02)V9(04).        05790000
236600         05  H-NAT-LABOR                  PIC 9(05)V9(02).        05800000
236700         05  H-NAT-NONLABOR               PIC 9(05)V9(02).        05810000
236800         05  H-REG-LABOR                  PIC 9(05)V9(02).        05820000
236900         05  H-REG-NONLABOR               PIC 9(05)V9(02).        05830000
237000         05  H-OPER-COLA                  PIC 9(01)V9(03).        05840000
237100         05  H-INTERN-RATIO               PIC 9(01)V9(04).        05850000
237200         05  H-OPER-COST-OUTLIER          PIC 9(07)V9(09).        05860000
237300         05  H-OPER-BILL-COSTS            PIC 9(07)V9(09).        05870000
237400         05  H-OPER-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        05880000
237500                                                                  05890000
237600     02  HOLD-CAPITAL-VARIABLES.                                  05900000
237700         05  H-CAPI-TOTAL-PAY             PIC 9(07)V9(02).        05910000
237800         05  H-CAPI-HSP                   PIC 9(07)V9(02).        05920000
237900         05  H-CAPI-FSP                   PIC 9(07)V9(02).        05930000
238000         05  H-CAPI-OUTLIER               PIC 9(07)V9(02).        05940000
238100         05  H-CAPI-OLD-HARM              PIC 9(07)V9(02).        05950000
238200         05  H-CAPI-DSH-ADJ               PIC 9(07)V9(02).        05960000
238300         05  H-CAPI-IME-ADJ               PIC 9(07)V9(02).        05970000
238400         05  H-CAPI-EXCEPTIONS            PIC 9(07)V9(02).        05980000
238500                                                                  05990000
238600     02  HOLD-CAPITAL2-VARIABLES.                                 06000000
238700         05  H-CAPI2-PAY-CODE             PIC X(1).               06010000
238800         05  H-CAPI2-B-FSP                PIC 9(07)V9(02).        06020000
238900         05  H-CAPI2-B-OUTLIER            PIC 9(07)V9(02).        06030000
239000                                                                  06040000
239100     02  HOLD-OTHER-VARIABLES.                                    06050000
239200         05  H-NON-TEMP-RELIEF-PAYMENT    PIC 9(07)V9(02).        06060000
239300         05  H-NEW-TECH-PAY-ADD-ON        PIC 9(07)V9(02).        06070000
239400         05  H-LOW-VOL-PAYMENT            PIC 9(07)V9(02).
239500         05  H-HVBP-HRR-DATA.
239600             10  H-VAL-BASED-PURCH-PARTIPNT PIC X.
239700             10  H-VAL-BASED-PURCH-ADJUST     PIC 9V9(11).
239800             10  H-HOSP-READMISS-REDUCTN      PIC X.
239900             10  H-HOSP-HRR-ADJUSTMT          PIC 9V9(4).
240000         05  H-OPERATNG-DATA.
240100             10  H-MODEL1-BUNDLE-DISPRCNT    PIC V999.
240200             10  H-OPER-BASE-DRG-PAY         PIC 9(08)V99.
240300             10  H-OPER-HSP-AMT              PIC 9(08)V99.
240400                                                                  06090000
240500     02  HOLD-PC-OTH-VARIABLES.                                   06100000
240600         05  H-OPER-DSH                   PIC 9(01)V9(04).        06110000
240700         05  H-CAPI-DSH                   PIC 9(01)V9(04).        06120000
240800         05  H-CAPI-HSP-PCT               PIC 9(01)V9(02).        06130000
240900         05  H-CAPI-FSP-PCT               PIC 9(01)V9(04).        06140000
241000         05  H-ARITH-ALOS                 PIC 9(02)V9(01).        06150000
241100         05  H-PR-WAGE-INDEX              PIC 9(02)V9(04).        06160000
241200         05  H-TRANSFER-ADJ               PIC 9(01)V9(05).        06170000
241300         05  H-PC-HMO-FLAG                PIC X(01).              06180000
241400         05  H-PC-COT-FLAG                PIC X(01).              06190000
241500         05  H-FILLER                     PIC X(0998).
241600                                                                  06210000
241700 01  HLD-PPS-DATA.                                                06220000
241800         10  HLD-PPS-RTC                PIC 9(02).                06230000
241900         10  HLD-PPS-WAGE-INDX          PIC 9(02)V9(04).          06240000
242000         10  HLD-PPS-OUTLIER-DAYS       PIC 9(03).                06250000
242100         10  HLD-PPS-AVG-LOS            PIC 9(02)V9(01).          06260000
242200         10  HLD-PPS-DAYS-CUTOFF        PIC 9(02)V9(01).          06270000
242300         10  HLD-PPS-OPER-IME-ADJ       PIC 9(06)V9(02).          06280000
242400         10  HLD-PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).          06290000
242500         10  HLD-PPS-OPER-HSP-PART      PIC 9(06)V9(02).          06300000
242600         10  HLD-PPS-OPER-FSP-PART      PIC 9(06)V9(02).          06310000
242700         10  HLD-PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).          06320000
242800         10  HLD-PPS-REG-DAYS-USED      PIC 9(03).                06330000
242900         10  HLD-PPS-LTR-DAYS-USED      PIC 9(02).                06340000
243000         10  HLD-PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).          06350000
243100         10  HLD-PPS-CALC-VERS          PIC X(05).                06360000
243200                                                                  06370000
243300 LINKAGE SECTION.                                                 06380000
243400***************************************************************   06390000
243500*                 * * * * * * * * *                           *   06400000
243600*    REVIEW CODES ARE USED TO DIRECT THE PPCAL  SUBROUTINE    *   06410000
243700*    IN HOW TO PAY THE BILL.                                  *   06420000
243800*                         *****                               *   06430000
243900*    COMMENTS  ** CLAIMS RECEIVED WITH CONDITION CODE 66      *   06440000
244000*                 SHOULD BE PROCESSED UNDER REVIEW CODE 06,   *   06450000
244100*                 07 OR 11 AS APPROPRIATE TO EXCLUDE ANY      *   06460000
244200*                 OUTLIER COMPUTATION.                        *   06470000
244300*                         *****                               *   06480000
244400*         REVIEW-CODE:                                        *   06490000
244500*            00 = PAY-WITH-OUTLIER.                           *   06500000
244600*                 WILL CALCULATE THE STANDARD PAYMENT.        *   06510000
244700*                 WILL ALSO ATTEMPT TO PAY ONLY COST          *   06520000
244800*                 OUTLIERS, DAY OUTLIERS EXPIRED 10/01/97     *   06530000
244900*            03 = PAY-PERDIEM-DAYS.                           *   06540000
245000*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06550000
245100*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   06560000
245200*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06570000
245300*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   06580000
245400*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06590000
245500*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   06600000
245600*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   06610000
245700*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   06620000
245800*                 BILL EXCEED THE COST THRESHOLD.             *   06630000
245900*            06 = PAY-XFER-NO-COST                            *   06640000
246000*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06650000
246100*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   06660000
246200*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06670000
246300*                 FOR THE DRG.  IF COVERED DAYS EQUAL OR      *   06680000
246400*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06690000
246500*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   06700000
246600*                 CALCULATE ANY COST OUTLIER PORTION          *   06710000
246700*                 OF THE PAYMENT.                             *   06720000
246800*            07 = PAY-WITHOUT-COST.                           *   06730000
246900*                 WILL CALCULATE THE STANDARD PAYMENT         *   06740000
247000*                 WITHOUT COST PORTION.                       *   06750000
247100*            09 = PAY-XFER-SPEC-DRG - POST-ACUTE TRANSFERS    *   06760000
247200*                 50-50> 28  29  30  40  41  42  219              06770000
247300*                        220 221 477 478 479 480 481              06780000
247400*                        482 492 493 494 500 501 502              06790000
247500*                        515 516 517 495 496 497                  06800000
247600* =======================================================         06801000
247700* THE 50/50 DRG'S DO NOT REPEAT WITH THE FULL PERDIEM DRG'S       06801000
247800* =======================================================         06801000
247900*                                                                 06801000
248000*                                                                 06801000
248100*     FULL PERDIEM >   3   4   25  26  27  28          31         06802000
248200*                      32  33              54  55  56  57         06803000
248300*                      64  65  66  70  71  72  85  86  87         06804000
248400*                      91  92  93  100 101 163 164 165 166        06805000
248500*                      167 168 175 176 177 178 179 186 187        06806000
248600*                      188 190 191 192 193 194 195 196 197        06807000
248700*                      198 205 206 207 216 217 218                06808000
248800*                          228 229 230 233 234 235 236 239        06809000
248900*                      240 241 242 243 244 255 256 257 264        06809100
249000*                      280 281 282 288 289 290 291 292 293        06809200
249100*                      299 300 301 314 315 316 326 327 328        06809300
249200*                      329 330 331 332 333 334 335 336 337        06809400
249300*                      356 357 358 371 372 373 374 375 376        06809500
249400*                      377 378 379 380 381 382 388 389 390        06809600
249500*                      405 406 407 414 415 416 441 442 443        06809700
249600*                      459 460 463 464 465 466 467 468 469        06809800
249700*                      470 474 475 476                            06809900
249800*                          483 484 488 489                        06810000
249900*                                          510 511 512            06810100
250000*                              533 534 535 536 539 540 541        06810200
250100*                      542 543 544 545 546 547 551 552 557        06810300
250200*                      558 559 560 561 562 563 573 574 575        06810400
250300*                      579 580 581 592 593 594 602 603 616        06810500
250400*                      617 618 622 623 624 628 629 630 637        06810600
250500*                      638 639 640 641 643 644 645 653 654        06810700
250600*                      655 659 660 661 682 683 684 689 690        06810800
250700*                      698 699 700 840 841 842 853 854 855        06810900
250800*                      856 857 858 862 863 867 868 869 870        06811000
250900*                      871 872 884 896 897 907 908 909 917        06811100
251000*                      918 945 946 947 948 956 981 982 983        06811200
251100*                      987 988 989                                06811300
251200*                                                                 06811400
251300*                               POST-ACUTE TRANSFERS          *   06811500
251400*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06811600
251500*                 THE STANDARD DRG PAYMENT IF THE COVERED DAYS*   06811700
251600*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06811800
251700*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   06811900
251800*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06812000
251900*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   06813000
252000*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   06814000
252100*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   06815000
252200*                 BILL EXCEED THE COST THRESHOLD.             *   06816000
252300*            11 = PAY-XFER-SPEC-DRG-NO-COST                   *   06817000
252400*                 POST-ACUTE TRANSFERS                        *   06818000
252500*                 50-50> 28  29  30  40  41  42  219              06819000
252600*                        220 221 477 478 479 480 481              06820000
252700*                        482 492 493 494 500 501 502              06830000
252800*                        515 516 517 495 496 497                  06840000
252900*                                                                 06850000
253000* =======================================================         06801000
253100* THE 50/50 DRG'S DO NOT REPEAT WITH THE FULL PERDIEM DRG'S       06801000
253200* =======================================================         06801000
253300*                                                                 06860000
253400*     FULL PERDIEM >     3   4   25  26  27              31       06870000
253500*                        32  33              54  55  56  57       06880000
253600*                        64  65  66  70  71  72  85  86  87       06890000
253700*                        91  92  93  100 101 163 164 165 166      06900000
253800*                        167 168 175 176 177 178 179 186 187      06910000
253900*                        188 190 191 192 193 194 195 196 197      06920000
254000*                        198 205 206 207 216 217 218              06930000
254100*                            228 229 230 233 234 235 236 239      06940000
254200*                        240 241 242 243 244 255 256 257 264      06950000
254300*                        280 281 282 288 289 290 291 292 293      06960000
254400*                        299 300 301 314 315 316 326 327 328      06970000
254500*                        329 330 331 332 333 334 335 336 337      06980000
254600*                        356 357 358 371 372 373 374 375 376      06990000
254700*                        377 378 379 380 381 382 388 389 390      07000000
254800*                        405 406 407 414 415 416 441 442 443      07010000
254900*                        459 460 463 464 465 466 467 468 469      07020000
255000*                        470 474 475 476                          07030000
255100*                            483 484 488 489                      07040000
255200*                                            510 511 512          07050000
255300*                                533 534 535 536 539 540 541      07060000
255400*                        542 543 544 545 546 547 551 552 557      07070000
255500*                        558 559 560 561 562 563 573 574 575      07080000
255600*                        579 580 581 592 593 594 602 603 616      07090000
255700*                        617 618 622 623 624 628 629 630 637      07100000
255800*                        638 639 640 641 643 644 645 653 654      07110000
255900*                        655 659 660 661 682 683 684 689 690      07120000
256000*                        698 699 700 840 841 842 853 854 855      07130000
256100*                        856 857 858 862 863 867 868 869 870      07140000
256200*                        871 872 884 896 897 907 908 909 917      07150000
256300*                        918 945 946 947 948 956 981 982 983      07160000
256400*                        987 988 989                              07170000
256500*                                                                 07180000
256600*                                                                 07190000
256700*                               POST-ACUTE TRANSFERS          *   07200000
256800*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   07210000
256900*                 THE STANDARD DRG PAYMENT IF THE COVERED DAYS*   07220000
257000*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   07230000
257100*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   07240000
257200*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   07250000
257300*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   07260000
257400*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   07270000
257500*                 PAYMENT.                                    *   07280000
257600***************************************************************   07290000
257700                                                                  07300000
257800**************************************************************    07310000
257900*      MILLINNIUM COMPATIBLE                                 *    07320000
258000*      THIS IS THE BILL-RECORD THAT WILL BE PASSED BACK FROM *    07330000
258100*      THE PPCAL001 PROGRAM AND AFTER FOR PROCESSING         *    07340000
258200*      IN THE NEW FORMAT                                     *    07350000
258300**************************************************************    07360000
258400 01  BILL-NEW-DATA.                                               07370000
258500         10  B-NPI10.                                             07380000
258600             15  B-NPI8             PIC X(08).                    07390000
258700             15  B-NPI-FILLER       PIC X(02).                    07400000
258800         10  B-PROVIDER-NO          PIC X(06).                    07410000
258900         10  B-REVIEW-CODE          PIC 9(02).                    07420000
259000             88  VALID-REVIEW-CODE    VALUE 00 03 06 07 09 11.    07430000
259100             88  PAY-WITH-OUTLIER     VALUE 00 07.                07440000
259200             88  PAY-PERDIEM-DAYS     VALUE 03.                   07450000
259300             88  PAY-XFER-NO-COST     VALUE 06.                   07460000
259400             88  PAY-WITHOUT-COST     VALUE 07.                   07470000
259500             88  PAY-XFER-SPEC-DRG    VALUE 09 11.                07480000
259600             88  PAY-XFER-SPEC-DRG-NO-COST VALUE 11.              07490000
259700         10  B-DRG                  PIC 9(03).                    07500000
259800             88  B-DRG-POSTACUTE-50-50                            07510000
259900                   VALUE 28  29  30  40  41  42  219              07520000
260000                         220 221 477 478 479 480 481              07530000
260100                         482 492 493 494 495 496 497
260200                         500 501 502 515 516 517.                 07550000
260300                                                                  07560000
260400             88  B-DRG-SPIRATN-DRG                                07510000
260500                   VALUE 163 164 165.                             07520000
260600                                                                  07560000
260700             88  B-DRG-SPIRATN-DRG11                              07510000
260800                   VALUE 199 200 201.                             07520000
260900                                                                  07560000
261000                                                                  07560000
261100             88  B-DRG-AUTOLITT-DRG                               07510000
261200                   VALUE 25 26 27.                                07520000
261300                                                                  07560000
261400* =======================================================         06801000
261500* THE 50/50 DRG'S DO NOT REPEAT WITH THE POSTACUTE  DRG'S         06801000
261600* =======================================================         06801000
261700*                                                                 06860000
261800             88  B-DRG-POSTACUTE-PERDIEM                          07570000
261900                   VALUE 3   4   25  26  27              31       07580000
262000                         32  33              54  55  56  57       07590000
262100                         64  65  66  70  71  72  85  86  87       07600000
262200                         91  92  93  100 101 163 164 165 166      07610000
262300                         167 168 175 176 177 178 179 186 187      07620000
262400                         188 190 191 192 193 194 195 196 197      07630000
262500                         198 205 206 207 216 217 218              07640000
262600                             228 229 230 233 234 235 236 239      07650000
262700                         240 241 242 243 244 255 256 257 264      07660000
262800                         280 281 282 288 289 290 291 292 293      07670000
262900                         299 300 301 314 315 316 326 327 328      07680000
263000                         329 330 331 332 333 334 335 336 337      07690000
263100                         356 357 358 371 372 373 374 375 376      07700000
263200                         377 378 379 380 381 382 388 389 390      07710000
263300                         405 406 407 414 415 416 441 442 443      07720000
263400                         459 460 463 464 465 466 467 468 469      07730000
263500                         470 474 475 476                          07740000
263600                             483 484 488 489                      07750000
263700                                             510 511 512          07760000
263800                                 533 534 535 536 539 540 541      07770000
263900                         542 543 544 545 546 547 551 552 557      07780000
264000                         558 559 560 561 562 563 573 574 575      07790000
264100                         579 580 581 592 593 594 602 603 616      07800000
264200                         617 618 622 623 624 628 629 630 637      07810000
264300                         638 639 640 641 643 644 645 653 654      07820000
264400                         655 659 660 661 682 683 684 689 690      07830000
264500                         698 699 700 840 841 842 853 854 855      07840000
264600                         856 857 858 862 863 867 868 869 870      07850000
264700                         871 872 884 896 897 907 908 909 917      07860000
264800                         918 945 946 947 948 956 981 982 983      07870000
264900                         987 988 989.                             07880000
265000                                                                  07890000
265100         10  B-LOS                  PIC 9(03).                    07900000
265200         10  B-COVERED-DAYS         PIC 9(03).                    07910000
265300         10  B-LTR-DAYS             PIC 9(02).                    07920000
265400         10  B-DISCHARGE-DATE.                                    07930000
265500             15  B-DISCHG-CC        PIC 9(02).                    07940000
265600             15  B-DISCHG-YY        PIC 9(02).                    07950000
265700             15  B-DISCHG-MM        PIC 9(02).                    07960000
265800             15  B-DISCHG-DD        PIC 9(02).                    07970000
265900         10  B-CHARGES-CLAIMED      PIC 9(07)V9(02).              07980000
266000         10  B-PRIN-PROC-CODE       PIC X(07).                    07990000
266100         10  B-OTHER-PROC-CODE1     PIC X(07).                    08000000
266200         10  B-OTHER-PROC-CODE2     PIC X(07).                    08010000
266300         10  B-OTHER-PROC-CODE3     PIC X(07).                    08020000
266400         10  B-OTHER-PROC-CODE4     PIC X(07).                    08030000
266500         10  B-OTHER-PROC-CODE5     PIC X(07).                    08040000
266600         10  B-OTHER-PROC-CODE6     PIC X(07).
266700         10  B-OTHER-PROC-CODE7     PIC X(07).
266800         10  B-OTHER-PROC-CODE8     PIC X(07).
266900         10  B-OTHER-PROC-CODE9     PIC X(07).
267000         10  B-OTHER-PROC-CODE10    PIC X(07).
267100         10  B-OTHER-PROC-CODE11    PIC X(07).
267200         10  B-OTHER-PROC-CODE12    PIC X(07).
267300         10  B-OTHER-PROC-CODE13    PIC X(07).
267400         10  B-OTHER-PROC-CODE14    PIC X(07).
267500         10  B-OTHER-PROC-CODE15    PIC X(07).
267600         10  B-OTHER-PROC-CODE16    PIC X(07).
267700         10  B-OTHER-PROC-CODE17    PIC X(07).
267800         10  B-OTHER-PROC-CODE18    PIC X(07).
267900         10  B-OTHER-PROC-CODE19    PIC X(07).
268000         10  B-OTHER-PROC-CODE20    PIC X(07).
268100         10  B-OTHER-PROC-CODE21    PIC X(07).
268200         10  B-OTHER-PROC-CODE22    PIC X(07).
268300         10  B-OTHER-PROC-CODE23    PIC X(07).
268400         10  B-OTHER-PROC-CODE24    PIC X(07).
268500         10  B-OTHER-DIAG-CODE1     PIC X(07).                    06012000
268600         10  B-OTHER-DIAG-CODE2     PIC X(07).                    06013000
268700         10  B-OTHER-DIAG-CODE3     PIC X(07).                    06014000
268800         10  B-OTHER-DIAG-CODE4     PIC X(07).                    06015000
268900         10  B-OTHER-DIAG-CODE5     PIC X(07).                    06016000
269000         10  B-OTHER-DIAG-CODE6     PIC X(07).                    06017000
269100         10  B-OTHER-DIAG-CODE7     PIC X(07).                    06018000
269200         10  B-OTHER-DIAG-CODE8     PIC X(07).                    06019000
269300         10  B-OTHER-DIAG-CODE9     PIC X(07).                    06019100
269400         10  B-OTHER-DIAG-CODE10    PIC X(07).                    06019200
269500         10  B-OTHER-DIAG-CODE11    PIC X(07).                    06019300
269600         10  B-OTHER-DIAG-CODE12    PIC X(07).                    06019400
269700         10  B-OTHER-DIAG-CODE13    PIC X(07).                    06019500
269800         10  B-OTHER-DIAG-CODE14    PIC X(07).                    06019600
269900         10  B-OTHER-DIAG-CODE15    PIC X(07).                    06019700
270000         10  B-OTHER-DIAG-CODE16    PIC X(07).                    06019800
270100         10  B-OTHER-DIAG-CODE17    PIC X(07).                    06019900
270200         10  B-OTHER-DIAG-CODE18    PIC X(07).                    06020000
270300         10  B-OTHER-DIAG-CODE19    PIC X(07).                    06020100
270400         10  B-OTHER-DIAG-CODE20    PIC X(07).                    06020200
270500         10  B-OTHER-DIAG-CODE21    PIC X(07).                    06020300
270600         10  B-OTHER-DIAG-CODE22    PIC X(07).                    06020400
270700         10  B-OTHER-DIAG-CODE23    PIC X(07).                    06020500
270800         10  B-OTHER-DIAG-CODE24    PIC X(07).                    06020600
270900         10  B-OTHER-DIAG-CODE25    PIC X(07).                    06020700
271000         10  B-DEMO-DATA.
271100             15  B-DEMO-CODE1           PIC X(02).
271200             15  B-DEMO-CODE2           PIC X(02).
271300             15  B-DEMO-CODE3           PIC X(02).
271400             15  B-DEMO-CODE4           PIC X(02).
271500         10  B-NDC-DATA.
271600             15  B-NDC-NUMBER           PIC X(11).
271700         10  FILLER                     PIC X(73).
271800                                                                  06020800
271900                                                                  06020800
272000                                                                  08050000
272100***************************************************************   08060000
272200*    THIS DATA IS CALCULATED BY THIS PPCAL  SUBROUTINE        *   08070000
272300*    AND PASSED BACK TO THE CALLING PROGRAM                   *   08080000
272400*            RETURN CODE VALUES (PPS-RTC)                     *   08090000
272500*                                                             *   08100000
272600*            PPS-RTC 00-49 = HOW THE BILL WAS PAID            *   08110000
272700*                                                             *   08120000
272800*      PPS-RTC 30,33,40,42,44  = OUTLIER RECONCILIATION       *   08130000
272900*                                                             *   08140000
273000*           30,00 = PAID NORMAL DRG PAYMENT                   *   08150000
273100*                                                             *   08160000
273200*              01 = PAID AS A DAY-OUTLIER.                    *   08170000
273300*                   NOTE:                                     *   08180000
273400*                     DAY-OUTLIER NO LONGER BEING PAID        *   08190000
273500*                         AS OF 10/01/97                      *   08200000
273600*                                                             *   08210000
273700*              02 = PAID AS A COST-OUTLIER.                   *   08220000
273800*                                                             *   08230000
273900*           33,03 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08240000
274000*                   AND INCLUDING THE FULL DRG.               *   08250000
274100*              05 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08260000
274200*                   AND INCLUDING THE FULL DRG WHICH ALSO     *   08270000
274300*                   QUALIFIED FOR A COST OUTLIER PAYMENT.     *   08280000
274400*              06 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08290000
274500*                   AND INCLUDING THE FULL DRG. PROVIDER      *   08300000
274600*                   REFUSED COST OUTLIER.                     *   08310000
274700*           40,10 = POST-ACUTE TRANSFER                       *   08320000
274800*                   DRG = 28  29  30  40  41  42  219             08330000
274900*                         220 221 477 478 479 480 481             08340000
275000*                         482 492 493 494 500 501 502             08350000
275100*                         515 516 517                             08360000
275200*                                                                 08370000
275300* =======================================================         06801000
275400* THE 50/50 DRG'S DO NOT REPEAT WITH THE POSTACUTE  DRG'S         06801000
275500* =======================================================         06801000
275600*                                                                 06860000
275700*           42,12 = POST-ACAUTE TRANSFER WITH SPECIFIC DRGS   *   08380000
275800*                       THE FOLLOWING DRG'S                   *   08390000
275900*                   DRG = 3   4   25  26  27              31      08400000
276000*                         32  33              54  55  56  57      08410000
276100*                         64  65  66  70  71  72  85  86  87      08420000
276200*                         91  92  93  100 101 163 164 165 166     08430000
276300*                         167 168 175 176 177 178 179 186 187     08440000
276400*                         188 190 191 192 193 194 195 196 197     08450000
276500*                         198 205 206 207 216 217 218             08460000
276600*                             228 229 230 233 234 235 236 239     08470000
276700*                         240 241 242 243 244 255 256 257 264     08480000
276800*                         280 281 282 288 289 290 291 292 293     08490000
276900*                         299 300 301 314 315 316 326 327 328     08500000
277000*                         329 330 331 332 333 334 335 336 337     08510000
277100*                         356 357 358 371 372 373 374 375 376     08520000
277200*                         377 378 379 380 381 382 388 389 390     08530000
277300*                         405 406 407 414 415 416 441 442 443     08540000
277400*                         459 460 463 464 465 466 467 468 469     08550000
277500*                         470 474 475 476                         08560000
277600*                             483 484 488 489             495     08570000
277700*                         496 497             510 511 512         08580000
277800*                                 533 534 535 536 539 540 541     08590000
277900*                         542 543 544 545 546 547 551 552 557     08600000
278000*                         558 559 560 561 562 563 573 574 575     08610000
278100*                         579 580 581 592 593 594 602 603 616     08620000
278200*                         617 618 622 623 624 628 629 630 637     08630000
278300*                         638 639 640 641 643 644 645 653 654     08640000
278400*                         655 659 660 661 682 683 684 689 690     08650000
278500*                         698 699 700 840 841 842 853 854 855     08660000
278600*                         856 857 858 862 863 867 868 869 870     08670000
278700*                         871 872 884 896 897 907 908 909 917     08680000
278800*                         918 945 946 947 948 956 981 982 983     08690000
278900*                         987 988 989                             08700000
279000*                                                                 08710000
279100*           44,14 = PAID NORMAL DRG PAYMENT WITH              *   08720000
279200*                    PERDIEM DAYS = OR > GM  ALOS             *   08730000
279300*              16 = PAID AS A COST-OUTLIER WITH               *   08740000
279400*                    PERDIEM DAYS = OR > GM  ALOS             *   08750000
279500*                                                             *   08760000
279600*            PPS-RTC 50-99 = WHY THE BILL WAS NOT PAID        *   08770000
279700*              51 = NO PROVIDER SPECIFIC INFO FOUND           *   08780000
279800*              52 = INVALID CBSA# IN PROVIDER FILE            *   08790000
279900*                   OR INVALID WAGE INDEX                     *   08800000
280000*              53 = WAIVER STATE - NOT CALCULATED BY PPS      *   08810000
280100*              54 = INVALID DRG                               *   08820000
280200*              55 = DISCHARGE DATE < PROVIDER EFF START DATE  *   08830000
280300*                                      OR                     *   08840000
280400*                   DISCHARGE DATE < CBSA EFF START DATE      *   08850000
280500*                   FOR PPS                                   *   08860000
280600*                                      OR                     *   08870000
280700*                   PROVIDER HAS BEEN TERMINATED ON OR BEFORE *   08880000
280800*                   DISCHARGE DATE                            *   08890000
280900*              56 = INVALID LENGTH OF STAY                    *   08900000
281000*              57 = REVIEW CODE INVALID (NOT 00 03 06 07 09   *   08910000
281100*                                        NOT 11)              *   08920000
281200*              58 = TOTAL CHARGES NOT NUMERIC                 *   08930000
281300*              61 = LIFETIME RESERVE DAYS NOT NUMERIC         *   08940000
281400*                   OR BILL-LTR-DAYS > 60                     *   08950000
281500*              62 = INVALID NUMBER OF COVERED DAYS            *   08960000
281600*              65 = PAY-CODE NOT = A,B OR C ON PROVIDER       *   08970000
281700*                   SPECIFIC FILE FOR CAPITAL                 *   08980000
281800*              67 = COST OUTLIER WITH LOS > COVERED DAYS      *   08990000
281900*                   OR COST OUTLIER THRESHOLD CALUCULATION    *   09000000
282000*              98 = CANNOT PROCESS BILL OLDER THAN 5 YEARS    *   09010000
282100***************************************************************   09020000
282200 01  PPS-DATA.                                                    09030000
282300         10  PPS-RTC                PIC 9(02).                    09040000
282400         10  PPS-WAGE-INDX          PIC 9(02)V9(04).              09050000
282500         10  PPS-OUTLIER-DAYS       PIC 9(03).                    09060000
282600         10  PPS-AVG-LOS            PIC 9(02)V9(01).              09070000
282700         10  PPS-DAYS-CUTOFF        PIC 9(02)V9(01).              09080000
282800         10  PPS-OPER-IME-ADJ       PIC 9(06)V9(02).              09090000
282900         10  PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).              09100000
283000         10  PPS-OPER-HSP-PART      PIC 9(06)V9(02).              09110000
283100         10  PPS-OPER-FSP-PART      PIC 9(06)V9(02).              09120000
283200         10  PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).              09130000
283300         10  PPS-REG-DAYS-USED      PIC 9(03).                    09140000
283400         10  PPS-LTR-DAYS-USED      PIC 9(02).                    09150000
283500         10  PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).              09160000
283600         10  PPS-CALC-VERS          PIC X(05).                    09170000
283700                                                                  09180000
283800******************************************************************09190000
283900*            THESE ARE THE VERSIONS OF THE PPCAL                  09200000
284000*           PROGRAMS THAT WILL BE PASSED BACK----                 09210000
284100*          ASSOCIATED WITH THE BILL BEING PROCESSED               09220000
284200******************************************************************09230000
284300 01  PRICER-OPT-VERS-SW.                                          09240000
284400     02  PRICER-OPTION-SW          PIC X(01).                     09250000
284500         88  ALL-TABLES-PASSED          VALUE 'A'.                09260000
284600         88  PROV-RECORD-PASSED         VALUE 'P'.                09270000
284700         88  ADDITIONAL-VARIABLES       VALUE 'M'.                09280000
284800         88  PC-PRICER                  VALUE 'C'.                09290000
284900     02  PPS-VERSIONS.                                            09300000
285000         10  PPDRV-VERSION         PIC X(05).                     09310000
285100                                                                  09320000
285200******************************************************************09330000
285300*        THIS IS THE VARIABLES THAT WILL BE PASSED BACK           09340000
285400*          ASSOCIATED WITH THE BILL BEING PROCESSED               09350000
285500******************************************************************09360000
285600 01  PPS-ADDITIONAL-VARIABLES.                                    09370000
285700     05  PPS-HSP-PCT                PIC 9(01)V9(02).              09380000
285800     05  PPS-FSP-PCT                PIC 9(01)V9(02).              09390000
285900     05  PPS-NAT-PCT                PIC 9(01)V9(02).              09400000
286000     05  PPS-REG-PCT                PIC 9(01)V9(02).              09410000
286100     05  PPS-FAC-SPEC-RATE          PIC 9(05)V9(02).              09420000
286200     05  PPS-UPDATE-FACTOR          PIC 9(01)V9(05).              09430000
286300     05  PPS-DRG-WT                 PIC 9(02)V9(04).              09440000
286400     05  PPS-NAT-LABOR              PIC 9(05)V9(02).              09450000
286500     05  PPS-NAT-NLABOR             PIC 9(05)V9(02).              09460000
286600     05  PPS-REG-LABOR              PIC 9(05)V9(02).              09470000
286700     05  PPS-REG-NLABOR             PIC 9(05)V9(02).              09480000
286800     05  PPS-OPER-COLA              PIC 9(01)V9(03).              09490000
286900     05  PPS-INTERN-RATIO           PIC 9(01)V9(04).              09500000
287000     05  PPS-COST-OUTLIER           PIC 9(07)V9(09).              09510000
287100     05  PPS-BILL-COSTS             PIC 9(07)V9(09).              09520000
287200     05  PPS-DOLLAR-THRESHOLD       PIC 9(07)V9(09).              09530000
287300     05  PPS-DSCHG-FRCTN            PIC 9(1)V9999.                09540000
287400     05  PPS-DRG-WT-FRCTN           PIC 9(2)V9999.                09550000
287500     05  PPS-CAPITAL-VARIABLES.                                   09560000
287600         10  PPS-CAPI-TOTAL-PAY           PIC 9(07)V9(02).        09570000
287700         10  PPS-CAPI-HSP                 PIC 9(07)V9(02).        09580000
287800         10  PPS-CAPI-FSP                 PIC 9(07)V9(02).        09590000
287900         10  PPS-CAPI-OUTLIER             PIC 9(07)V9(02).        09600000
288000         10  PPS-CAPI-OLD-HARM            PIC 9(07)V9(02).        09610000
288100         10  PPS-CAPI-DSH-ADJ             PIC 9(07)V9(02).        09620000
288200         10  PPS-CAPI-IME-ADJ             PIC 9(07)V9(02).        09630000
288300         10  PPS-CAPI-EXCEPTIONS          PIC 9(07)V9(02).        09640000
288400     05  PPS-CAPITAL2-VARIABLES.                                  09650000
288500         10  PPS-CAPI2-PAY-CODE             PIC X(1).             09660000
288600         10  PPS-CAPI2-B-FSP                PIC 9(07)V9(02).      09670000
288700         10  PPS-CAPI2-B-OUTLIER            PIC 9(07)V9(02).      09680000
288800                                                                  09690000
288900     05  PPS-OTHER-VARIABLES.                                     09700000
289000         10  PPS-NON-TEMP-RELIEF-PAYMENT    PIC 9(07)V9(02).      09710000
289100         10  PPS-NEW-TECH-PAY-ADD-ON        PIC 9(07)V9(02).      09720000
289200         10  PPS-LOW-VOL-PAYMENT            PIC 9(07)V9(02).
289300         10  PPS-HVBP-HRR-DATA.
289400             15  PPS-VAL-BASED-PURCH-PARTIPNT PIC X.
289500             15  PPS-VAL-BASED-PURCH-ADJUST   PIC 9V9(11).
289600             15  PPS-HOSP-READMISS-REDUCTN    PIC X.
289700             15  PPS-HOSP-HRR-ADJUSTMT        PIC 9V9(4).
289800         10  PPS-OPERATNG-DATA.
289900             15  PPS-MODEL1-BUNDLE-DISPRCNT  PIC V999.
290000             15  PPS-OPER-BASE-DRG-PAY       PIC 9(08)V99.
290100             15  PPS-OPER-HSP-AMT            PIC 9(08)V99.
290200                                                                  09740000
290300     05  PPS-PC-OTH-VARIABLES.                                    09750000
290400         10  PPS-OPER-DSH                   PIC 9(01)V9(04).      09760000
290500         10  PPS-CAPI-DSH                   PIC 9(01)V9(04).      09770000
290600         10  PPS-CAPI-HSP-PCT               PIC 9(01)V9(02).      09780000
290700         10  PPS-CAPI-FSP-PCT               PIC 9(01)V9(04).      09790000
290800         10  PPS-ARITH-ALOS                 PIC 9(02)V9(01).      09800000
290900         10  PPS-PR-WAGE-INDEX              PIC 9(02)V9(04).      09810000
291000         10  PPS-TRANSFER-ADJ               PIC 9(01)V9(05).      09820000
291100         10  PPS-PC-HMO-FLAG                PIC X(01).            09830000
291200         10  PPS-PC-COT-FLAG                PIC X(01).            09840000
291300         10  PPS-FILLER                     PIC X(0998).
291400                                                                  09860000
291500 01  PROV-NEW-HOLD.                                               09870000
291600     02  PROV-NEWREC-HOLD1.                                       09880000
291700         05  P-NEW-NPI10.                                         09890000
291800             10  P-NEW-NPI8             PIC X(08).                09900000
291900             10  P-NEW-NPI-FILLER       PIC X(02).                09910000
292000         05  P-NEW-PROVIDER-NO.                                   09920000
292100             88  P-NEW-DSH-ADJ-PROVIDERS                          09930000
292200                             VALUE '180049' '190044' '190144'     09940000
292300                                   '190191' '330047' '340085'     09950000
292400                                   '370016' '370149' '420043'.    09960000
292500             10  P-NEW-STATE            PIC 9(02).                09970000
292600             10  FILLER                 PIC X(04).                09980000
292700         05  P-NEW-DATE-DATA.                                     09990000
292800             10  P-NEW-EFF-DATE.                                  10000000
292900                 15  P-NEW-EFF-DT-CC    PIC 9(02).                10010000
293000                 15  P-NEW-EFF-DT-YY    PIC 9(02).                10020000
293100                 15  P-NEW-EFF-DT-MM    PIC 9(02).                10030000
293200                 15  P-NEW-EFF-DT-DD    PIC 9(02).                10040000
293300             10  P-NEW-FY-BEGIN-DATE.                             10050000
293400                 15  P-NEW-FY-BEG-DT-CC PIC 9(02).                10060000
293500                 15  P-NEW-FY-BEG-DT-YY PIC 9(02).                10070000
293600                 15  P-NEW-FY-BEG-DT-MM PIC 9(02).                10080000
293700                 15  P-NEW-FY-BEG-DT-DD PIC 9(02).                10090000
293800             10  P-NEW-REPORT-DATE.                               10100000
293900                 15  P-NEW-REPORT-DT-CC PIC 9(02).                10110000
294000                 15  P-NEW-REPORT-DT-YY PIC 9(02).                10120000
294100                 15  P-NEW-REPORT-DT-MM PIC 9(02).                10130000
294200                 15  P-NEW-REPORT-DT-DD PIC 9(02).                10140000
294300             10  P-NEW-TERMINATION-DATE.                          10150000
294400                 15  P-NEW-TERM-DT-CC   PIC 9(02).                10160000
294500                 15  P-NEW-TERM-DT-YY   PIC 9(02).                10170000
294600                 15  P-NEW-TERM-DT-MM   PIC 9(02).                10180000
294700                 15  P-NEW-TERM-DT-DD   PIC 9(02).                10190000
294800         05  P-NEW-WAIVER-CODE          PIC X(01).                10200000
294900             88  P-NEW-WAIVER-STATE       VALUE 'Y'.              10210000
295000         05  P-NEW-INTER-NO             PIC 9(05).                10220000
295100         05  P-NEW-PROVIDER-TYPE        PIC X(02).                10230000
295200             88  P-N-SOLE-COMMUNITY-PROV    VALUE '01' '11'.      10240000
295300             88  P-N-REFERRAL-CENTER        VALUE '07' '11'       10250000
295400                                                  '15' '17'       10260000
295500                                                  '22'.           10270000
295600             88  P-N-INDIAN-HEALTH-SERVICE  VALUE '08'.           10280000
295700             88  P-N-REDESIGNATED-RURAL-YR1 VALUE '09'.           10290000
295800             88  P-N-REDESIGNATED-RURAL-YR2 VALUE '10'.           10300000
295900             88  P-N-SOLE-COM-REF-CENT      VALUE '11'.           10310000
296000             88  P-N-MDH-REBASED-FY90       VALUE '14' '15'.      10320000
296100             88  P-N-MDH-RRC-REBASED-FY90   VALUE '15'.           10330000
296200             88  P-N-SCH-REBASED-FY90       VALUE '16' '17'.      10340000
296300             88  P-N-SCH-RRC-REBASED-FY90   VALUE '17'.           10350000
296400             88  P-N-MEDICAL-ASSIST-FACIL   VALUE '18'.           10360000
296500             88  P-N-EACH                   VALUE '21' '22'.      10370000
296600             88  P-N-EACH-REFERRAL-CENTER   VALUE '22'.           10380000
296700             88  P-N-NHCMQ-II-SNF           VALUE '32'.           10390000
296800             88  P-N-NHCMQ-III-SNF          VALUE '33'.           10400000
296900         05  P-NEW-CURRENT-CENSUS-DIV   PIC 9(01).                10410000
297000             88  P-N-NEW-ENGLAND            VALUE  1.             10420000
297100             88  P-N-MIDDLE-ATLANTIC        VALUE  2.             10430000
297200             88  P-N-SOUTH-ATLANTIC         VALUE  3.             10440000
297300             88  P-N-EAST-NORTH-CENTRAL     VALUE  4.             10450000
297400             88  P-N-EAST-SOUTH-CENTRAL     VALUE  5.             10460000
297500             88  P-N-WEST-NORTH-CENTRAL     VALUE  6.             10470000
297600             88  P-N-WEST-SOUTH-CENTRAL     VALUE  7.             10480000
297700             88  P-N-MOUNTAIN               VALUE  8.             10490000
297800             88  P-N-PACIFIC                VALUE  9.             10500000
297900         05  P-NEW-CURRENT-DIV   REDEFINES                        10510000
298000                    P-NEW-CURRENT-CENSUS-DIV   PIC 9(01).         10520000
298100             88  P-N-VALID-CENSUS-DIV    VALUE 1 THRU 9.          10530000
298200         05  P-NEW-MSA-DATA.                                      10540000
298300             10  P-NEW-CHG-CODE-INDEX       PIC X.                10550000
298400             10  P-NEW-GEO-LOC-MSAX         PIC X(04) JUST RIGHT. 10560000
298500             10  P-NEW-GEO-LOC-MSA9   REDEFINES                   10570000
298600                             P-NEW-GEO-LOC-MSAX  PIC 9(04).       10580000
298700             10  P-NEW-WAGE-INDEX-LOC-MSA   PIC X(04) JUST RIGHT. 10590000
298800             10  P-NEW-STAND-AMT-LOC-MSA    PIC X(04) JUST RIGHT. 10600000
298900             10  P-NEW-STAND-AMT-LOC-MSA9                         10610000
299000       REDEFINES P-NEW-STAND-AMT-LOC-MSA.                         10620000
299100                 15  P-NEW-RURAL-1ST.                             10630000
299200                     20  P-NEW-STAND-RURAL  PIC XX.               10640000
299300                         88  P-NEW-STD-RURAL-CHECK VALUE '  '.    10650000
299400                 15  P-NEW-RURAL-2ND        PIC XX.               10660000
299500         05  P-NEW-SOL-COM-DEP-HOSP-YR PIC XX.                    10670000
299600                 88  P-NEW-SCH-YRBLANK    VALUE   '  '.           10680000
299700                 88  P-NEW-SCH-YR82       VALUE   '82'.           10690000
299800                 88  P-NEW-SCH-YR87       VALUE   '87'.           10700000
299900         05  P-NEW-LUGAR                    PIC X.                10710000
300000         05  P-NEW-TEMP-RELIEF-IND          PIC X.                10720000
300100         05  P-NEW-FED-PPS-BLEND-IND        PIC X.                10730000
300200         05  FILLER                         PIC X(05).            10740000
300300     02  PROV-NEWREC-HOLD2.                                       10750000
300400         05  P-NEW-VARIABLES.                                     10760000
300500             10  P-NEW-FAC-SPEC-RATE     PIC  9(05)V9(02).        10770000
300600             10  P-NEW-COLA              PIC  9(01)V9(03).        10780000
300700             10  P-NEW-INTERN-RATIO      PIC  9(01)V9(04).        10790000
300800             10  P-NEW-BED-SIZE          PIC  9(05).              10800000
300900             10  P-NEW-OPER-CSTCHG-RATIO PIC  9(01)V9(03).        10810000
301000             10  P-NEW-CMI               PIC  9(01)V9(04).        10820000
301100             10  P-NEW-SSI-RATIO         PIC  V9(04).             10830000
301200             10  P-NEW-MEDICAID-RATIO    PIC  V9(04).             10840000
301300             10  P-NEW-PPS-BLEND-YR-IND  PIC  9(01).              10850000
301400             10  P-NEW-PRUF-UPDTE-FACTOR PIC  9(01)V9(05).        10860000
301500             10  P-NEW-DSH-PERCENT       PIC  V9(04).             10870000
301600             10  P-NEW-FYE-DATE          PIC  X(08).              10880000
301700         05  P-NEW-CBSA-DATA.                                     10890000
301800             10  P-NEW-CBSA-SPEC-PAY-IND    PIC X.                10900000
301900             10  P-NEW-CBSA-HOSP-QUAL-IND   PIC X.                10900000
302000             10  P-NEW-CBSA-GEO-LOC         PIC X(05) JUST RIGHT. 10900000
302100             10  P-NEW-CBSA-GEO-RURAL REDEFINES                   10900000
302200                 P-NEW-CBSA-GEO-LOC.                              10900000
302300                 15  P-NEW-CBSA-GEO-RURAL1ST PIC XXX.             10900000
302400                     88  P-NEW-CBSA-GEO-RURAL1    VALUE '   '.    10900000
302500                 15  P-NEW-CBSA-GEO-RURAL2ND PIC XX.              10900000
302600                                                                  10900000
302700             10  P-NEW-CBSA-RECLASS-LOC     PIC X(05) JUST RIGHT. 10900000
302800             10  P-NEW-CBSA-STAND-AMT-LOC   PIC X(05) JUST RIGHT. 10900000
302900             10  P-NEW-CBSA-SPEC-WAGE-INDEX    PIC 9(02)V9(04).   10900000
303000     02  PROV-NEWREC-HOLD3.                                       10930000
303100         05  P-NEW-PASS-AMT-DATA.                                 10940000
303200             10  P-NEW-PASS-AMT-CAPITAL    PIC 9(04)V99.          10950000
303300             10  P-NEW-PASS-AMT-DIR-MED-ED PIC 9(04)V99.          10960000
303400             10  P-NEW-PASS-AMT-ORGAN-ACQ  PIC 9(04)V99.          10970000
303500             10  P-NEW-PASS-AMT-PLUS-MISC  PIC 9(04)V99.          10980000
303600         05  P-NEW-CAPI-DATA.                                     10990000
303700             15  P-NEW-CAPI-PPS-PAY-CODE   PIC X.                 11000000
303800             15  P-NEW-CAPI-HOSP-SPEC-RATE PIC 9(04)V99.          11010000
303900             15  P-NEW-CAPI-OLD-HARM-RATE  PIC 9(04)V99.          11020000
304000             15  P-NEW-CAPI-NEW-HARM-RATIO PIC 9(01)V9999.        11030000
304100             15  P-NEW-CAPI-CSTCHG-RATIO   PIC 9V999.             11040000
304200             15  P-NEW-CAPI-NEW-HOSP       PIC X.                 11050000
304300             15  P-NEW-CAPI-IME            PIC 9V9999.            11060000
304400             15  P-NEW-CAPI-EXCEPTIONS     PIC 9(04)V99.          11070000
304500         05  P-HVBP-HRR-DATA.                                     08690000
304600             15  P-VAL-BASED-PURCH-PARTIPNT PIC X.                08690100
304700             15  P-VAL-BASED-PURCH-ADJUST   PIC 9V9(11).          08690200
304800             15  P-HOSP-READMISSION-REDUCTN PIC X.                08690300
304900             15  P-HOSP-HRR-ADJUSTMT        PIC 9V9(4).           08690400
305000         05  P-MODEL1-BUNDLE-DATA.                                      08
305100             15  P-MODEL1-BUNDLE-DISPRCNT   PIC V999.                   08
305200             15  P-HAC-REDUC-IND            PIC X.
305300             15  P-UNCOMP-CARE-AMOUNT       PIC 9(07)V99.
305400             15  P-EHR-REDUC-IND            PIC X.
305500         05  FILLER                         PIC X(09).
305600
305700******************************************************************11090000
305800 01  WAGE-NEW-CBSA-INDEX-RECORD.                                  11100000
305900     05  W-CBSA                        PIC X(5).                  11110000
306000     05  W-CBSA-SIZE                   PIC X.                     11120000
306100         88  LARGE-URBAN       VALUE 'L'.                         11130000
306200         88  OTHER-URBAN       VALUE 'O'.                         11140000
306300         88  ALL-RURAL         VALUE 'R'.                         11150000
306400     05  W-CBSA-EFF-DATE               PIC X(8).                  11160000
306500     05  FILLER                        PIC X.                     11170000
306600     05  W-CBSA-INDEX-RECORD           PIC S9(02)V9(04).          11180000
306700     05  W-CBSA-PR-INDEX-RECORD        PIC S9(02)V9(04).          11190000
306800                                                                  11200000
306900                                                                  11210000
307000 PROCEDURE DIVISION  USING BILL-NEW-DATA                          11220000
307100                           PPS-DATA                               11230000
307200                           PRICER-OPT-VERS-SW                     11240000
307300                           PPS-ADDITIONAL-VARIABLES               11250000
307400                           PROV-NEW-HOLD                          11260000
307500                           WAGE-NEW-CBSA-INDEX-RECORD.            11270000
307600                                                                  11280000
307700***************************************************************   11290000
307800*    PROCESSING:                                              *   11300000
307900*        A. WILL PROCESS CASES BASED ON DISCHARGE DATE            11310000
308000*        B. INITIALIZE PPCAL  HOLD VARIABLES.                 *   11320000
308100*        C. EDIT THE DATA PASSED FROM THE BILL BEFORE         *   11330000
308200*           ATTEMPTING TO CALCULATE PPS. IF THIS BILL         *   11340000
308300*           CANNOT BE PROCESSED, SET A RETURN CODE AND        *   11350000
308400*           GOBACK.                                           *   11360000
308500*        D. ASSEMBLE PRICING COMPONENTS.                      *   11370000
308600*        E. CALCULATE THE PRICE.                              *   11380000
308700***************************************************************   11390000
308800                                                                  11400000
308900     MOVE ZEROES TO NON-TEMP-RELIEF-PAYMENT.                      11410000
309000     MOVE 'N' TO TEMP-RELIEF-FLAG.                                11420000
309100     MOVE 'N' TO OUTLIER-RECON-FLAG.                              11430000
309200                                                                  11440000
309300     PERFORM 0200-MAINLINE-CONTROL THRU 0200-EXIT.                11450000
309400                                                                  11460000
309500     MOVE HOLD-ADDITIONAL-VARIABLES TO  PPS-ADDITIONAL-VARIABLES. 11470000
309600     MOVE H-DSCHG-FRCTN             TO  PPS-DSCHG-FRCTN.          11480000
309700     MOVE H-DRG-WT-FRCTN            TO  PPS-DRG-WT-FRCTN.         11490000
309800     MOVE HOLD-CAPITAL-VARIABLES    TO  PPS-CAPITAL-VARIABLES.    11500000
309900     MOVE HOLD-CAPITAL2-VARIABLES   TO  PPS-CAPITAL2-VARIABLES.   11510000
310000     MOVE CAL-VERSION               TO  PPS-CALC-VERS.            11520000
310100     MOVE HOLD-OTHER-VARIABLES      TO  PPS-OTHER-VARIABLES.      11530000
310200     MOVE HOLD-PC-OTH-VARIABLES     TO  PPS-PC-OTH-VARIABLES.     11540000
310300                                                                  11550000
310400     IF (PPS-RTC = '00' OR '03' OR '10' OR                        11560000
310500                   '12' OR '14')                                  11570000
310600        MOVE 'Y' TO OUTLIER-RECON-FLAG                            11580000
310700        MOVE PPS-DATA TO HLD-PPS-DATA                             11590000
310800        PERFORM 0200-MAINLINE-CONTROL THRU 0200-EXIT              11600000
310900        MOVE HLD-PPS-DATA TO PPS-DATA.                            11610000
311000                                                                  11620000
311100     GOBACK.                                                      11630000
311200                                                                  11640000
311300 0200-MAINLINE-CONTROL.                                           11650000
311400                                                                  11660000
311500     MOVE 'N' TO HMO-TAG.                                         11670000
311600                                                                  11680000
311700     IF PPS-PC-HMO-FLAG = 'Y' OR                                  11690000
311800               HMO-FLAG = 'Y'                                     11700000
311900        MOVE 'Y' TO HMO-TAG.                                      11710000
312000                                                                  11720000
312100     IF P-NEW-STATE NOT = 40                                      11730000
312200        MOVE ZEROES TO W-CBSA-PR-INDEX-RECORD.                    11740000
312300                                                                  11750000
312400     MOVE ALL '0' TO PPS-DATA                                     11760000
312500                     H-OPER-DSH-SCH                               11770000
312600                     H-OPER-DSH-RRC                               11780000
312700                     HOLD-PPS-COMPONENTS                          11790000
312800                     HOLD-PPS-COMPONENTS                          11800000
312900                     HOLD-ADDITIONAL-VARIABLES                    11810000
313000                     HOLD-CAPITAL-VARIABLES                       11820000
313100                     HOLD-CAPITAL2-VARIABLES                      11830000
313200                     HOLD-OTHER-VARIABLES                         11840000
313300                     HOLD-PC-OTH-VARIABLES.                       11850000
313400                                                                  11860000
313500     IF P-NEW-CAPI-HOSP-SPEC-RATE NOT NUMERIC                     11870000
313600        MOVE 0 TO P-NEW-CAPI-HOSP-SPEC-RATE.                      11880000
313700                                                                  11890000
313800     IF P-NEW-CAPI-OLD-HARM-RATE  NOT NUMERIC                     11900000
313900        MOVE 0 TO P-NEW-CAPI-OLD-HARM-RATE.                       11910000
314000                                                                  11920000
314100     IF P-NEW-CAPI-NEW-HARM-RATIO NOT NUMERIC                     11930000
314200        MOVE 0 TO P-NEW-CAPI-NEW-HARM-RATIO.                      11940000
314300                                                                  11950000
314400     IF P-NEW-CAPI-CSTCHG-RATIO NOT NUMERIC                       11960000
314500        MOVE 0 TO P-NEW-CAPI-CSTCHG-RATIO.                        11970000
314600                                                                  11980000
314700                                                                  11990000
314800     PERFORM 1000-EDIT-THE-BILL-INFO.                             12000000
314900                                                                  12010000
315000     IF  PPS-RTC = 00                                             12020000
315100         PERFORM 2000-ASSEMBLE-PPS-VARIABLES                      12030000
315200         PERFORM 3000-CALC-PAYMENT THRU 3000-EXIT.                12040000
315300                                                                  12050000
315400     IF OUTLIER-RECON-FLAG = 'Y'                                  12060000
315500        MOVE 'N' TO OUTLIER-RECON-FLAG                            12070000
315600        GO TO 0200-EXIT.                                          12080000
315700                                                                  12090000
315800     IF PPS-RTC = 00                                              12100000
315900        IF H-PERDIEM-DAYS = H-ALOS OR                             12110000
316000           H-PERDIEM-DAYS > H-ALOS                                12120000
316100           MOVE 14 TO PPS-RTC.                                    12130000
316200                                                                  12140000
316300     IF PPS-RTC = 02                                              12150000
316400        IF H-PERDIEM-DAYS = H-ALOS OR                             12160000
316500           H-PERDIEM-DAYS > H-ALOS                                12170000
316600           MOVE 16 TO PPS-RTC.                                    12180000
316700                                                                  12190000
316800 0200-EXIT.   EXIT.                                               12200000
316900                                                                  12210000
317000 1000-EDIT-THE-BILL-INFO.                                         12220000
317100                                                                  12230000
317200     MOVE 1.00 TO H-CAPI-PAYCDE-PCT1.                             12240000
317300     MOVE 0.00 TO H-CAPI-PAYCDE-PCT2.                             12250000
317400                                                                  12260000
317500     IF  PPS-RTC = 00                                             12270000
317600         IF  P-NEW-WAIVER-STATE                                   12280000
317700             MOVE 53 TO PPS-RTC.                                  12290000
317800                                                                  12300000
317900     IF  PPS-RTC = 00                                             12310000
318000         IF  B-DRG < 001                                                00
318100               OR = 009 OR = 016 OR = 017                         12330000
318200               OR = 018 OR = 019 OR = 043 OR = 044                12340000
318300               OR = 045 OR = 046 OR = 047 OR = 048                12350000
318400               OR = 049 OR = 050 OR = 051 OR = 104                12360000
318500               OR = 105 OR = 106 OR = 107 OR = 108                12370000
318600               OR = 109 OR = 110 OR = 111 OR = 112                12380000
318700               OR = 118 OR = 119 OR = 120 OR = 126                12390000
318800               OR = 127 OR = 128 OR = 140 OR = 141                12400000
318900               OR = 142 OR = 143 OR = 144 OR = 145                12410000
319000               OR = 160 OR = 161 OR = 162 OR = 169                12420000
319100               OR = 170 OR = 171 OR = 172 OR = 173                12430000
319200               OR = 174 OR = 209 OR = 210 OR = 211                12440000
319300               OR = 212 OR = 213 OR = 214                         12450000
319400               OR = 266 OR = 267 OR = 268 OR = 269                12460000
319500               OR = 270 OR = 271 OR = 272 OR = 273                12470000
319600               OR = 274 OR = 275 OR = 276 OR = 277                12480000
319700               OR = 278 OR = 279 OR = 317 OR = 318                12490000
319800               OR = 319 OR = 320 OR = 321 OR = 322                12500000
319900               OR = 323 OR = 324 OR = 325 OR = 359                12510000
320000               OR = 360 OR = 361 OR = 362 OR = 363                12520000
320100               OR = 364 OR = 365 OR = 366 OR = 367                12530000
320200               OR = 396 OR = 397 OR = 398 OR = 399                12540000
320300               OR = 400 OR = 401 OR = 402 OR = 403                12550000
320400               OR = 404 OR = 426 OR = 427 OR = 428                12560000
320500               OR = 429 OR = 430 OR = 431 OR = 447                12570000
320600               OR = 448 OR = 449 OR = 450 OR = 451                12580000
320700               OR = 452 OR = 518 OR = 519 OR = 520                12590000
320800               OR = 521 OR = 522 OR = 523 OR = 524                12600000
320900               OR = 525 OR = 526 OR = 527 OR = 528                12610000
321000               OR = 529 OR = 530 OR = 531 OR = 532                12620000
321100               OR = 567 OR = 568 OR = 569 OR = 570                12630000
321200               OR = 571 OR = 572 OR = 586 OR = 587                12640000
321300               OR = 588 OR = 589 OR = 590 OR = 591                12650000
321400               OR = 608 OR = 609 OR = 610 OR = 611                12660000
321500               OR = 612 OR = 613 OR = 631 OR = 632                12670000
321600               OR = 633 OR = 634 OR = 635 OR = 636                12680000
321700               OR = 646 OR = 647 OR = 648 OR = 649                12690000
321800               OR = 650 OR = 651 OR = 676 OR = 677                12700000
321900               OR = 678 OR = 679 OR = 680 OR = 681                12710000
322000               OR = 701 OR = 702 OR = 703 OR = 704                12720000
322100               OR = 705 OR = 706 OR = 719 OR = 720                12730000
322200               OR = 721 OR = 731 OR = 732 OR = 733                12740000
322300               OR = 751 OR = 752 OR = 753 OR = 762                12750000
322400               OR = 763 OR = 764 OR = 771 OR = 772                12760000
322500               OR = 773 OR = 783 OR = 784 OR = 785                12770000
322600               OR = 786 OR = 787 OR = 788 OR = 796                12780000
322700               OR = 797 OR = 798 OR = 805 OR = 806                12790000
322800               OR = 807 OR = 817 OR = 818 OR = 819                12800000
322900               OR = 831 OR = 832 OR = 833 OR = 850                12810000
323000               OR = 851 OR = 852 OR = 859 OR = 860                12820000
323100               OR = 861 OR = 873 OR = 874 OR = 875                12830000
323200               OR = 877 OR = 878 OR = 879                               00
323300               OR = 888 OR = 889 OR = 890                               00
323400               OR = 891 OR = 892 OR = 893                         12850000
323500               OR = 893 OR = 898 OR = 899 OR = 900                12860000
323600               OR = 910 OR = 911 OR = 912 OR = 924                12870000
323700               OR = 925 OR = 926 OR = 930 OR = 931                12880000
323800               OR = 932 OR = 936 OR = 937 OR = 938                12890000
323900               OR = 942 OR = 943 OR = 944 OR = 952                12900000
324000               OR = 953 OR = 954 OR = 960 OR = 961                12910000
324100               OR = 962 OR = 966 OR = 967 OR = 968                12920000
324200               OR = 971 OR = 972 OR = 973 OR = 978                12930000
324300               OR = 979 OR = 980 OR = 990 OR = 991                12940000
324400               OR = 992 OR = 993 OR = 994 OR = 995                12950000
324500               OR = 996 OR = 997                                  12960000
324600             MOVE 54 TO PPS-RTC.                                  12970000
324700                                                                  12980000
324800     IF  PPS-RTC = 00                                             12990000
324900            IF  ((B-DISCHARGE-DATE < P-NEW-EFF-DATE) OR           13000000
325000                 (B-DISCHARGE-DATE < W-CBSA-EFF-DATE))            13010000
325100                MOVE 55 TO PPS-RTC.                               13020000
325200                                                                  13030000
325300     IF  PPS-RTC = 00                                             13040000
325400         IF P-NEW-TERMINATION-DATE > 00000000                     13050000
325500            IF  ((B-DISCHARGE-DATE = P-NEW-TERMINATION-DATE) OR   13060000
325600                 (B-DISCHARGE-DATE > P-NEW-TERMINATION-DATE))     13070000
325700                  MOVE 55 TO PPS-RTC.                             13080000
325800                                                                  13090000
325900     IF  PPS-RTC = 00                                             13100000
326000         IF  B-LOS NOT NUMERIC                                    13110000
326100             MOVE 56 TO PPS-RTC                                   13120000
326200         ELSE                                                     13130000
326300         IF  B-LOS = 0                                            13140000
326400             IF B-REVIEW-CODE NOT = 00 AND                        13150000
326500                              NOT = 03 AND                        13160000
326600                              NOT = 06 AND                        13170000
326700                              NOT = 07 AND                        13180000
326800                              NOT = 09 AND                        13190000
326900                              NOT = 11                            13200000
327000             MOVE 56 TO PPS-RTC.                                  13210000
327100                                                                  13220000
327200     IF  PPS-RTC = 00                                             13230000
327300         IF  B-LTR-DAYS NOT NUMERIC OR B-LTR-DAYS > 60            13240000
327400             MOVE 61 TO PPS-RTC                                   13250000
327500         ELSE                                                     13260000
327600             MOVE B-LTR-DAYS TO H-LTR-DAYS.                       13270000
327700                                                                  13280000
327800     IF  PPS-RTC = 00                                             13290000
327900         IF  B-COVERED-DAYS NOT NUMERIC                           13300000
328000             MOVE 62 TO PPS-RTC                                   13310000
328100         ELSE                                                     13320000
328200         IF  B-COVERED-DAYS = 0 AND B-LOS > 0                     13330000
328300             MOVE 62 TO PPS-RTC                                   13340000
328400         ELSE                                                     13350000
328500             MOVE B-COVERED-DAYS TO H-COV-DAYS.                   13360000
328600                                                                  13370000
328700     IF  PPS-RTC = 00                                             13380000
328800         IF  H-LTR-DAYS  > H-COV-DAYS                             13390000
328900             MOVE 62 TO PPS-RTC                                   13400000
329000         ELSE                                                     13410000
329100             COMPUTE H-REG-DAYS = H-COV-DAYS - H-LTR-DAYS.        13420000
329200                                                                  13430000
329300     IF  PPS-RTC = 00                                             13440000
329400         IF  NOT VALID-REVIEW-CODE                                13450000
329500             MOVE 57 TO PPS-RTC.                                  13460000
329600                                                                  13470000
329700     IF  PPS-RTC = 00                                             13480000
329800         IF  B-CHARGES-CLAIMED NOT NUMERIC                        13490000
329900             MOVE 58 TO PPS-RTC.                                  13500000
330000                                                                  13510000
330100     IF PPS-RTC = 00                                              13520000
330200           IF P-NEW-CAPI-NEW-HOSP NOT = 'Y'                       13530000
330300                 IF P-NEW-CAPI-PPS-PAY-CODE NOT = 'A' AND         13540000
330400                                            NOT = 'B' AND         13550000
330500                                            NOT = 'C'             13560000
330600                 MOVE 65 TO PPS-RTC.                              13570000
330700                                                                  13580000
330800 2000-ASSEMBLE-PPS-VARIABLES.                                     13590000
330900***  GET THE PROVIDER SPECIFIC VARIABLES.                         13600000
331000***  GET THE PROVIDER SPECIFIC VARIABLES.                         13610000
331100                                                                  13620000
331200     MOVE P-NEW-FAC-SPEC-RATE TO H-FAC-SPEC-RATE.                 13630000
331300     MOVE P-NEW-INTERN-RATIO TO H-INTERN-RATIO.                   13640000
331400                                                                  13650000
331500     IF  (P-NEW-STATE = 02 OR 12)                                 13660000
331600         MOVE P-NEW-COLA TO H-OPER-COLA                           13670000
331700     ELSE                                                         13680000
331800         MOVE 1.000  TO H-OPER-COLA.                              13690000
331900                                                                  13700000
332000***************************************************************   13710000
332100***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              13720000
332200***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              13730000
332300                                                                  13740000
332400     PERFORM 2600-GET-DRG-WEIGHT                                  13750000
332500             VARYING DX5 FROM 1 BY 1 UNTIL DX5 > 1.               13760000
332600                                                                  13770000
332700***************************************************************   13780000
332800***  GET THE WAGE-INDEX                                           13790000
332900***  GET THE WAGE-INDEX                                           13800000
333000                                                                  13810000
333100     MOVE W-CBSA-INDEX-RECORD TO H-WAGE-INDEX.                    13820000
333200     MOVE W-CBSA-PR-INDEX-RECORD TO H-PR-WAGE-INDEX.              13830000
333300     MOVE P-NEW-STATE            TO MES-PPS-STATE.                13830000
333400*****YEARCHANGE 2011.0 ************************************       16570000
333500** USING THE STATE FACTORS TO ALTER THE WAGE INDEX WAS STOPPED*   13850000
333600** FOR FY 2011                                                    13850000
333700***************************************************************   13850000
333800*    PERFORM 4200-SSRFBN-CODE-RTN THRU 4200-EXIT.
333900*****YEARCHANGE 2011.0 ************************************       16570000
334000
334100*    IF  P-NEW-CBSA-SPEC-PAY-IND = '1' OR '2'                           00
334200       COMPUTE H-WAGE-INDEX ROUNDED =
334300                         H-WAGE-INDEX * 1
334400*    ELSE                                                         13910000
334500*      COMPUTE H-WAGE-INDEX ROUNDED =
334600*                        H-WAGE-INDEX * MES-SSRFBN-RATE.
334700
334800*****YEARCHANGE 2011.0 ************************************       16570000
334900
335000***************************************************************   13850000
335100***  GET THE LABOR, NON-LABOR STANDARD RATES                      13860000
335200                                                                  13870000
335300     IF  P-NEW-STATE = 40                                         13880000
335400         MOVE 2 TO R2                                             13890000
335500         MOVE 3 TO R4                                             13900000
335600     ELSE                                                         13910000
335700         MOVE 1 TO R2                                             13920000
335800         MOVE 1 TO R4.                                            13930000
335900                                                                  13940000
336000     IF  LARGE-URBAN                                              13950000
336100         MOVE 1 TO R3                                             13960000
336200     ELSE                                                         13970000
336300         MOVE 2 TO R3.                                            13980000
336400                                                                  13990000
336500     IF ((P-NEW-CBSA-HOSP-QUAL-IND = '1') AND                     14000000
336600        (H-WAGE-INDEX > 01.0000))                                 14010000
336700        PERFORM 2300-GET-LAB-NONLAB-TB1-RATES                     14020000
336800             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14030000
336900                                                                  14040000
337000     IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND                 14050000
337100         (H-WAGE-INDEX > 01.0000))                                14060000
337200        PERFORM 2300-GET-LAB-NONLAB-TB2-RATES                     14070000
337300             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14080000
337400                                                                  14090000
337500     IF ((P-NEW-CBSA-HOSP-QUAL-IND  = '1') AND                    14100000
337600         (H-WAGE-INDEX < 01.0000 OR H-WAGE-INDEX = 01.0000))      14110000
337700        PERFORM 2300-GET-LAB-NONLAB-TB3-RATES                     14120000
337800             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14130000
337900                                                                  14140000
338000     IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND                 14150000
338100         (H-WAGE-INDEX < 01.0000 OR H-WAGE-INDEX = 01.0000))      14160000
338200        PERFORM 2300-GET-LAB-NONLAB-TB4-RATES                     14170000
338300             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14180000
338400                                                                  14190000
338500     IF P-NEW-STATE = 40                                          14200000
338600        IF ((P-NEW-CBSA-HOSP-QUAL-IND = '1') AND                  14210000
338700            (H-PR-WAGE-INDEX > 01.0000))                          14220000
338800             PERFORM 2300-GET-PR-LAB-TB1-RATES                    14230000
338900             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14240000
339000                                                                  14250000
339100                                                                  14260000
339200     IF P-NEW-STATE = 40                                          14270000
339300        IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND              14280000
339400             (H-PR-WAGE-INDEX > 01.0000))                         14290000
339500              PERFORM 2300-GET-PR-LAB-TB2-RATES                   14300000
339600                  VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.            14310000
339700                                                                  14320000
339800     IF P-NEW-STATE = 40                                          14330000
339900        IF ((P-NEW-CBSA-HOSP-QUAL-IND  = '1') AND                 14340000
340000         (H-PR-WAGE-INDEX < 01.0000 OR H-PR-WAGE-INDEX = 01.0000))14350000
340100          PERFORM 2300-GET-PR-LAB-TB3-RATES                       14360000
340200              VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                14370000
340300                                                                  14380000
340400     IF P-NEW-STATE = 40                                          14390000
340500        IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND              14400000
340600         (H-PR-WAGE-INDEX < 01.0000 OR H-PR-WAGE-INDEX = 01.0000))14410000
340700          PERFORM 2300-GET-PR-LAB-TB4-RATES                       14420000
340800              VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                14430000
340900                                                                  14440000
341000***************************************************************   14450000
341100***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               14460000
341200***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               14470000
341300                                                                  14480000
341400     MOVE 0.00  TO H-OPER-HSP-PCT.                                14490000
341500     MOVE 1.00  TO H-OPER-FSP-PCT.                                14500000
341600                                                                  14510000
341700***************************************************************   14520000
341800***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     14530000
341900***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     14540000
342000                                                                  14550000
342100      MOVE 1.00 TO H-NAT-PCT.                                     14560000
342200      MOVE 0.00 TO H-REG-PCT.                                     14570000
342300                                                                  14580000
342400     IF  P-NEW-STATE = 40                                         14590000
342500         MOVE 0.75 TO H-NAT-PCT                                   14600000
342600         MOVE 0.25 TO H-REG-PCT.                                  14610000
342700                                                                  14620000
342800     IF  P-N-SCH-REBASED-FY90 OR                                  14630000
342900         P-N-EACH OR                                              14640000
343000         P-N-MDH-REBASED-FY90                                     14650000
343100         MOVE 1.00 TO H-OPER-HSP-PCT.                             14660000
343200                                                                  14670000
343300 2300-GET-LAB-NONLAB-TB1-RATES.                                   14680000
343400                                                                  14690000
343500     IF  B-DISCHARGE-DATE NOT < TB1-RATE-EFF-DATE (R1)            14700000
343600         MOVE TB1-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14710000
343700         MOVE TB1-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14720000
343800         MOVE TB1-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14730000
343900         MOVE TB1-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14740000
344000                                                                  14750000
344100 2300-GET-LAB-NONLAB-TB2-RATES.                                   14760000
344200                                                                  14770000
344300     IF  B-DISCHARGE-DATE NOT < TB2-RATE-EFF-DATE (R1)            14780000
344400         MOVE TB2-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14790000
344500         MOVE TB2-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14800000
344600         MOVE TB2-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14810000
344700         MOVE TB2-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14820000
344800                                                                  14830000
344900 2300-GET-LAB-NONLAB-TB3-RATES.                                   14840000
345000                                                                  14850000
345100     IF  B-DISCHARGE-DATE NOT < TB3-RATE-EFF-DATE (R1)            14860000
345200         MOVE TB3-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14870000
345300         MOVE TB3-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14880000
345400         MOVE TB3-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14890000
345500         MOVE TB3-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14900000
345600                                                                  14910000
345700 2300-GET-LAB-NONLAB-TB4-RATES.                                   14920000
345800                                                                  14930000
345900     IF  B-DISCHARGE-DATE NOT < TB4-RATE-EFF-DATE (R1)            14940000
346000         MOVE TB4-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14950000
346100         MOVE TB4-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14960000
346200         MOVE TB4-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14970000
346300         MOVE TB4-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14980000
346400                                                                  14990000
346500 2300-GET-PR-LAB-TB1-RATES.                                       15000000
346600                                                                  15010000
346700     IF  B-DISCHARGE-DATE NOT < TB1-RATE-EFF-DATE (R1)            15020000
346800         MOVE TB1-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15030000
346900         MOVE TB1-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15040000
347000                                                                  15050000
347100 2300-GET-PR-LAB-TB2-RATES.                                       15060000
347200                                                                  15070000
347300     IF  B-DISCHARGE-DATE NOT < TB2-RATE-EFF-DATE (R1)            15080000
347400         MOVE TB2-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15090000
347500         MOVE TB2-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15100000
347600                                                                  15110000
347700 2300-GET-PR-LAB-TB3-RATES.                                       15120000
347800                                                                  15130000
347900     IF  B-DISCHARGE-DATE NOT < TB3-RATE-EFF-DATE (R1)            15140000
348000         MOVE TB3-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15150000
348100         MOVE TB3-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15160000
348200                                                                  15170000
348300 2300-GET-PR-LAB-TB4-RATES.                                       15180000
348400                                                                  15190000
348500     IF  B-DISCHARGE-DATE NOT < TB4-RATE-EFF-DATE (R1)            15200000
348600         MOVE TB4-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15210000
348700         MOVE TB4-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15220000
348800                                                                  15230000
348900                                                                  15240000
349000 2600-GET-DRG-WEIGHT.                                             15250000
349100                                                                  15260000
349200     IF  B-DISCHARGE-DATE NOT < DRGX-EFF-DATE (DX5)               15270000
349300         SET DX6 TO B-DRG                                         15280000
349400         MOVE DRG-WT (DX5 DX6)         TO H-DRG-WT                15290000
349500         MOVE DRG-ALOS (DX5 DX6)       TO H-ALOS                  15300000
349600         MOVE ZEROES                   TO H-DAYS-CUTOFF           15310000
349700         MOVE DRG-ARITH-ALOS (DX5 DX6) TO H-ARITH-ALOS.           15320000
349800                                                                  15330000
349900 3000-CALC-PAYMENT.                                               15340000
350000***************************************************************   15350000
350100                                                                  15360000
350200     PERFORM 3100-CALC-STAY-UTILIZATION.                          15370000
350300     PERFORM 3300-CALC-OPER-FSP-AMT.                              15380000
350400     PERFORM 3900A-CALC-OPER-DSH THRU 3900A-EXIT.                 15390000
350500                                                                  15400000
350600***********************************************************       15410000
350700***  OPERATING IME CALCULATION                                    15420000
350800***  OPERATING IME CALCULATION                                    15430000
350900                                                                  15440000
351000     COMPUTE H-OPER-IME-TEACH ROUNDED =                           15450000
351100            1.35 * ((1 + H-INTERN-RATIO) ** .405  - 1).           15460000
351200                                                                  15470000
351300***********************************************************       15480000
351400*                                                                 15490000
351500*    IF P-N-SCH-REBASED-FY90 OR                                   15500000
351600*       P-N-EACH OR                                               15510000
351700*       P-N-MDH-REBASED-FY90                                      15520000
351800*        PERFORM 3450-CALC-ADDITIONAL-HSP.                        15530000
351900*                                                                 15540000
352000     MOVE 00                 TO  PPS-RTC.                         15550000
352100     MOVE H-WAGE-INDEX       TO  PPS-WAGE-INDX.                   15560000
352200     MOVE H-ALOS             TO  PPS-AVG-LOS.                     15570000
352300     MOVE H-DAYS-CUTOFF      TO  PPS-DAYS-CUTOFF.                 15580000
352400                                                                  15590000
352500     MOVE B-LOS TO H-PERDIEM-DAYS.                                15600000
352600     IF H-PERDIEM-DAYS < 1                                        15610000
352700         MOVE 1 TO H-PERDIEM-DAYS.                                15620000
352800     ADD 1 TO H-PERDIEM-DAYS.                                     15630000
352900                                                                  15640000
353000     MOVE 1 TO H-DSCHG-FRCTN.                                     15650000
353100                                                                  15660000
353200     COMPUTE H-DRG-WT-FRCTN ROUNDED = H-DSCHG-FRCTN * H-DRG-WT.   15670000
353300                                                                  15680000
353400     IF (PAY-PERDIEM-DAYS  OR                                     15690000
353500         PAY-XFER-NO-COST) OR                                     15700000
353600        (PAY-XFER-SPEC-DRG AND                                    15710000
353700         B-DRG-POSTACUTE-PERDIEM)                                 15720000
353800         COMPUTE H-TRANSFER-ADJ ROUNDED = H-PERDIEM-DAYS / H-ALOS 15730000
353900         COMPUTE H-DSCHG-FRCTN  ROUNDED = H-PERDIEM-DAYS / H-ALOS 15740000
354000         IF H-DSCHG-FRCTN > 1                                     15750000
354100              MOVE 1 TO H-DSCHG-FRCTN                             15760000
354200              MOVE 1 TO H-TRANSFER-ADJ                            15770000
354300         ELSE                                                     15780000
354400              COMPUTE H-DRG-WT-FRCTN ROUNDED =                    15790000
354500                  (H-PERDIEM-DAYS / H-ALOS) * H-DRG-WT.           15800000
354600                                                                  15810000
354700     IF (PAY-XFER-SPEC-DRG AND                                    15820000
354800         B-DRG-POSTACUTE-50-50)                                   15830000
354900         COMPUTE H-TRANSFER-ADJ ROUNDED = H-PERDIEM-DAYS / H-ALOS 15840000
355000         COMPUTE H-DSCHG-FRCTN  ROUNDED =                         15850000
355100                        .5 + ((.5 * H-PERDIEM-DAYS) / H-ALOS)     15860000
355200         IF H-DSCHG-FRCTN > 1                                     15870000
355300              MOVE 1 TO H-DSCHG-FRCTN                             15880000
355400              MOVE 1 TO H-TRANSFER-ADJ                            15890000
355500         ELSE                                                     15900000
355600              COMPUTE H-DRG-WT-FRCTN ROUNDED =                    15910000
355700            (.5 + ((.5 * H-PERDIEM-DAYS) / H-ALOS)) * H-DRG-WT.   15920000
355800                                                                  15930000
355900                                                                  15940000
356000***********************************************************       15950000
356100***  CAPITAL DSH CALCULATION                                      15960000
356200***  CAPITAL DSH CALCULATION                                      15970000
356300                                                                  15980000
356400     MOVE 0 TO H-CAPI-DSH.                                        15990000
356500                                                                  16000000
356600     IF P-NEW-BED-SIZE NOT NUMERIC                                16010000
356700         MOVE 0 TO P-NEW-BED-SIZE.                                16020000
356800                                                                  16030000
356900     IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99        16040000
357000         COMPUTE H-CAPI-DSH ROUNDED = 2.7183 **                   16050000
357100                  (.2025 * (P-NEW-SSI-RATIO                       16060000
357200                          + P-NEW-MEDICAID-RATIO)) - 1.           16070000
357300                                                                  16080000
357400***********************************************************       16090000
357500***  CAPITAL IME TEACH CALCULATION                                16100000
357600***  CAPITAL IME TEACH CALCULATION                                16110000
357700                                                                  16120000
357800     MOVE 0 TO H-WK-CAPI-IME-TEACH.                               16130000
357900                                                                  16140000
358000     IF P-NEW-CAPI-IME NUMERIC                                    16150000
358100        IF P-NEW-CAPI-IME > 1.5000                                16160000
358200           MOVE 1.5000 TO P-NEW-CAPI-IME.                         16170000
358300                                                                  16180000
358400*****YEARCHANGE 2009.5 ****************************************   18470000
358500***                                                               16230000
358600***  PER POLICY, WE REMOVED THE .5 MULTIPLER                      16230000
358700***                                                               16230000
358800***********************************************************       16230000
358900     IF P-NEW-CAPI-IME NUMERIC                                    16190000
359000        COMPUTE H-WK-CAPI-IME-TEACH ROUNDED =                     16200000
359100         ((2.7183 ** (.2822 * P-NEW-CAPI-IME)) - 1).              16210000
359200                                                                  16220000
359300*****YEARCHANGE 2009.5 ****************************************   18470000
359400***********************************************************       16230000
359500     MOVE 0.00 TO H-DAYOUT-PCT.                                   16240000
359600     MOVE 0.80 TO H-CSTOUT-PCT.                                   16250000
359700                                                                  16260000
359800******************************************************************16270000
359900**                                                                16280000
360000** BURN DRGS FOR FY09 ARE 927, 928, 929, 933, 934 AND 935.        16281000
360100**                                                                16282000
360200******************************************************************16283000
360300                                                                  16284000
360400     IF  B-DRG = 927 OR 928 OR 929 OR 933 OR 934 OR 935           16285000
360500             MOVE 0.90 TO H-CSTOUT-PCT.                           16286000
360600                                                                  16287000
360700***     NATIONAL PERCENTAGE                                       16288000
360800     MOVE 0.6880   TO H-LABOR-PCT.                                16289000
360900     MOVE 0.3120   TO H-NONLABOR-PCT.                             16290000
361000                                                                  16300000
361100***     PUERTO RICO PERCENTAGE                                    16310000
361200     MOVE 0.6210   TO H-PR-LABOR-PCT.                             16320000
361300     MOVE 0.3790   TO H-PR-NONLABOR-PCT.                          16330000
361400                                                                  16340000
361500     IF (H-WAGE-INDEX < 01.0000 OR                                16350000
361600         H-WAGE-INDEX = 01.0000)                                  16360000
361700        MOVE 0.6200 TO H-LABOR-PCT                                16370000
361800        MOVE 0.3800 TO H-NONLABOR-PCT.                            16380000
361900***       ??????????                                              16390000
362000     IF P-NEW-STATE = 40                                          16400000
362100       IF (H-PR-WAGE-INDEX < 01.0000 OR                           16410000
362200           H-PR-WAGE-INDEX = 01.0000)                             16420000
362300          MOVE 0.6200 TO H-PR-LABOR-PCT                           16430000
362400          MOVE 0.3800 TO H-PR-NONLABOR-PCT.                       16440000
362500                                                                  16450000
362600                                                                  16460000
362700     IF  P-NEW-OPER-CSTCHG-RATIO NUMERIC                          16470000
362800             MOVE P-NEW-OPER-CSTCHG-RATIO TO H-OPER-CSTCHG-RATIO  16480000
362900     ELSE                                                         16490000
363000             MOVE 0.000 TO H-OPER-CSTCHG-RATIO.                   16500000
363100                                                                  16510000
363200     IF P-NEW-CAPI-CSTCHG-RATIO NUMERIC                           16520000
363300             MOVE P-NEW-CAPI-CSTCHG-RATIO TO H-CAPI-CSTCHG-RATIO  16530000
363400     ELSE                                                         16540000
363500             MOVE 0.000 TO H-CAPI-CSTCHG-RATIO.                   16550000
363600                                                                  16560000
363700***********************************************************       16570000
363800*****YEARCHANGE 2010.0 ************************************       16570000
363900***  CAPITAL PAYMENT METHOD B - YEARCHNG                          16580000
364000***  CAPITAL PAYMENT METHOD B                                     16590000
364100                                                                  16600000
364200     IF W-CBSA-SIZE = 'L'                                         16610000
364300        MOVE 1.00 TO H-CAPI-LARG-URBAN                            16620000
364400     ELSE                                                         16630000
364500        MOVE 1.00 TO H-CAPI-LARG-URBAN.                           16640000
364600                                                                  16650000
364700     COMPUTE H-CAPI-GAF    ROUNDED = (H-WAGE-INDEX ** .6848).     16660000
364800     COMPUTE H-PR-CAPI-GAF ROUNDED = (H-PR-WAGE-INDEX ** .6848).  16670000
364900                                                                  16680000
365000*****YEARCHANGE 2011.0 ************************************       16570000
365100     COMPUTE H-FEDERAL-RATE ROUNDED =                             16690000
365200                                 (0420.01 * H-CAPI-GAF).          16700000
365300     COMPUTE H-PUERTO-RICO-RATE ROUNDED =                         16710000
365400                                 (0197.66 * H-PR-CAPI-GAF).       16720000
365500*****YEARCHANGE 2011.0 ************************************       16570000
365600                                                                  16730000
365700     COMPUTE H-CAPI-COLA ROUNDED =                                16740000
365800                     (.3152 * (H-OPER-COLA - 1) + 1).             16750000
365900                                                                  16760000
366000     MOVE H-FEDERAL-RATE TO H-CAPI-FED-RATE.                      16770000
366100                                                                  16780000
366200     IF P-NEW-STATE = 40                                          16790000
366300        COMPUTE  H-CAPI-FED-RATE ROUNDED =                        16800000
366400                 (H-NAT-PCT * H-FEDERAL-RATE) +                   16810000
366500                 (H-REG-PCT * H-PUERTO-RICO-RATE).                16820000
366600***********************************************************       16830000
366700***  CAPITAL FSP CALCULATION                                      16840000
366800***  CAPITAL FSP CALCULATION                                      16850000
366900                                                                  16860000
367000     COMPUTE H-CAPI-FSP-PART ROUNDED =                            16870000
367100                               H-DRG-WT * H-CAPI-FED-RATE *       16880000
367200                               H-CAPI-COLA *                      16890000
367300                               H-CAPI-LARG-URBAN.                 16900000
367400                                                                  16910000
367500***********************************************************       16920000
367600***  CAPITAL PAYMENT METHOD A                                     16930000
367700***  CAPITAL PAYMENT METHOD A                                     16940000
367800                                                                  16950000
367900     IF P-N-SCH-REBASED-FY90 OR P-N-EACH                          16960000
368000        MOVE 1.00 TO H-CAPI-SCH                                   16970000
368100     ELSE                                                         16980000
368200        MOVE 0.85 TO H-CAPI-SCH.                                  16990000
368300                                                                  17000000
368400***********************************************************       17010000
368500***********  CAPITAL OLD-HOLD-HARMLESS CALCULATION ***********    17020000
368600***********  CAPITAL OLD-HOLD-HARMLESS CALCULATION ***********    17030000
368700                                                                  17040000
368800     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        17050000
368900                    (P-NEW-CAPI-OLD-HARM-RATE *                   17060000
369000                    H-CAPI-SCH).                                  17070000
369100                                                                  17080000
369200***********************************************************       17090000
369300        IF PAY-PERDIEM-DAYS                                       17100000
369400            IF  H-PERDIEM-DAYS < H-ALOS                           17110000
369500                IF  NOT (B-DRG = 789)                             17120000
369600                    PERFORM 3500-CALC-PERDIEM-AMT                 17130000
369700                    MOVE 03 TO PPS-RTC.                           17140000
369800                                                                  17150000
369900        IF PAY-XFER-SPEC-DRG                                      17160000
370000            IF  H-PERDIEM-DAYS < H-ALOS                           17170000
370100                IF  NOT (B-DRG = 789)                             17180000
370200                    PERFORM 3550-CALC-PERDIEM-AMT.                17190000
370300                                                                  17200000
370400        IF  PAY-XFER-NO-COST                                      17210000
370500            MOVE 00 TO PPS-RTC                                    17220000
370600            IF H-PERDIEM-DAYS < H-ALOS                            17230000
370700               IF  NOT (B-DRG = 789)                              17240000
370800                   PERFORM 3500-CALC-PERDIEM-AMT                  17250000
370900                   MOVE 06 TO PPS-RTC.                            17260000
371000                                                                  17270000
371100     PERFORM 4000-CALC-TECH-ADDON THRU 4000-EXIT.                 17280000
371200                                                                  17290000
371300     PERFORM 3600-CALC-OUTLIER THRU 3600-EXIT.                    17300000
371400                                                                  17310000
371500     IF OUTLIER-RECON-FLAG = 'Y' GO TO 3000-EXIT.                 17320000
371600                                                                  17330000
371700     IF PPS-RTC = 67  GO TO 3000-CONTINUE.                        17340000
371800                                                                  17350000
371900        IF PAY-XFER-SPEC-DRG                                      17360000
372000            IF  H-PERDIEM-DAYS < H-ALOS                           17370000
372100                IF  NOT (B-DRG = 789)                             17380000
372200                    PERFORM 3560-CHECK-RTN-CODE THRU 3560-EXIT.   17390000
372300                                                                  17400000
372400                                                                  17410000
372500        IF  PAY-PERDIEM-DAYS                                      17420000
372600            IF  H-OPER-OUTCST-PART > 0                            17430000
372700                MOVE H-OPER-OUTCST-PART TO                        17440000
372800                     H-OPER-OUTLIER-PART                          17450000
372900                MOVE 05 TO PPS-RTC                                17460000
373000            ELSE                                                  17470000
373100            IF  PPS-RTC NOT = 03                                  17480000
373200                MOVE 00 TO PPS-RTC                                17490000
373300                MOVE 0  TO H-OPER-OUTLIER-PART.                   17500000
373400                                                                  17510000
373500        IF  PAY-PERDIEM-DAYS                                      17520000
373600            IF  H-CAPI-OUTCST-PART > 0                            17530000
373700                MOVE H-CAPI-OUTCST-PART TO                        17540000
373800                     H-CAPI-OUTLIER-PART                          17550000
373900                MOVE 05 TO PPS-RTC                                17560000
374000            ELSE                                                  17570000
374100            IF  PPS-RTC NOT = 03                                  17580000
374200                MOVE 0  TO H-CAPI-OUTLIER-PART.                   17590000
374300                                                                  17600000
374400                                                                  15490000
374500     IF P-N-SCH-REBASED-FY90 OR                                   15500000
374600        P-N-EACH OR                                               15510000
374700        P-N-MDH-REBASED-FY90                                      15520000
374800         PERFORM 3450-CALC-ADDITIONAL-HSP.                        15530000
374900                                                                  15540000
375000                                                                  17610000
375100 3000-CONTINUE.                                                   17620000
375200                                                                  17630000
375300***********************************************************       17640000
375400***  DETERMINES THE FEDERAL AMOUNT THAT WOULD BE PAID IF          17650000
375500***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          17660000
375600                                                                  17670000
375700     COMPUTE H-CAPI2-B-FSP-PART ROUNDED = H-CAPI-FSP-PART.        17680000
375800                                                                  17690000
375900***********************************************************       17700000
376000                                                                  17710000
376100     IF  PPS-RTC = 67                                             17720000
376200         MOVE H-OPER-DOLLAR-THRESHOLD TO                          17730000
376300              WK-H-OPER-DOLLAR-THRESHOLD.                         17740000
376400                                                                  17750000
376500     IF  PPS-RTC < 50                                             17760000
376600         PERFORM 3800-CALC-TOT-AMT THRU 3800-EXIT                 17770000
376700     ELSE                                                         17780000
376800         MOVE ALL '0' TO PPS-OPER-HSP-PART                        17790000
376900                         PPS-OPER-FSP-PART                        17800000
377000                         PPS-OPER-OUTLIER-PART                    17810000
377100                         PPS-OUTLIER-DAYS                         17820000
377200                         PPS-REG-DAYS-USED                        17830000
377300                         PPS-LTR-DAYS-USED                        17840000
377400                         PPS-TOTAL-PAYMENT                        17850000
377500                         PPS-OPER-DSH-ADJ                         17860000
377600                         PPS-OPER-IME-ADJ                         17870000
377700                         H-DSCHG-FRCTN                            17880000
377800                         H-DRG-WT-FRCTN                           17890000
377900                         HOLD-ADDITIONAL-VARIABLES                17900000
378000                         HOLD-CAPITAL-VARIABLES                   17910000
378100                         HOLD-CAPITAL2-VARIABLES                  17920000
378200                         HOLD-OTHER-VARIABLES                     17930000
378300                         HOLD-PC-OTH-VARIABLES.                   17940000
378400                                                                  17950000
378500     IF  PPS-RTC = 67                                             17960000
378600         MOVE WK-H-OPER-DOLLAR-THRESHOLD TO                       17970000
378700                 H-OPER-DOLLAR-THRESHOLD.                         17980000
378800                                                                  17990000
378900 3000-EXIT.  EXIT.                                                18000000
379000                                                                  18010000
379100 3100-CALC-STAY-UTILIZATION.                                      18020000
379200                                                                  18030000
379300     MOVE 0 TO PPS-REG-DAYS-USED.                                 18040000
379400     MOVE 0 TO PPS-LTR-DAYS-USED.                                 18050000
379500                                                                  18060000
379600     IF H-REG-DAYS > 0                                            18070000
379700        IF H-REG-DAYS > B-LOS                                     18080000
379800           MOVE B-LOS TO PPS-REG-DAYS-USED                        18090000
379900        ELSE                                                      18100000
380000           MOVE H-REG-DAYS TO PPS-REG-DAYS-USED                   18110000
380100     ELSE                                                         18120000
380200        IF H-LTR-DAYS > B-LOS                                     18130000
380300           MOVE B-LOS TO PPS-LTR-DAYS-USED                        18140000
380400        ELSE                                                      18150000
380500           MOVE H-LTR-DAYS TO PPS-LTR-DAYS-USED.                  18160000
380600                                                                  18170000
380700                                                                  18180000
380800                                                                  18190000
380900 3300-CALC-OPER-FSP-AMT.                                          18200000
381000***********************************************************       18210000
381100***  OPERATING FSP CALCULATION                                    18220000
381200***  OPERATING FSP CALCULATION                                    18230000
381300                                                                  18240000
381400     COMPUTE H-OPER-FSP-PART ROUNDED =                            18250000
381500           (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +             18260000
381600            H-NAT-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18270000
381700                   ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.       18280000
381800                                                                  18290000
381900     IF P-NEW-STATE = 40                                          18300000
382000       COMPUTE H-OPER-FSP-PART ROUNDED =                          18310000
382100           (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +             18320000
382200            H-NAT-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18330000
382300                           +                                      18340000
382400           (H-REG-PCT * (H-REG-LABOR * H-PR-WAGE-INDEX +          18350000
382500            H-REG-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18360000
382600                   ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.       18370000
382700                                                                  18380000
382800                                                                  18390000
382900 3500-CALC-PERDIEM-AMT.                                           19020000
383000***********************************************************       19030000
383100***  REVIEW CODE = 03 OR 06                                       19040000
383200***  OPERATING PERDIEM-AMT CALCULATION                            19050000
383300***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              19060000
383400                                                                  19070000
383500        COMPUTE H-OPER-FSP-PART ROUNDED =                         19080000
383600        H-OPER-FSP-PART * H-TRANSFER-ADJ                          19090000
383700        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19100000
383800                                                                  19110000
383900***********************************************************       19120000
384000***********************************************************       19130000
384100***  REVIEW CODE = 03 OR 06                                       19140000
384200***  CAPITAL   PERDIEM-AMT CALCULATION                            19150000
384300***  CAPITAL   HSP AND FSP CALCULATION FOR TRANSFERS              19160000
384400                                                                  19170000
384500        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19180000
384600        H-CAPI-FSP-PART * H-TRANSFER-ADJ                          19190000
384700        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19200000
384800                                                                  19210000
384900***********************************************************       19220000
385000***  REVIEW CODE = 03 OR 06                                       19230000
385100***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19240000
385200***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19250000
385300                                                                  19260000
385400        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19270000
385500        H-CAPI-OLD-HARMLESS * H-TRANSFER-ADJ                      19280000
385600        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19290000
385700                                                                  19300000
385800 3550-CALC-PERDIEM-AMT.                                           19310000
385900***********************************************************       19320000
386000***  REVIEW CODE = 09  OR 11 TRANSFER WITH SPECIAL DRG            19330000
386100***  OPERATING PERDIEM-AMT CALCULATION                            19340000
386200***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              19350000
386300                                                                  19360000
386400     IF (B-DRG-POSTACUTE-50-50)                                   19370000
386500        MOVE 10 TO PPS-RTC                                        19380000
386600        COMPUTE H-OPER-FSP-PART ROUNDED =                         19390000
386700        H-OPER-FSP-PART * (.5 * (1 + H-TRANSFER-ADJ))             19400000
386800        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19410000
386900                                                                  19420000
387000     IF (B-DRG-POSTACUTE-PERDIEM)                                 19430000
387100        MOVE 12 TO PPS-RTC                                        19440000
387200        COMPUTE H-OPER-FSP-PART ROUNDED =                         19450000
387300        H-OPER-FSP-PART *  H-TRANSFER-ADJ                         19460000
387400        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19470000
387500                                                                  19480000
387600***********************************************************       19490000
387700***  CAPITAL PERDIEM-AMT CALCULATION                              19500000
387800***  CAPITAL HSP AND FSP CALCULATION FOR TRANSFERS                19510000
387900                                                                  19520000
388000     IF (B-DRG-POSTACUTE-50-50)                                   19530000
388100        MOVE 10 TO PPS-RTC                                        19540000
388200        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19550000
388300        H-CAPI-FSP-PART * (.5 * (1 + H-TRANSFER-ADJ))             19560000
388400        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19570000
388500                                                                  19580000
388600     IF (B-DRG-POSTACUTE-PERDIEM)                                 19590000
388700        MOVE 12 TO PPS-RTC                                        19600000
388800        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19610000
388900        H-CAPI-FSP-PART *  H-TRANSFER-ADJ                         19620000
389000        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19630000
389100                                                                  19640000
389200***********************************************************       19650000
389300***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19660000
389400***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19670000
389500                                                                  19680000
389600     IF (B-DRG-POSTACUTE-50-50)                                   19690000
389700        MOVE 10 TO PPS-RTC                                        19700000
389800        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19710000
389900        H-CAPI-OLD-HARMLESS * (.5 * (1 + H-TRANSFER-ADJ))         19720000
390000        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19730000
390100                                                                  19740000
390200     IF (B-DRG-POSTACUTE-PERDIEM)                                 19750000
390300        MOVE 12 TO PPS-RTC                                        19760000
390400        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19770000
390500        H-CAPI-OLD-HARMLESS *  H-TRANSFER-ADJ                     19780000
390600        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19790000
390700                                                                  19800000
390800 3560-CHECK-RTN-CODE.                                             19810000
390900                                                                  19820000
391000     IF (B-DRG-POSTACUTE-50-50)                                   19830000
391100        MOVE 10 TO PPS-RTC.                                       19840000
391200     IF (B-DRG-POSTACUTE-PERDIEM)                                 19850000
391300        MOVE 12 TO PPS-RTC.                                       19860000
391400                                                                  19870000
391500 3560-EXIT.    EXIT.                                              19880000
391600                                                                  19890000
391700 3600-CALC-OUTLIER.                                               19900000
391800***********************************************************       19910000
391900***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               19920000
392000***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               19930000
392100                                                                  19940000
392200     IF OUTLIER-RECON-FLAG = 'Y'                                  19950000
392300        COMPUTE H-OPER-CSTCHG-RATIO ROUNDED =                     19960000
392400               (H-OPER-CSTCHG-RATIO + .2).                        19970000
392500                                                                  19980000
392600     IF H-CAPI-CSTCHG-RATIO > 0 OR                                19990000
392700       H-OPER-CSTCHG-RATIO > 0                                    20000000
392800        COMPUTE H-OPER-SHARE-DOLL-THRESHOLD ROUNDED =             20010000
392900                H-OPER-CSTCHG-RATIO /                             20020000
393000               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        20030000
393100        COMPUTE H-CAPI-SHARE-DOLL-THRESHOLD ROUNDED =             20040000
393200                H-CAPI-CSTCHG-RATIO /                             20050000
393300               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        20060000
393400     ELSE                                                         20070000
393500         MOVE 0 TO H-OPER-SHARE-DOLL-THRESHOLD                    20080000
393600                   H-CAPI-SHARE-DOLL-THRESHOLD.                   20090000
393700                                                                  20100000
393800***********************************************************       20110000
393900*****YEARCHANGE 2010.0 ************************************       20110000
394000***  OUTLIER THRESHOLD AMOUNTS                                    20120000
394100***  OUTLIER THRESHOLD AMOUNTS                                    20130000
394200                                                                  20140000
394300*****YEARCHANGE 2011.0 ************************************       20110000
394400                                                                  20140000
394500     MOVE 23075.00 TO H-CST-THRESH.                               20150000
394600                                                                  20140000
394700*****YEARCHANGE 2011.0 ************************************       20110000
394800                                                                  20160000
394900     IF (B-REVIEW-CODE = '03') AND                                20170000
395000         H-PERDIEM-DAYS < H-ALOS                                  20180000
395100        COMPUTE H-CST-THRESH ROUNDED =                            20190000
395200                      (H-CST-THRESH * H-TRANSFER-ADJ)             20200000
395300                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20210000
395400                                                                  20220000
395500     IF ((B-REVIEW-CODE = '09') AND                               20230000
395600         (H-PERDIEM-DAYS < H-ALOS))                               20240000
395700         IF (B-DRG-POSTACUTE-PERDIEM)                             20250000
395800            COMPUTE H-CST-THRESH ROUNDED =                        20260000
395900                      (H-CST-THRESH * H-TRANSFER-ADJ)             20270000
396000                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20280000
396100                                                                  20290000
396200     IF ((B-REVIEW-CODE = '09') AND                               20300000
396300         (H-PERDIEM-DAYS < H-ALOS))                               20310000
396400         IF (B-DRG-POSTACUTE-50-50)                               20320000
396500           COMPUTE H-CST-THRESH ROUNDED =                         20330000
396600          (H-CST-THRESH * (.5 * (1 + H-TRANSFER-ADJ)))            20340000
396700                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20350000
396800                                                                  20360000
396900     COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                    20370000
397000        ((H-CST-THRESH * H-LABOR-PCT * H-WAGE-INDEX) +            20380000
397100         (H-CST-THRESH * H-NONLABOR-PCT * H-OPER-COLA)) *         20390000
397200          H-OPER-SHARE-DOLL-THRESHOLD.                            20400000
397300                                                                  20410000
397400     IF P-NEW-STATE = 40                                          20420000
397500        COMPUTE H-OPER-PR-DOLLAR-THRESHOLD ROUNDED =              20430000
397600           ((H-CST-THRESH * H-PR-LABOR-PCT * H-PR-WAGE-INDEX) +   20440000
397700            (H-CST-THRESH * H-PR-NONLABOR-PCT * H-OPER-COLA)) *   20450000
397800             H-OPER-SHARE-DOLL-THRESHOLD                          20460000
397900        COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                 20470000
398000               (H-OPER-DOLLAR-THRESHOLD * H-NAT-PCT) +            20480000
398100               (H-OPER-PR-DOLLAR-THRESHOLD * H-REG-PCT).          20490000
398200                                                                  20500000
398300***********************************************************       20510000
398400                                                                  20520000
398500     COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                    20530000
398600          H-CST-THRESH * H-CAPI-GAF * H-CAPI-LARG-URBAN *         20540000
398700          H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA.              20550000
398800                                                                  20560000
398900                                                                  20570000
399000     IF P-NEW-STATE = 40                                          20580000
399100        COMPUTE H-CAPI-PR-DOLLAR-THRESHOLD ROUNDED =              20590000
399200           H-CST-THRESH * H-PR-CAPI-GAF * H-CAPI-LARG-URBAN *     20600000
399300           H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA              20610000
399400        COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                 20620000
399500               (H-CAPI-DOLLAR-THRESHOLD * H-NAT-PCT) +            20630000
399600               (H-CAPI-PR-DOLLAR-THRESHOLD * H-REG-PCT).          20640000
399700                                                                  20650000
399800                                                                  20660000
399900     COMPUTE H-OPER-COST-OUTLIER ROUNDED =                        20670000
400000      (H-OPER-FSP-PART * (1 + H-OPER-IME-TEACH + H-OPER-DSH))     20680000
400100                       +                                          20690000
400200             H-OPER-DOLLAR-THRESHOLD                              20700000
400300                       +                                          20710000
400400                 H-NEW-TECH-PAY-ADD-ON.                           20720000
400500                                                                  20730000
400600     COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                        20740000
400700      (H-CAPI-FSP-PART * (1 + H-WK-CAPI-IME-TEACH + H-CAPI-DSH))  20750000
400800                       +                                          20760000
400900             H-CAPI-DOLLAR-THRESHOLD.                             20770000
401000                                                                  20780000
401100     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               20790000
401200         MOVE 0 TO H-CAPI-COST-OUTLIER.                           20800000
401300                                                                  20810000
401400                                                                  20820000
401500***********************************************************       20830000
401600***  OPERATING COST CALCULATION                                   20840000
401700***  OPERATING COST CALCULATION                                   20850000
401800                                                                  20860000
401900     COMPUTE H-OPER-BILL-COSTS ROUNDED =                          20870000
402000         B-CHARGES-CLAIMED * H-OPER-CSTCHG-RATIO                  20880000
402100         ON SIZE ERROR MOVE 0 TO H-OPER-BILL-COSTS.               20890000
402200                                                                  20900000
402300                                                                  20910000
402400     IF  H-OPER-BILL-COSTS > H-OPER-COST-OUTLIER                  20920000
402500         COMPUTE H-OPER-OUTCST-PART ROUNDED =                     20930000
402600         H-CSTOUT-PCT * (H-OPER-BILL-COSTS -                      20940000
402700                         H-OPER-COST-OUTLIER).                    20950000
402800                                                                  20960000
402900     IF PAY-WITHOUT-COST OR                                       20970000
403000        PAY-XFER-NO-COST OR                                       20980000
403100        PAY-XFER-SPEC-DRG-NO-COST                                 20990000
403200         MOVE 0 TO H-OPER-OUTCST-PART.                            21000000
403300                                                                  21010000
403400***********************************************************       21020000
403500***  CAPITAL COST CALCULATION                                     21030000
403600***  CAPITAL COST CALCULATION                                     21040000
403700                                                                  21050000
403800     COMPUTE H-CAPI-BILL-COSTS ROUNDED =                          21060000
403900             B-CHARGES-CLAIMED * H-CAPI-CSTCHG-RATIO              21070000
404000         ON SIZE ERROR MOVE 0 TO H-CAPI-BILL-COSTS.               21080000
404100                                                                  21090000
404200     IF  H-CAPI-BILL-COSTS > H-CAPI-COST-OUTLIER                  21100000
404300         COMPUTE H-CAPI-OUTCST-PART ROUNDED =                     21110000
404400         H-CSTOUT-PCT * (H-CAPI-BILL-COSTS -                      21120000
404500                         H-CAPI-COST-OUTLIER).                    21130000
404600                                                                  21140000
404700     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             21150000
404800       COMPUTE H-CAPI-OUTCST-PART ROUNDED =                       21160000
404900              (H-CAPI-OUTCST-PART * P-NEW-CAPI-NEW-HARM-RATIO).   21170000
405000                                                                  21180000
405100     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             21190000
405200        COMPUTE H-CAPI-OUTCST-PART ROUNDED =                      21200000
405300               (H-CAPI-OUTCST-PART * H-CAPI-PAYCDE-PCT1).         21210000
405400                                                                  21220000
405500     IF (H-CAPI-BILL-COSTS   + H-OPER-BILL-COSTS) <               21230000
405600        (H-CAPI-COST-OUTLIER + H-OPER-COST-OUTLIER)               21240000
405700        MOVE 0 TO H-CAPI-OUTCST-PART                              21250000
405800                  H-OPER-OUTCST-PART.                             21260000
405900                                                                  21270000
406000     IF PAY-WITHOUT-COST OR                                       21280000
406100        PAY-XFER-NO-COST OR                                       21290000
406200        PAY-XFER-SPEC-DRG-NO-COST                                 21300000
406300         MOVE 0 TO H-CAPI-OUTCST-PART.                            21310000
406400                                                                  21320000
406500***********************************************************       21330000
406600***  DETERMINES THE BILL TO BE COST  OUTLIER                      21340000
406700                                                                  21350000
406800     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               21360000
406900         MOVE 0 TO H-CAPI-OUTDAY-PART                             21370000
407000                   H-CAPI-OUTCST-PART.                            21380000
407100                                                                  21390000
407200     IF (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0             21400000
407300                 MOVE H-OPER-OUTCST-PART TO                       21410000
407400                      H-OPER-OUTLIER-PART                         21420000
407500                 MOVE H-CAPI-OUTCST-PART TO                       21430000
407600                      H-CAPI-OUTLIER-PART                         21440000
407700                 MOVE 02 TO PPS-RTC.                              21450000
407800                                                                  21460000
407900     IF OUTLIER-RECON-FLAG = 'Y'                                  21470000
408000        IF (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0          21480000
408100           COMPUTE HLD-PPS-RTC = HLD-PPS-RTC + 30                 21490000
408200           GO TO 3600-EXIT                                        21500000
408300        ELSE                                                      21510000
408400           GO TO 3600-EXIT                                        21520000
408500     ELSE                                                         21530000
408600        NEXT SENTENCE.                                            21540000
408700                                                                  21550000
408800                                                                  21560000
408900***********************************************************       21570000
409000***  DETERMINES IF COST OUTLIER                                   21580000
409100***  RECOMPUTES DOLLAR THRESHOLD TO BE SENT BACK WITH             21590000
409200***         RETURN CODE OF 02                                     21600000
409300                                                                  21610000
409400     MOVE 0 TO H-OPER-DOLLAR-THRESHOLD.                           21620000
409500                                                                  21630000
409600     IF PPS-RTC = 02                                              21640000
409700             COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =            21650000
409800                     (H-CAPI-COST-OUTLIER  +                      21660000
409900                      H-OPER-COST-OUTLIER)                        21670000
410000                             /                                    21680000
410100                    (H-CAPI-CSTCHG-RATIO  +                       21690000
410200                     H-OPER-CSTCHG-RATIO)                         21700000
410300             ON SIZE ERROR MOVE 0 TO H-OPER-DOLLAR-THRESHOLD.     21710000
410400                                                                  21720000
410500***********************************************************       21730000
410600***  DETERMINES IF COST OUTLIER WITH LOS IS > COVERED  DAYS       21740000
410700***         RETURN CODE OF 67                                     21750000
410800                                                                  21760000
410900     IF PPS-RTC = 02                                              21770000
411000         IF ((H-REG-DAYS + H-LTR-DAYS) < B-LOS) OR                21780000
411100            PPS-PC-COT-FLAG = 'Y'                                 21790000
411200             MOVE 67 TO PPS-RTC.                                  21800000
411300***********************************************************       21810000
411400                                                                  21820000
411500***********************************************************       21830000
411600***  DETERMINES THE OUTLIER AMOUNT THAT WOULD BE PAID IF          21840000
411700***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          21850000
411800                                                                  21860000
411900     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             21870000
412000        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21880000
412100                H-CAPI-OUTLIER-PART / P-NEW-CAPI-NEW-HARM-RATIO   21890000
412200         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          21900000
412300                                                                  21910000
412400     IF P-NEW-CAPI-PPS-PAY-CODE = 'B'                             21920000
412500        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21930000
412600                H-CAPI-OUTLIER-PART.                              21940000
412700                                                                  21950000
412800     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             21960000
412900        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21970000
413000                H-CAPI-OUTLIER-PART / H-CAPI-PAYCDE-PCT1          21980000
413100         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          21990000
413200                                                                  22000000
413300 3600-EXIT.   EXIT.                                               22010000
413400                                                                  22020000
413500 3450-CALC-ADDITIONAL-HSP.                                        18400000
413600***********************************************************       18410000
413700*    OBRA 89 CALCULATE ADDITIONAL HSP PAYMENT FOR                 18420000
413800*    SOLE COMMUNITY                                               18430000
413900*    AND ESSENTIAL ACCESS COMMUNITY HOSPITALS (EACH)              18440000
414000*    NOW REIMBURSED WITH 100% NATIONAL FEDERAL RATES              18450000
414100***********************************************************       18460000
414200*****YEARCHANGE 2010.0 ****************************************   18470000
414300***         GET THE UPDATING FACTOR                               18480000
414400***         GET THE UPDATING FACTOR                               18490000
414500                                                                  18500000
414600     MOVE 0.995743 TO H-BUDG-NUTR08.                              18510000
414700     MOVE 0.998795 TO H-BUDG-NUTR09.                              18510000
414800*****YEARCHANGE 2010.0 ****************************************   18470000
414900     MOVE 0.997941 TO H-BUDG-NUTR10.                              18510000
415000*****YEARCHANGE 2010.9 ****************************************   18470000
415100     MOVE 0.997935 TO H-BUDG-NUTR109.                             18510000
415200*****YEARCHANGE 2011.0 ****************************************   18470000
415300     MOVE 0.996731 TO H-BUDG-NUTR113.                             18510000
415400*****YEARCHANGE 2011.0 ****************************************   18470000
415500                                                                  18520000
415600     MOVE 1.0330 TO H-UPDATE-08.                                  18530000
415700
415800*****YEARCHANGE 2009.0 ****************************************   18470000
415900     MOVE 1.0360 TO H-UPDATE-09.
416000*****YEARCHANGE 2009.0 ****************************************   18470000
416100*****YEARCHANGE 2010.0 ****************************************   18470000
416200        MOVE 1.0210 TO H-UPDATE-10
416300*****YEARCHANGE 2010.0 ****************************************   18470000
416400*****YEARCHANGE 2010.9 ****************************************   18470000
416500        MOVE 1.0185 TO H-UPDATE-109
416600*****YEARCHANGE 2010.9 ****************************************   18470000
416700
416800     IF P-NEW-CBSA-HOSP-QUAL-IND = '1'
416900*****YEARCHANGE 2011.0 ****************************************   18470000
417000        MOVE 1.0235 TO H-UPDATE-113
417100     ELSE
417200        MOVE 1.0025 TO H-UPDATE-113.
417300*****YEARCHANGE 2011.0 ****************************************   18470000
417400
417500     IF P-NEW-STATE = 40                                          16790000
417600*****YEARCHANGE 2010.96****************************************   18470000
417700        MOVE 1.0210 TO H-UPDATE-109.
417800*****YEARCHANGE 2010.9 ****************************************   18470000
417900
418000     IF P-NEW-STATE = 40                                          16790000
418100*****YEARCHANGE 2011.0 ****************************************   18470000
418200        MOVE 1.0235 TO H-UPDATE-113.
418300*****YEARCHANGE 2011.0 ****************************************   18470000
418400
418500********YEARCHANGE 2011.0 *************************************   18590000
418600***         CASE MIX ADJUSTMENT - BROUGHT BACK FOR 2011           18480000
418700***         CASE MIX ADJUSTMENT - BROUGHT BACK FOR 2011           18480000
418800     MOVE 0.9718 TO H-CASE-MIX-ADJ.                                     00
418900
419000     COMPUTE H-UPDATE-FACTOR ROUNDED =
419100                       (H-UPDATE-08 * H-UPDATE-09 *
419200                        H-UPDATE-109 * H-UPDATE-113 *
419300                        H-BUDG-NUTR08 * H-BUDG-NUTR09 *
419400                        H-BUDG-NUTR109 * H-BUDG-NUTR113 *
419500                        H-CASE-MIX-ADJ).                                00
419600
419700     COMPUTE H-HSP-RATE ROUNDED =
419800         H-FAC-SPEC-RATE * H-UPDATE-FACTOR * H-DRG-WT.
419900***************************************************************
420000*
420100*    IF P-NEW-CBSA-HOSP-QUAL-IND = '1'                            18537000
420200*       COMPUTE H-HSP-RATE ROUNDED =                              18538000
420300*        (H-FAC-SPEC-RATE * 1) * H-UPDATE-FACTOR                  18539000
420400*    ELSE                                                         18540000
420500*       COMPUTE H-HSP-RATE ROUNDED =                              18550000
420600*        ((H-FAC-SPEC-RATE / 1.036) * 1.016) * H-UPDATE-FACTOR.   18560000
420700*                                                                 18570000
420800***************************************************************   18580000
420900********YEARCHANGE 2011.0 *************************************   18590000
421000***     OUTLIER OFFSETS                                           18591000
421100***     OPERATING NATIONAL                                        18600000
421200***     OPERATING PUERTO RICO BLEND                               18610000
421300                                                                  18620000
421400********YEARCHANGE 2011.0 *************************************   18590000
421500                                                                  18620000
421600      MOVE 0.948999 TO H-OUTLIER-OFFSET-NAT                       18630000
421700      MOVE 0.948079 TO H-OUTLIER-OFFSET-PR.                       18640000
421800                                                                  18620000
421900********YEARCHANGE 2011.0 *************************************   18590000
422000***************************************************************   18660000
422100     COMPUTE H-FSP-RATE ROUNDED =                                 18670000
422200        ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +               18680000
422300         H-NAT-NONLABOR * H-OPER-COLA)) * H-DRG-WT)               18690000
422400                           *                                      18700000
422500     (1 + H-OPER-IME-TEACH + H-OPER-DSH) +
422600                         H-OPER-OUTLIER-PART
422700                   ON SIZE ERROR MOVE 0 TO H-FSP-RATE.            18720000
422800                                                                  18730000
422900     IF P-NEW-STATE = 40                                          18740000
423000       COMPUTE H-FSP-RATE ROUNDED =                               18750000
423100         ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +              18760000
423200         H-NAT-NONLABOR * H-OPER-COLA))  * H-DRG-WT)              18770000
423300                           *                                      18780000
423400         (1 + H-OPER-IME-TEACH + H-OPER-DSH) +                    187810
423500                            H-OPER-OUTLIER-PART                   187820
423600                               +                                  187830
423700        ((H-REG-PCT * (H-REG-LABOR * H-PR-WAGE-INDEX +            18790000
423800         H-REG-NONLABOR * H-OPER-COLA)) * H-DRG-WT)               18800000
423900                           *                                      18810000
424000       (1 + H-OPER-IME-TEACH + H-OPER-DSH)
424100                   ON SIZE ERROR MOVE 0 TO H-FSP-RATE.            18830000
424200                                                                  18840000
424300                                                                  18850000
424400     IF  H-HSP-RATE > H-FSP-RATE                                  18860000
424500           COMPUTE H-OPER-HSP-PART ROUNDED =                      18870000
424600             (H-HSP-RATE - H-FSP-RATE)                            18880000
424700                   ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART        18890000
424800     ELSE                                                         18900000
424900         MOVE 0 TO H-OPER-HSP-PART.                               18910000
425000                                                                  18920000
425100***************************************************************   18930000
425200***         GET THE MDH REBASE                                    18940000
425300                                                                  18950000
425400     IF  H-HSP-RATE > H-FSP-RATE                                  18960000
425500         IF P-NEW-PROVIDER-TYPE = '14' OR '15'                    18970000
425600           COMPUTE H-OPER-HSP-PART ROUNDED =                      18980000
425700             (H-HSP-RATE - H-FSP-RATE) * .75                      18990000
425800                   ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART.       19000000
425900                                                                  19010000
426000***********************************************************       22030000
426100 3800-CALC-TOT-AMT.                                               22040000
426200***********************************************************       22050000
426300***  CALCULATE TOTALS FOR CAPITAL                                 22060000
426400***  CALCULATE TOTALS FOR CAPITAL                                 22070000
426500                                                                  22080000
426600     MOVE P-NEW-CAPI-PPS-PAY-CODE  TO H-CAPI2-PAY-CODE.           22090000
426700                                                                  22100000
426800     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             22110000
426900        MOVE P-NEW-CAPI-NEW-HARM-RATIO TO H-CAPI-FSP-PCT          22120000
427000        MOVE 0.00 TO H-CAPI-HSP-PCT.                              22130000
427100                                                                  22140000
427200     IF P-NEW-CAPI-PPS-PAY-CODE = 'B'                             22150000
427300        MOVE 0    TO H-CAPI-OLD-HARMLESS                          22160000
427400        MOVE 1.00 TO H-CAPI-FSP-PCT                               22170000
427500        MOVE 0.00 TO H-CAPI-HSP-PCT.                              22180000
427600                                                                  22190000
427700     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             22200000
427800        MOVE 0    TO H-CAPI-OLD-HARMLESS                          22210000
427900        MOVE H-CAPI-PAYCDE-PCT1 TO H-CAPI-FSP-PCT                 22220000
428000        MOVE H-CAPI-PAYCDE-PCT2 TO H-CAPI-HSP-PCT.                22230000
428100                                                                  22240000
428200     COMPUTE H-CAPI-HSP ROUNDED =                                 22250000
428300         H-CAPI-HSP-PCT * H-CAPI-HSP-PART.                        22260000
428400                                                                  22270000
428500     COMPUTE H-CAPI-FSP ROUNDED =                                 22280000
428600         H-CAPI-FSP-PCT * H-CAPI-FSP-PART.                        22290000
428700                                                                  22300000
428800     MOVE P-NEW-CAPI-EXCEPTIONS TO H-CAPI-EXCEPTIONS.             22310000
428900                                                                  22320000
429000     MOVE H-CAPI-OLD-HARMLESS TO H-CAPI-OLD-HARM.                 22330000
429100                                                                  22340000
429200     COMPUTE H-CAPI-DSH-ADJ ROUNDED =                             22350000
429300             H-CAPI-FSP                                           22360000
429400              * H-CAPI-DSH.                                       22370000
429500                                                                  22380000
429600     COMPUTE H-CAPI-IME-ADJ ROUNDED =                             22390000
429700          H-CAPI-FSP *                                            22400000
429800                 H-WK-CAPI-IME-TEACH.                             22410000
429900                                                                  22420000
430000     COMPUTE H-CAPI-OUTLIER ROUNDED =                             22430000
430100             1.00 * H-CAPI-OUTLIER-PART.                          22440000
430200                                                                  22450000
430300     COMPUTE H-CAPI2-B-FSP ROUNDED =                              22460000
430400             1.00 * H-CAPI2-B-FSP-PART.                           22470000
430500                                                                  22480000
430600     COMPUTE H-CAPI2-B-OUTLIER ROUNDED =                          22490000
430700             1.00 * H-CAPI2-B-OUTLIER-PART.                       22500000
430800***********************************************************       22510000
430900***  IF CAPITAL IS NOT IN EFFECT FOR GIVEN PROVIDER               22520000
431000***        THIS ZEROES OUT ALL CAPITAL DATA                       22530000
431100                                                                  22540000
431200     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               22550000
431300        MOVE ALL '0' TO HOLD-CAPITAL-VARIABLES.                   22560000
431400***********************************************************       22570000
431500                                                                  22580000
431600***********************************************************       22590000
431700***  CALCULATE FINAL TOTALS FOR OPERATING                         22600000
431800***  CALCULATE FINAL TOTALS FOR OPERATING                         22610000
431900                                                                  22620000
432000     IF (H-CAPI-OUTLIER > 0 AND                                   22630000
432100         PPS-OPER-OUTLIER-PART = 0)                               22640000
432200            COMPUTE PPS-OPER-OUTLIER-PART =                       22650000
432300                    PPS-OPER-OUTLIER-PART + .01.                  22660000
432400                                                                  22670000
432500     MOVE 01.000 TO WK-LOW-VOL25PCT.                              22680000
432600                                                                  22690000
432700     IF P-NEW-TEMP-RELIEF-IND = 'Y'                               22700000
432800     MOVE P-NEW-PROVIDER-NO      TO MES-PPS-PROV                  13830000
432900     PERFORM 4400-LOWVOL-CODE-RTN THRU 4400-EXIT.
433000
433100*****SET THE LOW-VOLUME DISCHARGE PERCENT
433200**   ADD ON TO 25% FOR DISCHARGES
433300
433400     IF P-NEW-TEMP-RELIEF-IND = 'Y'
433500     AND MESWK-LOWVOL-PROV-DISCHG < 200
433600            MOVE 00.250 TO WK-LOW-VOL25PCT
433700            GO TO LOW-VOL-CALC.
433800
433900***  CALCULATE THE LOW VOLUME DISCHARGE PERCENT
434000***  SLIDING SCALE ADD ON FOR
434100
434200     IF P-NEW-TEMP-RELIEF-IND = 'Y'
434300        AND MESWK-LOWVOL-PROV-DISCHG > 200
434400        AND MESWK-LOWVOL-PROV-DISCHG < 1600
434500            COMPUTE  WK-LOW-VOL25PCT ROUNDED =
434600            ((4 / 14) - (MESWK-LOWVOL-PROV-DISCHG / 5600))
434700            GO TO LOW-VOL-CALC
434800     ELSE
434900           MOVE 01.000 TO WK-LOW-VOL25PCT.
435000
435100 LOW-VOL-CALC.
435200
435300     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               22730000
435400                                                                  22740000
435500     IF  H-OPER-DSH NUMERIC                                       22750000
435600         COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                       22760000
435700                          PPS-OPER-FSP-PART  * H-OPER-DSH.        22770000
435800                                                                  22780000
435900     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           22790000
436000                         PPS-OPER-FSP-PART * H-OPER-IME-TEACH.    22800000
436100                                                                  22810000
436200                                                                  22820000
436300     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          22830000
436400                           H-OPER-FSP-PART * H-OPER-FSP-PCT.      22840000
436500                                                                  22850000
436600     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          22860000
436700                           H-OPER-HSP-PART * H-OPER-HSP-PCT.      22870000
436800                                                                  22880000
436900     COMPUTE PPS-OPER-OUTLIER-PART ROUNDED =                      22890000
437000                         H-OPER-OUTLIER-PART * H-OPER-FSP-PCT.    22900000
437100                                                                  22910000
437200     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    23040000
437300                                H-NEW-TECH-PAY-ADD-ON.            23050000
437400                                                                  23060000
437500     IF  WK-LOW-VOL25PCT < 1.000000                                     00
437600     COMPUTE WK-LOW-VOL-ADDON  ROUNDED =                          23040000
437700              (PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +            23154000
437800               PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +         23155000
437900                      PPS-OPER-IME-ADJ                            23156000
438000                           +                                      23157000
438100             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        23000000
438200             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    23010000
438300             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM +                   23020000
438400                 PPS-NEW-TECH-PAY-ADD-ON) *  WK-LOW-VOL25PCT      23158000
438500     ELSE
438600     COMPUTE WK-LOW-VOL-ADDON  ROUNDED = 0.000000.                23040000
438700                                                                  23060000
438800     COMPUTE H-LOW-VOL-PAYMENT ROUNDED = WK-LOW-VOL-ADDON.        23040000
438900                                                                  23060000
439000     IF HMO-TAG  = 'Y'                                            22920000
439100        PERFORM 3850-HMO-IME-ADJ.                                 22930000
439200                                                                  22940000
439300***********************************************************       22950000
439400***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             22960000
439500***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             22970000
439600                                                                  22980000
439700     COMPUTE H-CAPI-TOTAL-PAY ROUNDED =                           22990000
439800             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        23000000
439900             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    23010000
440000             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM.                    23020000
440100                                                                  23030000
440200     COMPUTE   PPS-TOTAL-PAYMENT ROUNDED =                        23153000
440300               PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +            23154000
440400               PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +         23155000
440500                      PPS-OPER-IME-ADJ                            23156000
440600                           +                                      23157000
440700                 PPS-NEW-TECH-PAY-ADD-ON                          23158000
440800                           +                                      23159000
440900                  WK-LOW-VOL-ADDON                                23159000
441000                           +                                      23159000
441100                 H-WK-PASS-AMT-PLUS-MISC                          23160000
441200                           +                                      23170000
441300                   H-CAPI-TOTAL-PAY.                              23180000
441400                                                                  23190000
441500 3800-EXIT.   EXIT.                                               24540000
441600                                                                  24550000
441700 3850-HMO-IME-ADJ.                                                23200000
441800***********************************************************       23210000
441900***  HMO CALC FOR PASS-THRU ADDON                                 23220000
442000***  HMO CALC FOR PASS-THRU ADDON                                 23230000
442100                                                                  23240000
442200     COMPUTE H-WK-PASS-AMT-PLUS-MISC ROUNDED =                    23250000
442300          (P-NEW-PASS-AMT-PLUS-MISC -                             23260000
442400          (P-NEW-PASS-AMT-ORGAN-ACQ +                             23270000
442500           P-NEW-PASS-AMT-DIR-MED-ED)) * B-LOS.                   23280000
442600                                                                  23290000
442700***********************************************************       23300000
442800***  HMO IME ADJUSTMENT --- NO LONGER PAID AS OF 10/01/2002       23310000
442900                                                                  23320000
443000     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           23330000
443100                   PPS-OPER-IME-ADJ * .0.                         23340000
443200                                                                  23350000
443300***********************************************************       23360000
443400                                                                  23370000
443500                                                                  23380000
443600 3900A-CALC-OPER-DSH.                                             23390000
443700                                                                  23400000
443800***  OPERATING DSH CALCULATION                                    23410000
443900***  OPERATING DSH CALCULATION                                    23420000
444000                                                                  23430000
444100      MOVE 0.0000 TO H-OPER-DSH.                                  23440000
444200                                                                  23450000
444300      COMPUTE H-WK-OPER-DSH ROUNDED  = (P-NEW-SSI-RATIO           23460000
444400                                     + P-NEW-MEDICAID-RATIO).     23470000
444500                                                                  23480000
444600***********************************************************       23490000
444700**1**    0-99 BEDS                                                23500000
444800***  NOT TO EXCEED 12%                                            23510000
444900                                                                  23520000
445000      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE < 100      23530000
445100                               AND H-WK-OPER-DSH > .1499          23540000
445200                               AND H-WK-OPER-DSH < .2020          23550000
445300        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23560000
445400                                      * .65 + .025                23570000
445500        IF H-OPER-DSH > .1200  MOVE .1200 TO H-OPER-DSH.          23580000
445600                                                                  23590000
445700      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE < 100      23600000
445800                               AND H-WK-OPER-DSH > .2019          23610000
445900        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23620000
446000                                      * .825 + .0588              23630000
446100        IF H-OPER-DSH > .1200  MOVE .1200 TO H-OPER-DSH.          23640000
446200                                                                  23650000
446300***********************************************************       23660000
446400**2**   100 + BEDS                                                23670000
446500***  NO CAP >> CAN EXCEED 12%                                     23680000
446600                                                                  23690000
446700      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99       23700000
446800                               AND H-WK-OPER-DSH > .1499          23710000
446900                               AND H-WK-OPER-DSH < .2020          23720000
447000        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23730000
447100                                      * .65 + .025.               23740000
447200                                                                  23750000
447300      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99       23760000
447400                               AND H-WK-OPER-DSH > .2019          23770000
447500        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23780000
447600                                      * .825 + .0588.             23790000
447700                                                                  23800000
447800***********************************************************       23810000
447900**3**   OTHER RURAL HOSPITALS LESS THEN 500 BEDS                  23820000
448000***  NOT TO EXCEED 12%                                            23830000
448100                                                                  23840000
448200      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE < 500           23850000
448300                               AND H-WK-OPER-DSH > .1499          23860000
448400                               AND H-WK-OPER-DSH < .2020          23870000
448500        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23880000
448600                                 * .65 + .025                     23890000
448700        IF H-OPER-DSH > .1200                                     23900000
448800              MOVE .1200 TO H-OPER-DSH.                           23910000
448900                                                                  23920000
449000      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE < 500           23930000
449100                               AND H-WK-OPER-DSH > .2019          23940000
449200        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23950000
449300                                 * .825 + .0588                   23960000
449400        IF H-OPER-DSH > .1200                                     23970000
449500                 MOVE .1200 TO H-OPER-DSH.                        23980000
449600***********************************************************       23990000
449700**4**   OTHER RURAL HOSPITALS 500 BEDS +                          24000000
449800***  NO CAP >> CAN EXCEED 12%                                     24010000
449900                                                                  24020000
450000      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE > 499           24030000
450100                               AND H-WK-OPER-DSH > .1499          24040000
450200                               AND H-WK-OPER-DSH < .2020          24050000
450300        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        24060000
450400                                 * .65 + .025.                    24070000
450500                                                                  24080000
450600      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE > 499           24090000
450700                               AND H-WK-OPER-DSH > .2019          24100000
450800        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       24110000
450900                                 * .825 + .0588.                  24120000
451000                                                                  24130000
451100***********************************************************       24140000
451200**7**   RURAL HOSPITALS SCH                                       24150000
451300***  NOT TO EXCEED 12%                                            24160000
451400                                                                  24170000
451500      IF W-CBSA-SIZE = 'R'                                        24180000
451600         IF (P-NEW-PROVIDER-TYPE = '16' OR '17' OR '21' OR '22')  24190000
451700                               AND H-WK-OPER-DSH > .1499          24200000
451800                               AND H-WK-OPER-DSH < .2020          24210000
451900         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)       24220000
452000                                 * .65 + .025                     24230000
452100        IF H-OPER-DSH > .1200                                     24240000
452200                 MOVE .1200 TO H-OPER-DSH.                        24250000
452300                                                                  24260000
452400      IF W-CBSA-SIZE = 'R'                                        24270000
452500         IF (P-NEW-PROVIDER-TYPE = '16' OR '17' OR '21' OR '22')  24280000
452600                               AND H-WK-OPER-DSH > .2019          24290000
452700         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)      24300000
452800                                 * .825 + .0588                   24310000
452900        IF H-OPER-DSH > .1200                                     24320000
453000                 MOVE .1200 TO H-OPER-DSH.                        24330000
453100                                                                  24340000
453200***********************************************************       24350000
453300**6**   RURAL HOSPITALS RRC   RULE 5 & 6 SAME                     24360000
453400***  RRC OVERRIDES SCH CAP                                        24370000
453500***  NO CAP >> CAN EXCEED 12%                                     24380000
453600                                                                  24390000
453700         IF (P-NEW-PROVIDER-TYPE = '07' OR '14' OR '15' OR        24400000
453800                                   '17' OR '22')                  24410000
453900                               AND H-WK-OPER-DSH > .1499          24420000
454000                               AND H-WK-OPER-DSH < .2020          24430000
454100         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)       24440000
454200                                 * .65 + .025.                    24450000
454300                                                                  24450000
454400         IF (P-NEW-PROVIDER-TYPE = '07' OR '14' OR '15' OR        24460000
454500                                   '17' OR '22')                  24470000
454600                               AND H-WK-OPER-DSH > .2019          24480000
454700         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)      24490000
454800                                 * .825 + .0588.                  24500000
454900                                                                  24510000
455000      COMPUTE H-OPER-DSH ROUNDED = H-OPER-DSH * 1.0000.           24520000
455100                                                                  24530000
455200 3900A-EXIT.   EXIT.                                              24540000
455300                                                                  24550000
455400 4000-CALC-TECH-ADDON.                                            24560000
455500                                                                  24570000
455600***********************************************************       24580000
455700***  CALCULATE TOTALS FOR OPERATING  ADD ON FOR TECH              24590000
455800***  CALCULATE TOTALS FOR OPERATING  ADD ON FOR TECH              24600000
455900                                                                  24610000
456000     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          24620000
456100         H-OPER-HSP-PCT * H-OPER-HSP-PART.                        24630000
456200                                                                  24640000
456300     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          24650000
456400         H-OPER-FSP-PCT * H-OPER-FSP-PART.                        24660000
456500                                                                  24670000
456600     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               24680000
456700                                                                  24690000
456800     IF  H-OPER-DSH NUMERIC                                       24700000
456900             COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                   24710000
457000              PPS-OPER-FSP-PART                                   24720000
457100              * H-OPER-DSH.                                       24730000
457200                                                                  24740000
457300     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           24750000
457400             PPS-OPER-FSP-PART *                                  24760000
457500             H-OPER-IME-TEACH.                                    24770000
457600                                                                  24780000
457700     COMPUTE H-BASE-DRG-PAYMENT ROUNDED =                         24790000
457800             PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +              24800000
457900             PPS-OPER-DSH-ADJ + PPS-OPER-IME-ADJ.                 24810000
458000                                                                  24820000
458100***********************************************************       24830000
458200****      NEUROSTIMULATOR CASES                                   24840000
458300***********************************************************       24850000
458400*                                                                 24860000
458500*    IF '8698   ' =  B-PRIN-PROC-CODE   OR                        24870000
458600*                    B-OTHER-PROC-CODE1 OR                        24880000
458700*                    B-OTHER-PROC-CODE2 OR                        24890000
458800*                    B-OTHER-PROC-CODE3 OR                        24900000
458900*                    B-OTHER-PROC-CODE4 OR                        24910000
459000*                    B-OTHER-PROC-CODE5                           24920000
459100*          NEXT SENTENCE                                          24930000
459200*    ELSE                                                         24940000
459300*          MOVE ZEROES TO H-NEW-TECH-ADDON-NEURO                  24950000
459400*          GO TO 4000-CHECK-GRAFT-CASES.                          24960000
459500*                                                                 24970000
459600*    MOVE 18640.00 TO H-CSTMED-NEURO.                             24980000
459700*                                                                 24990000
459800*    COMPUTE H-LESSER-NEURO-1 ROUNDED =                           25000000
459900*            .5   H-CSTMED-NEURO.                                 25010000
460000*                                                                 25020000
460100*    COMPUTE H-LESSER-NEURO-2 ROUNDED =                           25030000
460200*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25040000
460300*                    H-BASE-DRG-PAYMENT)   .5.                    25050000
460400*                                                                 25060000
460500*    IF H-LESSER-NEURO-2 > 0                                      25070000
460600*       IF H-LESSER-NEURO-1 < H-LESSER-NEURO-2                    25080000
460700*          MOVE H-LESSER-NEURO-1 TO H-NEW-TECH-ADDON-NEURO        25090000
460800*       ELSE                                                      25100000
460900*          MOVE H-LESSER-NEURO-2 TO H-NEW-TECH-ADDON-NEURO        25110000
461000*    ELSE                                                         25120000
461100*       MOVE ZEROES          TO H-NEW-TECH-ADDON-NEURO.           25130000
461200*                                                                 25140000
461300*4000-CHECK-GRAFT-CASES.                                          25150000
461400*                                                                 25160000
461500***********************************************************       25170000
461600***      GRAFT*(GORE*TAG)*CASES                                   25180000
461700***********************************************************       25190000
461800*                                                                 25200000
461900*    IF '3973   ' =  B-PRIN-PROC-CODE   OR                        25210000
462000*                    B-OTHER-PROC-CODE1 OR                        25220000
462100*                    B-OTHER-PROC-CODE2 OR                        25230000
462200*                    B-OTHER-PROC-CODE3 OR                        25240000
462300*                    B-OTHER-PROC-CODE4 OR                        25250000
462400*                    B-OTHER-PROC-CODE5                           25260000
462500*          NEXT SENTENCE                                          25270000
462600*    ELSE                                                         25280000
462700*          MOVE ZEROES TO H-NEW-TECH-ADDON-GRAFT                  25290000
462800*          GO TO 4000-CHECK-X-STOP.                               25300000
462900*                                                                 25310000
463000*    MOVE 21198.00 TO H-CSTMED-GRAFT.                             25320000
463100*                                                                 25330000
463200*    COMPUTE H-LESSER-GRAFT-1 ROUNDED =                           25340000
463300*            .5   H-CSTMED-GRAFT.                                 25350000
463400*                                                                 25360000
463500*    COMPUTE H-LESSER-GRAFT-2 ROUNDED =                           25370000
463600*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25380000
463700*                    H-BASE-DRG-PAYMENT)   .5.                    25390000
463800*                                                                 25400000
463900*    IF H-LESSER-GRAFT-2 > 0                                      25410000
464000*       IF H-LESSER-GRAFT-1 < H-LESSER-GRAFT-2                    25420000
464100*          MOVE H-LESSER-GRAFT-1 TO H-NEW-TECH-ADDON-GRAFT        25430000
464200*       ELSE                                                      25440000
464300*          MOVE H-LESSER-GRAFT-2 TO H-NEW-TECH-ADDON-GRAFT        25450000
464400*    ELSE                                                         25460000
464500*       MOVE ZEROES          TO H-NEW-TECH-ADDON-GRAFT.           25470000
464600*                                                                 25480000
464700*4000-CHECK-X-STOP.                                               25490000
464800*                                                                 25500000
464900***********************************************************       25510000
465000*****    X-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM         25520000
465100***********************************************************       25530000
465200*                                                                 25540000
465300*    IF '8458   ' =  B-PRIN-PROC-CODE   OR                        25550000
465400*                    B-OTHER-PROC-CODE1 OR                        25560000
465500*                    B-OTHER-PROC-CODE2 OR                        25570000
465600*                    B-OTHER-PROC-CODE3 OR                        25580000
465700*                    B-OTHER-PROC-CODE4 OR                        25590000
465800*                    B-OTHER-PROC-CODE5                           25600000
465900*          NEXT SENTENCE                                          25610000
466000*    ELSE                                                         25620000
466100*          MOVE ZEROES TO H-NEW-TECH-ADDON-X-STOP                 25630000
466200*          GO TO 4000-ADD-TECH-CASES.                             25640000
466300*                                                                 25650000
466400*    MOVE 8800.00 TO H-CSTMED-X-STOP.                             25660000
466500*                                                                 25670000
466600*    COMPUTE H-LESSER-HRTIMP-STOP-1 ROUNDED =                     25680000
466700*            .5   H-CSTMED-X-STOP.                                25690000
466800*                                                                 25700000
466900*    COMPUTE H-LESSER-HRTIMP-STOP-2 ROUNDED =                     25710000
467000*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25720000
467100*                    H-BASE-DRG-PAYMENT)   .5.                    25730000
467200*                                                                 25740000
467300*    IF H-LESSER-HRTIMP-STOP-2 > 0                                25750000
467400*       IF H-LESSER-HRTIMP-STOP-1 < H-LESSER-HRTIMP-STOP-2        25760000
467500*        MOVE H-LESSER-HRTIMP-STOP-1 TO H-NEW-TECH-ADDON-X-STOP   25770000
467600*       ELSE                                                      25780000
467700*        MOVE H-LESSER-HRTIMP-STOP-2 TO H-NEW-TECH-ADDON-X-STOP   25790000
467800*    ELSE                                                         25800000
467900*       MOVE ZEROES          TO H-NEW-TECH-ADDON-X-STOP.          25810000
468000*                                                                 25820000
468100*                                                                 25830000
468200*4000-ADD-TECH-CASES.                                             25840000
468300*                                                                 25850000
468400*    COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
468500*            H-NEW-TECH-ADDON-NEURO  +                            25870000
468600*            H-NEW-TECH-ADDON-GRAFT +                             25880000
468700*            H-NEW-TECH-ADDON-X-STOP.                             25890000
468800*                                                                 25900000
468900***********************************************************       25510000
469000***** HRTIMP-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
469100***********************************************************       25530000
469200                                                                  25540000
469300     IF '3752   ' =  B-PRIN-PROC-CODE     OR                      25550000
469400                     B-OTHER-PROC-CODE1   OR                      25560000
469500                     B-OTHER-PROC-CODE2   OR                      25570000
469600                     B-OTHER-PROC-CODE3   OR                      25580000
469700                     B-OTHER-PROC-CODE4   OR                      25590000
469800                     B-OTHER-PROC-CODE5   OR                      25590000
469900                     B-OTHER-PROC-CODE6   OR                      25600000
470000                     B-OTHER-PROC-CODE7   OR                      25600000
470100                     B-OTHER-PROC-CODE8   OR                      25600000
470200                     B-OTHER-PROC-CODE9   OR                      25600000
470300                     B-OTHER-PROC-CODE10  OR                      25600000
470400                     B-OTHER-PROC-CODE11  OR                      25600000
470500                     B-OTHER-PROC-CODE12  OR                      25600000
470600                     B-OTHER-PROC-CODE13  OR                      25600000
470700                     B-OTHER-PROC-CODE14  OR                      25600000
470800                     B-OTHER-PROC-CODE15  OR                      25600000
470900                     B-OTHER-PROC-CODE16  OR                      25600000
471000                     B-OTHER-PROC-CODE17  OR                      25600000
471100                     B-OTHER-PROC-CODE18  OR                      25600000
471200                     B-OTHER-PROC-CODE19  OR                      25600000
471300                     B-OTHER-PROC-CODE20  OR                      25600000
471400                     B-OTHER-PROC-CODE21  OR                      25600000
471500                     B-OTHER-PROC-CODE22  OR                      25600000
471600                     B-OTHER-PROC-CODE23  OR                      25600000
471700                     B-OTHER-PROC-CODE24                          25600000
471800           NEXT SENTENCE                                          25610000
471900     ELSE                                                         25620000
472000           MOVE ZEROES TO H-NEW-TECH-ADDON-HRTIMP-STOP            25630000
472100           GO TO 4000-ADD-TECH-CASES.                             25640000
472200                                                                  25650000
472300     MOVE 53000.00 TO H-CSTMED-HRTIMP-STOP.                       25660000
472400                                                                  25670000
472500     COMPUTE H-LESSER-HRTIMP-STOP-1 ROUNDED =                     25680000
472600                  H-CSTMED-HRTIMP-STOP.                           25690000
472700                                                                  25700000
472800     COMPUTE H-LESSER-HRTIMP-STOP-2 ROUNDED =                     25710000
472900          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
473000                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
473100                                                                  25740000
473200     IF H-LESSER-HRTIMP-STOP-2 > 0                                25750000
473300        IF H-LESSER-HRTIMP-STOP-1 < H-LESSER-HRTIMP-STOP-2        25760000
473400         MOVE H-LESSER-HRTIMP-STOP-1 TO
473500                                  H-NEW-TECH-ADDON-HRTIMP-STOP
473600        ELSE                                                      25780000
473700         MOVE H-LESSER-HRTIMP-STOP-2 TO
473800                                  H-NEW-TECH-ADDON-HRTIMP-STOP
473900     ELSE                                                         25800000
474000        MOVE ZEROES          TO H-NEW-TECH-ADDON-HRTIMP-STOP.     25810000
474100                                                                  25820000
474200                                                                  25830000
474300 4000-ADD-TECH-CASES.                                             25840000
474400                                                                  25850000
474500     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
474600             H-NEW-TECH-ADDON-HRTIMP-STOP.                        25890000
474700*                                                                 25900000
474800***********************************************************       23070000
474900* PUT NEW CHECK HERE IF H-NEW-TECH ZERO PERFORM                   23080000
475000                                                                  23110000
475100     IF   H-NEW-TECH-PAY-ADD-ON = 0                               23100000
475200     PERFORM 4100-ISLET-ISOLATION-ADD-ON THRU 4100-EXIT.          23120000
475300                                                                  23140000
475400     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    26009200
475500             H-NEW-TECH-PAY-ADD-ON.                               26009300
475600                                                                  23090000
475700     IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
475800          B-DRG-SPIRATN-DRG
475900        PERFORM 4300-SPIRAT-TECH-ADD-ON THRU 4300-EXIT.           23140000
476000                                                                  23090000
476100     IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
476200          B-DRG-SPIRATN-DRG11
476300        PERFORM 4310-SPIRAT-TECH-ADD-ON THRU 4310-EXIT.           23140000
476400                                                                  23130000
476500     IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
476600          B-DRG-AUTOLITT-DRG
476700        PERFORM 4500-AUTOLIT-TECH-ADD-ON THRU 4500-EXIT.          23140000
476800                                                                  23130000
476900     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    26009200
477000             H-NEW-TECH-PAY-ADD-ON.                               26009300
477100                                                                  26009400
477200*                                                                 25900000
477300 4000-EXIT.    EXIT.                                              25910000
477400***********************************************************       25920000
477500                                                                  25930000
477600 4100-ISLET-ISOLATION-ADD-ON.                                     25940000
477700***********************************************************       25950000
477800***  TECHNICAL TRANSPLANTATION OF CELLS                           25960000
477900***                                                               25970000
478000*** CODE 52.85 (ALLTRANSPLANTATION OF CELLS OF ISLETS OF          25980000
478100*** ISLETS OF LANGERHAUS) AND                                     25990000
478200*** V70.7 (EXAMINATION OF PARTICIPANT IN CLINICAL TRIAL).         25991000
478300*** V70.7 ONE OR MORE TIMES IN PROC-CODES AND 52.85 ONE OR MORE   25992000
478400*** TIMES IN ANY OTHER PROC-CODE                                  25993000
478500***********************************************************       25994000
478600*** IT WAS DECIDED ON 3/12/07 TO ONLY CHECK FOR 52.85 AND NOT     25995000
478700*** V70.7                                                         25995100
478800***********************************************************       25995200
478900                                                                  25995300
479000     MOVE 0 TO H-TECH-ADDON-ISLET-CNTR                            25995400
479100               H-TECH-ADDON-ISLET-CNTR2.                          25995500
479200                                                                  25995600
479300*    IF 'V707   ' =  B-PRIN-PROC-CODE   OR                        25995700
479400*                    B-OTHER-PROC-CODE1 OR                        25995800
479500*                    B-OTHER-PROC-CODE2 OR                        25995900
479600*                    B-OTHER-PROC-CODE3 OR                        25996000
479700*                    B-OTHER-PROC-CODE4 OR                        25997000
479800*                    B-OTHER-PROC-CODE5                           25998000
479900*          NEXT SENTENCE                                          25999000
480000*    ELSE                                                         25999100
480100*          MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  25999200
480200*          GO TO 4100-ADD-TECH-CASES.                             25999300
480300                                                                  25999400
480400     IF '5285   ' =  B-PRIN-PROC-CODE     OR                      25999500
480500                     B-OTHER-PROC-CODE1   OR                      25999600
480600                     B-OTHER-PROC-CODE2   OR                      25999700
480700                     B-OTHER-PROC-CODE3   OR                      25999800
480800                     B-OTHER-PROC-CODE4   OR                      25999900
480900                     B-OTHER-PROC-CODE5   OR                      26000000
481000                     B-OTHER-PROC-CODE6   OR                      25600000
481100                     B-OTHER-PROC-CODE7   OR                      25600000
481200                     B-OTHER-PROC-CODE8   OR                      25600000
481300                     B-OTHER-PROC-CODE9   OR                      25600000
481400                     B-OTHER-PROC-CODE10  OR                      25600000
481500                     B-OTHER-PROC-CODE11  OR                      25600000
481600                     B-OTHER-PROC-CODE12  OR                      25600000
481700                     B-OTHER-PROC-CODE13  OR                      25600000
481800                     B-OTHER-PROC-CODE14  OR                      25600000
481900                     B-OTHER-PROC-CODE15  OR                      25600000
482000                     B-OTHER-PROC-CODE16  OR                      25600000
482100                     B-OTHER-PROC-CODE17  OR                      25600000
482200                     B-OTHER-PROC-CODE18  OR                      25600000
482300                     B-OTHER-PROC-CODE19  OR                      25600000
482400                     B-OTHER-PROC-CODE20  OR                      25600000
482500                     B-OTHER-PROC-CODE21  OR                      25600000
482600                     B-OTHER-PROC-CODE22  OR                      25600000
482700                     B-OTHER-PROC-CODE23  OR                      25600000
482800                     B-OTHER-PROC-CODE24                          25600000
482900           NEXT SENTENCE                                          26000100
483000     ELSE                                                         26000200
483100           MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  26000300
483200           GO TO 4100-ADD-TECH-CASES.                             26000400
483300                                                                  26000500
483400     IF '5285   ' =  B-PRIN-PROC-CODE                             26000600
483500      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26000700
483600                       H-TECH-ADDON-ISLET-CNTR + 1.               26000800
483700                                                                  26000900
483800     IF '5285   ' =  B-OTHER-PROC-CODE1                           26001000
483900      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001100
484000                       H-TECH-ADDON-ISLET-CNTR + 1.               26001200
484100                                                                  26001300
484200     IF '5285   ' =  B-OTHER-PROC-CODE2                           26001400
484300      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001500
484400                       H-TECH-ADDON-ISLET-CNTR + 1.               26001600
484500                                                                  26001700
484600     IF '5285   ' =  B-OTHER-PROC-CODE3                           26001800
484700      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001900
484800                       H-TECH-ADDON-ISLET-CNTR + 1.               26002000
484900                                                                  26002100
485000     IF '5285   ' =  B-OTHER-PROC-CODE4                           26002200
485100      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002300
485200                       H-TECH-ADDON-ISLET-CNTR + 1.               26002400
485300                                                                  26002500
485400                                                                  26002600
485500     IF '5285   ' =  B-OTHER-PROC-CODE5                           26002700
485600      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
485700                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
485800                                                                  26002600
485900     IF '5285   ' =  B-OTHER-PROC-CODE6                           25600000
486000      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
486100                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
486200                                                                  26002600
486300     IF '5285   ' =  B-OTHER-PROC-CODE7                           25600000
486400      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
486500                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
486600                                                                  26002600
486700     IF '5285   ' =  B-OTHER-PROC-CODE8                           25600000
486800      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
486900                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
487000                                                                  26002600
487100     IF '5285   ' =  B-OTHER-PROC-CODE9                           25600000
487200      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
487300                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
487400                                                                  26002600
487500     IF '5285   ' =  B-OTHER-PROC-CODE10                          25600000
487600      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
487700                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
487800                                                                  26002600
487900     IF '5285   ' =  B-OTHER-PROC-CODE11                          25600000
488000      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
488100                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
488200                                                                  26002600
488300     IF '5285   ' =  B-OTHER-PROC-CODE12                          25600000
488400      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
488500                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
488600                                                                  26002600
488700     IF '5285   ' =  B-OTHER-PROC-CODE13                          25600000
488800      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
488900                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
489000                                                                  26002600
489100     IF '5285   ' =  B-OTHER-PROC-CODE14                          25600000
489200      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
489300                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
489400                                                                  26002600
489500     IF '5285   ' =  B-OTHER-PROC-CODE15                          25600000
489600      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
489700                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
489800                                                                  26002600
489900     IF '5285   ' =  B-OTHER-PROC-CODE16                          25600000
490000      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
490100                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
490200                                                                  26002600
490300     IF '5285   ' =  B-OTHER-PROC-CODE17                          25600000
490400      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
490500                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
490600                                                                  26002600
490700     IF '5285   ' =  B-OTHER-PROC-CODE18                          25600000
490800      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
490900                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
491000                                                                  26002600
491100     IF '5285   ' =  B-OTHER-PROC-CODE19                          25600000
491200      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
491300                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
491400                                                                  26002600
491500     IF '5285   ' =  B-OTHER-PROC-CODE20                          25600000
491600      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
491700                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
491800                                                                  26002600
491900     IF '5285   ' =  B-OTHER-PROC-CODE21                          25600000
492000      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
492100                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
492200                                                                  26002600
492300     IF '5285   ' =  B-OTHER-PROC-CODE22                          25600000
492400      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
492500                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
492600                                                                  26002600
492700     IF '5285   ' =  B-OTHER-PROC-CODE23                          25600000
492800      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
492900                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
493000                                                                  26002600
493100     IF '5285   ' =  B-OTHER-PROC-CODE24                          25600000
493200      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
493300                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
493400                                                                  26002600
493500                                                                  26003000
493600*    IF 'V707   ' =  B-PRIN-PROC-CODE                             26003100
493700*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26003200
493800*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26003300
493900*                                                                 26003400
494000*    IF 'V707   ' =  B-OTHER-PROC-CODE1                           26003500
494100*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26003600
494200*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26003700
494300*                                                                 26003800
494400*    IF 'V707   ' =  B-OTHER-PROC-CODE2                           26003900
494500*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004000
494600*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004100
494700*                                                                 26004200
494800*    IF 'V707   ' =  B-OTHER-PROC-CODE3                           26004300
494900*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004400
495000*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004500
495100*                                                                 26004600
495200*    IF 'V707   ' =  B-OTHER-PROC-CODE4                           26004700
495300*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004800
495400*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004900
495500*                                                                 26005000
495600*    IF 'V707   ' =  B-OTHER-PROC-CODE5                           26005100
495700*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26005200
495800*                    H-TECH-ADDON-ISLET-CNTR2 + 1.                26005300
495900*                                                                 26005400
496000*    IF  H-TECH-ADDON-ISLET-CNTR2 > 0                             26005500
496100*          NEXT SENTENCE                                          26005600
496200*    ELSE                                                         26005700
496300*          MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  26005800
496400*          GO TO 4100-ADD-TECH-CASES.                             26005900
496500                                                                  26006000
496600     IF  H-TECH-ADDON-ISLET-CNTR = 1                              26006100
496700     MOVE 18848.00 TO H-NEW-TECH-ADDON-ISLET                      26006200
496800           GO TO 4100-ADD-TECH-CASES.                             26006300
496900                                                                  26006400
497000     IF  H-TECH-ADDON-ISLET-CNTR > 1                              26006500
497100     MOVE 37696.00 TO H-NEW-TECH-ADDON-ISLET                      26006600
497200           GO TO 4100-ADD-TECH-CASES.                             26006700
497300                                                                  26006800
497400     MOVE 0 TO H-NEW-TECH-ADDON-ISLET.                            26006900
497500                                                                  26007000
497600                                                                  26008000
497700 4100-ADD-TECH-CASES.                                             26009000
497800                                                                  26009100
497900     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      26009200
498000             H-NEW-TECH-ADDON-ISLET.                              26009300
498100                                                                  26009400
498200 4100-EXIT.    EXIT.                                              26009500
498300                                                                  26009600
498400*
498500*4200-SSRFBN-CODE-RTN.
498600*    SET SSRFBN-IDX TO 1.
498700*    SEARCH SSRFBN-TAB VARYING SSRFBN-IDX
498800*        AT END
498900*          MOVE ' NO SSRFBN MESSAGE FOUND' TO MES-SSRFBN
499000*      WHEN WK-SSRFBN-STATE(SSRFBN-IDX) = MES-PPS-STATE
499100*        MOVE WK-SSRFBN-REASON-ALL (SSRFBN-IDX) TO MES-SSRFBN.
499200*
499300*4200-EXIT.   EXIT.
499400*
499500 4300-SPIRAT-TECH-ADD-ON.                                         25940000
499600***********************************************************       25510000
499700***** SPIRAT-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
499800***********************************************************       25530000
499900                                                                  25540000
500000     IF '3371   ' =  B-PRIN-PROC-CODE     OR                      25550000
500100                     B-OTHER-PROC-CODE1   OR                      25560000
500200                     B-OTHER-PROC-CODE2   OR                      25570000
500300                     B-OTHER-PROC-CODE3   OR                      25580000
500400                     B-OTHER-PROC-CODE4   OR                      25590000
500500                     B-OTHER-PROC-CODE5   OR                      25600000
500600                     B-OTHER-PROC-CODE6   OR                      25600000
500700                     B-OTHER-PROC-CODE7   OR                      25600000
500800                     B-OTHER-PROC-CODE8   OR                      25600000
500900                     B-OTHER-PROC-CODE9   OR                      25600000
501000                     B-OTHER-PROC-CODE10  OR                      25600000
501100                     B-OTHER-PROC-CODE11  OR                      25600000
501200                     B-OTHER-PROC-CODE12  OR                      25600000
501300                     B-OTHER-PROC-CODE13  OR                      25600000
501400                     B-OTHER-PROC-CODE14  OR                      25600000
501500                     B-OTHER-PROC-CODE15  OR                      25600000
501600                     B-OTHER-PROC-CODE16  OR                      25600000
501700                     B-OTHER-PROC-CODE17  OR                      25600000
501800                     B-OTHER-PROC-CODE18  OR                      25600000
501900                     B-OTHER-PROC-CODE19  OR                      25600000
502000                     B-OTHER-PROC-CODE20  OR                      25600000
502100                     B-OTHER-PROC-CODE21  OR                      25600000
502200                     B-OTHER-PROC-CODE22  OR                      25600000
502300                     B-OTHER-PROC-CODE23  OR                      25600000
502400                     B-OTHER-PROC-CODE24                          25600000
502500        IF '3222   ' =  B-PRIN-PROC-CODE     OR                   25550000
502600                        B-OTHER-PROC-CODE1   OR                   25560000
502700                        B-OTHER-PROC-CODE2   OR                   25570000
502800                        B-OTHER-PROC-CODE3   OR                   25580000
502900                        B-OTHER-PROC-CODE4   OR                   25590000
503000                        B-OTHER-PROC-CODE5   OR                   25600000
503100                        B-OTHER-PROC-CODE6   OR                   25600000
503200                        B-OTHER-PROC-CODE7   OR                   25600000
503300                        B-OTHER-PROC-CODE8   OR                   25600000
503400                        B-OTHER-PROC-CODE9   OR                   25600000
503500                        B-OTHER-PROC-CODE10  OR                   25600000
503600                        B-OTHER-PROC-CODE11  OR                   25600000
503700                        B-OTHER-PROC-CODE12  OR                   25600000
503800                        B-OTHER-PROC-CODE13  OR                   25600000
503900                        B-OTHER-PROC-CODE14  OR                   25600000
504000                        B-OTHER-PROC-CODE15  OR                   25600000
504100                        B-OTHER-PROC-CODE16  OR                   25600000
504200                        B-OTHER-PROC-CODE17  OR                   25600000
504300                        B-OTHER-PROC-CODE18  OR                   25600000
504400                        B-OTHER-PROC-CODE19  OR                   25600000
504500                        B-OTHER-PROC-CODE20  OR                   25600000
504600                        B-OTHER-PROC-CODE21  OR                   25600000
504700                        B-OTHER-PROC-CODE22  OR                   25600000
504800                        B-OTHER-PROC-CODE23  OR                   25600000
504900                        B-OTHER-PROC-CODE24                       25600000
505000           GO TO 4300-COMPUTE-SPIRAT                              25610000
505100        ELSE                                                      25620000
505200        IF '3230   ' =  B-PRIN-PROC-CODE     OR                   25550000
505300                        B-OTHER-PROC-CODE1   OR                   25560000
505400                        B-OTHER-PROC-CODE2   OR                   25570000
505500                        B-OTHER-PROC-CODE3   OR                   25580000
505600                        B-OTHER-PROC-CODE4   OR                   25590000
505700                        B-OTHER-PROC-CODE5   OR                   25600000
505800                        B-OTHER-PROC-CODE6   OR                   25600000
505900                        B-OTHER-PROC-CODE7   OR                   25600000
506000                        B-OTHER-PROC-CODE8   OR                   25600000
506100                        B-OTHER-PROC-CODE9   OR                   25600000
506200                        B-OTHER-PROC-CODE10  OR                   25600000
506300                        B-OTHER-PROC-CODE11  OR                   25600000
506400                        B-OTHER-PROC-CODE12  OR                   25600000
506500                        B-OTHER-PROC-CODE13  OR                   25600000
506600                        B-OTHER-PROC-CODE14  OR                   25600000
506700                        B-OTHER-PROC-CODE15  OR                   25600000
506800                        B-OTHER-PROC-CODE16  OR                   25600000
506900                        B-OTHER-PROC-CODE17  OR                   25600000
507000                        B-OTHER-PROC-CODE18  OR                   25600000
507100                        B-OTHER-PROC-CODE19  OR                   25600000
507200                        B-OTHER-PROC-CODE20  OR                   25600000
507300                        B-OTHER-PROC-CODE21  OR                   25600000
507400                        B-OTHER-PROC-CODE22  OR                   25600000
507500                        B-OTHER-PROC-CODE23  OR                   25600000
507600                        B-OTHER-PROC-CODE24                       25600000
507700           GO TO 4300-COMPUTE-SPIRAT                              25610000
507800        ELSE                                                      25620000
507900        IF '3239   ' =  B-PRIN-PROC-CODE     OR                   25550000
508000                        B-OTHER-PROC-CODE1   OR                   25560000
508100                        B-OTHER-PROC-CODE2   OR                   25570000
508200                        B-OTHER-PROC-CODE3   OR                   25580000
508300                        B-OTHER-PROC-CODE4   OR                   25590000
508400                        B-OTHER-PROC-CODE5   OR                   25600000
508500                        B-OTHER-PROC-CODE6   OR                   25600000
508600                        B-OTHER-PROC-CODE7   OR                   25600000
508700                        B-OTHER-PROC-CODE8   OR                   25600000
508800                        B-OTHER-PROC-CODE9   OR                   25600000
508900                        B-OTHER-PROC-CODE10  OR                   25600000
509000                        B-OTHER-PROC-CODE11  OR                   25600000
509100                        B-OTHER-PROC-CODE12  OR                   25600000
509200                        B-OTHER-PROC-CODE13  OR                   25600000
509300                        B-OTHER-PROC-CODE14  OR                   25600000
509400                        B-OTHER-PROC-CODE15  OR                   25600000
509500                        B-OTHER-PROC-CODE16  OR                   25600000
509600                        B-OTHER-PROC-CODE17  OR                   25600000
509700                        B-OTHER-PROC-CODE18  OR                   25600000
509800                        B-OTHER-PROC-CODE19  OR                   25600000
509900                        B-OTHER-PROC-CODE20  OR                   25600000
510000                        B-OTHER-PROC-CODE21  OR                   25600000
510100                        B-OTHER-PROC-CODE22  OR                   25600000
510200                        B-OTHER-PROC-CODE23  OR                   25600000
510300                        B-OTHER-PROC-CODE24                       25600000
510400           GO TO 4300-COMPUTE-SPIRAT                              25610000
510500        ELSE                                                      25620000
510600        IF '3241   ' =  B-PRIN-PROC-CODE     OR                   25550000
510700                        B-OTHER-PROC-CODE1   OR                   25560000
510800                        B-OTHER-PROC-CODE2   OR                   25570000
510900                        B-OTHER-PROC-CODE3   OR                   25580000
511000                        B-OTHER-PROC-CODE4   OR                   25590000
511100                        B-OTHER-PROC-CODE5   OR                   25600000
511200                        B-OTHER-PROC-CODE6   OR                   25600000
511300                        B-OTHER-PROC-CODE7   OR                   25600000
511400                        B-OTHER-PROC-CODE8   OR                   25600000
511500                        B-OTHER-PROC-CODE9   OR                   25600000
511600                        B-OTHER-PROC-CODE10  OR                   25600000
511700                        B-OTHER-PROC-CODE11  OR                   25600000
511800                        B-OTHER-PROC-CODE12  OR                   25600000
511900                        B-OTHER-PROC-CODE13  OR                   25600000
512000                        B-OTHER-PROC-CODE14  OR                   25600000
512100                        B-OTHER-PROC-CODE15  OR                   25600000
512200                        B-OTHER-PROC-CODE16  OR                   25600000
512300                        B-OTHER-PROC-CODE17  OR                   25600000
512400                        B-OTHER-PROC-CODE18  OR                   25600000
512500                        B-OTHER-PROC-CODE19  OR                   25600000
512600                        B-OTHER-PROC-CODE20  OR                   25600000
512700                        B-OTHER-PROC-CODE21  OR                   25600000
512800                        B-OTHER-PROC-CODE22  OR                   25600000
512900                        B-OTHER-PROC-CODE23  OR                   25600000
513000                        B-OTHER-PROC-CODE24                       25600000
513100           GO TO 4300-COMPUTE-SPIRAT                              25610000
513200        ELSE                                                      25620000
513300        IF '3249   ' =  B-PRIN-PROC-CODE     OR                   25550000
513400                        B-OTHER-PROC-CODE1   OR                   25560000
513500                        B-OTHER-PROC-CODE2   OR                   25570000
513600                        B-OTHER-PROC-CODE3   OR                   25580000
513700                        B-OTHER-PROC-CODE4   OR                   25590000
513800                        B-OTHER-PROC-CODE5   OR                   25600000
513900                        B-OTHER-PROC-CODE6   OR                   25600000
514000                        B-OTHER-PROC-CODE7   OR                   25600000
514100                        B-OTHER-PROC-CODE8   OR                   25600000
514200                        B-OTHER-PROC-CODE9   OR                   25600000
514300                        B-OTHER-PROC-CODE10  OR                   25600000
514400                        B-OTHER-PROC-CODE11  OR                   25600000
514500                        B-OTHER-PROC-CODE12  OR                   25600000
514600                        B-OTHER-PROC-CODE13  OR                   25600000
514700                        B-OTHER-PROC-CODE14  OR                   25600000
514800                        B-OTHER-PROC-CODE15  OR                   25600000
514900                        B-OTHER-PROC-CODE16  OR                   25600000
515000                        B-OTHER-PROC-CODE17  OR                   25600000
515100                        B-OTHER-PROC-CODE18  OR                   25600000
515200                        B-OTHER-PROC-CODE19  OR                   25600000
515300                        B-OTHER-PROC-CODE20  OR                   25600000
515400                        B-OTHER-PROC-CODE21  OR                   25600000
515500                        B-OTHER-PROC-CODE22  OR                   25600000
515600                        B-OTHER-PROC-CODE23  OR                   25600000
515700                        B-OTHER-PROC-CODE24                       25600000
515800           GO TO 4300-COMPUTE-SPIRAT                              25610000
515900     ELSE                                                         25620000
516000           NEXT SENTENCE.                                         25610000
516100                                                                  25620000
516200     IF '3373   ' =  B-PRIN-PROC-CODE     OR                      25550000
516300                     B-OTHER-PROC-CODE1   OR                      25560000
516400                     B-OTHER-PROC-CODE2   OR                      25570000
516500                     B-OTHER-PROC-CODE3   OR                      25580000
516600                     B-OTHER-PROC-CODE4   OR                      25590000
516700                     B-OTHER-PROC-CODE5   OR                      25600000
516800                     B-OTHER-PROC-CODE6   OR                      25600000
516900                     B-OTHER-PROC-CODE7   OR                      25600000
517000                     B-OTHER-PROC-CODE8   OR                      25600000
517100                     B-OTHER-PROC-CODE9   OR                      25600000
517200                     B-OTHER-PROC-CODE10  OR                      25600000
517300                     B-OTHER-PROC-CODE11  OR                      25600000
517400                     B-OTHER-PROC-CODE12  OR                      25600000
517500                     B-OTHER-PROC-CODE13  OR                      25600000
517600                     B-OTHER-PROC-CODE14  OR                      25600000
517700                     B-OTHER-PROC-CODE15  OR                      25600000
517800                     B-OTHER-PROC-CODE16  OR                      25600000
517900                     B-OTHER-PROC-CODE17  OR                      25600000
518000                     B-OTHER-PROC-CODE18  OR                      25600000
518100                     B-OTHER-PROC-CODE19  OR                      25600000
518200                     B-OTHER-PROC-CODE20  OR                      25600000
518300                     B-OTHER-PROC-CODE21  OR                      25600000
518400                     B-OTHER-PROC-CODE22  OR                      25600000
518500                     B-OTHER-PROC-CODE23  OR                      25600000
518600                     B-OTHER-PROC-CODE24                          25600000
518700        IF '3222   ' =  B-PRIN-PROC-CODE     OR                   25550000
518800                        B-OTHER-PROC-CODE1   OR                   25560000
518900                        B-OTHER-PROC-CODE2   OR                   25570000
519000                        B-OTHER-PROC-CODE3   OR                   25580000
519100                        B-OTHER-PROC-CODE4   OR                   25590000
519200                        B-OTHER-PROC-CODE5   OR                   25600000
519300                        B-OTHER-PROC-CODE6   OR                   25600000
519400                        B-OTHER-PROC-CODE7   OR                   25600000
519500                        B-OTHER-PROC-CODE8   OR                   25600000
519600                        B-OTHER-PROC-CODE9   OR                   25600000
519700                        B-OTHER-PROC-CODE10  OR                   25600000
519800                        B-OTHER-PROC-CODE11  OR                   25600000
519900                        B-OTHER-PROC-CODE12  OR                   25600000
520000                        B-OTHER-PROC-CODE13  OR                   25600000
520100                        B-OTHER-PROC-CODE14  OR                   25600000
520200                        B-OTHER-PROC-CODE15  OR                   25600000
520300                        B-OTHER-PROC-CODE16  OR                   25600000
520400                        B-OTHER-PROC-CODE17  OR                   25600000
520500                        B-OTHER-PROC-CODE18  OR                   25600000
520600                        B-OTHER-PROC-CODE19  OR                   25600000
520700                        B-OTHER-PROC-CODE20  OR                   25600000
520800                        B-OTHER-PROC-CODE21  OR                   25600000
520900                        B-OTHER-PROC-CODE22  OR                   25600000
521000                        B-OTHER-PROC-CODE23  OR                   25600000
521100                        B-OTHER-PROC-CODE24                       25600000
521200           GO TO 4300-COMPUTE-SPIRAT                              25610000
521300        ELSE                                                      25620000
521400        IF '3230   ' =  B-PRIN-PROC-CODE     OR                   25550000
521500                        B-OTHER-PROC-CODE1   OR                   25560000
521600                        B-OTHER-PROC-CODE2   OR                   25570000
521700                        B-OTHER-PROC-CODE3   OR                   25580000
521800                        B-OTHER-PROC-CODE4   OR                   25590000
521900                        B-OTHER-PROC-CODE5   OR                   25600000
522000                        B-OTHER-PROC-CODE6   OR                   25600000
522100                        B-OTHER-PROC-CODE7   OR                   25600000
522200                        B-OTHER-PROC-CODE8   OR                   25600000
522300                        B-OTHER-PROC-CODE9   OR                   25600000
522400                        B-OTHER-PROC-CODE10  OR                   25600000
522500                        B-OTHER-PROC-CODE11  OR                   25600000
522600                        B-OTHER-PROC-CODE12  OR                   25600000
522700                        B-OTHER-PROC-CODE13  OR                   25600000
522800                        B-OTHER-PROC-CODE14  OR                   25600000
522900                        B-OTHER-PROC-CODE15  OR                   25600000
523000                        B-OTHER-PROC-CODE16  OR                   25600000
523100                        B-OTHER-PROC-CODE17  OR                   25600000
523200                        B-OTHER-PROC-CODE18  OR                   25600000
523300                        B-OTHER-PROC-CODE19  OR                   25600000
523400                        B-OTHER-PROC-CODE20  OR                   25600000
523500                        B-OTHER-PROC-CODE21  OR                   25600000
523600                        B-OTHER-PROC-CODE22  OR                   25600000
523700                        B-OTHER-PROC-CODE23  OR                   25600000
523800                        B-OTHER-PROC-CODE24                       25600000
523900           GO TO 4300-COMPUTE-SPIRAT                              25610000
524000        ELSE                                                      25620000
524100        IF '3239   ' =  B-PRIN-PROC-CODE     OR                   25550000
524200                        B-OTHER-PROC-CODE1   OR                   25560000
524300                        B-OTHER-PROC-CODE2   OR                   25570000
524400                        B-OTHER-PROC-CODE3   OR                   25580000
524500                        B-OTHER-PROC-CODE4   OR                   25590000
524600                        B-OTHER-PROC-CODE5   OR                   25600000
524700                        B-OTHER-PROC-CODE6   OR                   25600000
524800                        B-OTHER-PROC-CODE7   OR                   25600000
524900                        B-OTHER-PROC-CODE8   OR                   25600000
525000                        B-OTHER-PROC-CODE9   OR                   25600000
525100                        B-OTHER-PROC-CODE10  OR                   25600000
525200                        B-OTHER-PROC-CODE11  OR                   25600000
525300                        B-OTHER-PROC-CODE12  OR                   25600000
525400                        B-OTHER-PROC-CODE13  OR                   25600000
525500                        B-OTHER-PROC-CODE14  OR                   25600000
525600                        B-OTHER-PROC-CODE15  OR                   25600000
525700                        B-OTHER-PROC-CODE16  OR                   25600000
525800                        B-OTHER-PROC-CODE17  OR                   25600000
525900                        B-OTHER-PROC-CODE18  OR                   25600000
526000                        B-OTHER-PROC-CODE19  OR                   25600000
526100                        B-OTHER-PROC-CODE20  OR                   25600000
526200                        B-OTHER-PROC-CODE21  OR                   25600000
526300                        B-OTHER-PROC-CODE22  OR                   25600000
526400                        B-OTHER-PROC-CODE23  OR                   25600000
526500                        B-OTHER-PROC-CODE24                       25600000
526600           GO TO 4300-COMPUTE-SPIRAT                              25610000
526700        ELSE                                                      25620000
526800        IF '3241   ' =  B-PRIN-PROC-CODE     OR                   25550000
526900                        B-OTHER-PROC-CODE1   OR                   25560000
527000                        B-OTHER-PROC-CODE2   OR                   25570000
527100                        B-OTHER-PROC-CODE3   OR                   25580000
527200                        B-OTHER-PROC-CODE4   OR                   25590000
527300                        B-OTHER-PROC-CODE5   OR                   25600000
527400                        B-OTHER-PROC-CODE6   OR                   25600000
527500                        B-OTHER-PROC-CODE7   OR                   25600000
527600                        B-OTHER-PROC-CODE8   OR                   25600000
527700                        B-OTHER-PROC-CODE9   OR                   25600000
527800                        B-OTHER-PROC-CODE10  OR                   25600000
527900                        B-OTHER-PROC-CODE11  OR                   25600000
528000                        B-OTHER-PROC-CODE12  OR                   25600000
528100                        B-OTHER-PROC-CODE13  OR                   25600000
528200                        B-OTHER-PROC-CODE14  OR                   25600000
528300                        B-OTHER-PROC-CODE15  OR                   25600000
528400                        B-OTHER-PROC-CODE16  OR                   25600000
528500                        B-OTHER-PROC-CODE17  OR                   25600000
528600                        B-OTHER-PROC-CODE18  OR                   25600000
528700                        B-OTHER-PROC-CODE19  OR                   25600000
528800                        B-OTHER-PROC-CODE20  OR                   25600000
528900                        B-OTHER-PROC-CODE21  OR                   25600000
529000                        B-OTHER-PROC-CODE22  OR                   25600000
529100                        B-OTHER-PROC-CODE23  OR                   25600000
529200                        B-OTHER-PROC-CODE24                       25600000
529300           GO TO 4300-COMPUTE-SPIRAT                              25610000
529400        ELSE                                                      25620000
529500        IF '3249   ' =  B-PRIN-PROC-CODE     OR                   25550000
529600                        B-OTHER-PROC-CODE1   OR                   25560000
529700                        B-OTHER-PROC-CODE2   OR                   25570000
529800                        B-OTHER-PROC-CODE3   OR                   25580000
529900                        B-OTHER-PROC-CODE4   OR                   25590000
530000                        B-OTHER-PROC-CODE5   OR                   25600000
530100                        B-OTHER-PROC-CODE6   OR                   25600000
530200                        B-OTHER-PROC-CODE7   OR                   25600000
530300                        B-OTHER-PROC-CODE8   OR                   25600000
530400                        B-OTHER-PROC-CODE9   OR                   25600000
530500                        B-OTHER-PROC-CODE10  OR                   25600000
530600                        B-OTHER-PROC-CODE11  OR                   25600000
530700                        B-OTHER-PROC-CODE12  OR                   25600000
530800                        B-OTHER-PROC-CODE13  OR                   25600000
530900                        B-OTHER-PROC-CODE14  OR                   25600000
531000                        B-OTHER-PROC-CODE15  OR                   25600000
531100                        B-OTHER-PROC-CODE16  OR                   25600000
531200                        B-OTHER-PROC-CODE17  OR                   25600000
531300                        B-OTHER-PROC-CODE18  OR                   25600000
531400                        B-OTHER-PROC-CODE19  OR                   25600000
531500                        B-OTHER-PROC-CODE20  OR                   25600000
531600                        B-OTHER-PROC-CODE21  OR                   25600000
531700                        B-OTHER-PROC-CODE22  OR                   25600000
531800                        B-OTHER-PROC-CODE23  OR                   25600000
531900                        B-OTHER-PROC-CODE24                       25600000
532000           GO TO 4300-COMPUTE-SPIRAT.                             25610000
532100                                                                        00
532200           MOVE ZEROES TO H-NEW-TECH-ADDON-SPIRAT-STOP.           25630000
532300           GO TO 4300-ADD-TECH-CASES.                             25640000
532400                                                                  25650000
532500 4300-COMPUTE-SPIRAT.                                             25840000
532600                                                                  25650000
532700     MOVE  3437.50 TO H-CSTMED-SPIRAT-STOP.                       25660000
532800                                                                  25670000
532900     COMPUTE H-LESSER-SPIRAT-STOP-1 ROUNDED =                     25680000
533000                  H-CSTMED-SPIRAT-STOP.                           25690000
533100                                                                  25700000
533200     COMPUTE H-LESSER-SPIRAT-STOP-2 ROUNDED =                     25710000
533300          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
533400                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
533500                                                                  25740000
533600     IF H-LESSER-SPIRAT-STOP-2 > 0                                25750000
533700        IF H-LESSER-SPIRAT-STOP-1 < H-LESSER-SPIRAT-STOP-2        25760000
533800         MOVE H-LESSER-SPIRAT-STOP-1 TO
533900                                  H-NEW-TECH-ADDON-SPIRAT-STOP
534000        ELSE                                                      25780000
534100         MOVE H-LESSER-SPIRAT-STOP-2 TO
534200                                  H-NEW-TECH-ADDON-SPIRAT-STOP
534300     ELSE                                                         25800000
534400        MOVE ZEROES          TO H-NEW-TECH-ADDON-SPIRAT-STOP.     25810000
534500                                                                  25820000
534600                                                                  25830000
534700 4300-ADD-TECH-CASES.                                             25840000
534800                                                                  25850000
534900     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
535000             H-NEW-TECH-ADDON-SPIRAT-STOP.                        25890000
535100*                                                                 25900000
535200 4300-EXIT.    EXIT.                                              25910000
535300
535400 4310-SPIRAT-TECH-ADD-ON.                                         25940000
535500***********************************************************       25510000
535600***** SPIRAT-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
535700***********************************************************       25530000
535800                                                                  25540000
535900     IF '3371   ' =  B-PRIN-PROC-CODE     OR                      25550000
536000                     B-OTHER-PROC-CODE1   OR                      25560000
536100                     B-OTHER-PROC-CODE2   OR                      25570000
536200                     B-OTHER-PROC-CODE3   OR                      25580000
536300                     B-OTHER-PROC-CODE4   OR                      25590000
536400                     B-OTHER-PROC-CODE5   OR                      25600000
536500                     B-OTHER-PROC-CODE6   OR                      25600000
536600                     B-OTHER-PROC-CODE7   OR                      25600000
536700                     B-OTHER-PROC-CODE8   OR                      25600000
536800                     B-OTHER-PROC-CODE9   OR                      25600000
536900                     B-OTHER-PROC-CODE10  OR                      25600000
537000                     B-OTHER-PROC-CODE11  OR                      25600000
537100                     B-OTHER-PROC-CODE12  OR                      25600000
537200                     B-OTHER-PROC-CODE13  OR                      25600000
537300                     B-OTHER-PROC-CODE14  OR                      25600000
537400                     B-OTHER-PROC-CODE15  OR                      25600000
537500                     B-OTHER-PROC-CODE16  OR                      25600000
537600                     B-OTHER-PROC-CODE17  OR                      25600000
537700                     B-OTHER-PROC-CODE18  OR                      25600000
537800                     B-OTHER-PROC-CODE19  OR                      25600000
537900                     B-OTHER-PROC-CODE20  OR                      25600000
538000                     B-OTHER-PROC-CODE21  OR                      25600000
538100                     B-OTHER-PROC-CODE22  OR                      25600000
538200                     B-OTHER-PROC-CODE23  OR                      25600000
538300                     B-OTHER-PROC-CODE24                          25600000
538400           GO TO 4320-COMPUTE-SPIRAT.                             25610000
538500                                                                        00
538600
538700      IF '3373   ' =  B-PRIN-PROC-CODE     OR                     25550000
538800                      B-OTHER-PROC-CODE1   OR                     25560000
538900                      B-OTHER-PROC-CODE2   OR                     25570000
539000                      B-OTHER-PROC-CODE3   OR                     25580000
539100                      B-OTHER-PROC-CODE4   OR                     25590000
539200                      B-OTHER-PROC-CODE5   OR                     25600000
539300                      B-OTHER-PROC-CODE6   OR                     25600000
539400                      B-OTHER-PROC-CODE7   OR                     25600000
539500                      B-OTHER-PROC-CODE8   OR                     25600000
539600                      B-OTHER-PROC-CODE9   OR                     25600000
539700                      B-OTHER-PROC-CODE10  OR                     25600000
539800                      B-OTHER-PROC-CODE11  OR                     25600000
539900                      B-OTHER-PROC-CODE12  OR                     25600000
540000                      B-OTHER-PROC-CODE13  OR                     25600000
540100                      B-OTHER-PROC-CODE14  OR                     25600000
540200                      B-OTHER-PROC-CODE15  OR                     25600000
540300                      B-OTHER-PROC-CODE16  OR                     25600000
540400                      B-OTHER-PROC-CODE17  OR                     25600000
540500                      B-OTHER-PROC-CODE18  OR                     25600000
540600                      B-OTHER-PROC-CODE19  OR                     25600000
540700                      B-OTHER-PROC-CODE20  OR                     25600000
540800                      B-OTHER-PROC-CODE21  OR                     25600000
540900                      B-OTHER-PROC-CODE22  OR                     25600000
541000                      B-OTHER-PROC-CODE23  OR                     25600000
541100                      B-OTHER-PROC-CODE24                         25600000
541200           GO TO 4320-COMPUTE-SPIRAT.                             25610000
541300                                                                  25620000
541400      MOVE ZEROES TO H-NEW-TECH-ADDON-SPIRAT-STOP.                25630000
541500         GO TO 4320-ADD-TECH-CASES.                               25640000
541600                                                                  25650000
541700 4320-COMPUTE-SPIRAT.                                             25840000
541800                                                                  25650000
541900     MOVE  3437.50 TO H-CSTMED-SPIRAT-STOP.                       25660000
542000                                                                  25670000
542100     COMPUTE H-LESSER-SPIRAT-STOP-1 ROUNDED =                     25680000
542200                  H-CSTMED-SPIRAT-STOP.                           25690000
542300                                                                  25700000
542400     COMPUTE H-LESSER-SPIRAT-STOP-2 ROUNDED =                     25710000
542500          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
542600                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
542700                                                                  25740000
542800     IF H-LESSER-SPIRAT-STOP-2 > 0                                25750000
542900        IF H-LESSER-SPIRAT-STOP-1 < H-LESSER-SPIRAT-STOP-2        25760000
543000         MOVE H-LESSER-SPIRAT-STOP-1 TO
543100                                  H-NEW-TECH-ADDON-SPIRAT-STOP
543200        ELSE                                                      25780000
543300         MOVE H-LESSER-SPIRAT-STOP-2 TO
543400                                  H-NEW-TECH-ADDON-SPIRAT-STOP
543500     ELSE                                                         25800000
543600        MOVE ZEROES          TO H-NEW-TECH-ADDON-SPIRAT-STOP.     25810000
543700                                                                  25820000
543800                                                                  25830000
543900 4320-ADD-TECH-CASES.                                             25840000
544000                                                                  25850000
544100     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
544200             H-NEW-TECH-ADDON-SPIRAT-STOP.                        25890000
544300*                                                                 25900000
544400 4310-EXIT.    EXIT.                                              25910000
544500
544600***********************************************************       25510000
544700* THIS IS A SEARCH FOR LOW VOLUME PROVIDERS BASED ON THEIR        25520000
544800* DISCHARGE COUNTS.                                               25520000
544900***********************************************************       25530000
545000 4400-LOWVOL-CODE-RTN.
545100
545200     SET LOWVOL-IDX TO 1.
545300     SEARCH LOWVOL-TAB VARYING LOWVOL-IDX
545400         AT END
545500           MOVE ' NO LOWVOL PROVIDER FOUND' TO MES-LOWVOL
545600           MOVE 1600 TO  MESWK-LOWVOL-PROV-DISCHG
545700       WHEN WK-LOWVOL-PROV (LOWVOL-IDX) = MES-PPS-PROV
545800         MOVE WK-LOWVOL-PROV-DISCHG(LOWVOL-IDX)
545900                            TO MESWK-LOWVOL-PROV-DISCHG.
546000
546100 4400-EXIT.   EXIT.
546200
546300
546400 4500-AUTOLIT-TECH-ADD-ON.                                        25940000
546500***********************************************************       25510000
546600***** CASES INVOLVING AUTOLITT PROCESS DECOMPRESSION SYSTEM       25520000
546700***********************************************************       25530000
546800                                                                  25540000
546900     IF '1761   ' =  B-PRIN-PROC-CODE     OR                      25550000
547000                     B-OTHER-PROC-CODE1   OR                      25560000
547100                     B-OTHER-PROC-CODE2   OR                      25570000
547200                     B-OTHER-PROC-CODE3   OR                      25580000
547300                     B-OTHER-PROC-CODE4   OR                      25590000
547400                     B-OTHER-PROC-CODE5   OR                      25600000
547500                     B-OTHER-PROC-CODE6   OR                      25600000
547600                     B-OTHER-PROC-CODE7   OR                      25600000
547700                     B-OTHER-PROC-CODE8   OR                      25600000
547800                     B-OTHER-PROC-CODE9   OR                      25600000
547900                     B-OTHER-PROC-CODE10  OR                      25600000
548000                     B-OTHER-PROC-CODE11  OR                      25600000
548100                     B-OTHER-PROC-CODE12  OR                      25600000
548200                     B-OTHER-PROC-CODE13  OR                      25600000
548300                     B-OTHER-PROC-CODE14  OR                      25600000
548400                     B-OTHER-PROC-CODE15  OR                      25600000
548500                     B-OTHER-PROC-CODE16  OR                      25600000
548600                     B-OTHER-PROC-CODE17  OR                      25600000
548700                     B-OTHER-PROC-CODE18  OR                      25600000
548800                     B-OTHER-PROC-CODE19  OR                      25600000
548900                     B-OTHER-PROC-CODE20  OR                      25600000
549000                     B-OTHER-PROC-CODE21  OR                      25600000
549100                     B-OTHER-PROC-CODE22  OR                      25600000
549200                     B-OTHER-PROC-CODE23  OR                      25600000
549300                     B-OTHER-PROC-CODE24                          25600000
549400           GO TO 4500-COMPUTE-AUTOLITT                            25610000
549500     ELSE                                                         25620000
549600           NEXT SENTENCE.                                         25610000
549700                                                                        00
549800           MOVE ZEROES TO H-NEW-TECH-ADDON-AUTOLITT-STOP.         25630000
549900           GO TO 4500-ADD-TECH-CASES.                             25640000
550000                                                                  25650000
550100 4500-COMPUTE-AUTOLITT.                                           25840000
550200                                                                  25650000
550300     MOVE  5300.00 TO H-CSTMED-AUTOLITT-STOP.                     25660000
550400                                                                  25670000
550500     COMPUTE H-LESSER-AUTOLITT-STOP-1 ROUNDED =                   25680000
550600                  H-CSTMED-AUTOLITT-STOP.                         25690000
550700                                                                  25700000
550800     COMPUTE H-LESSER-AUTOLITT-STOP-2 ROUNDED =                   25710000
550900          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
551000                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
551100                                                                  25740000
551200     IF H-LESSER-AUTOLITT-STOP-2 > 0                              25750000
551300        IF H-LESSER-AUTOLITT-STOP-1 < H-LESSER-AUTOLITT-STOP-2    25760000
551400         MOVE H-LESSER-AUTOLITT-STOP-1 TO
551500                                H-NEW-TECH-ADDON-AUTOLITT-STOP
551600        ELSE                                                      25780000
551700         MOVE H-LESSER-AUTOLITT-STOP-2 TO
551800                                H-NEW-TECH-ADDON-AUTOLITT-STOP
551900     ELSE                                                         25800000
552000        MOVE ZEROES          TO H-NEW-TECH-ADDON-AUTOLITT-STOP.   25810000
552100                                                                  25820000
552200                                                                  25830000
552300 4500-ADD-TECH-CASES.                                             25840000
552400                                                                  25850000
552500     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
552600             H-NEW-TECH-ADDON-AUTOLITT-STOP.                      25890000
552700*                                                                 25900000
552800 4500-EXIT.    EXIT.                                              25910000
552900
553000***********************************************************       25920000
553100******        L A S T   S O U R C E   S T A T E M E N T   *****   26009700
