PSGOE92 ;BIR/CML3-ACTIVE ORDER EDIT (CONT.) ;27 Jan 98 / 9:32 AM
;;5.0; INPATIENT MEDICATIONS ;**2,35,50,58,81,110,215**;16 DEC 97;Build 3
;
;Reference to ^DD(53.1 is supported by DBIA #2256.
;Reference to ^PS(55 is supported by DBIA #2191.
;Reference to ^PSDRUG is supported by DBIA #2192.
;
1 ; provider
S MSG=0,PSGF2=1 S:PSGOEEF(PSGF2) BACK="1^PSGOE92"
A1 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"Provider may not be edited for active complex orders." D PAUSE^VALM1
W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,1) G A1
I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$D(^VA(200,PSGPR,"PS")) W:0 " "_$P(^("PS"),"^",2)_" "_$P(^("PS"),"^",3) G DONE
I X?1."?" D ENHLP^PSGOEM(55.06,1)
I $E(X)="^" D ENFF G:Y>0 @Y G A1
K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)" D ^DIC K DIC I Y'>0 G A1
S PSGPR=+Y,PSGPRN=Y(0,0) G DONE
;
5 ; self med
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"Self Med may not be edited for active complex orders." D PAUSE^VALM1
S MSG=0,PSGF2=5 S:PSGOEEF(PSGF2) BACK="5^PSGOE92" K PSGOEEF(6) S:PSGSM PSGOEEF(6)=""
A5 W !,"SELF MED: " W:PSGSM]"" $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I "01"[X,$L(X)<2 S:X]"" PSGSM=+X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G:'PSGSM DONE S PSGOEEF(6)="" G 6
I X="@" W $C(7)," (Required)" G A5
I X?1"^".E D ENFF G:Y>0 @Y G A5
I X?1."?" D ENHLP^PSGOEM(55.06,5) G A5
D YN I S PSGSM=$E(X)="Y" K PSGOEEF(6) G:'PSGSM DONE S PSGOEEF(6)="" G 6
W $C(7) D ENHLP^PSGOEM(55.06,5) G A5
;
6 ; hospital supplied self med
S MSG=0,PSGF2=6 S:PSGOEEF(PSGF2) BACK="6^PSGOE92"
A6 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"Hospital Supplied Self Med may not be edited for active complex orders." D PAUSE^VALM1
W !,"HOSPITAL SUPPLIED SELF MED: " W:PSGHSM]"" $P("NO^YES","^",PSGHSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
I "01"[X,$L(X)=1 S:X]"" PSGHSM=+X W " (",$P("NO^YES","^",PSGHSM+1),")" S MSG=0,PSGF2=5 G DONE
I X="@" W $C(7)," (Required)" G A6
I X?1"^".E D ENFF G:Y>0 @Y G A6
I X?1."?" D ENHLP^PSGOEM(55.06,6) G A6
D YN I S PSGHSM=$E(X)="Y" S MSG=0,PSGF2=5 G DONE
W $C(7) D ENHLP^PSGOEM(55.06,6) G A6
;
2 ; dispense drug multiple
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)
S MSG=0,PSGF2=2,BACK="2^PSGOE92",PSGOEEND=1
NEW PSGX,PSGXX F PSGXX=0:0 S PSGX=PSGXX,PSGXX=$O(^PS(53.45,PSJSYSP,2,PSGXX)) Q:'PSGXX
K PSGXX
N DA,DIE,DR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=".02//1;.03" D ^DIE
I '$O(^PS(53.45,PSJSYSP,2,0)) W $C(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!",! S MSG=1
D DDOC^PSGOE82(PSGX) ;* Perform allergy/adv. reaction order checks
NEW PSJDOSE
D DOSECHK^PSJDOSE
I +$G(PSJDSFLG) D DSPWARN^PSJDOSE S PSGOEEF(109)=1
; PSJ*5*215 - If Dispense Drug(s) changed, make entry in Activity Log.
; Compare the edited dispense drug information in ^PS(53.45 to the active
; order dispense drug information in ^PS(55.
S (PSJDDTMP,PSJDD55,PSJDTMP1,PSJDD551)=""
F PSJDDTMP=0:0 S PSJDDTMP=$O(^PS(53.45,PSJSYSP,2,PSJDDTMP)) Q:'PSJDDTMP D
. S PSJDDTMP(PSJDDTMP)=$G(^PS(53.45,PSJSYSP,2,PSJDDTMP,0))
. S PSJDTMP1=PSJDTMP1_"Disp Drug: "_"("_$P($G(PSJDDTMP(PSJDDTMP)),"^",1)_") "_$P($G(^PSDRUG($P($G(PSJDDTMP(PSJDDTMP)),"^",1),0)),"^")_" Units: "_$P($G(PSJDDTMP(PSJDDTMP)),"^",2)_" "
F PSJDD55=0:0 S PSJDD55=$O(^PS(55,DFN,5,+ON,1,PSJDD55)) Q:'PSJDD55 D
. S PSJDD55(PSJDD55)=$G(^PS(55,DFN,5,+ON,1,PSJDD55,0))
. S PSJDD551=PSJDD551_"Disp Drug: "_"("_$P($G(PSJDD55(PSJDD55)),"^",1)_") "_$P($G(^PSDRUG($P($G(PSJDD55(PSJDD55)),"^",1),0)),"^")_" Units: "_$P($G(PSJDD55(PSJDD55)),"^",2)_" "
; If the two temporary strings PSJDTMP1 and PSJDD551 do not match each other exactly
; then an edit has been made to the Dispense Drug Field. Make a new entry in
; the Activity Log for this order.
I PSJDTMP1'=PSJDD551 D NEWUDAL^PSGAL5(DFN,+ON,6000,"Dispense Drug",PSJDD551)
K PSGOEEND,PSJDDTMP,PSJDTMP1,PSJDD55,PSJDD551 G DONE
;
15 ; comments
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
. W !!?5,"Comments may not be edited for active complex orders." D PAUSE^VALM1
S MSG=0,PSGF2=15,BACK="15^PSGOE92",DA=PSJSYSP,DR=1,DIE="^PS(53.45," D ^DIE W ! G DONE
;
72 ; provider comments
;
DONE ;
I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
K F,F0,PSGF2,F3,PSG,SDT Q
;
ENFF ; up-arrow to another field
S Y=-1 I '$D(PSGOEEF) W $C(7)," ??" Q
S X=$E(X,2,99) I X=+X S Y=$S($D(PSGOEEF(X)):X,1:-1) W " " W:Y>0 $$CODES2^PSIVUTL(53.1,X) W:Y'>0 $C(7),"??" Q
K DIC S DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I $D(PSGOEEF(+Y))" D ^DIC K DIC S Y=+Y S:Y>0 Y=$P($T(@("F"_Y)),";",3) Q
;
DEL ; delete entry
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
Q
;
YN ; yes/no as a set of codes
I X'?.U F Y=1:1:$L(X) I $E(X,Y)?1L S X=$E(X,1,Y-1)_$C($A(X,Y)-32)_$E(X,Y+1,$L(X))
F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
Q
;
F101 ;;101^PSGOE9
F109 ;;109^PSGOE9
F3 ;;3^PSGOE9
F7 ;;7^PSGOE9
PSGF26 ;;26^PSGOE9
F41 ;;41^PSGOE91
F8 ;;8^PSGOE91
F10 ;;10^PSGOE91
F34 ;;34^PSGOE91
F1 ;;1^PSGOE92
F5 ;;5^PSGOE92
PSGF2 ;;2^PSGOE92
PSGOE92 ;BIR/CML3-ACTIVE ORDER EDIT (CONT.) ;27 Jan 98 / 9:32 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**2,35,50,58,81,110,215**;16 DEC 97;Build 3
+2 ;
+3 ;Reference to ^DD(53.1 is supported by DBIA #2256.
+4 ;Reference to ^PS(55 is supported by DBIA #2191.
+5 ;Reference to ^PSDRUG is supported by DBIA #2192.
+6 ;
1 ; provider
+1 SET MSG=0
SET PSGF2=1
IF PSGOEEF(PSGF2)
SET BACK="1^PSGOE92"
A1 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+1 WRITE !!?5,"Provider may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+2 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+3 IF $SELECT(X="":'PSGPR,1:X="@")
WRITE $CHAR(7)," (Required)"
SET X="?"
DO ENHLP^PSGOEM(55.06,1)
GOTO A1
+4 IF X=""
IF PSGPR
SET X=PSGPRN
IF PSGPR'=PSGPRN
IF $DATA(^VA(200,PSGPR,"PS"))
IF 0
WRITE " "_$PIECE(^("PS"),"^",2)_" "_$PIECE(^("PS"),"^",3)
GOTO DONE
+5 IF X?1."?"
DO ENHLP^PSGOEM(55.06,1)
+6 IF $EXTRACT(X)="^"
DO ENFF
IF Y>0
GOTO @Y
GOTO A1
+7 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="EMQZ"
SET DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)"
DO ^DIC
KILL DIC
IF Y'>0
GOTO A1
+8 SET PSGPR=+Y
SET PSGPRN=Y(0,0)
GOTO DONE
+9 ;
5 ; self med
+1 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+2 WRITE !!?5,"Self Med may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+3 SET MSG=0
SET PSGF2=5
IF PSGOEEF(PSGF2)
SET BACK="5^PSGOE92"
KILL PSGOEEF(6)
IF PSGSM
SET PSGOEEF(6)=""
A5 WRITE !,"SELF MED: "
IF PSGSM]""
WRITE $PIECE("NO^YES","^",PSGSM+1),"// "
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+1 IF "01"[X
IF $LENGTH(X)<2
IF X]""
SET PSGSM=+X
IF PSGSM]""
WRITE " (",$PIECE("NO^YES","^",PSGSM+1),")"
IF 'PSGSM
GOTO DONE
SET PSGOEEF(6)=""
GOTO 6
+2 IF X="@"
WRITE $CHAR(7)," (Required)"
GOTO A5
+3 IF X?1"^".E
DO ENFF
IF Y>0
GOTO @Y
GOTO A5
+4 IF X?1."?"
DO ENHLP^PSGOEM(55.06,5)
GOTO A5
+5 DO YN
IF $TEST
SET PSGSM=$EXTRACT(X)="Y"
KILL PSGOEEF(6)
IF 'PSGSM
GOTO DONE
SET PSGOEEF(6)=""
GOTO 6
+6 WRITE $CHAR(7)
DO ENHLP^PSGOEM(55.06,5)
GOTO A5
+7 ;
6 ; hospital supplied self med
+1 SET MSG=0
SET PSGF2=6
IF PSGOEEF(PSGF2)
SET BACK="6^PSGOE92"
A6 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+1 WRITE !!?5,"Hospital Supplied Self Med may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+2 WRITE !,"HOSPITAL SUPPLIED SELF MED: "
IF PSGHSM]""
WRITE $PIECE("NO^YES","^",PSGHSM+1),"// "
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO DONE
+3 IF "01"[X
IF $LENGTH(X)=1
IF X]""
SET PSGHSM=+X
WRITE " (",$PIECE("NO^YES","^",PSGHSM+1),")"
SET MSG=0
SET PSGF2=5
GOTO DONE
+4 IF X="@"
WRITE $CHAR(7)," (Required)"
GOTO A6
+5 IF X?1"^".E
DO ENFF
IF Y>0
GOTO @Y
GOTO A6
+6 IF X?1."?"
DO ENHLP^PSGOEM(55.06,6)
GOTO A6
+7 DO YN
IF $TEST
SET PSGHSM=$EXTRACT(X)="Y"
SET MSG=0
SET PSGF2=5
GOTO DONE
+8 WRITE $CHAR(7)
DO ENHLP^PSGOEM(55.06,6)
GOTO A6
+9 ;
2 ; dispense drug multiple
+1 IF $GET(PSGP)
IF $GET(PSGORD)
IF $$COMPLEX^PSJOE(PSGP,PSGORD)
Begin DoDot:1
+2 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)
+3 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
+4 SET MSG=0
SET PSGF2=2
SET BACK="2^PSGOE92"
SET PSGOEEND=1
+5 NEW PSGX,PSGXX
FOR PSGXX=0:0
SET PSGX=PSGXX
SET PSGXX=$ORDER(^PS(53.45,PSJSYSP,2,PSGXX))
IF 'PSGXX
QUIT
+6 KILL PSGXX
+7 NEW DA,DIE,DR
SET DIE="^PS(53.45,"
SET DA=PSJSYSP
SET DR=2
SET DR(2,53.4502)=".02//1;.03"
DO ^DIE
+8 IF '$ORDER(^PS(53.45,PSJSYSP,2,0))
WRITE $CHAR(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!",!
SET MSG=1
+9 ;* Perform allergy/adv. reaction order checks
DO DDOC^PSGOE82(PSGX)
+10 NEW PSJDOSE
+11 DO DOSECHK^PSJDOSE
+12 IF +$GET(PSJDSFLG)
DO DSPWARN^PSJDOSE
SET PSGOEEF(109)=1
+13 ; PSJ*5*215 - If Dispense Drug(s) changed, make entry in Activity Log.
+14 ; Compare the edited dispense drug information in ^PS(53.45 to the active
+15 ; order dispense drug information in ^PS(55.
+16 SET (PSJDDTMP,PSJDD55,PSJDTMP1,PSJDD551)=""
+17 FOR PSJDDTMP=0:0
SET PSJDDTMP=$ORDER(^PS(53.45,PSJSYSP,2,PSJDDTMP))
IF 'PSJDDTMP
QUIT
Begin DoDot:1
+18 SET PSJDDTMP(PSJDDTMP)=$GET(^PS(53.45,PSJSYSP,2,PSJDDTMP,0))
+19 SET PSJDTMP1=PSJDTMP1_"Disp Drug: "_"("_$PIECE($GET(PSJDDTMP(PSJDDTMP)),"^",1)_") "_$PIECE($GET(^PSDRUG($PIECE($GET(PSJDDTMP(PSJDDTMP)),"^",1),0)),"^")_" Units: "_$PIECE($GET(PSJDDTMP(PSJDDTMP)),"^",2)_" "
End DoDot:1
+20 FOR PSJDD55=0:0
SET PSJDD55=$ORDER(^PS(55,DFN,5,+ON,1,PSJDD55))
IF 'PSJDD55
QUIT
Begin DoDot:1
+21 SET PSJDD55(PSJDD55)=$GET(^PS(55,DFN,5,+ON,1,PSJDD55,0))
+22 SET PSJDD551=PSJDD551_"Disp Drug: "_"("_$PIECE($GET(PSJDD55(PSJDD55)),"^",1)_") "_$PIECE($GET(^PSDRUG($PIECE($GET(PSJDD55(PSJDD55)),"^",1),0)),"^")_" Units: "_$PIECE($GET(PSJDD55(PSJDD55)),"^",2)_" "
End DoDot:1
+23 ; If the two temporary strings PSJDTMP1 and PSJDD551 do not match each other exactly
+24 ; then an edit has been made to the Dispense Drug Field. Make a new entry in
+25 ; the Activity Log for this order.
+26 IF PSJDTMP1'=PSJDD551
DO NEWUDAL^PSGAL5(DFN,+ON,6000,"Dispense Drug",PSJDD551)
+27 KILL PSGOEEND,PSJDDTMP,PSJDTMP1,PSJDD55,PSJDD551
GOTO DONE
+28 ;
15 ; comments
+1 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+2 WRITE !!?5,"Comments may not be edited for active complex orders."
DO PAUSE^VALM1
End DoDot:1
GOTO DONE
+3 SET MSG=0
SET PSGF2=15
SET BACK="15^PSGOE92"
SET DA=PSJSYSP
SET DR=1
SET DIE="^PS(53.45,"
DO ^DIE
WRITE !
GOTO DONE
+4 ;
72 ; provider comments
+1 ;
DONE ;
+1 IF PSGOEE
IF 'PSGOEEF(PSGF2)
GOTO @BACK
SET PSGOEE=PSGOEEF(PSGF2)
+2 KILL F,F0,PSGF2,F3,PSG,SDT
QUIT
+3 ;
ENFF ; up-arrow to another field
+1 SET Y=-1
IF '$DATA(PSGOEEF)
WRITE $CHAR(7)," ??"
QUIT
+2 SET X=$EXTRACT(X,2,99)
IF X=+X
SET Y=$SELECT($DATA(PSGOEEF(X)):X,1:-1)
WRITE " "
IF Y>0
WRITE $$CODES2^PSIVUTL(53.1,X)
IF Y'>0
WRITE $CHAR(7),"??"
QUIT
+3 KILL DIC
SET DIC="^DD(53.1,"
SET DIC(0)="QEM"
SET DIC("S")="I $D(PSGOEEF(+Y))"
DO ^DIC
KILL DIC
SET Y=+Y
IF Y>0
SET Y=$PIECE($TEXT(@("F"_Y)),";",3)
QUIT
+4 ;
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
+3 ;
YN ; yes/no as a set of codes
+1 IF X'?.U
FOR Y=1:1:$LENGTH(X)
IF $EXTRACT(X,Y)?1L
SET X=$EXTRACT(X,1,Y-1)_$CHAR($ASCII(X,Y)-32)_$EXTRACT(X,Y+1,$LENGTH(X))
+2 FOR Y="NO","YES"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
QUIT
+3 QUIT
+4 ;
F101 ;;101^PSGOE9
F109 ;;109^PSGOE9
F3 ;;3^PSGOE9
F7 ;;7^PSGOE9
PSGF26 ;;26^PSGOE9
F41 ;;41^PSGOE91
F8 ;;8^PSGOE91
F10 ;;10^PSGOE91
F34 ;;34^PSGOE91
F1 ;;1^PSGOE92
F5 ;;5^PSGOE92
PSGF2 ;;2^PSGOE92
