000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.          SNFOP140.                                   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***------------------------------------------------------------***00120100
001400*     SNFOP100   EFFECTIVE OCT 1, 2009                            00120200
001500*                OPENS CLAIMS FILE                                00120300
001600*                OPENS OUTPUT FILE                                00120400
001700*                OPENS MSA FILE                                   00120500
001800*                OPENS CBSA FILE                                  00120600
001900*                OPENS PRT FILE                                   00120700
002000***------------------------------------------------------------***00120800
002100*     SNFOP101   EFFECTIVE OCT 1, 2009                            00120900
002200*                OPENS CLAIMS FILE                                00121000
002300*                OPENS OUTPUT FILE                                00121100
002400*                OPENS MSA FILE                                   00121200
002500*                OPENS CBSA FILE                                  00121300
002600*                OPENS PRT FILE                                   00121400
002700***------------------------------------------------------------***00121500
002800*     SNFOP102   EFFECTIVE OCT 1, 2009                            00121600
002900*                OPENS CLAIMS FILE                                00121700
003000*                OPENS OUTPUT FILE                                00121800
003100*                OPENS MSA FILE                                   00121900
003200*                OPENS CBSA FILE                                  00122000
003300*                OPENS PRT FILE                                   00122100
003400***------------------------------------------------------------***00122200
003500*     SNFOP112   EFFECTIVE OCT 1, 2010                            00122300
003600*                OPENS CLAIMS FILE                                00122400
003700*                OPENS OUTPUT FILE                                00122500
003800*                OPENS MSA FILE                                   00122600
003900*                OPENS CBSA FILE                                  00122700
004000*                OPENS PRT FILE                                   00122800
004100***------------------------------------------------------------***00122900
004200*     SNFOP120   EFFECTIVE OCT 1, 2011                            00123000
004300*                OPENS CLAIMS FILE                                00123100
004400*                OPENS OUTPUT FILE                                00123200
004500*                OPENS MSA FILE                                   00123300
004600*                OPENS CBSA FILE                                  00123400
004700*                OPENS PRT FILE                                   00123500
004800******************************************************************00123600
004200*     SNFOP140   EFFECTIVE OCT 1, 2013                            00123701
004300*                OPENS CLAIMS FILE                                00123800
004400*                OPENS OUTPUT FILE                                00123900
004500*                OPENS MSA FILE                                   00124000
004600*                OPENS CBSA FILE                                  00124100
004700*                OPENS PRT FILE                                   00124200
004800******************************************************************00124300
004900 DATE-COMPILED.                                                   00124400
005000 ENVIRONMENT                     DIVISION.                        00124500
005100                                                                  00124600
005200 CONFIGURATION                   SECTION.                         00124700
005300 SOURCE-COMPUTER.                IBM-370.                         00124800
005400 OBJECT-COMPUTER.                IBM-370.                         00124900
005500                                                                  00125000
005600 INPUT-OUTPUT SECTION.                                            00125100
005700 FILE-CONTROL.                                                    00125200
005800                                                                  00125300
005900     SELECT M3PIFILE   ASSIGN TO UT-S-M3PIFILE                    00125400
006000         FILE STATUS IS UT1-STAT.                                 00125500
006100     SELECT OUTFILE    ASSIGN TO UT-S-OUTFILE                     00126000
006200         FILE STATUS IS UT2-STAT.                                 00127000
006300     SELECT PRTFILE    ASSIGN TO UT-S-PRTFILE                     00128000
006400         FILE STATUS IS PRT-STAT.                                 00129000
006500     SELECT MSAFILE    ASSIGN TO UT-S-MSAFILE                     00130000
006600         FILE STATUS IS MSA-STAT.                                 00140000
006700     SELECT CBSAFILE   ASSIGN TO UT-S-CBSAFILE                    00150000
006800         FILE STATUS IS CBSA-STAT.                                00160000
006900                                                                  00170000
007000 DATA DIVISION.                                                   00180000
007100 FILE SECTION.                                                    00190000
007200 FD  M3PIFILE                                                     00200000
007300     LABEL RECORDS ARE STANDARD                                   00210000
007400     RECORDING MODE IS F                                          00220000
007500     BLOCK CONTAINS 0 RECORDS.                                    00230000
007600 01  SNF-REC                     PIC X(250).                      00240000
007700                                                                  00250000
007800 FD  OUTFILE                                                      00260000
007900     LABEL RECORDS ARE STANDARD                                   00270000
008000     RECORDING MODE IS F                                          00280000
008100     BLOCK CONTAINS 0 RECORDS.                                    00290000
008200 01  OUT-REC                     PIC X(250).                      00300000
008300                                                                  00310000
008400 FD  PRTFILE                                                      00320000
008500     RECORDING MODE IS F                                          00330000
008600     BLOCK CONTAINS 133 RECORDS                                   00340000
008700     LABEL RECORDS ARE STANDARD.                                  00350000
008800 01  PRTFILE-LINE                PIC X(133).                      00360000
008900                                                                  00370000
009000 FD  MSAFILE                                                      00380000
009100     RECORDING MODE IS F                                          00390000
009200     BLOCK CONTAINS 133 RECORDS                                   00400000
009300     LABEL RECORDS ARE STANDARD.                                  00410000
009400 01  MSA-REC.                                                     00420000
009500     05  MSA-CODE                 PIC X(04).                      00430000
009600     05  FILLER                   PIC X.                          00440000
009700     05  MSA-EFFDATE              PIC X(08).                      00450000
009800     05  FILLER                   PIC X.                          00460000
009900     05  MSA-WAGEIND              PIC X(06).                      00470000
010000     05  FILLER                   PIC X(08).                      00480000
010100     05  MSA-NAME                 PIC X(52).                      00490000
010200                                                                  00500000
010300 FD  CBSAFILE                                                     00510000
010400     RECORDING MODE IS F                                          00520000
010500     BLOCK CONTAINS 133 RECORDS                                   00530000
010600     LABEL RECORDS ARE STANDARD.                                  00540000
010700 01  F-CBSA-REC.                                                  00550000
010800     05  F-CBSA-CODE              PIC X(05).                      00560000
010900     05  FILLER                   PIC X.                          00570000
011000     05  F-CBSA-EFFDATE           PIC X(08).                      00580000
011100     05  FILLER                   PIC X.                          00590000
011200     05  F-CBSA-WAGEIND           PIC X(06).                      00600000
011300     05  FILLER                   PIC X(08).                      00610000
011400     05  F-CBSA-NAME              PIC X(51).                      00620000
011500                                                                  00630000
011600                                                                  00640000
011700 WORKING-STORAGE SECTION.                                         00650000
011800 77  W-STORAGE-REF               PIC X(49)  VALUE                 00660000
011900     'SNF O P E N       - W O R K I N G   S T O R A G E'.         00670000
012000 01  SNFOP-VERSION               PIC X(09)  VALUE 'SNFOP14.0'.    00680001
012100 01  SNFDR-VERSION               PIC X(09)  VALUE 'SNFDR14.0'.    00690001
012200 01  SNFDR140                    PIC X(08)  VALUE 'SNFDR140'.     00700001
012300 01  EOF-SW                      PIC 9(01)  VALUE 0.              00710000
012400 01  EOF-MSA                     PIC 9(01)  VALUE 0.              00720000
012500 01  EOF-CBSA                    PIC 9(01)  VALUE 0.              00730000
012600 01  LINE-CTR                    PIC 9(02)  VALUE 65.             00740000
012700 01  M3PIFILE-CTR                PIC 9(09)  VALUE 0.              00750000
012800 01  OUTFILE-CTR                 PIC 9(09)  VALUE 0.              00760000
012900 01  PRTFILE-CTR                 PIC 9(09)  VALUE 0.              00770000
013000 01  UT1-STAT.                                                    00780000
013100     05  UT1-STAT1               PIC X.                           00790000
013200     05  UT1-STAT2               PIC X.                           00800000
013300 01  UT2-STAT.                                                    00810000
013400     05  UT2-STAT1               PIC X.                           00820000
013500     05  UT2-STAT2               PIC X.                           00830000
013600 01  PRT-STAT.                                                    00840000
013700     05  PRT-STAT1               PIC X.                           00850000
013800     05  PRT-STAT2               PIC X.                           00860000
013900 01  MSA-STAT.                                                    00870000
014000     05  MSA-STAT1               PIC X.                           00880000
014100     05  MSA-STAT2               PIC X.                           00890000
014200 01  CBSA-STAT.                                                   00900000
014300     05  CBSA-STAT1               PIC X.                          00910000
014400     05  CBSA-STAT2               PIC X.                          00920000
014500*******************************************************           00930000
014600* NATIONAL SNF RECORD FORMAT PASSED TO SNFDR,SNFPR    *           00940000
014700*******************************************************           00950000
014800 01  SNF-WORK.                                                    00960000
014900     05  SNF-INPUT-DATA.                                          00970000
015000         10  SNF-MSA                     PIC X(04).               00980000
015100         10  SNF-CBSA                    PIC X(05).               00990000
015200         10  SNF-SPEC-WI-IND             PIC X.                   01000000
015300             88  SNF-SPEC-WI-IND-VALUES   VALUE 'Y' 'N' '1' '2'.  01010000
015400         10  SNF-SPEC-WI                 PIC 9(02)V9(04).         01020000
015500         10  SNF-SPEC-WI-X  REDEFINES SNF-SPEC-WI PIC X(06).      01030000
015600         10  SNF-HCPPS-CODE              PIC X(05).               01040000
015700         10  SNF-FROM-DATE.                                       01050000
015800             15 SNF-FROM-CC              PIC XX.                  01060000
015900             15 SNF-FROM-YYMMDD.                                  01070000
016000                 25 SNF-FROM-YY          PIC XX.                  01080000
016100                 25 SNF-FROM-MM          PIC XX.                  01090000
016200                 25 SNF-FROM-DD          PIC XX.                  01100000
016300         10  SNF-THRU-DATE.                                       01110000
016400             15  SNF-THRU-CC             PIC XX.                  01120000
016500             15  SNF-THRU-YYMMDD.                                 01121000
016600                 25  SNF-THRU-YY         PIC XX.                  01122000
016700                 25  SNF-THRU-MM         PIC XX.                  01123000
016800                 25  SNF-THRU-DD         PIC XX.                  01124000
016900         10  SNF-FED-BLEND               PIC X.                   01125000
017000             88  SNF-FED-BLEND-VALUES                             01126000
017100                               VALUE '0' '1' '2' '3' '4'.         01127000
017200         10  SNF-FACILITY-RATE           PIC 9(05)V9(02).         01128000
017300         10  SNF-DIAGNOSIS-CODES.                                 01129000
017400             15  SNF-PRIN-DIAG-CODE      PIC X(07).               01130000
017500             15  SNF-OTHER-DIAG-CODE2    PIC X(07).               01140000
017600             15  SNF-OTHER-DIAG-CODE3    PIC X(07).               01150000
017700             15  SNF-OTHER-DIAG-CODE4    PIC X(07).               01160000
017800             15  SNF-OTHER-DIAG-CODE5    PIC X(07).               01170000
017900             15  SNF-OTHER-DIAG-CODE6    PIC X(07).               01180000
018000             15  SNF-OTHER-DIAG-CODE7    PIC X(07).               01190000
018100             15  SNF-OTHER-DIAG-CODE8    PIC X(07).               01200000
018200             15  SNF-OTHER-DIAG-CODE9    PIC X(07).               01210000
018300             15  SNF-OTHER-DIAG-CODE10   PIC X(07).               01220000
018400             15  SNF-OTHER-DIAG-CODE11   PIC X(07).               01230000
018500             15  SNF-OTHER-DIAG-CODE12   PIC X(07).               01240000
018600             15  SNF-OTHER-DIAG-CODE13   PIC X(07).               01250000
018700             15  SNF-OTHER-DIAG-CODE14   PIC X(07).               01260000
018800             15  SNF-OTHER-DIAG-CODE15   PIC X(07).               01261000
018900             15  SNF-OTHER-DIAG-CODE16   PIC X(07).               01262000
019000             15  SNF-OTHER-DIAG-CODE17   PIC X(07).               01263000
019100             15  SNF-OTHER-DIAG-CODE18   PIC X(07).               01264000
019200             15  SNF-OTHER-DIAG-CODE19   PIC X(07).               01265000
019300             15  SNF-OTHER-DIAG-CODE20   PIC X(07).               01266000
019400             15  SNF-OTHER-DIAG-CODE21   PIC X(07).               01267000
019500             15  SNF-OTHER-DIAG-CODE22   PIC X(07).               01268000
019600             15  SNF-OTHER-DIAG-CODE23   PIC X(07).               01269000
019700             15  SNF-OTHER-DIAG-CODE24   PIC X(07).               01269100
019800             15  SNF-OTHER-DIAG-CODE25   PIC X(07).               01269200
019900         10  SNF-PAY-RTC.                                         01269300
020000             15  SNF-PAYMENT-RATE        PIC 9(06)V9(02).         01269400
020100             15  SNF-RTC                 PIC 99.                  01269500
020200         10  FILLER                      PIC X(20).               01269600
020300                                                                  01269700
020400*******************************************************           01269800
020500*    RETURNED BY SNFDR AND SNFPR                      *           01269900
020600*******************************************************           01270000
020700 01  HOLD-VARIABLES.                                              01280000
020800     02  HOLD-VAR-DATA.                                           01290000
020900         05  FACTOR                         PIC 9.                01300000
021000         05  NUR-INDEX                      PIC 9V99.             01310000
021100         05  THR-INDEX                      PIC 9V99.             01320000
021200         05  AREA-WAGE-INDEX                PIC 9(01)V9(04).      01330000
021300         05  IP-RATE                        PIC 9(03)V9(02).      01340000
021400         05  GS-RATE                        PIC 9(02)V9(02).      01350000
021500         05  TH-RATE                        PIC 9(02)V9(02).      01360000
021600         05  REHAB-RATE                     PIC 9(03)V9(02).      01370000
021700         05  NURSING-COMPONENT              PIC 999V99.           01380000
021800         05  THERAPY-COMPONENT              PIC 999V99.           01390000
021900         05  NCM-THR-COMPONENT              PIC 999V99.           01400000
022000         05  NCM-COMPONENT                  PIC 999V99.           01410000
022100         05  PAYMENT-RATE-ADJ               PIC 9(06)V99.         01420000
022200         05  FED-PAYMENT                    PIC 9(06)V99.         01430000
022300     02  SNFPR-VERSION                      PIC X(09).            01440000
022400                                                                  01450000
022500                                                                  01460000
022600*******************************************************           01470000
022700*    SNF PAYMENT REPORT COMPONENTS                    *           01480000
022800*******************************************************           01490000
022900 01  SNF-DETAIL-LINE.                                             01500000
023000     05  FILLER                  PIC X(02)  VALUE SPACES.         01510000
023100     05  PRT-MSA-CBSA            PIC X(05).                       01520000
023200     05  FILLER                  PIC X(01)  VALUE SPACES.         01530000
023300     05  PRT-EFF-DATE            PIC X(08).                       01540000
023400     05  FILLER                  PIC X(01)  VALUE SPACES.         01550000
023500     05  PRT-AREA-WAGE-INDEX     PIC 9.9999.                      01560000
023600     05  FILLER                  PIC X(01)  VALUE SPACES.         01570000
023700     05  PRT-HCPPS               PIC X(05).                       01580000
023800     05  FILLER                  PIC X(01)  VALUE SPACES.         01590000
023900     05  PRT-NUR-INDEX           PIC 9.99.                        01600000
024000     05  FILLER                  PIC X(01)  VALUE SPACES.         01610000
024100     05  PRT-THR-INDEX           PIC 9.99.                        01620000
024200     05  FILLER                  PIC X(01)  VALUE SPACES.         01630000
024300     05  PRT-IP-RATE             PIC 999.99.                      01640000
024400     05  FILLER                  PIC X(01)  VALUE SPACES.         01650000
024500     05  PRT-GS-RATE             PIC 99.99.                       01660000
024600     05  FILLER                  PIC X(01)  VALUE SPACES.         01670000
024700     05  PRT-TH-RATE             PIC 99.99.                       01680000
024800     05  FILLER                  PIC X(01)  VALUE SPACES.         01690000
024900     05  PRT-RE-RATE             PIC 999.99.                      01700000
025000     05  FILLER                  PIC X(01)  VALUE SPACES.         01710000
025100     05  PRT-NURS-COMP           PIC $$,$$$.99.                   01720000
025200     05  FILLER                  PIC X(01)  VALUE SPACES.         01730000
025300     05  PRT-THER-COMP           PIC $$,$$$.99.                   01740000
025400     05  FILLER                  PIC X(01)  VALUE SPACES.         01750000
025500     05  PRT-NCM-THR-COMP        PIC $$,$$$.99.                   01760000
025600     05  PRT-NCM-COMP            PIC $$,$$$.99.                   01770000
025700     05  FILLER                  PIC X(01)  VALUE SPACES.         01780000
025800     05  PRT-FAC-PAY-RATE        PIC $$$,$$$.99.                  01790000
025900     05  PRT-PAYMENT-RATE        PIC $,$$$,$$$.99.                01800000
026000     05  FILLER                  PIC X(01)  VALUE SPACES.         01810000
026100     05  PRT-SNF-RTC             PIC 99.                          01820000
026200     05  FILLER                  PIC X(01)  VALUE SPACES.         01830000
026300     05  PRT-BLEND               PIC 9.                           01840000
026400                                                                  01850000
026500 01  SNF-HEAD1.                                                   01860000
026600     05  FILLER                  PIC X(01)  VALUE SPACES.         01870000
026700     05  FILLER                  PIC X(44)  VALUE                 01880000
026800        '  C M S ,                                   '.           01890000
026900     05  FILLER                  PIC X(44)  VALUE                 01900000
027000        '                                            '.           01910000
027100     05  FILLER                  PIC X(44)  VALUE                 01920000
027200        '                                            '.           01930000
027300                                                                  01940000
027400 01  SNF-HEAD2.                                                   01950000
027500     05  FILLER                  PIC X(01)  VALUE SPACES.         01960000
027600     05  FILLER                  PIC X(44)  VALUE                 01970000
027700        ' CMM,PDG,DDS SNF NATIONAL PRICER            '.           01980000
027800     05  FILLER                  PIC X(44)  VALUE                 01990000
027900        '              (NHCMQ)     T E S T   D A T A '.           02000000
028000     05  FILLER                  PIC X(44)  VALUE                 02010000
028100        '  R E P O R T                               '.           02020000
028200                                                                  02030000
028300 01  SNF-HEAD3.                                                   02040000
028400     05  FILLER                  PIC X(01)  VALUE SPACES.         02050000
028500     05  FILLER                  PIC X(44)  VALUE                 02060000
028600        ' MSA/    EFF-    WAGE  HCPPS              NU'.           02070000
028700     05  FILLER                  PIC X(44)  VALUE                 02080000
028800        'RS   NCM   TNCM  TCM      NURS    THER      '.           02090000
028900     05  FILLER                  PIC X(44)  VALUE                 02100000
029000        ' NCM-THR    NCM       FAC      TOT     RTC  '.           02110000
029100                                                                  02120000
029200 01  SNF-HEAD4.                                                   02130000
029300     05  FILLER                  PIC X(01)  VALUE SPACES.         02140000
029400     05  FILLER                  PIC X(44)  VALUE                 02150000
029500        '  CBSA   DATE    ADJ   CODE  NUR / THER   RA'.           02160000
029600     05  FILLER                  PIC X(44)  VALUE                 02170000
029700        'TE   RATE  RATE  RATE     COMP    COMP      '.           02180000
029800     05  FILLER                  PIC X(44)  VALUE                 02190000
029900        ' COMP       COMP      PAY      PAY      BLEN'.           02200000
030000                                                                  02210000
030100 01  MSA-WI-TABLE.                                                02220000
030200     05  MSA-DATA        OCCURS 8000                              02230000
030300                           INDEXED BY MU1 MU2 MU3.                02240000
030400         10  MSA-TB-MSA        PIC X(04).                         02250000
030500         10  MSA-TB-EFFDATE    PIC X(08).                         02260000
030600         10  MSA-TB-WAGEIND    PIC X(06).                         02270000
030700                                                                  02280000
030800 01  CBSA-WI-TABLE.                                               02290000
030900     05  T-CBSA-DATA        OCCURS 8000                           02300000
031000                           INDEXED BY MA1 MA2 MA3.                02310000
031100         10  T-CBSA-CODE       PIC X(05).                         02320000
031200         10  T-CBSA-EFFDATE    PIC X(08).                         02330000
031300         10  T-CBSA-WAGEIND    PIC X(06).                         02340000
031400                                                                  02350000
031500 PROCEDURE  DIVISION.                                             02360000
031600                                                                  02370000
031700 0000-MAINLINE  SECTION.                                          02380000
031800     OPEN INPUT  M3PIFILE                                         02390000
031900          OUTPUT OUTFILE                                          02400000
032000          OUTPUT PRTFILE.                                         02410000
032100                                                                  02420000
032200     PERFORM 1300-LOAD-MSAFILE                                    02430000
032200        THRU 1300-EXIT.                                           02431000
032300                                                                  02440000
032400     PERFORM 1500-LOAD-CBSAFILE                                   02450000
032400        THRU 1500-EXIT.                                           02451000
032500                                                                  02460000
032600     PERFORM 0100-PROCESS-RECORDS                                 02470000
032600        THRU 0100-EXIT                                            02471000
032600             UNTIL EOF-SW = 1.                                    02472000
032700                                                                  02480000
032800     DISPLAY ' '.                                                 02490000
032900                                                                  02500000
033000     DISPLAY '-- PROGRAM SNFOP___  VERSION  ===> ' SNFOP-VERSION. 02510000
033100     DISPLAY '-- PROGRAM SNFDR___  VERSION  ===> ' SNFDR-VERSION. 02520000
033200     DISPLAY '-- PROGRAM SNFPR___  VERSION  ===> ' SNFPR-VERSION. 02530000
033300                                                                  02540000
033400     DISPLAY ' '.                                                 02550000
033500                                                                  02560000
033600     DISPLAY '-- INPUT  COUNTS FOR M3PIFILE ===> ' M3PIFILE-CTR.  02570000
033700     DISPLAY '-- OUTPUT COUNTS FOR OUTFILE  ===> ' OUTFILE-CTR.   02580000
033800     DISPLAY '-- OUTPUT COUNTS FOR PRTFILE  ===> ' PRTFILE-CTR.   02590000
033900                                                                  02600000
034000     CLOSE M3PIFILE.                                              02610000
034100     CLOSE OUTFILE.                                               02620000
034200                                                                  02630000
034300     CLOSE PRTFILE.                                               02640000
034400     STOP RUN.                                                    02650000
034500                                                                  02660000
034600 0100-PROCESS-RECORDS.                                            02670000
034700                                                                  02680000
034700     READ M3PIFILE             INTO SNF-WORK                      02681000
034800         AT END                                                   02690000
034900             MOVE 1            TO EOF-SW                          02700000
035000             GO TO 0100-EXIT.                                     02710000
035100                                                                  02720000
035200     ADD 1                     TO M3PIFILE-CTR.                   02730000
035300                                                                  02740000
035400     MOVE ALL '0'              TO SNF-PAY-RTC                     02750000
035500                                  HOLD-VAR-DATA.                  02760000
035600                                                                  02770000
035700     IF SNF-THRU-DATE < 19980701                                  02780000
035800        MOVE '40'              TO SNF-RTC                         02790000
000000        PERFORM 1100-WRITE                                        02800000
037100           THRU 1100-EXIT                                         02801000
036000        GO TO 0100-EXIT.                                          02810000
036100                                                                  02820000
036200     IF SNF-RTC NOT = '00'                                        02830000
036300         PERFORM 1100-WRITE                                       02840000
037100            THRU 1100-EXIT                                        02841000
036400         GO TO 0100-EXIT.                                         02850000
036500                                                                  02860000
036600     IF  EOF-SW = 0                                               02870000
036700         CALL  SNFDR140        USING SNF-WORK                     02880001
036800                               HOLD-VARIABLES                     02890000
036900                               CBSA-WI-TABLE                      02900000
037000                               MSA-WI-TABLE                       02910000
037100         PERFORM 1100-WRITE                                       02920000
037100            THRU 1100-EXIT.                                       02921000
037200                                                                  02930000
037300 0100-EXIT.  EXIT.                                                02940000
037400                                                                  02950000
037500 1100-WRITE.                                                      02960000
037600******************************************************************02970000
037700*    PRINT SNF PROSPECTIVE PAYMENT TEST DATA DETAIL               02980000
037800*    REPORT AND WRITE TEST PAYMENT RECORD ROUTINE                 02990000
037900******************************************************************03000000
038000                                                                  03010000
038000     IF  LINE-CTR > 54                                            03011000
038100         PERFORM 1200-SNF-HEADINGS                                03020000
038100            THRU 1200-EXIT.                                       03021000
038200                                                                  03030000
038300     MOVE SPACES               TO  SNF-DETAIL-LINE.               03040000
038400                                                                  03050000
038500     IF SNF-THRU-DATE < 20051001                                  03060000
038600        MOVE SNF-MSA           TO PRT-MSA-CBSA                    03070000
038700     ELSE                                                         03080000
038800        MOVE SNF-CBSA          TO PRT-MSA-CBSA.                   03090000
038900                                                                  03100000
039000     MOVE SNF-THRU-DATE        TO PRT-EFF-DATE.                   03110000
039100     MOVE SNF-FED-BLEND        TO PRT-BLEND                       03120000
039200     MOVE SNF-HCPPS-CODE       TO PRT-HCPPS.                      03130000
039300     MOVE AREA-WAGE-INDEX      TO PRT-AREA-WAGE-INDEX.            03140000
039400     MOVE NUR-INDEX            TO PRT-NUR-INDEX.                  03150000
039500     MOVE THR-INDEX            TO PRT-THR-INDEX.                  03160000
039600                                                                  03170000
039700     MOVE IP-RATE              TO PRT-IP-RATE.                    03180000
039800     MOVE GS-RATE              TO PRT-GS-RATE.                    03190000
039900     MOVE TH-RATE              TO PRT-TH-RATE.                    03200000
040000     MOVE REHAB-RATE           TO PRT-RE-RATE.                    03210000
040100                                                                  03220000
040200     MOVE NURSING-COMPONENT    TO PRT-NURS-COMP.                  03230000
040300     MOVE THERAPY-COMPONENT    TO PRT-THER-COMP.                  03240000
040400     MOVE NCM-THR-COMPONENT    TO PRT-NCM-THR-COMP.               03250000
040500     MOVE NCM-COMPONENT        TO PRT-NCM-COMP.                   03260000
040600                                                                  03270000
040700     MOVE SNF-FACILITY-RATE    TO PRT-FAC-PAY-RATE.               03280000
040800     MOVE SNF-PAYMENT-RATE     TO PRT-PAYMENT-RATE.               03290000
040900                                                                  03300000
041000     MOVE SNF-RTC              TO PRT-SNF-RTC.                    03310000
041100                                                                  03320000
041200     WRITE PRTFILE-LINE        FROM SNF-DETAIL-LINE               03330000
041300                                    AFTER ADVANCING 1.            03340000
041400                                                                  03350000
041400     ADD 1                     TO PRTFILE-CTR.                    03351000
041700                                                                  03352000
041500     IF PRT-STAT1 > 0                                             03360000
041500        DISPLAY ' BAD1 WRITE ON PRTFILE FILE'.                    03361000
041700                                                                  03362000
041600     ADD 1                     TO LINE-CTR.                       03370000
041700                                                                  03380000
041800     WRITE OUT-REC             FROM SNF-WORK.                     03390000
041900                                                                  03400000
042000     IF UT2-STAT1 > 0                                             03410000
042000        DISPLAY ' BAD2 WRITE ON OUTFILE  FILE'.                   03411000
041900                                                                  03412000
042100     ADD 1                     TO OUTFILE-CTR.                    03420000
042200                                                                  03430000
042300 1100-EXIT.  EXIT.                                                03440000
042400                                                                  03450000
042500 1200-SNF-HEADINGS.                                               03460000
042600                                                                  03470000
042600     WRITE PRTFILE-LINE        FROM SNF-HEAD1                     03471000
042700                                    AFTER ADVANCING PAGE.         03480000
042700                                                                  03481000
042800     IF PRT-STAT1 > 0                                             03490000
042800        DISPLAY ' BAD3 WRITE ON PRTFILE FILE'.                    03490100
042800                                                                  03491000
042900     WRITE PRTFILE-LINE        FROM SNF-HEAD2                     03500000
043000                                    AFTER ADVANCING 1.            03510000
042700                                                                  03511000
043100     IF PRT-STAT1 > 0                                             03520000
043100        DISPLAY ' BAD4 WRITE ON PRTFILE FILE'.                    03521000
042800                                                                  03522000
043200     WRITE PRTFILE-LINE        FROM SNF-HEAD3                     03530000
043300                                    AFTER ADVANCING 2.            03540000
042700                                                                  03541000
043400     IF PRT-STAT1 > 0                                             03550000
043400        DISPLAY ' BAD5 WRITE ON PRTFILE FILE'.                    03551000
043400                                                                  03552000
043500     WRITE PRTFILE-LINE        FROM SNF-HEAD4                     03560000
043600                                    AFTER ADVANCING 1.            03570000
042700                                                                  03571000
043700     IF PRT-STAT1 > 0                                             03580000
043700        DISPLAY ' BAD6 WRITE ON PRTFILE FILE'.                    03581000
042700                                                                  03582000
043800     MOVE ALL '  -'            TO PRTFILE-LINE.                   03590000
042700                                                                  03591000
043900     WRITE PRTFILE-LINE        AFTER ADVANCING 1.                 03600000
042700                                                                  03601000
044000     IF PRT-STAT1 > 0                                             03610000
044000        DISPLAY ' BAD7 WRITE ON PRTFILE FILE'.                    03611000
042700                                                                  03612000
044100     MOVE 5                    TO LINE-CTR.                       03620000
044200                                                                  03630000
044300 1200-EXIT.  EXIT.                                                03640000
044400                                                                  03650000
044500 1300-LOAD-MSAFILE.                                               03660000
044600                                                                  03670000
044600     OPEN INPUT MSAFILE.                                          03671000
044700     MOVE 0                    TO EOF-MSA.                        03680000
044800     SET MU3                   TO EOF-MSA.                        03690000
044900                                                                  03700000
045000     PERFORM 1400-READ-MSAFILE                                    03710000
045000        THRU 1400-EXIT                                            03711000
045100             UNTIL EOF-MSA = 1.                                   03720000
045200                                                                  03730000
045300     CLOSE MSAFILE.                                               03740000
045400                                                                  03750000
045500 1300-EXIT.  EXIT.                                                03760000
045600                                                                  03770000
045700 1400-READ-MSAFILE.                                               03780000
045800                                                                  03790000
045800     READ MSAFILE                                                 03791000
045900          AT END                                                  03800000
045900             MOVE 1            TO EOF-MSA.                        03801000
046000                                                                  03810000
046100     IF EOF-MSA = 0                                               03820000
046200        SET MU3                UP BY 1                            03830000
046300        MOVE MSA-CODE          TO MSA-TB-MSA     (MU3)            03840000
046400        MOVE MSA-EFFDATE       TO MSA-TB-EFFDATE (MU3)            03850000
046500        MOVE MSA-WAGEIND       TO MSA-TB-WAGEIND (MU3).           03860000
046600                                                                  03870000
046600 1400-EXIT.  EXIT.                                                03871000
046700                                                                  03880000
046800 1500-LOAD-CBSAFILE.                                              03890000
046900                                                                  03900000
046900     OPEN INPUT CBSAFILE.                                         03901000
046900                                                                  03902000
047000     MOVE 0                    TO EOF-CBSA.                       03910000
047100     SET MA3                   TO EOF-CBSA.                       03920000
047200                                                                  03930000
047300     PERFORM 1600-READ-CBSAFILE                                   03940000
047300        THRU 1600-EXIT                                            03941000
047400             UNTIL EOF-CBSA = 1.                                  03950000
047500                                                                  03960000
047600     CLOSE CBSAFILE.                                              03970000
047700                                                                  03980000
047800 1500-EXIT.  EXIT.                                                03990000
047900                                                                  04000000
048000 1600-READ-CBSAFILE.                                              04010000
047900                                                                  04011000
048100     READ CBSAFILE                                                04020000
048200          AT END                                                  04030000
048200             MOVE 1            TO EOF-CBSA.                       04031000
048300                                                                  04040000
048400     IF EOF-CBSA = 0                                              04050000
048500        SET MA3                UP BY 1                            04060000
048600            MOVE F-CBSA-CODE   TO T-CBSA-CODE    (MA3)            04070000
048700            MOVE F-CBSA-EFFDATE                                   04080000
048700                               TO T-CBSA-EFFDATE (MA3)            04081000
048800            MOVE F-CBSA-WAGEIND                                   04090000
048800                               TO T-CBSA-WAGEIND (MA3).           04091000
048900 1600-EXIT.  EXIT.                                                04100000
049000                                                                  04110000
049100*****        LAST STATEMENT               *************           04120000
