NHINVPT ;SLC/MKB -- Patient demographics extract
;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
;
; External References DBIA#
; ------------------- -----
; ^DIC(42 10039
; ^DPT 10035
; DGCV 4156
; DGMSTAPI 2716
; DGNTAPI 3457
; DGPFAPI 3860
; DILFD 2055
; DIQ 2056
; MPIF001 2701
; SDUTL3 1252
; VADPT 10061
; VAFCTFU1 2990
; VASITE 10112
; XUAF4 2171
;
; ------------ Get data from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find current patient demographics
; [BEG,END,MAX,ID not currently used]
S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
N PAT,SYS S SYS=$$SITE^VASITE
D DEM,SVC,PRF,ATC,SUPP,ALIAS,FAC
I $D(PAT)>9 D XML(.PAT)
Q
;
DEM ;-demographic data
N VADM,VA,VAERR,X
S X=+$$GETICN^MPIF001(DFN) S:X>1 PAT("icn")=X
D DEM^VADPT S X=VADM(1),PAT("fullName")=X
S PAT("familyName")=$P(X,","),PAT("givenNames")=$P(X,",",2,99)
S PAT("ssn")=$P(VADM(2),U),PAT("id")=DFN
S:$D(VA("BID")) PAT("bid")=$E(X)_VA("BID")
S PAT("dob")=+$P($P(VADM(3),U),".")
S PAT("gender")=$P(VADM(5),U)
S PAT("lrdfn")=+$G(^DPT(DFN,"LR"))
S X=+$P($P(VADM(6),U),".") S:X PAT("died")=X
S X=$$GET1^DIQ(38.1,DFN_",",2,"I") S:$L(X) PAT("sensitive")=X
S X=+VADM(9) S:X PAT("religion")=X
S X=$P(VADM(10),U,2) S:$L(X) PAT("maritalStatus")=$E(X)
I VADM(11) D
. N I S I=0
. F S I=$O(VADM(11,I)) Q:I<1 S X=+VADM(11,I),PAT("ethnicity",X)=$$GET1^DIQ(10.2,X_",",4)
I VADM(12) D
. N I S I=0
. F S I=$O(VADM(12,I)) Q:I<1 S X=+VADM(12,I),PAT("race",X)=$$GET1^DIQ(10,X_",",4)
Q
SVC ;-service data
N VAEL,VASV,VAERR,X,Y,I,AO,IR,PGF,HNC,MST,CV
D 7^VADPT
S PAT("veteran")=VAEL(4)
S PAT("sc")=+VAEL(3) S:VAEL(3) PAT("scPercent")=+$P(VAEL(3),U,2)
;
; exposures
S AO=VASV(2),IR=VASV(3)
S X=$P($G(^DPT(DFN,.322)),U,10),PGF=$S(X="Y":1,X="N":0,1:"")
S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT")))
S HNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"")
S X=$P($$GETSTAT^DGMSTAPI(DFN),U,2),MST=$S(X="Y":1,X="N":0,1:"")
S X=$$CVEDT^DGCV(DFN),CV=$S(+X<0:"",+X=0:0,$P(X,U,3):1,1:0)
S PAT("exposures")=AO_U_IR_U_PGF_U_HNC_U_MST_U_CV
;
; rated disabilities [see DGRPDB]
S I=0 F S I=$O(^DPT(DFN,.372,I)) Q:I<1 D
. N DIS S DIS=$G(^DPT(DFN,.372,I,0))
. S Y=$$GET1^DIQ(31,+DIS_",",.01)
. S PAT("disability",+DIS)=Y_U_$P(DIS,U,2,3) ;name^%^sc
Q
PRF ;-patient record flags
N NHINPF,I,NAME,TEXT
Q:'$$GETACT^DGPFAPI(DFN,"NHINPF")
S I=0 F S I=$O(NHINPF(I)) Q:I<1 D
. S NAME=$P(NHINPF(I,"FLAG"),U,2)
. M TEXT=NHINPF(I,"NARR")
. S PAT("flag",I)=NAME_U_$$STRING^NHINV(.TEXT)
Q
ATC ;-address & telecom
N VAPA,I,X
S VAPA("P")="" D ADD^VADPT ;permanent address
S X="" F I=1:1:4 S X=X_VAPA(I)_U
S X=X_$P(VAPA(5),U,2)_U_$P(VAPA(11),U,2)
S PAT("address")=X ;street1^st2^st3^city^state^zip
S X=VAPA(8)_U_$$GET1^DIQ(2,DFN_",",.134)_U_$$GET1^DIQ(2,DFN_",",.132)
S PAT("telecom")=X ;home^cell^work phones
Q
SUPP ;-support contacts
N VAOA,A,I,X,TYPE
F A="",1 K VAOA D
. S:A VAOA("A")=A D OAD^VADPT Q:'$L($G(VAOA(9)))
. S TYPE=$S(A=1:"ECON",1:"NOK")
. S PAT("support",TYPE)=VAOA(9)_U_VAOA(10) ;name^relationship
. S X="" F I=1:1:4 S X=X_VAOA(I)_U
. S X=X_$P(VAOA(5),U,2)_U_$P(VAOA(11),U,2)
. S PAT("support",TYPE,"address")=X ;street1^st2^st3^city^state^zip
. S I=$S(A=1:.33011,1:.21011),X=VAOA(8)_U_U_$$GET1^DIQ(2,DFN_",",I)
. S PAT("support",TYPE,"telecom")=X ;home^cell^work phones
Q
ALIAS ;-other names used
N I,X
S I=0 F S I=$O(^DPT(DFN,.01,I)) Q:I<1 S X=$G(^(I,0)) D
. S PAT("alias",I)=$P(X,U)
Q
FAC ;-treating facilities [see FACLIST^ORWCIRN]
N IFN S DFN=+$G(DFN) Q:DFN<1
N NHINY,HOME,I,X,IEN
I $L($T(TFL^VAFCTFU1)) D TFL^VAFCTFU1(.NHINY,DFN)
I $P($G(NHINY(1)),U)<0 D Q ;not setup
. S X=$$SITE^VASITE,PAT("facility",+X)=$P(X,U,3)_U_$P(X,U,2)
S HOME=+$P($G(^DPT(DFN,"MPI")),U,3) ;home facility
S I=0 F S I=$O(NHINY(I)) Q:I<1 D
. S X=NHINY(I) Q:$P(X,U)="" ;unknown
. S IEN=+$$IEN^XUAF4($P(X,U))
. I +X=776!(+X=200) S $P(X,U,2)="DEPT. OF DEFENSE"
. S PAT("facility",IEN)=$P(X,U,1,3) ;stn# ^ name ^ last date
. I IEN=HOME S $P(PAT("facility",IEN),U,4)=1
Q
;
INPT ;-current inpt status data
N ADM,X
S ADM=+$G(^DPT(DFN,.105)) I ADM D
. N VAIN,VAERR,HLOC,SVC
. D INP^VADPT S PAT("admitted")=ADM_U_+VAIN(7)
. S PAT("ward")=VAIN(4),PAT("roomBed")=VAIN(5)
. S HLOC=+$G(^DIC(42,+VAIN(4),44)),SVC=$P($G(^(0)),U,3)
. S PAT("location")=HLOC_U_$P(VAIN(4),U,2)
. S:$L(SVC) PAT("locSvc")=SVC_U_$$EXTERNAL^DILFD(42,.03,,SVC)
. S PAT("specialty")=VAIN(3)
. S PAT("attending")=VAIN(11)
. S X=$$FAC^NHINV(HLOC),PAT("site")=X
S PAT("inpatient")=$S(ADM:"true",1:"false")
S X=$$OUTPTPR^SDUTL3(DFN) S:X PAT("pcProvider")=X
S X=$$OUTPTTM^SDUTL3(DFN) S:X PAT("pcTeam")=X
Q
;
; ------------ Return data to middle tier ------------
;
XML(ITEM) ; -- Return patient data as XML in @NHIN@(n)
; as <element code='123' displayName='ABC' />
N ATT,X,Y,I,ID
D ADD("<patient>") S NHINTOTL=$G(NHINTOTL)+1
S ATT="" F S ATT=$O(ITEM(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. I ATT="exposures" D:X["1" S Y="" Q
.. S I=0,Y="<exposures>" D ADD(Y)
.. F ID="AO","IR","PG","HNC","MST","CV" S I=I+1 I $P(X,U,I) S Y="<exposure value='"_ID_"' />" D ADD(Y)
.. D ADD("</exposures>")
. I $L($O(ITEM(ATT,""))) D Q ;multiples
.. S ID=$S($E(ATT,$L(ATT))="s":ATT_"es",$E(ATT,$L(ATT))="y":$E(ATT,1,$L(ATT)-1)_"ies",1:ATT_"s")
.. D ADD("<"_ID_">")
.. S I="" F S I=$O(ITEM(ATT,I)) Q:I="" D D:$L(Y) ADD(Y)
... S X=ITEM(ATT,I),Y="<"_ATT_" "
... I ATT="support" D S Y="" Q
.... S Y=Y_"contactType='"_I_"' name='"_$$ESC^NHINV($P(X,U))_$S($L($P(X,U,2)):"' relationship='"_$$ESC^NHINV($P(X,U,2)),1:"")_"' >" D ADD(Y)
.... S X=$G(ITEM(ATT,I,"address")) I $L(X) D ADDR(X)
.... S X=$G(ITEM(ATT,I,"telecom")) I $L(X) D PHONE(X)
.... D ADD("</support>")
... I ATT="alias" S Y=Y_"fullName='"_$$ESC^NHINV(X)_$S(X[",":"' familyName='"_$$ESC^NHINV($P(X,","))_"' givenNames='"_$$ESC^NHINV($P(X,",",2,99)),1:"")_"' />" Q
... I ATT="flag" S Y=Y_"name='"_$$ESC^NHINV($P(X,U))_"' text='"_$$ESC^NHINV($P(X,U,2))_"' />" Q
... I ATT="facility" S Y=Y_"code='"_$P(X,U)_"' name='"_$$ESC^NHINV($P(X,U,2))_$S($P(X,U,3):"' latestDate='"_$P($P(X,U,3),"."),1:"")_$S($P(X,U,4):"' homeSite='1",1:"")_"' />" Q
... I ATT="disability" S Y=Y_"vaCode='"_I_"' printName='"_$$ESC^NHINV($P(X,U))_$S($P(X,U,2):"' sc='"_$P(X,U,2)_"' scPercent='"_$P(X,U,3),1:"")_"' />" Q
... S Y=Y_"value='"_$$ESC^NHINV(ITEM(ATT,I))_"' />"
.. D ADD("</"_ID_">") S Y=""
. S X=$G(ITEM(ATT)),Y="" Q:'$L(X)
. I ATT="address" D ADDR(X) S Y="" Q
. I ATT="telecom" D PHONE(X) S Y="" Q
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
. S Y="<"_ATT_" code='"_$P(X,U)_"' name='"_$$ESC^NHINV($P(X,U,2))_"' />"
D ADD("</patient>")
Q
;
ADDR(X) ; -- XML address node from X=street1^st2^st3^city^state^zip
N I,Y Q:$L(X)'>5 ;no data
S Y="<address"
F I=1,2,3 I $L($P(X,U,I)) S Y=Y_" streetLine"_I_"='"_$$ESC^NHINV($P(X,U,I))_"'"
I $L($P(X,U,4)) S Y=Y_" city='"_$$ESC^NHINV($P(X,U,4))_"'"
I $L($P(X,U,5)) S Y=Y_" stateProvince='"_$P(X,U,5)_"'"
I $L($P(X,U,6)) S Y=Y_" postalCode='"_$P(X,U,6)_"'"
S Y=Y_" />" D ADD(Y)
Q
;
PHONE(X) ; -- XML telecom node from X=home^cell^work numbers
N I,Y Q:$L(X)'>2 ;no data
D ADD("<telecomList>")
I $L($P(X,U,1)) S Y="<telecom usageType='H' value='"_$P(X,U,1)_"' />" D ADD(Y)
I $L($P(X,U,2)) S Y="<telecom usageType='MC' value='"_$P(X,U,2)_"' />" D ADD(Y)
I $L($P(X,U,3)) S Y="<telecom usageType='WP' value='"_$P(X,U,3)_"' />" D ADD(Y)
D ADD("</telecomList>")
Q
;
ADD(X) ; Add a line @NHIN@(n)=X
S NHINI=$G(NHINI)+1
S @NHIN@(NHINI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVPT 7981 printed Sep 23, 2025@19:53:48 Page 2
NHINVPT ;SLC/MKB -- Patient demographics extract
+1 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
+2 ;
+3 ; External References DBIA#
+4 ; ------------------- -----
+5 ; ^DIC(42 10039
+6 ; ^DPT 10035
+7 ; DGCV 4156
+8 ; DGMSTAPI 2716
+9 ; DGNTAPI 3457
+10 ; DGPFAPI 3860
+11 ; DILFD 2055
+12 ; DIQ 2056
+13 ; MPIF001 2701
+14 ; SDUTL3 1252
+15 ; VADPT 10061
+16 ; VAFCTFU1 2990
+17 ; VASITE 10112
+18 ; XUAF4 2171
+19 ;
+20 ; ------------ Get data from VistA ------------
+21 ;
EN(DFN,BEG,END,MAX,ID) ; -- find current patient demographics
+1 ; [BEG,END,MAX,ID not currently used]
+2 ;invalid patient
SET DFN=+$GET(DFN)
if DFN<1
QUIT
+3 NEW PAT,SYS
SET SYS=$$SITE^VASITE
+4 DO DEM
DO SVC
DO PRF
DO ATC
DO SUPP
DO ALIAS
DO FAC
+5 IF $DATA(PAT)>9
DO XML(.PAT)
+6 QUIT
+7 ;
DEM ;-demographic data
+1 NEW VADM,VA,VAERR,X
+2 SET X=+$$GETICN^MPIF001(DFN)
if X>1
SET PAT("icn")=X
+3 DO DEM^VADPT
SET X=VADM(1)
SET PAT("fullName")=X
+4 SET PAT("familyName")=$PIECE(X,",")
SET PAT("givenNames")=$PIECE(X,",",2,99)
+5 SET PAT("ssn")=$PIECE(VADM(2),U)
SET PAT("id")=DFN
+6 if $DATA(VA("BID"))
SET PAT("bid")=$EXTRACT(X)_VA("BID")
+7 SET PAT("dob")=+$PIECE($PIECE(VADM(3),U),".")
+8 SET PAT("gender")=$PIECE(VADM(5),U)
+9 SET PAT("lrdfn")=+$GET(^DPT(DFN,"LR"))
+10 SET X=+$PIECE($PIECE(VADM(6),U),".")
if X
SET PAT("died")=X
+11 SET X=$$GET1^DIQ(38.1,DFN_",",2,"I")
if $LENGTH(X)
SET PAT("sensitive")=X
+12 SET X=+VADM(9)
if X
SET PAT("religion")=X
+13 SET X=$PIECE(VADM(10),U,2)
if $LENGTH(X)
SET PAT("maritalStatus")=$EXTRACT(X)
+14 IF VADM(11)
Begin DoDot:1
+15 NEW I
SET I=0
+16 FOR
SET I=$ORDER(VADM(11,I))
if I<1
QUIT
SET X=+VADM(11,I)
SET PAT("ethnicity",X)=$$GET1^DIQ(10.2,X_",",4)
End DoDot:1
+17 IF VADM(12)
Begin DoDot:1
+18 NEW I
SET I=0
+19 FOR
SET I=$ORDER(VADM(12,I))
if I<1
QUIT
SET X=+VADM(12,I)
SET PAT("race",X)=$$GET1^DIQ(10,X_",",4)
End DoDot:1
+20 QUIT
SVC ;-service data
+1 NEW VAEL,VASV,VAERR,X,Y,I,AO,IR,PGF,HNC,MST,CV
+2 DO 7^VADPT
+3 SET PAT("veteran")=VAEL(4)
+4 SET PAT("sc")=+VAEL(3)
if VAEL(3)
SET PAT("scPercent")=+$PIECE(VAEL(3),U,2)
+5 ;
+6 ; exposures
+7 SET AO=VASV(2)
SET IR=VASV(3)
+8 SET X=$PIECE($GET(^DPT(DFN,.322)),U,10)
SET PGF=$SELECT(X="Y":1,X="N":0,1:"")
+9 SET X=$$GETCUR^DGNTAPI(DFN,"HNC")
SET X=+($GET(HNC("STAT")))
+10 SET HNC=$SELECT(X=4:1,X=5:1,X=1:0,X=6:0,1:"")
+11 SET X=$PIECE($$GETSTAT^DGMSTAPI(DFN),U,2)
SET MST=$SELECT(X="Y":1,X="N":0,1:"")
+12 SET X=$$CVEDT^DGCV(DFN)
SET CV=$SELECT(+X<0:"",+X=0:0,$PIECE(X,U,3):1,1:0)
+13 SET PAT("exposures")=AO_U_IR_U_PGF_U_HNC_U_MST_U_CV
+14 ;
+15 ; rated disabilities [see DGRPDB]
+16 SET I=0
FOR
SET I=$ORDER(^DPT(DFN,.372,I))
if I<1
QUIT
Begin DoDot:1
+17 NEW DIS
SET DIS=$GET(^DPT(DFN,.372,I,0))
+18 SET Y=$$GET1^DIQ(31,+DIS_",",.01)
+19 ;name^%^sc
SET PAT("disability",+DIS)=Y_U_$PIECE(DIS,U,2,3)
End DoDot:1
+20 QUIT
PRF ;-patient record flags
+1 NEW NHINPF,I,NAME,TEXT
+2 if '$$GETACT^DGPFAPI(DFN,"NHINPF")
QUIT
+3 SET I=0
FOR
SET I=$ORDER(NHINPF(I))
if I<1
QUIT
Begin DoDot:1
+4 SET NAME=$PIECE(NHINPF(I,"FLAG"),U,2)
+5 MERGE TEXT=NHINPF(I,"NARR")
+6 SET PAT("flag",I)=NAME_U_$$STRING^NHINV(.TEXT)
End DoDot:1
+7 QUIT
ATC ;-address & telecom
+1 NEW VAPA,I,X
+2 ;permanent address
SET VAPA("P")=""
DO ADD^VADPT
+3 SET X=""
FOR I=1:1:4
SET X=X_VAPA(I)_U
+4 SET X=X_$PIECE(VAPA(5),U,2)_U_$PIECE(VAPA(11),U,2)
+5 ;street1^st2^st3^city^state^zip
SET PAT("address")=X
+6 SET X=VAPA(8)_U_$$GET1^DIQ(2,DFN_",",.134)_U_$$GET1^DIQ(2,DFN_",",.132)
+7 ;home^cell^work phones
SET PAT("telecom")=X
+8 QUIT
SUPP ;-support contacts
+1 NEW VAOA,A,I,X,TYPE
+2 FOR A="",1
KILL VAOA
Begin DoDot:1
+3 if A
SET VAOA("A")=A
DO OAD^VADPT
if '$LENGTH($GET(VAOA(9)))
QUIT
+4 SET TYPE=$SELECT(A=1:"ECON",1:"NOK")
+5 ;name^relationship
SET PAT("support",TYPE)=VAOA(9)_U_VAOA(10)
+6 SET X=""
FOR I=1:1:4
SET X=X_VAOA(I)_U
+7 SET X=X_$PIECE(VAOA(5),U,2)_U_$PIECE(VAOA(11),U,2)
+8 ;street1^st2^st3^city^state^zip
SET PAT("support",TYPE,"address")=X
+9 SET I=$SELECT(A=1:.33011,1:.21011)
SET X=VAOA(8)_U_U_$$GET1^DIQ(2,DFN_",",I)
+10 ;home^cell^work phones
SET PAT("support",TYPE,"telecom")=X
End DoDot:1
+11 QUIT
ALIAS ;-other names used
+1 NEW I,X
+2 SET I=0
FOR
SET I=$ORDER(^DPT(DFN,.01,I))
if I<1
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+3 SET PAT("alias",I)=$PIECE(X,U)
End DoDot:1
+4 QUIT
FAC ;-treating facilities [see FACLIST^ORWCIRN]
+1 NEW IFN
SET DFN=+$GET(DFN)
if DFN<1
QUIT
+2 NEW NHINY,HOME,I,X,IEN
+3 IF $LENGTH($TEXT(TFL^VAFCTFU1))
DO TFL^VAFCTFU1(.NHINY,DFN)
+4 ;not setup
IF $PIECE($GET(NHINY(1)),U)<0
Begin DoDot:1
+5 SET X=$$SITE^VASITE
SET PAT("facility",+X)=$PIECE(X,U,3)_U_$PIECE(X,U,2)
End DoDot:1
QUIT
+6 ;home facility
SET HOME=+$PIECE($GET(^DPT(DFN,"MPI")),U,3)
+7 SET I=0
FOR
SET I=$ORDER(NHINY(I))
if I<1
QUIT
Begin DoDot:1
+8 ;unknown
SET X=NHINY(I)
if $PIECE(X,U)=""
QUIT
+9 SET IEN=+$$IEN^XUAF4($PIECE(X,U))
+10 IF +X=776!(+X=200)
SET $PIECE(X,U,2)="DEPT. OF DEFENSE"
+11 ;stn# ^ name ^ last date
SET PAT("facility",IEN)=$PIECE(X,U,1,3)
+12 IF IEN=HOME
SET $PIECE(PAT("facility",IEN),U,4)=1
End DoDot:1
+13 QUIT
+14 ;
INPT ;-current inpt status data
+1 NEW ADM,X
+2 SET ADM=+$GET(^DPT(DFN,.105))
IF ADM
Begin DoDot:1
+3 NEW VAIN,VAERR,HLOC,SVC
+4 DO INP^VADPT
SET PAT("admitted")=ADM_U_+VAIN(7)
+5 SET PAT("ward")=VAIN(4)
SET PAT("roomBed")=VAIN(5)
+6 SET HLOC=+$GET(^DIC(42,+VAIN(4),44))
SET SVC=$PIECE($GET(^(0)),U,3)
+7 SET PAT("location")=HLOC_U_$PIECE(VAIN(4),U,2)
+8 if $LENGTH(SVC)
SET PAT("locSvc")=SVC_U_$$EXTERNAL^DILFD(42,.03,,SVC)
+9 SET PAT("specialty")=VAIN(3)
+10 SET PAT("attending")=VAIN(11)
+11 SET X=$$FAC^NHINV(HLOC)
SET PAT("site")=X
End DoDot:1
+12 SET PAT("inpatient")=$SELECT(ADM:"true",1:"false")
+13 SET X=$$OUTPTPR^SDUTL3(DFN)
if X
SET PAT("pcProvider")=X
+14 SET X=$$OUTPTTM^SDUTL3(DFN)
if X
SET PAT("pcTeam")=X
+15 QUIT
+16 ;
+17 ; ------------ Return data to middle tier ------------
+18 ;
XML(ITEM) ; -- Return patient data as XML in @NHIN@(n)
+1 ; as <element code='123' displayName='ABC' />
+2 NEW ATT,X,Y,I,ID
+3 DO ADD("<patient>")
SET NHINTOTL=$GET(NHINTOTL)+1
+4 SET ATT=""
FOR
SET ATT=$ORDER(ITEM(ATT))
if ATT=""
QUIT
Begin DoDot:1
+5 IF ATT="exposures"
if X["1"
Begin DoDot:2
+6 SET I=0
SET Y="<exposures>"
DO ADD(Y)
+7 FOR ID="AO","IR","PG","HNC","MST","CV"
SET I=I+1
IF $PIECE(X,U,I)
SET Y="<exposure value='"_ID_"' />"
DO ADD(Y)
+8 DO ADD("</exposures>")
End DoDot:2
SET Y=""
QUIT
+9 ;multiples
IF $LENGTH($ORDER(ITEM(ATT,"")))
Begin DoDot:2
+10 SET ID=$SELECT($EXTRACT(ATT,$LENGTH(ATT))="s":ATT_"es",$EXTRACT(ATT,$LENGTH(ATT))="y":$EXTRACT(ATT,1,$LENGTH(ATT)-1)_"ies",1:ATT_"s")
+11 DO ADD("<"_ID_">")
+12 SET I=""
FOR
SET I=$ORDER(ITEM(ATT,I))
if I=""
QUIT
Begin DoDot:3
+13 SET X=ITEM(ATT,I)
SET Y="<"_ATT_" "
+14 IF ATT="support"
Begin DoDot:4
+15 SET Y=Y_"contactType='"_I_"' name='"_$$ESC^NHINV($PIECE(X,U))_$SELECT($LENGTH($PIECE(X,U,2)):"' relationship='"_$$ESC^NHINV($PIECE(X,U,2)),1:"")_"' >"
DO ADD(Y)
+16 SET X=$GET(ITEM(ATT,I,"address"))
IF $LENGTH(X)
DO ADDR(X)
+17 SET X=$GET(ITEM(ATT,I,"telecom"))
IF $LENGTH(X)
DO PHONE(X)
+18 DO ADD("</support>")
End DoDot:4
SET Y=""
QUIT
+19 IF ATT="alias"
SET Y=Y_"fullName='"_$$ESC^NHINV(X)_$SELECT(X[",":"' familyName='"_$$ESC^NHINV($PIECE(X,","))_"' givenNames='"_$$ESC^NHINV($PIECE(X,",",2,99)),1:"")_"' />"
QUIT
+20 IF ATT="flag"
SET Y=Y_"name='"_$$ESC^NHINV($PIECE(X,U))_"' text='"_$$ESC^NHINV($PIECE(X,U,2))_"' />"
QUIT
+21 IF ATT="facility"
SET Y=Y_"code='"_$PIECE(X,U)_"' name='"_$$ESC^NHINV($PIECE(X,U,2))_$SELECT($PIECE(X,U,3):"' latestDate='"_$PIECE($PIECE(X,U,3),"."),1:"")_$SELECT($PIECE(X,U,4):"' homeSite='1",1:"")_"' />"
QUIT
+22 IF ATT="disability"
SET Y=Y_"vaCode='"_I_"' printName='"_$$ESC^NHINV($PIECE(X,U))_$SELECT($PIECE(X,U,2):"' sc='"_$PIECE(X,U,2)_"' scPercent='"_$PIECE(X,U,3),1:"")_"' />"
QUIT
+23 SET Y=Y_"value='"_$$ESC^NHINV(ITEM(ATT,I))_"' />"
End DoDot:3
if $LENGTH(Y)
DO ADD(Y)
+24 DO ADD("</"_ID_">")
SET Y=""
End DoDot:2
QUIT
+25 SET X=$GET(ITEM(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+26 IF ATT="address"
DO ADDR(X)
SET Y=""
QUIT
+27 IF ATT="telecom"
DO PHONE(X)
SET Y=""
QUIT
+28 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
QUIT
+29 SET Y="<"_ATT_" code='"_$PIECE(X,U)_"' name='"_$$ESC^NHINV($PIECE(X,U,2))_"' />"
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+30 DO ADD("</patient>")
+31 QUIT
+32 ;
ADDR(X) ; -- XML address node from X=street1^st2^st3^city^state^zip
+1 ;no data
NEW I,Y
if $LENGTH(X)'>5
QUIT
+2 SET Y="<address"
+3 FOR I=1,2,3
IF $LENGTH($PIECE(X,U,I))
SET Y=Y_" streetLine"_I_"='"_$$ESC^NHINV($PIECE(X,U,I))_"'"
+4 IF $LENGTH($PIECE(X,U,4))
SET Y=Y_" city='"_$$ESC^NHINV($PIECE(X,U,4))_"'"
+5 IF $LENGTH($PIECE(X,U,5))
SET Y=Y_" stateProvince='"_$PIECE(X,U,5)_"'"
+6 IF $LENGTH($PIECE(X,U,6))
SET Y=Y_" postalCode='"_$PIECE(X,U,6)_"'"
+7 SET Y=Y_" />"
DO ADD(Y)
+8 QUIT
+9 ;
PHONE(X) ; -- XML telecom node from X=home^cell^work numbers
+1 ;no data
NEW I,Y
if $LENGTH(X)'>2
QUIT
+2 DO ADD("<telecomList>")
+3 IF $LENGTH($PIECE(X,U,1))
SET Y="<telecom usageType='H' value='"_$PIECE(X,U,1)_"' />"
DO ADD(Y)
+4 IF $LENGTH($PIECE(X,U,2))
SET Y="<telecom usageType='MC' value='"_$PIECE(X,U,2)_"' />"
DO ADD(Y)
+5 IF $LENGTH($PIECE(X,U,3))
SET Y="<telecom usageType='WP' value='"_$PIECE(X,U,3)_"' />"
DO ADD(Y)
+6 DO ADD("</telecomList>")
+7 QUIT
+8 ;
ADD(X) ; Add a line @NHIN@(n)=X
+1 SET NHINI=$GET(NHINI)+1
+2 SET @NHIN@(NHINI)=X
+3 QUIT
