NHINVIT ;SLC/MKB -- Vitals extract
;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
;
; External References DBIA#
; ------------------- -----
; ^SC 10040
; ^VA(200 10060
; DIC 2051
; DIQ 2056
; GMRVUT0,^UTILITY($J,"GMRVD") 1446
; GMVPXRM 3647
;
; ------------ Get vitals from VistA ------------
;
EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
N NHITM,NHIPRM,GMRVSTR,IDT,TYPE,VIT,CNT,X0,X,Y,I,N
S DFN=+$G(DFN) Q:DFN<1
;
; get one measurement
I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
;
; get all measurements
S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
S GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN",GMRVSTR(0)=BEG_U_END_U_MAX_"^1"
K ^UTILITY($J,"GMRVD") D EN1^GMRVUT0
S (IDT,CNT)=0 F S IDT=$O(^UTILITY($J,"GMRVD",IDT)) Q:IDT<1 D Q:CNT'<MAX
. K VIT S VIT("taken")=9999999-IDT,CNT=CNT+1,N=0
. S TYPE="" F S TYPE=$O(^UTILITY($J,"GMRVD",IDT,TYPE)) Q:TYPE="" D
.. N NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,QUAL
.. S IFN=+$O(^UTILITY($J,"GMRVD",IDT,TYPE,0)),X0=$G(^(IFN))
.. S X=+$P(X0,U,3),NAME=$$GET1^DIQ(120.5,IFN_",",.03)
.. S VUID=$$VUID^NHINV(X,120.51),RESULT=$P(X0,U,8)
.. S UNIT=$S(TYPE="T":"F",TYPE="HT":"in",TYPE="WT":"lb",TYPE="CVP":"cmH2O",TYPE="CG":"in",1:"")
.. S (MRES,MUNT)="" I $L($P(X0,U,13)) D
... S X=$S(TYPE="T":"C",TYPE="HT":"cm",TYPE="WT":"kg",TYPE="CG":"cm",1:"")
... S MRES=$P(X0,U,13) S:$L(X) MUNT=X
.. S X=$$RANGE(TYPE),(HIGH,LOW)="" I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
.. S N=N+1,VIT("measurement",N)=IFN_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
.. S QUAL=$P(X0,U,17) I $L(QUAL) F I=1:1:$L(QUAL,";") D
... S X=$P(QUAL,";",I),Y=$$FIND1^DIC(120.52,,"QX",X)
... I Y S VIT("measurement",N,"qualifier",I)=X_U_$$VUID^NHINV(Y,120.52)
. S VIT("entered")=$P($G(X0),U,4) ;use last one
. S X=+$P($G(X0),U,5) S:X VIT("location")=$$LOC(X)
. S VIT("facility")=$$FAC^NHINV(X)
. D XML(.VIT)
K ^UTILITY($J,"GMRVD")
Q
;
EN1(ID,VIT) ; -- return a vital/measurement in VIT("attribute")
K VIT S ID=+$G(ID) Q:ID<1 ;invalid ien
N NHY,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
D EN^GMVPXRM(.NHY,ID,"B")
S DFN=+$G(NHY(2)) Q:DFN<1
S TYPE=$$GET1^DIQ(120.51,+NHY(3)_",",1)
S VIT("facility")=$$FAC^NHINV(+NHY(5)),VIT("location")=NHY(5)
S NAME=$P(NHY(3),U,2),VUID=$$VUID^NHINV(+NHY(3),120.51)
S X=$P(NHY(7),U,2),RESULT=X,(UNIT,MRES,MUNT)=""
I TYPE="T" S UNIT="F",MUNT="C" S MRES=$J(X-32*5/9,0,1) ; EN1^GMRVUTL
I TYPE="HT" S UNIT="in",MUNT="cm" S MRES=$J(2.54*X,0,2) ; EN2^GMRVUTL
I TYPE="WT" S UNIT="lb",MUNT="kg" S MRES=$J(X/2.2,0,2) ; EN3^GMRVUTL
I TYPE="CG" S UNIT="in",MUNT="cm" S MRES=$J(2.54*X,0,2)
I TYPE="CVP" S UNIT="cmH2O"
S VIT("taken")=+NHY(1),VIT("entered")=+NHY(4),(HIGH,LOW)=""
S X=$$RANGE(TYPE) I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
S VIT("measurement",1)=ID_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
S I=0 F S I=$O(NHY(12,I)) Q:I<1 S X=$G(NHY(12,I)),VIT("measurement",1,"qualifier",I)=$P(X,U,2)_U_$$VUID^NHINV(+X,120.52)
I $G(NHY(9)) D ;entered in error/reasons
. S I=0 F S I=$O(NHY(11,I)) Q:I<1 S VIT("removed",I)=$P(NHY(11,I),U,2)
Q
;
USER(X) ; -- Return ien^name for person# X
N Y S X=+$G(X)
S Y=$S(X:X_U_$P($G(^VA(200,X,0)),U),1:"^")
Q Y
;
LOC(X) ; -- Return ien^name for hospital location X
N Y S X=+$G(X)
S Y=$S(X:X_U_$P($G(^SC(X,0)),U),1:"^")
Q Y
;
RANGE(TYPE) ; -- return high^low range of values for TYPE
N Y S Y="" I '$D(NHIPRM) D ;get parameter values
. N VAL D GETS^DIQ(120.57,"1,","5:7","","VAL")
. M NHIPRM=VAL(120.57,"1,")
I TYPE="T" S Y=$G(NHIPRM(5.1))_U_$G(NHIPRM(5.2))
I TYPE="P" S Y=$G(NHIPRM(5.3))_U_$G(NHIPRM(5.4))
I TYPE="R" S Y=$G(NHIPRM(5.5))_U_$G(NHIPRM(5.6))
I TYPE="CVP" S Y=$G(NHIPRM(6.1))_U_$G(NHIPRM(6.2))
I TYPE="PO2" S Y="100^"_$G(NHIPRM(6.3))
I TYPE="BP" D
. S Y=$G(NHIPRM(5.7))_"/"_$G(NHIPRM(5.71))_U
. S Y=Y_$G(NHIPRM(5.8))_"/"_$G(NHIPRM(5.81))
Q Y
;
; ------------ Return data to middle tier ------------
;
NAME(X) ; -- Return name of measurement type X for XML element
N Y S X=$G(X),Y=""
S Y=$S(X="BP":"bloodPressure",X="T":"temperature",X="R":"respiration",X="P":"pulse",X="HT":"height",X="WT":"weight",X="CVP":"centralVenousPressure",X="CG":"circumferenceGirth",X="PO2":"pulseOximetry",X="PN":"pain",1:"")
Q Y
;
XML(VIT) ; -- Return vital measurement as XML in @NHIN@(#)
N ATT,X,Y,I,J,P,NAMES,TAG
D ADD("<vital>") S NHINTOTL=$G(NHINTOTL)+1
S ATT="" F S ATT=$O(VIT(ATT)) Q:ATT="" D
. I ATT="measurement" D Q
.. D ADD("<measurements>")
.. S NAMES="id^vuid^name^value^units^metricValue^metricUnits^high^low^Z"
.. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 D
... S X=$G(VIT(ATT,I)),Y="<"_ATT_" "
... F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
... I '$D(VIT(ATT,I,"qualifier")) S Y=Y_"/>" D ADD(Y) Q
... S Y=Y_">" D ADD(Y),ADD("<qualifiers>")
... S J=0 F S J=$O(VIT(ATT,I,"qualifier",J)) Q:J<1 D
.... S Y="<qualifier ",X=$G(VIT(ATT,I,"qualifier",J))
.... F P=1:1 S TAG=$P("name^vuid^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
.... S Y=Y_"/>" D ADD(Y)
... D ADD("</qualifiers>"),ADD("</measurement>")
.. D ADD("</measurements>")
. I ATT="removed" D Q
.. D ADD("<removed>")
.. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 S Y="<reason value='"_$G(VIT(ATT,I))_"' />" D ADD(Y)
.. D ADD("</removed>")
. S X=$G(VIT(ATT)),Y="" Q:'$L(X)
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" D ADD(Y) Q
. I $L(X)>1 D
.. S Y="<"_ATT_" "
.. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
.. S Y=Y_"/>" D ADD(Y)
D ADD("</vital>")
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[HNHINVIT 5944 printed Apr 09, 2024@21:20:30 Page 2
NHINVIT ;SLC/MKB -- Vitals extract
+1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
+2 ;
+3 ; External References DBIA#
+4 ; ------------------- -----
+5 ; ^SC 10040
+6 ; ^VA(200 10060
+7 ; DIC 2051
+8 ; DIQ 2056
+9 ; GMRVUT0,^UTILITY($J,"GMRVD") 1446
+10 ; GMVPXRM 3647
+11 ;
+12 ; ------------ Get vitals from VistA ------------
+13 ;
EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
+1 NEW NHITM,NHIPRM,GMRVSTR,IDT,TYPE,VIT,CNT,X0,X,Y,I,N
+2 SET DFN=+$GET(DFN)
if DFN<1
QUIT
+3 ;
+4 ; get one measurement
+5 IF $GET(IFN)
DO EN1(IFN,.NHITM)
DO XML(.NHITM)
QUIT
+6 ;
+7 ; get all measurements
+8 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,9999998)
SET MAX=$GET(MAX,999999)
+9 SET GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN"
SET GMRVSTR(0)=BEG_U_END_U_MAX_"^1"
+10 KILL ^UTILITY($JOB,"GMRVD")
DO EN1^GMRVUT0
+11 SET (IDT,CNT)=0
FOR
SET IDT=$ORDER(^UTILITY($JOB,"GMRVD",IDT))
if IDT<1
QUIT
Begin DoDot:1
+12 KILL VIT
SET VIT("taken")=9999999-IDT
SET CNT=CNT+1
SET N=0
+13 SET TYPE=""
FOR
SET TYPE=$ORDER(^UTILITY($JOB,"GMRVD",IDT,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+14 NEW NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,QUAL
+15 SET IFN=+$ORDER(^UTILITY($JOB,"GMRVD",IDT,TYPE,0))
SET X0=$GET(^(IFN))
+16 SET X=+$PIECE(X0,U,3)
SET NAME=$$GET1^DIQ(120.5,IFN_",",.03)
+17 SET VUID=$$VUID^NHINV(X,120.51)
SET RESULT=$PIECE(X0,U,8)
+18 SET UNIT=$SELECT(TYPE="T":"F",TYPE="HT":"in",TYPE="WT":"lb",TYPE="CVP":"cmH2O",TYPE="CG":"in",1:"")
+19 SET (MRES,MUNT)=""
IF $LENGTH($PIECE(X0,U,13))
Begin DoDot:3
+20 SET X=$SELECT(TYPE="T":"C",TYPE="HT":"cm",TYPE="WT":"kg",TYPE="CG":"cm",1:"")
+21 SET MRES=$PIECE(X0,U,13)
if $LENGTH(X)
SET MUNT=X
End DoDot:3
+22 SET X=$$RANGE(TYPE)
SET (HIGH,LOW)=""
IF $LENGTH(X)
SET HIGH=$PIECE(X,U)
SET LOW=$PIECE(X,U,2)
+23 SET N=N+1
SET VIT("measurement",N)=IFN_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
+24 SET QUAL=$PIECE(X0,U,17)
IF $LENGTH(QUAL)
FOR I=1:1:$LENGTH(QUAL,";")
Begin DoDot:3
+25 SET X=$PIECE(QUAL,";",I)
SET Y=$$FIND1^DIC(120.52,,"QX",X)
+26 IF Y
SET VIT("measurement",N,"qualifier",I)=X_U_$$VUID^NHINV(Y,120.52)
End DoDot:3
End DoDot:2
+27 ;use last one
SET VIT("entered")=$PIECE($GET(X0),U,4)
+28 SET X=+$PIECE($GET(X0),U,5)
if X
SET VIT("location")=$$LOC(X)
+29 SET VIT("facility")=$$FAC^NHINV(X)
+30 DO XML(.VIT)
End DoDot:1
if CNT'<MAX
QUIT
+31 KILL ^UTILITY($JOB,"GMRVD")
+32 QUIT
+33 ;
EN1(ID,VIT) ; -- return a vital/measurement in VIT("attribute")
+1 ;invalid ien
KILL VIT
SET ID=+$GET(ID)
if ID<1
QUIT
+2 NEW NHY,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
+3 DO EN^GMVPXRM(.NHY,ID,"B")
+4 SET DFN=+$GET(NHY(2))
if DFN<1
QUIT
+5 SET TYPE=$$GET1^DIQ(120.51,+NHY(3)_",",1)
+6 SET VIT("facility")=$$FAC^NHINV(+NHY(5))
SET VIT("location")=NHY(5)
+7 SET NAME=$PIECE(NHY(3),U,2)
SET VUID=$$VUID^NHINV(+NHY(3),120.51)
+8 SET X=$PIECE(NHY(7),U,2)
SET RESULT=X
SET (UNIT,MRES,MUNT)=""
+9 ; EN1^GMRVUTL
IF TYPE="T"
SET UNIT="F"
SET MUNT="C"
SET MRES=$JUSTIFY(X-32*5/9,0,1)
+10 ; EN2^GMRVUTL
IF TYPE="HT"
SET UNIT="in"
SET MUNT="cm"
SET MRES=$JUSTIFY(2.54*X,0,2)
+11 ; EN3^GMRVUTL
IF TYPE="WT"
SET UNIT="lb"
SET MUNT="kg"
SET MRES=$JUSTIFY(X/2.2,0,2)
+12 IF TYPE="CG"
SET UNIT="in"
SET MUNT="cm"
SET MRES=$JUSTIFY(2.54*X,0,2)
+13 IF TYPE="CVP"
SET UNIT="cmH2O"
+14 SET VIT("taken")=+NHY(1)
SET VIT("entered")=+NHY(4)
SET (HIGH,LOW)=""
+15 SET X=$$RANGE(TYPE)
IF $LENGTH(X)
SET HIGH=$PIECE(X,U)
SET LOW=$PIECE(X,U,2)
+16 SET VIT("measurement",1)=ID_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
+17 SET I=0
FOR
SET I=$ORDER(NHY(12,I))
if I<1
QUIT
SET X=$GET(NHY(12,I))
SET VIT("measurement",1,"qualifier",I)=$PIECE(X,U,2)_U_$$VUID^NHINV(+X,120.52)
+18 ;entered in error/reasons
IF $GET(NHY(9))
Begin DoDot:1
+19 SET I=0
FOR
SET I=$ORDER(NHY(11,I))
if I<1
QUIT
SET VIT("removed",I)=$PIECE(NHY(11,I),U,2)
End DoDot:1
+20 QUIT
+21 ;
USER(X) ; -- Return ien^name for person# X
+1 NEW Y
SET X=+$GET(X)
+2 SET Y=$SELECT(X:X_U_$PIECE($GET(^VA(200,X,0)),U),1:"^")
+3 QUIT Y
+4 ;
LOC(X) ; -- Return ien^name for hospital location X
+1 NEW Y
SET X=+$GET(X)
+2 SET Y=$SELECT(X:X_U_$PIECE($GET(^SC(X,0)),U),1:"^")
+3 QUIT Y
+4 ;
RANGE(TYPE) ; -- return high^low range of values for TYPE
+1 ;get parameter values
NEW Y
SET Y=""
IF '$DATA(NHIPRM)
Begin DoDot:1
+2 NEW VAL
DO GETS^DIQ(120.57,"1,","5:7","","VAL")
+3 MERGE NHIPRM=VAL(120.57,"1,")
End DoDot:1
+4 IF TYPE="T"
SET Y=$GET(NHIPRM(5.1))_U_$GET(NHIPRM(5.2))
+5 IF TYPE="P"
SET Y=$GET(NHIPRM(5.3))_U_$GET(NHIPRM(5.4))
+6 IF TYPE="R"
SET Y=$GET(NHIPRM(5.5))_U_$GET(NHIPRM(5.6))
+7 IF TYPE="CVP"
SET Y=$GET(NHIPRM(6.1))_U_$GET(NHIPRM(6.2))
+8 IF TYPE="PO2"
SET Y="100^"_$GET(NHIPRM(6.3))
+9 IF TYPE="BP"
Begin DoDot:1
+10 SET Y=$GET(NHIPRM(5.7))_"/"_$GET(NHIPRM(5.71))_U
+11 SET Y=Y_$GET(NHIPRM(5.8))_"/"_$GET(NHIPRM(5.81))
End DoDot:1
+12 QUIT Y
+13 ;
+14 ; ------------ Return data to middle tier ------------
+15 ;
NAME(X) ; -- Return name of measurement type X for XML element
+1 NEW Y
SET X=$GET(X)
SET Y=""
+2 SET Y=$SELECT(X="BP":"bloodPressure",X="T":"temperature",X="R":"respiration",X="P":"pulse",X="HT":"height",X="WT":"weight",X="CVP":"centralVenousPressure",X="CG":"circumferenceGirth",X="PO2":"pulseOximetry",X="PN":"pain",1:"")
+3 QUIT Y
+4 ;
XML(VIT) ; -- Return vital measurement as XML in @NHIN@(#)
+1 NEW ATT,X,Y,I,J,P,NAMES,TAG
+2 DO ADD("<vital>")
SET NHINTOTL=$GET(NHINTOTL)+1
+3 SET ATT=""
FOR
SET ATT=$ORDER(VIT(ATT))
if ATT=""
QUIT
Begin DoDot:1
+4 IF ATT="measurement"
Begin DoDot:2
+5 DO ADD("<measurements>")
+6 SET NAMES="id^vuid^name^value^units^metricValue^metricUnits^high^low^Z"
+7 SET I=0
FOR
SET I=$ORDER(VIT(ATT,I))
if I<1
QUIT
Begin DoDot:3
+8 SET X=$GET(VIT(ATT,I))
SET Y="<"_ATT_" "
+9 FOR P=1:1
SET TAG=$PIECE(NAMES,U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET Y=Y_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
+10 IF '$DATA(VIT(ATT,I,"qualifier"))
SET Y=Y_"/>"
DO ADD(Y)
QUIT
+11 SET Y=Y_">"
DO ADD(Y)
DO ADD("<qualifiers>")
+12 SET J=0
FOR
SET J=$ORDER(VIT(ATT,I,"qualifier",J))
if J<1
QUIT
Begin DoDot:4
+13 SET Y="<qualifier "
SET X=$GET(VIT(ATT,I,"qualifier",J))
+14 FOR P=1:1
SET TAG=$PIECE("name^vuid^Z",U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET Y=Y_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
+15 SET Y=Y_"/>"
DO ADD(Y)
End DoDot:4
+16 DO ADD("</qualifiers>")
DO ADD("</measurement>")
End DoDot:3
+17 DO ADD("</measurements>")
End DoDot:2
QUIT
+18 IF ATT="removed"
Begin DoDot:2
+19 DO ADD("<removed>")
+20 SET I=0
FOR
SET I=$ORDER(VIT(ATT,I))
if I<1
QUIT
SET Y="<reason value='"_$GET(VIT(ATT,I))_"' />"
DO ADD(Y)
+21 DO ADD("</removed>")
End DoDot:2
QUIT
+22 SET X=$GET(VIT(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+23 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
DO ADD(Y)
QUIT
+24 IF $LENGTH(X)>1
Begin DoDot:2
+25 SET Y="<"_ATT_" "
+26 FOR P=1:1
SET TAG=$PIECE("code^name^Z",U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET Y=Y_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
+27 SET Y=Y_"/>"
DO ADD(Y)
End DoDot:2
End DoDot:1
+28 DO ADD("</vital>")
+29 QUIT
+30 ;
ADD(X) ; Add a line @NHIN@(n)=X
+1 SET NHINI=$GET(NHINI)+1
+2 SET @NHIN@(NHINI)=X
+3 QUIT
