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

VPRDGMV.m

Go to the documentation of this file.
  1. VPRDGMV ;SLC/MKB -- Vitals extract ;8/2/11 15:29
  1. ;;1.0;VIRTUAL PATIENT RECORD;**1,4**;Sep 01, 2011;Build 6
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^SC 10040
  1. ; ^VA(200 10060
  1. ; DILFD 2055
  1. ; GMRVUT0,^UTILITY($J,"GMRVD") 1446
  1. ; GMVGETQL 5048
  1. ; GMVGETVT 5047
  1. ; GMVRPCM 5702
  1. ; GMVUTL 5046
  1. ;
  1. ; ------------ Get vitals from VistA ------------
  1. ;
  1. EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
  1. N VPRITM,VPRPARAM,GMRVSTR,IDT,TYPE,VIT,CNT,X0,X,Y,I,N
  1. S DFN=+$G(DFN) Q:DFN<1
  1. ;
  1. ; get one measurement
  1. I $G(IFN),IFN?7N1"."1.6N S (BEG,END)=IFN K IFN
  1. I $G(IFN) D EN1(IFN,.VPRITM),XML(.VPRITM) Q
  1. ;
  1. ; get all measurements
  1. S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
  1. S GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN",GMRVSTR(0)=BEG_U_END_U_MAX_"^1"
  1. K ^UTILITY($J,"GMRVD") D EN1^GMRVUT0
  1. S (IDT,CNT)=0 F S IDT=$O(^UTILITY($J,"GMRVD",IDT)) Q:IDT<1 D Q:CNT'<MAX
  1. . K VIT S VIT("taken")=9999999-IDT,CNT=CNT+1,N=0
  1. . S TYPE="" F S TYPE=$O(^UTILITY($J,"GMRVD",IDT,TYPE)) Q:TYPE="" D
  1. .. N NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,BMI,QUAL
  1. .. S IFN=+$O(^UTILITY($J,"GMRVD",IDT,TYPE,0)),X0=$G(^(IFN))
  1. .. S X=+$P(X0,U,3),NAME=$$FIELD^GMVGETVT(X,1)
  1. .. S VUID=$$FIELD^GMVGETVT(X,4),RESULT=$P(X0,U,8),UNIT=$$UNIT(TYPE)
  1. .. S (MRES,MUNT)="" I $L($P(X0,U,13)) D
  1. ... S X=$S(TYPE="T":"C",TYPE="HT":"cm",TYPE="WT":"kg",TYPE="CG":"cm",1:"")
  1. ... S MRES=$P(X0,U,13) S:$L(X) MUNT=X
  1. .. S X=$$RANGE(TYPE),(HIGH,LOW)="" I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
  1. .. S BMI=$S(TYPE="WT":$P(X0,U,14),1:"")
  1. .. S N=N+1,VIT("measurement",N)=IFN_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW_U_BMI
  1. .. S QUAL=$P(X0,U,17) I $L(QUAL) F I=1:1:$L(QUAL,";") D
  1. ... S X=$P(QUAL,";",I),Y=$$GETIEN^GMVGETQL(X,1)
  1. ... I Y S VIT("measurement",N,"qualifier",I)=X_U_$$FIELD^GMVGETQL(Y,3)
  1. . S VIT("entered")=$P($G(X0),U,4) ;use last one
  1. . S X=+$P($G(X0),U,5) S:X VIT("location")=$$LOC(X)
  1. . S VIT("facility")=$$FAC^VPRD(X)
  1. . D XML(.VIT)
  1. K ^UTILITY($J,"GMRVD")
  1. Q
  1. ;
  1. EN1(ID,VIT) ; -- return a vital/measurement in VIT("attribute")
  1. K VIT S ID=+$G(ID) Q:ID<1 ;invalid ien
  1. N VPRY,X0,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
  1. D GETREC^GMVUTL(.VPRY,ID,1) S X0=$G(VPRY(0))
  1. S DFN=+$P(X0,U,2) Q:DFN<1
  1. S TYPE=$$FIELD^GMVGETVT(+$P(X0,U,3),2)
  1. S X=+$P(X0,U,5),VIT("location")=$$LOC(X)
  1. S VIT("facility")=$$FAC^VPRD(X)
  1. S NAME=$$FIELD^GMVGETVT($P(X0,U,3),1),VUID=$$FIELD^GMVGETVT($P(X0,U,3),4)
  1. S X=$P(X0,U,8),RESULT=X,UNIT=$$UNIT(TYPE),(MRES,MUNT)=""
  1. I TYPE="T" S MUNT="C",MRES=$J(X-32*5/9,0,1) ;EN1^GMRVUTL
  1. I TYPE="HT" S MUNT="cm",MRES=$J(2.54*X,0,2) ;EN2^GMRVUTL
  1. I TYPE="WT" S MUNT="kg",MRES=$J(X/2.2,0,2) ;EN3^GMRVUTL
  1. I TYPE="CG" S MUNT="cm",MRES=$J(2.54*X,0,2)
  1. S VIT("taken")=+X0,VIT("entered")=+$P(X0,U,4),(HIGH,LOW)=""
  1. S X=$$RANGE(TYPE) I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
  1. S VIT("measurement",1)=ID_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
  1. F I=1:1:$L(VPRY(5),U) S X=$P(VPRY(5),U,I),VIT("measurement",1,"qualifier",I)=$$FIELD^GMVGETQL(X,1)_U_$$FIELD^GMVGETQL(X,3) ;name^VUID
  1. I $G(VPRY(2)) D ;entered in error/reasons
  1. . S X=$P(VPRY(2),U,3)
  1. . F I=1:1:$L(X,"~") S VIT("removed",I)=$$EXTERNAL^DILFD(120.506,.01,,$P(X,"~",I))
  1. Q
  1. ;
  1. UNIT(X) ; -- Return unit for vital type X
  1. N Y S Y=""
  1. I TYPE="BP" S Y="mm[Hg]"
  1. I TYPE="T" S Y="F"
  1. I TYPE="R" S Y="/min"
  1. I TYPE="P" S Y="/min"
  1. I TYPE="HT" S Y="in"
  1. I TYPE="WT" S Y="lb"
  1. I TYPE="CVP" S Y="cmH2O"
  1. I TYPE="CG" S Y="in"
  1. I TYPE="PO2" S Y="%"
  1. Q Y
  1. ;
  1. USER(X) ; -- Return ien^name for person# X
  1. N Y S X=+$G(X)
  1. S Y=$S(X:X_U_$P($G(^VA(200,X,0)),U),1:"^")
  1. Q Y
  1. ;
  1. LOC(X) ; -- Return ien^name for hospital location X
  1. N Y S X=+$G(X)
  1. S Y=$S(X:X_U_$P($G(^SC(X,0)),U),1:"^")
  1. Q Y
  1. ;
  1. RANGE(TYPE) ; -- return high^low range of values for TYPE
  1. N Y I '$D(VPRPARAM(TYPE)) D ;get parameter values
  1. . N VPRFLDS,VPRI,VPRY,VPRN,VPRX,X
  1. . S VPRFLDS=$S(TYPE="T":"5.1^5.2",TYPE="P":"5.3^5.4",TYPE="R":"5.5^5.6",TYPE="CVP":"6.1^6.2",TYPE="PO2":6.3,TYPE="BP":"5.7^5.71^5.8^5.81",1:"") Q:VPRFLDS=""
  1. . F VPRI=1:1:$L(VPRFLDS,U) S VPRN=$P(VPRFLDS,U,VPRI) D RPC^GMVRPCM(.VPRY,"GETHILO",VPRN) S VPRX(VPRN)=$G(@VPRY@(0))
  1. . I TYPE="T" S VPRPARAM(TYPE)=$G(VPRX(5.1))_U_$G(VPRX(5.2))
  1. . I TYPE="P" S VPRPARAM(TYPE)=$G(VPRX(5.3))_U_$G(VPRX(5.4))
  1. . I TYPE="R" S VPRPARAM(TYPE)=$G(VPRX(5.5))_U_$G(VPRX(5.6))
  1. . I TYPE="CVP" S VPRPARAM(TYPE)=$G(VPRX(6.1))_U_$G(VPRX(6.2))
  1. . I TYPE="PO2" S VPRPARAM(TYPE)="100^"_$G(VPRX(6.3))
  1. . I TYPE="BP" S VPRPARAM(TYPE)=$G(VPRX(5.7))_"/"_$G(VPRX(5.71))_U_$G(VPRX(5.8))_"/"_$G(VPRX(5.81))
  1. S Y=$G(VPRPARAM(TYPE))
  1. Q Y
  1. ;
  1. ; ------------ Return data to middle tier ------------
  1. ;
  1. NAME(X) ; -- Return name of measurement type X for XML element
  1. N Y S X=$G(X),Y=""
  1. 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:"")
  1. Q Y
  1. ;
  1. XML(VIT) ; -- Return vital measurement as XML in @VPR@(#)
  1. N ATT,X,Y,I,J,P,NAMES,TAG
  1. D ADD("<vital>") S VPRTOTL=$G(VPRTOTL)+1
  1. S ATT="" F S ATT=$O(VIT(ATT)) Q:ATT="" D
  1. . I ATT="measurement" D Q
  1. .. D ADD("<measurements>")
  1. .. S NAMES="id^vuid^name^value^units^metricValue^metricUnits^high^low^bmi^Z"
  1. .. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 D
  1. ... S X=$G(VIT(ATT,I)),Y="<"_ATT_" "
  1. ... F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^VPRD($P(X,U,P))_"' "
  1. ... I '$D(VIT(ATT,I,"qualifier")) S Y=Y_"/>" D ADD(Y) Q
  1. ... S Y=Y_">" D ADD(Y),ADD("<qualifiers>")
  1. ... S J=0 F S J=$O(VIT(ATT,I,"qualifier",J)) Q:J<1 D
  1. .... S Y="<qualifier ",X=$G(VIT(ATT,I,"qualifier",J))
  1. .... 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^VPRD($P(X,U,P))_"' "
  1. .... S Y=Y_"/>" D ADD(Y)
  1. ... D ADD("</qualifiers>"),ADD("</measurement>")
  1. .. D ADD("</measurements>")
  1. . I ATT="removed" D Q
  1. .. D ADD("<removed>")
  1. .. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 S Y="<reason value='"_$G(VIT(ATT,I))_"' />" D ADD(Y)
  1. .. D ADD("</removed>")
  1. . S X=$G(VIT(ATT)),Y="" Q:'$L(X)
  1. . I X'["^" S Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />" D ADD(Y) Q
  1. . I $L(X)>1 D
  1. .. S Y="<"_ATT_" "
  1. .. 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^VPRD($P(X,U,P))_"' "
  1. .. S Y=Y_"/>" D ADD(Y)
  1. D ADD("</vital>")
  1. Q
  1. ;
  1. ADD(X) ; Add a line @VPR@(n)=X
  1. S VPRI=$G(VPRI)+1
  1. S @VPR@(VPRI)=X
  1. Q