- VPRDGMV ;SLC/MKB -- Vitals extract ;8/2/11 15:29
- ;;1.0;VIRTUAL PATIENT RECORD;**1,4**;Sep 01, 2011;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^SC 10040
- ; ^VA(200 10060
- ; DILFD 2055
- ; GMRVUT0,^UTILITY($J,"GMRVD") 1446
- ; GMVGETQL 5048
- ; GMVGETVT 5047
- ; GMVRPCM 5702
- ; GMVUTL 5046
- ;
- ; ------------ Get vitals from VistA ------------
- ;
- EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
- N VPRITM,VPRPARAM,GMRVSTR,IDT,TYPE,VIT,CNT,X0,X,Y,I,N
- S DFN=+$G(DFN) Q:DFN<1
- ;
- ; get one measurement
- I $G(IFN),IFN?7N1"."1.6N S (BEG,END)=IFN K IFN
- I $G(IFN) D EN1(IFN,.VPRITM),XML(.VPRITM) Q
- ;
- ; get all measurements
- S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
- 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,BMI,QUAL
- .. S IFN=+$O(^UTILITY($J,"GMRVD",IDT,TYPE,0)),X0=$G(^(IFN))
- .. S X=+$P(X0,U,3),NAME=$$FIELD^GMVGETVT(X,1)
- .. S VUID=$$FIELD^GMVGETVT(X,4),RESULT=$P(X0,U,8),UNIT=$$UNIT(TYPE)
- .. 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 BMI=$S(TYPE="WT":$P(X0,U,14),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
- .. S QUAL=$P(X0,U,17) I $L(QUAL) F I=1:1:$L(QUAL,";") D
- ... S X=$P(QUAL,";",I),Y=$$GETIEN^GMVGETQL(X,1)
- ... I Y S VIT("measurement",N,"qualifier",I)=X_U_$$FIELD^GMVGETQL(Y,3)
- . 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^VPRD(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 VPRY,X0,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
- D GETREC^GMVUTL(.VPRY,ID,1) S X0=$G(VPRY(0))
- S DFN=+$P(X0,U,2) Q:DFN<1
- S TYPE=$$FIELD^GMVGETVT(+$P(X0,U,3),2)
- S X=+$P(X0,U,5),VIT("location")=$$LOC(X)
- S VIT("facility")=$$FAC^VPRD(X)
- S NAME=$$FIELD^GMVGETVT($P(X0,U,3),1),VUID=$$FIELD^GMVGETVT($P(X0,U,3),4)
- S X=$P(X0,U,8),RESULT=X,UNIT=$$UNIT(TYPE),(MRES,MUNT)=""
- I TYPE="T" S MUNT="C",MRES=$J(X-32*5/9,0,1) ;EN1^GMRVUTL
- I TYPE="HT" S MUNT="cm",MRES=$J(2.54*X,0,2) ;EN2^GMRVUTL
- I TYPE="WT" S MUNT="kg",MRES=$J(X/2.2,0,2) ;EN3^GMRVUTL
- I TYPE="CG" S MUNT="cm",MRES=$J(2.54*X,0,2)
- S VIT("taken")=+X0,VIT("entered")=+$P(X0,U,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
- 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
- I $G(VPRY(2)) D ;entered in error/reasons
- . S X=$P(VPRY(2),U,3)
- . F I=1:1:$L(X,"~") S VIT("removed",I)=$$EXTERNAL^DILFD(120.506,.01,,$P(X,"~",I))
- Q
- ;
- UNIT(X) ; -- Return unit for vital type X
- N Y S Y=""
- I TYPE="BP" S Y="mm[Hg]"
- I TYPE="T" S Y="F"
- I TYPE="R" S Y="/min"
- I TYPE="P" S Y="/min"
- I TYPE="HT" S Y="in"
- I TYPE="WT" S Y="lb"
- I TYPE="CVP" S Y="cmH2O"
- I TYPE="CG" S Y="in"
- I TYPE="PO2" S Y="%"
- Q Y
- ;
- 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 I '$D(VPRPARAM(TYPE)) D ;get parameter values
- . N VPRFLDS,VPRI,VPRY,VPRN,VPRX,X
- . 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=""
- . 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))
- . I TYPE="T" S VPRPARAM(TYPE)=$G(VPRX(5.1))_U_$G(VPRX(5.2))
- . I TYPE="P" S VPRPARAM(TYPE)=$G(VPRX(5.3))_U_$G(VPRX(5.4))
- . I TYPE="R" S VPRPARAM(TYPE)=$G(VPRX(5.5))_U_$G(VPRX(5.6))
- . I TYPE="CVP" S VPRPARAM(TYPE)=$G(VPRX(6.1))_U_$G(VPRX(6.2))
- . I TYPE="PO2" S VPRPARAM(TYPE)="100^"_$G(VPRX(6.3))
- . I TYPE="BP" S VPRPARAM(TYPE)=$G(VPRX(5.7))_"/"_$G(VPRX(5.71))_U_$G(VPRX(5.8))_"/"_$G(VPRX(5.81))
- S Y=$G(VPRPARAM(TYPE))
- 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 @VPR@(#)
- N ATT,X,Y,I,J,P,NAMES,TAG
- D ADD("<vital>") S VPRTOTL=$G(VPRTOTL)+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^bmi^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^VPRD($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^VPRD($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^VPRD(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^VPRD($P(X,U,P))_"' "
- .. S Y=Y_"/>" D ADD(Y)
- D ADD("</vital>")
- Q
- ;
- ADD(X) ; Add a line @VPR@(n)=X
- S VPRI=$G(VPRI)+1
- S @VPR@(VPRI)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDGMV 6753 printed Jan 18, 2025@03:45:35 Page 2
- VPRDGMV ;SLC/MKB -- Vitals extract ;8/2/11 15:29
- +1 ;;1.0;VIRTUAL PATIENT RECORD;**1,4**;Sep 01, 2011;Build 6
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; External References DBIA#
- +5 ; ------------------- -----
- +6 ; ^SC 10040
- +7 ; ^VA(200 10060
- +8 ; DILFD 2055
- +9 ; GMRVUT0,^UTILITY($J,"GMRVD") 1446
- +10 ; GMVGETQL 5048
- +11 ; GMVGETVT 5047
- +12 ; GMVRPCM 5702
- +13 ; GMVUTL 5046
- +14 ;
- +15 ; ------------ Get vitals from VistA ------------
- +16 ;
- EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
- +1 NEW VPRITM,VPRPARAM,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)
- IF IFN?7N1"."1.6N
- SET (BEG,END)=IFN
- KILL IFN
- +6 IF $GET(IFN)
- DO EN1(IFN,.VPRITM)
- DO XML(.VPRITM)
- QUIT
- +7 ;
- +8 ; get all measurements
- +9 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,4141015)
- SET MAX=$GET(MAX,9999)
- +10 SET GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN"
- SET GMRVSTR(0)=BEG_U_END_U_MAX_"^1"
- +11 KILL ^UTILITY($JOB,"GMRVD")
- DO EN1^GMRVUT0
- +12 SET (IDT,CNT)=0
- FOR
- SET IDT=$ORDER(^UTILITY($JOB,"GMRVD",IDT))
- if IDT<1
- QUIT
- Begin DoDot:1
- +13 KILL VIT
- SET VIT("taken")=9999999-IDT
- SET CNT=CNT+1
- SET N=0
- +14 SET TYPE=""
- FOR
- SET TYPE=$ORDER(^UTILITY($JOB,"GMRVD",IDT,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:2
- +15 NEW NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,BMI,QUAL
- +16 SET IFN=+$ORDER(^UTILITY($JOB,"GMRVD",IDT,TYPE,0))
- SET X0=$GET(^(IFN))
- +17 SET X=+$PIECE(X0,U,3)
- SET NAME=$$FIELD^GMVGETVT(X,1)
- +18 SET VUID=$$FIELD^GMVGETVT(X,4)
- SET RESULT=$PIECE(X0,U,8)
- SET UNIT=$$UNIT(TYPE)
- +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 BMI=$SELECT(TYPE="WT":$PIECE(X0,U,14),1:"")
- +24 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_U_BMI
- +25 SET QUAL=$PIECE(X0,U,17)
- IF $LENGTH(QUAL)
- FOR I=1:1:$LENGTH(QUAL,";")
- Begin DoDot:3
- +26 SET X=$PIECE(QUAL,";",I)
- SET Y=$$GETIEN^GMVGETQL(X,1)
- +27 IF Y
- SET VIT("measurement",N,"qualifier",I)=X_U_$$FIELD^GMVGETQL(Y,3)
- End DoDot:3
- End DoDot:2
- +28 ;use last one
- SET VIT("entered")=$PIECE($GET(X0),U,4)
- +29 SET X=+$PIECE($GET(X0),U,5)
- if X
- SET VIT("location")=$$LOC(X)
- +30 SET VIT("facility")=$$FAC^VPRD(X)
- +31 DO XML(.VIT)
- End DoDot:1
- if CNT'<MAX
- QUIT
- +32 KILL ^UTILITY($JOB,"GMRVD")
- +33 QUIT
- +34 ;
- 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 VPRY,X0,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
- +3 DO GETREC^GMVUTL(.VPRY,ID,1)
- SET X0=$GET(VPRY(0))
- +4 SET DFN=+$PIECE(X0,U,2)
- if DFN<1
- QUIT
- +5 SET TYPE=$$FIELD^GMVGETVT(+$PIECE(X0,U,3),2)
- +6 SET X=+$PIECE(X0,U,5)
- SET VIT("location")=$$LOC(X)
- +7 SET VIT("facility")=$$FAC^VPRD(X)
- +8 SET NAME=$$FIELD^GMVGETVT($PIECE(X0,U,3),1)
- SET VUID=$$FIELD^GMVGETVT($PIECE(X0,U,3),4)
- +9 SET X=$PIECE(X0,U,8)
- SET RESULT=X
- SET UNIT=$$UNIT(TYPE)
- SET (MRES,MUNT)=""
- +10 ;EN1^GMRVUTL
- IF TYPE="T"
- SET MUNT="C"
- SET MRES=$JUSTIFY(X-32*5/9,0,1)
- +11 ;EN2^GMRVUTL
- IF TYPE="HT"
- SET MUNT="cm"
- SET MRES=$JUSTIFY(2.54*X,0,2)
- +12 ;EN3^GMRVUTL
- IF TYPE="WT"
- SET MUNT="kg"
- SET MRES=$JUSTIFY(X/2.2,0,2)
- +13 IF TYPE="CG"
- SET MUNT="cm"
- SET MRES=$JUSTIFY(2.54*X,0,2)
- +14 SET VIT("taken")=+X0
- SET VIT("entered")=+$PIECE(X0,U,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 ;name^VUID
- FOR I=1:1:$LENGTH(VPRY(5),U)
- SET X=$PIECE(VPRY(5),U,I)
- SET VIT("measurement",1,"qualifier",I)=$$FIELD^GMVGETQL(X,1)_U_$$FIELD^GMVGETQL(X,3)
- +18 ;entered in error/reasons
- IF $GET(VPRY(2))
- Begin DoDot:1
- +19 SET X=$PIECE(VPRY(2),U,3)
- +20 FOR I=1:1:$LENGTH(X,"~")
- SET VIT("removed",I)=$$EXTERNAL^DILFD(120.506,.01,,$PIECE(X,"~",I))
- End DoDot:1
- +21 QUIT
- +22 ;
- UNIT(X) ; -- Return unit for vital type X
- +1 NEW Y
- SET Y=""
- +2 IF TYPE="BP"
- SET Y="mm[Hg]"
- +3 IF TYPE="T"
- SET Y="F"
- +4 IF TYPE="R"
- SET Y="/min"
- +5 IF TYPE="P"
- SET Y="/min"
- +6 IF TYPE="HT"
- SET Y="in"
- +7 IF TYPE="WT"
- SET Y="lb"
- +8 IF TYPE="CVP"
- SET Y="cmH2O"
- +9 IF TYPE="CG"
- SET Y="in"
- +10 IF TYPE="PO2"
- SET Y="%"
- +11 QUIT Y
- +12 ;
- 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
- IF '$DATA(VPRPARAM(TYPE))
- Begin DoDot:1
- +2 NEW VPRFLDS,VPRI,VPRY,VPRN,VPRX,X
- +3 SET VPRFLDS=$SELECT(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:"")
- if VPRFLDS=""
- QUIT
- +4 FOR VPRI=1:1:$LENGTH(VPRFLDS,U)
- SET VPRN=$PIECE(VPRFLDS,U,VPRI)
- DO RPC^GMVRPCM(.VPRY,"GETHILO",VPRN)
- SET VPRX(VPRN)=$GET(@VPRY@(0))
- +5 IF TYPE="T"
- SET VPRPARAM(TYPE)=$GET(VPRX(5.1))_U_$GET(VPRX(5.2))
- +6 IF TYPE="P"
- SET VPRPARAM(TYPE)=$GET(VPRX(5.3))_U_$GET(VPRX(5.4))
- +7 IF TYPE="R"
- SET VPRPARAM(TYPE)=$GET(VPRX(5.5))_U_$GET(VPRX(5.6))
- +8 IF TYPE="CVP"
- SET VPRPARAM(TYPE)=$GET(VPRX(6.1))_U_$GET(VPRX(6.2))
- +9 IF TYPE="PO2"
- SET VPRPARAM(TYPE)="100^"_$GET(VPRX(6.3))
- +10 IF TYPE="BP"
- SET VPRPARAM(TYPE)=$GET(VPRX(5.7))_"/"_$GET(VPRX(5.71))_U_$GET(VPRX(5.8))_"/"_$GET(VPRX(5.81))
- End DoDot:1
- +11 SET Y=$GET(VPRPARAM(TYPE))
- +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 @VPR@(#)
- +1 NEW ATT,X,Y,I,J,P,NAMES,TAG
- +2 DO ADD("<vital>")
- SET VPRTOTL=$GET(VPRTOTL)+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^bmi^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^VPRD($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^VPRD($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^VPRD(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^VPRD($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 @VPR@(n)=X
- +1 SET VPRI=$GET(VPRI)+1
- +2 SET @VPR@(VPRI)=X
- +3 QUIT