APSPORXA ; IHS/DSD/ENM - enter outside rx ; [ 02/20/2001 1:50 PM ]
;;6.0;IHS PHARMACY MODIFICATIONS;**1,3**;09/03/97
;
START ;EP - called from option
HDR ;write header
W:$D(IOF) @IOF
F J=1:1:7 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X
K X,J
W !!
;
BEGIN ;
D INIT
G:APSPQUIT EXIT
D GETPAT
G:DFN="" EXIT
;F D GETDRUG Q:APSPQUIT!(APSPDIEN="") D PROCESS
;F D GETDRUG Q:APSPQUIT!(APSPDIEN="") D ^APSQDRG S:PSORX("DFLG") APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT) D ^APSQDRDU S:$G(PSORX("DFLG")) APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT) D PROCESS ;IHS/OKCAO/POC
F D GETDRUG Q:APSPQUIT!(APSPDIEN="") S X="APSQDRG" X ^%ZOSF("TEST") D:$T ^APSQDRG S:PSORX("DFLG") APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT) D PROCESS ;IHS/OKCAO/POC
D EXIT
Q
PROCESS ;
D GETDATE
Q:APSPDATE=""
D GETOL
Q:APSPOL=""
D GENVISIT
Q:APSPQUIT
D GENVMED
Q
EXIT ;cleanup and exit
K DFN,APCDLOOK,APCDANE,APCDALVR,APCDVSIT,APCDPAT
K APSPOIEN,APSPDRUG,APSPDIEN,APSPOL,APSPDATE,APSPQUIT ;IHS/DSD/ENM APSPDOL REMOVED
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 APSPQUIT=0
S APSPOIEN=$O(^PSDRUG("B","OUTSIDE DRUG",0)) I 'APSPOIEN W !!,$C(7),$C(7),"OUTSIDE DRUG not defined in DRUG file, notify supervisor." H 3 S APSPQUIT=1 Q
;I APCDFLG S APSPQUIT=1 Q
I '$D(PSOPAR) D ^PSOLSET ;set up pharmacy site parameters
;S APSPDOL=4472
I '$G(APSPDOL) W !!,"DEFAULT OTHER LOCATION NOT DEFINED IN PHARMACY SITE FILE!! NOTIFY YOUR SUPERVISOR" H 3 S APSPQUIT=1 Q
Q
GETDATE ;EP GET DATE OF ENCOUNTER
K DIR S APSPDATE="",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 APSPDATE=Y
Q
GETOL ;
S APSPOL=""
S DIR(0)="9000010,2101",DIR("A")="Enter LOCATION WHERE DISPENSED" K DA D ^DIR K DIR
S APSPOL=Y
Q
GETDRUG ;
S (APSPDRUG,APSPDIEN)=""
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,APSPDRUG)=Y,DIC="^PSDRUG(",DIC(0)="MQE" D ^DIC K DIC
I Y=-1 D NODRUG Q
S APSPDIEN=+Y,APSPDRUG="" 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 APSPQUIT=1 Q
I Y G GETDRUG
S APSPDIEN=APSPOIEN
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")=APSPDRUG D ^DIR K DIR S:$D(DTOUT) DIRUT=1
I $D(DIRUT) S APSPQUIT=1 W !!,"Exiting..." Q
S APSPDRUG=Y
S APSPDRUG=$TR(APSPDRUG,"-") ;IHS/OKCAO/POC 4/22/98
Q
GENVISIT ;
K APCDALVR
S APCDALVR("AUPNTALK")=""
S APCDALVR("APCDDATE")=APSPDATE
S APCDALVR("APCDTYPE")="O"
S APCDALVR("APCDPAT")=DFN
S APCDALVR("APCDLOC")=$G(APSPDOL)
S APCDALVR("APCDCAT")="E"
S APCDALVR("APCDAUTO")="",APCDALVR("APCDANE")=""
S APCDALVR("APCDOLOC")=APSPOL
D ^APCDALV
I $D(APCDALVR("APCDAFLG")) W !!,$C(7),"Creating PCC Visit Failed....Notify Supervisor" H 3 S APSPQUIT=1 Q
S APCDVSIT=APCDALVR("APCDVSIT"),APCDPAT=APCDALVR("APCDPAT") S Y=DFN D ^AUPNPAT
Q
GENVMED ;
I '$G(APSPDIEN) W !!,"Error.... no drug entry" H 2 Q
;D ^APCDEA3
W !!,"Please enter all available information about this prescription.",!
S DA=APCDVSIT,DR="[APCD ORX (ADD)]",DIE="^AUPNVSIT(" D ^DIE
I $D(Y) W !!,"Creating V Medication entry failed!! Notify supervisor!" H 3 Q
Q
GETPAT ;EP
W !
S DFN=""
S DIC("A")="Enter PATIENT NAME: ",DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S DFN=+Y
;ADD THESE 2 LINES TO BUILD DRUG ARRAY IHS/OKCAO/POC
S PSODFN=+Y
D ^PSOBUILD
Q
;
TEXT ;
;;
;;IHS PHARMACY MODULE/PCC Interface
;;
;;*******************************
;;* Entry of OUTSIDE RX's *
;;*******************************
;;
APSPORXA ; IHS/DSD/ENM - enter outside rx ; [ 02/20/2001 1:50 PM ]
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**1,3**;09/03/97
+2 ;
START ;EP - called from option
HDR ;write header
+1 IF $DATA(IOF)
WRITE @IOF
+2 FOR J=1:1:7
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 APSPQUIT
GOTO EXIT
+3 DO GETPAT
+4 IF DFN=""
GOTO EXIT
+5 ;F D GETDRUG Q:APSPQUIT!(APSPDIEN="") D PROCESS
+6 ;F D GETDRUG Q:APSPQUIT!(APSPDIEN="") D ^APSQDRG S:PSORX("DFLG") APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT) D ^APSQDRDU S:$G(PSORX("DFLG")) APSPQUIT=1 K PSORX("DFLG") Q:$G(APSPQUIT) D PROCESS ;IHS/OKCAO/POC
+7 ;IHS/OKCAO/POC
FOR
DO GETDRUG
IF APSPQUIT!(APSPDIEN="")
QUIT
SET X="APSQDRG"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ^APSQDRG
IF PSORX("DFLG")
SET APSPQUIT=1
KILL PSORX("DFLG")
IF $GET(APSPQUIT)
QUIT
DO PROCESS
+8 DO EXIT
+9 QUIT
PROCESS ;
+1 DO GETDATE
+2 IF APSPDATE=""
QUIT
+3 DO GETOL
+4 IF APSPOL=""
QUIT
+5 DO GENVISIT
+6 IF APSPQUIT
QUIT
+7 DO GENVMED
+8 QUIT
EXIT ;cleanup and exit
+1 KILL DFN,APCDLOOK,APCDANE,APCDALVR,APCDVSIT,APCDPAT
+2 ;IHS/DSD/ENM APSPDOL REMOVED
KILL APSPOIEN,APSPDRUG,APSPDIEN,APSPOL,APSPDATE,APSPQUIT
+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 APSPQUIT=0
+2 SET APSPOIEN=$ORDER(^PSDRUG("B","OUTSIDE DRUG",0))
IF 'APSPOIEN
WRITE !!,$CHAR(7),$CHAR(7),"OUTSIDE DRUG not defined in DRUG file, notify supervisor."
HANG 3
SET APSPQUIT=1
QUIT
+3 ;I APCDFLG S APSPQUIT=1 Q
+4 ;set up pharmacy site parameters
IF '$DATA(PSOPAR)
DO ^PSOLSET
+5 ;S APSPDOL=4472
+6 IF '$GET(APSPDOL)
WRITE !!,"DEFAULT OTHER LOCATION NOT DEFINED IN PHARMACY SITE FILE!! NOTIFY YOUR SUPERVISOR"
HANG 3
SET APSPQUIT=1
QUIT
+7 QUIT
GETDATE ;EP GET DATE OF ENCOUNTER
+1 KILL DIR
SET APSPDATE=""
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 APSPDATE=Y
+6 QUIT
GETOL ;
+1 SET APSPOL=""
+2 SET DIR(0)="9000010,2101"
SET DIR("A")="Enter LOCATION WHERE DISPENSED"
KILL DA
DO ^DIR
KILL DIR
+3 SET APSPOL=Y
+4 QUIT
GETDRUG ;
+1 SET (APSPDRUG,APSPDIEN)=""
+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,APSPDRUG)=Y
SET DIC="^PSDRUG("
SET DIC(0)="MQE"
DO ^DIC
KILL DIC
+6 IF Y=-1
DO NODRUG
QUIT
+7 SET APSPDIEN=+Y
SET APSPDRUG=""
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 APSPQUIT=1
QUIT
+4 IF Y
GOTO GETDRUG
+5 SET APSPDIEN=APSPOIEN
+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")=APSPDRUG
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET DIRUT=1
+7 IF $DATA(DIRUT)
SET APSPQUIT=1
WRITE !!,"Exiting..."
QUIT
+8 SET APSPDRUG=Y
+9 ;IHS/OKCAO/POC 4/22/98
SET APSPDRUG=$TRANSLATE(APSPDRUG,"-")
+10 QUIT
GENVISIT ;
+1 KILL APCDALVR
+2 SET APCDALVR("AUPNTALK")=""
+3 SET APCDALVR("APCDDATE")=APSPDATE
+4 SET APCDALVR("APCDTYPE")="O"
+5 SET APCDALVR("APCDPAT")=DFN
+6 SET APCDALVR("APCDLOC")=$GET(APSPDOL)
+7 SET APCDALVR("APCDCAT")="E"
+8 SET APCDALVR("APCDAUTO")=""
SET APCDALVR("APCDANE")=""
+9 SET APCDALVR("APCDOLOC")=APSPOL
+10 DO ^APCDALV
+11 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,$CHAR(7),"Creating PCC Visit Failed....Notify Supervisor"
HANG 3
SET APSPQUIT=1
QUIT
+12 SET APCDVSIT=APCDALVR("APCDVSIT")
SET APCDPAT=APCDALVR("APCDPAT")
SET Y=DFN
DO ^AUPNPAT
+13 QUIT
GENVMED ;
+1 IF '$GET(APSPDIEN)
WRITE !!,"Error.... no drug entry"
HANG 2
QUIT
+2 ;D ^APCDEA3
+3 WRITE !!,"Please enter all available information about this prescription.",!
+4 SET DA=APCDVSIT
SET DR="[APCD ORX (ADD)]"
SET DIE="^AUPNVSIT("
DO ^DIE
+5 IF $DATA(Y)
WRITE !!,"Creating V Medication entry failed!! Notify supervisor!"
HANG 3
QUIT
+6 QUIT
GETPAT ;EP
+1 WRITE !
+2 SET DFN=""
+3 SET DIC("A")="Enter PATIENT NAME: "
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y<0
QUIT
+5 SET DFN=+Y
+6 ;ADD THESE 2 LINES TO BUILD DRUG ARRAY IHS/OKCAO/POC
+7 SET PSODFN=+Y
+8 DO ^PSOBUILD
+9 QUIT
+10 ;
TEXT ;
+1 ;;
+2 ;;IHS PHARMACY MODULE/PCC Interface
+3 ;;
+4 ;;*******************************
+5 ;;* Entry of OUTSIDE RX's *
+6 ;;*******************************
+7 ;;
