VPRDJ02 ;SLC/MKB -- Problems,Allergies,Vitals ;6/25/12 16:11
;;1.0;VIRTUAL PATIENT RECORD;**2,5**;Sep 01, 2011;Build 21
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^PXRMINDX 4290
; ^SC 10040
; DIC 2051
; DIQ 2056
; GMPLUTL2 2741
; GMRADPT 10099
; GMRAOR2 2422
; GMRVUT0,^UTILITY($J 1446
; GMVGETQL 5048
; GMVGETVT 5047
; GMVUTL 5046
; ICDEX 5747
; XLFSTR 10104
; XUAF4 2171
;
; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
;
GMPL1(ID) ; -- problem
N VPRL,PROB,X,I,DATE,USER,FAC
D DETAIL^GMPLUTL2(ID,.VPRL) Q:'$D(VPRL) ;doesn't exist
;
S PROB("uid")=$$SETUID^VPRUTILS("problem",DFN,ID),PROB("localId")=ID
S PROB("problemText")=$G(VPRL("NARRATIVE"))
S DATE=$P($G(VPRL("ENTERED")),U)
S:$L(DATE) DATE=$$DATE^VPRDGMPL(DATE),PROB("entered")=$$JSONDT^VPRUTILS(DATE)
S X=$G(VPRL("DIAGNOSIS")) I $L(X) D
. N ICD9ZN,DIAG,SYS
. I DATE'>0 S DATE=DT
. S ICD9ZN=$$ICDDX^ICDEX(X,DATE,,"E"),DIAG=$S($P($G(ICD9ZN),U,4)'="":$P(ICD9ZN,U,4),1:X)
. S SYS=$$LOW^XLFSTR($G(VPRL("CSYS"),"ICD")) ;icd or 10d
. S PROB("icdCode")=$$SETNCS^VPRUTILS(SYS,X),PROB("icdName")=DIAG
S X=$G(VPRL("ONSET")) S:$L(X) X=$$DATE^VPRDGMPL(X),PROB("onset")=$$JSONDT^VPRUTILS(X)
S X=$G(VPRL("MODIFIED")) S:$L(X) X=$$DATE^VPRDGMPL(X),PROB("updated")=$$JSONDT^VPRUTILS(X)
S X=$G(VPRL("STATUS")) I $L(X) D
. S PROB("statusName")=X,X=$E(X)
. S X=$S(X="A":55561003,X="I":73425007,1:"")
. S PROB("statusCode")=$$SETNCS^VPRUTILS("sct",X)
S X=$G(VPRL("PRIORITY")) I X]"" D
. S X=$$LOW^XLFSTR(X),PROB("acuityName")=X
. S PROB("acuityCode")=$$SETVURN^VPRUTILS("prob-acuity",$E(X))
S X=$$GET1^DIQ(9000011,ID_",",1.07,"I") S:X PROB("resolved")=$$JSONDT^VPRUTILS(X)
S X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
S:X="P" PROB("unverified")="false",PROB("removed")="false"
S:X="T" PROB("unverified")="true",PROB("removed")="false"
S:X="H" PROB("unverified")="false",PROB("removed")="true"
S X=$G(VPRL("SC")),X=$S(X="YES":"",X="NO":"false",1:"")
S:$L(X) PROB("serviceConnected")=X
S X=$G(VPRL("PROVIDER")) I $L(X) D
. S PROB("providerName")=X,X=$$GET1^DIQ(9000011,ID_",",1.05,"I")
. S PROB("providerUid")=$$SETUID^VPRUTILS("user",,+X)
S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
S X=$G(VPRL("CLINIC")) I $L(X) D
. S PROB("locationName")=X
. N LOC S LOC=+$$FIND1^DIC(44,,"QX",X)
. S:LOC PROB("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
S X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
S:X FAC=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
I 'X S FAC=$$FAC^VPRD ;local stn#^name
D FACILITY^VPRUTILS(FAC,"PROB")
S I=0 F S I=$O(VPRL("COMMENT",I)) Q:I<1 D
. S X=$G(VPRL("COMMENT",I))
. S USER=$$VA200^VPRDGMPL($P(X,U,2)),DATE=$$DATE^VPRDGMPL($P(X,U))
. S PROB("comments",I,"enteredByCode")=$$SETUID^VPRUTILS("user",,+USER)
. S PROB("comments",I,"enteredByName")=$P(X,U,2)
. S PROB("comments",I,"entered")=$$JSONDT^VPRUTILS(DATE)
. S PROB("comments",I,"comment")=$P(X,U,3)
D ADD^VPRDJ("PROB","problem")
Q
;
GMRA1(ID) ; -- allergy/reaction GMRAL(ID)
N GMRA,VPRY,REAC,X,Y,I
S GMRA=$G(GMRAL(ID)) D EN1^GMRAOR2(ID,"VPRY")
;
S X=$P(VPRY,U,10) I $L(X) S X=$$DATE^VPRDGMRA(X) Q:X<VPRSTART Q:X>VPRSTOP S REAC("entered")=$$JSONDT^VPRUTILS(X)
S X=$$FAC^VPRD D FACILITY^VPRUTILS(X,"REAC")
S REAC("kind")="Allergy / Adverse Reaction"
S REAC("localId")=ID,REAC("uid")=$$SETUID^VPRUTILS("allergy",DFN,ID)
S (REAC("summary"),REAC("products",1,"name"))=$P(VPRY,U) I $P(GMRA,U,9) D
. S X=$P(GMRA,U,9),REAC("reference")=X
. S Y=+$P(X,"(",2) I 'Y,X["PSDRUG" S Y=50
. S I=$$VUID^VPRD(+X,Y),REAC("products",1,"vuid")=$$SETVURN^VPRUTILS("vuid",I)
S REAC("historical")=$S($E($P(VPRY,U,5))="H":"true",1:"false")
; REAC("adverseEventTypeName")=$P(VPRY,U,7)_" "_$P(VPRY,U,6) ;TYPE_MECH
I $P(VPRY,U,4)="VERIFIED",$P(VPRY,U,9) S REAC("verified")=$$JSONDT^VPRUTILS($P(VPRY,U,9))
; reactions
S I=0 F S I=$O(GMRAL(ID,"S",I)) Q:I<1 D
. S X=$G(GMRAL(ID,"S",I))
. S REAC("reactions",I,"name")=$P(X,";")
. S Y=$$VUID^VPRD(+$P(X,";",2),120.83)
. S REAC("reactions",I,"vuid")=$$SETVURN^VPRUTILS("vuid",Y)
I GMRA="" S REAC("removed")="true" ;entered in error
D ADD^VPRDJ("REAC","allergy")
Q
;
NKA ; -- no assessment or NKA [GMRAL=0 or ""]
N REAC,X
S REAC("assessment")=$S(GMRAL=0:"nka",1:"not done")
S X=$$FAC^VPRD D FACILITY^VPRUTILS(X,"REAC")
D ADD^VPRDJ("REAC","allergy")
Q
;
GMV1(ID) ; -- vital/measurement ^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID)
N VIT,VPRY,X0,TYPE,LOC,FAC,X,Y,MRES,MUNT,HIGH,LOW,I
D GETREC^GMVUTL(.VPRY,ID,1) S X0=$G(VPRY(0))
; GMRVUT0 returns CLiO data with a pseudo-ID >> get real ID
I X0="",$G(VPRIDT),$D(VPRTYP) D ;[from VPRDJ0]
. N GMRVD S GMRVD=$G(^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID))
. S ID=$O(^PXRMINDX(120.5,"PI",DFN,$P(GMRVD,U,3),+GMRVD,""))
. I $L(ID) D GETREC^GMVUTL(.VPRY,ID,1) S X0=$G(VPRY(0))
Q:X0=""
;
S VIT("localId")=ID,VIT("kind")="Vital Sign"
S VIT("uid")=$$SETUID^VPRUTILS("vital",DFN,ID)
S VIT("observed")=$$JSONDT^VPRUTILS(+X0)
S VIT("resulted")=$$JSONDT^VPRUTILS(+$P(X0,U,4))
S TYPE=$$FIELD^GMVGETVT(+$P(X0,U,3),2)
S VIT("displayName")=TYPE
S VIT("typeName")=$$FIELD^GMVGETVT($P(X0,U,3),1)
S VIT("typeCode")="urn:va:vuid:"_$$FIELD^GMVGETVT($P(X0,U,3),4)
S X=$P(X0,U,8),VIT("result")=X
S VIT("units")=$$UNIT^VPRDGMV(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:MRES VIT("metricResult")=MRES,VIT("metricUnits")=MUNT
S X=$$RANGE^VPRDGMV(TYPE) I $L(X) S VIT("high")=$P(X,U),VIT("low")=$P(X,U,2)
S VIT("summary")=VIT("typeName")_" "_VIT("result")_" "_VIT("units")
F I=1:1:$L(VPRY(5),U) S X=$P(VPRY(5),U,I) I X D
. S VIT("qualifiers",I,"name")=$$FIELD^GMVGETQL(X,1)
. S VIT("qualifiers",I,"vuid")=$$FIELD^GMVGETQL(X,3)
I $G(VPRY(2)) S VIT("removed")="true" ;entered in error
S LOC=+$P(X0,U,5),FAC=$$FAC^VPRD(LOC)
S VIT("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
S VIT("locationName")=$S(LOC:$P($G(^SC(LOC,0)),U),1:"unknown")
D FACILITY^VPRUTILS(FAC,"VIT")
D ADD^VPRDJ("VIT","vital")
Q
;
VPR(COLL) ; -- VPR Patient Objects
N ID I $L($G(VPRID)) D Q
. S ID=+VPRID I 'ID S ID=+$O(^VPR(560.1,"B",VPRID,0)) ;IEN or UID
. D:ID VPR1(560.1,ID)
Q:$G(COLL)="" ;error
S ID=0 F S ID=$O(^VPR(560.1,"C",DFN,COLL,ID)) Q:ID<1 D VPR1(560.1,ID)
Q
VPR1(FNUM,ID) ; -- [patient] object
N I,X,VPRY
S I=0 F S I=$O(^VPR(FNUM,ID,1,I)) Q:I<1 S X=$G(^(I,0)),VPRY(I)=X
I $D(VPRY) D ;already encoded JSON
. S VPRI=VPRI+1 S:VPRI>1 @VPR@(VPRI,.3)=","
. M @VPR@(VPRI)=VPRY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJ02 7139 printed Apr 09, 2024@21:48:12 Page 2
VPRDJ02 ;SLC/MKB -- Problems,Allergies,Vitals ;6/25/12 16:11
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2,5**;Sep 01, 2011;Build 21
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^PXRMINDX 4290
+7 ; ^SC 10040
+8 ; DIC 2051
+9 ; DIQ 2056
+10 ; GMPLUTL2 2741
+11 ; GMRADPT 10099
+12 ; GMRAOR2 2422
+13 ; GMRVUT0,^UTILITY($J 1446
+14 ; GMVGETQL 5048
+15 ; GMVGETVT 5047
+16 ; GMVUTL 5046
+17 ; ICDEX 5747
+18 ; XLFSTR 10104
+19 ; XUAF4 2171
+20 ;
+21 ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
+22 ;
GMPL1(ID) ; -- problem
+1 NEW VPRL,PROB,X,I,DATE,USER,FAC
+2 ;doesn't exist
DO DETAIL^GMPLUTL2(ID,.VPRL)
if '$DATA(VPRL)
QUIT
+3 ;
+4 SET PROB("uid")=$$SETUID^VPRUTILS("problem",DFN,ID)
SET PROB("localId")=ID
+5 SET PROB("problemText")=$GET(VPRL("NARRATIVE"))
+6 SET DATE=$PIECE($GET(VPRL("ENTERED")),U)
+7 if $LENGTH(DATE)
SET DATE=$$DATE^VPRDGMPL(DATE)
SET PROB("entered")=$$JSONDT^VPRUTILS(DATE)
+8 SET X=$GET(VPRL("DIAGNOSIS"))
IF $LENGTH(X)
Begin DoDot:1
+9 NEW ICD9ZN,DIAG,SYS
+10 IF DATE'>0
SET DATE=DT
+11 SET ICD9ZN=$$ICDDX^ICDEX(X,DATE,,"E")
SET DIAG=$SELECT($PIECE($GET(ICD9ZN),U,4)'="":$PIECE(ICD9ZN,U,4),1:X)
+12 ;icd or 10d
SET SYS=$$LOW^XLFSTR($GET(VPRL("CSYS"),"ICD"))
+13 SET PROB("icdCode")=$$SETNCS^VPRUTILS(SYS,X)
SET PROB("icdName")=DIAG
End DoDot:1
+14 SET X=$GET(VPRL("ONSET"))
if $LENGTH(X)
SET X=$$DATE^VPRDGMPL(X)
SET PROB("onset")=$$JSONDT^VPRUTILS(X)
+15 SET X=$GET(VPRL("MODIFIED"))
if $LENGTH(X)
SET X=$$DATE^VPRDGMPL(X)
SET PROB("updated")=$$JSONDT^VPRUTILS(X)
+16 SET X=$GET(VPRL("STATUS"))
IF $LENGTH(X)
Begin DoDot:1
+17 SET PROB("statusName")=X
SET X=$EXTRACT(X)
+18 SET X=$SELECT(X="A":55561003,X="I":73425007,1:"")
+19 SET PROB("statusCode")=$$SETNCS^VPRUTILS("sct",X)
End DoDot:1
+20 SET X=$GET(VPRL("PRIORITY"))
IF X]""
Begin DoDot:1
+21 SET X=$$LOW^XLFSTR(X)
SET PROB("acuityName")=X
+22 SET PROB("acuityCode")=$$SETVURN^VPRUTILS("prob-acuity",$EXTRACT(X))
End DoDot:1
+23 SET X=$$GET1^DIQ(9000011,ID_",",1.07,"I")
if X
SET PROB("resolved")=$$JSONDT^VPRUTILS(X)
+24 SET X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
+25 if X="P"
SET PROB("unverified")="false"
SET PROB("removed")="false"
+26 if X="T"
SET PROB("unverified")="true"
SET PROB("removed")="false"
+27 if X="H"
SET PROB("unverified")="false"
SET PROB("removed")="true"
+28 SET X=$GET(VPRL("SC"))
SET X=$SELECT(X="YES":"",X="NO":"false",1:"")
+29 if $LENGTH(X)
SET PROB("serviceConnected")=X
+30 SET X=$GET(VPRL("PROVIDER"))
IF $LENGTH(X)
Begin DoDot:1
+31 SET PROB("providerName")=X
SET X=$$GET1^DIQ(9000011,ID_",",1.05,"I")
+32 SET PROB("providerUid")=$$SETUID^VPRUTILS("user",,+X)
End DoDot:1
+33 SET X=$$GET1^DIQ(9000011,ID_",",1.06)
if $LENGTH(X)
SET PROB("service")=X
+34 SET X=$GET(VPRL("CLINIC"))
IF $LENGTH(X)
Begin DoDot:1
+35 SET PROB("locationName")=X
+36 NEW LOC
SET LOC=+$$FIND1^DIC(44,,"QX",X)
+37 if LOC
SET PROB("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
End DoDot:1
+38 SET X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
+39 if X
SET FAC=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
+40 ;local stn#^name
IF 'X
SET FAC=$$FAC^VPRD
+41 DO FACILITY^VPRUTILS(FAC,"PROB")
+42 SET I=0
FOR
SET I=$ORDER(VPRL("COMMENT",I))
if I<1
QUIT
Begin DoDot:1
+43 SET X=$GET(VPRL("COMMENT",I))
+44 SET USER=$$VA200^VPRDGMPL($PIECE(X,U,2))
SET DATE=$$DATE^VPRDGMPL($PIECE(X,U))
+45 SET PROB("comments",I,"enteredByCode")=$$SETUID^VPRUTILS("user",,+USER)
+46 SET PROB("comments",I,"enteredByName")=$PIECE(X,U,2)
+47 SET PROB("comments",I,"entered")=$$JSONDT^VPRUTILS(DATE)
+48 SET PROB("comments",I,"comment")=$PIECE(X,U,3)
End DoDot:1
+49 DO ADD^VPRDJ("PROB","problem")
+50 QUIT
+51 ;
GMRA1(ID) ; -- allergy/reaction GMRAL(ID)
+1 NEW GMRA,VPRY,REAC,X,Y,I
+2 SET GMRA=$GET(GMRAL(ID))
DO EN1^GMRAOR2(ID,"VPRY")
+3 ;
+4 SET X=$PIECE(VPRY,U,10)
IF $LENGTH(X)
SET X=$$DATE^VPRDGMRA(X)
if X<VPRSTART
QUIT
if X>VPRSTOP
QUIT
SET REAC("entered")=$$JSONDT^VPRUTILS(X)
+5 SET X=$$FAC^VPRD
DO FACILITY^VPRUTILS(X,"REAC")
+6 SET REAC("kind")="Allergy / Adverse Reaction"
+7 SET REAC("localId")=ID
SET REAC("uid")=$$SETUID^VPRUTILS("allergy",DFN,ID)
+8 SET (REAC("summary"),REAC("products",1,"name"))=$PIECE(VPRY,U)
IF $PIECE(GMRA,U,9)
Begin DoDot:1
+9 SET X=$PIECE(GMRA,U,9)
SET REAC("reference")=X
+10 SET Y=+$PIECE(X,"(",2)
IF 'Y
IF X["PSDRUG"
SET Y=50
+11 SET I=$$VUID^VPRD(+X,Y)
SET REAC("products",1,"vuid")=$$SETVURN^VPRUTILS("vuid",I)
End DoDot:1
+12 SET REAC("historical")=$SELECT($EXTRACT($PIECE(VPRY,U,5))="H":"true",1:"false")
+13 ; REAC("adverseEventTypeName")=$P(VPRY,U,7)_" "_$P(VPRY,U,6) ;TYPE_MECH
+14 IF $PIECE(VPRY,U,4)="VERIFIED"
IF $PIECE(VPRY,U,9)
SET REAC("verified")=$$JSONDT^VPRUTILS($PIECE(VPRY,U,9))
+15 ; reactions
+16 SET I=0
FOR
SET I=$ORDER(GMRAL(ID,"S",I))
if I<1
QUIT
Begin DoDot:1
+17 SET X=$GET(GMRAL(ID,"S",I))
+18 SET REAC("reactions",I,"name")=$PIECE(X,";")
+19 SET Y=$$VUID^VPRD(+$PIECE(X,";",2),120.83)
+20 SET REAC("reactions",I,"vuid")=$$SETVURN^VPRUTILS("vuid",Y)
End DoDot:1
+21 ;entered in error
IF GMRA=""
SET REAC("removed")="true"
+22 DO ADD^VPRDJ("REAC","allergy")
+23 QUIT
+24 ;
NKA ; -- no assessment or NKA [GMRAL=0 or ""]
+1 NEW REAC,X
+2 SET REAC("assessment")=$SELECT(GMRAL=0:"nka",1:"not done")
+3 SET X=$$FAC^VPRD
DO FACILITY^VPRUTILS(X,"REAC")
+4 DO ADD^VPRDJ("REAC","allergy")
+5 QUIT
+6 ;
GMV1(ID) ; -- vital/measurement ^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID)
+1 NEW VIT,VPRY,X0,TYPE,LOC,FAC,X,Y,MRES,MUNT,HIGH,LOW,I
+2 DO GETREC^GMVUTL(.VPRY,ID,1)
SET X0=$GET(VPRY(0))
+3 ; GMRVUT0 returns CLiO data with a pseudo-ID >> get real ID
+4 ;[from VPRDJ0]
IF X0=""
IF $GET(VPRIDT)
IF $DATA(VPRTYP)
Begin DoDot:1
+5 NEW GMRVD
SET GMRVD=$GET(^UTILITY($JOB,"GMRVD",VPRIDT,VPRTYP,ID))
+6 SET ID=$ORDER(^PXRMINDX(120.5,"PI",DFN,$PIECE(GMRVD,U,3),+GMRVD,""))
+7 IF $LENGTH(ID)
DO GETREC^GMVUTL(.VPRY,ID,1)
SET X0=$GET(VPRY(0))
End DoDot:1
+8 if X0=""
QUIT
+9 ;
+10 SET VIT("localId")=ID
SET VIT("kind")="Vital Sign"
+11 SET VIT("uid")=$$SETUID^VPRUTILS("vital",DFN,ID)
+12 SET VIT("observed")=$$JSONDT^VPRUTILS(+X0)
+13 SET VIT("resulted")=$$JSONDT^VPRUTILS(+$PIECE(X0,U,4))
+14 SET TYPE=$$FIELD^GMVGETVT(+$PIECE(X0,U,3),2)
+15 SET VIT("displayName")=TYPE
+16 SET VIT("typeName")=$$FIELD^GMVGETVT($PIECE(X0,U,3),1)
+17 SET VIT("typeCode")="urn:va:vuid:"_$$FIELD^GMVGETVT($PIECE(X0,U,3),4)
+18 SET X=$PIECE(X0,U,8)
SET VIT("result")=X
+19 SET VIT("units")=$$UNIT^VPRDGMV(TYPE)
SET (MRES,MUNT)=""
+20 ;EN1^GMRVUTL
IF TYPE="T"
SET MUNT="C"
SET MRES=$JUSTIFY(X-32*5/9,0,1)
+21 ;EN2^GMRVUTL
IF TYPE="HT"
SET MUNT="cm"
SET MRES=$JUSTIFY(2.54*X,0,2)
+22 ;EN3^GMRVUTL
IF TYPE="WT"
SET MUNT="kg"
SET MRES=$JUSTIFY(X/2.2,0,2)
+23 IF TYPE="CG"
SET MUNT="cm"
SET MRES=$JUSTIFY(2.54*X,0,2)
+24 if MRES
SET VIT("metricResult")=MRES
SET VIT("metricUnits")=MUNT
+25 SET X=$$RANGE^VPRDGMV(TYPE)
IF $LENGTH(X)
SET VIT("high")=$PIECE(X,U)
SET VIT("low")=$PIECE(X,U,2)
+26 SET VIT("summary")=VIT("typeName")_" "_VIT("result")_" "_VIT("units")
+27 FOR I=1:1:$LENGTH(VPRY(5),U)
SET X=$PIECE(VPRY(5),U,I)
IF X
Begin DoDot:1
+28 SET VIT("qualifiers",I,"name")=$$FIELD^GMVGETQL(X,1)
+29 SET VIT("qualifiers",I,"vuid")=$$FIELD^GMVGETQL(X,3)
End DoDot:1
+30 ;entered in error
IF $GET(VPRY(2))
SET VIT("removed")="true"
+31 SET LOC=+$PIECE(X0,U,5)
SET FAC=$$FAC^VPRD(LOC)
+32 SET VIT("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
+33 SET VIT("locationName")=$SELECT(LOC:$PIECE($GET(^SC(LOC,0)),U),1:"unknown")
+34 DO FACILITY^VPRUTILS(FAC,"VIT")
+35 DO ADD^VPRDJ("VIT","vital")
+36 QUIT
+37 ;
VPR(COLL) ; -- VPR Patient Objects
+1 NEW ID
IF $LENGTH($GET(VPRID))
Begin DoDot:1
+2 ;IEN or UID
SET ID=+VPRID
IF 'ID
SET ID=+$ORDER(^VPR(560.1,"B",VPRID,0))
+3 if ID
DO VPR1(560.1,ID)
End DoDot:1
QUIT
+4 ;error
if $GET(COLL)=""
QUIT
+5 SET ID=0
FOR
SET ID=$ORDER(^VPR(560.1,"C",DFN,COLL,ID))
if ID<1
QUIT
DO VPR1(560.1,ID)
+6 QUIT
VPR1(FNUM,ID) ; -- [patient] object
+1 NEW I,X,VPRY
+2 SET I=0
FOR
SET I=$ORDER(^VPR(FNUM,ID,1,I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET VPRY(I)=X
+3 ;already encoded JSON
IF $DATA(VPRY)
Begin DoDot:1
+4 SET VPRI=VPRI+1
if VPRI>1
SET @VPR@(VPRI,.3)=","
+5 MERGE @VPR@(VPRI)=VPRY
End DoDot:1
+6 QUIT
