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

RGRSPARS.m

Go to the documentation of this file. 
  1. RGRSPARS ;ALB/RJS-REGISTRATION MESSAGE PARSER FOR CIRN ;3/8/96
  1.  ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
  1. EN(ARRAY) ;
  1.  ;This procedure call returns an array of patient information in the 
  1.  ;corresponding PATIENT file (#2) field numbers as well as Patient
  1.  ;sensitivity.
  1.  ;
  1.  ;Input: Required Variable
  1.  ;
  1.  ; ARRAY - Supplied array variable (Pass by reference)
  1.  ;
  1.  ;Output:
  1.  ;
  1.  ; ARRAY - Array of patient information gathered from HL7 segments
  1.  ;
  1.  N RGRSPID,RGRSZEL,RGRSZPD,RGRSZSP,RGC,RGRSPD1,RGRSZEM,RGRSZCT,RGRSZFF
  1.  N STATE,STATEIEN,SUBCOMP,STREETS,INSTITU,CNTYCODE,ADDRESS,RGRSOBX
  1.  N RGRSMSH
  1.  S RGC=$E(HL("ECH")),SUBCOMP=$E(HL("ECH"),2)
  1.  S RGRSMSH=$$SEG1^RGRSUTIL("MSH",1,"MSH")
  1.  S RGRSPID=$$SEG1^RGRSUTIL("PID",1,"PID")
  1.  S RGRSPD1=$$SEG1^RGRSUTIL("PD1",1,"PD1")
  1.  S RGRSZEL=$$SEG1^RGRSUTIL("ZEL",1,"ZEL")
  1.  S RGRSZPD=$$SEG1^RGRSUTIL("ZPD",1,"ZPD")
  1.  S RGRSZSP=$$SEG1^RGRSUTIL("ZSP",1,"ZSP")
  1.  S RGRSZEM=$$SEG1^RGRSUTIL("ZEM",1,"ZEM")
  1.  S RGRSZCT=$$SEG1^RGRSUTIL("ZCT",1,"ZCT")
  1.  S RGRSZFF=$$SEG1^RGRSUTIL("ZFF",1,"ZFF")
  1.  S RGRSOBX=$$SEG1^RGRSUTIL("OBX",1,"OBX")
  1.  S @ARRAY@(.01)=$$FREE($$FMNAME^HLFNC($P(RGRSPID,HL("FS"),6),HL("ECH"))) ;NAME
  1.  S @ARRAY@(.02)=$$SEX($P(RGRSPID,HL("FS"),9)) ;SEX
  1.  S @ARRAY@(.03)=$$FREE($$FMDATE^HLFNC($P(RGRSPID,HL("FS"),8))) ;DOB
  1.  S @ARRAY@(.05)=$$MARITAL($P(RGRSPID,HL("FS"),17)) ;MARITAL STATUS
  1.  S @ARRAY@(.08)=$$RELIG($P(RGRSPID,HL("FS"),18)) ;RELIGIOUS PREFERENCE
  1.  S @ARRAY@(.09)=$$FREE($P(RGRSPID,HL("FS"),20)) ;SOCIAL SECURITY #
  1.  S ADDRESS=$$FREE($P(RGRSPID,HL("FS"),12)) ;ADDRESS FIELDS
  1.  S @ARRAY@(.111)=$$FREE($P(ADDRESS,RGC,1)) ;STREET ADDRESS [1]
  1.  S @ARRAY@(.112)=$$FREE($P(ADDRESS,RGC,2)) ;STREET ADDRESS [2]
  1.  S @ARRAY@(.113)=$$FREE($P(ADDRESS,RGC,8)) ;STREET ADDRESS [3]
  1.  S @ARRAY@(.114)=$$FREE($P($P(RGRSPID,HL("FS"),12),RGC,3)) ;CITY
  1.  S @ARRAY@(.115)=$$STATE($P($P(RGRSPID,HL("FS"),12),RGC,4)) ;STATE
  1.  S @ARRAY@(.1112)=$$FREE($P($P(RGRSPID,HL("FS"),12),RGC,5)) ;ZIP+4
  1.  S CNTYCODE=$P(RGRSPID,HL("FS"),13) ;COUNTY CODE
  1.  S @ARRAY@(.117)=$$COUNTY(@ARRAY@(.115),CNTYCODE)
  1.  S @ARRAY@(.131)=$$FREE($P(RGRSPID,HL("FS"),14)) ;PHONE NUMBER-HOME
  1.  S @ARRAY@(.132)=$$FREE($P(RGRSPID,HL("FS"),15)) ;PHONE NUMBER-WORK
  1.  S @ARRAY@(.211)=$$FREE($P(RGRSZCT,HL("FS"),4)) ;K-NAME
  1.  S @ARRAY@(.219)=$$FREE($P(RGRSZCT,HL("FS"),7)) ;K-PHONE NUMBER
  1.  S @ARRAY@(.2403)=$$FREE($P(RGRSPID,HL("FS"),7)) ;MOTHERS MAIDEN NAME
  1.  S @ARRAY@(.301)=$$YESNO($P(RGRSZSP,HL("FS"),3)) ;SERVICE CONNECTED
  1.  S @ARRAY@(.302)=$$FREE($P(RGRSZSP,HL("FS"),4)) ;SERVICE CONNECTED PERCENTAGE
  1.  S @ARRAY@(.31115)=$$EMP($P(RGRSZEM,HL("FS"),4)) ;EMPLOYMENT STATUS
  1.  S @ARRAY@(.323)=$$POS($P(RGRSZSP,HL("FS"),5)) ;PERIOD OF SERVICE
  1.  S @ARRAY@(.351)=$$FREE($$FMDATE^HLFNC($P(RGRSZPD,HL("FS"),10))) ;DATE OF DEATH
  1.  S @ARRAY@(.361)=$$ELIG($P(RGRSZEL,HL("FS"),3)) ;PRIMARY ELIGIBILITY CODE
  1.  S @ARRAY@(.3612)=$$FREE($$FMDATE^HLFNC($P(RGRSZEL,HL("FS"),12))) ;DT VER
  1.  S @ARRAY@(.3615)=$$FREE($P(RGRSZEL,HL("FS"),14)) ;VERIFICATION METHOD
  1.  S @ARRAY@(391)=$$TYPE($P(RGRSZEL,HL("FS"),10)) ;PATIENT TYPE
  1.  S @ARRAY@(1901)=$$VETERAN($P(RGRSZEL,HL("FS"),9)) ;VETERAN (Y/N)
  1.  S @ARRAY@(991.01)=$$FREE($P($P(RGRSPID,HL("FS"),3),"V",1)) ;INTEG CONTROL #
  1.  S @ARRAY@(991.02)=$$FREE($P($P(RGRSPID,HL("FS"),3),"V",2)) ;CHECKSUM
  1.  S @ARRAY@(991.03)=$$FREE($P($P(RGRSPD1,HL("FS"),4),RGC,1)) ;VCCI
  1.  S @ARRAY@("SENDING SITE")=$$FREE($P(RGRSMSH,HL("FS"),4)) ;SENDING SITE
  1.  S @ARRAY@("SITENUM")=$$FREE($P($P(RGRSPD1,HL("FS"),4),RGC,3)) ;VCCI SITENUM
  1.  S @ARRAY@("DFN")=$$FREE($P($P(RGRSPID,HL("FS"),4),RGC,1)) ;DFN
  1.  S @ARRAY@("FLD")=$P(RGRSZFF,HL("FS"),3) ;FIELD(S) EDITED
  1.  I $$FREE($P($P(RGRSOBX,HL("FS"),4),RGC,2))="SECURITY LEVEL" DO
  1.  . S @ARRAY@("SENSITIVITY")=$$SENSTIVE($P(RGRSOBX,HL("FS"),6),RGC) ;SENSTIVITY
  1.  . S @ARRAY@("SENSITIVITY USER")=$$FREE($P($P(RGRSOBX,HL("FS"),17),RGC,2))_","_$$FREE($P($P(RGRSOBX,HL("FS"),17),RGC,3)) ;REMOTE PERSON WHO MADE PT. SENSITIVE
  1.  . S @ARRAY@("SENSITIVITY DATE")=$$FREE($$FMDATE^HLFNC($P(RGRSOBX,HL("FS"),15))) ;DATE/TIME PERSON MADE PT. SENSITIVE AT REMOTE SITE
  1.  D NOW^%DTC S @ARRAY@(.097)=X
  1.  K %H,%I,X,%
  1.  Q
  1.  ;
  1. VETERAN(HLCODE) ;
  1.  Q:$$FREE(HLCODE)="" ""
  1.  Q:$$FREE(HLCODE)="""@""" """@"""
  1.  Q:HLCODE=1 "YES"
  1.  Q:HLCODE=0 "NO"
  1.  Q HLCODE_"^1"
  1.  ;
  1. STATE(STATE) ;
  1.  N RETURN,STATEIEN
  1.  Q:$$FREE(STATE)="" ""
  1.  Q:$$FREE(STATE)="""@""" """@"""
  1.  S STATEIEN=$O(^DIC(5,"C",STATE,0))
  1.  I $G(STATEIEN)="" Q STATE_"^1"
  1.  S RETURN=$P(^DIC(5,STATEIEN,0),"^",1)
  1.  Q:$G(RETURN)'="" RETURN
  1.  Q STATE_"^1"
  1.  ;
  1. COUNTY(STATE,CNTYCODE) ;
  1.  ;This function entry point is used to obtain the county name
  1.  ;
  1.  ;Input: Required Variables
  1.  ;
  1.  ; STATE - State name
  1.  ; CNTYCODE - County code
  1.  ;
  1.  ;Output:
  1.  ; County name   - If known
  1.  ;    "@"        - If missing required input
  1.  ; County Code^1 - If county code was unknown
  1.  ;
  1.  N STATEIEN,COUNTIEN,CNTYNAME
  1.  Q:$G(STATE)=""!($G(STATE)=HL("Q"))!($G(CNTYCODE)="") ""
  1.  Q:$G(CNTYCODE)=HL("Q") """@"""
  1.  S STATEIEN=$O(^DIC(5,"B",STATE,0))
  1.  Q:$G(STATEIEN)'>0 CNTYCODE_"^1"
  1.  S COUNTIEN=$O(^DIC(5,STATEIEN,1,"C",CNTYCODE,0))
  1.  Q:$G(COUNTIEN)'>0 CNTYCODE_"^1"
  1.  S CNTYNAME=$P(^DIC(5,STATEIEN,1,COUNTIEN,0),"^",1)
  1.  Q:$L(CNTYNAME)'>0 CNTYCODE_"^1"
  1.  Q $G(CNTYNAME)
  1.  ;
  1. KILL ;
  1.  K @ARRAY
  1.  Q
  1.  ;
  1. FREE(DATA) ;
  1.  Q:$G(DATA)="" ""
  1.  Q:DATA=HL("Q") """@"""
  1.  Q $G(DATA)
  1. SEX(DATA) ;
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  I DATA="M" Q "MALE"
  1.  I DATA="F" Q "FEMALE"
  1.  Q "^<UNRESOLVED>"
  1.  ;
  1. MARITAL(DATA) ;
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  Q:DATA="A" "SEPARATED"
  1.  Q:DATA="D" "DIVORCED"
  1.  Q:DATA="M" "MARRIED"
  1.  Q:DATA="S" "NEVER MARRIED"
  1.  Q:DATA="W" "WIDOW/WIDOWER"
  1.  Q:DATA="U" "UNKNOWN"
  1.  Q DATA_"^1"
  1.  ;
  1. SENSTIVE(DATA,SUBCOMP) ;
  1.  Q:$G(DATA)="" 0
  1.  Q:$P(DATA,SUBCOMP,1)=1 1
  1.  Q 0
  1.  ;
  1. YESNO(DATA) ;
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  I DATA="1" Q "YES"
  1.  I DATA="0" Q "NO"
  1.  Q "^<UNRESOLVED>"
  1. RELIG(DATA) ;
  1.  N IEN,RELIG
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  S IEN=$O(^DIC(13,"C",DATA,0))
  1.  I $G(IEN)="" Q DATA_"^1"
  1.  S RELIG=$P($G(^DIC(13,IEN,0)),"^",1)
  1.  I $G(RELIG)="" Q DATA_"^1"
  1.  Q $G(RELIG)
  1. POS(DATA) ;
  1.  N IEN,POS
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  S IEN=$O(^DIC(21,"D",DATA,0))
  1.  I $G(IEN)="" Q DATA_"^1"
  1.  S POS=$P($G(^DIC(21,IEN,0)),"^",1)
  1.  I $G(POS)="" Q DATA_"^1"
  1.  Q $G(POS)
  1. ELIG(DATA)      ;
  1.  N IEN,ELIGPTR,ELIG
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  S ELIGPTR=$O(^DIC(8,"D",DATA,0))
  1.  I $G(ELIGPTR)'>0 Q DATA_"^1"
  1.  S ELIG=$P($G(^DIC(8,ELIGPTR,0)),"^",1)
  1.  I $G(ELIG)="" Q DATA_"^1"
  1.  Q $G(ELIG)
  1. TYPE(DATA) ;
  1.  N IEN,TYPE
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  S IEN=$O(^DG(391,"B",DATA,0))
  1.  I $G(IEN)="" Q DATA_"^1"
  1.  S TYPE=$P($G(^DG(391,IEN,0)),"^",1)
  1.  I $G(TYPE)="" Q DATA_"^1"
  1.  Q $G(TYPE)
  1. EMP(DATA) ;
  1.  N IEN,EMP
  1.  Q:$$FREE(DATA)="" ""
  1.  Q:$$FREE(DATA)="""@""" """@"""
  1.  Q:DATA=1 "EMPLOYED FULL TIME"
  1.  Q:DATA=2 "EMPLOYED PART TIME"
  1.  Q:DATA=3 "NOT EMPLOYED"
  1.  Q:DATA=4 "SELF EMPLOYED"
  1.  Q:DATA=5 "RETIRED"
  1.  Q:DATA=6 "ACTIVE MILITARY DUTY"
  1.  Q:DATA=9 "UNKNOWN"
  1.  Q DATA_"^1"