APCDAAPC.m

APCDAAPC ; IHS/CMI/LAB - APC CODE ENTRY ;

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

 ;

START ;

 S APCDTPCC=""

 S DIC="^AUTTRCD(",DIC(0)="AEMQ",DIC("A")="Enter APC CODE:  " 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 APCDAPC=+Y

 S APCDICD=$P(^AUTTRCD(APCDAPC,0),U,5)

 S APCDLOOK=$O(^ICD9("BA",APCDICD,0))

 I APCDLOOK="" W !!,$C(7),$C(7),"No ICD Diagnosis for that code - notify supervisor.",! S APCDTERR=1,APCDLOOK="",APCDCPT="" G XIT

 S APCDLOOK="`"_APCDLOOK

 D XIT

 Q

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

 Q

APCDAAPC  ; IHS/CMI/LAB - APC CODE ENTRY ;

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

 +2       ;

START     ;

 +1        SET APCDTPCC=""

 +2        SET DIC="^AUTTRCD("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter APC CODE:  "

           DO ^DIC

           KILL DIC

 +3        IF Y=""

               GOTO XIT

 +4        IF Y=-1

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

                   SET APCDTSKI=1

                   SET APCDLOOK=""

                   GOTO XIT

 +5        IF Y=-1

               SET APCDTERR=1

               SET APCDLOOK=""

               GOTO XIT

 +6        SET APCDAPC=+Y

 +7        SET APCDICD=$PIECE(^AUTTRCD(APCDAPC,0),U,5)

 +8        SET APCDLOOK=$ORDER(^ICD9("BA",APCDICD,0))

 +9        IF APCDLOOK=""

               WRITE !!,$CHAR(7),$CHAR(7),"No ICD Diagnosis for that code - notify supervisor.",!

               SET APCDTERR=1

               SET APCDLOOK=""

               SET APCDCPT=""

               GOTO XIT

 +10       SET APCDLOOK="`"_APCDLOOK

 +11       DO XIT

 +12       QUIT 

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

 +1        QUIT