Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSDNACT

PSDNACT.m

Go to the documentation of this file.
  1. PSDNACT ;BIR/JPW-Inactivate NAOUs ; 6 July 94
  1. ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
  1. I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
  1. W !!,?10,"Inactivate NAOUs" D NOW^%DTC S PSDT=X
  1. NAOU ;
  1. 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
  1. END K %,%H,%I,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSDA,PSDN,PSDR,PSDT,X,Y
  1. Q
  1. LOOP ;asks for inactivating drugs and loops to complete
  1. 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
  1. W !! K DA,DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to inactivate ALL stocked drugs within this NAOU"
  1. 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."
  1. D ^DIR K DIR I 'Y!$D(DIRUT) D MSG Q
  1. I '$D(^PSD(58.8,PSDA,1,0)) W !!,"There are no stocked drugs for this NAOU!!",!! Q
  1. W !!,"Inactivating all stocked drugs within "_PSDN_"..."
  1. 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 "."
  1. MSG W !!,PSDN," has been inactivated.",!
  1. Q