- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODGDGI.m
r613 r623 1 PSODGDGI ;BIR/SAB - drug drug interaction checker ; 6/28/07 7:36am2 ;;7.0;OUTPATIENT PHARMACY;**10,27,48,130,144,132,188,207,243,274**;DEC 1997;Build 8 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 TECH 41 42 43 BLD I $D(^XUSEC("PSORPH",DUZ))D PHARM Q44 45 46 47 PHARM 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 CRI 65 66 67 68 69 70 71 CRITN 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 MESS 109 PPL 110 111 112 113 114 115 116 117 ULRX 118 119 120 1 PSODGDGI ;BIR/SAB - drug drug interaction checker ;4/14/93 2 ;;7.0;OUTPATIENT PHARMACY;**10,27,48,130,144,132,188,207,243**;DEC 1997;Build 22 3 ;External reference to ^PS(56 supported by DBIA 2229 4 ;External reference to ^PSDRUG supported by DBIA 221 5 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 6 ;External reference to DDIEX^PSNAPIS supported by DBIA 2574 7 ;External references to ^ORRDI1 supported by DBIA 4659 8 ;External reference ^XTMP("ORRDI" supported by DBIA 4660 9 Q:$$DDIEX^PSNAPIS($P(PSODRUG("NDF"),"A"),$P(PSODRUG("NDF"),"A",2)) 10 N PSOICT S (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)="" 11 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 12 .Q:$P(PSOSD(STA,DRG),"^",7)']"" 13 .S NDF=$P(PSOSD(STA,DRG),"^",7) 14 .;New logic to Loop All interactions and filter-up a critical if it exists 15 .S IT=0,PSOICT="" 16 .F S IT=$O(^PS(56,"APD",NDF,PSODRUG("NDF"),IT)) Q:'IT D 17 ..Q:$$DDIEX^PSNAPIS($P(NDF,"A"),$P(NDF,"A",2)) 18 ..Q:$P(^PS(56,IT,0),"^",7)&($P(^PS(56,IT,0),"^",7)<DT) 19 ..I 'PSOICT S PSOICT=IT Q 20 ..I $P($G(^PS(56,IT,0)),"^",4)=1 S PSOICT=IT Q 21 ..Q 22 .I 'PSOICT Q 23 .S IT=PSOICT 24 .I STA="ZNONVA" S DNM=DRG W ! D NVA^PSODRDU1 K DNM,IT,PSOICT Q 25 .D BLD Q:+$G(PSORX("DFLG")) 26 .Q 27 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 28 K IT 29 ; CHECK FOR REMOTE DRUG INTERACTIONS 30 I +$G(PSORX("DFLG")) Q 31 I $T(HAVEHDR^ORRDI1)']"" Q 32 I '$$HAVEHDR^ORRDI1 Q 33 I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q 34 .I $T(REMOTE^PSORX1)]"" Q 35 .W !,"Remote data not available - Only local order checks processed." D PAUSE^PSOORRD2 36 I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !,"Remote data not available - Only local order checks processed." D PAUSE^PSOORRD2 Q 37 I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2 38 K ^TMP($J,"DI"_PSODFN),^TMP($J,"DI") 39 Q 40 TECH ;add tech entry to RX VERIFY file (#52.4) 41 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 42 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 43 BLD I $D(^XUSEC("PSORPH",DUZ)) S PSORX("PHARM")=DUZ D PHARM Q 44 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 45 I $P(^PS(56,IT,0),"^",4)=2 S SERS=IT_","_SERS,DGS=$P(PSOSD(STA,DRG),"^")_","_DGS 46 S:$P(^PS(56,IT,0),"^",4)=1 CRIT=1 Q 47 PHARM ;pharmacist verification of drug interaction 48 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 49 .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2) D Q 50 ..W !,"Rx: "_$P($G(^PSRX($P(PSOSD(STA,DRG),"^"),0)),"^")_" Drug: "_$P($G(^PSDRUG(+$P($G(^(0)),"^",6),0)),"^") 51 ..W !,"which interacts with the drug you are entering!",! 52 .W !!,"Another person is editing Rx "_$P($G(^PSRX($P(PSOSD(STA,DRG),"^"),0)),"^")_",",!,"which interacts with the drug you are entering!",! 53 S PSODGRLX=$P(PSOSD(STA,DRG),"^") 54 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," 55 S DIR("?")=" 'NO' if you DON'T want to "_$S($P(SER,"^",4)=1:"continue processing",1:"enter an intervention for")_" this medication," 56 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,"^") 57 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 58 I 'Y,$P(SER,"^",4)=1 S PSORX("DFLG")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT 59 I Y,$P(SER,"^",4)=1 S PSORX("INTERVENE")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT G CRI Q 60 I 'Y,$P(SER,"^",4)=2 K DIR,DTOUT,DIRUT,DIROUT,DUOUT D ULRX Q 61 I Y,$P(SER,"^",4)=2 S PSORX("INTERVENE")=2,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT 62 D ULRX 63 Q 64 CRI ;process new drug interactions entered by pharmacist 65 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" 66 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 67 I $P(SER,"^",4)=1 D 68 .D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q 69 .S PSORX("INTERVENE")=$P(SER,"^",4) 70 K DUOUT,DTOUT,DIRUT,DIROUT D ULRX Q 71 CRITN ;process multiple new drug interactions 72 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,"^") 73 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" 74 S DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$P(^PSRX(+PSOSD(STA,DRG),0),"^") 75 S DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$P(^PSRX(+PSOSD(STA,DRG),0),"^")_" and Dispense New Rx" 76 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 77 I Y=1 S PSORX("DFLG")=1,DGI="",PSHLDDRG=PSODRUG("IEN") D D ULRX Q 78 .I $G(PSORXED) D Q 79 ..D NOOR^PSOCAN4 I $D(DIRUT) W $C(7)," ACTION NOT TAKEN!",! S PSORX("DFLG")=1 K PSORX("INTERVENE") Q 80 ..S DA=$P(PSOLST(ORN),"^",2) D MESS,ENQ^PSORXDL,FULL^VALM1 81 ..K PSOSD($P(PSOLST(ORN),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1 82 .S PSODRUG("IEN")=$P(^PSRX($P(PSOSD(STA,DRG),"^"),0),"^",6) D FULL^VALM1,^PSORXI 83 .S PSODRUG("IEN")=PSHLDDRG,VALMBCK="R" 84 .K DTOUT,DIRUT,DIROUT,DUOUT,PSHLDDRG 85 .I $G(OR0) D 86 ..D NOOR^PSOCAN4 I $D(DIRUT) D Q 87 ...W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1 88 ..D DC^PSOORFI2 89 I Y=2 S (DA,PSOHOLDA)=+PSOSD(STA,DRG) D D ULRX Q 90 .D NOOR^PSOCAN4 I $D(DIRUT) D Q 91 ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1 92 .D MESS,ENQ^PSORXDL 93 .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL 94 .K PSOSD(STA,DRG),DTOUT,DIROUT,DIRUT,DUOUT,PSOHOLDA 95 .S:$G(PSOSD) PSOSD=PSOSD-1 S VALMBCK="R" 96 I Y=3 S (DA,PSOHOLDA)=+PSOSD(STA,DRG) D S VALMBCK="R" 97 .D NOOR^PSOCAN4 I $D(DIRUT) D Q 98 ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1 99 .S:$G(PSOSD) PSOSD=PSOSD-1 S PSORX("DFLG")=1 D MESS,ENQ^PSORXDL 100 .I $G(OR0) D DC^PSOORFI2 101 .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL K PSOSD(STA,DRG),PSOHOLDA 102 .I $G(PSORXED) D 103 ..S DA=$P(PSOLST(ORN),"^",2) D MESS,ENQ^PSORXDL,FULL^VALM1 104 ..K PSOSD($P(PSOLST(ORN),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1 105 K DTOUT,DIROUT,DIRUT,DUOUT 106 D ULRX 107 Q 108 MESS W !!,"Canceling Rx: "_$P($G(^PSRX(DA,0)),"^")_" "_"Drug: "_$P($G(^PSDRUG($P(^PSRX(DA,0),"^",6),0)),"^"),! Q 109 PPL F PSOSL=0:0 S PSOSL=$O(PSORX("PSOL",PSOSL)) Q:'PSOSL S PSOX2=PSOSL 110 I $G(PSOX2) D 111 .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)="" 112 .F PSOL=0:0 S PSOL=$O(PSOL(PSOL)) Q:'PSOL F ENT=0:0 S ENT=$O(PSOL(PSOL,ENT)) Q:'ENT D 113 ..I ENT=1,'$P(PSORX("PSOL",PSOL),",",2) K PSORX("PSOL",PSOL) Q 114 ..I ENT=1,$P(PSORX("PSOL",PSOL),",",2) S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",2,99) Q 115 ..S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",1,ENT-1)_","_$P(PSORX("PSOL",PSOL),",",ENT+1,99) 116 K PSOX2,PSOSL,PSOL,ENT Q 117 ULRX ; 118 I '$G(PSODGRLX) Q 119 D PSOUL^PSSLOCK(PSODGRLX) K PSODGRLX 120 Q
Note:
See TracChangeset
for help on using the changeset viewer.
