GMRADPT ;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;18-Mar-2011 10:56;MGH
;;4.0;Adverse Reaction Tracking;**2,10,1002**;Mar 29, 1996;Build 32
;IHS/MSC/MGH Inactive node added
EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
;INPUT VARIABLES:
;
; DFN Pointer to Patient file.
; GMRA (OPTIONAL) A^B^C DEFAULT="0^0^111"
; where A = 0 return all reactions (allergic/non-allergic).
; 1 return allergies only.
; 2 return non-allergies only.
; B = 0 return all data (verified or non-verified).
; 1 return only verified data.
; 2 return only non-verified data.
; C = X_Y_Z
; where X, Y, and Z are either 0 or 1. 1 would mean to
; return an Adverse Reaction of that particular type,
; and zero means do not return an Adverse Reaction of
; that type.
; X is for TYPE=OTHER
; Y is for TYPE=FOOD
; Z is for TYPE=DRUG.
; E.g., 001 (return drug only), 111 (returns all types),
; and 010 (returns food only).
; D=1 Include inactive allergies
;OUTPUT VARIABLES:
; GMRAL = 1 if patient has Adverse Reaction
; 0 if patient has no known Adverse Reaction
; null if patient has not been asked about Adverse Reaction
; GMRAL(PTR TO 120.8) = A^B^C^D^E^F^G^H^I
; where A = Pointer to Patient file.
; B = Free text of causative agent.
; *C = Type of reaction, where D is drug, F is food, and O is
; other.
; D = 1 if Adverse Reaction has been verified
; 0 if Adverse Reaction has not been verified
; E = 0 if this is an allergic reaction
; 1 if this is not an allergic reaction
; **F = the mechanism of reaction in the format:
; External format;Internal format
; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
; G = Type of reaction.
; where D = drug
; DF = drug/food
; DFO = drug/food/other
; DO = drug/other
; F = food
; FO = food/other
; O = other
; H = the mechanism of reaction in the format:
; External format;Internal format
; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
; I = IEN and Global root of reactant (stored in piece B above)
; set equal to the GMR ALLERGY field (#1) of the PATIENT
; ALLERGY file (#120.8)
; GMRAL(PTR TO 120.8,"S",COUNT) = S
; where COUNT = number 1 to number of signs/symptoms for this
; reaction.
; S = a sign/symptom for this reaction in the format:
; External format;Internal format
;
;* NOTE: This piece will no longer be supported after 9/1/97,
; Please use piece G.
;** NOTE: This piece will no longer be supported after 9/1/97,
; Please use piece H.
;
N GMRAOTH
Q:'$D(DFN) S:'$D(GMRA)#2 GMRA="0^0^111" K GMRAL
DPT ;
;Read NKA Node in file 120.86
S GMRAL=$P($G(^GMR(120.86,DFN,0)),U,2)
;Do not set GMRAL array if patient is unassessed or NKA.
I GMRAL=0 Q ;PATIENT HAS NO KNOWN ALLERGIES
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
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
K GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
Q
SETAL ;
N %,GMRAI,GMRASIGN,CHK
;Q:'$P(GMRANODE,"^",12)&'$D(GMRAOSOF) ;IF NOT SIGNED OFF MARK IT
Q:+$G(^GMR(120.8,GMRAREC,"ER"))&'$D(GMRAERR) ;IF ENTERED IN ERROR QUIT
S CHK=$$CHK(GMRAREC)
Q:CHK=1
I GMRAL'=1 S GMRAL=1 ; PATIENT HAS ALLERGIES
S GMRAI=0 ; BEGIN CHECK FOR ADR/ALL CRITERIA
I '$P(GMRA,"^") S GMRAI=1
E I $P(GMRA,"^")=1 S:$F("AU",$P(GMRANODE,"^",14))>1 GMRAI=1
E S:$F("P",$P(GMRANODE,"^",14))>1 GMRAI=1
Q:'GMRAI ; QUIT IF ADR/ALL CRITERIA NOT MET
Q:2-$P(GMRA,"^",2)=(1-$P(GMRANODE,"^",16)) ;QUIT IF VER/NON VER CRITERIA NOT MET
S GMRAI=0 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
F %=1:1:3 I $E($P(GMRA,"^",3),%),$P(GMRANODE,"^",20)[$E("OFD",%) S GMRAI=1 Q
Q:'GMRAI ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
D PASS(GMRAREC,.GMRAL)
Q
PASS(GMRAREC,GMRAL) ; Data filer
; This subroutine will store all the patient date for a reaction is an
; array.
; Input:
; GMRAREC = The IEN for the entry in 120.8
;Output:
; GMRAL(GMRAREC) the array entry for the record
;
N GMRANODE,GMRAIN,GMRINODE,GMRAY2,GMRAZ2,GMRASRC,GMRAZSRC,GMRASNO,GMTAZT,GMRAX,GMRAY,GMRAY2,GMRAZ,GMRAZT
S GMRANODE=$G(^GMR(120.8,GMRAREC,0)) Q:GMRANODE=""
S GMRASRC=$P($G(^GMR(120.8,GMRAREC,9999999.11)),U,1)
S GMRASNO=$P($G(^GMR(120.8,GMRAREC,9999999.11)),U,2)
;IHS/MSC/MGH Added node for inactive
S GMRINODE=$G(^GMR(120.8,GMRAREC,9999999.12))
S %=$P(GMRANODE,"^",14)
S GMRAL(GMRAREC)=$P(GMRANODE,"^",1,2)_"^"_$E($P(GMRANODE,"^",20))_"^"_+$P(GMRANODE,"^",16)_"^"_$S(%="A"!(%="U"):0,1:1)
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:"")
S GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_$P(GMRANODE,"^",3)
S GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_GMRASRC_"^"_GMRASNO
Q:'$O(^GMR(120.8,GMRAREC,10,0)) ;QUIT IF NO SIGNS/SYMPTOMS
S:'$D(GMRAOTH) GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
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
.S GMRAZ=$G(^GMR(120.8,GMRAREC,10,GMRAX,0))
.S GMRAZ(1)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$P(GMRAZ,U,2)_";"_+GMRAZ)
.S GMRAZSRC=$P($G(^GMR(120.8,GMRAREC,10,GMRAX,9999999.11)),U,1)
.S GMRAZT=$P($G(^GMR(120.8,GMRAREC,10,GMRAX,0)),U,4)
.I GMRAZSRC S GMRAZ(1)=GMRAZ(1)_U_GMRAZT_U_GMRAZSRC
.Q
Q
CHK(GMRAIEN) ;IHS/MSC/MGH Check to see if this allergy is inactive
N Z,INACT,REACT,INZ
S INZ=0
I $P(GMRA,U,4)=1 Q 0
S Z=$O(^GMR(120.8,GMRAIEN,9999999.12,$C(0)),-1) I +Z D
.S INACT=$P($G(^GMR(120.8,GMRAIEN,9999999.12,Z,0)),U,1)
.S REACT=$P($G(^GMR(120.8,GMRAIEN,9999999.12,Z,0)),U,4)
.I +INACT&(REACT="") S INZ=1
Q INZ
GMRADPT ;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;18-Mar-2011 10:56;MGH
+1 ;;4.0;Adverse Reaction Tracking;**2,10,1002**;Mar 29, 1996;Build 32
+2 ;IHS/MSC/MGH Inactive node added
EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
+1 ;INPUT VARIABLES:
+2 ;
+3 ; DFN Pointer to Patient file.
+4 ; GMRA (OPTIONAL) A^B^C DEFAULT="0^0^111"
+5 ; where A = 0 return all reactions (allergic/non-allergic).
+6 ; 1 return allergies only.
+7 ; 2 return non-allergies only.
+8 ; B = 0 return all data (verified or non-verified).
+9 ; 1 return only verified data.
+10 ; 2 return only non-verified data.
+11 ; C = X_Y_Z
+12 ; where X, Y, and Z are either 0 or 1. 1 would mean to
+13 ; return an Adverse Reaction of that particular type,
+14 ; and zero means do not return an Adverse Reaction of
+15 ; that type.
+16 ; X is for TYPE=OTHER
+17 ; Y is for TYPE=FOOD
+18 ; Z is for TYPE=DRUG.
+19 ; E.g., 001 (return drug only), 111 (returns all types),
+20 ; and 010 (returns food only).
+21 ; D=1 Include inactive allergies
+22 ;OUTPUT VARIABLES:
+23 ; GMRAL = 1 if patient has Adverse Reaction
+24 ; 0 if patient has no known Adverse Reaction
+25 ; null if patient has not been asked about Adverse Reaction
+26 ; GMRAL(PTR TO 120.8) = A^B^C^D^E^F^G^H^I
+27 ; where A = Pointer to Patient file.
+28 ; B = Free text of causative agent.
+29 ; *C = Type of reaction, where D is drug, F is food, and O is
+30 ; other.
+31 ; D = 1 if Adverse Reaction has been verified
+32 ; 0 if Adverse Reaction has not been verified
+33 ; E = 0 if this is an allergic reaction
+34 ; 1 if this is not an allergic reaction
+35 ; **F = the mechanism of reaction in the format:
+36 ; External format;Internal format
+37 ; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
+38 ; G = Type of reaction.
+39 ; where D = drug
+40 ; DF = drug/food
+41 ; DFO = drug/food/other
+42 ; DO = drug/other
+43 ; F = food
+44 ; FO = food/other
+45 ; O = other
+46 ; H = the mechanism of reaction in the format:
+47 ; External format;Internal format
+48 ; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
+49 ; I = IEN and Global root of reactant (stored in piece B above)
+50 ; set equal to the GMR ALLERGY field (#1) of the PATIENT
+51 ; ALLERGY file (#120.8)
+52 ; GMRAL(PTR TO 120.8,"S",COUNT) = S
+53 ; where COUNT = number 1 to number of signs/symptoms for this
+54 ; reaction.
+55 ; S = a sign/symptom for this reaction in the format:
+56 ; External format;Internal format
+57 ;
+58 ;* NOTE: This piece will no longer be supported after 9/1/97,
+59 ; Please use piece G.
+60 ;** NOTE: This piece will no longer be supported after 9/1/97,
+61 ; Please use piece H.
+62 ;
+63 NEW GMRAOTH
+64 IF '$DATA(DFN)
QUIT
IF '$DATA(GMRA)#2
SET GMRA="0^0^111"
KILL GMRAL
DPT ;
+1 ;Read NKA Node in file 120.86
+2 SET GMRAL=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
+3 ;Do not set GMRAL array if patient is unassessed or NKA.
+4 ;PATIENT HAS NO KNOWN ALLERGIES
IF GMRAL=0
QUIT
+5 FOR GMRAREC=0:0
SET GMRAREC=$ORDER(^GMR(120.8,"B",DFN,GMRAREC))
IF GMRAREC'>0
QUIT
SET GMRANODE=$SELECT($DATA(^GMR(120.8,GMRAREC,0)):^(0),1:"")
IF GMRANODE
DO SETAL
+6 ;if flag is set to 1 (reactions exist), then make certain the reactions are passed in the GMRAL array
IF GMRAL=1
IF +$ORDER(GMRAL(0))'>0
SET GMRAL=0
+7 KILL GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
+8 QUIT
SETAL ;
+1 NEW %,GMRAI,GMRASIGN,CHK
+2 ;Q:'$P(GMRANODE,"^",12)&'$D(GMRAOSOF) ;IF NOT SIGNED OFF MARK IT
+3 ;IF ENTERED IN ERROR QUIT
IF +$GET(^GMR(120.8,GMRAREC,"ER"))&'$DATA(GMRAERR)
QUIT
+4 SET CHK=$$CHK(GMRAREC)
+5 IF CHK=1
QUIT
+6 ; PATIENT HAS ALLERGIES
IF GMRAL'=1
SET GMRAL=1
+7 ; BEGIN CHECK FOR ADR/ALL CRITERIA
SET GMRAI=0
+8 IF '$PIECE(GMRA,"^")
SET GMRAI=1
+9 IF '$TEST
IF $PIECE(GMRA,"^")=1
IF $FIND("AU",$PIECE(GMRANODE,"^",14))>1
SET GMRAI=1
+10 IF '$TEST
IF $FIND("P",$PIECE(GMRANODE,"^",14))>1
SET GMRAI=1
+11 ; QUIT IF ADR/ALL CRITERIA NOT MET
IF 'GMRAI
QUIT
+12 ;QUIT IF VER/NON VER CRITERIA NOT MET
IF 2-$PIECE(GMRA,"^",2)=(1-$PIECE(GMRANODE,"^",16))
QUIT
+13 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
SET GMRAI=0
+14 FOR %=1:1:3
IF $EXTRACT($PIECE(GMRA,"^",3),%)
IF $PIECE(GMRANODE,"^",20)[$EXTRACT("OFD",%)
SET GMRAI=1
QUIT
+15 ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
IF 'GMRAI
QUIT
+16 DO PASS(GMRAREC,.GMRAL)
+17 QUIT
PASS(GMRAREC,GMRAL) ; Data filer
+1 ; This subroutine will store all the patient date for a reaction is an
+2 ; array.
+3 ; Input:
+4 ; GMRAREC = The IEN for the entry in 120.8
+5 ;Output:
+6 ; GMRAL(GMRAREC) the array entry for the record
+7 ;
+8 NEW GMRANODE,GMRAIN,GMRINODE,GMRAY2,GMRAZ2,GMRASRC,GMRAZSRC,GMRASNO,GMTAZT,GMRAX,GMRAY,GMRAY2,GMRAZ,GMRAZT
+9 SET GMRANODE=$GET(^GMR(120.8,GMRAREC,0))
IF GMRANODE=""
QUIT
+10 SET GMRASRC=$PIECE($GET(^GMR(120.8,GMRAREC,9999999.11)),U,1)
+11 SET GMRASNO=$PIECE($GET(^GMR(120.8,GMRAREC,9999999.11)),U,2)
+12 ;IHS/MSC/MGH Added node for inactive
+13 SET GMRINODE=$GET(^GMR(120.8,GMRAREC,9999999.12))
+14 SET %=$PIECE(GMRANODE,"^",14)
+15 SET GMRAL(GMRAREC)=$PIECE(GMRANODE,"^",1,2)_"^"_$EXTRACT($PIECE(GMRANODE,"^",20))_"^"_+$PIECE(GMRANODE,"^",16)_"^"_$SELECT(%="A"!(%="U"):0,1:1)
+16 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_$SELECT(%="A":"ALLERGY;0",%="P":"PHARMACOLOGIC;2",%="U":"UNKNOWN;U",1:"")_"^"_$PIECE(GMRANODE,"^",20)_"^"_$SELECT(%="A":"ALLERGY;A",%="P":"PHARMACOLOGIC;P",%="U":"UNKNOWN;U",1:"")
+17 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_$PIECE(GMRANODE,"^",3)
+18 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_"^"_GMRASRC_"^"_GMRASNO
+19 ;QUIT IF NO SIGNS/SYMPTOMS
IF '$ORDER(^GMR(120.8,GMRAREC,10,0))
QUIT
+20 IF '$DATA(GMRAOTH)
SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+21 SET GMRAX=0
SET GMRAY=1
FOR
SET GMRAX=$ORDER(^GMR(120.8,GMRAREC,10,GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:1
+22 SET GMRAZ=$GET(^GMR(120.8,GMRAREC,10,GMRAX,0))
+23 SET GMRAZ(1)=$SELECT(+GMRAZ'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$PIECE(GMRAZ,U,2)_";"_+GMRAZ)
+24 SET GMRAZSRC=$PIECE($GET(^GMR(120.8,GMRAREC,10,GMRAX,9999999.11)),U,1)
+25 SET GMRAZT=$PIECE($GET(^GMR(120.8,GMRAREC,10,GMRAX,0)),U,4)
+26 IF GMRAZSRC
SET GMRAZ(1)=GMRAZ(1)_U_GMRAZT_U_GMRAZSRC
+27 QUIT
End DoDot:1
IF GMRAZ'=""
SET GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1)
SET GMRAY=GMRAY+1
+28 QUIT
CHK(GMRAIEN) ;IHS/MSC/MGH Check to see if this allergy is inactive
+1 NEW Z,INACT,REACT,INZ
+2 SET INZ=0
+3 IF $PIECE(GMRA,U,4)=1
QUIT 0
+4 SET Z=$ORDER(^GMR(120.8,GMRAIEN,9999999.12,$CHAR(0)),-1)
IF +Z
Begin DoDot:1
+5 SET INACT=$PIECE($GET(^GMR(120.8,GMRAIEN,9999999.12,Z,0)),U,1)
+6 SET REACT=$PIECE($GET(^GMR(120.8,GMRAIEN,9999999.12,Z,0)),U,4)
+7 IF +INACT&(REACT="")
SET INZ=1
End DoDot:1
+8 QUIT INZ