PSSDIUTL.m

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 ---PSSDIUTL   15514     printed  Feb 18, 2025@23:56:55                                                                                                                                                                                                   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