ETSLNC ;O-OIFO/FM23 - LOINC APIs ;01/31/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 LOINC Code with Check Digit (required)
; ETSSYS Coding System (required) [hard coded to LNC]
; .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) = Code ^ "LNC" ^ "LOINC"
; ARY(<date>,<status>) = Comment
;
;Note:
; This software was written based upon the current
; standard of a 1 to 1 relationship between the LOINC
; Code and its associated IEN.
;
N ETSSI,ETSTD,ETSSTAT,ETSDATE,ETSIEN,ETSN,ETSFLG
N ETSDIEN,ETSDATA
K ARY
;
;Validate the input
Q:'$G(ETSCODE) "-1^Code missing"
;
; Check for valid LOINC Code and retrieve the IEN
S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
Q:(+ETSIEN=-1) ETSIEN
;
S:$G(ETSSYS)="" ETSSYS="LNC"
Q:ETSSYS'="LNC" "-1^Invalid source"
;
S ETSSI="LNC^LOINC"
S ETSTD=$$DT^XLFDT
;
; Loop through Activation History Multiple to get the information.
S ETSDATE=0
F S ETSDATE=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE)) Q:'ETSDATE D
. S ETSDIEN=0
. F S ETSDIEN=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE,ETSDIEN)) Q:'ETSDIEN D
. . S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
. . Q:ETSDATA="" ; validate that the IEN and history exists
. . S ETSSTAT=$P(ETSDATA,U,2)
. . I '$D(ARY(ETSDATE,ETSSTAT)) D
. . . S ARY(0)=+($G(ARY(0)))+1
. . . S ARY(ETSDATE,ETSSTAT)=""
;
; Loop through and update the comment portion of the array
S ETSDATE=0,ETSFLG=0
F S ETSDATE=$O(ARY(ETSDATE)) Q:+ETSDATE'>0 D
. S ETSSTAT=""
. F S ETSSTAT=$O(ARY(ETSDATE,ETSSTAT)) Q:'$L(ETSSTAT) D
. . I +ETSSTAT>0,ETSFLG'=1 S ARY(ETSDATE,ETSSTAT)="Activated",ETSFLG=1 Q
. . I +ETSSTAT'>0 S ARY(ETSDATE,ETSSTAT)="Inactivated" Q
. . I +ETSSTAT>0 D
. . . S ARY(ETSDATE,ETSSTAT)="Re-activated"
. . . I $D(ARY(ETSDATE,0)) D
. . . . S ARY(ETSDATE,ETSSTAT)="Revised" K ARY(ETSDATE,0)
;
; Count the # entries and update the comments for any future changes with the word Pending.
K ARY(0)
S ETSN=0,ETSDATE=""
F S ETSDATE=$O(ARY(ETSDATE)) Q:'$L(ETSDATE) D
. S ETSSTAT="" F S ETSSTAT=$O(ARY(ETSDATE,ETSSTAT)) Q:'$L(ETSSTAT) D
. . I ETSSTAT?1N,ETSDATE?7N,ETSDATE>ETSTD,$L($G(ARY(ETSDATE,ETSSTAT))) D
. . . S ARY(ETSDATE,ETSSTAT)=$G(ARY(ETSDATE,ETSSTAT))_" (Pending)"
. . S ETSN=ETSN+1
;
Q:+ETSN'>0 "-1^No History Found"
;
S ARY(0)=ETSN
S:ETSN>0&($L(ETSSI))&($L(ETSCODE)) ARY(0,0)=ETSCODE_"^"_ETSSI
Q ETSN
;
PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
;
; Input:
;
; ETSCODE LOINC Code with Check digit (required)
; ETSSYS Coding System (Hardcode to look for LNC, required)
; .ARY Array, passed by Reference (required)
;
; Output:
;
; $$PERIOD Multiple piece "^" delimited string
;
; 1 Number of Activation Periods found
; 2 NULL
; 3 "LNC"
; 4 "LOINC"
; 5 "Logical Observation Identifier Names and Codes"
;
; 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 n/a
;
; 3 Variable Pointer IEN;ETSLNC(129.1,
;
; 4 Long Common Name (field #83)
;
; ARY(Activation Date,0) = Fully Specified Name (field #80
;
; Looks through the Activation History to build the information
;
N ETSACT,ETSINA,ETSDT,ETSIEN,ETSIDT,ETSPER,ETSFSN
N ETSCT,ETSLCN,ETSSD,ETSVP,ETSDATE
;
Q:'$L($G(ETSCODE)) "-1^Missing Code"
;
; Check for valid LOINC Code and retrieve the IEN
S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
Q:(+ETSIEN=-1) ETSIEN
;
S:$G(ETSSYS)="" ETSSYS="LNC"
Q:ETSSYS'="LNC" "-1^Missing/Invalid Coding System"
;
; Hardcode the Coding system information for now.
S ETSSD="LNC^LOINC^Logical Observation Identifier Names and Codes"
K ARY
;
;Retrieve the entries
S ETSDIEN=0
F S ETSDIEN=$O(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN)) Q:'ETSDIEN D
. S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
. Q:ETSDATA=""
. S ETSSTAT=$P(ETSDATA,U,2),ETSDATE=$P(ETSDATA,U)
. ;If status is active, update active array
. I ETSSTAT S ETSACT(ETSDATE)="" Q
. ;Else update inactive array
. S ETSINA(ETSDATE)=""
;
;Check for activation periods - if none, quit
I '$D(ETSACT) D Q ARY(0)
. S ARY(0)="-1^No activation periods found"
;
;Build the temp array for return to the user
S ETSDT=""
F S ETSDT=$O(ETSACT(ETSDT)) Q:'$L(ETSDT) D
. ; Inactive Date
. S ETSIDT=$O(ETSINA(ETSDT))
. ; if no future inactivation, check for same day
. S:ETSIDT="" ETSIDT=$G(ETSINA(ETSDT))
. ; Fully specified name and Long Common Name
. S ETSFSN=$G(^ETSLNC(129.1,+ETSIEN,80))
. S ETSLCN=$G(^ETSLNC(129.1,+ETSIEN,83))
. ; Kill inactive entry
. K:ETSIDT?7N ETSINA(ETSIDT)
. ; Variable Pointer
. S ETSVP=ETSIEN_";ETSLNC(129.1,"
. ; Set array
. S ETSPER(ETSDT)=ETSIDT_"^^"_ETSVP_"^"_ETSLCN
. S:$L(ETSFSN) ETSPER(ETSDT,0)=ETSFSN
;
;Count the # of entries
S (ETSDT,ETSCT)=0 F S ETSDT=$O(ETSPER(ETSDT)) Q:ETSDT'?7N S ETSCT=ETSCT+1
;
;If no entries, exit with error message
I ETSCT'>0 S ARY(0)="-1^No activation periods found" Q
;
;Merge the temp array to the returning array and set the 0 node.
M ARY=ETSPER
S ARY(0)=ETSCT_U_U_ETSSD
;
;Exit with the Number of entries
Q $G(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 13 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="LNC"
Q:ETSSYS'="LNC" "-1^Invalid Coding System"
S ETSDATA="^LNC^LNC^LOINC^Logical Observation Identifier Names and Codes^Duke University Medical Center"
S $P(ETSDATA,U,12)=$P($G(^DD(129.1,0,"VRRV")),U) ;Get the Current Version
S $P(ETSDATA,U,13)=$P($G(^DD(129.1,0,"VRRV")),U,2) ;Get the Current Version implementation date
S $P(ETSDATA,U,14)=20000 ; Search Max similar to LEX Lookup threshold
Q ETSDATA
;
CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
;
; Input:
;
; ETSCODE LOINC Code with Check Digit (Required)
; ETSCSYS "LNC" hardcoded for LOINC
; ETSCDT Code Set Versioning Date in
; FileMan date Format (default = TODAY)
; .ARY Output array passed by reference
;
; Output:
;
; $$CSDATA 1 if successful (in LOINC Table)
; 0 if unsuccessful
;
; or
;
; -1 ^ Error Message
;
;
; ARY()
;
;
; Lexicon Data
;
; ARY("LEX",1) IEN ^ Preferred Term
; ARY("LEX",2) Status ^ Effective Date
; ARY("LEX",8) Deactivated Concept Flag
;
; Coding System Data
;
; ARY("SYS",1) IEN
; ARY("SYS",2) Long Common Name
;
; 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
; "SYS" for Coding System 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,ETSDATA,ETSX,ETSHDATA,ETSHDT,ETSHIEN,ETSHIEN2
;
; Clear array in case older information present
K ARY
;
Q:'$L($G(ETSCODE)) "-1^Code missing"
;
; Check for valid LOINC Code and retrieve the IEN
S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
Q:(+ETSIEN=-1) ETSIEN
;
S:$G(ETSCSYS)="" ETSCSYS="LNC"
Q:ETSCSYS'="LNC" "-1^Invalid source"
;
; Set default date if no date sent
I $G(ETSCDT)="" S ETSCDT=$$DT^XLFDT
;
; Make sure Date is a valid FileMan Date
Q:+$$CHKDATE(ETSCDT)=-1 "-1^Invalid Date"
;
; Lex Node
;
; IEN and Fully specified Name
S ARY("LEX",1)=ETSIEN_U_$G(^ETSLNC(129.1,ETSIEN,80))
S ARY("LEX",1,"N")="IEN ^ Fully Specified Name"
;
; Activation Status information
S ETSSTAT=0
;
; Get the activation status based on the date
; Locate the correct activation status - if activation occurred on the day sent in use that date
S ETSHDT=""
S:$D(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT)) ETSHDT=ETSCDT
; or get the last activation
S:'ETSHDT ETSHDT=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT),-1)
;
; Only process if activation history found
I ETSHDT'="" D
. S ETSHIEN=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,""))
. ;
. ; If node not corrupted
. I ETSHIEN'="" D
. . ; get the node data
. . S ETSHDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN,0))
. . ; if data is present, set the 2nd node of LEX
. . I ETSHDATA'="" D
. . . S ETSSTAT=$P(ETSHDATA,U,2)
. . . I ETSSTAT=0 D
. . . . S ETSHIEN2=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,ETSHIEN))
. . . . I ETSHIEN2'="" S ETSSTAT=$P(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN2,0),U,2)
. . . S ARY("LEX",2)=ETSSTAT_U_ETSHDT
. . S ARY("LEX",2,"N")="Status ^ Effective Date"
;
; Status Flag (1 if status INACTIVE, otherwise "")
S ARY("LEX",8)=$S(ETSSTAT=0:1,1:"")
S ARY("LEX",8,"N")="Deactivated Concept"
;
; SYS Node
S ARY("SYS",1)=ETSIEN
S ARY("SYS",1,"N")="IEN"
;
; Long Common Name
S ARY("SYS",2)=$G(^ETSLNC(129.1,ETSIEN,83))
S ARY("SYS",2,"N")="Long Common Name"
;
Q 1
;
TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Taxonomy lookup for Clinical Reminders
;Redirecting to ETSLNCTX for processing
Q $$TAX^ETSLNCTX($G(ETSX),$G(ETSSRC),$G(ETSDT),$G(ETSSUB),$G(ETSVER))
;
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
;
CHKCODE(ETSCODE) ;Entry point for routine $$CHKCODE
;Check for missing variable, exit if not defined
I $G(ETSCODE)="" Q "-1^LOINC Code missing"
;
;Redirect to ETSLNC1 where the code resides
Q $$CHKCODE^ETSLNC1(ETSCODE)
;
GETCODE(ETSIEN) ;Entry point for routine $$GETCODE
;Check for missing variable, exit if not defined
Q:$G(ETSIEN)="" "-1^Missing Parameter"
;
;Redirect to ETSLNC1 where the code resides
Q $$GETCODE^ETSLNC1(ETSIEN)
;
GETNAME(ETSINPT,ETSINTY,NAME) ;Entry point for routine $$GETNAME
;Redirect to ETSLNC1 where the code resides
Q $$GETNAME^ETSLNC1($G(ETSINPT),$G(ETSINTY),.NAME)
;
GETSTAT(ETSINPT,ETSINTY) ;Entry point for routine $$GETSTAT
;Redirect to ETSLNC1 where the code resides
Q $$GETSTAT^ETSLNC1($G(ETSINPT),$G(ETSINTY))
;
GETREC(ETSINPT,ETSINTY,ETSSUB) ;Entry point for routine $$GETREC
;Redirect to ETSLNC1 where the code resides
Q $$GETREC^ETSLNC3($G(ETSINPT),$G(ETSINTY),$G(ETSSUB))
;
VERSION() ;Entry point for routine $$VERSION
;Redirect to ETSLNC1 where the code resides
Q $$VERSION^ETSLNC2()
;
COMLST(ETSCOM,ETSTYP,ETSSUB) ;Entry point for routine $$COMLST
;Redirect to ETSLNC2 where the code resides
Q $$COMLST^ETSLNC2($G(ETSCOM),$G(ETSTYP),$G(ETSSUB))
;
DEPLST(ETSSUB) ;Entry point for routine $$DEPLST
;Redirect to ETSLNC1 where the code resides
Q $$DEPLST^ETSLNC2($G(ETSSUB))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSLNC 12790 printed Oct 16, 2024@17:54:45 Page 2
ETSLNC ;O-OIFO/FM23 - LOINC APIs ;01/31/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 LOINC Code with Check Digit (required)
+5 ; ETSSYS Coding System (required) [hard coded to LNC]
+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) = Code ^ "LNC" ^ "LOINC"
+16 ; ARY(<date>,<status>) = Comment
+17 ;
+18 ;Note:
+19 ; This software was written based upon the current
+20 ; standard of a 1 to 1 relationship between the LOINC
+21 ; Code and its associated IEN.
+22 ;
+23 NEW ETSSI,ETSTD,ETSSTAT,ETSDATE,ETSIEN,ETSN,ETSFLG
+24 NEW ETSDIEN,ETSDATA
+25 KILL ARY
+26 ;
+27 ;Validate the input
+28 if '$GET(ETSCODE)
QUIT "-1^Code missing"
+29 ;
+30 ; Check for valid LOINC Code and retrieve the IEN
+31 SET ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
+32 if (+ETSIEN=-1)
QUIT ETSIEN
+33 ;
+34 if $GET(ETSSYS)=""
SET ETSSYS="LNC"
+35 if ETSSYS'="LNC"
QUIT "-1^Invalid source"
+36 ;
+37 SET ETSSI="LNC^LOINC"
+38 SET ETSTD=$$DT^XLFDT
+39 ;
+40 ; Loop through Activation History Multiple to get the information.
+41 SET ETSDATE=0
+42 FOR
SET ETSDATE=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE))
if 'ETSDATE
QUIT
Begin DoDot:1
+43 SET ETSDIEN=0
+44 FOR
SET ETSDIEN=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE,ETSDIEN))
if 'ETSDIEN
QUIT
Begin DoDot:2
+45 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
+46 ; validate that the IEN and history exists
if ETSDATA=""
QUIT
+47 SET ETSSTAT=$PIECE(ETSDATA,U,2)
+48 IF '$DATA(ARY(ETSDATE,ETSSTAT))
Begin DoDot:3
+49 SET ARY(0)=+($GET(ARY(0)))+1
+50 SET ARY(ETSDATE,ETSSTAT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 ; Loop through and update the comment portion of the array
+53 SET ETSDATE=0
SET ETSFLG=0
+54 FOR
SET ETSDATE=$ORDER(ARY(ETSDATE))
if +ETSDATE'>0
QUIT
Begin DoDot:1
+55 SET ETSSTAT=""
+56 FOR
SET ETSSTAT=$ORDER(ARY(ETSDATE,ETSSTAT))
if '$LENGTH(ETSSTAT)
QUIT
Begin DoDot:2
+57 IF +ETSSTAT>0
IF ETSFLG'=1
SET ARY(ETSDATE,ETSSTAT)="Activated"
SET ETSFLG=1
QUIT
+58 IF +ETSSTAT'>0
SET ARY(ETSDATE,ETSSTAT)="Inactivated"
QUIT
+59 IF +ETSSTAT>0
Begin DoDot:3
+60 SET ARY(ETSDATE,ETSSTAT)="Re-activated"
+61 IF $DATA(ARY(ETSDATE,0))
Begin DoDot:4
+62 SET ARY(ETSDATE,ETSSTAT)="Revised"
KILL ARY(ETSDATE,0)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+63 ;
+64 ; Count the # entries and update the comments for any future changes with the word Pending.
+65 KILL ARY(0)
+66 SET ETSN=0
SET ETSDATE=""
+67 FOR
SET ETSDATE=$ORDER(ARY(ETSDATE))
if '$LENGTH(ETSDATE)
QUIT
Begin DoDot:1
+68 SET ETSSTAT=""
FOR
SET ETSSTAT=$ORDER(ARY(ETSDATE,ETSSTAT))
if '$LENGTH(ETSSTAT)
QUIT
Begin DoDot:2
+69 IF ETSSTAT?1N
IF ETSDATE?7N
IF ETSDATE>ETSTD
IF $LENGTH($GET(ARY(ETSDATE,ETSSTAT)))
Begin DoDot:3
+70 SET ARY(ETSDATE,ETSSTAT)=$GET(ARY(ETSDATE,ETSSTAT))_" (Pending)"
End DoDot:3
+71 SET ETSN=ETSN+1
End DoDot:2
End DoDot:1
+72 ;
+73 if +ETSN'>0
QUIT "-1^No History Found"
+74 ;
+75 SET ARY(0)=ETSN
+76 if ETSN>0&($LENGTH(ETSSI))&($LENGTH(ETSCODE))
SET ARY(0,0)=ETSCODE_"^"_ETSSI
+77 QUIT ETSN
+78 ;
PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
+1 ;
+2 ; Input:
+3 ;
+4 ; ETSCODE LOINC Code with Check digit (required)
+5 ; ETSSYS Coding System (Hardcode to look for LNC, required)
+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
+13 ; 2 NULL
+14 ; 3 "LNC"
+15 ; 4 "LOINC"
+16 ; 5 "Logical Observation Identifier Names and Codes"
+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 n/a
+30 ;
+31 ; 3 Variable Pointer IEN;ETSLNC(129.1,
+32 ;
+33 ; 4 Long Common Name (field #83)
+34 ;
+35 ; ARY(Activation Date,0) = Fully Specified Name (field #80
+36 ;
+37 ; Looks through the Activation History to build the information
+38 ;
+39 NEW ETSACT,ETSINA,ETSDT,ETSIEN,ETSIDT,ETSPER,ETSFSN
+40 NEW ETSCT,ETSLCN,ETSSD,ETSVP,ETSDATE
+41 ;
+42 if '$LENGTH($GET(ETSCODE))
QUIT "-1^Missing Code"
+43 ;
+44 ; Check for valid LOINC Code and retrieve the IEN
+45 SET ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
+46 if (+ETSIEN=-1)
QUIT ETSIEN
+47 ;
+48 if $GET(ETSSYS)=""
SET ETSSYS="LNC"
+49 if ETSSYS'="LNC"
QUIT "-1^Missing/Invalid Coding System"
+50 ;
+51 ; Hardcode the Coding system information for now.
+52 SET ETSSD="LNC^LOINC^Logical Observation Identifier Names and Codes"
+53 KILL ARY
+54 ;
+55 ;Retrieve the entries
+56 SET ETSDIEN=0
+57 FOR
SET ETSDIEN=$ORDER(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN))
if 'ETSDIEN
QUIT
Begin DoDot:1
+58 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
+59 if ETSDATA=""
QUIT
+60 SET ETSSTAT=$PIECE(ETSDATA,U,2)
SET ETSDATE=$PIECE(ETSDATA,U)
+61 ;If status is active, update active array
+62 IF ETSSTAT
SET ETSACT(ETSDATE)=""
QUIT
+63 ;Else update inactive array
+64 SET ETSINA(ETSDATE)=""
End DoDot:1
+65 ;
+66 ;Check for activation periods - if none, quit
+67 IF '$DATA(ETSACT)
Begin DoDot:1
+68 SET ARY(0)="-1^No activation periods found"
End DoDot:1
QUIT ARY(0)
+69 ;
+70 ;Build the temp array for return to the user
+71 SET ETSDT=""
+72 FOR
SET ETSDT=$ORDER(ETSACT(ETSDT))
if '$LENGTH(ETSDT)
QUIT
Begin DoDot:1
+73 ; Inactive Date
+74 SET ETSIDT=$ORDER(ETSINA(ETSDT))
+75 ; if no future inactivation, check for same day
+76 if ETSIDT=""
SET ETSIDT=$GET(ETSINA(ETSDT))
+77 ; Fully specified name and Long Common Name
+78 SET ETSFSN=$GET(^ETSLNC(129.1,+ETSIEN,80))
+79 SET ETSLCN=$GET(^ETSLNC(129.1,+ETSIEN,83))
+80 ; Kill inactive entry
+81 if ETSIDT?7N
KILL ETSINA(ETSIDT)
+82 ; Variable Pointer
+83 SET ETSVP=ETSIEN_";ETSLNC(129.1,"
+84 ; Set array
+85 SET ETSPER(ETSDT)=ETSIDT_"^^"_ETSVP_"^"_ETSLCN
+86 if $LENGTH(ETSFSN)
SET ETSPER(ETSDT,0)=ETSFSN
End DoDot:1
+87 ;
+88 ;Count the # of entries
+89 SET (ETSDT,ETSCT)=0
FOR
SET ETSDT=$ORDER(ETSPER(ETSDT))
if ETSDT'?7N
QUIT
SET ETSCT=ETSCT+1
+90 ;
+91 ;If no entries, exit with error message
+92 IF ETSCT'>0
SET ARY(0)="-1^No activation periods found"
QUIT
+93 ;
+94 ;Merge the temp array to the returning array and set the 0 node.
+95 MERGE ARY=ETSPER
+96 SET ARY(0)=ETSCT_U_U_ETSSD
+97 ;
+98 ;Exit with the Number of entries
+99 QUIT $GET(ARY(0))
+100 ;
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 13 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="LNC"
+27 if ETSSYS'="LNC"
QUIT "-1^Invalid Coding System"
+28 SET ETSDATA="^LNC^LNC^LOINC^Logical Observation Identifier Names and Codes^Duke University Medical Center"
+29 ;Get the Current Version
SET $PIECE(ETSDATA,U,12)=$PIECE($GET(^DD(129.1,0,"VRRV")),U)
+30 ;Get the Current Version implementation date
SET $PIECE(ETSDATA,U,13)=$PIECE($GET(^DD(129.1,0,"VRRV")),U,2)
+31 ; Search Max similar to LEX Lookup threshold
SET $PIECE(ETSDATA,U,14)=20000
+32 QUIT ETSDATA
+33 ;
CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
+1 ;
+2 ; Input:
+3 ;
+4 ; ETSCODE LOINC Code with Check Digit (Required)
+5 ; ETSCSYS "LNC" hardcoded for LOINC
+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 LOINC Table)
+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 ^ Preferred Term
+26 ; ARY("LEX",2) Status ^ Effective Date
+27 ; ARY("LEX",8) Deactivated Concept Flag
+28 ;
+29 ; Coding System Data
+30 ;
+31 ; ARY("SYS",1) IEN
+32 ; ARY("SYS",2) Long Common Name
+33 ;
+34 ; Each data element will be in the following format:
+35 ;
+36 ; ARY(ID,SUB) = DATA
+37 ; ARY(ID,SUB,"N") = NAME of the Data Element
+38 ;
+39 ; Where
+40 ;
+41 ; ID Identifier, may be:
+42 ;
+43 ; "LEX" for Lexicon data
+44 ; "SYS" for Coding System data
+45 ;
+46 ; SUB Numeric Subscript
+47 ;
+48 ; DATA This may be:
+49 ;
+50 ; A value if it applies and is found
+51 ; Null if it applies but not found
+52 ; N/A if it does not apply
+53 ;
+54 ; NAME This is the common name given to the
+55 ; data element
+56 ;
+57 NEW ETSIEN,ETSDATA,ETSX,ETSHDATA,ETSHDT,ETSHIEN,ETSHIEN2
+58 ;
+59 ; Clear array in case older information present
+60 KILL ARY
+61 ;
+62 if '$LENGTH($GET(ETSCODE))
QUIT "-1^Code missing"
+63 ;
+64 ; Check for valid LOINC Code and retrieve the IEN
+65 SET ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
+66 if (+ETSIEN=-1)
QUIT ETSIEN
+67 ;
+68 if $GET(ETSCSYS)=""
SET ETSCSYS="LNC"
+69 if ETSCSYS'="LNC"
QUIT "-1^Invalid source"
+70 ;
+71 ; Set default date if no date sent
+72 IF $GET(ETSCDT)=""
SET ETSCDT=$$DT^XLFDT
+73 ;
+74 ; Make sure Date is a valid FileMan Date
+75 if +$$CHKDATE(ETSCDT)=-1
QUIT "-1^Invalid Date"
+76 ;
+77 ; Lex Node
+78 ;
+79 ; IEN and Fully specified Name
+80 SET ARY("LEX",1)=ETSIEN_U_$GET(^ETSLNC(129.1,ETSIEN,80))
+81 SET ARY("LEX",1,"N")="IEN ^ Fully Specified Name"
+82 ;
+83 ; Activation Status information
+84 SET ETSSTAT=0
+85 ;
+86 ; Get the activation status based on the date
+87 ; Locate the correct activation status - if activation occurred on the day sent in use that date
+88 SET ETSHDT=""
+89 if $DATA(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT))
SET ETSHDT=ETSCDT
+90 ; or get the last activation
+91 if 'ETSHDT
SET ETSHDT=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT),-1)
+92 ;
+93 ; Only process if activation history found
+94 IF ETSHDT'=""
Begin DoDot:1
+95 SET ETSHIEN=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,""))
+96 ;
+97 ; If node not corrupted
+98 IF ETSHIEN'=""
Begin DoDot:2
+99 ; get the node data
+100 SET ETSHDATA=$GET(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN,0))
+101 ; if data is present, set the 2nd node of LEX
+102 IF ETSHDATA'=""
Begin DoDot:3
+103 SET ETSSTAT=$PIECE(ETSHDATA,U,2)
+104 IF ETSSTAT=0
Begin DoDot:4
+105 SET ETSHIEN2=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,ETSHIEN))
+106 IF ETSHIEN2'=""
SET ETSSTAT=$PIECE(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN2,0),U,2)
End DoDot:4
+107 SET ARY("LEX",2)=ETSSTAT_U_ETSHDT
End DoDot:3
+108 SET ARY("LEX",2,"N")="Status ^ Effective Date"
End DoDot:2
End DoDot:1
+109 ;
+110 ; Status Flag (1 if status INACTIVE, otherwise "")
+111 SET ARY("LEX",8)=$SELECT(ETSSTAT=0:1,1:"")
+112 SET ARY("LEX",8,"N")="Deactivated Concept"
+113 ;
+114 ; SYS Node
+115 SET ARY("SYS",1)=ETSIEN
+116 SET ARY("SYS",1,"N")="IEN"
+117 ;
+118 ; Long Common Name
+119 SET ARY("SYS",2)=$GET(^ETSLNC(129.1,ETSIEN,83))
+120 SET ARY("SYS",2,"N")="Long Common Name"
+121 ;
+122 QUIT 1
+123 ;
TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Taxonomy lookup for Clinical Reminders
+1 ;Redirecting to ETSLNCTX for processing
+2 QUIT $$TAX^ETSLNCTX($GET(ETSX),$GET(ETSSRC),$GET(ETSDT),$GET(ETSSUB),$GET(ETSVER))
+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 ;
CHKCODE(ETSCODE) ;Entry point for routine $$CHKCODE
+1 ;Check for missing variable, exit if not defined
+2 IF $GET(ETSCODE)=""
QUIT "-1^LOINC Code missing"
+3 ;
+4 ;Redirect to ETSLNC1 where the code resides
+5 QUIT $$CHKCODE^ETSLNC1(ETSCODE)
+6 ;
GETCODE(ETSIEN) ;Entry point for routine $$GETCODE
+1 ;Check for missing variable, exit if not defined
+2 if $GET(ETSIEN)=""
QUIT "-1^Missing Parameter"
+3 ;
+4 ;Redirect to ETSLNC1 where the code resides
+5 QUIT $$GETCODE^ETSLNC1(ETSIEN)
+6 ;
GETNAME(ETSINPT,ETSINTY,NAME) ;Entry point for routine $$GETNAME
+1 ;Redirect to ETSLNC1 where the code resides
+2 QUIT $$GETNAME^ETSLNC1($GET(ETSINPT),$GET(ETSINTY),.NAME)
+3 ;
GETSTAT(ETSINPT,ETSINTY) ;Entry point for routine $$GETSTAT
+1 ;Redirect to ETSLNC1 where the code resides
+2 QUIT $$GETSTAT^ETSLNC1($GET(ETSINPT),$GET(ETSINTY))
+3 ;
GETREC(ETSINPT,ETSINTY,ETSSUB) ;Entry point for routine $$GETREC
+1 ;Redirect to ETSLNC1 where the code resides
+2 QUIT $$GETREC^ETSLNC3($GET(ETSINPT),$GET(ETSINTY),$GET(ETSSUB))
+3 ;
VERSION() ;Entry point for routine $$VERSION
+1 ;Redirect to ETSLNC1 where the code resides
+2 QUIT $$VERSION^ETSLNC2()
+3 ;
COMLST(ETSCOM,ETSTYP,ETSSUB) ;Entry point for routine $$COMLST
+1 ;Redirect to ETSLNC2 where the code resides
+2 QUIT $$COMLST^ETSLNC2($GET(ETSCOM),$GET(ETSTYP),$GET(ETSSUB))
+3 ;
DEPLST(ETSSUB) ;Entry point for routine $$DEPLST
+1 ;Redirect to ETSLNC1 where the code resides
+2 QUIT $$DEPLST^ETSLNC2($GET(ETSSUB))
+3 ;
