BDMDB1H ; IHS/CMI/LAB - 2014 DIABETES AUDIT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**7**;JUN 14, 2007;Build 24
;
GATHER ;
S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!($D(BDM)) D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X D
...Q:'$D(^AUPNVLAB(X,0))
...Q:$$UP^XLFSTR($P(^AUPNVLAB(X,0),U,4))["CANC"
...I '$G(BDMACRA) Q:$$UP^XLFSTR($P(^AUPNVLAB(X,0),U,4))["COMMENT"
...Q:$P(^AUPNVLAB(X,0),U,4)=""
...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETO Q
...Q:'BDMOT
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,BDMOT)
...D SETO
...Q
Q
LOINC(A,B) ;EP - is loinc code A in taxonomy B
NEW %
I '$G(B) Q ""
S %=$P($G(^LAB(95.3,A,9999999)),U,2)
I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
I $D(^ATXAX(B,21,"B",%)) Q 1
Q ""
SETO ;
S BDMC=BDMC+1
S V=$P(^AUPNVLAB(X,0),U,3),BDMV=$P($P($G(^AUPNVSIT(V,0)),U),".") Q:'BDMV
S BDM(9999999-BDMV,BDMC)=BDMV_"^"_$S($P(^AUPNVLAB(X,0),U,4)]"":$P(^AUPNVLAB(X,0),U,4),1:"")_"^"_$$VAL^XBDIQ1(9000010.09,X,.01)_"^"_X_";AUPNVLAB^"_V
Q
SETV ;
S BDMC=BDMC+1
S V=$P(^AUPNVLAB(X,0),U,3),BDMV=$P($P($G(^AUPNVSIT(V,0)),U),".") Q:'BDMV
S BDM(BDMC)=BDMV_"^"_$S($P(^AUPNVLAB(X,0),U,4)]"":$P(^AUPNVLAB(X,0),U,4),1:"")_"^"_$$VAL^XBDIQ1(9000010.09,X,.01)_"^"_X_";AUPNVLAB^"_V
Q
SETN ;
S N="" NEW A,G,BDMR,D
S A=0 F S A=$O(BDM(A)) Q:A'=+A S BDMR(9999999-$P(BDM(A),U,1),A)=BDM(A)
S (A,D,G)=0 F S D=$O(BDMR(D)) Q:D'=+D!(G) D
.S A=0 F S A=$O(BDMR(D,A)) Q:A'=+A!(G) D
..S R=$P(^AUPNVLAB(+$P(BDM(A),U,4),0),U,4) I R]"",$$UP^XLFSTR(R)'="COMMENT" S G=A
S N=$S(G:G,1:1)
Q
SET3 ;
NEW X,N1,N2,N3,A,T
K A
S X=0 F S X=$O(BDM(X)) Q:X'=+X S A($P(BDM(X),U),X)=""
NEW D S D=0 F S D=$O(A(D)) Q:D'=+D D
.S G=0,N=0 F S N=$O(A(D,N)) Q:N'=+N D
..I $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"",$$UP^XLFSTR($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4))'="COMMENT" S G=1 Q
.I G S N=0 F S N=$O(A(D,N)) Q:N'=+N I $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)="" K BDM(N)
.Q
Q
;
URIN ;EP
NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V,G,C,BDMNROK,T,N,BDMACRA
1 ;
K BDM S BDMC=0,BDMACRA=1
S BDMOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
S BDMLT=$O(^ATXLAB("B","DM AUDIT QUANT UACR",0))
D GATHER
S D=0,C=0,G="" F S D=$O(BDM(D)) Q:D'=+D!(G]"") S C=0 F S C=$O(BDM(D,C)) Q:C'=+C!(G]"") D
.;EVALUATE RESULT, if contains < or > strip that off and use the number
.S R=$P(BDM(D,C),U,2)
.I R["<"!(R[">") S R=$$STV^BDMDB18(R,8) I R]"" S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_1_U_R
.S R=$$STV^BDMDB18(R,8)
.I R="" D Q
..S (E,X,J,L)=""
..S BDMOT=$O(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))
..S BDMLT=$O(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))
..S V=$P(BDM(D,C),U,5) S X=0 F S X=$O(^AUPNVLAB("AD",V,X)) Q:X'=+X!(G) D
...S L=$P($G(^AUPNVLAB(X,0)),U,1)
...Q:L=""
...S E=""
...I BDMLT,$D(^ATXLAB(BDMLT,21,"B",L)) S E=1
...I 'E,BDMOT S J=$P($G(^AUPNVLAB(X,11)),U,13) I J]"",$$LOINC(J,BDMOT) S E=1
...Q:'E
...I $P(^AUPNVLAB(X,0),U,4)["<" S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_1_U_5
...I $P(^AUPNVLAB(X,0),U,4)[">" S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_1_U_999
..I 'G S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_1_U_R
.S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_1_U_R
Q G
;OLD STUFF
I G]"" Q G
K BDMACRA
2 ;
K BDM
S BDMC=0
S BDMOT="DM AUDIT P/C RATIO LOINC"
S BDMLT=$O(^ATXLAB("B","DM AUDIT P/C RATIO TAX",0))
D GATHER
S D=0,C=0,G="" F S D=$O(BDM(D)) Q:D'=+D!(G]"") S C=0 F S C=$O(BDM(D,C)) Q:C'=+C!(G]"") D
.S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_2
I G]"" Q G
3 ;
K BDM
S BDMC=0
S BDMOT=""
S BDMLT=$O(^ATXLAB("B","DM AUDIT 24HR URINE PROTEIN",0))
D GATHER
S D=0,C=0,G="" F S D=$O(BDM(D)) Q:D'=+D!(G]"") S C=0 F S C=$O(BDM(D,C)) Q:C'=+C!(G]"") D
.S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_3
I G]"" Q G
4 ;
K BDM
S BDMC=0
S BDMOT=""
S BDMLT=$O(^ATXLAB("B","DM AUDIT SEMI QUANT UACR",0))
D GATHER
S D=0,C=0,G="" F S D=$O(BDM(D)) Q:D'=+D!(G]"") S C=0 F S C=$O(BDM(D,C)) Q:C'=+C!(G]"") D
.S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_4
I G]"" Q G
5 ;
K BDM
S BDMC=0
S BDMOT=$O(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))
S BDMLT=$O(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))
D GATHER
S D=0,C=0,G="" F S D=$O(BDM(D)) Q:D'=+D!(G]"") S C=0 F S C=$O(BDM(D,C)) Q:C'=+C!(G]"") D
.S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_5
I G]"" Q G
6 ;
K BDM
S BDMC=0
S BDMOT=$O(^ATXAX("B","BGP URINE PROTEIN LOINC CODES",0))
S BDMLT=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
D GATHER
S D=0,C=0,G="" F S D=$O(BDM(D)) Q:D'=+D!(G]"") S C=0 F S C=$O(BDM(D,C)) Q:C'=+C!(G]"") D
.S G="1 Yes "_U_$P(BDM(D,C),U,2)_U_$$FMTE^XLFDT($P(BDM(D,C),U))_U_$P(BDM(D,C),U,3)_U_6
I G]"" Q G
Q "2 No"
SEMIE(V) ;EP - called from epi
I V="" Q ""
I V["-" Q 2
I V["300" Q 3
I V[">" Q 3
I V["<" Q 1
S V=$$STV^BDMDB18(V,5,1)
S V=+V
I 'V Q ""
I +V>299.99 Q 3
I +V>29.9999,+V<299.9999 Q 2
I +V<30 Q 1
Q ""
UPE(%) ;EP - called from epi
I %="" Q ""
I %["+" Q 2
I %[">" Q 2
I $E(%)="P" Q 2
I $E(%)="p" Q 2
I $E($$UP^XLFSTR(%))="S" Q 2
I $E($$UP^XLFSTR(%))="M" Q 2
I $E($$UP^XLFSTR(%))="L" Q 2
I +%>29 Q 2
Q 1
BDMDB1H ; IHS/CMI/LAB - 2014 DIABETES AUDIT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7**;JUN 14, 2007;Build 24
+2 ;
GATHER ;
+1 SET B=9999999-BDATE
SET E=9999999-EDATE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)!($DATA(BDM))
QUIT
Begin DoDot:1
+2 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+4 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+5 IF $$UP^XLFSTR($PIECE(^AUPNVLAB(X,0),U,4))["CANC"
QUIT
+6 IF '$GET(BDMACRA)
IF $$UP^XLFSTR($PIECE(^AUPNVLAB(X,0),U,4))["COMMENT"
QUIT
+7 IF $PIECE(^AUPNVLAB(X,0),U,4)=""
QUIT
+8 IF BDMLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BDMLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
DO SETO
QUIT
+9 IF 'BDMOT
QUIT
+10 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+11 IF '$$LOINC(J,BDMOT)
QUIT
+12 DO SETO
+13 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
LOINC(A,B) ;EP - is loinc code A in taxonomy B
+1 NEW %
+2 IF '$GET(B)
QUIT ""
+3 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
+4 IF %]""
IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+5 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
+6 IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+7 QUIT ""
SETO ;
+1 SET BDMC=BDMC+1
+2 SET V=$PIECE(^AUPNVLAB(X,0),U,3)
SET BDMV=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
IF 'BDMV
QUIT
+3 SET BDM(9999999-BDMV,BDMC)=BDMV_"^"_$SELECT($PIECE(^AUPNVLAB(X,0),U,4)]"":$PIECE(^AUPNVLAB(X,0),U,4),1:"")_"^"_$$VAL^XBDIQ1(9000010.09,X,.01)_"^"_X_";AUPNVLAB^"_V
+4 QUIT
SETV ;
+1 SET BDMC=BDMC+1
+2 SET V=$PIECE(^AUPNVLAB(X,0),U,3)
SET BDMV=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
IF 'BDMV
QUIT
+3 SET BDM(BDMC)=BDMV_"^"_$SELECT($PIECE(^AUPNVLAB(X,0),U,4)]"":$PIECE(^AUPNVLAB(X,0),U,4),1:"")_"^"_$$VAL^XBDIQ1(9000010.09,X,.01)_"^"_X_";AUPNVLAB^"_V
+4 QUIT
SETN ;
+1 SET N=""
NEW A,G,BDMR,D
+2 SET A=0
FOR
SET A=$ORDER(BDM(A))
IF A'=+A
QUIT
SET BDMR(9999999-$PIECE(BDM(A),U,1),A)=BDM(A)
+3 SET (A,D,G)=0
FOR
SET D=$ORDER(BDMR(D))
IF D'=+D!(G)
QUIT
Begin DoDot:1
+4 SET A=0
FOR
SET A=$ORDER(BDMR(D,A))
IF A'=+A!(G)
QUIT
Begin DoDot:2
+5 SET R=$PIECE(^AUPNVLAB(+$PIECE(BDM(A),U,4),0),U,4)
IF R]""
IF $$UP^XLFSTR(R)'="COMMENT"
SET G=A
End DoDot:2
End DoDot:1
+6 SET N=$SELECT(G:G,1:1)
+7 QUIT
SET3 ;
+1 NEW X,N1,N2,N3,A,T
+2 KILL A
+3 SET X=0
FOR
SET X=$ORDER(BDM(X))
IF X'=+X
QUIT
SET A($PIECE(BDM(X),U),X)=""
+4 NEW D
SET D=0
FOR
SET D=$ORDER(A(D))
IF D'=+D
QUIT
Begin DoDot:1
+5 SET G=0
SET N=0
FOR
SET N=$ORDER(A(D,N))
IF N'=+N
QUIT
Begin DoDot:2
+6 IF $PIECE(^AUPNVLAB(+$PIECE(BDM(N),U,4),0),U,4)]""
IF $$UP^XLFSTR($PIECE(^AUPNVLAB(+$PIECE(BDM(N),U,4),0),U,4))'="COMMENT"
SET G=1
QUIT
End DoDot:2
+7 IF G
SET N=0
FOR
SET N=$ORDER(A(D,N))
IF N'=+N
QUIT
IF $PIECE(^AUPNVLAB(+$PIECE(BDM(N),U,4),0),U,4)=""
KILL BDM(N)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
URIN ;EP
+1 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V,G,C,BDMNROK,T,N,BDMACRA
1 ;
+1 KILL BDM
SET BDMC=0
SET BDMACRA=1
+2 SET BDMOT=$ORDER(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
+3 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT QUANT UACR",0))
+4 DO GATHER
+5 SET D=0
SET C=0
SET G=""
FOR
SET D=$ORDER(BDM(D))
IF D'=+D!(G]"")
QUIT
SET C=0
FOR
SET C=$ORDER(BDM(D,C))
IF C'=+C!(G]"")
QUIT
Begin DoDot:1
+6 ;EVALUATE RESULT, if contains < or > strip that off and use the number
+7 SET R=$PIECE(BDM(D,C),U,2)
+8 IF R["<"!(R[">")
SET R=$$STV^BDMDB18(R,8)
IF R]""
SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_1_U_R
+9 SET R=$$STV^BDMDB18(R,8)
+10 IF R=""
Begin DoDot:2
+11 SET (E,X,J,L)=""
+12 SET BDMOT=$ORDER(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))
+13 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))
+14 SET V=$PIECE(BDM(D,C),U,5)
SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+15 SET L=$PIECE($GET(^AUPNVLAB(X,0)),U,1)
+16 IF L=""
QUIT
+17 SET E=""
+18 IF BDMLT
IF $DATA(^ATXLAB(BDMLT,21,"B",L))
SET E=1
+19 IF 'E
IF BDMOT
SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J]""
IF $$LOINC(J,BDMOT)
SET E=1
+20 IF 'E
QUIT
+21 IF $PIECE(^AUPNVLAB(X,0),U,4)["<"
SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_1_U_5
+22 IF $PIECE(^AUPNVLAB(X,0),U,4)[">"
SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_1_U_999
End DoDot:3
+23 IF 'G
SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_1_U_R
End DoDot:2
QUIT
+24 SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_1_U_R
End DoDot:1
+25 QUIT G
+26 ;OLD STUFF
+27 IF G]""
QUIT G
+28 KILL BDMACRA
2 ;
+1 KILL BDM
+2 SET BDMC=0
+3 SET BDMOT="DM AUDIT P/C RATIO LOINC"
+4 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT P/C RATIO TAX",0))
+5 DO GATHER
+6 SET D=0
SET C=0
SET G=""
FOR
SET D=$ORDER(BDM(D))
IF D'=+D!(G]"")
QUIT
SET C=0
FOR
SET C=$ORDER(BDM(D,C))
IF C'=+C!(G]"")
QUIT
Begin DoDot:1
+7 SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_2
End DoDot:1
+8 IF G]""
QUIT G
3 ;
+1 KILL BDM
+2 SET BDMC=0
+3 SET BDMOT=""
+4 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT 24HR URINE PROTEIN",0))
+5 DO GATHER
+6 SET D=0
SET C=0
SET G=""
FOR
SET D=$ORDER(BDM(D))
IF D'=+D!(G]"")
QUIT
SET C=0
FOR
SET C=$ORDER(BDM(D,C))
IF C'=+C!(G]"")
QUIT
Begin DoDot:1
+7 SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_3
End DoDot:1
+8 IF G]""
QUIT G
4 ;
+1 KILL BDM
+2 SET BDMC=0
+3 SET BDMOT=""
+4 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT SEMI QUANT UACR",0))
+5 DO GATHER
+6 SET D=0
SET C=0
SET G=""
FOR
SET D=$ORDER(BDM(D))
IF D'=+D!(G]"")
QUIT
SET C=0
FOR
SET C=$ORDER(BDM(D,C))
IF C'=+C!(G]"")
QUIT
Begin DoDot:1
+7 SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_4
End DoDot:1
+8 IF G]""
QUIT G
5 ;
+1 KILL BDM
+2 SET BDMC=0
+3 SET BDMOT=$ORDER(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))
+4 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))
+5 DO GATHER
+6 SET D=0
SET C=0
SET G=""
FOR
SET D=$ORDER(BDM(D))
IF D'=+D!(G]"")
QUIT
SET C=0
FOR
SET C=$ORDER(BDM(D,C))
IF C'=+C!(G]"")
QUIT
Begin DoDot:1
+7 SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_5
End DoDot:1
+8 IF G]""
QUIT G
6 ;
+1 KILL BDM
+2 SET BDMC=0
+3 SET BDMOT=$ORDER(^ATXAX("B","BGP URINE PROTEIN LOINC CODES",0))
+4 SET BDMLT=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
+5 DO GATHER
+6 SET D=0
SET C=0
SET G=""
FOR
SET D=$ORDER(BDM(D))
IF D'=+D!(G]"")
QUIT
SET C=0
FOR
SET C=$ORDER(BDM(D,C))
IF C'=+C!(G]"")
QUIT
Begin DoDot:1
+7 SET G="1 Yes "_U_$PIECE(BDM(D,C),U,2)_U_$$FMTE^XLFDT($PIECE(BDM(D,C),U))_U_$PIECE(BDM(D,C),U,3)_U_6
End DoDot:1
+8 IF G]""
QUIT G
+9 QUIT "2 No"
SEMIE(V) ;EP - called from epi
+1 IF V=""
QUIT ""
+2 IF V["-"
QUIT 2
+3 IF V["300"
QUIT 3
+4 IF V[">"
QUIT 3
+5 IF V["<"
QUIT 1
+6 SET V=$$STV^BDMDB18(V,5,1)
+7 SET V=+V
+8 IF 'V
QUIT ""
+9 IF +V>299.99
QUIT 3
+10 IF +V>29.9999
IF +V<299.9999
QUIT 2
+11 IF +V<30
QUIT 1
+12 QUIT ""
UPE(%) ;EP - called from epi
+1 IF %=""
QUIT ""
+2 IF %["+"
QUIT 2
+3 IF %[">"
QUIT 2
+4 IF $EXTRACT(%)="P"
QUIT 2
+5 IF $EXTRACT(%)="p"
QUIT 2
+6 IF $EXTRACT($$UP^XLFSTR(%))="S"
QUIT 2
+7 IF $EXTRACT($$UP^XLFSTR(%))="M"
QUIT 2
+8 IF $EXTRACT($$UP^XLFSTR(%))="L"
QUIT 2
+9 IF +%>29
QUIT 2
+10 QUIT 1
