PSNOP54.m

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)