- 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
