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

ETSRXN.m

Go to the documentation of this file.
  1. ETSRXN ;O-OIFO/FM23 - RxNorm APIs ;03/06/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. HIST(ETSCODE,ETSSYS,ARY) ; Get Activation History for a Code
  1. ;
  1. ; Input:
  1. ;
  1. ; ETSCODE RXCUI (required)
  1. ; ETSSYS Coding System (required) [hard coded to RXN]
  1. ; .ARY Array, passed by Reference (required)
  1. ;
  1. ; Output:
  1. ;
  1. ; $$HIST Number of Histories Found
  1. ; or
  1. ; -1 ^ error message
  1. ;
  1. ; ARY(0) = Number of Activation History
  1. ; ARY(0,0) = IEN ^ "RXN" ^ "RXNORM" ^ IEN (file 129.2)
  1. ; ^ TTY (file 129.2, #.03)
  1. ; ARY(0,1) = STR (file 129.2, #1)
  1. ; ARY(<date>,<status>) = Comment
  1. ;
  1. ;
  1. N ETSSI,ETSSTAT,ETSDATE,ETSIEN,ETSN
  1. ;
  1. ;Clear any older data
  1. K ARY
  1. ;
  1. ;Validate the input
  1. Q:'$G(ETSCODE) "-1^Code missing"
  1. S:$G(ETSSYS)="" ETSSYS="RXN"
  1. Q:ETSSYS'="RXN" "-1^Invalid source"
  1. ;
  1. S ETSSI="RXN^RXNORM"
  1. ;
  1. ; Find the most relevant entry for the RXCUI
  1. ; Need to look at TTYs PSN, SCD, SBD, GPACK
  1. ; and BPACK in that order of preference for
  1. ; the RXNORM source. Entry is also not
  1. ; suppressed (129.2,field .05 = "N")
  1. S ETSIEN=$$GETIEN(ETSCODE,1,"")
  1. ;
  1. ; quit if RXCUI is not defined for any of the preferred TTYs
  1. Q:ETSIEN="" "-1^RXCUI Not Found"
  1. ;
  1. ;Get the activation date and count
  1. S ETSSTAT=1,ETSN=1
  1. S ETSDATE=$$GET1^DIQ(129.2,ETSIEN_", ",91,"I")
  1. ;
  1. Q:ETSDATE="" "-1^Activation Date Not Found"
  1. ;
  1. S ARY(ETSDATE,ETSSTAT)="Activated"
  1. ;
  1. S ARY(0)=ETSN
  1. S ARY(0,0)=ETSSI_"^"_ETSIEN_"^"
  1. S ARY(0,0)=ARY(0,0)_$$GET1^DIQ(129.2,ETSIEN_", ",.03,"I")
  1. S ARY(0,1)=$$GET1^DIQ(129.2,ETSIEN_", ",1,"I")
  1. Q ETSN
  1. ;
  1. GETIEN(ETSRXC,ETSACT,ETSDT) ;
  1. ; Input - ETSRXC - RXCUI (required)
  1. ; ETSACT - (Optional) Active only (default is 1)
  1. ; ETSDT - (Optional) Date to filter on
  1. ;
  1. ; Output - $$GETIEN - IEN of the most relevant entry
  1. ; or NULL
  1. ; Find the most relevant entry for the RXCUI
  1. ; Need to look at TTYs PSN, SCD, SBD, GPACK
  1. ; and BPACK in that order of preference for
  1. ; the RXNORM source. Entry is also not
  1. ; suppressed (129.2,field .05 = "N")
  1. N ETSIEN,TTY,FLG,ETSFDT
  1. ;
  1. S ETSFDT=$G(ETSDT)
  1. S ETSIEN=""
  1. S:$G(ETSACT)="" ETSACT=1
  1. ;
  1. ; Loop through the VA requested TTYs.
  1. S FLG=0
  1. F TTY="PSN","SCD","SBD","GPACK","BPACK" D Q:FLG
  1. . S ETSIEN=$O(^ETSRXN(129.2,"C","RXNORM",ETSCODE,TTY,""))
  1. . Q:ETSIEN=""
  1. . ;Check the suppress flag
  1. . S FLG=1
  1. . I ETSACT D Q
  1. .. I $$GET1^DIQ(129.2,ETSIEN_", ",.05,"I")'="N" S FLG=0 Q ; RXCUI Suppressed
  1. .. S:'$$ACTFLG(ETSFDT,ETSIEN) FLG=0 ;Date requsted before activation date
  1. . I 'ETSACT D Q
  1. .. S:'$$ACTFLG(ETSFDT,ETSIEN) FLG=0 ;Date requsted before activation date
  1. ;
  1. ; Return null if Inactive, not found or suppressed
  1. Q:'FLG ""
  1. ;
  1. ; Return IEN if found and Active
  1. Q ETSIEN
  1. ;
  1. ACTFLG(ETSFDT,ETSIEN) ;determine if RXCUI is active
  1. ;
  1. ; Input: ETSFDT - Date user wishes to check for active status
  1. ; ETSIEN - IEN of the requested RXCUI
  1. ;
  1. ; Output: $$ACTFLG - 1 (Active) or 0 (Date before activation)
  1. ;
  1. N ETSADT,ETSFLG
  1. ;
  1. S ETSFLG=1 ; Defaut is active
  1. I $G(ETSFDT)'="" D
  1. . S ETSADT=$$GET1^DIQ(129.2,$G(ETSIEN)_", ",91,"I")
  1. . I ETSADT="" S ETSFLG=0 Q
  1. . I ETSFDT<ETSADT S ETSFLG=0 Q
  1. Q ETSFLG
  1. ;
  1. PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
  1. ;
  1. ; Input:
  1. ;
  1. ; ETSCODE RXCUI (required)
  1. ; ETSSYS Coding System (Hardcode to look for RXN, default is RXN)
  1. ; .ARY Array, passed by Reference (required)
  1. ;
  1. ; Output:
  1. ;
  1. ; $$PERIOD Multiple piece "^" delimited string
  1. ;
  1. ; 1 Number of Activation Periods found (should only be 1
  1. ; 2 TTY
  1. ; 3 "RXN"
  1. ; 4 "RXNORM"
  1. ; 5 "RXNORM"
  1. ;
  1. ; or
  1. ;
  1. ; -1^Message (no entries or other error message)
  1. ;
  1. ; ARY(0) Same as $$PERIOD (above)
  1. ;
  1. ; ARY(Activation Date) = 4 piece "^" delimited string
  1. ;
  1. ; 1 Inactivation Date
  1. ; (conditional)
  1. ;
  1. ; 2 not used
  1. ;
  1. ; 3 Variable Pointer IEN;ETSRXN(129.2,
  1. ;
  1. ; 4 not used
  1. ;
  1. ; ARY(Activation Date,0) = STR
  1. ;
  1. ; Looks through the Activation History to build the information
  1. ;
  1. N ETSSD,ETSIEN,ETSADT
  1. ;
  1. Q:'$L($G(ETSCODE)) "-1^Missing RXCUI"
  1. S:$G(ETSSYS)="" ETSSYS="RXN"
  1. Q:ETSSYS'="RXN" "-1^Missing/Invalid Coding System"
  1. Q:'$D(ARY) "-1^Return Array Not Defined"
  1. ;
  1. ; Hardcode the Coding system information for now.
  1. S ETSSD="RXN^RXNORM^RXNORM"
  1. K ARY
  1. ;
  1. ; Retrieve the IEN for the code
  1. S ETSIEN=$$GETIEN(ETSCODE,1,"")
  1. Q:ETSIEN="" "-1^RXCUI Not Found"
  1. ;
  1. S ARY(0)="1"_U_$$GET1^DIQ(129.2,ETSIEN_", ",.03,"I")_U_ETSSD
  1. ;
  1. ;set the activation date nodes
  1. S ETSADT=$$GET1^DIQ(129.2,ETSIEN_", ",91,"I")
  1. Q:ETSADT="" "-1^Activation Date not found"
  1. ;
  1. S ARY(ETSADT)=U_U_ETSIEN_";ETSRXN(129.2"_U
  1. S ARY(ETSADT,0)=$$GET1^DIQ(129.2,ETSIEN_", ",1,"I")
  1. Q ARY(0)
  1. ;
  1. CSYS(ETSSYS) ;Retrieve the Coding System Information
  1. ; Hardcoded to specifically provide LEXICON users System Information
  1. ; Currently hardcoded - ETS does not have a Coding System dictionary
  1. ;
  1. ; Input
  1. ;
  1. ; ETSSYS Coding System Abbreviation (757.03,.01)
  1. ; or pointer to file 757.03
  1. ;
  1. ; Output
  1. ;
  1. ; A 14 piece caret (^) delimited string
  1. ;
  1. ; 1 Not Used
  1. ; 2 SAB (3 character source abbreviation)
  1. ; 3 Source Abbreviation (3-7 char)
  1. ; 4 Nomenclature (2-11 char)
  1. ; 5 Source Title (2-52 char)
  1. ; 6 Source (2-50 char)
  1. ; 7-11 Not used
  1. ; 12 Version Id (1-40 char) [optional]
  1. ; 13 Implementation Date (date) [optional]
  1. ; 14 Lookup Threshold
  1. ;
  1. N ETSDATA
  1. S ETSDATA=""
  1. S:$G(ETSSYS)="" ETSSYS="RXN"
  1. Q:ETSSYS'="RXN" "-1^Invalid Coding System"
  1. S ETSDATA="^RXN^RxNorm^RxNorm^RxNorm^National Library of Medicine"
  1. Q ETSDATA
  1. ;
  1. CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
  1. ;
  1. ; Input:
  1. ;
  1. ; ETSCODE Classification Code (Required)
  1. ; ETSCSYS "RXN" hardcoded for RxNorm
  1. ; ETSCDT Code Set Versioning Date in
  1. ; FileMan date Format (default = TODAY)
  1. ; .ARY Output array passed by reference
  1. ;
  1. ; Output:
  1. ;
  1. ; $$CSDATA 1 if successful (in RxNorm Concept Table #129.2)
  1. ; 0 if unsuccessful
  1. ;
  1. ; or
  1. ;
  1. ; -1 ^ Error Message
  1. ;
  1. ;
  1. ; ARY()
  1. ;
  1. ;
  1. ; Lexicon Data
  1. ;
  1. ; ARY("LEX",1) IEN ^ STR
  1. ; ARY("LEX",2) Status ^ Effective Date
  1. ; ARY("LEX",8) Deactivated Concept Flag
  1. ;
  1. ; RXNORM Data
  1. ;
  1. ; ARY("RXN",1) Term Type (TTY) ^ Suppression Flag (Suppress) ^ Content View Flag (CVF)
  1. ;
  1. ; Each data element will be in the following format:
  1. ;
  1. ; ARY(ID,SUB) = DATA
  1. ; ARY(ID,SUB,"N") = NAME of the Data Element
  1. ;
  1. ; Where
  1. ;
  1. ; ID Identifier, may be:
  1. ;
  1. ; "LEX" for Lexicon data
  1. ; "RXN" for RXNORM specific data
  1. ;
  1. ; SUB Numeric Subscript
  1. ;
  1. ; DATA This may be:
  1. ;
  1. ; A value if it applies and is found
  1. ; Null if it applies but not found
  1. ; N/A if it does not apply
  1. ;
  1. ; NAME This is the common name given to the
  1. ; data element
  1. ;
  1. N ETSIEN,ETSARY,ETSDATA,ETSX,ETSEFDT,ETSDFLG,ETSSTAT
  1. ;
  1. Q:'$L($G(ETSCODE)) "-1^Code missing"
  1. S:$G(ETSCSYS)="" ETSCSYS="RXN"
  1. Q:ETSCSYS'="RXN" "-1^Invalid source"
  1. ;
  1. I $G(ETSCDT)="" S ETSCDT=$$DT^XLFDT
  1. ; Make sure Date is a valid FileMan Date
  1. Q:+$$CHKDATE(ETSCDT)=-1 "-1^Invalid Date"
  1. ;
  1. ; Clear array in case older information present
  1. K ARY
  1. ;
  1. ; Retrieve the IEN for the code
  1. S ETSIEN=$$GETIEN(ETSCODE,1,"")
  1. Q:ETSIEN="" "-1^RXCUI Not Found"
  1. ;
  1. ;Get the DATA
  1. D GETS^DIQ(129.2,ETSIEN,"**","IE","ETSARY")
  1. ;
  1. ; Default Activation Status information, Deactivation Flag
  1. S ETSSTAT=1,ETSDFLG=""
  1. ;
  1. ;Get the Activation Effective Date
  1. S ETSEFDT=ETSARY(129.2,ETSIEN_",",91,"I")
  1. ;
  1. ; If the activation date is newer than the date requested
  1. ; correct the Activation Date and the Deactivated concept flag
  1. S:ETSEFDT>ETSCDT ETSEFDT="",ETSDFLG=1
  1. ;
  1. ; Lex Node
  1. ;
  1. ; IEN and the Text of the concept
  1. S ARY("LEX",1)=ETSIEN_U_ETSARY(129.2,ETSIEN_",",1,"E")
  1. S ARY("LEX",1,"N")="IEN ^ Text (STR)"
  1. ;
  1. ; set the activation status
  1. I ETSEFDT'="" D
  1. . S ARY("LEX",2)=ETSSTAT_U_ETSEFDT
  1. . S ARY("LEX",2,"N")="Status ^ Effective Date"
  1. ;
  1. ; Status Flag (always active, so always "")
  1. S ARY("LEX",8)=ETSDFLG
  1. S ARY("LEX",8,"N")="Deactivated Concept"
  1. ;
  1. ; RXN Node
  1. S ARY("RXN",1)=ETSARY(129.2,ETSIEN_",",.03,"I")_U ;TTY
  1. S ARY("RXN",1)=ARY("RXN",1)_ETSARY(129.2,ETSIEN_",",.05,"I") ;SUPPRESS FLAG
  1. S ARY("RXN",1)=ARY("RXN",1)_U_ETSARY(129.2,ETSIEN_",",.06,"I") ;CVF
  1. S ARY("RXN",1,"N")="Term Type (TTY) ^ Suppression Flag (Suppress) ^ Content View Flag (CVF)"
  1. ;
  1. Q 1
  1. ;
  1. VUICLASS(ETSVUID,ETSSUB) ;Entry point for function $$VUICLASS
  1. ;Redirecting to ETSRXNTX for processing
  1. Q $$TAX^ETSRXNTX($G(ETSVUID),$G(ETSSUB),1)
  1. ;
  1. TAX(ETSVUID,ETSSUB) ; Taxonomy lookup for Clinical Reminders
  1. ;Redirecting to ETSRXNTX for processing
  1. Q $$TAX^ETSRXNTX($G(ETSVUID),$G(ETSSUB),0)
  1. ;
  1. CHKDATE(ETSX) ;Check to see if the date is in proper FileMan format
  1. ;
  1. N %DT,X,Y,DTOUT
  1. S %DT="X",X=ETSX D ^%DT
  1. S:$G(DTOUT)'="" Y=-1 ;set error condition if timeout occurs
  1. Q Y
  1. ;
  1. VUI2RXN(ETSVUID,ETSTTY,ETSSUB) ;Entry point for function $$VUI2RXN
  1. ;Redirect to ETSRXN1 where the code resides
  1. Q $$VUI2RXN^ETSRXN1($G(ETSVUID),$G(ETSTTY),$G(ETSSUB))
  1. ;
  1. NDC2RXN(ETSNDC,ETSSUB) ;Entry point for function $$NDC2RXN
  1. ;Redirect to ETSRXN1 where the code resides
  1. Q $$NDC2RXN^ETSRXN1($G(ETSNDC),$G(ETSSUB))
  1. ;
  1. RXN2OUT(ETSRXCUI,ETSSUB) ;Entry point for function $$RXN2OUT
  1. ;Redirect to ETSRXN1 where the code resides
  1. Q $$RXN2OUT^ETSRXN1($G(ETSRXCUI),$G(ETSSUB))
  1. ;
  1. GETDATA(ETSRXCUI,ETSSUB) ;Entry point for function $$GETDATA
  1. ;Redirect to ETSRXN1 where the code resides
  1. Q $$GETDATA^ETSRXN1($G(ETSRXCUI),$G(ETSSUB))
  1. ;