PSGOEH1 ;BIR/CML3-PLACE (OR MARK TO BE PLACED) ORDERS ON HOLD ;30 OCT 97 / 4:03 PM
;;5.0;INPATIENT MEDICATIONS ;**426**;16 DEC 97;Build 4
;
S ND=$G(^PS(55,PSGP,5,+PSGORD,0)),PSGND4=$G(^(4)) I 'PSJSYSU,'$P(PSJSYSP0,"^",4) D MARK G DONE
F W !!,"Do you wish to place this order 'ON HOLD'" S %=1 D YN^DICN Q:% D HM
G DONE:%'=1
S PSJNOO=$$ENNOO^PSJUTL5("H") S %=$S(PSJNOO<0:0,1:1)
G HOK:%=1,DONE:'$P(PSGND4,"^",18)!'$P(PSGND4,"^",19) F W !!,"This order has been marked for hold. Do you want to unmark it" S %=2 D YN^DICN Q:% D UM
I %=1 K DA S $P(PSGND4,"^",18,20)="^^",PSGAL("C")=21081+PSJSYSU,DA(1)=PSGP,DA=+PSGORD D ^PSGAL5
G DONE
;
HOK ;
D NOW^%DTC S PSGDT=% W:'$D(PSJACHLD) "." S $P(PSGND4,"^",18,20)="1^^"_PSGDT,$P(PSGND4,"^",22,24)="^^",$P(PSGND4,"^",21)=$S($P(ND,"^",9)]"":$P(ND,"^",9),1:"A")
I PSJSYSU,$P(PSGND4,"^",+PSJSYSU=1*2+1),$P(PSGND4,"^",15),'$P(PSGND4,"^",16) S $P(PSGND4,"^",15,17)="^^"
S PSGAL("C")=PSJSYSU*10+8500,PSGALR=41,DIE="^PS(55,"_PSGP_",5,",DA=+PSGORD,DA(1)=PSGP,DR=$S($D(PSGACT):"15;",1:"")_"28////H"
W:'$D(PSJACHLD) "." D ^PSGAL5 W:'$D(PSJACHLD) "." D ^DIE W:'$D(PSJACHLD) "."
S PSOC=$S('$G(EXPF):"OH",1:"SC") D EN1^PSJHL2(PSGP,PSOC,PSGORD)
S ^PS(55,"AUE",PSGP,+PSGORD)="" I PSJSYSL,$S(PSJSYSL<3:1,1:$P(PSGND4,"^",+PSJSYSU'=3+9)) S $P(^PS(55,PSGP,5,+PSGORD,7),"^",1,2)=PSGDT_"^H1",PSGTOL=2,PSGUOW=DUZ,PSGTOO=1 D ENL^PSGVDS
;Removes Nurse Verification + Updating PSGND4 because it gets set at DONE below - PSJ-426
D DELNV^PSJUTL3(PSGP,PSGORD) S:$G(PSGND4)'="" $P(PSGND4,"^",1,2)="^",$P(PSGND4,"^",10)=""
I $D(PSJSYSO) S PSGORD=+PSGORD_"A",PSGPOSA="H",PSGPOSD=PSGDT D ENPOS^PSGVDS
I '$D(PSJACHLD) S PSGCANFL=-1
;
DONE ;
S:PSGND4]"" ^PS(55,PSGP,5,+PSGORD,4)=PSGND4
I $G(PSJLMPRO) K DIR S DIR(0)="E" D ^DIR
K DA,DIE,DIR,DP,DR,H,PSGAL,PSGALR,PSGND4,PSGPOSA,PSGPOSD,PSGTOL,PSGTOO,PSGUOW Q
;
MARK ;
I $P(PSGND4,"^",18),$P(PSGND4,"^",19) W $C(7),!!,"THIS ORDER HAS ALREADY BEEN MARKED." Q
K DA S $P(PSGND4,"^",18,20)="1^"_DUZ_"^"_PSGDT,PSGAL("C")=13081,DA(1)=PSGP,DA=+PSGORD D ^PSGAL5
W !,"ORDER MARKED TO BE PLACED ON HOLD."
Q
;
HM ;
W !!,"Enter a 'Y' to place this order on hold. Enter an 'N' (or '^') if you do not wish to place this order on hold." Q
;
UM ;
I H'?1."?" W $C(7)," ??" Q
W !!,"Enter a 'Y' to unmark this order. Enter an 'N' (or '^') to leave it as is." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOEH1 2375 printed Dec 13, 2024@02:02:13 Page 2
PSGOEH1 ;BIR/CML3-PLACE (OR MARK TO BE PLACED) ORDERS ON HOLD ;30 OCT 97 / 4:03 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**426**;16 DEC 97;Build 4
+2 ;
+3 SET ND=$GET(^PS(55,PSGP,5,+PSGORD,0))
SET PSGND4=$GET(^(4))
IF 'PSJSYSU
IF '$PIECE(PSJSYSP0,"^",4)
DO MARK
GOTO DONE
+4 FOR
WRITE !!,"Do you wish to place this order 'ON HOLD'"
SET %=1
DO YN^DICN
if %
QUIT
DO HM
+5 if %'=1
GOTO DONE
+6 SET PSJNOO=$$ENNOO^PSJUTL5("H")
SET %=$SELECT(PSJNOO<0:0,1:1)
+7 if %=1
GOTO HOK
if '$PIECE(PSGND4,"^",18)!'$PIECE(PSGND4,"^",19)
GOTO DONE
FOR
WRITE !!,"This order has been marked for hold. Do you want to unmark it"
SET %=2
DO YN^DICN
if %
QUIT
DO UM
+8 IF %=1
KILL DA
SET $PIECE(PSGND4,"^",18,20)="^^"
SET PSGAL("C")=21081+PSJSYSU
SET DA(1)=PSGP
SET DA=+PSGORD
DO ^PSGAL5
+9 GOTO DONE
+10 ;
HOK ;
+1 DO NOW^%DTC
SET PSGDT=%
if '$DATA(PSJACHLD)
WRITE "."
SET $PIECE(PSGND4,"^",18,20)="1^^"_PSGDT
SET $PIECE(PSGND4,"^",22,24)="^^"
SET $PIECE(PSGND4,"^",21)=$SELECT($PIECE(ND,"^",9)]"":$PIECE(ND,"^",9),1:"A")
+2 IF PSJSYSU
IF $PIECE(PSGND4,"^",+PSJSYSU=1*2+1)
IF $PIECE(PSGND4,"^",15)
IF '$PIECE(PSGND4,"^",16)
SET $PIECE(PSGND4,"^",15,17)="^^"
+3 SET PSGAL("C")=PSJSYSU*10+8500
SET PSGALR=41
SET DIE="^PS(55,"_PSGP_",5,"
SET DA=+PSGORD
SET DA(1)=PSGP
SET DR=$SELECT($DATA(PSGACT):"15;",1:"")_"28////H"
+4 if '$DATA(PSJACHLD)
WRITE "."
DO ^PSGAL5
if '$DATA(PSJACHLD)
WRITE "."
DO ^DIE
if '$DATA(PSJACHLD)
WRITE "."
+5 SET PSOC=$SELECT('$GET(EXPF):"OH",1:"SC")
DO EN1^PSJHL2(PSGP,PSOC,PSGORD)
+6 SET ^PS(55,"AUE",PSGP,+PSGORD)=""
IF PSJSYSL
IF $SELECT(PSJSYSL<3:1,1:$PIECE(PSGND4,"^",+PSJSYSU'=3+9))
SET $PIECE(^PS(55,PSGP,5,+PSGORD,7),"^",1,2)=PSGDT_"^H1"
SET PSGTOL=2
SET PSGUOW=DUZ
SET PSGTOO=1
DO ENL^PSGVDS
+7 ;Removes Nurse Verification + Updating PSGND4 because it gets set at DONE below - PSJ-426
+8 DO DELNV^PSJUTL3(PSGP,PSGORD)
if $GET(PSGND4)'=""
SET $PIECE(PSGND4,"^",1,2)="^"
SET $PIECE(PSGND4,"^",10)=""
+9 IF $DATA(PSJSYSO)
SET PSGORD=+PSGORD_"A"
SET PSGPOSA="H"
SET PSGPOSD=PSGDT
DO ENPOS^PSGVDS
+10 IF '$DATA(PSJACHLD)
SET PSGCANFL=-1
+11 ;
DONE ;
+1 if PSGND4]""
SET ^PS(55,PSGP,5,+PSGORD,4)=PSGND4
+2 IF $GET(PSJLMPRO)
KILL DIR
SET DIR(0)="E"
DO ^DIR
+3 KILL DA,DIE,DIR,DP,DR,H,PSGAL,PSGALR,PSGND4,PSGPOSA,PSGPOSD,PSGTOL,PSGTOO,PSGUOW
QUIT
+4 ;
MARK ;
+1 IF $PIECE(PSGND4,"^",18)
IF $PIECE(PSGND4,"^",19)
WRITE $CHAR(7),!!,"THIS ORDER HAS ALREADY BEEN MARKED."
QUIT
+2 KILL DA
SET $PIECE(PSGND4,"^",18,20)="1^"_DUZ_"^"_PSGDT
SET PSGAL("C")=13081
SET DA(1)=PSGP
SET DA=+PSGORD
DO ^PSGAL5
+3 WRITE !,"ORDER MARKED TO BE PLACED ON HOLD."
+4 QUIT
+5 ;
HM ;
+1 WRITE !!,"Enter a 'Y' to place this order on hold. Enter an 'N' (or '^') if you do not wish to place this order on hold."
QUIT
+2 ;
UM ;
+1 IF H'?1."?"
WRITE $CHAR(7)," ??"
QUIT
+2 WRITE !!,"Enter a 'Y' to unmark this order. Enter an 'N' (or '^') to leave it as is."
QUIT
