- 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 Feb 18, 2025@23:28:38 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
