PSGOE81 ;BIR/CML3-NON-VERIFIED ORDER EDIT (CONT.) ;10 Mar 99 / 10:55 AM
;;5.0; INPATIENT MEDICATIONS ;**26,50,64,58,82,110,111,136**;16 DEC 97
;
39 ; admin times
S MSG=0,PSGF2=39 S:PSGOEEF(PSGF2) BACK="39^PSGOE81"
A39 I $$ODD^PSGS0(PSGS0XT) G DONE
W !,"ADMIN TIMES: "_$S(PSGAT:PSGAT_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I X="" S:(($G(PSGS0XT)="D")&'PSGS0Y) PSGOEE=0 G DONE
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A39
I PSGS0XT="D"&'$G(X) I ((",P,R,")'[(","_$G(PSGST)_",")) D G A39
.W $C(7)," ??" S X="?" W !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(53.1,39)
I X="@" D DEL G:%'=1 A39 S PSGAT="" G DONE
I X?1."?" D ENHLP^PSGOEM(53.1,39) G A39
D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,39) G A39
S (PSGS0Y,PSGAT)=X,PSGS0Y=PSGAT G DONE
;
8 ; special instructions
S MSG=0,PSGF2=8 S:PSGOEEF(PSGF2) BACK="8^PSGOE81"
A8 N DIR S DIR(0)="FO^1:180^D ^PSGSICHK",DIR("A")="SPECIAL INSTRUCTIONS",DIR("??")="^D ENHLP^PSGOEM(53.1,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^PSGOE82 G:Y>0 @Y G A8
I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,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^PSGOE82 G:Y>0 @Y G A8
I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G A8
I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
I X?1."?" D ENHLP^PSGOEM(53.1,8) G A8
D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G A8
S PSGSI=X G DONE
;
10 ; start date/time
S MSG=0,PSGF2=10 S:PSGOEEF(PSGF2) BACK="10^PSGOE81"
A10 ;
K PSGSDX N DUR,DURMIN,TMPFD
I $G(PSGORD)["P",$G(PSGP) I $$LASTREN^PSJLMPRI(PSGP,PSGORD) D Q
. W !?5,"Start Date may not be edited at this point. " D PAUSE^VALM1
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 " "_$P(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(53.1,10)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A10
NEW TMPX S TMPX=X,X1=+$G(PSGLI),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(53.1,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,PSGNESD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
I $G(PSGORD)["P",$G(PSGP) S DUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,"P",1) I DUR]"" S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN D
. S TMPFD=$$FMADD^XLFDT(PSGSD,,,DURMIN) K:(TMPFD<PSGSD) TMPFD I $G(TMPFD) S PSGFD=TMPFD,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
G DONE
;
25 ; stop date
S MSG=0,PSGF2=25 S:PSGOEEF(PSGF2) BACK="25^PSGOE81"
A25 ;
K PSGFDX
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 W25
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A25
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,25)
I X=+X,(X>0),(X'>2000000) G A25:'$$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 A25 S (PSGFDX,PSGFD,PSGNEFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) ; I $P(PSGNEDFD,"^",3)="O",PSGNESD'=PSGNEFD S PSGNESD=PSGNEFD,PSGSD=PSGFD
W25 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 EFDNV^PSJUTL
I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
Q
;
FF ; up-arrow to another field
D ENFF^PSGOEM I Y>0,Y'=39,Y'=8,Y'=10,Y'=25 S Y=Y_"^PSGOE8"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:Y=2 FB=PSGF2_"^PSGOE81"
Q
;
DEL ; delete entry
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
Q
PSGOE81 ;BIR/CML3-NON-VERIFIED ORDER EDIT (CONT.) ;10 Mar 99 / 10:55 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**26,50,64,58,82,110,111,136**;16 DEC 97
+2 ;
39 ; admin times
+1 SET MSG=0
SET PSGF2=39
IF PSGOEEF(PSGF2)
SET BACK="39^PSGOE81"
A39 IF $$ODD^PSGS0(PSGS0XT)
GOTO DONE
+1 WRITE !,"ADMIN TIMES: "_$SELECT(PSGAT:PSGAT_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+2 IF X=""
IF (($GET(PSGS0XT)="D")&'PSGS0Y)
SET PSGOEE=0
GOTO DONE
+3 IF $EXTRACT(X)="^"
DO ENFF^PSGOE82
IF Y>0
GOTO @Y
GOTO A39
+4 IF PSGS0XT="D"&'$GET(X)
IF ((",P,R,")'[(","_$GET(PSGST)_","))
Begin DoDot:1
+5 WRITE $CHAR(7)," ??"
SET X="?"
WRITE !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times."
DO ENHLP^PSGOEM(53.1,39)
End DoDot:1
GOTO A39
+6 IF X="@"
DO DEL
IF %'=1
GOTO A39
SET PSGAT=""
GOTO DONE
+7 IF X?1."?"
DO ENHLP^PSGOEM(53.1,39)
GOTO A39
+8 DO ENCHK^PSGS0
IF '$DATA(X)
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,39)
GOTO A39
+9 SET (PSGS0Y,PSGAT)=X
SET PSGS0Y=PSGAT
GOTO DONE
+10 ;
8 ; special instructions
+1 SET MSG=0
SET PSGF2=8
IF PSGOEEF(PSGF2)
SET BACK="8^PSGOE81"
A8 NEW DIR
SET DIR(0)="FO^1:180^D ^PSGSICHK"
SET DIR("A")="SPECIAL INSTRUCTIONS"
SET DIR("??")="^D ENHLP^PSGOEM(53.1,8)"
IF $GET(PSGSI)]""
SET DIR("B")=$PIECE(PSGSI,"^")
DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET PSGOEE=0
GOTO DONE
+1 IF $EXTRACT(X)=U
DO ENFF^PSGOE82
IF Y>0
GOTO @Y
GOTO A8
+2 IF X="@"
IF PSGSI=""
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,8)
GOTO A8
+3 IF X="@"
DO DEL
IF %'=1
GOTO A8
SET PSGSI=""
GOTO DONE
+4 IF Y=""
IF PSGSI=""
GOTO DONE
+5 SET PSGSI=$SELECT(Y]"":Y,1:PSGSI)
SET PSGSI=$$ENBCMA^PSJUTL("U")
GOTO DONE
+6 QUIT
+7 WRITE !,"SPECIAL INSTRUCTIONS: "_$SELECT(PSGSI]"":PSGSI_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+8 IF X=""
SET X=PSGSI
IF X=""
GOTO DONE
+9 IF $EXTRACT(X)="^"
DO ENFF^PSGOE82
IF Y>0
GOTO @Y
GOTO A8
+10 IF X="@"
IF PSGSI=""
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,8)
GOTO A8
+11 IF X="@"
DO DEL
IF %'=1
GOTO A8
SET PSGSI=""
GOTO DONE
+12 IF X?1."?"
DO ENHLP^PSGOEM(53.1,8)
GOTO A8
+13 DO ^PSGSICHK
IF '$DATA(X)
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,8)
GOTO A8
+14 SET PSGSI=X
GOTO DONE
+15 ;
10 ; start date/time
+1 SET MSG=0
SET PSGF2=10
IF PSGOEEF(PSGF2)
SET BACK="10^PSGOE81"
A10 ;
+1 KILL PSGSDX
NEW DUR,DURMIN,TMPFD
+2 IF $GET(PSGORD)["P"
IF $GET(PSGP)
IF $$LASTREN^PSJLMPRI(PSGP,PSGORD)
Begin DoDot:1
+3 WRITE !?5,"Start Date may not be edited at this point. "
DO PAUSE^VALM1
End DoDot:1
QUIT
+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 " "_$PIECE(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(53.1,10)
+8 IF $EXTRACT(X)="^"
DO ENFF^PSGOE82
IF Y>0
GOTO @Y
GOTO A10
+9 NEW TMPX
SET TMPX=X
SET X1=+$GET(PSGLI)
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(53.1,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,PSGNESD)=+Y
SET PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
+12 IF $GET(PSGORD)["P"
IF $GET(PSGP)
SET DUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,"P",1)
IF DUR]""
SET DURMIN=$$DURMIN^PSJLIVMD(DUR)
IF DURMIN
Begin DoDot:1
+13 SET TMPFD=$$FMADD^XLFDT(PSGSD,,,DURMIN)
IF (TMPFD<PSGSD)
KILL TMPFD
IF $GET(TMPFD)
SET PSGFD=TMPFD
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
End DoDot:1
+14 GOTO DONE
+15 ;
25 ; stop date
+1 SET MSG=0
SET PSGF2=25
IF PSGOEEF(PSGF2)
SET BACK="25^PSGOE81"
A25 ;
+1 KILL PSGFDX
+2 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
+3 IF X=""
IF PSGFD
WRITE " "_$PIECE(PSGFDN,"^")
GOTO W25
+4 IF $EXTRACT(X)="^"
DO ENFF^PSGOE82
IF Y>0
GOTO @Y
GOTO A25
+5 IF X="@"!(X?1."?")
IF X="@"
WRITE $CHAR(7)," (Required)"
IF X="@"
SET X="?"
DO ENHLP^PSGOEM(53.1,25)
+6 IF X=+X
IF (X>0)
IF (X'>2000000)
IF '$$ENDL^PSGDL(PSGSCH,X)
GOTO A25
KILL PSGDLS
SET PSGDL=X
WRITE " ...dose limit..."
DO ENE^PSGDL
+7 ; I $P(PSGNEDFD,"^",3)="O",PSGNESD'=PSGNEFD S PSGNESD=PSGNEFD,PSGSD=PSGFD
KILL %DT
SET %DT="ERTX"
SET %DT(0)=PSGSD
DO ^%DT
KILL %DT
IF Y'>0
GOTO A25
SET (PSGFDX,PSGFD,PSGNEFD)=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W25 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 EFDNV^PSJUTL
+3 IF PSGOEE
IF 'PSGOEEF(PSGF2)
GOTO @BACK
SET PSGOEE=PSGOEEF(PSGF2)
+4 QUIT
+5 ;
FF ; up-arrow to another field
+1 DO ENFF^PSGOEM
IF Y>0
IF Y'=39
IF Y'=8
IF Y'=10
IF Y'=25
SET Y=Y_"^PSGOE8"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2)
IF Y=2
SET FB=PSGF2_"^PSGOE81"
+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
