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"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRSPARS 7067 printed Nov 22, 2024@16:53:11 Page 2
RGRSPARS ;ALB/RJS-REGISTRATION MESSAGE PARSER FOR CIRN ;3/8/96
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
EN(ARRAY) ;
+1 ;This procedure call returns an array of patient information in the
+2 ;corresponding PATIENT file (#2) field numbers as well as Patient
+3 ;sensitivity.
+4 ;
+5 ;Input: Required Variable
+6 ;
+7 ; ARRAY - Supplied array variable (Pass by reference)
+8 ;
+9 ;Output:
+10 ;
+11 ; ARRAY - Array of patient information gathered from HL7 segments
+12 ;
+13 NEW RGRSPID,RGRSZEL,RGRSZPD,RGRSZSP,RGC,RGRSPD1,RGRSZEM,RGRSZCT,RGRSZFF
+14 NEW STATE,STATEIEN,SUBCOMP,STREETS,INSTITU,CNTYCODE,ADDRESS,RGRSOBX
+15 NEW RGRSMSH
+16 SET RGC=$EXTRACT(HL("ECH"))
SET SUBCOMP=$EXTRACT(HL("ECH"),2)
+17 SET RGRSMSH=$$SEG1^RGRSUTIL("MSH",1,"MSH")
+18 SET RGRSPID=$$SEG1^RGRSUTIL("PID",1,"PID")
+19 SET RGRSPD1=$$SEG1^RGRSUTIL("PD1",1,"PD1")
+20 SET RGRSZEL=$$SEG1^RGRSUTIL("ZEL",1,"ZEL")
+21 SET RGRSZPD=$$SEG1^RGRSUTIL("ZPD",1,"ZPD")
+22 SET RGRSZSP=$$SEG1^RGRSUTIL("ZSP",1,"ZSP")
+23 SET RGRSZEM=$$SEG1^RGRSUTIL("ZEM",1,"ZEM")
+24 SET RGRSZCT=$$SEG1^RGRSUTIL("ZCT",1,"ZCT")
+25 SET RGRSZFF=$$SEG1^RGRSUTIL("ZFF",1,"ZFF")
+26 SET RGRSOBX=$$SEG1^RGRSUTIL("OBX",1,"OBX")
+27 ;NAME
SET @ARRAY@(.01)=$$FREE($$FMNAME^HLFNC($PIECE(RGRSPID,HL("FS"),6),HL("ECH")))
+28 ;SEX
SET @ARRAY@(.02)=$$SEX($PIECE(RGRSPID,HL("FS"),9))
+29 ;DOB
SET @ARRAY@(.03)=$$FREE($$FMDATE^HLFNC($PIECE(RGRSPID,HL("FS"),8)))
+30 ;MARITAL STATUS
SET @ARRAY@(.05)=$$MARITAL($PIECE(RGRSPID,HL("FS"),17))
+31 ;RELIGIOUS PREFERENCE
SET @ARRAY@(.08)=$$RELIG($PIECE(RGRSPID,HL("FS"),18))
+32 ;SOCIAL SECURITY #
SET @ARRAY@(.09)=$$FREE($PIECE(RGRSPID,HL("FS"),20))
+33 ;ADDRESS FIELDS
SET ADDRESS=$$FREE($PIECE(RGRSPID,HL("FS"),12))
+34 ;STREET ADDRESS [1]
SET @ARRAY@(.111)=$$FREE($PIECE(ADDRESS,RGC,1))
+35 ;STREET ADDRESS [2]
SET @ARRAY@(.112)=$$FREE($PIECE(ADDRESS,RGC,2))
+36 ;STREET ADDRESS [3]
SET @ARRAY@(.113)=$$FREE($PIECE(ADDRESS,RGC,8))
+37 ;CITY
SET @ARRAY@(.114)=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),12),RGC,3))
+38 ;STATE
SET @ARRAY@(.115)=$$STATE($PIECE($PIECE(RGRSPID,HL("FS"),12),RGC,4))
+39 ;ZIP+4
SET @ARRAY@(.1112)=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),12),RGC,5))
+40 ;COUNTY CODE
SET CNTYCODE=$PIECE(RGRSPID,HL("FS"),13)
+41 SET @ARRAY@(.117)=$$COUNTY(@ARRAY@(.115),CNTYCODE)
+42 ;PHONE NUMBER-HOME
SET @ARRAY@(.131)=$$FREE($PIECE(RGRSPID,HL("FS"),14))
+43 ;PHONE NUMBER-WORK
SET @ARRAY@(.132)=$$FREE($PIECE(RGRSPID,HL("FS"),15))
+44 ;K-NAME
SET @ARRAY@(.211)=$$FREE($PIECE(RGRSZCT,HL("FS"),4))
+45 ;K-PHONE NUMBER
SET @ARRAY@(.219)=$$FREE($PIECE(RGRSZCT,HL("FS"),7))
+46 ;MOTHERS MAIDEN NAME
SET @ARRAY@(.2403)=$$FREE($PIECE(RGRSPID,HL("FS"),7))
+47 ;SERVICE CONNECTED
SET @ARRAY@(.301)=$$YESNO($PIECE(RGRSZSP,HL("FS"),3))
+48 ;SERVICE CONNECTED PERCENTAGE
SET @ARRAY@(.302)=$$FREE($PIECE(RGRSZSP,HL("FS"),4))
+49 ;EMPLOYMENT STATUS
SET @ARRAY@(.31115)=$$EMP($PIECE(RGRSZEM,HL("FS"),4))
+50 ;PERIOD OF SERVICE
SET @ARRAY@(.323)=$$POS($PIECE(RGRSZSP,HL("FS"),5))
+51 ;DATE OF DEATH
SET @ARRAY@(.351)=$$FREE($$FMDATE^HLFNC($PIECE(RGRSZPD,HL("FS"),10)))
+52 ;PRIMARY ELIGIBILITY CODE
SET @ARRAY@(.361)=$$ELIG($PIECE(RGRSZEL,HL("FS"),3))
+53 ;DT VER
SET @ARRAY@(.3612)=$$FREE($$FMDATE^HLFNC($PIECE(RGRSZEL,HL("FS"),12)))
+54 ;VERIFICATION METHOD
SET @ARRAY@(.3615)=$$FREE($PIECE(RGRSZEL,HL("FS"),14))
+55 ;PATIENT TYPE
SET @ARRAY@(391)=$$TYPE($PIECE(RGRSZEL,HL("FS"),10))
+56 ;VETERAN (Y/N)
SET @ARRAY@(1901)=$$VETERAN($PIECE(RGRSZEL,HL("FS"),9))
+57 ;INTEG CONTROL #
SET @ARRAY@(991.01)=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),3),"V",1))
+58 ;CHECKSUM
SET @ARRAY@(991.02)=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),3),"V",2))
+59 ;VCCI
SET @ARRAY@(991.03)=$$FREE($PIECE($PIECE(RGRSPD1,HL("FS"),4),RGC,1))
+60 ;SENDING SITE
SET @ARRAY@("SENDING SITE")=$$FREE($PIECE(RGRSMSH,HL("FS"),4))
+61 ;VCCI SITENUM
SET @ARRAY@("SITENUM")=$$FREE($PIECE($PIECE(RGRSPD1,HL("FS"),4),RGC,3))
+62 ;DFN
SET @ARRAY@("DFN")=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),4),RGC,1))
+63 ;FIELD(S) EDITED
SET @ARRAY@("FLD")=$PIECE(RGRSZFF,HL("FS"),3)
+64 IF $$FREE($PIECE($PIECE(RGRSOBX,HL("FS"),4),RGC,2))="SECURITY LEVEL"
Begin DoDot:1
+65 ;SENSTIVITY
SET @ARRAY@("SENSITIVITY")=$$SENSTIVE($PIECE(RGRSOBX,HL("FS"),6),RGC)
+66 ;REMOTE PERSON WHO MADE PT. SENSITIVE
SET @ARRAY@("SENSITIVITY USER")=$$FREE($PIECE($PIECE(RGRSOBX,HL("FS"),17),RGC,2))_","_$$FREE($PIECE($PIECE(RGRSOBX,HL("FS"),17),RGC,3))
+67 ;DATE/TIME PERSON MADE PT. SENSITIVE AT REMOTE SITE
SET @ARRAY@("SENSITIVITY DATE")=$$FREE($$FMDATE^HLFNC($PIECE(RGRSOBX,HL("FS"),15)))
End DoDot:1
+68 DO NOW^%DTC
SET @ARRAY@(.097)=X
+69 KILL %H,%I,X,%
+70 QUIT
+71 ;
VETERAN(HLCODE) ;
+1 if $$FREE(HLCODE)=""
QUIT ""
+2 if $$FREE(HLCODE)="""@"""
QUIT """@"""
+3 if HLCODE=1
QUIT "YES"
+4 if HLCODE=0
QUIT "NO"
+5 QUIT HLCODE_"^1"
+6 ;
STATE(STATE) ;
+1 NEW RETURN,STATEIEN
+2 if $$FREE(STATE)=""
QUIT ""
+3 if $$FREE(STATE)="""@"""
QUIT """@"""
+4 SET STATEIEN=$ORDER(^DIC(5,"C",STATE,0))
+5 IF $GET(STATEIEN)=""
QUIT STATE_"^1"
+6 SET RETURN=$PIECE(^DIC(5,STATEIEN,0),"^",1)
+7 if $GET(RETURN)'=""
QUIT RETURN
+8 QUIT STATE_"^1"
+9 ;
COUNTY(STATE,CNTYCODE) ;
+1 ;This function entry point is used to obtain the county name
+2 ;
+3 ;Input: Required Variables
+4 ;
+5 ; STATE - State name
+6 ; CNTYCODE - County code
+7 ;
+8 ;Output:
+9 ; County name - If known
+10 ; "@" - If missing required input
+11 ; County Code^1 - If county code was unknown
+12 ;
+13 NEW STATEIEN,COUNTIEN,CNTYNAME
+14 if $GET(STATE)=""!($GET(STATE)=HL("Q"))!($GET(CNTYCODE)="")
QUIT ""
+15 if $GET(CNTYCODE)=HL("Q")
QUIT """@"""
+16 SET STATEIEN=$ORDER(^DIC(5,"B",STATE,0))
+17 if $GET(STATEIEN)'>0
QUIT CNTYCODE_"^1"
+18 SET COUNTIEN=$ORDER(^DIC(5,STATEIEN,1,"C",CNTYCODE,0))
+19 if $GET(COUNTIEN)'>0
QUIT CNTYCODE_"^1"
+20 SET CNTYNAME=$PIECE(^DIC(5,STATEIEN,1,COUNTIEN,0),"^",1)
+21 if $LENGTH(CNTYNAME)'>0
QUIT CNTYCODE_"^1"
+22 QUIT $GET(CNTYNAME)
+23 ;
KILL ;
+1 KILL @ARRAY
+2 QUIT
+3 ;
FREE(DATA) ;
+1 if $GET(DATA)=""
QUIT ""
+2 if DATA=HL("Q")
QUIT """@"""
+3 QUIT $GET(DATA)
SEX(DATA) ;
+1 if $$FREE(DATA)=""
QUIT ""
+2 if $$FREE(DATA)="""@"""
QUIT """@"""
+3 IF DATA="M"
QUIT "MALE"
+4 IF DATA="F"
QUIT "FEMALE"
+5 QUIT "^<UNRESOLVED>"
+6 ;
MARITAL(DATA) ;
+1 if $$FREE(DATA)=""
QUIT ""
+2 if $$FREE(DATA)="""@"""
QUIT """@"""
+3 if DATA="A"
QUIT "SEPARATED"
+4 if DATA="D"
QUIT "DIVORCED"
+5 if DATA="M"
QUIT "MARRIED"
+6 if DATA="S"
QUIT "NEVER MARRIED"
+7 if DATA="W"
QUIT "WIDOW/WIDOWER"
+8 if DATA="U"
QUIT "UNKNOWN"
+9 QUIT DATA_"^1"
+10 ;
SENSTIVE(DATA,SUBCOMP) ;
+1 if $GET(DATA)=""
QUIT 0
+2 if $PIECE(DATA,SUBCOMP,1)=1
QUIT 1
+3 QUIT 0
+4 ;
YESNO(DATA) ;
+1 if $$FREE(DATA)=""
QUIT ""
+2 if $$FREE(DATA)="""@"""
QUIT """@"""
+3 IF DATA="1"
QUIT "YES"
+4 IF DATA="0"
QUIT "NO"
+5 QUIT "^<UNRESOLVED>"
RELIG(DATA) ;
+1 NEW IEN,RELIG
+2 if $$FREE(DATA)=""
QUIT ""
+3 if $$FREE(DATA)="""@"""
QUIT """@"""
+4 SET IEN=$ORDER(^DIC(13,"C",DATA,0))
+5 IF $GET(IEN)=""
QUIT DATA_"^1"
+6 SET RELIG=$PIECE($GET(^DIC(13,IEN,0)),"^",1)
+7 IF $GET(RELIG)=""
QUIT DATA_"^1"
+8 QUIT $GET(RELIG)
POS(DATA) ;
+1 NEW IEN,POS
+2 if $$FREE(DATA)=""
QUIT ""
+3 if $$FREE(DATA)="""@"""
QUIT """@"""
+4 SET IEN=$ORDER(^DIC(21,"D",DATA,0))
+5 IF $GET(IEN)=""
QUIT DATA_"^1"
+6 SET POS=$PIECE($GET(^DIC(21,IEN,0)),"^",1)
+7 IF $GET(POS)=""
QUIT DATA_"^1"
+8 QUIT $GET(POS)
ELIG(DATA) ;
+1 NEW IEN,ELIGPTR,ELIG
+2 if $$FREE(DATA)=""
QUIT ""
+3 if $$FREE(DATA)="""@"""
QUIT """@"""
+4 SET ELIGPTR=$ORDER(^DIC(8,"D",DATA,0))
+5 IF $GET(ELIGPTR)'>0
QUIT DATA_"^1"
+6 SET ELIG=$PIECE($GET(^DIC(8,ELIGPTR,0)),"^",1)
+7 IF $GET(ELIG)=""
QUIT DATA_"^1"
+8 QUIT $GET(ELIG)
TYPE(DATA) ;
+1 NEW IEN,TYPE
+2 if $$FREE(DATA)=""
QUIT ""
+3 if $$FREE(DATA)="""@"""
QUIT """@"""
+4 SET IEN=$ORDER(^DG(391,"B",DATA,0))
+5 IF $GET(IEN)=""
QUIT DATA_"^1"
+6 SET TYPE=$PIECE($GET(^DG(391,IEN,0)),"^",1)
+7 IF $GET(TYPE)=""
QUIT DATA_"^1"
+8 QUIT $GET(TYPE)
EMP(DATA) ;
+1 NEW IEN,EMP
+2 if $$FREE(DATA)=""
QUIT ""
+3 if $$FREE(DATA)="""@"""
QUIT """@"""
+4 if DATA=1
QUIT "EMPLOYED FULL TIME"
+5 if DATA=2
QUIT "EMPLOYED PART TIME"
+6 if DATA=3
QUIT "NOT EMPLOYED"
+7 if DATA=4
QUIT "SELF EMPLOYED"
+8 if DATA=5
QUIT "RETIRED"
+9 if DATA=6
QUIT "ACTIVE MILITARY DUTY"
+10 if DATA=9
QUIT "UNKNOWN"
+11 QUIT DATA_"^1"
