ETSLNCTX ;O-OIFO/FM23 - LOINC Taxonomy Search (Part 1) ;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
;
TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Get Taxonomy Information
;
; Input:
;
; ETSX Search String Either a partial text or a LOINC Code with check digit
;
; ETSSRC Source: either LNC or LOINC
;
; ETSDT Date to use to evaluate status in FileMan Format (defaults to TODAY)
;
; ETSSUB Name of a subscript to use in the ^TMP
; global (optional)
;
; ^TMP(ETSSUB,$J,
; ^TMP("ETSTAX",$J, Default
;
; ETSVER Versioning Flag (optional, default = 0)
;
; 0 Return active and inactive codes
; 1 Version, return active codes only
;
; Output:
;
; $$TAX The number of codes found or -1 ^ error message
;
; ^TMP(ETSSUB,$J,ETSSRC,(ETSCODE_" "),#)
;
; 5 piece "^" delimited string
;
; 1 Activation Date (can be a future date)
; 2 Inactivation Date (can be a future date)
; 3 Not Needed (NULL)
; 4 Variable Pointer to a National file (i.e. <IEN>ETSLNC(129.1,
; 5 LONG COMMON NAME (field #83)
;
; ^TMP(ETSSUB,$J,ETSSRC,(ETSCODE_" "),#,0)
;
; 2 piece "^" delimited string
;
; 1 Code (no spaces)
; 2 Fully Specified Name (Field #80)
;
N ETSIEN,ETSNUM,ETSLNCDG
;
;Check for Parameter errors
Q:$G(ETSX)="" "-1^Search Text Missing"
S:$G(ETSSRC)="" ETSSRC="LNC"
I ETSSRC'="LNC" Q "-1^Invalid Source"
;
;Set Default values for optional parameters
S:$G(ETSDT)="" ETSDT=$$DT^XLFDT
; Make sure Date is a valid FileMan Date
Q:+$$CHKDATE^ETSLNC(ETSDT)=-1 "-1^Invalid Date"
;
S:$G(ETSSUB)="" ETSSUB="ETSTAX"
;Clear the temporary array in case there is older data in existence
K ^TMP(ETSSUB,$J)
;
S ETSVER=+$G(ETSVER)
I (ETSVER>1)!(ETSVER<0) Q "-1^Invalid Version Flag"
;
;Standardize search string to all CAPS to match Indexes
S ETSX=$$UP^XLFSTR($G(ETSX))
;
; Check data format. If it is in 1N.N-N format (i.e. 1-8 or 11111-8)
; or all numeric, then it is a LOINC Code (processed below)
I (ETSX?1N.N1"-"1N)!(ETSX?1N.N) D Q:(+ETSIEN=-1) ETSIEN
. ; Check for valid LOINC Code and retrieve the IEN, correct
. ; the input to be LOINC-Check Digit if necessary.
. I ETSX?1N.N D
.. S ETSIEN=$O(^ETSLNC(129.1,"B",ETSX,""))
.. I ETSIEN="" S ETSIEN="-1^Invalid LOINC Code" Q
.. S ETSLNCDG=ETSIEN_"-"_$P($G(^ETSLNC(129.1,ETSIEN,0)),U,15) ; Set LOINC code for the return array
. I ETSX?1N.N1"-"1N D
.. S ETSIEN=$$CHKCODE^ETSLNC1(ETSX),ETSLNCDG=ETSX ; Set the IEN and LOINC code for the return array
. Q:(+ETSIEN=-1)
. ;
. ;Update TMP array and counter
. S ETSCT=1
. D UPDARY(ETSLNCDG,.ETSCT,ETSIEN,ETSDT,ETSVER)
. S ^TMP(ETSSUB,$J,0)=ETSCT
;
;Otherwise, it's a text string. Call partial search algorithm
D:ETSX'?1N.N1"-"1N TEXTSRCH(ETSX,ETSSUB,ETSDT,ETSVER)
;
;
;Return # items found in the search
S ETSNUM=+($G(^TMP(ETSSUB,$J,0))) Q:ETSNUM'>0 "-1^No Entries Found"
Q ETSNUM
;
TEXTSRCH(ETSX,ETSSUB,ETSDT,ETSVER) ; Look for Taxonomy items by Text String
;
N ETSTERM,ETSCT,ETSDATA,I,ETSFLG,ETSIEN,ETSLCCD
;
;Apply Indexing formatting rules to the searching
S ETSX=$$PREPTEXT^ETSLNCIX(ETSX)
Q:ETSX="" ;No valid terms to search, exit
;
;Store each word in its own node in an local array
F I=1:1:$L(ETSX," ") S ETSTERM(I)=$P(ETSX," ",I)
;
;Initialize looping and counter variables
S (ETSCT,ETSIEN)=0
;
;Loop to find All IENS with all of the search terms
;(intersection of all of the terms sent)
S ETSTERM(0)=$L(ETSX," ")
F S ETSIEN=$O(^ETSLNC(129.1,"D",ETSTERM(1),ETSIEN)) Q:'ETSIEN D
. S ETSFLG=1 ; Assume all terms are in array
. I ETSTERM(0)>1 D
. . F I=2:1:ETSTERM(0) I ETSTERM(I)'="" I '$D(^ETSLNC(129.1,"D",ETSTERM(I),ETSIEN)) S ETSFLG=0 Q
. I ETSFLG S ^TMP(ETSSUB,$J,"RESULT",ETSIEN)="",ETSCT=ETSCT+1
;
;If no matches found, exit
Q:'ETSCT
;
;Reset Counter and Looping Variable
S ETSCT=0,ETSIEN=""
;
;Loop through the "RESULT" node to extract the necessary data to return
F S ETSIEN=$O(^TMP(ETSSUB,$J,"RESULT",ETSIEN)) Q:'ETSIEN D
. S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,0))
. Q:$G(ETSDATA)="" ; check for data corruption
. S ETSCT=ETSCT+1
. S ETSLCCD=$P(ETSDATA,U)_"-"_$P(ETSDATA,U,15) ; build LOINC Code for lookup
. D UPDARY(ETSLCCD,.ETSCT,ETSIEN,ETSDT,ETSVER)
S ^TMP(ETSSUB,$J,0)=ETSCT
;
;Clear the result node
K ^TMP(ETSSUB,$J,"RESULT")
Q
;
UPDARY(ETSX,ETSCT,ETSIEN,ETSDT,ETSVER) ; Update the Temporary array
;
N ETSSTR,ETSARY,ETSAPER,ETSINDT,ETSPERD,ETSNFLG
S (ETSINDT,ETSSTR)="",ETSNFLG=0
;
;Obtain the Activation History of the code)
S ETSAPER=$$PERIOD^ETSLNC(ETSX,"LNC",.ETSARY)
;
S ETSPERD=$O(ETSARY(ETSDT),-1) ;Get the current activation period
I ETSPERD=0 D
. I $G(ETSARY(ETSDT))="" S ETSNFLG=1 Q ;no activation history for date
. S ETSPERD=ETSDT ; otherwise, date is first day of activation
S:$G(ETSARY(ETSPERD))'=0 ETSINDT=$P(ETSARY(ETSPERD),U)
;
;stop processing if version flag is for actives only and the code is inactive
;also adjust the counter
I (ETSVER),($G(ETSINDT)'=""),(ETSDT'<ETSINDT) S ETSFLG=1,ETSCT=ETSCT-1 Q
;
;If no Activation history, update Dates with NULL
I +ETSAPER'>0 D
. S $P(ETSSTR,U,1)="" ;Activation Date
. S $P(ETSSTR,U,2)="" ;Inactive date (If present)
;
;If Activation history, update the dates
I +ETSAPER>0 D
. I 'ETSNFLG D
.. S $P(ETSSTR,U,1)=ETSPERD ;Activation Date
.. S $P(ETSSTR,U,2)=ETSINDT ;Inactive date (If present)
S $P(ETSSTR,U,4)=ETSIEN_";ETSLNC(129.1," ;Variable pointer
S $P(ETSSTR,U,5)=$G(^ETSLNC(129.1,ETSIEN,83)) ;Long Common Name
S ^TMP(ETSSUB,$J,1,ETSX_" ",ETSCT)=ETSSTR
S ^TMP(ETSSUB,$J,1,ETSX_" ",ETSCT,0)=ETSX_"^"_$G(^ETSLNC(129.1,ETSIEN,80)) ;LOINC Code^Fully Specified Name
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSLNCTX 6240 printed Sep 23, 2025@19:30:14 Page 2
ETSLNCTX ;O-OIFO/FM23 - LOINC Taxonomy Search (Part 1) ;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 ;
TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Get Taxonomy Information
+1 ;
+2 ; Input:
+3 ;
+4 ; ETSX Search String Either a partial text or a LOINC Code with check digit
+5 ;
+6 ; ETSSRC Source: either LNC or LOINC
+7 ;
+8 ; ETSDT Date to use to evaluate status in FileMan Format (defaults to TODAY)
+9 ;
+10 ; ETSSUB Name of a subscript to use in the ^TMP
+11 ; global (optional)
+12 ;
+13 ; ^TMP(ETSSUB,$J,
+14 ; ^TMP("ETSTAX",$J, Default
+15 ;
+16 ; ETSVER Versioning Flag (optional, default = 0)
+17 ;
+18 ; 0 Return active and inactive codes
+19 ; 1 Version, return active codes only
+20 ;
+21 ; Output:
+22 ;
+23 ; $$TAX The number of codes found or -1 ^ error message
+24 ;
+25 ; ^TMP(ETSSUB,$J,ETSSRC,(ETSCODE_" "),#)
+26 ;
+27 ; 5 piece "^" delimited string
+28 ;
+29 ; 1 Activation Date (can be a future date)
+30 ; 2 Inactivation Date (can be a future date)
+31 ; 3 Not Needed (NULL)
+32 ; 4 Variable Pointer to a National file (i.e. <IEN>ETSLNC(129.1,
+33 ; 5 LONG COMMON NAME (field #83)
+34 ;
+35 ; ^TMP(ETSSUB,$J,ETSSRC,(ETSCODE_" "),#,0)
+36 ;
+37 ; 2 piece "^" delimited string
+38 ;
+39 ; 1 Code (no spaces)
+40 ; 2 Fully Specified Name (Field #80)
+41 ;
+42 NEW ETSIEN,ETSNUM,ETSLNCDG
+43 ;
+44 ;Check for Parameter errors
+45 if $GET(ETSX)=""
QUIT "-1^Search Text Missing"
+46 if $GET(ETSSRC)=""
SET ETSSRC="LNC"
+47 IF ETSSRC'="LNC"
QUIT "-1^Invalid Source"
+48 ;
+49 ;Set Default values for optional parameters
+50 if $GET(ETSDT)=""
SET ETSDT=$$DT^XLFDT
+51 ; Make sure Date is a valid FileMan Date
+52 if +$$CHKDATE^ETSLNC(ETSDT)=-1
QUIT "-1^Invalid Date"
+53 ;
+54 if $GET(ETSSUB)=""
SET ETSSUB="ETSTAX"
+55 ;Clear the temporary array in case there is older data in existence
+56 KILL ^TMP(ETSSUB,$JOB)
+57 ;
+58 SET ETSVER=+$GET(ETSVER)
+59 IF (ETSVER>1)!(ETSVER<0)
QUIT "-1^Invalid Version Flag"
+60 ;
+61 ;Standardize search string to all CAPS to match Indexes
+62 SET ETSX=$$UP^XLFSTR($GET(ETSX))
+63 ;
+64 ; Check data format. If it is in 1N.N-N format (i.e. 1-8 or 11111-8)
+65 ; or all numeric, then it is a LOINC Code (processed below)
+66 IF (ETSX?1N.N1"-"1N)!(ETSX?1N.N)
Begin DoDot:1
+67 ; Check for valid LOINC Code and retrieve the IEN, correct
+68 ; the input to be LOINC-Check Digit if necessary.
+69 IF ETSX?1N.N
Begin DoDot:2
+70 SET ETSIEN=$ORDER(^ETSLNC(129.1,"B",ETSX,""))
+71 IF ETSIEN=""
SET ETSIEN="-1^Invalid LOINC Code"
QUIT
+72 ; Set LOINC code for the return array
SET ETSLNCDG=ETSIEN_"-"_$PIECE($GET(^ETSLNC(129.1,ETSIEN,0)),U,15)
End DoDot:2
+73 IF ETSX?1N.N1"-"1N
Begin DoDot:2
+74 ; Set the IEN and LOINC code for the return array
SET ETSIEN=$$CHKCODE^ETSLNC1(ETSX)
SET ETSLNCDG=ETSX
End DoDot:2
+75 if (+ETSIEN=-1)
QUIT
+76 ;
+77 ;Update TMP array and counter
+78 SET ETSCT=1
+79 DO UPDARY(ETSLNCDG,.ETSCT,ETSIEN,ETSDT,ETSVER)
+80 SET ^TMP(ETSSUB,$JOB,0)=ETSCT
End DoDot:1
if (+ETSIEN=-1)
QUIT ETSIEN
+81 ;
+82 ;Otherwise, it's a text string. Call partial search algorithm
+83 if ETSX'?1N.N1"-"1N
DO TEXTSRCH(ETSX,ETSSUB,ETSDT,ETSVER)
+84 ;
+85 ;
+86 ;Return # items found in the search
+87 SET ETSNUM=+($GET(^TMP(ETSSUB,$JOB,0)))
if ETSNUM'>0
QUIT "-1^No Entries Found"
+88 QUIT ETSNUM
+89 ;
TEXTSRCH(ETSX,ETSSUB,ETSDT,ETSVER) ; Look for Taxonomy items by Text String
+1 ;
+2 NEW ETSTERM,ETSCT,ETSDATA,I,ETSFLG,ETSIEN,ETSLCCD
+3 ;
+4 ;Apply Indexing formatting rules to the searching
+5 SET ETSX=$$PREPTEXT^ETSLNCIX(ETSX)
+6 ;No valid terms to search, exit
if ETSX=""
QUIT
+7 ;
+8 ;Store each word in its own node in an local array
+9 FOR I=1:1:$LENGTH(ETSX," ")
SET ETSTERM(I)=$PIECE(ETSX," ",I)
+10 ;
+11 ;Initialize looping and counter variables
+12 SET (ETSCT,ETSIEN)=0
+13 ;
+14 ;Loop to find All IENS with all of the search terms
+15 ;(intersection of all of the terms sent)
+16 SET ETSTERM(0)=$LENGTH(ETSX," ")
+17 FOR
SET ETSIEN=$ORDER(^ETSLNC(129.1,"D",ETSTERM(1),ETSIEN))
if 'ETSIEN
QUIT
Begin DoDot:1
+18 ; Assume all terms are in array
SET ETSFLG=1
+19 IF ETSTERM(0)>1
Begin DoDot:2
+20 FOR I=2:1:ETSTERM(0)
IF ETSTERM(I)'=""
IF '$DATA(^ETSLNC(129.1,"D",ETSTERM(I),ETSIEN))
SET ETSFLG=0
QUIT
End DoDot:2
+21 IF ETSFLG
SET ^TMP(ETSSUB,$JOB,"RESULT",ETSIEN)=""
SET ETSCT=ETSCT+1
End DoDot:1
+22 ;
+23 ;If no matches found, exit
+24 if 'ETSCT
QUIT
+25 ;
+26 ;Reset Counter and Looping Variable
+27 SET ETSCT=0
SET ETSIEN=""
+28 ;
+29 ;Loop through the "RESULT" node to extract the necessary data to return
+30 FOR
SET ETSIEN=$ORDER(^TMP(ETSSUB,$JOB,"RESULT",ETSIEN))
if 'ETSIEN
QUIT
Begin DoDot:1
+31 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,0))
+32 ; check for data corruption
if $GET(ETSDATA)=""
QUIT
+33 SET ETSCT=ETSCT+1
+34 ; build LOINC Code for lookup
SET ETSLCCD=$PIECE(ETSDATA,U)_"-"_$PIECE(ETSDATA,U,15)
+35 DO UPDARY(ETSLCCD,.ETSCT,ETSIEN,ETSDT,ETSVER)
End DoDot:1
+36 SET ^TMP(ETSSUB,$JOB,0)=ETSCT
+37 ;
+38 ;Clear the result node
+39 KILL ^TMP(ETSSUB,$JOB,"RESULT")
+40 QUIT
+41 ;
UPDARY(ETSX,ETSCT,ETSIEN,ETSDT,ETSVER) ; Update the Temporary array
+1 ;
+2 NEW ETSSTR,ETSARY,ETSAPER,ETSINDT,ETSPERD,ETSNFLG
+3 SET (ETSINDT,ETSSTR)=""
SET ETSNFLG=0
+4 ;
+5 ;Obtain the Activation History of the code)
+6 SET ETSAPER=$$PERIOD^ETSLNC(ETSX,"LNC",.ETSARY)
+7 ;
+8 ;Get the current activation period
SET ETSPERD=$ORDER(ETSARY(ETSDT),-1)
+9 IF ETSPERD=0
Begin DoDot:1
+10 ;no activation history for date
IF $GET(ETSARY(ETSDT))=""
SET ETSNFLG=1
QUIT
+11 ; otherwise, date is first day of activation
SET ETSPERD=ETSDT
End DoDot:1
+12 if $GET(ETSARY(ETSPERD))'=0
SET ETSINDT=$PIECE(ETSARY(ETSPERD),U)
+13 ;
+14 ;stop processing if version flag is for actives only and the code is inactive
+15 ;also adjust the counter
+16 IF (ETSVER)
IF ($GET(ETSINDT)'="")
IF (ETSDT'<ETSINDT)
SET ETSFLG=1
SET ETSCT=ETSCT-1
QUIT
+17 ;
+18 ;If no Activation history, update Dates with NULL
+19 IF +ETSAPER'>0
Begin DoDot:1
+20 ;Activation Date
SET $PIECE(ETSSTR,U,1)=""
+21 ;Inactive date (If present)
SET $PIECE(ETSSTR,U,2)=""
End DoDot:1
+22 ;
+23 ;If Activation history, update the dates
+24 IF +ETSAPER>0
Begin DoDot:1
+25 IF 'ETSNFLG
Begin DoDot:2
+26 ;Activation Date
SET $PIECE(ETSSTR,U,1)=ETSPERD
+27 ;Inactive date (If present)
SET $PIECE(ETSSTR,U,2)=ETSINDT
End DoDot:2
End DoDot:1
+28 ;Variable pointer
SET $PIECE(ETSSTR,U,4)=ETSIEN_";ETSLNC(129.1,"
+29 ;Long Common Name
SET $PIECE(ETSSTR,U,5)=$GET(^ETSLNC(129.1,ETSIEN,83))
+30 SET ^TMP(ETSSUB,$JOB,1,ETSX_" ",ETSCT)=ETSSTR
+31 ;LOINC Code^Fully Specified Name
SET ^TMP(ETSSUB,$JOB,1,ETSX_" ",ETSCT,0)=ETSX_"^"_$GET(^ETSLNC(129.1,ETSIEN,80))
+32 QUIT
