204 lines
9.5 KiB
Mathematica
204 lines
9.5 KiB
Mathematica
GMRAOR ;HIRMFO/WAA,RM-OERR UTILITIES ;10/23/06 09:26
|
|
;;4.0;Adverse Reaction Tracking;**2,13,26,37**;Mar 29, 1996;Build 1
|
|
ORCHK(DFN,TYP,PTR,LOC) ; Given a patient IEN (DFN), this function will
|
|
; return 1 (true) if the patient has an allergy to an agent defined
|
|
; by TYP and PTR, else it returns 0 (false). See table below.
|
|
; The Contrast Media Reaction check will return a null if the patient
|
|
; is not in the ART database. Contrast Media checks will also
|
|
; return whether the check is from local or remote data as the second
|
|
; piece of the flag if LOC is defined as a positive integer
|
|
;
|
|
; Contrast Media Reaction: TYP="CM", PTR (undefined)
|
|
; Drug Reaction: TYP="DR", PTR=IEN in ^PSNDF(.
|
|
; Drug Ingredients: TYP="IN", PTR=IEN in ^PS(50.416,
|
|
; Drug Class: TYP="CL", PTR=IEN in ^PS(50.605,
|
|
;
|
|
N GMRAFLG,GMRACM,DA ;37
|
|
S GMRAFLG=0
|
|
I $G(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$G(TYP)_"^"))!($G(TYP)'="CM"&($G(PTR)<1)) S GMRAFLG=""
|
|
E D
|
|
.D GETDATA(DFN) ;26 Retreive local/remote allergy data for order checking
|
|
.I TYP="CM" S GMRAFLG=$$RAD(DFN)_$S($G(LOC)&($G(GMRACM)'=""):("^"_$G(GMRACM)),1:"") ;37 check for Contrast Media Reaction, return location if requested
|
|
.I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR) ; check for Drug Reaction
|
|
.I TYP="IN" S GMRAFLG=$$ING(DFN,PTR) ; Check for Drug Ingredients
|
|
.I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR) ; Check for Drug Class
|
|
.Q
|
|
Q GMRAFLG
|
|
RAD(DFN) ; Subroutine checks for Contrast Media Reaction, returns 1 or 0.
|
|
N FLG,DC,LOCAL,REMOTE ;37 entire section added
|
|
S FLG=$P($G(^GMR(120.86,DFN,0)),U,2) S:FLG=1 FLG=0 S DC="DX10" F S DC=$O(^TMP("GMRAOC",$J,"APC",DC)) Q:DC'["DX10" D
|
|
.S FLG=1
|
|
.I $G(^TMP("GMRAOC",$J,"APC",DC))["LOCAL" S LOCAL=1
|
|
.I $G(^TMP("GMRAOC",$J,"APC",DC))["REMOTE" S REMOTE=1
|
|
S GMRACM=$S($G(LOCAL)&($G(REMOTE)):"LOCAL AND REMOTE SITE(S)",$G(LOCAL):"LOCAL",$G(REMOTE):"REMOTE SITE(S)",1:"")
|
|
;D EN1^GMRADPT S FLG=GMRAL
|
|
;I GMRAL S GMRAPA=0 F S GMRAPA=$O(GMRAL(GMRAPA)) Q:GMRAPA<1 D Q:FLG
|
|
;.S FLG=$$RALLG^GMRARAD(GMRAPA)
|
|
;.Q
|
|
Q FLG
|
|
DRUG(DFN,PTR) ; Subroutine checks for Drug Reaction, returns 1 or 0.
|
|
N %,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA S FLG=0
|
|
K GMRAING,GMRADRCL
|
|
S PSNDA=$P(PTR,"."),PSNVPN=$P(PTR,".",2)
|
|
I $G(@($$NDFREF_PSNDA_",0)"))'="" D
|
|
.; Check for rxn to ingredients.
|
|
.; If use the new entry point if there.
|
|
.I $T(DISPDRG^PSNNGR)]"",PSNVPN]"" D
|
|
..K ^TMP("PSNDD",$J) D DISPDRG^PSNNGR ; get ingredients
|
|
..S GMRAI=0,%=1 F S GMRAI=$O(^TMP("PSNDD",$J,GMRAI)) Q:GMRAI<1 I $D(^TMP("GMRAOC",$J,"API",GMRAI)) S FLG=1,GMRAING(%)=^TMP("PSNDD",$J,GMRAI)_$$FAC(^TMP("GMRAOC",$J,"API",GMRAI)),%=%+1 ;26
|
|
..K ^TMP("PSNDD",$J)
|
|
..Q
|
|
.E D ; get ingredients
|
|
..K ^TMP("PSN",$J) D ^PSNNGR
|
|
..S GMRAI=0,%=1 F S GMRAI=$O(^TMP("PSN",$J,GMRAI)) Q:GMRAI<1 I $D(^TMP("GMRAOC",$J,"API",GMRAI)) S FLG=1,GMRAING(%)=^TMP("PSN",$J,GMRAI)_$$FAC(^TMP("GMRAOC",$J,"API",GMRAI)),%=%+1 ;26
|
|
..K ^TMP("PSN",$J)
|
|
..Q
|
|
.Q:FLG ; Rxn to ingredient, quit now.
|
|
.; Check for rxn to VA Drug Class
|
|
.S PSNDA=$P(PTR,"."),PSNVPN=$P(PTR,".",2)
|
|
.N CLASS
|
|
.I PSNVPN S CLASS=$$DCLCODE^PSNAPIS(PSNDA,PSNVPN) D DRCL(CLASS) Q
|
|
.N CLASS,LIST
|
|
.S LIST=$$CLIST^PSNAPIS(PSNDA,.LIST) Q:'$G(LIST)
|
|
.S LIST=0 F S LIST=$O(LIST(LIST)) Q:'LIST D DRCL($P(LIST(LIST),U,2))
|
|
.Q
|
|
Q FLG
|
|
FAC(NODE) ;
|
|
N FAC
|
|
S FAC=$S($L(NODE):" ("_NODE_")",1:"")
|
|
Q FAC
|
|
DRCL(CODE) ;return any rxn's in GMRADRCL(
|
|
I '$D(^TMP("GMRAOC",$J,"APC",CODE)) Q
|
|
N J S J=$S('$D(GMRADRCL):1,1:$O(GMRADRCL(999),-1)+1)
|
|
;S GMRADRCL(J)=$$CLASS2^PSNAPIS(CODE)
|
|
N CLSFN
|
|
S CLSFN=$P(^PS(50.605,+$O(^PS(50.605,"B",CODE,0)),0),U,2)
|
|
S GMRADRCL(J)=CODE_"^"_CLSFN_$$FAC(^TMP("GMRAOC",$J,"APC",CODE))
|
|
S FLG=2
|
|
Q
|
|
ING(DFN,PTR) ; Subroutine checks for Drug Ingredients, returns:
|
|
; If found FLG= 1 with GMRAIEN Array Drug Ingredients
|
|
; Not found FLG= 0
|
|
N GMRAX K GMRAIEN
|
|
S FLG=0
|
|
S GMRAX=0
|
|
F S GMRAX=$O(^GMR(120.8,"API",DFN,PTR,GMRAX)) Q:GMRAX<1 S FLG=1,GMRAIEN(GMRAX)=""
|
|
Q FLG
|
|
CLASS(DFN,PTR) ; Subroutine checks for Drug Class, returns:
|
|
; If found FLG= 1 with GMRAIEN Array Drug Class
|
|
; Not found FLG= 0
|
|
N GMRAC,GMRAX K GMRAIEN
|
|
S GMRAX=0,FLG=0,GMRAC=$P($G(^PS(50.605,PTR,0)),U)
|
|
I GMRAC'="" F S GMRAX=$O(^GMR(120.8,"APC",DFN,GMRAC,GMRAX)) Q:GMRAX<1 S FLG=1,GMRAIEN(GMRAX)=""
|
|
Q FLG
|
|
NDFREF() ;get version dependent NDF reference
|
|
I $$VERSION^XPDUTL("PSN")<4 Q "^PSNDF("
|
|
Q "^PSNDF(50.6," ; new reference for ver 4.0
|
|
;
|
|
GETDATA(DFN) ;Obtain local and HDR related allergy data for use in order checking. Section added in patch 26
|
|
;Output from call will be stored in ^TMP as follows:
|
|
;^TMP("GMRAOC",$J,"API",J)="" where J is the ingredient IEN
|
|
;^TMP("GMRAOC",$J,"APC",K)="" where K is the drug class classification (e.g. MS105)
|
|
;
|
|
L +^XTMP("GMRAOC",DFN)
|
|
S ^XTMP("GMRAOC",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
|
|
N GMRRECDT,GMRCACHE,GMRFRESH,GMRNEW,GMRXTMP
|
|
S (GMRFRESH,GMRNEW,GMRXTMP)=0
|
|
S GMRRECDT=$P($G(^XTMP("ORRDI","ART",DFN,0)),U)
|
|
S GMRCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
|
|
I $$FMDIFF^XLFDT($$NOW^XLFDT,GMRRECDT,2)<(60*GMRCACHE),$P(^XTMP("ORRDI","ART",DFN,0),U,3)>-1 S GMRFRESH=1
|
|
S GMRXTMP=$D(^XTMP("GMRAOC",DFN))
|
|
S GMRNEW=$S($D(^XTMP("GMRAOC",DFN,"ERROR")):2,$D(^XTMP("GMRAOC",DFN,"NEW")):1,1:0)
|
|
I GMRFRESH&GMRXTMP&(GMRNEW=1) K ^XTMP("GMRAOC",DFN,"NEW") D LOCAL(DFN)
|
|
I 'GMRFRESH!'GMRXTMP!(GMRNEW=2) K ^XTMP("GMRAOC",DFN) D REMOTE(DFN),LOCAL(DFN)
|
|
I GMRRECDT'=$G(^XTMP("GMRAOC",DFN,0)) K ^XTMP("GMRAOC",DFN) D REMOTE(DFN),LOCAL(DFN)
|
|
K ^TMP("GMRAOC",$J)
|
|
M ^TMP("GMRAOC",$J)=^XTMP("GMRAOC",DFN)
|
|
L -^XTMP("GMRAOC",DFN)
|
|
Q
|
|
;
|
|
SETNODE(ITEM,DATA) ;
|
|
N VALUE
|
|
S VALUE=""
|
|
I ITEM[DATA S VALUE=ITEM Q VALUE
|
|
I DATA="LOCAL" D Q VALUE
|
|
.I ITEM="" S VALUE="LOCAL" Q
|
|
.I ITEM["REMOTE SITE(S)" S VALUE="LOCAL AND REMOTE SITE(S)"
|
|
I DATA="REMOTE SITE(S)" D Q VALUE
|
|
.I ITEM="" S VALUE="REMOTE SITE(S)" Q
|
|
.I ITEM["LOCAL" S VALUE="LOCAL AND REMOTE SITE(S)"
|
|
Q VALUE
|
|
;
|
|
LOCAL(DFN) ;
|
|
N J
|
|
S J=0 F S J=$O(^GMR(120.8,"API",DFN,J)) Q:'+J S ^XTMP("GMRAOC",DFN,"API",J)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"API",J)),"LOCAL")
|
|
S J="" F S J=$O(^GMR(120.8,"APC",DFN,J)) Q:J="" S ^XTMP("GMRAOC",DFN,"APC",J)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"APC",J)),"LOCAL")
|
|
Q
|
|
;
|
|
REMOTE(DFN) ;
|
|
;I $G(TYP)'="DR" Q ;only get remote data for order checking on drug orders
|
|
N J,FLG,REACT,IN,VUID,FILE,GMRARAY,DC,DCLASS,GMRAING,GMRADC,K,INGLST,I,PRIM,IEN
|
|
;Check for HDR data
|
|
Q:'$L($T(HAVEHDR^ORRDI1)) Q:'$$HAVEHDR^ORRDI1 ;Quit if call doesn't exist or if the HDR isn't available
|
|
Q:'$$GET^ORRDI1(DFN,"ART") ;Quit if no HDR data for selected patient
|
|
S ^XTMP("GMRAOC",DFN,0)=$P($G(^XTMP("ORRDI","ART",DFN,0)),U)
|
|
S J=0 F S J=$O(^XTMP("ORRDI","ART",DFN,J)) Q:'+J D
|
|
.S FLG=0
|
|
.S REACT=$G(^XTMP("ORRDI","ART",DFN,J,"REACTANT",0)) ;Reaction VUID
|
|
.I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS")) D ;Ingredient data exists
|
|
..S FLG=1 ;Have ingredient data so REACT is ok
|
|
..S IN=0 F S IN=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS",IN)) Q:'+IN D
|
|
...S VUID=$P(^(IN),U),FILE=$P(^(IN),U,3) ;Naked from above line
|
|
...S FILE=$P(FILE,"99VA",2)
|
|
...D GETIREF^XTID(FILE,,VUID,"GMRARAY") ;Get IENs related to VUID
|
|
...S IEN=0 F S IEN=$O(GMRARAY(FILE,.01,IEN)) Q:'+IEN S ^XTMP("GMRAOC",DFN,"API",+IEN)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"API",+IEN)),"REMOTE SITE(S)")
|
|
...K GMRARAY
|
|
.I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES")) D ;Drug class data exists
|
|
..S FLG=1
|
|
..S DC=0 F S DC=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES",DC)) Q:'+DC D
|
|
...S DCLASS=$P(^(DC),U,2) ;Naked from above, gets drug class (e.g.MS105)
|
|
...S ^XTMP("GMRAOC",DFN,"APC",DCLASS)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"APC",DCLASS)),"REMOTE SITE(S)")
|
|
.D FIND(REACT,.GMRAING,.GMRADC) I $D(GMRAING)!($D(GMRADC)) D
|
|
..S K=0 F S K=$O(GMRAING(K)) Q:'+K S ^XTMP("GMRAOC",DFN,"API",K)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"API",K)),"REMOTE SITE(S)")
|
|
..S K="" F S K=$O(GMRADC(K)) Q:K="" S ^XTMP("GMRAOC",DFN,"APC",K)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"APC",K)),"REMOTE SITE(S)")
|
|
I $D(^XTMP("GMRAOC",DFN,"API")) D
|
|
.N I,INGLST
|
|
.S I=0 F S I=$O(^XTMP("GMRAOC",DFN,"API",I)) Q:'I D
|
|
..N PRIM
|
|
..S PRIM=$$PRIMARY(I)
|
|
..I PRIM S INGLST(PRIM)=^XTMP("GMRAOC",DFN,"API",I) K ^XTMP("GMRAOC",DFN,"API",I)
|
|
.S I=0 F S I=$O(INGLST(I)) Q:'I S ^XTMP("GMRAOC",DFN,"API",I)=INGLST(I)
|
|
Q
|
|
;
|
|
FIND(REACT,ING,DC) ;If reactant didn't include drug classes and/or ingredients, try and find them locally. Section added in patch 26
|
|
N VUID,FILE,PSNDA,GMRAIEN,LIST,GMRAI,GMRALIST,GMRARAY,J,SUB,FLAG
|
|
S FLAG=0
|
|
S VUID=$P(REACT,U)
|
|
S FILE=$P(REACT,U,3)
|
|
S FILE=$P(FILE,"99VA",2)
|
|
D GETIREF^XTID(,,VUID,"GMRARAY")
|
|
S FILE="" F S FILE=$O(GMRARAY(FILE)) Q:FILE="" D
|
|
.S GMRAIEN=0 F S GMRAIEN=$O(GMRARAY(FILE,.01,GMRAIEN)) Q:'+GMRAIEN D
|
|
..I FILE=50.6 D
|
|
...K ^TMP("PSN",$J) S PSNDA=+GMRAIEN D ^PSNNGR
|
|
...S GMRAI=0 F S GMRAI=$O(^TMP("PSN",$J,GMRAI)) Q:GMRAI<1 S ING(GMRAI)=""
|
|
...K ^TMP("PSN",$J),GMRARAY
|
|
...S PSNDA=+GMRAIEN,GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST) Q:'$G(GMRALIST)
|
|
...S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST S DC($P(GMRALIST(GMRALIST),U,2))=""
|
|
..I FILE=120.82 D
|
|
...S SUB=0 F S SUB=$O(^GMRD(120.82,+GMRAIEN,"ING",SUB)) Q:'+SUB S ING(+$P($G(^GMRD(120.82,+GMRAIEN,"ING",SUB,0)),U))="" ;record ingredients
|
|
...S SUB=0 F S SUB=$O(^GMRD(120.82,+GMRAIEN,"CLASS",SUB)) Q:'+SUB S DC($P($$CLASS2^PSNAPIS(+$P($G(^GMRD(120.82,+GMRAIEN,"CLASS",SUB,0)),U)),U))="" ;Get drug classes
|
|
..I FILE=50.605 D
|
|
...S DC($P($$CLASS2^PSNAPIS(+GMRAIEN),U))=""
|
|
..I FILE=50.416 D
|
|
...S ING(+GMRAIEN)=""
|
|
Q
|
|
PRIMARY(INGIEN) ;check if INGIEN is a primary ingredient
|
|
;returns 0 if INGIEN is primary
|
|
;returns the IEN of INGIEN's primary ingredient if INGIEN is not primary
|
|
N RETURN
|
|
K ^TMP($J,"GMRALIST")
|
|
D ZERO^PSN50P41(INGIEN,,,"GMRALIST")
|
|
S RETURN=+$G(^TMP($J,"GMRALIST",INGIEN,2))
|
|
Q RETURN
|