PSGOE91 ;BIR/CML3-ACTIVE ORDER EDIT (CONT.) ;10 JUL 96 / 7:54 AM
;;5.0; INPATIENT MEDICATIONS ;**50,64,58,110,111,136**;16 DEC 97
;
;Reference to ^PS(55 is supported by DBIA #2191.
;
41 ; admin times
S MSG=0,PSGF2=41 S:PSGOEEF(PSGF2) BACK="41^PSGOE91"
I $$ODD^PSGS0(PSGS0XT) G DONE
A41 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"ADMIN TIMES may not be edited for active complex orders." D PAUSE^VALM1
W !,"ADMIN TIMES: "_$S(PSGAT:PSGAT_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I X="" G DONE
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A41
I X="@",'PSGAT!(PSGS0XT="D")!(PSGSCH["@") I ((",P,R,")'[(","_$G(PSGST)_",")) D G A41
.W $C(7)," ??" S X="?" W:PSGS0XT="D"!(PSGSCH["@") !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(55.06,41)
I X="@" D DEL G:%'=1 A41 S PSGAT="" G DONE
I X?1."?" D ENHLP^PSGOEM(55.06,41) G A41
D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,41) G A41
S (PSGS0Y,PSGAT)=X G DONE
;
8 ; special instructions
S MSG=0,PSGF2=8 S:PSGOEEF(PSGF2) BACK="8^PSGOE91"
A8 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
. N X,Y,PARENT,P2ND S P2ND=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,.2)),1:$G(^PS(53.1,+PSGORD,.2))),PARENT=$P(P2ND,"^",8)
. I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
N DIR S DIR(0)="FO^1:180^D ^PSGSICHK",DIR("A")="SPECIAL INSTRUCTIONS",DIR("??")="^D ENHLP^PSGOEM(55.06,8)" S:$G(PSGSI)]"" DIR("B")=$P(PSGSI,"^") D ^DIR I $D(DUOUT)!$D(DTOUT) S PSGOEE=0 G DONE
I $E(X)=U D ENFF^PSGOE92 G:Y>0 @Y G A8
I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,8) G A8
I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
I Y="",PSGSI="" G DONE
S PSGSI=$S(Y]"":Y,1:PSGSI),PSGSI=$$ENBCMA^PSJUTL("U") G DONE
Q
W !,"SPECIAL INSTRUCTIONS: "_$S(PSGSI]"":PSGSI_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I X="" S X=PSGSI I X="" G DONE
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A8
I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,8) G A8
I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
I X?1."?" D ENHLP^PSGOEM(55.06,8) G A8
D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,8) G A8
S PSGSI=X G DONE
;
10 ; start date/time
S MSG=0,PSGF2=10 S:PSGOEEF(PSGF2) BACK="10^PSGOE91"
A10 ;
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"Start Date/Time may not be edited for active complex orders." D PAUSE^VALM1
K PSGSDX
W !,"START DATE/TIME: "_$S($P(PSGSDN,"^")]"":$P(PSGSDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I X="",PSGSD W " "_PSGSDN G DONE
I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGSD=+X,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) W " ",$P(PSGSDN,"^") G DONE
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,10)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A10
NEW TMPX S TMPX=X,X1=PSGDT,X2=-7 D C^%DTC K %DT S %DT="ERTX",%DT(0)=X,X=TMPX D ^%DT K %DT I Y'>0 D ENHLP^PSGOEM(55.06,10) G A10
I PSGFD<Y W $C(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",! S MSG=1 G A10
S (PSGSDX,PSGSD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) G DONE
;
34 ; stop date
S MSG=0,PSGF2=34 S:PSGOEEF(PSGF2) BACK="34^PSGOE91"
A34 ;
K PSGFDX
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"Stop Date/Time may not be edited for active complex orders." D PAUSE^VALM1
W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I X="",PSGFD W " "_$P(PSGFDN,"^") G W34
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A34
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,34)
I X=+X,(X>0),(X'>2000000) G A34:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D ENE^PSGDL
K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT G:Y'>0 A34 S (PSGFDX,PSGFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W34 I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! S MSG=1
;
;
DONE ;
;Display Expected First Dose;BHW;PSJ*5*136
D EFDACT^PSJUTL
I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
K F,F0,F1,PSGF2,F3,PSG,SDT Q
;
FF ; up-arrow to another field
D ENFF^PSGOEM I Y>0,Y'=41,Y'=8,Y'=10,Y'=34 S Y=Y_"^PSGOE9"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:Y=2 FB=PSGF2_"^PSGOE91"
Q
;
DEL ; delete entry
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
Q
PSGOE91 ;BIR/CML3-ACTIVE ORDER EDIT (CONT.) ;10 JUL 96 / 7:54 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**50,64,58,110,111,136**;16 DEC 97
+2 ;
+3 ;Reference to ^PS(55 is supported by DBIA #2191.
+4 ;
41 ; admin times
+1 SET MSG=0
SET PSGF2=41
IF PSGOEEF(PSGF2)
SET BACK="41^PSGOE91"
+2 IF $$ODD^PSGS0(PSGS0XT)
GOTO DONE
A41 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+1 WRITE !!?5,"ADMIN TIMES may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+2 WRITE !,"ADMIN TIMES: "_$SELECT(PSGAT:PSGAT_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+3 IF X=""
GOTO DONE
+4 IF $EXTRACT(X)="^"
DO ENFF^PSGOE92
IF Y>0
GOTO @Y
GOTO A41
+5 IF X="@"
IF 'PSGAT!(PSGS0XT="D")!(PSGSCH["@")
IF ((",P,R,")'[(","_$GET(PSGST)_","))
Begin DoDot:1
+6 WRITE $CHAR(7)," ??"
SET X="?"
IF PSGS0XT="D"!(PSGSCH["@")
WRITE !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times."
DO ENHLP^PSGOEM(55.06,41)
End DoDot:1
GOTO A41
+7 IF X="@"
DO DEL
IF %'=1
GOTO A41
SET PSGAT=""
GOTO DONE
+8 IF X?1."?"
DO ENHLP^PSGOEM(55.06,41)
GOTO A41
+9 DO ENCHK^PSGS0
IF '$DATA(X)
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(55.06,41)
GOTO A41
+10 SET (PSGS0Y,PSGAT)=X
GOTO DONE
+11 ;
8 ; special instructions
+1 SET MSG=0
SET PSGF2=8
IF PSGOEEF(PSGF2)
SET BACK="8^PSGOE91"
A8 IF $GET(PSGP)
IF $GET(PSGORD)
IF $$COMPLEX^PSJOE(PSGP,PSGORD)
Begin DoDot:1
+1 NEW X,Y,PARENT,P2ND
SET P2ND=$SELECT(PSGORD["U":$GET(^PS(55,PSGP,5,+PSGORD,.2)),1:$GET(^PS(53.1,+PSGORD,.2)))
SET PARENT=$PIECE(P2ND,"^",8)
+2 IF PARENT
DO FULL^VALM1
WRITE !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order."
DO CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
End DoDot:1
+3 NEW DIR
SET DIR(0)="FO^1:180^D ^PSGSICHK"
SET DIR("A")="SPECIAL INSTRUCTIONS"
SET DIR("??")="^D ENHLP^PSGOEM(55.06,8)"
IF $GET(PSGSI)]""
SET DIR("B")=$PIECE(PSGSI,"^")
DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET PSGOEE=0
GOTO DONE
+4 IF $EXTRACT(X)=U
DO ENFF^PSGOE92
IF Y>0
GOTO @Y
GOTO A8
+5 IF X="@"
IF PSGSI=""
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(55.06,8)
GOTO A8
+6 IF X="@"
DO DEL
IF %'=1
GOTO A8
SET PSGSI=""
GOTO DONE
+7 IF Y=""
IF PSGSI=""
GOTO DONE
+8 SET PSGSI=$SELECT(Y]"":Y,1:PSGSI)
SET PSGSI=$$ENBCMA^PSJUTL("U")
GOTO DONE
+9 QUIT
+10 WRITE !,"SPECIAL INSTRUCTIONS: "_$SELECT(PSGSI]"":PSGSI_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+11 IF X=""
SET X=PSGSI
IF X=""
GOTO DONE
+12 IF $EXTRACT(X)="^"
DO ENFF^PSGOE92
IF Y>0
GOTO @Y
GOTO A8
+13 IF X="@"
IF PSGSI=""
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(55.06,8)
GOTO A8
+14 IF X="@"
DO DEL
IF %'=1
GOTO A8
SET PSGSI=""
GOTO DONE
+15 IF X?1."?"
DO ENHLP^PSGOEM(55.06,8)
GOTO A8
+16 DO ^PSGSICHK
IF '$DATA(X)
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(55.06,8)
GOTO A8
+17 SET PSGSI=X
GOTO DONE
+18 ;
10 ; start date/time
+1 SET MSG=0
SET PSGF2=10
IF PSGOEEF(PSGF2)
SET BACK="10^PSGOE91"
A10 ;
+1 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+2 WRITE !!?5,"Start Date/Time may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+3 KILL PSGSDX
+4 WRITE !,"START DATE/TIME: "_$SELECT($PIECE(PSGSDN,"^")]"":$PIECE(PSGSDN,"^")_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+5 IF X=""
IF PSGSD
WRITE " "_PSGSDN
GOTO DONE
+6 IF X="P"
DO ENPREV^PSGDL
IF '$DATA(X)
WRITE $CHAR(7)
IF '$DATA(X)
GOTO A10
SET PSGSD=+X
SET PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
WRITE " ",$PIECE(PSGSDN,"^")
GOTO DONE
+7 IF X="@"!(X?1."?")
IF X="@"
WRITE $CHAR(7)," (Required)"
IF X="@"
SET X="?"
DO ENHLP^PSGOEM(55.06,10)
+8 IF $EXTRACT(X)="^"
DO ENFF^PSGOE92
IF Y>0
GOTO @Y
GOTO A10
+9 NEW TMPX
SET TMPX=X
SET X1=PSGDT
SET X2=-7
DO C^%DTC
KILL %DT
SET %DT="ERTX"
SET %DT(0)=X
SET X=TMPX
DO ^%DT
KILL %DT
IF Y'>0
DO ENHLP^PSGOEM(55.06,10)
GOTO A10
+10 IF PSGFD<Y
WRITE $CHAR(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",!
SET MSG=1
GOTO A10
+11 SET (PSGSDX,PSGSD)=+Y
SET PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
GOTO DONE
+12 ;
34 ; stop date
+1 SET MSG=0
SET PSGF2=34
IF PSGOEEF(PSGF2)
SET BACK="34^PSGOE91"
A34 ;
+1 KILL PSGFDX
+2 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+3 WRITE !!?5,"Stop Date/Time may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+4 WRITE !,"STOP DATE/TIME: "_$SELECT($PIECE(PSGFDN,"^")]"":$PIECE(PSGFDN,"^")_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+5 IF X=""
IF PSGFD
WRITE " "_$PIECE(PSGFDN,"^")
GOTO W34
+6 IF $EXTRACT(X)="^"
DO ENFF^PSGOE92
IF Y>0
GOTO @Y
GOTO A34
+7 IF X="@"!(X?1."?")
IF X="@"
WRITE $CHAR(7)," (Required)"
IF X="@"
SET X="?"
DO ENHLP^PSGOEM(55.06,34)
+8 IF X=+X
IF (X>0)
IF (X'>2000000)
IF '$$ENDL^PSGDL(PSGSCH,X)
GOTO A34
KILL PSGDLS
SET PSGDL=X
WRITE " ...dose limit..."
DO ENE^PSGDL
+9 KILL %DT
SET %DT="ERTX"
SET %DT(0)=PSGSD
DO ^%DT
KILL %DT
IF Y'>0
GOTO A34
SET (PSGFDX,PSGFD)=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W34 IF PSGFD<PSGDT
WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
SET MSG=1
+1 ;
+2 ;
DONE ;
+1 ;Display Expected First Dose;BHW;PSJ*5*136
+2 DO EFDACT^PSJUTL
+3 IF PSGOEE
IF 'PSGOEEF(PSGF2)
GOTO @BACK
SET PSGOEE=PSGOEEF(PSGF2)
+4 KILL F,F0,F1,PSGF2,F3,PSG,SDT
QUIT
+5 ;
FF ; up-arrow to another field
+1 DO ENFF^PSGOEM
IF Y>0
IF Y'=41
IF Y'=8
IF Y'=10
IF Y'=34
SET Y=Y_"^PSGOE9"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2)
IF Y=2
SET FB=PSGF2_"^PSGOE91"
+2 QUIT
+3 ;
DEL ; delete entry
+1 WRITE !?3,"SURE YOU WANT TO DELETE"
SET %=0
DO YN^DICN
IF %'=1
WRITE $CHAR(7)," <NOTHING DELETED>"
+2 QUIT
