| [613] | 1 | PSDNARC ;BIR/JPW-Enter/Edit Narcotic Breakdown Info ; 8 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
|
|---|
| 4 | W !!,"Enter Narcotic Breakdown Unit and Package Size for Stock Drugs"
|
|---|
| 5 | S PSDS=$P(PSDSITE,U,3),PSDSN=$P(PSDSITE,U,4)
|
|---|
| 6 | I $P(PSDSITE,U,5) S PSDOUT=0 W !!,"Dispensing Site: ",PSDSN,! D DIE G END
|
|---|
| 7 | NARC ;
|
|---|
| 8 | S PSDOUT=0 K DA,DIC S DIC("B")=$P(PSDSITE,U,4)
|
|---|
| 9 | SEL ;select disp. vault in file 58.8
|
|---|
| 10 | W ! S DIC=58.8,DIC(0)="QEA",DIC("A")="Select Dispensing Site: ",DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)=""M"":1,$P(^(0),""^"",2)=""S"":1,1:0)"
|
|---|
| 11 | D ^DIC K DIC G:Y<0 END
|
|---|
| 12 | S PSDS=+Y,$P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=$P(Y,U,2)
|
|---|
| 13 | D DIE G:PSDOUT END
|
|---|
| 14 | G SEL
|
|---|
| 15 | END K DA,DIC,DIE,DR,DTOUT,DUOUT,PSDOUT,PSDS,PSDSN,PSDR,SITE,X,Y
|
|---|
| 16 | Q
|
|---|
| 17 | DIE ;edit narcotic breakdown unit and package size
|
|---|
| 18 | I '$D(^PSD(58.8,PSDS,1,0)) W !!,"There are no stocked drugs for this Dispensing Site!!",!! Q
|
|---|
| 19 | K DA,DIC W ! S DIC("W")="W:$P(^PSDRUG(Y,0),""^"",9) "" N/F"" I $P(^PSD(58.8,PSDS,1,Y,0),""^"",14)]"""",$P(^(0),""^"",14)'>DT W $C(7),"" *** INACTIVE ***"""
|
|---|
| 20 | S DA(1)=+PSDS,DIC(0)="QEAMZ",DIC="^PSD(58.8,"_PSDS_",1," D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S PSDOUT=1 Q
|
|---|
| 21 | Q:Y<0
|
|---|
| 22 | S PSDR=+Y W !!,"STOCKED DRUG: "_Y(0,0) I $P($G(^PSD(58.8,PSDS,1,PSDR,0)),"^",14)]"",$P(^(0),"^",14)'>DT W ?45," *** INACTIVE ***"
|
|---|
| 23 | K DA,DIE,DR S DIE="^PSD(58.8,"_PSDS_",1,",DA(1)=+PSDS,DA=+PSDR,DR="7;8" D ^DIE K DA,DIE,DR
|
|---|
| 24 | G DIE
|
|---|
