PSJDCHK ;BIR/MLM-ORDER CHECKS FOR DRUG SELECTION ;24 NOV 97 / 1:27 PM
;;5.0; INPATIENT MEDICATIONS ;**81,91**;16 DEC 97
;
; Reference to ^PS(51.2 is supported by DBIA 2178.
; Reference to ^PS(52.6 is supported by DBIA 1231.
; Reference to ^PS(52.7 is supported by DBIA 2173.
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^PSDRUG( is supported by DBIA 2192.
; Reference to ^PSOORDRG is supported by DBIA #2190.
; Reference to ^PSOORRL is supported by DBIA #2400.
; Reference to ^PSD(58.8 is supported by DBIA 2283.
; Reference to ^PSI(58.1 is supported by DBIA 2284.
;
START ;
;
END ; used by DRUG (55.06,101 & 53.1,101) x-refs to warn user if patient is receiving or about to receive the drug just ordered
Q:$D(PSJHLSKP)
N Z,ZZ I $G(PSJPWD)&($P($G(PSJSYSU),";")=3)&($G(PSGDRG)) I ($D(^PSI(58.1,"D",PSGDRG,PSJPWD)))!($D(^PSD(58.8,"D",PSGDRG,PSJPWD))) W !?25,"*** A WARD STOCK ITEM ***"
;I $G(^DPT(+PSGP,"PI"))="Y",$D(^("PG",PSGX)) W $C(7),$C(7),!!?7,"*** WARNING! THIS PATIENT IS LISTED AS REACTING TO THIS DRUG! ***",!
Q
ENDDC(PSGP,PSJDD) ; Perform Duplicate Drug, Duplicate Class,
; Drug-Drug interaction check, Drug-Allergy interaction check.
D END,EN^PSOORDRG(PSGP,PSJDD) K PSJPDRG S Y=1,X="" S DFN=PSGP
I $O(^TMP($J,"DD",0)) D
.W !,"This patient is already receiving this medication in the following orders:",!,"this drug.",!
.F INDEX=0:0 S INDEX=$O(^TMP($J,"DD",INDEX)) Q:'INDEX S ND=$G(^TMP($J,"DD",INDEX)),ON=$P(ND,U,3),TYPE=$P(ON,";",2) D OEL^PSOORRL(PSGP,ON) D @TYPE
Q
O ; Display OP order.
W !,"Outpatient display goes here",!
Q
I ; Display UD order.
W !,"Inpatient Order Display goes here",!
Q
S ND=$P($G(^TMP($J,"PS",0)),"^")
I $D(^TMP($J,"PS","A"))!($D(^TMP($J,"PS","B"))) D
.F X=0:0 S X=$O(^TMP($J,"PS","A",X)) Q:'X D
..S Y=$G(^TMP($J,"PS","A",X,0)) I Y W !,?10,$P(Y,U)," ",$P(Y,U,2) W:$P(Y,U,3) "(",$P(Y,U,3),")"
..W !,?10,$P(ND,U),!,?13,"Give: "
.F X=0:0 S X=$O(^TMP($J,"DI",X)) Q:'X D
..S ND=$G(^TMP($J,"DI",X,0)) W $P(ND,U,2)," (",$P(ND,U,4),")",!
;
CONT ; Ask user if they wish to continue in spite of an order check.
Q:'$D(PSJPDRG) S DIR(0)="Y",DIR("A")="Do you wish to continue entering this order",DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order,"
S DIR("?")="or ""Y"" to continue with the order entry process." D ^DIR S:'Y Y=-1,X="^"
Q
;
SF ;
S Y=+Y,ND=$G(^PSDRUG(Y,0)),PSGID=+$G(^("I")) I PSGID W !!,"THIS DRUG IS INACTIVE AS OF ",$E($$ENDTC^PSGMI(PSGID),1,8)
W !!,$S($P(ND,"^",9):"NON-",1:""),"FORMULARY ITEM" W:$P(ND,"^",10)]"" !,$P(ND,"^",10)
S ND=$P($G(^PSDRUG(Y,2)),"^",3)["U" W !,$P("NOT^","^",ND+1)," A UNIT DOSE DRUG" W ! S ND=$G(^(8)),N5=$G(^(8.5)) W !?2,$$CODES2^PSIVUTL(50,62.01),": " I ND W $P(ND,"^")
W !?10,$$CODES2^PSIVUTL(50,62.02),": " I $P(ND,"^",2) W $S($D(^PS(51.2,$P(ND,"^",2),0)):$P(^(0),"^"),1:$P(ND,"^",2))
W !?6,$$CODES2^PSIVUTL(50,62.03),": " I $P(ND,"^",3)]"" W $$CODES^PSIVUTL($P(ND,"^",3),50,62.03)
W !?11,$$CODES2^PSIVUTL(50,62.04),": " I $P(ND,"^",4)]"" W $P(ND,"^",4)
W !,$$CODES2^PSIVUTL(50,62.05),": " I $P(ND,"^",5) W $S('$D(^PSDRUG(+$P(ND,"^",5),0)):$P(ND,"^",5),$P(^(0),"^")]"":$P(^(0),"^"),1:$P(ND,"^",5))
W !?17,$$CODES2^PSIVUTL(50,212.2),": " I $P(N5,"^",2)]"" W $P(N5,"^",2)
Q:'$$CODES2^PSIVUTL(50,212) W !?17,$$CODES2^PSIVUTL(50,212),": " D
. F Q=0:0 S Q=$O(^PSDRUG(Y,212,Q)) Q:'Q S ND=$G(^(Q,0)) I ND,$P(ND,"^",2) W ?31,$S('$D(^PS(57.5,+ND,0)):+ND_";PS(57.5,",$P(^(0),"^")]"":$P(^(0),"^"),1:+ND_";PS(57.5,"),?56,$P(ND,"^",2),!
Q
;
PDWCHK(DFN,ON) ; Print Dup Drug order.
N ND,ND0,ND2,X
;W:'$D(PSJDCHK) $C(7),$C(7),!!,"WARNING! THIS PATIENT HAS THE FOLLOWING ORDER(S) FOR THIS MEDICATION:",!!
;I ON["V" D DISPIV Q
F DRG=0:0 S DRG=$O(^PS(55,DFN,"IV",+ON,"AD",DRG)) Q:'DRG D
. S ND=$$DRUGNAME^PSJLMUTL(DFN,ON)
S F=$S(ON["P":"^PS(53.1,",1:"^PS(55,"_DFN_",5,"),ND0=$G(@(F_+ON_",0)")),ND2=$G(^(2)),X=$P(ND,U,2),X=$S(X=.2:$P($G(^(.2)),U,2),1:$G(^(.3)))
W ?10,$P(ND,U),!,?13,"Give: ",X," ",$$ENMRN^PSGMI(+$P(ND0,U,3))," ",$P(ND2,U),!!
Q
;
DISPUD(DFN,ON) ;
I ON["P",(TYPE="F") ;D DISPPF(DFN,ON) Q
S F=$S(ON["P":"^PS(53.1,",1:"^PS(55,"_DFN_",5,"),DN=$$DRUGNAME^PSJLMUTL(DFN,ON)
S ND0=$G(@(F_+ON_",0)")),TYPE=$P(ND0,U,4),ND2=$G(^(2))
S X=$P(DN,U,2),LINE=$S(X=".2":$P($G(@(F_+ON_",.2)")),U,2),X=.3:$P($G(@(F_+ON_".3)")),U),1:"")
W !,?10,$P(DN,U),!,13,"Give: ",LINE," ",$$ENMRA^PSGMI(+$P(ND0,U,3))," ",$P(ND2,U),!!
Q
;
DISPIV(DFN,ON) ; Display condensed IV order display.
N AD,SOL
F AD=0:0 S AD=$O(^PS(55,DFN,"IV",+ON,"AD",AD)) Q:'AD D
.S ND=$G(^PS(55,DFN,"IV",+ON,"AD",AD,0)),DRG=$P($G(^PS(52.6,+ND,0)),U),AMT=$P(ND,U,2),BOT=$P(ND,U,3)
.W !,PAD," ",AMT W:BOT "(",BOT,")"
F SOL=0:0 S SOL=$O(^PS(55,"IV",+ON,"SOL",SOL)) Q:'SOL D
.S ND=$G(^PS(55,DFN,"IV",+ON,"SOL",SOL,0)),DRG=$P($G(^PS(52.7,+ND,0)),U),AMT=$P(ND,U,2)
.W !,$S(FIRST:"in",1:" "),$P(DRG,U)," ",$P(DRG,U,2)
Q
PSJDCHK ;BIR/MLM-ORDER CHECKS FOR DRUG SELECTION ;24 NOV 97 / 1:27 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**81,91**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(51.2 is supported by DBIA 2178.
+4 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+5 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+6 ; Reference to ^PS(55 is supported by DBIA 2191.
+7 ; Reference to ^PSDRUG( is supported by DBIA 2192.
+8 ; Reference to ^PSOORDRG is supported by DBIA #2190.
+9 ; Reference to ^PSOORRL is supported by DBIA #2400.
+10 ; Reference to ^PSD(58.8 is supported by DBIA 2283.
+11 ; Reference to ^PSI(58.1 is supported by DBIA 2284.
+12 ;
START ;
+1 ;
END ; used by DRUG (55.06,101 & 53.1,101) x-refs to warn user if patient is receiving or about to receive the drug just ordered
+1 IF $DATA(PSJHLSKP)
QUIT
+2 NEW Z,ZZ
IF $GET(PSJPWD)&($PIECE($GET(PSJSYSU),";")=3)&($GET(PSGDRG))
IF ($DATA(^PSI(58.1,"D",PSGDRG,PSJPWD)))!($DATA(^PSD(58.8,"D",PSGDRG,PSJPWD)))
WRITE !?25,"*** A WARD STOCK ITEM ***"
+3 ;I $G(^DPT(+PSGP,"PI"))="Y",$D(^("PG",PSGX)) W $C(7),$C(7),!!?7,"*** WARNING! THIS PATIENT IS LISTED AS REACTING TO THIS DRUG! ***",!
+4 QUIT
ENDDC(PSGP,PSJDD) ; Perform Duplicate Drug, Duplicate Class,
+1 ; Drug-Drug interaction check, Drug-Allergy interaction check.
+2 DO END
DO EN^PSOORDRG(PSGP,PSJDD)
KILL PSJPDRG
SET Y=1
SET X=""
SET DFN=PSGP
+3 IF $ORDER(^TMP($JOB,"DD",0))
Begin DoDot:1
+4 WRITE !,"This patient is already receiving this medication in the following orders:",!,"this drug.",!
+5 FOR INDEX=0:0
SET INDEX=$ORDER(^TMP($JOB,"DD",INDEX))
IF 'INDEX
QUIT
SET ND=$GET(^TMP($JOB,"DD",INDEX))
SET ON=$PIECE(ND,U,3)
SET TYPE=$PIECE(ON,";",2)
DO OEL^PSOORRL(PSGP,ON)
DO @TYPE
End DoDot:1
+6 QUIT
O ; Display OP order.
+1 WRITE !,"Outpatient display goes here",!
+2 QUIT
I ; Display UD order.
+1 WRITE !,"Inpatient Order Display goes here",!
+2 QUIT
+3 SET ND=$PIECE($GET(^TMP($JOB,"PS",0)),"^")
+4 IF $DATA(^TMP($JOB,"PS","A"))!($DATA(^TMP($JOB,"PS","B")))
Begin DoDot:1
+5 FOR X=0:0
SET X=$ORDER(^TMP($JOB,"PS","A",X))
IF 'X
QUIT
Begin DoDot:2
+6 SET Y=$GET(^TMP($JOB,"PS","A",X,0))
IF Y
WRITE !,?10,$PIECE(Y,U)," ",$PIECE(Y,U,2)
IF $PIECE(Y,U,3)
WRITE "(",$PIECE(Y,U,3),")"
+7 WRITE !,?10,$PIECE(ND,U),!,?13,"Give: "
End DoDot:2
+8 FOR X=0:0
SET X=$ORDER(^TMP($JOB,"DI",X))
IF 'X
QUIT
Begin DoDot:2
+9 SET ND=$GET(^TMP($JOB,"DI",X,0))
WRITE $PIECE(ND,U,2)," (",$PIECE(ND,U,4),")",!
End DoDot:2
End DoDot:1
+10 ;
CONT ; Ask user if they wish to continue in spite of an order check.
+1 IF '$DATA(PSJPDRG)
QUIT
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue entering this order"
SET DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order,"
+2 SET DIR("?")="or ""Y"" to continue with the order entry process."
DO ^DIR
IF 'Y
SET Y=-1
SET X="^"
+3 QUIT
+4 ;
SF ;
+1 SET Y=+Y
SET ND=$GET(^PSDRUG(Y,0))
SET PSGID=+$GET(^("I"))
IF PSGID
WRITE !!,"THIS DRUG IS INACTIVE AS OF ",$EXTRACT($$ENDTC^PSGMI(PSGID),1,8)
+2 WRITE !!,$SELECT($PIECE(ND,"^",9):"NON-",1:""),"FORMULARY ITEM"
IF $PIECE(ND,"^",10)]""
WRITE !,$PIECE(ND,"^",10)
+3 SET ND=$PIECE($GET(^PSDRUG(Y,2)),"^",3)["U"
WRITE !,$PIECE("NOT^","^",ND+1)," A UNIT DOSE DRUG"
WRITE !
SET ND=$GET(^(8))
SET N5=$GET(^(8.5))
WRITE !?2,$$CODES2^PSIVUTL(50,62.01),": "
IF ND
WRITE $PIECE(ND,"^")
+4 WRITE !?10,$$CODES2^PSIVUTL(50,62.02),": "
IF $PIECE(ND,"^",2)
WRITE $SELECT($DATA(^PS(51.2,$PIECE(ND,"^",2),0)):$PIECE(^(0),"^"),1:$PIECE(ND,"^",2))
+5 WRITE !?6,$$CODES2^PSIVUTL(50,62.03),": "
IF $PIECE(ND,"^",3)]""
WRITE $$CODES^PSIVUTL($PIECE(ND,"^",3),50,62.03)
+6 WRITE !?11,$$CODES2^PSIVUTL(50,62.04),": "
IF $PIECE(ND,"^",4)]""
WRITE $PIECE(ND,"^",4)
+7 WRITE !,$$CODES2^PSIVUTL(50,62.05),": "
IF $PIECE(ND,"^",5)
WRITE $SELECT('$DATA(^PSDRUG(+$PIECE(ND,"^",5),0)):$PIECE(ND,"^",5),$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:$PIECE(ND,"^",5))
+8 WRITE !?17,$$CODES2^PSIVUTL(50,212.2),": "
IF $PIECE(N5,"^",2)]""
WRITE $PIECE(N5,"^",2)
+9 IF '$$CODES2^PSIVUTL(50,212)
QUIT
WRITE !?17,$$CODES2^PSIVUTL(50,212),": "
Begin DoDot:1
+10 FOR Q=0:0
SET Q=$ORDER(^PSDRUG(Y,212,Q))
IF 'Q
QUIT
SET ND=$GET(^(Q,0))
IF ND
IF $PIECE(ND,"^",2)
WRITE ?31,$SELECT('$DATA(^PS(57.5,+ND,0)):+ND_";PS(57.5,",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:+ND_";PS(57.5,"),?56,$PIECE(ND,"^",2),!
End DoDot:1
+11 QUIT
+12 ;
PDWCHK(DFN,ON) ; Print Dup Drug order.
+1 NEW ND,ND0,ND2,X
+2 ;W:'$D(PSJDCHK) $C(7),$C(7),!!,"WARNING! THIS PATIENT HAS THE FOLLOWING ORDER(S) FOR THIS MEDICATION:",!!
+3 ;I ON["V" D DISPIV Q
+4 FOR DRG=0:0
SET DRG=$ORDER(^PS(55,DFN,"IV",+ON,"AD",DRG))
IF 'DRG
QUIT
Begin DoDot:1
+5 SET ND=$$DRUGNAME^PSJLMUTL(DFN,ON)
End DoDot:1
+6 SET F=$SELECT(ON["P":"^PS(53.1,",1:"^PS(55,"_DFN_",5,")
SET ND0=$GET(@(F_+ON_",0)"))
SET ND2=$GET(^(2))
SET X=$PIECE(ND,U,2)
SET X=$SELECT(X=.2:$PIECE($GET(^(.2)),U,2),1:$GET(^(.3)))
+7 WRITE ?10,$PIECE(ND,U),!,?13,"Give: ",X," ",$$ENMRN^PSGMI(+$PIECE(ND0,U,3))," ",$PIECE(ND2,U),!!
+8 QUIT
+9 ;
DISPUD(DFN,ON) ;
+1 ;D DISPPF(DFN,ON) Q
IF ON["P"
IF (TYPE="F")
+2 SET F=$SELECT(ON["P":"^PS(53.1,",1:"^PS(55,"_DFN_",5,")
SET DN=$$DRUGNAME^PSJLMUTL(DFN,ON)
+3 SET ND0=$GET(@(F_+ON_",0)"))
SET TYPE=$PIECE(ND0,U,4)
SET ND2=$GET(^(2))
+4 SET X=$PIECE(DN,U,2)
SET LINE=$SELECT(X=".2":$PIECE($GET(@(F_+ON_",.2)")),U,2),X=.3:$PIECE($GET(@(F_+ON_".3)")),U),1:"")
+5 WRITE !,?10,$PIECE(DN,U),!,13,"Give: ",LINE," ",$$ENMRA^PSGMI(+$PIECE(ND0,U,3))," ",$PIECE(ND2,U),!!
+6 QUIT
+7 ;
DISPIV(DFN,ON) ; Display condensed IV order display.
+1 NEW AD,SOL
+2 FOR AD=0:0
SET AD=$ORDER(^PS(55,DFN,"IV",+ON,"AD",AD))
IF 'AD
QUIT
Begin DoDot:1
+3 SET ND=$GET(^PS(55,DFN,"IV",+ON,"AD",AD,0))
SET DRG=$PIECE($GET(^PS(52.6,+ND,0)),U)
SET AMT=$PIECE(ND,U,2)
SET BOT=$PIECE(ND,U,3)
+4 WRITE !,PAD," ",AMT
IF BOT
WRITE "(",BOT,")"
End DoDot:1
+5 FOR SOL=0:0
SET SOL=$ORDER(^PS(55,"IV",+ON,"SOL",SOL))
IF 'SOL
QUIT
Begin DoDot:1
+6 SET ND=$GET(^PS(55,DFN,"IV",+ON,"SOL",SOL,0))
SET DRG=$PIECE($GET(^PS(52.7,+ND,0)),U)
SET AMT=$PIECE(ND,U,2)
+7 WRITE !,$SELECT(FIRST:"in",1:" "),$PIECE(DRG,U)," ",$PIECE(DRG,U,2)
End DoDot:1
+8 QUIT
