PSODRGN ;BIR/SJA-ORDER ENTRY DRUG SELECTION ;02/15/07
;;7.0;OUTPATIENT PHARMACY;**268,422,573**;DEC 1997;Build 2
;Reference ^PSDRUG supported by DBIA 221
; PSO*7.0*573 Add Duplicate Drug Check during Drug Edit
;
SELECT ;
K:'$G(PSORXED) CLOZPAT
K DIC,X,Y,PSODRUG("TRADE NAME"),PSODRUG("NDC"),PSODRUG("DAW") S:$G(POERR)&($P($G(OR0),"^",9)) Y=$P(^PSDRUG($P(OR0,"^",9),0),"^")
I $G(PSODRUG("IEN"))]"" S Y=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN")
S (PSDC,PSI)=0 W !!!,"The following Drug(s) are available for selection:"
F PSI=0:0 S PSI=$O(^PSDRUG("ASP",PSODRUG("OI"),PSI)) Q:'PSI I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1) D
.S PSDC=PSDC+1 W !,PSDC_". "_$P(^PSDRUG(PSI,0),"^")_$S($P(^(0),"^",9):" (N/F)",1:"")
.S PSDC(PSDC)=PSI
I PSDC=0 D
.N X,DRG
.S DRG=+$P($G(^PSRX(DA,0)),"^",6)
.S X=$$GET1^DIQ(50,DRG,100)
.I X'="",(DT>X) D
.. W !!," This Dispense Drug is now Inactive. You may select a"
.. W !," new Orderable Item, or you can enter a new Order with"
.. W !," an Active Drug.",!
.E W !!,"No drugs available!",!
.K DIR S DIR(0)="E",DIR("A")="Press return to continue"
.D ^DIR K DIR
G:'PSDC ETX K PSOBDR S PSOBDR("NAME")=PSODRUG("NAME")
I PSDC'=1 D
.I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
.K PSODRUG("NAME"),PSODRUG("IEN")
W ! D KV S DIR(0)="N^1:"_PSDC,DIR("A")="Select Drug by number" D ^DIR
I $G(PSORXED),X["^" S PSORXED("DFLG")=1 G SELECTX
I +$G(PSOEDIT)=1,X="^"!(X["^^")!($D(DTOUT)) S PSONEW("DFLG")=1 G SELECTX
I '$G(POERR),X[U,$L(X)>1 S PSODIR("FLD")=PSONEW("FLD") D JUMP^PSODIR1 S:$G(PSODIR("FIELD")) PSONEW("FIELD")=PSODIR("FIELD") K PSODIR S PSODRG("QFLG")=1 G SELECTX
I +$G(PSOEDIT)=1,$D(DTOUT) S PSONEW("DFLG")=1 G SELECTX
I $D(DUOUT) K DUOUT G SELECT
I Y<0 G SELECT
S:$G(PSONEW("OLD VAL"))=+Y&('$G(PSOEDIT)) PSODRG("QFLG")=1
D KV K PSOY S PSOY(0)=^PSDRUG(PSDC(Y),0),PSOY=PSDC(Y)_"^"_$P(PSOY(0),"^")
I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE
SELECTX K X,Y,DTOUT,DUOUT,PSDC,PSI,PSONEW("OLD VAL")
Q
TRADE ;
K DIR,DIC,DA,X,Y
S DIR(0)="52,6.5" S:$G(PSOTRN)]"" DIR("B")=$G(PSOTRN) D ^DIR K DIR,DIC
I X="@" S Y=X K DIRUT
I $D(DIRUT) S:$D(DUOUT)!$D(DTOUT)&('$D(PSORX("EDIT"))) PSONEW("DFLG")=1 G TRADEX
S PSODRUG("TRADE NAME")=Y
TRADEX I $G(PSORXED("DFLG")),$D(DIRUT) S PSORXED("DFLG")=1
K DIRUT,DTOUT,DUOUT,X,Y,DA,DR,DIE
Q
ETX S VALMBCK="R" I 'PSDC S VALMSG="NO dispense drugs tied to this orderable item!"
TX D KV K PSDC,PSI,X,Y
Q
KV K DIR,DIRUT,DUOUT,DTOUT
Q
6 ;Called from PSOBKDED due to it's routine size.
I $G(PSOEDIT),$G(PSODRUG("NAME"))'=$G(PSOBDR("NAME")) D
.S PSOXXX(1)="You have changed the dispense drug from",PSOXXX(2)=$P($G(PSOBDR("NAME")),"^")_" to "_$P($G(PSODRUG("NAME")),"^")_"." D EN^DDIOL(.PSOXXX,"","!") S PSOAC=1
.D POST^PSODRG ;*573 Added this line
.I '$G(PSORX("DFLG")) K PSOBDR D 10^PSOBKDED ;Dose *573 Added check for "DFLG"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODRGN 3005 printed Apr 09, 2024@21:28:24 Page 2
PSODRGN ;BIR/SJA-ORDER ENTRY DRUG SELECTION ;02/15/07
+1 ;;7.0;OUTPATIENT PHARMACY;**268,422,573**;DEC 1997;Build 2
+2 ;Reference ^PSDRUG supported by DBIA 221
+3 ; PSO*7.0*573 Add Duplicate Drug Check during Drug Edit
+4 ;
SELECT ;
+1 if '$GET(PSORXED)
KILL CLOZPAT
+2 KILL DIC,X,Y,PSODRUG("TRADE NAME"),PSODRUG("NDC"),PSODRUG("DAW")
if $GET(POERR)&($PIECE($GET(OR0),"^",9))
SET Y=$PIECE(^PSDRUG($PIECE(OR0,"^",9),0),"^")
+3 IF $GET(PSODRUG("IEN"))]""
SET Y=PSODRUG("NAME")
SET PSONEW("OLD VAL")=PSODRUG("IEN")
+4 SET (PSDC,PSI)=0
WRITE !!!,"The following Drug(s) are available for selection:"
+5 FOR PSI=0:0
SET PSI=$ORDER(^PSDRUG("ASP",PSODRUG("OI"),PSI))
if 'PSI
QUIT
IF $SELECT('$DATA(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0)
IF $SELECT($PIECE($GET(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1)
Begin DoDot:1
+6 SET PSDC=PSDC+1
WRITE !,PSDC_". "_$PIECE(^PSDRUG(PSI,0),"^")_$SELECT($PIECE(^(0),"^",9):" (N/F)",1:"")
+7 SET PSDC(PSDC)=PSI
End DoDot:1
+8 IF PSDC=0
Begin DoDot:1
+9 NEW X,DRG
+10 SET DRG=+$PIECE($GET(^PSRX(DA,0)),"^",6)
+11 SET X=$$GET1^DIQ(50,DRG,100)
+12 IF X'=""
IF (DT>X)
Begin DoDot:2
+13 WRITE !!," This Dispense Drug is now Inactive. You may select a"
+14 WRITE !," new Orderable Item, or you can enter a new Order with"
+15 WRITE !," an Active Drug.",!
End DoDot:2
+16 IF '$TEST
WRITE !!,"No drugs available!",!
+17 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press return to continue"
+18 DO ^DIR
KILL DIR
End DoDot:1
+19 if 'PSDC
GOTO ETX
KILL PSOBDR
SET PSOBDR("NAME")=PSODRUG("NAME")
+20 IF PSDC'=1
Begin DoDot:1
+21 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),2)),"^")=$GET(PSODRUG("OI"))
QUIT
+22 KILL PSODRUG("NAME"),PSODRUG("IEN")
End DoDot:1
+23 WRITE !
DO KV
SET DIR(0)="N^1:"_PSDC
SET DIR("A")="Select Drug by number"
DO ^DIR
+24 IF $GET(PSORXED)
IF X["^"
SET PSORXED("DFLG")=1
GOTO SELECTX
+25 IF +$GET(PSOEDIT)=1
IF X="^"!(X["^^")!($DATA(DTOUT))
SET PSONEW("DFLG")=1
GOTO SELECTX
+26 IF '$GET(POERR)
IF X[U
IF $LENGTH(X)>1
SET PSODIR("FLD")=PSONEW("FLD")
DO JUMP^PSODIR1
if $GET(PSODIR("FIELD"))
SET PSONEW("FIELD")=PSODIR("FIELD")
KILL PSODIR
SET PSODRG("QFLG")=1
GOTO SELECTX
+27 IF +$GET(PSOEDIT)=1
IF $DATA(DTOUT)
SET PSONEW("DFLG")=1
GOTO SELECTX
+28 IF $DATA(DUOUT)
KILL DUOUT
GOTO SELECT
+29 IF Y<0
GOTO SELECT
+30 if $GET(PSONEW("OLD VAL"))=+Y&('$GET(PSOEDIT))
SET PSODRG("QFLG")=1
+31 DO KV
KILL PSOY
SET PSOY(0)=^PSDRUG(PSDC(Y),0)
SET PSOY=PSDC(Y)_"^"_$PIECE(PSOY(0),"^")
+32 IF $PIECE(PSOY(0),"^")="OTHER DRUG"!($PIECE(PSOY(0),"^")="OUTSIDE DRUG")
DO TRADE
SELECTX KILL X,Y,DTOUT,DUOUT,PSDC,PSI,PSONEW("OLD VAL")
+1 QUIT
TRADE ;
+1 KILL DIR,DIC,DA,X,Y
+2 SET DIR(0)="52,6.5"
if $GET(PSOTRN)]""
SET DIR("B")=$GET(PSOTRN)
DO ^DIR
KILL DIR,DIC
+3 IF X="@"
SET Y=X
KILL DIRUT
+4 IF $DATA(DIRUT)
if $DATA(DUOUT)!$DATA(DTOUT)&('$DATA(PSORX("EDIT")))
SET PSONEW("DFLG")=1
GOTO TRADEX
+5 SET PSODRUG("TRADE NAME")=Y
TRADEX IF $GET(PSORXED("DFLG"))
IF $DATA(DIRUT)
SET PSORXED("DFLG")=1
+1 KILL DIRUT,DTOUT,DUOUT,X,Y,DA,DR,DIE
+2 QUIT
ETX SET VALMBCK="R"
IF 'PSDC
SET VALMSG="NO dispense drugs tied to this orderable item!"
TX DO KV
KILL PSDC,PSI,X,Y
+1 QUIT
KV KILL DIR,DIRUT,DUOUT,DTOUT
+1 QUIT
6 ;Called from PSOBKDED due to it's routine size.
+1 IF $GET(PSOEDIT)
IF $GET(PSODRUG("NAME"))'=$GET(PSOBDR("NAME"))
Begin DoDot:1
+2 SET PSOXXX(1)="You have changed the dispense drug from"
SET PSOXXX(2)=$PIECE($GET(PSOBDR("NAME")),"^")_" to "_$PIECE($GET(PSODRUG("NAME")),"^")_"."
DO EN^DDIOL(.PSOXXX,"","!")
SET PSOAC=1
+3 ;*573 Added this line
DO POST^PSODRG
+4 ;Dose *573 Added check for "DFLG"
IF '$GET(PSORX("DFLG"))
KILL PSOBDR
DO 10^PSOBKDED
End DoDot:1
+5 QUIT
