000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.          SNFDR150.                                   00020000
000300*AUTHOR.                 CMS.                                     00030000
000400*                                                                 00040000
000500******************************************************************00050000
000600*REMARKS.                                                         00060000
000700*     SNFPR990   NATIONAL SNF FOR JULY 1 1998                     00070000
000800*                MSA FILE = ML12.DBA2652.WIPREREC.#970924         00080000
000900*     SNFPR000   EFFECTIVE OCT 1, 1999                            00090000
001000*                MSA FILE = ML12.DBA2652.WIPREREC.#990628         00100000
001100*                      BOTH YEARS                                 00110000
001200*                      ADDED 48 VIRGIN ISLAND TO MSA FILE         00120000
001300*                      ADDED 65 GUAM TO MSA FILE                  00130000
001400*                MADE MSA FILE AN ARGUMENT PASTED TO SNFPR        00140000
001500*     SNFPR001   EFFECTIVE APR 1, 2000                            00150000
001600*                   20% INCREASE FOR 15 RUGS                      00160000
001700*                EFFECTIVE JAN 1, 2000                            00170000
001800*                   100 % FACILITY FOR TWO PROVIDERS              00180000
001900*     SNFPR010   EFFECTIVE OCT 1, 2000                            00190000
002000*                MSA FILE = ML12.DBA2652.WIPREREC.#000705.STANLEY 00200000
002100*                   24% INCREASE FOR 15 RUGS                      00210000
002200*                   04% INCREASE FOR ALL OTHER RUGS               00220000
002300*                   NEW RATES FOR FY 2001                         00230000
002400*     SNFPR012   EFFECTIVE APR 1, 2001 WITH NEW RATES             00240000
002500*                MSA FILE = ML12.DBA2652.WIPREREC.#000705.STANLEY 00250000
002600*                 ADD ONS ARE APPLIED AFTER ALL ADJUSTMENTS ARE MA00260000
002700*                   MADE. THE THREE ADD ONS ARE  4%, 10.7%, 24%.  00270000
002800*                   NEW RATES FOR FY 2001                         00280000
002900*     SNFPR020   EFFECTIVE OCT 1, 2001 WITH NEW RATES             00290000
003000*                MSA FILE = ML12.DBA2652.WIPREREC.#010707.STANLEY 00300000
003100*                 ADD ONS ARE APPLIED AFTER ALL ADJUSTMENTS ARE MA00310000
003200*                   MADE. THE THREE ADD ONS ARE  4%, 10.7%, 24%.  00320000
003300*                   NEW RATES FOR FY 2002                         00330000
003400*     SNFPR020   EFFECTIVE DEC 1, 2001 CHANGE FOR FOLLOWING MSA   00340000
003500*     MSA021     MSA 1123, 3810, 7520                             00350000
003600*               MSA FILE = ML12.@DBA2652.WIPREREC.#010707.STANLEY 00360000
003700*     SNFPR030   EFFECTIVE OCT 1, 2002 WITH NEW RATES             00370000
003800*               MSA FILE = ML12.@DBA2652.WIPREREC.#020709.STANLEY 00380000
003900*                THE TWO ADD-ONS ARE  6.7% AND 20%                00390000
004000*     SNFPR040   EFFECTIVE OCT 1, 2003 WITH NEW RATES             00400000
004100*              MSA FILE =  ML00.@DBA2652.WIPREREC.#030826.STANLEY 00410000
004200*     SNFPR050   EFFECTIVE OCT 1, 2004                            00420000
004300*         MSA FILE =  ML00.@DBA2652.WI2005.PFPREC.#040901.SCR401U 00430000
004400*              INCREASED INPUT AND OUTPUT FILE TO 125 BYTES       00440000
004500*                   ADDED 9 DIAGNOSIS CODES                       00450000
004600*              STILL PROCESS USING MSA FILE                       00460000
004700*     SNFPR051   EFFECTIVE JAN 1, 2005                            00470000
004800*         MSA FILE =  ML00.@DBA2652.WI2005.PFPREC.#041020.SCR401U 00480000
004900*     SNFPR060   EFFECTIVE OCT 1, 2005                            00490000
005000*              NO CBSA FILE FOR FY2006                            00500000
005100*                 WILL USE THE WAGE INDEX LOCATED IN PROV RECORD  00510000
005200*     SNFPR061   EFFECTIVE JUL 1, 2006                            00520000
005300*              CONVERT TO CICS                                    00530000
005400*     SNFPR071   EFFECTIVE OCT 1, 2006                            00540000
005500*              UPDATE RATE                                        00550000
005600*              ADD CBSA FILE FOR FY2007                           00560000
005700*     SNFPR082   EFFECTIVE OCT 2, 2007                            00570000
005800*              KEEP CBSA FILE FOR FY2008                          00580000
005900*     SNFPR090   EFFECTIVE OCT 2, 2008                            00590000
006000*              KEEP CBSA FILE FOR FY2009                          00600000
006100*     SNFPR100   EFFECTIVE OCT 1, 2009                            00610000
006200*              KEEP CBSA FILE FOR FY2009                          00620000
006300*     SNFPR101   EFFECTIVE OCT 1, 2009                            00630000
006400*              KEEP CBSA FILE FOR FY2009                          00640000
006500******************************************************************00650000
006600*     SNFPR102   EFFECTIVE OCT 2, 2009                            00660000
006700*              KEEP CBSA FILE FOR FY2010                          00670000
006800******************************************************************00680000
006900*     SNFPR112   EFFECTIVE OCT 1, 2010                            00690000
007000*              KEEP CBSA FILE FOR FY2011                          00700000
007100******************************************************************00710000
007200*     SNFPR120   EFFECTIVE OCT 1, 2011                            00720000
007300*              KEEP CBSA FILE FOR FY2012                          00730000
007400******************************************************************00740001
007500*     SNFPR140   EFFECTIVE OCT 1, 2013                            00750000
007600*              KEEP CBSA FILE FOR FY2014                          00760000
007700******************************************************************00770000
007800*     SNFPR150   EFFECTIVE OCT 1, 2014                            00780000
007900*              KEEP CBSA FILE FOR FY2015                          00790000
008000******************************************************************00800000
008100 DATE-COMPILED.                                                   00810000
008200 ENVIRONMENT                     DIVISION.                        00820000
008300                                                                  00830000
008400 CONFIGURATION                   SECTION.                         00840000
008500 SOURCE-COMPUTER.                IBM-370.                         00850000
008600 OBJECT-COMPUTER.                IBM-370.                         00860000
008700                                                                  00870000
008800 INPUT-OUTPUT SECTION.                                            00880000
008900 FILE-CONTROL.                                                    00890000
009000 DATA DIVISION.                                                   00900000
009100 FILE SECTION.                                                    00910000
009200                                                                  00920000
009300 WORKING-STORAGE SECTION.                                         00930000
009400 77  W-STORAGE-REF               PIC X(49)  VALUE                 00940000
009500     'SNF D R I V E R   - W O R K I N G   S T O R A G E'.         00950000
009600 01  SNFDR-VERSION               PIC X(09)  VALUE 'SNFDR15.0'.    00960000
009700 01  SNFPR150                    PIC X(08)  VALUE 'SNFPR150'.     00970000
009800 01  HOLD-SNF-CBSA.                                               00980000
009900     05  HOLD-SNF-CBSA-1ST       PIC XXX    VALUE SPACES.         00990000
010000     05  HOLD-SNF-CBSA-2ND       PIC XX     VALUE SPACES.         01000000
010100 01  SNF-HOLD-THRU-DATE.                                          01010000
010200     05  SNF-HOLD-THRU-CC        PIC XX.                          01020000
010300     05  SNF-HOLD-THRU-YYMMDD.                                    01030000
010400         15  SNF-HOLD-THRU-YY    PIC XX.                          01040000
010500         15  SNF-HOLD-THRU-MMDD  PIC XXXX.                        01050000
010600                                                                  01060000
010700*******************************************************           01070000
010800*    PASSED TO SNFPR PROGRAM CLAIMS                   *           01080000
010900*         FOR CLAIMS PRIOR 10/01/2005                 *           01090000
011000*******************************************************           01100000
011100 01  MSA-WAGE-INDEX-RECORD.                                       01110000
011200     02  MSA-WIR-MSA           PIC X(04).                         01120000
011300     02  MSA-WIR-EFFDATE       PIC X(08).                         01130000
011400     02  MSA-WIR-AREA-WAGEIND  PIC X(06).                         01140000
011500                                                                  01150000
011600*******************************************************           01160000
011700*    PASSED TO SNFPR PROGRAM CLAIMS                   *           01170000
011800*         FOR CLAIMS ON OR AFTER  10/01/2005          *           01180000
011900*******************************************************           01190000
012000 01  CBSA-WAGE-INDEX-RECORD.                                      01200000
012100     02  CBSA-WIR-CBSA         PIC X(05).                         01210000
012200     02  CBSA-WIR-EFFDATE      PIC X(08).                         01220000
012300     02  CBSA-WIR-AREA-WAGEIND PIC X(06).                         01230000
012400                                                                  01240000
012500 LINKAGE SECTION.                                                 01250000
012600                                                                  01260000
012700*******************************************************           01270000
012800* NATIONAL SNF RECORD FORMAT PASSED TO SNFPR PROGRAM  *           01280000
012900*******************************************************           01290000
013000 01  SNF-WORK.                                                    01300000
013100     05  SNF-INPUT-DATA.                                          01310000
013200         10  SNF-MSA           PIC X(04).                         01320000
013300         10  SNF-CBSA.                                            01330000
013400             15  SNF-CBSA-1ST  PIC XXX.                           01340000
013500                 88  SNF-CBSA-RURAL   VALUE '   ' '999'.          01350000
013600             15  SNF-CBSA-2ND  PIC XX.                            01360000
013700         10  SNF-SPEC-WI-IND   PIC X.                             01370000
013800             88  SNF-SPEC-WI-IND-VALUES   VALUE 'Y' 'N' '1' '2'.  01380000
013900         10  SNF-SPEC-WI       PIC 9(02)V9(04).                   01390000
014000         10  SNF-SPEC-WI-X     REDEFINES                          01400000
014100                               SNF-SPEC-WI PIC X(06).             01410000
014200         10  SNF-HCPPS-CODE    PIC X(05).                         01420000
014300         10  SNF-FROM-DATE.                                       01430000
014400             15  SNF-FROM-CC   PIC XX.                            01440000
014500             15  SNF-FROM-YYMMDD.                                 01450000
014600                 25  SNF-FROM-YY                                  01460000
014700                               PIC XX.                            01470000
014800                 25  SNF-FROM-MM                                  01480000
014900                               PIC XX.                            01490000
015000                 25  SNF-FROM-DD                                  01500000
015100                               PIC XX.                            01510000
015200         10  SNF-THRU-DATE.                                       01520000
015300             15  SNF-THRU-CC   PIC XX.                            01530000
015400             15  SNF-THRU-YYMMDD.                                 01540000
015500                 25  SNF-THRU-YY                                  01550000
015600                               PIC XX.                            01560000
015700                 25  SNF-THRU-MM                                  01570000
015800                               PIC XX.                            01580000
015900                 25  SNF-THRU-DD                                  01590000
016000                               PIC XX.                            01600000
016100         10  SNF-FED-BLEND     PIC X.                             01610000
016200             88  SNF-FED-BLEND-VALUES                             01620000
016300                                   VALUE '0' '1' '2' '3' '4'.     01630000
016400         10  SNF-FACILITY-RATE PIC 9(05)V9(02).                   01640000
016500         10  SNF-DIAGNOSIS-CODES.                                 01650000
016600             15  SNF-PRIN-DIAG-CODE      PIC X(07).               01660000
016700             15  SNF-OTHER-DIAG-CODE2    PIC X(07).               01670000
016800             15  SNF-OTHER-DIAG-CODE3    PIC X(07).               01680000
016900             15  SNF-OTHER-DIAG-CODE4    PIC X(07).               01690000
017000             15  SNF-OTHER-DIAG-CODE5    PIC X(07).               01700000
017100             15  SNF-OTHER-DIAG-CODE6    PIC X(07).               01710000
017200             15  SNF-OTHER-DIAG-CODE7    PIC X(07).               01720000
017300             15  SNF-OTHER-DIAG-CODE8    PIC X(07).               01730000
017400             15  SNF-OTHER-DIAG-CODE9    PIC X(07).               01740000
017500             15  SNF-OTHER-DIAG-CODE10   PIC X(07).               01750000
017600             15  SNF-OTHER-DIAG-CODE11   PIC X(07).               01760000
017700             15  SNF-OTHER-DIAG-CODE12   PIC X(07).               01770000
017800             15  SNF-OTHER-DIAG-CODE13   PIC X(07).               01780000
017900             15  SNF-OTHER-DIAG-CODE14   PIC X(07).               01790000
018000             15  SNF-OTHER-DIAG-CODE15   PIC X(07).               01800000
018100             15  SNF-OTHER-DIAG-CODE16   PIC X(07).               01810000
018200             15  SNF-OTHER-DIAG-CODE17   PIC X(07).               01820000
018300             15  SNF-OTHER-DIAG-CODE18   PIC X(07).               01830000
018400             15  SNF-OTHER-DIAG-CODE19   PIC X(07).               01840000
018500             15  SNF-OTHER-DIAG-CODE20   PIC X(07).               01850000
018600             15  SNF-OTHER-DIAG-CODE21   PIC X(07).               01860000
018700             15  SNF-OTHER-DIAG-CODE22   PIC X(07).               01870000
018800             15  SNF-OTHER-DIAG-CODE23   PIC X(07).               01880000
018900             15  SNF-OTHER-DIAG-CODE24   PIC X(07).               01890000
019000             15  SNF-OTHER-DIAG-CODE25   PIC X(07).               01900000
019100         10  SNF-PAY-RTC.                                         01910000
019200             15  SNF-PAYMENT-RATE                                 01920000
019300                               PIC 9(06)V9(02).                   01930000
019400             15  SNF-RTC       PIC 99.                            01940000
019500         10  SNF-FILLER            PIC X(24).                     01950005
019600                                                                  01960000
019700*******************************************************           01970000
019800*    RETURNED BY SNFPR PROGRAM                        *           01980000
019900*******************************************************           01990000
020000 01  HOLD-VARIABLES.                                              02000000
020100     02  HOLD-VAR-DATA.                                           02010000
020200         05  FACTOR            PIC 9.                             02020000
020300         05  NUR-INDEX         PIC 9V99.                          02030000
020400         05  THR-INDEX         PIC 9V99.                          02040000
020500         05  AREA-WAGE-INDEX   PIC 9(01)V9(04).                   02050000
020600         05  IP-RATE           PIC 9(03)V9(02).                   02060000
020700         05  GS-RATE           PIC 9(02)V9(02).                   02070000
020800         05  TH-RATE           PIC 9(02)V9(02).                   02080000
020900         05  REHAB-RATE        PIC 9(03)V9(02).                   02090000
021000         05  NURSING-COMPONENT PIC 999V99.                        02100000
021100         05  THERAPY-COMPONENT PIC 999V99.                        02110000
021200         05  NCM-THR-COMPONENT PIC 999V99.                        02120000
021300         05  NCM-COMPONENT     PIC 999V99.                        02130000
021400         05  PAYMENT-RATE-ADJ  PIC 9(06)V99.                      02140000
021500         05  FED-PAYMENT       PIC 9(06)V99.                      02150000
021600     02  SNFPR-VERSION         PIC X(09).                         02160000
021700                                                                  02170000
021800                                                                  02180000
021900                                                                  02190000
022000 01  MSA-WI-TABLE.                                                02200000
022100     05  MSA-DATA        OCCURS 8000                              02210000
022200                           INDEXED BY MU1 MU2 MU3.                02220000
022300         10  MSA-TB-MSA        PIC X(04).                         02230000
022400         10  MSA-TB-EFFDATE    PIC X(08).                         02240000
022500         10  MSA-TB-WAGEIND    PIC X(06).                         02250000
022600                                                                  02260000
022700 01  CBSA-WI-TABLE.                                               02270000
022800     05  T-CBSA-DATA        OCCURS 8000                           02280000
022900                           INDEXED BY MA1 MA2 MA3.                02290000
023000         10  T-CBSA            PIC X(05).                         02300000
023100         10  T-CBSA-EFFDATE    PIC X(08).                         02310000
023200         10  T-CBSA-WAGEIND    PIC X(06).                         02320000
023300                                                                  02330000
023400 PROCEDURE  DIVISION USING SNF-WORK                               02340000
023500                           HOLD-VARIABLES                         02350000
023600                           CBSA-WI-TABLE                          02360000
023700                           MSA-WI-TABLE.                          02370000
023800                                                                  02380000
023900 0000-MAINLINE  SECTION.                                          02390000
024000                                                                  02400000
024100     PERFORM 0100-PROCESS-RECORDS                                 02410000
024200        THRU 0100-EXIT.                                           02420000
024300                                                                  02430000
024400     GOBACK.                                                      02440000
024500                                                                  02450000
024600                                                                  02460000
024700 0100-PROCESS-RECORDS.                                            02470000
024800                                                                  02480000
024900     MOVE ALL '0'              TO SNF-PAY-RTC                     02490000
025000                                  HOLD-VAR-DATA                   02500000
025100                                  MSA-WAGE-INDEX-RECORD           02510000
025200                                  CBSA-WAGE-INDEX-RECORD.         02520000
025300                                                                  02530000
025400     IF SNF-THRU-DATE < 19980701                                  02540000
025500        MOVE '40'              TO SNF-RTC                         02550000
025600        GO TO 0100-EXIT.                                          02560000
025700                                                                  02570000
025800     MOVE SNF-CBSA             TO HOLD-SNF-CBSA.                  02580000
025900                                                                  02590000
026000     IF SNF-CBSA-RURAL                                            02600000
026100        MOVE SPACES            TO HOLD-SNF-CBSA-1ST.              02610000
026200                                                                  02620000
026300     IF SNF-THRU-DATE < 20051001                                  02630000
026400        PERFORM 1600-GET-MSA                                      02640000
026500           THRU 1600-EXIT                                         02650000
026600     ELSE                                                         02660000
026700        PERFORM 1650-GET-CBSA                                     02670000
026800           THRU 1650-EXIT.                                        02680000
026900                                                                  02690000
027000     IF SNF-RTC NOT = '00'                                        02700000
027100         GO TO 0100-EXIT.                                         02710000
027200                                                                  02720000
027300     IF SNF-THRU-DATE < 20051001                                  02730000
027400         PERFORM 1700-GET-WAGE-INDEX                              02740000
027500            THRU 1700-EXIT                                        02750000
027600         VARYING MU2           FROM MU1 BY 1 UNTIL                02760000
027700         MSA-TB-MSA (MU2) NOT = SNF-MSA                           02770000
027800     ELSE                                                         02780000
027900         PERFORM 1900-GET-WAGE-INDEX                              02790000
028000            THRU 1900-EXIT                                        02800000
028100         VARYING MA2           FROM MA1 BY 1 UNTIL                02810000
028200         T-CBSA (MA2) NOT = HOLD-SNF-CBSA.                        02820000
028300                                                                  02830000
028400     IF SNF-THRU-DATE < 20051001                                  02840000
028500        IF '000000' = MSA-WIR-AREA-WAGEIND                        02850000
028600            MOVE '30'          TO SNF-RTC                         02860000
028700            GO TO 0100-EXIT.                                      02870000
028800                                                                  02880000
028900     IF SNF-RTC NOT = '00'                                        02890000
029000         GO TO 0100-EXIT.                                         02900000
029100                                                                  02910003
029200                                                                  02920000
029300     CALL  SNFPR150 USING SNF-WORK                                02930000
029400                          HOLD-VARIABLES                          02940000
029500                          CBSA-WAGE-INDEX-RECORD                  02950000
029600                          MSA-WAGE-INDEX-RECORD.                  02960000
029700                                                                  02970000
029800 0100-EXIT.  EXIT.                                                02980000
029900                                                                  02990000
030000                                                                  03000000
030100 1600-GET-MSA.                                                    03010000
030200     SET MU1                   TO 1.                              03020000
030300                                                                  03030000
030400     SEARCH MSA-DATA VARYING MU1                                  03040000
030500            AT END                                                03050000
030600               MOVE '30'       TO SNF-RTC                         03060000
030700               GO TO 1600-EXIT                                    03070000
030800            WHEN MSA-TB-MSA (MU1) = SNF-MSA                       03080000
030900               SET MU2         TO MU1.                            03090000
031000                                                                  03100000
031100 1600-EXIT.  EXIT.                                                03110000
031200                                                                  03120000
031300 1650-GET-CBSA.                                                   03130000
031400     SET MA1                   TO 1.                              03140000
031500                                                                  03150000
031600     SEARCH T-CBSA-DATA VARYING MA1                               03160000
031700            AT END                                                03170000
031800               MOVE '30'       TO SNF-RTC                         03180000
031900               GO TO 1650-EXIT                                    03190000
032000            WHEN T-CBSA (MA1) = HOLD-SNF-CBSA                     03200000
032100               SET MA2         TO MA1.                            03210000
032200                                                                  03220000
032300 1650-EXIT.  EXIT.                                                03230000
032400                                                                  03240000
032500 1700-GET-WAGE-INDEX.                                             03250000
032600                                                                  03260000
032700     IF SNF-THRU-DATE NOT < MSA-TB-EFFDATE (MU2)                  03270000
032800        MOVE MSA-TB-MSA     (MU2)                                 03280000
032900                               TO MSA-WIR-MSA                     03290000
033000        MOVE MSA-TB-EFFDATE (MU2)                                 03300000
033100                               TO MSA-WIR-EFFDATE                 03310000
033200        MOVE MSA-TB-WAGEIND (MU2)                                 03320000
033300                               TO MSA-WIR-AREA-WAGEIND.           03330000
033400                                                                  03340000
033500 1700-EXIT.  EXIT.                                                03350000
033600                                                                  03360000
033700 1900-GET-WAGE-INDEX.                                             03370000
033800                                                                  03380000
033900     IF  SNF-SPEC-WI-IND = 'Y'                                    03390002
034000         MOVE '1'              TO SNF-SPEC-WI-IND.                03400002
034100                                                                  03410002
034200     IF  SNF-SPEC-WI-IND = '1' AND SNF-SPEC-WI-X NOT NUMERIC      03420002
034300         MOVE '30'             TO SNF-RTC                         03430002
034400         GO TO 1900-EXIT.                                         03440000
034500                                                                  03450000
034600     IF  SNF-SPEC-WI-IND = '1' AND SNF-SPEC-WI-X NUMERIC          03460000
034700         MOVE SNF-CBSA         TO CBSA-WIR-CBSA                   03470000
034800         MOVE '20051001'       TO CBSA-WIR-EFFDATE                03480000
034900         MOVE SNF-SPEC-WI-X    TO CBSA-WIR-AREA-WAGEIND           03490000
035000         GO TO 1900-EXIT.                                         03500000
035100                                                                  03510000
035200     MOVE SNF-THRU-DATE TO SNF-HOLD-THRU-DATE                     03520000
035300                                                                  03530000
035400     IF SNF-HOLD-THRU-DATE NOT < T-CBSA-EFFDATE (MA2)             03540000
035500        MOVE T-CBSA         (MA2)                                 03550000
035600                               TO CBSA-WIR-CBSA                   03560000
035700        MOVE T-CBSA-EFFDATE (MA2)                                 03570000
035800                               TO CBSA-WIR-EFFDATE                03580000
035900        MOVE T-CBSA-WAGEIND (MA2)                                 03590000
036000                               TO CBSA-WIR-AREA-WAGEIND.          03600000
036100                                                                  03610000
036200 1900-EXIT.  EXIT.                                                03620000
036300*****        LAST STATEMENT               *************           03630000
