PSODGDG1 ;BHAM ISC/SAB - DRUG INTERACTION PROCESSOR ;02/25/94 9:14
;;7.0;OUTPATIENT PHARMACY;**251,372**;DEC 1997;Build 54
;External reference ^PSDRUG( supported by DBIA 221
;
G PROC^PSODGDG2
PROCESS ;verification
Q:$P(^PSRX(PSONV,"STA"),"^")=13
W @IOF W !,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID")_" RX #"_$P(INT,"^")
D CUTDATE^PSOFUNC:'$G(PSODTCUT),^PSOBUILD:'+$G(PSOZVER),^PSODSPL
S DIR("?",1)="Answer 'YES' if you DO want to "_$S($P(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
S DIR("?",2)=" 'NO' if you DON'T want to "_$S($P(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,",DIR("?")=" or 'P' to review medication profile."
W $C(7),$C(7) S DIR("A",1)="",DIR("A",2)="***"_$S($P(SER,"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"*** "_"Drug Interaction with RX #"_$P(^PSRX($P($P(MED,",",INA),"^"),0),"^"),DIR("A",3)=" Drug: "_$P($G(^PSDRUG($P(^(0),"^",6),0)),"^")
S DIR(0)="SA^1:YES;0:NO;P:PROFILE",DIR("A")="Do you want to "_$S($P(SER,"^",4)=1:"Continue? ",1:"Intervene? "),DIR("B")="Y" D ^DIR I Y="P" W ! K Y G PROCESS
I 'Y,$P(SER,"^",4)=1 S PSVERFLG=1
I Y,$P(SER,"^",4)=1 S PSORX("INTERVENE")=1 K DIR,DTOUT,DIRUT,DIROUT,DUOUT D CRI Q
I Y,$P(SER,"^",4)=2 S PSORX("INTERVENE")=2,DA=IFN D INV
K DIR,DTOUT,DIRUT,DIROUT,DUOUT Q
Q
CRI ;new interactions
K DIR I $P(RX,"^",15)=4 D CRITN Q
S DIR("A",1)="",DIR("A",2)="Do you want to Process or Cancel medication?"
S DIR("A")="Rx #"_$P($G(^PSRX(DA,0)),"^")_" "_"Drug: "_$P($G(^PSDRUG($P(^PSRX(DA,0),"^",6),0)),"^")_": "
S DIR(0)="SA^1:PROCESS;0:CANCEL MEDICATION",DIR("B")="PROCESS"
K ANSDIR
S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'C' to Cancel Medication" D ^DIR K DIR
I $D(DIRUT) S (PSORX("DFLG"),PSVERFLG)=1 Q
S ANSDIR=Y,PSONV=DA
D SIG^XUSESIG I X1="" S (PSORX("DFLG"),PSVERFLG)=1 K ANSDIR Q
I 'ANSDIR N PSOHDINV D G Q1
.D NOOR^PSOCAN4 I $D(DIRUT) D UPOUT Q
.S DA=PSONV D RXV S DA=PSONV,PSORX("INTERVENE")=1 D INV S DA=PSONV
.D PSDEL,HLDINVS,DEL K PSORX("INTERVENE") S PSVERFLG=1
I ANSDIR&'$G(PSODIR) S DA=PSONV D HLDINV,INV S DA=PSONV D
.I '$G(PSVERFLG) D ^PSODGDG2 S $P(^PSRX(PSONV,"STA"),"^")=1 S ZONE=PSONV D ONE
Q1 K DIK,DTOUT,DIRUT,DIROUT,DUOUT,LST,ANSDIR,PSONOOR S PSVERFLG=1
Q
HLDINV ;
I $G(PSORX("INTERVENE")) S PSOHDINV=$G(PSORX("INTERVENE"))
Q
;
;
HLDINVS ;
I $G(PSOHDINV) S PSORX("INTERVENE")=PSOHDINV
Q
;
CRITN ;multiple interactions
S PSOTHER=$P($P(MED,",",INA),"^") N PSONV
K DIR S DIR("A",1)="",DIR("A",2)="Do you want to: ",DIR("A",3)=" 1. Cancel Rx #"_$P(INT,"^")_" DRUG: "_$P(^PSDRUG($P(INT,"^",6),0),"^")
S DIR("A",4)=" 2. Cancel Rx #"_$P(RX,"^")_" DRUG: "_$P(^PSDRUG($P(RX,"^",6),0),"^"),DIR("A",5)=" 3. Cancel Both 1 and 2",DIR("A")=" 5. Leave Both Non-verified (do nothing) ?: ",DIR("A",6)=" 4. Process Both 1 and 2"
S DIR(0)="SA^1:1 to be Canceled;2:2 to be Canceled;3:Cancel BOTH 1 and 2;4:ACTIVATE 1 and 2;5:DO NOTHING TO 1 and 2"
S DIR("?",1)="Enter '1' to Cancel Rx #"_$P(INT,"^")_" DRUG: "_$P(^PSDRUG($P(INT,"^",6),0),"^"),DIR("?",2)=" '2' to Cancel Rx #"_$P(RX,"^")_" DRUG: "_$P(^PSDRUG($P(RX,"^",6),0),"^")
S DIR("?",3)=" '3' or 'B' to Cancel Both 1 and 2",DIR("?",4)=" '4' or 'A' to Activate both RXs",DIR("?")=" '5' or 'D' to do nothing/leave both RXs in a Pending Status" D ^DIR K DIR I Y["^"!(Y=5)!($D(DIRUT)) S PSVERFLG=1 G CRIZ
S PSAN=Y D SIG^XUSESIG I X1="" K PSAN S (PSORX("DFLG"),PSVERFLG)=1 G CRIZ
I PSAN=1 D D KILL Q
.D NOOR^PSOCAN4 I $D(DIRUT) D UPOUT,KILL K PSONORR,PSORX("INTERVENE") Q
.S DA=IFN D RXV
.S DA=IFN D PSDEL,DEL
.S:$G(PSOSD) PSOSD=PSOSD-1 S DA=IFN D INV S DA=$P(MED,",",INA) S DA=PSOTHER
.D INV S DA=PSOTHER S $P(^PSRX(PSOTHER,"STA"),"^")=1,ZONE=PSOTHER
.D ONE K PSONOOR
I PSAN=2 D D KILL K PSONOOR Q
.D NOOR^PSOCAN4 I $D(DIRUT) D UPOUT,KILL K PSONOOR,PSORX("INTERVENE") Q
.S DA=$P(MED,",",INA) D PSDEL,DEL
.K PSONOOR S:$G(PSOSD) PSOSD=PSOSD-1 S DA=$P(MED,",",INA)
.D INV S DA=IFN D INV S DA=IFN
.I 'PSVERFLG,'$P(MED,",",(INA+1)) D ^PSODGDG2 S DA=IFN,$P(^PSRX(DA,"STA"),"^")=1 S ZONE=DA D ONE
I PSAN=3 D D KILL K PSONOOR Q
.D NOOR^PSOCAN4 I $D(DIRUT) D UPOUT,KILL K PSONOOR,PSORX("INTERVENE") Q
.F DA=$P(MED,",",INA),IFN S PSHOLDDA=DA D PSDEL,DEL S DA=PSHOLDDA D INV K DTOUT,DIROUT,DIRUT,DUOUT,PSAN,PSHOLDDA
I $G(PSAN)=4 S LST=1,PPL="" D
.S DA=$P(MED,",",INA) D INV S $P(^PSRX(PSOTHER,"STA"),"^")=1 S ZONE=PSOTHER S PSOTHER(PSOTHER)=PSOTHER D ONE
.S DA=IFN D INV I 'PSVERFLG,'$P(MED,",",(INA+1)) D ^PSODGDG2 S DA=IFN,$P(^PSRX(DA,"STA"),"^")=1 S ZONE=DA D ONE
.S:$G(PSOSD) PSOSD=PSOSD-2
D KILL
CRIZ ;
Q
RXV S DIK="^PS(52.4," D ^DIK Q ;251;verify there's no dosing checks before deleting
INV D EN1^PSORXI(.DA) K PSORX("INTERVENE") Q
PSDEL Q:$G(STAT)']""
S STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD",STAT=$P(STA,"^",$P(^PSRX(DA,"STA"),"^")+1)
I $P($G(PSOSD(STAT,$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^"))),"^")=DA K PSOSD(STAT,$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^"))
E K PSOSD(STAT,$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^")_"^"_DA)
Q
DEL W !!,"Canceling Rx: "_$P($G(^PSRX(DA,0)),"^")_" "_"Drug: "_$P($G(^PSDRUG($P(^PSRX(DA,0),"^",6),0)),"^"),!
D ENQ^PSORXDL S PSORX("DFLG")=1
S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR K DIR
I $G(PSOPOCK) S VALMBCK="Q"
Q
ONE S STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD",STAT=$P(STA,"^",$P(^PSRX(ZONE,"STA"),"^")+1)
I $P($G(PSOSD(STAT,$P(^PSDRUG($P(^PSRX(ZONE,0),"^",6),0),"^"))),"^")=ZONE S $P(PSOSD(STAT,$P(^PSDRUG($P(^PSRX(ZONE,0),"^",6),0),"^")),"^",2)=1
E I $G(PSOSD(STAT,$P(^PSDRUG($P(^PSRX(ZONE,0),"^",6),0),"^")_"^"_ZONE)) S $P(PSOSD(STAT,$P(^PSDRUG($P(^PSRX(ZONE,0),"^",6),0),"^")_"^"_ZONE),"^",2)=1
K ZONE,STA,STAT Q
KILL K DIR,DIK,DTOUT,DIROUT,DIRUT,DUOUT,LST,PPL,PSAN Q
;
UPOUT W " ACTION NOT TAKEN!",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR K DIR S PSVERFLG=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODGDG1 6236 printed Nov 22, 2024@17:36:55 Page 2
PSODGDG1 ;BHAM ISC/SAB - DRUG INTERACTION PROCESSOR ;02/25/94 9:14
+1 ;;7.0;OUTPATIENT PHARMACY;**251,372**;DEC 1997;Build 54
+2 ;External reference ^PSDRUG( supported by DBIA 221
+3 ;
+4 GOTO PROC^PSODGDG2
PROCESS ;verification
+1 if $PIECE(^PSRX(PSONV,"STA"),"^")=13
QUIT
+2 WRITE @IOF
WRITE !,$PIECE(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID")_" RX #"_$PIECE(INT,"^")
+3 if '$GET(PSODTCUT)
DO CUTDATE^PSOFUNC
if '+$GET(PSOZVER)
DO ^PSOBUILD
DO ^PSODSPL
+4 SET DIR("?",1)="Answer 'YES' if you DO want to "_$SELECT($PIECE(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
+5 SET DIR("?",2)=" 'NO' if you DON'T want to "_$SELECT($PIECE(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
SET DIR("?")=" or 'P' to review medication profile."
+6 WRITE $CHAR(7),$CHAR(7)
SET DIR("A",1)=""
SET DIR("A",2)="***"_$SELECT($PIECE(SER,"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"*** "_"Drug Interaction with RX #"_$PIECE(^PSRX($PIECE($PIECE(MED,",",INA),"^"),0),"^")
SET DIR("A",3)=" Drug: "_$PIECE($GET(^PSDRUG($PIECE(^(0),"^",6),0)),"^")
+7 SET DIR(0)="SA^1:YES;0:NO;P:PROFILE"
SET DIR("A")="Do you want to "_$SELECT($PIECE(SER,"^",4)=1:"Continue? ",1:"Intervene? ")
SET DIR("B")="Y"
DO ^DIR
IF Y="P"
WRITE !
KILL Y
GOTO PROCESS
+8 IF 'Y
IF $PIECE(SER,"^",4)=1
SET PSVERFLG=1
+9 IF Y
IF $PIECE(SER,"^",4)=1
SET PSORX("INTERVENE")=1
KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
DO CRI
QUIT
+10 IF Y
IF $PIECE(SER,"^",4)=2
SET PSORX("INTERVENE")=2
SET DA=IFN
DO INV
+11 KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
QUIT
+12 QUIT
CRI ;new interactions
+1 KILL DIR
IF $PIECE(RX,"^",15)=4
DO CRITN
QUIT
+2 SET DIR("A",1)=""
SET DIR("A",2)="Do you want to Process or Cancel medication?"
+3 SET DIR("A")="Rx #"_$PIECE($GET(^PSRX(DA,0)),"^")_" "_"Drug: "_$PIECE($GET(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0)),"^")_": "
+4 SET DIR(0)="SA^1:PROCESS;0:CANCEL MEDICATION"
SET DIR("B")="PROCESS"
+5 KILL ANSDIR
+6 SET DIR("?",1)="Enter '1' or 'P' to Process medication"
SET DIR("?")=" '^' to EXIT"
SET DIR("?",2)=" '0' or 'C' to Cancel Medication"
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET (PSORX("DFLG"),PSVERFLG)=1
QUIT
+8 SET ANSDIR=Y
SET PSONV=DA
+9 DO SIG^XUSESIG
IF X1=""
SET (PSORX("DFLG"),PSVERFLG)=1
KILL ANSDIR
QUIT
+10 IF 'ANSDIR
NEW PSOHDINV
Begin DoDot:1
+11 DO NOOR^PSOCAN4
IF $DATA(DIRUT)
DO UPOUT
QUIT
+12 SET DA=PSONV
DO RXV
SET DA=PSONV
SET PSORX("INTERVENE")=1
DO INV
SET DA=PSONV
+13 DO PSDEL
DO HLDINVS
DO DEL
KILL PSORX("INTERVENE")
SET PSVERFLG=1
End DoDot:1
GOTO Q1
+14 IF ANSDIR&'$GET(PSODIR)
SET DA=PSONV
DO HLDINV
DO INV
SET DA=PSONV
Begin DoDot:1
+15 IF '$GET(PSVERFLG)
DO ^PSODGDG2
SET $PIECE(^PSRX(PSONV,"STA"),"^")=1
SET ZONE=PSONV
DO ONE
End DoDot:1
Q1 KILL DIK,DTOUT,DIRUT,DIROUT,DUOUT,LST,ANSDIR,PSONOOR
SET PSVERFLG=1
+1 QUIT
HLDINV ;
+1 IF $GET(PSORX("INTERVENE"))
SET PSOHDINV=$GET(PSORX("INTERVENE"))
+2 QUIT
+3 ;
+4 ;
HLDINVS ;
+1 IF $GET(PSOHDINV)
SET PSORX("INTERVENE")=PSOHDINV
+2 QUIT
+3 ;
CRITN ;multiple interactions
+1 SET PSOTHER=$PIECE($PIECE(MED,",",INA),"^")
NEW PSONV
+2 KILL DIR
SET DIR("A",1)=""
SET DIR("A",2)="Do you want to: "
SET DIR("A",3)=" 1. Cancel Rx #"_$PIECE(INT,"^")_" DRUG: "_$PIECE(^PSDRUG($PIECE(INT,"^",6),0),"^")
+3 SET DIR("A",4)=" 2. Cancel Rx #"_$PIECE(RX,"^")_" DRUG: "_$PIECE(^PSDRUG($PIECE(RX,"^",6),0),"^")
SET DIR("A",5)=" 3. Cancel Both 1 and 2"
SET DIR("A")=" 5. Leave Both Non-verified (do nothing) ?: "
SET DIR("A",6)=" 4. Process Both 1 and 2"
+4 SET DIR(0)="SA^1:1 to be Canceled;2:2 to be Canceled;3:Cancel BOTH 1 and 2;4:ACTIVATE 1 and 2;5:DO NOTHING TO 1 and 2"
+5 SET DIR("?",1)="Enter '1' to Cancel Rx #"_$PIECE(INT,"^")_" DRUG: "_$PIECE(^PSDRUG($PIECE(INT,"^",6),0),"^")
SET DIR("?",2)=" '2' to Cancel Rx #"_$PIECE(RX,"^")_" DRUG: "_$PIECE(^PSDRUG($PIECE(RX,"^",6),0),"^")
+6 SET DIR("?",3)=" '3' or 'B' to Cancel Both 1 and 2"
SET DIR("?",4)=" '4' or 'A' to Activate both RXs"
SET DIR("?")=" '5' or 'D' to do nothing/leave both RXs in a Pending Status"
DO ^DIR
KILL DIR
IF Y["^"!(Y=5)!($DATA(DIRUT))
SET PSVERFLG=1
GOTO CRIZ
+7 SET PSAN=Y
DO SIG^XUSESIG
IF X1=""
KILL PSAN
SET (PSORX("DFLG"),PSVERFLG)=1
GOTO CRIZ
+8 IF PSAN=1
Begin DoDot:1
+9 DO NOOR^PSOCAN4
IF $DATA(DIRUT)
DO UPOUT
DO KILL
KILL PSONORR,PSORX("INTERVENE")
QUIT
+10 SET DA=IFN
DO RXV
+11 SET DA=IFN
DO PSDEL
DO DEL
+12 if $GET(PSOSD)
SET PSOSD=PSOSD-1
SET DA=IFN
DO INV
SET DA=$PIECE(MED,",",INA)
SET DA=PSOTHER
+13 DO INV
SET DA=PSOTHER
SET $PIECE(^PSRX(PSOTHER,"STA"),"^")=1
SET ZONE=PSOTHER
+14 DO ONE
KILL PSONOOR
End DoDot:1
DO KILL
QUIT
+15 IF PSAN=2
Begin DoDot:1
+16 DO NOOR^PSOCAN4
IF $DATA(DIRUT)
DO UPOUT
DO KILL
KILL PSONOOR,PSORX("INTERVENE")
QUIT
+17 SET DA=$PIECE(MED,",",INA)
DO PSDEL
DO DEL
+18 KILL PSONOOR
if $GET(PSOSD)
SET PSOSD=PSOSD-1
SET DA=$PIECE(MED,",",INA)
+19 DO INV
SET DA=IFN
DO INV
SET DA=IFN
+20 IF 'PSVERFLG
IF '$PIECE(MED,",",(INA+1))
DO ^PSODGDG2
SET DA=IFN
SET $PIECE(^PSRX(DA,"STA"),"^")=1
SET ZONE=DA
DO ONE
End DoDot:1
DO KILL
KILL PSONOOR
QUIT
+21 IF PSAN=3
Begin DoDot:1
+22 DO NOOR^PSOCAN4
IF $DATA(DIRUT)
DO UPOUT
DO KILL
KILL PSONOOR,PSORX("INTERVENE")
QUIT
+23 FOR DA=$PIECE(MED,",",INA),IFN
SET PSHOLDDA=DA
DO PSDEL
DO DEL
SET DA=PSHOLDDA
DO INV
KILL DTOUT,DIROUT,DIRUT,DUOUT,PSAN,PSHOLDDA
End DoDot:1
DO KILL
KILL PSONOOR
QUIT
+24 IF $GET(PSAN)=4
SET LST=1
SET PPL=""
Begin DoDot:1
+25 SET DA=$PIECE(MED,",",INA)
DO INV
SET $PIECE(^PSRX(PSOTHER,"STA"),"^")=1
SET ZONE=PSOTHER
SET PSOTHER(PSOTHER)=PSOTHER
DO ONE
+26 SET DA=IFN
DO INV
IF 'PSVERFLG
IF '$PIECE(MED,",",(INA+1))
DO ^PSODGDG2
SET DA=IFN
SET $PIECE(^PSRX(DA,"STA"),"^")=1
SET ZONE=DA
DO ONE
+27 if $GET(PSOSD)
SET PSOSD=PSOSD-2
End DoDot:1
+28 DO KILL
CRIZ ;
+1 QUIT
RXV ;251;verify there's no dosing checks before deleting
SET DIK="^PS(52.4,"
DO ^DIK
QUIT
INV DO EN1^PSORXI(.DA)
KILL PSORX("INTERVENE")
QUIT
PSDEL if $GET(STAT)']""
QUIT
+1 SET STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD"
SET STAT=$PIECE(STA,"^",$PIECE(^PSRX(DA,"STA"),"^")+1)
+2 IF $PIECE($GET(PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0),"^"))),"^")=DA
KILL PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0),"^"))
+3 IF '$TEST
KILL PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0),"^")_"^"_DA)
+4 QUIT
DEL WRITE !!,"Canceling Rx: "_$PIECE($GET(^PSRX(DA,0)),"^")_" "_"Drug: "_$PIECE($GET(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0)),"^"),!
+1 DO ENQ^PSORXDL
SET PSORX("DFLG")=1
+2 SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
+3 IF $GET(PSOPOCK)
SET VALMBCK="Q"
+4 QUIT
ONE SET STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD"
SET STAT=$PIECE(STA,"^",$PIECE(^PSRX(ZONE,"STA"),"^")+1)
+1 IF $PIECE($GET(PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(ZONE,0),"^",6),0),"^"))),"^")=ZONE
SET $PIECE(PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(ZONE,0),"^",6),0),"^")),"^",2)=1
+2 IF '$TEST
IF $GET(PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(ZONE,0),"^",6),0),"^")_"^"_ZONE))
SET $PIECE(PSOSD(STAT,$PIECE(^PSDRUG($PIECE(^PSRX(ZONE,0),"^",6),0),"^")_"^"_ZONE),"^",2)=1
+3 KILL ZONE,STA,STAT
QUIT
KILL KILL DIR,DIK,DTOUT,DIROUT,DIRUT,DUOUT,LST,PPL,PSAN
QUIT
+1 ;
UPOUT WRITE " ACTION NOT TAKEN!",!
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
SET PSVERFLG=1
QUIT
