| [613] | 1 | PSODRGN ;BIR/SJA-ORDER ENTRY DRUG SELECTION ;02/15/07
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**268**;DEC 1997;Build 9
|
|---|
| 3 | ;Reference ^PSDRUG supported by DBIA 221
|
|---|
| 4 | ;
|
|---|
| 5 | SELECT ;
|
|---|
| 6 | K:'$G(PSORXED) CLOZPAT
|
|---|
| 7 | 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),"^")
|
|---|
| 8 | I $G(PSODRUG("IEN"))]"" S Y=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN")
|
|---|
| 9 | S (PSDC,PSI)=0 W !!!,"The following Drug(s) are available for selection:"
|
|---|
| 10 | 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
|
|---|
| 11 | .S PSDC=PSDC+1 W !,PSDC_". "_$P(^PSDRUG(PSI,0),"^")_$S($P(^(0),"^",9):" (N/F)",1:"")
|
|---|
| 12 | .S PSDC(PSDC)=PSI
|
|---|
| 13 | I PSDC=0 D
|
|---|
| 14 | .N X,DRG
|
|---|
| 15 | .S DRG=+$P($G(^PSRX(DA,0)),"^",6)
|
|---|
| 16 | .S X=$$GET1^DIQ(50,DRG,100)
|
|---|
| 17 | .I X'="",(DT>X) D
|
|---|
| 18 | .. W !!," This Dispense Drug is now Inactive. You may select a"
|
|---|
| 19 | .. W !," new Orderable Item, or you can enter a new Order with"
|
|---|
| 20 | .. W !," an Active Drug.",!
|
|---|
| 21 | .E W !!,"No drugs available!",!
|
|---|
| 22 | .K DIR S DIR(0)="E",DIR("A")="Press return to continue"
|
|---|
| 23 | .D ^DIR K DIR
|
|---|
| 24 | G:'PSDC ETX K PSOBDR S PSOBDR("NAME")=PSODRUG("NAME")
|
|---|
| 25 | I PSDC'=1 D
|
|---|
| 26 | .I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),"^")=$G(PSODRUG("OI")) Q
|
|---|
| 27 | .K PSODRUG("NAME"),PSODRUG("IEN")
|
|---|
| 28 | W ! D KV S DIR(0)="N^1:"_PSDC,DIR("A")="Select Drug by number" D ^DIR
|
|---|
| 29 | I $G(PSORXED),X["^" S PSORXED("DFLG")=1 G SELECTX
|
|---|
| 30 | I +$G(PSOEDIT)=1,X="^"!(X["^^")!($D(DTOUT)) S PSONEW("DFLG")=1 G SELECTX
|
|---|
| 31 | 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
|
|---|
| 32 | I +$G(PSOEDIT)=1,$D(DTOUT) S PSONEW("DFLG")=1 G SELECTX
|
|---|
| 33 | I $D(DUOUT) K DUOUT G SELECT
|
|---|
| 34 | I Y<0 G SELECT
|
|---|
| 35 | S:$G(PSONEW("OLD VAL"))=+Y&('$G(PSOEDIT)) PSODRG("QFLG")=1
|
|---|
| 36 | D KV K PSOY S PSOY(0)=^PSDRUG(PSDC(Y),0),PSOY=PSDC(Y)_"^"_$P(PSOY(0),"^")
|
|---|
| 37 | I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE
|
|---|
| 38 | SELECTX K X,Y,DTOUT,DUOUT,PSDC,PSI,PSONEW("OLD VAL")
|
|---|
| 39 | Q
|
|---|
| 40 | TRADE ;
|
|---|
| 41 | K DIR,DIC,DA,X,Y
|
|---|
| 42 | S DIR(0)="52,6.5" S:$G(PSOTRN)]"" DIR("B")=$G(PSOTRN) D ^DIR K DIR,DIC
|
|---|
| 43 | I X="@" S Y=X K DIRUT
|
|---|
| 44 | I $D(DIRUT) S:$D(DUOUT)!$D(DTOUT)&('$D(PSORX("EDIT"))) PSONEW("DFLG")=1 G TRADEX
|
|---|
| 45 | S PSODRUG("TRADE NAME")=Y
|
|---|
| 46 | TRADEX I $G(PSORXED("DFLG")),$D(DIRUT) S PSORXED("DFLG")=1
|
|---|
| 47 | K DIRUT,DTOUT,DUOUT,X,Y,DA,DR,DIE
|
|---|
| 48 | Q
|
|---|
| 49 | ETX S VALMBCK="R" I 'PSDC S VALMSG="NO dispense drugs tied to this orderable item!"
|
|---|
| 50 | TX D KV K PSDC,PSI,X,Y
|
|---|
| 51 | Q
|
|---|
| 52 | KV K DIR,DIRUT,DUOUT,DTOUT
|
|---|
| 53 | Q
|
|---|
| 54 | 6 ;Called from PSOBKDED due to it's routine size.
|
|---|
| 55 | I $G(PSOEDIT),$G(PSODRUG("NAME"))'=$G(PSOBDR("NAME")) D
|
|---|
| 56 | .S DIR(0)="Y",DIR("B")="YES"
|
|---|
| 57 | .S DIR("A",1)="You have changed the dispense drug from"
|
|---|
| 58 | .S DIR("A",2)=$P(PSOBDR("NAME"),"^")_" to "_$P(PSODRUG("NAME"),"^")_".",DIR("A",3)=""
|
|---|
| 59 | .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))
|
|---|
| 60 | .S DIR("A")="Do You want to Edit the SIG"
|
|---|
| 61 | .D ^DIR K DIR I $D(DIRUT) S PSORX("DFLG")=1 D M1^PSOOREDX Q
|
|---|
| 62 | .Q:$D(DIRUT)!('Y)
|
|---|
| 63 | .K PSOBDR D 10^PSOBKDED ;Dose
|
|---|
| 64 | Q
|
|---|
