Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASAILK

EASAILK.m

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