- VPRSDAOB ;SLC/MKB/CMF -- SDA Observation utilities ;7/28/23 14:11
- ;;1.0;VIRTUAL PATIENT RECORD;**33**;Sep 01, 2011;Build 8
- ;;Per VHA Directive 6402, this routine should not be modified.
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^PXRMINDX 4290
- ; DIQ 2056
- ; GMRVUT0, ^UTILITY($J 1446
- ; GMVBMI 7437
- ; GMVGETVT 5047
- ; GMVUTL 5046
- ; ^MDC(704.117 5810
- ;
- VITALS ; -- GMR Vital Measurements query [main]
- ; Expects DSTRT, DSTOP, DMAX from DDEGET and returns DLIST(#)=ien
- N GMRVSTR,VPRIDT,VPRTYP,ID,VPRN,X0,TYP,GUID
- S GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN" ;CPRS vitals data set
- S GMRVSTR(0)=DSTRT_U_DSTOP_U_DMAX_"^1"
- D EN1^GMRVUT0 S VPRN=0
- S VPRIDT=0 F S VPRIDT=$O(^UTILITY($J,"GMRVD",VPRIDT)) Q:VPRIDT<1 D Q:VPRN'<DMAX
- . S VPRTYP="" F S VPRTYP=$O(^UTILITY($J,"GMRVD",VPRIDT,VPRTYP)) Q:VPRTYP="" D
- .. S ID=$O(^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,0)) Q:'ID
- .. ; check ^PXRM for 704.117 GUID instead of 120.5 ien
- .. S X0=$G(^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID)),TYP=$P(X0,U,3)
- .. S GUID=$O(^PXRMINDX(120.5,"PI",DFN,TYP,+X0,"")) S:GUID="" GUID=ID
- .. S VPRN=VPRN+1,DLIST(VPRN)=GUID
- .. S ^TMP("VPRGMV",$J,GUID)=$G(^UTILITY($J,"GMRVD",VPRIDT,VPRTYP,ID))
- K ^UTILITY($J,"GMRVD")
- Q
- ;
- VIT1(IEN) ; -- get info for one Vital measurement
- ; Accepts IEN = #120.5 ien or #704.117 GUID
- ; Returns VPRV array, VPRGMV=VPRV(0), VPRANGE, VPRTYPE to entity
- S IEN=$G(IEN) I IEN="" S DDEOUT=1 Q
- D GETREC^GMVUTL(.VPRV,IEN,1)
- S VPRGMV=$G(VPRV(0)) I '$G(VPRV(0)) S DDEOUT=1 Q
- I $$ISGUID($P(VPRGMV,U,8)) S DDEOUT=1 Q ;don't pass rare but potential GUID strings as actual values
- S VPRTYPE=$$FIELD^GMVGETVT(+$P(VPRGMV,U,3),2)
- I VPRTYPE="WT" D ;get BMI for weight record
- . I $G(^TMP("VPRGMV",$J,IEN)) S $P(VPRGMV,U,14)=$P(^(IEN),U,14) Q
- . ; get BMI from query array if available, else call GMVBMI
- . N VPRBMI,DFN
- . S VPRBMI(1)=+VPRGMV,VPRBMI(2)=$P(VPRGMV,U,8),DFN=+$P(VPRGMV,U,2)
- . D CALBMI^GMVBMI(.VPRBMI,0)
- . S:$G(VPRBMI)'="" $P(VPRGMV,U,14)=VPRBMI
- S VPRANGE=$S($L(VPRTYPE):$$RANGE^VPRDGMV(VPRTYPE),1:"")
- Q
- ;
- VITQUAL ; -- build DLIST(#)=Qualifiers [code^name]
- N I,X,QUALS
- S QUALS=$G(VPRV(5))
- F I=1:1 S X=$P(QUALS,U,I) Q:X="" S DLIST(I)=X
- Q
- ;
- VITCODE(IEN,SFN) ; -- return [first] code for vital type
- ; SubFileNumber = 120.518 for Vital Type
- ; 120.522 for Vital Qualifier
- N VPRC,IENS,Y
- D GETS^DIQ(SFN,"1,"_IEN_",","**",,"VPRC")
- S IENS=$O(VPRC(SFN_1,""))
- S Y=$S($L(IENS):$G(VPRC(SFN_1,IENS,.01,"I")),1:"")
- Q Y
- ;
- MDC(OBS) ; -- MDC OBSERVATION UPDATE protocol listener
- N DFN,ID,ACT,VPROBS
- M VPROBS=OBS
- D:'$D(VPROBS) NOOBS ;currently not provided by MDC event
- Q:$G(VPROBS("ERROR"))'=""
- Q:$G(VPROBS("DOMAIN","VITALS"))'=1
- S DFN=+$G(VPROBS("PATIENT_ID","I")) Q:DFN<1
- S ID=$G(VPROBS("OBS_ID","I")) Q:'$L(ID)
- S ACT=$S('$G(VPROBS("STATUS","I")):"@",1:"")
- D POST^VPRHS(DFN,"Observation",ID_";120.5",ACT)
- Q
- ;
- NOOBS ; -- called if OBS array was not created by MDCPROTD
- ; MDC event called from ASTATUS index, so expects FM variables (DA, X1, X2)
- N IEN,VPRERR,VPRGUID,Y
- S IEN=$G(DA) I '+IEN S VPROBS("ERROR")="Invalid DA value passed to entry point." Q
- D GETS^DIQ(704.117,IEN_",",".01;.08;.09","INR","^TMP(""VPROBS"",$J)","VPRERR")
- I $D(VPRERR) D Q
- . S VPROBS("ERROR")=$G(VPRERR("DIERR",1))_U_$G(VPRERR("DIERR",1,"TEXT",1))
- M VPROBS=^TMP("VPROBS",$J,704.117,IEN_",") K ^TMP("VPROBS",$J)
- S VPROBS("DOMAIN","VITALS")=0
- S VPRGUID=$$GET1^DIQ(704.117,IEN_",",.07)
- F Y=1:1 Q:$T(MAP+Y)="" I $P($T(MAP+Y),";",4)=VPRGUID S VPROBS("DOMAIN","VITALS")=1 Q
- Q
- ;
- ISGUID(MDX) ; Returns true if MDX is in the format of a GUID. Copied from MDCLIO1
- N X,Y
- Q:$L(MDX)'=38 0
- Q:MDX'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}" 0
- ; Scan for Uppercase character above F
- S X=1 F Y=71:1:90 I MDX[$C(Y) S X=0 Q
- Q X
- ;
- MAP ;Contains the CLiO terms paired with a vital sign - vital;term_guid. Copied from MDCLIO1
- ;;ABDOMINAL GIRTH;{F70E6642-2719-22BE-BE87-DEF0A884F177}
- ;;AUDIOMETRY;{FFD29134-8BB2-248E-0412-93C2C08B076F}
- ;;BLOOD PRESSURE;{B15F2DF6-CE99-B847-FE6B-3D5F174A2BCD}
- ;;CENTRAL VENOUS PRESSURE;{D30F98A7-4C5D-12E8-AB4D-9C85A4332EC3}
- ;;CIRCUMFERENCE/GIRTH;{92A124D4-B75F-9FD9-1A51-605887BCEA79};
- ;;FETAL HEART TONES;{A2E22A44-E924-ADDE-2B8E-0251666B4DE6}
- ;;FUNDAL HEIGHT;{EEAB8762-624F-7BA3-4001-114FD229BA69}
- ;;HEAD CIRCUMFERENCE;{33827E3C-5DBB-083C-D8BE-4DFD7D42071F}
- ;;HEARING;{813CCC94-3D64-5093-BC6C-053EFD9948F9}
- ;;HEIGHT;{B440216B-0FB3-1950-7859-7C1BE398FE4A}
- ;;PAIN;{47A83DEA-BA95-38AD-DF2E-1F209122E684}
- ;;PULSE;{FCA63B76-EF4C-EBE5-33C1-F1EEBD7A7BC4}
- ;;PULSE OXIMETRY;{5F84DD55-3CCF-094C-2536-B51EB7FAD999}
- ;;RESPIRATION;{973ED2C0-0625-7DF9-17DC-8FFF7E376F23}
- ;;TEMPERATURE;{0F33223E-DF2C-6B8B-5201-5E091C5F9065}
- ;;TONOMETRY;{C06989EF-4B0F-4941-B1A7-FA9D81A480FF}
- ;;VISION CORRECTED;{ED022AC1-EBE4-E708-684D-63D00628A94C}
- ;;VISION UNCORRECTED;{BEA5E565-D728-F5B3-0A3A-0528C42A45C4}
- ;;WEIGHT;{CD2D8263-6B71-0E1C-0AFE-87B4B2C12632}
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRSDAOB 5189 printed Jan 18, 2025@03:47:02 Page 2
- VPRSDAOB ;SLC/MKB/CMF -- SDA Observation utilities ;7/28/23 14:11
- +1 ;;1.0;VIRTUAL PATIENT RECORD;**33**;Sep 01, 2011;Build 8
- +2 ;;Per VHA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; External References DBIA#
- +5 ; ------------------- -----
- +6 ; ^PXRMINDX 4290
- +7 ; DIQ 2056
- +8 ; GMRVUT0, ^UTILITY($J 1446
- +9 ; GMVBMI 7437
- +10 ; GMVGETVT 5047
- +11 ; GMVUTL 5046
- +12 ; ^MDC(704.117 5810
- +13 ;
- VITALS ; -- GMR Vital Measurements query [main]
- +1 ; Expects DSTRT, DSTOP, DMAX from DDEGET and returns DLIST(#)=ien
- +2 NEW GMRVSTR,VPRIDT,VPRTYP,ID,VPRN,X0,TYP,GUID
- +3 ;CPRS vitals data set
- SET GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN"
- +4 SET GMRVSTR(0)=DSTRT_U_DSTOP_U_DMAX_"^1"
- +5 DO EN1^GMRVUT0
- SET VPRN=0
- +6 SET VPRIDT=0
- FOR
- SET VPRIDT=$ORDER(^UTILITY($JOB,"GMRVD",VPRIDT))
- if VPRIDT<1
- QUIT
- Begin DoDot:1
- +7 SET VPRTYP=""
- FOR
- SET VPRTYP=$ORDER(^UTILITY($JOB,"GMRVD",VPRIDT,VPRTYP))
- if VPRTYP=""
- QUIT
- Begin DoDot:2
- +8 SET ID=$ORDER(^UTILITY($JOB,"GMRVD",VPRIDT,VPRTYP,0))
- if 'ID
- QUIT
- +9 ; check ^PXRM for 704.117 GUID instead of 120.5 ien
- +10 SET X0=$GET(^UTILITY($JOB,"GMRVD",VPRIDT,VPRTYP,ID))
- SET TYP=$PIECE(X0,U,3)
- +11 SET GUID=$ORDER(^PXRMINDX(120.5,"PI",DFN,TYP,+X0,""))
- if GUID=""
- SET GUID=ID
- +12 SET VPRN=VPRN+1
- SET DLIST(VPRN)=GUID
- +13 SET ^TMP("VPRGMV",$JOB,GUID)=$GET(^UTILITY($JOB,"GMRVD",VPRIDT,VPRTYP,ID))
- End DoDot:2
- End DoDot:1
- if VPRN'<DMAX
- QUIT
- +14 KILL ^UTILITY($JOB,"GMRVD")
- +15 QUIT
- +16 ;
- VIT1(IEN) ; -- get info for one Vital measurement
- +1 ; Accepts IEN = #120.5 ien or #704.117 GUID
- +2 ; Returns VPRV array, VPRGMV=VPRV(0), VPRANGE, VPRTYPE to entity
- +3 SET IEN=$GET(IEN)
- IF IEN=""
- SET DDEOUT=1
- QUIT
- +4 DO GETREC^GMVUTL(.VPRV,IEN,1)
- +5 SET VPRGMV=$GET(VPRV(0))
- IF '$GET(VPRV(0))
- SET DDEOUT=1
- QUIT
- +6 ;don't pass rare but potential GUID strings as actual values
- IF $$ISGUID($PIECE(VPRGMV,U,8))
- SET DDEOUT=1
- QUIT
- +7 SET VPRTYPE=$$FIELD^GMVGETVT(+$PIECE(VPRGMV,U,3),2)
- +8 ;get BMI for weight record
- IF VPRTYPE="WT"
- Begin DoDot:1
- +9 IF $GET(^TMP("VPRGMV",$JOB,IEN))
- SET $PIECE(VPRGMV,U,14)=$PIECE(^(IEN),U,14)
- QUIT
- +10 ; get BMI from query array if available, else call GMVBMI
- +11 NEW VPRBMI,DFN
- +12 SET VPRBMI(1)=+VPRGMV
- SET VPRBMI(2)=$PIECE(VPRGMV,U,8)
- SET DFN=+$PIECE(VPRGMV,U,2)
- +13 DO CALBMI^GMVBMI(.VPRBMI,0)
- +14 if $GET(VPRBMI)'=""
- SET $PIECE(VPRGMV,U,14)=VPRBMI
- End DoDot:1
- +15 SET VPRANGE=$SELECT($LENGTH(VPRTYPE):$$RANGE^VPRDGMV(VPRTYPE),1:"")
- +16 QUIT
- +17 ;
- VITQUAL ; -- build DLIST(#)=Qualifiers [code^name]
- +1 NEW I,X,QUALS
- +2 SET QUALS=$GET(VPRV(5))
- +3 FOR I=1:1
- SET X=$PIECE(QUALS,U,I)
- if X=""
- QUIT
- SET DLIST(I)=X
- +4 QUIT
- +5 ;
- VITCODE(IEN,SFN) ; -- return [first] code for vital type
- +1 ; SubFileNumber = 120.518 for Vital Type
- +2 ; 120.522 for Vital Qualifier
- +3 NEW VPRC,IENS,Y
- +4 DO GETS^DIQ(SFN,"1,"_IEN_",","**",,"VPRC")
- +5 SET IENS=$ORDER(VPRC(SFN_1,""))
- +6 SET Y=$SELECT($LENGTH(IENS):$GET(VPRC(SFN_1,IENS,.01,"I")),1:"")
- +7 QUIT Y
- +8 ;
- MDC(OBS) ; -- MDC OBSERVATION UPDATE protocol listener
- +1 NEW DFN,ID,ACT,VPROBS
- +2 MERGE VPROBS=OBS
- +3 ;currently not provided by MDC event
- if '$DATA(VPROBS)
- DO NOOBS
- +4 if $GET(VPROBS("ERROR"))'=""
- QUIT
- +5 if $GET(VPROBS("DOMAIN","VITALS"))'=1
- QUIT
- +6 SET DFN=+$GET(VPROBS("PATIENT_ID","I"))
- if DFN<1
- QUIT
- +7 SET ID=$GET(VPROBS("OBS_ID","I"))
- if '$LENGTH(ID)
- QUIT
- +8 SET ACT=$SELECT('$GET(VPROBS("STATUS","I")):"@",1:"")
- +9 DO POST^VPRHS(DFN,"Observation",ID_";120.5",ACT)
- +10 QUIT
- +11 ;
- NOOBS ; -- called if OBS array was not created by MDCPROTD
- +1 ; MDC event called from ASTATUS index, so expects FM variables (DA, X1, X2)
- +2 NEW IEN,VPRERR,VPRGUID,Y
- +3 SET IEN=$GET(DA)
- IF '+IEN
- SET VPROBS("ERROR")="Invalid DA value passed to entry point."
- QUIT
- +4 DO GETS^DIQ(704.117,IEN_",",".01;.08;.09","INR","^TMP(""VPROBS"",$J)","VPRERR")
- +5 IF $DATA(VPRERR)
- Begin DoDot:1
- +6 SET VPROBS("ERROR")=$GET(VPRERR("DIERR",1))_U_$GET(VPRERR("DIERR",1,"TEXT",1))
- End DoDot:1
- QUIT
- +7 MERGE VPROBS=^TMP("VPROBS",$JOB,704.117,IEN_",")
- KILL ^TMP("VPROBS",$JOB)
- +8 SET VPROBS("DOMAIN","VITALS")=0
- +9 SET VPRGUID=$$GET1^DIQ(704.117,IEN_",",.07)
- +10 FOR Y=1:1
- if $TEXT(MAP+Y)=""
- QUIT
- IF $PIECE($TEXT(MAP+Y),";",4)=VPRGUID
- SET VPROBS("DOMAIN","VITALS")=1
- QUIT
- +11 QUIT
- +12 ;
- ISGUID(MDX) ; Returns true if MDX is in the format of a GUID. Copied from MDCLIO1
- +1 NEW X,Y
- +2 if $LENGTH(MDX)'=38
- QUIT 0
- +3 if MDX'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}"
- QUIT 0
- +4 ; Scan for Uppercase character above F
- +5 SET X=1
- FOR Y=71:1:90
- IF MDX[$CHAR(Y)
- SET X=0
- QUIT
- +6 QUIT X
- +7 ;
- MAP ;Contains the CLiO terms paired with a vital sign - vital;term_guid. Copied from MDCLIO1
- +1 ;;ABDOMINAL GIRTH;{F70E6642-2719-22BE-BE87-DEF0A884F177}
- +2 ;;AUDIOMETRY;{FFD29134-8BB2-248E-0412-93C2C08B076F}
- +3 ;;BLOOD PRESSURE;{B15F2DF6-CE99-B847-FE6B-3D5F174A2BCD}
- +4 ;;CENTRAL VENOUS PRESSURE;{D30F98A7-4C5D-12E8-AB4D-9C85A4332EC3}
- +5 ;;CIRCUMFERENCE/GIRTH;{92A124D4-B75F-9FD9-1A51-605887BCEA79};
- +6 ;;FETAL HEART TONES;{A2E22A44-E924-ADDE-2B8E-0251666B4DE6}
- +7 ;;FUNDAL HEIGHT;{EEAB8762-624F-7BA3-4001-114FD229BA69}
- +8 ;;HEAD CIRCUMFERENCE;{33827E3C-5DBB-083C-D8BE-4DFD7D42071F}
- +9 ;;HEARING;{813CCC94-3D64-5093-BC6C-053EFD9948F9}
- +10 ;;HEIGHT;{B440216B-0FB3-1950-7859-7C1BE398FE4A}
- +11 ;;PAIN;{47A83DEA-BA95-38AD-DF2E-1F209122E684}
- +12 ;;PULSE;{FCA63B76-EF4C-EBE5-33C1-F1EEBD7A7BC4}
- +13 ;;PULSE OXIMETRY;{5F84DD55-3CCF-094C-2536-B51EB7FAD999}
- +14 ;;RESPIRATION;{973ED2C0-0625-7DF9-17DC-8FFF7E376F23}
- +15 ;;TEMPERATURE;{0F33223E-DF2C-6B8B-5201-5E091C5F9065}
- +16 ;;TONOMETRY;{C06989EF-4B0F-4941-B1A7-FA9D81A480FF}
- +17 ;;VISION CORRECTED;{ED022AC1-EBE4-E708-684D-63D00628A94C}
- +18 ;;VISION UNCORRECTED;{BEA5E565-D728-F5B3-0A3A-0528C42A45C4}
- +19 ;;WEIGHT;{CD2D8263-6B71-0E1C-0AFE-87B4B2C12632}
- +20 QUIT