GMRAOR2 ;HIRMFO/RM-OERR UTILITIES ;08-Aug-2013 14:08;DU
;;4.0;Adverse Reaction Tracking;**21,1002,1006,1007**;Mar 29, 1996;Build 18
EN1(IEN,ARRAY) ; This entry point returns detailed information about a
; particular patient allergy/adverse reaction.
; Input Variables
; IEN = The internal entry number of the reaction in file 120.8
; ARRAY = The array that the reaction data is to be passed back in.
; (Note: The return array cannot be the GMRAL array.)
Q:$G(IEN)=""
S ARRAY=$S($G(ARRAY)'="":ARRAY,1:"GMRACT") Q:ARRAY="GMRAL"
N GMRAPA,GMRAOTH,GMRAL,GMRAI,GMRASRC,GMRASNO,%
S GMRAPA=IEN,GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
; Set up GMRAL variable
S GMRAL=$P(GMRAPA(0),U,2)_U
S GMRAL=GMRAL_$S($P(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01"),1:"<None>")_U ;21
S %=$S($P(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",","8","I"),1:"") ;21
S GMRAL=GMRAL_$S(%>1:$P($G(^DIC(3.1,%,0)),U),1:"")_U
S GMRAL=GMRAL_$S($P(GMRAPA(0),U,16)=1:"",1:"NOT ")_"VERIFIED"_U
S GMRAL=GMRAL_$S($P(GMRAPA(0),U,6)="o":"OBSERVED",$P(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")_U
S GMRAL=GMRAL_$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 GMRAL=GMRAL_$$OUTTYPE^GMRAUTL($P(GMRAPA(0),U,20))_U_$S($P(GMRAPA(0),U,16)&('$P(GMRAPA(0),U,18)):"<auto-verified>",1:$$GET1^DIQ(200,$P(GMRAPA(0),U,18)_",",.01))_U_$P(GMRAPA(0),U,17) ;21
S GMRAL=GMRAL_U_$$FMTE^XLFDT($P(GMRAPA(0),U,4)) ;21 add orig date/time
;IHS/MSC/MGH changes for EHR patch 8 added back in patch 1006
S GMRASRC=$P($G(^GMR(120.8,GMRAPA,9999999.11)),U,1)
I +GMRASRC S GMRAL=GMRAL_U_$P($G(^BEHOAR(90460.05,GMRASRC,0)),U,1) ;Add the source of the data MSC/IHS/MGH
S GMRASNO=$P($G(^GMR(120.8,GMRAPA,9999999.11)),U,2)
I +GMRASNO S GMRAL=GMRAL_U_$P($G(^BEHOAR(90460.06,GMRASNO,0)),U,1)_" "_$P($G(^BEHOAR(90460.06,GMRASNO,0)),U,2) ;Add the SNOMED code
;IHS/MSC/MGH Set up inactivate data in GMRAL("N", Patch 1006
N ZZ,X,X4,X2,X3,X5
S ZZ=0
S GMRAI=9999999 F S GMRAI=$O(^GMR(120.8,GMRAPA,9999999.12,GMRAI),-1) Q:'+GMRAI D
.N GMRAIN,IIEN,X,X1,X2,X3,X4,X5
.S GMRAIN=$G(^GMR(120.8,GMRAPA,9999999.12,GMRAI,0))
.S IIEN=GMRAI_","_GMRAPA_","
.S X=$$GET1^DIQ(120.899999912,IIEN,.01),X2=$$GET1^DIQ(120.899999912,IIEN,1),X3=$$GET1^DIQ(120.899999912,IIEN,2)
.S ZZ=ZZ+1
.S GMRAL("N",ZZ)=X_U_X2_U_X3
.I $P(GMRAIN,U,4)'="" D
..S X4=$$GET1^DIQ(120.899999912,IIEN,3),X5=$$GET1^DIQ(120.899999912,IIEN,4)
..S $P(GMRAL("N",ZZ),U,4)=X4 S $P(GMRAL("N",ZZ),U,5)=X5
.Q
;end mods
;Set up Comments in to GMRAL("C",
S GMRAI=0 F %=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 GMRAL("C",%)=$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) ;21
.M GMRAL("C",%)=^GMR(120.8,GMRAPA,26,GMRAI,2)
.Q
;Observer information from file 120.85
S GMRAI=0 F %=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 GMRAL("O",%)=$P(GMRACOM,U)_U_$S($P(GMRACOM,U,14)=1:"MILD",$P(GMRACOM,U,14)=2:"MODERATE",$P(GMRACOM,U,14)=3:"SEVERE",1:"")
.Q
;Signs/Symptoms
S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
S GMRAI=0 F %=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,10,GMRAI)) Q:GMRAI<1 D
.N GMRAZ,SSRC,SNO
.S GMRAZ=$G(^GMR(120.8,GMRAPA,10,GMRAI,0)) Q:GMRAZ=""
.S GMRAL("S",%)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U),1:$P(GMRAZ,U,2))_$S($P(GMRAZ,U,4)'="":" ("_$$FIXDT($$FMTE^XLFDT($P(GMRAZ,U,4),2))_")",1:"") ;21
.S SSRC=$P($G(^GMR(120.8,GMRAPA,10,GMRAI,9999999.11)),U),SNO=$P($G(^GMR(120.8,GMRAPA,10,GMRAI,9999999.11)),U,2)
.I +SSRC S GMRAL("S",%)=GMRAL("S",%)_" Src: "_$P($G(^BEHOAR(90460.05,SSRC,0)),U,1)
.I SNO S GMRAL("S",%)=$G(GMRAL("S",%))_"; Snomed: "_SNO ;MU patch add source MSC/IHS/MGH/Patch 1007 added SNOMED
.Q
;VA Drug Class
S GMRAI=0 F %=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 GMRAL("V",%)=$P($G(^PS(50.605,GMRACOM,0)),U,1,2)
.Q
;Drug Ingredients
S GMRAI=0 F %=1:1 S GMRAI=$O(^GMR(120.8,GMRAPA,2,GMRAI)) Q:GMRAI<1 D
.N GMRACOM,RXN,UNI,TXT,TXT1,TXT2
.S RXN="",UNI=""
.S (TXT,TXT1,TXT2)=""
.S GMRACOM=$G(^GMR(120.8,GMRAPA,2,GMRAI,0)) Q:GMRACOM=""
.S RXN=$P($G(^GMR(120.8,GMRAPA,2,GMRAI,9999999)),U)
.S UNI=$P($G(^GMR(120.8,GMRAPA,2,GMRAI,9999999)),U,2)
.I $L(RXN) S TXT1="; RxNorm: "_RXN_" "
.I $L(UNI) S TXT2="; UNII: "_UNI
.S TXT=TXT1_TXT2
.S GMRAL("I",%)=$P($G(^PS(50.416,GMRACOM,0)),U)_TXT
.Q
M @ARRAY=GMRAL
Q
FIXDT(VAL) ;Change format for imprecise dates
N RET
S RET=VAL
I +$P(VAL,"/",1)=0!(+$P(VAL,"/",2)=0) S RET=$$FMTE^XLFDT($P(GMRAZ,U,4))
Q RET
GMRAOR2 ;HIRMFO/RM-OERR UTILITIES ;08-Aug-2013 14:08;DU
+1 ;;4.0;Adverse Reaction Tracking;**21,1002,1006,1007**;Mar 29, 1996;Build 18
EN1(IEN,ARRAY) ; This entry point returns detailed information about a
+1 ; particular patient allergy/adverse reaction.
+2 ; Input Variables
+3 ; IEN = The internal entry number of the reaction in file 120.8
+4 ; ARRAY = The array that the reaction data is to be passed back in.
+5 ; (Note: The return array cannot be the GMRAL array.)
+6 IF $GET(IEN)=""
QUIT
+7 SET ARRAY=$SELECT($GET(ARRAY)'="":ARRAY,1:"GMRACT")
IF ARRAY="GMRAL"
QUIT
+8 NEW GMRAPA,GMRAOTH,GMRAL,GMRAI,GMRASRC,GMRASNO,%
+9 SET GMRAPA=IEN
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
IF GMRAPA(0)=""
QUIT
+10 ; Set up GMRAL variable
+11 SET GMRAL=$PIECE(GMRAPA(0),U,2)_U
+12 ;21
SET GMRAL=GMRAL_$SELECT($PIECE(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",",".01"),1:"<None>")_U
+13 ;21
SET %=$SELECT($PIECE(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",","8","I"),1:"")
+14 SET GMRAL=GMRAL_$SELECT(%>1:$PIECE($GET(^DIC(3.1,%,0)),U),1:"")_U
+15 SET GMRAL=GMRAL_$SELECT($PIECE(GMRAPA(0),U,16)=1:"",1:"NOT ")_"VERIFIED"_U
+16 SET GMRAL=GMRAL_$SELECT($PIECE(GMRAPA(0),U,6)="o":"OBSERVED",$PIECE(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")_U
+17 SET GMRAL=GMRAL_$SELECT($PIECE(GMRAPA(0),U,14)="A":"ALLERGY",$PIECE(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$PIECE(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")_U
+18 ;21
SET GMRAL=GMRAL_$$OUTTYPE^GMRAUTL($PIECE(GMRAPA(0),U,20))_U_$SELECT($PIECE(GMRAPA(0),U,16)&('$PIECE(GMRAPA(0),U,18)):"<auto-verified>",1:$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,18)_",",.01))_U_$PIECE(GMRAPA(0),U,17)
+19 ;21 add orig date/time
SET GMRAL=GMRAL_U_$$FMTE^XLFDT($PIECE(GMRAPA(0),U,4))
+20 ;IHS/MSC/MGH changes for EHR patch 8 added back in patch 1006
+21 SET GMRASRC=$PIECE($GET(^GMR(120.8,GMRAPA,9999999.11)),U,1)
+22 ;Add the source of the data MSC/IHS/MGH
IF +GMRASRC
SET GMRAL=GMRAL_U_$PIECE($GET(^BEHOAR(90460.05,GMRASRC,0)),U,1)
+23 SET GMRASNO=$PIECE($GET(^GMR(120.8,GMRAPA,9999999.11)),U,2)
+24 ;Add the SNOMED code
IF +GMRASNO
SET GMRAL=GMRAL_U_$PIECE($GET(^BEHOAR(90460.06,GMRASNO,0)),U,1)_" "_$PIECE($GET(^BEHOAR(90460.06,GMRASNO,0)),U,2)
+25 ;IHS/MSC/MGH Set up inactivate data in GMRAL("N", Patch 1006
+26 NEW ZZ,X,X4,X2,X3,X5
+27 SET ZZ=0
+28 SET GMRAI=9999999
FOR
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,9999999.12,GMRAI),-1)
IF '+GMRAI
QUIT
Begin DoDot:1
+29 NEW GMRAIN,IIEN,X,X1,X2,X3,X4,X5
+30 SET GMRAIN=$GET(^GMR(120.8,GMRAPA,9999999.12,GMRAI,0))
+31 SET IIEN=GMRAI_","_GMRAPA_","
+32 SET X=$$GET1^DIQ(120.899999912,IIEN,.01)
SET X2=$$GET1^DIQ(120.899999912,IIEN,1)
SET X3=$$GET1^DIQ(120.899999912,IIEN,2)
+33 SET ZZ=ZZ+1
+34 SET GMRAL("N",ZZ)=X_U_X2_U_X3
+35 IF $PIECE(GMRAIN,U,4)'=""
Begin DoDot:2
+36 SET X4=$$GET1^DIQ(120.899999912,IIEN,3)
SET X5=$$GET1^DIQ(120.899999912,IIEN,4)
+37 SET $PIECE(GMRAL("N",ZZ),U,4)=X4
SET $PIECE(GMRAL("N",ZZ),U,5)=X5
End DoDot:2
+38 QUIT
End DoDot:1
+39 ;end mods
+40 ;Set up Comments in to GMRAL("C",
+41 SET GMRAI=0
FOR %=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,26,GMRAI))
IF GMRAI<1
QUIT
Begin DoDot:1
+42 NEW GMRACOM
+43 SET GMRACOM=$GET(^GMR(120.8,GMRAPA,26,GMRAI,0))
IF GMRACOM=""
QUIT
+44 ;21
SET GMRAL("C",%)=$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)
+45 MERGE GMRAL("C",%)=^GMR(120.8,GMRAPA,26,GMRAI,2)
+46 QUIT
End DoDot:1
+47 ;Observer information from file 120.85
+48 SET GMRAI=0
FOR %=1:1
SET GMRAI=$ORDER(^GMR(120.85,"C",GMRAPA,GMRAI))
IF GMRAI<1
QUIT
Begin DoDot:1
+49 NEW GMRACOM
+50 SET GMRACOM=$GET(^GMR(120.85,GMRAI,0))
IF GMRACOM=""
QUIT
+51 SET GMRAL("O",%)=$PIECE(GMRACOM,U)_U_$SELECT($PIECE(GMRACOM,U,14)=1:"MILD",$PIECE(GMRACOM,U,14)=2:"MODERATE",$PIECE(GMRACOM,U,14)=3:"SEVERE",1:"")
+52 QUIT
End DoDot:1
+53 ;Signs/Symptoms
+54 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+55 SET GMRAI=0
FOR %=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,10,GMRAI))
IF GMRAI<1
QUIT
Begin DoDot:1
+56 NEW GMRAZ,SSRC,SNO
+57 SET GMRAZ=$GET(^GMR(120.8,GMRAPA,10,GMRAI,0))
IF GMRAZ=""
QUIT
+58 ;21
SET GMRAL("S",%)=$SELECT(+GMRAZ'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+GMRAZ,0)),U),1:$PIECE(GMRAZ,U,2))_$SELECT($PIECE(GMRAZ,U,4)'="":" ("_$$FIXDT($$FMTE^XLFDT($PIECE(GMRAZ,U,4),2))_")",1:"")
+59 SET SSRC=$PIECE($GET(^GMR(120.8,GMRAPA,10,GMRAI,9999999.11)),U)
SET SNO=$PIECE($GET(^GMR(120.8,GMRAPA,10,GMRAI,9999999.11)),U,2)
+60 IF +SSRC
SET GMRAL("S",%)=GMRAL("S",%)_" Src: "_$PIECE($GET(^BEHOAR(90460.05,SSRC,0)),U,1)
+61 ;MU patch add source MSC/IHS/MGH/Patch 1007 added SNOMED
IF SNO
SET GMRAL("S",%)=$GET(GMRAL("S",%))_"; Snomed: "_SNO
+62 QUIT
End DoDot:1
+63 ;VA Drug Class
+64 SET GMRAI=0
FOR %=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,3,GMRAI))
IF GMRAI<1
QUIT
Begin DoDot:1
+65 NEW GMRACOM
+66 SET GMRACOM=$GET(^GMR(120.8,GMRAPA,3,GMRAI,0))
IF GMRACOM=""
QUIT
+67 SET GMRAL("V",%)=$PIECE($GET(^PS(50.605,GMRACOM,0)),U,1,2)
+68 QUIT
End DoDot:1
+69 ;Drug Ingredients
+70 SET GMRAI=0
FOR %=1:1
SET GMRAI=$ORDER(^GMR(120.8,GMRAPA,2,GMRAI))
IF GMRAI<1
QUIT
Begin DoDot:1
+71 NEW GMRACOM,RXN,UNI,TXT,TXT1,TXT2
+72 SET RXN=""
SET UNI=""
+73 SET (TXT,TXT1,TXT2)=""
+74 SET GMRACOM=$GET(^GMR(120.8,GMRAPA,2,GMRAI,0))
IF GMRACOM=""
QUIT
+75 SET RXN=$PIECE($GET(^GMR(120.8,GMRAPA,2,GMRAI,9999999)),U)
+76 SET UNI=$PIECE($GET(^GMR(120.8,GMRAPA,2,GMRAI,9999999)),U,2)
+77 IF $LENGTH(RXN)
SET TXT1="; RxNorm: "_RXN_" "
+78 IF $LENGTH(UNI)
SET TXT2="; UNII: "_UNI
+79 SET TXT=TXT1_TXT2
+80 SET GMRAL("I",%)=$PIECE($GET(^PS(50.416,GMRACOM,0)),U)_TXT
+81 QUIT
End DoDot:1
+82 MERGE @ARRAY=GMRAL
+83 QUIT
FIXDT(VAL) ;Change format for imprecise dates
+1 NEW RET
+2 SET RET=VAL
+3 IF +$PIECE(VAL,"/",1)=0!(+$PIECE(VAL,"/",2)=0)
SET RET=$$FMTE^XLFDT($PIECE(GMRAZ,U,4))
+4 QUIT RET
