- PSDNACT ;BIR/JPW-Inactivate NAOUs ; 6 July 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
- W !!,?10,"Inactivate NAOUs" D NOW^%DTC S PSDT=X
- NAOU ;
- K DIC F W ! S DIC=58.8,DIC(0)="QEA",DIC("A")="Select NAOU: ",DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$P(^(0),""^"",2)'=""P""" D ^DIC K DIC Q:Y<0 S PSDA=+Y,PSDN=$P(Y,"^",2) K DA,DIE,DR S DIE=58.8,DA=+PSDA,DR="4" D ^DIE K DIE,DR D LOOP
- END K %,%H,%I,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSDA,PSDN,PSDR,PSDT,X,Y
- Q
- LOOP ;asks for inactivating drugs and loops to complete
- I $S('$D(^PSD(58.8,PSDA,"I")):1,'^("I"):1,^("I")>DT:1,1:0) W !!,"This NAOU is now ACTIVE. Use the Inactivate NAOU Stock Drug option",!,"to reactivate stocked drugs within "_PSDN_"." Q
- W !! K DA,DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to inactivate ALL stocked drugs within this NAOU"
- S DIR("?",1)="Answer 'YES' to inactivate all stocked drugs in this NAOU,",DIR("?")="answer 'NO' to leave all stocked drugs ACTIVE in this NAOU."
- D ^DIR K DIR I 'Y!$D(DIRUT) D MSG Q
- I '$D(^PSD(58.8,PSDA,1,0)) W !!,"There are no stocked drugs for this NAOU!!",!! Q
- W !!,"Inactivating all stocked drugs within "_PSDN_"..."
- F PSDR=0:0 S PSDR=$O(^PSD(58.8,PSDA,1,PSDR)) Q:'PSDR I $D(^PSD(58.8,PSDA,1,PSDR,0)) K DA,DIE,DR S DA=+PSDR,DA(1)=+PSDA,DIE="^PSD(58.8,"_PSDA_",1,",DR="13////"_PSDT_";14////O;14.5////NAOU INACTIVATED" D ^DIE K DIE,DR W "."
- MSG W !!,PSDN," has been inactivated.",!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNACT 1470 printed Feb 18, 2025@23:13:10 Page 2
- PSDNACT ;BIR/JPW-Inactivate NAOUs ; 6 July 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- +2 IF '$DATA(PSDSITE)
- DO ^PSDSET
- if '$DATA(PSDSITE)
- QUIT
- +3 WRITE !!,?10,"Inactivate NAOUs"
- DO NOW^%DTC
- SET PSDT=X
- NAOU ;
- +1 KILL DIC
- FOR
- WRITE !
- SET DIC=58.8
- SET DIC(0)="QEA"
- SET DIC("A")="Select NAOU: "
- SET DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$P(^(0),""^"",2)'=""P"""
- DO ^DIC
- KILL DIC
- if Y<0
- QUIT
- SET PSDA=+Y
- SET PSDN=$PIECE(Y,"^",2)
- KILL DA,DIE,DR
- SET DIE=58.8
- SET DA=+PSDA
- SET DR="4"
- DO ^DIE
- KILL DIE,DR
- DO LOOP
- END KILL %,%H,%I,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSDA,PSDN,PSDR,PSDT,X,Y
- +1 QUIT
- LOOP ;asks for inactivating drugs and loops to complete
- +1 IF $SELECT('$DATA(^PSD(58.8,PSDA,"I")):1,'^("I"):1,^("I")>DT:1,1:0)
- WRITE !!,"This NAOU is now ACTIVE. Use the Inactivate NAOU Stock Drug option",!,"to reactivate stocked drugs within "_PSDN_"."
- QUIT
- +2 WRITE !!
- KILL DA,DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Do you want to inactivate ALL stocked drugs within this NAOU"
- +3 SET DIR("?",1)="Answer 'YES' to inactivate all stocked drugs in this NAOU,"
- SET DIR("?")="answer 'NO' to leave all stocked drugs ACTIVE in this NAOU."
- +4 DO ^DIR
- KILL DIR
- IF 'Y!$DATA(DIRUT)
- DO MSG
- QUIT
- +5 IF '$DATA(^PSD(58.8,PSDA,1,0))
- WRITE !!,"There are no stocked drugs for this NAOU!!",!!
- QUIT
- +6 WRITE !!,"Inactivating all stocked drugs within "_PSDN_"..."
- +7 FOR PSDR=0:0
- SET PSDR=$ORDER(^PSD(58.8,PSDA,1,PSDR))
- if 'PSDR
- QUIT
- IF $DATA(^PSD(58.8,PSDA,1,PSDR,0))
- KILL DA,DIE,DR
- SET DA=+PSDR
- SET DA(1)=+PSDA
- SET DIE="^PSD(58.8,"_PSDA_",1,"
- SET DR="13////"_PSDT_";14////O;14.5////NAOU INACTIVATED"
- DO ^DIE
- KILL DIE,DR
- WRITE "."
- MSG WRITE !!,PSDN," has been inactivated.",!
- +1 QUIT