CIAVIHVT ;CIA/DKM - Vitals support for RPMS ;07-Sep-2004 19:29;DKM
;;1.1;VUECENTRIC RPMS SUPPORT;;Sep 14, 2004
;;Copyright 2000-2003, Clinical Informatics Associates, Inc.
;=================================================================
; Converts vitals to proper formatting for PCC
VIT2PCC(VIT) ;
N PCC,X,VAL,TYP,VST,OBS,DFN,VSTR,UNT,DAT,ERR
S PCC="",X=0,VSTR="",ERR=""
F S X=$O(VIT(X)) Q:'X D Q:$L(ERR)
.S VAL=VIT(X),OBS=$P(VAL,U,2),TYP=$TR($P(VAL,U),"+")
.I TYP="VST" S VAL=$P(VAL,U,3)
.E S UNT=$P(VAL,U,7),DAT=$P(VAL,U,8),VAL=$P(VAL,U,5)
.D:$L(VAL) VALIDATE(TYP,.OBS,.VAL,.UNT,.ERR)
.I $L(ERR) S ERR="-1^"_ERR Q
.I $L(VAL),TYP="VIT" S PCC=PCC_$S($L(PCC):"|",1:"")_OBS_";"_VAL
I '$L(ERR) D
.S VST=$$VSTR2VIS^CIAVCXEN(DFN,VSTR,1)
.I VST>0 S VST=+VST
.E S ERR=VST
Q $S($L(ERR):ERR,1:VST_"|"_DUZ_"|"_PCC)
; Validate VAL
VALIDATE(TYP,OBS,VAL,UNT,ERR) ;
N EP
S EP=TYP_OBS,ERR="",UNT=$G(UNT)
I $T(@EP)="" S ERR="Unknown measurement type."
E D @EP
Q
; Validates units
CHKUNT(UNIT) ;
S:'$L(UNT) UNT=UNIT
S:UNT'=UNIT ERR="Improper units: "_UNT
Q:$Q $L(ERR)
Q
; Validate numeric range
CHKRNG(VAL,LOW,HI,FR) ;
I '$G(FR),VAL["." S ERR="Fractional portion not allowed"
E I "."'[$TR(VAL,"0123456789") S ERR="Invalid numeric format"
E S VAL=+VAL S:(VAL<LOW)!(VAL>HI) ERR="Entry outside acceptable range"
Q:$Q $L(ERR)
Q
VSTDT S $P(VSTR,";",2)=+VAL
Q
VSTPT S DFN=+VAL
Q
VSTHL S $P(VSTR,";")=+VAL
Q
VITPN S OBS="PA"
VITPA D CHKRNG(.VAL,0,10)
Q
VITBP I VAL'?2.3N1"/"2.3N S ERR="Invalid data format" Q
N SBP,DBP
S SBP=$P(VAL,"/"),DBP=$P(VAL,"/",2)
Q:$$CHKRNG(.SBP,0,300)
Q:$$CHKRNG(.DBP,0,200)
S VAL=SBP_"/"_DBP
Q
VITTMP S:UNT="C" VAL=VAL*9/5+32,UNT="F"
Q:$$CHKUNT("F")
Q:$$CHKRNG(.VAL,80,110,1)
Q
VITPU D CHKRNG(.VAL,0,300)
Q
VITRS Q
VITHT S:UNT="CM" VAL=VAL/2.54,UNT="IN"
Q:$$CHKUNT("IN")
Q
VITWT S:UNT="KG" VAL=VAL/2.2,UNT="LB"
Q:$$CHKUNT("LB")
Q
; Store vitals data in V MEASUREMENT
VALSTORE(DATA,VIT) ;
S VIT=$$VIT2PCC(.VIT)
I VIT'>0 S DATA(1)=VIT
E D MEA^BTRSETME(.DATA,VIT)
I $G(DATA(1))<0 S DATA(0)=-1,DATA(1)=$P(DATA(1),U,2)
E S DATA(0)=1
Q
; RPC for validate
RATECHK(DATA,OBS,VAL,UNT) ;
N ERR
D VALIDATE("VIT",OBS,.VAL,.UNT,.ERR)
S DATA=$S($L(ERR):"0^"_ERR,1:"1^"_VAL_U_UNT)
Q
; Return most recent vital of specified type
; Return value is IEN^VALUE^D/T
VITAL(DFN,TYP) ;
N IDT,IEN,DAT,VIS
S:TYP'=+TYP TYP=$O(^AUTTMSR("B",TYP,0))
Q:'TYP ""
S IDT=$O(^AUPNVMSR("AA",DFN,TYP,0)) Q:'IDT "" S IEN=$O(^(IDT,0))
Q:'IEN ""
S X=$G(^AUPNVMSR(IEN,0)),DAT=+$G(^(12))
S:'DAT DAT=+$G(^AUPNVSIT(+$P(X,U,3),0))
Q IEN_U_$P(X,U,4)_U_DAT
; Return data for vital entry template
; Format is:
; DATA(n)=Type IEN^Type Abbr^Type Desc^Last Value^Last Date^Units
TEMPLATE(DATA,DFN,LOC) ;
N ENT,TMP,ERR,TYP,X
S ENT=$S($G(LOC):"ALL^LOC.`"_LOC,1:"ALL"),DATA=$$TMPGBL^CIAVMRPC
D GETLST^XPAR(.TMP,ENT,"CIAOCVVM TEMPLATE","I",.ERR)
F TMP=0:0 S TMP=$O(TMP(TMP)) Q:'TMP D
.S TYP=+TMP(TMP),X=$$VITAL(DFN,TYP),@DATA@(TMP)=TYP_U_$P($G(^AUTTMSR(TYP,0)),U,1,2)_U_$P(X,U,2,3)
Q
; Postinit for installation
POSTINIT D SETLIST^CIAOCVVM("CIAOCVVM TEMPLATE")
Q
CIAVIHVT ;CIA/DKM - Vitals support for RPMS ;07-Sep-2004 19:29;DKM
+1 ;;1.1;VUECENTRIC RPMS SUPPORT;;Sep 14, 2004
+2 ;;Copyright 2000-2003, Clinical Informatics Associates, Inc.
+3 ;=================================================================
+4 ; Converts vitals to proper formatting for PCC
VIT2PCC(VIT) ;
+1 NEW PCC,X,VAL,TYP,VST,OBS,DFN,VSTR,UNT,DAT,ERR
+2 SET PCC=""
SET X=0
SET VSTR=""
SET ERR=""
+3 FOR
SET X=$ORDER(VIT(X))
IF 'X
QUIT
Begin DoDot:1
+4 SET VAL=VIT(X)
SET OBS=$PIECE(VAL,U,2)
SET TYP=$TRANSLATE($PIECE(VAL,U),"+")
+5 IF TYP="VST"
SET VAL=$PIECE(VAL,U,3)
+6 IF '$TEST
SET UNT=$PIECE(VAL,U,7)
SET DAT=$PIECE(VAL,U,8)
SET VAL=$PIECE(VAL,U,5)
+7 IF $LENGTH(VAL)
DO VALIDATE(TYP,.OBS,.VAL,.UNT,.ERR)
+8 IF $LENGTH(ERR)
SET ERR="-1^"_ERR
QUIT
+9 IF $LENGTH(VAL)
IF TYP="VIT"
SET PCC=PCC_$SELECT($LENGTH(PCC):"|",1:"")_OBS_";"_VAL
End DoDot:1
IF $LENGTH(ERR)
QUIT
+10 IF '$LENGTH(ERR)
Begin DoDot:1
+11 SET VST=$$VSTR2VIS^CIAVCXEN(DFN,VSTR,1)
+12 IF VST>0
SET VST=+VST
+13 IF '$TEST
SET ERR=VST
End DoDot:1
+14 QUIT $SELECT($LENGTH(ERR):ERR,1:VST_"|"_DUZ_"|"_PCC)
+15 ; Validate VAL
VALIDATE(TYP,OBS,VAL,UNT,ERR) ;
+1 NEW EP
+2 SET EP=TYP_OBS
SET ERR=""
SET UNT=$GET(UNT)
+3 IF $TEXT(@EP)=""
SET ERR="Unknown measurement type."
+4 IF '$TEST
DO @EP
+5 QUIT
+6 ; Validates units
CHKUNT(UNIT) ;
+1 IF '$LENGTH(UNT)
SET UNT=UNIT
+2 IF UNT'=UNIT
SET ERR="Improper units: "_UNT
+3 IF $QUIT
QUIT $LENGTH(ERR)
+4 QUIT
+5 ; Validate numeric range
CHKRNG(VAL,LOW,HI,FR) ;
+1 IF '$GET(FR)
IF VAL["."
SET ERR="Fractional portion not allowed"
+2 IF '$TEST
IF "."'[$TRANSLATE(VAL,"0123456789")
SET ERR="Invalid numeric format"
+3 IF '$TEST
SET VAL=+VAL
IF (VAL<LOW)!(VAL>HI)
SET ERR="Entry outside acceptable range"
+4 IF $QUIT
QUIT $LENGTH(ERR)
+5 QUIT
VSTDT SET $PIECE(VSTR,";",2)=+VAL
+1 QUIT
VSTPT SET DFN=+VAL
+1 QUIT
VSTHL SET $PIECE(VSTR,";")=+VAL
+1 QUIT
VITPN SET OBS="PA"
VITPA DO CHKRNG(.VAL,0,10)
+1 QUIT
VITBP IF VAL'?2.3N1"/"2.3N
SET ERR="Invalid data format"
QUIT
+1 NEW SBP,DBP
+2 SET SBP=$PIECE(VAL,"/")
SET DBP=$PIECE(VAL,"/",2)
+3 IF $$CHKRNG(.SBP,0,300)
QUIT
+4 IF $$CHKRNG(.DBP,0,200)
QUIT
+5 SET VAL=SBP_"/"_DBP
+6 QUIT
VITTMP IF UNT="C"
SET VAL=VAL*9/5+32
SET UNT="F"
+1 IF $$CHKUNT("F")
QUIT
+2 IF $$CHKRNG(.VAL,80,110,1)
QUIT
+3 QUIT
VITPU DO CHKRNG(.VAL,0,300)
+1 QUIT
VITRS QUIT
VITHT IF UNT="CM"
SET VAL=VAL/2.54
SET UNT="IN"
+1 IF $$CHKUNT("IN")
QUIT
+2 QUIT
VITWT IF UNT="KG"
SET VAL=VAL/2.2
SET UNT="LB"
+1 IF $$CHKUNT("LB")
QUIT
+2 QUIT
+3 ; Store vitals data in V MEASUREMENT
VALSTORE(DATA,VIT) ;
+1 SET VIT=$$VIT2PCC(.VIT)
+2 IF VIT'>0
SET DATA(1)=VIT
+3 IF '$TEST
DO MEA^BTRSETME(.DATA,VIT)
+4 IF $GET(DATA(1))<0
SET DATA(0)=-1
SET DATA(1)=$PIECE(DATA(1),U,2)
+5 IF '$TEST
SET DATA(0)=1
+6 QUIT
+7 ; RPC for validate
RATECHK(DATA,OBS,VAL,UNT) ;
+1 NEW ERR
+2 DO VALIDATE("VIT",OBS,.VAL,.UNT,.ERR)
+3 SET DATA=$SELECT($LENGTH(ERR):"0^"_ERR,1:"1^"_VAL_U_UNT)
+4 QUIT
+5 ; Return most recent vital of specified type
+6 ; Return value is IEN^VALUE^D/T
VITAL(DFN,TYP) ;
+1 NEW IDT,IEN,DAT,VIS
+2 IF TYP'=+TYP
SET TYP=$ORDER(^AUTTMSR("B",TYP,0))
+3 IF 'TYP
QUIT ""
+4 SET IDT=$ORDER(^AUPNVMSR("AA",DFN,TYP,0))
IF 'IDT
QUIT ""
SET IEN=$ORDER(^(IDT,0))
+5 IF 'IEN
QUIT ""
+6 SET X=$GET(^AUPNVMSR(IEN,0))
SET DAT=+$GET(^(12))
+7 IF 'DAT
SET DAT=+$GET(^AUPNVSIT(+$PIECE(X,U,3),0))
+8 QUIT IEN_U_$PIECE(X,U,4)_U_DAT
+9 ; Return data for vital entry template
+10 ; Format is:
+11 ; DATA(n)=Type IEN^Type Abbr^Type Desc^Last Value^Last Date^Units
TEMPLATE(DATA,DFN,LOC) ;
+1 NEW ENT,TMP,ERR,TYP,X
+2 SET ENT=$SELECT($GET(LOC):"ALL^LOC.`"_LOC,1:"ALL")
SET DATA=$$TMPGBL^CIAVMRPC
+3 DO GETLST^XPAR(.TMP,ENT,"CIAOCVVM TEMPLATE","I",.ERR)
+4 FOR TMP=0:0
SET TMP=$ORDER(TMP(TMP))
IF 'TMP
QUIT
Begin DoDot:1
+5 SET TYP=+TMP(TMP)
SET X=$$VITAL(DFN,TYP)
SET @DATA@(TMP)=TYP_U_$PIECE($GET(^AUTTMSR(TYP,0)),U,1,2)_U_$PIECE(X,U,2,3)
End DoDot:1
+6 QUIT
+7 ; Postinit for installation
POSTINIT DO SETLIST^CIAOCVVM("CIAOCVVM TEMPLATE")
+1 QUIT
