PSNJP54 ;BIR/JCH-INPATIENT REPORT ;20 Nov 01 / 10:15 AM
;;4.0; NATIONAL DRUG FILE;**54,61,63**; 30 Oct 98
;
; 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.
;
EN ; Main entry point
N EXIT,PNAME,STDT,ENDT,RUNDT,OUTFORM,BEGDT,DOB,DPT0,ORTYP,PID
N PRODNAM,PSGORD,SCHTYP,SOLDRUG,STPDT,STPDT,TYP1,TYP2,VAPROD,INACTFLG
D INIT Q:'$G(DUZ)
S EXIT=0 D GETDATE Q:EXIT ;Get beginning and ending dates
D FORMAT Q:$D(DIRUT) ; Report or Spreadsheet format
S ZTDESC="Inpatient Medications Missed Drug Interactions Report"
S ZTRTN="START^PSNJP54"
F G="BEGDT","ENDT","OUTFORM" S:$D(@G) ZTSAVE(G)=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE) Q
;
START ; Begin processing
;Begin $O'ing through ^PS(55,DFN - (every patient)
I '$$PATCH^XPDUTL("PSN*4.0*54") D EN^DDIOL("Patch PSN*4.0*54 must be installed before this report can be run.","","!") Q
I '$D(^XTMP("PSNINT")) W !,"The primary data for this report does not exist",!! Q
S PSJPG=1,RUNDT=DT D HD
N BEGDTF,ENDTF,PNAME,DFN,DIRUT,TCNT S TCNT=0
S ENDTF=ENDT_".999999",BEGDTF=BEGDT-.01,RUNDT=DT K ^TMP("PSN PSNJ54"),^TMP("PSN PSNJ54I")
S DFN=0 F S DFN=$O(^PS(55,DFN)) Q:'DFN!$D(DIRUT) D PROCESS Q:$D(DIRUT)
I OUTFORM'="S" W ?12,"END OF ACTIVE DRUG INTERACTIONS",! D HD
S INACTFLG=1 D INACTOUT
I 'TCNT W !!?10,"** No Missed Drug Interactions Found **"
Q
;
PROCESS ; Begin processing a single patient
N INTER,PROD,DONE,CNT
S PSJDT=BEGDTF,ORTYP="U" D GETUD
S PSJDT=BEGDTF,ORTYP="I" D GETIV
S PROD=0 F S PROD=$O(PROD(PROD)) Q:'PROD!$D(DIRUT) D
.S VAPROD=PROD F S VAPROD=$O(PROD(VAPROD)) Q:'VAPROD!$D(DIRUT) D
..Q:'$D(^XTMP("PSNINT",PROD,VAPROD))!$D(DIRUT)
..D CHK(PROD,VAPROD)
Q
;
GETUD ; Build VA Products from Unit Dose Orders into PROD array
N STDT,PSGORD,DDSEQ,STDT,DDRUG,VAPROD
F S PSJDT=$O(^PS(55,DFN,5,"AUS",PSJDT)) Q:PSJDT>ENDTF!('PSJDT) D
.S PSGORD=0
.F S PSGORD=$O(^PS(55,DFN,5,"AUS",PSJDT,PSGORD)) Q:'PSGORD D
..S DDSEQ=0 F S DDSEQ=$O(^PS(55,DFN,5,PSGORD,1,DDSEQ)) Q:'DDSEQ D
...S DDRUG=+$G(^PS(55,DFN,5,PSGORD,1,DDSEQ,0))
...S STDT=$G(^PS(55,DFN,5,PSGORD,2)),STPDT=$P(STDT,"^",4),STDT=$P(STDT,"^",2)
...Q:'DDRUG S VAPROD=$P($G(^PSDRUG(DDRUG,"ND")),"^",3)
...Q:'VAPROD Q:'$D(^XTMP("PSNINT",VAPROD))
...S PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
Q
;
GETIV ; Build VA Products from IV Orders into PROD array
N ADD,SOL,ADSEQ,SOLSEQ,ADDRUG,VAPROD
F S PSJDT=$O(^PS(55,DFN,"IV","AIS",PSJDT)) Q:PSJDT>ENDTF!('PSJDT) D
.S PSGORD=0
.F S PSGORD=$O(^PS(55,DFN,"IV","AIS",PSJDT,PSGORD)) Q:'PSGORD D
..S STDT=$G(^PS(55,DFN,"IV",PSGORD,0))
..S STPDT=$P(STDT,"^",3),STDT=$P(STDT,"^",2)
..S ADSEQ=0
..F S ADSEQ=$O(^PS(55,DFN,"IV",PSGORD,"AD",ADSEQ)) Q:'ADSEQ D
...S ADD=$P($G(^PS(55,DFN,"IV",PSGORD,"AD",ADSEQ,0)),"^")
...S ADDRUG=$P($G(^PS(52.6,ADD,0)),"^",2)
...Q:'ADDRUG S VAPROD=$P($G(^PSDRUG(ADDRUG,"ND")),"^",3)
...Q:'VAPROD Q:'$D(^XTMP("PSNINT",VAPROD))
...S PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
..S SOLSEQ=0
..F S SOLSEQ=$O(^PS(55,DFN,"IV",PSGORD,"SOL",SOLSEQ)) Q:'SOLSEQ D
...S SOL=$P($G(^PS(55,DFN,"IV",PSGORD,"SOL",SOLSEQ,0)),"^")
...S SOLDRUG=$P($G(^PS(52.7,SOL,0)),"^",2)
...Q:'SOLDRUG S VAPROD=$P($G(^PSDRUG(SOLDRUG,"ND")),"^",3)
...Q:'VAPROD Q:'$D(^XTMP("PSNINT",VAPROD))
...S PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
Q
;
CHK(PR1,PR2) ; Given two VA PRODUCTS known to interact (exist in ^XTMP)
; find specific interactions within a single patient's orders
; based on overlapping START/STOP dates.
;
N DT,ORD,TYP,START1,START2,STOP1,STOP2
D GETVITAL(DFN)
S TYP1="" F S TYP1=$O(PROD(PR1,TYP1)) Q:TYP1=""!$D(DIRUT) D
.S ORD1=0 F S ORD1=$O(PROD(PR1,TYP1,ORD1)) Q:'ORD1!$D(DIRUT) D
..S TYP2="" F S TYP2=$O(PROD(PR2,TYP2)) Q:TYP2=""!$D(DIRUT) D
...S ORD2=0 F S ORD2=$O(PROD(PR2,TYP2,ORD2)) Q:'ORD2!$D(DIRUT) D
....N INACT S INACT=0
....S START1=PROD(PR1,TYP1,ORD1),STOP1=$P(START1,"^",2),START1=+START1
....S START2=PROD(PR2,TYP2,ORD2),STOP2=$P(START2,"^",2),START2=+START2
....I (START1>START2)!(START1=START2) I START1<STOP2 D DISP(START1) Q
....I (START2>START1)!(START2=START1) I START2<STOP1 D DISP(START2) Q
Q
;
DISP(START) ; Display an interaction between two VA PRODUCTS
N SEVER,INTCNT,INTNAM,INTIEN,INTDATA
I ($Y+6)>IOSL D HD Q:$D(DIRUT) K CNT
S INTCNT=0 F S INTCNT=$O(^XTMP("PSNINT",PR1,PR2,INTCNT)) Q:'INTCNT!$D(DIRUT) D
.S INTDATA=$G(^XTMP("PSNINT",PR1,PR2,INTCNT))
.S INTIEN=$P(INTDATA,"^")
.D CHKINACT(START,INTIEN,INTCNT) Q:INACT
.D DISP2
Q
;
DISP2 ;
S CNT=$G(CNT)+1,TCNT=$G(TCNT)+1
I (OUTFORM'="S") D Q:$D(DIRUT)
.I CNT=1 W !,PNAME,?25,"DOB: ",DOB,?41,"PID: ",PID
.I ($Y+6)>IOSL D HD
I OUTFORM="S" W !,PNAME,"^",DOB,"^",PID,"^"
S SEVER=$P(INTDATA,"^",5),INTNAM=$P(INTDATA,"^",2)
S SEVER=$S($G(SEVER)=1:"Critical",$G(SEVER)=2:"Significant",1:"Unknown")
I OUTFORM'="S" W !?1,"Interaction: ",INTNAM,?49," Severity: ",SEVER D
.I INACT W !?1,"Interaction Inactivation Date: ",$$FMTE^XLFDT(INACT,2)
I OUTFORM="S" W INTNAM_"^"_SEVER_"^" W:INACT $$FMTE^XLFDT(INACT,2) W "^"
D ORDOUT(DFN,PR1,TYP1,ORD1,START1,STOP1)
D ORDOUT(DFN,PR2,TYP2,ORD2,START2,STOP2)
W:OUTFORM'="S" !
Q
;
INACTOUT ;
;
W ! W:OUTFORM'="S" ?10,"START OF INACTIVE DRUG INTERACTIONS" W !
N DFN,ORD1,ORD2,PR1,PR2,TYP1,TYP2,STOP1,STOP2,DATA,DIRUT,INTCNT
S DFN=0 F S DFN=$O(^TMP("PSN PSNJ54I",$J,DFN)) Q:'DFN!$D(DIRUT) D
.S PR1=0 F S PR1=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1)) Q:'PR1!$D(DIRUT) D
..S PR2="" F S PR2=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2)) Q:'PR2!$D(DIRUT) D
...S ORD1="" F S ORD1=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1)) Q:'ORD1!$D(DIRUT) D
....S ORD2="" F S ORD2=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1,ORD2)) Q:'ORD2!$D(DIRUT) D
.....S INTCNT=""
.....F S INTCNT=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1,ORD2,INTCNT)) Q:'INTCNT!$D(DIRUT) D
......S DATA=^(INTCNT),TYP1=$P(DATA,"^"),TYP2=$P(DATA,"^",2),INACT=$P(DATA,"^",7)
......S START1=$P(DATA,"^",3),START2=$P(DATA,"^",4)
......S STOP1=$P(DATA,"^",5),STOP2=$P(DATA,"^",6)
......S INTDATA=$G(^XTMP("PSNINT",PR1,PR2,INTCNT))
......D GETVITAL(DFN) D DISP2
Q
;
ORDOUT(DFN,PRODUCT,TYPE,ORDER,START,STOP) ; Print an individual order
S ND0=^PS(55,DFN,$S(TYPE="U":5,1:"IV"),ORDER,0),SCHTYP=$P(ND0,"^",7)
S PRODNAM=$P($G(^PSNDF(50.68,PRODUCT,0)),"^")
I OUTFORM'="S" D Q ; Regular Report Format
.W !?3,ORDER,TYPE,?8,$E(PRODNAM,1,25) I PRODNAM["(",PRODNAM'[")" W ")"
.W ?36,SCHTYP,?43,$$FMTE^XLFDT(START\1,2),?53,$$FMTE^XLFDT(STOP\1,2)
W ORDER,"^",TYPE,"^",PRODNAM,"^",SCHTYP,"^",$$FMTE^XLFDT(START\1,2),"^"
W $$FMTE^XLFDT(STOP\1,2)
Q
;
GETVITAL(DFN) ;
S DPT0=^DPT(DFN,0),PNAME=$P(DPT0,"^"),DOB=$P(DPT0,"^",3),PID=$P(DPT0,"^",9)
S DOB=$$FMTE^XLFDT(DOB,2),PID=$TR($J($P(DPT0,"^",9),9)," ",0)
S PID=$E(PID,1,3)_"-"_$E(PID,4,5)_"-"_$E(PID,6,9)
Q
;
CHKINACT(START,IIEN,XTMPCNT) ;
N INACTDT
S INACTDT=$P(^PS(56,IIEN,0),"^",7)
Q:'INACTDT
Q:INACTDT>START
S STRING=TYP1_"^"_TYP2_"^"_START1_"^"_START2_"^"_STOP1_"^"_STOP2_"^"_INACTDT_"^"_XTMPCNT
S ^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1,ORD2,XTMPCNT)=STRING
S INACT=1
Q
;
GETDATE ; Prompt for "Stop Date" to begin search
N NEXT S NEXT=""
W !?5,"This report searches Inpatient Medications orders by" D
.W !?5,"STOP DATE, looking for drug interactions based on the"
.W !?5,"data in ^XTMP(""PSNINT"",VA PRODUCT,VA PRODUCT)"
.W !!,"Default starting date is one year ago."
S X1=DT,X2=-365 D C^%DTC S D=X
S D=$$FMTE^XLFDT(D)
S Y=-1 F W !!,"Enter starting date: "_D_" // " R X:DTIME S:X="" X=D D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) S:Y<0 EXIT=1 Q
I $G(EXIT) W !,"No starting date chosen" Q
S BEGDT=Y,ENDT=DT+10000 D:+$E(Y,6,7)=0 DTC
Q
;
DTM W !!,"Enter the Order Stop Date to begin searching from: "
W !!
Q
;
;
FORMAT ; Prompt for "Report" or "Spreadsheet" format
N DIR,STRING
S DIR(0)="SB^R:REPORT;S:SPREADSHEET",DIR("B")="Report"
S DIR("A")="Select a format for your data"
D ^DIR Q:$D(DIRUT)
S OUTFORM=Y
I OUTFORM="S" S STRING="PATIENT NAME^DATE OF BIRTH^PATIENT ID^" D
.S STRING=STRING_"DESCRIPTION OF INTERACTION^SEVERITY OF INTERACTION^"
.S STRING=STRING_"INACTIVATION DATE OF INTERACTION^ORDER NUMBER 1^"
.S STRING=STRING_"ORDER TYPE 1^VA PRODUCT 1^SCHEDULE TYPE 1^START TIME 1^STOP TIME 1^"
.S STRING=STRING_"STOP TIME 1^ORDER NUMBER 2^ORDER TYPE 2^VA PRODUCT 2^"
.S STRING=STRING_"SCHEDULE TYPE 2^START TIME 2^STOP TIME 2"
.W !!,"Format of Data elements, delimited by '^' :"
.F I=1:1:$L(STRING,"^") W !,I,") ",?5,$P(STRING,"^",I)
Q
;
HD ; Continue prompt, print header
Q:OUTFORM="S"
I PSJPG>1,$E(IOST)="C" S DIR(0)="E" D
.S DIR("A")="Press Return to Continue or ""^"" to quit"
.D ^DIR K DIR W !
Q:$D(DIRUT)
I $E(IOST)="C" W @IOF
W:$G(INACTFLG) ?16,"*INACTIVE* "
W ?22,"Inpatient Drug Interaction Report" D
.W ?72,"Page "_PSJPG
.W !?20,"Run Date: ",$$FMTE^XLFDT(RUNDT)
W !?1,"Order",?8,"VA Product Name"
W ?33,"Sch Type",?44,"Start",?54,"Stop"
W ! F Y=1:1:75 W "-"
W ! S PSJPG=PSJPG+1
Q
;
INIT ; Check for DT,DUZ,etc.
K ^UTILITY($J)
I '$G(DUZ)!'$D(DTIME)!'$G(DT) D Q
.W !?5,"You must run ^XUP before running this report." Q
I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
S RUNDT=DT,DTOUT=0
D RESETDT
Q
;
RESETDT ;
S X=+$G(^XTMP("PSNINT",0))
I X S X=$$FMADD^XLFDT(DT,90) S $P(^XTMP("PSNINT",0),"^")=X
Q
;
DTC ;Date format
N DD,MM S DD=31,MM=+$E(Y,4,5)
I MM'=12 S MM=MM+1,MM=$S(MM<10:"0",1:"")_MM,X2=Y,X1=$E(Y,1,3)_MM_"00" D
.D ^%DTC S DD=X
S ENDT=Y+DD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNJP54 9786 printed Dec 13, 2024@02:24:13 Page 2
PSNJP54 ;BIR/JCH-INPATIENT REPORT ;20 Nov 01 / 10:15 AM
+1 ;;4.0; NATIONAL DRUG FILE;**54,61,63**; 30 Oct 98
+2 ;
+3 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+4 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+5 ; Reference to ^PS(55 is supported by DBIA 2191.
+6 ; Reference to ^PSDRUG is supported by DBIA 2192.
+7 ;
EN ; Main entry point
+1 NEW EXIT,PNAME,STDT,ENDT,RUNDT,OUTFORM,BEGDT,DOB,DPT0,ORTYP,PID
+2 NEW PRODNAM,PSGORD,SCHTYP,SOLDRUG,STPDT,STPDT,TYP1,TYP2,VAPROD,INACTFLG
+3 DO INIT
if '$GET(DUZ)
QUIT
+4 ;Get beginning and ending dates
SET EXIT=0
DO GETDATE
if EXIT
QUIT
+5 ; Report or Spreadsheet format
DO FORMAT
if $DATA(DIRUT)
QUIT
+6 SET ZTDESC="Inpatient Medications Missed Drug Interactions Report"
+7 SET ZTRTN="START^PSNJP54"
+8 FOR G="BEGDT","ENDT","OUTFORM"
if $DATA(@G)
SET ZTSAVE(G)=""
+9 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
QUIT
+10 ;
START ; Begin processing
+1 ;Begin $O'ing through ^PS(55,DFN - (every patient)
+2 IF '$$PATCH^XPDUTL("PSN*4.0*54")
DO EN^DDIOL("Patch PSN*4.0*54 must be installed before this report can be run.","","!")
QUIT
+3 IF '$DATA(^XTMP("PSNINT"))
WRITE !,"The primary data for this report does not exist",!!
QUIT
+4 SET PSJPG=1
SET RUNDT=DT
DO HD
+5 NEW BEGDTF,ENDTF,PNAME,DFN,DIRUT,TCNT
SET TCNT=0
+6 SET ENDTF=ENDT_".999999"
SET BEGDTF=BEGDT-.01
SET RUNDT=DT
KILL ^TMP("PSN PSNJ54"),^TMP("PSN PSNJ54I")
+7 SET DFN=0
FOR
SET DFN=$ORDER(^PS(55,DFN))
if 'DFN!$DATA(DIRUT)
QUIT
DO PROCESS
if $DATA(DIRUT)
QUIT
+8 IF OUTFORM'="S"
WRITE ?12,"END OF ACTIVE DRUG INTERACTIONS",!
DO HD
+9 SET INACTFLG=1
DO INACTOUT
+10 IF 'TCNT
WRITE !!?10,"** No Missed Drug Interactions Found **"
+11 QUIT
+12 ;
PROCESS ; Begin processing a single patient
+1 NEW INTER,PROD,DONE,CNT
+2 SET PSJDT=BEGDTF
SET ORTYP="U"
DO GETUD
+3 SET PSJDT=BEGDTF
SET ORTYP="I"
DO GETIV
+4 SET PROD=0
FOR
SET PROD=$ORDER(PROD(PROD))
if 'PROD!$DATA(DIRUT)
QUIT
Begin DoDot:1
+5 SET VAPROD=PROD
FOR
SET VAPROD=$ORDER(PROD(VAPROD))
if 'VAPROD!$DATA(DIRUT)
QUIT
Begin DoDot:2
+6 if '$DATA(^XTMP("PSNINT",PROD,VAPROD))!$DATA(DIRUT)
QUIT
+7 DO CHK(PROD,VAPROD)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
GETUD ; Build VA Products from Unit Dose Orders into PROD array
+1 NEW STDT,PSGORD,DDSEQ,STDT,DDRUG,VAPROD
+2 FOR
SET PSJDT=$ORDER(^PS(55,DFN,5,"AUS",PSJDT))
if PSJDT>ENDTF!('PSJDT)
QUIT
Begin DoDot:1
+3 SET PSGORD=0
+4 FOR
SET PSGORD=$ORDER(^PS(55,DFN,5,"AUS",PSJDT,PSGORD))
if 'PSGORD
QUIT
Begin DoDot:2
+5 SET DDSEQ=0
FOR
SET DDSEQ=$ORDER(^PS(55,DFN,5,PSGORD,1,DDSEQ))
if 'DDSEQ
QUIT
Begin DoDot:3
+6 SET DDRUG=+$GET(^PS(55,DFN,5,PSGORD,1,DDSEQ,0))
+7 SET STDT=$GET(^PS(55,DFN,5,PSGORD,2))
SET STPDT=$PIECE(STDT,"^",4)
SET STDT=$PIECE(STDT,"^",2)
+8 if 'DDRUG
QUIT
SET VAPROD=$PIECE($GET(^PSDRUG(DDRUG,"ND")),"^",3)
+9 if 'VAPROD
QUIT
if '$DATA(^XTMP("PSNINT",VAPROD))
QUIT
+10 SET PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
GETIV ; Build VA Products from IV Orders into PROD array
+1 NEW ADD,SOL,ADSEQ,SOLSEQ,ADDRUG,VAPROD
+2 FOR
SET PSJDT=$ORDER(^PS(55,DFN,"IV","AIS",PSJDT))
if PSJDT>ENDTF!('PSJDT)
QUIT
Begin DoDot:1
+3 SET PSGORD=0
+4 FOR
SET PSGORD=$ORDER(^PS(55,DFN,"IV","AIS",PSJDT,PSGORD))
if 'PSGORD
QUIT
Begin DoDot:2
+5 SET STDT=$GET(^PS(55,DFN,"IV",PSGORD,0))
+6 SET STPDT=$PIECE(STDT,"^",3)
SET STDT=$PIECE(STDT,"^",2)
+7 SET ADSEQ=0
+8 FOR
SET ADSEQ=$ORDER(^PS(55,DFN,"IV",PSGORD,"AD",ADSEQ))
if 'ADSEQ
QUIT
Begin DoDot:3
+9 SET ADD=$PIECE($GET(^PS(55,DFN,"IV",PSGORD,"AD",ADSEQ,0)),"^")
+10 SET ADDRUG=$PIECE($GET(^PS(52.6,ADD,0)),"^",2)
+11 if 'ADDRUG
QUIT
SET VAPROD=$PIECE($GET(^PSDRUG(ADDRUG,"ND")),"^",3)
+12 if 'VAPROD
QUIT
if '$DATA(^XTMP("PSNINT",VAPROD))
QUIT
+13 SET PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
End DoDot:3
+14 SET SOLSEQ=0
+15 FOR
SET SOLSEQ=$ORDER(^PS(55,DFN,"IV",PSGORD,"SOL",SOLSEQ))
if 'SOLSEQ
QUIT
Begin DoDot:3
+16 SET SOL=$PIECE($GET(^PS(55,DFN,"IV",PSGORD,"SOL",SOLSEQ,0)),"^")
+17 SET SOLDRUG=$PIECE($GET(^PS(52.7,SOL,0)),"^",2)
+18 if 'SOLDRUG
QUIT
SET VAPROD=$PIECE($GET(^PSDRUG(SOLDRUG,"ND")),"^",3)
+19 if 'VAPROD
QUIT
if '$DATA(^XTMP("PSNINT",VAPROD))
QUIT
+20 SET PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
CHK(PR1,PR2) ; Given two VA PRODUCTS known to interact (exist in ^XTMP)
+1 ; find specific interactions within a single patient's orders
+2 ; based on overlapping START/STOP dates.
+3 ;
+4 NEW DT,ORD,TYP,START1,START2,STOP1,STOP2
+5 DO GETVITAL(DFN)
+6 SET TYP1=""
FOR
SET TYP1=$ORDER(PROD(PR1,TYP1))
if TYP1=""!$DATA(DIRUT)
QUIT
Begin DoDot:1
+7 SET ORD1=0
FOR
SET ORD1=$ORDER(PROD(PR1,TYP1,ORD1))
if 'ORD1!$DATA(DIRUT)
QUIT
Begin DoDot:2
+8 SET TYP2=""
FOR
SET TYP2=$ORDER(PROD(PR2,TYP2))
if TYP2=""!$DATA(DIRUT)
QUIT
Begin DoDot:3
+9 SET ORD2=0
FOR
SET ORD2=$ORDER(PROD(PR2,TYP2,ORD2))
if 'ORD2!$DATA(DIRUT)
QUIT
Begin DoDot:4
+10 NEW INACT
SET INACT=0
+11 SET START1=PROD(PR1,TYP1,ORD1)
SET STOP1=$PIECE(START1,"^",2)
SET START1=+START1
+12 SET START2=PROD(PR2,TYP2,ORD2)
SET STOP2=$PIECE(START2,"^",2)
SET START2=+START2
+13 IF (START1>START2)!(START1=START2)
IF START1<STOP2
DO DISP(START1)
QUIT
+14 IF (START2>START1)!(START2=START1)
IF START2<STOP1
DO DISP(START2)
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
DISP(START) ; Display an interaction between two VA PRODUCTS
+1 NEW SEVER,INTCNT,INTNAM,INTIEN,INTDATA
+2 IF ($Y+6)>IOSL
DO HD
if $DATA(DIRUT)
QUIT
KILL CNT
+3 SET INTCNT=0
FOR
SET INTCNT=$ORDER(^XTMP("PSNINT",PR1,PR2,INTCNT))
if 'INTCNT!$DATA(DIRUT)
QUIT
Begin DoDot:1
+4 SET INTDATA=$GET(^XTMP("PSNINT",PR1,PR2,INTCNT))
+5 SET INTIEN=$PIECE(INTDATA,"^")
+6 DO CHKINACT(START,INTIEN,INTCNT)
if INACT
QUIT
+7 DO DISP2
End DoDot:1
+8 QUIT
+9 ;
DISP2 ;
+1 SET CNT=$GET(CNT)+1
SET TCNT=$GET(TCNT)+1
+2 IF (OUTFORM'="S")
Begin DoDot:1
+3 IF CNT=1
WRITE !,PNAME,?25,"DOB: ",DOB,?41,"PID: ",PID
+4 IF ($Y+6)>IOSL
DO HD
End DoDot:1
if $DATA(DIRUT)
QUIT
+5 IF OUTFORM="S"
WRITE !,PNAME,"^",DOB,"^",PID,"^"
+6 SET SEVER=$PIECE(INTDATA,"^",5)
SET INTNAM=$PIECE(INTDATA,"^",2)
+7 SET SEVER=$SELECT($GET(SEVER)=1:"Critical",$GET(SEVER)=2:"Significant",1:"Unknown")
+8 IF OUTFORM'="S"
WRITE !?1,"Interaction: ",INTNAM,?49," Severity: ",SEVER
Begin DoDot:1
+9 IF INACT
WRITE !?1,"Interaction Inactivation Date: ",$$FMTE^XLFDT(INACT,2)
End DoDot:1
+10 IF OUTFORM="S"
WRITE INTNAM_"^"_SEVER_"^"
if INACT
WRITE $$FMTE^XLFDT(INACT,2)
WRITE "^"
+11 DO ORDOUT(DFN,PR1,TYP1,ORD1,START1,STOP1)
+12 DO ORDOUT(DFN,PR2,TYP2,ORD2,START2,STOP2)
+13 if OUTFORM'="S"
WRITE !
+14 QUIT
+15 ;
INACTOUT ;
+1 ;
+2 WRITE !
if OUTFORM'="S"
WRITE ?10,"START OF INACTIVE DRUG INTERACTIONS"
WRITE !
+3 NEW DFN,ORD1,ORD2,PR1,PR2,TYP1,TYP2,STOP1,STOP2,DATA,DIRUT,INTCNT
+4 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("PSN PSNJ54I",$JOB,DFN))
if 'DFN!$DATA(DIRUT)
QUIT
Begin DoDot:1
+5 SET PR1=0
FOR
SET PR1=$ORDER(^TMP("PSN PSNJ54I",$JOB,DFN,PR1))
if 'PR1!$DATA(DIRUT)
QUIT
Begin DoDot:2
+6 SET PR2=""
FOR
SET PR2=$ORDER(^TMP("PSN PSNJ54I",$JOB,DFN,PR1,PR2))
if 'PR2!$DATA(DIRUT)
QUIT
Begin DoDot:3
+7 SET ORD1=""
FOR
SET ORD1=$ORDER(^TMP("PSN PSNJ54I",$JOB,DFN,PR1,PR2,ORD1))
if 'ORD1!$DATA(DIRUT)
QUIT
Begin DoDot:4
+8 SET ORD2=""
FOR
SET ORD2=$ORDER(^TMP("PSN PSNJ54I",$JOB,DFN,PR1,PR2,ORD1,ORD2))
if 'ORD2!$DATA(DIRUT)
QUIT
Begin DoDot:5
+9 SET INTCNT=""
+10 FOR
SET INTCNT=$ORDER(^TMP("PSN PSNJ54I",$JOB,DFN,PR1,PR2,ORD1,ORD2,INTCNT))
if 'INTCNT!$DATA(DIRUT)
QUIT
Begin DoDot:6
+11 SET DATA=^(INTCNT)
SET TYP1=$PIECE(DATA,"^")
SET TYP2=$PIECE(DATA,"^",2)
SET INACT=$PIECE(DATA,"^",7)
+12 SET START1=$PIECE(DATA,"^",3)
SET START2=$PIECE(DATA,"^",4)
+13 SET STOP1=$PIECE(DATA,"^",5)
SET STOP2=$PIECE(DATA,"^",6)
+14 SET INTDATA=$GET(^XTMP("PSNINT",PR1,PR2,INTCNT))
+15 DO GETVITAL(DFN)
DO DISP2
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
ORDOUT(DFN,PRODUCT,TYPE,ORDER,START,STOP) ; Print an individual order
+1 SET ND0=^PS(55,DFN,$SELECT(TYPE="U":5,1:"IV"),ORDER,0)
SET SCHTYP=$PIECE(ND0,"^",7)
+2 SET PRODNAM=$PIECE($GET(^PSNDF(50.68,PRODUCT,0)),"^")
+3 ; Regular Report Format
IF OUTFORM'="S"
Begin DoDot:1
+4 WRITE !?3,ORDER,TYPE,?8,$EXTRACT(PRODNAM,1,25)
IF PRODNAM["("
IF PRODNAM'[")"
WRITE ")"
+5 WRITE ?36,SCHTYP,?43,$$FMTE^XLFDT(START\1,2),?53,$$FMTE^XLFDT(STOP\1,2)
End DoDot:1
QUIT
+6 WRITE ORDER,"^",TYPE,"^",PRODNAM,"^",SCHTYP,"^",$$FMTE^XLFDT(START\1,2),"^"
+7 WRITE $$FMTE^XLFDT(STOP\1,2)
+8 QUIT
+9 ;
GETVITAL(DFN) ;
+1 SET DPT0=^DPT(DFN,0)
SET PNAME=$PIECE(DPT0,"^")
SET DOB=$PIECE(DPT0,"^",3)
SET PID=$PIECE(DPT0,"^",9)
+2 SET DOB=$$FMTE^XLFDT(DOB,2)
SET PID=$TRANSLATE($JUSTIFY($PIECE(DPT0,"^",9),9)," ",0)
+3 SET PID=$EXTRACT(PID,1,3)_"-"_$EXTRACT(PID,4,5)_"-"_$EXTRACT(PID,6,9)
+4 QUIT
+5 ;
CHKINACT(START,IIEN,XTMPCNT) ;
+1 NEW INACTDT
+2 SET INACTDT=$PIECE(^PS(56,IIEN,0),"^",7)
+3 if 'INACTDT
QUIT
+4 if INACTDT>START
QUIT
+5 SET STRING=TYP1_"^"_TYP2_"^"_START1_"^"_START2_"^"_STOP1_"^"_STOP2_"^"_INACTDT_"^"_XTMPCNT
+6 SET ^TMP("PSN PSNJ54I",$JOB,DFN,PR1,PR2,ORD1,ORD2,XTMPCNT)=STRING
+7 SET INACT=1
+8 QUIT
+9 ;
GETDATE ; Prompt for "Stop Date" to begin search
+1 NEW NEXT
SET NEXT=""
+2 WRITE !?5,"This report searches Inpatient Medications orders by"
Begin DoDot:1
+3 WRITE !?5,"STOP DATE, looking for drug interactions based on the"
+4 WRITE !?5,"data in ^XTMP(""PSNINT"",VA PRODUCT,VA PRODUCT)"
+5 WRITE !!,"Default starting date is one year ago."
End DoDot:1
+6 SET X1=DT
SET X2=-365
DO C^%DTC
SET D=X
+7 SET D=$$FMTE^XLFDT(D)
+8 SET Y=-1
FOR
WRITE !!,"Enter starting date: "_D_" // "
READ X:DTIME
if X=""
SET X=D
if X?1."?"
DO DTM
if "^"'[X
DO ^%DT
IF Y>0!("^"[X)
if Y<0
SET EXIT=1
QUIT
+9 IF $GET(EXIT)
WRITE !,"No starting date chosen"
QUIT
+10 SET BEGDT=Y
SET ENDT=DT+10000
if +$EXTRACT(Y,6,7)=0
DO DTC
+11 QUIT
+12 ;
DTM WRITE !!,"Enter the Order Stop Date to begin searching from: "
+1 WRITE !!
+2 QUIT
+3 ;
+4 ;
FORMAT ; Prompt for "Report" or "Spreadsheet" format
+1 NEW DIR,STRING
+2 SET DIR(0)="SB^R:REPORT;S:SPREADSHEET"
SET DIR("B")="Report"
+3 SET DIR("A")="Select a format for your data"
+4 DO ^DIR
if $DATA(DIRUT)
QUIT
+5 SET OUTFORM=Y
+6 IF OUTFORM="S"
SET STRING="PATIENT NAME^DATE OF BIRTH^PATIENT ID^"
Begin DoDot:1
+7 SET STRING=STRING_"DESCRIPTION OF INTERACTION^SEVERITY OF INTERACTION^"
+8 SET STRING=STRING_"INACTIVATION DATE OF INTERACTION^ORDER NUMBER 1^"
+9 SET STRING=STRING_"ORDER TYPE 1^VA PRODUCT 1^SCHEDULE TYPE 1^START TIME 1^STOP TIME 1^"
+10 SET STRING=STRING_"STOP TIME 1^ORDER NUMBER 2^ORDER TYPE 2^VA PRODUCT 2^"
+11 SET STRING=STRING_"SCHEDULE TYPE 2^START TIME 2^STOP TIME 2"
+12 WRITE !!,"Format of Data elements, delimited by '^' :"
+13 FOR I=1:1:$LENGTH(STRING,"^")
WRITE !,I,") ",?5,$PIECE(STRING,"^",I)
End DoDot:1
+14 QUIT
+15 ;
HD ; Continue prompt, print header
+1 if OUTFORM="S"
QUIT
+2 IF PSJPG>1
IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
Begin DoDot:1
+3 SET DIR("A")="Press Return to Continue or ""^"" to quit"
+4 DO ^DIR
KILL DIR
WRITE !
End DoDot:1
+5 if $DATA(DIRUT)
QUIT
+6 IF $EXTRACT(IOST)="C"
WRITE @IOF
+7 if $GET(INACTFLG)
WRITE ?16,"*INACTIVE* "
+8 WRITE ?22,"Inpatient Drug Interaction Report"
Begin DoDot:1
+9 WRITE ?72,"Page "_PSJPG
+10 WRITE !?20,"Run Date: ",$$FMTE^XLFDT(RUNDT)
End DoDot:1
+11 WRITE !?1,"Order",?8,"VA Product Name"
+12 WRITE ?33,"Sch Type",?44,"Start",?54,"Stop"
+13 WRITE !
FOR Y=1:1:75
WRITE "-"
+14 WRITE !
SET PSJPG=PSJPG+1
+15 QUIT
+16 ;
INIT ; Check for DT,DUZ,etc.
+1 KILL ^UTILITY($JOB)
+2 IF '$GET(DUZ)!'$DATA(DTIME)!'$GET(DT)
Begin DoDot:1
+3 WRITE !?5,"You must run ^XUP before running this report."
QUIT
End DoDot:1
QUIT
+4 IF '$DATA(PSGDT)
DO NOW^%DTC
SET PSGDT=$EXTRACT(%,1,12)
+5 SET RUNDT=DT
SET DTOUT=0
+6 DO RESETDT
+7 QUIT
+8 ;
RESETDT ;
+1 SET X=+$GET(^XTMP("PSNINT",0))
+2 IF X
SET X=$$FMADD^XLFDT(DT,90)
SET $PIECE(^XTMP("PSNINT",0),"^")=X
+3 QUIT
+4 ;
DTC ;Date format
+1 NEW DD,MM
SET DD=31
SET MM=+$EXTRACT(Y,4,5)
+2 IF MM'=12
SET MM=MM+1
SET MM=$SELECT(MM<10:"0",1:"")_MM
SET X2=Y
SET X1=$EXTRACT(Y,1,3)_MM_"00"
Begin DoDot:1
+3 DO ^%DTC
SET DD=X
End DoDot:1
+4 SET ENDT=Y+DD
+5 QUIT
