ETSRXN1 ;O-OIFO/FM23 - RxNorm APIs 2 ;03/06/2017
;;1.0;Enterprise Terminology Service;**1**;Mar 20, 2017;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
VUI2RXN(ETSVUID,ETSTTY,ETSSUB) ;Extract RxNorm Concept Numbers and other data for a given VA Unique ID
; Input -- ETSVUID VA Unique ID (VUID) (Required)
; ETSTTY Term Type Lookup (Optional)
; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSRXN)
; Output --
; $$VUI2RXN - # records found or -1^<error message>
;
; ^TMP(ETSSUB,$J,RXCUI Count, Results in the following subscripts:
; 0) = IEN^RXCUI (#.01)^Source (SAB) (#.02)^Term_Type (TTY) (#.03)^Code (#.04)^Suppression_Flag (SUPPRESS) (#.05)
; 1) = Text (STR) (#1)
;
N ETSCIEN,ETSCNT,ETSDATA,ETSRXCUI,ETSSTR,ETSSUPP
;
;Check for missing variable, exit if not defined
I $G(ETSVUID)="" Q "-1^VUID missing"
;
;Initialize looping
S ETSCIEN="",ETSCNT=0
;
;Set the default for the subscript if not sent
S:$G(ETSSUB)="" ETSSUB="ETSRXN"
;
;Clear previous search to prevent result contamination
K ^TMP(ETSSUB,$J)
;
;If no Term Type specified, loop through all Term Types
I $G(ETSTTY)="" S ETSTTY="" D Q ETSCNT
.F S ETSTTY=$O(^ETSRXN(129.2,"C","VANDF",ETSVUID,ETSTTY)) Q:ETSTTY="" D
..F S ETSCIEN=$O(^ETSRXN(129.2,"C","VANDF",ETSVUID,ETSTTY,ETSCIEN)) Q:'ETSCIEN D VUIDATA
.Q
;
;Return data for chosen Term Type
F S ETSCIEN=$O(^ETSRXN(129.2,"C","VANDF",ETSVUID,ETSTTY,ETSCIEN)) Q:'ETSCIEN D VUIDATA
;
;Return record count
Q ETSCNT
;
VUIDATA ;Store data
S ETSCNT=ETSCNT+1
K ETSDATA D GETS^DIQ(129.2,ETSCIEN_",",".01;.05;1","","ETSDATA")
S ETSDATA="ETSDATA(129.2,"""_ETSCIEN_","")"
S ETSRXCUI=@ETSDATA@(.01)
S ETSSUPP=@ETSDATA@(.05)
S ETSSTR=@ETSDATA@(1)
S ^TMP(ETSSUB,$J,ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_"VANDF"_U_ETSTTY_U_ETSVUID_U_ETSSUPP
S ^TMP(ETSSUB,$J,ETSCNT,1)=ETSSTR
Q
;
NDC2RXN(ETSNDC,ETSSUB) ;Extract RxNorm Simple Concept Numbers and other data for a given National Drug Code
; Input -- ETSNDC National Drug Code (NDC) (Required)
; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSNDC)
; Output --
; $$NDC2RXN - # records found or -1^<error message>
;
; ^TMP(ETSSUB,$J,RXCUI Count,0) = IEN^RXCUI (#.01)^Source (SAB) (#.02)^Suppression_Flag (SUPPRESS) (#.03)
;
N ETS1,ETS2,ETS3
N ETSCIEN,ETSCNT,ETSDATA,ETSERR,ETSRXCUI,ETSSRC,ETSSUPP
;
;Check for missing variable, exit if not defined
I $G(ETSNDC)="" Q "-1^NDC missing"
;
;Validate NDC input
S ETSERR=""
I ETSNDC["-" D I +ETSERR Q ETSERR
.I ETSNDC'?.6N1"-".4N1"-".2N S ETSERR="-1^Invalid NDC format" Q
.S ETS1=$P(ETSNDC,"-"),ETS2=$P(ETSNDC,"-",2),ETS3=$P(ETSNDC,"-",3)
.S ETSNDC=$E("00000",1,5-$L(ETS1))_ETS1_$E("0000",1,4-$L(ETS2))_ETS2_$E("00",1,2-$L(ETS3))_ETS3
.Q
;
I ETSNDC'?11.12N Q "-1^Invalid NDC format"
;
;Initialize looping
S ETSCIEN="",ETSCNT=0
;
;Set the default for the subscript if not sent
S:$G(ETSSUB)="" ETSSUB="ETSNDC"
;
;Clear previous search to prevent result contamination
K ^TMP(ETSSUB,$J)
;
;Store data for chosen NDC Code
NDCDATA F S ETSCIEN=$O(^ETSRXN(129.21,"C","NDC",ETSNDC,ETSCIEN)) Q:'ETSCIEN D
.S ETSCNT=ETSCNT+1
.K ETSDATA D GETS^DIQ(129.21,ETSCIEN_",",".01;.02;.03","","ETSDATA")
.S ETSDATA="ETSDATA(129.21,"""_ETSCIEN_","")"
.S ETSRXCUI=@ETSDATA@(.01)
.S ETSSRC=@ETSDATA@(.02)
.S ETSSUPP=@ETSDATA@(.03)
.S ^TMP(ETSSUB,$J,ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSSRC_U_ETSSUPP
.Q
;
;Return record count
Q ETSCNT
;
RXN2OUT(ETSRXCUI,ETSSUB) ;Extract VUID and NDC for a given RxNorm Concept Unique ID (RXCUI)
; Input -- ETSRXCUI RxNorm Concept Unique ID (RXCUI) (Required)
; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSOUT)
; Output --
; $$RXN2OUT - # VUIDs^# NDCs found or -1^<error message>
;
; ^TMP(ETSSUB,$J,RXCUI, Results in the following subscripts:
; "VUID") = Count
; "VUID",VUID Count,0) = IEN^RXCUI (129.2,#.01)^Source (SAB) (#.02)^Term_Type (TTY) (#.03)^Code (#.04)^Suppression_Flag (SUPPRESS) (#.05)
; 1) = Text (STR) (#1)
; "NDC") = Count
; "NDC",NDC Count,0) = IEN^RXCUI (129.21,#.01)^Code (#.05)^Source (SAB) (#.02)^Suppression_Flag (SUPPRESS) (#.03)
; "NDC",NDC Count,1) = Attribute Name (ATN) (129.21,#1)
; "NDC",NDC Count,2) = Attribute Value (ATV) (129.21,#2)
;
N ETSATN,ETSCIEN,ETSCODE,ETSDATA,ETSNCNT,ETSNDC,ETSSRC,ETSSTR,ETSSUPP,ETSTTY,ETSVCNT,ETSVUID
;
;Check for missing variable, exit if not defined
I $G(ETSRXCUI)="" Q "-1^RXCUI missing"
;
;Set the default for the subscript if not sent
S:$G(ETSSUB)="" ETSSUB="ETSOUT"
;
;Clear previous search to prevent result contamination
K ^TMP(ETSSUB,$J)
;
;Store VUID data
;Initialize looping
S ETSCIEN="",ETSVCNT=0
;
F S ETSCIEN=$O(^ETSRXN(129.2,"B",ETSRXCUI,ETSCIEN)) Q:'ETSCIEN I $$GET1^DIQ(129.2,ETSCIEN_",",.02)="VANDF" D
.S ETSVCNT=ETSVCNT+1
.K ETSDATA D GETS^DIQ(129.2,ETSCIEN_",",".04;.03;.05;1","","ETSDATA")
.S ETSDATA="ETSDATA(129.2,"""_ETSCIEN_","")"
.S ETSTTY=@ETSDATA@(.03)
.S ETSVUID=@ETSDATA@(.04)
.S ETSSUPP=@ETSDATA@(.05)
.S ETSSTR=@ETSDATA@(1)
.S ^TMP(ETSSUB,$J,ETSRXCUI,"VUID",ETSVCNT,0)=ETSCIEN_U_ETSRXCUI_U_"VANDF"_U_ETSTTY_U_ETSVUID_U_ETSSUPP
.S ^TMP(ETSSUB,$J,ETSRXCUI,"VUID",ETSVCNT,1)=ETSSTR
.Q
;
S ^TMP(ETSSUB,$J,ETSRXCUI,"VUID")=ETSVCNT
;
;Store NDC data
;Initialize looping
S ETSCIEN="",ETSNCNT=0
;
F S ETSCIEN=$O(^ETSRXN(129.21,"B",ETSRXCUI,ETSCIEN)) Q:'ETSCIEN I $$GET1^DIQ(129.21,ETSCIEN_",",1)="NDC" D
.S ETSNCNT=ETSNCNT+1
.K ETSDATA D GETS^DIQ(129.21,ETSCIEN_",",".05;.02;.03;1;2","","ETSDATA")
.S ETSDATA="ETSDATA(129.21,"""_ETSCIEN_","")"
.S ETSCODE=@ETSDATA@(.05)
.S ETSSRC=@ETSDATA@(.02)
.S ETSSUPP=@ETSDATA@(.03)
.S ETSATN=@ETSDATA@(1)
.S ETSNDC=@ETSDATA@(2)
.S ^TMP(ETSSUB,$J,ETSRXCUI,"NDC",ETSNCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSCODE_U_ETSSRC_U_ETSSUPP
.S ^TMP(ETSSUB,$J,ETSRXCUI,"NDC",ETSNCNT,1)=ETSATN
.S ^TMP(ETSSUB,$J,ETSRXCUI,"NDC",ETSNCNT,2)=ETSNDC
.Q
;
S ^TMP(ETSSUB,$J,ETSRXCUI,"NDC")=ETSNCNT
;
;Return record counts
Q ETSVCNT_U_ETSNCNT
;
GETDATA(ETSRXCUI,ETSSUB) ;Extract all data related to a given RxNorm Concept Unique ID (RXCUI)
; Input -- ETSRXCUI RxNorm Concept Unique ID (RXCUI) (Required)
; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSDATA)
; Output --
; $$RXN2OUT - 1 if records found; 0 if no records found; or -1^<error message>
;
; ^TMP(ETSSUB,$J,RXCUI, Results in the following subscripts:
; "RXCONSO") = RXNORM CONCEPTS NAMES AND SOURCES (File #129.2) Count
; "RXCONSO",RXCONSO Count,0) = IEN^RXCUI (#.01)^Source (SAB) (#.02)^Term_Type (TTY) (#.03)^Code (#.04)^Suppression_Flag (SUPPRESS) (#.05)^Content_View_Flag (CVF) (#.06)
; 1) = Text (STR) (#1)
;
; "RXNSAT") = RXNORM SIMPLE CONCEPT AND ATOM ATTRIBUTES (File #129.21) Count
; "RXNSAT",RXNSAT Count,0) = IEN^RXCUI (#.01)^Code (#.05)^Source (SAB) (#.02)^Suppression_Flag (SUPPRESS) (#.03)^Content_View_Flag (CVF) (#.04)
; "RXNSAT",RXNSAT Count,1) = Attribute Name (ATN) (#1)
; "RXNSAT",RXNSAT Count,2) = Attribute Value (ATV) (#2)
;
; "RXNREL") = RXNORM RELATED CONCEPTS (File #129.22) Count
; "RXNREL",RXNREL Count,0) = IEN^RXCUI (RXCUI1) (#.01)^Relationship (REL) (#.02)^RXCUI2 (#.03)^Secondary Relationship (RELA) (#.04)^Source (SAB) (#.05)^Suppression_Flag (SUPPRESS) (#.06)^Content_View_Flag (CVF) (#.07)
;
; "RXNSTY") = RXNORM SEMANTIC TYPES (File #129.23) Count
; "RXNSTY",RXNSTY Count,0) = IEN^RXCUI (#.01)^Semantic_Type (STY) (#.02)^Content_View_Flag (CVF) (#.03)
;
N ETSATN,ETSATV,ETSCIEN,ETSCNT,ETSCODE,ETSCVF,ETSDATA,ETSI,ETSREL,ETSRELA,ETSRXN2,ETSSRC,ETSSTR,ETSSTY,ETSSUPP,ETSTTY
;
;Check for missing variable, exit if not defined
I $G(ETSRXCUI)="" Q "-1^RXCUI missing"
;
;Set the default for the subscript if not sent
S:$G(ETSSUB)="" ETSSUB="ETSDATA"
;
;Clear previous search to prevent result contamination
K ^TMP(ETSSUB,$J)
;
;Store RXCONSO data
;Initialize looping
S ETSCIEN="",ETSCNT=0
;
F S ETSCIEN=$O(^ETSRXN(129.2,"B",ETSRXCUI,ETSCIEN)) Q:'ETSCIEN D
.S ETSCNT=ETSCNT+1
.K ETSDATA D GETS^DIQ(129.2,ETSCIEN_",","**","","ETSDATA")
.S ETSDATA="ETSDATA(129.2,"""_ETSCIEN_","")"
.S ETSSRC=@ETSDATA@(.02)
.S ETSTTY=@ETSDATA@(.03)
.S ETSCODE=@ETSDATA@(.04)
.S ETSSUPP=@ETSDATA@(.05)
.S ETSCVF=@ETSDATA@(.06)
.S ETSSTR=@ETSDATA@(1)
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXCONSO",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSSRC_U_ETSTTY_U_ETSCODE_U_ETSSUPP_U_ETSCVF
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXCONSO",ETSCNT,1)=ETSSTR
.Q
;
S ^TMP(ETSSUB,$J,ETSRXCUI,"RXCONSO")=ETSCNT
;
;Store RXNSAT data
;Initialize looping
S ETSCIEN="",ETSCNT=0
;
F S ETSCIEN=$O(^ETSRXN(129.21,"B",ETSRXCUI,ETSCIEN)) Q:'ETSCIEN D
.S ETSCNT=ETSCNT+1
.K ETSDATA D GETS^DIQ(129.21,ETSCIEN_",","**","","ETSDATA")
.S ETSDATA="ETSDATA(129.21,"""_ETSCIEN_","")"
.S ETSCODE=@ETSDATA@(.05)
.S ETSSRC=@ETSDATA@(.02)
.S ETSSUPP=@ETSDATA@(.03)
.S ETSCVF=@ETSDATA@(.04)
.S ETSATN=@ETSDATA@(1)
.S ETSATV=@ETSDATA@(2)
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNSAT",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSCODE_U_ETSSRC_U_ETSSUPP_U_ETSCVF
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNSAT",ETSCNT,1)=ETSATN
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNSAT",ETSCNT,2)=ETSATV
.Q
;
S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNSAT")=ETSCNT
;
;Store RXNREL data
;Initialize looping
S ETSCIEN="",ETSCNT=0
;
F S ETSCIEN=$O(^ETSRXN(129.22,"B",ETSRXCUI,ETSCIEN)) Q:'ETSCIEN D
.S ETSCNT=ETSCNT+1
.K ETSDATA D GETS^DIQ(129.22,ETSCIEN_",","**","","ETSDATA")
.S ETSDATA="ETSDATA(129.22,"""_ETSCIEN_","")"
.S ETSREL=@ETSDATA@(.02)
.S ETSRXN2=@ETSDATA@(.03)
.S ETSRELA=@ETSDATA@(.04)
.S ETSSRC=@ETSDATA@(.05)
.S ETSSUPP=@ETSDATA@(.06)
.S ETSCVF=@ETSDATA@(.07)
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNREL",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSREL_U_ETSRXN2_U_ETSRELA_U_ETSSRC_U_ETSSUPP_U_ETSCVF
.Q
;
S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNREL")=ETSCNT
;
;Store RXNSTY data
;Initialize looping
S ETSCIEN="",ETSCNT=0
;
F S ETSCIEN=$O(^ETSRXN(129.23,"B",ETSRXCUI,ETSCIEN)) Q:'ETSCIEN D
.S ETSCNT=ETSCNT+1
.K ETSDATA D GETS^DIQ(129.23,ETSCIEN_",","**","","ETSDATA")
.S ETSDATA="ETSDATA(129.23,"""_ETSCIEN_","")"
.S ETSSTY=@ETSDATA@(.02)
.S ETSCVF=@ETSDATA@(.03)
.S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNSTY",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSSTY_U_ETSCVF
.Q
;
S ^TMP(ETSSUB,$J,ETSRXCUI,"RXNSTY")=ETSCNT
;
;Return results
S ETSCNT=0 F ETSI="RXCONSO","RXNSAT","RXNREL","RXNSTY" S ETSCNT=ETSCNT+^TMP(ETSSUB,$J,ETSRXCUI,ETSI)
I ETSCNT Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSRXN1 11305 printed Nov 22, 2024@17:04:14 Page 2
ETSRXN1 ;O-OIFO/FM23 - RxNorm APIs 2 ;03/06/2017
+1 ;;1.0;Enterprise Terminology Service;**1**;Mar 20, 2017;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
VUI2RXN(ETSVUID,ETSTTY,ETSSUB) ;Extract RxNorm Concept Numbers and other data for a given VA Unique ID
+1 ; Input -- ETSVUID VA Unique ID (VUID) (Required)
+2 ; ETSTTY Term Type Lookup (Optional)
+3 ; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSRXN)
+4 ; Output --
+5 ; $$VUI2RXN - # records found or -1^<error message>
+6 ;
+7 ; ^TMP(ETSSUB,$J,RXCUI Count, Results in the following subscripts:
+8 ; 0) = IEN^RXCUI (#.01)^Source (SAB) (#.02)^Term_Type (TTY) (#.03)^Code (#.04)^Suppression_Flag (SUPPRESS) (#.05)
+9 ; 1) = Text (STR) (#1)
+10 ;
+11 NEW ETSCIEN,ETSCNT,ETSDATA,ETSRXCUI,ETSSTR,ETSSUPP
+12 ;
+13 ;Check for missing variable, exit if not defined
+14 IF $GET(ETSVUID)=""
QUIT "-1^VUID missing"
+15 ;
+16 ;Initialize looping
+17 SET ETSCIEN=""
SET ETSCNT=0
+18 ;
+19 ;Set the default for the subscript if not sent
+20 if $GET(ETSSUB)=""
SET ETSSUB="ETSRXN"
+21 ;
+22 ;Clear previous search to prevent result contamination
+23 KILL ^TMP(ETSSUB,$JOB)
+24 ;
+25 ;If no Term Type specified, loop through all Term Types
+26 IF $GET(ETSTTY)=""
SET ETSTTY=""
Begin DoDot:1
+27 FOR
SET ETSTTY=$ORDER(^ETSRXN(129.2,"C","VANDF",ETSVUID,ETSTTY))
if ETSTTY=""
QUIT
Begin DoDot:2
+28 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.2,"C","VANDF",ETSVUID,ETSTTY,ETSCIEN))
if 'ETSCIEN
QUIT
DO VUIDATA
End DoDot:2
+29 QUIT
End DoDot:1
QUIT ETSCNT
+30 ;
+31 ;Return data for chosen Term Type
+32 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.2,"C","VANDF",ETSVUID,ETSTTY,ETSCIEN))
if 'ETSCIEN
QUIT
DO VUIDATA
+33 ;
+34 ;Return record count
+35 QUIT ETSCNT
+36 ;
VUIDATA ;Store data
+1 SET ETSCNT=ETSCNT+1
+2 KILL ETSDATA
DO GETS^DIQ(129.2,ETSCIEN_",",".01;.05;1","","ETSDATA")
+3 SET ETSDATA="ETSDATA(129.2,"""_ETSCIEN_","")"
+4 SET ETSRXCUI=@ETSDATA@(.01)
+5 SET ETSSUPP=@ETSDATA@(.05)
+6 SET ETSSTR=@ETSDATA@(1)
+7 SET ^TMP(ETSSUB,$JOB,ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_"VANDF"_U_ETSTTY_U_ETSVUID_U_ETSSUPP
+8 SET ^TMP(ETSSUB,$JOB,ETSCNT,1)=ETSSTR
+9 QUIT
+10 ;
NDC2RXN(ETSNDC,ETSSUB) ;Extract RxNorm Simple Concept Numbers and other data for a given National Drug Code
+1 ; Input -- ETSNDC National Drug Code (NDC) (Required)
+2 ; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSNDC)
+3 ; Output --
+4 ; $$NDC2RXN - # records found or -1^<error message>
+5 ;
+6 ; ^TMP(ETSSUB,$J,RXCUI Count,0) = IEN^RXCUI (#.01)^Source (SAB) (#.02)^Suppression_Flag (SUPPRESS) (#.03)
+7 ;
+8 NEW ETS1,ETS2,ETS3
+9 NEW ETSCIEN,ETSCNT,ETSDATA,ETSERR,ETSRXCUI,ETSSRC,ETSSUPP
+10 ;
+11 ;Check for missing variable, exit if not defined
+12 IF $GET(ETSNDC)=""
QUIT "-1^NDC missing"
+13 ;
+14 ;Validate NDC input
+15 SET ETSERR=""
+16 IF ETSNDC["-"
Begin DoDot:1
+17 IF ETSNDC'?.6N1"-".4N1"-".2N
SET ETSERR="-1^Invalid NDC format"
QUIT
+18 SET ETS1=$PIECE(ETSNDC,"-")
SET ETS2=$PIECE(ETSNDC,"-",2)
SET ETS3=$PIECE(ETSNDC,"-",3)
+19 SET ETSNDC=$EXTRACT("00000",1,5-$LENGTH(ETS1))_ETS1_$EXTRACT("0000",1,4-$LENGTH(ETS2))_ETS2_$EXTRACT("00",1,2-$LENGTH(ETS3))_ETS3
+20 QUIT
End DoDot:1
IF +ETSERR
QUIT ETSERR
+21 ;
+22 IF ETSNDC'?11.12N
QUIT "-1^Invalid NDC format"
+23 ;
+24 ;Initialize looping
+25 SET ETSCIEN=""
SET ETSCNT=0
+26 ;
+27 ;Set the default for the subscript if not sent
+28 if $GET(ETSSUB)=""
SET ETSSUB="ETSNDC"
+29 ;
+30 ;Clear previous search to prevent result contamination
+31 KILL ^TMP(ETSSUB,$JOB)
+32 ;
+33 ;Store data for chosen NDC Code
NDCDATA FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.21,"C","NDC",ETSNDC,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+1 SET ETSCNT=ETSCNT+1
+2 KILL ETSDATA
DO GETS^DIQ(129.21,ETSCIEN_",",".01;.02;.03","","ETSDATA")
+3 SET ETSDATA="ETSDATA(129.21,"""_ETSCIEN_","")"
+4 SET ETSRXCUI=@ETSDATA@(.01)
+5 SET ETSSRC=@ETSDATA@(.02)
+6 SET ETSSUPP=@ETSDATA@(.03)
+7 SET ^TMP(ETSSUB,$JOB,ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSSRC_U_ETSSUPP
+8 QUIT
End DoDot:1
+9 ;
+10 ;Return record count
+11 QUIT ETSCNT
+12 ;
RXN2OUT(ETSRXCUI,ETSSUB) ;Extract VUID and NDC for a given RxNorm Concept Unique ID (RXCUI)
+1 ; Input -- ETSRXCUI RxNorm Concept Unique ID (RXCUI) (Required)
+2 ; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSOUT)
+3 ; Output --
+4 ; $$RXN2OUT - # VUIDs^# NDCs found or -1^<error message>
+5 ;
+6 ; ^TMP(ETSSUB,$J,RXCUI, Results in the following subscripts:
+7 ; "VUID") = Count
+8 ; "VUID",VUID Count,0) = IEN^RXCUI (129.2,#.01)^Source (SAB) (#.02)^Term_Type (TTY) (#.03)^Code (#.04)^Suppression_Flag (SUPPRESS) (#.05)
+9 ; 1) = Text (STR) (#1)
+10 ; "NDC") = Count
+11 ; "NDC",NDC Count,0) = IEN^RXCUI (129.21,#.01)^Code (#.05)^Source (SAB) (#.02)^Suppression_Flag (SUPPRESS) (#.03)
+12 ; "NDC",NDC Count,1) = Attribute Name (ATN) (129.21,#1)
+13 ; "NDC",NDC Count,2) = Attribute Value (ATV) (129.21,#2)
+14 ;
+15 NEW ETSATN,ETSCIEN,ETSCODE,ETSDATA,ETSNCNT,ETSNDC,ETSSRC,ETSSTR,ETSSUPP,ETSTTY,ETSVCNT,ETSVUID
+16 ;
+17 ;Check for missing variable, exit if not defined
+18 IF $GET(ETSRXCUI)=""
QUIT "-1^RXCUI missing"
+19 ;
+20 ;Set the default for the subscript if not sent
+21 if $GET(ETSSUB)=""
SET ETSSUB="ETSOUT"
+22 ;
+23 ;Clear previous search to prevent result contamination
+24 KILL ^TMP(ETSSUB,$JOB)
+25 ;
+26 ;Store VUID data
+27 ;Initialize looping
+28 SET ETSCIEN=""
SET ETSVCNT=0
+29 ;
+30 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.2,"B",ETSRXCUI,ETSCIEN))
if 'ETSCIEN
QUIT
IF $$GET1^DIQ(129.2,ETSCIEN_",",.02)="VANDF"
Begin DoDot:1
+31 SET ETSVCNT=ETSVCNT+1
+32 KILL ETSDATA
DO GETS^DIQ(129.2,ETSCIEN_",",".04;.03;.05;1","","ETSDATA")
+33 SET ETSDATA="ETSDATA(129.2,"""_ETSCIEN_","")"
+34 SET ETSTTY=@ETSDATA@(.03)
+35 SET ETSVUID=@ETSDATA@(.04)
+36 SET ETSSUPP=@ETSDATA@(.05)
+37 SET ETSSTR=@ETSDATA@(1)
+38 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"VUID",ETSVCNT,0)=ETSCIEN_U_ETSRXCUI_U_"VANDF"_U_ETSTTY_U_ETSVUID_U_ETSSUPP
+39 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"VUID",ETSVCNT,1)=ETSSTR
+40 QUIT
End DoDot:1
+41 ;
+42 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"VUID")=ETSVCNT
+43 ;
+44 ;Store NDC data
+45 ;Initialize looping
+46 SET ETSCIEN=""
SET ETSNCNT=0
+47 ;
+48 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.21,"B",ETSRXCUI,ETSCIEN))
if 'ETSCIEN
QUIT
IF $$GET1^DIQ(129.21,ETSCIEN_",",1)="NDC"
Begin DoDot:1
+49 SET ETSNCNT=ETSNCNT+1
+50 KILL ETSDATA
DO GETS^DIQ(129.21,ETSCIEN_",",".05;.02;.03;1;2","","ETSDATA")
+51 SET ETSDATA="ETSDATA(129.21,"""_ETSCIEN_","")"
+52 SET ETSCODE=@ETSDATA@(.05)
+53 SET ETSSRC=@ETSDATA@(.02)
+54 SET ETSSUPP=@ETSDATA@(.03)
+55 SET ETSATN=@ETSDATA@(1)
+56 SET ETSNDC=@ETSDATA@(2)
+57 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"NDC",ETSNCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSCODE_U_ETSSRC_U_ETSSUPP
+58 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"NDC",ETSNCNT,1)=ETSATN
+59 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"NDC",ETSNCNT,2)=ETSNDC
+60 QUIT
End DoDot:1
+61 ;
+62 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"NDC")=ETSNCNT
+63 ;
+64 ;Return record counts
+65 QUIT ETSVCNT_U_ETSNCNT
+66 ;
GETDATA(ETSRXCUI,ETSSUB) ;Extract all data related to a given RxNorm Concept Unique ID (RXCUI)
+1 ; Input -- ETSRXCUI RxNorm Concept Unique ID (RXCUI) (Required)
+2 ; ETSSUB (Optional) Subscript for ^TMP array storing the results (default = ETSDATA)
+3 ; Output --
+4 ; $$RXN2OUT - 1 if records found; 0 if no records found; or -1^<error message>
+5 ;
+6 ; ^TMP(ETSSUB,$J,RXCUI, Results in the following subscripts:
+7 ; "RXCONSO") = RXNORM CONCEPTS NAMES AND SOURCES (File #129.2) Count
+8 ; "RXCONSO",RXCONSO Count,0) = IEN^RXCUI (#.01)^Source (SAB) (#.02)^Term_Type (TTY) (#.03)^Code (#.04)^Suppression_Flag (SUPPRESS) (#.05)^Content_View_Flag (CVF) (#.06)
+9 ; 1) = Text (STR) (#1)
+10 ;
+11 ; "RXNSAT") = RXNORM SIMPLE CONCEPT AND ATOM ATTRIBUTES (File #129.21) Count
+12 ; "RXNSAT",RXNSAT Count,0) = IEN^RXCUI (#.01)^Code (#.05)^Source (SAB) (#.02)^Suppression_Flag (SUPPRESS) (#.03)^Content_View_Flag (CVF) (#.04)
+13 ; "RXNSAT",RXNSAT Count,1) = Attribute Name (ATN) (#1)
+14 ; "RXNSAT",RXNSAT Count,2) = Attribute Value (ATV) (#2)
+15 ;
+16 ; "RXNREL") = RXNORM RELATED CONCEPTS (File #129.22) Count
+17 ; "RXNREL",RXNREL Count,0) = IEN^RXCUI (RXCUI1) (#.01)^Relationship (REL) (#.02)^RXCUI2 (#.03)^Secondary Relationship (RELA) (#.04)^Source (SAB) (#.05)^Suppression_Flag (SUPPRESS) (#.06)^Content_View_Flag (CVF) (#.07)
+18 ;
+19 ; "RXNSTY") = RXNORM SEMANTIC TYPES (File #129.23) Count
+20 ; "RXNSTY",RXNSTY Count,0) = IEN^RXCUI (#.01)^Semantic_Type (STY) (#.02)^Content_View_Flag (CVF) (#.03)
+21 ;
+22 NEW ETSATN,ETSATV,ETSCIEN,ETSCNT,ETSCODE,ETSCVF,ETSDATA,ETSI,ETSREL,ETSRELA,ETSRXN2,ETSSRC,ETSSTR,ETSSTY,ETSSUPP,ETSTTY
+23 ;
+24 ;Check for missing variable, exit if not defined
+25 IF $GET(ETSRXCUI)=""
QUIT "-1^RXCUI missing"
+26 ;
+27 ;Set the default for the subscript if not sent
+28 if $GET(ETSSUB)=""
SET ETSSUB="ETSDATA"
+29 ;
+30 ;Clear previous search to prevent result contamination
+31 KILL ^TMP(ETSSUB,$JOB)
+32 ;
+33 ;Store RXCONSO data
+34 ;Initialize looping
+35 SET ETSCIEN=""
SET ETSCNT=0
+36 ;
+37 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.2,"B",ETSRXCUI,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+38 SET ETSCNT=ETSCNT+1
+39 KILL ETSDATA
DO GETS^DIQ(129.2,ETSCIEN_",","**","","ETSDATA")
+40 SET ETSDATA="ETSDATA(129.2,"""_ETSCIEN_","")"
+41 SET ETSSRC=@ETSDATA@(.02)
+42 SET ETSTTY=@ETSDATA@(.03)
+43 SET ETSCODE=@ETSDATA@(.04)
+44 SET ETSSUPP=@ETSDATA@(.05)
+45 SET ETSCVF=@ETSDATA@(.06)
+46 SET ETSSTR=@ETSDATA@(1)
+47 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXCONSO",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSSRC_U_ETSTTY_U_ETSCODE_U_ETSSUPP_U_ETSCVF
+48 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXCONSO",ETSCNT,1)=ETSSTR
+49 QUIT
End DoDot:1
+50 ;
+51 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXCONSO")=ETSCNT
+52 ;
+53 ;Store RXNSAT data
+54 ;Initialize looping
+55 SET ETSCIEN=""
SET ETSCNT=0
+56 ;
+57 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.21,"B",ETSRXCUI,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+58 SET ETSCNT=ETSCNT+1
+59 KILL ETSDATA
DO GETS^DIQ(129.21,ETSCIEN_",","**","","ETSDATA")
+60 SET ETSDATA="ETSDATA(129.21,"""_ETSCIEN_","")"
+61 SET ETSCODE=@ETSDATA@(.05)
+62 SET ETSSRC=@ETSDATA@(.02)
+63 SET ETSSUPP=@ETSDATA@(.03)
+64 SET ETSCVF=@ETSDATA@(.04)
+65 SET ETSATN=@ETSDATA@(1)
+66 SET ETSATV=@ETSDATA@(2)
+67 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNSAT",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSCODE_U_ETSSRC_U_ETSSUPP_U_ETSCVF
+68 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNSAT",ETSCNT,1)=ETSATN
+69 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNSAT",ETSCNT,2)=ETSATV
+70 QUIT
End DoDot:1
+71 ;
+72 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNSAT")=ETSCNT
+73 ;
+74 ;Store RXNREL data
+75 ;Initialize looping
+76 SET ETSCIEN=""
SET ETSCNT=0
+77 ;
+78 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.22,"B",ETSRXCUI,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+79 SET ETSCNT=ETSCNT+1
+80 KILL ETSDATA
DO GETS^DIQ(129.22,ETSCIEN_",","**","","ETSDATA")
+81 SET ETSDATA="ETSDATA(129.22,"""_ETSCIEN_","")"
+82 SET ETSREL=@ETSDATA@(.02)
+83 SET ETSRXN2=@ETSDATA@(.03)
+84 SET ETSRELA=@ETSDATA@(.04)
+85 SET ETSSRC=@ETSDATA@(.05)
+86 SET ETSSUPP=@ETSDATA@(.06)
+87 SET ETSCVF=@ETSDATA@(.07)
+88 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNREL",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSREL_U_ETSRXN2_U_ETSRELA_U_ETSSRC_U_ETSSUPP_U_ETSCVF
+89 QUIT
End DoDot:1
+90 ;
+91 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNREL")=ETSCNT
+92 ;
+93 ;Store RXNSTY data
+94 ;Initialize looping
+95 SET ETSCIEN=""
SET ETSCNT=0
+96 ;
+97 FOR
SET ETSCIEN=$ORDER(^ETSRXN(129.23,"B",ETSRXCUI,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+98 SET ETSCNT=ETSCNT+1
+99 KILL ETSDATA
DO GETS^DIQ(129.23,ETSCIEN_",","**","","ETSDATA")
+100 SET ETSDATA="ETSDATA(129.23,"""_ETSCIEN_","")"
+101 SET ETSSTY=@ETSDATA@(.02)
+102 SET ETSCVF=@ETSDATA@(.03)
+103 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNSTY",ETSCNT,0)=ETSCIEN_U_ETSRXCUI_U_ETSSTY_U_ETSCVF
+104 QUIT
End DoDot:1
+105 ;
+106 SET ^TMP(ETSSUB,$JOB,ETSRXCUI,"RXNSTY")=ETSCNT
+107 ;
+108 ;Return results
+109 SET ETSCNT=0
FOR ETSI="RXCONSO","RXNSAT","RXNREL","RXNSTY"
SET ETSCNT=ETSCNT+^TMP(ETSSUB,$JOB,ETSRXCUI,ETSI)
+110 IF ETSCNT
QUIT 1
+111 QUIT 0
