- PSDMFG ;BIR/JPW-Enter/Edit Drug Mfg/Lot #/Exp. Dates ; 8 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
- W !!,"Enter Manufacturer, Lot #, and/or Expiration Dates 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
- MFG ;
- S PSDOUT=0 K DA,DIC S DIC("B")=$P(PSDSITE,U,4)
- SEL ;select disp site
- 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 mfg/lot#/exp. date
- I '$D(^PSD(58.8,PSDS,1,0)) W !!,"There are no stocked drugs for this Dispensing Site!!",!! Q
- W ! K DA,DIC 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="9;10;11" D ^DIE K DA,DIE,DR
- G DIE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDMFG 1414 printed Feb 18, 2025@23:13:09 Page 2
- PSDMFG ;BIR/JPW-Enter/Edit Drug Mfg/Lot #/Exp. Dates ; 8 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- +2 IF '$DATA(PSDSITE)
- DO ^PSDSET
- if '$DATA(PSDSITE)
- QUIT
- +3 WRITE !!,"Enter Manufacturer, Lot #, and/or Expiration Dates 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
- MFG ;
- +1 SET PSDOUT=0
- KILL DA,DIC
- SET DIC("B")=$PIECE(PSDSITE,U,4)
- SEL ;select disp site
- +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 mfg/lot#/exp. date
- +1 IF '$DATA(^PSD(58.8,PSDS,1,0))
- WRITE !!,"There are no stocked drugs for this Dispensing Site!!",!!
- QUIT
- +2 WRITE !
- KILL DA,DIC
- 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="9;10;11"
- DO ^DIE
- KILL DA,DIE,DR
- +7 GOTO DIE