source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAOR.m@ 1340

Last change on this file since 1340 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1GMRAOR ;HIRMFO/WAA,RM-OERR UTILITIES ;10/23/06 09:26
2 ;;4.0;Adverse Reaction Tracking;**2,13,26,37**;Mar 29, 1996;Build 1
3ORCHK(DFN,TYP,PTR,LOC) ; Given a patient IEN (DFN), this function will
4 ; return 1 (true) if the patient has an allergy to an agent defined
5 ; by TYP and PTR, else it returns 0 (false). See table below.
6 ; The Contrast Media Reaction check will return a null if the patient
7 ; is not in the ART database. Contrast Media checks will also
8 ; return whether the check is from local or remote data as the second
9 ; piece of the flag if LOC is defined as a positive integer
10 ;
11 ; Contrast Media Reaction: TYP="CM", PTR (undefined)
12 ; Drug Reaction: TYP="DR", PTR=IEN in ^PSNDF(.
13 ; Drug Ingredients: TYP="IN", PTR=IEN in ^PS(50.416,
14 ; Drug Class: TYP="CL", PTR=IEN in ^PS(50.605,
15 ;
16 N GMRAFLG,GMRACM,DA ;37
17 S GMRAFLG=0
18 I $G(DFN)<1!("^CM^DR^IN^CL^"'[("^"_$G(TYP)_"^"))!($G(TYP)'="CM"&($G(PTR)<1)) S GMRAFLG=""
19 E D
20 .D GETDATA(DFN) ;26 Retreive local/remote allergy data for order checking
21 .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
22 .I TYP="DR" S GMRAFLG=$$DRUG(DFN,PTR) ; check for Drug Reaction
23 .I TYP="IN" S GMRAFLG=$$ING(DFN,PTR) ; Check for Drug Ingredients
24 .I TYP="CL" S GMRAFLG=$$CLASS(DFN,PTR) ; Check for Drug Class
25 .Q
26 Q GMRAFLG
27RAD(DFN) ; Subroutine checks for Contrast Media Reaction, returns 1 or 0.
28 N FLG,DC,LOCAL,REMOTE ;37 entire section added
29 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
30 .S FLG=1
31 .I $G(^TMP("GMRAOC",$J,"APC",DC))["LOCAL" S LOCAL=1
32 .I $G(^TMP("GMRAOC",$J,"APC",DC))["REMOTE" S REMOTE=1
33 S GMRACM=$S($G(LOCAL)&($G(REMOTE)):"LOCAL AND REMOTE SITE(S)",$G(LOCAL):"LOCAL",$G(REMOTE):"REMOTE SITE(S)",1:"")
34 ;D EN1^GMRADPT S FLG=GMRAL
35 ;I GMRAL S GMRAPA=0 F S GMRAPA=$O(GMRAL(GMRAPA)) Q:GMRAPA<1 D Q:FLG
36 ;.S FLG=$$RALLG^GMRARAD(GMRAPA)
37 ;.Q
38 Q FLG
39DRUG(DFN,PTR) ; Subroutine checks for Drug Reaction, returns 1 or 0.
40 N %,FLG,GMRAC,GMRADR,GMRAI,PSNVPN,PSNDA S FLG=0
41 K GMRAING,GMRADRCL
42 S PSNDA=$P(PTR,"."),PSNVPN=$P(PTR,".",2)
43 I $G(@($$NDFREF_PSNDA_",0)"))'="" D
44 .; Check for rxn to ingredients.
45 .; If use the new entry point if there.
46 .I $T(DISPDRG^PSNNGR)]"",PSNVPN]"" D
47 ..K ^TMP("PSNDD",$J) D DISPDRG^PSNNGR ; get ingredients
48 ..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
49 ..K ^TMP("PSNDD",$J)
50 ..Q
51 .E D ; get ingredients
52 ..K ^TMP("PSN",$J) D ^PSNNGR
53 ..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
54 ..K ^TMP("PSN",$J)
55 ..Q
56 .Q:FLG ; Rxn to ingredient, quit now.
57 .; Check for rxn to VA Drug Class
58 .S PSNDA=$P(PTR,"."),PSNVPN=$P(PTR,".",2)
59 .N CLASS
60 .I PSNVPN S CLASS=$$DCLCODE^PSNAPIS(PSNDA,PSNVPN) D DRCL(CLASS) Q
61 .N CLASS,LIST
62 .S LIST=$$CLIST^PSNAPIS(PSNDA,.LIST) Q:'$G(LIST)
63 .S LIST=0 F S LIST=$O(LIST(LIST)) Q:'LIST D DRCL($P(LIST(LIST),U,2))
64 .Q
65 Q FLG
66FAC(NODE) ;
67 N FAC
68 S FAC=$S($L(NODE):" ("_NODE_")",1:"")
69 Q FAC
70DRCL(CODE) ;return any rxn's in GMRADRCL(
71 I '$D(^TMP("GMRAOC",$J,"APC",CODE)) Q
72 N J S J=$S('$D(GMRADRCL):1,1:$O(GMRADRCL(999),-1)+1)
73 ;S GMRADRCL(J)=$$CLASS2^PSNAPIS(CODE)
74 N CLSFN
75 S CLSFN=$P(^PS(50.605,+$O(^PS(50.605,"B",CODE,0)),0),U,2)
76 S GMRADRCL(J)=CODE_"^"_CLSFN_$$FAC(^TMP("GMRAOC",$J,"APC",CODE))
77 S FLG=2
78 Q
79ING(DFN,PTR) ; Subroutine checks for Drug Ingredients, returns:
80 ; If found FLG= 1 with GMRAIEN Array Drug Ingredients
81 ; Not found FLG= 0
82 N GMRAX K GMRAIEN
83 S FLG=0
84 S GMRAX=0
85 F S GMRAX=$O(^GMR(120.8,"API",DFN,PTR,GMRAX)) Q:GMRAX<1 S FLG=1,GMRAIEN(GMRAX)=""
86 Q FLG
87CLASS(DFN,PTR) ; Subroutine checks for Drug Class, returns:
88 ; If found FLG= 1 with GMRAIEN Array Drug Class
89 ; Not found FLG= 0
90 N GMRAC,GMRAX K GMRAIEN
91 S GMRAX=0,FLG=0,GMRAC=$P($G(^PS(50.605,PTR,0)),U)
92 I GMRAC'="" F S GMRAX=$O(^GMR(120.8,"APC",DFN,GMRAC,GMRAX)) Q:GMRAX<1 S FLG=1,GMRAIEN(GMRAX)=""
93 Q FLG
94NDFREF() ;get version dependent NDF reference
95 I $$VERSION^XPDUTL("PSN")<4 Q "^PSNDF("
96 Q "^PSNDF(50.6," ; new reference for ver 4.0
97 ;
98GETDATA(DFN) ;Obtain local and HDR related allergy data for use in order checking. Section added in patch 26
99 ;Output from call will be stored in ^TMP as follows:
100 ;^TMP("GMRAOC",$J,"API",J)="" where J is the ingredient IEN
101 ;^TMP("GMRAOC",$J,"APC",K)="" where K is the drug class classification (e.g. MS105)
102 ;
103 L +^XTMP("GMRAOC",DFN)
104 S ^XTMP("GMRAOC",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
105 N GMRRECDT,GMRCACHE,GMRFRESH,GMRNEW,GMRXTMP
106 S (GMRFRESH,GMRNEW,GMRXTMP)=0
107 S GMRRECDT=$P($G(^XTMP("ORRDI","ART",DFN,0)),U)
108 S GMRCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
109 I $$FMDIFF^XLFDT($$NOW^XLFDT,GMRRECDT,2)<(60*GMRCACHE),$P(^XTMP("ORRDI","ART",DFN,0),U,3)>-1 S GMRFRESH=1
110 S GMRXTMP=$D(^XTMP("GMRAOC",DFN))
111 S GMRNEW=$S($D(^XTMP("GMRAOC",DFN,"ERROR")):2,$D(^XTMP("GMRAOC",DFN,"NEW")):1,1:0)
112 I GMRFRESH&GMRXTMP&(GMRNEW=1) K ^XTMP("GMRAOC",DFN,"NEW") D LOCAL(DFN)
113 I 'GMRFRESH!'GMRXTMP!(GMRNEW=2) K ^XTMP("GMRAOC",DFN) D REMOTE(DFN),LOCAL(DFN)
114 I GMRRECDT'=$G(^XTMP("GMRAOC",DFN,0)) K ^XTMP("GMRAOC",DFN) D REMOTE(DFN),LOCAL(DFN)
115 K ^TMP("GMRAOC",$J)
116 M ^TMP("GMRAOC",$J)=^XTMP("GMRAOC",DFN)
117 L -^XTMP("GMRAOC",DFN)
118 Q
119 ;
120SETNODE(ITEM,DATA) ;
121 N VALUE
122 S VALUE=""
123 I ITEM[DATA S VALUE=ITEM Q VALUE
124 I DATA="LOCAL" D Q VALUE
125 .I ITEM="" S VALUE="LOCAL" Q
126 .I ITEM["REMOTE SITE(S)" S VALUE="LOCAL AND REMOTE SITE(S)"
127 I DATA="REMOTE SITE(S)" D Q VALUE
128 .I ITEM="" S VALUE="REMOTE SITE(S)" Q
129 .I ITEM["LOCAL" S VALUE="LOCAL AND REMOTE SITE(S)"
130 Q VALUE
131 ;
132LOCAL(DFN) ;
133 N J
134 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")
135 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")
136 Q
137 ;
138REMOTE(DFN) ;
139 ;I $G(TYP)'="DR" Q ;only get remote data for order checking on drug orders
140 N J,FLG,REACT,IN,VUID,FILE,GMRARAY,DC,DCLASS,GMRAING,GMRADC,K,INGLST,I,PRIM,IEN
141 ;Check for HDR data
142 Q:'$L($T(HAVEHDR^ORRDI1)) Q:'$$HAVEHDR^ORRDI1 ;Quit if call doesn't exist or if the HDR isn't available
143 Q:'$$GET^ORRDI1(DFN,"ART") ;Quit if no HDR data for selected patient
144 S ^XTMP("GMRAOC",DFN,0)=$P($G(^XTMP("ORRDI","ART",DFN,0)),U)
145 S J=0 F S J=$O(^XTMP("ORRDI","ART",DFN,J)) Q:'+J D
146 .S FLG=0
147 .S REACT=$G(^XTMP("ORRDI","ART",DFN,J,"REACTANT",0)) ;Reaction VUID
148 .I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS")) D ;Ingredient data exists
149 ..S FLG=1 ;Have ingredient data so REACT is ok
150 ..S IN=0 F S IN=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG INGREDIENTS",IN)) Q:'+IN D
151 ...S VUID=$P(^(IN),U),FILE=$P(^(IN),U,3) ;Naked from above line
152 ...S FILE=$P(FILE,"99VA",2)
153 ...D GETIREF^XTID(FILE,,VUID,"GMRARAY") ;Get IENs related to VUID
154 ...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)")
155 ...K GMRARAY
156 .I $D(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES")) D ;Drug class data exists
157 ..S FLG=1
158 ..S DC=0 F S DC=$O(^XTMP("ORRDI","ART",DFN,J,"DRUG CLASSES",DC)) Q:'+DC D
159 ...S DCLASS=$P(^(DC),U,2) ;Naked from above, gets drug class (e.g.MS105)
160 ...S ^XTMP("GMRAOC",DFN,"APC",DCLASS)=$$SETNODE($G(^XTMP("GMRAOC",DFN,"APC",DCLASS)),"REMOTE SITE(S)")
161 .D FIND(REACT,.GMRAING,.GMRADC) I $D(GMRAING)!($D(GMRADC)) D
162 ..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)")
163 ..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)")
164 I $D(^XTMP("GMRAOC",DFN,"API")) D
165 .N I,INGLST
166 .S I=0 F S I=$O(^XTMP("GMRAOC",DFN,"API",I)) Q:'I D
167 ..N PRIM
168 ..S PRIM=$$PRIMARY(I)
169 ..I PRIM S INGLST(PRIM)=^XTMP("GMRAOC",DFN,"API",I) K ^XTMP("GMRAOC",DFN,"API",I)
170 .S I=0 F S I=$O(INGLST(I)) Q:'I S ^XTMP("GMRAOC",DFN,"API",I)=INGLST(I)
171 Q
172 ;
173FIND(REACT,ING,DC) ;If reactant didn't include drug classes and/or ingredients, try and find them locally. Section added in patch 26
174 N VUID,FILE,PSNDA,GMRAIEN,LIST,GMRAI,GMRALIST,GMRARAY,J,SUB,FLAG
175 S FLAG=0
176 S VUID=$P(REACT,U)
177 S FILE=$P(REACT,U,3)
178 S FILE=$P(FILE,"99VA",2)
179 D GETIREF^XTID(,,VUID,"GMRARAY")
180 S FILE="" F S FILE=$O(GMRARAY(FILE)) Q:FILE="" D
181 .S GMRAIEN=0 F S GMRAIEN=$O(GMRARAY(FILE,.01,GMRAIEN)) Q:'+GMRAIEN D
182 ..I FILE=50.6 D
183 ...K ^TMP("PSN",$J) S PSNDA=+GMRAIEN D ^PSNNGR
184 ...S GMRAI=0 F S GMRAI=$O(^TMP("PSN",$J,GMRAI)) Q:GMRAI<1 S ING(GMRAI)=""
185 ...K ^TMP("PSN",$J),GMRARAY
186 ...S PSNDA=+GMRAIEN,GMRALIST=$$CLIST^PSNAPIS(PSNDA,.GMRALIST) Q:'$G(GMRALIST)
187 ...S GMRALIST=0 F S GMRALIST=$O(GMRALIST(GMRALIST)) Q:'GMRALIST S DC($P(GMRALIST(GMRALIST),U,2))=""
188 ..I FILE=120.82 D
189 ...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
190 ...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
191 ..I FILE=50.605 D
192 ...S DC($P($$CLASS2^PSNAPIS(+GMRAIEN),U))=""
193 ..I FILE=50.416 D
194 ...S ING(+GMRAIEN)=""
195 Q
196PRIMARY(INGIEN) ;check if INGIEN is a primary ingredient
197 ;returns 0 if INGIEN is primary
198 ;returns the IEN of INGIEN's primary ingredient if INGIEN is not primary
199 N RETURN
200 K ^TMP($J,"GMRALIST")
201 D ZERO^PSN50P41(INGIEN,,,"GMRALIST")
202 S RETURN=+$G(^TMP($J,"GMRALIST",INGIEN,2))
203 Q RETURN
Note: See TracBrowser for help on using the repository browser.