PSODRGN ;BIR/SJA-ORDER ENTRY DRUG SELECTION ;28-Mar-2016 12:58;DU
;;7.0;OUTPATIENT PHARMACY;**268,1021**;DEC 1997;Build 14
;Reference ^PSDRUG supported by DBIA 221
;
; Modified - IHS/MSC/PLS - 03/28/2016 - Line SELECT+30
;
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
;IHS/MSC/PLS - 03/28/2016 - CR5951
I $$ERXONLY^APSPFNC6(+Y) D S Y=-1 G SELECT
.W !,"Drug is marked as ERX Only",*7,!
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 DIR(0)="Y",DIR("B")="YES"
.S DIR("A",1)="You have changed the dispense drug from"
.S DIR("A",2)=$P(PSOBDR("NAME"),"^")_" to "_$P(PSODRUG("NAME"),"^")_".",DIR("A",3)=""
.F I=0:0 S I=$O(SIG(I)) Q:'I S DIR("A",3+I)=$S(I=1:"Current SIG: ",1:"")_$G(SIG(I))
.S DIR("A")="Do You want to Edit the SIG"
.D ^DIR K DIR I $D(DIRUT) S PSORX("DFLG")=1 D M1^PSOOREDX Q
.Q:$D(DIRUT)!('Y)
.K PSOBDR D 10^PSOBKDED ;Dose
Q
PSODRGN ;BIR/SJA-ORDER ENTRY DRUG SELECTION ;28-Mar-2016 12:58;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**268,1021**;DEC 1997;Build 14
+2 ;Reference ^PSDRUG supported by DBIA 221
+3 ;
+4 ; Modified - IHS/MSC/PLS - 03/28/2016 - Line SELECT+30
+5 ;
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 ;IHS/MSC/PLS - 03/28/2016 - CR5951
+31 IF $$ERXONLY^APSPFNC6(+Y)
Begin DoDot:1
+32 WRITE !,"Drug is marked as ERX Only",*7,!
End DoDot:1
SET Y=-1
GOTO SELECT
+33 IF $GET(PSONEW("OLD VAL"))=+Y&('$GET(PSOEDIT))
SET PSODRG("QFLG")=1
+34 DO KV
KILL PSOY
SET PSOY(0)=^PSDRUG(PSDC(Y),0)
SET PSOY=PSDC(Y)_"^"_$PIECE(PSOY(0),"^")
+35 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 DIR(0)="Y"
SET DIR("B")="YES"
+3 SET DIR("A",1)="You have changed the dispense drug from"
+4 SET DIR("A",2)=$PIECE(PSOBDR("NAME"),"^")_" to "_$PIECE(PSODRUG("NAME"),"^")_"."
SET DIR("A",3)=""
+5 FOR I=0:0
SET I=$ORDER(SIG(I))
IF 'I
QUIT
SET DIR("A",3+I)=$SELECT(I=1:"Current SIG: ",1:"")_$GET(SIG(I))
+6 SET DIR("A")="Do You want to Edit the SIG"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET PSORX("DFLG")=1
DO M1^PSOOREDX
QUIT
+8 IF $DATA(DIRUT)!('Y)
QUIT
+9 ;Dose
KILL PSOBDR
DO 10^PSOBKDED
End DoDot:1
+10 QUIT
