CIAVIHVT.m

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