000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.          SNFOP181.                                   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
007200******************************************************************00626400
007300 DATE-COMPILED.                                                   00626500
007400 ENVIRONMENT                     DIVISION.                        00626600
007500                                                                  00626700
007600 CONFIGURATION                   SECTION.                         00626800
007700 SOURCE-COMPUTER.                IBM-370.                         00626900
007800 OBJECT-COMPUTER.                IBM-370.                         00627000
007900                                                                  00628000
008000 INPUT-OUTPUT SECTION.                                            00629000
008100 FILE-CONTROL.                                                    00630000
008200                                                                  00640000
008300     SELECT M3PIFILE   ASSIGN TO UT-S-M3PIFILE                    00650000
008400         FILE STATUS IS UT1-STAT.                                 00660000
008500     SELECT OUTFILE    ASSIGN TO UT-S-OUTFILE                     00670000
008600         FILE STATUS IS UT2-STAT.                                 00680000
008700     SELECT PRTFILE    ASSIGN TO UT-S-PRTFILE                     00690000
008800         FILE STATUS IS PRT-STAT.                                 00700000
008900     SELECT MSAFILE    ASSIGN TO UT-S-MSAFILE                     00710000
009000         FILE STATUS IS MSA-STAT.                                 00720000
009100     SELECT CBSAFILE   ASSIGN TO UT-S-CBSAFILE                    00730000
009200         FILE STATUS IS CBSA-STAT.                                00740000
009300                                                                  00750000
009400 DATA DIVISION.                                                   00760000
009500 FILE SECTION.                                                    00770000
009600 FD  M3PIFILE                                                     00780000
009700     LABEL RECORDS ARE STANDARD                                   00790000
009800     RECORDING MODE IS F                                          00800000
009900     BLOCK CONTAINS 0 RECORDS.                                    00810000
010000 01  SNF-REC                     PIC X(250).                      00820000
010100                                                                  00830000
010200 FD  OUTFILE                                                      00840000
010300     LABEL RECORDS ARE STANDARD                                   00850000
010400     RECORDING MODE IS F                                          00860000
010500     BLOCK CONTAINS 0 RECORDS.                                    00870000
010600 01  OUT-REC                     PIC X(250).                      00880000
010700                                                                  00890000
010800 FD  PRTFILE                                                      00900000
010900     RECORDING MODE IS F                                          00910000
011000     BLOCK CONTAINS 133 RECORDS                                   00920000
011100     LABEL RECORDS ARE STANDARD.                                  00930000
011200 01  PRTFILE-LINE                PIC X(133).                      00940000
011300                                                                  00950000
011400 FD  MSAFILE                                                      00960000
011500     RECORDING MODE IS F                                          00970000
011600     BLOCK CONTAINS 133 RECORDS                                   00980000
011700     LABEL RECORDS ARE STANDARD.                                  00990000
011800 01  MSA-REC.                                                     01000000
011900     05  MSA-CODE                 PIC X(04).                      01010000
012000     05  FILLER                   PIC X.                          01020000
012100     05  MSA-EFFDATE              PIC X(08).                      01030000
012200     05  FILLER                   PIC X.                          01040000
012300     05  MSA-WAGEIND              PIC X(06).                      01050000
012400     05  FILLER                   PIC X(08).                      01060000
012500     05  MSA-NAME                 PIC X(52).                      01070000
012600                                                                  01080000
012700 FD  CBSAFILE                                                     01090000
012800     RECORDING MODE IS F                                          01100000
012900     BLOCK CONTAINS 133 RECORDS                                   01110000
013000     LABEL RECORDS ARE STANDARD.                                  01120000
013100 01  F-CBSA-REC.                                                  01130000
013200     05  F-CBSA-CODE              PIC X(05).                      01140000
013300     05  FILLER                   PIC X.                          01150000
013400     05  F-CBSA-EFFDATE           PIC X(08).                      01160000
013500     05  FILLER                   PIC X.                          01170000
013600     05  F-CBSA-WAGEIND           PIC X(06).                      01180000
013700     05  FILLER                   PIC X(08).                      01190000
013800     05  F-CBSA-NAME              PIC X(51).                      01200000
013900                                                                  01210000
014000                                                                  01220000
014100 WORKING-STORAGE SECTION.                                         01230000
014200 77  W-STORAGE-REF               PIC X(49)  VALUE                 01240000
014300     'SNF O P E N       - W O R K I N G   S T O R A G E'.         01250000
014400 01  SNFOP-VERSION               PIC X(09)  VALUE 'SNFOP18.1'.    01260000
014500 01  SNFDR-VERSION               PIC X(09)  VALUE 'SNFDR18.1'.    01270000
014600 01  SNFDR181                    PIC X(08)  VALUE 'SNFDR181'.     01280001
014700 01  EOF-SW                      PIC 9(01)  VALUE 0.              01290000
014800 01  EOF-MSA                     PIC 9(01)  VALUE 0.              01300000
014900 01  EOF-CBSA                    PIC 9(01)  VALUE 0.              01310000
015000 01  LINE-CTR                    PIC 9(02)  VALUE 65.             01320000
015100 01  M3PIFILE-CTR                PIC 9(09)  VALUE 0.              01330000
015200 01  CBSA-CTR                    PIC 9(09)  VALUE 0.              01340000
015300 01  MSA-CTR                     PIC 9(09)  VALUE 0.              01350000
015400 01  OUTFILE-CTR                 PIC 9(09)  VALUE 0.              01360000
015500 01  PRTFILE-CTR                 PIC 9(09)  VALUE 0.              01370000
015600 01  UT1-STAT.                                                    01380000
015700     05  UT1-STAT1               PIC X.                           01390000
015800     05  UT1-STAT2               PIC X.                           01400000
015900 01  UT2-STAT.                                                    01410000
016000     05  UT2-STAT1               PIC X.                           01420000
016100     05  UT2-STAT2               PIC X.                           01430000
016200 01  PRT-STAT.                                                    01440000
016300     05  PRT-STAT1               PIC X.                           01450000
016400     05  PRT-STAT2               PIC X.                           01460000
016500 01  MSA-STAT.                                                    01470000
016600     05  MSA-STAT1               PIC X.                           01480000
016700     05  MSA-STAT2               PIC X.                           01490000
016800 01  CBSA-STAT.                                                   01500000
016900     05  CBSA-STAT1               PIC X.                          01510000
017000     05  CBSA-STAT2               PIC X.                          01520000
017100*******************************************************           01530000
017200* NATIONAL SNF RECORD FORMAT PASSED TO SNFDR,SNFPR    *           01540000
017300*******************************************************           01550000
017400 01  SNF-WORK.                                                    01560000
017500     05  SNF-INPUT-DATA.                                          01570000
017600         10  SNF-MSA                     PIC X(04).               01580000
017700         10  SNF-CBSA                    PIC X(05).               01590000
017800         10  SNF-SPEC-WI-IND             PIC X.                   01600000
017900             88  SNF-SPEC-WI-IND-VALUES   VALUE 'Y' 'N' '1' '2'.  01610000
018000         10  SNF-SPEC-WI                 PIC 9(02)V9(04).         01620000
018100         10  SNF-SPEC-WI-X  REDEFINES SNF-SPEC-WI PIC X(06).      01630000
018200         10  SNF-HCPPS-CODE              PIC X(05).               01640000
018300         10  SNF-FROM-DATE.                                       01650000
018400             15 SNF-FROM-CC              PIC XX.                  01660000
018500             15 SNF-FROM-YYMMDD.                                  01670000
018600                 25 SNF-FROM-YY          PIC XX.                  01680000
018700                 25 SNF-FROM-MM          PIC XX.                  01690000
018800                 25 SNF-FROM-DD          PIC XX.                  01700000
018900         10  SNF-THRU-DATE.                                       01710000
019000             15  SNF-THRU-CC             PIC XX.                  01720000
019100             15  SNF-THRU-YYMMDD.                                 01730000
019200                 25  SNF-THRU-YY         PIC XX.                  01740000
019300                 25  SNF-THRU-MM         PIC XX.                  01750000
019400                 25  SNF-THRU-DD         PIC XX.                  01760000
019500         10  SNF-FED-BLEND               PIC X.                   01770000
019600             88  SNF-FED-BLEND-VALUES                             01780000
019700                               VALUE '0' '1' '2' '3' '4'.         01790000
019800         10  SNF-FACILITY-RATE           PIC 9(05)V9(02).         01800000
019900         10  SNF-DIAGNOSIS-CODES.                                 01810000
020000             15  SNF-PRIN-DIAG-CODE      PIC X(07).               01820000
020100             15  SNF-OTHER-DIAG-CODE2    PIC X(07).               01830000
020200             15  SNF-OTHER-DIAG-CODE3    PIC X(07).               01840000
020300             15  SNF-OTHER-DIAG-CODE4    PIC X(07).               01850000
020400             15  SNF-OTHER-DIAG-CODE5    PIC X(07).               01860000
020500             15  SNF-OTHER-DIAG-CODE6    PIC X(07).               01870000
020600             15  SNF-OTHER-DIAG-CODE7    PIC X(07).               01880000
020700             15  SNF-OTHER-DIAG-CODE8    PIC X(07).               01890000
020800             15  SNF-OTHER-DIAG-CODE9    PIC X(07).               01900000
020900             15  SNF-OTHER-DIAG-CODE10   PIC X(07).               01910000
021000             15  SNF-OTHER-DIAG-CODE11   PIC X(07).               01920000
021100             15  SNF-OTHER-DIAG-CODE12   PIC X(07).               01930000
021200             15  SNF-OTHER-DIAG-CODE13   PIC X(07).               01940000
021300             15  SNF-OTHER-DIAG-CODE14   PIC X(07).               01950000
021400             15  SNF-OTHER-DIAG-CODE15   PIC X(07).               01960000
021500             15  SNF-OTHER-DIAG-CODE16   PIC X(07).               01970000
021600             15  SNF-OTHER-DIAG-CODE17   PIC X(07).               01980000
021700             15  SNF-OTHER-DIAG-CODE18   PIC X(07).               01990000
021800             15  SNF-OTHER-DIAG-CODE19   PIC X(07).               02000000
021900             15  SNF-OTHER-DIAG-CODE20   PIC X(07).               02010000
022000             15  SNF-OTHER-DIAG-CODE21   PIC X(07).               02020000
022100             15  SNF-OTHER-DIAG-CODE22   PIC X(07).               02030000
022200             15  SNF-OTHER-DIAG-CODE23   PIC X(07).               02040000
022300             15  SNF-OTHER-DIAG-CODE24   PIC X(07).               02050000
022400             15  SNF-OTHER-DIAG-CODE25   PIC X(07).               02060000
022500         10  SNF-PAY-RTC.                                         02070000
022600             15  SNF-PAYMENT-RATE        PIC 9(06)V9(02).         02080000
022700             15  SNF-RTC                 PIC 99.                  02090000
022800         10  FILLER                      PIC X(20).               02100000
022900                                                                  02110000
023000*******************************************************           02120000
023100*    RETURNED BY SNFDR AND SNFPR                      *           02130000
023200*******************************************************           02140000
023300 01  HOLD-VARIABLES.                                              02150000
023400     02  HOLD-VAR-DATA.                                           02160000
023500         05  FACTOR                         PIC 9.                02170000
023600         05  NUR-INDEX                      PIC 9V99.             02180000
023700         05  THR-INDEX                      PIC 9V99.             02190000
023800         05  AREA-WAGE-INDEX                PIC 9(01)V9(04).      02200000
023900         05  IP-RATE                        PIC 9(03)V9(02).      02210000
024000         05  GS-RATE                        PIC 9(02)V9(02).      02220000
024100         05  TH-RATE                        PIC 9(02)V9(02).      02230000
024200         05  REHAB-RATE                     PIC 9(03)V9(02).      02240000
024300         05  NURSING-COMPONENT              PIC 999V99.           02250000
024400         05  THERAPY-COMPONENT              PIC 999V99.           02260000
024500         05  NCM-THR-COMPONENT              PIC 999V99.           02270000
024600         05  NCM-COMPONENT                  PIC 999V99.           02280000
024700         05  PAYMENT-RATE-ADJ               PIC 9(06)V99.         02290000
024800         05  FED-PAYMENT                    PIC 9(06)V99.         02300000
024900     02  SNFPR-VERSION                      PIC X(09).            02310000
025000                                                                  02320000
025100                                                                  02330000
025200*******************************************************           02340000
025300*    SNF PAYMENT REPORT COMPONENTS                    *           02350000
025400*******************************************************           02360000
025500 01  SNF-DETAIL-LINE.                                             02370000
025600     05  FILLER                  PIC X(02)  VALUE SPACES.         02380000
025700     05  PRT-MSA-CBSA            PIC X(05).                       02390000
025800     05  FILLER                  PIC X(01)  VALUE SPACES.         02400000
025900     05  PRT-EFF-DATE            PIC X(08).                       02410000
026000     05  FILLER                  PIC X(01)  VALUE SPACES.         02420000
026100     05  PRT-AREA-WAGE-INDEX     PIC 9.9999.                      02430000
026200     05  FILLER                  PIC X(01)  VALUE SPACES.         02440000
026300     05  PRT-HCPPS               PIC X(05).                       02450000
026400     05  FILLER                  PIC X(01)  VALUE SPACES.         02460000
026500     05  PRT-NUR-INDEX           PIC 9.99.                        02470000
026600     05  FILLER                  PIC X(01)  VALUE SPACES.         02480000
026700     05  PRT-THR-INDEX           PIC 9.99.                        02490000
026800     05  FILLER                  PIC X(01)  VALUE SPACES.         02500000
026900     05  PRT-IP-RATE             PIC 999.99.                      02510000
027000     05  FILLER                  PIC X(01)  VALUE SPACES.         02520000
027100     05  PRT-GS-RATE             PIC 99.99.                       02530000
027200     05  FILLER                  PIC X(01)  VALUE SPACES.         02540000
027300     05  PRT-TH-RATE             PIC 99.99.                       02550000
027400     05  FILLER                  PIC X(01)  VALUE SPACES.         02560000
027500     05  PRT-RE-RATE             PIC 999.99.                      02570000
027600     05  FILLER                  PIC X(01)  VALUE SPACES.         02580000
027700     05  PRT-NURS-COMP           PIC $$,$$$.99.                   02590000
027800     05  FILLER                  PIC X(01)  VALUE SPACES.         02600000
027900     05  PRT-THER-COMP           PIC $$,$$$.99.                   02610000
028000     05  FILLER                  PIC X(01)  VALUE SPACES.         02620000
028100     05  PRT-NCM-THR-COMP        PIC $$,$$$.99.                   02630000
028200     05  PRT-NCM-COMP            PIC $$,$$$.99.                   02640000
028300     05  FILLER                  PIC X(01)  VALUE SPACES.         02650000
028400     05  PRT-FAC-PAY-RATE        PIC $$$,$$$.99.                  02660000
028500     05  PRT-PAYMENT-RATE        PIC $,$$$,$$$.99.                02670000
028600     05  FILLER                  PIC X(01)  VALUE SPACES.         02680000
028700     05  PRT-SNF-RTC             PIC 99.                          02690000
028800     05  FILLER                  PIC X(01)  VALUE SPACES.         02700000
028900     05  PRT-BLEND               PIC 9.                           02710000
029000                                                                  02720000
029100 01  SNF-HEAD1.                                                   02730000
029200     05  FILLER                  PIC X(01)  VALUE SPACES.         02740000
029300     05  FILLER                  PIC X(44)  VALUE                 02750000
029400        '  C M S ,                                   '.           02760000
029500     05  FILLER                  PIC X(44)  VALUE                 02770000
029600        '                                            '.           02780000
029700     05  FILLER                  PIC X(44)  VALUE                 02790000
029800        '                                            '.           02800000
029900                                                                  02810000
030000 01  SNF-HEAD2.                                                   02820000
030100     05  FILLER                  PIC X(01)  VALUE SPACES.         02830000
030200     05  FILLER                  PIC X(44)  VALUE                 02840000
030300        ' CMM,PDG,DDS SNF NATIONAL PRICER            '.           02850000
030400     05  FILLER                  PIC X(44)  VALUE                 02860000
030500        '              (NHCMQ)     T E S T   D A T A '.           02870000
030600     05  FILLER                  PIC X(44)  VALUE                 02880000
030700        '  R E P O R T                               '.           02890000
030800                                                                  02900000
030900 01  SNF-HEAD3.                                                   02910000
031000     05  FILLER                  PIC X(01)  VALUE SPACES.         02920000
031100     05  FILLER                  PIC X(44)  VALUE                 02930000
031200        ' MSA/    EFF-    WAGE  HCPPS              NU'.           02940000
031300     05  FILLER                  PIC X(44)  VALUE                 02950000
031400        'RS   NCM   TNCM  TCM      NURS    THER      '.           02960000
031500     05  FILLER                  PIC X(44)  VALUE                 02970000
031600        ' NCM-THR    NCM       FAC      TOT     RTC  '.           02980000
031700                                                                  02990000
031800 01  SNF-HEAD4.                                                   03000000
031900     05  FILLER                  PIC X(01)  VALUE SPACES.         03010000
032000     05  FILLER                  PIC X(44)  VALUE                 03020000
032100        '  CBSA   DATE    ADJ   CODE  NUR / THER   RA'.           03030000
032200     05  FILLER                  PIC X(44)  VALUE                 03040000
032300        'TE   RATE  RATE  RATE     COMP    COMP      '.           03050000
032400     05  FILLER                  PIC X(44)  VALUE                 03060000
032500        ' COMP       COMP      PAY      PAY      BLEN'.           03070000
032600                                                                  03080000
032700 01  MSA-WI-TABLE.                                                03090000
032800     05  MSA-DATA        OCCURS 8000                              03100000
032900                           INDEXED BY MU1 MU2 MU3.                03110000
033000         10  MSA-TB-MSA        PIC X(04).                         03120000
033100         10  MSA-TB-EFFDATE    PIC X(08).                         03130000
033200         10  MSA-TB-WAGEIND    PIC X(06).                         03140000
033300                                                                  03150000
033400 01  CBSA-WI-TABLE.                                               03160000
033500     05  T-CBSA-DATA        OCCURS 8000                           03170000
033600                           INDEXED BY MA1 MA2 MA3.                03180000
033700         10  T-CBSA-CODE       PIC X(05).                         03190000
033800         10  T-CBSA-EFFDATE    PIC X(08).                         03200000
033900         10  T-CBSA-WAGEIND    PIC X(06).                         03210000
034000                                                                  03220000
034100 PROCEDURE  DIVISION.                                             03230000
034200                                                                  03240000
034300 0000-MAINLINE  SECTION.                                          03250000
034400                                                                  03260000
034500     OPEN INPUT  M3PIFILE.                                        03270000
034600                                                                  03280000
034700     OPEN OUTPUT OUTFILE                                          03290000
034800          OUTPUT PRTFILE.                                         03300000
034900                                                                  03310000
035000     PERFORM 1300-LOAD-MSAFILE                                    03320000
035100        THRU 1300-EXIT.                                           03330000
035200                                                                  03340000
035300******************************************************************03350000
035400*    MSA TABLE OVERFLOW                                           03360000
035500*    DISCONTINUE PROCESSING                                       03370000
035600******************************************************************03371000
035700                                                                  03371100
035800     IF MSA-CTR > 7999                                            03371200
035900        GO TO 0050-EOJ.                                           03371300
036000                                                                  03371400
036100     PERFORM 1500-LOAD-CBSAFILE                                   03371500
036200        THRU 1500-EXIT.                                           03371600
036300                                                                  03371700
036400                                                                  03371800
036500******************************************************************03371900
036600*    CBSA TABLE OVERFLOW                                          03372000
036700*    DISCONTINUE PROCESSING                                       03373000
036800******************************************************************03374000
036900                                                                  03375000
037000     IF CBSA-CTR > 7999                                           03376000
037100        GO TO 0050-EOJ.                                           03377000
037200                                                                  03378000
037300                                                                  03379000
037400     PERFORM 0100-PROCESS-RECORDS                                 03380000
037500        THRU 0100-EXIT                                            03390000
037600             UNTIL EOF-SW = 1.                                    03400000
037700                                                                  03410000
037800                                                                  03420000
037900    0050-EOJ.                                                     03430000
038000                                                                  03440000
038100     DISPLAY ' '.                                                 03450000
038200                                                                  03460000
038300     DISPLAY '-- PROGRAM SNFOP___  VERSION  ===> ' SNFOP-VERSION. 03470000
038400     DISPLAY '-- PROGRAM SNFDR___  VERSION  ===> ' SNFDR-VERSION. 03480000
038500     DISPLAY '-- PROGRAM SNFPR___  VERSION  ===> ' SNFPR-VERSION. 03490000
038600                                                                  03500000
038700     DISPLAY ' '.                                                 03510000
038800                                                                  03520000
038900     DISPLAY '-- INPUT  COUNTS FOR M3PIFILE ===> ' M3PIFILE-CTR.  03530000
039000     DISPLAY '-- OUTPUT COUNTS FOR OUTFILE  ===> ' OUTFILE-CTR.   03540000
039100     DISPLAY '-- OUTPUT COUNTS FOR PRTFILE  ===> ' PRTFILE-CTR.   03550000
039200                                                                  03560000
039300     CLOSE M3PIFILE.                                              03570000
039400     CLOSE OUTFILE.                                               03580000
039500     CLOSE PRTFILE.                                               03590000
039600                                                                  03600000
039700     STOP RUN.                                                    03610000
039800                                                                  03620000
039900 0100-PROCESS-RECORDS.                                            03630000
040000                                                                  03640000
040100     READ M3PIFILE             INTO SNF-WORK                      03650000
040200         AT END                                                   03660000
040300             MOVE 1            TO EOF-SW                          03670000
040400             GO TO 0100-EXIT.                                     03680000
040500                                                                  03690000
040600     ADD 1                     TO M3PIFILE-CTR.                   03700000
040700                                                                  03710000
040800     MOVE ALL '0'              TO SNF-PAY-RTC                     03720000
040900                                  HOLD-VAR-DATA.                  03730000
041000                                                                  03740000
041100     IF SNF-THRU-DATE < 19980701                                  03750000
041200        MOVE '40'              TO SNF-RTC                         03760000
041300        PERFORM 1100-WRITE                                        03770000
041400           THRU 1100-EXIT                                         03780000
041700        GO TO 0100-EXIT.                                          03790000
041600                                                                  03800000
041700     IF SNF-RTC NOT = '00'                                        03810000
041800         PERFORM 1100-WRITE                                       03820000
041900            THRU 1100-EXIT                                        03830000
042000         GO TO 0100-EXIT.                                         03840000
042100                                                                  03850000
042200     IF  EOF-SW = 0                                               03860000
042300         CALL  SNFDR181        USING SNF-WORK                     03870000
042400                               HOLD-VARIABLES                     03880000
042500                               CBSA-WI-TABLE                      03890000
042600                               MSA-WI-TABLE                       03900000
042700         PERFORM 1100-WRITE                                       03910000
042800            THRU 1100-EXIT.                                       03920000
042900                                                                  03930000
043000 0100-EXIT.  EXIT.                                                03940000
043100                                                                  03950000
043200 1100-WRITE.                                                      03960000
043300******************************************************************03970000
043400*    PRINT SNF PROSPECTIVE PAYMENT TEST DATA DETAIL               03980000
043500*    REPORT AND WRITE TEST PAYMENT RECORD ROUTINE                 03990000
043600******************************************************************04000000
043700                                                                  04010000
043800     IF  LINE-CTR > 54                                            04020000
043900         PERFORM 1200-SNF-HEADINGS                                04030000
044000            THRU 1200-EXIT.                                       04040000
044100                                                                  04050000
044200     MOVE SPACES               TO  SNF-DETAIL-LINE.               04060000
044300                                                                  04070000
044400     IF SNF-THRU-DATE < 20051001                                  04080000
044500        MOVE SNF-MSA           TO PRT-MSA-CBSA                    04090000
044600     ELSE                                                         04100000
044700        MOVE SNF-CBSA          TO PRT-MSA-CBSA.                   04110000
044800                                                                  04120000
044900     MOVE SNF-THRU-DATE        TO PRT-EFF-DATE.                   04130000
045000     MOVE SNF-FED-BLEND        TO PRT-BLEND                       04140000
045100     MOVE SNF-HCPPS-CODE       TO PRT-HCPPS.                      04150000
045200     MOVE AREA-WAGE-INDEX      TO PRT-AREA-WAGE-INDEX.            04160000
045300     MOVE NUR-INDEX            TO PRT-NUR-INDEX.                  04170000
045400     MOVE THR-INDEX            TO PRT-THR-INDEX.                  04180000
045500                                                                  04190000
045600     MOVE IP-RATE              TO PRT-IP-RATE.                    04200000
045700     MOVE GS-RATE              TO PRT-GS-RATE.                    04210000
045800     MOVE TH-RATE              TO PRT-TH-RATE.                    04220000
045900     MOVE REHAB-RATE           TO PRT-RE-RATE.                    04230000
046000                                                                  04240000
046100     MOVE NURSING-COMPONENT    TO PRT-NURS-COMP.                  04250000
046200     MOVE THERAPY-COMPONENT    TO PRT-THER-COMP.                  04260000
046300     MOVE NCM-THR-COMPONENT    TO PRT-NCM-THR-COMP.               04270000
046400     MOVE NCM-COMPONENT        TO PRT-NCM-COMP.                   04280000
046500                                                                  04290000
046600     MOVE SNF-FACILITY-RATE    TO PRT-FAC-PAY-RATE.               04300000
046700     MOVE SNF-PAYMENT-RATE     TO PRT-PAYMENT-RATE.               04310000
046800                                                                  04320000
046900     MOVE SNF-RTC              TO PRT-SNF-RTC.                    04330000
047000                                                                  04340000
047100     WRITE PRTFILE-LINE        FROM SNF-DETAIL-LINE               04350000
047200                                    AFTER ADVANCING 1.            04360000
047300                                                                  04370000
047400     ADD 1                     TO PRTFILE-CTR.                    04380000
047500                                                                  04390000
047600     IF PRT-STAT1 > 0                                             04400000
047700        DISPLAY ' BAD1 WRITE ON PRTFILE FILE'.                    04410000
047800                                                                  04420000
047900     ADD 1                     TO LINE-CTR.                       04430000
048000                                                                  04440000
048100     WRITE OUT-REC             FROM SNF-WORK.                     04450000
048200                                                                  04460000
048300     IF UT2-STAT1 > 0                                             04470000
048400        DISPLAY ' BAD2 WRITE ON OUTFILE  FILE'.                   04480000
048500                                                                  04490000
048600     ADD 1                     TO OUTFILE-CTR.                    04500000
048700                                                                  04510000
048800 1100-EXIT.  EXIT.                                                04520000
048900                                                                  04530000
049000 1200-SNF-HEADINGS.                                               04540000
049100                                                                  04550000
049200     WRITE PRTFILE-LINE        FROM SNF-HEAD1                     04560000
049300                                    AFTER ADVANCING PAGE.         04570000
049400                                                                  04580000
049500     IF PRT-STAT1 > 0                                             04590000
049600        DISPLAY ' BAD3 WRITE ON PRTFILE FILE'.                    04600000
049700                                                                  04610000
049800     WRITE PRTFILE-LINE        FROM SNF-HEAD2                     04620000
049900                                    AFTER ADVANCING 1.            04630000
050000                                                                  04640000
050100     IF PRT-STAT1 > 0                                             04650000
050200        DISPLAY ' BAD4 WRITE ON PRTFILE FILE'.                    04660000
050300                                                                  04670000
050400     WRITE PRTFILE-LINE        FROM SNF-HEAD3                     04680000
050500                                    AFTER ADVANCING 2.            04690000
050600                                                                  04700000
050700     IF PRT-STAT1 > 0                                             04710000
050800        DISPLAY ' BAD5 WRITE ON PRTFILE FILE'.                    04720000
050900                                                                  04730000
051000     WRITE PRTFILE-LINE        FROM SNF-HEAD4                     04740000
051100                                    AFTER ADVANCING 1.            04750000
051200                                                                  04760000
051300     IF PRT-STAT1 > 0                                             04770000
051400        DISPLAY ' BAD6 WRITE ON PRTFILE FILE'.                    04780000
051500                                                                  04790000
051600     MOVE ALL '  -'            TO PRTFILE-LINE.                   04800000
051700                                                                  04810000
051800     WRITE PRTFILE-LINE        AFTER ADVANCING 1.                 04820000
051900                                                                  04830000
052000     IF PRT-STAT1 > 0                                             04840000
052100        DISPLAY ' BAD7 WRITE ON PRTFILE FILE'.                    04850000
052200                                                                  04860000
052300     MOVE 5                    TO LINE-CTR.                       04870000
052400                                                                  04880000
052500 1200-EXIT.  EXIT.                                                04890000
052600                                                                  04900000
052700 1300-LOAD-MSAFILE.                                               04910000
052800                                                                  04920000
052900     OPEN INPUT MSAFILE.                                          04930000
053000     MOVE 0                    TO EOF-MSA.                        04940000
053100     SET MU3                   TO EOF-MSA.                        04950000
053200                                                                  04960000
053300     PERFORM 1400-READ-MSAFILE                                    04970000
053400        THRU 1400-EXIT                                            04980000
053500             UNTIL EOF-MSA = 1.                                   04990000
053600                                                                  05000000
053700     CLOSE MSAFILE.                                               05010000
053800                                                                  05020000
053900 1300-EXIT.  EXIT.                                                05030000
054000                                                                  05040000
054100 1400-READ-MSAFILE.                                               05050000
054200                                                                  05060000
054300     READ MSAFILE                                                 05070000
054400          AT END                                                  05080000
054500             MOVE 1            TO EOF-MSA                         05090000
054600                                                                  05100000
054700     GO TO 1400-EXIT.                                             05101000
054800                                                                  05102000
054900     ADD 1                     TO MSA-CTR.                        05103000
055000                                                                  05104000
055100                                                                  05105000
055200     IF MSA-CTR > 7999                                            05106000
055300        DISPLAY ' '                                               05107000
055400        DISPLAY '-- SNF PROGRAM  VERSION ==> ' SNFOP-VERSION      05108000
055500        DISPLAY ' '                                               05109000
055600        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05110000
055700        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05111000
055800        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05112000
055900        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 MSA RECORDS'    05113000
056000        DISPLAY  ' MSA FILE TO LARGE '                            05114000
056100        MOVE 1                 TO EOF-MSA.                        05115000
056200                                                                  05116000
056300     IF EOF-MSA = 0                                               05117000
056400        SET MU3                UP BY 1                            05118000
056500        MOVE MSA-CODE          TO MSA-TB-MSA     (MU3)            05119000
056600        MOVE MSA-EFFDATE       TO MSA-TB-EFFDATE (MU3)            05120000
056700        MOVE MSA-WAGEIND       TO MSA-TB-WAGEIND (MU3).           05130000
056800                                                                  05140000
056900 1400-EXIT.  EXIT.                                                05150000
057000                                                                  05160000
057100 1500-LOAD-CBSAFILE.                                              05170000
057200                                                                  05180000
057300     OPEN INPUT CBSAFILE.                                         05190000
057400                                                                  05200000
057500     MOVE 0                    TO EOF-CBSA.                       05210000
057600     SET MA3                   TO EOF-CBSA.                       05220000
057700                                                                  05230000
057800     PERFORM 1600-READ-CBSAFILE                                   05240000
057900        THRU 1600-EXIT                                            05250000
058000             UNTIL EOF-CBSA = 1.                                  05260000
058100                                                                  05270000
058200     CLOSE CBSAFILE.                                              05280000
058300                                                                  05290000
058400 1500-EXIT.  EXIT.                                                05300000
058500                                                                  05310000
058600 1600-READ-CBSAFILE.                                              05320000
058700                                                                  05330000
058800     READ CBSAFILE                                                05340000
058900          AT END                                                  05350000
059000             MOVE 1            TO EOF-CBSA                        05360000
059100                                                                  05370000
059200     GO TO 1600-EXIT.                                             05380000
059300                                                                  05390000
059400     ADD 1                     TO CBSA-CTR.                       05391000
059500                                                                  05391100
059600                                                                  05391200
059700     IF CBSA-CTR > 7999                                           05391300
059800        DISPLAY ' '                                               05391400
059900        DISPLAY '-- SNF PROGRAM  VERSION ==> ' SNFOP-VERSION      05391500
060000        DISPLAY ' '                                               05391600
060100        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05391700
060200        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05391800
060300        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05391900
060400        DISPLAY  ' CAN NOT PROCESS MORE THAN 8000 CBSA RECORDS'   05392000
060500        DISPLAY  ' CBSA FILE TO LARGE '                           05393000
060600        MOVE 1                 TO EOF-CBSA.                       05394000
060700                                                                  05395000
060800                                                                  05396000
060900     IF EOF-CBSA = 0                                              05397000
061000        SET MA3                UP BY 1                            05398000
061100            MOVE F-CBSA-CODE   TO T-CBSA-CODE    (MA3)            05399000
061200            MOVE F-CBSA-EFFDATE                                   05400000
061300                               TO T-CBSA-EFFDATE (MA3)            05410000
061400            MOVE F-CBSA-WAGEIND                                   05420000
061500                               TO T-CBSA-WAGEIND (MA3).           05430000
061600 1600-EXIT.  EXIT.                                                05440000
061700                                                                  05450000
061800*****        LAST STATEMENT               *************           05460000
