VENPCCG3.m

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