BMCDAPOV.m

BMCDAPOV ; IHS/PHXAO/TMJ - Screen E-Codes ; 

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

START ;

 S BMCTPCC=""

 S DIC="^ICD9(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)'=""E""",DIC("A")="ENTER A DIAGNOSIS CODE: " D ^DIC K DIC

 G:Y="" XIT

 I Y=-1,X=""!(X="^") S BMCTSKI=1,BMCLOOK="" G XIT

 I Y=-1 S BMCERROR=1,BMCLOOK="" G XIT

 S BMCLOOK="`"_+Y,BMCTNQP=X

 ;

XIT K Y,X,DO,D,DD,DIPGM,BMCTPCC

 Q

BMCDAPOV  ; IHS/PHXAO/TMJ - Screen E-Codes ; 

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

START     ;

 +1        SET BMCTPCC=""

 +2        SET DIC="^ICD9("

           SET DIC(0)="AEMQ"

           SET DIC("S")="I $P(^(0),U,2)'=""E"""

           SET DIC("A")="ENTER A DIAGNOSIS CODE: "

           DO ^DIC

           KILL DIC

 +3        IF Y=""

               GOTO XIT

 +4        IF Y=-1

               IF X=""!(X="^")

                   SET BMCTSKI=1

                   SET BMCLOOK=""

                   GOTO XIT

 +5        IF Y=-1

               SET BMCERROR=1

               SET BMCLOOK=""

               GOTO XIT

 +6        SET BMCLOOK="`"_+Y

           SET BMCTNQP=X

 +7       ;

XIT        KILL Y,X,DO,D,DD,DIPGM,BMCTPCC

 +1        QUIT