- 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 Jan 18, 2025@02:40:53 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