- 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
