PSJOCDI ;BIR/MV - DISPLAY DRUG INTERACTION ORDER CHECKS ;6 Jun 07 / 3:37 PM
;;5.0;INPATIENT MEDICATIONS;**181,260,252,257,281**;16 DEC 97;Build 113
;Reference to ^PSODRDU2 is supported by DBIA #2189
;Reference to ^PS(55 is supported by DBIA #2191
;
DI ;
NEW PSJDN,PSJDNM,PSJMON,PSJOCLST,PSJPON,PSJSEV,PSJHDR,PSJRDI,PSJ2,PSJONFLG,PSJCRTCL,PSJSORT,PSJGROUP,PSJCLINF,PSJDXOPT
;If interception occurred, display message to user
;
;Store VUID from Remote data in PSJRDI(PSJON)=VUID.
D RDIVUID
S PSJ2=0
;Loop through drug drug order checks output
S PSJSEV="" F S PSJSEV=$O(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV)) Q:PSJSEV=""!($G(PSGORQF)) D
. S PSJDNM="" F S PSJDNM=$O(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM)) Q:PSJDNM=""!($G(PSGORQF)) D
.. S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON)) Q:PSJPON=""!($G(PSGORQF)) D
... S PSJCLINF="",PSJDXOPT=$S($G(PSJDGCK):"PROSPECTIVE",1:"PROFILE")
... S PSJCLINF="",PSJCLINF=$P($G(^TMP($J,"PSJPRE","IN",PSJDXOPT,PSJPON)),"^",7)
... F PSJDN=0:0 S PSJDN=$O(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN)) Q:'PSJDN!($G(PSGORQF)) D SORTORD
I $O(PSJOCLST(""))="" Q
D CRITICAL
D DSPLOC
I $D(^TMP($J,"PSJPRE","OUT","DRUGDRUG","S")) D
. W !,"*** REFER TO MONOGRAPH FOR SIGNIFICANT INTERACTION CLINICAL EFFECTS",!
D LINE^PSJMISC("=",81)
W !
D MON^PSJMON(.PSJMON)
D:$G(PSJONFLG)&('$D(PSJDGCK)) INTERV
Q
DSPLOC ;Display drug drug interaction - sorted by severity, prospective drug (50,.01), profile drug (VAgen name), package, seq#
NEW PSJDN,PSJDNV,PSJPON,PSJP,PSJX,X,PSJXSEV,PSJXNM,PSJXNM1,PSJXSORT,PSJXDN,PSJSORT,PSJPSPEC,PSJPROFL,PSJ2,PSJSEV,PSJHDRS,PSJDSPON,PSJCLINF
;
K PSJPAUSE
I '$G(PSJDRGIF) D PAUSE^PSJMISC(1,0) W @IOF D LINE^PSJMISC("=",81) S PSJDEFLG=1
;Get the last drug in the sort list so a '=' line is printed instead of '.'
S PSJLINE=".",PSJHDRS=""
S PSJXSEV=$O(PSJOCLST(""),-1)
S PSJXNM=$O(PSJOCLST(PSJXSEV,""),-1)
S PSJXNM1=$O(PSJOCLST(PSJXSEV,PSJXNM,""),-1)
S PSJXSORT=$O(PSJOCLST(PSJXSEV,PSJXNM,PSJXNM1,""),-1)
S PSJXDN=$O(PSJOCLST(PSJXSEV,PSJXNM,PSJXNM1,PSJXSORT,""),-1)
;
;S PSJSEV="" F S PSJSEV=$O(PSJOCLST(PSJSEV)) Q:PSJSEV="" D
;Displaying Critical orders
S PSJSEV="C"
;I $D(PSJCRTCL) D LINE^PSJMISC("=",81)
F PSJSORT=0:0 S PSJSORT=$O(PSJCRTCL(PSJSORT)) Q:'PSJSORT D
. F PSJGROUP=0:0 S PSJGROUP=$O(PSJCRTCL(PSJSORT,PSJGROUP)) Q:'PSJGROUP D
.. S X=$G(PSJCRTCL(PSJSORT,PSJGROUP))
.. D DSPCRTCL($P(X,U),$P(X,U,2))
;Displaying Significant orders
K PSJDSPON
S PSJSEV="S"
S PSJPSPEC="" F S PSJPSPEC=$O(PSJOCLST(PSJSEV,PSJPSPEC)) Q:PSJPSPEC="" D
. D LINE^PSJMISC("=",81)
. F PSJSORT=0:0 S PSJSORT=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJSORT)) Q:'PSJSORT D
.. F PSJ2=0:0 S PSJ2=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJSORT,PSJ2)) Q:'PSJ2 D
... S PSJDNV=PSJOCLST(PSJSEV,PSJPSPEC,PSJSORT,PSJ2)
... D DISPON
. W !
Q
DSPCRTCL(PSJPSPEC,PSJPROFL) ;Display Critical orders
NEW PSJSORT,PSJ2
Q:$G(PSJPSPEC)=""
Q:$G(PSJPROFL)=""
F PSJSORT=0:0 S PSJSORT=$O(PSJOCLST("C",PSJPSPEC,PSJPROFL,PSJSORT)) Q:'PSJSORT D
. F PSJ2=0:0 S PSJ2=$O(PSJOCLST("C",PSJPSPEC,PSJPROFL,PSJSORT,PSJ2)) Q:'PSJ2 D
.. S PSJDNV=PSJOCLST("C",PSJPSPEC,PSJPROFL,PSJSORT,PSJ2)
.. D DISPON
Q
DISPON ; Display orders & clin effects if applied.
I ($Y+8)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
F X=1:1:11 S PSJP(X)=$P(PSJDNV,U,X)
S PSJCLINF=$P(PSJDNV,U,12)
I ($G(PSJHDR)'=$P(PSJDNV,U,3))!(PSJHDRS'=PSJSEV) S PSJHDR=$P(PSJDNV,U,3),PSJHDRS=PSJSEV K PSJDSPON D HDR(PSJHDR)
I ($Y+8)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
I PSJSORT=10 D
. S (PSJDRGIF,PSJONFLG)=1
. I $P(PSJCLINF,";",2) D DISPCLN^PSJCLNOC(.PSJP,PSJCLINF) Q
. D DSPDRG(PSJP(4),$P(PSJDNV,U,2),PSJCLINF)
I ($Y+6)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
I PSJSORT>10 S (PSJDRGIF,PSJONFLG)=1 D ;PSJDRGIF - drug interaction displayed
. I $D(PSJDSPON($P(PSJP(4),";",2))) Q
. S PSJDSPON($P(PSJP(4),";",2))=""
. I $P($P(PSJDNV,U,12),";",2) D DISPCLN^PSJCLNOC(.PSJP,PSJCLINF) Q
. D EN^PSODRDU2(DFN,PSJP(4),"PSJPRE")
I ($Y+6)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
DISPON2 ;
I PSJSEV=PSJXSEV,(PSJPSPEC=PSJXNM),(PSJSORT=PSJXSORT),(PSJ2=PSJXDN) S PSJLINE="="
I PSJSEV="C",$$DSPLCLIN(PSJ2) D CLIN(PSJP(5),PSJP(2),PSJP(4),PSJP(1),PSJLINE)
I ($Y+6)>IOSL D PAUSE^PSJMISC() W @IOF
Q
SORTORD ;Sort drug drug output to display in order of: Inpatient, Active Rx, Remote Rx, Pending Rx, Non_VA
NEW PDJDNV,PSJX
S PSJDNV=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN))
I $E(PSJPON,1,1)'="I" D
. S PSJX=$E($P(PSJPON,";"),1,1)
. D OCLST($S(PSJX["C":10,PSJX="O":20,PSJX="R":30,PSJX="P":40,PSJX="N":50,1:""),PSJCLINF)
I $E(PSJPON,1,1)="I" D OCLST(10,PSJCLINF)
Q
OCLST(PSJ1,PSJCLINF) ;Sort orders into array to display later
;PSJOCLST(PSJSEV("C",PSJPSPEC,PSJPROFL,PSJ1-package,PSJ2)=P1...P6 (P1=SEQ NO, P2=Drug Name(Profile), P3=Drug Name(Prospective)
; (P4=Pharm order# ,P5=Severity, P6=P3 IEN)
;PSJOCLST(PSJSEV("S",PSJPSPEC,PSJ1-package,PSJ2)=P1...P12 (P1=SEQ NO, P2=Drug Name(Profile), P3=Drug Name(Prospective), P12=PSJCLINF
; (P4=Pharm order# ,P5=Severity, P6=P3 IEN)
;PSJSEV: Sort first by severity
;PSJ1: 10=PSJ Order
; 20=PSO Active Rx
; 30=Remote Rx
; 40=PSO pending
; 50=Non-VA
;PSJ2: A counter
NEW PSJDNV,PSJMONTI,PSJMONV,PSJVAGEN,PSJON1,PSJON2,PSJONFG,PSJPSPEC,PSJPROFL
Q:'$G(PSJ1)
S PSJ2=$G(PSJ2)+1
S PSJDNV=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN))
S PSJPSPEC=$P(PSJDNV,U,4) S:PSJPSPEC="" PSJPSPEC="UNKNOWN DRUG NAME"
; Criticals are grouped by profile VAGEN name and then package type
I PSJSEV="C" D
. S PSJVAGEN=$$VAGEN^PSJMISC(+$P(PSJDNV,U,3)) I PSJVAGEN="" S PSJVAGEN=PSJDNM
. S PSJOCLST(PSJSEV,PSJPSPEC,PSJVAGEN,PSJ1,PSJ2)=PSJDN_U_$G(PSJDNM)_U_$P(PSJDNV,U,4)_U_PSJPON_U_PSJSEV_U_$P(PSJDNV,U,2)_"^^^^^^"_PSJCLINF
; Significants are grouped by package type so Inpatient orders display first
I PSJSEV="S" D
. S PSJOCLST(PSJSEV,PSJPSPEC,PSJ1,PSJ2)=PSJDN_U_$G(PSJDNM)_U_$P(PSJDNV,U,4)_U_PSJPON_U_PSJSEV_U_$P(PSJDNV,U,2)_"^^^^^^"_PSJCLINF
S PSJMONTI=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN,"PMON",3,0))
S PSJMONTI=$P(PSJMONTI,"MONOGRAPH TITLE: ",2) Q:PSJMONTI=""
S PSJVAGEN=$$VAGEN^PSJMISC(+$P(PSJDNV,U,3))
I PSJVAGEN="",'+$P(PSJDNV,U,3) S PSJVAGEN=$$GENVUID^PSJMISC($G(PSJRDI(PSJPON)))
Q:PSJVAGEN=""
S PSJVAGEN=PSJVAGEN_"+"_$P(PSJDNV,U,4)
S PSJMONV=$G(PSJMON(PSJVAGEN,PSJMONTI))
I PSJMONTI]"" D
. S $P(PSJMON(PSJVAGEN,PSJMONTI),U,1,7)=PSJDN_U_$G(PSJDNM)_U_+$P(PSJDNV,U,3)_U_$P(PSJDNV,U,4)_U_+$P(PSJDNV,U,2)_U_PSJPON_U_PSJSEV
. S $P(PSJMON(PSJVAGEN,PSJMONTI),U,11)=PSJVAGEN
I PSJMONV]"" D
. I $P(PSJMONV,U,7)'=PSJSEV S $P(PSJMON(PSJVAGEN,PSJMONTI),U,9)=1
. S PSJONFG=0
. S PSJON1=$P($P(PSJMONV,U,6),";")
. S PSJON2=$P(PSJPON,";")
. I PSJON1="I",PSJON2'="I" S PSJONFG=1
. I PSJON1'="I",PSJON2="I" S PSJONFG=1
. I PSJONFG S $P(PSJMON(PSJVAGEN,PSJMONTI),U,10)=1
K PSJON1,PSJON2,PSJONFG
Q
CLIN(PSJSEV,PSJDNM,PSJPON,PSJDN,PSJLINE) ;
;No longer need to display the clinical effect for Significant
Q:PSJSEV="S"
NEW PSJCLINV,PSJNDX,PSJX
I $G(PSJLINE)="" S PSJLINE="."
F PSJDNX=0:0 S PSJDNX=$O(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDNX)) Q:'PSJDNX D
. S PSJCLINV=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDNX,"CLIN"))
. W !
. S PSJX=$P(PSJCLINV,"CLINICAL EFFECTS: ",2) I ($Y+($L(PSJX)\65)+4)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
. D WRITE^PSJMISC(PSJX)
W !
I ($Y+8)>IOSL D PAUSE^PSJMISC(0,0) W @IOF
Q
INTERV ;Log intervention. Required for Critical.
;Critical interaction MUST log an intervention before continue with the order
;Only log one intervention for a prospective drug & log it for the higher severity
NEW PSJSEV,PSJDD,PSJDN,PSJNDV,PSJTYPE,PSJINTVD,PSJPROFL
K PSJDDSV,PSJINTVD
;Required intervention for each of the prospective drug with critical interactions
F PSJSEV="C" Q:$G(PSGORQF) S PSJPSPEC="" F S PSJPSPEC=$O(PSJOCLST(PSJSEV,PSJPSPEC)) Q:PSJPSPEC="" D
. S PSJPROFL="" F S PSJPROFL=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL)) Q:PSJPROFL="" D
.. F PSJTYPE=0:0 S PSJTYPE=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJTYPE)) Q:'PSJTYPE D
... F PSJDN=0:0 S PSJDN=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJTYPE,PSJDN)) Q:'PSJDN Q:$G(PSGORQF) D
.... S PSJNDV=$G(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJTYPE,PSJDN)),PSJDD=$P(PSJNDV,U,6)
.... ;I ($P($P(PSJNDV,U,4),";",1)="I"),('$D(PSJINTVD($P(PSJNDV,U,3)))) D
.... I '$D(PSJINTVD($P(PSJNDV,U,3))) D
..... S (PSJINTVD($P(PSJNDV,U,3)))=""
..... D:'$D(PSJDGCK) RINTERV^PSJGMRA("CRITICAL DRUG INTERACTION",$P(PSJNDV,U,3))
;
; Optional intervention for each of the prospective drug(not the same as critical) with significant interactions
F PSJSEV="S" Q:$G(PSGORQF) S PSJPSPEC="" F S PSJPSPEC=$O(PSJOCLST(PSJSEV,PSJPSPEC)) Q:PSJPSPEC="" D
. F PSJTYPE=0:0 S PSJTYPE=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJTYPE)) Q:'PSJTYPE D
.. F PSJDN=0:0 S PSJDN=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJTYPE,PSJDN)) Q:'PSJDN Q:$G(PSGORQF) D
... S PSJNDV=$G(PSJOCLST(PSJSEV,PSJPSPEC,PSJTYPE,PSJDN)),PSJDD=$P(PSJNDV,U,6)
... I '$D(PSJINTVD($P(PSJNDV,U,3))) D
.... S (PSJINTVD($P(PSJNDV,U,3)))=""
.... D:'$D(PSJDGCK) INTERV^PSJGMRA("SIGNIFICANT DRUG INTERACTION",$P(PSJNDV,U,3))
Q
HDR(PSJDNM) ;Display the intro text on drug interaction
NEW PSJSTCK,PSJCNT SET PSJSTCK="",PSJCNT=0
;
IF $G(PSJDGCK) FOR SET PSJCNT=$O(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJCNT)) Q:PSJCNT=""!(PSJSTCK'="") D
.IF PSJDNM=$P(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJCNT),U,4) SET PSJSTCK=$$PSTAT(PSJCNT)
IF $G(PSJSTCK)'="" D Q
.W !,"This patient is receiving the following order(s) that have a "
.W $S($G(PSJSEV)="C":"CRITICAL",$G(PSJSEV)="S":"SIGNIFICANT",1:"")_" Drug"
.W !,"Interaction with "_$G(PSJDNM)_$G(PSJSTCK)_":",!
IF '$G(PSJDGCK) D Q
.W !,"This patient is receiving the following order(s) that have a "
.W $S($G(PSJSEV)="C":"CRITICAL",$G(PSJSEV)="S":"SIGNIFICANT",1:"")_" Drug"
.W !,"Interaction with "_$G(PSJDNM)_":",!
Q
PSTAT(PSJPONCK) ;**Display order status - CCR 5980
NEW PSJONCK,PSJCNT,PSJIND,PSJCKOS,PSJCKST
SET PSJCKOS="",PSJCKST="",PSJONCK=0,PSJCNT=0,PSJIND=""
;
Q:'$G(PSJDGCK) PSJCKST
;
IF $P(PSJPONCK,";",2)="" S PSJCKST=" (Prospective)" Q PSJCKST
IF $P(PSJPONCK,";",1)="P" S PSJCKST=" (OP Pending)" Q PSJCKST
IF $P(PSJPONCK,";",1)="O" D SET PSJCKST=" (Local Rx #"_$P(^PSRX($P(PSJPONCK,";",2),0),U,1)_" ("_PSJCKOS_"))" Q PSJCKST
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=0 SET PSJCKOS="Active" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=1 SET PSJCKOS="Non-Verified" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=2 SET PSJCKOS="Refill" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=3 SET PSJCKOS="Hold" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=4 SET PSJCKOS="Drug Interactions" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=5 SET PSJCKOS="Suspended" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=10 SET PSJCKOS="Done" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=11 SET PSJCKOS="Expired" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=12 SET PSJCKOS="Discontinued" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=13 SET PSJCKOS="Deleted" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=14 SET PSJCKOS="Discontinued by provider" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=15 SET PSJCKOS="Discontinued (Edit)" Q
.IF $P(^PSRX($P(PSJPONCK,";",2),"STA"),U,1)=16 SET PSJCKOS="Provider Hold" Q
IF $P(PSJPONCK,";",1)="N" SET PSJCKST=" (Non-VA)" Q PSJCKST
IF PSJCKST="" SET PSJCNT=$L($P(PSJPONCK,";",2)),PSJIND=$E($P(PSJPONCK,";",2),PSJCNT),PSJONCK=+$P(PSJPONCK,";",2)
IF $G(PSJIND)="P" D Q PSJCKST
.IF $P(^PS(53.1,PSJONCK,0),U,9)="A" SET PSJCKST=" (IP Active)" Q
.IF $P(^PS(53.1,PSJONCK,0),U,9)="D" SET PSJCKST=" (IP Discontinued)" Q
.IF $P(^PS(53.1,PSJONCK,0),U,9)="I" SET PSJCKST=" (IP Incomplete)" Q
.IF $P(^PS(53.1,PSJONCK,0),U,9)="N" SET PSJCKST=" (IP Non-Verified)" Q
.IF $P(^PS(53.1,PSJONCK,0),U,9)="U" SET PSJCKST=" (IP Unreleased)" Q
.IF $P(^PS(53.1,PSJONCK,0),U,9)="P" SET PSJCKST=" (IP Pending)" Q
IF $G(PSJIND)="U" D Q PSJCKST
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="A" SET PSJCKST=" (IP Active)" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="D" SET PSJCKST=" (IP Discontinued)" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="E" SET PSJCKST=" (IP Expired)" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="H" SET PSJCKST=" (IP Hold)" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="R" SET PSJCKST=" (IP Renewed)" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="RE" SET PSJCKST=" (IP Reinstated)" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="DE" SET PSJCKST=" (IP Discontinued (Edit))" Q
.IF $P(^PS(55,$G(DFN),5,PSJONCK,0),U,9)="DR" SET PSJCKST=" (IP Discontinued (Renewal))" Q
IF $G(PSJIND)="V" D Q PSJCKST
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="A" SET PSJCKST=" (IP Active)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="H" SET PSJCKST=" (IP Hold)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="R" SET PSJCKST=" (IP Renewed)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="D" SET PSJCKST=" (IP Discontinued)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="E" SET PSJCKST=" (IP Expired)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="P" SET PSJCKST=" (IP Purge)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="O" SET PSJCKST=" (IP On call)" Q
.IF $P(^PS(55,$G(DFN),"IV",PSJONCK,0),U,17)="N" SET PSJCKST=" (IP Non-Verified)" Q
Q PSJCKST
;
DSPDRG(PSJPON,PSJDNM,PSJCLINF) ;Display order info or drug name from prospective. CCR 6454
Q:$G(PSJPON)=""
;IF $G(PSJDGCK) NEW PSJSTCK SET PSJSTCK=$$PSTAT(PSJPON)
;IF $G(PSJDGCK),$G(PSJSTCK)'="" W !,?8,$G(PSJDNM)_$G(PSJSTCK),! Q
I $P(PSJPON,";",3)="PROSPECTIVE" W !?8,$G(PSJDNM)_" (Prospective)",! Q
I $D(PSJDSPON($P(PSJPON,";",2))) Q
S PSJDSPON($P(PSJPON,";",2))=""
I ($Y+8)>IOSL D PAUSE^PSJMISC(1,0) W @IOF
D DSPORD^PSJOC($P(PSJPON,";",2),"",PSJCLINF)
Q
RDIVUID ;Loop thru the "IN" global to store the VUID for remote Rx
NEW PSJPON,PSJVUID
K PSJRDI
S PSJPON=""
F S PSJPON=$O(^TMP($J,"PSJPRE","IN","PROFILE",PSJPON)) Q:PSJPON="" I $E(PSJPON,1,1)="R" D
. S PSJVUID=$P($G(^TMP($J,"PSJPRE","IN","PROFILE",PSJPON)),U,2)
. S:+PSJVUID PSJRDI(PSJPON)=PSJVUID
Q
DSPLCLIN(PSJ2) ;If the next drug on the list is diff the flag to display the clin effects.
NEW PSJCLINC,PSJCLINN,PSJDNVC,PSJDNVN,PSJPC,PSJPN,PSJ2N,PSJSORTN
I $G(PSJ2)="" Q 0
S PSJDNVC=PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2)
F X=1:1:10 S PSJPC(X)=$P(PSJDNVC,U,X)
S PSJ2N=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2))
I 'PSJ2N S PSJSORTN=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT)) Q:'PSJSORTN 1
S PSJ2N=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,0)) Q:'PSJ2N 1
S PSJDNVN=PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2N)
F X=1:1:10 S PSJPN(X)=$P(PSJDNVN,U,X)
I $S(PSJPC(5)="":1,PSJPC(2)="":1,PSJPC(4)="":1,'+PSJPC(1):1,PSJPN(5)="":1,PSJPN(2)="":1,PSJPN(4)="":1,'+PSJPN(1):1,1:0) Q 0
S PSJCLINC=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJPC(5),PSJPC(2),PSJPC(4),PSJPC(1),"CLIN"))
S PSJCLINN=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJPN(5),PSJPN(2),PSJPN(4),PSJPN(1),"CLIN"))
I (PSJCLINC'=PSJCLINN) Q 1
Q 0
CRITICAL ;
NEW PSJGROUP,PSJNEXT
S PSJGROUP=0,PSJNEXT=0
S PSJSEV="C"
S PSJPSPEC="" F S PSJPSPEC=$O(PSJOCLST(PSJSEV,PSJPSPEC)) Q:PSJPSPEC="" D
. S PSJPROFL="" F S PSJPROFL=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL)) Q:PSJPROFL="" D
.. S PSJNEXT=0
.. S PSJGROUP=PSJGROUP+1
.. F PSJSORT=0:0 S PSJSORT=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT)) Q:'PSJSORT D
... Q:PSJNEXT
... F PSJ2=0:0 S PSJ2=$O(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2)) Q:'PSJ2 D
.... Q:PSJNEXT
.... S PSJCRTCL(PSJSORT,PSJGROUP)=PSJPSPEC_U_PSJPROFL_U_$P(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2),"^",12)
.... S PSJNEXT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOCDI 15907 printed Apr 09, 2024@21:05:26 Page 2
PSJOCDI ;BIR/MV - DISPLAY DRUG INTERACTION ORDER CHECKS ;6 Jun 07 / 3:37 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**181,260,252,257,281**;16 DEC 97;Build 113
+2 ;Reference to ^PSODRDU2 is supported by DBIA #2189
+3 ;Reference to ^PS(55 is supported by DBIA #2191
+4 ;
DI ;
+1 NEW PSJDN,PSJDNM,PSJMON,PSJOCLST,PSJPON,PSJSEV,PSJHDR,PSJRDI,PSJ2,PSJONFLG,PSJCRTCL,PSJSORT,PSJGROUP,PSJCLINF,PSJDXOPT
+2 ;If interception occurred, display message to user
+3 ;
+4 ;Store VUID from Remote data in PSJRDI(PSJON)=VUID.
+5 DO RDIVUID
+6 SET PSJ2=0
+7 ;Loop through drug drug order checks output
+8 SET PSJSEV=""
FOR
SET PSJSEV=$ORDER(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV))
if PSJSEV=""!($GET(PSGORQF))
QUIT
Begin DoDot:1
+9 SET PSJDNM=""
FOR
SET PSJDNM=$ORDER(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM))
if PSJDNM=""!($GET(PSGORQF))
QUIT
Begin DoDot:2
+10 SET PSJPON=""
FOR
SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON))
if PSJPON=""!($GET(PSGORQF))
QUIT
Begin DoDot:3
+11 SET PSJCLINF=""
SET PSJDXOPT=$SELECT($GET(PSJDGCK):"PROSPECTIVE",1:"PROFILE")
+12 SET PSJCLINF=""
SET PSJCLINF=$PIECE($GET(^TMP($JOB,"PSJPRE","IN",PSJDXOPT,PSJPON)),"^",7)
+13 FOR PSJDN=0:0
SET PSJDN=$ORDER(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN))
if 'PSJDN!($GET(PSGORQF))
QUIT
DO SORTORD
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF $ORDER(PSJOCLST(""))=""
QUIT
+15 DO CRITICAL
+16 DO DSPLOC
+17 IF $DATA(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG","S"))
Begin DoDot:1
+18 WRITE !,"*** REFER TO MONOGRAPH FOR SIGNIFICANT INTERACTION CLINICAL EFFECTS",!
End DoDot:1
+19 DO LINE^PSJMISC("=",81)
+20 WRITE !
+21 DO MON^PSJMON(.PSJMON)
+22 if $GET(PSJONFLG)&('$DATA(PSJDGCK))
DO INTERV
+23 QUIT
DSPLOC ;Display drug drug interaction - sorted by severity, prospective drug (50,.01), profile drug (VAgen name), package, seq#
+1 NEW PSJDN,PSJDNV,PSJPON,PSJP,PSJX,X,PSJXSEV,PSJXNM,PSJXNM1,PSJXSORT,PSJXDN,PSJSORT,PSJPSPEC,PSJPROFL,PSJ2,PSJSEV,PSJHDRS,PSJDSPON,PSJCLINF
+2 ;
+3 KILL PSJPAUSE
+4 IF '$GET(PSJDRGIF)
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
DO LINE^PSJMISC("=",81)
SET PSJDEFLG=1
+5 ;Get the last drug in the sort list so a '=' line is printed instead of '.'
+6 SET PSJLINE="."
SET PSJHDRS=""
+7 SET PSJXSEV=$ORDER(PSJOCLST(""),-1)
+8 SET PSJXNM=$ORDER(PSJOCLST(PSJXSEV,""),-1)
+9 SET PSJXNM1=$ORDER(PSJOCLST(PSJXSEV,PSJXNM,""),-1)
+10 SET PSJXSORT=$ORDER(PSJOCLST(PSJXSEV,PSJXNM,PSJXNM1,""),-1)
+11 SET PSJXDN=$ORDER(PSJOCLST(PSJXSEV,PSJXNM,PSJXNM1,PSJXSORT,""),-1)
+12 ;
+13 ;S PSJSEV="" F S PSJSEV=$O(PSJOCLST(PSJSEV)) Q:PSJSEV="" D
+14 ;Displaying Critical orders
+15 SET PSJSEV="C"
+16 ;I $D(PSJCRTCL) D LINE^PSJMISC("=",81)
+17 FOR PSJSORT=0:0
SET PSJSORT=$ORDER(PSJCRTCL(PSJSORT))
if 'PSJSORT
QUIT
Begin DoDot:1
+18 FOR PSJGROUP=0:0
SET PSJGROUP=$ORDER(PSJCRTCL(PSJSORT,PSJGROUP))
if 'PSJGROUP
QUIT
Begin DoDot:2
+19 SET X=$GET(PSJCRTCL(PSJSORT,PSJGROUP))
+20 DO DSPCRTCL($PIECE(X,U),$PIECE(X,U,2))
End DoDot:2
End DoDot:1
+21 ;Displaying Significant orders
+22 KILL PSJDSPON
+23 SET PSJSEV="S"
+24 SET PSJPSPEC=""
FOR
SET PSJPSPEC=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC))
if PSJPSPEC=""
QUIT
Begin DoDot:1
+25 DO LINE^PSJMISC("=",81)
+26 FOR PSJSORT=0:0
SET PSJSORT=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJSORT))
if 'PSJSORT
QUIT
Begin DoDot:2
+27 FOR PSJ2=0:0
SET PSJ2=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJSORT,PSJ2))
if 'PSJ2
QUIT
Begin DoDot:3
+28 SET PSJDNV=PSJOCLST(PSJSEV,PSJPSPEC,PSJSORT,PSJ2)
+29 DO DISPON
End DoDot:3
End DoDot:2
+30 WRITE !
End DoDot:1
+31 QUIT
DSPCRTCL(PSJPSPEC,PSJPROFL) ;Display Critical orders
+1 NEW PSJSORT,PSJ2
+2 if $GET(PSJPSPEC)=""
QUIT
+3 if $GET(PSJPROFL)=""
QUIT
+4 FOR PSJSORT=0:0
SET PSJSORT=$ORDER(PSJOCLST("C",PSJPSPEC,PSJPROFL,PSJSORT))
if 'PSJSORT
QUIT
Begin DoDot:1
+5 FOR PSJ2=0:0
SET PSJ2=$ORDER(PSJOCLST("C",PSJPSPEC,PSJPROFL,PSJSORT,PSJ2))
if 'PSJ2
QUIT
Begin DoDot:2
+6 SET PSJDNV=PSJOCLST("C",PSJPSPEC,PSJPROFL,PSJSORT,PSJ2)
+7 DO DISPON
End DoDot:2
End DoDot:1
+8 QUIT
DISPON ; Display orders & clin effects if applied.
+1 IF ($Y+8)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+2 FOR X=1:1:11
SET PSJP(X)=$PIECE(PSJDNV,U,X)
+3 SET PSJCLINF=$PIECE(PSJDNV,U,12)
+4 IF ($GET(PSJHDR)'=$PIECE(PSJDNV,U,3))!(PSJHDRS'=PSJSEV)
SET PSJHDR=$PIECE(PSJDNV,U,3)
SET PSJHDRS=PSJSEV
KILL PSJDSPON
DO HDR(PSJHDR)
+5 IF ($Y+8)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+6 IF PSJSORT=10
Begin DoDot:1
+7 SET (PSJDRGIF,PSJONFLG)=1
+8 IF $PIECE(PSJCLINF,";",2)
DO DISPCLN^PSJCLNOC(.PSJP,PSJCLINF)
QUIT
+9 DO DSPDRG(PSJP(4),$PIECE(PSJDNV,U,2),PSJCLINF)
End DoDot:1
+10 IF ($Y+6)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+11 ;PSJDRGIF - drug interaction displayed
IF PSJSORT>10
SET (PSJDRGIF,PSJONFLG)=1
Begin DoDot:1
+12 IF $DATA(PSJDSPON($PIECE(PSJP(4),";",2)))
QUIT
+13 SET PSJDSPON($PIECE(PSJP(4),";",2))=""
+14 IF $PIECE($PIECE(PSJDNV,U,12),";",2)
DO DISPCLN^PSJCLNOC(.PSJP,PSJCLINF)
QUIT
+15 DO EN^PSODRDU2(DFN,PSJP(4),"PSJPRE")
End DoDot:1
+16 IF ($Y+6)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
DISPON2 ;
+1 IF PSJSEV=PSJXSEV
IF (PSJPSPEC=PSJXNM)
IF (PSJSORT=PSJXSORT)
IF (PSJ2=PSJXDN)
SET PSJLINE="="
+2 IF PSJSEV="C"
IF $$DSPLCLIN(PSJ2)
DO CLIN(PSJP(5),PSJP(2),PSJP(4),PSJP(1),PSJLINE)
+3 IF ($Y+6)>IOSL
DO PAUSE^PSJMISC()
WRITE @IOF
+4 QUIT
SORTORD ;Sort drug drug output to display in order of: Inpatient, Active Rx, Remote Rx, Pending Rx, Non_VA
+1 NEW PDJDNV,PSJX
+2 SET PSJDNV=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN))
+3 IF $EXTRACT(PSJPON,1,1)'="I"
Begin DoDot:1
+4 SET PSJX=$EXTRACT($PIECE(PSJPON,";"),1,1)
+5 DO OCLST($SELECT(PSJX["C":10,PSJX="O":20,PSJX="R":30,PSJX="P":40,PSJX="N":50,1:""),PSJCLINF)
End DoDot:1
+6 IF $EXTRACT(PSJPON,1,1)="I"
DO OCLST(10,PSJCLINF)
+7 QUIT
OCLST(PSJ1,PSJCLINF) ;Sort orders into array to display later
+1 ;PSJOCLST(PSJSEV("C",PSJPSPEC,PSJPROFL,PSJ1-package,PSJ2)=P1...P6 (P1=SEQ NO, P2=Drug Name(Profile), P3=Drug Name(Prospective)
+2 ; (P4=Pharm order# ,P5=Severity, P6=P3 IEN)
+3 ;PSJOCLST(PSJSEV("S",PSJPSPEC,PSJ1-package,PSJ2)=P1...P12 (P1=SEQ NO, P2=Drug Name(Profile), P3=Drug Name(Prospective), P12=PSJCLINF
+4 ; (P4=Pharm order# ,P5=Severity, P6=P3 IEN)
+5 ;PSJSEV: Sort first by severity
+6 ;PSJ1: 10=PSJ Order
+7 ; 20=PSO Active Rx
+8 ; 30=Remote Rx
+9 ; 40=PSO pending
+10 ; 50=Non-VA
+11 ;PSJ2: A counter
+12 NEW PSJDNV,PSJMONTI,PSJMONV,PSJVAGEN,PSJON1,PSJON2,PSJONFG,PSJPSPEC,PSJPROFL
+13 if '$GET(PSJ1)
QUIT
+14 SET PSJ2=$GET(PSJ2)+1
+15 SET PSJDNV=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN))
+16 SET PSJPSPEC=$PIECE(PSJDNV,U,4)
if PSJPSPEC=""
SET PSJPSPEC="UNKNOWN DRUG NAME"
+17 ; Criticals are grouped by profile VAGEN name and then package type
+18 IF PSJSEV="C"
Begin DoDot:1
+19 SET PSJVAGEN=$$VAGEN^PSJMISC(+$PIECE(PSJDNV,U,3))
IF PSJVAGEN=""
SET PSJVAGEN=PSJDNM
+20 SET PSJOCLST(PSJSEV,PSJPSPEC,PSJVAGEN,PSJ1,PSJ2)=PSJDN_U_$GET(PSJDNM)_U_$PIECE(PSJDNV,U,4)_U_PSJPON_U_PSJSEV_U_$PIECE(PSJDNV,U,2)_"^^^^^^"_PSJCLINF
End DoDot:1
+21 ; Significants are grouped by package type so Inpatient orders display first
+22 IF PSJSEV="S"
Begin DoDot:1
+23 SET PSJOCLST(PSJSEV,PSJPSPEC,PSJ1,PSJ2)=PSJDN_U_$GET(PSJDNM)_U_$PIECE(PSJDNV,U,4)_U_PSJPON_U_PSJSEV_U_$PIECE(PSJDNV,U,2)_"^^^^^^"_PSJCLINF
End DoDot:1
+24 SET PSJMONTI=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDN,"PMON",3,0))
+25 SET PSJMONTI=$PIECE(PSJMONTI,"MONOGRAPH TITLE: ",2)
if PSJMONTI=""
QUIT
+26 SET PSJVAGEN=$$VAGEN^PSJMISC(+$PIECE(PSJDNV,U,3))
+27 IF PSJVAGEN=""
IF '+$PIECE(PSJDNV,U,3)
SET PSJVAGEN=$$GENVUID^PSJMISC($GET(PSJRDI(PSJPON)))
+28 if PSJVAGEN=""
QUIT
+29 SET PSJVAGEN=PSJVAGEN_"+"_$PIECE(PSJDNV,U,4)
+30 SET PSJMONV=$GET(PSJMON(PSJVAGEN,PSJMONTI))
+31 IF PSJMONTI]""
Begin DoDot:1
+32 SET $PIECE(PSJMON(PSJVAGEN,PSJMONTI),U,1,7)=PSJDN_U_$GET(PSJDNM)_U_+$PIECE(PSJDNV,U,3)_U_$PIECE(PSJDNV,U,4)_U_+$PIECE(PSJDNV,U,2)_U_PSJPON_U_PSJSEV
+33 SET $PIECE(PSJMON(PSJVAGEN,PSJMONTI),U,11)=PSJVAGEN
End DoDot:1
+34 IF PSJMONV]""
Begin DoDot:1
+35 IF $PIECE(PSJMONV,U,7)'=PSJSEV
SET $PIECE(PSJMON(PSJVAGEN,PSJMONTI),U,9)=1
+36 SET PSJONFG=0
+37 SET PSJON1=$PIECE($PIECE(PSJMONV,U,6),";")
+38 SET PSJON2=$PIECE(PSJPON,";")
+39 IF PSJON1="I"
IF PSJON2'="I"
SET PSJONFG=1
+40 IF PSJON1'="I"
IF PSJON2="I"
SET PSJONFG=1
+41 IF PSJONFG
SET $PIECE(PSJMON(PSJVAGEN,PSJMONTI),U,10)=1
End DoDot:1
+42 KILL PSJON1,PSJON2,PSJONFG
+43 QUIT
CLIN(PSJSEV,PSJDNM,PSJPON,PSJDN,PSJLINE) ;
+1 ;No longer need to display the clinical effect for Significant
+2 if PSJSEV="S"
QUIT
+3 NEW PSJCLINV,PSJNDX,PSJX
+4 IF $GET(PSJLINE)=""
SET PSJLINE="."
+5 FOR PSJDNX=0:0
SET PSJDNX=$ORDER(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDNX))
if 'PSJDNX
QUIT
Begin DoDot:1
+6 SET PSJCLINV=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJSEV,PSJDNM,PSJPON,PSJDNX,"CLIN"))
+7 WRITE !
+8 SET PSJX=$PIECE(PSJCLINV,"CLINICAL EFFECTS: ",2)
IF ($Y+($LENGTH(PSJX)\65)+4)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+9 DO WRITE^PSJMISC(PSJX)
End DoDot:1
+10 WRITE !
+11 IF ($Y+8)>IOSL
DO PAUSE^PSJMISC(0,0)
WRITE @IOF
+12 QUIT
INTERV ;Log intervention. Required for Critical.
+1 ;Critical interaction MUST log an intervention before continue with the order
+2 ;Only log one intervention for a prospective drug & log it for the higher severity
+3 NEW PSJSEV,PSJDD,PSJDN,PSJNDV,PSJTYPE,PSJINTVD,PSJPROFL
+4 KILL PSJDDSV,PSJINTVD
+5 ;Required intervention for each of the prospective drug with critical interactions
+6 FOR PSJSEV="C"
if $GET(PSGORQF)
QUIT
SET PSJPSPEC=""
FOR
SET PSJPSPEC=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC))
if PSJPSPEC=""
QUIT
Begin DoDot:1
+7 SET PSJPROFL=""
FOR
SET PSJPROFL=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL))
if PSJPROFL=""
QUIT
Begin DoDot:2
+8 FOR PSJTYPE=0:0
SET PSJTYPE=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJTYPE))
if 'PSJTYPE
QUIT
Begin DoDot:3
+9 FOR PSJDN=0:0
SET PSJDN=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJTYPE,PSJDN))
if 'PSJDN
QUIT
if $GET(PSGORQF)
QUIT
Begin DoDot:4
+10 SET PSJNDV=$GET(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJTYPE,PSJDN))
SET PSJDD=$PIECE(PSJNDV,U,6)
+11 ;I ($P($P(PSJNDV,U,4),";",1)="I"),('$D(PSJINTVD($P(PSJNDV,U,3)))) D
+12 IF '$DATA(PSJINTVD($PIECE(PSJNDV,U,3)))
Begin DoDot:5
+13 SET (PSJINTVD($PIECE(PSJNDV,U,3)))=""
+14 if '$DATA(PSJDGCK)
DO RINTERV^PSJGMRA("CRITICAL DRUG INTERACTION",$PIECE(PSJNDV,U,3))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 ; Optional intervention for each of the prospective drug(not the same as critical) with significant interactions
+17 FOR PSJSEV="S"
if $GET(PSGORQF)
QUIT
SET PSJPSPEC=""
FOR
SET PSJPSPEC=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC))
if PSJPSPEC=""
QUIT
Begin DoDot:1
+18 FOR PSJTYPE=0:0
SET PSJTYPE=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJTYPE))
if 'PSJTYPE
QUIT
Begin DoDot:2
+19 FOR PSJDN=0:0
SET PSJDN=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJTYPE,PSJDN))
if 'PSJDN
QUIT
if $GET(PSGORQF)
QUIT
Begin DoDot:3
+20 SET PSJNDV=$GET(PSJOCLST(PSJSEV,PSJPSPEC,PSJTYPE,PSJDN))
SET PSJDD=$PIECE(PSJNDV,U,6)
+21 IF '$DATA(PSJINTVD($PIECE(PSJNDV,U,3)))
Begin DoDot:4
+22 SET (PSJINTVD($PIECE(PSJNDV,U,3)))=""
+23 if '$DATA(PSJDGCK)
DO INTERV^PSJGMRA("SIGNIFICANT DRUG INTERACTION",$PIECE(PSJNDV,U,3))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
HDR(PSJDNM) ;Display the intro text on drug interaction
+1 NEW PSJSTCK,PSJCNT
SET PSJSTCK=""
SET PSJCNT=0
+2 ;
+3 IF $GET(PSJDGCK)
FOR
SET PSJCNT=$ORDER(^TMP($JOB,"PSJPRE","IN","PROSPECTIVE",PSJCNT))
if PSJCNT=""!(PSJSTCK'="")
QUIT
Begin DoDot:1
+4 IF PSJDNM=$PIECE(^TMP($JOB,"PSJPRE","IN","PROSPECTIVE",PSJCNT),U,4)
SET PSJSTCK=$$PSTAT(PSJCNT)
End DoDot:1
+5 IF $GET(PSJSTCK)'=""
Begin DoDot:1
+6 WRITE !,"This patient is receiving the following order(s) that have a "
+7 WRITE $SELECT($GET(PSJSEV)="C":"CRITICAL",$GET(PSJSEV)="S":"SIGNIFICANT",1:"")_" Drug"
+8 WRITE !,"Interaction with "_$GET(PSJDNM)_$GET(PSJSTCK)_":",!
End DoDot:1
QUIT
+9 IF '$GET(PSJDGCK)
Begin DoDot:1
+10 WRITE !,"This patient is receiving the following order(s) that have a "
+11 WRITE $SELECT($GET(PSJSEV)="C":"CRITICAL",$GET(PSJSEV)="S":"SIGNIFICANT",1:"")_" Drug"
+12 WRITE !,"Interaction with "_$GET(PSJDNM)_":",!
End DoDot:1
QUIT
+13 QUIT
PSTAT(PSJPONCK) ;**Display order status - CCR 5980
+1 NEW PSJONCK,PSJCNT,PSJIND,PSJCKOS,PSJCKST
+2 SET PSJCKOS=""
SET PSJCKST=""
SET PSJONCK=0
SET PSJCNT=0
SET PSJIND=""
+3 ;
+4 if '$GET(PSJDGCK)
QUIT PSJCKST
+5 ;
+6 IF $PIECE(PSJPONCK,";",2)=""
SET PSJCKST=" (Prospective)"
QUIT PSJCKST
+7 IF $PIECE(PSJPONCK,";",1)="P"
SET PSJCKST=" (OP Pending)"
QUIT PSJCKST
+8 IF $PIECE(PSJPONCK,";",1)="O"
Begin DoDot:1
+9 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=0
SET PSJCKOS="Active"
QUIT
+10 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=1
SET PSJCKOS="Non-Verified"
QUIT
+11 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=2
SET PSJCKOS="Refill"
QUIT
+12 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=3
SET PSJCKOS="Hold"
QUIT
+13 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=4
SET PSJCKOS="Drug Interactions"
QUIT
+14 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=5
SET PSJCKOS="Suspended"
QUIT
+15 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=10
SET PSJCKOS="Done"
QUIT
+16 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=11
SET PSJCKOS="Expired"
QUIT
+17 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=12
SET PSJCKOS="Discontinued"
QUIT
+18 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=13
SET PSJCKOS="Deleted"
QUIT
+19 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=14
SET PSJCKOS="Discontinued by provider"
QUIT
+20 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=15
SET PSJCKOS="Discontinued (Edit)"
QUIT
+21 IF $PIECE(^PSRX($PIECE(PSJPONCK,";",2),"STA"),U,1)=16
SET PSJCKOS="Provider Hold"
QUIT
End DoDot:1
SET PSJCKST=" (Local Rx #"_$PIECE(^PSRX($PIECE(PSJPONCK,";",2),0),U,1)_" ("_PSJCKOS_"))"
QUIT PSJCKST
+22 IF $PIECE(PSJPONCK,";",1)="N"
SET PSJCKST=" (Non-VA)"
QUIT PSJCKST
+23 IF PSJCKST=""
SET PSJCNT=$LENGTH($PIECE(PSJPONCK,";",2))
SET PSJIND=$EXTRACT($PIECE(PSJPONCK,";",2),PSJCNT)
SET PSJONCK=+$PIECE(PSJPONCK,";",2)
+24 IF $GET(PSJIND)="P"
Begin DoDot:1
+25 IF $PIECE(^PS(53.1,PSJONCK,0),U,9)="A"
SET PSJCKST=" (IP Active)"
QUIT
+26 IF $PIECE(^PS(53.1,PSJONCK,0),U,9)="D"
SET PSJCKST=" (IP Discontinued)"
QUIT
+27 IF $PIECE(^PS(53.1,PSJONCK,0),U,9)="I"
SET PSJCKST=" (IP Incomplete)"
QUIT
+28 IF $PIECE(^PS(53.1,PSJONCK,0),U,9)="N"
SET PSJCKST=" (IP Non-Verified)"
QUIT
+29 IF $PIECE(^PS(53.1,PSJONCK,0),U,9)="U"
SET PSJCKST=" (IP Unreleased)"
QUIT
+30 IF $PIECE(^PS(53.1,PSJONCK,0),U,9)="P"
SET PSJCKST=" (IP Pending)"
QUIT
End DoDot:1
QUIT PSJCKST
+31 IF $GET(PSJIND)="U"
Begin DoDot:1
+32 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="A"
SET PSJCKST=" (IP Active)"
QUIT
+33 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="D"
SET PSJCKST=" (IP Discontinued)"
QUIT
+34 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="E"
SET PSJCKST=" (IP Expired)"
QUIT
+35 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="H"
SET PSJCKST=" (IP Hold)"
QUIT
+36 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="R"
SET PSJCKST=" (IP Renewed)"
QUIT
+37 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="RE"
SET PSJCKST=" (IP Reinstated)"
QUIT
+38 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="DE"
SET PSJCKST=" (IP Discontinued (Edit))"
QUIT
+39 IF $PIECE(^PS(55,$GET(DFN),5,PSJONCK,0),U,9)="DR"
SET PSJCKST=" (IP Discontinued (Renewal))"
QUIT
End DoDot:1
QUIT PSJCKST
+40 IF $GET(PSJIND)="V"
Begin DoDot:1
+41 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="A"
SET PSJCKST=" (IP Active)"
QUIT
+42 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="H"
SET PSJCKST=" (IP Hold)"
QUIT
+43 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="R"
SET PSJCKST=" (IP Renewed)"
QUIT
+44 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="D"
SET PSJCKST=" (IP Discontinued)"
QUIT
+45 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="E"
SET PSJCKST=" (IP Expired)"
QUIT
+46 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="P"
SET PSJCKST=" (IP Purge)"
QUIT
+47 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="O"
SET PSJCKST=" (IP On call)"
QUIT
+48 IF $PIECE(^PS(55,$GET(DFN),"IV",PSJONCK,0),U,17)="N"
SET PSJCKST=" (IP Non-Verified)"
QUIT
End DoDot:1
QUIT PSJCKST
+49 QUIT PSJCKST
+50 ;
DSPDRG(PSJPON,PSJDNM,PSJCLINF) ;Display order info or drug name from prospective. CCR 6454
+1 if $GET(PSJPON)=""
QUIT
+2 ;IF $G(PSJDGCK) NEW PSJSTCK SET PSJSTCK=$$PSTAT(PSJPON)
+3 ;IF $G(PSJDGCK),$G(PSJSTCK)'="" W !,?8,$G(PSJDNM)_$G(PSJSTCK),! Q
+4 IF $PIECE(PSJPON,";",3)="PROSPECTIVE"
WRITE !?8,$GET(PSJDNM)_" (Prospective)",!
QUIT
+5 IF $DATA(PSJDSPON($PIECE(PSJPON,";",2)))
QUIT
+6 SET PSJDSPON($PIECE(PSJPON,";",2))=""
+7 IF ($Y+8)>IOSL
DO PAUSE^PSJMISC(1,0)
WRITE @IOF
+8 DO DSPORD^PSJOC($PIECE(PSJPON,";",2),"",PSJCLINF)
+9 QUIT
RDIVUID ;Loop thru the "IN" global to store the VUID for remote Rx
+1 NEW PSJPON,PSJVUID
+2 KILL PSJRDI
+3 SET PSJPON=""
+4 FOR
SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE","IN","PROFILE",PSJPON))
if PSJPON=""
QUIT
IF $EXTRACT(PSJPON,1,1)="R"
Begin DoDot:1
+5 SET PSJVUID=$PIECE($GET(^TMP($JOB,"PSJPRE","IN","PROFILE",PSJPON)),U,2)
+6 if +PSJVUID
SET PSJRDI(PSJPON)=PSJVUID
End DoDot:1
+7 QUIT
DSPLCLIN(PSJ2) ;If the next drug on the list is diff the flag to display the clin effects.
+1 NEW PSJCLINC,PSJCLINN,PSJDNVC,PSJDNVN,PSJPC,PSJPN,PSJ2N,PSJSORTN
+2 IF $GET(PSJ2)=""
QUIT 0
+3 SET PSJDNVC=PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2)
+4 FOR X=1:1:10
SET PSJPC(X)=$PIECE(PSJDNVC,U,X)
+5 SET PSJ2N=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2))
+6 IF 'PSJ2N
SET PSJSORTN=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT))
if 'PSJSORTN
QUIT 1
+7 SET PSJ2N=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,0))
if 'PSJ2N
QUIT 1
+8 SET PSJDNVN=PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2N)
+9 FOR X=1:1:10
SET PSJPN(X)=$PIECE(PSJDNVN,U,X)
+10 IF $SELECT(PSJPC(5)="":1,PSJPC(2)="":1,PSJPC(4)="":1,'+PSJPC(1):1,PSJPN(5)="":1,PSJPN(2)="":1,PSJPN(4)="":1,'+PSJPN(1):1,1:0)
QUIT 0
+11 SET PSJCLINC=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJPC(5),PSJPC(2),PSJPC(4),PSJPC(1),"CLIN"))
+12 SET PSJCLINN=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJPN(5),PSJPN(2),PSJPN(4),PSJPN(1),"CLIN"))
+13 IF (PSJCLINC'=PSJCLINN)
QUIT 1
+14 QUIT 0
CRITICAL ;
+1 NEW PSJGROUP,PSJNEXT
+2 SET PSJGROUP=0
SET PSJNEXT=0
+3 SET PSJSEV="C"
+4 SET PSJPSPEC=""
FOR
SET PSJPSPEC=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC))
if PSJPSPEC=""
QUIT
Begin DoDot:1
+5 SET PSJPROFL=""
FOR
SET PSJPROFL=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL))
if PSJPROFL=""
QUIT
Begin DoDot:2
+6 SET PSJNEXT=0
+7 SET PSJGROUP=PSJGROUP+1
+8 FOR PSJSORT=0:0
SET PSJSORT=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT))
if 'PSJSORT
QUIT
Begin DoDot:3
+9 if PSJNEXT
QUIT
+10 FOR PSJ2=0:0
SET PSJ2=$ORDER(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2))
if 'PSJ2
QUIT
Begin DoDot:4
+11 if PSJNEXT
QUIT
+12 SET PSJCRTCL(PSJSORT,PSJGROUP)=PSJPSPEC_U_PSJPROFL_U_$PIECE(PSJOCLST(PSJSEV,PSJPSPEC,PSJPROFL,PSJSORT,PSJ2),"^",12)
+13 SET PSJNEXT=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
