source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASAILK.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.6 KB
RevLine 
[613]1EASAILK ;ALB/BRM - ADDRESS INDEXING APIS ; 11/13/02 4:28pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;Mar 15, 2001
3 ;
4 Q
5 ;
6GETFIPS(DFN,INCYR,AIGMT) ;get the appropriate FIPS code and address for GMT
7 ;
8 ;INPUT:
9 ; DFN - internal entry number for the #2 file
10 ; INCYR - (optional) income year for which the GMT Address will
11 ; be returned. If this value is null, then this function
12 ; will not check for an existing GMT address (i.e. new
13 ; MT, conversion, etc.) but will follow all other
14 ; applicable rules. INCYR is in internal FILEMAN format
15 ;
16 ;OUTPUT:
17 ; The AIGMT array will be returned with the FIPS code and
18 ; address data used to compute the FIPS code. The array will
19 ; be structured as follows:
20 ; AIGMT("INCYR") - Income Year used to compute GMT Threshold
21 ; AIGMT("FIPS") - FIPS County Code to compute GMT Threshold
22 ; AIGMT("MSA") - MSA code associated with this zip code
23 ; AIGMT("ST1") - Street Address 1
24 ; AIGMT("ST2") - Street Address 2
25 ; AIGMT("CITY") - City
26 ; AIGMT("STATE") - State
27 ; AIGMT("ZIP") - Zip Code
28 ; AIGMT("COUNTY") - County
29 ; AIGMT("GMTIEN") - ien for the GMT Thresholds file
30 ; AIGMT("SOURCE") - this field will contain the source of the
31 ; address.
32 ; AIGMT("SITE") - this field will hold the site number related
33 ; to the source if AIGMT("SOURCE")="MT"
34 ;
35 ; If AIGMT("SOURCE")="PATIENT" then the address used for obtaining
36 ; the County FIPS code information was based on the Patient's
37 ; address in the #2 file.
38 ;
39 ; If AIGMT("SOURCE")="MT" then the address used to obtain the
40 ; county FIPS code information was based on the Primary Means
41 ; Test location.
42 ;
43 N X
44 ; initialize AIGMT array values
45 F X="FIPS","ST1","ST2","ST3","CITY","STATE","ZIP","COUNTY","SOURCE","SITE","INCYR","MSA","GMTIEN" S AIGMT(X)=""
46 Q:'DFN
47 S:'$G(INCYR) INCYR=($E($$DT^XLFDT,1,3)-1)
48 S INCYR=$E(INCYR,1,3)_"0000"
49 ; look for patient address in #2
50 D PATIENT(DFN,.AIGMT,.INCYR) Q:AIGMT("SOURCE")'=""
51 ; look for Primary Means Test location address
52 D PRIMMT(DFN,.AIGMT,.INCYR)
53 Q
54 ;
55PATIENT(DFN,AIGMT,INCYR) ;find patient's address in the Patient (#2) file
56 Q:'$G(DFN)
57 N ZIPDAT,VAPA,MSA,GMTIEN
58 ; get patient address
59 S VAPA("P")=1 D ADD^VADPT
60 ; quit if no zip code is present on the Patient record
61 Q:$G(VAPA(6))=""
62 ; determine postal code validity
63 D POSTAL^XIPUTIL(VAPA(6),.ZIPDAT)
64 ; quit if FIPS cannot be determined for this zip code
65 Q:$G(ZIPDAT("ERROR"))]""
66 ; determine MSA code for this zip code
67 S MSA=$$MSACHK(VAPA(6))
68 ; determine if GMT Threshold exists for this zip code
69 S GMTIEN=$$GMTCHK(.INCYR,$G(ZIPDAT("FIPS CODE")),.MSA)
70 Q:'GMTIEN
71 ; populate array
72 S AIGMT("INCYR")=$G(INCYR)
73 S AIGMT("FIPS")=$G(ZIPDAT("FIPS CODE"))
74 S AIGMT("ST1")=$G(VAPA(1))
75 S AIGMT("ST2")=$G(VAPA(2))
76 S AIGMT("ST3")=$G(VAPA(3))
77 S AIGMT("CITY")=$G(VAPA(4))
78 S AIGMT("STATE")=$G(VAPA(5)) ;ien^state name
79 S AIGMT("ZIP")=$G(VAPA(6))
80 S AIGMT("COUNTY")=$G(ZIPDAT("COUNTY"))
81 S AIGMT("MSA")=MSA
82 S AIGMT("GMTIEN")=GMTIEN
83 S AIGMT("SOURCE")="PATIENT"
84 Q
85 ;
86PRIMMT(DFN,AIGMT,INCYR) ;find Primary MT location address
87 N MTIEN,ZIPDAT,MTDATA,ERR,MTSRC,STATION
88 S MTIEN=+$$LST^DGMTU(DFN,$$DT^XLFDT)
89 Q:'MTIEN
90 D GETS^DIQ(408.31,MTIEN_",",".23;2.05","I","MTDATA","ERR")
91 Q:$D(ERR)
92 S MTSRC=$G(MTDATA(408.31,MTIEN_",",.23,"I"))
93 Q:"^2^3^"[("^"_MTSRC_"^") ;DCD is the source of this income test
94 S STATION=$G(MTDATA(408.31,MTIEN_",",2.05,"I"))
95 Q:STATION']""
96 ; get primary means test location address and populate array
97 D STATADDR(STATION,.AIGMT,.INCYR)
98 Q
99 ;
100STATADDR(STATION,AIGMT,INCYR) ;get the VAMC station address
101 Q:$G(STATION)']""
102 N ZIP,GMTIEN,FIPS,MSA,STFIPS,IEN4,IENS,ZIPDAT,IEN5,SITEADDR
103 S IEN4=$$IEN^XUAF4(STATION) Q:'IEN4
104 S IENS=IEN4_","
105 D GETS^DIQ(4,IENS,"1.01:1.04","","SITEADDR")
106 Q:$G(SITEADDR(4,IENS,1.04))=""
107 ; determine postal code validity
108 D POSTAL^XIPUTIL(SITEADDR(4,IENS,1.04),.ZIPDAT)
109 ; quit if FIPS cannot be determined for this zip code
110 Q:$G(ZIPDAT("ERROR"))]""
111 ; determine MSA code for this zip code
112 S MSA=$$MSACHK(SITEADDR(4,IENS,1.04))
113 ; determine if GMT Threshold exists for this zip code
114 S GMTIEN=$$GMTCHK(.INCYR,$G(ZIPDAT("FIPS CODE")),.MSA)
115 Q:'GMTIEN
116 ; populate array
117 S AIGMT("INCYR")=$G(INCYR)
118 S AIGMT("FIPS")=$G(ZIPDAT("FIPS CODE"))
119 S AIGMT("ST1")=$G(SITEADDR(4,IENS,1.01))
120 S AIGMT("ST2")=$G(SITEADDR(4,IENS,1.02))
121 S AIGMT("ST3")=""
122 S AIGMT("CITY")=$G(SITEADDR(4,IENS,1.03))
123 S AIGMT("STATE")=$G(ZIPDAT("STATE POINTER"))_"^"_$G(ZIPDAT("STATE"))
124 S AIGMT("ZIP")=$G(SITEADDR(4,IENS,1.04))
125 S AIGMT("COUNTY")=$G(ZIPDAT("COUNTY"))
126 S AIGMT("SITE")=STATION
127 S AIGMT("MSA")=MSA
128 S AIGMT("GMTIEN")=GMTIEN
129 S AIGMT("SOURCE")="MT"
130 Q
131MSACHK(ZIP) ; check and return MSA code if it exists for a Zip Code
132 Q:$G(ZIP)']"" ""
133 Q:'$D(^EAS(712.6,"B",$E(ZIP,1,5))) ""
134 Q $O(^EAS(712.6,"AMSA",$E(ZIP,1,5),""))
135 ;
136GMTCHK(YEAR,FIPS,MSA) ;check for valid GMT Threshold
137 ;
138 ;INPUT:
139 ; YEAR - Income Yr (FM internal) on which to base the GMT Threshold
140 ; If YEAR="" then the current income year is used
141 ; FIPS - 5-digit FIPS County Code for this record
142 ; MSA (pass by reference) - MSA to utilize for GMT determination
143 ;
144 ;OUTPUT:
145 ; MSA (pass by reference) - updated MSA code if applicable
146 ; return variable: 0^error if no GMT Threshold can be determined or
147 ; ien to the GMT Threshold file
148 ;
149 Q:$G(FIPS)']"" "0^FIPS INPUT PARAMETER MISSING"
150 S:'$G(MSA) MSA=$G(MSA)
151 S:'$G(YEAR) YEAR=($E($$DT^XLFDT,1,3)-1)_"0000"
152 Q:'MSA $$MSAZERO(YEAR,FIPS,.MSA)
153 Q:'$D(^EAS(712.5,"AMSA",YEAR)) "0^INVALID YEAR"
154 Q:'$D(^EAS(712.5,"AMSA",YEAR,FIPS)) "0^INVALID FIPS"
155 Q:$D(^EAS(712.5,"AMSA",YEAR,FIPS,MSA)) $O(^EAS(712.5,"AMSA",YEAR,FIPS,MSA,""))
156 S GMTIEN=$$MSAZERO(YEAR,FIPS,.MSA)
157 Q:GMTIEN GMTIEN
158 Q "0^GMT THRESHOLD CANNOT BE DETERMINED"
159 ;
160MSAZERO(YEAR,FIPS,MSA) ;MSA for this zip code appears to be zero. Can we
161 ; determine a GMT Threshold?
162 ;
163 ;INPUT:
164 ; YEAR - Income Year on which to base the GMT Threshold
165 ; FIPS - 5-digit FIPS County Code for this record
166 ; MSA (pass by reference) - MSA to utilize for GMT determination
167 ;
168 ;OUTPUT:
169 ; MSA (pass by reference) - updated MSA code if applicable
170 ; return variable: 0 if no GMT Threshold can be determined or
171 ; ien to the GMT Threshold file
172 ;
173 N TMPMSA,TMPGMT
174 S GMTIEN="0^GMT THRESHOLD CANNOT BE DETERMINED",(TMPMSA,TMPGMT)=""
175 Q:'$G(YEAR)!($G(FIPS)="") GMTIEN
176 ;
177 ; no MSA file entry - get GMT ien if possible
178 I '$D(^EAS(712.5,"AMSA",YEAR,FIPS)) D Q GMTIEN
179 .I '$D(^EAS(712.5,"GMT",YEAR,FIPS)) Q
180 .S GMTIEN=$O(^EAS(712.5,"GMT",YEAR,FIPS,""))
181 ;
182 ; Is there an entry for this MSA?
183 I MSA'="",$D(^EAS(712.5,"AMSA",YEAR,FIPS,MSA)) D Q GMTIEN
184 .S GMTIEN=$O(^EAS(712.5,"AMSA",YEAR,FIPS,MSA,""))
185 ;
186 ; Is there only 1 MSA for this FIPS code?
187 S TMPMSA=$O(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA))
188 Q:$O(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA))'="" GMTIEN
189 S GMTIEN=$O(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA,""))
190 S MSA=TMPMSA
191 Q GMTIEN
192 ;
193 ;
194FIPS(ZIP,INCYR) ; look-up the 5-digit FIPS County code for the entered zip
195 ;
196 ;INPUT:
197 ; ZIP - zip code
198 ; INCYR - (optional) income year to use to obtain the GMT Threshold
199 ; if the income year is not defined, then the current income
200 ; year is used. INCYR is in Fileman internal date format
201 ;
202 ;OUTPUT:
203 ; 5-digit FIPS code ^ MSA value ^ GMT Threshold ien ^ error message
204 ;
205 N MSA,GMTIEN,FIPS,ZIPDAT
206 Q:$G(ZIP)="" "0^0^0^ZIP CODE NOT ENTERED"
207 I $G(INCYR),INCYR?4N Q "0^0^0^INCOME YEAR MUST BE INTERNAL DATE"
208 D POSTAL^XIPUTIL(ZIP,.ZIPDAT)
209 Q:$G(ZIPDAT("ERROR"))]"" "0^0^0^ZIP CODE NOT IN POSTAL CODE FILE"
210 S FIPS=$G(ZIPDAT("FIPS CODE")) S:FIPS']"" FIPS=0
211 S MSA=$$MSACHK(ZIP)
212 S GMTIEN=$$GMTCHK(.INCYR,FIPS,.MSA)
213 Q FIPS_"^"_MSA_"^"_GMTIEN
214 ;
Note: See TracBrowser for help on using the repository browser.