source: qrda/C0Q/trunk/p/C0QGMRAD.m@ 1438

Last change on this file since 1438 was 1438, checked in by Sam Habiel, 13 years ago

Updated routines after many small fixes; added C0QKIDS as well
File size: 5.5 KB
Line 
1C0QGMRAD ;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;1/15/98 13:47
2 ;;1.0;C0Q;;May 21, 2012;Build 43
3EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
4 ;INPUT VARIABLES:
5 ;
6 ; DFN Pointer to Patient file.
7 ; GMRA (OPTIONAL) A^B^C DEFAULT="0^0^111^0" **LOCAL
8 ; where A = 0 return all reactions (allergic/non-allergic).
9 ; 1 return allergies only.
10 ; 2 return non-allergies only.
11 ; B = 0 return all data (verified or non-verified).
12 ; 1 return only verified data.
13 ; 2 return only non-verified data.
14 ; C = X_Y_Z
15 ; where X, Y, and Z are either 0 or 1. 1 would mean to
16 ; return an Adverse Reaction of that particular type,
17 ; and zero means do not return an Adverse Reaction of
18 ; that type.
19 ; X is for TYPE=OTHER
20 ; Y is for TYPE=FOOD
21 ; Z is for TYPE=DRUG.
22 ; E.g., 001 (return drug only), 111 (returns all types),
23 ; and 010 (returns food only).
24 ; **LOCAL
25 ; D = 0 return both Observed and Historical
26 ; 1 return only Observed
27 ; **LOCAL
28 ;OUTPUT VARIABLES:
29 ; GMRAL = 1 if patient has Adverse Reaction
30 ; 0 if patient has no known Adverse Reaction
31 ; null if patient has not been asked about Adverse Reaction
32 ; GMRAL(PTR TO 120.8) = A^B^C^D^E^F^G^H^I
33 ; where A = Pointer to Patient file.
34 ; B = Free text of causative agent.
35 ; *C = Type of reaction, where D is drug, F is food, and O is
36 ; other.
37 ; D = 1 if Adverse Reaction has been verified
38 ; 0 if Adverse Reaction has not been verified
39 ; E = 0 if this is an allergic reaction
40 ; 1 if this is not an allergic reaction
41 ; **F = the mechanism of reaction in the format:
42 ; External format;Internal format
43 ; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
44 ; G = Type of reaction.
45 ; where D = drug
46 ; DF = drug/food
47 ; DFO = drug/food/other
48 ; DO = drug/other
49 ; F = food
50 ; FO = food/other
51 ; O = other
52 ; H = the mechanism of reaction in the format:
53 ; External format;Internal format
54 ; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
55 ; I = IEN and Global root of reactant (stored in piece B above)
56 ; set equal to the GMR ALLERGY field (#1) of the PATIENT
57 ; ALLERGY file (#120.8)
58 ; GMRAL(PTR TO 120.8,"S",COUNT) = S
59 ; where COUNT = number 1 to number of signs/symptoms for this
60 ; reaction.
61 ; S = a sign/symptom for this reaction in the format:
62 ; External format;Internal format
63 ;
64 ;* NOTE: This piece will no longer be supported after 9/1/97,
65 ; Please use piece G.
66 ;** NOTE: This piece will no longer be supported after 9/1/97,
67 ; Please use piece H.
68 ;
69 N GMRAOTH
70 Q:'$D(DFN) S:'$D(GMRA)#2 GMRA="0^0^111^1" K GMRAL
71DPT ;
72 ;Read NKA Node in file 120.86
73 S GMRAL=$P($G(^GMR(120.86,DFN,0)),U,2)
74 ;Do not set GMRAL array if patient is unassessed or NKA.
75 I GMRAL=0 Q ;PATIENT HAS NO KNOWN ALLERGIES
76 F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"B",DFN,GMRAREC)) Q:GMRAREC'>0 S GMRANODE=$S($D(^GMR(120.8,GMRAREC,0)):^(0),1:"") D:GMRANODE SETAL
77 I GMRAL=1,+$O(GMRAL(0))'>0 S GMRAL=0 ;if flag is set to 1 (reactions exist), then make certain the reactions are passed in the GMRAL array
78 K GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
79 Q
80SETAL ;
81 N %,GMRAI,GMRASIGN
82 ;Q:'$P(GMRANODE,"^",12)&'$D(GMRAOSOF) ;IF NOT SIGNED OFF MARK IT
83 Q:+$G(^GMR(120.8,GMRAREC,"ER"))&'$D(GMRAERR) ;IF ENTERED IN ERROR QUIT
84 I GMRAL'=1 S GMRAL=1 ; PATIENT HAS ALLERGIES
85 S GMRAI=0 ; BEGIN CHECK FOR ADR/ALL CRITERIA
86 I $P(GMRA,"^",4),$P(GMRANODE,"^",6)="h" Q ;QUIT IF HISTORICAL EXCLUDED **LOCAL
87 I '$P(GMRA,"^") S GMRAI=1
88 E I $P(GMRA,"^")=1 S:$F("AU",$P(GMRANODE,"^",14))>1 GMRAI=1
89 E S:$F("P",$P(GMRANODE,"^",14))>1 GMRAI=1
90 Q:'GMRAI ; QUIT IF ADR/ALL CRITERIA NOT MET
91 Q:2-$P(GMRA,"^",2)=(1-$P(GMRANODE,"^",16)) ;QUIT IF VER/NON VER CRITERIA NOT MET
92 S GMRAI=0 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
93 F %=1:1:3 I $E($P(GMRA,"^",3),%),$P(GMRANODE,"^",20)[$E("OFD",%) S GMRAI=1 Q
94 Q:'GMRAI ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
95 D PASS(GMRAREC,.GMRAL)
96 Q
97PASS(GMRAREC,GMRAL) ; Data filer
98 ; This subroutine will store all the patient date for a reaction is an
99 ; array.
100 ; Input:
101 ; GMRAREC = The IEN for the entry in 120.8
102 ;Output:
103 ; GMRAL(GMRAREC) the array entry for the record
104 ;
105 N GMRANODE
106 S GMRANODE=$G(^GMR(120.8,GMRAREC,0)) Q:GMRANODE=""
107 S %=$P(GMRANODE,"^",14)
108 S GMRAL(GMRAREC)=$P(GMRANODE,"^",1,2)_"^"_$E($P(GMRANODE,"^",20))_"^"_+$P(GMRANODE,"^",16)_"^"_$S(%="A"!(%="U"):0,1:1)
109 S GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_$S(%="A":"ALLERGY;0",%="P":"PHARMACOLOGIC;2",%="U":"UNKNOWN;U",1:"")_"^"_$P(GMRANODE,"^",20)_"^"_$S(%="A":"ALLERGY;A",%="P":"PHARMACOLOGIC;P",%="U":"UNKNOWN;U",1:"")
110 S GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_$P(GMRANODE,"^",3)
111 Q:'$O(^GMR(120.8,GMRAREC,10,0)) ;QUIT IF NO SIGNS/SYMPTOMS
112 S:'$D(GMRAOTH) GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
113 S GMRAX=0,GMRAY=1 F S GMRAX=$O(^GMR(120.8,GMRAREC,10,GMRAX)) Q:GMRAX<1 D I GMRAZ'="" S GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1),GMRAY=GMRAY+1
114 .S GMRAZ=$G(^GMR(120.8,GMRAREC,10,GMRAX,0))
115 .S GMRAZ(1)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$P(GMRAZ,U,2)_";"_+GMRAZ)
116 .Q
117 K GMRAX,GMRAY,GMRAZ
118 Q
Note: See TracBrowser for help on using the repository browser.