- EASAILK ;ALB/BRM - ADDRESS INDEXING APIS ; 11/13/02 4:28pm
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;Mar 15, 2001
- ;
- Q
- ;
- GETFIPS(DFN,INCYR,AIGMT) ;get the appropriate FIPS code and address for GMT
- ;
- ;INPUT:
- ; DFN - internal entry number for the #2 file
- ; INCYR - (optional) income year for which the GMT Address will
- ; be returned. If this value is null, then this function
- ; will not check for an existing GMT address (i.e. new
- ; MT, conversion, etc.) but will follow all other
- ; applicable rules. INCYR is in internal FILEMAN format
- ;
- ;OUTPUT:
- ; The AIGMT array will be returned with the FIPS code and
- ; address data used to compute the FIPS code. The array will
- ; be structured as follows:
- ; AIGMT("INCYR") - Income Year used to compute GMT Threshold
- ; AIGMT("FIPS") - FIPS County Code to compute GMT Threshold
- ; AIGMT("MSA") - MSA code associated with this zip code
- ; AIGMT("ST1") - Street Address 1
- ; AIGMT("ST2") - Street Address 2
- ; AIGMT("CITY") - City
- ; AIGMT("STATE") - State
- ; AIGMT("ZIP") - Zip Code
- ; AIGMT("COUNTY") - County
- ; AIGMT("GMTIEN") - ien for the GMT Thresholds file
- ; AIGMT("SOURCE") - this field will contain the source of the
- ; address.
- ; AIGMT("SITE") - this field will hold the site number related
- ; to the source if AIGMT("SOURCE")="MT"
- ;
- ; If AIGMT("SOURCE")="PATIENT" then the address used for obtaining
- ; the County FIPS code information was based on the Patient's
- ; address in the #2 file.
- ;
- ; If AIGMT("SOURCE")="MT" then the address used to obtain the
- ; county FIPS code information was based on the Primary Means
- ; Test location.
- ;
- N X
- ; initialize AIGMT array values
- F X="FIPS","ST1","ST2","ST3","CITY","STATE","ZIP","COUNTY","SOURCE","SITE","INCYR","MSA","GMTIEN" S AIGMT(X)=""
- Q:'DFN
- S:'$G(INCYR) INCYR=($E($$DT^XLFDT,1,3)-1)
- S INCYR=$E(INCYR,1,3)_"0000"
- ; look for patient address in #2
- D PATIENT(DFN,.AIGMT,.INCYR) Q:AIGMT("SOURCE")'=""
- ; look for Primary Means Test location address
- D PRIMMT(DFN,.AIGMT,.INCYR)
- Q
- ;
- PATIENT(DFN,AIGMT,INCYR) ;find patient's address in the Patient (#2) file
- Q:'$G(DFN)
- N ZIPDAT,VAPA,MSA,GMTIEN
- ; get patient address
- S VAPA("P")=1 D ADD^VADPT
- ; quit if no zip code is present on the Patient record
- Q:$G(VAPA(6))=""
- ; determine postal code validity
- D POSTAL^XIPUTIL(VAPA(6),.ZIPDAT)
- ; quit if FIPS cannot be determined for this zip code
- Q:$G(ZIPDAT("ERROR"))]""
- ; determine MSA code for this zip code
- S MSA=$$MSACHK(VAPA(6))
- ; determine if GMT Threshold exists for this zip code
- S GMTIEN=$$GMTCHK(.INCYR,$G(ZIPDAT("FIPS CODE")),.MSA)
- Q:'GMTIEN
- ; populate array
- S AIGMT("INCYR")=$G(INCYR)
- S AIGMT("FIPS")=$G(ZIPDAT("FIPS CODE"))
- S AIGMT("ST1")=$G(VAPA(1))
- S AIGMT("ST2")=$G(VAPA(2))
- S AIGMT("ST3")=$G(VAPA(3))
- S AIGMT("CITY")=$G(VAPA(4))
- S AIGMT("STATE")=$G(VAPA(5)) ;ien^state name
- S AIGMT("ZIP")=$G(VAPA(6))
- S AIGMT("COUNTY")=$G(ZIPDAT("COUNTY"))
- S AIGMT("MSA")=MSA
- S AIGMT("GMTIEN")=GMTIEN
- S AIGMT("SOURCE")="PATIENT"
- Q
- ;
- PRIMMT(DFN,AIGMT,INCYR) ;find Primary MT location address
- N MTIEN,ZIPDAT,MTDATA,ERR,MTSRC,STATION
- S MTIEN=+$$LST^DGMTU(DFN,$$DT^XLFDT)
- Q:'MTIEN
- D GETS^DIQ(408.31,MTIEN_",",".23;2.05","I","MTDATA","ERR")
- Q:$D(ERR)
- S MTSRC=$G(MTDATA(408.31,MTIEN_",",.23,"I"))
- Q:"^2^3^"[("^"_MTSRC_"^") ;DCD is the source of this income test
- S STATION=$G(MTDATA(408.31,MTIEN_",",2.05,"I"))
- Q:STATION']""
- ; get primary means test location address and populate array
- D STATADDR(STATION,.AIGMT,.INCYR)
- Q
- ;
- STATADDR(STATION,AIGMT,INCYR) ;get the VAMC station address
- Q:$G(STATION)']""
- N ZIP,GMTIEN,FIPS,MSA,STFIPS,IEN4,IENS,ZIPDAT,IEN5,SITEADDR
- S IEN4=$$IEN^XUAF4(STATION) Q:'IEN4
- S IENS=IEN4_","
- D GETS^DIQ(4,IENS,"1.01:1.04","","SITEADDR")
- Q:$G(SITEADDR(4,IENS,1.04))=""
- ; determine postal code validity
- D POSTAL^XIPUTIL(SITEADDR(4,IENS,1.04),.ZIPDAT)
- ; quit if FIPS cannot be determined for this zip code
- Q:$G(ZIPDAT("ERROR"))]""
- ; determine MSA code for this zip code
- S MSA=$$MSACHK(SITEADDR(4,IENS,1.04))
- ; determine if GMT Threshold exists for this zip code
- S GMTIEN=$$GMTCHK(.INCYR,$G(ZIPDAT("FIPS CODE")),.MSA)
- Q:'GMTIEN
- ; populate array
- S AIGMT("INCYR")=$G(INCYR)
- S AIGMT("FIPS")=$G(ZIPDAT("FIPS CODE"))
- S AIGMT("ST1")=$G(SITEADDR(4,IENS,1.01))
- S AIGMT("ST2")=$G(SITEADDR(4,IENS,1.02))
- S AIGMT("ST3")=""
- S AIGMT("CITY")=$G(SITEADDR(4,IENS,1.03))
- S AIGMT("STATE")=$G(ZIPDAT("STATE POINTER"))_"^"_$G(ZIPDAT("STATE"))
- S AIGMT("ZIP")=$G(SITEADDR(4,IENS,1.04))
- S AIGMT("COUNTY")=$G(ZIPDAT("COUNTY"))
- S AIGMT("SITE")=STATION
- S AIGMT("MSA")=MSA
- S AIGMT("GMTIEN")=GMTIEN
- S AIGMT("SOURCE")="MT"
- Q
- MSACHK(ZIP) ; check and return MSA code if it exists for a Zip Code
- Q:$G(ZIP)']"" ""
- Q:'$D(^EAS(712.6,"B",$E(ZIP,1,5))) ""
- Q $O(^EAS(712.6,"AMSA",$E(ZIP,1,5),""))
- ;
- GMTCHK(YEAR,FIPS,MSA) ;check for valid GMT Threshold
- ;
- ;INPUT:
- ; YEAR - Income Yr (FM internal) on which to base the GMT Threshold
- ; If YEAR="" then the current income year is used
- ; FIPS - 5-digit FIPS County Code for this record
- ; MSA (pass by reference) - MSA to utilize for GMT determination
- ;
- ;OUTPUT:
- ; MSA (pass by reference) - updated MSA code if applicable
- ; return variable: 0^error if no GMT Threshold can be determined or
- ; ien to the GMT Threshold file
- ;
- Q:$G(FIPS)']"" "0^FIPS INPUT PARAMETER MISSING"
- S:'$G(MSA) MSA=$G(MSA)
- S:'$G(YEAR) YEAR=($E($$DT^XLFDT,1,3)-1)_"0000"
- Q:'MSA $$MSAZERO(YEAR,FIPS,.MSA)
- Q:'$D(^EAS(712.5,"AMSA",YEAR)) "0^INVALID YEAR"
- Q:'$D(^EAS(712.5,"AMSA",YEAR,FIPS)) "0^INVALID FIPS"
- Q:$D(^EAS(712.5,"AMSA",YEAR,FIPS,MSA)) $O(^EAS(712.5,"AMSA",YEAR,FIPS,MSA,""))
- S GMTIEN=$$MSAZERO(YEAR,FIPS,.MSA)
- Q:GMTIEN GMTIEN
- Q "0^GMT THRESHOLD CANNOT BE DETERMINED"
- ;
- MSAZERO(YEAR,FIPS,MSA) ;MSA for this zip code appears to be zero. Can we
- ; determine a GMT Threshold?
- ;
- ;INPUT:
- ; YEAR - Income Year on which to base the GMT Threshold
- ; FIPS - 5-digit FIPS County Code for this record
- ; MSA (pass by reference) - MSA to utilize for GMT determination
- ;
- ;OUTPUT:
- ; MSA (pass by reference) - updated MSA code if applicable
- ; return variable: 0 if no GMT Threshold can be determined or
- ; ien to the GMT Threshold file
- ;
- N TMPMSA,TMPGMT
- S GMTIEN="0^GMT THRESHOLD CANNOT BE DETERMINED",(TMPMSA,TMPGMT)=""
- Q:'$G(YEAR)!($G(FIPS)="") GMTIEN
- ;
- ; no MSA file entry - get GMT ien if possible
- I '$D(^EAS(712.5,"AMSA",YEAR,FIPS)) D Q GMTIEN
- .I '$D(^EAS(712.5,"GMT",YEAR,FIPS)) Q
- .S GMTIEN=$O(^EAS(712.5,"GMT",YEAR,FIPS,""))
- ;
- ; Is there an entry for this MSA?
- I MSA'="",$D(^EAS(712.5,"AMSA",YEAR,FIPS,MSA)) D Q GMTIEN
- .S GMTIEN=$O(^EAS(712.5,"AMSA",YEAR,FIPS,MSA,""))
- ;
- ; Is there only 1 MSA for this FIPS code?
- S TMPMSA=$O(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA))
- Q:$O(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA))'="" GMTIEN
- S GMTIEN=$O(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA,""))
- S MSA=TMPMSA
- Q GMTIEN
- ;
- ;
- FIPS(ZIP,INCYR) ; look-up the 5-digit FIPS County code for the entered zip
- ;
- ;INPUT:
- ; ZIP - zip code
- ; INCYR - (optional) income year to use to obtain the GMT Threshold
- ; if the income year is not defined, then the current income
- ; year is used. INCYR is in Fileman internal date format
- ;
- ;OUTPUT:
- ; 5-digit FIPS code ^ MSA value ^ GMT Threshold ien ^ error message
- ;
- N MSA,GMTIEN,FIPS,ZIPDAT
- Q:$G(ZIP)="" "0^0^0^ZIP CODE NOT ENTERED"
- I $G(INCYR),INCYR?4N Q "0^0^0^INCOME YEAR MUST BE INTERNAL DATE"
- D POSTAL^XIPUTIL(ZIP,.ZIPDAT)
- Q:$G(ZIPDAT("ERROR"))]"" "0^0^0^ZIP CODE NOT IN POSTAL CODE FILE"
- S FIPS=$G(ZIPDAT("FIPS CODE")) S:FIPS']"" FIPS=0
- S MSA=$$MSACHK(ZIP)
- S GMTIEN=$$GMTCHK(.INCYR,FIPS,.MSA)
- Q FIPS_"^"_MSA_"^"_GMTIEN
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASAILK 8029 printed Feb 18, 2025@23:20:03 Page 2
- EASAILK ;ALB/BRM - ADDRESS INDEXING APIS ; 11/13/02 4:28pm
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**13**;Mar 15, 2001
- +2 ;
- +3 QUIT
- +4 ;
- GETFIPS(DFN,INCYR,AIGMT) ;get the appropriate FIPS code and address for GMT
- +1 ;
- +2 ;INPUT:
- +3 ; DFN - internal entry number for the #2 file
- +4 ; INCYR - (optional) income year for which the GMT Address will
- +5 ; be returned. If this value is null, then this function
- +6 ; will not check for an existing GMT address (i.e. new
- +7 ; MT, conversion, etc.) but will follow all other
- +8 ; applicable rules. INCYR is in internal FILEMAN format
- +9 ;
- +10 ;OUTPUT:
- +11 ; The AIGMT array will be returned with the FIPS code and
- +12 ; address data used to compute the FIPS code. The array will
- +13 ; be structured as follows:
- +14 ; AIGMT("INCYR") - Income Year used to compute GMT Threshold
- +15 ; AIGMT("FIPS") - FIPS County Code to compute GMT Threshold
- +16 ; AIGMT("MSA") - MSA code associated with this zip code
- +17 ; AIGMT("ST1") - Street Address 1
- +18 ; AIGMT("ST2") - Street Address 2
- +19 ; AIGMT("CITY") - City
- +20 ; AIGMT("STATE") - State
- +21 ; AIGMT("ZIP") - Zip Code
- +22 ; AIGMT("COUNTY") - County
- +23 ; AIGMT("GMTIEN") - ien for the GMT Thresholds file
- +24 ; AIGMT("SOURCE") - this field will contain the source of the
- +25 ; address.
- +26 ; AIGMT("SITE") - this field will hold the site number related
- +27 ; to the source if AIGMT("SOURCE")="MT"
- +28 ;
- +29 ; If AIGMT("SOURCE")="PATIENT" then the address used for obtaining
- +30 ; the County FIPS code information was based on the Patient's
- +31 ; address in the #2 file.
- +32 ;
- +33 ; If AIGMT("SOURCE")="MT" then the address used to obtain the
- +34 ; county FIPS code information was based on the Primary Means
- +35 ; Test location.
- +36 ;
- +37 NEW X
- +38 ; initialize AIGMT array values
- +39 FOR X="FIPS","ST1","ST2","ST3","CITY","STATE","ZIP","COUNTY","SOURCE","SITE","INCYR","MSA","GMTIEN"
- SET AIGMT(X)=""
- +40 if 'DFN
- QUIT
- +41 if '$GET(INCYR)
- SET INCYR=($EXTRACT($$DT^XLFDT,1,3)-1)
- +42 SET INCYR=$EXTRACT(INCYR,1,3)_"0000"
- +43 ; look for patient address in #2
- +44 DO PATIENT(DFN,.AIGMT,.INCYR)
- if AIGMT("SOURCE")'=""
- QUIT
- +45 ; look for Primary Means Test location address
- +46 DO PRIMMT(DFN,.AIGMT,.INCYR)
- +47 QUIT
- +48 ;
- PATIENT(DFN,AIGMT,INCYR) ;find patient's address in the Patient (#2) file
- +1 if '$GET(DFN)
- QUIT
- +2 NEW ZIPDAT,VAPA,MSA,GMTIEN
- +3 ; get patient address
- +4 SET VAPA("P")=1
- DO ADD^VADPT
- +5 ; quit if no zip code is present on the Patient record
- +6 if $GET(VAPA(6))=""
- QUIT
- +7 ; determine postal code validity
- +8 DO POSTAL^XIPUTIL(VAPA(6),.ZIPDAT)
- +9 ; quit if FIPS cannot be determined for this zip code
- +10 if $GET(ZIPDAT("ERROR"))]""
- QUIT
- +11 ; determine MSA code for this zip code
- +12 SET MSA=$$MSACHK(VAPA(6))
- +13 ; determine if GMT Threshold exists for this zip code
- +14 SET GMTIEN=$$GMTCHK(.INCYR,$GET(ZIPDAT("FIPS CODE")),.MSA)
- +15 if 'GMTIEN
- QUIT
- +16 ; populate array
- +17 SET AIGMT("INCYR")=$GET(INCYR)
- +18 SET AIGMT("FIPS")=$GET(ZIPDAT("FIPS CODE"))
- +19 SET AIGMT("ST1")=$GET(VAPA(1))
- +20 SET AIGMT("ST2")=$GET(VAPA(2))
- +21 SET AIGMT("ST3")=$GET(VAPA(3))
- +22 SET AIGMT("CITY")=$GET(VAPA(4))
- +23 ;ien^state name
- SET AIGMT("STATE")=$GET(VAPA(5))
- +24 SET AIGMT("ZIP")=$GET(VAPA(6))
- +25 SET AIGMT("COUNTY")=$GET(ZIPDAT("COUNTY"))
- +26 SET AIGMT("MSA")=MSA
- +27 SET AIGMT("GMTIEN")=GMTIEN
- +28 SET AIGMT("SOURCE")="PATIENT"
- +29 QUIT
- +30 ;
- PRIMMT(DFN,AIGMT,INCYR) ;find Primary MT location address
- +1 NEW MTIEN,ZIPDAT,MTDATA,ERR,MTSRC,STATION
- +2 SET MTIEN=+$$LST^DGMTU(DFN,$$DT^XLFDT)
- +3 if 'MTIEN
- QUIT
- +4 DO GETS^DIQ(408.31,MTIEN_",",".23;2.05","I","MTDATA","ERR")
- +5 if $DATA(ERR)
- QUIT
- +6 SET MTSRC=$GET(MTDATA(408.31,MTIEN_",",.23,"I"))
- +7 ;DCD is the source of this income test
- if "^2^3^"[("^"_MTSRC_"^")
- QUIT
- +8 SET STATION=$GET(MTDATA(408.31,MTIEN_",",2.05,"I"))
- +9 if STATION']""
- QUIT
- +10 ; get primary means test location address and populate array
- +11 DO STATADDR(STATION,.AIGMT,.INCYR)
- +12 QUIT
- +13 ;
- STATADDR(STATION,AIGMT,INCYR) ;get the VAMC station address
- +1 if $GET(STATION)']""
- QUIT
- +2 NEW ZIP,GMTIEN,FIPS,MSA,STFIPS,IEN4,IENS,ZIPDAT,IEN5,SITEADDR
- +3 SET IEN4=$$IEN^XUAF4(STATION)
- if 'IEN4
- QUIT
- +4 SET IENS=IEN4_","
- +5 DO GETS^DIQ(4,IENS,"1.01:1.04","","SITEADDR")
- +6 if $GET(SITEADDR(4,IENS,1.04))=""
- QUIT
- +7 ; determine postal code validity
- +8 DO POSTAL^XIPUTIL(SITEADDR(4,IENS,1.04),.ZIPDAT)
- +9 ; quit if FIPS cannot be determined for this zip code
- +10 if $GET(ZIPDAT("ERROR"))]""
- QUIT
- +11 ; determine MSA code for this zip code
- +12 SET MSA=$$MSACHK(SITEADDR(4,IENS,1.04))
- +13 ; determine if GMT Threshold exists for this zip code
- +14 SET GMTIEN=$$GMTCHK(.INCYR,$GET(ZIPDAT("FIPS CODE")),.MSA)
- +15 if 'GMTIEN
- QUIT
- +16 ; populate array
- +17 SET AIGMT("INCYR")=$GET(INCYR)
- +18 SET AIGMT("FIPS")=$GET(ZIPDAT("FIPS CODE"))
- +19 SET AIGMT("ST1")=$GET(SITEADDR(4,IENS,1.01))
- +20 SET AIGMT("ST2")=$GET(SITEADDR(4,IENS,1.02))
- +21 SET AIGMT("ST3")=""
- +22 SET AIGMT("CITY")=$GET(SITEADDR(4,IENS,1.03))
- +23 SET AIGMT("STATE")=$GET(ZIPDAT("STATE POINTER"))_"^"_$GET(ZIPDAT("STATE"))
- +24 SET AIGMT("ZIP")=$GET(SITEADDR(4,IENS,1.04))
- +25 SET AIGMT("COUNTY")=$GET(ZIPDAT("COUNTY"))
- +26 SET AIGMT("SITE")=STATION
- +27 SET AIGMT("MSA")=MSA
- +28 SET AIGMT("GMTIEN")=GMTIEN
- +29 SET AIGMT("SOURCE")="MT"
- +30 QUIT
- MSACHK(ZIP) ; check and return MSA code if it exists for a Zip Code
- +1 if $GET(ZIP)']""
- QUIT ""
- +2 if '$DATA(^EAS(712.6,"B",$EXTRACT(ZIP,1,5)))
- QUIT ""
- +3 QUIT $ORDER(^EAS(712.6,"AMSA",$EXTRACT(ZIP,1,5),""))
- +4 ;
- GMTCHK(YEAR,FIPS,MSA) ;check for valid GMT Threshold
- +1 ;
- +2 ;INPUT:
- +3 ; YEAR - Income Yr (FM internal) on which to base the GMT Threshold
- +4 ; If YEAR="" then the current income year is used
- +5 ; FIPS - 5-digit FIPS County Code for this record
- +6 ; MSA (pass by reference) - MSA to utilize for GMT determination
- +7 ;
- +8 ;OUTPUT:
- +9 ; MSA (pass by reference) - updated MSA code if applicable
- +10 ; return variable: 0^error if no GMT Threshold can be determined or
- +11 ; ien to the GMT Threshold file
- +12 ;
- +13 if $GET(FIPS)']""
- QUIT "0^FIPS INPUT PARAMETER MISSING"
- +14 if '$GET(MSA)
- SET MSA=$GET(MSA)
- +15 if '$GET(YEAR)
- SET YEAR=($EXTRACT($$DT^XLFDT,1,3)-1)_"0000"
- +16 if 'MSA
- QUIT $$MSAZERO(YEAR,FIPS,.MSA)
- +17 if '$DATA(^EAS(712.5,"AMSA",YEAR))
- QUIT "0^INVALID YEAR"
- +18 if '$DATA(^EAS(712.5,"AMSA",YEAR,FIPS))
- QUIT "0^INVALID FIPS"
- +19 if $DATA(^EAS(712.5,"AMSA",YEAR,FIPS,MSA))
- QUIT $ORDER(^EAS(712.5,"AMSA",YEAR,FIPS,MSA,""))
- +20 SET GMTIEN=$$MSAZERO(YEAR,FIPS,.MSA)
- +21 if GMTIEN
- QUIT GMTIEN
- +22 QUIT "0^GMT THRESHOLD CANNOT BE DETERMINED"
- +23 ;
- MSAZERO(YEAR,FIPS,MSA) ;MSA for this zip code appears to be zero. Can we
- +1 ; determine a GMT Threshold?
- +2 ;
- +3 ;INPUT:
- +4 ; YEAR - Income Year on which to base the GMT Threshold
- +5 ; FIPS - 5-digit FIPS County Code for this record
- +6 ; MSA (pass by reference) - MSA to utilize for GMT determination
- +7 ;
- +8 ;OUTPUT:
- +9 ; MSA (pass by reference) - updated MSA code if applicable
- +10 ; return variable: 0 if no GMT Threshold can be determined or
- +11 ; ien to the GMT Threshold file
- +12 ;
- +13 NEW TMPMSA,TMPGMT
- +14 SET GMTIEN="0^GMT THRESHOLD CANNOT BE DETERMINED"
- SET (TMPMSA,TMPGMT)=""
- +15 if '$GET(YEAR)!($GET(FIPS)="")
- QUIT GMTIEN
- +16 ;
- +17 ; no MSA file entry - get GMT ien if possible
- +18 IF '$DATA(^EAS(712.5,"AMSA",YEAR,FIPS))
- Begin DoDot:1
- +19 IF '$DATA(^EAS(712.5,"GMT",YEAR,FIPS))
- QUIT
- +20 SET GMTIEN=$ORDER(^EAS(712.5,"GMT",YEAR,FIPS,""))
- End DoDot:1
- QUIT GMTIEN
- +21 ;
- +22 ; Is there an entry for this MSA?
- +23 IF MSA'=""
- IF $DATA(^EAS(712.5,"AMSA",YEAR,FIPS,MSA))
- Begin DoDot:1
- +24 SET GMTIEN=$ORDER(^EAS(712.5,"AMSA",YEAR,FIPS,MSA,""))
- End DoDot:1
- QUIT GMTIEN
- +25 ;
- +26 ; Is there only 1 MSA for this FIPS code?
- +27 SET TMPMSA=$ORDER(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA))
- +28 if $ORDER(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA))'=""
- QUIT GMTIEN
- +29 SET GMTIEN=$ORDER(^EAS(712.5,"AMSA",YEAR,FIPS,TMPMSA,""))
- +30 SET MSA=TMPMSA
- +31 QUIT GMTIEN
- +32 ;
- +33 ;
- FIPS(ZIP,INCYR) ; look-up the 5-digit FIPS County code for the entered zip
- +1 ;
- +2 ;INPUT:
- +3 ; ZIP - zip code
- +4 ; INCYR - (optional) income year to use to obtain the GMT Threshold
- +5 ; if the income year is not defined, then the current income
- +6 ; year is used. INCYR is in Fileman internal date format
- +7 ;
- +8 ;OUTPUT:
- +9 ; 5-digit FIPS code ^ MSA value ^ GMT Threshold ien ^ error message
- +10 ;
- +11 NEW MSA,GMTIEN,FIPS,ZIPDAT
- +12 if $GET(ZIP)=""
- QUIT "0^0^0^ZIP CODE NOT ENTERED"
- +13 IF $GET(INCYR)
- IF INCYR?4N
- QUIT "0^0^0^INCOME YEAR MUST BE INTERNAL DATE"
- +14 DO POSTAL^XIPUTIL(ZIP,.ZIPDAT)
- +15 if $GET(ZIPDAT("ERROR"))]""
- QUIT "0^0^0^ZIP CODE NOT IN POSTAL CODE FILE"
- +16 SET FIPS=$GET(ZIPDAT("FIPS CODE"))
- if FIPS']""
- SET FIPS=0
- +17 SET MSA=$$MSACHK(ZIP)
- +18 SET GMTIEN=$$GMTCHK(.INCYR,FIPS,.MSA)
- +19 QUIT FIPS_"^"_MSA_"^"_GMTIEN
- +20 ;