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  Sep 23, 2025@19:29:44                                                                                                                                                                                                     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      ;