PSGOEHA ;BIR/CML3-HOLD (OR UNHOLD) ALL ORDERS ;31 OCT 97 / 10:17 AM
 ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97
 ;
 ; Reference to ^PS(55 is supported by DBIA 2191
 ; Reference to ^PSSLOCK is supported by DBIA #2789
 ;
 I PSGOEHA,$P(ND,"^",9)="H" D HOK^PSGOEH0 Q
 I 'PSGOEHA,$P(ND,"^",9)'="H" D HOK^PSGOEH1
 Q
 ;
 ;
EN ;
 D ENCV^PSGSETU I $D(XQUIT) Q
 I 'PSJSYSU,'$P(PSJSYSP0,"^",4) W !!,"Sorry, but have not been authorized to use this option.",! S PSGP=0 G DONE
 K PSGACT D NOW^%DTC S PSGDT=%,PSHOEHA=1 D ENP^PSGGAO I PSGP'>0 W !,"No patient chosen." G DONE
 ;S X=PSGP_";DPT(" D LK^ORX2 G:'Y DONE
 N PSJLK S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) G DONE
 S PSGOEHA=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",7),1:0) W ! I PSGOEHA W !,"THIS PATIENT'S ORDERS ARE ON HOLD."
 F  W !,"DO YOU WANT TO ",$S('PSGOEHA:"PLACE",1:"TAKE")," THIS PATIENT'S ORDERS ",$S('PSGOEHA:"ON",1:"OFF OF")," HOLD" S %=1 D YN^DICN Q:%  D HM
 I %'=1 S PSGP=0 G DONE
 I 'PSGOEHA S DIE="^PS(55,",DA=PSGP,DR=62.11 W ! D ^DIE W !,"...a few moments, please..."
 F SD=$S(PSGOEHA:PSJPAD,1:PSGDT):0 S SD=$O(^PS(55,PSGP,5,"AUS",SD)) Q:'SD  F PSGORD=0:0 S PSGORD=$O(^PS(55,PSGP,5,"AUS",SD,PSGORD)) Q:'PSGORD  I $D(^PS(55,PSGP,5,PSGORD,0)) S ND=^(0),PSGND4=$G(^(4)) D PSGOEHA
 D:'$D(^PS(55,PSGP,0)) ENSET0^PSGNE3(PSGP) S $P(^PS(55,PSGP,5.1),"^",7)='PSGOEHA S:PSGOEHA $P(^(5.1),"^",10)="" W ".DONE!"
 ;S X=PSGP_";DPT(" D ULK^ORX2
 D UL^PSSLOCK(PSGP)
 ;
DONE ;
 I PSGP>0,$P(PSJSYSL,"^",2)]"" S PSGOP=PSGP D ENQL^PSGLW
 D ENKV^PSGSETU K D0,D1,ND,PSG,PSGOEHA,PSGOP,PSGORD,SD,ST,WD Q
 ;
HM ;
 W !!?2,"Enter a 'Y' to ",$S(PSGOEHA:"take off of",1:"place on")," hold all of this patient's active orders.  Enter",!,"an 'N' (or '^') to exit this option.",! Q
 ;
ENACH ;
 K DA,PSGACT S DA(1)=PSGP,PSJACSD=$S(PSGOEHA=1:+PSJPAD,1:PSGDT),PSJACHLD=1
 F PSJACSD=PSJACSD:0 S PSJACSD=$O(^PS(55,PSGP,5,"AUS",PSJACSD)) Q:'PSJACSD  F PSGORD=0:0 S (PSGORD,DA)=$O(^PS(55,PSGP,5,"AUS",PSJACSD,PSGORD)) Q:'PSGORD  I $D(^PS(55,PSGP,5,DA,0)) S ND=^(0),PSGND4=$G(^(4)) D PSGOEHA
 K PSJACHLD,PSJACSD Q