GMRADPT ; HIRMFO/RM,WAA - UTILITY TO GATHER PATIENT DATA ; Oct 16, 2023@3:03:00
;;4.0;Adverse Reaction Tracking;**2,10,46,52,53,63,51,68**;Mar 29, 1996;Build 5
;
EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
;*BD
N GMRAOTH,GMRAV1
Q:'$D(DFN)
I '$D(GMRA)#2 S GMRA="0^0^111"
K GMRAL
S GMRAV1=1,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
D DPT
Q
;*ED
EN2 ; ENTRY TO GATHER PATIENT A/AR DATA
;INPUT VARIABLES:
;
; DFN Pointer to Patient file.
; GMRA (OPTIONAL) A^B^C^D^E DEFAULT="0^0^111^0^0"
; 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 = 0 return local allergies only
; 1 return local and remote allergies
; E = 0 exclude entered in error entries
; 1 include entered in error entries
;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) = A^B^C^D^E^F^G^H^I^J^K
; where PTR = Either pointer to 120.8 for local reactions or
; 'R' appended with pointer to ^XTMP("ORRDI","ART",DFN, for remote reactions
; 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 = variable pointer to the causative agent returned in piece B
; J = observed/historical of the reaction in the format:
; External format;Internal format
; GMRAL(PTR,"S",COUNT) = S^D
; 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
; D = date/time sign/symptom entered in the format:
; External format;Internal format
; GMRAL(PTR,"O",COUNT) = S^D
; where COUNT = number 1 to number of observations for this
; reaction.
; S = a severity for this reaction in the format:
; External format;Internal format
; D = date/time of observation in the format:
; External format;Internal format
; GMRAL(PTR,"H") = S^D
; S = a severity for this reaction in the format:
; External format;Internal format
; D = date/time of observation in the format:
; External format;Internal format
; GMRAL(PTR,"ERROR") = D
; where D = date/time entry marked entered in error in the format:
; External format;Internal format
; Note: This will only exist for local reactions
;
; GMRAL(PTR,"SITE") = SITE
; where SITE = reporting institution in the format:
; Institution File (#4) Pointer^Station Name^Station Number
; Note: This will only exist for remote reactions
;
;* 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.
;
;*BD
D DPT2
Q
;*ED
DPT ;
;*BD
;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(0)
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
DPT2 ;DO NOT CALL THIS ENTRY POINT AS IT WILL BE DELETED IN THE FUTURE. USE EN2 INSTEAD.
;*ED
N GMRAOTH,REMOTE,MECH,IDX,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
Q:'$D(DFN)
I '$D(GMRA)#2 S GMRA="0^0^111^0^0"
K GMRAL
S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
S REMOTE=$S(+$P(GMRA,U,4):$$HDRDATA^GMRAHDR,1:0)
S GMRAL=$$NKA^GMRANKA(DFN)
I +GMRAL=0,$P(GMRA,U,4),($D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9) D
.S IDX=0 F S IDX=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX)) Q:'IDX D
..N RETURN
..S RETURN=$$INTERNAL(120.86,1,^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
..I RETURN=1 S GMRAL=1
..I GMRAL'=1,(RETURN=0) S GMRAL=0
I +GMRAL=0,'$P(GMRA,U,5) Q
D MECH
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(0)
I +$G(REMOTE)>0 D
.N INDEX
.S INDEX=0 F S INDEX=$O(^XTMP("ORRDI","ART",DFN,INDEX)) Q:+$G(INDEX)=0 D
..N GMRANODE,GMRAREC,RETURN
..S GMRAREC=$NA(^XTMP("ORRDI","ART",DFN,INDEX))
..S RETURN=$$INTERNAL(120.8,17,$G(@GMRAREC@("MECHANISM",0)))
..S:RETURN'=-1 $P(GMRANODE,U,14)=RETURN
..S RETURN=$$UP^XLFSTR($E($G(@GMRAREC@("VERIFIED",0)),1))
..S $P(GMRANODE,U,16)=$S(RETURN="Y":1,RETURN="N":0,1:"")
..S $P(GMRANODE,U,20)=$P($G(@GMRAREC@("TYPE",0)),U,1)
..D SETAL(1)
I GMRAL=1,$O(GMRAL(0))="" S GMRAL=0
K GMRA
Q
INTERNAL(FILE,FIELD,VALUE) ;RETURN INTERNAL VALUE OF VUID
;PARAMETERS: FILE => FILE NUMBER WHERE THE DATA RESIDES
; FIELD => FIELD NUMBER WHERE THE DATA RESIDES
; VALUE => CARET-DELIMITED STRING WHERE THE FIRST
; PIECE CONTAINS THE VUID
;RETURNS: -1 => BAD INPUT PARAMETERS
; INTERNAL VALUE OF VUID
N RETURN
S RETURN=-1
Q:$G(VALUE)="" RETURN
N GMRARRAY
D GETIREF^XTID(FILE,,$P(VALUE,U,1),"GMRARRAY")
S:$D(GMRARRAY(FILE,FIELD))>9 RETURN=$O(GMRARRAY(FILE,FIELD,""))
Q RETURN
SETAL(REMOTE) ;DETERMINE WHETHER TO RETURN CURRENT ALLERGY
;PARAMETER: REMOTE => 0 IF ALLERGY IS LOCAL, 1 IF IT IS REMOTE
N %,GMRAI,GMRASIGN
;IF LOCAL, EXCLUDE ENTERED IN ERROR AND ENTRY IS ENTERED IN ERROR, THEN QUIT
;(REMOTE ENTERED IN ERROR ALREADY FILTERED)
I 'REMOTE,'$P(GMRA,U,5),(+$G(^GMR(120.8,GMRAREC,"ER"))) Q
I GMRAL'=1 S GMRAL=1 ; PATIENT HAS ALLERGIES
S GMRAI=0 ; BEGIN CHECK FOR ADR/ALL CRITERIA
I '$P(GMRA,U) S GMRAI=1
E I $P(GMRA,U)=1 S:$F("AU",$P(GMRANODE,U,14))>1 GMRAI=1
E S:$F("P",$P(GMRANODE,U,14))>1 GMRAI=1
Q:'GMRAI ; QUIT IF ADR/ALL CRITERIA NOT MET
Q:2-$P(GMRA,U,2)=(1-$P(GMRANODE,U,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,U,3),%),$P(GMRANODE,U,20)[$E("OFD",%) S GMRAI=1 Q
Q:'GMRAI ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
D DATA(.GMRAREC,.GMRAL)
Q
DATA(GMRAREC,GMRAL) ;RETRIEVE THE APPROPRIATE DATA
;PARAMETERS: GMRAREC => REFERENCE TO THE VARIABLE CONTAINING THE CURRENT ALLERGY'S IEN
; GMRAL => REFERENCE TO THE ARRAY IN WHICH TO RETURN DATA
D:+$G(GMRAREC)>0 PASS(.GMRAREC,.GMRAL)
D:+$G(GMRAREC)=0 REMOTE(.GMRAL,.GMRAREC)
Q
PASS(GMRAREC,GMRAL) ;RETRIEVE LOCAL DATA
;PARAMETERS: GMRAREC => IEN OF THE CURRENT ALLERGY
; GMRAL => ARRAY IN WHICH TO RETURN DATA
N GMRANODE,%,GMRAX,GMRAY,GMRAZ,GMRAKC
I '$D(MECH) D
.D MECH
.S GMRAKC=1
S GMRANODE=$G(^GMR(120.8,GMRAREC,0)) Q:GMRANODE=""
S %=$P(GMRANODE,U,14)
S GMRAL(GMRAREC)=$P(GMRANODE,U,1,2)_U_$E($P(GMRANODE,U,20))_U_+$P(GMRANODE,U,16)_U_$S(%="A"!(%="U"):0,1:1)
S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$S(%="A":"ALLERGY;0",%="P":"PHARMACOLOGIC;2",%="U":"UNKNOWN;U",1:"")_U_$P(GMRANODE,U,20)_U_$S(%'="":$G(MECH(%)),1:"")
S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$P(GMRANODE,U,3)
;*BD
I '$G(GMRAV1) D
.;*ED
.S %=$P(GMRANODE,U,6)
.S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$$EXTERNAL^DILFD(120.8,6,,%)_";"_%
.I $D(^GMR(120.85,"C",GMRAREC))>9 D
..N IEN,IDX
..S IEN=0 F S IEN=$O(^GMR(120.85,"C",GMRAREC,IEN)) Q:'+IEN D
...S IDX=1+$G(IDX),%=$P($G(^GMR(120.85,IEN,0)),U,14)
...S GMRAL(GMRAREC,"O",IDX)=$$EXTERNAL^DILFD(120.85,14.5,,%)_";"_%_U
...S %=$P($G(^GMR(120.85,IEN,0)),U)
...S GMRAL(GMRAREC,"O",IDX)=GMRAL(GMRAREC,"O",IDX)_$$EXTERNAL^DILFD(120.85,.01,,%)_";"_%
.I $P($G(^GMR(120.8,GMRAREC,"ER")),U)=1 D
..S %=$P($G(^GMR(120.8,GMRAREC,"ER")),U,2)
..S GMRAL(GMRAREC,"ERROR")=$$EXTERNAL^DILFD(120.8,23,,%)_";"_%
I $P(GMRANODE,U,6)="h" D
.N SEVR,SEVRDT
.S SEVR=$P(GMRANODE,U,8)
.S SEVRDT=$P(GMRANODE,U,9)
.S GMRAL(GMRAREC,"H")=$$EXTERNAL^DILFD(120.8,8,,SEVR)_";"_SEVR_U_$$EXTERNAL^DILFD(120.8,9,,SEVRDT)_";"_SEVRDT
I $O(^GMR(120.8,GMRAREC,10,0)) D
.S GMRAX=0,GMRAY=1 F S GMRAX=$O(^GMR(120.8,GMRAREC,10,GMRAX)) Q:GMRAX<1 D
..S GMRAZ=$G(^GMR(120.8,GMRAREC,10,GMRAX,0))
..Q:GMRAZ=""
..S GMRAZ(1)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$P(GMRAZ,U,2)_";"_+GMRAZ)
..;*BD
..I '$G(GMRAV1) D
...;*ED (CLEAN UP PERIODS)
...S GMRAZ(1)=GMRAZ(1)_U_$$FMTE^XLFDT($P(GMRAZ,U,4))_";"_$P(GMRAZ,U,4)
..S GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1),GMRAY=GMRAY+1
K:+$G(GMRAKC) MECH
Q
REMOTE(GMRAL,NODE) ;RETRIEVE REMOTE DATA
;PARAMETERS: GMRAL => ARRAY IN WHICH TO RETURN DATA
; NODE => IEN OF THE CURRENT ALLERGY
S MECH=$P(GMRANODE,U,14)
;A, B, & C
S GMRAL("R"_INDEX)=DFN_U_$G(@NODE@("REACTANT",0))_U_U
;D
S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_+$P(GMRANODE,U,16)_U
;E & F
S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$S(MECH="A"!(MECH="U"):0,1:1)_U_U
;G
S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$P(GMRANODE,U,20)_U
;H
S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$S(MECH'="":$G(MECH(MECH)),1:"")_U
;I
N VUID,FILE,IEN,GLOBAL,RETURN,ERROR,GMRARRAY
S VUID=$P($G(@NODE@("GMRALLERGY",0)),U,1)
S FILE=$P($P($G(@NODE@("GMRALLERGY",0)),U,3),"99VA",2)
I FILE>0 D
.D FILE^DID(FILE,,"GLOBAL NAME","RETURN","ERROR")
.Q:$D(ERROR)
.D GETIREF^XTID(FILE,,VUID,"GMRARRAY")
.S IEN=0 F S IEN=$O(GMRARRAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
..S $P(GMRAL("R"_INDEX),U,9)=+IEN_";"_$P(RETURN("GLOBAL NAME"),U,2)
S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_U
;J
N OBSHIS
I $D(@NODE@("OBS/HISTORICAL"))>9 D
.N GMRARRAY
.D GETIREF^XTID(120.8,,$P($G(@NODE@("OBS/HISTORICAL",0)),U,1),"GMRARRAY")
.S OBSHIS=$O(GMRARRAY(120.8,6,"")),OBSHIS=$$EXTERNAL^DILFD(120.8,6,,OBSHIS)_";"_OBSHIS
S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$G(OBSHIS)
;K
I $D(@NODE@("SEVERITY"))>9 D
.S GMRAL("R"_INDEX,"O",1)=$P($G(@NODE@("SEVERITY",0)),U,2)_";"_$P($G(@NODE@("SEVERITY",0)),U)_U
N SINDEX,DATE
S SINDEX=0 F S SINDEX=$O(@NODE@("SIGNS/SYMPTOMS",SINDEX)) Q:+$G(SINDEX)=0 D
.I $P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)="L" D
..S GMRAL("R"_INDEX,"S",SINDEX)=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_GMRAOTH
.I $P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)'="L" D
..N GMRARRAY
..S VUID=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,1)
..S FILE=$P($P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3),"99VA",2)
..D GETIREF^XTID(FILE,,VUID,"GMRARRAY")
..S IEN=0 F S IEN=$O(GMRARRAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
...S GMRAL("R"_INDEX,"S",SINDEX)=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_+IEN
.S DATE=$$HL7TFM^XLFDT($G(@NODE@("SIGNS/SYMPTOMS",SINDEX,"DATE_ENTERED",0)))
.S $P(GMRAL("R"_INDEX,"S",SINDEX),U,2)=$$FMTE^XLFDT(DATE)_";"_DATE
S GMRAL("R"_INDEX,"SITE")=$G(@NODE@("FACILITY",0))
MECH ;CREATE MECHANISM ARRAY
S MECH("A")="ALLERGY;A",MECH("P")="PHARMACOLOGIC;P",MECH("U")="UNKNOWN;U"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADPT 12788 printed Dec 13, 2024@01:38:50 Page 2
GMRADPT ; HIRMFO/RM,WAA - UTILITY TO GATHER PATIENT DATA ; Oct 16, 2023@3:03:00
+1 ;;4.0;Adverse Reaction Tracking;**2,10,46,52,53,63,51,68**;Mar 29, 1996;Build 5
+2 ;
EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
+1 ;*BD
+2 NEW GMRAOTH,GMRAV1
+3 if '$DATA(DFN)
QUIT
+4 IF '$DATA(GMRA)#2
SET GMRA="0^0^111"
+5 KILL GMRAL
+6 SET GMRAV1=1
SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+7 DO DPT
+8 QUIT
+9 ;*ED
EN2 ; ENTRY TO GATHER PATIENT A/AR DATA
+1 ;INPUT VARIABLES:
+2 ;
+3 ; DFN Pointer to Patient file.
+4 ; GMRA (OPTIONAL) A^B^C^D^E DEFAULT="0^0^111^0^0"
+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 = 0 return local allergies only
+22 ; 1 return local and remote allergies
+23 ; E = 0 exclude entered in error entries
+24 ; 1 include entered in error entries
+25 ;OUTPUT VARIABLES:
+26 ; GMRAL = 1 if patient has Adverse Reaction
+27 ; 0 if patient has no known Adverse Reaction
+28 ; null if patient has not been asked about Adverse Reaction
+29 ; GMRAL(PTR) = A^B^C^D^E^F^G^H^I^J^K
+30 ; where PTR = Either pointer to 120.8 for local reactions or
+31 ; 'R' appended with pointer to ^XTMP("ORRDI","ART",DFN, for remote reactions
+32 ; A = Pointer to Patient file.
+33 ; B = Free text of causative agent.
+34 ; *C = Type of reaction, where D is drug, F is food, and O is
+35 ; other.
+36 ; D = 1 if Adverse Reaction has been verified
+37 ; 0 if Adverse Reaction has not been verified
+38 ; E = 0 if this is an allergic reaction
+39 ; 1 if this is not an allergic reaction
+40 ; **F = the mechanism of reaction in the format:
+41 ; External format;Internal format
+42 ; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
+43 ; G = Type of reaction.
+44 ; where D = drug
+45 ; DF = drug/food
+46 ; DFO = drug/food/other
+47 ; DO = drug/other
+48 ; F = food
+49 ; FO = food/other
+50 ; O = other
+51 ; H = the mechanism of reaction in the format:
+52 ; External format;Internal format
+53 ; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
+54 ; I = variable pointer to the causative agent returned in piece B
+55 ; J = observed/historical of the reaction in the format:
+56 ; External format;Internal format
+57 ; GMRAL(PTR,"S",COUNT) = S^D
+58 ; where COUNT = number 1 to number of signs/symptoms for this
+59 ; reaction.
+60 ; S = a sign/symptom for this reaction in the format:
+61 ; External format;Internal format
+62 ; D = date/time sign/symptom entered in the format:
+63 ; External format;Internal format
+64 ; GMRAL(PTR,"O",COUNT) = S^D
+65 ; where COUNT = number 1 to number of observations for this
+66 ; reaction.
+67 ; S = a severity for this reaction in the format:
+68 ; External format;Internal format
+69 ; D = date/time of observation in the format:
+70 ; External format;Internal format
+71 ; GMRAL(PTR,"H") = S^D
+72 ; S = a severity for this reaction in the format:
+73 ; External format;Internal format
+74 ; D = date/time of observation in the format:
+75 ; External format;Internal format
+76 ; GMRAL(PTR,"ERROR") = D
+77 ; where D = date/time entry marked entered in error in the format:
+78 ; External format;Internal format
+79 ; Note: This will only exist for local reactions
+80 ;
+81 ; GMRAL(PTR,"SITE") = SITE
+82 ; where SITE = reporting institution in the format:
+83 ; Institution File (#4) Pointer^Station Name^Station Number
+84 ; Note: This will only exist for remote reactions
+85 ;
+86 ;* NOTE: This piece will no longer be supported after 9/1/97,
+87 ; Please use piece G.
+88 ;** NOTE: This piece will no longer be supported after 9/1/97,
+89 ; Please use piece H.
+90 ;
+91 ;*BD
+92 DO DPT2
+93 QUIT
+94 ;*ED
DPT ;
+1 ;*BD
+2 ;Read NKA Node in file 120.86
+3 SET GMRAL=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
+4 ;Do not set GMRAL array if patient is unassessed or NKA.
+5 ;PATIENT HAS NO KNOWN ALLERGIES
IF GMRAL=0
QUIT
+6 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(0)
+7 ;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
+8 KILL GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
+9 QUIT
DPT2 ;DO NOT CALL THIS ENTRY POINT AS IT WILL BE DELETED IN THE FUTURE. USE EN2 INSTEAD.
+1 ;*ED
+2 NEW GMRAOTH,REMOTE,MECH,IDX,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
+3 if '$DATA(DFN)
QUIT
+4 IF '$DATA(GMRA)#2
SET GMRA="0^0^111^0^0"
+5 KILL GMRAL
+6 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+7 SET REMOTE=$SELECT(+$PIECE(GMRA,U,4):$$HDRDATA^GMRAHDR,1:0)
+8 SET GMRAL=$$NKA^GMRANKA(DFN)
+9 IF +GMRAL=0
IF $PIECE(GMRA,U,4)
IF ($DATA(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9)
Begin DoDot:1
+10 SET IDX=0
FOR
SET IDX=$ORDER(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
if 'IDX
QUIT
Begin DoDot:2
+11 NEW RETURN
+12 SET RETURN=$$INTERNAL(120.86,1,^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
+13 IF RETURN=1
SET GMRAL=1
+14 IF GMRAL'=1
IF (RETURN=0)
SET GMRAL=0
End DoDot:2
End DoDot:1
+15 IF +GMRAL=0
IF '$PIECE(GMRA,U,5)
QUIT
+16 DO MECH
+17 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(0)
+18 IF +$GET(REMOTE)>0
Begin DoDot:1
+19 NEW INDEX
+20 SET INDEX=0
FOR
SET INDEX=$ORDER(^XTMP("ORRDI","ART",DFN,INDEX))
if +$GET(INDEX)=0
QUIT
Begin DoDot:2
+21 NEW GMRANODE,GMRAREC,RETURN
+22 SET GMRAREC=$NAME(^XTMP("ORRDI","ART",DFN,INDEX))
+23 SET RETURN=$$INTERNAL(120.8,17,$GET(@GMRAREC@("MECHANISM",0)))
+24 if RETURN'=-1
SET $PIECE(GMRANODE,U,14)=RETURN
+25 SET RETURN=$$UP^XLFSTR($EXTRACT($GET(@GMRAREC@("VERIFIED",0)),1))
+26 SET $PIECE(GMRANODE,U,16)=$SELECT(RETURN="Y":1,RETURN="N":0,1:"")
+27 SET $PIECE(GMRANODE,U,20)=$PIECE($GET(@GMRAREC@("TYPE",0)),U,1)
+28 DO SETAL(1)
End DoDot:2
End DoDot:1
+29 IF GMRAL=1
IF $ORDER(GMRAL(0))=""
SET GMRAL=0
+30 KILL GMRA
+31 QUIT
INTERNAL(FILE,FIELD,VALUE) ;RETURN INTERNAL VALUE OF VUID
+1 ;PARAMETERS: FILE => FILE NUMBER WHERE THE DATA RESIDES
+2 ; FIELD => FIELD NUMBER WHERE THE DATA RESIDES
+3 ; VALUE => CARET-DELIMITED STRING WHERE THE FIRST
+4 ; PIECE CONTAINS THE VUID
+5 ;RETURNS: -1 => BAD INPUT PARAMETERS
+6 ; INTERNAL VALUE OF VUID
+7 NEW RETURN
+8 SET RETURN=-1
+9 if $GET(VALUE)=""
QUIT RETURN
+10 NEW GMRARRAY
+11 DO GETIREF^XTID(FILE,,$PIECE(VALUE,U,1),"GMRARRAY")
+12 if $DATA(GMRARRAY(FILE,FIELD))>9
SET RETURN=$ORDER(GMRARRAY(FILE,FIELD,""))
+13 QUIT RETURN
SETAL(REMOTE) ;DETERMINE WHETHER TO RETURN CURRENT ALLERGY
+1 ;PARAMETER: REMOTE => 0 IF ALLERGY IS LOCAL, 1 IF IT IS REMOTE
+2 NEW %,GMRAI,GMRASIGN
+3 ;IF LOCAL, EXCLUDE ENTERED IN ERROR AND ENTRY IS ENTERED IN ERROR, THEN QUIT
+4 ;(REMOTE ENTERED IN ERROR ALREADY FILTERED)
+5 IF 'REMOTE
IF '$PIECE(GMRA,U,5)
IF (+$GET(^GMR(120.8,GMRAREC,"ER")))
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,U)
SET GMRAI=1
+9 IF '$TEST
IF $PIECE(GMRA,U)=1
if $FIND("AU",$PIECE(GMRANODE,U,14))>1
SET GMRAI=1
+10 IF '$TEST
if $FIND("P",$PIECE(GMRANODE,U,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,U,2)=(1-$PIECE(GMRANODE,U,16))
QUIT
+13 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
SET GMRAI=0
+14 FOR %=1:1:3
IF $EXTRACT($PIECE(GMRA,U,3),%)
IF $PIECE(GMRANODE,U,20)[$EXTRACT("OFD",%)
SET GMRAI=1
QUIT
+15 ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
if 'GMRAI
QUIT
+16 DO DATA(.GMRAREC,.GMRAL)
+17 QUIT
DATA(GMRAREC,GMRAL) ;RETRIEVE THE APPROPRIATE DATA
+1 ;PARAMETERS: GMRAREC => REFERENCE TO THE VARIABLE CONTAINING THE CURRENT ALLERGY'S IEN
+2 ; GMRAL => REFERENCE TO THE ARRAY IN WHICH TO RETURN DATA
+3 if +$GET(GMRAREC)>0
DO PASS(.GMRAREC,.GMRAL)
+4 if +$GET(GMRAREC)=0
DO REMOTE(.GMRAL,.GMRAREC)
+5 QUIT
PASS(GMRAREC,GMRAL) ;RETRIEVE LOCAL DATA
+1 ;PARAMETERS: GMRAREC => IEN OF THE CURRENT ALLERGY
+2 ; GMRAL => ARRAY IN WHICH TO RETURN DATA
+3 NEW GMRANODE,%,GMRAX,GMRAY,GMRAZ,GMRAKC
+4 IF '$DATA(MECH)
Begin DoDot:1
+5 DO MECH
+6 SET GMRAKC=1
End DoDot:1
+7 SET GMRANODE=$GET(^GMR(120.8,GMRAREC,0))
if GMRANODE=""
QUIT
+8 SET %=$PIECE(GMRANODE,U,14)
+9 SET GMRAL(GMRAREC)=$PIECE(GMRANODE,U,1,2)_U_$EXTRACT($PIECE(GMRANODE,U,20))_U_+$PIECE(GMRANODE,U,16)_U_$SELECT(%="A"!(%="U"):0,1:1)
+10 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$SELECT(%="A":"ALLERGY;0",%="P":"PHARMACOLOGIC;2",%="U":"UNKNOWN;U",1:"")_U_$PIECE(GMRANODE,U,20)_U_$SELECT(%'="":$GET(MECH(%)),1:"")
+11 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$PIECE(GMRANODE,U,3)
+12 ;*BD
+13 IF '$GET(GMRAV1)
Begin DoDot:1
+14 ;*ED
+15 SET %=$PIECE(GMRANODE,U,6)
+16 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$$EXTERNAL^DILFD(120.8,6,,%)_";"_%
+17 IF $DATA(^GMR(120.85,"C",GMRAREC))>9
Begin DoDot:2
+18 NEW IEN,IDX
+19 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.85,"C",GMRAREC,IEN))
if '+IEN
QUIT
Begin DoDot:3
+20 SET IDX=1+$GET(IDX)
SET %=$PIECE($GET(^GMR(120.85,IEN,0)),U,14)
+21 SET GMRAL(GMRAREC,"O",IDX)=$$EXTERNAL^DILFD(120.85,14.5,,%)_";"_%_U
+22 SET %=$PIECE($GET(^GMR(120.85,IEN,0)),U)
+23 SET GMRAL(GMRAREC,"O",IDX)=GMRAL(GMRAREC,"O",IDX)_$$EXTERNAL^DILFD(120.85,.01,,%)_";"_%
End DoDot:3
End DoDot:2
+24 IF $PIECE($GET(^GMR(120.8,GMRAREC,"ER")),U)=1
Begin DoDot:2
+25 SET %=$PIECE($GET(^GMR(120.8,GMRAREC,"ER")),U,2)
+26 SET GMRAL(GMRAREC,"ERROR")=$$EXTERNAL^DILFD(120.8,23,,%)_";"_%
End DoDot:2
End DoDot:1
+27 IF $PIECE(GMRANODE,U,6)="h"
Begin DoDot:1
+28 NEW SEVR,SEVRDT
+29 SET SEVR=$PIECE(GMRANODE,U,8)
+30 SET SEVRDT=$PIECE(GMRANODE,U,9)
+31 SET GMRAL(GMRAREC,"H")=$$EXTERNAL^DILFD(120.8,8,,SEVR)_";"_SEVR_U_$$EXTERNAL^DILFD(120.8,9,,SEVRDT)_";"_SEVRDT
End DoDot:1
+32 IF $ORDER(^GMR(120.8,GMRAREC,10,0))
Begin DoDot:1
+33 SET GMRAX=0
SET GMRAY=1
FOR
SET GMRAX=$ORDER(^GMR(120.8,GMRAREC,10,GMRAX))
if GMRAX<1
QUIT
Begin DoDot:2
+34 SET GMRAZ=$GET(^GMR(120.8,GMRAREC,10,GMRAX,0))
+35 if GMRAZ=""
QUIT
+36 SET GMRAZ(1)=$SELECT(+GMRAZ'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$PIECE(GMRAZ,U,2)_";"_+GMRAZ)
+37 ;*BD
+38 IF '$GET(GMRAV1)
Begin DoDot:3
+39 ;*ED (CLEAN UP PERIODS)
+40 SET GMRAZ(1)=GMRAZ(1)_U_$$FMTE^XLFDT($PIECE(GMRAZ,U,4))_";"_$PIECE(GMRAZ,U,4)
End DoDot:3
+41 SET GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1)
SET GMRAY=GMRAY+1
End DoDot:2
End DoDot:1
+42 if +$GET(GMRAKC)
KILL MECH
+43 QUIT
REMOTE(GMRAL,NODE) ;RETRIEVE REMOTE DATA
+1 ;PARAMETERS: GMRAL => ARRAY IN WHICH TO RETURN DATA
+2 ; NODE => IEN OF THE CURRENT ALLERGY
+3 SET MECH=$PIECE(GMRANODE,U,14)
+4 ;A, B, & C
+5 SET GMRAL("R"_INDEX)=DFN_U_$GET(@NODE@("REACTANT",0))_U_U
+6 ;D
+7 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_+$PIECE(GMRANODE,U,16)_U
+8 ;E & F
+9 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$SELECT(MECH="A"!(MECH="U"):0,1:1)_U_U
+10 ;G
+11 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$PIECE(GMRANODE,U,20)_U
+12 ;H
+13 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$SELECT(MECH'="":$GET(MECH(MECH)),1:"")_U
+14 ;I
+15 NEW VUID,FILE,IEN,GLOBAL,RETURN,ERROR,GMRARRAY
+16 SET VUID=$PIECE($GET(@NODE@("GMRALLERGY",0)),U,1)
+17 SET FILE=$PIECE($PIECE($GET(@NODE@("GMRALLERGY",0)),U,3),"99VA",2)
+18 IF FILE>0
Begin DoDot:1
+19 DO FILE^DID(FILE,,"GLOBAL NAME","RETURN","ERROR")
+20 if $DATA(ERROR)
QUIT
+21 DO GETIREF^XTID(FILE,,VUID,"GMRARRAY")
+22 SET IEN=0
FOR
SET IEN=$ORDER(GMRARRAY(FILE,.01,IEN))
if +$GET(IEN)=0
QUIT
Begin DoDot:2
+23 SET $PIECE(GMRAL("R"_INDEX),U,9)=+IEN_";"_$PIECE(RETURN("GLOBAL NAME"),U,2)
End DoDot:2
End DoDot:1
+24 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_U
+25 ;J
+26 NEW OBSHIS
+27 IF $DATA(@NODE@("OBS/HISTORICAL"))>9
Begin DoDot:1
+28 NEW GMRARRAY
+29 DO GETIREF^XTID(120.8,,$PIECE($GET(@NODE@("OBS/HISTORICAL",0)),U,1),"GMRARRAY")
+30 SET OBSHIS=$ORDER(GMRARRAY(120.8,6,""))
SET OBSHIS=$$EXTERNAL^DILFD(120.8,6,,OBSHIS)_";"_OBSHIS
End DoDot:1
+31 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$GET(OBSHIS)
+32 ;K
+33 IF $DATA(@NODE@("SEVERITY"))>9
Begin DoDot:1
+34 SET GMRAL("R"_INDEX,"O",1)=$PIECE($GET(@NODE@("SEVERITY",0)),U,2)_";"_$PIECE($GET(@NODE@("SEVERITY",0)),U)_U
End DoDot:1
+35 NEW SINDEX,DATE
+36 SET SINDEX=0
FOR
SET SINDEX=$ORDER(@NODE@("SIGNS/SYMPTOMS",SINDEX))
if +$GET(SINDEX)=0
QUIT
Begin DoDot:1
+37 IF $PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)="L"
Begin DoDot:2
+38 SET GMRAL("R"_INDEX,"S",SINDEX)=$PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_GMRAOTH
End DoDot:2
+39 IF $PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)'="L"
Begin DoDot:2
+40 NEW GMRARRAY
+41 SET VUID=$PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,1)
+42 SET FILE=$PIECE($PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3),"99VA",2)
+43 DO GETIREF^XTID(FILE,,VUID,"GMRARRAY")
+44 SET IEN=0
FOR
SET IEN=$ORDER(GMRARRAY(FILE,.01,IEN))
if +$GET(IEN)=0
QUIT
Begin DoDot:3
+45 SET GMRAL("R"_INDEX,"S",SINDEX)=$PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_+IEN
End DoDot:3
End DoDot:2
+46 SET DATE=$$HL7TFM^XLFDT($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX,"DATE_ENTERED",0)))
+47 SET $PIECE(GMRAL("R"_INDEX,"S",SINDEX),U,2)=$$FMTE^XLFDT(DATE)_";"_DATE
End DoDot:1
+48 SET GMRAL("R"_INDEX,"SITE")=$GET(@NODE@("FACILITY",0))
MECH ;CREATE MECHANISM ARRAY
+1 SET MECH("A")="ALLERGY;A"
SET MECH("P")="PHARMACOLOGIC;P"
SET MECH("U")="UNKNOWN;U"
+2 QUIT
