GMRAZRXU ; IHS/MSC/MGH - RxNorm and UNI code ;04-Feb-2014 16:21;DU
;;4.0;Adverse Reaction Tracking;**1007**;Mar 29, 1996;Build 18
;
;When a new allergy is stored, find the Rxnorm and/or UNI codes to be attached to the allergy and it symptoms
RXNORM(GMRAIEN) ;EP
N TYPE
S TYPE=$P($G(^GMR(120.8,GMRAIEN,0)),U,3)
I $P(TYPE,";",2)="GMRD(120.82," D GMR(GMRAIEN)
E D ING(GMRAIEN)
D SIGNS(GMRAIEN)
Q
;Lookup and set the UNII code associated with this GMR allergy
GMR(GMRAIEN) ;GMR files
N TXT,ARR,IN,OUT,X,UNII,IEN,ERR,IEN2
Q:'GMRAIEN
S TXT=$P($G(^GMR(120.8,GMRAIEN,0)),U,2)
;Do Apelon lookup here
S IN=TXT_U_"32773^^1"
S X=$$ASSOC^BSTSAPI(IN)
I $P(X,U,3)'="" D
. S IEN=GMRAIEN_","
. S FDA(120.8,IEN,9999999.15)=$P(X,U,3)
. D UPDATE^DIE(,"FDA","IEN2","ERR")
Q
;Lookup the drug ingredients and store the RxNorm and UNII codes associated with each
ING(GMRAIEN) ;drug ingredients
N TXT,ARR,IN,OUT,X,RXNORM,UNII,IEN,ERR,ING,VUID,PRIM,RET,AIEN
S RET=0
S IEN=0 F S IEN=$O(^GMR(120.8,GMRAIEN,2,IEN)) Q:'+IEN D
.S ING=$P($G(^GMR(120.8,GMRAIEN,2,IEN,0)),U,1)
.S PRIM=$$GET1^DIQ(50.416,ING,.02,"I")
.S ING=$P($G(^PS(50.416,ING,0)),U)
.S AIEN=IEN_","_GMRAIEN_","
.;Lookup the RxNorm and UNII based on the name
.S IN=ING_U_"32771^^1"
.S X=$$ASSOC^BSTSAPI(IN)
.I $P(X,U,2)'=""!($P(X,U,3)'="") D
..I $P(X,U,2)'="" S FDA(120.802,AIEN,9999999.01)=$P(X,U,2)
..I $P(X,U,3)'="" S FDA(120.802,AIEN,9999999.02)=$P(X,U,3)
..D UPDATE^DIE(,"FDA","IEN2","ERR")
.I $P(X,U,2)=""&($P(X,U,3)="") D
..Q:PRIM=""
..S IN=PRIM_U_"32771^^1"
..S X=$$ASSOC^BSTSAPI(IN)
..I $P(X,U,2)'="" S FDA(120.802,AIEN,9999999.01)=$P(X,U,2)
..I $P(X,U,3)'="" S FDA(120.802,AIEN,9999999.02)=$P(X,U,3)
..D UPDATE^DIE(,"FDA","IEN2","ERR")
Q
;For signs/symptoms
SIGNS(GMRAIEN) ;signs multiple
N REACT,X,IN,FNUM,FDA,IEN2,ERR
S RET=0
S IEN=0 F S IEN=$O(^GMR(120.8,GMRAIEN,10,IEN)) Q:'+IEN D
.S AIEN=IEN_","_GMRAIEN_","
.S REACT=$$GET1^DIQ(120.81,AIEN,.01)
.S IN=REACT_"^32772^^1"
.S X=$$ASSOC^BSTSAPI(IN)
.I $P(X,U,1)'="" D
..S FNUM=120.81
..S FDA(FNUM,AIEN,9999999.12)=$P(X,U,1)
..D UPDATE^DIE(,"FDA","IEN2","ERR")
Q
BACKLOAD ;EP Backload this data on entire allergy file
N GMRAIEN,DFN,REACT,TYPE,DATA,EIE
S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,GMRAIEN)) Q:'+GMRAIEN D
.S DATA=$G(^GMR(120.8,GMRAIEN,0))
.S DFN=$P(DATA,U),REACT=$P(DATA,U,2),TYPE=$P(DATA,U,3)
.Q:(DFN="")!(REACT="")!(TYPE="")
.S EIE=$$GET1^DIQ(120.8,GMRAIEN,22,"I")
.Q:EIE=1
.D RXNORM(GMRAIEN)
Q
GMRAZRXU ; IHS/MSC/MGH - RxNorm and UNI code ;04-Feb-2014 16:21;DU
+1 ;;4.0;Adverse Reaction Tracking;**1007**;Mar 29, 1996;Build 18
+2 ;
+3 ;When a new allergy is stored, find the Rxnorm and/or UNI codes to be attached to the allergy and it symptoms
RXNORM(GMRAIEN) ;EP
+1 NEW TYPE
+2 SET TYPE=$PIECE($GET(^GMR(120.8,GMRAIEN,0)),U,3)
+3 IF $PIECE(TYPE,";",2)="GMRD(120.82,"
DO GMR(GMRAIEN)
+4 IF '$TEST
DO ING(GMRAIEN)
+5 DO SIGNS(GMRAIEN)
+6 QUIT
+7 ;Lookup and set the UNII code associated with this GMR allergy
GMR(GMRAIEN) ;GMR files
+1 NEW TXT,ARR,IN,OUT,X,UNII,IEN,ERR,IEN2
+2 IF 'GMRAIEN
QUIT
+3 SET TXT=$PIECE($GET(^GMR(120.8,GMRAIEN,0)),U,2)
+4 ;Do Apelon lookup here
+5 SET IN=TXT_U_"32773^^1"
+6 SET X=$$ASSOC^BSTSAPI(IN)
+7 IF $PIECE(X,U,3)'=""
Begin DoDot:1
+8 SET IEN=GMRAIEN_","
+9 SET FDA(120.8,IEN,9999999.15)=$PIECE(X,U,3)
+10 DO UPDATE^DIE(,"FDA","IEN2","ERR")
End DoDot:1
+11 QUIT
+12 ;Lookup the drug ingredients and store the RxNorm and UNII codes associated with each
ING(GMRAIEN) ;drug ingredients
+1 NEW TXT,ARR,IN,OUT,X,RXNORM,UNII,IEN,ERR,ING,VUID,PRIM,RET,AIEN
+2 SET RET=0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,GMRAIEN,2,IEN))
IF '+IEN
QUIT
Begin DoDot:1
+4 SET ING=$PIECE($GET(^GMR(120.8,GMRAIEN,2,IEN,0)),U,1)
+5 SET PRIM=$$GET1^DIQ(50.416,ING,.02,"I")
+6 SET ING=$PIECE($GET(^PS(50.416,ING,0)),U)
+7 SET AIEN=IEN_","_GMRAIEN_","
+8 ;Lookup the RxNorm and UNII based on the name
+9 SET IN=ING_U_"32771^^1"
+10 SET X=$$ASSOC^BSTSAPI(IN)
+11 IF $PIECE(X,U,2)'=""!($PIECE(X,U,3)'="")
Begin DoDot:2
+12 IF $PIECE(X,U,2)'=""
SET FDA(120.802,AIEN,9999999.01)=$PIECE(X,U,2)
+13 IF $PIECE(X,U,3)'=""
SET FDA(120.802,AIEN,9999999.02)=$PIECE(X,U,3)
+14 DO UPDATE^DIE(,"FDA","IEN2","ERR")
End DoDot:2
+15 IF $PIECE(X,U,2)=""&($PIECE(X,U,3)="")
Begin DoDot:2
+16 IF PRIM=""
QUIT
+17 SET IN=PRIM_U_"32771^^1"
+18 SET X=$$ASSOC^BSTSAPI(IN)
+19 IF $PIECE(X,U,2)'=""
SET FDA(120.802,AIEN,9999999.01)=$PIECE(X,U,2)
+20 IF $PIECE(X,U,3)'=""
SET FDA(120.802,AIEN,9999999.02)=$PIECE(X,U,3)
+21 DO UPDATE^DIE(,"FDA","IEN2","ERR")
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;For signs/symptoms
SIGNS(GMRAIEN) ;signs multiple
+1 NEW REACT,X,IN,FNUM,FDA,IEN2,ERR
+2 SET RET=0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,GMRAIEN,10,IEN))
IF '+IEN
QUIT
Begin DoDot:1
+4 SET AIEN=IEN_","_GMRAIEN_","
+5 SET REACT=$$GET1^DIQ(120.81,AIEN,.01)
+6 SET IN=REACT_"^32772^^1"
+7 SET X=$$ASSOC^BSTSAPI(IN)
+8 IF $PIECE(X,U,1)'=""
Begin DoDot:2
+9 SET FNUM=120.81
+10 SET FDA(FNUM,AIEN,9999999.12)=$PIECE(X,U,1)
+11 DO UPDATE^DIE(,"FDA","IEN2","ERR")
End DoDot:2
End DoDot:1
+12 QUIT
BACKLOAD ;EP Backload this data on entire allergy file
+1 NEW GMRAIEN,DFN,REACT,TYPE,DATA,EIE
+2 SET GMRAIEN=0
FOR
SET GMRAIEN=$ORDER(^GMR(120.8,GMRAIEN))
IF '+GMRAIEN
QUIT
Begin DoDot:1
+3 SET DATA=$GET(^GMR(120.8,GMRAIEN,0))
+4 SET DFN=$PIECE(DATA,U)
SET REACT=$PIECE(DATA,U,2)
SET TYPE=$PIECE(DATA,U,3)
+5 IF (DFN="")!(REACT="")!(TYPE="")
QUIT
+6 SET EIE=$$GET1^DIQ(120.8,GMRAIEN,22,"I")
+7 IF EIE=1
QUIT
+8 DO RXNORM(GMRAIEN)
End DoDot:1
+9 QUIT
