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