source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQAL.m@ 1639

Last change on this file since 1639 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.5 KB
RevLine 
[623]1ORQQAL ; slc/CLA,JFR - Functions which return patient allergy data ;6/8/06 14:11
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,216,232**;Dec 17, 1997;Build 19
3LIST(ORAY,ORPT) ; RETURN PATIENT'S ALLERGY/ADVERSE REACTION INFO:
4 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
5 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
6 N I,J,K
7 S I=1,J=0,K=0
8 D EN1^GMRAOR1(ORPT,"GMRARXN")
9 I $G(GMRARXN)="" S ORAY(I)="^No Allergy Assessment"
10 I $G(GMRARXN)=0 S ORAY(I)="^No Known Allergies"
11 I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" S ORAY(I)=$P(GMRARXN(J),"^",3)_"^"_$P(GMRARXN(J),"^")_"^"_$P(GMRARXN(J),"^",2) D SIGNS S I=I+1
12 S:'$D(ORAY(1)) ORAY(1)="^No allergies found."
13 K GMRARXN
14 Q
15SIGNS S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D
16 .I N=0 S ORAY(I)=ORAY(I)_"^"_$P(GMRARXN(J,"S",K),";")
17 .E S ORAY(I)=ORAY(I)_";"_$P(GMRARXN(J,"S",K),";")
18 .S N=N+1
19 Q
20LRPT(ORAY,ORPT) ; RETURN PT'S ALLERGY/ADVERSE REACTION INFO IN REPORT FORMAT:
21 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
22 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
23 N I,J,K,SEVER,CR,GMRAIDT ;216
24 S CR=$CHAR(13)
25 S I=1,J=0,K=0,SEVER="",GMRAIDT=1 ;216
26 D EN1^GMRAOR1(ORPT,"GMRARXN")
27 I $G(GMRARXN)="" S ORAY(I)="No Allergy Assessment"
28 I $G(GMRARXN)=0 S ORAY(I)="No Known Allergies"
29 I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" D
30 .S SEVER=$P(GMRARXN(J),U,2)
31 .S ORAY(I)=$P(GMRARXN(J),U)_" "_$S($L($G(SEVER)):"[Severity: "_SEVER_"]",1:""),I=I+1
32 .S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D
33 ..I N=0 S ORAY(I)=" Signs/symptoms: "_$P(GMRARXN(J,"S",K),";")
34 ..E S ORAY(I)=" "_$P(GMRARXN(J,"S",K),";")
35 ..I $P(GMRARXN(J,"S",K),";",2) S ORAY(I)=ORAY(I)_" ("_$$FMTE^XLFDT($P(GMRARXN(J,"S",K),";",2),2)_")" ;216
36 ..S N=N+1,I=I+1
37 .S ORAY(I)=" ",I=I+1
38 S:'$D(ORAY(1)) ORAY(1)="No allergies found."
39 K GMRARXN
40 Q
41RXN(ORAY,ORPT,SRC,NDF,PSDRUG) ; RETURN TRUE OR FALSE IF PATIENT IS ALLERGIC TO AGENT
42 ; SRC: ALLERGEN SOURCE (CM=CONTRAST MEDIA, DR=DRUG)
43 ; NDF: IF SRC=DR, NDF=Nat'l Drug File ien ELSE NDF=""
44 ; PSDRUG:IF SRC=DR, PSDRUG=(local) Drug file ien ELSE PSDRUG=""
45 S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF)
46 I SRC="DR",ORAY=1 D ;drug ingredient allergy found
47 .S I=1,J=0 F S J=$O(GMRAING(J)) Q:J="" D
48 ..I I=1 S ORAY=ORAY_U_GMRAING(J)
49 ..E S ORAY=ORAY_";"_GMRAING(J)
50 ..S I=I+1
51 I SRC="DR",ORAY=2 D ;drug class allergy found
52 .S CL="",I=1,J=0 F S J=$O(GMRADRCL(J)) Q:J="" D
53 ..; per test sites 3/17/04 - no oc for pt allergy to entire HERBS class:
54 ..Q:$P(GMRADRCL(J),U)="HA000"
55 ..I I=1 S ORAY=ORAY_U_$P(GMRADRCL(J),U,2)
56 ..E S CL=$P(GMRADRCL(J),U,2) I ORAY'[CL S ORAY=ORAY_";"_CL
57 ..S I=I+1
58 I SRC="DR",(+$G(ORAY)<1) D MEDCLASS(.ORAY,ORPT,PSDRUG)
59 K I,J,GMRADRCL,GMRAING,CL
60 Q
61MEDCLASS(ORAY,DFN,PSDRUG) ;check for allergens with medications in same VA drug class
62 N ORVACLS,CL,X,I,RET,TYP
63 S TYP="DR"
64 Q:+$G(PSDRUG)<1
65 S ORVACLS=$P(^PSDRUG(PSDRUG,0),U,2)
66 Q:$L(ORVACLS)<4
67 Q:$G(ORVACLS)="HA000" ;don't process herbal drug class for order checks
68 S CL=$S($E(ORVACLS,1,4)="CN10":5,1:4) ;look at 5 chars if ANALGESICS
69 D GETDATA^GMRAOR(DFN)
70 Q:'$D(^TMP("GMRAOC",$J,"APC"))
71 S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D
72 .I $E(I,1,CL)=$E(ORVACLS,1,CL) S X=I
73 I $L($G(X)) D
74 .N IEN,NAME
75 .D IEN^PSN50P65(,X,"ORQQAL")
76 .S IEN=$O(^TMP($J,"ORQQAL","B",X,0))
77 .I 'IEN S ORAY="2"_U_X Q
78 .S NAME=$G(^TMP($J,"ORQQAL",IEN,1))
79 .I '$L(NAME) S ORAY="2"_U_X Q
80 .S ORAY="2"_U_NAME_": ("_$G(^TMP("GMRAOC",$J,"APC",X))_")"
81 K ^TMP("GMRAOC",$J)
82 Q
83DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
84 D EN1^GMRAOR2(ALLR,"GMRACT")
85 N CR,OX,OH S CR=$CHAR(13),I=1
86 S ORAY(I)=" Causative agent: "_$P(GMRACT,U),I=I+1
87 S ORAY(I)=" Nature of Reaction: "_$S($P(GMRACT,U,6)="ALLERGY":"Allergy",$P(GMRACT,U,6)="PHARMACOLOGIC":"Adverse Reaction",$P(GMRACT,U,6)="UNKNOWN":"Unknown",1:""),I=I+1 ;216
88 S ORAY(I)=" ",I=I+1
89 I $D(GMRACT("S",1)) D SYMP
90 I $D(GMRACT("V",1)) D CLAS
91 S ORAY(I)=" Originator: "_$P(GMRACT,U,2)_$S($L($P(GMRACT,U,3)):" ("_$P(GMRACT,U,3)_")",1:""),I=I+1 ;216
92 S ORAY(I)=" Originated: "_$P(GMRACT,U,10),I=I+1 ;216
93 I $D(GMRACT("O",1)) D OBS
94 S ORAY(I)=" Verified: "_$S($P(GMRACT,U,4)="VERIFIED":$P(GMRACT,U,8),1:"No"),I=I+1 ;216
95 S ORAY(I)="Observed/Historical: "_$S($P(GMRACT,U,5)="OBSERVED":"Observed",$P(GMRACT,U,5)="HISTORICAL":"Historical",1:""),I=I+1
96 I $D(GMRACT("C",1)) D COM
97 K GMRACT
98 Q
99SYMP S K=0,N=0 F S K=$O(GMRACT("S",K)) Q:K'>0 D
100 .I N=0 S ORAY(I)=" Signs/symptoms: "_GMRACT("S",K),I=I+1
101 .E S ORAY(I)=" "_GMRACT("S",K),I=I+1
102 .S N=N+1
103 S ORAY(I)=" ",I=I+1
104 K N,K
105 Q
106CLAS S K=0,N=0 F S K=$O(GMRACT("V",K)) Q:K'>0 D
107 .I N=0 S ORAY(I)=" Drug Classes: "_$P(GMRACT("V",K),U,2),I=I+1
108 .E S ORAY(I)=" "_$P(GMRACT("V",K),U,2),I=I+1
109 .S N=N+1
110 S ORAY(I)=" ",I=I+1
111 K N,K
112 Q
113OBS S K=0,N=0 F S K=$O(GMRACT("O",K)) Q:K'>0 D
114 .I N=0 D
115 ..S Y=$P(GMRACT("O",K),U) D DD^%DT
116 ..S ORAY(I)=" Obs dates/severity: "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
117 .E D
118 ..S Y=$P(GMRACT("O",K),U) D DD^%DT
119 ..S ORAY(I)=" "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
120 .S N=N+1
121 S ORAY(I)=" ",I=I+1
122 K N,K,Y
123 Q
124COM S K=0,N=0,ORAY(I)=" ",I=I+1
125 F S K=$O(GMRACT("C",K)) Q:K'>0 D
126 .I N=0 S ORAY(I)="Comments:",I=I+1
127 .S Y=$P(GMRACT("C",K),U) D DD^%DT
128 .S ORAY(I)=" "_Y_" by "_$P(GMRACT("C",K),U,2),I=I+1
129 .I $D(GMRACT("C",K,1,0)) S L=0 F S L=$O(GMRACT("C",K,L)) Q:L'>0 D
130 ..S ORAY(I)=GMRACT("C",K,L,0),I=I+1
131 .S N=N+1
132 S ORAY(I)=" ",I=I+1
133 K N,K,L,Y
134 Q
Note: See TracBrowser for help on using the repository browser.