ETSLNC2 ;O-OIFO/FM23 - LOINC APIs 3 ;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
;
VERSION() ;Get LOINC Version
; The LOINC Version is stored in the PACKAGE REVISION DATA
; node of the definition of the LOINC file (#129.1).
;
; Input -- None
; Output -- $$VERSION - LOINC Version, Null, or
; -1^File Definition Error
;
N ETSANS,ETSARY,ETSERR
;
; Query data
D FILE^DID(129.1,"","PACKAGE REVISION DATA","ETSARY","ETSERR")
;
; Quit if error occurred during query
Q:$D(ETSERR) "-1^File Definition Error"
;
;Set-up LOINC version to return
; Initialize
S ETSANS=""
I $D(ETSARY("PACKAGE REVISION DATA")) D
. S ETSANS=$P($G(ETSARY("PACKAGE REVISION DATA")),U)
Q ETSANS
;
COMLST(ETSCOM,ETSTYP,ETSSUB) ;Get List by Component
; Input --
; ETSCOM Component to look up. Either IEN (File 129.1, field 1)
; or Name (129.11, field .01)
; ETSTYP Type of Component, either (I)EN or (N)ame (default is N)
; ETSSUB Subscript used to store the data in
; Default is "ETSCOMP"
;
; Output --
; ^TMP(ETSSUB,$J,"COMP",ETSCODE) Fully Specified Name field (#80)
;
; Note: ETSARR is not initialized (ie KILLed) on input
; The calling application is responsible for
; initializing the array.
;
; COMLST = 1 - Success
; -1^<message> - Error
; 0 - Component not used
;
N ETSCIEN,ETSCODE,ETSFSN,ETSCMIEN
;
;Set default array Subscript
S:$G(ETSSUB)="" ETSSUB="ETSCOMP"
;
;Clean up temp array.
K ^TMP(ETSSUB,$J)
;
S ETSCOM=$$TRIM^XLFSTR(ETSCOM)
;
;Quit if no component sent
Q:$G(ETSCOM)="" "-1^Component is missing"
;
S ETSCOM=$$UP^XLFSTR(ETSCOM)
;Set Input Type to default of "N", if not defined
S:$G(ETSTYP)="" ETSTYP="N"
I (ETSTYP'="N"),(ETSTYP'="I") Q "-1^Invalid Input Type"
;
;If the component is an IEN, do setup.
S:ETSTYP="I" ETSCMIEN=ETSCOM
;If the component is a name, find its IEN and do setup
; Quit with error message if name not found in Component index, (File 129.11, Index "B"
I ETSTYP="N" Q:'$D(^ETSLNC(129.11,"B",$E(ETSCOM,1,240))) "-1^Component Not Found" D
. S ETSCMIEN=$O(^ETSLNC(129.11,"B",$E(ETSCOM,1,240),""))
;
;Set-up LOINC List to return
S ETSCIEN=0
;
F S ETSCIEN=$O(^ETSLNC(129.1,"C",ETSCMIEN,ETSCIEN)) Q:'ETSCIEN D
. I $D(^ETSLNC(129.1,ETSCIEN,0)) D
.. S ETSCODE=$P(^ETSLNC(129.1,ETSCIEN,0),"^")
.. ;get the fully specified name (fsn)
.. S ETSFSN=$G(^ETSLNC(129.1,ETSCIEN,80))
.. ;Save the fully specified name to the array.
.. S ^TMP(ETSSUB,$J,"COMP",ETSCODE)=ETSFSN
;
;If the component was found in a LOINC Code,
; return 1
Q:$D(^TMP(ETSSUB,$J)) 1
;otherwise, return 0
Q 0
;
DEPLST(ETSSUB) ;Get Deprecated List
; Input -- (Optional) ETSSUB Subscript for the
; Temporary Deprecated List Array
; (Default is "ETSDEP")
;
; Output -- Temporary Global Deprecated List Array
; ^TMP(ETSSUB,$J,"DEPRECATED",<ETSCODE>)=Fully Specified Name field (#80)
; $$DEPLST - 1 Deprecated items found
; 0 No Deprecated items found
;
;Set default subscript if necessary.
S:$G(ETSSUB)="" ETSSUB="ETSDEP"
;
;Clear array
K ^TMP(ETSSUB,$J)
;
N ETSCIEN,ETSCODE
;
;Create List to return
S ETSCIEN=0
F S ETSCIEN=$O(^ETSLNC(129.1,"AD",1,ETSCIEN)) Q:'ETSCIEN D
. I $D(^ETSLNC(129.1,ETSCIEN,0)) D
.. S ETSCODE=$P(^ETSLNC(129.1,ETSCIEN,0),"^",1)
.. S ^TMP(ETSSUB,$J,"DEPRECATED",ETSCODE)=$G(^ETSLNC(129.1,ETSCIEN,80))
;
;Exiting:
; If deprecated items found
Q:$D(^TMP(ETSSUB,$J)) 1
;Otherwise, send 0 - no results
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSLNC2 3847 printed Sep 23, 2025@19:30:12 Page 2
ETSLNC2 ;O-OIFO/FM23 - LOINC APIs 3 ;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 ;
VERSION() ;Get LOINC Version
+1 ; The LOINC Version is stored in the PACKAGE REVISION DATA
+2 ; node of the definition of the LOINC file (#129.1).
+3 ;
+4 ; Input -- None
+5 ; Output -- $$VERSION - LOINC Version, Null, or
+6 ; -1^File Definition Error
+7 ;
+8 NEW ETSANS,ETSARY,ETSERR
+9 ;
+10 ; Query data
+11 DO FILE^DID(129.1,"","PACKAGE REVISION DATA","ETSARY","ETSERR")
+12 ;
+13 ; Quit if error occurred during query
+14 if $DATA(ETSERR)
QUIT "-1^File Definition Error"
+15 ;
+16 ;Set-up LOINC version to return
+17 ; Initialize
+18 SET ETSANS=""
+19 IF $DATA(ETSARY("PACKAGE REVISION DATA"))
Begin DoDot:1
+20 SET ETSANS=$PIECE($GET(ETSARY("PACKAGE REVISION DATA")),U)
End DoDot:1
+21 QUIT ETSANS
+22 ;
COMLST(ETSCOM,ETSTYP,ETSSUB) ;Get List by Component
+1 ; Input --
+2 ; ETSCOM Component to look up. Either IEN (File 129.1, field 1)
+3 ; or Name (129.11, field .01)
+4 ; ETSTYP Type of Component, either (I)EN or (N)ame (default is N)
+5 ; ETSSUB Subscript used to store the data in
+6 ; Default is "ETSCOMP"
+7 ;
+8 ; Output --
+9 ; ^TMP(ETSSUB,$J,"COMP",ETSCODE) Fully Specified Name field (#80)
+10 ;
+11 ; Note: ETSARR is not initialized (ie KILLed) on input
+12 ; The calling application is responsible for
+13 ; initializing the array.
+14 ;
+15 ; COMLST = 1 - Success
+16 ; -1^<message> - Error
+17 ; 0 - Component not used
+18 ;
+19 NEW ETSCIEN,ETSCODE,ETSFSN,ETSCMIEN
+20 ;
+21 ;Set default array Subscript
+22 if $GET(ETSSUB)=""
SET ETSSUB="ETSCOMP"
+23 ;
+24 ;Clean up temp array.
+25 KILL ^TMP(ETSSUB,$JOB)
+26 ;
+27 SET ETSCOM=$$TRIM^XLFSTR(ETSCOM)
+28 ;
+29 ;Quit if no component sent
+30 if $GET(ETSCOM)=""
QUIT "-1^Component is missing"
+31 ;
+32 SET ETSCOM=$$UP^XLFSTR(ETSCOM)
+33 ;Set Input Type to default of "N", if not defined
+34 if $GET(ETSTYP)=""
SET ETSTYP="N"
+35 IF (ETSTYP'="N")
IF (ETSTYP'="I")
QUIT "-1^Invalid Input Type"
+36 ;
+37 ;If the component is an IEN, do setup.
+38 if ETSTYP="I"
SET ETSCMIEN=ETSCOM
+39 ;If the component is a name, find its IEN and do setup
+40 ; Quit with error message if name not found in Component index, (File 129.11, Index "B"
+41 IF ETSTYP="N"
if '$DATA(^ETSLNC(129.11,"B",$EXTRACT(ETSCOM,1,240)))
QUIT "-1^Component Not Found"
Begin DoDot:1
+42 SET ETSCMIEN=$ORDER(^ETSLNC(129.11,"B",$EXTRACT(ETSCOM,1,240),""))
End DoDot:1
+43 ;
+44 ;Set-up LOINC List to return
+45 SET ETSCIEN=0
+46 ;
+47 FOR
SET ETSCIEN=$ORDER(^ETSLNC(129.1,"C",ETSCMIEN,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+48 IF $DATA(^ETSLNC(129.1,ETSCIEN,0))
Begin DoDot:2
+49 SET ETSCODE=$PIECE(^ETSLNC(129.1,ETSCIEN,0),"^")
+50 ;get the fully specified name (fsn)
+51 SET ETSFSN=$GET(^ETSLNC(129.1,ETSCIEN,80))
+52 ;Save the fully specified name to the array.
+53 SET ^TMP(ETSSUB,$JOB,"COMP",ETSCODE)=ETSFSN
End DoDot:2
End DoDot:1
+54 ;
+55 ;If the component was found in a LOINC Code,
+56 ; return 1
+57 if $DATA(^TMP(ETSSUB,$JOB))
QUIT 1
+58 ;otherwise, return 0
+59 QUIT 0
+60 ;
DEPLST(ETSSUB) ;Get Deprecated List
+1 ; Input -- (Optional) ETSSUB Subscript for the
+2 ; Temporary Deprecated List Array
+3 ; (Default is "ETSDEP")
+4 ;
+5 ; Output -- Temporary Global Deprecated List Array
+6 ; ^TMP(ETSSUB,$J,"DEPRECATED",<ETSCODE>)=Fully Specified Name field (#80)
+7 ; $$DEPLST - 1 Deprecated items found
+8 ; 0 No Deprecated items found
+9 ;
+10 ;Set default subscript if necessary.
+11 if $GET(ETSSUB)=""
SET ETSSUB="ETSDEP"
+12 ;
+13 ;Clear array
+14 KILL ^TMP(ETSSUB,$JOB)
+15 ;
+16 NEW ETSCIEN,ETSCODE
+17 ;
+18 ;Create List to return
+19 SET ETSCIEN=0
+20 FOR
SET ETSCIEN=$ORDER(^ETSLNC(129.1,"AD",1,ETSCIEN))
if 'ETSCIEN
QUIT
Begin DoDot:1
+21 IF $DATA(^ETSLNC(129.1,ETSCIEN,0))
Begin DoDot:2
+22 SET ETSCODE=$PIECE(^ETSLNC(129.1,ETSCIEN,0),"^",1)
+23 SET ^TMP(ETSSUB,$JOB,"DEPRECATED",ETSCODE)=$GET(^ETSLNC(129.1,ETSCIEN,80))
End DoDot:2
End DoDot:1
+24 ;
+25 ;Exiting:
+26 ; If deprecated items found
+27 if $DATA(^TMP(ETSSUB,$JOB))
QUIT 1
+28 ;Otherwise, send 0 - no results
+29 QUIT 0
