PSJOCDI.m

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 ---PSJOCDI   15907     printed  Mar 13, 2025@21:12:52                                                                                                                                                                                                    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))