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

ETSLNC.m

Go to the documentation of this file.
  1. ETSLNC ;O-OIFO/FM23 - LOINC APIs ;01/31/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 LOINC Code with Check Digit (required)
  1. ; ETSSYS Coding System (required) [hard coded to LNC]
  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) = Code ^ "LNC" ^ "LOINC"
  1. ; ARY(<date>,<status>) = Comment
  1. ;
  1. ;Note:
  1. ; This software was written based upon the current
  1. ; standard of a 1 to 1 relationship between the LOINC
  1. ; Code and its associated IEN.
  1. ;
  1. N ETSSI,ETSTD,ETSSTAT,ETSDATE,ETSIEN,ETSN,ETSFLG
  1. N ETSDIEN,ETSDATA
  1. K ARY
  1. ;
  1. ;Validate the input
  1. Q:'$G(ETSCODE) "-1^Code missing"
  1. ;
  1. ; Check for valid LOINC Code and retrieve the IEN
  1. S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
  1. Q:(+ETSIEN=-1) ETSIEN
  1. ;
  1. S:$G(ETSSYS)="" ETSSYS="LNC"
  1. Q:ETSSYS'="LNC" "-1^Invalid source"
  1. ;
  1. S ETSSI="LNC^LOINC"
  1. S ETSTD=$$DT^XLFDT
  1. ;
  1. ; Loop through Activation History Multiple to get the information.
  1. S ETSDATE=0
  1. F S ETSDATE=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE)) Q:'ETSDATE D
  1. . S ETSDIEN=0
  1. . F S ETSDIEN=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE,ETSDIEN)) Q:'ETSDIEN D
  1. . . S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
  1. . . Q:ETSDATA="" ; validate that the IEN and history exists
  1. . . S ETSSTAT=$P(ETSDATA,U,2)
  1. . . I '$D(ARY(ETSDATE,ETSSTAT)) D
  1. . . . S ARY(0)=+($G(ARY(0)))+1
  1. . . . S ARY(ETSDATE,ETSSTAT)=""
  1. ;
  1. ; Loop through and update the comment portion of the array
  1. S ETSDATE=0,ETSFLG=0
  1. F S ETSDATE=$O(ARY(ETSDATE)) Q:+ETSDATE'>0 D
  1. . S ETSSTAT=""
  1. . F S ETSSTAT=$O(ARY(ETSDATE,ETSSTAT)) Q:'$L(ETSSTAT) D
  1. . . I +ETSSTAT>0,ETSFLG'=1 S ARY(ETSDATE,ETSSTAT)="Activated",ETSFLG=1 Q
  1. . . I +ETSSTAT'>0 S ARY(ETSDATE,ETSSTAT)="Inactivated" Q
  1. . . I +ETSSTAT>0 D
  1. . . . S ARY(ETSDATE,ETSSTAT)="Re-activated"
  1. . . . I $D(ARY(ETSDATE,0)) D
  1. . . . . S ARY(ETSDATE,ETSSTAT)="Revised" K ARY(ETSDATE,0)
  1. ;
  1. ; Count the # entries and update the comments for any future changes with the word Pending.
  1. K ARY(0)
  1. S ETSN=0,ETSDATE=""
  1. F S ETSDATE=$O(ARY(ETSDATE)) Q:'$L(ETSDATE) D
  1. . S ETSSTAT="" F S ETSSTAT=$O(ARY(ETSDATE,ETSSTAT)) Q:'$L(ETSSTAT) D
  1. . . I ETSSTAT?1N,ETSDATE?7N,ETSDATE>ETSTD,$L($G(ARY(ETSDATE,ETSSTAT))) D
  1. . . . S ARY(ETSDATE,ETSSTAT)=$G(ARY(ETSDATE,ETSSTAT))_" (Pending)"
  1. . . S ETSN=ETSN+1
  1. ;
  1. Q:+ETSN'>0 "-1^No History Found"
  1. ;
  1. S ARY(0)=ETSN
  1. S:ETSN>0&($L(ETSSI))&($L(ETSCODE)) ARY(0,0)=ETSCODE_"^"_ETSSI
  1. Q ETSN
  1. ;
  1. PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
  1. ;
  1. ; Input:
  1. ;
  1. ; ETSCODE LOINC Code with Check digit (required)
  1. ; ETSSYS Coding System (Hardcode to look for LNC, required)
  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
  1. ; 2 NULL
  1. ; 3 "LNC"
  1. ; 4 "LOINC"
  1. ; 5 "Logical Observation Identifier Names and Codes"
  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 n/a
  1. ;
  1. ; 3 Variable Pointer IEN;ETSLNC(129.1,
  1. ;
  1. ; 4 Long Common Name (field #83)
  1. ;
  1. ; ARY(Activation Date,0) = Fully Specified Name (field #80
  1. ;
  1. ; Looks through the Activation History to build the information
  1. ;
  1. N ETSACT,ETSINA,ETSDT,ETSIEN,ETSIDT,ETSPER,ETSFSN
  1. N ETSCT,ETSLCN,ETSSD,ETSVP,ETSDATE
  1. ;
  1. Q:'$L($G(ETSCODE)) "-1^Missing Code"
  1. ;
  1. ; Check for valid LOINC Code and retrieve the IEN
  1. S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
  1. Q:(+ETSIEN=-1) ETSIEN
  1. ;
  1. S:$G(ETSSYS)="" ETSSYS="LNC"
  1. Q:ETSSYS'="LNC" "-1^Missing/Invalid Coding System"
  1. ;
  1. ; Hardcode the Coding system information for now.
  1. S ETSSD="LNC^LOINC^Logical Observation Identifier Names and Codes"
  1. K ARY
  1. ;
  1. ;Retrieve the entries
  1. S ETSDIEN=0
  1. F S ETSDIEN=$O(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN)) Q:'ETSDIEN D
  1. . S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
  1. . Q:ETSDATA=""
  1. . S ETSSTAT=$P(ETSDATA,U,2),ETSDATE=$P(ETSDATA,U)
  1. . ;If status is active, update active array
  1. . I ETSSTAT S ETSACT(ETSDATE)="" Q
  1. . ;Else update inactive array
  1. . S ETSINA(ETSDATE)=""
  1. ;
  1. ;Check for activation periods - if none, quit
  1. I '$D(ETSACT) D Q ARY(0)
  1. . S ARY(0)="-1^No activation periods found"
  1. ;
  1. ;Build the temp array for return to the user
  1. S ETSDT=""
  1. F S ETSDT=$O(ETSACT(ETSDT)) Q:'$L(ETSDT) D
  1. . ; Inactive Date
  1. . S ETSIDT=$O(ETSINA(ETSDT))
  1. . ; if no future inactivation, check for same day
  1. . S:ETSIDT="" ETSIDT=$G(ETSINA(ETSDT))
  1. . ; Fully specified name and Long Common Name
  1. . S ETSFSN=$G(^ETSLNC(129.1,+ETSIEN,80))
  1. . S ETSLCN=$G(^ETSLNC(129.1,+ETSIEN,83))
  1. . ; Kill inactive entry
  1. . K:ETSIDT?7N ETSINA(ETSIDT)
  1. . ; Variable Pointer
  1. . S ETSVP=ETSIEN_";ETSLNC(129.1,"
  1. . ; Set array
  1. . S ETSPER(ETSDT)=ETSIDT_"^^"_ETSVP_"^"_ETSLCN
  1. . S:$L(ETSFSN) ETSPER(ETSDT,0)=ETSFSN
  1. ;
  1. ;Count the # of entries
  1. S (ETSDT,ETSCT)=0 F S ETSDT=$O(ETSPER(ETSDT)) Q:ETSDT'?7N S ETSCT=ETSCT+1
  1. ;
  1. ;If no entries, exit with error message
  1. I ETSCT'>0 S ARY(0)="-1^No activation periods found" Q
  1. ;
  1. ;Merge the temp array to the returning array and set the 0 node.
  1. M ARY=ETSPER
  1. S ARY(0)=ETSCT_U_U_ETSSD
  1. ;
  1. ;Exit with the Number of entries
  1. Q $G(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 13 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="LNC"
  1. Q:ETSSYS'="LNC" "-1^Invalid Coding System"
  1. S ETSDATA="^LNC^LNC^LOINC^Logical Observation Identifier Names and Codes^Duke University Medical Center"
  1. S $P(ETSDATA,U,12)=$P($G(^DD(129.1,0,"VRRV")),U) ;Get the Current Version
  1. S $P(ETSDATA,U,13)=$P($G(^DD(129.1,0,"VRRV")),U,2) ;Get the Current Version implementation date
  1. S $P(ETSDATA,U,14)=20000 ; Search Max similar to LEX Lookup threshold
  1. Q ETSDATA
  1. ;
  1. CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
  1. ;
  1. ; Input:
  1. ;
  1. ; ETSCODE LOINC Code with Check Digit (Required)
  1. ; ETSCSYS "LNC" hardcoded for LOINC
  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 LOINC Table)
  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 ^ Preferred Term
  1. ; ARY("LEX",2) Status ^ Effective Date
  1. ; ARY("LEX",8) Deactivated Concept Flag
  1. ;
  1. ; Coding System Data
  1. ;
  1. ; ARY("SYS",1) IEN
  1. ; ARY("SYS",2) Long Common Name
  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. ; "SYS" for Coding System 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,ETSDATA,ETSX,ETSHDATA,ETSHDT,ETSHIEN,ETSHIEN2
  1. ;
  1. ; Clear array in case older information present
  1. K ARY
  1. ;
  1. Q:'$L($G(ETSCODE)) "-1^Code missing"
  1. ;
  1. ; Check for valid LOINC Code and retrieve the IEN
  1. S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
  1. Q:(+ETSIEN=-1) ETSIEN
  1. ;
  1. S:$G(ETSCSYS)="" ETSCSYS="LNC"
  1. Q:ETSCSYS'="LNC" "-1^Invalid source"
  1. ;
  1. ; Set default date if no date sent
  1. I $G(ETSCDT)="" S ETSCDT=$$DT^XLFDT
  1. ;
  1. ; Make sure Date is a valid FileMan Date
  1. Q:+$$CHKDATE(ETSCDT)=-1 "-1^Invalid Date"
  1. ;
  1. ; Lex Node
  1. ;
  1. ; IEN and Fully specified Name
  1. S ARY("LEX",1)=ETSIEN_U_$G(^ETSLNC(129.1,ETSIEN,80))
  1. S ARY("LEX",1,"N")="IEN ^ Fully Specified Name"
  1. ;
  1. ; Activation Status information
  1. S ETSSTAT=0
  1. ;
  1. ; Get the activation status based on the date
  1. ; Locate the correct activation status - if activation occurred on the day sent in use that date
  1. S ETSHDT=""
  1. S:$D(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT)) ETSHDT=ETSCDT
  1. ; or get the last activation
  1. S:'ETSHDT ETSHDT=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT),-1)
  1. ;
  1. ; Only process if activation history found
  1. I ETSHDT'="" D
  1. . S ETSHIEN=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,""))
  1. . ;
  1. . ; If node not corrupted
  1. . I ETSHIEN'="" D
  1. . . ; get the node data
  1. . . S ETSHDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN,0))
  1. . . ; if data is present, set the 2nd node of LEX
  1. . . I ETSHDATA'="" D
  1. . . . S ETSSTAT=$P(ETSHDATA,U,2)
  1. . . . I ETSSTAT=0 D
  1. . . . . S ETSHIEN2=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,ETSHIEN))
  1. . . . . I ETSHIEN2'="" S ETSSTAT=$P(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN2,0),U,2)
  1. . . . S ARY("LEX",2)=ETSSTAT_U_ETSHDT
  1. . . S ARY("LEX",2,"N")="Status ^ Effective Date"
  1. ;
  1. ; Status Flag (1 if status INACTIVE, otherwise "")
  1. S ARY("LEX",8)=$S(ETSSTAT=0:1,1:"")
  1. S ARY("LEX",8,"N")="Deactivated Concept"
  1. ;
  1. ; SYS Node
  1. S ARY("SYS",1)=ETSIEN
  1. S ARY("SYS",1,"N")="IEN"
  1. ;
  1. ; Long Common Name
  1. S ARY("SYS",2)=$G(^ETSLNC(129.1,ETSIEN,83))
  1. S ARY("SYS",2,"N")="Long Common Name"
  1. ;
  1. Q 1
  1. ;
  1. TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Taxonomy lookup for Clinical Reminders
  1. ;Redirecting to ETSLNCTX for processing
  1. Q $$TAX^ETSLNCTX($G(ETSX),$G(ETSSRC),$G(ETSDT),$G(ETSSUB),$G(ETSVER))
  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. CHKCODE(ETSCODE) ;Entry point for routine $$CHKCODE
  1. ;Check for missing variable, exit if not defined
  1. I $G(ETSCODE)="" Q "-1^LOINC Code missing"
  1. ;
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$CHKCODE^ETSLNC1(ETSCODE)
  1. ;
  1. GETCODE(ETSIEN) ;Entry point for routine $$GETCODE
  1. ;Check for missing variable, exit if not defined
  1. Q:$G(ETSIEN)="" "-1^Missing Parameter"
  1. ;
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$GETCODE^ETSLNC1(ETSIEN)
  1. ;
  1. GETNAME(ETSINPT,ETSINTY,NAME) ;Entry point for routine $$GETNAME
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$GETNAME^ETSLNC1($G(ETSINPT),$G(ETSINTY),.NAME)
  1. ;
  1. GETSTAT(ETSINPT,ETSINTY) ;Entry point for routine $$GETSTAT
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$GETSTAT^ETSLNC1($G(ETSINPT),$G(ETSINTY))
  1. ;
  1. GETREC(ETSINPT,ETSINTY,ETSSUB) ;Entry point for routine $$GETREC
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$GETREC^ETSLNC3($G(ETSINPT),$G(ETSINTY),$G(ETSSUB))
  1. ;
  1. VERSION() ;Entry point for routine $$VERSION
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$VERSION^ETSLNC2()
  1. ;
  1. COMLST(ETSCOM,ETSTYP,ETSSUB) ;Entry point for routine $$COMLST
  1. ;Redirect to ETSLNC2 where the code resides
  1. Q $$COMLST^ETSLNC2($G(ETSCOM),$G(ETSTYP),$G(ETSSUB))
  1. ;
  1. DEPLST(ETSSUB) ;Entry point for routine $$DEPLST
  1. ;Redirect to ETSLNC1 where the code resides
  1. Q $$DEPLST^ETSLNC2($G(ETSSUB))
  1. ;