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

ETSLNC2.m

Go to the documentation of this file.
  1. ETSLNC2 ;O-OIFO/FM23 - LOINC APIs 3 ;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. VERSION() ;Get LOINC Version
  1. ; The LOINC Version is stored in the PACKAGE REVISION DATA
  1. ; node of the definition of the LOINC file (#129.1).
  1. ;
  1. ; Input -- None
  1. ; Output -- $$VERSION - LOINC Version, Null, or
  1. ; -1^File Definition Error
  1. ;
  1. N ETSANS,ETSARY,ETSERR
  1. ;
  1. ; Query data
  1. D FILE^DID(129.1,"","PACKAGE REVISION DATA","ETSARY","ETSERR")
  1. ;
  1. ; Quit if error occurred during query
  1. Q:$D(ETSERR) "-1^File Definition Error"
  1. ;
  1. ;Set-up LOINC version to return
  1. ; Initialize
  1. S ETSANS=""
  1. I $D(ETSARY("PACKAGE REVISION DATA")) D
  1. . S ETSANS=$P($G(ETSARY("PACKAGE REVISION DATA")),U)
  1. Q ETSANS
  1. ;
  1. COMLST(ETSCOM,ETSTYP,ETSSUB) ;Get List by Component
  1. ; Input --
  1. ; ETSCOM Component to look up. Either IEN (File 129.1, field 1)
  1. ; or Name (129.11, field .01)
  1. ; ETSTYP Type of Component, either (I)EN or (N)ame (default is N)
  1. ; ETSSUB Subscript used to store the data in
  1. ; Default is "ETSCOMP"
  1. ;
  1. ; Output --
  1. ; ^TMP(ETSSUB,$J,"COMP",ETSCODE) Fully Specified Name field (#80)
  1. ;
  1. ; Note: ETSARR is not initialized (ie KILLed) on input
  1. ; The calling application is responsible for
  1. ; initializing the array.
  1. ;
  1. ; COMLST = 1 - Success
  1. ; -1^<message> - Error
  1. ; 0 - Component not used
  1. ;
  1. N ETSCIEN,ETSCODE,ETSFSN,ETSCMIEN
  1. ;
  1. ;Set default array Subscript
  1. S:$G(ETSSUB)="" ETSSUB="ETSCOMP"
  1. ;
  1. ;Clean up temp array.
  1. K ^TMP(ETSSUB,$J)
  1. ;
  1. S ETSCOM=$$TRIM^XLFSTR(ETSCOM)
  1. ;
  1. ;Quit if no component sent
  1. Q:$G(ETSCOM)="" "-1^Component is missing"
  1. ;
  1. S ETSCOM=$$UP^XLFSTR(ETSCOM)
  1. ;Set Input Type to default of "N", if not defined
  1. S:$G(ETSTYP)="" ETSTYP="N"
  1. I (ETSTYP'="N"),(ETSTYP'="I") Q "-1^Invalid Input Type"
  1. ;
  1. ;If the component is an IEN, do setup.
  1. S:ETSTYP="I" ETSCMIEN=ETSCOM
  1. ;If the component is a name, find its IEN and do setup
  1. ; Quit with error message if name not found in Component index, (File 129.11, Index "B"
  1. I ETSTYP="N" Q:'$D(^ETSLNC(129.11,"B",$E(ETSCOM,1,240))) "-1^Component Not Found" D
  1. . S ETSCMIEN=$O(^ETSLNC(129.11,"B",$E(ETSCOM,1,240),""))
  1. ;
  1. ;Set-up LOINC List to return
  1. S ETSCIEN=0
  1. ;
  1. F S ETSCIEN=$O(^ETSLNC(129.1,"C",ETSCMIEN,ETSCIEN)) Q:'ETSCIEN D
  1. . I $D(^ETSLNC(129.1,ETSCIEN,0)) D
  1. .. S ETSCODE=$P(^ETSLNC(129.1,ETSCIEN,0),"^")
  1. .. ;get the fully specified name (fsn)
  1. .. S ETSFSN=$G(^ETSLNC(129.1,ETSCIEN,80))
  1. .. ;Save the fully specified name to the array.
  1. .. S ^TMP(ETSSUB,$J,"COMP",ETSCODE)=ETSFSN
  1. ;
  1. ;If the component was found in a LOINC Code,
  1. ; return 1
  1. Q:$D(^TMP(ETSSUB,$J)) 1
  1. ;otherwise, return 0
  1. Q 0
  1. ;
  1. DEPLST(ETSSUB) ;Get Deprecated List
  1. ; Input -- (Optional) ETSSUB Subscript for the
  1. ; Temporary Deprecated List Array
  1. ; (Default is "ETSDEP")
  1. ;
  1. ; Output -- Temporary Global Deprecated List Array
  1. ; ^TMP(ETSSUB,$J,"DEPRECATED",<ETSCODE>)=Fully Specified Name field (#80)
  1. ; $$DEPLST - 1 Deprecated items found
  1. ; 0 No Deprecated items found
  1. ;
  1. ;Set default subscript if necessary.
  1. S:$G(ETSSUB)="" ETSSUB="ETSDEP"
  1. ;
  1. ;Clear array
  1. K ^TMP(ETSSUB,$J)
  1. ;
  1. N ETSCIEN,ETSCODE
  1. ;
  1. ;Create List to return
  1. S ETSCIEN=0
  1. F S ETSCIEN=$O(^ETSLNC(129.1,"AD",1,ETSCIEN)) Q:'ETSCIEN D
  1. . I $D(^ETSLNC(129.1,ETSCIEN,0)) D
  1. .. S ETSCODE=$P(^ETSLNC(129.1,ETSCIEN,0),"^",1)
  1. .. S ^TMP(ETSSUB,$J,"DEPRECATED",ETSCODE)=$G(^ETSLNC(129.1,ETSCIEN,80))
  1. ;
  1. ;Exiting:
  1. ; If deprecated items found
  1. Q:$D(^TMP(ETSSUB,$J)) 1
  1. ;Otherwise, send 0 - no results
  1. Q 0