source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRHBRV.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 9.6 KB
Line 
1IBCRHBRV ;ALB/ARH - RATES: UPLOAD (RC) VERSION FUNCTIONS ; 14-FEB-01
2 ;;2.0;INTEGRATED BILLING;**148,169,245,270,285,298,325,334,355,360,365**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; RC functions related to Version, most have to be updated when a new version is to be exported
6 ;
7SELVERS() ; get version to upload from user
8 N DIR,DIRUT,DTOUT,DUOUT,X,Y,IB,IBV,IBVP,IBX
9 S IBV="1.0^1.1^1.2^1.4^2.0^2.1^2.3^2.4^2.5^2.6^2.7^2.8^2.9" ; List of valid version numbers
10 S IBX=0
11 W !!,"Select the version of Reasonable Charges to upload.",!
12 S DIR("?")="Enter a code from the list corresponding to the version of Reasonable Charges to upload. There was no version 1.3 nor 2.2 of Reasonable Charges."
13 S DIR(0)="SO^"
14 F IB=1:1:$L(IBV,U) S IBVP=$P(IBV,U,IB),DIR(0)=DIR(0)_+IBVP_":Reasonable Charges version "_IBVP_";"
15 D ^DIR K DIR S:$L(Y)=1 Y=Y_".0" S IBX=+$S(IBV[Y:Y,1:0)
16 Q IBX
17 ;
18VERSION() ; return currently loaded version of RC files (1, 1.1, ...)
19 N IBX S IBX=$G(^XTMP("IBCR RC SITE","VERSION"))
20 Q IBX
21 ;
22VERSDT(VERS) ; return Effective Date of a version of RC files, either version passed in or currently loaded version
23 N IBX S:'$G(VERS) VERS=$$VERSION
24 S IBX=$S(VERS=1:2990901,VERS=1.1:3001102,VERS=1.2:3010508,VERS=1.4:3030429,VERS=2:3031219,VERS=2.1:3040415,VERS=2.3:3050101,VERS=2.4:3050411,VERS=2.5:3051001,VERS=2.6:3060101,VERS=2.7:3060825,VERS=2.8:3061001,VERS=2.9:3070101,1:"")
25 Q IBX
26 ;
27VERSEDT(VERS) ; return Inactive Date of a version of RC files, either version passed in or currently loaded version
28 N IBX S:'$G(VERS) VERS=$$VERSION
29 S IBX=$S(VERS=1:3001101,VERS=1.1:3010507,VERS=1.2:3030428,VERS=1.4:3031218,VERS=2:3040414,VERS=2.1:3041231,VERS=2.3:3050410,VERS=2.4:3050930,VERS=2.5:3051231,VERS=2.6:3060824,VERS=2.7:3060930,VERS=2.8:3061231,1:"")
30 Q IBX
31 ;
32VERSALL() ; returns all RC versions and corresponding effective date
33 N IBX S IBX="1;2990901^1.1;3001102^1.2;3010508^1.4;3030429^2;3031219^2.1;3040415^2.3;3050101^2.4;3050411^2.5;3051001^2.6;3060101^2.7;3060825^2.8;3061001^2.9;3070101"
34 Q IBX
35 ;
36VERSEND() ; returns all RC versions and corresponding inactive dates
37 N IBX S IBX="1;3001101^1.1;3010507^1.2;3030428^1.4;3031218^2;3040414^2.1;3041231^2.3;3050410^2.4;3050930^2.5;3051231^2.6;3060824^2.7;3060930^2.8;3061231"
38 Q IBX
39 ;
40 ;
41VERSITE(SITE) ; returns the list of versions loaded for a particular site
42 ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded
43 ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does
44 N IBCS,IBXRF,IBITM,IBVERS,IBCSFN,IBI,IBV,IBX,IBY S IBX=""
45 S IBVERS=$$VERSALL,IBITM=99201
46 ;
47 I $G(SITE)'="" S IBCS="RC-PHYSICIAN" F S IBCS=$O(^IBE(363.1,"B",IBCS)) Q:IBCS'["RC-PHYSICIAN" D
48 . S IBV=$L(IBCS," ") I $P(IBCS," ",IBV)'=SITE Q
49 . S IBCSFN=$O(^IBE(363.1,"B",IBCS,0)) Q:'IBCSFN S IBXRF="AIVDTS"_IBCSFN
50 . F IBI=1:1 S IBV=$P(IBVERS,U,IBI) Q:'IBV I $O(^IBA(363.2,IBXRF,IBITM,-$P(IBV,";",2),0)) S IBY(+IBV)=""
51 S IBV="" F S IBV=$O(IBY(IBV)) Q:'IBV S IBX=IBX_IBV_","
52 ;
53 I $E(IBX,$L(IBX))="," S IBX=$E(IBX,1,$L(IBX)-1)
54 Q IBX
55 ;
56MSGSITE(SITE) ; display a message indicating which versions are loaded for a site
57 N IBVERS Q:'$G(SITE)
58 S IBVERS=$$VERSITE(SITE)
59 I 'IBVERS W !!,?12,"There appear to be no RC charges already loaded for "_SITE_"."
60 I +IBVERS W !!,?12,"RC versions "_IBVERS_" appear to be already loaded for "_SITE_"."
61 Q
62 ;
63MSGVERS(SITE) ; check if versions are being loaded in the correct order, should be loaded in date order
64 ; displays messages to the user:
65 ; - if loading a version that has already been loaded for the site
66 ; - if loading a version when any future versions have already been loaded for the site
67 ; - if loading a version when the last version has not yet been loaded for the site
68 ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded
69 ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does
70 N IBVERS,IBVDTC,IBVERSIN,IBVERSO Q:'$G(SITE)
71 ;
72 S IBVERS=$$VERSION Q:'IBVERS S IBVDTC=$$VERSDT,IBVERSIN=","_$$VERSITE(SITE)_","
73 ;
74 ; check if loading a version that has already been loaded
75 I IBVERSIN[(","_IBVERS_",") D
76 . W !!,?5,"*** It appears version RC v",IBVERS," has already been loaded for this site ***"
77 ;
78 ; check if loading a version when any future versions have already been loaded
79 F IBVERSO=1,1.1,1.2,1.4,2,2.1,2.3,2.4,2.5,2.6,2.7,2.8,2.9 I IBVERSO>IBVERS D
80 . I IBVERSIN[(","_IBVERSO_",") D
81 .. W !!,?5,">>> Currently trying to load RC v"_IBVERS_" but RC v"_IBVERSO_" appears to be already",!,?9,"loaded for this site. The versions should be loaded in date order."
82 ;
83 ; check if loading a version when the last version has not yet been loaded
84 F IBVERSO=2.9,2.8,2.7,2.6,2.5,2.4,2.3,2.1,2,1.4,1.2,1.1,1 I IBVERS>IBVERSO D Q
85 . I IBVERSIN'[(","_IBVERSO_",") D
86 .. W !!,?5,"*** Currently trying to load RC v"_IBVERS_" but RC v"_IBVERSO_" does not appear to be",!,?9,"loaded for this site. The versions should be loaded in date order."
87 .. W !!,?5,">>> Continue only if there will never be a need to bill events before ",!,?9,$$FMTE^XLFDT(IBVDTC,2)," for this site. If RC v"_IBVERSO_" will be needed for this site then",!,?9,"load it first."
88 ;
89 Q
90 ;
91FILES(IBFILES,VERS) ; source Host file name, description, and routine label that parses the file
92 ; the subscript used for the file in XTMP is 'IBCR RC '_X w/ X=the routine label that parses the file
93 ;
94 I $G(VERS)=1.1 G FBREAL
95 I $G(VERS)=1.2 G FCREAL
96 I $G(VERS)=1.4 G FDREAL
97 I $G(VERS)=2 G FEREAL
98 I $G(VERS)=2.1 G FFREAL
99 I $G(VERS)=2.3 G FGREAL
100 I $G(VERS)=2.4 G FHREAL
101 I $G(VERS)=2.5 G FIREAL^IBCRHBV1
102 I $G(VERS)=2.6 G FJREAL^IBCRHBV1
103 I $G(VERS)=2.7 G FKREAL^IBCRHBV1
104 I $G(VERS)=2.8 G FLREAL^IBCRHBV1
105 I $G(VERS)=2.9 G FMREAL^IBCRHBV1
106 ;
107FREAL S IBFILES("IBRCVA.TXT")="RC v1 Inpatient Facility Charges^A"
108 S IBFILES("IBRCVB.TXT")="RC v1 Inpatient Facility Area Factors^B"
109 S IBFILES("IBRCVC.TXT")="RC v1 Outpatient Facility Charges^C"
110 S IBFILES("IBRCVD.TXT")="RC v1 Outpatient Facility Area Factors^D"
111 S IBFILES("IBRCVE.TXT")="RC v1 Physician Charges E^E"
112 S IBFILES("IBRCVF.TXT")="RC v1 Physician Charges F^F"
113 S IBFILES("IBRCVG.TXT")="RC v1 Physician Charges G^G"
114 S IBFILES("IBRCVH.TXT")="RC v1 Physician Area Factors^H"
115 S IBFILES("IBRCVI.TXT")="RC v1 Physician Unit Area Factors^I"
116 Q
117 ;
118FBREAL S IBFILES("IBRC0011A.TXT")="RC v1.1 Inpatient Facility Charges^A"
119 S IBFILES("IBRC0011B.TXT")="RC v1.1 Inpatient Facility Area Factors^B"
120 S IBFILES("IBRC0011C.TXT")="RC v1.1 Outpatient Facility Charges^C"
121 S IBFILES("IBRC0011D.TXT")="RC v1.1 Outpatient Facility Area Factors^D"
122 S IBFILES("IBRC0011E.TXT")="RC v1.1 Physician Charges E^E"
123 S IBFILES("IBRC0011F.TXT")="RC v1.1 Physician Charges F^F"
124 S IBFILES("IBRC0011G.TXT")="RC v1.1 Physician Charges G^G"
125 S IBFILES("IBRC0011H.TXT")="RC v1.1 Physician Area Factors^H"
126 S IBFILES("IBRC0011I.TXT")="RC v1.1 Physician Unit Area Factors^I"
127 Q
128 ;
129FCREAL S IBFILES("IBRC0105A.TXT")="RC v1.2 Inpatient Facility Charges^A"
130 S IBFILES("IBRC0105B.TXT")="RC v1.2 Inpatient Facility Area Factors^B"
131 S IBFILES("IBRC0105C.TXT")="RC v1.2 Outpatient Facility Charges^C"
132 S IBFILES("IBRC0105D.TXT")="RC v1.2 Outpatient Facility Area Factors^D"
133 S IBFILES("IBRC0105E.TXT")="RC v1.2 Physician Charges E^E"
134 S IBFILES("IBRC0105F.TXT")="RC v1.2 Physician Charges F^F"
135 S IBFILES("IBRC0105G.TXT")="RC v1.2 Physician Charges G^G"
136 S IBFILES("IBRC0105H.TXT")="RC v1.2 Physician Area Factors^H"
137 S IBFILES("IBRC0105I.TXT")="RC v1.2 Physician Unit Area Factors^I"
138 Q
139 ;
140FDREAL S IBFILES("IBRC0304A.TXT")="RC v1.4 Inpatient Facility Charges^A"
141 S IBFILES("IBRC0304B.TXT")="RC v1.4 Inpatient Facility Area Factors^B"
142 S IBFILES("IBRC0304C.TXT")="RC v1.4 Outpatient Facility Charges^C"
143 S IBFILES("IBRC0304D.TXT")="RC v1.4 Outpatient Facility Area Factors^D"
144 S IBFILES("IBRC0304E.TXT")="RC v1.4 Physician Charges E^E"
145 S IBFILES("IBRC0304F.TXT")="RC v1.4 Physician Charges F^F"
146 S IBFILES("IBRC0304G.TXT")="RC v1.4 Physician Charges G^G"
147 S IBFILES("IBRC0304H.TXT")="RC v1.4 Physician Area Factors^H"
148 S IBFILES("IBRC0304I.TXT")="RC v1.4 Physician Unit Area Factors^I"
149 Q
150 ;
151FEREAL S IBFILES("IBRC0312A.TXT")="RC v2.0 Inpatient Facility Charges^A^10"
152 S IBFILES("IBRC0312B.TXT")="RC v2.0 Outpatient Facility Charges^B^14"
153 S IBFILES("IBRC0312C.TXT")="RC v2.0 Professional Charges^C^23"
154 S IBFILES("IBRC0312D.TXT")="RC v2.0 Service Category Codes^D^4"
155 S IBFILES("IBRC0312E.TXT")="RC v2.0 Area Factors^E^41"
156 S IBFILES("IBRC0312F.TXT")="RC v2.0 VA Sites and Zip Codes^F^4"
157 Q
158 ;
159FFREAL S IBFILES("IBRC0404A.TXT")="RC v2.1 Inpatient Facility Charges^A^10"
160 S IBFILES("IBRC0404B.TXT")="RC v2.1 Outpatient Facility Charges^B^14"
161 S IBFILES("IBRC0404C.TXT")="RC v2.1 Professional Charges^C^23"
162 S IBFILES("IBRC0404D.TXT")="RC v2.1 Service Category Codes^D^4"
163 S IBFILES("IBRC0404E.TXT")="RC v2.1 Area Factors^E^41"
164 S IBFILES("IBRC0404F.TXT")="RC v2.1 VA Sites and Zip Codes^F^4"
165 Q
166 ;
167FGREAL S IBFILES("IBRC0501A.TXT")="RC v2.3 Inpatient Facility Charges^A^10"
168 S IBFILES("IBRC0501B.TXT")="RC v2.3 Outpatient Facility Charges^B^14"
169 S IBFILES("IBRC0501C.TXT")="RC v2.3 Professional Charges^C^23"
170 S IBFILES("IBRC0501D.TXT")="RC v2.3 Service Category Codes^D^4"
171 S IBFILES("IBRC0501E.TXT")="RC v2.3 Area Factors^E^41"
172 S IBFILES("IBRC0501F.TXT")="RC v2.3 VA Sites and Zip Codes^F^4"
173 Q
174 ;
175FHREAL S IBFILES("IBRC0504A.TXT")="RC v2.4 Inpatient Facility Charges^A^10"
176 S IBFILES("IBRC0504B.TXT")="RC v2.4 Outpatient Facility Charges^B^14"
177 S IBFILES("IBRC0504C.TXT")="RC v2.4 Professional Charges^C^23"
178 S IBFILES("IBRC0504D.TXT")="RC v2.4 Service Category Codes^D^4"
179 S IBFILES("IBRC0504E.TXT")="RC v2.4 Area Factors^E^41"
180 S IBFILES("IBRC0504F.TXT")="RC v2.4 VA Sites and Zip Codes^F^4"
181 Q
Note: See TracBrowser for help on using the repository browser.