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

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

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
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,243**;Dec 17, 1997;Build 242
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 S ORVACLS=$$CLASS50^ORPEAPI(PSDRUG)
67 Q:$L(ORVACLS)<4
68 Q:$G(ORVACLS)="HA000" ;don't process herbal drug class for order checks
69 S CL=$S($E(ORVACLS,1,4)="CN10":5,1:4) ;look at 5 chars if ANALGESICS
70 D GETDATA^GMRAOR(DFN)
71 Q:'$D(^TMP("GMRAOC",$J,"APC"))
72 S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D
73 .I $E(I,1,CL)=$E(ORVACLS,1,CL) S X=I
74 I $L($G(X)) D
75 .N IEN,NAME
76 .D IEN^PSN50P65(,X,"ORQQAL")
77 .S IEN=$O(^TMP($J,"ORQQAL","B",X,0))
78 .I 'IEN S ORAY="2"_U_X Q
79 .S NAME=$G(^TMP($J,"ORQQAL",IEN,1))
80 .I '$L(NAME) S ORAY="2"_U_X Q
81 .S ORAY="2"_U_NAME_": ("_$G(^TMP("GMRAOC",$J,"APC",X))_")"
82 K ^TMP("GMRAOC",$J)
83 Q
84DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
85 D EN1^GMRAOR2(ALLR,"GMRACT")
86 N CR,OX,OH S CR=$CHAR(13),I=1
87 S ORAY(I)=" Causative agent: "_$P(GMRACT,U),I=I+1
88 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
89 S ORAY(I)=" ",I=I+1
90 I $D(GMRACT("S",1)) D SYMP
91 I $D(GMRACT("V",1)) D CLAS
92 S ORAY(I)=" Originator: "_$P(GMRACT,U,2)_$S($L($P(GMRACT,U,3)):" ("_$P(GMRACT,U,3)_")",1:""),I=I+1 ;216
93 S ORAY(I)=" Originated: "_$P(GMRACT,U,10),I=I+1 ;216
94 I $D(GMRACT("O",1)) D OBS
95 S ORAY(I)=" Verified: "_$S($P(GMRACT,U,4)="VERIFIED":$P(GMRACT,U,8),1:"No"),I=I+1 ;216
96 S ORAY(I)="Observed/Historical: "_$S($P(GMRACT,U,5)="OBSERVED":"Observed",$P(GMRACT,U,5)="HISTORICAL":"Historical",1:""),I=I+1
97 I $D(GMRACT("C",1)) D COM
98 K GMRACT
99 Q
100SYMP S K=0,N=0 F S K=$O(GMRACT("S",K)) Q:K'>0 D
101 .I N=0 S ORAY(I)=" Signs/symptoms: "_GMRACT("S",K),I=I+1
102 .E S ORAY(I)=" "_GMRACT("S",K),I=I+1
103 .S N=N+1
104 S ORAY(I)=" ",I=I+1
105 K N,K
106 Q
107CLAS S K=0,N=0 F S K=$O(GMRACT("V",K)) Q:K'>0 D
108 .I N=0 S ORAY(I)=" Drug Classes: "_$P(GMRACT("V",K),U,2),I=I+1
109 .E S ORAY(I)=" "_$P(GMRACT("V",K),U,2),I=I+1
110 .S N=N+1
111 S ORAY(I)=" ",I=I+1
112 K N,K
113 Q
114OBS S K=0,N=0 F S K=$O(GMRACT("O",K)) Q:K'>0 D
115 .I N=0 D
116 ..S Y=$P(GMRACT("O",K),U) D DD^%DT
117 ..S ORAY(I)=" Obs dates/severity: "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
118 .E D
119 ..S Y=$P(GMRACT("O",K),U) D DD^%DT
120 ..S ORAY(I)=" "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
121 .S N=N+1
122 S ORAY(I)=" ",I=I+1
123 K N,K,Y
124 Q
125COM S K=0,N=0,ORAY(I)=" ",I=I+1
126 F S K=$O(GMRACT("C",K)) Q:K'>0 D
127 .I N=0 S ORAY(I)="Comments:",I=I+1
128 .S Y=$P(GMRACT("C",K),U) D DD^%DT
129 .S ORAY(I)=" "_Y_" by "_$P(GMRACT("C",K),U,2),I=I+1
130 .I $D(GMRACT("C",K,1,0)) S L=0 F S L=$O(GMRACT("C",K,L)) Q:L'>0 D
131 ..S ORAY(I)=GMRACT("C",K,L,0),I=I+1
132 .S N=N+1
133 S ORAY(I)=" ",I=I+1
134 K N,K,L,Y
135 Q
Note: See TracBrowser for help on using the repository browser.