GMRAOR2 ; HIRMFO/RM - OERR UTILITIES ;May 11, 2021@12:06:30
;;4.0;Adverse Reaction Tracking;**21,41,46,63**;Mar 29, 1996;Build 34
EN1(IEN,ARRAY) ;RETURNS DATA FOR SPECIFIC ADVERSE REACTION
;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2422
;*BD
N GMRAV1
S GMRAV1=1
;*ED
D DATA($G(IEN),$G(ARRAY,"GMRACT"))
Q
EN2(IEN,ARRAY) ;RETURNS DATA FOR SPECIFIC ADVERSE REACTION
;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2422
;PARAMETERS: IEN => INTERNAL ENTRY NUMBER IN PATIENT ALLERGIES FILE (#120.8)
; ARRAY => NAME OF THE ARRAY IN WHICH TO RETURN THE
; REACTION DATA. IF NOTHING IS PASSED IN, DATA
; IS RETURNED IN THE GMRACT ARRAY.
D DATA($G(IEN),$G(ARRAY,"GMRACT"))
Q
DATA(IEN,ARRAY) ;ASSEMBLE DATA TO RETURN
;PARAMETERS: IEN => IEN IN FILE #120.8
; ARRAY => NAME OF THE ARRAY IN WHICH TO RETURN THE
; REACTION DATA.
Q:$G(IEN)=""
N GMRAPA,GMRAOTH,GMRAI,GMRAGMR,GMRAORIG,GMRAIDX
K @ARRAY
S GMRAPA=IEN,GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
;*BD
I $G(GMRAV1) S @ARRAY=$P(GMRAPA(0),U,2)_U
I '$G(GMRAV1) D
.;*ED (C U DOTS)
.I $P(GMRAPA(0),U,20)["D" D
..S GMRAGMR=$$EXTERNAL^DILFD(120.8,1,,$P(GMRAPA(0),U,3))
..I $P(GMRAPA(0),U,2)'=GMRAGMR S @ARRAY=GMRAGMR_" ["_$P(GMRAPA(0),U,2)_"]"_U
.I $P(GMRAPA(0),U,20)'["D"!('$D(@ARRAY)) D
..S @ARRAY=$P(GMRAPA(0),U,2)_U
S GMRAORIG=$P(GMRAPA(0),U,5)
I +GMRAORIG>0 D
.S @ARRAY=@ARRAY_$$GET1^DIQ(120.8,GMRAPA_",",5)_U_$$GET1^DIQ(200,GMRAORIG_",",8)_U
I +GMRAORIG=0 D
.S @ARRAY=@ARRAY_"<None>"_U_U
S @ARRAY=@ARRAY_$S($P(GMRAPA(0),U,16)=1:"",1:"NOT ")_"VERIFIED"_U
S @ARRAY=@ARRAY_$S($P(GMRAPA(0),U,6)="o":"OBSERVED",$P(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")_U
S @ARRAY=@ARRAY_$S($P(GMRAPA(0),U,14)="A":"ALLERGY",$P(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$P(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")_U
S @ARRAY=@ARRAY_$$OUTTYPE^GMRAUTL($P(GMRAPA(0),U,20))_U_$S($P(GMRAPA(0),U,16)&('$P(GMRAPA(0),U,18)):"<auto-verified>",1:$$GET1^DIQ(120.8,GMRAPA_",",21))_U_$P(GMRAPA(0),U,17)
S @ARRAY=@ARRAY_U_$$FMTE^XLFDT($P(GMRAPA(0),U,4))
;Comments
S GMRAI=0 F GMRAIDX=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,26,GMRAI)) Q:GMRAI<1 D
.N GMRACOM
.S GMRACOM=$G(^GMR(120.8,GMRAPA,26,GMRAI,0)) Q:GMRACOM=""
.S @ARRAY@("C",GMRAIDX)=$P(GMRACOM,U)_U_$S($P(GMRACOM,U,3)="V":"VERIFIER",$P(GMRACOM,U,3)="O":"ORIGINATOR",1:"")_U_$$GET1^DIQ(200,$P(GMRACOM,U,2)_",",.01)
.M @ARRAY@("C",GMRAIDX)=^GMR(120.8,GMRAPA,26,GMRAI,2)
;Observer information from file #120.85
I $P(GMRAPA(0),U,6)="o" D
.S GMRAI=0 F GMRAIDX=1:1 S GMRAI=$O(^GMR(120.85,"C",GMRAPA,GMRAI)) Q:GMRAI<1 D
..N GMRACOM
..S GMRACOM=$G(^GMR(120.85,GMRAI,0)) Q:GMRACOM=""
..S @ARRAY@("O",GMRAIDX)=$P(GMRACOM,U)_U_$S($P(GMRACOM,U,14)=1:"MILD",$P(GMRACOM,U,14)=2:"MODERATE",$P(GMRACOM,U,14)=3:"SEVERE",1:"")
;Historical information
I $P(GMRAPA(0),U,6)="h" D
.I $P(GMRAPA(0),U,8)="",$P(GMRAPA(0),U,9)="" Q
.S @ARRAY@("H")=$P(GMRAPA(0),U,9)_U_$S($P(GMRAPA(0),U,8)=1:"MILD",$P(GMRAPA(0),U,8)=2:"MODERATE",$P(GMRAPA(0),U,8)=3:"SEVERE",1:"")
;Signs/Symptoms
S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
S GMRAI=0 F GMRAIDX=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,10,GMRAI)) Q:GMRAI<1 D
.N GMRAZ
.S GMRAZ=$G(^GMR(120.8,GMRAPA,10,GMRAI,0)) Q:GMRAZ=""
.S @ARRAY@("S",GMRAIDX)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U),1:$P(GMRAZ,U,2))_$S($P(GMRAZ,U,4)'="":" ("_$$FMTE^XLFDT($P(GMRAZ,U,4),2)_")",1:"")
;VA Drug Classes
S GMRAI=0 F GMRAIDX=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,3,GMRAI)) Q:GMRAI<1 D
.N GMRACOM
.S GMRACOM=$G(^GMR(120.8,GMRAPA,3,GMRAI,0)) Q:GMRACOM=""
.S @ARRAY@("V",GMRAIDX)=$$CLP2CLDA^GMRAPENC(GMRACOM)
;Drug Ingredients
S GMRAI=0 F GMRAIDX=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,2,GMRAI)) Q:GMRAI<1 D
.N GMRACOM
.S GMRACOM=$G(^GMR(120.8,GMRAPA,2,GMRAI,0)) Q:GMRACOM=""
.S @ARRAY@("I",GMRAIDX)=$$INP2INNA^GMRAPENC(GMRACOM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR2 3925 printed Sep 23, 2025@19:15:38 Page 2
GMRAOR2 ; HIRMFO/RM - OERR UTILITIES ;May 11, 2021@12:06:30
+1 ;;4.0;Adverse Reaction Tracking;**21,41,46,63**;Mar 29, 1996;Build 34
EN1(IEN,ARRAY) ;RETURNS DATA FOR SPECIFIC ADVERSE REACTION
+1 ;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2422
+2 ;*BD
+3 NEW GMRAV1
+4 SET GMRAV1=1
+5 ;*ED
+6 DO DATA($GET(IEN),$GET(ARRAY,"GMRACT"))
+7 QUIT
EN2(IEN,ARRAY) ;RETURNS DATA FOR SPECIFIC ADVERSE REACTION
+1 ;CONTROLLED BY SUPPORTED INTEGRATION AGREEMENT #2422
+2 ;PARAMETERS: IEN => INTERNAL ENTRY NUMBER IN PATIENT ALLERGIES FILE (#120.8)
+3 ; ARRAY => NAME OF THE ARRAY IN WHICH TO RETURN THE
+4 ; REACTION DATA. IF NOTHING IS PASSED IN, DATA
+5 ; IS RETURNED IN THE GMRACT ARRAY.
+6 DO DATA($GET(IEN),$GET(ARRAY,"GMRACT"))
+7 QUIT
DATA(IEN,ARRAY) ;ASSEMBLE DATA TO RETURN
+1 ;PARAMETERS: IEN => IEN IN FILE #120.8
+2 ; ARRAY => NAME OF THE ARRAY IN WHICH TO RETURN THE
+3 ; REACTION DATA.
+4 if $GET(IEN)=""
QUIT
+5 NEW GMRAPA,GMRAOTH,GMRAI,GMRAGMR,GMRAORIG,GMRAIDX
+6 KILL @ARRAY
+7 SET GMRAPA=IEN
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+8 ;*BD
+9 IF $GET(GMRAV1)
SET @ARRAY=$PIECE(GMRAPA(0),U,2)_U
+10 IF '$GET(GMRAV1)
Begin DoDot:1
+11 ;*ED (C U DOTS)
+12 IF $PIECE(GMRAPA(0),U,20)["D"
Begin DoDot:2
+13 SET GMRAGMR=$$EXTERNAL^DILFD(120.8,1,,$PIECE(GMRAPA(0),U,3))
+14 IF $PIECE(GMRAPA(0),U,2)'=GMRAGMR
SET @ARRAY=GMRAGMR_" ["_$PIECE(GMRAPA(0),U,2)_"]"_U
End DoDot:2
+15 IF $PIECE(GMRAPA(0),U,20)'["D"!('$DATA(@ARRAY))
Begin DoDot:2
+16 SET @ARRAY=$PIECE(GMRAPA(0),U,2)_U
End DoDot:2
End DoDot:1
+17 SET GMRAORIG=$PIECE(GMRAPA(0),U,5)
+18 IF +GMRAORIG>0
Begin DoDot:1
+19 SET @ARRAY=@ARRAY_$$GET1^DIQ(120.8,GMRAPA_",",5)_U_$$GET1^DIQ(200,GMRAORIG_",",8)_U
End DoDot:1
+20 IF +GMRAORIG=0
Begin DoDot:1
+21 SET @ARRAY=@ARRAY_"<None>"_U_U
End DoDot:1
+22 SET @ARRAY=@ARRAY_$SELECT($PIECE(GMRAPA(0),U,16)=1:"",1:"NOT ")_"VERIFIED"_U
+23 SET @ARRAY=@ARRAY_$SELECT($PIECE(GMRAPA(0),U,6)="o":"OBSERVED",$PIECE(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")_U
+24 SET @ARRAY=@ARRAY_$SELECT($PIECE(GMRAPA(0),U,14)="A":"ALLERGY",$PIECE(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$PIECE(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")_U
+25 SET @ARRAY=@ARRAY_$$OUTTYPE^GMRAUTL($PIECE(GMRAPA(0),U,20))_U_$SELECT($PIECE(GMRAPA(0),U,16)&('$PIECE(GMRAPA(0),U,18)):"<auto-verified>",1:$$GET1^DIQ(120.8,GMRAPA_",",21))_U_$PIECE(GMRAPA(0),U,17)
+26 SET @ARRAY=@ARRAY_U_$$FMTE^XLFDT($PIECE(GMRAPA(0),U,4))
+27 ;Comments
+28 SET GMRAI=0
FOR GMRAIDX=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,26,GMRAI))
if GMRAI<1
QUIT
Begin DoDot:1
+29 NEW GMRACOM
+30 SET GMRACOM=$GET(^GMR(120.8,GMRAPA,26,GMRAI,0))
if GMRACOM=""
QUIT
+31 SET @ARRAY@("C",GMRAIDX)=$PIECE(GMRACOM,U)_U_$SELECT($PIECE(GMRACOM,U,3)="V":"VERIFIER",$PIECE(GMRACOM,U,3)="O":"ORIGINATOR",1:"")_U_$$GET1^DIQ(200,$PIECE(GMRACOM,U,2)_",",.01)
+32 MERGE @ARRAY@("C",GMRAIDX)=^GMR(120.8,GMRAPA,26,GMRAI,2)
End DoDot:1
+33 ;Observer information from file #120.85
+34 IF $PIECE(GMRAPA(0),U,6)="o"
Begin DoDot:1
+35 SET GMRAI=0
FOR GMRAIDX=1:1
SET GMRAI=$ORDER(^GMR(120.85,"C",GMRAPA,GMRAI))
if GMRAI<1
QUIT
Begin DoDot:2
+36 NEW GMRACOM
+37 SET GMRACOM=$GET(^GMR(120.85,GMRAI,0))
if GMRACOM=""
QUIT
+38 SET @ARRAY@("O",GMRAIDX)=$PIECE(GMRACOM,U)_U_$SELECT($PIECE(GMRACOM,U,14)=1:"MILD",$PIECE(GMRACOM,U,14)=2:"MODERATE",$PIECE(GMRACOM,U,14)=3:"SEVERE",1:"")
End DoDot:2
End DoDot:1
+39 ;Historical information
+40 IF $PIECE(GMRAPA(0),U,6)="h"
Begin DoDot:1
+41 IF $PIECE(GMRAPA(0),U,8)=""
IF $PIECE(GMRAPA(0),U,9)=""
QUIT
+42 SET @ARRAY@("H")=$PIECE(GMRAPA(0),U,9)_U_$SELECT($PIECE(GMRAPA(0),U,8)=1:"MILD",$PIECE(GMRAPA(0),U,8)=2:"MODERATE",$PIECE(GMRAPA(0),U,8)=3:"SEVERE",1:"")
End DoDot:1
+43 ;Signs/Symptoms
+44 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+45 SET GMRAI=0
FOR GMRAIDX=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,10,GMRAI))
if GMRAI<1
QUIT
Begin DoDot:1
+46 NEW GMRAZ
+47 SET GMRAZ=$GET(^GMR(120.8,GMRAPA,10,GMRAI,0))
if GMRAZ=""
QUIT
+48 SET @ARRAY@("S",GMRAIDX)=$SELECT(+GMRAZ'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+GMRAZ,0)),U),1:$PIECE(GMRAZ,U,2))_$SELECT($PIECE(GMRAZ,U,4)'="":" ("_$$FMTE^XLFDT($PIECE(GMRAZ,U,4),2)_")",1:"")
End DoDot:1
+49 ;VA Drug Classes
+50 SET GMRAI=0
FOR GMRAIDX=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,3,GMRAI))
if GMRAI<1
QUIT
Begin DoDot:1
+51 NEW GMRACOM
+52 SET GMRACOM=$GET(^GMR(120.8,GMRAPA,3,GMRAI,0))
if GMRACOM=""
QUIT
+53 SET @ARRAY@("V",GMRAIDX)=$$CLP2CLDA^GMRAPENC(GMRACOM)
End DoDot:1
+54 ;Drug Ingredients
+55 SET GMRAI=0
FOR GMRAIDX=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,2,GMRAI))
if GMRAI<1
QUIT
Begin DoDot:1
+56 NEW GMRACOM
+57 SET GMRACOM=$GET(^GMR(120.8,GMRAPA,2,GMRAI,0))
if GMRACOM=""
QUIT
+58 SET @ARRAY@("I",GMRAIDX)=$$INP2INNA^GMRAPENC(GMRACOM)
End DoDot:1
+59 QUIT
