- PSODGDGI ;BIR/SAB - drug drug interaction checker ;05-Jun-2013 08:41;DU
- ;;7.0;OUTPATIENT PHARMACY;**10,27,48,130,144,132,188,207,243,274,1015**;DEC 1997;Build 62
- ;External reference to ^PS(56 supported by DBIA 2229
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
- ;External references to ^ORRDI1 supported by DBIA 4659
- ;External reference ^XTMP("ORRDI" supported by DBIA 4660
- ;IHS/MSC/MGH - Compound med modifications and check line label added
- Q:$$DDIEX^PSNAPIS($P(PSODRUG("NDF"),"A"),$P(PSODRUG("NDF"),"A",2))
- N PSOICT,CMP,TDRG,CMPDR,CDRG
- S (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)=""
- F S STA=$O(PSOSD(STA)) Q:STA=""!($G(PSORX("DFLG"))) F S DRG=$O(PSOSD(STA,DRG)) Q:DRG=""!($G(PSORX("DFLG"))) I $P(PSOSD(STA,DRG),"^",2)<10 D
- .;IHS/MSC/MGH check for compound medications
- .S CMP=0
- .S TDRG=$O(^PSDRUG("B",$P(DRG,U),""))
- .I +TDRG S CMP=$P($G(^PSDRUG(TDRG,999999935)),U,1)
- .I CMP=1 D
- ..N CMPDR,SAVE,CDRG,CNDF
- ..S CMPDR=0
- ..F S CMPDR=$O(^PSDRUG(TDRG,999999936,CMPDR)) Q:'+CMPDR D
- ...S CDRG=$P($G(^PSDRUG(TDRG,999999936,CMPDR,0)),U,1)
- ...S NDF=$S($G(^PSDRUG(CDRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
- ...D CHECK(NDF)
- .E D
- ..Q:$P(PSOSD(STA,DRG),"^",7)']""
- ..S NDF=$P(PSOSD(STA,DRG),"^",7)
- ..D CHECK(NDF)
- I '$D(^XUSEC("PSORPH",DUZ)),$G(DGI)]"" S:+CRIT PSONEW("STATUS")=4 W $C(7),!,"DRUG INTERACTION WITH RX #s: "_LSI,! K LSI,DRG,IT,NDF,PSOICT
- K IT
- ; CHECK FOR REMOTE DRUG INTERACTIONS
- I +$G(PSORX("DFLG")) Q
- I $T(HAVEHDR^ORRDI1)']"" Q
- I '$$HAVEHDR^ORRDI1 Q
- I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q
- .I $T(REMOTE^PSORX1)]"" Q
- .W !,"Remote data not available - Only local order checks processed." D PAUSE^PSOORRD2
- I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !,"Remote data not available - Only local order checks processed." D PAUSE^PSOORRD2 Q
- I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2
- K ^TMP($J,"DI"_PSODFN),^TMP($J,"DI")
- Q
- CHECK(NDF) ; check drug interations
- ;New logic to Loop All interactions and filter-up a critical if it exists
- ;Moved into separate subroutine to process multiples
- S IT=0,PSOICT=""
- F S IT=$O(^PS(56,"APD",NDF,PSODRUG("NDF"),IT)) Q:'IT D
- .Q:$$DDIEX^PSNAPIS($P(NDF,"A"),$P(NDF,"A",2))
- .Q:$P(^PS(56,IT,0),"^",7)&($P(^PS(56,IT,0),"^",7)<DT)
- .I 'PSOICT S PSOICT=IT Q
- .I $P($G(^PS(56,IT,0)),"^",4)=1 S PSOICT=IT Q
- .Q
- I 'PSOICT Q
- S IT=PSOICT
- I STA="ZNONVA" S DNM=DRG W ! D NVA^PSODRDU1 K DNM,IT,PSOICT Q
- D BLD Q:+$G(PSORX("DFLG"))
- Q
- TECH ;add tech entry to RX VERIFY file (#52.4)
- I +CRIT S PSODI=1,DIC="^PS(52.4,",DLAYGO=52.4,DIC(0)="L",(DINUM,X)=PSOX("IRXN"),DIC("DR")="1////"_PSODFN_";2////"_DUZ_";4///"_DT_";7///"_1_";7.1///"_SER_";7.2///"_DGI K DD,DO D FILE^DICN K DD,DO
- S:$G(DGS)'="" $P(^PSRX(PSOX("IRXN"),"DRI"),"^")=SERS,$P(^PSRX(PSOX("IRXN"),"DRI"),"^",2)=DGS K PSODI,CRIT,DIC,DLAYGO,DINUM,DGI,DGS,SER,SERS Q
- BLD I $D(^XUSEC("PSORPH",DUZ)) D PHARM Q
- S LSI=$P(^PSRX(+PSOSD(STA,DRG),0),"^")_"/"_$P(^PSDRUG($P(^(0),"^",6),0),"^")_","_LSI,DGI=$P(PSOSD(STA,DRG),"^")_","_DGI,SER=IT_","_SER I $P(PSOSD(STA,DRG),"^",9),$P(^PS(56,IT,0),"^",4)=1 S $P(^PSRX(+PSOSD(STA,DRG),"STA"),"^")=4
- I $P(^PS(56,IT,0),"^",4)=2 S SERS=IT_","_SERS,DGS=$P(PSOSD(STA,DRG),"^")_","_DGS
- S:$P(^PS(56,IT,0),"^",4)=1 CRIT=1 Q
- PHARM ;pharmacist verification of drug interaction
- D PSOL^PSSLOCK($P(PSOSD(STA,DRG),"^")) I '$G(PSOMSG) D K PSOMSG S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR S PSORX("DFLG")=1 Q
- .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2) D Q
- ..W !,"Rx: "_$P($G(^PSRX($P(PSOSD(STA,DRG),"^"),0)),"^")_" Drug: "_$P($G(^PSDRUG(+$P($G(^(0)),"^",6),0)),"^")
- ..W !,"which interacts with the drug you are entering!",!
- .W !!,"Another person is editing Rx "_$P($G(^PSRX($P(PSOSD(STA,DRG),"^"),0)),"^")_",",!,"which interacts with the drug you are entering!",!
- S PSODGRLX=$P(PSOSD(STA,DRG),"^")
- S SER=^PS(56,IT,0),DIR("?",1)="Answer 'YES' if you DO want to "_$S($P(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
- S DIR("?")=" 'NO' if you DON'T want to "_$S($P(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
- W $C(7),$C(7) S DIR("A",1)="***"_$S($P(SER,"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"*** "_"Drug Interaction with RX #"_$P(^PSRX($P(PSOSD(STA,DRG),"^"),0),"^"),DIR("A",2)="DRUG: "_$P(DRG,"^")
- S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to "_$S($P(SER,"^",4)=1:"Continue? ",1:"Intervene? "),DIR("B")="Y" D ^DIR
- I 'Y,$P(SER,"^",4)=1 S PSORX("DFLG")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT
- I Y,$P(SER,"^",4)=1 S PSORX("INTERVENE")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT G CRI Q
- I 'Y,$P(SER,"^",4)=2 K DIR,DTOUT,DIRUT,DIROUT,DUOUT D ULRX Q
- I Y,$P(SER,"^",4)=2 S PSORX("INTERVENE")=2,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT
- D ULRX
- Q
- CRI ;process new drug interactions entered by pharmacist
- K DIR G:$P(PSOSD(STA,DRG),"^",9) CRITN 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"
- S DIR("?",1)="Enter '1' or 'P' to Activate medication",DIR("?")=" '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
- I $P(SER,"^",4)=1 D
- .D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q
- .S PSORX("INTERVENE")=$P(SER,"^",4)
- K DUOUT,DTOUT,DIRUT,DIROUT D ULRX Q
- CRITN ;process multiple new drug interactions
- 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(PSOSD(STA,DRG),"^"),0),"^")_" DRUG: "_$P(DRG,"^")
- S DIR("A",5)=" 3. Delete 1 and Cancel 2",DIR("A")=" 4. Continue ?: ",DIR(0)="SA^1:NEW MEDICATION;2:ACTIVE New Rx "_$P(DRG,"^")_";3:BOTH;4:CONTINUE"
- S DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$P(^PSRX(+PSOSD(STA,DRG),0),"^")
- S DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$P(^PSRX(+PSOSD(STA,DRG),0),"^")_" and Dispense New Rx"
- 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
- I Y=1 S PSORX("DFLG")=1,DGI="",PSHLDDRG=PSODRUG("IEN") D D ULRX Q
- .I $G(PSORXED) D Q
- ..D NOOR^PSOCAN4 I $D(DIRUT) W $C(7)," ACTION NOT TAKEN!",! S PSORX("DFLG")=1 K PSORX("INTERVENE") Q
- ..S DA=$P(PSOLST(ORN),"^",2) D MESS,ENQ^PSORXDL,FULL^VALM1
- ..K PSOSD($P(PSOLST(ORN),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1
- .S PSODRUG("IEN")=$P(^PSRX($P(PSOSD(STA,DRG),"^"),0),"^",6) D FULL^VALM1,^PSORXI
- .S PSODRUG("IEN")=PSHLDDRG,VALMBCK="R"
- .K DTOUT,DIRUT,DIROUT,DUOUT,PSHLDDRG
- .I $G(OR0) D
- ..D NOOR^PSOCAN4 I $D(DIRUT) D Q
- ...W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1
- ..D DC^PSOORFI2
- I Y=2 S (DA,PSOHOLDA)=+PSOSD(STA,DRG) D D ULRX Q
- .D NOOR^PSOCAN4 I $D(DIRUT) D Q
- ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1
- .D MESS,ENQ^PSORXDL
- .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL
- .K PSOSD(STA,DRG),DTOUT,DIROUT,DIRUT,DUOUT,PSOHOLDA
- .S:$G(PSOSD) PSOSD=PSOSD-1 S VALMBCK="R"
- I Y=3 S (DA,PSOHOLDA)=+PSOSD(STA,DRG) D S VALMBCK="R"
- .D NOOR^PSOCAN4 I $D(DIRUT) D Q
- ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1
- .S:$G(PSOSD) PSOSD=PSOSD-1 S PSORX("DFLG")=1 D MESS,ENQ^PSORXDL
- .I $G(OR0) D DC^PSOORFI2
- .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL K PSOSD(STA,DRG),PSOHOLDA
- .I $G(PSORXED) D
- ..S DA=$P(PSOLST(ORN),"^",2) D MESS,ENQ^PSORXDL,FULL^VALM1
- ..K PSOSD($P(PSOLST(ORN),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1
- K DTOUT,DIROUT,DIRUT,DUOUT
- D ULRX
- Q
- MESS W !!,"Canceling Rx: "_$P($G(^PSRX(DA,0)),"^")_" "_"Drug: "_$P($G(^PSDRUG($P(^PSRX(DA,0),"^",6),0)),"^"),! Q
- PPL F PSOSL=0:0 S PSOSL=$O(PSORX("PSOL",PSOSL)) Q:'PSOSL S PSOX2=PSOSL
- I $G(PSOX2) D
- .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(PSOSD(STA,DRG),"^") S PSOL(PSOSL,ENT)=""
- .F PSOL=0:0 S PSOL=$O(PSOL(PSOL)) Q:'PSOL F ENT=0:0 S ENT=$O(PSOL(PSOL,ENT)) Q:'ENT D
- ..I ENT=1,'$P(PSORX("PSOL",PSOL),",",2) K PSORX("PSOL",PSOL) Q
- ..I ENT=1,$P(PSORX("PSOL",PSOL),",",2) S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",2,99) Q
- ..S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",1,ENT-1)_","_$P(PSORX("PSOL",PSOL),",",ENT+1,99)
- K PSOX2,PSOSL,PSOL,ENT Q
- ULRX ;
- I '$G(PSODGRLX) Q
- D PSOUL^PSSLOCK(PSODGRLX) K PSODGRLX
- Q
- PSODGDGI ;BIR/SAB - drug drug interaction checker ;05-Jun-2013 08:41;DU
- +1 ;;7.0;OUTPATIENT PHARMACY;**10,27,48,130,144,132,188,207,243,274,1015**;DEC 1997;Build 62
- +2 ;External reference to ^PS(56 supported by DBIA 2229
- +3 ;External reference to ^PSDRUG supported by DBIA 221
- +4 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- +5 ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
- +6 ;External references to ^ORRDI1 supported by DBIA 4659
- +7 ;External reference ^XTMP("ORRDI" supported by DBIA 4660
- +8 ;IHS/MSC/MGH - Compound med modifications and check line label added
- +9 IF $$DDIEX^PSNAPIS($PIECE(PSODRUG("NDF"),"A"),$PIECE(PSODRUG("NDF"),"A",2))
- QUIT
- +10 NEW PSOICT,CMP,TDRG,CMPDR,CDRG
- +11 SET (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)=""
- +12 FOR
- SET STA=$ORDER(PSOSD(STA))
- IF STA=""!($GET(PSORX("DFLG")))
- QUIT
- FOR
- SET DRG=$ORDER(PSOSD(STA,DRG))
- IF DRG=""!($GET(PSORX("DFLG")))
- QUIT
- IF $PIECE(PSOSD(STA,DRG),"^",2)<10
- Begin DoDot:1
- +13 ;IHS/MSC/MGH check for compound medications
- +14 SET CMP=0
- +15 SET TDRG=$ORDER(^PSDRUG("B",$PIECE(DRG,U),""))
- +16 IF +TDRG
- SET CMP=$PIECE($GET(^PSDRUG(TDRG,999999935)),U,1)
- +17 IF CMP=1
- Begin DoDot:2
- +18 NEW CMPDR,SAVE,CDRG,CNDF
- +19 SET CMPDR=0
- +20 FOR
- SET CMPDR=$ORDER(^PSDRUG(TDRG,999999936,CMPDR))
- IF '+CMPDR
- QUIT
- Begin DoDot:3
- +21 SET CDRG=$PIECE($GET(^PSDRUG(TDRG,999999936,CMPDR,0)),U,1)
- +22 SET NDF=$SELECT($GET(^PSDRUG(CDRG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +23 DO CHECK(NDF)
- End DoDot:3
- End DoDot:2
- +24 IF '$TEST
- Begin DoDot:2
- +25 IF $PIECE(PSOSD(STA,DRG),"^",7)']""
- QUIT
- +26 SET NDF=$PIECE(PSOSD(STA,DRG),"^",7)
- +27 DO CHECK(NDF)
- End DoDot:2
- End DoDot:1
- +28 IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF $GET(DGI)]""
- IF +CRIT
- SET PSONEW("STATUS")=4
- WRITE $CHAR(7),!,"DRUG INTERACTION WITH RX #s: "_LSI,!
- KILL LSI,DRG,IT,NDF,PSOICT
- +29 KILL IT
- +30 ; CHECK FOR REMOTE DRUG INTERACTIONS
- +31 IF +$GET(PSORX("DFLG"))
- QUIT
- +32 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +33 IF '$$HAVEHDR^ORRDI1
- QUIT
- +34 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
- Begin DoDot:1
- +35 IF $TEXT(REMOTE^PSORX1)]""
- QUIT
- +36 WRITE !,"Remote data not available - Only local order checks processed."
- DO PAUSE^PSOORRD2
- End DoDot:1
- QUIT
- +37 IF $PIECE($GET(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0
- WRITE !,"Remote data not available - Only local order checks processed."
- DO PAUSE^PSOORRD2
- QUIT
- +38 IF $DATA(^TMP($JOB,"DI"_PSODFN))
- KILL ^TMP($JOB,"DI")
- MERGE ^TMP($JOB,"DI")=^TMP($JOB,"DI"_PSODFN)
- DO DRGINT^PSOORRD2
- +39 KILL ^TMP($JOB,"DI"_PSODFN),^TMP($JOB,"DI")
- +40 QUIT
- CHECK(NDF) ; check drug interations
- +1 ;New logic to Loop All interactions and filter-up a critical if it exists
- +2 ;Moved into separate subroutine to process multiples
- +3 SET IT=0
- SET PSOICT=""
- +4 FOR
- SET IT=$ORDER(^PS(56,"APD",NDF,PSODRUG("NDF"),IT))
- IF 'IT
- QUIT
- Begin DoDot:1
- +5 IF $$DDIEX^PSNAPIS($PIECE(NDF,"A"),$PIECE(NDF,"A",2))
- QUIT
- +6 IF $PIECE(^PS(56,IT,0),"^",7)&($PIECE(^PS(56,IT,0),"^",7)<DT)
- QUIT
- +7 IF 'PSOICT
- SET PSOICT=IT
- QUIT
- +8 IF $PIECE($GET(^PS(56,IT,0)),"^",4)=1
- SET PSOICT=IT
- QUIT
- +9 QUIT
- End DoDot:1
- +10 IF 'PSOICT
- QUIT
- +11 SET IT=PSOICT
- +12 IF STA="ZNONVA"
- SET DNM=DRG
- WRITE !
- DO NVA^PSODRDU1
- KILL DNM,IT,PSOICT
- QUIT
- +13 DO BLD
- IF +$GET(PSORX("DFLG"))
- QUIT
- +14 QUIT
- TECH ;add tech entry to RX VERIFY file (#52.4)
- +1 IF +CRIT
- SET PSODI=1
- SET DIC="^PS(52.4,"
- SET DLAYGO=52.4
- SET DIC(0)="L"
- SET (DINUM,X)=PSOX("IRXN")
- SET DIC("DR")="1////"_PSODFN_";2////"_DUZ_";4///"_DT_";7///"_1_";7.1///"_SER_";7.2///"_DGI
- KILL DD,DO
- DO FILE^DICN
- KILL DD,DO
- +2 IF $GET(DGS)'=""
- SET $PIECE(^PSRX(PSOX("IRXN"),"DRI"),"^")=SERS
- SET $PIECE(^PSRX(PSOX("IRXN"),"DRI"),"^",2)=DGS
- KILL PSODI,CRIT,DIC,DLAYGO,DINUM,DGI,DGS,SER,SERS
- QUIT
- BLD IF $DATA(^XUSEC("PSORPH",DUZ))
- DO PHARM
- QUIT
- +1 SET LSI=$PIECE(^PSRX(+PSOSD(STA,DRG),0),"^")_"/"_$PIECE(^PSDRUG($PIECE(^(0),"^",6),0),"^")_","_LSI
- SET DGI=$PIECE(PSOSD(STA,DRG),"^")_","_DGI
- SET SER=IT_","_SER
- IF $PIECE(PSOSD(STA,DRG),"^",9)
- IF $PIECE(^PS(56,IT,0),"^",4)=1
- SET $PIECE(^PSRX(+PSOSD(STA,DRG),"STA"),"^")=4
- +2 IF $PIECE(^PS(56,IT,0),"^",4)=2
- SET SERS=IT_","_SERS
- SET DGS=$PIECE(PSOSD(STA,DRG),"^")_","_DGS
- +3 IF $PIECE(^PS(56,IT,0),"^",4)=1
- SET CRIT=1
- QUIT
- PHARM ;pharmacist verification of drug interaction
- +1 DO PSOL^PSSLOCK($PIECE(PSOSD(STA,DRG),"^"))
- IF '$GET(PSOMSG)
- Begin DoDot:1
- +2 IF $PIECE($GET(PSOMSG),"^",2)'=""
- WRITE !!,$PIECE(PSOMSG,"^",2)
- Begin DoDot:2
- +3 WRITE !,"Rx: "_$PIECE($GET(^PSRX($PIECE(PSOSD(STA,DRG),"^"),0)),"^")_" Drug: "_$PIECE($GET(^PSDRUG(+$PIECE($GET(^(0)),"^",6),0)),"^")
- +4 WRITE !,"which interacts with the drug you are entering!",!
- End DoDot:2
- QUIT
- +5 WRITE !!,"Another person is editing Rx "_$PIECE($GET(^PSRX($PIECE(PSOSD(STA,DRG),"^"),0)),"^")_",",!,"which interacts with the drug you are entering!",!
- End DoDot:1
- KILL PSOMSG
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- SET PSORX("DFLG")=1
- QUIT
- +6 SET PSODGRLX=$PIECE(PSOSD(STA,DRG),"^")
- +7 SET SER=^PS(56,IT,0)
- SET DIR("?",1)="Answer 'YES' if you DO want to "_$SELECT($PIECE(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
- +8 SET DIR("?")=" 'NO' if you DON'T want to "_$SELECT($PIECE(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication,"
- +9 WRITE $CHAR(7),$CHAR(7)
- SET DIR("A",1)="***"_$SELECT($PIECE(SER,"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"*** "_"Drug Interaction with RX #"_$PIECE(^PSRX($PIECE(PSOSD(STA,DRG),"^"),0),"^")
- SET DIR("A",2)="DRUG: "_$PIECE(DRG,"^")
- +10 SET DIR(0)="SA^1:YES;0:NO"
- SET DIR("A")="Do you want to "_$SELECT($PIECE(SER,"^",4)=1:"Continue? ",1:"Intervene? ")
- SET DIR("B")="Y"
- DO ^DIR
- +11 IF 'Y
- IF $PIECE(SER,"^",4)=1
- SET PSORX("DFLG")=1
- SET DGI=""
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- +12 IF Y
- IF $PIECE(SER,"^",4)=1
- SET PSORX("INTERVENE")=1
- SET DGI=""
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- GOTO CRI
- QUIT
- +13 IF 'Y
- IF $PIECE(SER,"^",4)=2
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- DO ULRX
- QUIT
- +14 IF Y
- IF $PIECE(SER,"^",4)=2
- SET PSORX("INTERVENE")=2
- SET DGI=""
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- +15 DO ULRX
- +16 QUIT
- CRI ;process new drug interactions entered by pharmacist
- +1 KILL DIR
- IF $PIECE(PSOSD(STA,DRG),"^",9)
- GOTO CRITN
- SET DIR("A",1)=""
- SET DIR("A",2)="Do you want to Process medication"
- SET DIR("A")=PSODRUG("NAME")_": "
- SET DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY"
- SET DIR("B")="P"
- +2 SET DIR("?",1)="Enter '1' or 'P' to Activate medication"
- SET DIR("?")=" '0' or 'A' to Abort Order Entry process"
- DO ^DIR
- KILL X1,DIR
- IF 'Y
- SET PSORX("DFLG")=1
- SET DGI=""
- KILL DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE")
- DO ULRX
- QUIT
- +3 IF $PIECE(SER,"^",4)=1
- Begin DoDot:1
- +4 DO SIG^XUSESIG
- IF X1=""
- KILL PSORX("INTERVENE")
- SET PSORX("DFLG")=1
- QUIT
- +5 SET PSORX("INTERVENE")=$PIECE(SER,"^",4)
- End DoDot:1
- +6 KILL DUOUT,DTOUT,DIRUT,DIROUT
- DO ULRX
- QUIT
- CRITN ;process multiple new drug interactions
- +1 KILL X1,DIR
- SET DIR("A",1)=""
- SET DIR("A",2)="Do you want to: "
- SET DIR("A",3)=" 1. Delete NEW medication "_PSODRUG("NAME")
- SET DIR("A",4)=" 2. Cancel ACTIVE New Rx #"_$PIECE(^PSRX($PIECE(PSOSD(STA,DRG),"^"),0),"^")_" DRUG: "_$PIECE(DRG,"^")
- +2 SET DIR("A",5)=" 3. Delete 1 and Cancel 2"
- SET DIR("A")=" 4. Continue ?: "
- SET DIR(0)="SA^1:NEW MEDICATION;2:ACTIVE New Rx "_$PIECE(DRG,"^")_";3:BOTH;4:CONTINUE"
- +3 SET DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$PIECE(^PSRX(+PSOSD(STA,DRG),0),"^")
- +4 SET DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$PIECE(^PSRX(+PSOSD(STA,DRG),0),"^")_" and Dispense New Rx"
- +5 SET DIR("?",3)=" '3' or 'B' to Delete 1 and Cancel 2"
- SET DIR("?")=" '4' or 'C' to do nothing to either Rx"
- DO ^DIR
- KILL DIR
- +6 IF Y=1
- SET PSORX("DFLG")=1
- SET DGI=""
- SET PSHLDDRG=PSODRUG("IEN")
- Begin DoDot:1
- +7 IF $GET(PSORXED)
- Begin DoDot:2
- +8 DO NOOR^PSOCAN4
- IF $DATA(DIRUT)
- WRITE $CHAR(7)," ACTION NOT TAKEN!",!
- SET PSORX("DFLG")=1
- KILL PSORX("INTERVENE")
- QUIT
- +9 SET DA=$PIECE(PSOLST(ORN),"^",2)
- DO MESS
- DO ENQ^PSORXDL
- DO FULL^VALM1
- +10 KILL PSOSD($PIECE(PSOLST(ORN),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT
- IF $GET(PSOSD)
- SET PSOSD=PSOSD-1
- SET ZONE=1
- End DoDot:2
- QUIT
- +11 SET PSODRUG("IEN")=$PIECE(^PSRX($PIECE(PSOSD(STA,DRG),"^"),0),"^",6)
- DO FULL^VALM1
- DO ^PSORXI
- +12 SET PSODRUG("IEN")=PSHLDDRG
- SET VALMBCK="R"
- +13 KILL DTOUT,DIRUT,DIROUT,DUOUT,PSHLDDRG
- +14 IF $GET(OR0)
- Begin DoDot:2
- +15 DO NOOR^PSOCAN4
- IF $DATA(DIRUT)
- Begin DoDot:3
- +16 WRITE $CHAR(7)," ACTION NOT TAKEN!",!
- KILL PSORX("INTERVENE")
- SET PSORX("DFLG")=1
- End DoDot:3
- QUIT
- +17 DO DC^PSOORFI2
- End DoDot:2
- End DoDot:1
- DO ULRX
- QUIT
- +18 IF Y=2
- SET (DA,PSOHOLDA)=+PSOSD(STA,DRG)
- Begin DoDot:1
- +19 DO NOOR^PSOCAN4
- IF $DATA(DIRUT)
- Begin DoDot:2
- +20 WRITE $CHAR(7)," ACTION NOT TAKEN!",!
- KILL PSORX("INTERVENE")
- SET PSORX("DFLG")=1
- End DoDot:2
- QUIT
- +21 DO MESS
- DO ENQ^PSORXDL
- +22 SET DA=PSOHOLDA
- DO FULL^VALM1
- DO EN1^PSORXI(.DA)
- DO PPL
- +23 KILL PSOSD(STA,DRG),DTOUT,DIROUT,DIRUT,DUOUT,PSOHOLDA
- +24 IF $GET(PSOSD)
- SET PSOSD=PSOSD-1
- SET VALMBCK="R"
- End DoDot:1
- DO ULRX
- QUIT
- +25 IF Y=3
- SET (DA,PSOHOLDA)=+PSOSD(STA,DRG)
- Begin DoDot:1
- +26 DO NOOR^PSOCAN4
- IF $DATA(DIRUT)
- Begin DoDot:2
- +27 WRITE $CHAR(7)," ACTION NOT TAKEN!",!
- KILL PSORX("INTERVENE")
- SET PSORX("DFLG")=1
- End DoDot:2
- QUIT
- +28 IF $GET(PSOSD)
- SET PSOSD=PSOSD-1
- SET PSORX("DFLG")=1
- DO MESS
- DO ENQ^PSORXDL
- +29 IF $GET(OR0)
- DO DC^PSOORFI2
- +30 SET DA=PSOHOLDA
- DO FULL^VALM1
- DO EN1^PSORXI(.DA)
- DO PPL
- KILL PSOSD(STA,DRG),PSOHOLDA
- +31 IF $GET(PSORXED)
- Begin DoDot:2
- +32 SET DA=$PIECE(PSOLST(ORN),"^",2)
- DO MESS
- DO ENQ^PSORXDL
- DO FULL^VALM1
- +33 KILL PSOSD($PIECE(PSOLST(ORN),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT
- IF $GET(PSOSD)
- SET PSOSD=PSOSD-1
- SET ZONE=1
- End DoDot:2
- End DoDot:1
- SET VALMBCK="R"
- +34 KILL DTOUT,DIROUT,DIRUT,DUOUT
- +35 DO ULRX
- +36 QUIT
- MESS WRITE !!,"Canceling Rx: "_$PIECE($GET(^PSRX(DA,0)),"^")_" "_"Drug: "_$PIECE($GET(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0)),"^"),!
- QUIT
- PPL FOR PSOSL=0:0
- SET PSOSL=$ORDER(PSORX("PSOL",PSOSL))
- IF 'PSOSL
- QUIT
- SET PSOX2=PSOSL
- +1 IF $GET(PSOX2)
- Begin DoDot:1
- +2 FOR PSOSL=0:1:PSOX2
- SET PSOSL=$ORDER(PSORX("PSOL",PSOSL))
- IF 'PSOSL
- QUIT
- FOR ENT=1:1:$LENGTH(PSORX("PSOL",PSOSL),",")
- IF $PIECE(PSORX("PSOL",PSOSL),",",ENT)=$PIECE(PSOSD(STA,DRG),"^")
- SET PSOL(PSOSL,ENT)=""
- +3 FOR PSOL=0:0
- SET PSOL=$ORDER(PSOL(PSOL))
- IF 'PSOL
- QUIT
- FOR ENT=0:0
- SET ENT=$ORDER(PSOL(PSOL,ENT))
- IF 'ENT
- QUIT
- Begin DoDot:2
- +4 IF ENT=1
- IF '$PIECE(PSORX("PSOL",PSOL),",",2)
- KILL PSORX("PSOL",PSOL)
- QUIT
- +5 IF ENT=1
- IF $PIECE(PSORX("PSOL",PSOL),",",2)
- SET PSORX("PSOL",PSOL)=$PIECE(PSORX("PSOL",PSOL),",",2,99)
- QUIT
- +6 SET PSORX("PSOL",PSOL)=$PIECE(PSORX("PSOL",PSOL),",",1,ENT-1)_","_$PIECE(PSORX("PSOL",PSOL),",",ENT+1,99)
- End DoDot:2
- End DoDot:1
- +7 KILL PSOX2,PSOSL,PSOL,ENT
- QUIT
- ULRX ;
- +1 IF '$GET(PSODGRLX)
- QUIT
- +2 DO PSOUL^PSSLOCK(PSODGRLX)
- KILL PSODGRLX
- +3 QUIT
