- 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
