- PSODGDGP ;BIR/SAB - drug drug interaction checker ;4/14/93
- ;;7.0;OUTPATIENT PHARMACY;**251,387,379,391,372,416,370**;DEC 1997;Build 14
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External references PSOUL^PSSLOCK supported by DBIA 2789
- ;External references to ^ORRDI1 supported by DBIA 4659
- ;External reference ^XTMP("ORRDI" supported by DBIA 4660
- ;External reference to $$DS^PSSDSAPI supported by DBIA 5425
- N DRG,PSOREMOT S (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)="",PSOREMOT=0
- D BLD Q:+$G(PSORX("DFLG"))!($G(PSODLQT))
- I '$D(^XUSEC("PSORPH",DUZ)),$G(DGI)]"" S:$G(CRIT) PSONEW("STATUS")=4 W $C(7),!,"DRUG INTERACTON WITH RX #s: "_LSI,!
- I '$D(^XUSEC("PSORPH",DUZ)),(","_$G(^TMP("PSOSER",$J,0))_",")[(",1,") S:$D(^TMP("PSODGI",$J,0)) PSONEW("STATUS")=4
- K DRG,NDF,PSOICT,IT,LSI
- I +$G(PSORX("DFLG")) Q
- I +$G(PSODRUG("NDF"))'=0 D
- .I $T(HAVEHDR^ORRDI1)']"" Q
- .I '$$HAVEHDR^ORRDI1 Q
- .;D HD^PSODDPR2():(($Y+5)>IOSL)
- .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
- .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")
- 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
- Q
- TECH ;add tech entry to RX VERIFY file (#52.4); called from new order/copy/renew
- I $$DS^PSSDSAPI,+$G(^TMP("PSODOSF",$J,0)) S ^PS(52.4,PSOXIRXN,1)=^TMP("PSODOSF",$J,0)
- Q:'$D(^TMP("PSODGI",$J,0))
- S $P(^PSRX(PSOXIRXN,"DRI"),"^")=^TMP("PSOSER",$J,0)_"^"_^TMP("PSODGI",$J,0)
- 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)
- Q
- TECH2(PSOXIRXN,PSODFN,DUZ,PSOX) ;
- I $D(PSOX("NOPSDRPH")) G T3
- Q:$D(^XUSEC("PSORPH",DUZ))
- T3 ;
- ; The only time PSOX("NOPSDRPH) key is defined equal to 1 is for controlled substances and the user doesn't hold
- ; the PSDRPH key.
- N PSODWARN,PSOSIGNIF,PSOINTSV,PSOTLBL S (PSODWARN,PSOSIGNIF,PSOTLBL,PSOINTSV)=0
- S:$$DS^PSSDSAPI&(+$G(^TMP("PSODOSF",$J,0))) PSODWARN=1 ;dosing drug warning
- 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
- ;
- ; When verification is OFF and there's a significant drug interaction or the user doesn't hold the PSDRPH key,
- ; 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
- ; a tech warning label and the bottle label must print when significant interactions are present. However if the
- ; the PSOX("NOPSDRPH") variable is defined, no labels are allowed to print and processing should continue on.
- ;
- 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
- .S $P(^PSRX(PSOXIRXN,"DRI"),"^")=^TMP("PSOSER",$J,0)
- .S $P(^PSRX(PSOXIRXN,"DRI"),"^",2)=^TMP("PSODGI",$J,0)
- .I '$P(PSOPAR,"^",2) S PSOTLBL=1
- ;
- ; If verification is ON, set file 52.4. If there are critical drug interactions or dose warnings, the fields to
- ; indicate these must be set and a tech warning label should print. If the PSOX("NOPSDRPH") variable is present,
- ; file 52.4 should be set (along with any drug interaction and dose warning data) and the technician warning label
- ; should print (PSOTLBL=2)
- ;
- I ($D(PSOX("NOPSDRPH")))!($G(PSODWARN))!($G(PSORX("VERIFY"))) D
- .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOXIRXN,DIC(0)="ML",X=PSOXIRXN
- .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")
- .I '$D(PSOX("NOPSDRPH")) Q:PSOINTSV'[1&('PSODWARN)
- .D TECH
- ;
- I $D(^PS(52.4,PSOXIRXN)) K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA
- I '$G(PSORX("VERIFY")) S:(PSOX("STATUS")=4!$G(PSODWARN)) PSOTLBL=1 ;verification off, dose warn or drug interaction, print technician warning label
- I $G(PSORX("VERIFY")) S PSOTLBL=$S('$G(PSODWARN)&('$G(PSOSIGNIF)):2,'$G(PSODWARN)&($G(PSOSIGNIF)):2,$G(PSODWARN):1,1:0)
- ;
- ; If the PSOX("NOPSDRPH") variable is present and regardless of the verification switch, labels cannot be
- ; printed (i.e. PSOTLBL=2). A technician warning label will be printed if drug interactions or dose warnings are
- ; present.
- I $D(PSOX("NOPSDRPH")) S PSOTLBL=2
- Q PSOTLBL
- ;
- BLD I $D(^XUSEC("PSORPH",DUZ)) D PHARM Q ;*370
- BLD2 ;
- Q:$P(ON,";")'="O"
- S LSI=$P(^PSRX($P(ON,";",2),0),"^")_"/"_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")_","_LSI
- I '$D(^TMP("PSODGI",$J,0)) D
- . S ^TMP("PSODGI",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGI",$J,0)),^TMP("PSOSER",$J,0)=IT_","_$G(^TMP("PSOSER",$J,0))
- I ^TMP("PSODGI",$J,0)'[$P(ON,";",2) D
- .S ^TMP("PSODGI",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGI",$J,0))
- .S ^TMP("PSOSER",$J,0)=IT_","_$G(^TMP("PSOSER",$J,0))
- 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))
- S:IT=1 ^TMP("PSOTDD",$J,1)=1
- Q
- PHARM ;pharmacist verification of drug interaction
- S PSODGRLX=$P(ON,";",2)
- S DIR("?",1)="Answer 'YES' if you DO want to "_$S(IT=1:"continue processing",1:"enter an intervention for")_" this medication,"
- S DIR("?")=" 'NO' if you DON'T want to "_$S(IT=1:"continue processing",1:"enter an intervention for")_" this medication,"
- 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
- 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
- I Y,IT=1 S PSORX("INTERVENE")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT G CRI Q
- I 'Y,IT=2 S:$G(DIRUT) (PSODLQT,PSOQUIT)=1 K DIR,DTOUT,DIRUT,DIROUT,DUOUT D ULRX Q
- I Y,IT=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 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
- I IT=1 D
- .S PSORX("INTERVENE")=IT
- .D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q
- 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(ON,";",2),0),"^")_" DRUG: "_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 "_DRG_";3:BOTH;4:CONTINUE"
- S DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$P(^PSRX($P(ON,";",2),0),"^")
- S DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$P(^PSRX($P(ON,";",2),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(ON,";",2) D MESS,ENQ^PSORXDL,FULL^VALM1
- ..K PSOSD($P(PSOLST($P(ON,";",2)),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1
- .S PSODRUG("IEN")=$P(^PSRX($P(ON,";",2),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)=$P(ON,";",2) 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 DTOUT,DIROUT,DIRUT,DUOUT,PSOHOLDA
- .S:$G(PSOSD) PSOSD=PSOSD-1 S VALMBCK="R"
- I Y=3 S (DA,PSOHOLDA)=$P(ON,";",2) 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 PSOHOLDA
- .I $G(PSORXED) D
- ..S DA=$P(ON,";",2) D MESS,ENQ^PSORXDL,FULL^VALM1
- ..K 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(ON,";",2) 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODGDGP 9852 printed Feb 18, 2025@23:53:24 Page 2
- 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
- +2 ;External reference to ^PSDRUG supported by DBIA 221
- +3 ;External references PSOUL^PSSLOCK supported by DBIA 2789
- +4 ;External references to ^ORRDI1 supported by DBIA 4659
- +5 ;External reference ^XTMP("ORRDI" supported by DBIA 4660
- +6 ;External reference to $$DS^PSSDSAPI supported by DBIA 5425
- +7 NEW DRG,PSOREMOT
- SET (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)=""
- SET PSOREMOT=0
- +8 DO BLD
- if +$GET(PSORX("DFLG"))!($GET(PSODLQT))
- QUIT
- +9 IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF $GET(DGI)]""
- if $GET(CRIT)
- SET PSONEW("STATUS")=4
- WRITE $CHAR(7),!,"DRUG INTERACTON WITH RX #s: "_LSI,!
- +10 IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF (","_$GET(^TMP("PSOSER",$JOB,0))_",")[(",1,")
- if $DATA(^TMP("PSODGI",$JOB,0))
- SET PSONEW("STATUS")=4
- +11 KILL DRG,NDF,PSOICT,IT,LSI
- +12 IF +$GET(PSORX("DFLG"))
- QUIT
- +13 IF +$GET(PSODRUG("NDF"))'=0
- Begin DoDot:1
- +14 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +15 IF '$$HAVEHDR^ORRDI1
- QUIT
- +16 ;D HD^PSODDPR2():(($Y+5)>IOSL)
- +17 IF $PIECE($GET(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0
- WRITE !!,"Remote data not available - Only local order checks processed.",!!
- SET PSOREMOT=1
- if (($Y+5)>IOSL)
- DO HD^PSODDPR2()
- QUIT
- +18 IF $DATA(^TMP($JOB,"DI"_PSODFN))
- KILL ^TMP($JOB,"DI")
- MERGE ^TMP($JOB,"DI")=^TMP($JOB,"DI"_PSODFN)
- DO DRGINT^PSOORRD2
- +19 KILL ^TMP($JOB,"DI"_PSODFN),^TMP($JOB,"DI")
- End DoDot:1
- +20 IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF $GET(PSOREMOT)!($GET(DGI)]"")
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to Continue..."
- DO ^DIR
- KILL DIR,DUOUT,DTOUT
- +21 QUIT
- TECH ;add tech entry to RX VERIFY file (#52.4); called from new order/copy/renew
- +1 IF $$DS^PSSDSAPI
- IF +$GET(^TMP("PSODOSF",$JOB,0))
- SET ^PS(52.4,PSOXIRXN,1)=^TMP("PSODOSF",$JOB,0)
- +2 if '$DATA(^TMP("PSODGI",$JOB,0))
- QUIT
- +3 SET $PIECE(^PSRX(PSOXIRXN,"DRI"),"^")=^TMP("PSOSER",$JOB,0)_"^"_^TMP("PSODGI",$JOB,0)
- +4 SET $PIECE(^PS(52.4,PSOXIRXN,0),"^",8)=1
- SET $PIECE(^PS(52.4,PSOXIRXN,0),"^",9)=^TMP("PSOSER",$JOB,0)
- SET $PIECE(^PS(52.4,PSOXIRXN,0),"^",10)=^TMP("PSODGI",$JOB,0)
- +5 QUIT
- TECH2(PSOXIRXN,PSODFN,DUZ,PSOX) ;
- +1 IF $DATA(PSOX("NOPSDRPH"))
- GOTO T3
- +2 if $DATA(^XUSEC("PSORPH",DUZ))
- QUIT
- T3 ;
- +1 ; The only time PSOX("NOPSDRPH) key is defined equal to 1 is for controlled substances and the user doesn't hold
- +2 ; the PSDRPH key.
- +3 NEW PSODWARN,PSOSIGNIF,PSOINTSV,PSOTLBL
- SET (PSODWARN,PSOSIGNIF,PSOTLBL,PSOINTSV)=0
- +4 ;dosing drug warning
- if $$DS^PSSDSAPI&(+$GET(^TMP("PSODOSF",$JOB,0)))
- SET PSODWARN=1
- +5 ;critical and significant drug interaction drug warnings
- IF $DATA(^TMP("PSOSER",$JOB,0))
- SET PSOINTSV=$GET(^TMP("PSOSER",$JOB,0))
- if PSOINTSV[1
- SET PSODWARN=1
- if PSOINTSV[2
- SET PSOSIGNIF=1
- +6 ;
- +7 ; When verification is OFF and there's a significant drug interaction or the user doesn't hold the PSDRPH key,
- +8 ; 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
- +9 ; a tech warning label and the bottle label must print when significant interactions are present. However if the
- +10 ; the PSOX("NOPSDRPH") variable is defined, no labels are allowed to print and processing should continue on.
- +11 ;
- +12 ;don't set 52.4 when verification is off and only significiant interaction
- IF '$GET(PSORX("VERIFY"))
- IF 'PSODWARN&($GET(PSOSIGNIF))
- Begin DoDot:1
- +13 SET $PIECE(^PSRX(PSOXIRXN,"DRI"),"^")=^TMP("PSOSER",$JOB,0)
- +14 SET $PIECE(^PSRX(PSOXIRXN,"DRI"),"^",2)=^TMP("PSODGI",$JOB,0)
- +15 IF '$PIECE(PSOPAR,"^",2)
- SET PSOTLBL=1
- End DoDot:1
- if '$DATA(PSOX("NOPSDRPH"))
- QUIT PSOTLBL
- +16 ;
- +17 ; If verification is ON, set file 52.4. If there are critical drug interactions or dose warnings, the fields to
- +18 ; indicate these must be set and a tech warning label should print. If the PSOX("NOPSDRPH") variable is present,
- +19 ; file 52.4 should be set (along with any drug interaction and dose warning data) and the technician warning label
- +20 ; should print (PSOTLBL=2)
- +21 ;
- +22 IF ($DATA(PSOX("NOPSDRPH")))!($GET(PSODWARN))!($GET(PSORX("VERIFY")))
- Begin DoDot:1
- +23 KILL DIC,DLAYGO,DINUM,DIADD,X,DD,DO
- SET DIC="^PS(52.4,"
- SET DLAYGO=52.4
- SET DINUM=PSOXIRXN
- SET DIC(0)="ML"
- SET X=PSOXIRXN
- +24 DO FILE^DICN
- KILL DD,DO,DIC,DLAYGO,DINUM
- SET ^PS(52.4,PSOXIRXN,0)=PSOXIRXN_"^"_PSODFN_"^"_DUZ_"^"_"^"_$EXTRACT(PSOX("LOGIN DATE"),1,7)_"^"_PSOXIRXN_"^"_PSOX("STOP DATE")
- +25 IF '$DATA(PSOX("NOPSDRPH"))
- if PSOINTSV'[1&('PSODWARN)
- QUIT
- +26 DO TECH
- End DoDot:1
- +27 ;
- +28 IF $DATA(^PS(52.4,PSOXIRXN))
- KILL DIK,DA
- SET DIK="^PS(52.4,"
- SET DA=PSOX("IRXN")
- DO IX^DIK
- KILL DIK,DA
- +29 ;verification off, dose warn or drug interaction, print technician warning label
- IF '$GET(PSORX("VERIFY"))
- if (PSOX("STATUS")=4!$GET(PSODWARN))
- SET PSOTLBL=1
- +30 IF $GET(PSORX("VERIFY"))
- SET PSOTLBL=$SELECT('$GET(PSODWARN)&('$GET(PSOSIGNIF)):2,'$GET(PSODWARN)&($GET(PSOSIGNIF)):2,$GET(PSODWARN):1,1:0)
- +31 ;
- +32 ; If the PSOX("NOPSDRPH") variable is present and regardless of the verification switch, labels cannot be
- +33 ; printed (i.e. PSOTLBL=2). A technician warning label will be printed if drug interactions or dose warnings are
- +34 ; present.
- +35 IF $DATA(PSOX("NOPSDRPH"))
- SET PSOTLBL=2
- +36 QUIT PSOTLBL
- +37 ;
- BLD ;*370
- IF $DATA(^XUSEC("PSORPH",DUZ))
- DO PHARM
- QUIT
- BLD2 ;
- +1 if $PIECE(ON,";")'="O"
- QUIT
- +2 SET LSI=$PIECE(^PSRX($PIECE(ON,";",2),0),"^")_"/"_$PIECE(^PSDRUG($PIECE(^PSRX($PIECE(ON,";",2),0),"^",6),0),"^")_","_LSI
- +3 IF '$DATA(^TMP("PSODGI",$JOB,0))
- Begin DoDot:1
- +4 SET ^TMP("PSODGI",$JOB,0)=$PIECE(ON,";",2)_","_$GET(^TMP("PSODGI",$JOB,0))
- SET ^TMP("PSOSER",$JOB,0)=IT_","_$GET(^TMP("PSOSER",$JOB,0))
- End DoDot:1
- +5 IF ^TMP("PSODGI",$JOB,0)'[$PIECE(ON,";",2)
- Begin DoDot:1
- +6 SET ^TMP("PSODGI",$JOB,0)=$PIECE(ON,";",2)_","_$GET(^TMP("PSODGI",$JOB,0))
- +7 SET ^TMP("PSOSER",$JOB,0)=IT_","_$GET(^TMP("PSOSER",$JOB,0))
- End DoDot:1
- +8 IF IT=2
- SET ^TMP("PSOSERS",$JOB,0)=IT_","_$GET(^TMP("PSOSERS",$JOB,0))
- SET ^TMP("PSODGS",$JOB,0)=$PIECE(ON,";",2)_","_$GET(^TMP("PSODGS",$JOB,0))
- +9 if IT=1
- SET ^TMP("PSOTDD",$JOB,1)=1
- +10 QUIT
- PHARM ;pharmacist verification of drug interaction
- +1 SET PSODGRLX=$PIECE(ON,";",2)
- +2 SET DIR("?",1)="Answer 'YES' if you DO want to "_$SELECT(IT=1:"continue processing",1:"enter an intervention for")_" this medication,"
- +3 SET DIR("?")=" 'NO' if you DON'T want to "_$SELECT(IT=1:"continue processing",1:"enter an intervention for")_" this medication,"
- +4 WRITE !
- SET DIR(0)="SA^1:YES;0:NO"
- SET DIR("A")="Do you want to "_$SELECT(IT=1:"Continue? ",1:"Intervene? ")
- SET DIR("B")="Y"
- DO ^DIR
- +5 IF 'Y
- IF IT=1
- SET PSODLQT=1
- SET DGI=""
- if '$GET(PSORXED)&('$GET(PSOREINS))
- SET PSORX("DFLG")=1
- if $GET(PSORXED)!($GET(PSOREINS))
- SET PSOQUIT=1
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- QUIT
- +6 IF Y
- IF IT=1
- SET PSORX("INTERVENE")=1
- SET DGI=""
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- GOTO CRI
- QUIT
- +7 IF 'Y
- IF IT=2
- if $GET(DIRUT)
- SET (PSODLQT,PSOQUIT)=1
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- DO ULRX
- QUIT
- +8 IF Y
- IF IT=2
- SET PSORX("INTERVENE")=2
- SET DGI=""
- KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT
- +9 DO ULRX
- +10 QUIT
- CRI ;process new drug interactions entered by pharmacist
- +1 ;G:$P(PSOSD(STA,DRG),"^",9) CRITN
- KILL DIR
- +2 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"
- +3 SET DIR("?",1)="Enter '1' or 'P' to Process medication"
- SET DIR("?")=" '^' to EXIT"
- SET DIR("?",2)=" '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
- +4 IF IT=1
- Begin DoDot:1
- +5 SET PSORX("INTERVENE")=IT
- +6 DO SIG^XUSESIG
- IF X1=""
- KILL PSORX("INTERVENE")
- SET PSORX("DFLG")=1
- QUIT
- End DoDot:1
- +7 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(ON,";",2),0),"^")_" DRUG: "_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 "_DRG_";3:BOTH;4:CONTINUE"
- +3 SET DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$PIECE(^PSRX($PIECE(ON,";",2),0),"^")
- +4 SET DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$PIECE(^PSRX($PIECE(ON,";",2),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(ON,";",2)
- DO MESS
- DO ENQ^PSORXDL
- DO FULL^VALM1
- +10 KILL PSOSD($PIECE(PSOLST($PIECE(ON,";",2)),"^",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(ON,";",2),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)=$PIECE(ON,";",2)
- 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 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)=$PIECE(ON,";",2)
- 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 PSOHOLDA
- +31 IF $GET(PSORXED)
- Begin DoDot:2
- +32 SET DA=$PIECE(ON,";",2)
- DO MESS
- DO ENQ^PSORXDL
- DO FULL^VALM1
- +33 KILL 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(ON,";",2)
- 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