- 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 Feb 18, 2025@23:20:21 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