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