PSDNARC ;BIR/JPW-Enter/Edit Narcotic Breakdown Info ; 8 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
W !!,"Enter Narcotic Breakdown Unit and Package Size for Stock Drugs"
S PSDS=$P(PSDSITE,U,3),PSDSN=$P(PSDSITE,U,4)
I $P(PSDSITE,U,5) S PSDOUT=0 W !!,"Dispensing Site: ",PSDSN,! D DIE G END
NARC ;
S PSDOUT=0 K DA,DIC S DIC("B")=$P(PSDSITE,U,4)
SEL ;select disp. vault in file 58.8
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)"
D ^DIC K DIC G:Y<0 END
S PSDS=+Y,$P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=$P(Y,U,2)
D DIE G:PSDOUT END
G SEL
END K DA,DIC,DIE,DR,DTOUT,DUOUT,PSDOUT,PSDS,PSDSN,PSDR,SITE,X,Y
Q
DIE ;edit narcotic breakdown unit and package size
I '$D(^PSD(58.8,PSDS,1,0)) W !!,"There are no stocked drugs for this Dispensing Site!!",!! Q
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 ***"""
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
Q:Y<0
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 ***"
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
G DIE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNARC 1443 printed Nov 22, 2024@16:56:58 Page 2
PSDNARC ;BIR/JPW-Enter/Edit Narcotic Breakdown Info ; 8 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
+2 IF '$DATA(PSDSITE)
DO ^PSDSET
if '$DATA(PSDSITE)
QUIT
+3 WRITE !!,"Enter Narcotic Breakdown Unit and Package Size for Stock Drugs"
+4 SET PSDS=$PIECE(PSDSITE,U,3)
SET PSDSN=$PIECE(PSDSITE,U,4)
+5 IF $PIECE(PSDSITE,U,5)
SET PSDOUT=0
WRITE !!,"Dispensing Site: ",PSDSN,!
DO DIE
GOTO END
NARC ;
+1 SET PSDOUT=0
KILL DA,DIC
SET DIC("B")=$PIECE(PSDSITE,U,4)
SEL ;select disp. vault in file 58.8
+1 WRITE !
SET DIC=58.8
SET DIC(0)="QEA"
SET DIC("A")="Select Dispensing Site: "
SET DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)=""M"":1,$P(^(0),""^"",2)=""S"":1,1:0)"
+2 DO ^DIC
KILL DIC
if Y<0
GOTO END
+3 SET PSDS=+Y
SET $PIECE(PSDSITE,U,3)=+Y
SET $PIECE(PSDSITE,U,4)=$PIECE(Y,U,2)
+4 DO DIE
if PSDOUT
GOTO END
+5 GOTO SEL
END KILL DA,DIC,DIE,DR,DTOUT,DUOUT,PSDOUT,PSDS,PSDSN,PSDR,SITE,X,Y
+1 QUIT
DIE ;edit narcotic breakdown unit and package size
+1 IF '$DATA(^PSD(58.8,PSDS,1,0))
WRITE !!,"There are no stocked drugs for this Dispensing Site!!",!!
QUIT
+2 KILL DA,DIC
WRITE !
SET 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 ***"""
+3 SET DA(1)=+PSDS
SET DIC(0)="QEAMZ"
SET DIC="^PSD(58.8,"_PSDS_",1,"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET PSDOUT=1
QUIT
+4 if Y<0
QUIT
+5 SET PSDR=+Y
WRITE !!,"STOCKED DRUG: "_Y(0,0)
IF $PIECE($GET(^PSD(58.8,PSDS,1,PSDR,0)),"^",14)]""
IF $PIECE(^(0),"^",14)'>DT
WRITE ?45," *** INACTIVE ***"
+6 KILL DA,DIE,DR
SET DIE="^PSD(58.8,"_PSDS_",1,"
SET DA(1)=+PSDS
SET DA=+PSDR
SET DR="7;8"
DO ^DIE
KILL DA,DIE,DR
+7 GOTO DIE
