000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.          SNFOP190.                                   00020000
000300*AUTHOR.                CMS.                                      00030000
000400*                                                                 00040000
000500******************************************************************00050000
000600*REMARKS.                                                         00060000
000700*     SNFOP090   EFFECTIVE OCT 2, 2008                            00070000
000800*                OPENS CLAIMS FILE                                00080000
000900*                OPENS OUTPUT FILE                                00090000
001000*                OPENS MSA FILE                                   00100000
001100*                OPENS CBSA FILE                                  00110000
001200*                OPENS PRT FILE                                   00120000
001300***------------------------------------------------------------***00130000
001400*     SNFOP100   EFFECTIVE OCT 1, 2009                            00140000
001500*                OPENS CLAIMS FILE                                00150000
001600*                OPENS OUTPUT FILE                                00160000
001700*                OPENS MSA FILE                                   00170000
001800*                OPENS CBSA FILE                                  00180000
001900*                OPENS PRT FILE                                   00190000
002000***------------------------------------------------------------***00200000
002100*     SNFOP101   EFFECTIVE OCT 1, 2009                            00210000
002200*                OPENS CLAIMS FILE                                00220000
002300*                OPENS OUTPUT FILE                                00230000
002400*                OPENS MSA FILE                                   00240000
002500*                OPENS CBSA FILE                                  00250000
002600*                OPENS PRT FILE                                   00260000
002700***------------------------------------------------------------***00270000
002800*     SNFOP102   EFFECTIVE OCT 1, 2009                            00280000
002900*                OPENS CLAIMS FILE                                00290000
003000*                OPENS OUTPUT FILE                                00300000
003100*                OPENS MSA FILE                                   00310000
003200*                OPENS CBSA FILE                                  00320000
003300*                OPENS PRT FILE                                   00330000
003400***------------------------------------------------------------***00340000
003500*     SNFOP112   EFFECTIVE OCT 1, 2010                            00350000
003600*                OPENS CLAIMS FILE                                00360000
003700*                OPENS OUTPUT FILE                                00370000
003800*                OPENS MSA FILE                                   00380000
003900*                OPENS CBSA FILE                                  00390000
004000*                OPENS PRT FILE                                   00400000
004100***------------------------------------------------------------***00410000
004200*     SNFOP120   EFFECTIVE OCT 1, 2011                            00420000
004300*                OPENS CLAIMS FILE                                00430000
004400*                OPENS OUTPUT FILE                                00440000
004500*                OPENS MSA FILE                                   00450000
004600*                OPENS CBSA FILE                                  00460000
004700*                OPENS PRT FILE                                   00470000
004800******************************************************************00480000
004900*     SNFOP140   EFFECTIVE OCT 1, 2013                            00490000
005000*                OPENS CLAIMS FILE                                00500000
005100*                OPENS OUTPUT FILE                                00510000
005200*                OPENS MSA FILE                                   00520000
005300*                OPENS CBSA FILE                                  00530000
005400*                OPENS PRT FILE                                   00540000
005500******************************************************************00550000
005600*     SNFOP150   EFFECTIVE OCT 1, 2014                            00560000
005700*                OPENS CLAIMS FILE                                00570000
005800*                OPENS OUTPUT FILE                                00580000
005900*                OPENS MSA FILE                                   00590000
006000*                OPENS CBSA FILE                                  00600000
006100*                OPENS PRT FILE                                   00610000
006200******************************************************************00620000
006300******************************************************************00621000
006400*     SNFOP160   EFFECTIVE OCT 1, 2015                            00622000
006500*                ICD10 TESTING SNF OPEN MODULE - SNFOP160         00623000
006600*                OPENS CLAIMS FILE                                00624000
006700*                OPENS OUTPUT FILE                                00624100
006800*                OPENS MSA FILE                                   00624200
006900*                OPENS CBSA FILE                                  00624300
007000*                OPENS PRT FILE                                   00624400
007100******************************************************************00624500
006300******************************************************************00624600
006400*     SNFOP170   EFFECTIVE OCT 1, 2016                            00624700
006500*                OPEN MODULE - SNFOP170                           00624800
006600*                OPENS CLAIMS FILE                                00624900
006700*                OPENS OUTPUT FILE                                00625000
006800*                OPENS MSA FILE                                   00625100
006900*                OPENS CBSA FILE                                  00625200
007000*                OPENS PRT FILE                                   00625300
007100******************************************************************00625400
006300******************************************************************00625500
006400*     SNFOP180   EFFECTIVE OCT 1, 2017                            00625600
006500*                OPEN MODULE - SNFOP180                           00625700
006600*                OPENS CLAIMS FILE                                00625800
006700*                OPENS OUTPUT FILE                                00625900
006800*                OPENS MSA FILE                                   00626000
006900*                OPENS CBSA FILE                                  00626100
007000*                OPENS PRT FILE                                   00626200
007100******************************************************************00626300
007100******************************************************************00626400
006300******************************************************************00626500
006400*     SNFOP19B   EFFECTIVE OCT 1, 2018                            00626600
006500*                OPEN MODULE - SNFOP19B                           00626700
006600*                OPENS CLAIMS FILE                                00626800
006700*                OPENS OUTPUT FILE                                00626900
006800*                OPENS MSA FILE                                   00627000
006900*                OPENS CBSA FILE                                  00627100
007000*                OPENS PRT FILE                                   00627200
007100******************************************************************00627300
007200******************************************************************00627400
007300 DATE-COMPILED.                                                   00627500
007400 ENVIRONMENT                     DIVISION.                        00627600
007500                                                                  00627700
007600 CONFIGURATION                   SECTION.                         00627800
007700 SOURCE-COMPUTER.                IBM-370.                         00627900
007800 OBJECT-COMPUTER.                IBM-370.                         00628000
007900                                                                  00628100
008000 INPUT-OUTPUT SECTION.                                            00628200
008100 FILE-CONTROL.                                                    00628300
008200                                                                  00628400
008300     SELECT M3PIFILE   ASSIGN TO UT-S-M3PIFILE                    00628500
008400         FILE STATUS IS UT1-STAT.                                 00628600
008500     SELECT OUTFILE    ASSIGN TO UT-S-OUTFILE                     00628700
008600         FILE STATUS IS UT2-STAT.                                 00628800
008700     SELECT PRTFILE    ASSIGN TO UT-S-PRTFILE                     00628900
008800         FILE STATUS IS PRT-STAT.                                 00629000
008900     SELECT MSAFILE    ASSIGN TO UT-S-MSAFILE                     00630000
009000         FILE STATUS IS MSA-STAT.                                 00640000
009100     SELECT CBSAFILE   ASSIGN TO UT-S-CBSAFILE                    00650000
009200         FILE STATUS IS CBSA-STAT.                                00660000
009300                                                                  00670000
009400 DATA DIVISION.                                                   00680000
009500 FILE SECTION.                                                    00690000
009600 FD  M3PIFILE                                                     00700000
009700     LABEL RECORDS ARE STANDARD                                   00710000
009800     RECORDING MODE IS F                                          00720000
009900     BLOCK CONTAINS 0 RECORDS.                                    00730000
010000 01  SNF-REC                     PIC X(300).                      00740000
010100                                                                  00750000
010200 FD  OUTFILE                                                      00760000
010300     LABEL RECORDS ARE STANDARD                                   00770000
010400     RECORDING MODE IS F                                          00780000
010500     BLOCK CONTAINS 0 RECORDS.                                    00790000
010600 01  OUT-REC                     PIC X(300).                      00800000
010700                                                                  00810000
010800 FD  PRTFILE                                                      00820000
010900     RECORDING MODE IS F                                          00830000
011000     BLOCK CONTAINS 133 RECORDS                                   00840000
011100     LABEL RECORDS ARE STANDARD.                                  00850000
011200 01  PRTFILE-LINE                PIC X(133).                      00860000
011300                                                                  00870000
011400 FD  MSAFILE                                                      00880000
011500     RECORDING MODE IS F                                          00890000
011600     BLOCK CONTAINS 133 RECORDS                                   00900000
011700     LABEL RECORDS ARE STANDARD.                                  00910000
011800 01  MSA-REC.                                                     00920000
011900     05  MSA-CODE                 PIC X(04).                      00930000
012000     05  FILLER                   PIC X.                          00940000
012100     05  MSA-EFFDATE              PIC X(08).                      00950000
012200     05  FILLER                   PIC X.                          00960000
012300     05  MSA-WAGEIND              PIC X(06).                      00970000
012400     05  FILLER                   PIC X(08).                      00980000
012500     05  MSA-NAME                 PIC X(52).                      00990000
012600                                                                  01000000
012700 FD  CBSAFILE                                                     01010000
012800     RECORDING MODE IS F                                          01020000
012900     BLOCK CONTAINS 133 RECORDS                                   01030000
013000     LABEL RECORDS ARE STANDARD.                                  01040000
013100 01  F-CBSA-REC.                                                  01050000
013200     05  F-CBSA-CODE              PIC X(05).                      01060000
013300     05  FILLER                   PIC X.                          01070000
013400     05  F-CBSA-EFFDATE           PIC X(08).                      01080000
013500     05  FILLER                   PIC X.                          01090000
013600     05  F-CBSA-WAGEIND           PIC X(06).                      01100000
013700     05  FILLER                   PIC X(08).                      01110000
013800     05  F-CBSA-NAME              PIC X(51).                      01120000
013900                                                                  01130000
014000                                                                  01140000
014100 WORKING-STORAGE SECTION.                                         01150000
014200 77  W-STORAGE-REF               PIC X(49)  VALUE                 01160000
014300     'SNF O P E N       - W O R K I N G   S T O R A G E'.         01170000
014400 01  SNFOP-VERSION               PIC X(09)  VALUE 'SNFOP19.0'.    01180000
014500 01  SNFDR-VERSION               PIC X(09)  VALUE 'SNFDR19.0'.    01190000
014600 01  SNFDR190                    PIC X(08)  VALUE 'SNFDR190'.     01200000
014700 01  EOF-SW                      PIC 9(01)  VALUE 0.              01210000
014800 01  EOF-MSA                     PIC 9(01)  VALUE 0.              01220000
014900 01  EOF-CBSA                    PIC 9(01)  VALUE 0.              01230000
015000 01  LINE-CTR                    PIC 9(02)  VALUE 65.             01240000
015100 01  M3PIFILE-CTR                PIC 9(09)  VALUE 0.              01250000
015200 01  CBSA-CTR                    PIC 9(09)  VALUE 0.              01260000
015300 01  MSA-CTR                     PIC 9(09)  VALUE 0.              01270000
015400 01  OUTFILE-CTR                 PIC 9(09)  VALUE 0.              01280000
015500 01  PRTFILE-CTR                 PIC 9(09)  VALUE 0.              01290000
015600 01  UT1-STAT.                                                    01300000
015700     05  UT1-STAT1               PIC X.                           01310000
015800     05  UT1-STAT2               PIC X.                           01320000
015900 01  UT2-STAT.                                                    01330000
016000     05  UT2-STAT1               PIC X.                           01340000
016100     05  UT2-STAT2               PIC X.                           01350000
016200 01  PRT-STAT.                                                    01360000
016300     05  PRT-STAT1               PIC X.                           01370000
016400     05  PRT-STAT2               PIC X.                           01380000
016500 01  MSA-STAT.                                                    01390000
016600     05  MSA-STAT1               PIC X.                           01400000
016700     05  MSA-STAT2               PIC X.                           01410000
016800 01  CBSA-STAT.                                                   01420000
016900     05  CBSA-STAT1               PIC X.                          01430000
017000     05  CBSA-STAT2               PIC X.                          01440000
017100*******************************************************           01450000
017200* NATIONAL SNF RECORD FORMAT PASSED TO SNFDR,SNFPR    *           01460000
017300*******************************************************           01470000
017400 01  SNF-WORK.                                                    01480000
017500     05  SNF-INPUT-DATA.                                          01490000
017600         10  SNF-MSA                     PIC X(04).               01500000
017700         10  SNF-CBSA                    PIC X(05).               01510000
017800         10  SNF-SPEC-WI-IND             PIC X.                   01520000
017900             88  SNF-SPEC-WI-IND-VALUES   VALUE 'Y' 'N' '1' '2'.  01530000
018000         10  SNF-SPEC-WI                 PIC 9(02)V9(04).         01540000
018100         10  SNF-SPEC-WI-X  REDEFINES SNF-SPEC-WI PIC X(06).      01550000
018200         10  SNF-HCPPS-CODE              PIC X(05).               01560000
018300         10  SNF-FROM-DATE.                                       01570000
018400             15 SNF-FROM-CC              PIC XX.                  01580000
018500             15 SNF-FROM-YYMMDD.                                  01590000
018600                 25 SNF-FROM-YY          PIC XX.                  01600000
018700                 25 SNF-FROM-MM          PIC XX.                  01610000
018800                 25 SNF-FROM-DD          PIC XX.                  01620000
018900         10  SNF-THRU-DATE.                                       01630000
019000             15  SNF-THRU-CC             PIC XX.                  01640000
019100             15  SNF-THRU-YYMMDD.                                 01650000
019200                 25  SNF-THRU-YY         PIC XX.                  01660000
019300                 25  SNF-THRU-MM         PIC XX.                  01670000
019400                 25  SNF-THRU-DD         PIC XX.                  01680000
019500         10  SNF-FED-BLEND               PIC X.                   01690000
019600             88  SNF-FED-BLEND-VALUES                             01700000
019700                               VALUE '0' '1' '2' '3' '4'.         01710000
019800         10  SNF-FACILITY-RATE           PIC 9(05)V9(02).         01720000
019900         10  SNF-DIAGNOSIS-CODES.                                 01730000
020000             15  SNF-PRIN-DIAG-CODE      PIC X(07).               01740000
020100             15  SNF-OTHER-DIAG-CODE2    PIC X(07).               01750000
020200             15  SNF-OTHER-DIAG-CODE3    PIC X(07).               01760000
020300             15  SNF-OTHER-DIAG-CODE4    PIC X(07).               01770000
020400             15  SNF-OTHER-DIAG-CODE5    PIC X(07).               01780000
020500             15  SNF-OTHER-DIAG-CODE6    PIC X(07).               01790000
020600             15  SNF-OTHER-DIAG-CODE7    PIC X(07).               01800000
020700             15  SNF-OTHER-DIAG-CODE8    PIC X(07).               01810000
020800             15  SNF-OTHER-DIAG-CODE9    PIC X(07).               01820000
020900             15  SNF-OTHER-DIAG-CODE10   PIC X(07).               01830000
021000             15  SNF-OTHER-DIAG-CODE11   PIC X(07).               01840000
021100             15  SNF-OTHER-DIAG-CODE12   PIC X(07).               01850000
021200             15  SNF-OTHER-DIAG-CODE13   PIC X(07).               01860000
021300             15  SNF-OTHER-DIAG-CODE14   PIC X(07).               01870000
021400             15  SNF-OTHER-DIAG-CODE15   PIC X(07).               01880000
021500             15  SNF-OTHER-DIAG-CODE16   PIC X(07).               01890000
021600             15  SNF-OTHER-DIAG-CODE17   PIC X(07).               01900000
021700             15  SNF-OTHER-DIAG-CODE18   PIC X(07).               01910000
021800             15  SNF-OTHER-DIAG-CODE19   PIC X(07).               01920000
021900             15  SNF-OTHER-DIAG-CODE20   PIC X(07).               01930000
022000             15  SNF-OTHER-DIAG-CODE21   PIC X(07).               01940000
022100             15  SNF-OTHER-DIAG-CODE22   PIC X(07).               01950000
022200             15  SNF-OTHER-DIAG-CODE23   PIC X(07).               01960000
022300             15  SNF-OTHER-DIAG-CODE24   PIC X(07).               01970000
022400             15  SNF-OTHER-DIAG-CODE25   PIC X(07).               01980000
022500         10  SNF-PAY-RTC.                                         01990000
022600             15  SNF-PAYMENT-RATE        PIC 9(06)V9(02).         02000000
022700             15  SNF-RTC                 PIC 99.                  02010000
022500         10  VBP-DATA.                                            02020000
022600             15  VBP-MULTIPLIER          PIC S9V9(11).            02030000
022700             15  VBP-PAY-DIFF            PIC S9(06)V9(02).        02040000
022800         10  FILLER                      PIC X(50).               02050000
022900                                                                  02060000
023000*******************************************************           02070000
023100*    RETURNED BY SNFDR AND SNFPR                      *           02080000
023200*******************************************************           02090000
023300 01  HOLD-VARIABLES.                                              02100000
023400     02  HOLD-VAR-DATA.                                           02110000
023500         05  FACTOR                         PIC 9.                02120000
023600         05  NUR-INDEX                      PIC 9V99.             02130000
023700         05  THR-INDEX                      PIC 9V99.             02140000
023800         05  AREA-WAGE-INDEX                PIC 9(01)V9(04).      02150000
023900         05  IP-RATE                        PIC 9(03)V9(02).      02160000
024000         05  GS-RATE                        PIC 9(02)V9(02).      02170000
024100         05  TH-RATE                        PIC 9(02)V9(02).      02180000
024200         05  REHAB-RATE                     PIC 9(03)V9(02).      02190000
024300         05  NURSING-COMPONENT              PIC 999V99.           02200000
024400         05  THERAPY-COMPONENT              PIC 999V99.           02210000
024500         05  NCM-THR-COMPONENT              PIC 999V99.           02220000
024600         05  NCM-COMPONENT                  PIC 999V99.           02230000
024700         05  PAYMENT-RATE-ADJ               PIC 9(06)V99.         02240000
024800         05  FED-PAYMENT                    PIC 9(06)V99.         02250000
024900     02  SNFPR-VERSION                      PIC X(09).            02260000
025000                                                                  02270000
025100                                                                  02280000
025100                                                                  02281000
025200*******************************************************           02282000
025300*    SNF PAYMENT REPORT COMPONENTS                    *           02283000
025400*******************************************************           02284000
025500 01  SNF-DETAIL-LINE.                                             02285000
025600     05  FILLER                  PIC X(02)  VALUE SPACES.         02286000
025700     05  PRT-MSA-CBSA            PIC X(05).                       02287000
025800     05  FILLER                  PIC X(01)  VALUE SPACES.         02288000
025900     05  PRT-EFF-DATE            PIC X(08).                       02289000
026000     05  FILLER                  PIC X(02)  VALUE SPACES.         02289100
026100     05  PRT-AREA-WAGE-INDEX     PIC 9.9999.                      02289200
026200     05  FILLER                  PIC X(02)  VALUE SPACES.         02289300
026300     05  PRT-HCPPS               PIC X(05).                       02289400
027600     05  FILLER                  PIC X(01)  VALUE SPACES.         02289500
027700     05  PRT-NURS-COMP           PIC $$,$$$.99.                   02289600
027800     05  FILLER                  PIC X(01)  VALUE SPACES.         02289700
027900     05  PRT-THER-COMP           PIC $$,$$$.99.                   02289800
028000     05  FILLER                  PIC X(01)  VALUE SPACES.         02289900
028100     05  PRT-NCM-THR-COMP        PIC $$,$$$.99.                   02290000
028600     05  FILLER                  PIC X(01)  VALUE SPACES.         02290100
028200     05  PRT-NCM-COMP            PIC $$,$$$.99.                   02290200
028300     05  FILLER                  PIC X(01)  VALUE SPACES.         02290300
028500     05  PRT-INIT-PAY-RATE       PIC $,$$$,$$$.99.                02290400
028600     05  FILLER                  PIC X(02)  VALUE SPACES.         02290500
028700     05  PRT-SNF-RTC             PIC 99.                          02290600
028800     05  FILLER                  PIC X(02)  VALUE SPACES.         02290700
028900     05  PRT-BLEND               PIC 9.                           02290800
026400     05  FILLER                  PIC X(02)  VALUE SPACES.         02290900
026500     05  PRT-VBP-MULTIPLIER      PIC +Z.ZZZZZZZZZZZ.              02291000
026400     05  FILLER                  PIC X(02)  VALUE SPACES.         02291100
028400     05  PRT-VBP-PAY-DIFF        PIC +$ZZ,ZZZ.99.                 02291200
026600     05  FILLER                  PIC X(01)  VALUE SPACES.         02291300
028500     05  PRT-VBP-PAY-RATE        PIC $,$$$,$$$.99.                02291400
029000                                                                  02291500
025200*******************************************************           02291600
025300*    SNF PAYMENT REPORT COMPONENTS                    *           02291700
025400*******************************************************           02291800
029000                                                                  02291900
029100 01  SNF-HEAD1.                                                   02292000
029200     05  FILLER                  PIC X(01)  VALUE SPACES.         02293000
029300     05  FILLER                  PIC X(44)  VALUE                 02294000
029400        '  C M S ,                                   '.           02295000
029500     05  FILLER                  PIC X(44)  VALUE                 02296000
029600        '                                            '.           02297000
029700     05  FILLER                  PIC X(44)  VALUE                 02298000
029800        '                                            '.           02299000
029900                                                                  02300000
030000 01  SNF-HEAD2.                                                   02310000
030100     05  FILLER                  PIC X(01)  VALUE SPACES.         02320000
030200     05  FILLER                  PIC X(44)  VALUE                 02330000
030300        ' CMM,PDG,DDS SNF NATIONAL PRICER            '.           02340000
030400     05  FILLER                  PIC X(44)  VALUE                 02350000
030500        '              (NHCMQ)     T E S T   D A T A '.           02360000
030600     05  FILLER                  PIC X(44)  VALUE                 02370000
030700        '  R E P O R T                               '.           02380000
030800                                                                  02390000
030900 01  SNF-HEAD3.                                                   02400000
031000     05  FILLER                  PIC X(01)  VALUE SPACES.         02410000
031100     05  FILLER                  PIC X(44)  VALUE                 02420000
031200        ' MSA/    EFF-     WAGE   HCPPS    NURS   '.              02430000
031300     05  FILLER                  PIC X(44)  VALUE                 02440000
031400        ' THER   NCM-THER     NCM     UNADJUSTED  RTC'.           02450000
031500     05  FILLER                  PIC X(44)  VALUE                 02460000
031600        ' FED       VBP        VBP-PAY     VBP-ADJUST'.           02470000
031700                                                                  02480000
031800 01  SNF-HEAD4.                                                   02490000
031900     05  FILLER                  PIC X(01)  VALUE SPACES.         02500000
032000     05  FILLER                  PIC X(44)  VALUE                 02510000
032100        '  CBSA   DATE     INDEX  CODE     COMP  '.               02520000
032200     05  FILLER                  PIC X(44)  VALUE                 02530000
032300        ' COMP     COMP       COMP      PAY-RATE'.                02540000
032400     05  FILLER                  PIC X(44)  VALUE                 02550000
032500        ' BLEND  MULTIPLIER      DIFF        PAY-RATE'.           02560000
032600                                                                  02570000
032700 01  MSA-WI-TABLE.                                                02580000
032800     05  MSA-DATA        OCCURS 8000                              02590000
032900                           INDEXED BY MU1 MU2 MU3.                02600000
033000         10  MSA-TB-MSA        PIC X(04).                         02610000
033100         10  MSA-TB-EFFDATE    PIC X(08).                         02620000
033200         10  MSA-TB-WAGEIND    PIC X(06).                         02630000
033300                                                                  02640000
033400 01  CBSA-WI-TABLE.                                               02650000
033500     05  T-CBSA-DATA        OCCURS 8000                           02660000
033600                           INDEXED BY MA1 MA2 MA3.                02670000
033700         10  T-CBSA-CODE       PIC X(05).                         02680000
033800         10  T-CBSA-EFFDATE    PIC X(08).                         02690000
033900         10  T-CBSA-WAGEIND    PIC X(06).                         02700000
034000                                                                  02710000
034100 PROCEDURE  DIVISION.                                             02720000
034200                                                                  02730000
034300 0000-MAINLINE  SECTION.                                          02740000
034400                                                                  02750000
034500     OPEN INPUT  M3PIFILE.                                        02760000
034600                                                                  02770000
034700     OPEN OUTPUT OUTFILE                                          02780000
034800          OUTPUT PRTFILE.                                         02790000
034900                                                                  02800000
035000     PERFORM 1300-LOAD-MSAFILE                                    02810000
035100        THRU 1300-EXIT.                                           02820000
035200                                                                  02830000
035300******************************************************************02840000
035400*    MSA TABLE OVERFLOW                                           02850000
035500*    DISCONTINUE PROCESSING                                       02860000
035600******************************************************************02870000
035700                                                                  02880000
035800     IF MSA-CTR > 7999                                            02890000
035900        GO TO 0050-EOJ.                                           02900000
036000                                                                  02910000
036100     PERFORM 1500-LOAD-CBSAFILE                                   02920000
036200        THRU 1500-EXIT.                                           02930000
036300                                                                  02940000
036400                                                                  02950000
036500******************************************************************02960000
036600*    CBSA TABLE OVERFLOW                                          02970000
036700*    DISCONTINUE PROCESSING                                       02980000
036800******************************************************************02990000
036900                                                                  03000000
037000     IF CBSA-CTR > 7999                                           03010000
037100        GO TO 0050-EOJ.                                           03020000
037200                                                                  03030000
037300                                                                  03040000
037400     PERFORM 0100-PROCESS-RECORDS                                 03050000
037500        THRU 0100-EXIT                                            03060000
037600             UNTIL EOF-SW = 1.                                    03070000
037700                                                                  03080000
037800                                                                  03090000
037900    0050-EOJ.                                                     03100000
038000                                                                  03110000
038100     DISPLAY ' '.                                                 03120000
038200                                                                  03130000
038300     DISPLAY '-- PROGRAM SNFOP___  VERSION  ===> ' SNFOP-VERSION. 03140000
038400     DISPLAY '-- PROGRAM SNFDR___  VERSION  ===> ' SNFDR-VERSION. 03150000
038500     DISPLAY '-- PROGRAM SNFPR___  VERSION  ===> ' SNFPR-VERSION. 03160000
038600                                                                  03170000
038700     DISPLAY ' '.                                                 03180000
038800                                                                  03190000
038900     DISPLAY '-- INPUT  COUNTS FOR M3PIFILE ===> ' M3PIFILE-CTR.  03200000
039000     DISPLAY '-- OUTPUT COUNTS FOR OUTFILE  ===> ' OUTFILE-CTR.   03210000
039100     DISPLAY '-- OUTPUT COUNTS FOR PRTFILE  ===> ' PRTFILE-CTR.   03220000
039200                                                                  03230000
039300     CLOSE M3PIFILE.                                              03240000
039400     CLOSE OUTFILE.                                               03250000
039500     CLOSE PRTFILE.                                               03260000
039600                                                                  03270000
039700     STOP RUN.                                                    03280000
039800                                                                  03290000
039900 0100-PROCESS-RECORDS.                                            03300000
040000                                                                  03310000
040100     READ M3PIFILE             INTO SNF-WORK                      03320000
040200         AT END                                                   03330000
040300             MOVE 1            TO EOF-SW                          03340000
040400             GO TO 0100-EXIT.                                     03350000
040500                                                                  03360000
040600     ADD 1                     TO M3PIFILE-CTR.                   03370000
040700                                                                  03380000
040800     MOVE ALL '0'              TO SNF-PAY-RTC                     03390000
040900                                  HOLD-VAR-DATA.                  03400000
041000                                                                  03410000
041100     IF SNF-THRU-DATE < 19980701                                  03420000
041200        MOVE '40'              TO SNF-RTC                         03430000
041300        PERFORM 1100-WRITE                                        03440000
041400           THRU 1100-EXIT                                         03450000
041700        GO TO 0100-EXIT.                                          03460000
041600                                                                  03470000
041700     IF SNF-RTC NOT = '00'                                        03480000
041800         PERFORM 1100-WRITE                                       03490000
041900            THRU 1100-EXIT                                        03500000
042000         GO TO 0100-EXIT.                                         03510000
042100                                                                  03520000
042200     IF  EOF-SW = 0                                               03530000
038700     DISPLAY ' '.                                                 03540000
038800                                                                  03550000
038700     DISPLAY ' '.                                                 03560000
038900     DISPLAY '-- VBP-MULTIPLIER ===> ' VBP-MULTIPLIER.            03570000
038700     DISPLAY ' '.                                                 03580000
038800                                                                  03590000
042300         CALL  SNFDR190        USING SNF-WORK                     03600000
042400                               HOLD-VARIABLES                     03610000
042500                               CBSA-WI-TABLE                      03620000
042600                               MSA-WI-TABLE                       03630000
042700         PERFORM 1100-WRITE                                       03640000
042800            THRU 1100-EXIT.                                       03650000
042900                                                                  03660000
043000 0100-EXIT.  EXIT.                                                03670000
043100                                                                  03680000
043200 1100-WRITE.                                                      03690000
043300******************************************************************03700000
043400*    PRINT SNF PROSPECTIVE PAYMENT TEST DATA DETAIL               03710000
043500*    REPORT AND WRITE TEST PAYMENT RECORD ROUTINE                 03720000
043600******************************************************************03730000
043700                                                                  03740000
043800     IF  LINE-CTR > 54                                            03750000
043900         PERFORM 1200-SNF-HEADINGS                                03760000
044000            THRU 1200-EXIT.                                       03770000
044100                                                                  03780000
044200     MOVE SPACES               TO  SNF-DETAIL-LINE.               03790000
044300                                                                  03800000
044400     IF SNF-THRU-DATE < 20051001                                  03810000
044500        MOVE SNF-MSA           TO PRT-MSA-CBSA                    03820000
044600     ELSE                                                         03830000
044700        MOVE SNF-CBSA          TO PRT-MSA-CBSA.                   03840000
044800                                                                  03850000
044900     MOVE SNF-THRU-DATE        TO PRT-EFF-DATE.                   03860000
045000     MOVE SNF-FED-BLEND        TO PRT-BLEND                       03870000
045100     MOVE SNF-HCPPS-CODE       TO PRT-HCPPS.                      03880000
045200     MOVE AREA-WAGE-INDEX      TO PRT-AREA-WAGE-INDEX.            03890000
046000                                                                  03900000
046100     MOVE NURSING-COMPONENT    TO PRT-NURS-COMP.                  03910000
046200     MOVE THERAPY-COMPONENT    TO PRT-THER-COMP.                  03920000
046300     MOVE NCM-THR-COMPONENT    TO PRT-NCM-THR-COMP.               03930000
046400     MOVE NCM-COMPONENT        TO PRT-NCM-COMP.                   03940000
046500                                                                  03950000
043300******************************************************************03960000
043400*        <<<  CMS ONLY TESTING  >>>                               03970000
043400*   NEEDED SNF PROSPECTIVE PAYMENT BEFORE THE VBP ADJUSTMENT.     03980000
043450*                                                                 03990000
043500*   MOVED PAYMENT TO A DEFUNCT LINKAGE FIELD, SNF-FACILITY-RATE   04000000
043500*   ONCE THE DATA IS MOVED TO PRINT REPORT FIELD                  04010000
043500*   RETURN SNF-FACILITY-RATE        TO ZERO                       04020000
043600*** ---------------------------------------------------------*****04030000
043500*   >>> SNFPR19B MUST REINSERT THIS CODE PRIOR TO VBP LOGIC       04040000
378700*     [ MOVE HLD-PAYMENT-RATE     TO HLD-FACILITY-RATE.]          04050000
043400*                                                                 04060000
043400*                                                                 04070000
043600****-  MUST >>NOT<< ALLOW TO BE CONTAINED IN ANY           --*****04080000
043600****-         PUBLISHED VERSION                            --*****04090000
043600*** ---------------------------------------------------------*****04100000
046700     MOVE SNF-FACILITY-RATE    TO PRT-INIT-PAY-RATE.              04110000
046700     MOVE SNF-FACILITY-RATE    TO PRT-INIT-PAY-RATE.              04120000
046700     MOVE 0                    TO SNF-FACILITY-RATE.              04130000
046800                                                                  04140000
043600*** ---------------------------------------------------------*****04150000
046900     MOVE SNF-RTC              TO PRT-SNF-RTC.                    04160000
046900     MOVE VBP-MULTIPLIER       TO PRT-VBP-MULTIPLIER.             04170000
046900     MOVE VBP-PAY-DIFF         TO PRT-VBP-PAY-DIFF.               04180000
046700     MOVE SNF-PAYMENT-RATE     TO PRT-VBP-PAY-RATE.               04190000
047000                                                                  04200000
047100     WRITE PRTFILE-LINE        FROM SNF-DETAIL-LINE               04210000
047200                                    AFTER ADVANCING 1.            04220000
047300                                                                  04230000
047400     ADD 1                     TO PRTFILE-CTR.                    04240000
047500                                                                  04250000
047600     IF PRT-STAT1 > 0                                             04260000
047700        DISPLAY ' BAD1 WRITE ON PRTFILE FILE'.                    04270000
047800                                                                  04280000
047900     ADD 1                     TO LINE-CTR.                       04290000
048000                                                                  04300000
048100     WRITE OUT-REC             FROM SNF-WORK.                     04310000
048200                                                                  04320000
048300     IF UT2-STAT1 > 0                                             04330000
048400        DISPLAY ' BAD2 WRITE ON OUTFILE  FILE'.                   04340000
048500                                                                  04350000
048600     ADD 1                     TO OUTFILE-CTR.                    04360000
048700                                                                  04370000
048800 1100-EXIT.  EXIT.                                                04380000
048900                                                                  04390000
049000 1200-SNF-HEADINGS.                                               04400000
049100                                                                  04410000
049200     WRITE PRTFILE-LINE        FROM SNF-HEAD1                     04420000
049300                                    AFTER ADVANCING PAGE.         04430000
049400                                                                  04440000
049500     IF PRT-STAT1 > 0                                             04450000
049600        DISPLAY ' BAD3 WRITE ON PRTFILE FILE'.                    04460000
049700                                                                  04470000
049800     WRITE PRTFILE-LINE        FROM SNF-HEAD2                     04480000
049900                                    AFTER ADVANCING 1.            04490000
050000                                                                  04500000
050100     IF PRT-STAT1 > 0                                             04510000
050200        DISPLAY ' BAD4 WRITE ON PRTFILE FILE'.                    04520000
050300                                                                  04530000
050400     WRITE PRTFILE-LINE        FROM SNF-HEAD3                     04540000
050500                                    AFTER ADVANCING 2.            04550000
050600                                                                  04560000
050700     IF PRT-STAT1 > 0                                             04570000
050800        DISPLAY ' BAD5 WRITE ON PRTFILE FILE'.                    04580000
050900                                                                  04590000
051000     WRITE PRTFILE-LINE        FROM SNF-HEAD4                     04600000
051100                                    AFTER ADVANCING 1.            04610000
051200                                                                  04620000
051300     IF PRT-STAT1 > 0                                             04630000
051400        DISPLAY ' BAD6 WRITE ON PRTFILE FILE'.                    04640000
051500                                                                  04650000
051600     MOVE ALL '  -'            TO PRTFILE-LINE.                   04660000
051700                                                                  04670000
051800     WRITE PRTFILE-LINE        AFTER ADVANCING 1.                 04680000
051900                                                                  04690000
052000     IF PRT-STAT1 > 0                                             04700000
052100        DISPLAY ' BAD7 WRITE ON PRTFILE FILE'.                    04710000
052200                                                                  04720000
052300     MOVE 5                    TO LINE-CTR.                       04730000
052400                                                                  04740000
052500 1200-EXIT.  EXIT.                                                04750000
052600                                                                  04760000
052700 1300-LOAD-MSAFILE.                                               04770000
052800                                                                  04780000
052900     OPEN INPUT MSAFILE.                                          04790000
053000     MOVE 0                    TO EOF-MSA.                        04800000
053100     SET MU3                   TO EOF-MSA.                        04810000
053200                                                                  04820000
053300     PERFORM 1400-READ-MSAFILE                                    04830000
053400        THRU 1400-EXIT                                            04840000
053500             UNTIL EOF-MSA = 1.                                   04850000
053600                                                                  04860000
053700     CLOSE MSAFILE.                                               04870000
053800                                                                  04880000
053900 1300-EXIT.  EXIT.                                                04890000
054000                                                                  04900000
054100 1400-READ-MSAFILE.                                               04910000
054200                                                                  04920000
054300     READ MSAFILE                                                 04930000
054400          AT END                                                  04940000
054500             MOVE 1            TO EOF-MSA                         04950000
054600                                                                  04960000
054700     GO TO 1400-EXIT.                                             04970000
054800                                                                  04980000
054900     ADD 1                     TO MSA-CTR.                        04990000
055000                                                                  05000000
055100                                                                  05010000
055200     IF MSA-CTR > 7999                                            05020000
055300        DISPLAY ' '                                               05030000
055400        DISPLAY '-- SNF PROGRAM  VERSION ==> ' SNFOP-VERSION      05040000
055500        DISPLAY ' '                                               05050000
055600        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05060000
055700        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05070000
055800        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05080000
055900        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05090000
056000        DISPLAY  ' MSA FILE TO LARGE '                            05100000
056100        MOVE 1                 TO EOF-MSA.                        05101000
056200                                                                  05102000
056300     IF EOF-MSA = 0                                               05103000
056400        SET MU3                UP BY 1                            05104000
056500        MOVE MSA-CODE          TO MSA-TB-MSA     (MU3)            05105000
056600        MOVE MSA-EFFDATE       TO MSA-TB-EFFDATE (MU3)            05106000
056700        MOVE MSA-WAGEIND       TO MSA-TB-WAGEIND (MU3).           05107000
056800                                                                  05108000
056900 1400-EXIT.  EXIT.                                                05109000
057000                                                                  05110000
057100 1500-LOAD-CBSAFILE.                                              05111000
057200                                                                  05112000
057300     OPEN INPUT CBSAFILE.                                         05113000
057400                                                                  05114000
057500     MOVE 0                    TO EOF-CBSA.                       05115000
057600     SET MA3                   TO EOF-CBSA.                       05116000
057700                                                                  05117000
057800     PERFORM 1600-READ-CBSAFILE                                   05118000
057900        THRU 1600-EXIT                                            05119000
058000             UNTIL EOF-CBSA = 1.                                  05120000
058100                                                                  05130000
058200     CLOSE CBSAFILE.                                              05140000
058300                                                                  05150000
058400 1500-EXIT.  EXIT.                                                05160000
058500                                                                  05170000
058600 1600-READ-CBSAFILE.                                              05180000
058700                                                                  05190000
058800     READ CBSAFILE                                                05200000
058900          AT END                                                  05210000
059000             MOVE 1            TO EOF-CBSA                        05220000
059100                                                                  05230000
059200     GO TO 1600-EXIT.                                             05240000
059300                                                                  05250000
059400     ADD 1                     TO CBSA-CTR.                       05260000
059500                                                                  05270000
059600                                                                  05280000
059700     IF CBSA-CTR > 7999                                           05290000
059800        DISPLAY ' '                                               05300000
059900        DISPLAY '-- SNF PROGRAM  VERSION ==> ' SNFOP-VERSION      05310000
060000        DISPLAY ' '                                               05320000
060100        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05330000
060200        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05340000
060300        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05350000
060400        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05360000
060500        DISPLAY  ' CBSA FILE TO LARGE '                           05370000
060600        MOVE 1                 TO EOF-CBSA.                       05380000
060700                                                                  05390000
060800                                                                  05391000
060900     IF EOF-CBSA = 0                                              05391100
061000        SET MA3                UP BY 1                            05391200
061100            MOVE F-CBSA-CODE   TO T-CBSA-CODE    (MA3)            05391300
061200            MOVE F-CBSA-EFFDATE                                   05391400
061300                               TO T-CBSA-EFFDATE (MA3)            05391500
061400            MOVE F-CBSA-WAGEIND                                   05391600
061500                               TO T-CBSA-WAGEIND (MA3).           05391700
061600 1600-EXIT.  EXIT.                                                05391800
061700                                                                  05391900
061800*****        LAST STATEMENT               *************           05392000
