- 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 Jan 18, 2025@02:55:15 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 ;