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

BCHMSRE.m

Go to the documentation of this file.
  1. BCHMSRE ; IHS/CMI/LAB - Edits for measurement values ;
  1. ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1. ;
  1. ;called from input transform on measurement fields in chr record
  1. ;edits data value.
  1. ;
  1. BP ;EP (BLOOD PRESSURE)
  1. NEW BCHBPS,BCHBPD
  1. I $L(X)>7!($L(X)<5)!'(X?2.3N1"/"2.3N) K X Q
  1. S BCHBPS=+$P(X,"/",1),BCHBPD=+$P(X,"/",2)
  1. I BCHBPS<20!(BCHBPS>275) K X G BPX
  1. I BCHBPD<20!(BCHBPD>200) K X G BPX
  1. I BCHBPS'>BCHBPD K X G BPX
  1. S X=BCHBPS_"/"_BCHBPD
  1. BPX K BCHBPS,BCHBPD
  1. Q
  1. HC ;EP (HEAD CIRCUMFERENCE)
  1. D:X?.E.A.E MHT
  1. Q:'$D(X)
  1. D HTHCC
  1. S:$P(X,".",2)?4N.N X=X+.0005,X=$P(X,".")_"."_$E($P(X,".",2),1,3)
  1. S X=+X
  1. Q:'$D(X)
  1. K:+X'=X!(X>30)!(X<10)!(X?.E1"."4N.N) X
  1. Q:'$D(X)
  1. ;K:X-(X\1)#.125 X
  1. Q
  1. HE ;EP (HEARING)
  1. K:X'="A"&(X'="N") X
  1. Q
  1. HT ;EP (HEIGHT)
  1. D:X?.E.A.E MHT
  1. Q:'$D(X)
  1. D HTHCC
  1. S:$P(X,".",2)?4N.N X=X+.0005,X=$P(X,".")_"."_$E($P(X,".",2),1,3)
  1. S X=+X
  1. Q:'$D(X)
  1. K:+X'=X!(X>80)!(X<10)!(X?.E1"."4N.N) X
  1. Q:'$D(X)
  1. ;K:X-(X\1)#.125 X
  1. Q
  1. HTHCC Q:X'["/"
  1. Q:X'?2N1" "1N1"/"1N
  1. S X=$P(X," ")_+("."_($P($P(X," ",2),"/")*1000\$P($P(X," ",2),"/",2)))
  1. Q
  1. ;EP
  1. MHT ;EP
  1. NEW BCHC,BCHI,BCHJ
  1. S BCHJ=$L(X) F BCHI=1:1:BCHJ S BCHC=$E(X,BCHI) I BCHC?1A S BCHC=$S(BCHC?1L:$C($A(BCHC)-32),1:BCHC)
  1. S (BCHI,BCHC)="" F BCHI=1:1:BCHJ S BCHC=$E(X,BCHI) Q:"C"[BCHC
  1. I BCHC="C" D @BCHC
  1. K BCHC,BCHI,BCHJ
  1. Q
  1. PU ;EP (PULSE)
  1. K:+X'=X!(X>250)!(X<30)!(X?.E1"."1N.N) X
  1. Q
  1. TMP ;EP (TEMPERATURE)
  1. K:+X'=X!(X>109.9)!(X<94)!(X?.E1"."2N.N) X
  1. Q
  1. VC ;EP (VISION CORRECTED)
  1. VU ;EP (VISION UNCORRECTED)
  1. I $L(X)>7!($L(X)<2)!'((X?2.3N)!(X?1"/"2.3N)!(X?2.3N1"/"2.3N)) K X Q
  1. I $P(X,"/")'="" I $P(X,"/")<10!($P(X,"/")>999) K X Q
  1. I $P(X,"/",2)'="" I $P(X,"/",2)<10!($P(X,"/",2)>999) K X Q
  1. Q
  1. WT ;EP (WEIGHT)
  1. D:X?.E.A.E MWT
  1. Q:'$D(X)
  1. D WTC
  1. S:$P(X,".",2)?5N.N X=X+.00005,X=$P(X,".")_"."_$E($P(X,".",2),1,4)
  1. S X=+X
  1. Q:'$D(X)
  1. K:+X'=X!(X>750)!(X<2)!(X?.E1"."5N.N) X
  1. Q:'$D(X)
  1. ;K:X-(X\1)#.0625 X
  1. Q
  1. WTC Q:+X=X!(X'[" ")
  1. Q:'(X?1.3N1" "1.2N!(X?1.3N1" "1.2N1"/"1.2N))
  1. I X'["/" Q:+$P(X," ",2)>16 S X=+X+(+$P(X," ",2)/16) Q
  1. Q:+$P($P(X," ",2),"/")'<+$P($P(X," ",2),"/",2)
  1. S X=+X+((+$P(X," ",2)/$P($P(X," ",2),"/",2)))
  1. Q
  1. ;EP
  1. MWT ;EP
  1. NEW BCHI,BCHJ,BCHC
  1. S BCHJ=$L(X) F BCHI=1:1:BCHJ S BCHC=$E(X,BCHI) I BCHC?1A S BCHC=$S(BCHC?1L:$C($A(BCHC)-32),1:BCHC)
  1. S (BCHI,BCHC)="" F BCHI=1:1:BCHJ S BCHC=$E(X,BCHI) Q:"GK"[BCHC
  1. I "GK"[BCHC D @BCHC
  1. K BCHC,BCHI,BCHJ
  1. Q
  1. MWTC ;EP
  1. Q:+X=X!(X'[" ")!(X'["/")
  1. K:'(X?1.6N1" "1.2N1"/"1.2N) X
  1. Q:'$D(X)
  1. S X=+X+((+$P(X," ",2)/$P($P(X," ",2),"/",2)))
  1. Q
  1. K ;EP
  1. I X["/" S X=$P(X,BCHC) D MWTC
  1. Q:'$D(X)
  1. S X=+X
  1. S X=(X*2.2046226)
  1. Q
  1. G ;EP
  1. I X["/" S X=$P(X,BCHC) D MWTC
  1. Q:'$D(X)
  1. S X=+X
  1. S X=(X*.0022046226)
  1. Q
  1. C ;EP
  1. I X["/" S X=$P(X,BCHC) D MWTC
  1. Q:'$D(X)
  1. S X=+X
  1. S X=(X*.393701)
  1. Q
  1. AG ;EP (ABDOMINAL GIRTH)
  1. K:+X'=X!(X>150)!(X<0)!(X?.E1"."1N.N) X
  1. Q
  1. FH ;EP Fundal Height
  1. K:+X'=X!(X>50)!(X<10)!(X?.E1"."1N.N) X
  1. Q
  1. FT ;EP Fetal Heart Tones
  1. K:+X'=X!(X>250)!(X<50)!(X?.E1"."1N.N) X
  1. Q
  1. RS ;EP
  1. I X'?1.2N!(X<8)!(X>90) K X Q
  1. Q
  1. HELP ;EP HELP FOR VARIOUS TYPES
  1. D ^BCHMSRH
  1. Q