PSODGDG2 ;BIR/RTR-drug drug interaction continued ;8/8/96
;;7.0;OUTPATIENT PHARMACY;**27,130,251,375,372**;DEC 1997;Build 54
;External reference to ^DPT supported by DBIA 10035
;External references to U, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
;External reference to $$DS^PSSDSAPI supported by DBIA 5424
EN ;Activate or process an Rx
Q:'$G(DA)
K ^PS(52.4,"ADI",DA,1),^PSRX(DA,"DRI") F ZZZ=8,9,10 S $P(^PS(52.4,DA,0),"^",ZZZ)=""
K ZZZ Q
PROC I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) W $C(7),$C(7),!!,"SITE PARAMETERS MUST BE DEFINED !",! G EX
I '$D(^XUSEC("PSORPH",DUZ)) W $C(7),$C(7),!,"YOU MUST BE A PHARMACIST TO COMPLETE THIS PROCEDURE !",!! Q
I $P($G(^VA(200,DUZ,20)),"^",4)']"" W $C(7),$C(7),!,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE !",!! Q
N PSOODOSP
BEG S DIC="^PS(52.4,",DIC(0)="AQXEZ",DIC("S")="I $D(^PS(52.4,""ADI"",+Y))!($D(^PS(52.4,""DW"",+Y)))"
S DIC("A")=$S($$DS^PSSDSAPI:"Select RX with Order Checks: ",1:"Select RX with Drug Interaction: ")
S DIC("W")="W ?$X+5,$P(^DPT($P(^PS(52.4,+Y,0),""^"",2),0),""^"")_"" "",?40,$E($P(^(0),""^"",9),1,3)_""-""_$E($P(^(0),""^"",9),4,5)_""-""_$E($P(^(0),""^"",9),6,9)"
D ^DIC K DIC G:"^"[$E(X)!($D(DTOUT)) EX
ENT S (PSODFN,PSOVRDFN,DFN,PSDFN)=$P(Y(0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^"),(PSONV,PSONVXX,IFN,DGDG)=+Y D STAT G:FLAGST BEG D ^PSOBUILD
S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY K PSOPLCK G BEG
K PSOPLCK D PSOL^PSSLOCK(PSONV) I '$G(PSOMSG) D UL^PSSLOCK(PSODFN) D K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR K DIR,PSOMSG G BEG
.I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
.W !!,"Another person is editing this order.",!
I $G(PSOODOSP)'=DFN S PSOODOSP=DFN K PSORX("DOSING OFF")
D PID^VADPT
K PSODLQT N PSOPOCK S PSOPOCK=1 D DGDGI^PSOVER
I $G(VERLFLAG) D UL^PSSLOCK(PSOVRDFN) D PSOUL^PSSLOCK(PSONVXX) K VERLFLAG G BEG
D PACK^PSOVER
D UL^PSSLOCK(PSOVRDFN),PSOUL^PSSLOCK(PSONVXX)
W !! G BEG
EX D END^PSOVER K DTOUT,DIRUT,PSORX,PSOVRDFN,PSONVXX Q
;
STAT ;
S FLAGST=0
S ST00=$P($G(^PSRX(PSONV,"STA")),"^")
I $P($G(^PSRX(PSONV,2)),"^",6),+$P($G(^PSRX(PSONV,2)),"^",6)<DT,ST00<12 S $P(^PSRX(PSONV,"STA"),"^")=11,ST00=11
I ST00=1!(ST00=4) Q
S FLAGST=1
K DIK S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK
I ST00>10,ST00<16,$O(^PS(52.5,"B",PSONV,0)) S DA=$O(^PS(52.5,"B",PSONV,0)),DIK="^PS(52.5," D ^DIK K DIK
I ST00>10,ST00<16,$G(^PSRX(PSONV,"H"))]"" K:$P(^PSRX(PSONV,"H"),"^") ^PSRX("AH",$P(^PSRX(PSONV,"H"),"^"),PSONV) S ^PSRX(PSONV,"H")=""
S STEXT=$S(ST00=0:"Active",ST00=2:"Refill",ST00=3:"Hold",ST00=5:"Suspended",ST00=11:"Expired",ST00=12:"Canceled",ST00=13:"Deleted",ST00=14:"Discontinued",ST00=15:"Discontinued (Edit)",ST00=16:"Provider Hold",1:"Unknown")
I '$G(CLFLAG) W !!?3,"Rx # ",$P($G(^PSRX(PSONV,0)),"^")," has a status of ",STEXT_".",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press RETURN to continue" D ^DIR W ! K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODGDG2 2994 printed Oct 16, 2024@18:27:35 Page 2
PSODGDG2 ;BIR/RTR-drug drug interaction continued ;8/8/96
+1 ;;7.0;OUTPATIENT PHARMACY;**27,130,251,375,372**;DEC 1997;Build 54
+2 ;External reference to ^DPT supported by DBIA 10035
+3 ;External references to U, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
+4 ;External reference to $$DS^PSSDSAPI supported by DBIA 5424
EN ;Activate or process an Rx
+1 if '$GET(DA)
QUIT
+2 KILL ^PS(52.4,"ADI",DA,1),^PSRX(DA,"DRI")
FOR ZZZ=8,9,10
SET $PIECE(^PS(52.4,DA,0),"^",ZZZ)=""
+3 KILL ZZZ
QUIT
PROC IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),$CHAR(7),!!,"SITE PARAMETERS MUST BE DEFINED !",!
GOTO EX
+1 IF '$DATA(^XUSEC("PSORPH",DUZ))
WRITE $CHAR(7),$CHAR(7),!,"YOU MUST BE A PHARMACIST TO COMPLETE THIS PROCEDURE !",!!
QUIT
+2 IF $PIECE($GET(^VA(200,DUZ,20)),"^",4)']""
WRITE $CHAR(7),$CHAR(7),!,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE !",!!
QUIT
+3 NEW PSOODOSP
BEG SET DIC="^PS(52.4,"
SET DIC(0)="AQXEZ"
SET DIC("S")="I $D(^PS(52.4,""ADI"",+Y))!($D(^PS(52.4,""DW"",+Y)))"
+1 SET DIC("A")=$SELECT($$DS^PSSDSAPI:"Select RX with Order Checks: ",1:"Select RX with Drug Interaction: ")
+2 SET DIC("W")="W ?$X+5,$P(^DPT($P(^PS(52.4,+Y,0),""^"",2),0),""^"")_"" "",?40,$E($P(^(0),""^"",9),1,3)_""-""_$E($P(^(0),""^"",9),4,5)_""-""_$E($P(^(0),""^"",9),6,9)"
+3 DO ^DIC
KILL DIC
if "^"[$EXTRACT(X)!($DATA(DTOUT))
GOTO EX
ENT SET (PSODFN,PSOVRDFN,DFN,PSDFN)=$PIECE(Y(0),"^",2)
SET PPL=""
SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
SET (PSONV,PSONVXX,IFN,DGDG)=+Y
DO STAT
if FLAGST
GOTO BEG
DO ^PSOBUILD
+1 SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)
IF '$GET(PSOPLCK)
DO LOCK^PSOORCPY
KILL PSOPLCK
GOTO BEG
+2 KILL PSOPLCK
DO PSOL^PSSLOCK(PSONV)
IF '$GET(PSOMSG)
DO UL^PSSLOCK(PSODFN)
Begin DoDot:1
+3 IF $PIECE($GET(PSOMSG),"^",2)'=""
WRITE !!,$PIECE(PSOMSG,"^",2),!
QUIT
+4 WRITE !!,"Another person is editing this order.",!
End DoDot:1
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR,PSOMSG
GOTO BEG
+5 IF $GET(PSOODOSP)'=DFN
SET PSOODOSP=DFN
KILL PSORX("DOSING OFF")
+6 DO PID^VADPT
+7 KILL PSODLQT
NEW PSOPOCK
SET PSOPOCK=1
DO DGDGI^PSOVER
+8 IF $GET(VERLFLAG)
DO UL^PSSLOCK(PSOVRDFN)
DO PSOUL^PSSLOCK(PSONVXX)
KILL VERLFLAG
GOTO BEG
+9 DO PACK^PSOVER
+10 DO UL^PSSLOCK(PSOVRDFN)
DO PSOUL^PSSLOCK(PSONVXX)
+11 WRITE !!
GOTO BEG
EX DO END^PSOVER
KILL DTOUT,DIRUT,PSORX,PSOVRDFN,PSONVXX
QUIT
+1 ;
STAT ;
+1 SET FLAGST=0
+2 SET ST00=$PIECE($GET(^PSRX(PSONV,"STA")),"^")
+3 IF $PIECE($GET(^PSRX(PSONV,2)),"^",6)
IF +$PIECE($GET(^PSRX(PSONV,2)),"^",6)<DT
IF ST00<12
SET $PIECE(^PSRX(PSONV,"STA"),"^")=11
SET ST00=11
+4 IF ST00=1!(ST00=4)
QUIT
+5 SET FLAGST=1
+6 KILL DIK
SET DA=PSONV
SET DIK="^PS(52.4,"
DO ^DIK
KILL DIK
+7 IF ST00>10
IF ST00<16
IF $ORDER(^PS(52.5,"B",PSONV,0))
SET DA=$ORDER(^PS(52.5,"B",PSONV,0))
SET DIK="^PS(52.5,"
DO ^DIK
KILL DIK
+8 IF ST00>10
IF ST00<16
IF $GET(^PSRX(PSONV,"H"))]""
if $PIECE(^PSRX(PSONV,"H"),"^")
KILL ^PSRX("AH",$PIECE(^PSRX(PSONV,"H"),"^"),PSONV)
SET ^PSRX(PSONV,"H")=""
+9 SET STEXT=$SELECT(ST00=0:"Active",ST00=2:"Refill",ST00=3:"Hold",ST00=5:"Suspended",ST00=11:"Expired",ST00=12:"Canceled",ST00=13:"Deleted",ST00=14:"Discontinued",ST00=15:"Discontinued (Edit)",ST00=16:"Provider Hold",1:"Unknown")
+10 IF '$GET(CLFLAG)
WRITE !!?3,"Rx # ",$PIECE($GET(^PSRX(PSONV,0)),"^")," has a status of ",STEXT_".",!
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
WRITE !
KILL DIR
+11 QUIT
