APCDAEDU ; IHS/CMI/LAB - education topic lookup ;
;;2.0;IHS PCC SUITE;**2,7,11**;MAY 14, 2009;Build 58
;
;
EP ;
D EN^XBNEW("EP1^APCDAEDU","APCDT12;APCDT04;APCDTSKI;APCDLOOK,APCDTERR,APCDPEDP,APCDPEDV;APCDVSIT;APCDDATE")
Q
EP1 ;;
S APCDTSKI="",APCDLOOK="",APCDPEDC=0
K APCDPCPT
W !!,"You can enter education topics in 3 ways:",!?3,"- using the name of the topic (e.g. DM-DIET)",!?3,"- using an ICD Diagnosis for the topic diagnosis and enter a topic category"
W !?3,"- using a CPT code for the topic and enter a topic category",!
;S DIR(0)="F^1:30",DIR("A")="Enter EDUCATION Topic" KILL DA D ^DIR KILL DIR
S DIR(0)="S^T:EDUCATION TOPIC;D:DIAGNOSIS;C:CPT CODE",DIR("A")="Do you wish to enter a",DIR("B")="T" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S APCDTSKI=1 Q
I Y="T" D OLD Q
I Y="D" D ICD S APCDTSKI=1 Q
I Y="C" D CPT S APCDTSKI=1 Q
Q
ICD ;
S APCDT04=""
S (APCDLOOK,APCDTSKI,APCDTERR)=""
S APCDTDIA="ICD DIAGNOSIS CODE NUMBER"
D ^APCDAPOV
I APCDLOOK="" S APCDTSKI=1 G EP1
S APCDT04=APCDLOOK K APCDLOOK,APCDTSKI,APCDTERR
TOPIC ;
W !
S APCDT12=""
S DIR(0)="9000010.16,.12",DIR("A")="Enter "_$S(APCDPEDC:"another ",1:"")_"Category" KILL DA D ^DIR KILL DIR
I $D(DIRUT),APCDPEDC=0 S (APCDLOOK,APCDT04,APCDT12)="" W !,"No education topic entered." G EP1
Q:$D(DIRUT)
Q:Y=""
S APCDT12="`"_+Y
;
P01 ;get .01 value by concatenating topic and dx
NEW APCDY,APCDM
S APCDY=$P($$ICDDX^ICDEX($P(APCDT04,"`",2),$$VD^APCLV(APCDVSIT)),U,2)_"-"_$P(^APCDEDCV($P(APCDT12,"`",2),0),U),APCDM=$P(APCDY,"-")_"-"_$P(^APCDEDCV($P(APCDT12,"`",2),0),U,2)
S Z=$O(^AUTTEDT("B",APCDY,0)) I Z S APCDLOOK="`"_Z D ADDVPED G TOPIC
;add to educ topics file
D ^XBFMK S X=APCDY,DIC(0)="L",DIC="^AUTTEDT(",DLAYGO=9999999.09,DIADD=1,DIC("DR")="1///"_APCDM_";.04///"_APCDT04 K DD,D0,DO D FILE^DICN
I Y=-1 W !!,"error adding new education topic, notify supervisor." S APCDTSKI=1,APCDLOOK="",APCDT04="",APCDT12="" Q
S APCDLOOK="`"_+Y D ADDVPED G TOPIC
Q
;add to education topics file
OLD ;
S (APCDTSKI,APCDLOOK)=""
;do DIC lookup into education topics file
X:$D(^DD(9000010.16,.01,12.1)) ^DD(9000010.16,.01,12.1) S DIC="^AUTTEDT(",DIC(0)="AEMQ",DIC("A")="Enter EDUCATION Topic: " D ^DIC K DIC
I Y="" S APCDTSKI=1,APCDLOOK="" Q
I Y=-1,X=""!(X="^") S APCDTSKI=1,APCDLOOK="" Q
I Y=-1 S APCDTERR=1,APCDLOOK="" Q
S APCDLOOK="`"_+Y
S APCDT04=$P(^AUTTEDT(+Y,0),U,4) I APCDT04 S APCDT04="`"_APCDT04
Q
ADDVPED ;add v patient education entry
D ^XBFMK
S DIC="^AUPNVPED(",X=$P(APCDLOOK,"`",2),DIC(0)="L",DIADD=1,DLAYGO=9000010.16 K DD,D0,DO D FILE^DICN
K DIADD,DLAYGO,DIC,DA,DD,DO
I Y=-1 W !!,"Creating V Patient Education failed! Notify programmer." D ^XBFMK Q
S DA=+Y,DIE="^AUPNVPED(",DR=".02////"_APCDPEDP_";.03////"_APCDPEDV
S DR=DR_$S($D(APCDPCPT):"",1:";.04///"_APCDT04)
S DR=DR_";.12///"_APCDT12_";1102;.06;.05;.08;.11;.13;.14;1101" D ^DIE
I $D(Y) W !!,"Creating V patient ed failed! Notify programmer." D ^XBFMK Q
D ^XBFMK
S APCDPEDC=APCDPEDC+1
Q
CPT ;
S APCDPCPT=1
S APCDT04=""
;lookup in ICD file
S DIC="^ICPT(",DIC(0)="AMEQ" D ^DIC K DIC
I X="" S APCDLOOK="",APCDTSKI=1,APCDT04="" Q
I $D(DUOUT) S APCDTSKI=1,APCDLOOK="",APCDT04="",APCDT12="" Q
I Y=-1 G EP1
S APCDT04="`"_+Y
CTOPIC ;
W !
S APCDT12=""
S DIR(0)="9000010.16,.12",DIR("A")="Enter "_$S(APCDPEDC:"another ",1:"")_"Category" KILL DA D ^DIR KILL DIR
I $D(DIRUT),APCDPEDC=0 S (APCDLOOK,APCDT04,APCDT12)="" W !,"No education topic entered." G EP1
Q:$D(DIRUT)
Q:Y=""
S APCDT12="`"_+Y
;
CP01 ;get .01 value by concatenating topic and dx
NEW APCDY,APCDM
S APCDY=$P($$CPT^ICPTCOD($P(APCDT04,"`",2)),U,2)_"-"_$P(^APCDEDCV($P(APCDT12,"`",2),0),U),APCDM=$P(APCDY,"-")_"-"_$P(^APCDEDCV($P(APCDT12,"`",2),0),U,2)
S Z=$O(^AUTTEDT("B",APCDY,0)) I Z S APCDLOOK="`"_Z D ADDVPED G CTOPIC
;add to educ topics file
D ^XBFMK S X=APCDY,DIC(0)="L",DIC="^AUTTEDT(",DLAYGO=9999999.09,DIADD=1,DIC("DR")="1///"_APCDM_";.11///"_APCDT04 K DD,D0,DO D FILE^DICN
I Y=-1 W !!,"error adding new education topic, notify supervisor." S APCDTSKI=1,APCDLOOK="",APCDT04="",APCDT12="" Q
S APCDLOOK="`"_+Y D ADDVPED G CTOPIC
Q
APCDAEDU ; IHS/CMI/LAB - education topic lookup ;
+1 ;;2.0;IHS PCC SUITE;**2,7,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
EP ;
+1 DO EN^XBNEW("EP1^APCDAEDU","APCDT12;APCDT04;APCDTSKI;APCDLOOK,APCDTERR,APCDPEDP,APCDPEDV;APCDVSIT;APCDDATE")
+2 QUIT
EP1 ;;
+1 SET APCDTSKI=""
SET APCDLOOK=""
SET APCDPEDC=0
+2 KILL APCDPCPT
+3 WRITE !!,"You can enter education topics in 3 ways:",!?3,"- using the name of the topic (e.g. DM-DIET)",!?3,"- using an ICD Diagnosis for the topic diagnosis and enter a topic category"
+4 WRITE !?3,"- using a CPT code for the topic and enter a topic category",!
+5 ;S DIR(0)="F^1:30",DIR("A")="Enter EDUCATION Topic" KILL DA D ^DIR KILL DIR
+6 SET DIR(0)="S^T:EDUCATION TOPIC;D:DIAGNOSIS;C:CPT CODE"
SET DIR("A")="Do you wish to enter a"
SET DIR("B")="T"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET APCDTSKI=1
QUIT
+8 IF Y="T"
DO OLD
QUIT
+9 IF Y="D"
DO ICD
SET APCDTSKI=1
QUIT
+10 IF Y="C"
DO CPT
SET APCDTSKI=1
QUIT
+11 QUIT
ICD ;
+1 SET APCDT04=""
+2 SET (APCDLOOK,APCDTSKI,APCDTERR)=""
+3 SET APCDTDIA="ICD DIAGNOSIS CODE NUMBER"
+4 DO ^APCDAPOV
+5 IF APCDLOOK=""
SET APCDTSKI=1
GOTO EP1
+6 SET APCDT04=APCDLOOK
KILL APCDLOOK,APCDTSKI,APCDTERR
TOPIC ;
+1 WRITE !
+2 SET APCDT12=""
+3 SET DIR(0)="9000010.16,.12"
SET DIR("A")="Enter "_$SELECT(APCDPEDC:"another ",1:"")_"Category"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
IF APCDPEDC=0
SET (APCDLOOK,APCDT04,APCDT12)=""
WRITE !,"No education topic entered."
GOTO EP1
+5 IF $DATA(DIRUT)
QUIT
+6 IF Y=""
QUIT
+7 SET APCDT12="`"_+Y
+8 ;
P01 ;get .01 value by concatenating topic and dx
+1 NEW APCDY,APCDM
+2 SET APCDY=$PIECE($$ICDDX^ICDEX($PIECE(APCDT04,"`",2),$$VD^APCLV(APCDVSIT)),U,2)_"-"_$PIECE(^APCDEDCV($PIECE(APCDT12,"`",2),0),U)
SET APCDM=$PIECE(APCDY,"-")_"-"_$PIECE(^APCDEDCV($PIECE(APCDT12,"`",2),0),U,2)
+3 SET Z=$ORDER(^AUTTEDT("B",APCDY,0))
IF Z
SET APCDLOOK="`"_Z
DO ADDVPED
GOTO TOPIC
+4 ;add to educ topics file
+5 DO ^XBFMK
SET X=APCDY
SET DIC(0)="L"
SET DIC="^AUTTEDT("
SET DLAYGO=9999999.09
SET DIADD=1
SET DIC("DR")="1///"_APCDM_";.04///"_APCDT04
KILL DD,D0,DO
DO FILE^DICN
+6 IF Y=-1
WRITE !!,"error adding new education topic, notify supervisor."
SET APCDTSKI=1
SET APCDLOOK=""
SET APCDT04=""
SET APCDT12=""
QUIT
+7 SET APCDLOOK="`"_+Y
DO ADDVPED
GOTO TOPIC
+8 QUIT
+9 ;add to education topics file
OLD ;
+1 SET (APCDTSKI,APCDLOOK)=""
+2 ;do DIC lookup into education topics file
+3 IF $DATA(^DD(9000010.16,.01,12.1))
XECUTE ^DD(9000010.16,.01,12.1)
SET DIC="^AUTTEDT("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter EDUCATION Topic: "
DO ^DIC
KILL DIC
+4 IF Y=""
SET APCDTSKI=1
SET APCDLOOK=""
QUIT
+5 IF Y=-1
IF X=""!(X="^")
SET APCDTSKI=1
SET APCDLOOK=""
QUIT
+6 IF Y=-1
SET APCDTERR=1
SET APCDLOOK=""
QUIT
+7 SET APCDLOOK="`"_+Y
+8 SET APCDT04=$PIECE(^AUTTEDT(+Y,0),U,4)
IF APCDT04
SET APCDT04="`"_APCDT04
+9 QUIT
ADDVPED ;add v patient education entry
+1 DO ^XBFMK
+2 SET DIC="^AUPNVPED("
SET X=$PIECE(APCDLOOK,"`",2)
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9000010.16
KILL DD,D0,DO
DO FILE^DICN
+3 KILL DIADD,DLAYGO,DIC,DA,DD,DO
+4 IF Y=-1
WRITE !!,"Creating V Patient Education failed! Notify programmer."
DO ^XBFMK
QUIT
+5 SET DA=+Y
SET DIE="^AUPNVPED("
SET DR=".02////"_APCDPEDP_";.03////"_APCDPEDV
+6 SET DR=DR_$SELECT($DATA(APCDPCPT):"",1:";.04///"_APCDT04)
+7 SET DR=DR_";.12///"_APCDT12_";1102;.06;.05;.08;.11;.13;.14;1101"
DO ^DIE
+8 IF $DATA(Y)
WRITE !!,"Creating V patient ed failed! Notify programmer."
DO ^XBFMK
QUIT
+9 DO ^XBFMK
+10 SET APCDPEDC=APCDPEDC+1
+11 QUIT
CPT ;
+1 SET APCDPCPT=1
+2 SET APCDT04=""
+3 ;lookup in ICD file
+4 SET DIC="^ICPT("
SET DIC(0)="AMEQ"
DO ^DIC
KILL DIC
+5 IF X=""
SET APCDLOOK=""
SET APCDTSKI=1
SET APCDT04=""
QUIT
+6 IF $DATA(DUOUT)
SET APCDTSKI=1
SET APCDLOOK=""
SET APCDT04=""
SET APCDT12=""
QUIT
+7 IF Y=-1
GOTO EP1
+8 SET APCDT04="`"_+Y
CTOPIC ;
+1 WRITE !
+2 SET APCDT12=""
+3 SET DIR(0)="9000010.16,.12"
SET DIR("A")="Enter "_$SELECT(APCDPEDC:"another ",1:"")_"Category"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
IF APCDPEDC=0
SET (APCDLOOK,APCDT04,APCDT12)=""
WRITE !,"No education topic entered."
GOTO EP1
+5 IF $DATA(DIRUT)
QUIT
+6 IF Y=""
QUIT
+7 SET APCDT12="`"_+Y
+8 ;
CP01 ;get .01 value by concatenating topic and dx
+1 NEW APCDY,APCDM
+2 SET APCDY=$PIECE($$CPT^ICPTCOD($PIECE(APCDT04,"`",2)),U,2)_"-"_$PIECE(^APCDEDCV($PIECE(APCDT12,"`",2),0),U)
SET APCDM=$PIECE(APCDY,"-")_"-"_$PIECE(^APCDEDCV($PIECE(APCDT12,"`",2),0),U,2)
+3 SET Z=$ORDER(^AUTTEDT("B",APCDY,0))
IF Z
SET APCDLOOK="`"_Z
DO ADDVPED
GOTO CTOPIC
+4 ;add to educ topics file
+5 DO ^XBFMK
SET X=APCDY
SET DIC(0)="L"
SET DIC="^AUTTEDT("
SET DLAYGO=9999999.09
SET DIADD=1
SET DIC("DR")="1///"_APCDM_";.11///"_APCDT04
KILL DD,D0,DO
DO FILE^DICN
+6 IF Y=-1
WRITE !!,"error adding new education topic, notify supervisor."
SET APCDTSKI=1
SET APCDLOOK=""
SET APCDT04=""
SET APCDT12=""
QUIT
+7 SET APCDLOOK="`"_+Y
DO ADDVPED
GOTO CTOPIC
+8 QUIT
