PSNOP54 ;BHAM ISC/SAB - build array of outpatient current meds ;14 Dec 01
;;4.0; NATIONAL DRUG FILE;**54**; 30 Oct 98
;External reference ^PS(55 supported by DBIA 2191
;External reference ^PSDRUG( supported by DBIA 2192
;External reference ^PSRX( supported by DBIA 1977
;This report searches Outpatient Medications looking for drug
;interactions based on the data in
;^XTMP("PSNINT",VA PRODUCT,VA PRODUCT,1)
;---------------------------------------------------------------
START ;
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
W !,"This report searches Outpatient Medications looking for drug interactions",!,"based on the data in ^XTMP(""PSNINT"",VA PRODUCT,VA PRODUCT,1)",!
K ^TMP("PSN PSO",$J),^TMP("PSN PSOEX",$J),DIR,DIRUT
K ^TMP("ZPSN PSOEX",$J)
W ! S DIR(0)="SB^R:REPORT;S:SPREAD SHEET;B:BOTH",DIR("B")="Report",DIR("A")="What format would you like your data" D ^DIR G:$D(DIRUT) EOJ S RPT=Y
;
S X="T-485",%DT="" D ^%DT X ^DD("DD")
W ! D EN^DDIOL("Default Starting Date is equal to One Year plus 120 days.","","!")
S %DT("B")=Y,%DT="AEP",%DT("A")="Starting Date: " D ^%DT I Y=-1 G EOJ
S PSOCUTDT=Y
;
W ! K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I POP W !,"Nothing Printed" G EOJ
I $D(IO("Q")) D G EOJ
.S ZTRTN="EN^PSNOP54",ZTDESC="Report of Possible Non-Reported Drug Interactions",ZTSAVE("RPT")="",ZTSAVE("PSOCUTDT")=""
.S ZTREQ="@" D ^%ZTLOAD W !,"Report"_$S('$D(ZTSK):" NOT ",1:" ")_"Queued to Print!",!
;
EN D BUILD G EOJ
Q
;
BUILD ;build profiles
I '$D(^XTMP("PSNINT")) W !,"The primary data for this report does not exist",!! Q
S PT=0
PT S PSOEXPDT=PSOCUTDT-1 S PT=$O(^PS(55,PT)) G:'PT BUILDX D
.F S PSOEXPDT=$O(^PS(55,PT,"P","A",PSOEXPDT)) Q:'PSOEXPDT F RX=0:0 S RX=$O(^PS(55,PT,"P","A",PSOEXPDT,RX)) Q:'RX I $D(^PSRX(RX,0)) D GET
.D DIDI K ^TMP("PSN PSO",$J)
G PT
BUILDX ;
I $G(RPT)="B" G BUILDXB
S PSONISS=0 D OUT
I $O(^TMP("ZPSN PSOEX",$J,0)) S PSONISS=1 D D OUT
.I RPT'="S" W @IOF
Q
BUILDXB ;
S RPT="R",PSONISS=0 D OUT
I $O(^TMP("ZPSN PSOEX",$J,0)) S PSONISS=1 W @IOF D OUT
S RPT="S",PSONISS=0 D OUT
I $O(^TMP("ZPSN PSOEX",$J,0)) S PSONISS=1 D OUT
Q
GET ;med list
Q:'$P(^PSRX(RX,0),"^",2)!($P(^(0),"^",2)'=PT)!('$P(^(0),"^",6))
S PSORX0=^PSRX(RX,0),RX2=$G(^(2)),PSOST0=+$G(^("STA"))
S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^ACTIVE^^^^^^EXPIRED^DISCONTINUED^MARKED FOR DELETION^DISCONTINUED^DISCONTINUED^HOLD"
S STATUS=$P(STA,"^",(PSOST0+1))
G:PSOST0=13 GETX
S PSODRG=+$P(PSORX0,"^",6)
I '$D(^PSDRUG(PSODRG,0)) G GETX
S PSODRUGN=$P(^PSDRUG(PSODRG,0),"^")
S PSONDF=$S($G(^PSDRUG(PSODRG,"ND"))]"":$P(^PSDRUG(PSODRG,"ND"),"^",3),1:0)
S Y=$P(RX2,"^",2) X ^DD("DD") S FD=Y,Y=$P(RX2,"^",6) X ^DD("DD") S ED=Y
S ^TMP("PSN PSO",$J,RX,0)=$P(^PSRX(RX,0),"^")_"^"_PSODRG_"^"_PSODRUGN_"^"_PSONDF_"^"_STATUS_"^"_FD_"^"_ED
GETX Q
;
EOJ K PSOEXPDT,PSODRG,PSONDF,PSORX0,PSOST0,PSODRUGN,RX,RX2,SS,STA,STATUS
K DIR,DIRUT,DUOUT,DTOUT,RPT,^TMP("PSN PSOEX",$J),XI,XT,PT,PG,X,PSOCUTDT
K ^TMP("PSN PSO",$J),%,%DT,ED,FD,NDF1,NDF2
K ^TMP("ZPSN PSOEX",$J),PSOZZACT,PSOININD,PSOINN1,PSOINN2,PSOISSD1,PSOISSD2,PSOISLAT,PSONISS,PSNVP,PSOSETIN,PSOW,PSOF,PSOG
D ^%ZISC
Q
DIDI ;check for interactions
F XI=0:0 S XI=$O(^TMP("PSN PSO",$J,XI)) Q:'XI S NDF1=+$P(^TMP("PSN PSO",$J,XI,0),"^",4) D
.F XT=0:0 S XT=$O(^TMP("PSN PSO",$J,XT)) Q:'XT I XI'=XT D
..;Q:$G(^TMP("PSN PSO",$J,XI,XT))!($G(^TMP("PSN PSO",$J,XT,XI)))
..S NDF2=+$P(^TMP("PSN PSO",$J,XT,0),"^",4) ;I $G(^XTMP("PSNINT",NDF1,NDF2,1))]""!($G(^XTMP("PSNINT",NDF2,NDF1,1))) D D EXC S ^TMP("PSN PSO",$J,XI,XT)=1
..S PSNVP="" F S PSNVP=$O(^XTMP("PSNINT",NDF1,NDF2,PSNVP)) Q:PSNVP="" I $G(^XTMP("PSNINT",NDF1,NDF2,PSNVP))]""!($G(^XTMP("PSNINT",NDF2,NDF1,PSNVP))]"") D
...K PSOININD,PSOINN1,PSOINN2,PSNW
...S PSOINN1=$P($G(^XTMP("PSNINT",NDF1,NDF2,PSNVP)),"^"),PSOINN2=$P($G(^XTMP("PSNINT",NDF2,NDF1,PSNVP)),"^")
...I '$G(PSOINN1),'$G(PSOINN2) Q
...I PSOINN1 S PSOININD=$P($G(^PS(56,PSOINN1,0)),"^",7) D
....I 'PSOININD K PSOININD
....I '$G(^TMP("PSN PSO",$J,XI,XT,PSOINN1)),'$G(^TMP("PSN PSO",$J,XT,XI,PSOINN1)) S ^TMP("PSN PSO",$J,XI,XT,PSOINN1)=1 S PSOW=PSOINN1 D EXC
...I PSOINN2,PSOINN2'=$G(PSOINN1) S PSOININD=$P($G(^PS(56,PSOINN2,0)),"^",7) D
....I 'PSOININD K PSOININD
....I '$G(^TMP("PSN PSO",$J,XI,XT,PSOINN2)),'$G(^TMP("PSN PSO",$J,XT,XI,PSOINN2)) S ^TMP("PSN PSO",$J,XI,XT,PSOINN2)=1 S PSOW=PSOINN2 D EXC
;^XTMP("PSNINT",14544,46,1) = 846^COLCHICINE/CYCLOSPORINE^7^1363^1^1^228
Q
EXC ;builds exceptions
S PSOZZACT=0 I $G(PSOININD) D
.;find later issue date of the 2 Rx's
.S PSOISSD1=$P($G(^PSRX(XI,0)),"^",13),PSOISSD2=$P($G(^PSRX(XT,0)),"^",13)
.K PSOISLAT I PSOISSD1,'PSOISSD2 S PSOISLAT=PSOISSD1 Q
.I PSOISSD2,'PSOISSD1 S PSOISLAT=PSOISSD2 Q
.S PSOISLAT=$S(PSOISSD2>PSOISSD1:PSOISSD2,1:PSOISSD1)
.I '$G(PSOISLAT) S PSOISLAT=DT
I $G(PSOININD),$G(PSOININD)'>$G(PSOISLAT) S PSOZZACT=1
I '$D(^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0)) D
.S DFN=PT D DEM^VADPT K DFN
.S ^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0)=VADM(1)_"^"_$P(VADM(2),"^",2)_"^"_$P(VADM(3),"^",2)_" ("_VADM(4)_") ("_$P(VADM(5),"^")_")"
.K VADM
S ^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)=$P(^TMP("PSN PSO",$J,XI,0),"^")_"^"_$P(^TMP("PSN PSO",$J,XI,0),"^",3)_"^"_$P(^TMP("PSN PSO",$J,XI,0),"^",5)
S ^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)=^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)_"^"_$P(^TMP("PSN PSO",$J,XT,0),"^")_"^"_$P(^TMP("PSN PSO",$J,XT,0),"^",3)_"^"_$P(^TMP("PSN PSO",$J,XT,0),"^",5)
S ^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)=^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)_"^"_$P(^XTMP("PSNINT",NDF1,NDF2,PSNVP),"^",2)
S ^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)=^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,0)_"^"_$S($P(^XTMP("PSNINT",NDF1,NDF2,PSNVP),"^",5)=1:"Critical",1:"Significant")
S ^TMP($S(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,XI,XT,PSOW,1,0)=$P(^TMP("PSN PSO",$J,XI,0),"^",6)_"^"_$P(^TMP("PSN PSO",$J,XI,0),"^",7)_"^"_$P(^TMP("PSN PSO",$J,XT,0),"^",6)_"^"_$P(^TMP("PSN PSO",$J,XT,0),"^",7)
;Next line, using variables such as X1, so won't call File, Date OK?
I PSOZZACT S ^TMP("ZPSN PSOEX",$J,PT,XI,XT,PSOW,1,0)=$G(^TMP("ZPSN PSOEX",$J,PT,XI,XT,PSOW,1,0))_"^"_$E($G(PSOININD),4,5)_"/"_$E($G(PSOININD),6,7)_"/"_$E($G(PSOININD),2,3)
Q
OUT ;data print
D:RPT'="S" HDR I '$O(^TMP("PSN PSOEX",$J,0)),'$O(^TMP("ZPSN PSOEX",$J,0)) U IO W !!,"NO EXCEPTIONS FOUND!",! Q
I RPT="S" D RPT Q
F PT=0:0 S PT=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT)) Q:'PT D W ! F SS=1:1:IOM-2 W "_"
.I ($Y+7)>IOSL D HDR
.W !,$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),"^"),?40,"PID: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),"^",2),?60,"DOB: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),"^",3)
.F RX=0:0 S RX=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX)) Q:'RX S PSOF="" F S PSOF=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF)) Q:PSOF="" D
..S PSOG="" F S PSOG=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG)) Q:PSOG="" D
...I ($Y+7)>IOSL D HDR W !,$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),"^"),?40,"PID: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),"^",2),?60,"DOB: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),"^",3)
...W !,"Interaction: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",7),?55,"Severity: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",8)
...I PSONISS W !,"Interaction Inactivation Date: "_$P($G(^TMP("ZPSN PSOEX",$J,PT,RX,PSOF,PSOG,1,0)),"^",5)
...W !?5,"Rx#: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^"),?50,"Rx#: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",4)
...W !?5,$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",2),?50,$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",5)
...W !?5,$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",3),?50,$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0),"^",6)
...W !?5,"Filled: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,1,0),"^"),?50,"Filled: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,1,0),"^",3)
...W !?5,"Expires: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,1,0),"^",2),?50,"Expires: "_$P(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,1,0),"^",4),!
Q
RPT U IO W ! F PT=0:0 S PT=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT)) Q:'PT D
.W !,^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,0),! F RX=0:0 S RX=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX)) Q:'RX S PSOF="" F S PSOF=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF)) Q:PSOF="" D
..S PSOG="" F S PSOG=$O(^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG)) Q:PSOG="" D
...W ^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,0)
...W !,^TMP($S(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J,PT,RX,PSOF,PSOG,1,0),!
...I PSONISS W "Interaction inactivated on "_$P($G(^TMP("ZPSN PSOEX",$J,PT,RX,PSOF,PSOG,1,0)),"^",5),!
Q
HDR ;
S PG=$G(PG)+1 D NOW^%DTC S Y=$P(%,".") X ^DD("DD")
U IO W @IOF,"Possible Unreported Drug Interactions",?($X+5),"Print Date: "_Y,?($X+10),"Page: "_PG
I PSONISS W !,"Inactivated Drug Interactions"
W ! F SS=1:1:IOM-2 W "="
W !
Q
PSNOP54 ;BHAM ISC/SAB - build array of outpatient current meds ;14 Dec 01
+1 ;;4.0; NATIONAL DRUG FILE;**54**; 30 Oct 98
+2 ;External reference ^PS(55 supported by DBIA 2191
+3 ;External reference ^PSDRUG( supported by DBIA 2192
+4 ;External reference ^PSRX( supported by DBIA 1977
+5 ;This report searches Outpatient Medications looking for drug
+6 ;interactions based on the data in
+7 ;^XTMP("PSNINT",VA PRODUCT,VA PRODUCT,1)
+8 ;---------------------------------------------------------------
START ;
+1 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
+2 WRITE !,"This report searches Outpatient Medications looking for drug interactions",!,"based on the data in ^XTMP(""PSNINT"",VA PRODUCT,VA PRODUCT,1)",!
+3 KILL ^TMP("PSN PSO",$JOB),^TMP("PSN PSOEX",$JOB),DIR,DIRUT
+4 KILL ^TMP("ZPSN PSOEX",$JOB)
+5 WRITE !
SET DIR(0)="SB^R:REPORT;S:SPREAD SHEET;B:BOTH"
SET DIR("B")="Report"
SET DIR("A")="What format would you like your data"
DO ^DIR
IF $DATA(DIRUT)
GOTO EOJ
SET RPT=Y
+6 ;
+7 SET X="T-485"
SET %DT=""
DO ^%DT
XECUTE ^DD("DD")
+8 WRITE !
DO EN^DDIOL("Default Starting Date is equal to One Year plus 120 days.","","!")
+9 SET %DT("B")=Y
SET %DT="AEP"
SET %DT("A")="Starting Date: "
DO ^%DT
IF Y=-1
GOTO EOJ
+10 SET PSOCUTDT=Y
+11 ;
+12 WRITE !
KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF POP
WRITE !,"Nothing Printed"
GOTO EOJ
+13 IF $DATA(IO("Q"))
Begin DoDot:1
+14 SET ZTRTN="EN^PSNOP54"
SET ZTDESC="Report of Possible Non-Reported Drug Interactions"
SET ZTSAVE("RPT")=""
SET ZTSAVE("PSOCUTDT")=""
+15 SET ZTREQ="@"
DO ^%ZTLOAD
WRITE !,"Report"_$SELECT('$DATA(ZTSK):" NOT ",1:" ")_"Queued to Print!",!
End DoDot:1
GOTO EOJ
+16 ;
EN DO BUILD
GOTO EOJ
+1 QUIT
+2 ;
BUILD ;build profiles
+1 IF '$DATA(^XTMP("PSNINT"))
WRITE !,"The primary data for this report does not exist",!!
QUIT
+2 SET PT=0
PT SET PSOEXPDT=PSOCUTDT-1
SET PT=$ORDER(^PS(55,PT))
IF 'PT
GOTO BUILDX
Begin DoDot:1
+1 FOR
SET PSOEXPDT=$ORDER(^PS(55,PT,"P","A",PSOEXPDT))
IF 'PSOEXPDT
QUIT
FOR RX=0:0
SET RX=$ORDER(^PS(55,PT,"P","A",PSOEXPDT,RX))
IF 'RX
QUIT
IF $DATA(^PSRX(RX,0))
DO GET
+2 DO DIDI
KILL ^TMP("PSN PSO",$JOB)
End DoDot:1
+3 GOTO PT
BUILDX ;
+1 IF $GET(RPT)="B"
GOTO BUILDXB
+2 SET PSONISS=0
DO OUT
+3 IF $ORDER(^TMP("ZPSN PSOEX",$JOB,0))
SET PSONISS=1
Begin DoDot:1
+4 IF RPT'="S"
WRITE @IOF
End DoDot:1
DO OUT
+5 QUIT
BUILDXB ;
+1 SET RPT="R"
SET PSONISS=0
DO OUT
+2 IF $ORDER(^TMP("ZPSN PSOEX",$JOB,0))
SET PSONISS=1
WRITE @IOF
DO OUT
+3 SET RPT="S"
SET PSONISS=0
DO OUT
+4 IF $ORDER(^TMP("ZPSN PSOEX",$JOB,0))
SET PSONISS=1
DO OUT
+5 QUIT
GET ;med list
+1 IF '$PIECE(^PSRX(RX,0),"^",2)!($PIECE(^(0),"^",2)'=PT)!('$PIECE(^(0),"^",6))
QUIT
+2 SET PSORX0=^PSRX(RX,0)
SET RX2=$GET(^(2))
SET PSOST0=+$GET(^("STA"))
+3 SET STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^ACTIVE^^^^^^EXPIRED^DISCONTINUED^MARKED FOR DELETION^DISCONTINUED^DISCONTINUED^HOLD"
+4 SET STATUS=$PIECE(STA,"^",(PSOST0+1))
+5 IF PSOST0=13
GOTO GETX
+6 SET PSODRG=+$PIECE(PSORX0,"^",6)
+7 IF '$DATA(^PSDRUG(PSODRG,0))
GOTO GETX
+8 SET PSODRUGN=$PIECE(^PSDRUG(PSODRG,0),"^")
+9 SET PSONDF=$SELECT($GET(^PSDRUG(PSODRG,"ND"))]"":$PIECE(^PSDRUG(PSODRG,"ND"),"^",3),1:0)
+10 SET Y=$PIECE(RX2,"^",2)
XECUTE ^DD("DD")
SET FD=Y
SET Y=$PIECE(RX2,"^",6)
XECUTE ^DD("DD")
SET ED=Y
+11 SET ^TMP("PSN PSO",$JOB,RX,0)=$PIECE(^PSRX(RX,0),"^")_"^"_PSODRG_"^"_PSODRUGN_"^"_PSONDF_"^"_STATUS_"^"_FD_"^"_ED
GETX QUIT
+1 ;
EOJ KILL PSOEXPDT,PSODRG,PSONDF,PSORX0,PSOST0,PSODRUGN,RX,RX2,SS,STA,STATUS
+1 KILL DIR,DIRUT,DUOUT,DTOUT,RPT,^TMP("PSN PSOEX",$JOB),XI,XT,PT,PG,X,PSOCUTDT
+2 KILL ^TMP("PSN PSO",$JOB),%,%DT,ED,FD,NDF1,NDF2
+3 KILL ^TMP("ZPSN PSOEX",$JOB),PSOZZACT,PSOININD,PSOINN1,PSOINN2,PSOISSD1,PSOISSD2,PSOISLAT,PSONISS,PSNVP,PSOSETIN,PSOW,PSOF,PSOG
+4 DO ^%ZISC
+5 QUIT
DIDI ;check for interactions
+1 FOR XI=0:0
SET XI=$ORDER(^TMP("PSN PSO",$JOB,XI))
IF 'XI
QUIT
SET NDF1=+$PIECE(^TMP("PSN PSO",$JOB,XI,0),"^",4)
Begin DoDot:1
+2 FOR XT=0:0
SET XT=$ORDER(^TMP("PSN PSO",$JOB,XT))
IF 'XT
QUIT
IF XI'=XT
Begin DoDot:2
+3 ;Q:$G(^TMP("PSN PSO",$J,XI,XT))!($G(^TMP("PSN PSO",$J,XT,XI)))
+4 ;I $G(^XTMP("PSNINT",NDF1,NDF2,1))]""!($G(^XTMP("PSNINT",NDF2,NDF1,1))) D D EXC S ^TMP("PSN PSO",$J,XI,XT)=1
SET NDF2=+$PIECE(^TMP("PSN PSO",$JOB,XT,0),"^",4)
+5 SET PSNVP=""
FOR
SET PSNVP=$ORDER(^XTMP("PSNINT",NDF1,NDF2,PSNVP))
IF PSNVP=""
QUIT
IF $GET">GET(^XTMP("PSNINT",NDF1,NDF2,PSNVP))]""!($GET">GET(^XTMP("PSNINT",NDF2,NDF1,PSNVP))]"")
Begin DoDot:3
+6 KILL PSOININD,PSOINN1,PSOINN2,PSNW
+7 SET PSOINN1=$PIECE($GET(^XTMP("PSNINT",NDF1,NDF2,PSNVP)),"^")
SET PSOINN2=$PIECE($GET(^XTMP("PSNINT",NDF2,NDF1,PSNVP)),"^")
+8 IF '$GET(PSOINN1)
IF '$GET(PSOINN2)
QUIT
+9 IF PSOINN1
SET PSOININD=$PIECE($GET(^PS(56,PSOINN1,0)),"^",7)
Begin DoDot:4
+10 IF 'PSOININD
KILL PSOININD
+11 IF '$GET(^TMP("PSN PSO",$JOB,XI,XT,PSOINN1))
IF '$GET(^TMP("PSN PSO",$JOB,XT,XI,PSOINN1))
SET ^TMP("PSN PSO",$JOB,XI,XT,PSOINN1)=1
SET PSOW=PSOINN1
DO EXC
End DoDot:4
+12 IF PSOINN2
IF PSOINN2'=$GET(PSOINN1)
SET PSOININD=$PIECE($GET(^PS(56,PSOINN2,0)),"^",7)
Begin DoDot:4
+13 IF 'PSOININD
KILL PSOININD
+14 IF '$GET(^TMP("PSN PSO",$JOB,XI,XT,PSOINN2))
IF '$GET(^TMP("PSN PSO",$JOB,XT,XI,PSOINN2))
SET ^TMP("PSN PSO",$JOB,XI,XT,PSOINN2)=1
SET PSOW=PSOINN2
DO EXC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;^XTMP("PSNINT",14544,46,1) = 846^COLCHICINE/CYCLOSPORINE^7^1363^1^1^228
+16 QUIT
EXC ;builds exceptions
+1 SET PSOZZACT=0
IF $GET(PSOININD)
Begin DoDot:1
+2 ;find later issue date of the 2 Rx's
+3 SET PSOISSD1=$PIECE($GET(^PSRX(XI,0)),"^",13)
SET PSOISSD2=$PIECE($GET(^PSRX(XT,0)),"^",13)
+4 KILL PSOISLAT
IF PSOISSD1
IF 'PSOISSD2
SET PSOISLAT=PSOISSD1
QUIT
+5 IF PSOISSD2
IF 'PSOISSD1
SET PSOISLAT=PSOISSD2
QUIT
+6 SET PSOISLAT=$SELECT(PSOISSD2>PSOISSD1:PSOISSD2,1:PSOISSD1)
+7 IF '$GET(PSOISLAT)
SET PSOISLAT=DT
End DoDot:1
+8 IF $GET(PSOININD)
IF $GET">GET(PSOININD)'>$GET">GET(PSOISLAT)
SET PSOZZACT=1
+9 IF '$DATA(^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0))
Begin DoDot:1
+10 SET DFN=PT
DO DEM^VADPT
KILL DFN
+11 SET ^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0)=VADM(1)_"^"_$PIECE(VADM(2),"^",2)_"^"_$PIECE(VADM(3),"^",2)_" ("_VADM(4)_") ("_$PIECE(VADM(5),"^")_")"
+12 KILL VADM
End DoDot:1
+13 SET ^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,0)=$PIECE(^TMP("PSN PSO",$JOB,XI,0),"^")_"^"_$PIECE(^TMP("PSN PSO",$JOB,XI,0),"^",3)_"^"_$PIECE(^TMP("PSN PSO",$JOB,XI,0),"^",5)
+14 SET ^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),...
... $JOB,PT,XI,XT,PSOW,0)=^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,0)_"^"_$PIECE(^TMP("PSN PSO",$JOB,XT,0),"^")_"^"_$PIECE(^TMP("PSN PSO",$JOB,XT,0),"^",3)_"^"_$PIECE(^TMP("PSN PSO",$JOB,XT,0),"^",5)
+15 SET ^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,0)=^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,0)_"^"_$PIECE(^XTMP("PSNINT",NDF1,NDF2,PSNVP),"^",2)
+16 SET ^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,0)=^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,0)_"^"_$SELECT($PIECE(^XTMP("PSNINT",NDF1,NDF2,PSNVP),"^",5)=1:"Critical",1:"Significant")
+17 SET ^TMP($SELECT(PSOZZACT:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,XI,XT,PSOW,1,0)=$PIECE(^TMP("PSN PSO",$JOB,XI,0),"^",6)_"^"_$PIECE(^TMP("PSN PSO",$JOB,XI,0),"^",7)_"^"_$PIECE(^TMP("PSN PSO",$JOB,XT,0),"^",6)_"^"_$PIECE(^TMP("PSN PSO",$JOB,XT,0),"
^",7)
+18 ;Next line, using variables such as X1, so won't call File, Date OK?
+19 IF PSOZZACT
SET ^TMP("ZPSN PSOEX",$JOB,PT,XI,XT,PSOW,1,0)=$GET">GET">GET">GET">GET">GET">GET">GET(^TMP("ZPSN PSOEX",$JOB,PT,XI,XT,PSOW,1,0))_"^"_$EXTRACT($GET">GET">GET">GET">GET">GET">GET">GET(PSOININD),4,5)_"/"_$EXTRACT($GET">GET">GET">GET">GET">GET">GET">GET(PSOININD),6,7)_"/"_$EXTRACT($GET">GET">GET">GET">GET">GET">GET">GET(PSOININD),2,3)
+20 QUIT
OUT ;data print
+1 IF RPT'="S"
DO HDR
IF '$ORDER(^TMP("PSN PSOEX",$JOB,0))
IF '$ORDER(^TMP("ZPSN PSOEX",$JOB,0))
USE IO
WRITE !!,"NO EXCEPTIONS FOUND!",!
QUIT
+2 IF RPT="S"
DO RPT
QUIT
+3 FOR PT=0:0
SET PT=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT))
IF 'PT
QUIT
Begin DoDot:1
+4 IF ($Y+7)>IOSL
DO HDR
+5 WRITE !,$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0),"^"),?40,"PID: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0),"^",2),?60,"DOB: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$J
OB,PT,0),"^",3)
+6 FOR RX=0:0
SET RX=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX))
IF 'RX
QUIT
SET PSOF=""
FOR
SET PSOF=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF))
IF PSOF=""
QUIT
Begin DoDot:2
+7 SET PSOG=""
FOR
SET PSOG=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG))
IF PSOG=""
QUIT
Begin DoDot:3
+8 IF ($Y+7)>IOSL
DO HDR
WRITE !,$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0),"^"),?40,"PID: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0),"^",2),?60,"DOB: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN
PSOEX",1:"PSN PSOEX"),$JOB,PT,0),"^",3)
+9 WRITE !,"Interaction: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",7),?55,"Severity: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",8)
+10 IF PSONISS
WRITE !,"Interaction Inactivation Date: "_$PIECE($GET(^TMP("ZPSN PSOEX",$JOB,PT,RX,PSOF,PSOG,1,0)),"^",5)
+11 WRITE !?5,"Rx#: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^"),?50,"Rx#: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",4)
+12 WRITE !?5,$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",2),?50,$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",5)
+13 WRITE !?5,$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",3),?50,$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0),"^",6)
+14 WRITE !?5,"Filled: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,1,0),"^"),?50,"Filled: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,1,0),"^",3)
+15 WRITE !?5,"Expires: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,1,0),"^",2),?50,"Expires: "_$PIECE(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,1,0),"^",4),
!
End DoDot:3
End DoDot:2
End DoDot:1
WRITE !
FOR SS=1:1:IOM-2
WRITE "_"
+16 QUIT
RPT USE IO
WRITE !
FOR PT=0:0
SET PT=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT))
IF 'PT
QUIT
Begin DoDot:1
+1 WRITE !,^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,0),!
FOR RX=0:0
SET RX=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX))
IF 'RX
QUIT
SET PSOF=""
FOR
SET PSOF=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF))
IF PSOF=""
QUIT
Begin DoDot:2
+2 SET PSOG=""
FOR
SET PSOG=$ORDER(^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG))
IF PSOG=""
QUIT
Begin DoDot:3
+3 WRITE ^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,0)
+4 WRITE !,^TMP($SELECT(PSONISS:"ZPSN PSOEX",1:"PSN PSOEX"),$JOB,PT,RX,PSOF,PSOG,1,0),!
+5 IF PSONISS
WRITE "Interaction inactivated on "_$PIECE($GET(^TMP("ZPSN PSOEX",$JOB,PT,RX,PSOF,PSOG,1,0)),"^",5),!
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
HDR ;
+1 SET PG=$GET(PG)+1
DO NOW^%DTC
SET Y=$PIECE(%,".")
XECUTE ^DD("DD")
+2 USE IO
WRITE @IOF,"Possible Unreported Drug Interactions",?($X+5),"Print Date: "_Y,?($X+10),"Page: "_PG
+3 IF PSONISS
WRITE !,"Inactivated Drug Interactions"
+4 WRITE !
FOR SS=1:1:IOM-2
WRITE "="
+5 WRITE !
+6 QUIT
