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