ETSRXN ;O-OIFO/FM23 - RxNorm APIs ;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
;
HIST(ETSCODE,ETSSYS,ARY) ; Get Activation History for a Code
;
; Input:
;
; ETSCODE RXCUI (required)
; ETSSYS Coding System (required) [hard coded to RXN]
; .ARY Array, passed by Reference (required)
;
; Output:
;
; $$HIST Number of Histories Found
; or
; -1 ^ error message
;
; ARY(0) = Number of Activation History
; ARY(0,0) = IEN ^ "RXN" ^ "RXNORM" ^ IEN (file 129.2)
; ^ TTY (file 129.2, #.03)
; ARY(0,1) = STR (file 129.2, #1)
; ARY(<date>,<status>) = Comment
;
;
N ETSSI,ETSSTAT,ETSDATE,ETSIEN,ETSN
;
;Clear any older data
K ARY
;
;Validate the input
Q:'$G(ETSCODE) "-1^Code missing"
S:$G(ETSSYS)="" ETSSYS="RXN"
Q:ETSSYS'="RXN" "-1^Invalid source"
;
S ETSSI="RXN^RXNORM"
;
; Find the most relevant entry for the RXCUI
; Need to look at TTYs PSN, SCD, SBD, GPACK
; and BPACK in that order of preference for
; the RXNORM source. Entry is also not
; suppressed (129.2,field .05 = "N")
S ETSIEN=$$GETIEN(ETSCODE,1,"")
;
; quit if RXCUI is not defined for any of the preferred TTYs
Q:ETSIEN="" "-1^RXCUI Not Found"
;
;Get the activation date and count
S ETSSTAT=1,ETSN=1
S ETSDATE=$$GET1^DIQ(129.2,ETSIEN_", ",91,"I")
;
Q:ETSDATE="" "-1^Activation Date Not Found"
;
S ARY(ETSDATE,ETSSTAT)="Activated"
;
S ARY(0)=ETSN
S ARY(0,0)=ETSSI_"^"_ETSIEN_"^"
S ARY(0,0)=ARY(0,0)_$$GET1^DIQ(129.2,ETSIEN_", ",.03,"I")
S ARY(0,1)=$$GET1^DIQ(129.2,ETSIEN_", ",1,"I")
Q ETSN
;
GETIEN(ETSRXC,ETSACT,ETSDT) ;
; Input - ETSRXC - RXCUI (required)
; ETSACT - (Optional) Active only (default is 1)
; ETSDT - (Optional) Date to filter on
;
; Output - $$GETIEN - IEN of the most relevant entry
; or NULL
; Find the most relevant entry for the RXCUI
; Need to look at TTYs PSN, SCD, SBD, GPACK
; and BPACK in that order of preference for
; the RXNORM source. Entry is also not
; suppressed (129.2,field .05 = "N")
N ETSIEN,TTY,FLG,ETSFDT
;
S ETSFDT=$G(ETSDT)
S ETSIEN=""
S:$G(ETSACT)="" ETSACT=1
;
; Loop through the VA requested TTYs.
S FLG=0
F TTY="PSN","SCD","SBD","GPACK","BPACK" D Q:FLG
. S ETSIEN=$O(^ETSRXN(129.2,"C","RXNORM",ETSCODE,TTY,""))
. Q:ETSIEN=""
. ;Check the suppress flag
. S FLG=1
. I ETSACT D Q
.. I $$GET1^DIQ(129.2,ETSIEN_", ",.05,"I")'="N" S FLG=0 Q ; RXCUI Suppressed
.. S:'$$ACTFLG(ETSFDT,ETSIEN) FLG=0 ;Date requsted before activation date
. I 'ETSACT D Q
.. S:'$$ACTFLG(ETSFDT,ETSIEN) FLG=0 ;Date requsted before activation date
;
; Return null if Inactive, not found or suppressed
Q:'FLG ""
;
; Return IEN if found and Active
Q ETSIEN
;
ACTFLG(ETSFDT,ETSIEN) ;determine if RXCUI is active
;
; Input: ETSFDT - Date user wishes to check for active status
; ETSIEN - IEN of the requested RXCUI
;
; Output: $$ACTFLG - 1 (Active) or 0 (Date before activation)
;
N ETSADT,ETSFLG
;
S ETSFLG=1 ; Defaut is active
I $G(ETSFDT)'="" D
. S ETSADT=$$GET1^DIQ(129.2,$G(ETSIEN)_", ",91,"I")
. I ETSADT="" S ETSFLG=0 Q
. I ETSFDT<ETSADT S ETSFLG=0 Q
Q ETSFLG
;
PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
;
; Input:
;
; ETSCODE RXCUI (required)
; ETSSYS Coding System (Hardcode to look for RXN, default is RXN)
; .ARY Array, passed by Reference (required)
;
; Output:
;
; $$PERIOD Multiple piece "^" delimited string
;
; 1 Number of Activation Periods found (should only be 1
; 2 TTY
; 3 "RXN"
; 4 "RXNORM"
; 5 "RXNORM"
;
; or
;
; -1^Message (no entries or other error message)
;
; ARY(0) Same as $$PERIOD (above)
;
; ARY(Activation Date) = 4 piece "^" delimited string
;
; 1 Inactivation Date
; (conditional)
;
; 2 not used
;
; 3 Variable Pointer IEN;ETSRXN(129.2,
;
; 4 not used
;
; ARY(Activation Date,0) = STR
;
; Looks through the Activation History to build the information
;
N ETSSD,ETSIEN,ETSADT
;
Q:'$L($G(ETSCODE)) "-1^Missing RXCUI"
S:$G(ETSSYS)="" ETSSYS="RXN"
Q:ETSSYS'="RXN" "-1^Missing/Invalid Coding System"
Q:'$D(ARY) "-1^Return Array Not Defined"
;
; Hardcode the Coding system information for now.
S ETSSD="RXN^RXNORM^RXNORM"
K ARY
;
; Retrieve the IEN for the code
S ETSIEN=$$GETIEN(ETSCODE,1,"")
Q:ETSIEN="" "-1^RXCUI Not Found"
;
S ARY(0)="1"_U_$$GET1^DIQ(129.2,ETSIEN_", ",.03,"I")_U_ETSSD
;
;set the activation date nodes
S ETSADT=$$GET1^DIQ(129.2,ETSIEN_", ",91,"I")
Q:ETSADT="" "-1^Activation Date not found"
;
S ARY(ETSADT)=U_U_ETSIEN_";ETSRXN(129.2"_U
S ARY(ETSADT,0)=$$GET1^DIQ(129.2,ETSIEN_", ",1,"I")
Q ARY(0)
;
CSYS(ETSSYS) ;Retrieve the Coding System Information
; Hardcoded to specifically provide LEXICON users System Information
; Currently hardcoded - ETS does not have a Coding System dictionary
;
; Input
;
; ETSSYS Coding System Abbreviation (757.03,.01)
; or pointer to file 757.03
;
; Output
;
; A 14 piece caret (^) delimited string
;
; 1 Not Used
; 2 SAB (3 character source abbreviation)
; 3 Source Abbreviation (3-7 char)
; 4 Nomenclature (2-11 char)
; 5 Source Title (2-52 char)
; 6 Source (2-50 char)
; 7-11 Not used
; 12 Version Id (1-40 char) [optional]
; 13 Implementation Date (date) [optional]
; 14 Lookup Threshold
;
N ETSDATA
S ETSDATA=""
S:$G(ETSSYS)="" ETSSYS="RXN"
Q:ETSSYS'="RXN" "-1^Invalid Coding System"
S ETSDATA="^RXN^RxNorm^RxNorm^RxNorm^National Library of Medicine"
Q ETSDATA
;
CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
;
; Input:
;
; ETSCODE Classification Code (Required)
; ETSCSYS "RXN" hardcoded for RxNorm
; ETSCDT Code Set Versioning Date in
; FileMan date Format (default = TODAY)
; .ARY Output array passed by reference
;
; Output:
;
; $$CSDATA 1 if successful (in RxNorm Concept Table #129.2)
; 0 if unsuccessful
;
; or
;
; -1 ^ Error Message
;
;
; ARY()
;
;
; Lexicon Data
;
; ARY("LEX",1) IEN ^ STR
; ARY("LEX",2) Status ^ Effective Date
; ARY("LEX",8) Deactivated Concept Flag
;
; RXNORM Data
;
; ARY("RXN",1) Term Type (TTY) ^ Suppression Flag (Suppress) ^ Content View Flag (CVF)
;
; Each data element will be in the following format:
;
; ARY(ID,SUB) = DATA
; ARY(ID,SUB,"N") = NAME of the Data Element
;
; Where
;
; ID Identifier, may be:
;
; "LEX" for Lexicon data
; "RXN" for RXNORM specific data
;
; SUB Numeric Subscript
;
; DATA This may be:
;
; A value if it applies and is found
; Null if it applies but not found
; N/A if it does not apply
;
; NAME This is the common name given to the
; data element
;
N ETSIEN,ETSARY,ETSDATA,ETSX,ETSEFDT,ETSDFLG,ETSSTAT
;
Q:'$L($G(ETSCODE)) "-1^Code missing"
S:$G(ETSCSYS)="" ETSCSYS="RXN"
Q:ETSCSYS'="RXN" "-1^Invalid source"
;
I $G(ETSCDT)="" S ETSCDT=$$DT^XLFDT
; Make sure Date is a valid FileMan Date
Q:+$$CHKDATE(ETSCDT)=-1 "-1^Invalid Date"
;
; Clear array in case older information present
K ARY
;
; Retrieve the IEN for the code
S ETSIEN=$$GETIEN(ETSCODE,1,"")
Q:ETSIEN="" "-1^RXCUI Not Found"
;
;Get the DATA
D GETS^DIQ(129.2,ETSIEN,"**","IE","ETSARY")
;
; Default Activation Status information, Deactivation Flag
S ETSSTAT=1,ETSDFLG=""
;
;Get the Activation Effective Date
S ETSEFDT=ETSARY(129.2,ETSIEN_",",91,"I")
;
; If the activation date is newer than the date requested
; correct the Activation Date and the Deactivated concept flag
S:ETSEFDT>ETSCDT ETSEFDT="",ETSDFLG=1
;
; Lex Node
;
; IEN and the Text of the concept
S ARY("LEX",1)=ETSIEN_U_ETSARY(129.2,ETSIEN_",",1,"E")
S ARY("LEX",1,"N")="IEN ^ Text (STR)"
;
; set the activation status
I ETSEFDT'="" D
. S ARY("LEX",2)=ETSSTAT_U_ETSEFDT
. S ARY("LEX",2,"N")="Status ^ Effective Date"
;
; Status Flag (always active, so always "")
S ARY("LEX",8)=ETSDFLG
S ARY("LEX",8,"N")="Deactivated Concept"
;
; RXN Node
S ARY("RXN",1)=ETSARY(129.2,ETSIEN_",",.03,"I")_U ;TTY
S ARY("RXN",1)=ARY("RXN",1)_ETSARY(129.2,ETSIEN_",",.05,"I") ;SUPPRESS FLAG
S ARY("RXN",1)=ARY("RXN",1)_U_ETSARY(129.2,ETSIEN_",",.06,"I") ;CVF
S ARY("RXN",1,"N")="Term Type (TTY) ^ Suppression Flag (Suppress) ^ Content View Flag (CVF)"
;
Q 1
;
VUICLASS(ETSVUID,ETSSUB) ;Entry point for function $$VUICLASS
;Redirecting to ETSRXNTX for processing
Q $$TAX^ETSRXNTX($G(ETSVUID),$G(ETSSUB),1)
;
TAX(ETSVUID,ETSSUB) ; Taxonomy lookup for Clinical Reminders
;Redirecting to ETSRXNTX for processing
Q $$TAX^ETSRXNTX($G(ETSVUID),$G(ETSSUB),0)
;
CHKDATE(ETSX) ;Check to see if the date is in proper FileMan format
;
N %DT,X,Y,DTOUT
S %DT="X",X=ETSX D ^%DT
S:$G(DTOUT)'="" Y=-1 ;set error condition if timeout occurs
Q Y
;
VUI2RXN(ETSVUID,ETSTTY,ETSSUB) ;Entry point for function $$VUI2RXN
;Redirect to ETSRXN1 where the code resides
Q $$VUI2RXN^ETSRXN1($G(ETSVUID),$G(ETSTTY),$G(ETSSUB))
;
NDC2RXN(ETSNDC,ETSSUB) ;Entry point for function $$NDC2RXN
;Redirect to ETSRXN1 where the code resides
Q $$NDC2RXN^ETSRXN1($G(ETSNDC),$G(ETSSUB))
;
RXN2OUT(ETSRXCUI,ETSSUB) ;Entry point for function $$RXN2OUT
;Redirect to ETSRXN1 where the code resides
Q $$RXN2OUT^ETSRXN1($G(ETSRXCUI),$G(ETSSUB))
;
GETDATA(ETSRXCUI,ETSSUB) ;Entry point for function $$GETDATA
;Redirect to ETSRXN1 where the code resides
Q $$GETDATA^ETSRXN1($G(ETSRXCUI),$G(ETSSUB))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSRXN 10736 printed Dec 13, 2024@01:54:02 Page 2
ETSRXN ;O-OIFO/FM23 - RxNorm APIs ;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 ;
HIST(ETSCODE,ETSSYS,ARY) ; Get Activation History for a Code
+1 ;
+2 ; Input:
+3 ;
+4 ; ETSCODE RXCUI (required)
+5 ; ETSSYS Coding System (required) [hard coded to RXN]
+6 ; .ARY Array, passed by Reference (required)
+7 ;
+8 ; Output:
+9 ;
+10 ; $$HIST Number of Histories Found
+11 ; or
+12 ; -1 ^ error message
+13 ;
+14 ; ARY(0) = Number of Activation History
+15 ; ARY(0,0) = IEN ^ "RXN" ^ "RXNORM" ^ IEN (file 129.2)
+16 ; ^ TTY (file 129.2, #.03)
+17 ; ARY(0,1) = STR (file 129.2, #1)
+18 ; ARY(<date>,<status>) = Comment
+19 ;
+20 ;
+21 NEW ETSSI,ETSSTAT,ETSDATE,ETSIEN,ETSN
+22 ;
+23 ;Clear any older data
+24 KILL ARY
+25 ;
+26 ;Validate the input
+27 if '$GET(ETSCODE)
QUIT "-1^Code missing"
+28 if $GET(ETSSYS)=""
SET ETSSYS="RXN"
+29 if ETSSYS'="RXN"
QUIT "-1^Invalid source"
+30 ;
+31 SET ETSSI="RXN^RXNORM"
+32 ;
+33 ; Find the most relevant entry for the RXCUI
+34 ; Need to look at TTYs PSN, SCD, SBD, GPACK
+35 ; and BPACK in that order of preference for
+36 ; the RXNORM source. Entry is also not
+37 ; suppressed (129.2,field .05 = "N")
+38 SET ETSIEN=$$GETIEN(ETSCODE,1,"")
+39 ;
+40 ; quit if RXCUI is not defined for any of the preferred TTYs
+41 if ETSIEN=""
QUIT "-1^RXCUI Not Found"
+42 ;
+43 ;Get the activation date and count
+44 SET ETSSTAT=1
SET ETSN=1
+45 SET ETSDATE=$$GET1^DIQ(129.2,ETSIEN_", ",91,"I")
+46 ;
+47 if ETSDATE=""
QUIT "-1^Activation Date Not Found"
+48 ;
+49 SET ARY(ETSDATE,ETSSTAT)="Activated"
+50 ;
+51 SET ARY(0)=ETSN
+52 SET ARY(0,0)=ETSSI_"^"_ETSIEN_"^"
+53 SET ARY(0,0)=ARY(0,0)_$$GET1^DIQ(129.2,ETSIEN_", ",.03,"I")
+54 SET ARY(0,1)=$$GET1^DIQ(129.2,ETSIEN_", ",1,"I")
+55 QUIT ETSN
+56 ;
GETIEN(ETSRXC,ETSACT,ETSDT) ;
+1 ; Input - ETSRXC - RXCUI (required)
+2 ; ETSACT - (Optional) Active only (default is 1)
+3 ; ETSDT - (Optional) Date to filter on
+4 ;
+5 ; Output - $$GETIEN - IEN of the most relevant entry
+6 ; or NULL
+7 ; Find the most relevant entry for the RXCUI
+8 ; Need to look at TTYs PSN, SCD, SBD, GPACK
+9 ; and BPACK in that order of preference for
+10 ; the RXNORM source. Entry is also not
+11 ; suppressed (129.2,field .05 = "N")
+12 NEW ETSIEN,TTY,FLG,ETSFDT
+13 ;
+14 SET ETSFDT=$GET(ETSDT)
+15 SET ETSIEN=""
+16 if $GET(ETSACT)=""
SET ETSACT=1
+17 ;
+18 ; Loop through the VA requested TTYs.
+19 SET FLG=0
+20 FOR TTY="PSN","SCD","SBD","GPACK","BPACK"
Begin DoDot:1
+21 SET ETSIEN=$ORDER(^ETSRXN(129.2,"C","RXNORM",ETSCODE,TTY,""))
+22 if ETSIEN=""
QUIT
+23 ;Check the suppress flag
+24 SET FLG=1
+25 IF ETSACT
Begin DoDot:2
+26 ; RXCUI Suppressed
IF $$GET1^DIQ(129.2,ETSIEN_", ",.05,"I")'="N"
SET FLG=0
QUIT
+27 ;Date requsted before activation date
if '$$ACTFLG(ETSFDT,ETSIEN)
SET FLG=0
End DoDot:2
QUIT
+28 IF 'ETSACT
Begin DoDot:2
+29 ;Date requsted before activation date
if '$$ACTFLG(ETSFDT,ETSIEN)
SET FLG=0
End DoDot:2
QUIT
End DoDot:1
if FLG
QUIT
+30 ;
+31 ; Return null if Inactive, not found or suppressed
+32 if 'FLG
QUIT ""
+33 ;
+34 ; Return IEN if found and Active
+35 QUIT ETSIEN
+36 ;
ACTFLG(ETSFDT,ETSIEN) ;determine if RXCUI is active
+1 ;
+2 ; Input: ETSFDT - Date user wishes to check for active status
+3 ; ETSIEN - IEN of the requested RXCUI
+4 ;
+5 ; Output: $$ACTFLG - 1 (Active) or 0 (Date before activation)
+6 ;
+7 NEW ETSADT,ETSFLG
+8 ;
+9 ; Defaut is active
SET ETSFLG=1
+10 IF $GET(ETSFDT)'=""
Begin DoDot:1
+11 SET ETSADT=$$GET1^DIQ(129.2,$GET(ETSIEN)_", ",91,"I")
+12 IF ETSADT=""
SET ETSFLG=0
QUIT
+13 IF ETSFDT<ETSADT
SET ETSFLG=0
QUIT
End DoDot:1
+14 QUIT ETSFLG
+15 ;
PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
+1 ;
+2 ; Input:
+3 ;
+4 ; ETSCODE RXCUI (required)
+5 ; ETSSYS Coding System (Hardcode to look for RXN, default is RXN)
+6 ; .ARY Array, passed by Reference (required)
+7 ;
+8 ; Output:
+9 ;
+10 ; $$PERIOD Multiple piece "^" delimited string
+11 ;
+12 ; 1 Number of Activation Periods found (should only be 1
+13 ; 2 TTY
+14 ; 3 "RXN"
+15 ; 4 "RXNORM"
+16 ; 5 "RXNORM"
+17 ;
+18 ; or
+19 ;
+20 ; -1^Message (no entries or other error message)
+21 ;
+22 ; ARY(0) Same as $$PERIOD (above)
+23 ;
+24 ; ARY(Activation Date) = 4 piece "^" delimited string
+25 ;
+26 ; 1 Inactivation Date
+27 ; (conditional)
+28 ;
+29 ; 2 not used
+30 ;
+31 ; 3 Variable Pointer IEN;ETSRXN(129.2,
+32 ;
+33 ; 4 not used
+34 ;
+35 ; ARY(Activation Date,0) = STR
+36 ;
+37 ; Looks through the Activation History to build the information
+38 ;
+39 NEW ETSSD,ETSIEN,ETSADT
+40 ;
+41 if '$LENGTH($GET(ETSCODE))
QUIT "-1^Missing RXCUI"
+42 if $GET(ETSSYS)=""
SET ETSSYS="RXN"
+43 if ETSSYS'="RXN"
QUIT "-1^Missing/Invalid Coding System"
+44 if '$DATA(ARY)
QUIT "-1^Return Array Not Defined"
+45 ;
+46 ; Hardcode the Coding system information for now.
+47 SET ETSSD="RXN^RXNORM^RXNORM"
+48 KILL ARY
+49 ;
+50 ; Retrieve the IEN for the code
+51 SET ETSIEN=$$GETIEN(ETSCODE,1,"")
+52 if ETSIEN=""
QUIT "-1^RXCUI Not Found"
+53 ;
+54 SET ARY(0)="1"_U_$$GET1^DIQ(129.2,ETSIEN_", ",.03,"I")_U_ETSSD
+55 ;
+56 ;set the activation date nodes
+57 SET ETSADT=$$GET1^DIQ(129.2,ETSIEN_", ",91,"I")
+58 if ETSADT=""
QUIT "-1^Activation Date not found"
+59 ;
+60 SET ARY(ETSADT)=U_U_ETSIEN_";ETSRXN(129.2"_U
+61 SET ARY(ETSADT,0)=$$GET1^DIQ(129.2,ETSIEN_", ",1,"I")
+62 QUIT ARY(0)
+63 ;
CSYS(ETSSYS) ;Retrieve the Coding System Information
+1 ; Hardcoded to specifically provide LEXICON users System Information
+2 ; Currently hardcoded - ETS does not have a Coding System dictionary
+3 ;
+4 ; Input
+5 ;
+6 ; ETSSYS Coding System Abbreviation (757.03,.01)
+7 ; or pointer to file 757.03
+8 ;
+9 ; Output
+10 ;
+11 ; A 14 piece caret (^) delimited string
+12 ;
+13 ; 1 Not Used
+14 ; 2 SAB (3 character source abbreviation)
+15 ; 3 Source Abbreviation (3-7 char)
+16 ; 4 Nomenclature (2-11 char)
+17 ; 5 Source Title (2-52 char)
+18 ; 6 Source (2-50 char)
+19 ; 7-11 Not used
+20 ; 12 Version Id (1-40 char) [optional]
+21 ; 13 Implementation Date (date) [optional]
+22 ; 14 Lookup Threshold
+23 ;
+24 NEW ETSDATA
+25 SET ETSDATA=""
+26 if $GET(ETSSYS)=""
SET ETSSYS="RXN"
+27 if ETSSYS'="RXN"
QUIT "-1^Invalid Coding System"
+28 SET ETSDATA="^RXN^RxNorm^RxNorm^RxNorm^National Library of Medicine"
+29 QUIT ETSDATA
+30 ;
CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
+1 ;
+2 ; Input:
+3 ;
+4 ; ETSCODE Classification Code (Required)
+5 ; ETSCSYS "RXN" hardcoded for RxNorm
+6 ; ETSCDT Code Set Versioning Date in
+7 ; FileMan date Format (default = TODAY)
+8 ; .ARY Output array passed by reference
+9 ;
+10 ; Output:
+11 ;
+12 ; $$CSDATA 1 if successful (in RxNorm Concept Table #129.2)
+13 ; 0 if unsuccessful
+14 ;
+15 ; or
+16 ;
+17 ; -1 ^ Error Message
+18 ;
+19 ;
+20 ; ARY()
+21 ;
+22 ;
+23 ; Lexicon Data
+24 ;
+25 ; ARY("LEX",1) IEN ^ STR
+26 ; ARY("LEX",2) Status ^ Effective Date
+27 ; ARY("LEX",8) Deactivated Concept Flag
+28 ;
+29 ; RXNORM Data
+30 ;
+31 ; ARY("RXN",1) Term Type (TTY) ^ Suppression Flag (Suppress) ^ Content View Flag (CVF)
+32 ;
+33 ; Each data element will be in the following format:
+34 ;
+35 ; ARY(ID,SUB) = DATA
+36 ; ARY(ID,SUB,"N") = NAME of the Data Element
+37 ;
+38 ; Where
+39 ;
+40 ; ID Identifier, may be:
+41 ;
+42 ; "LEX" for Lexicon data
+43 ; "RXN" for RXNORM specific data
+44 ;
+45 ; SUB Numeric Subscript
+46 ;
+47 ; DATA This may be:
+48 ;
+49 ; A value if it applies and is found
+50 ; Null if it applies but not found
+51 ; N/A if it does not apply
+52 ;
+53 ; NAME This is the common name given to the
+54 ; data element
+55 ;
+56 NEW ETSIEN,ETSARY,ETSDATA,ETSX,ETSEFDT,ETSDFLG,ETSSTAT
+57 ;
+58 if '$LENGTH($GET(ETSCODE))
QUIT "-1^Code missing"
+59 if $GET(ETSCSYS)=""
SET ETSCSYS="RXN"
+60 if ETSCSYS'="RXN"
QUIT "-1^Invalid source"
+61 ;
+62 IF $GET(ETSCDT)=""
SET ETSCDT=$$DT^XLFDT
+63 ; Make sure Date is a valid FileMan Date
+64 if +$$CHKDATE(ETSCDT)=-1
QUIT "-1^Invalid Date"
+65 ;
+66 ; Clear array in case older information present
+67 KILL ARY
+68 ;
+69 ; Retrieve the IEN for the code
+70 SET ETSIEN=$$GETIEN(ETSCODE,1,"")
+71 if ETSIEN=""
QUIT "-1^RXCUI Not Found"
+72 ;
+73 ;Get the DATA
+74 DO GETS^DIQ(129.2,ETSIEN,"**","IE","ETSARY")
+75 ;
+76 ; Default Activation Status information, Deactivation Flag
+77 SET ETSSTAT=1
SET ETSDFLG=""
+78 ;
+79 ;Get the Activation Effective Date
+80 SET ETSEFDT=ETSARY(129.2,ETSIEN_",",91,"I")
+81 ;
+82 ; If the activation date is newer than the date requested
+83 ; correct the Activation Date and the Deactivated concept flag
+84 if ETSEFDT>ETSCDT
SET ETSEFDT=""
SET ETSDFLG=1
+85 ;
+86 ; Lex Node
+87 ;
+88 ; IEN and the Text of the concept
+89 SET ARY("LEX",1)=ETSIEN_U_ETSARY(129.2,ETSIEN_",",1,"E")
+90 SET ARY("LEX",1,"N")="IEN ^ Text (STR)"
+91 ;
+92 ; set the activation status
+93 IF ETSEFDT'=""
Begin DoDot:1
+94 SET ARY("LEX",2)=ETSSTAT_U_ETSEFDT
+95 SET ARY("LEX",2,"N")="Status ^ Effective Date"
End DoDot:1
+96 ;
+97 ; Status Flag (always active, so always "")
+98 SET ARY("LEX",8)=ETSDFLG
+99 SET ARY("LEX",8,"N")="Deactivated Concept"
+100 ;
+101 ; RXN Node
+102 ;TTY
SET ARY("RXN",1)=ETSARY(129.2,ETSIEN_",",.03,"I")_U
+103 ;SUPPRESS FLAG
SET ARY("RXN",1)=ARY("RXN",1)_ETSARY(129.2,ETSIEN_",",.05,"I")
+104 ;CVF
SET ARY("RXN",1)=ARY("RXN",1)_U_ETSARY(129.2,ETSIEN_",",.06,"I")
+105 SET ARY("RXN",1,"N")="Term Type (TTY) ^ Suppression Flag (Suppress) ^ Content View Flag (CVF)"
+106 ;
+107 QUIT 1
+108 ;
VUICLASS(ETSVUID,ETSSUB) ;Entry point for function $$VUICLASS
+1 ;Redirecting to ETSRXNTX for processing
+2 QUIT $$TAX^ETSRXNTX($GET(ETSVUID),$GET(ETSSUB),1)
+3 ;
TAX(ETSVUID,ETSSUB) ; Taxonomy lookup for Clinical Reminders
+1 ;Redirecting to ETSRXNTX for processing
+2 QUIT $$TAX^ETSRXNTX($GET(ETSVUID),$GET(ETSSUB),0)
+3 ;
CHKDATE(ETSX) ;Check to see if the date is in proper FileMan format
+1 ;
+2 NEW %DT,X,Y,DTOUT
+3 SET %DT="X"
SET X=ETSX
DO ^%DT
+4 ;set error condition if timeout occurs
if $GET(DTOUT)'=""
SET Y=-1
+5 QUIT Y
+6 ;
VUI2RXN(ETSVUID,ETSTTY,ETSSUB) ;Entry point for function $$VUI2RXN
+1 ;Redirect to ETSRXN1 where the code resides
+2 QUIT $$VUI2RXN^ETSRXN1($GET(ETSVUID),$GET(ETSTTY),$GET(ETSSUB))
+3 ;
NDC2RXN(ETSNDC,ETSSUB) ;Entry point for function $$NDC2RXN
+1 ;Redirect to ETSRXN1 where the code resides
+2 QUIT $$NDC2RXN^ETSRXN1($GET(ETSNDC),$GET(ETSSUB))
+3 ;
RXN2OUT(ETSRXCUI,ETSSUB) ;Entry point for function $$RXN2OUT
+1 ;Redirect to ETSRXN1 where the code resides
+2 QUIT $$RXN2OUT^ETSRXN1($GET(ETSRXCUI),$GET(ETSSUB))
+3 ;
GETDATA(ETSRXCUI,ETSSUB) ;Entry point for function $$GETDATA
+1 ;Redirect to ETSRXN1 where the code resides
+2 QUIT $$GETDATA^ETSRXN1($GET(ETSRXCUI),$GET(ETSSUB))
+3 ;
