Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ETSRXNTX

ETSRXNTX.m

Go to the documentation of this file. 
  1. ETSRXNTX ;O-OIFO/FM23 - RxNorm Taxonomy Search ;03/17/2017
  1.  ;;1.0;Enterprise Terminology Service;**1**;Mar 20, 2017;Build 7
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. TAX(ETSVUID,ETSSUB,ETSCLASS) ; Get Taxonomy Information
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;  ETSVUID VA Unique ID (VUID) Search Term (Required)
  1.  ;    
  1.  ;  ETSSUB  Name of a subscript to use in the ^TMP global (optional)
  1.  ;            
  1.  ;          ^TMP(ETSSUB,$J,
  1.  ;          ^TMP("ETSCLA",$J,    Default for $$VUICLASS
  1.  ;          ^TMP("ETSTAX",$J,    Default for $$TAX
  1.  ;    
  1.  ;  ETSCLASS Call Flag (optional, default = 0)
  1.  ;     
  1.  ;           0  This function was called from the $$TAX API - Get all VUIDs with the same value set as the VUID passed in
  1.  ;           1  This function was called from the $$VUICLASS API - Get all VUIDs with the same drug class as the VUID passed in
  1.  ;     
  1.  ; Output: 
  1.  ; 
  1.  ;  $$TAX   The number of codes found or -1 ^ error message
  1.  ;    
  1.  ;  ^TMP(ETSSUB,$J,ETSVUID,"VUID"),#,0)
  1.  ;    
  1.  ;          6-piece "^"-delimited string
  1.  ;                             
  1.  ;          1   File #129.2 IEN
  1.  ;          2   RXCUI (Field #.01)
  1.  ;          3   Source (SAB) (Field #.02)
  1.  ;          4   Term_Type (TTY) (Field #.03)
  1.  ;          5   Code (VUID) (Field #.04)
  1.  ;          6   Suppression_Flag (SUPPRESS) (Field #.05)
  1.  ; 
  1.  ;  ^TMP(ETSSUB,$J,ETSVUID,"VUID"),#,1) = Text (STR) (Field #1)
  1.  ;
  1.  ;      For $$TAX:
  1.  ;  ^TMP(ETSSUB,$J,ETSVUID,"VUID"),#,2) = Activation Date (Field #91)
  1.  ;
  1.  N ETSC,ETSCNT,ETSCODE,ETSCODE5,ETSCTR,ETSDATA,ETSERR,ETSIEN,ETSNODE,ETSRELA,ETSRES,ETSRXCUI,ETSRXCU1,ETSRXCU2,ETSSAB
  1.  N ETSSUPP,ETSTTY,ETSTTYS
  1.  ;
  1.  ;Check for Parameter errors
  1.  I $G(ETSVUID)="" Q "-1^VUID missing"
  1.  ;
  1.  ;Set Default values for optional parameters
  1.  S:$G(ETSCLASS)'=1 ETSCLASS=0
  1.  S:$G(ETSSUB)="" ETSSUB=$S(ETSCLASS=1:"ETSCLA",1:"ETSTAX")
  1.  ;
  1.  ;Clear the temporary arrays in case there is older data in existence
  1.  K ^TMP(ETSSUB,$J)
  1.  D CLEANUP
  1.  ;
  1.  ;Set other defaults
  1.  S ETSTTYS=$S(ETSCLASS=1:",AB,CD,",1:",IN,PIN,")  ;Term Types to search
  1.  S ^TMP(ETSSUB,$J,ETSVUID,"VUID")=0  ;Number of records found
  1.  ;
  1.  ;
  1.  ;Step A -- Get initial RXCUI list from VUID
  1.  S ETSCNT=$$VUI2RXN^ETSRXN(ETSVUID,"","ETSSTEP A") I ETSCNT<1 Q ETSCNT
  1.  ;
  1.  ;Weed out suppressed records
  1.  S ETSCTR="" F  S ETSCTR=$O(^TMP("ETSSTEP A",$J,ETSCTR)) Q:'ETSCTR  D
  1.  .S ETSSUPP=$P($G(^TMP("ETSSTEP A",$J,ETSCTR,0)),U,6)
  1.  .I ETSSUPP=""!(ETSSUPP="N") Q
  1.  .S ETSCNT=ETSCNT-1 K ^TMP("ETSSTEP A",$J,ETSCTR)
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 Q ETSCNT
  1.  ;
  1.  ;Step B -- Find "inverse_isa" relationships
  1.  ;S ETSRXCUI="",ETSCNT=0 F  S ETSRXCUI=$O(^TMP("ETSSTEP A",$J,ETSRXCUI)) Q:ETSRXCUI=""  D
  1.  S ETSCNT=0,ETSCTR="" F  S ETSCTR=$O(^TMP("ETSSTEP A",$J,ETSCTR)) Q:'ETSCTR  D
  1.  .S ETSNODE=^TMP("ETSSTEP A",$J,ETSCTR,0),ETSRXCUI=$P(ETSNODE,U,2)  Q:ETSRXCUI=""
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.22,"B",ETSRXCUI,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.22,ETSIEN_",",".03;.04;.05;.06","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.22,"""_ETSIEN_","")"
  1.  ..S ETSRXCU2=@ETSDATA@(.03) Q:ETSRXCU2=""
  1.  ..S ETSRELA=@ETSDATA@(.04)
  1.  ..S ETSSAB=@ETSDATA@(.05)
  1.  ..S ETSSUPP=@ETSDATA@(.06)
  1.  ..I ETSRELA'="inverse_isa" Q
  1.  ..I ETSSAB'="RXNORM" Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP B",$J,ETSRXCU2)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step C -- Find "ingredient_of" relationships, using RXCUI2 from the last list as RXCUI1 lookup for this one
  1.  S ETSRXCU1="",ETSCNT=0 F  S ETSRXCU1=$O(^TMP("ETSSTEP B",$J,ETSRXCU1)) Q:ETSRXCU1=""  D
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.22,"B",ETSRXCU1,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.22,ETSIEN_",",".03;.04;.05;.06","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.22,"""_ETSIEN_","")"
  1.  ..S ETSRXCU2=@ETSDATA@(.03) Q:ETSRXCU2=""
  1.  ..S ETSRELA=@ETSDATA@(.04)
  1.  ..S ETSSAB=@ETSDATA@(.05)
  1.  ..S ETSSUPP=@ETSDATA@(.06)
  1.  ..I ETSRELA'="ingredient_of" Q
  1.  ..I ETSSAB'="RXNORM" Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP C",$J,ETSRXCU2)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step D -- Get simple concept/atom attributes with SAB="ATC", using RXCUI2 from the last list as RXCUI lookup for this one
  1.  S ETSRXCUI="",ETSCNT=0 F  S ETSRXCUI=$O(^TMP("ETSSTEP C",$J,ETSRXCUI)) Q:ETSRXCUI=""  D
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.21,"B",ETSRXCUI,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.21,ETSIEN_",",".02;.03;.05","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.21,"""_ETSIEN_","")"
  1.  ..S ETSSAB=@ETSDATA@(.02)
  1.  ..S ETSSUPP=@ETSDATA@(.03)
  1.  ..S ETSCODE=@ETSDATA@(.05) Q:ETSCODE=""
  1.  ..I ETSSAB'="ATC" Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP D",$J,$E(ETSCODE,1,5))=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step E -- Get drug classes with CODE from the last list's 5-character abbreviation
  1.  S ETSCODE5="",ETSCNT=0 F  S ETSCODE5=$O(^TMP("ETSSTEP D",$J,ETSCODE5)) Q:ETSCODE5=""  D
  1.  .S ETSC="^ETSRXN(129.21,""C"",""IS_DRUG_CLASS"")" F  S ETSC=$Q(@ETSC) Q:$QS(ETSC,3)'="IS_DRUG_CLASS"  D
  1.  ..S ETSIEN=$QS(ETSC,5)
  1.  ..K ETSDATA D GETS^DIQ(129.21,ETSIEN_",",".01;.03;.05","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.21,"""_ETSIEN_","")"
  1.  ..S ETSRXCUI=@ETSDATA@(.01) Q:ETSRXCUI=""
  1.  ..S ETSSUPP=@ETSDATA@(.03)
  1.  ..S ETSCODE=@ETSDATA@(.05)
  1.  ..I ETSCODE'=ETSCODE5 Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP E",$J,ETSRXCUI)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step F -- Retrieve CODEs for these drug classes from concept names/sources file
  1.  S ETSCNT=0,ETSRXCUI="" F  S ETSRXCUI=$O(^TMP("ETSSTEP E",$J,ETSRXCUI)) Q:'ETSRXCUI  D
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.2,"B",ETSRXCUI,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.2,ETSIEN_",",".04;.05","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.2,"""_ETSIEN_","")"
  1.  ..S ETSCODE=@ETSDATA@(.04) Q:ETSCODE=""
  1.  ..S ETSSUPP=@ETSDATA@(.05)
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP F",$J,$E(ETSCODE,1,5))=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step G -- Get simple concept/atom attributes with ATN="ATC_LEVEL" and CODEs beginning with the last list's 5-character abbreviation
  1.  S ETSCODE5="",ETSCNT=0 F  S ETSCODE5=$O(^TMP("ETSSTEP F",$J,ETSCODE5)) Q:ETSCODE5=""  D
  1.  .S ETSC="^ETSRXN(129.21,""C"",""ATC_LEVEL"")" F  S ETSC=$Q(@ETSC) Q:$QS(ETSC,3)'="ATC_LEVEL"  D
  1.  ..S ETSIEN=$QS(ETSC,5)
  1.  ..K ETSDATA D GETS^DIQ(129.21,ETSIEN_",",".01;.03;.05","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.21,"""_ETSIEN_","")"
  1.  ..S ETSRXCUI=@ETSDATA@(.01) Q:ETSRXCUI=""
  1.  ..S ETSSUPP=@ETSDATA@(.03)
  1.  ..S ETSCODE=@ETSDATA@(.05)
  1.  ..I $E(ETSCODE,1,5)'=ETSCODE5 Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP G",$J,ETSRXCUI)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step H -- Retrieve concept names/sources for these drugs with SAB="RXNORM"
  1.  S ETSCNT=0,ETSRXCUI="" F  S ETSRXCUI=$O(^TMP("ETSSTEP G",$J,ETSRXCUI)) Q:'ETSRXCUI  D
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.2,"B",ETSRXCUI,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.2,ETSIEN_",",".02;.05","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.2,"""_ETSIEN_","")"
  1.  ..S ETSSAB=@ETSDATA@(.02)
  1.  ..S ETSSUPP=@ETSDATA@(.05)
  1.  ..I ETSSAB'="RXNORM" Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP H",$J,ETSRXCUI)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step I -- Find "has_ingredient" relationships
  1.  S ETSRXCUI="",ETSCNT=0 F  S ETSRXCUI=$O(^TMP("ETSSTEP H",$J,ETSRXCUI)) Q:ETSRXCUI=""  D
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.22,"B",ETSRXCUI,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.22,ETSIEN_",",".03;.04;.05;.06","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.22,"""_ETSIEN_","")"
  1.  ..S ETSRXCU2=@ETSDATA@(.03) Q:ETSRXCU2=""
  1.  ..S ETSRELA=@ETSDATA@(.04)
  1.  ..S ETSSAB=@ETSDATA@(.05)
  1.  ..S ETSSUPP=@ETSDATA@(.06)
  1.  ..I ETSRELA'="has_ingredient" Q
  1.  ..I ETSSAB'="RXNORM" Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP I",$J,ETSRXCU2)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step J -- Find "isa" relationships, using RXCUI2 from the last list as RXCUI1 lookup for this one
  1.  S ETSRXCU1="",ETSCNT=0 F  S ETSRXCU1=$O(^TMP("ETSSTEP I",$J,ETSRXCU1)) Q:ETSRXCU1=""  D
  1.  .S ETSIEN="" F  S ETSIEN=$O(^ETSRXN(129.22,"B",ETSRXCU1,ETSIEN)) Q:'ETSIEN  D
  1.  ..K ETSDATA D GETS^DIQ(129.22,ETSIEN_",",".03;.04;.05;.06","","ETSDATA")
  1.  ..S ETSDATA="ETSDATA(129.22,"""_ETSIEN_","")"
  1.  ..S ETSRXCU2=@ETSDATA@(.03) Q:ETSRXCU2=""
  1.  ..S ETSRELA=@ETSDATA@(.04)
  1.  ..S ETSSAB=@ETSDATA@(.05)
  1.  ..S ETSSUPP=@ETSDATA@(.06)
  1.  ..I ETSRELA'="isa" Q
  1.  ..I ETSSAB'="RXNORM" Q
  1.  ..I ETSSUPP'="",ETSSUPP'="N" Q
  1.  ..S ETSCNT=ETSCNT+1
  1.  ..S ^TMP("ETSSTEP J",$J,ETSRXCU2)=""
  1.  .Q
  1.  ;
  1.  I ETSCNT=0 D CLEANUP Q ETSCNT
  1.  ;
  1.  ;Step K -- Retrieve concept names/sources for these RXCUIs with SAB="VANDF", using RXCUI2 from the last list as RXCUI lookup for this one
  1.  S ETSRES=0,ETSRXCUI="",ETSERR=0 F  S ETSRXCUI=$O(^TMP("ETSSTEP J",$J,ETSRXCUI)) Q:ETSRXCUI=""!ETSERR  D
  1.  .S ETSCNT=$$RXN2OUT^ETSRXN(ETSRXCUI,"ETSSTEP K") I ETSCNT<0 S ETSERR=1 Q
  1.  .I +ETSCNT=0 Q
  1.  .D FILTER
  1.  .Q
  1.  ;
  1.  S ^TMP(ETSSUB,$J,ETSVUID,"VUID")=ETSRES
  1.  ;
  1.  I ETSERR K ^TMP(ETSSUB,$J)
  1.  ;
  1.  D CLEANUP Q ETSRES
  1.  ;
  1.  ;
  1. FILTER ;Weed out suppressed records and filter by TTY
  1.  S ETSCTR="" F  S ETSCTR=$O(^TMP("ETSSTEP K",$J,ETSRXCUI,"VUID",ETSCTR)) Q:'ETSCTR  D
  1.  .S ETSNODE=^TMP("ETSSTEP K",$J,ETSRXCUI,"VUID",ETSCTR,0)
  1.  .S ETSTTY=$P(ETSNODE,U,4)
  1.  .S ETSSUPP=$P(ETSNODE,U,6)
  1.  .I ETSTTYS'[(","_ETSTTY_",") Q
  1.  .I ETSSUPP'="",ETSSUPP'="N" Q
  1.  .S ETSRES=ETSRES+1
  1.  .S ^TMP(ETSSUB,$J,ETSVUID,"VUID",ETSRES,0)=ETSNODE
  1.  .S ^TMP(ETSSUB,$J,ETSVUID,"VUID",ETSRES,1)=^TMP("ETSSTEP K",$J,ETSRXCUI,"VUID",ETSCTR,1)
  1.  .I 'ETSCLASS S ^TMP(ETSSUB,$J,ETSVUID,"VUID",ETSRES,2)=$$GET1^DIQ(129.2,$P(ETSNODE,U)_",",91)
  1.  .Q
  1.  Q
  1.  ;
  1. CLEANUP ;Kill intermediate globals
  1.  F ETSCTR="ETSSTEP A","ETSSTEP B","ETSSTEP C","ETSSTEP D","ETSSTEP E","ETSSTEP F","ETSSTEP G","ETSSTEP H","ETSSTEP I","ETSSTEP J","ETSSTEP K" K ^TMP(ETSCTR,$J)
  1.  Q