38 lines
2.0 KiB
Mathematica
38 lines
2.0 KiB
Mathematica
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
|