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

SDECDEM.m

Go to the documentation of this file.
  1. SDECDEM ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017
  1. ;;5.3;Scheduling;**658**;Aug 13, 1993;Build 23
  1. ;
  1. Q
  1. ;
  1. ;INPUT:
  1. ; 1. ZIP - 5 or 9 digit numeric Zip code
  1. ;RETURN:
  1. ; 1. CITYNAME - City name
  1. ; 2. CITY_ABB - City Abbreviation
  1. ; 3. CITY_KEY - City Key
  1. ; 4. COUNTYNAME - County name
  1. ; 5. COUNTYIEN - County Pointer
  1. ; 6. FIPS - FIPS code
  1. ; 7. ZIP - ZIP CODE
  1. ; 8. P_CITY_KEY - Preferred City Key
  1. ; 9. STATENAME - State name
  1. ; 10. STATE_IEN - State ien
  1. ; 11. UID - Unique Key
  1. ;
  1. N SDATA,SDECI,SDI,SDTMP,X
  1. S SDECI=0
  1. S RET="^TMP(""SDECDEM"","_$J_",""ZIPLINK"")"
  1. K @RET
  1. ; data header
  1. S SDTMP="T00030CITYNAME^T00030CITY_ABB^T00030CITY_KEY^T00030COUNTYNAME^T00030COUNTY_IEN^T00030FIPS^T00030ZIP"
  1. S SDTMP=SDTMP_"^T00030P_CITY_KEY^T00030STATENAME^T00030STATE_IEN^T00030UID"
  1. S @RET@(0)=SDTMP_$C(30)
  1. ;validate ZIP
  1. S ZIP=$G(ZIP)
  1. I ZIP'="" D
  1. .I ($A(ZIP)=45),$L(ZIP)>20!($L(ZIP)<5) S @RET@(1)="-1^Zip code must be 5 or 9 numeric digits "_ZIP_"."_$C(30,31) Q
  1. .S X=ZIP D ZIPIN^VAFADDR S X=$G(X) S:X'="" ZIP=X I X="" S @RET@(1)="-1^Invalid zip code "_ZIP_"."_$C(30,31) Q
  1. ;
  1. I ZIP'="" D
  1. .D POSTALB^XIPUTIL(ZIP,.SDATA)
  1. .S SDI="" F S SDI=$O(SDATA(SDI)) Q:SDI="" D
  1. ..S SDTMP=$G(SDATA(SDI,"CITY"))
  1. ..S $P(SDTMP,U,2)=$G(SDATA(SDI,"CITY ABBREVIATION"))
  1. ..S $P(SDTMP,U,3)=$G(SDATA(SDI,"CITY KEY"))
  1. ..S $P(SDTMP,U,4)=$G(SDATA(SDI,"COUNTY"))
  1. ..S $P(SDTMP,U,5)=$G(SDATA(SDI,"COUNTY POINTER"))
  1. ..S $P(SDTMP,U,6)=$G(SDATA(SDI,"FIPS CODE"))
  1. ..S $P(SDTMP,U,7)=$G(SDATA(SDI,"POSTAL CODE"))
  1. ..S $P(SDTMP,U,8)=$G(SDATA(SDI,"PREFERRED CITY KEY"))
  1. ..S $P(SDTMP,U,9)=$G(SDATA(SDI,"STATE"))
  1. ..S $P(SDTMP,U,10)=$G(SDATA(SDI,"STATE POINTER"))
  1. ..S $P(SDTMP,U,11)=$G(SDATA(SDI,"UNIQUE KEY"))
  1. ..S SDECI=SDECI+1 S @RET@(SDECI)=SDTMP_$C(30)
  1. S @RET@(SDECI)=@RET@(SDECI)_$C(31)
  1. Q
  1. ;
  1. MARITAL(RET) ;GET Marital status entries from the MARITAL STATUS file (#11)
  1. ;INPUT:
  1. ; none
  1. ;RETURN:
  1. ; 1. MIEN - Marital Status ID pointer to the MARITAL STATUS file (#11)
  1. ; 2. MNAME - Marital Status name
  1. ; 3. MABB - Marital Status Abbreviation
  1. ; 4. MCODE - Marital Status Code - valid values are:
  1. ; D:DIVORCED
  1. ; M:MARRIED
  1. ; N:NEVER MARRIED
  1. ; S:SEPARATED
  1. ; W:WIDOWED
  1. ; U:UNKNOWN
  1. N MIEN,MNAME,MNOD,SDECI
  1. S SDECI=0
  1. S RET="^TMP(""SDECDEM"","_$J_",""MARITAL"")"
  1. K @RET
  1. ; data header
  1. S @RET@(0)="T00030MIEN^T00030MNAME^T00030MABB^T00030MCODE"_$C(30)
  1. ;
  1. S MNAME="" F S MNAME=$O(^DIC(11,"B",MNAME)) Q:MNAME="" D
  1. .S MIEN=0 F S MIEN=$O(^DIC(11,"B",MNAME,MIEN)) Q:MIEN="" D
  1. ..S MNOD=$G(^DIC(11,MIEN,0))
  1. ..Q:MNOD=""
  1. ..S SDECI=SDECI+1 S @RET@(SDECI)=MIEN_U_MNAME_U_$P(MNOD,U,2)_U_$P(MNOD,U,3)_$C(30)
  1. S @RET@(SDECI)=@RET@(SDECI)_$C(31)
  1. Q
  1. ;
  1. RELIGION(RET) ;GET Religious preference entries from the RELITION file (#13)
  1. ;INPUT:
  1. ; none
  1. ;RETURN:
  1. ; 1. RIEN - Religion ID pointer to the RELIGION file (#13)
  1. ; 2. RNAME - Religion name
  1. ; 3. RABB - Religion Abbreviation
  1. ; 4. RCLASS - Religion Classification code
  1. ; 1=CATHOLIC
  1. ; 2=PROTESTANT
  1. ; 3=JEWISH
  1. ; 4=ORTHODOX
  1. ; 5=OTHER
  1. ; 5. RCLASSN - Relition Classification name
  1. ; 6. RCODE - Religion Code - Numeric 1-99
  1. N RIEN,RNAME,RNOD,SDECI
  1. S SDECI=0
  1. S RET="^TMP(""SDECDEM"","_$J_",""RELIGION"")"
  1. K @RET
  1. ; data header
  1. S @RET@(0)="T00030RIEN^T00030RNAME^T00030RABB^T00030RCLASS^T00030RCLASSN^T00030RCODE"_$C(30)
  1. ;
  1. S RNAME="" F S RNAME=$O(^DIC(13,"B",RNAME)) Q:RNAME="" D
  1. .S RIEN=0 F S RIEN=$O(^DIC(13,"B",RNAME,RIEN)) Q:RIEN="" D
  1. ..S RNOD=$G(^DIC(13,RIEN,0))
  1. ..Q:RNOD=""
  1. ..S SDECI=SDECI+1 S @RET@(SDECI)=RIEN_U_RNAME_U_$P(RNOD,U,2)_U_$P(RNOD,U,3)_U_$$GET1^DIQ(13,RIEN_",",2)_U_$P(RNOD,U,4)_$C(30)
  1. S @RET@(SDECI)=@RET@(SDECI)_$C(31)
  1. Q
  1. ;
  1. CITYAB(ZIP,CITY) ;GET city abbreviation for given city and zip
  1. N CITY1,CITYAB,SDATA,SDI
  1. S (CITY1,CITYAB)=""
  1. S ZIP=$G(ZIP) Q:ZIP="" ""
  1. S CITY=$G(CITY)
  1. D POSTALB^XIPUTIL(ZIP,.SDATA)
  1. S SDI="" F S SDI=$O(SDATA(SDI)) Q:SDI="" D Q:CITY1=CITY
  1. .S CITY1=$G(SDATA(SDI,"CITY"))
  1. .S CITY1=$S($E(CITY1,$L(CITY1))="*":$E(CITY1,1,$L(CITY1)-1),1:CITY1)
  1. .S CITYAB=$G(SDATA(SDI,"CITY ABBREVIATION"))
  1. Q CITYAB