PSSDIUTL ;HP/MJE - Drug Interaction Utility ;09/22/11 5:00pm
;;1.0;PHARMACY DATA MANAGEMENT;**169,175,199**;9/30/97;Build 2
;Reference ^PSDRUG supported by DBIA 221
;Reference to XTID is supported DBIS 4631
;Reference to IN^PSSHRQ2 supported by DBIA 5369
CHKFDB ;ping FDB
N BASE
S BASE="PINGTST^"_$T(+0)
K ^TMP($J,BASE),DRGLST
S ^TMP($J,BASE,"IN","PING")=""
D IN^PSSHRQ2(BASE)
D:$G(^TMP($J,BASE,"OUT",0))'=0 Q:$G(^TMP($J,BASE,"OUT",0))'=0
.S DIR(0)="E",DIR("A",1)="The FDB database is not available at this time!"
.S DIR("A",2)="Reason: "_$P($G(^TMP($J,BASE,"OUT",0)),"^",2)
.S DIR("A",4)="Please contact the National Service Desk."
.S DIR("A",5)=""
.S DIR("A")="Press Return to continue...",DIR("?")="Press Return to continue"
.W ! D ^DIR K DIRUT,DUOUT,DIR,X,Y W @IOF
K ^TMP($J,BASE),BASE
N NUM,MON,TEXTSTR S DRGLST=0,NUM=1,TEXTSTR="",PSSDGCK=1 N ID,ORTYP,NDF,DRUG,ON,PSONULN,PSONULN2 S $P(PSONULN,"-",60)="-",$P(PSONULN2,"=",60)="="
K ^TMP($J)
SELECT ;
K:'$G(PSORXED) CLOZPAT
K IT,DIC,X,Y,PSODRUG("TRADE NAME"),PSODRUG("NDC"),PSODRUG("DAW"),PSODRUG("BAD") S:$G(POERR)&($P($G(OR0),"^",9)) Y=$P(^PSDRUG($P(OR0,"^",9),0),"^")
I $G(PSODRUG("IEN"))]"" S Y=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN")
W !,"Drug "_NUM_": "_$S($G(Y)]"":Y_"// ",1:"") R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1
I X="",$G(Y)]"" S:Y X=Y S:'X X=$G(PSODRUG("IEN")) S:X X="`"_X
I X="",DRGLST>1 W !!,"Now Processing Enhanced Order Checks! Please wait...",! H 1 G FDBCALL
I X="",DRGLST<2 W !!,"A minimum of 2 Drugs are required!",! G SELECT
I X?1."?" W !!,"Answer with DRUG NUMBER, or GENERIC NAME, or VA PRODUCT NAME, or",!,"NATIONAL DRUG CLASS, or SYNONYM" G SELECT
I $G(PSORXED),X["^" S PSORXED("DFLG")=1 W ! G SELECTX
I X="^"!(X["^^")!($D(DTOUT)) W ! G SELECTX
S DIC=50,DIC(0)="EMQZVT",DIC("T")="",D="B^C^VAPN^VAC"
S DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$$GCN^PSSDIUTL(+Y),$$PKGFLG^PSSDIUTL($P($G(^PSDRUG(+Y,2)),""^"",3)),$D(^PSDRUG(""ASP"",+$G(^(2)),+Y))"
D MIX^DIC1 K DIC,PKF2,D
I $D(DTOUT) G SELECTX
I $D(DUOUT) K DUOUT G SELECT
I Y<0 G SELECT
S:$G(PSONEW("OLD VAL"))=+Y&('$G(PSOEDIT)) PSODRG("QFLG")=1
K PSOY S PSOY=Y,PSOY(0)=Y(0)
I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE
G:Y<0 SELECT
F DRGLSTI=0:0 S DRGLSTI=$O(DRGLST(DRGLSTI)) Q:'DRGLSTI D
.I DRGLSTI=+Y S DRGLSTF=1
I $D(DRGLSTF) S NUM=DRGLST+1 K DRGLSTF W !!,"You have selected a duplicate drug please enter a different drug.." K DIR,DRGLSTI,Y S DIR(0)="E",DIR("A")="Press Return to Continue..." W ! D ^DIR K DIR G SELECT
S DRGLST=$G(DRGLST)+1,DRGLST(+Y)=Y_"^"_DRGLST,NUM=NUM+1 G SELECT
SELECTX K DIC,X,Y,DTOUT,DUOUT,PSONEW("OLD VAL"),DRGLST
Q
GCN(PSSIENID) ;Return 0 for not matched, 1 for matched with no GCNSEQNO, 1^1 for matched with a GCNSEQNO
N PSSNDFID,PSSGCNPT,PSSGCNID
S PSSNDFID=$P($G(^PSDRUG(PSSIENID,"ND")),"^"),PSSGCNPT=$P($G(^PSDRUG(PSSIENID,"ND")),"^",3)
I 'PSSNDFID!('PSSGCNPT) Q 0
S PSSGCNID=$$PROD0^PSNAPIS(PSSNDFID,PSSGCNPT)
I $P(PSSGCNID,"^",7) Q PSSIENID_";"_PSSNDFID_";"_$P(PSSGCNID,"^",7)
Q PSSIENID_";"_PSSNDFID
PKGFLG(PKF2) ;
I $S(PKF2["O":1,1:0) Q 1
I $S(PKF2["X":1,1:0) Q 1
I $S(PKF2["U":1,1:0) Q 1
I $S(PKF2["I":1,1:0) Q 1
Q 0
TRADE ;
K DIR,DIC,DA,X,Y
S DIR(0)="52,6.5" S:$G(PSOTRN)]"" DIR("B")=$G(PSOTRN) D ^DIR K DIR,DIC
I X="@" S Y=X K DIRUT
I $D(DIRUT) S:$D(DUOUT)!$D(DTOUT)&('$D(PSORX("EDIT"))) PSONEW("DFLG")=1 G TRADEX
S PSODRUG("TRADE NAME")=Y
TRADEX I $G(PSORXED("DFLG")),$D(DIRUT) S PSORXED("DFLG")=1
K DIRUT,DTOUT,DUOUT,X,Y,DA,DR,DIE Q
FDBCALL S LIST="PSOPEPS",^TMP($J,LIST,"IN","DRUGDRUG")=""
F I=0:0 S I=$O(DRGLST(I)) Q:'I D
.S DIEN=$P(DRGLST(I),"^"),DNM=$P(DRGLST(I),"^",2),ON="Z;"_$P(DRGLST(I),"^",3)_";PROSPECTIVE;"_$P(DRGLST(I),"^",3)
.K ID,P1,P2 S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(DIEN,"ND")),"^",3)_",")
.S:ID=0 PSODRUG("IEN")=DIEN
.S P1=$P($G(^PSDRUG(DIEN,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2)
.S SEQN=$P(X,"^",7)
.S ^TMP($J,LIST,"IN","PROSPECTIVE",ON)=SEQN_"^"_ID_"^"_DIEN_"^"_DNM K ID
S ^TMP($J,LIST,"IN","THERAPY")=""
D IN^PSSHRQ2(LIST)
S THSW2=0
I +$G(^TMP($J,LIST,"OUT",0))=1 D PROC
I '$G(^TMP($J,LIST,"OUT",0)) W !,"No drug interactions or therapeutic duplication occurred." W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR G EXIT
I +$G(^TMP($J,LIST,"OUT",0))=-1 W !,"Error: "_$P(^TMP($J,"PSOPEPS","OUT",0),"^",2),! G EXIT
G:'$D(^TMP($J,"PSOPEPS","OUT","THERAPY")) RMON
W !,PSONULN2 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
RMON I $G(MON) D MON I $G(X)="" W ! D RMON
EXIT ;
K DRGLST,DIC,X,Y,ID,ORTYP,DIEN,DNM,PSONULN,PSSDGCK,MON,^TMP($J),LIST,PSODRUG("IEN") Q
PROC ;
I $D(PSODGCK) N PSONULN,PSONULN2,THSW2 S $P(PSONULN,"-",60)="-",$P(PSONULN2,"=",60)="=",THSW2=0
W @IOF K ^UTILITY($J) I $O(^TMP($J,LIST,"OUT","EXCEPTIONS",""))]"" D EXC^PSODDPR5
I '$D(^TMP($J,LIST,"OUT","DRUGDRUG"))&'$D(^TMP($J,LIST,"OUT","THERAPY",1)) W !,"No Order Check Warnings Found",! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
I $D(PSODGCK),'$D(^TMP($J,LIST,"OUT","DRUGDRUG")),$D(^TMP($J,"PSOPEPS","OUT","THERAPY")) G DGCKTHER
D DELDISC^PSSDIUTX I $D(^TMP($J,LIST,"OUT","DRUGDRUG")) W !,"*** DRUG INTERACTION(S) ***",!,PSONULN2,!
N DRG,ON,CT,DRGI,PDRG,SEV,SEVH,STX,INT,CLI,PDRG S (ON,DRG,SV)="",CT=0,SEVH="Critical"
F S SV=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV)) Q:SV="" F S DRG=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG)) Q:DRG="" D
.F S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON)) Q:ON="" F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT D DUP
I $D(^TMP($J,LIST,"OUT","DRUGDRUG")) W !,PSONULN2 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR ;(end of inter data)
DGCKTHER I $D(^TMP($J,"PSOPEPS","OUT","THERAPY")) W @IOF W PSONULN2,!,"*** THERAPEUTIC DUPLICATION(S) ***",! D THER
I $D(PSODGCK),'$D(^TMP($J,LIST,"OUT","DRUGDRUG")),$D(^TMP($J,"PSOPEPS","OUT","THERAPY")) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." W ! D ^DIR K DIR W @IOF Q
DGCKMON I $D(PSODGCK),$D(^TMP($J,LIST,"OUT","DRUGDRUG")),$G(MON) D MON I $G(X)="" W ! D DGCKMON
Q
THER ;
S (THR,THR1,THR2,TCTR,TCLSTR)="" S TALWNUM=0 N TLN,TLN2 S $P(TLN,"=",60)="",$P(TLN2,"-",60)="" S THSW=0
F S THR=$O(^TMP($J,LIST,"OUT","THERAPY",THR)) Q:THR="" D
.S THR1="",TCLSTR=""
.F S THR1=$O(^TMP($J,LIST,"OUT","THERAPY",THR,THR1)) Q:THR1="" D
..S TALWNUM=TALWNUM+$G(^TMP($J,LIST,"OUT","THERAPY",THR,THR1,"ALLOW"))
..S TCLSTR=TCLSTR_$G(^TMP($J,LIST,"OUT","THERAPY",THR,THR1,"CLASS"))
..S:+$O(^TMP($J,LIST,"OUT","THERAPY",THR,THR1))'=0 TCLSTR=TCLSTR_", "
.I TALWNUM=0 I ($Y+8)>IOSL,$E(IOST)="C" D
..K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
.W:THSW !,TLN2 S THSW=1
.I TALWNUM=0 D
..F S TCTR=$O(^TMP($J,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR)) Q:TCTR="" D
...W !,?12,"Drug Name: ",$$THOSTAT^PSSCKOS($P($G(^TMP($J,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR)),U,3),THR,TCTR)
..W !,!,"Duplication Allowance: 0",!,?11,"Drug Class: "
..I $L(TCLSTR)>50 D
...K BSIG N BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
...S BBSIG=TCLSTR,(BVAR,BVAR1)="",III=1
...S ZNT=0 F NNN=1:1:$L(BBSIG) I $E(BBSIG,NNN)=" "!($L(BBSIG)=NNN) S ZNT=ZNT+1 D I $L(BVAR)>50 S BSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1
....S BVAR1=$P(BBSIG," ",(ZNT)),BLIM=BVAR,BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
...I $G(BVAR)'="" S BSIG(III)=BVAR
...I $G(BSIG(1))=""!($G(BSIG(1))=" ") S BSIG(1)=$G(BSIG(2)) K BSIG(2)
..I $L(TCLSTR)>50 D
...S I=""
...F S I=$O(BSIG(I)) Q:'I D
....W:I=1 BSIG(I),! W:I>1 ?23,BSIG(I)
..E D
...W TCLSTR
.I TALWNUM>0 D
..S THR2="",TCLSTR=""
..F S THR2=$O(^TMP($J,LIST,"OUT","THERAPY",THR,THR2)) Q:+THR2=0 D
...F S TCTR=$O(^TMP($J,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR)) Q:TCTR="" D
....W !,?12,"Drug Name: ",$$THOSTAT^PSSCKOS($P($G(^TMP($J,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR)),U,3),THR,TCTR)
...W !,!,"Duplication Allowance: ",$G(^TMP($J,LIST,"OUT","THERAPY",THR,THR2,"ALLOW"))
...K TCLSTR S TCLSTR=^TMP($J,LIST,"OUT","THERAPY",THR,THR2,"CLASS")
...W !,?11,"Drug Class: "
...I $L(TCLSTR)>50 D
....K BSIG N BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
....S BBSIG=TCLSTR,(BVAR,BVAR1)="",III=1
....S ZNT=0 F NNN=1:1:$L(BBSIG) I $E(BBSIG,NNN)=" "!($L(BBSIG)=NNN) S ZNT=ZNT+1 D I $L(BVAR)>50 S BSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1
.....S BVAR1=$P(BBSIG," ",(ZNT)),BLIM=BVAR,BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
....I $G(BVAR)'="" S BSIG(III)=BVAR
....I $G(BSIG(1))=""!($G(BSIG(1))=" ") S BSIG(1)=$G(BSIG(2)) K BSIG(2)
...I $L(TCLSTR)>50 D
....S I=""
....F S I=$O(BSIG(I)) Q:'I D
.....I ($Y+6)>IOSL,$E(IOST)="C" D
......K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
.....W:I=1 BSIG(I),! W:I>1 ?23,BSIG(I),!
...E D
....W TCLSTR,!
...I ($Y+6)>IOSL,$E(IOST)="C" D
....K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR
Q
DUP ;
N PDRGN,DRGN S PDRGN="",DRGN=""
I ($Y+8)>IOSL,$E(IOST)="C" D
.K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
I $O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0)) S MON=1
S PDRG=$P(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)
S CLI=$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"CLIN"))
S SEV=$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV"))
S:SEVH'=SEV PSONULN="",$P(PSONULN,"=",60)="="
I ($Y+6)>IOSL,$E(IOST)="C" D
.K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR
W:THSW2 PSONULN,! S THSW2=1
SET PDRGN=$$POSTAT^PSSCKOS(DRG,PDRG,SV,ON,CT),DRGN=$$OSTAT^PSSCKOS(DRG,ON)
W "***"_SEV_"*** Drug Interaction with ",!,DRGN_" and" W:SEV="Critical" !,PDRGN,!! W:SEV="Significant" !,PDRGN,!!
S:SEVH'=SEV PSONULN="",$P(PSONULN,"-",60)="-"
S SEVH=SEV
I $L(CLI)>70 D
.K BSIG N BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
.S BBSIG=CLI,(BVAR,BVAR1)="",III=1
.S ZNT=0 F NNN=1:1:$L(BBSIG) I $E(BBSIG,NNN)=" "!($L(BBSIG)=NNN) S ZNT=ZNT+1 D I $L(BVAR)>70 S BSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1
..S BVAR1=$P(BBSIG," ",(ZNT)),BLIM=BVAR,BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
.I $G(BVAR)'="" S BSIG(III)=BVAR
.I $G(BSIG(1))=""!($G(BSIG(1))=" ") S BSIG(1)=$G(BSIG(2)) K BSIG(2)
I $L(CLI)>70 D
.S I=""
.F S I=$O(BSIG(I)) Q:'I D
..W BSIG(I),!
E D
.W CLI,!
K BSIG,BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
Q
MON ;
I '$G(DUOUT) W ! K DIR S DIR("A")="Display Professional Interaction Monograph",DIR("B")="NO",DIR(0)="Y",DIR("?")="Enter Y if you would like to see the Monograph." D ^DIR W !
I X="^"!(X["^^")!($D(DTOUT)) Q
K SEL,DIR,DTOUT,DUOUT,DIRUT Q:Y=0
S MONT=1,SEL=1 K Y D BLD Q:$G(SEL)=0
K IOP,%ZIS,POP S %ZIS="QM" W ! D ^%ZIS
I POP K SEL,DIR,DTOUT,DUOUT,DIRUT,MONT W !,"NOTHING PRINTED" G MON
I $D(IO("Q")) D Q
.S ZTRTN="OUT^PSOIDPRE",ZTDESC="Monograph Report of Drug Interactions",ZTSAVE("MONT")=""
.S ZTSAVE("PSONULN")="",ZTSAVE("LIST")="",ZTSAVE("^TMP($J,LIST,""OUT"",""DRUGDRUG"",")="",ZTSAVE("^TMP($J,""PSOMONP"",")=""
.D ^%ZTLOAD,^%ZISC W !,"Monograph Queued to Print!",! S:$D(ZTQUEUED) ZTREQ="Q"
D OUT,^%ZISC
W ! G:Y'=0 MON
Q
OUT ;print monograph
N DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PDRG,RNG,QX
D:MONT=1 PROF D:MONT=2 CON D:MONT=3 PROF
Q
BLD ;
K SEL,X,Y,DRG,ON,CT,RNG,^TMP($J,"PSOMON"),^TMP($J,"PSOMONP") S (DRG,ON,SV)="",CT=0
F S SV=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV)) Q:SV="" F S DRG=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG)) Q:DRG="" F S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON)) Q:ON="" D
.F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT I $O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0)) D
..S RNG=$G(RNG)+1
..S ^TMP($J,"PSOMON",RNG,DRG)=DRG_"^"_ON_"^"_CT_"^"_$P(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)_"^"_$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV"))
I '$D(^TMP($J,"PSOMON",2)) S Y=1 G ONEMONO
K DIR S IND=0,DRG=""
;F S IND=$O(^TMP($J,"PSOMON",IND)) Q:'IND F S DRG=$O(^TMP($J,"PSOMON",IND,DRG)) Q:DRG="" S DIR("A",IND)=IND_". "_DRG_" and "_$P(^TMP($J,"PSOMON",IND,DRG),"^",4) S DIR("A",IND+1)=""
F S IND=$O(^TMP($J,"PSOMON",IND)) Q:'IND F S DRG=$O(^TMP($J,"PSOMON",IND,DRG)) Q:DRG="" D
.I ($Y+6)>IOSL,$E(IOST)="C" D
..W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
.W !,IND_". "_DRG_" and "_$P(^TMP($J,"PSOMON",IND,DRG),"^",4)
W ! S DIR("A")="Select Monograph for printing by number",DIR(0)="LO^1:"_RNG D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT))!(X="^")!(X="") S SEL=0 Q
ONEMONO F G=1:1:$L(Y) Q:$P(Y,",",G)="" S DRG=$O(^TMP($J,"PSOMON",$P(Y,",",G),"")),^TMP($J,"PSOMONP",$P(Y,",",G),0)=^TMP($J,"PSOMON",$P(Y,",",G),DRG)
K ^TMP($J,"PSOMON")
Q
;
NEWPG ;new page form feed
N DIR
S DIR(0)="E",DIR("A")="Press Return to Continue or ""^"" to Exit"
D ^DIR Q:($D(DUOUT)!($D(DTOUT)))
W @IOF,$S($G(MONT)=2:"Consumer",1:"Professional")_" Monograph",!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!!
Q
;
FORMAT ; WATCH OUT WITH CHANGES HERE!!!
K BSIG,XX N BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
I $L(TEXTSTR)'>70 D
. W ?5,TEXTSTR,!
I $L(TEXTSTR)>70 D
.S BBSIG=TEXTSTR,(BVAR,BVAR1)="",III=1
.S ZNT=0 F NNN=1:1:$L(BBSIG) I $E(BBSIG,NNN)=" "!($L(BBSIG)=NNN) S ZNT=ZNT+1 D I $L(BVAR)>70 S BSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1
..S BVAR1=$P(BBSIG," ",(ZNT)),BLIM=BVAR,BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
.I $G(BVAR)'="" S BSIG(III)=BVAR
.I $G(BSIG(1))=""!($G(BSIG(1))=" ") S BSIG(1)=$G(BSIG(2)) K BSIG(2)
F XX=0:0 S XX=$O(BSIG(XX)) Q:'XX D Q:($D(DUOUT)!($D(DTOUT)))
. I $Y+6>IOSL,$E(IOST)="C" D NEWPG Q:($D(DUOUT)!($D(DTOUT)))
. W ?5,BSIG(XX),!
K BSIG,BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM S TEXTSTR=""
Q
PROF ;
F I=0:0 S I=$O(^TMP($J,"PSOMONP",I)) Q:'I S DRG=$P(^TMP($J,"PSOMONP",I,0),"^"),ON=$P(^(0),"^",2),CT=$P(^(0),"^",3),PDRG=$P(^(0),"^",4),SEV=$E($P(^(0),"^",5),1,1) D Q:$D(DUOUT)!($D(DTOUT))
.U IO W @IOF,!,PSONULN,!,"Professional Monograph",!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!!
.F QX=0:0 S QX=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"PMON",QX)) Q:'QX D Q:($D(DUOUT)!($D(DTOUT)))
..I $Y+6>IOSL,$E(IOST)="C" D NEWPG Q:($D(DUOUT)!($D(DTOUT)))
..S TEXTSTR=^TMP($J,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"PMON",QX,0) D FORMAT
..I ($Y+6)>IOSL,$E(IOST)="C" W !
Q:($D(DUOUT)!($D(DTOUT)))
K DTOUT,DUOUT
D:MONT=3
.U IO W @IOF,!,PSONULN,!,"Consumer Monograph",!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!
.F QX=0:0 S QX=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"CMON",QX)) Q:'QX D Q:($D(DUOUT)!($D(DTOUT)))
..I $Y+6>IOSL,$E(IOST)="C" D NEWPG Q:($D(DUOUT)!($D(DTOUT)))
..W !?5,^TMP($J,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"CMON",QX,0)
W !,PSONULN,!
K DTOUT,DUOUT I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR,DTOUT,DUOUT
Q
CON F I=0:0 S I=$O(^TMP($J,"PSOMONP",I)) Q:'I S DRG=$P(^TMP($J,"PSOMONP",I,0),"^"),ON=$P(^(0),"^",2),CT=$P(^(0),"^",3),PDRG=$P(^(0),"^",4),SEV=$P(^(0),"^",5) D Q:$D(DUOUT)!($D(DTOUT))
.U IO W @IOF,!,"Consumer Monograph",!,PSONULN,!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!!
.F QX=0:0 S QX=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"CMON",QX)) Q:'QX D Q:($D(DUOUT)!($D(DTOUT)))
..I $Y+6>IOSL,$E(IOST)="C" D NEWPG Q:($D(DUOUT)!($D(DTOUT)))
..W !?5,^TMP($J,LIST,"OUT","DRUGDRUG",DRG,ON,CT,"CMON",QX,0)
I '$G(DUOUT) W !,PSONULN,!
K DTOUT,DUOUT I $E(IOST)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR,DTOUT,DUOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDIUTL 15514 printed Oct 16, 2024@18:31:36 Page 2
PSSDIUTL ;HP/MJE - Drug Interaction Utility ;09/22/11 5:00pm
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**169,175,199**;9/30/97;Build 2
+2 ;Reference ^PSDRUG supported by DBIA 221
+3 ;Reference to XTID is supported DBIS 4631
+4 ;Reference to IN^PSSHRQ2 supported by DBIA 5369
CHKFDB ;ping FDB
+1 NEW BASE
+2 SET BASE="PINGTST^"_$TEXT(+0)
+3 KILL ^TMP($JOB,BASE),DRGLST
+4 SET ^TMP($JOB,BASE,"IN","PING")=""
+5 DO IN^PSSHRQ2(BASE)
+6 if $GET(^TMP($JOB,BASE,"OUT",0))'=0
Begin DoDot:1
+7 SET DIR(0)="E"
SET DIR("A",1)="The FDB database is not available at this time!"
+8 SET DIR("A",2)="Reason: "_$PIECE($GET(^TMP($JOB,BASE,"OUT",0)),"^",2)
+9 SET DIR("A",4)="Please contact the National Service Desk."
+10 SET DIR("A",5)=""
+11 SET DIR("A")="Press Return to continue..."
SET DIR("?")="Press Return to continue"
+12 WRITE !
DO ^DIR
KILL DIRUT,DUOUT,DIR,X,Y
WRITE @IOF
End DoDot:1
if $GET(^TMP($JOB,BASE,"OUT",0))'=0
QUIT
+13 KILL ^TMP($JOB,BASE),BASE
+14 NEW NUM,MON,TEXTSTR
SET DRGLST=0
SET NUM=1
SET TEXTSTR=""
SET PSSDGCK=1
NEW ID,ORTYP,NDF,DRUG,ON,PSONULN,PSONULN2
SET $PIECE(PSONULN,"-",60)="-"
SET $PIECE(PSONULN2,"=",60)="="
+15 KILL ^TMP($JOB)
SELECT ;
+1 if '$GET(PSORXED)
KILL CLOZPAT
+2 KILL IT,DIC,X,Y,PSODRUG("TRADE NAME"),PSODRUG("NDC"),PSODRUG("DAW"),PSODRUG("BAD")
if $GET(POERR)&($PIECE($GET(OR0),"^",9))
SET Y=$PIECE(^PSDRUG($PIECE(OR0,"^",9),0),"^")
+3 IF $GET(PSODRUG("IEN"))]""
SET Y=PSODRUG("NAME")
SET PSONEW("OLD VAL")=PSODRUG("IEN")
+4 WRITE !,"Drug "_NUM_": "_$SELECT($GET(Y)]"":Y_"// ",1:"")
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET DTOUT=1
+5 IF X=""
IF $GET(Y)]""
if Y
SET X=Y
if 'X
SET X=$GET(PSODRUG("IEN"))
if X
SET X="`"_X
+6 IF X=""
IF DRGLST>1
WRITE !!,"Now Processing Enhanced Order Checks! Please wait...",!
HANG 1
GOTO FDBCALL
+7 IF X=""
IF DRGLST<2
WRITE !!,"A minimum of 2 Drugs are required!",!
GOTO SELECT
+8 IF X?1."?"
WRITE !!,"Answer with DRUG NUMBER, or GENERIC NAME, or VA PRODUCT NAME, or",!,"NATIONAL DRUG CLASS, or SYNONYM"
GOTO SELECT
+9 IF $GET(PSORXED)
IF X["^"
SET PSORXED("DFLG")=1
WRITE !
GOTO SELECTX
+10 IF X="^"!(X["^^")!($DATA(DTOUT))
WRITE !
GOTO SELECTX
+11 SET DIC=50
SET DIC(0)="EMQZVT"
SET DIC("T")=""
SET D="B^C^VAPN^VAC"
+12 SET DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$$GCN^PSSDIUTL(+Y),$$PKGFLG^PSSDIUTL($P($G(^PSDRUG(+Y,2)),""^"",3)),$D(^PSDRUG(""ASP"",+$G(^(2)),+Y))"
+13 DO MIX^DIC1
KILL DIC,PKF2,D
+14 IF $DATA(DTOUT)
GOTO SELECTX
+15 IF $DATA(DUOUT)
KILL DUOUT
GOTO SELECT
+16 IF Y<0
GOTO SELECT
+17 if $GET(PSONEW("OLD VAL"))=+Y&('$GET(PSOEDIT))
SET PSODRG("QFLG")=1
+18 KILL PSOY
SET PSOY=Y
SET PSOY(0)=Y(0)
+19 IF $PIECE(PSOY(0),"^")="OTHER DRUG"!($PIECE(PSOY(0),"^")="OUTSIDE DRUG")
DO TRADE
+20 if Y<0
GOTO SELECT
+21 FOR DRGLSTI=0:0
SET DRGLSTI=$ORDER(DRGLST(DRGLSTI))
if 'DRGLSTI
QUIT
Begin DoDot:1
+22 IF DRGLSTI=+Y
SET DRGLSTF=1
End DoDot:1
+23 IF $DATA(DRGLSTF)
SET NUM=DRGLST+1
KILL DRGLSTF
WRITE !!,"You have selected a duplicate drug please enter a different drug.."
KILL DIR,DRGLSTI,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
WRITE !
DO ^DIR
KILL DIR
GOTO SELECT
+24 SET DRGLST=$GET(DRGLST)+1
SET DRGLST(+Y)=Y_"^"_DRGLST
SET NUM=NUM+1
GOTO SELECT
SELECTX KILL DIC,X,Y,DTOUT,DUOUT,PSONEW("OLD VAL"),DRGLST
+1 QUIT
GCN(PSSIENID) ;Return 0 for not matched, 1 for matched with no GCNSEQNO, 1^1 for matched with a GCNSEQNO
+1 NEW PSSNDFID,PSSGCNPT,PSSGCNID
+2 SET PSSNDFID=$PIECE($GET(^PSDRUG(PSSIENID,"ND")),"^")
SET PSSGCNPT=$PIECE($GET(^PSDRUG(PSSIENID,"ND")),"^",3)
+3 IF 'PSSNDFID!('PSSGCNPT)
QUIT 0
+4 SET PSSGCNID=$$PROD0^PSNAPIS(PSSNDFID,PSSGCNPT)
+5 IF $PIECE(PSSGCNID,"^",7)
QUIT PSSIENID_";"_PSSNDFID_";"_$PIECE(PSSGCNID,"^",7)
+6 QUIT PSSIENID_";"_PSSNDFID
PKGFLG(PKF2) ;
+1 IF $SELECT(PKF2["O":1,1:0)
QUIT 1
+2 IF $SELECT(PKF2["X":1,1:0)
QUIT 1
+3 IF $SELECT(PKF2["U":1,1:0)
QUIT 1
+4 IF $SELECT(PKF2["I":1,1:0)
QUIT 1
+5 QUIT 0
TRADE ;
+1 KILL DIR,DIC,DA,X,Y
+2 SET DIR(0)="52,6.5"
if $GET(PSOTRN)]""
SET DIR("B")=$GET(PSOTRN)
DO ^DIR
KILL DIR,DIC
+3 IF X="@"
SET Y=X
KILL DIRUT
+4 IF $DATA(DIRUT)
if $DATA(DUOUT)!$DATA(DTOUT)&('$DATA(PSORX("EDIT")))
SET PSONEW("DFLG")=1
GOTO TRADEX
+5 SET PSODRUG("TRADE NAME")=Y
TRADEX IF $GET(PSORXED("DFLG"))
IF $DATA(DIRUT)
SET PSORXED("DFLG")=1
+1 KILL DIRUT,DTOUT,DUOUT,X,Y,DA,DR,DIE
QUIT
FDBCALL SET LIST="PSOPEPS"
SET ^TMP($JOB,LIST,"IN","DRUGDRUG")=""
+1 FOR I=0:0
SET I=$ORDER(DRGLST(I))
if 'I
QUIT
Begin DoDot:1
+2 SET DIEN=$PIECE(DRGLST(I),"^")
SET DNM=$PIECE(DRGLST(I),"^",2)
SET ON="Z;"_$PIECE(DRGLST(I),"^",3)_";PROSPECTIVE;"_$PIECE(DRGLST(I),"^",3)
+3 KILL ID,P1,P2
SET ID=+$$GETVUID^XTID(50.68,,+$PIECE($GET(^PSDRUG(DIEN,"ND")),"^",3)_",")
+4 if ID=0
SET PSODRUG("IEN")=DIEN
+5 SET P1=$PIECE($GET(^PSDRUG(DIEN,"ND")),"^")
SET P2=$PIECE($GET(^("ND")),"^",3)
SET X=$$PROD0^PSNAPIS(P1,P2)
+6 SET SEQN=$PIECE(X,"^",7)
+7 SET ^TMP($JOB,LIST,"IN","PROSPECTIVE",ON)=SEQN_"^"_ID_"^"_DIEN_"^"_DNM
KILL ID
End DoDot:1
+8 SET ^TMP($JOB,LIST,"IN","THERAPY")=""
+9 DO IN^PSSHRQ2(LIST)
+10 SET THSW2=0
+11 IF +$GET(^TMP($JOB,LIST,"OUT",0))=1
DO PROC
+12 IF '$GET(^TMP($JOB,LIST,"OUT",0))
WRITE !,"No drug interactions or therapeutic duplication occurred."
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
GOTO EXIT
+13 IF +$GET(^TMP($JOB,LIST,"OUT",0))=-1
WRITE !,"Error: "_$PIECE(^TMP($JOB,"PSOPEPS","OUT",0),"^",2),!
GOTO EXIT
+14 if '$DATA(^TMP($JOB,"PSOPEPS","OUT","THERAPY"))
GOTO RMON
+15 WRITE !,PSONULN2
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
RMON IF $GET(MON)
DO MON
IF $GET(X)=""
WRITE !
DO RMON
EXIT ;
+1 KILL DRGLST,DIC,X,Y,ID,ORTYP,DIEN,DNM,PSONULN,PSSDGCK,MON,^TMP($JOB),LIST,PSODRUG("IEN")
QUIT
PROC ;
+1 IF $DATA(PSODGCK)
NEW PSONULN,PSONULN2,THSW2
SET $PIECE(PSONULN,"-",60)="-"
SET $PIECE(PSONULN2,"=",60)="="
SET THSW2=0
+2 WRITE @IOF
KILL ^UTILITY($JOB)
IF $ORDER(^TMP($JOB,LIST,"OUT","EXCEPTIONS",""))]""
DO EXC^PSODDPR5
+3 IF '$DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG"))&'$DATA(^TMP($JOB,LIST,"OUT","THERAPY",1))
WRITE !,"No Order Check Warnings Found",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
+4 IF $DATA(PSODGCK)
IF '$DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG"))
IF $DATA(^TMP($JOB,"PSOPEPS","OUT","THERAPY"))
GOTO DGCKTHER
+5 DO DELDISC^PSSDIUTX
IF $DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG"))
WRITE !,"*** DRUG INTERACTION(S) ***",!,PSONULN2,!
+6 NEW DRG,ON,CT,DRGI,PDRG,SEV,SEVH,STX,INT,CLI,PDRG
SET (ON,DRG,SV)=""
SET CT=0
SET SEVH="Critical"
+7 FOR
SET SV=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV))
if SV=""
QUIT
FOR
SET DRG=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG))
if DRG=""
QUIT
Begin DoDot:1
+8 FOR
SET ON=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON))
if ON=""
QUIT
FOR
SET CT=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT))
if 'CT
QUIT
DO DUP
End DoDot:1
+9 ;(end of inter data)
IF $DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG"))
WRITE !,PSONULN2
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
DGCKTHER IF $DATA(^TMP($JOB,"PSOPEPS","OUT","THERAPY"))
WRITE @IOF
WRITE PSONULN2,!,"*** THERAPEUTIC DUPLICATION(S) ***",!
DO THER
+1 IF $DATA(PSODGCK)
IF '$DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG"))
IF $DATA(^TMP($JOB,"PSOPEPS","OUT","THERAPY"))
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
WRITE !
DO ^DIR
KILL DIR
WRITE @IOF
QUIT
DGCKMON IF $DATA(PSODGCK)
IF $DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG"))
IF $GET(MON)
DO MON
IF $GET(X)=""
WRITE !
DO DGCKMON
+1 QUIT
THER ;
+1 SET (THR,THR1,THR2,TCTR,TCLSTR)=""
SET TALWNUM=0
NEW TLN,TLN2
SET $PIECE(TLN,"=",60)=""
SET $PIECE(TLN2,"-",60)=""
SET THSW=0
+2 FOR
SET THR=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",THR))
if THR=""
QUIT
Begin DoDot:1
+3 SET THR1=""
SET TCLSTR=""
+4 FOR
SET THR1=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",THR,THR1))
if THR1=""
QUIT
Begin DoDot:2
+5 SET TALWNUM=TALWNUM+$GET(^TMP($JOB,LIST,"OUT","THERAPY",THR,THR1,"ALLOW"))
+6 SET TCLSTR=TCLSTR_$GET(^TMP($JOB,LIST,"OUT","THERAPY",THR,THR1,"CLASS"))
+7 if +$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",THR,THR1))'=0
SET TCLSTR=TCLSTR_", "
End DoDot:2
+8 IF TALWNUM=0
IF ($Y+8)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:2
+9 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:2
+10 if THSW
WRITE !,TLN2
SET THSW=1
+11 IF TALWNUM=0
Begin DoDot:2
+12 FOR
SET TCTR=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR))
if TCTR=""
QUIT
Begin DoDot:3
+13 WRITE !,?12,"Drug Name: ",$$THOSTAT^PSSCKOS($PIECE($GET(^TMP($JOB,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR)),U,3),THR,TCTR)
End DoDot:3
+14 WRITE !,!,"Duplication Allowance: 0",!,?11,"Drug Class: "
+15 IF $LENGTH(TCLSTR)>50
Begin DoDot:3
+16 KILL BSIG
NEW BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
+17 SET BBSIG=TCLSTR
SET (BVAR,BVAR1)=""
SET III=1
+18 SET ZNT=0
FOR NNN=1:1:$LENGTH(BBSIG)
IF $EXTRACT(BBSIG,NNN)=" "!($LENGTH(BBSIG)=NNN)
SET ZNT=ZNT+1
Begin DoDot:4
+19 SET BVAR1=$PIECE(BBSIG," ",(ZNT))
SET BLIM=BVAR
SET BVAR=$SELECT(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
End DoDot:4
IF $LENGTH(BVAR)>50
SET BSIG(III)=BLIM_" "
SET III=III+1
SET BVAR=BVAR1
+20 IF $GET(BVAR)'=""
SET BSIG(III)=BVAR
+21 IF $GET(BSIG(1))=""!($GET(BSIG(1))=" ")
SET BSIG(1)=$GET(BSIG(2))
KILL BSIG(2)
End DoDot:3
+22 IF $LENGTH(TCLSTR)>50
Begin DoDot:3
+23 SET I=""
+24 FOR
SET I=$ORDER(BSIG(I))
if 'I
QUIT
Begin DoDot:4
+25 if I=1
WRITE BSIG(I),!
if I>1
WRITE ?23,BSIG(I)
End DoDot:4
End DoDot:3
+26 IF '$TEST
Begin DoDot:3
+27 WRITE TCLSTR
End DoDot:3
End DoDot:2
+28 IF TALWNUM>0
Begin DoDot:2
+29 SET THR2=""
SET TCLSTR=""
+30 FOR
SET THR2=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",THR,THR2))
if +THR2=0
QUIT
Begin DoDot:3
+31 FOR
SET TCTR=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR))
if TCTR=""
QUIT
Begin DoDot:4
+32 WRITE !,?12,"Drug Name: ",$$THOSTAT^PSSCKOS($PIECE($GET(^TMP($JOB,LIST,"OUT","THERAPY",THR,"DRUGS",TCTR)),U,3),THR,TCTR)
End DoDot:4
+33 WRITE !,!,"Duplication Allowance: ",$GET(^TMP($JOB,LIST,"OUT","THERAPY",THR,THR2,"ALLOW"))
+34 KILL TCLSTR
SET TCLSTR=^TMP($JOB,LIST,"OUT","THERAPY",THR,THR2,"CLASS")
+35 WRITE !,?11,"Drug Class: "
+36 IF $LENGTH(TCLSTR)>50
Begin DoDot:4
+37 KILL BSIG
NEW BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
+38 SET BBSIG=TCLSTR
SET (BVAR,BVAR1)=""
SET III=1
+39 SET ZNT=0
FOR NNN=1:1:$LENGTH(BBSIG)
IF $EXTRACT(BBSIG,NNN)=" "!($LENGTH(BBSIG)=NNN)
SET ZNT=ZNT+1
Begin DoDot:5
+40 SET BVAR1=$PIECE(BBSIG," ",(ZNT))
SET BLIM=BVAR
SET BVAR=$SELECT(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
End DoDot:5
IF $LENGTH(BVAR)>50
SET BSIG(III)=BLIM_" "
SET III=III+1
SET BVAR=BVAR1
+41 IF $GET(BVAR)'=""
SET BSIG(III)=BVAR
+42 IF $GET(BSIG(1))=""!($GET(BSIG(1))=" ")
SET BSIG(1)=$GET(BSIG(2))
KILL BSIG(2)
End DoDot:4
+43 IF $LENGTH(TCLSTR)>50
Begin DoDot:4
+44 SET I=""
+45 FOR
SET I=$ORDER(BSIG(I))
if 'I
QUIT
Begin DoDot:5
+46 IF ($Y+6)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:6
+47 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:6
+48 if I=1
WRITE BSIG(I),!
if I>1
WRITE ?23,BSIG(I),!
End DoDot:5
End DoDot:4
+49 IF '$TEST
Begin DoDot:4
+50 WRITE TCLSTR,!
End DoDot:4
+51 IF ($Y+6)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:4
+52 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+53 QUIT
DUP ;
+1 NEW PDRGN,DRGN
SET PDRGN=""
SET DRGN=""
+2 IF ($Y+8)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+3 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:1
+4 IF $ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0))
SET MON=1
+5 SET PDRG=$PIECE(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)
+6 SET CLI=$GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"CLIN"))
+7 SET SEV=$GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV"))
+8 if SEVH'=SEV
SET PSONULN=""
SET $PIECE(PSONULN,"=",60)="="
+9 IF ($Y+6)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+10 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
End DoDot:1
+11 if THSW2
WRITE PSONULN,!
SET THSW2=1
+12 SET PDRGN=$$POSTAT^PSSCKOS(DRG,PDRG,SV,ON,CT)
SET DRGN=$$OSTAT^PSSCKOS(DRG,ON)
+13 WRITE "***"_SEV_"*** Drug Interaction with ",!,DRGN_" and"
if SEV="Critical"
WRITE !,PDRGN,!!
if SEV="Significant"
WRITE !,PDRGN,!!
+14 if SEVH'=SEV
SET PSONULN=""
SET $PIECE(PSONULN,"-",60)="-"
+15 SET SEVH=SEV
+16 IF $LENGTH(CLI)>70
Begin DoDot:1
+17 KILL BSIG
NEW BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
+18 SET BBSIG=CLI
SET (BVAR,BVAR1)=""
SET III=1
+19 SET ZNT=0
FOR NNN=1:1:$LENGTH(BBSIG)
IF $EXTRACT(BBSIG,NNN)=" "!($LENGTH(BBSIG)=NNN)
SET ZNT=ZNT+1
Begin DoDot:2
+20 SET BVAR1=$PIECE(BBSIG," ",(ZNT))
SET BLIM=BVAR
SET BVAR=$SELECT(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
End DoDot:2
IF $LENGTH(BVAR)>70
SET BSIG(III)=BLIM_" "
SET III=III+1
SET BVAR=BVAR1
+21 IF $GET(BVAR)'=""
SET BSIG(III)=BVAR
+22 IF $GET(BSIG(1))=""!($GET(BSIG(1))=" ")
SET BSIG(1)=$GET(BSIG(2))
KILL BSIG(2)
End DoDot:1
+23 IF $LENGTH(CLI)>70
Begin DoDot:1
+24 SET I=""
+25 FOR
SET I=$ORDER(BSIG(I))
if 'I
QUIT
Begin DoDot:2
+26 WRITE BSIG(I),!
End DoDot:2
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 WRITE CLI,!
End DoDot:1
+29 KILL BSIG,BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
+30 QUIT
MON ;
+1 IF '$GET(DUOUT)
WRITE !
KILL DIR
SET DIR("A")="Display Professional Interaction Monograph"
SET DIR("B")="NO"
SET DIR(0)="Y"
SET DIR("?")="Enter Y if you would like to see the Monograph."
DO ^DIR
WRITE !
+2 IF X="^"!(X["^^")!($DATA(DTOUT))
QUIT
+3 KILL SEL,DIR,DTOUT,DUOUT,DIRUT
if Y=0
QUIT
+4 SET MONT=1
SET SEL=1
KILL Y
DO BLD
if $GET(SEL)=0
QUIT
+5 KILL IOP,%ZIS,POP
SET %ZIS="QM"
WRITE !
DO ^%ZIS
+6 IF POP
KILL SEL,DIR,DTOUT,DUOUT,DIRUT,MONT
WRITE !,"NOTHING PRINTED"
GOTO MON
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="OUT^PSOIDPRE"
SET ZTDESC="Monograph Report of Drug Interactions"
SET ZTSAVE("MONT")=""
+9 SET ZTSAVE("PSONULN")=""
SET ZTSAVE("LIST")=""
SET ZTSAVE("^TMP($J,LIST,""OUT"",""DRUGDRUG"",")=""
SET ZTSAVE("^TMP($J,""PSOMONP"",")=""
+10 DO ^%ZTLOAD
DO ^%ZISC
WRITE !,"Monograph Queued to Print!",!
if $DATA(ZTQUEUED)
SET ZTREQ="Q"
End DoDot:1
QUIT
+11 DO OUT
DO ^%ZISC
+12 WRITE !
if Y'=0
GOTO MON
+13 QUIT
OUT ;print monograph
+1 NEW DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PDRG,RNG,QX
+2 if MONT=1
DO PROF
if MONT=2
DO CON
if MONT=3
DO PROF
+3 QUIT
BLD ;
+1 KILL SEL,X,Y,DRG,ON,CT,RNG,^TMP($JOB,"PSOMON"),^TMP($JOB,"PSOMONP")
SET (DRG,ON,SV)=""
SET CT=0
+2 FOR
SET SV=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV))
if SV=""
QUIT
FOR
SET DRG=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG))
if DRG=""
QUIT
FOR
SET ON=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON))
if ON=""
QUIT
Begin DoDot:1
+3 FOR
SET CT=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT))
if 'CT
QUIT
IF $ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0))
Begin DoDot:2
+4 SET RNG=$GET(RNG)+1
+5 SET ^TMP($JOB,"PSOMON",RNG,DRG)=DRG_"^"_ON_"^"_CT_"^"_$PIECE(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)_"^"_$GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV"))
End DoDot:2
End DoDot:1
+6 IF '$DATA(^TMP($JOB,"PSOMON",2))
SET Y=1
GOTO ONEMONO
+7 KILL DIR
SET IND=0
SET DRG=""
+8 ;F S IND=$O(^TMP($J,"PSOMON",IND)) Q:'IND F S DRG=$O(^TMP($J,"PSOMON",IND,DRG)) Q:DRG="" S DIR("A",IND)=IND_". "_DRG_" and "_$P(^TMP($J,"PSOMON",IND,DRG),"^",4) S DIR("A",IND+1)=""
+9 FOR
SET IND=$ORDER(^TMP($JOB,"PSOMON",IND))
if 'IND
QUIT
FOR
SET DRG=$ORDER(^TMP($JOB,"PSOMON",IND,DRG))
if DRG=""
QUIT
Begin DoDot:1
+10 IF ($Y+6)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:2
+11 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:2
+12 WRITE !,IND_". "_DRG_" and "_$PIECE(^TMP($JOB,"PSOMON",IND,DRG),"^",4)
End DoDot:1
+13 WRITE !
SET DIR("A")="Select Monograph for printing by number"
SET DIR(0)="LO^1:"_RNG
DO ^DIR
KILL DIR
+14 IF $DATA(DUOUT)!($DATA(DTOUT))!(X="^")!(X="")
SET SEL=0
QUIT
ONEMONO FOR G=1:1:$LENGTH(Y)
if $PIECE(Y,",",G)=""
QUIT
SET DRG=$ORDER(^TMP($JOB,"PSOMON",$PIECE(Y,",",G),""))
SET ^TMP($JOB,"PSOMONP",$PIECE(Y,",",G),0)=^TMP($JOB,"PSOMON",$PIECE(Y,",",G),DRG)
+1 KILL ^TMP($JOB,"PSOMON")
+2 QUIT
+3 ;
NEWPG ;new page form feed
+1 NEW DIR
+2 SET DIR(0)="E"
SET DIR("A")="Press Return to Continue or ""^"" to Exit"
+3 DO ^DIR
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+4 WRITE @IOF,$SELECT($GET(MONT)=2:"Consumer",1:"Professional")_" Monograph",!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!!
+5 QUIT
+6 ;
FORMAT ; WATCH OUT WITH CHANGES HERE!!!
+1 KILL BSIG,XX
NEW BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
+2 IF $LENGTH(TEXTSTR)'>70
Begin DoDot:1
+3 WRITE ?5,TEXTSTR,!
End DoDot:1
+4 IF $LENGTH(TEXTSTR)>70
Begin DoDot:1
+5 SET BBSIG=TEXTSTR
SET (BVAR,BVAR1)=""
SET III=1
+6 SET ZNT=0
FOR NNN=1:1:$LENGTH(BBSIG)
IF $EXTRACT(BBSIG,NNN)=" "!($LENGTH(BBSIG)=NNN)
SET ZNT=ZNT+1
Begin DoDot:2
+7 SET BVAR1=$PIECE(BBSIG," ",(ZNT))
SET BLIM=BVAR
SET BVAR=$SELECT(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
End DoDot:2
IF $LENGTH(BVAR)>70
SET BSIG(III)=BLIM_" "
SET III=III+1
SET BVAR=BVAR1
+8 IF $GET(BVAR)'=""
SET BSIG(III)=BVAR
+9 IF $GET(BSIG(1))=""!($GET(BSIG(1))=" ")
SET BSIG(1)=$GET(BSIG(2))
KILL BSIG(2)
End DoDot:1
+10 FOR XX=0:0
SET XX=$ORDER(BSIG(XX))
if 'XX
QUIT
Begin DoDot:1
+11 IF $Y+6>IOSL
IF $EXTRACT(IOST)="C"
DO NEWPG
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+12 WRITE ?5,BSIG(XX),!
End DoDot:1
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+13 KILL BSIG,BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
SET TEXTSTR=""
+14 QUIT
PROF ;
+1 FOR I=0:0
SET I=$ORDER(^TMP($JOB,"PSOMONP",I))
if 'I
QUIT
SET DRG=$PIECE(^TMP($JOB,"PSOMONP",I,0),"^")
SET ON=$PIECE(^(0),"^",2)
SET CT=$PIECE(^(0),"^",3)
SET PDRG=$PIECE(^(0),"^",4)
SET SEV=$EXTRACT($PIECE(^(0),"^",5),1,1)
Begin DoDot:1
+2 USE IO
WRITE @IOF,!,PSONULN,!,"Professional Monograph",!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!!
+3 FOR QX=0:0
SET QX=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"PMON",QX))
if 'QX
QUIT
Begin DoDot:2
+4 IF $Y+6>IOSL
IF $EXTRACT(IOST)="C"
DO NEWPG
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+5 SET TEXTSTR=^TMP($JOB,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"PMON",QX,0)
DO FORMAT
+6 IF ($Y+6)>IOSL
IF $EXTRACT(IOST)="C"
WRITE !
End DoDot:2
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
End DoDot:1
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+7 if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+8 KILL DTOUT,DUOUT
+9 if MONT=3
Begin DoDot:1
+10 USE IO
WRITE @IOF,!,PSONULN,!,"Consumer Monograph",!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!
+11 FOR QX=0:0
SET QX=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"CMON",QX))
if 'QX
QUIT
Begin DoDot:2
+12 IF $Y+6>IOSL
IF $EXTRACT(IOST)="C"
DO NEWPG
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+13 WRITE !?5,^TMP($JOB,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"CMON",QX,0)
End DoDot:2
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
End DoDot:1
+14 WRITE !,PSONULN,!
+15 KILL DTOUT,DUOUT
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR,DTOUT,DUOUT
+16 QUIT
CON FOR I=0:0
SET I=$ORDER(^TMP($JOB,"PSOMONP",I))
if 'I
QUIT
SET DRG=$PIECE(^TMP($JOB,"PSOMONP",I,0),"^")
SET ON=$PIECE(^(0),"^",2)
SET CT=$PIECE(^(0),"^",3)
SET PDRG=$PIECE(^(0),"^",4)
SET SEV=$PIECE(^(0),"^",5)
Begin DoDot:1
+1 USE IO
WRITE @IOF,!,"Consumer Monograph",!,PSONULN,!!,"Drug Interaction with ",!,DRG_" and "_PDRG,!!
+2 FOR QX=0:0
SET QX=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SEV,DRG,ON,CT,"CMON",QX))
if 'QX
QUIT
Begin DoDot:2
+3 IF $Y+6>IOSL
IF $EXTRACT(IOST)="C"
DO NEWPG
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
+4 WRITE !?5,^TMP($JOB,LIST,"OUT","DRUGDRUG",DRG,ON,CT,"CMON",QX,0)
End DoDot:2
if ($DATA(DUOUT)!($DATA(DTOUT)))
QUIT
End DoDot:1
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+5 IF '$GET(DUOUT)
WRITE !,PSONULN,!
+6 KILL DTOUT,DUOUT
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR,DTOUT,DUOUT
+7 QUIT
