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

VPRSDAOB.m

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