- 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 Feb 18, 2025@23:53:50 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