000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.          SNFDR130.                                   00020002
000300*AUTHOR.                 CMS.                                     00030005
000400*                                                                 00040005
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                            00561000
005800*              KEEP CBSA FILE FOR FY2008                          00562000
005900*     SNFPR090   EFFECTIVE OCT 2, 2008                            00562100
006000*              KEEP CBSA FILE FOR FY2009                          00562200
006100*     SNFPR100   EFFECTIVE OCT 1, 2009                            00562300
006200*              KEEP CBSA FILE FOR FY2009                          00562400
006300*     SNFPR101   EFFECTIVE OCT 1, 2009                            00562500
006400*              KEEP CBSA FILE FOR FY2009                          00562600
006500******************************************************************00562700
006600*     SNFPR102   EFFECTIVE OCT 2, 2009                            00562800
006700*              KEEP CBSA FILE FOR FY2010                          00562900
006800******************************************************************00563000
006900*     SNFPR112   EFFECTIVE OCT 1, 2010                            00563100
007000*              KEEP CBSA FILE FOR FY2011                          00563200
007100******************************************************************00563300
007200*     SNFPR120   EFFECTIVE OCT 1, 2011                            00563500
007300*              KEEP CBSA FILE FOR FY2012                          00563600
007400******************************************************************00563700
007200*     SNFPR130   EFFECTIVE OCT 1, 2012                            00563801
007300*              KEEP CBSA FILE FOR FY2013                          00563901
007400******************************************************************00564001
007500 DATE-COMPILED.                                                   00564100
007600 ENVIRONMENT                     DIVISION.                        00564200
007700                                                                  00564300
007800 CONFIGURATION                   SECTION.                         00564400
007900 SOURCE-COMPUTER.                IBM-370.                         00564500
008000 OBJECT-COMPUTER.                IBM-370.                         00564600
008100                                                                  00564700
008200 INPUT-OUTPUT SECTION.                                            00564800
008300 FILE-CONTROL.                                                    00564900
008400 DATA DIVISION.                                                   00565000
008500 FILE SECTION.                                                    00565100
008600                                                                  00565200
008700 WORKING-STORAGE SECTION.                                         00565300
008800 77  W-STORAGE-REF               PIC X(49)  VALUE                 00565400
008900     'SNF D R I V E R   - W O R K I N G   S T O R A G E'.         00565500
009000 01  SNFDR-VERSION               PIC X(09)  VALUE 'SNFDR13.0'.    00565601
009100 01  SNFPR130                    PIC X(08)  VALUE 'SNFPR130'.     00565701
009200 01  HOLD-SNF-CBSA.                                               00566000
009300     05  HOLD-SNF-CBSA-1ST       PIC XXX    VALUE SPACES.         00567000
009400     05  HOLD-SNF-CBSA-2ND       PIC XX     VALUE SPACES.         00568000
009500 01  SNF-HOLD-THRU-DATE.                                          00569000
009600     05  SNF-HOLD-THRU-CC        PIC XX.                          00570000
009700     05  SNF-HOLD-THRU-YYMMDD.                                    00580000
009800         15  SNF-HOLD-THRU-YY    PIC XX.                          00590000
009900         15  SNF-HOLD-THRU-MMDD  PIC XXXX.                        00600000
010800                                                                  00601001
010000*******************************************************           00610000
010100*    PASSED TO SNFPR PROGRAM CLAIMS                   *           00620000
010200*         FOR CLAIMS PRIOR 10/01/2005                 *           00630000
010300*******************************************************           00631000
010400 01  MSA-WAGE-INDEX-RECORD.                                       00632000
010500     02  MSA-WIR-MSA           PIC X(04).                         00633005
010600     02  MSA-WIR-EFFDATE       PIC X(08).                         00634005
010700     02  MSA-WIR-AREA-WAGEIND  PIC X(06).                         00635005
010800                                                                  00636000
010900*******************************************************           00637000
011000*    PASSED TO SNFPR PROGRAM CLAIMS                   *           00638000
011100*         FOR CLAIMS ON OR AFTER  10/01/2005          *           00639000
011200*******************************************************           00640000
011300 01  CBSA-WAGE-INDEX-RECORD.                                      00650000
011400     02  CBSA-WIR-CBSA         PIC X(05).                         00660005
011500     02  CBSA-WIR-EFFDATE      PIC X(08).                         00670005
011600     02  CBSA-WIR-AREA-WAGEIND PIC X(06).                         00680005
011700                                                                  00690000
011800 LINKAGE SECTION.                                                 00700000
011900                                                                  00710000
012000*******************************************************           00720000
012100* NATIONAL SNF RECORD FORMAT PASSED TO SNFPR PROGRAM  *           00730000
012200*******************************************************           00740000
012300 01  SNF-WORK.                                                    00750000
012400     05  SNF-INPUT-DATA.                                          00760000
012500         10  SNF-MSA           PIC X(04).                         00770005
012600         10  SNF-CBSA.                                            00780000
012700             15  SNF-CBSA-1ST  PIC XXX.                           00790005
012800                 88  SNF-CBSA-RURAL   VALUE '   ' '999'.          00800000
012900             15  SNF-CBSA-2ND  PIC XX.                            00810005
013000         10  SNF-SPEC-WI-IND   PIC X.                             00820005
013100             88  SNF-SPEC-WI-IND-VALUES   VALUE 'Y' 'N' '1' '2'.  00830000
013200         10  SNF-SPEC-WI       PIC 9(02)V9(04).                   00840005
013300         10  SNF-SPEC-WI-X     REDEFINES                          00850005
013300                               SNF-SPEC-WI PIC X(06).             00851005
013400         10  SNF-HCPPS-CODE    PIC X(05).                         00860005
013500         10  SNF-FROM-DATE.                                       00870000
013600             15  SNF-FROM-CC   PIC XX.                            00880005
013700             15  SNF-FROM-YYMMDD.                                 00890000
013800                 25  SNF-FROM-YY                                  00900005
013800                               PIC XX.                            00901005
013900                 25  SNF-FROM-MM                                  00910005
013800                               PIC XX.                            00911005
014000                 25  SNF-FROM-DD                                  00920005
013800                               PIC XX.                            00921005
014100         10  SNF-THRU-DATE.                                       00930000
014200             15  SNF-THRU-CC   PIC XX.                            00940005
014300             15  SNF-THRU-YYMMDD.                                 00950000
014400                 25  SNF-THRU-YY                                  00960005
013800                               PIC XX.                            00961005
014500                 25  SNF-THRU-MM                                  00970005
013800                               PIC XX.                            00971005
014600                 25  SNF-THRU-DD                                  00980005
013800                               PIC XX.                            00981005
014700         10  SNF-FED-BLEND     PIC X.                             00990005
014800             88  SNF-FED-BLEND-VALUES                             01000000
014900                                   VALUE '0' '1' '2' '3' '4'.     01010005
015000         10  SNF-FACILITY-RATE PIC 9(05)V9(02).                   01020005
015100         10  SNF-DIAGNOSIS-CODES.                                 01030000
015200             15  SNF-PRIN-DIAG-CODE      PIC X(07).               01040000
015300             15  SNF-OTHER-DIAG-CODE2    PIC X(07).               01050000
015400             15  SNF-OTHER-DIAG-CODE3    PIC X(07).               01060000
015500             15  SNF-OTHER-DIAG-CODE4    PIC X(07).               01070000
015600             15  SNF-OTHER-DIAG-CODE5    PIC X(07).               01080000
015700             15  SNF-OTHER-DIAG-CODE6    PIC X(07).               01090000
015800             15  SNF-OTHER-DIAG-CODE7    PIC X(07).               01100000
015900             15  SNF-OTHER-DIAG-CODE8    PIC X(07).               01110000
016000             15  SNF-OTHER-DIAG-CODE9    PIC X(07).               01120000
016100             15  SNF-OTHER-DIAG-CODE10   PIC X(07).               01121000
016200             15  SNF-OTHER-DIAG-CODE11   PIC X(07).               01122000
016300             15  SNF-OTHER-DIAG-CODE12   PIC X(07).               01123000
016400             15  SNF-OTHER-DIAG-CODE13   PIC X(07).               01124000
016500             15  SNF-OTHER-DIAG-CODE14   PIC X(07).               01125000
016600             15  SNF-OTHER-DIAG-CODE15   PIC X(07).               01126000
016700             15  SNF-OTHER-DIAG-CODE16   PIC X(07).               01127000
016800             15  SNF-OTHER-DIAG-CODE17   PIC X(07).               01128000
016900             15  SNF-OTHER-DIAG-CODE18   PIC X(07).               01129000
017000             15  SNF-OTHER-DIAG-CODE19   PIC X(07).               01129100
017100             15  SNF-OTHER-DIAG-CODE20   PIC X(07).               01129200
017200             15  SNF-OTHER-DIAG-CODE21   PIC X(07).               01129300
017300             15  SNF-OTHER-DIAG-CODE22   PIC X(07).               01129400
017400             15  SNF-OTHER-DIAG-CODE23   PIC X(07).               01129500
017500             15  SNF-OTHER-DIAG-CODE24   PIC X(07).               01129600
017600             15  SNF-OTHER-DIAG-CODE25   PIC X(07).               01129700
017700         10  SNF-PAY-RTC.                                         01129800
017800             15  SNF-PAYMENT-RATE                                 01129905
017800                               PIC 9(06)V9(02).                   01130005
017900             15  SNF-RTC       PIC 99.                            01131005
018000         10  FILLER            PIC X(24).                         01140005
018100                                                                  01150000
018200*******************************************************           01160000
018300*    RETURNED BY SNFPR PROGRAM                        *           01170000
018400*******************************************************           01180000
018500 01  HOLD-VARIABLES.                                              01190000
018600     02  HOLD-VAR-DATA.                                           01200000
018700         05  FACTOR            PIC 9.                             01210005
018800         05  NUR-INDEX         PIC 9V99.                          01220005
018900         05  THR-INDEX         PIC 9V99.                          01230005
019000         05  AREA-WAGE-INDEX   PIC 9(01)V9(04).                   01240005
019100         05  IP-RATE           PIC 9(03)V9(02).                   01250005
019200         05  GS-RATE           PIC 9(02)V9(02).                   01260005
019300         05  TH-RATE           PIC 9(02)V9(02).                   01270005
019400         05  REHAB-RATE        PIC 9(03)V9(02).                   01280005
019500         05  NURSING-COMPONENT PIC 999V99.                        01290005
019600         05  THERAPY-COMPONENT PIC 999V99.                        01300005
019700         05  NCM-THR-COMPONENT PIC 999V99.                        01310005
019800         05  NCM-COMPONENT     PIC 999V99.                        01320005
019900         05  PAYMENT-RATE-ADJ  PIC 9(06)V99.                      01330005
020000         05  FED-PAYMENT       PIC 9(06)V99.                      01340005
020100     02  SNFPR-VERSION         PIC X(09).                         01350005
020200                                                                  01360000
020300                                                                  01370000
020400                                                                  01380000
020500 01  MSA-WI-TABLE.                                                01390000
020600     05  MSA-DATA        OCCURS 8000                              01400000
020700                           INDEXED BY MU1 MU2 MU3.                01410000
020800         10  MSA-TB-MSA        PIC X(04).                         01420000
020900         10  MSA-TB-EFFDATE    PIC X(08).                         01430000
021000         10  MSA-TB-WAGEIND    PIC X(06).                         01440000
021100                                                                  01450000
021200 01  CBSA-WI-TABLE.                                               01460000
021300     05  T-CBSA-DATA        OCCURS 8000                           01470000
021400                           INDEXED BY MA1 MA2 MA3.                01480000
021500         10  T-CBSA            PIC X(05).                         01490000
021600         10  T-CBSA-EFFDATE    PIC X(08).                         01500000
021700         10  T-CBSA-WAGEIND    PIC X(06).                         01510000
021800                                                                  01520000
021900 PROCEDURE  DIVISION USING SNF-WORK                               01530000
022000                           HOLD-VARIABLES                         01540000
022100                           CBSA-WI-TABLE                          01550000
022200                           MSA-WI-TABLE.                          01560000
022300                                                                  01570000
022400 0000-MAINLINE  SECTION.                                          01580000
022500                                                                  01590000
022600     PERFORM 0100-PROCESS-RECORDS                                 01600003
022600        THRU 0100-EXIT.                                           01601003
022700                                                                  01610000
022800     GOBACK.                                                      01620000
022900                                                                  01630000
023000                                                                  01640000
023100 0100-PROCESS-RECORDS.                                            01650000
023200                                                                  01660000
023300     MOVE ALL '0'              TO SNF-PAY-RTC                     01670003
023400                                  HOLD-VAR-DATA                   01680003
023500                                  MSA-WAGE-INDEX-RECORD           01690003
023600                                  CBSA-WAGE-INDEX-RECORD.         01700003
023700                                                                  01710000
023800     IF SNF-THRU-DATE < 19980701                                  01720000
023900        MOVE '40'              TO SNF-RTC                         01730003
024000        GO TO 0100-EXIT.                                          01740000
024100                                                                  01750000
024200     MOVE SNF-CBSA             TO HOLD-SNF-CBSA.                  01760003
024100                                                                  01761003
024300     IF SNF-CBSA-RURAL                                            01770000
024400        MOVE SPACES            TO HOLD-SNF-CBSA-1ST.              01780003
024500                                                                  01790000
024600     IF SNF-THRU-DATE < 20051001                                  01800000
024700        PERFORM 1600-GET-MSA                                      01810003
024700           THRU 1600-EXIT                                         01811003
024800     ELSE                                                         01820000
024900        PERFORM 1650-GET-CBSA                                     01830003
024900           THRU 1650-EXIT.                                        01831003
025000                                                                  01840000
025100     IF SNF-RTC NOT = '00'                                        01850000
025200         GO TO 0100-EXIT.                                         01860000
025300                                                                  01870000
025400     IF SNF-THRU-DATE < 20051001                                  01880000
025500         PERFORM 1700-GET-WAGE-INDEX                              01890005
025500            THRU 1700-EXIT                                        01891005
025600         VARYING MU2           FROM MU1 BY 1 UNTIL                01900005
025700         MSA-TB-MSA (MU2) NOT = SNF-MSA                           01910000
025800     ELSE                                                         01920000
025900         PERFORM 1900-GET-WAGE-INDEX                              01930005
025900            THRU 1900-EXIT                                        01931005
026000         VARYING MA2           FROM MA1 BY 1 UNTIL                01940005
026100         T-CBSA (MA2) NOT = HOLD-SNF-CBSA.                        01950000
026200                                                                  01960000
026300     IF SNF-THRU-DATE < 20051001                                  01970000
026400        IF '000000' = MSA-WIR-AREA-WAGEIND                        01980000
026500            MOVE '30'          TO SNF-RTC                         01990005
026600            GO TO 0100-EXIT.                                      02000005
026700                                                                  02010000
026800     IF SNF-RTC NOT = '00'                                        02020000
026900         GO TO 0100-EXIT.                                         02030000
027000                                                                  02040000
027100     CALL  SNFPR130 USING SNF-WORK                                02050004
027200                          HOLD-VARIABLES                          02060000
027300                          CBSA-WAGE-INDEX-RECORD                  02070000
027400                          MSA-WAGE-INDEX-RECORD.                  02080000
027500                                                                  02090000
027600 0100-EXIT.  EXIT.                                                02100000
027700                                                                  02110000
027800                                                                  02120000
027900 1600-GET-MSA.                                                    02130000
028000     SET MU1                   TO 1.                              02140005
028100                                                                  02150000
028200     SEARCH MSA-DATA VARYING MU1                                  02160000
028300            AT END                                                02170000
028400               MOVE '30'       TO SNF-RTC                         02180005
028500               GO TO 1600-EXIT                                    02190000
028600            WHEN MSA-TB-MSA (MU1) = SNF-MSA                       02200000
028700               SET MU2         TO MU1.                            02210005
028800                                                                  02220000
028900 1600-EXIT.  EXIT.                                                02230000
029000                                                                  02240000
029100 1650-GET-CBSA.                                                   02250000
029200     SET MA1                   TO 1.                              02260005
029300                                                                  02270000
029400     SEARCH T-CBSA-DATA VARYING MA1                               02280000
029500            AT END                                                02290000
029600               MOVE '30'       TO SNF-RTC                         02300005
029700               GO TO 1650-EXIT                                    02310000
029800            WHEN T-CBSA (MA1) = HOLD-SNF-CBSA                     02320000
029900               SET MA2         TO MA1.                            02330005
030000                                                                  02340000
030100 1650-EXIT.  EXIT.                                                02350000
030200                                                                  02360000
030300 1700-GET-WAGE-INDEX.                                             02370000
030400                                                                  02380000
030500     IF SNF-THRU-DATE NOT < MSA-TB-EFFDATE (MU2)                  02390000
030600        MOVE MSA-TB-MSA     (MU2)                                 02400005
030600                               TO MSA-WIR-MSA                     02401005
030700        MOVE MSA-TB-EFFDATE (MU2)                                 02410005
030700                               TO MSA-WIR-EFFDATE                 02411005
030800        MOVE MSA-TB-WAGEIND (MU2)                                 02420005
030800                               TO MSA-WIR-AREA-WAGEIND.           02421005
030900                                                                  02430000
031000 1700-EXIT.  EXIT.                                                02440000
031100                                                                  02450000
031200 1900-GET-WAGE-INDEX.                                             02460000
031300                                                                  02470000
031400     IF  SNF-SPEC-WI-IND = '1' AND SNF-SPEC-WI-X NOT NUMERIC      02480000
031500         MOVE '30'             TO SNF-RTC                         02490005
031600         GO TO 1900-EXIT.                                         02500000
031700                                                                  02510000
031800     IF  SNF-SPEC-WI-IND = '1' AND SNF-SPEC-WI-X NUMERIC          02520000
031900         MOVE SNF-CBSA         TO CBSA-WIR-CBSA                   02530005
032000         MOVE '20051001'       TO CBSA-WIR-EFFDATE                02540005
032100         MOVE SNF-SPEC-WI-X    TO CBSA-WIR-AREA-WAGEIND           02550005
032200         GO TO 1900-EXIT.                                         02560000
032300                                                                  02570000
032400     MOVE SNF-THRU-DATE TO SNF-HOLD-THRU-DATE                     02580000
032500                                                                  02590000
032600     IF SNF-HOLD-THRU-DATE NOT < T-CBSA-EFFDATE (MA2)             02600000
032700        MOVE T-CBSA         (MA2)                                 02610005
032700                               TO CBSA-WIR-CBSA                   02611005
032800        MOVE T-CBSA-EFFDATE (MA2)                                 02620005
032800                               TO CBSA-WIR-EFFDATE                02621005
032900        MOVE T-CBSA-WAGEIND (MA2)                                 02630005
032900                               TO CBSA-WIR-AREA-WAGEIND.          02631005
033000                                                                  02640000
033100 1900-EXIT.  EXIT.                                                02650000
033200*****        LAST STATEMENT               *************           02660000
