VENPCCG3 ; IHS/OIT/GIS - GET ICD PREFERENCES ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
A ;
NARR ; EP-convert the provider narr. to mixed case sentences
Q:'$D(NARR)
S VENT("F")=$E(NARR,1)
UP S VENT("F")=$TR(VENT("F"),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S VENT("L")=$E(NARR,2,80)
LOW S VENT("L")=$TR(VENT("L"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S NARR=VENT("F")_VENT("L")
S VENT("LEN")=$L(NARR)
D NARR2
Q
NARR2 ; chk for ii i Dm dm etc. and change the case to upper
;
I NARR?.E1" ii".E D
. S NARR=$P(NARR," ii",1)_" II"_$P(NARR," ii",2,99)
I NARR?.E1" iii".E D
. S NARR=$P(NARR," iii",1)_" III"_$P(NARR," iii",2,99)
I NARR?.E1" i ".E D
. S NARR=$P(NARR," i ",1)_" I "_$P(NARR," i ",2,99)
I NARR?.E1" i.".E D
. S NARR=$P(NARR," i.",1)_" I."_$P(NARR," i.",2,99)
I NARR?.E1" iv.".E D
. S NARR=$P(NARR," iv.",1)_" IV."_$P(NARR," iv.",2,99)
I NARR?.E1" iv ".E D
. S NARR=$P(NARR," iv ",1)_" IV "_$P(NARR," iv ",2,99)
I NARR?.E1" dm ".E D
. S NARR=$P(NARR," dm ",1)_" DM "_$P(NARR," dm ",2,99)
I NARR?.E1" dm.".E D
. S NARR=$P(NARR," dm.",1)_" DM."_$P(NARR," dm.",2,99)
I NARR?.E1" Dm ".E D
. S NARR=$P(NARR," Dm ",1)_" DM "_$P(NARR," Dm ",2,99)
I NARR?.E1" Dm.".E D
. S NARR=$P(NARR," Dm.",1)_" DM."_$P(NARR," Dm.",2,99)
I NARR?.E1"Dm.".E D
. S NARR=$P(NARR,"Dm.",1)_"DM."_$P(NARR,"Dm.",2,99)
I NARR="Chf" S NARR="CHF"
I NARR="Copd" S NARR="COPD"
I NARR="Uri" S NARR="URI"
Q
VENPCCG3 ; IHS/OIT/GIS - GET ICD PREFERENCES ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
A ;
NARR ; EP-convert the provider narr. to mixed case sentences
+1 IF '$DATA(NARR)
QUIT
+2 SET VENT("F")=$EXTRACT(NARR,1)
UP SET VENT("F")=$TRANSLATE(VENT("F"),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 SET VENT("L")=$EXTRACT(NARR,2,80)
LOW SET VENT("L")=$TRANSLATE(VENT("L"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+1 SET NARR=VENT("F")_VENT("L")
+2 SET VENT("LEN")=$LENGTH(NARR)
+3 DO NARR2
+4 QUIT
NARR2 ; chk for ii i Dm dm etc. and change the case to upper
+1 ;
+2 IF NARR?.E1" ii".E
Begin DoDot:1
+3 SET NARR=$PIECE(NARR," ii",1)_" II"_$PIECE(NARR," ii",2,99)
End DoDot:1
+4 IF NARR?.E1" iii".E
Begin DoDot:1
+5 SET NARR=$PIECE(NARR," iii",1)_" III"_$PIECE(NARR," iii",2,99)
End DoDot:1
+6 IF NARR?.E1" i ".E
Begin DoDot:1
+7 SET NARR=$PIECE(NARR," i ",1)_" I "_$PIECE(NARR," i ",2,99)
End DoDot:1
+8 IF NARR?.E1" i.".E
Begin DoDot:1
+9 SET NARR=$PIECE(NARR," i.",1)_" I."_$PIECE(NARR," i.",2,99)
End DoDot:1
+10 IF NARR?.E1" iv.".E
Begin DoDot:1
+11 SET NARR=$PIECE(NARR," iv.",1)_" IV."_$PIECE(NARR," iv.",2,99)
End DoDot:1
+12 IF NARR?.E1" iv ".E
Begin DoDot:1
+13 SET NARR=$PIECE(NARR," iv ",1)_" IV "_$PIECE(NARR," iv ",2,99)
End DoDot:1
+14 IF NARR?.E1" dm ".E
Begin DoDot:1
+15 SET NARR=$PIECE(NARR," dm ",1)_" DM "_$PIECE(NARR," dm ",2,99)
End DoDot:1
+16 IF NARR?.E1" dm.".E
Begin DoDot:1
+17 SET NARR=$PIECE(NARR," dm.",1)_" DM."_$PIECE(NARR," dm.",2,99)
End DoDot:1
+18 IF NARR?.E1" Dm ".E
Begin DoDot:1
+19 SET NARR=$PIECE(NARR," Dm ",1)_" DM "_$PIECE(NARR," Dm ",2,99)
End DoDot:1
+20 IF NARR?.E1" Dm.".E
Begin DoDot:1
+21 SET NARR=$PIECE(NARR," Dm.",1)_" DM."_$PIECE(NARR," Dm.",2,99)
End DoDot:1
+22 IF NARR?.E1"Dm.".E
Begin DoDot:1
+23 SET NARR=$PIECE(NARR,"Dm.",1)_"DM."_$PIECE(NARR,"Dm.",2,99)
End DoDot:1
+24 IF NARR="Chf"
SET NARR="CHF"
+25 IF NARR="Copd"
SET NARR="COPD"
+26 IF NARR="Uri"
SET NARR="URI"
+27 QUIT
