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

PSODGAL1.m

Go to the documentation of this file.
  1. PSODGAL1 ;BIR/LC,SAB - enhanced DRUG ALLERGY REACTION CHECKING ;12/09/07 02:22
  1. ;;7.0;OUTPATIENT PHARMACY;**251,401,390,424,429,411,500**;DEC 1997;Build 9
  1. ;External reference to $$ORCHK2^GMRAOR supported by DBIA 2378
  1. ;External reference to ^PS(50.605 supported by DBIA 696
  1. ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076
  1. ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729
  1. ;External reference to ^PS(55 supported by DBIA 2228
  1. ;External reference to ^PS(53.1 supported by DBIA 5793
  1. ;External reference to ^PSJRXI supported by DBIA 6076
  1. ;External reference to SIG^XUSESIG supported by DBIA 10050
  1. ;External reference to $$FINDC^PSJDGAL2 supportedby DBIA 6140
  1. ;
  1. EN ; Called from both inpatient and outpatient pharmacy
  1. N PSOACK,DFN,PSODAL,RXN,LPTR,PSOSEVT,PSOSEVT1,NDF,PSOSYMS,PSOINGRE,PSOSORT,PSOGIEN,PSODGCL,PSODGCL1,I,II,PSOADA,PSOADAT,PSOASEV,PSOASITE,PSODRCL1,PSODRCL
  1. N PSOINGR,PSOGMRA,PSOGMRA2,PSOIADAT,PSOLCLAS,PSOLOC,PSOOINGR,PSOSEV,PSOSNAM,PTR,TYP,ZPOP,ZPOP2,ZSITE,ZZSITE,PSOCAGNT,PSORXORD
  1. K ^TMP($J,"PSODRCLS"),DSPLQ,PSOMDC,ZGMRA,GMRAING,GMRADRCL,GMRAREAC,PSOALGYF,PSOASORT,GMRARSLT
  1. S DFN=PSODFN
  1. S (NDF,TYP,PTR,PSOALGYF)=""
  1. I $D(PSODRUG("NDF")),PSODRUG("NDF")'=0 S NDF=$P(PSODRUG("NDF"),"A"),TYP=$P(PSODRUG("NDF"),"A",2),PTR=$S(NDF=0:"",1:NDF)_"."_TYP
  1. S $P(PTR,".",3)=PSODRUG("IEN")
  1. ;
  1. CHK ;matched to ndf
  1. S:'$G(PSJALGCT) PSJALGCT=1 ;counter for inpatient; OP will always be 1
  1. K ZMED,ZMEDLCL S PSOACK=$$ORCHK2^GMRAOR(DFN,"DR",PTR,"","GMRARSLT") D:+$G(PSOACK)>0
  1. .D DSPLY Q:$G(PSORX("DFLG"))!($G(PSGORQF))
  1. .Q:$D(^XUSEC("PSORPH",DUZ))!($G(PSODGCK))
  1. .I +$G(PSOACK)=1 D
  1. ..N ZMSG,ZLOCAL,ZINGREDS,ZI,ZINGRED
  1. ..S ^TMP("PSODAI",$J,0)=1,(PSOSEV,PSOLOC,PSODRG)=""
  1. ..S ZMSG="" F S ZMSG=$O(GMRARSLT(ZMSG)) Q:'ZMSG D
  1. ...S PSOGIEN=$$GMSGPTR(ZMSG)
  1. ...Q:PSOGIEN=""
  1. ...S ZLOCAL=$S($P(GMRARSLT(ZMSG,PSOGIEN),U,2)="L":" (local)",1:" (remote)")
  1. ...S ZINGREDS=$G(GMRARSLT(ZMSG,"MESSAGE","OFFENDERS","ING"))
  1. ...Q:ZINGREDS=""
  1. ...S:$E(ZINGREDS,1)="~" ZINGREDS=$E(ZINGREDS,2,9999)
  1. ...F ZI=1:1:$L(ZINGREDS,"~") S ZINGRED=$P(ZINGREDS,"~",ZI) Q:ZINGRED="" D
  1. ....S ^TMP("PSODAI",$J,ZI,0)=ZINGRED_ZLOCAL
  1. ....Q
  1. Q:$G(PSORX("DFLG"))!($G(PSGORQF))
  1. S NDF=$P(PSODRUG("NDF"),"A")
  1. I +$G(PSOACK)>0!$G(^TMP($J,"PSODRCLS",0)) D
  1. .I '$D(^XUSEC("PSORPH",DUZ)),'$D(PSOMDC) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR,DUOUT,DIRUT Q
  1. .I $D(PSJDGCK)!$D(PSODGCK) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR,DUOUT,DIRUT W @IOF Q
  1. .S DIR("?",1)="Answer 'YES' if you DO want to enter a intervention for this medication,",DIR("?")=" 'NO' if you DON'T want to enter a intervention for this medication,"
  1. .S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="YES" D ^DIR I '$G(PSJAOC) W !
  1. .I ($D(DTOUT))!($D(DUOUT)) S:'$G(PSJAOC) (PSODLQT,PSORX("DFLG"))=1 S:$G(PSJAOC) PSGORQF=1 Q
  1. .I 'Y D:$G(PSOSEVT1("S"))=1 Q
  1. ..S:$G(PSJAOC) PSGORQF=1
  1. ..S:'$G(PSJAOC) (PSORX("DFLG"),PSOQUIT)=1
  1. ..W !!,"With a SEVERE reaction, an intervention is required!",! S VALMBCK="R"
  1. ..I $G(PSGCOPY)=1!($G(PSIVCOPY)=1) W !,"Order not copied!",! S PSJCOFLG=1 ;set flag if COPY to not repeat this message in PSGOD
  1. ..I $G(PSJREN)=1 W !,"No changes made to this order!",! S PSJRNFLG=1 ;set flag if RENEW to not repeat this message in PSGOEE
  1. ..I '$G(PSOSPRNW) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR
  1. ..S:$G(PSOSPRNW) PSORENW("DFLG")=1,PSORX("DFLG")=0,PSOQUIT=1
  1. ..I $D(DTOUT)!($D(DUOUT)) D K DIR,DUOUT,DIRUT W !
  1. ...I $G(PSJAOC) S PSGORQF=1 Q ;inpatient
  1. ...S (PSODLQT,PSOQUIT,PSORX("DFLG"))=1
  1. .D CRI:$G(PSOSEVT1("S"))=1
  1. .Q:$G(PSORX("DFLG"))!($G(PSGORQF))
  1. .I $G(PSJAOC) S PSJDAL=1 D ^PSJRXI I $G(PSJDAL("DA")) S $P(^TMP("PSODAOC",$J,"ALLERGY",PSJALGCT,"INTERVENTION"),"^")=PSJDAL("DA") K PSJDAL("DA")
  1. .I '$G(PSJAOC) S PSODAL=1 D ^PSORXI I $G(PSODAL("DA")) S $P(^TMP("PSODAOC",$J,"ALLERGY",PSJALGCT,"INTERVENTION"),"^")=PSODAL("DA") K PSODAL("DA")
  1. .K PSJRXI("DA"),PSODAL("DA")
  1. EX K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,DSPLQ,PSOMDC,AGNL,SEV,SEV,ZGMRA,LPTR,ALTOT
  1. K PSOACK,GMRAING,GMRADRCL,GMRAREAC,GMRARSLT,I,APTR,GMRA,LP,^TMP($J,"PSODRCLS"),ZCLA,ZCNT,ZINSTL,ZSAT
  1. I $D(PSJDGCK)!$D(PSODGCK)!$G(PSORX("DFLG"))!$G(PSGORQF) K ^TMP("PSODAOC",$J)
  1. I '$G(PSJAOC) K PSGORQF
  1. Q
  1. ;
  1. DSPLY ;
  1. K PSOSYMS,PSOCAGNT
  1. D SORTN^PSODGAL3,FULL^VALM1
  1. K AGNL,SEV,SEVN,PSOHIS N INGLOC,ZINGLOC,ZMEDL,DACNT,DACNT2,ZSTA,ZDATE
  1. N ZZING,ZZLOC,ZZALL,PSOACNT,PSOLOCAL,PSOPTR,PSOSITT,PSOCA,ZLOC,PSOATYPE S (ALTOT,DACNT,DACNT2,ZLOC,ZCLA,PSOACNT,PSOATYPE)=0,ZMEDL=""
  1. S (ZZLOC,PSOCA,ZZALL,ZZING,PSOSEV,PSOINGR,PSOASITE,PSOIADAT,PSOGIEN,PSOADA)=""
  1. F S PSOSEV=$O(PSOCAGNT(PSOSEV)) Q:PSOSEV="" F S PSOCA=$O(PSOCAGNT(PSOSEV,PSOCA)) Q:PSOCA="" F S PSOATYPE=$O(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)) Q:PSOATYPE="" S ALTOT=ALTOT+1
  1. F S PSOSEV=$O(PSOCAGNT(PSOSEV)) Q:PSOSEV=""!($G(PSORX("DFLG")))!($G(PSGORQF)) F S PSOCA=$O(PSOCAGNT(PSOSEV,PSOCA)) Q:PSOCA=""!($G(PSORX("DFLG")))!($G(PSGORQF)) D
  1. .F S PSOATYPE=$O(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)) Q:PSOATYPE=""!($G(PSORX("DFLG")))!($G(PSGORQF)) D
  1. ..S PSOGMRA2=""
  1. ..S PSOGMRA2=PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)
  1. ..S (PSOPTR,ZZALL,PSODRCL)=""
  1. ..S PSOPTR=$P($P(PSOGMRA2,"^",1),"|")
  1. ..S PSOSITT=$P($P(PSOGMRA2,"^",1),"|",4)
  1. ..S ZZALL=$$GMSGPTR(PSOPTR)
  1. ..Q:ZZALL=""
  1. ..D DSPLY1
  1. Q
  1. DSPLY1 ;
  1. ; 1 2 3 4 5 6 7 8 9 10
  1. N ZINDATE,ZSIGN,PSOINSTL,PSOSTA,PSOHIS,PSOSTYP,PSOMEDL,PSOLOCAL,PSODATA,PSOWCA,PSOCAR,PSOSTYPI,PSOLOCI,PSOMEDLI,PSOHISI,PSOSEVI,DRCLIEN,DRCLIENE,PSODCLAS,ZALL,ZMSG
  1. S PSOHISI=$P(GMRARSLT(PSOPTR,ZZALL),U,8)
  1. S PSOHIS=$S(PSOHISI="o":"OBSERVED",1:"HISTORICAL")
  1. S PSOASEV=$$GETSEV^PSODGAL3(PSOSITT,PSOPTR,.GMRARSLT)
  1. S PSOSEVT=PSOSEV
  1. S DACNT=DACNT+1
  1. S DACNT2=DACNT2+1
  1. S:PSOSEV=1 PSOSEVT1("S")=1
  1. W $C(7),!!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
  1. W !,$S($G(PSODGCKF)!($G(PSJDGFLG)):" Profile Drug: ",1:" Prospective Drug: ")
  1. ;
  1. S PSORXORD=""
  1. N PSJCPROS,PSJNCOM,PROSPECT S (PSJCPROS,PSJNCOM,PROPSECT)=""
  1. I $G(PSJAOC) D
  1. .S PSORXORD=$S($G(PSJORD):PSJORD,$G(ON55):ON55,$G(ON):ON,$G(PSJNORD):PSJNORD,1:"")
  1. .I '$G(PSORXORD) S PSORXORD=$G(PSGORD)
  1. .;for complex UD orders display format: orderable item doseform (units) ex: MORPHINE TAB,SA (100MG)
  1. .I $G(PSJCOM) S PSJNCOM=$$FINDC^PSJDGAL2($G(PSORXORD)),PSJCPROS=$P(PSJNCOM,"^",2)
  1. .I '$G(PSJDGCK)&('$G(PSODGCK)) W $S($G(PSORXORD)["V":PSODRUG("OIN"),$G(PSORXORD)["P"&($D(^PS(53.1,+$G(PSORXORD),"AD"))):PSODRUG("OIN"),$G(PSJCOM):PSJCPROS,1:PSODRUG("NAME"))
  1. .I $G(PSJDGCK)!($G(PSODGCK)) W PSODRUG("NAME")
  1. E W PSODRUG("NAME")
  1. ;
  1. W !," Causative Agent: "
  1. S (PSOWCA,PSOCAR)="",PSOALGYF=1
  1. I PSOCA["/" D S PSOCAR=$E(PSOCAR,3,$L(PSOCAR))
  1. . F I=1:1 S PSOWCA=$P(PSOCA,"/",I) Q:PSOWCA="" S PSOCAR=PSOCAR_"/ "_PSOWCA
  1. I PSOCAR="" S PSOCAR=PSOCA
  1. ;
  1. K ^UTILITY($J,"W"),X S DIWL=1,DIWR=55,(X,DIWF)=""
  1. N CAUSAGNT S (X,PSODCLAS,CAUSAGNT,ZSITE)="",CAUSAGNT=PSOCAGNT(PSOSEV,PSOCA,PSOATYPE)
  1. ;
  1. SITE ;
  1. S X=""
  1. F II=1:1 S ZSITE=$P(CAUSAGNT,"^",II) Q:ZSITE="" D
  1. .S (ZDATE,PSOSNAM,ZZSITE,PSOLOCAL)=""
  1. .S ZZSITE=$P(ZSITE,"|",4),ZDATE=$P(ZSITE,"|",2),PSOLOCAL=$P(ZSITE,"|",3),ZMSG=$P(ZSITE,"|")
  1. .S PSOSNAM=$P(GMRARSLT(ZMSG,"MESSAGE",1,ZZSITE),U)
  1. .;;S PSOSNAM=$$GET1^DIQ(4,ZZSITE,.01)
  1. .S X=X_", "_PSOSNAM_" - "_$P(ZDATE,"@")
  1. S X=$S(X'="":PSOCAR_" ("_$E(X,3,9999)_")",1:PSOCAR)
  1. D ^DIWP,UTIL
  1. ;
  1. W " Historical/Observed: "_$P(PSOHIS,";")
  1. W !," Severity: "_$S(PSOASEV="":"Not Entered",1:PSOASEV)
  1. S (PSOOINGR,ZPOP)="" N Z,ZI,ZX,ZOV,PSOWINGR,PSOWIN,REMSITE,REMTMP
  1. S DIWL=1,DIWR=55,(X,DIWF)=""
  1. F S PSOINGR=$O(PSOCAGNT(PSOSEV,PSOCA,PSOATYPE,PSOINGR)) Q:PSOINGR=""!(PSOINGR="ZZZSYMPTOMS") D
  1. .I '$G(ZPOP) S ZPOP=1 W !?7," Ingredients: "
  1. .S X=X_", "_PSOINGR
  1. D ^DIWP,UTIL
  1. K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX,X,^TMP("PSN",$J),PSNDA,PSNID
  1. I $P(GMRARSLT(PSOPTR,"MESSAGE",2),U)]"" D SYM1 S ZSIGN=1
  1. I '$G(ZSIGN) W ?3," Signs/Symptoms: None Entered",!
  1. S PSOLOCAL="",PSOLOCAL=$P($P(ZZALL,"^",3),"|",2)
  1. ;
  1. DRCL ;PSODRCL1(99,"AMPICILLIN/SULBACTAM","PENICILLINS,AMINO DERIVATIVES")=1
  1. I $D(PSODRCL1(PSOSEV,PSOCA,PSOATYPE)) D
  1. .W ?8," Drug Class: "
  1. .N III,XX,X K ^UTILITY($J,"W") S DIWL=1,DIWR=55,(X,XX,DIWF)=""
  1. .F S XX=$O(PSODRCL1(PSOSEV,PSOCA,PSOATYPE,XX)) Q:XX="" D
  1. ..S DRCLIEN=PSODRCL1(PSOSEV,PSOCA,PSOATYPE,XX),DRCLIENE=$$GET1^DIQ(50.605,DRCLIEN,.01,"E")
  1. ..S X=X_", "_$S(DRCLIENE'="":DRCLIENE_" ",1:"")_XX
  1. .S X=$E(X,3,999) D ^DIWP
  1. .D UTIL
  1. D OVRD ;Override Reason
  1. S PSOACNT=PSOACNT+1
  1. I ALTOT>PSOACNT K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S:$G(PSJAOC) PSGORQF=1 S:'$G(PSJAOC) (PSODLQT,PSORX("DFLG"))=1 K DIR,DUOUT,DIRUT W @IOF
  1. Q
  1. ;
  1. OVRD ; Override Reason
  1. N Z,ZI,ZX,ZOV,ZORN,X,PSOPRET,PSOOVRDR K ^UTILITY($J,"W") S DIWL=1,DIWR=50,(ZOV,ZORN,DIWF)=""
  1. I '+$G(PSJORD) D G OVRDX
  1. .I $G(PSOFOERR) D Q
  1. ..S PSOOVRDR=+$P($G(^PS(52.41,ORD,0)),"^") S:PSOOVRDR ZORN=PSOOVRDR
  1. .I $G(PSOREINS) D Q
  1. ..I $G(ZRXN) S ZORN=$P(^PSRX(ZRXN,"OR1"),"^",2)
  1. .I $G(PSOVER1),$G(PSONV) S PSOOVRDR=+$P($G(^PSRX(PSONV,"OR1")),"^",2) S:PSOOVRDR ZORN=PSOOVRDR
  1. ;
  1. I '$G(PSJINFIN) G OVRDX
  1. I PSJORD["P" S ZORN=+$P($G(^PS(53.1,+PSJORD,0)),U,21) G OVRDX
  1. I PSJORD["U" S ZORN=+$P($G(^PS(55,DFN,5,+PSJORD,0)),U,21) G OVRDX
  1. I PSJORD["V" S ZORN=+$P($G(^PS(55,DFN,"IV",+PSJORD,0)),U,21)
  1. OVRDX ;
  1. G:'$G(ZORN) NF
  1. D GETOC4^OROCAPI1(ZORN,.PSOPRET)
  1. F ZI=0:0 S ZI=$O(PSOPRET(ZORN,"DATA",ZI)) Q:'ZI I $P($P(PSOPRET(ZORN,"DATA",ZI,1),"^"),";",2)=3,$G(PSOPRET(ZORN,"DATA",ZI,"OR",1,0))]"" S ZOV=$G(PSOPRET(ZORN,"DATA",ZI,"OR",1,0))
  1. S ^TMP("PSODAOC",$J,"ALLERGY","PROVR")=ZOV
  1. NF ;
  1. I '$G(PSODGCK)&('$G(PSJDGCK)) D
  1. .W !?3,"Provider Override Reason: " S X=$S($G(ZOV)]"":ZOV,1:"N/A - Order Check Not Evaluated by Provider") D ^DIWP
  1. .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?29,^UTILITY($J,"W",1,ZX,0),!
  1. .K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,ZORN,RET
  1. ; pso*7*401
  1. I $D(PSOMDC) D
  1. .W !,"Warning: The following drug class does not exist in the VA DRUG CLASS"
  1. .W !,"file (#50.605). Please do a manual Drug-Allergy order check and notify"
  1. .W !,"the pharmacy ADPAC for follow up.",!
  1. .S PSOMDC="" F S PSOMDC=$O(PSOMDC(PSOMDC)) Q:PSOMDC="" W !,"VA Drug Class: "_PSOMDC,!
  1. .W ! S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue"
  1. .D ^DIR K DIR W !
  1. Q
  1. SYM1 ;format signs/symptoms
  1. N PSOSYMX,QX,ZSYM
  1. K ^UTILITY($J,"W"),X S DIWL=1,DIWR=55,DIWF=""
  1. S (ZSYM,PSOSYMX)="",QX=0
  1. F S ZSYM=$O(PSOSYMS(PSOSEV,PSOCA,PSOATYPE,"ZZZSYMPTOMS",ZSYM)) Q:ZSYM="" S QX=QX+1,PSOSYMX=PSOSYMX_", "_$P(ZSYM,";",1)
  1. S PSOSYMX=$E(PSOSYMX,3,999),X=PSOSYMX D ^DIWP
  1. W ?4," Signs/Symptoms: "
  1. N ZNODE F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX D
  1. .S ZNODE="",ZNODE=^UTILITY($J,"W",1,ZX,0)
  1. .I $E(ZNODE,1,2)=", " S ZNODE=$E(ZNODE,3,999)
  1. .W ?22,ZNODE,!
  1. K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX
  1. Q
  1. ;
  1. CRI ;input electronic sig
  1. N X1 D SIG^XUSESIG I X1="" D Q
  1. .K PSORX("INTERVENE"),DIR
  1. .I $G(PSJAOC) S PSGORQF=1
  1. .E S PSORX("DFLG")=1,VALMBCK="R"
  1. .S:$D(PSORENW) PSORENW("DFLG")=1
  1. .W !!,"With a SEVERE reaction, an Electronic Signature is required!",!
  1. .I $G(PSGCOPY)=1!($G(PSIVCOPY)=1) W !,"Order not copied!",!
  1. .I $G(PSJREN)=1 W !,"No changes made to this order!",!
  1. .S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR W !
  1. S PSORX("INTERVENE")=1
  1. Q
  1. DIR ;
  1. S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue"
  1. D ^DIR K DIR W !
  1. Q
  1. ;
  1. UTIL ;
  1. N ZNODE F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX D
  1. .S ZNODE="",ZNODE=^UTILITY($J,"W",1,ZX,0)
  1. .I $E(ZNODE,1,2)=", " S ZNODE=$E(ZNODE,3,999)
  1. .W ?22,ZNODE,!
  1. K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX
  1. Q
  1. ;
  1. GMSGPTR(MSG,NODE) ; retrieve second level pointer from new allergy array
  1. N RESULT
  1. S RESULT=$O(GMRARSLT(MSG,$G(NODE)))
  1. Q:+RESULT>0 RESULT
  1. S:RESULT="MESSAGE" RESULT=$O(GMRARSLT(MSG,RESULT))
  1. Q:$E(RESULT,1)="R" RESULT
  1. S RESULT=""
  1. Q RESULT
  1. ;