AMHLEOD ; IHS/CMI/LAB - enter outside rx ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;EP - called from option
D FULL^VALM1
I 'DFN W !!,"Patient not defined" D EXIT Q
HDR ;write header
W:$D(IOF) @IOF
F J=1:1:10 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X
K X,J
W !!
;
BEGIN ;
D INIT
G:AMHQUIT EXIT
G:DFN="" EXIT
D GETLOC
F D GETDRUG Q:AMHQUIT!(AMHDIEN="") D PROCESS
D EXIT
Q
PROCESS ;
D GETDATE
Q:AMHDATE=""
D GETOL
Q:AMHOL=""
D GENVISIT
Q:AMHQUIT
D GENVMED
Q
EXIT ;cleanup and exit
K APCDLOOK,APCDANE,APCDALVR,APCDVSIT,APCDPAT
K AMHOIEN,AMHDRUG,AMHDIEN,AMHOL,AMHDATE,AMHQUIT,AMHLOC
D KILL^AUPNPAT K AUPNTALK,AUPNLK("ALL")
K DIE,DR,DA,DIRUT,DIR,DTOUT,DUOUT,DIV,DIW,DQ,DD,DQ,DI,DIC,DIR,X,Y,I,DDH,DI,D,D0
Q
INIT ;EP
S AMHQUIT=0
S AMHOIEN=$O(^PSDRUG("B","OUTSIDE DRUG",0)) I 'AMHOIEN W !!,$C(7),$C(7),"OUTSIDE DRUG not defined in DRUG file, notify programmer." H 3 S AMHQUIT=1 Q
Q
GETLOC ; GET LOCATION OF ENCOUNTER
W !!,"Please enter your service unit's OTHER or UNDESIG location.",!,"If you don't know what that is please ask your PCC Data Entry Operator",!,"for the location of encounter to use for historical activities performed"
W !,"outside this facility.",!
S AMHLOC=""
S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S AMHLOC=+Y
Q
;
GETDATE ;EP GET DATE OF ENCOUNTER
K DIR S AMHDATE="",DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter DATE DISPENSED" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S %DT="ET" D ^%DT G:Y<0 GETDATE
I Y>DT W " <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
S AMHDATE=Y
Q
GETOL ;
S AMHOL=""
S DIR(0)="9000010,2101",DIR("A")="Enter LOCATION WHERE DISPENSED" K DA D ^DIR K DIR
S AMHOL=Y
Q
GETDRUG ;
S (AMHDRUG,AMHDIEN)=""
W !! K DD,DIR S DIR(0)="FO^1:40",DIR("A")="Enter DRUG NAME" D ^DIR K DIR S:$D(DTOUT) DIRUT=1
Q:Y=""
I $D(DIRUT) W !,"No drug entered!!" Q
S (X,AMHDRUG)=Y,DIC="^PSDRUG(",DIC(0)="MQE" D ^DIC K DIC
I Y=-1 D NODRUG Q
S AMHDIEN=+Y,AMHDRUG="" K DIR,DA,DIRUT,DTOUT,DUOUT
Q
;
NODRUG ;
W !,"That drug cannot be found in the Drug file."
K DIR S DIR(0)="Y",DIR("A")="Do you want to try to lookup the drug in the Drug file again",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"Exiting..." S AMHQUIT=1 Q
I Y G GETDRUG
S AMHDIEN=AMHOIEN
W ! K DD,DIR S DIR(0)="FO^1:40",DIR("A")="Enter the FULL DRUG NAME...",DIR("A",1)="You must enter the drug name that will appear on the health summary.",DIR("B")=AMHDRUG D ^DIR K DIR S:$D(DTOUT) DIRUT=1
I $D(DIRUT) S AMHQUIT=1 W !!,"Exiting..." Q
S AMHDRUG=Y
S AMHDRUG=$TR(AMHDRUG,"-") ;IHS/OKCAO/POC 4/22/98
Q
GENVISIT ;
K APCDALVR
S APCDALVR("AUPNTALK")=""
S APCDALVR("APCDDATE")=AMHDATE
S APCDALVR("APCDTYPE")="O"
S APCDALVR("APCDPAT")=DFN
S APCDALVR("APCDLOC")=AMHLOC
S APCDALVR("APCDCAT")="E"
S APCDALVR("APCDAUTO")="",APCDALVR("APCDANE")=""
S APCDALVR("APCDOLOC")=AMHOL
D ^APCDALV
I $D(APCDALVR("APCDAFLG")) W !!,$C(7),"Creating PCC Visit Failed....Notify Supervisor" H 3 S AMHQUIT=1 Q
S APCDVSIT=APCDALVR("APCDVSIT"),APCDPAT=APCDALVR("APCDPAT") S Y=DFN D ^AUPNPAT
Q
GENVMED ;
I '$G(AMHDIEN) W !!,"Error.... no drug entry" H 2 Q
W !!,"Please enter all available information about this prescription.",!
S DA=APCDVSIT,DR="[AMH ORX (ADD)]",DIE="^AUPNVSIT(" D ^DIE
I $D(Y) W !!,"Creating V Medication entry failed!! Notify supervisor!" H 3 Q
Q
TEXT ;
;;
;;IHS BEHAVIORAL HEALTH/PCC Interface
;;
;;*******************************
;;* Entry of OUTSIDE RX's *
;;*******************************
;;
;;Use this option to enter medications that the patient is taking
;;that were not prescribed by you or that were filled at a pharmacy
;;other than the pharmacy at this facility.
AMHLEOD ; IHS/CMI/LAB - enter outside rx ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;EP - called from option
+1 DO FULL^VALM1
+2 IF 'DFN
WRITE !!,"Patient not defined"
DO EXIT
QUIT
HDR ;write header
+1 IF $DATA(IOF)
WRITE @IOF
+2 FOR J=1:1:10
SET X=$PIECE($TEXT(TEXT+J),";;",2)
WRITE !?80-$LENGTH(X)\2,X
+3 KILL X,J
+4 WRITE !!
+5 ;
BEGIN ;
+1 DO INIT
+2 IF AMHQUIT
GOTO EXIT
+3 IF DFN=""
GOTO EXIT
+4 DO GETLOC
+5 FOR
DO GETDRUG
IF AMHQUIT!(AMHDIEN="")
QUIT
DO PROCESS
+6 DO EXIT
+7 QUIT
PROCESS ;
+1 DO GETDATE
+2 IF AMHDATE=""
QUIT
+3 DO GETOL
+4 IF AMHOL=""
QUIT
+5 DO GENVISIT
+6 IF AMHQUIT
QUIT
+7 DO GENVMED
+8 QUIT
EXIT ;cleanup and exit
+1 KILL APCDLOOK,APCDANE,APCDALVR,APCDVSIT,APCDPAT
+2 KILL AMHOIEN,AMHDRUG,AMHDIEN,AMHOL,AMHDATE,AMHQUIT,AMHLOC
+3 DO KILL^AUPNPAT
KILL AUPNTALK,AUPNLK("ALL")
+4 KILL DIE,DR,DA,DIRUT,DIR,DTOUT,DUOUT,DIV,DIW,DQ,DD,DQ,DI,DIC,DIR,X,Y,I,DDH,DI,D,D0
+5 QUIT
INIT ;EP
+1 SET AMHQUIT=0
+2 SET AMHOIEN=$ORDER(^PSDRUG("B","OUTSIDE DRUG",0))
IF 'AMHOIEN
WRITE !!,$CHAR(7),$CHAR(7),"OUTSIDE DRUG not defined in DRUG file, notify programmer."
HANG 3
SET AMHQUIT=1
QUIT
+3 QUIT
GETLOC ; GET LOCATION OF ENCOUNTER
+1 WRITE !!,"Please enter your service unit's OTHER or UNDESIG location.",!,"If you don't know what that is please ask your PCC Data Entry Operator",!,"for the location of encounter to use for historical activities performed"
+2 WRITE !,"outside this facility.",!
+3 SET AMHLOC=""
+4 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF Y<0
QUIT
+6 SET AMHLOC=+Y
+7 QUIT
+8 ;
GETDATE ;EP GET DATE OF ENCOUNTER
+1 KILL DIR
SET AMHDATE=""
SET DIR(0)="DO^:"_DT_":EPT"
SET DIR("A")="Enter DATE DISPENSED"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+4 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+5 SET AMHDATE=Y
+6 QUIT
GETOL ;
+1 SET AMHOL=""
+2 SET DIR(0)="9000010,2101"
SET DIR("A")="Enter LOCATION WHERE DISPENSED"
KILL DA
DO ^DIR
KILL DIR
+3 SET AMHOL=Y
+4 QUIT
GETDRUG ;
+1 SET (AMHDRUG,AMHDIEN)=""
+2 WRITE !!
KILL DD,DIR
SET DIR(0)="FO^1:40"
SET DIR("A")="Enter DRUG NAME"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET DIRUT=1
+3 IF Y=""
QUIT
+4 IF $DATA(DIRUT)
WRITE !,"No drug entered!!"
QUIT
+5 SET (X,AMHDRUG)=Y
SET DIC="^PSDRUG("
SET DIC(0)="MQE"
DO ^DIC
KILL DIC
+6 IF Y=-1
DO NODRUG
QUIT
+7 SET AMHDIEN=+Y
SET AMHDRUG=""
KILL DIR,DA,DIRUT,DTOUT,DUOUT
+8 QUIT
+9 ;
NODRUG ;
+1 WRITE !,"That drug cannot be found in the Drug file."
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to try to lookup the drug in the Drug file again"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
WRITE !,"Exiting..."
SET AMHQUIT=1
QUIT
+4 IF Y
GOTO GETDRUG
+5 SET AMHDIEN=AMHOIEN
+6 WRITE !
KILL DD,DIR
SET DIR(0)="FO^1:40"
SET DIR("A")="Enter the FULL DRUG NAME..."
SET DIR("A",1)="You must enter the drug name that will appear on the health summary."
SET DIR("B")=AMHDRUG
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET DIRUT=1
+7 IF $DATA(DIRUT)
SET AMHQUIT=1
WRITE !!,"Exiting..."
QUIT
+8 SET AMHDRUG=Y
+9 ;IHS/OKCAO/POC 4/22/98
SET AMHDRUG=$TRANSLATE(AMHDRUG,"-")
+10 QUIT
GENVISIT ;
+1 KILL APCDALVR
+2 SET APCDALVR("AUPNTALK")=""
+3 SET APCDALVR("APCDDATE")=AMHDATE
+4 SET APCDALVR("APCDTYPE")="O"
+5 SET APCDALVR("APCDPAT")=DFN
+6 SET APCDALVR("APCDLOC")=AMHLOC
+7 SET APCDALVR("APCDCAT")="E"
+8 SET APCDALVR("APCDAUTO")=""
SET APCDALVR("APCDANE")=""
+9 SET APCDALVR("APCDOLOC")=AMHOL
+10 DO ^APCDALV
+11 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,$CHAR(7),"Creating PCC Visit Failed....Notify Supervisor"
HANG 3
SET AMHQUIT=1
QUIT
+12 SET APCDVSIT=APCDALVR("APCDVSIT")
SET APCDPAT=APCDALVR("APCDPAT")
SET Y=DFN
DO ^AUPNPAT
+13 QUIT
GENVMED ;
+1 IF '$GET(AMHDIEN)
WRITE !!,"Error.... no drug entry"
HANG 2
QUIT
+2 WRITE !!,"Please enter all available information about this prescription.",!
+3 SET DA=APCDVSIT
SET DR="[AMH ORX (ADD)]"
SET DIE="^AUPNVSIT("
DO ^DIE
+4 IF $DATA(Y)
WRITE !!,"Creating V Medication entry failed!! Notify supervisor!"
HANG 3
QUIT
+5 QUIT
TEXT ;
+1 ;;
+2 ;;IHS BEHAVIORAL HEALTH/PCC Interface
+3 ;;
+4 ;;*******************************
+5 ;;* Entry of OUTSIDE RX's *
+6 ;;*******************************
+7 ;;
+8 ;;Use this option to enter medications that the patient is taking
+9 ;;that were not prescribed by you or that were filled at a pharmacy
+10 ;;other than the pharmacy at this facility.
