APCDAPHX.m

APCDAPHX ; IHS/CMI/LAB - PERSONAL HX LOOKUP ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

START ;

 X:$D(^DD(9000013,.01,12.1)) ^DD(9000013,.01,12.1) S DIC="^ICD9(",DIC(0)="AEMQ",DIC("A")="Enter PERSONAL HISTORY Diagnosis: " D ^DIC K DIC

 G:Y="" XIT

 I Y=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" G XIT

 I Y=-1 S APCDTERR=1,APCDLOOK="" G XIT

 S APCDLOOK="`"_+Y,APCDTNQP=X

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

 Q

APCDAPHX  ; IHS/CMI/LAB - PERSONAL HX LOOKUP ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

START     ;

 +1        IF $DATA(^DD(9000013,.01,12.1))

               XECUTE ^DD(9000013,.01,12.1)

           SET DIC="^ICD9("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter PERSONAL HISTORY Diagnosis: "

           DO ^DIC

           KILL DIC

 +2        IF Y=""

               GOTO XIT

 +3        IF Y=-1

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

                   SET APCDTSKI=1

                   SET APCDLOOK=""

                   GOTO XIT

 +4        IF Y=-1

               SET APCDTERR=1

               SET APCDLOOK=""

               GOTO XIT

 +5        SET APCDLOOK="`"_+Y

           SET APCDTNQP=X

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

 +1        QUIT