source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOEHA.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PSGOEHA ;BIR/CML3-HOLD (OR UNHOLD) ALL ORDERS ;31 OCT 97 / 10:17 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191
5 ; Reference to ^PSSLOCK is supported by DBIA #2789
6 ;
7 I PSGOEHA,$P(ND,"^",9)="H" D HOK^PSGOEH0 Q
8 I 'PSGOEHA,$P(ND,"^",9)'="H" D HOK^PSGOEH1
9 Q
10 ;
11 ;
12EN ;
13 D ENCV^PSGSETU I $D(XQUIT) Q
14 I 'PSJSYSU,'$P(PSJSYSP0,"^",4) W !!,"Sorry, but have not been authorized to use this option.",! S PSGP=0 G DONE
15 K PSGACT D NOW^%DTC S PSGDT=%,PSHOEHA=1 D ENP^PSGGAO I PSGP'>0 W !,"No patient chosen." G DONE
16 ;S X=PSGP_";DPT(" D LK^ORX2 G:'Y DONE
17 N PSJLK S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) G DONE
18 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."
19 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
20 I %'=1 S PSGP=0 G DONE
21 I 'PSGOEHA S DIE="^PS(55,",DA=PSGP,DR=62.11 W ! D ^DIE W !,"...a few moments, please..."
22 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
23 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!"
24 ;S X=PSGP_";DPT(" D ULK^ORX2
25 D UL^PSSLOCK(PSGP)
26 ;
27DONE ;
28 I PSGP>0,$P(PSJSYSL,"^",2)]"" S PSGOP=PSGP D ENQL^PSGLW
29 D ENKV^PSGSETU K D0,D1,ND,PSG,PSGOEHA,PSGOP,PSGORD,SD,ST,WD Q
30 ;
31HM ;
32 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
33 ;
34ENACH ;
35 K DA,PSGACT S DA(1)=PSGP,PSJACSD=$S(PSGOEHA=1:+PSJPAD,1:PSGDT),PSJACHLD=1
36 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
37 K PSJACHLD,PSJACSD Q
Note: See TracBrowser for help on using the repository browser.