PSDNARC.m

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

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