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