Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODGDGP

PSODGDGP.m

Go to the documentation of this file.
  1. PSODGDGP ;BIR/SAB - drug drug interaction checker ;4/14/93
  1. ;;7.0;OUTPATIENT PHARMACY;**251,387,379,391,372,416,370**;DEC 1997;Build 14
  1. ;External reference to ^PSDRUG supported by DBIA 221
  1. ;External references PSOUL^PSSLOCK supported by DBIA 2789
  1. ;External references to ^ORRDI1 supported by DBIA 4659
  1. ;External reference ^XTMP("ORRDI" supported by DBIA 4660
  1. ;External reference to $$DS^PSSDSAPI supported by DBIA 5425
  1. N DRG,PSOREMOT S (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)="",PSOREMOT=0
  1. D BLD Q:+$G(PSORX("DFLG"))!($G(PSODLQT))
  1. I '$D(^XUSEC("PSORPH",DUZ)),$G(DGI)]"" S:$G(CRIT) PSONEW("STATUS")=4 W $C(7),!,"DRUG INTERACTON WITH RX #s: "_LSI,!
  1. I '$D(^XUSEC("PSORPH",DUZ)),(","_$G(^TMP("PSOSER",$J,0))_",")[(",1,") S:$D(^TMP("PSODGI",$J,0)) PSONEW("STATUS")=4
  1. K DRG,NDF,PSOICT,IT,LSI
  1. I +$G(PSORX("DFLG")) Q
  1. I +$G(PSODRUG("NDF"))'=0 D
  1. .I $T(HAVEHDR^ORRDI1)']"" Q
  1. .I '$$HAVEHDR^ORRDI1 Q
  1. .;D HD^PSODDPR2():(($Y+5)>IOSL)
  1. .I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !!,"Remote data not available - Only local order checks processed.",!! S PSOREMOT=1 D HD^PSODDPR2():(($Y+5)>IOSL) Q
  1. .I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2
  1. .K ^TMP($J,"DI"_PSODFN),^TMP($J,"DI")
  1. I '$D(^XUSEC("PSORPH",DUZ)),$G(PSOREMOT)!($G(DGI)]"") K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue..." D ^DIR K DIR,DUOUT,DTOUT
  1. Q
  1. TECH ;add tech entry to RX VERIFY file (#52.4); called from new order/copy/renew
  1. I $$DS^PSSDSAPI,+$G(^TMP("PSODOSF",$J,0)) S ^PS(52.4,PSOXIRXN,1)=^TMP("PSODOSF",$J,0)
  1. Q:'$D(^TMP("PSODGI",$J,0))
  1. S $P(^PSRX(PSOXIRXN,"DRI"),"^")=^TMP("PSOSER",$J,0)_"^"_^TMP("PSODGI",$J,0)
  1. S $P(^PS(52.4,PSOXIRXN,0),"^",8)=1,$P(^PS(52.4,PSOXIRXN,0),"^",9)=^TMP("PSOSER",$J,0),$P(^PS(52.4,PSOXIRXN,0),"^",10)=^TMP("PSODGI",$J,0)
  1. Q
  1. TECH2(PSOXIRXN,PSODFN,DUZ,PSOX) ;
  1. I $D(PSOX("NOPSDRPH")) G T3
  1. Q:$D(^XUSEC("PSORPH",DUZ))
  1. T3 ;
  1. ; The only time PSOX("NOPSDRPH) key is defined equal to 1 is for controlled substances and the user doesn't hold
  1. ; the PSDRPH key.
  1. N PSODWARN,PSOSIGNIF,PSOINTSV,PSOTLBL S (PSODWARN,PSOSIGNIF,PSOTLBL,PSOINTSV)=0
  1. S:$$DS^PSSDSAPI&(+$G(^TMP("PSODOSF",$J,0))) PSODWARN=1 ;dosing drug warning
  1. I $D(^TMP("PSOSER",$J,0)) S PSOINTSV=$G(^TMP("PSOSER",$J,0)) S:PSOINTSV[1 PSODWARN=1 S:PSOINTSV[2 PSOSIGNIF=1 ;critical and significant drug interaction drug warnings
  1. ;
  1. ; When verification is OFF and there's a significant drug interaction or the user doesn't hold the PSDRPH key,
  1. ; set file 52 "DRI" node for the significant drug interactions but don't quit. When the verification switch is off, the bottle label and the tech warning
  1. ; a tech warning label and the bottle label must print when significant interactions are present. However if the
  1. ; the PSOX("NOPSDRPH") variable is defined, no labels are allowed to print and processing should continue on.
  1. ;
  1. I '$G(PSORX("VERIFY")),'PSODWARN&($G(PSOSIGNIF)) D Q:'$D(PSOX("NOPSDRPH")) PSOTLBL ;don't set 52.4 when verification is off and only significiant interaction
  1. .S $P(^PSRX(PSOXIRXN,"DRI"),"^")=^TMP("PSOSER",$J,0)
  1. .S $P(^PSRX(PSOXIRXN,"DRI"),"^",2)=^TMP("PSODGI",$J,0)
  1. .I '$P(PSOPAR,"^",2) S PSOTLBL=1
  1. ;
  1. ; If verification is ON, set file 52.4. If there are critical drug interactions or dose warnings, the fields to
  1. ; indicate these must be set and a tech warning label should print. If the PSOX("NOPSDRPH") variable is present,
  1. ; file 52.4 should be set (along with any drug interaction and dose warning data) and the technician warning label
  1. ; should print (PSOTLBL=2)
  1. ;
  1. I ($D(PSOX("NOPSDRPH")))!($G(PSODWARN))!($G(PSORX("VERIFY"))) D
  1. .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOXIRXN,DIC(0)="ML",X=PSOXIRXN
  1. .D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM S ^PS(52.4,PSOXIRXN,0)=PSOXIRXN_"^"_PSODFN_"^"_DUZ_"^"_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOXIRXN_"^"_PSOX("STOP DATE")
  1. .I '$D(PSOX("NOPSDRPH")) Q:PSOINTSV'[1&('PSODWARN)
  1. .D TECH
  1. ;
  1. I $D(^PS(52.4,PSOXIRXN)) K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA
  1. I '$G(PSORX("VERIFY")) S:(PSOX("STATUS")=4!$G(PSODWARN)) PSOTLBL=1 ;verification off, dose warn or drug interaction, print technician warning label
  1. I $G(PSORX("VERIFY")) S PSOTLBL=$S('$G(PSODWARN)&('$G(PSOSIGNIF)):2,'$G(PSODWARN)&($G(PSOSIGNIF)):2,$G(PSODWARN):1,1:0)
  1. ;
  1. ; If the PSOX("NOPSDRPH") variable is present and regardless of the verification switch, labels cannot be
  1. ; printed (i.e. PSOTLBL=2). A technician warning label will be printed if drug interactions or dose warnings are
  1. ; present.
  1. I $D(PSOX("NOPSDRPH")) S PSOTLBL=2
  1. Q PSOTLBL
  1. ;
  1. BLD I $D(^XUSEC("PSORPH",DUZ)) D PHARM Q ;*370
  1. BLD2 ;
  1. Q:$P(ON,";")'="O"
  1. S LSI=$P(^PSRX($P(ON,";",2),0),"^")_"/"_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")_","_LSI
  1. I '$D(^TMP("PSODGI",$J,0)) D
  1. . S ^TMP("PSODGI",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGI",$J,0)),^TMP("PSOSER",$J,0)=IT_","_$G(^TMP("PSOSER",$J,0))
  1. I ^TMP("PSODGI",$J,0)'[$P(ON,";",2) D
  1. .S ^TMP("PSODGI",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGI",$J,0))
  1. .S ^TMP("PSOSER",$J,0)=IT_","_$G(^TMP("PSOSER",$J,0))
  1. I IT=2 S ^TMP("PSOSERS",$J,0)=IT_","_$G(^TMP("PSOSERS",$J,0)),^TMP("PSODGS",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGS",$J,0))
  1. S:IT=1 ^TMP("PSOTDD",$J,1)=1
  1. Q
  1. PHARM ;pharmacist verification of drug interaction
  1. S PSODGRLX=$P(ON,";",2)
  1. S DIR("?",1)="Answer 'YES' if you DO want to "_$S(IT=1:"continue processing",1:"enter an intervention for")_" this medication,"
  1. S DIR("?")=" 'NO' if you DON'T want to "_$S(IT=1:"continue processing",1:"enter an intervention for")_" this medication,"
  1. W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to "_$S(IT=1:"Continue? ",1:"Intervene? "),DIR("B")="Y" D ^DIR
  1. I 'Y,IT=1 S PSODLQT=1,DGI="" S:'$G(PSORXED)&('$G(PSOREINS)) PSORX("DFLG")=1 S:$G(PSORXED)!($G(PSOREINS)) PSOQUIT=1 K DIR,DTOUT,DIRUT,DIROUT,DUOUT Q
  1. I Y,IT=1 S PSORX("INTERVENE")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT G CRI Q
  1. I 'Y,IT=2 S:$G(DIRUT) (PSODLQT,PSOQUIT)=1 K DIR,DTOUT,DIRUT,DIROUT,DUOUT D ULRX Q
  1. I Y,IT=2 S PSORX("INTERVENE")=2,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT
  1. D ULRX
  1. Q
  1. CRI ;process new drug interactions entered by pharmacist
  1. K DIR ;G:$P(PSOSD(STA,DRG),"^",9) CRITN
  1. S DIR("A",1)="",DIR("A",2)="Do you want to Process medication",DIR("A")=PSODRUG("NAME")_": ",DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY",DIR("B")="P"
  1. S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'A' to Abort Order Entry process" D ^DIR K X1,DIR I 'Y S PSORX("DFLG")=1,DGI="" K DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE") D ULRX Q
  1. I IT=1 D
  1. .S PSORX("INTERVENE")=IT
  1. .D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q
  1. K DUOUT,DTOUT,DIRUT,DIROUT D ULRX Q
  1. CRITN ;process multiple new drug interactions
  1. K X1,DIR S DIR("A",1)="",DIR("A",2)="Do you want to: ",DIR("A",3)=" 1. Delete NEW medication "_PSODRUG("NAME"),DIR("A",4)=" 2. Cancel ACTIVE New Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" DRUG: "_DRG
  1. S DIR("A",5)=" 3. Delete 1 and Cancel 2",DIR("A")=" 4. Continue ?: ",DIR(0)="SA^1:NEW MEDICATION;2:ACTIVE New Rx "_DRG_";3:BOTH;4:CONTINUE"
  1. S DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$P(^PSRX($P(ON,";",2),0),"^")
  1. S DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" and Dispense New Rx"
  1. S DIR("?",3)=" '3' or 'B' to Delete 1 and Cancel 2",DIR("?")=" '4' or 'C' to do nothing to either Rx" D ^DIR K DIR
  1. I Y=1 S PSORX("DFLG")=1,DGI="",PSHLDDRG=PSODRUG("IEN") D D ULRX Q
  1. .I $G(PSORXED) D Q
  1. ..D NOOR^PSOCAN4 I $D(DIRUT) W $C(7)," ACTION NOT TAKEN!",! S PSORX("DFLG")=1 K PSORX("INTERVENE") Q
  1. ..S DA=$P(ON,";",2) D MESS,ENQ^PSORXDL,FULL^VALM1
  1. ..K PSOSD($P(PSOLST($P(ON,";",2)),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1
  1. .S PSODRUG("IEN")=$P(^PSRX($P(ON,";",2),0),"^",6) D FULL^VALM1,^PSORXI
  1. .S PSODRUG("IEN")=PSHLDDRG,VALMBCK="R"
  1. .K DTOUT,DIRUT,DIROUT,DUOUT,PSHLDDRG
  1. .I $G(OR0) D
  1. ..D NOOR^PSOCAN4 I $D(DIRUT) D Q
  1. ...W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1
  1. ..D DC^PSOORFI2
  1. I Y=2 S (DA,PSOHOLDA)=$P(ON,";",2) D D ULRX Q
  1. .D NOOR^PSOCAN4 I $D(DIRUT) D Q
  1. ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1
  1. .D MESS,ENQ^PSORXDL
  1. .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL
  1. .K DTOUT,DIROUT,DIRUT,DUOUT,PSOHOLDA
  1. .S:$G(PSOSD) PSOSD=PSOSD-1 S VALMBCK="R"
  1. I Y=3 S (DA,PSOHOLDA)=$P(ON,";",2) D S VALMBCK="R"
  1. .D NOOR^PSOCAN4 I $D(DIRUT) D Q
  1. ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1
  1. .S:$G(PSOSD) PSOSD=PSOSD-1 S PSORX("DFLG")=1 D MESS,ENQ^PSORXDL
  1. .I $G(OR0) D DC^PSOORFI2
  1. .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL K PSOHOLDA
  1. .I $G(PSORXED) D
  1. ..S DA=$P(ON,";",2) D MESS,ENQ^PSORXDL,FULL^VALM1
  1. ..K DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1
  1. K DTOUT,DIROUT,DIRUT,DUOUT
  1. D ULRX
  1. Q
  1. MESS W !!,"Canceling Rx: "_$P($G(^PSRX(DA,0)),"^")_" "_"Drug: "_$P($G(^PSDRUG($P(^PSRX(DA,0),"^",6),0)),"^"),! Q
  1. PPL F PSOSL=0:0 S PSOSL=$O(PSORX("PSOL",PSOSL)) Q:'PSOSL S PSOX2=PSOSL
  1. I $G(PSOX2) D
  1. .F PSOSL=0:1:PSOX2 S PSOSL=$O(PSORX("PSOL",PSOSL)) Q:'PSOSL F ENT=1:1:$L(PSORX("PSOL",PSOSL),",") I $P(PSORX("PSOL",PSOSL),",",ENT)=$P(ON,";",2) S PSOL(PSOSL,ENT)=""
  1. .F PSOL=0:0 S PSOL=$O(PSOL(PSOL)) Q:'PSOL F ENT=0:0 S ENT=$O(PSOL(PSOL,ENT)) Q:'ENT D
  1. ..I ENT=1,'$P(PSORX("PSOL",PSOL),",",2) K PSORX("PSOL",PSOL) Q
  1. ..I ENT=1,$P(PSORX("PSOL",PSOL),",",2) S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",2,99) Q
  1. ..S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",1,ENT-1)_","_$P(PSORX("PSOL",PSOL),",",ENT+1,99)
  1. K PSOX2,PSOSL,PSOL,ENT Q
  1. ULRX ;
  1. I '$G(PSODGRLX) Q
  1. D PSOUL^PSSLOCK(PSODGRLX) K PSODGRLX
  1. Q