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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOEHA 2094 printed Apr 09, 2024@21:07:36 Page 2
PSGOEHA ;BIR/CML3-HOLD (OR UNHOLD) ALL ORDERS ;31 OCT 97 / 10:17 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191
+4 ; Reference to ^PSSLOCK is supported by DBIA #2789
+5 ;
+6 IF PSGOEHA
IF $PIECE(ND,"^",9)="H"
DO HOK^PSGOEH0
QUIT
+7 IF 'PSGOEHA
IF $PIECE(ND,"^",9)'="H"
DO HOK^PSGOEH1
+8 QUIT
+9 ;
+10 ;
EN ;
+1 DO ENCV^PSGSETU
IF $DATA(XQUIT)
QUIT
+2 IF 'PSJSYSU
IF '$PIECE(PSJSYSP0,"^",4)
WRITE !!,"Sorry, but have not been authorized to use this option.",!
SET PSGP=0
GOTO DONE
+3 KILL PSGACT
DO NOW^%DTC
SET PSGDT=%
SET PSHOEHA=1
DO ENP^PSGGAO
IF PSGP'>0
WRITE !,"No patient chosen."
GOTO DONE
+4 ;S X=PSGP_";DPT(" D LK^ORX2 G:'Y DONE
+5 NEW PSJLK
SET PSJLK=$$L^PSSLOCK(PSGP,1)
IF 'PSJLK
WRITE !,$CHAR(7),$PIECE(PSJLK,U,2)
GOTO DONE
+6 SET PSGOEHA=$SELECT($DATA(^PS(55,PSGP,5.1)):$PIECE(^(5.1),"^",7),1:0)
WRITE !
IF PSGOEHA
WRITE !,"THIS PATIENT'S ORDERS ARE ON HOLD."
+7 FOR
WRITE !,"DO YOU WANT TO ",$SELECT('PSGOEHA:"PLACE",1:"TAKE")," THIS PATIENT'S ORDERS ",$SELECT('PSGOEHA:"ON",1:"OFF OF")," HOLD"
SET %=1
DO YN^DICN
if %
QUIT
DO HM
+8 IF %'=1
SET PSGP=0
GOTO DONE
+9 IF 'PSGOEHA
SET DIE="^PS(55,"
SET DA=PSGP
SET DR=62.11
WRITE !
DO ^DIE
WRITE !,"...a few moments, please..."
+10 FOR SD=$SELECT(PSGOEHA:PSJPAD,1:PSGDT):0
SET SD=$ORDER(^PS(55,PSGP,5,"AUS",SD))
if 'SD
QUIT
FOR PSGORD=0:0
SET PSGORD=$ORDER(^PS(55,PSGP,5,"AUS",SD,PSGORD))
if 'PSGORD
QUIT
IF $DATA(^PS(55,PSGP,5,PSGORD,0))
SET ND=^(0)
SET PSGND4=$GET(^(4))
DO PSGOEHA
+11 if '$DATA(^PS(55,PSGP,0))
DO ENSET0^PSGNE3(PSGP)
SET $PIECE(^PS(55,PSGP,5.1),"^",7)='PSGOEHA
if PSGOEHA
SET $PIECE(^(5.1),"^",10)=""
WRITE ".DONE!"
+12 ;S X=PSGP_";DPT(" D ULK^ORX2
+13 DO UL^PSSLOCK(PSGP)
+14 ;
DONE ;
+1 IF PSGP>0
IF $PIECE(PSJSYSL,"^",2)]""
SET PSGOP=PSGP
DO ENQL^PSGLW
+2 DO ENKV^PSGSETU
KILL D0,D1,ND,PSG,PSGOEHA,PSGOP,PSGORD,SD,ST,WD
QUIT
+3 ;
HM ;
+1 WRITE !!?2,"Enter a 'Y' to ",$SELECT(PSGOEHA:"take off of",1:"place on")," hold all of this patient's active orders. Enter",!,"an 'N' (or '^') to exit this option.",!
QUIT
+2 ;
ENACH ;
+1 KILL DA,PSGACT
SET DA(1)=PSGP
SET PSJACSD=$SELECT(PSGOEHA=1:+PSJPAD,1:PSGDT)
SET PSJACHLD=1
+2 FOR PSJACSD=PSJACSD:0
SET PSJACSD=$ORDER(^PS(55,PSGP,5,"AUS",PSJACSD))
if 'PSJACSD
QUIT
FOR PSGORD=0:0
SET (PSGORD,DA)=$ORDER(^PS(55,PSGP,5,"AUS",PSJACSD,PSGORD))
if 'PSGORD
QUIT
IF $DATA(^PS(55,PSGP,5,DA,0))
SET ND=^(0)
SET PSGND4=$GET(^(4))
DO PSGOEHA
+3 KILL PSJACHLD,PSJACSD
QUIT
