ETSLNC1 ;O-OIFO/FM23 - LOINC APIs 2 ;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
;
CHKCODE(ETSLOINC) ;Check if LOINC Code exists
;
;Input
; ETSLOINC: LOINC Code with Check digit in a nnnnn-n format (i.e. 12345-6, 1-8, etc.)
;
;Output
; $$CHKCODE: IEN of the Valid Code
; or
; -1^error message
;
N ETSCKDGT,ETSCODE,ETSIEN
;
;Validate that the LOINC Code is in the correct format
I ETSLOINC'?1.5N1"-"1N Q "-1^Invalid LOINC Code"
;
;Look for the LOINC code in the database
S ETSCKDGT=$P(ETSLOINC,"-",2),ETSCODE=$P(ETSLOINC,"-")
I '$D(^ETSLNC(129.1,"B",ETSCODE)) Q "-1^LOINC Code not found"
;
; Validate that the Code is defined in the Database
S ETSIEN=$O(^ETSLNC(129.1,"B",ETSCODE,""))
S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,0))
I ETSDATA="" Q "-1^LOINC Code data missing"
;
;Validate the Check Digit
I $P(ETSDATA,U,15)'=ETSCKDGT Q "-1^Invalid Check digit"
;
;Code is valid, return the IEN
Q ETSIEN
;
GETCODE(ETSIEN) ;Get LOINC Code by IEN
; Input -- ETSIEN LOINC file IEN
; Output -- $$GETCODE
; LOINC Code with check digit
; or
; -1^<error message> - Error
;
;Initialize default output
N ETSANS,ETSDATA
S ETSANS="-1^LOINC Code not found"
;
;Check for missing variable, exit if not defined
Q:$G(ETSIEN)="" "-1^Missing Parameter"
;
;Set-up LOINC Code to return
S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,0))
I ETSDATA'="" S ETSANS=$P(ETSDATA,U,1)_"-"_$P(ETSDATA,U,15)
Q $G(ETSANS)
;
GETNAME(ETSINPT,ETSINTY,NAME) ;Get LOINC Name Array by Code or IEN
; Input -- ETSINPT LOINC Code or IEN
; ETSINTY Input Type (Optional- Default "C")
; "C"=LOINC Code
; "I"=LOINC IEN
;
; Output -- NAME LOINC Name Array subscripts: (array will be cleared upon entry)
; ("FULLNAME")=Fully Specified Name field (#80)
; ("SHORTNAME")=ShortName field (#81)
; ("LONGNAME")=Long Common Name field (#83)
; or
; $$GETNAME 1 for success and results found
; 0 no results found
; or
; -1^<error message>
;
N ETSCIEN,ETSCODE
;
;Check for result array , exit if not defined
Q:'$D(NAME) "-1^Missing Return Array"
;
;Clear array pieces and re-initialize result array
K NAME("FULLNAME"),NAME("LONGNAME"),NAME("SHORTNAME")
;
;Check for existence of an IEN/Code
Q:$G(ETSINPT)="" "-1^Missing Code or IEN"
;
;Set Input Type to default of "C", if not defined
S:$G(ETSINTY)="" ETSINTY="C"
I (ETSINTY'="C"),(ETSINTY'="I") Q "-1^Invalid Input Type"
;
S ETSCIEN="" ; initialize the IEN.
;
;Check input for LOINC Code or IEN
;Assume the input type is an IEN
I ETSINTY="I" D Q:(ETSCIEN="") "-1^Invalid LOINC IEN"
. S:$D(^ETSLNC(129.1,ETSINPT,0)) ETSCIEN=ETSINPT
;if the input type was a code, retrieve the IEN.
I ETSINTY="C" D Q:(+ETSCIEN=-1) ETSCIEN
. S ETSCIEN=$$CHKCODE(ETSINPT)
;
;Set-up LOINC Name array to return
S NAME("FULLNAME")=$G(^ETSLNC(129.1,ETSCIEN,80))
S NAME("SHORTNAME")=$G(^ETSLNC(129.1,ETSCIEN,81))
S NAME("LONGNAME")=$G(^ETSLNC(129.1,ETSCIEN,83))
Q 1
;
GETIEN(ETSCODE) ;Retrieve the IEN if given a code.
Q:$G(ETSCODE)="" "" ;Return "" if code not sent in
Q $O(^ETSLNC(129.1,"B",ETSCODE,"")) ;No duplicates so return code
;
GETSTAT(ETSINPT,ETSTYP) ; Retrieves the current Status.
;
;Input
; ETSINPT: LOINC Code or LOINC IEN
; ETSTYP: Input Type, either C for Code (default) or I for IEN
;
;Output
; $$GETSTAT: Current Status (Internal format^External Format)
; or
; -1^error code
;
N ETSCIEN,ETSCODE,ETSSTATI,ETSANS
;
;Check for missing variable, exit if not defined
Q:$G(ETSINPT)="" "-1^Missing LOINC Code"
;
;Set Input Type to default of "C", if not defined
S:$G(ETSTYP)="" ETSTYP="C"
S ETSTYP=$$UP^XLFSTR(ETSTYP)
I (ETSTYP'="C"),(ETSTYP'="I") Q "-1^Invalid Input Type"
;
;Check input for LOINC Code or IEN
;Assume the input type is an IEN
S:ETSTYP="I" ETSCIEN=ETSINPT
;
;if the input type was a code, retrieve the IEN.
I ETSTYP="C" S ETSINPT=$$UP^XLFSTR(ETSINPT),ETSCIEN=$$CHKCODE(ETSINPT)
;
;Exit if the IEN was either not passed in or not found.
Q:(+ETSCIEN=-1) ETSCIEN
;
;Exit if IEN, but no data for IEN
Q:'$D(^ETSLNC(129.1,ETSCIEN,0)) "-1^LOINC IEN Not Found"
;
;Get LOINC Status
S ETSSTATI=$P($G(^ETSLNC(129.1,ETSCIEN,4)),"^",1)
;
;Set-up LOINC Status to return
;return Active if no status found (per field definition)
Q:ETSSTATI="" "^ACTIVE"
;
;return status (Internal^external) if found
S ETSANS=ETSSTATI_"^"_$$EXTERNAL^DILFD(129.1,20,"",ETSSTATI)
Q $G(ETSANS)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSLNC1 4977 printed Dec 13, 2024@01:53:57 Page 2
ETSLNC1 ;O-OIFO/FM23 - LOINC APIs 2 ;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 ;
CHKCODE(ETSLOINC) ;Check if LOINC Code exists
+1 ;
+2 ;Input
+3 ; ETSLOINC: LOINC Code with Check digit in a nnnnn-n format (i.e. 12345-6, 1-8, etc.)
+4 ;
+5 ;Output
+6 ; $$CHKCODE: IEN of the Valid Code
+7 ; or
+8 ; -1^error message
+9 ;
+10 NEW ETSCKDGT,ETSCODE,ETSIEN
+11 ;
+12 ;Validate that the LOINC Code is in the correct format
+13 IF ETSLOINC'?1.5N1"-"1N
QUIT "-1^Invalid LOINC Code"
+14 ;
+15 ;Look for the LOINC code in the database
+16 SET ETSCKDGT=$PIECE(ETSLOINC,"-",2)
SET ETSCODE=$PIECE(ETSLOINC,"-")
+17 IF '$DATA(^ETSLNC(129.1,"B",ETSCODE))
QUIT "-1^LOINC Code not found"
+18 ;
+19 ; Validate that the Code is defined in the Database
+20 SET ETSIEN=$ORDER(^ETSLNC(129.1,"B",ETSCODE,""))
+21 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,0))
+22 IF ETSDATA=""
QUIT "-1^LOINC Code data missing"
+23 ;
+24 ;Validate the Check Digit
+25 IF $PIECE(ETSDATA,U,15)'=ETSCKDGT
QUIT "-1^Invalid Check digit"
+26 ;
+27 ;Code is valid, return the IEN
+28 QUIT ETSIEN
+29 ;
GETCODE(ETSIEN) ;Get LOINC Code by IEN
+1 ; Input -- ETSIEN LOINC file IEN
+2 ; Output -- $$GETCODE
+3 ; LOINC Code with check digit
+4 ; or
+5 ; -1^<error message> - Error
+6 ;
+7 ;Initialize default output
+8 NEW ETSANS,ETSDATA
+9 SET ETSANS="-1^LOINC Code not found"
+10 ;
+11 ;Check for missing variable, exit if not defined
+12 if $GET(ETSIEN)=""
QUIT "-1^Missing Parameter"
+13 ;
+14 ;Set-up LOINC Code to return
+15 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,0))
+16 IF ETSDATA'=""
SET ETSANS=$PIECE(ETSDATA,U,1)_"-"_$PIECE(ETSDATA,U,15)
+17 QUIT $GET(ETSANS)
+18 ;
GETNAME(ETSINPT,ETSINTY,NAME) ;Get LOINC Name Array by Code or IEN
+1 ; Input -- ETSINPT LOINC Code or IEN
+2 ; ETSINTY Input Type (Optional- Default "C")
+3 ; "C"=LOINC Code
+4 ; "I"=LOINC IEN
+5 ;
+6 ; Output -- NAME LOINC Name Array subscripts: (array will be cleared upon entry)
+7 ; ("FULLNAME")=Fully Specified Name field (#80)
+8 ; ("SHORTNAME")=ShortName field (#81)
+9 ; ("LONGNAME")=Long Common Name field (#83)
+10 ; or
+11 ; $$GETNAME 1 for success and results found
+12 ; 0 no results found
+13 ; or
+14 ; -1^<error message>
+15 ;
+16 NEW ETSCIEN,ETSCODE
+17 ;
+18 ;Check for result array , exit if not defined
+19 if '$DATA(NAME)
QUIT "-1^Missing Return Array"
+20 ;
+21 ;Clear array pieces and re-initialize result array
+22 KILL NAME("FULLNAME"),NAME("LONGNAME"),NAME("SHORTNAME")
+23 ;
+24 ;Check for existence of an IEN/Code
+25 if $GET(ETSINPT)=""
QUIT "-1^Missing Code or IEN"
+26 ;
+27 ;Set Input Type to default of "C", if not defined
+28 if $GET(ETSINTY)=""
SET ETSINTY="C"
+29 IF (ETSINTY'="C")
IF (ETSINTY'="I")
QUIT "-1^Invalid Input Type"
+30 ;
+31 ; initialize the IEN.
SET ETSCIEN=""
+32 ;
+33 ;Check input for LOINC Code or IEN
+34 ;Assume the input type is an IEN
+35 IF ETSINTY="I"
Begin DoDot:1
+36 if $DATA(^ETSLNC(129.1,ETSINPT,0))
SET ETSCIEN=ETSINPT
End DoDot:1
if (ETSCIEN="")
QUIT "-1^Invalid LOINC IEN"
+37 ;if the input type was a code, retrieve the IEN.
+38 IF ETSINTY="C"
Begin DoDot:1
+39 SET ETSCIEN=$$CHKCODE(ETSINPT)
End DoDot:1
if (+ETSCIEN=-1)
QUIT ETSCIEN
+40 ;
+41 ;Set-up LOINC Name array to return
+42 SET NAME("FULLNAME")=$GET(^ETSLNC(129.1,ETSCIEN,80))
+43 SET NAME("SHORTNAME")=$GET(^ETSLNC(129.1,ETSCIEN,81))
+44 SET NAME("LONGNAME")=$GET(^ETSLNC(129.1,ETSCIEN,83))
+45 QUIT 1
+46 ;
GETIEN(ETSCODE) ;Retrieve the IEN if given a code.
+1 ;Return "" if code not sent in
if $GET(ETSCODE)=""
QUIT ""
+2 ;No duplicates so return code
QUIT $ORDER(^ETSLNC(129.1,"B",ETSCODE,""))
+3 ;
GETSTAT(ETSINPT,ETSTYP) ; Retrieves the current Status.
+1 ;
+2 ;Input
+3 ; ETSINPT: LOINC Code or LOINC IEN
+4 ; ETSTYP: Input Type, either C for Code (default) or I for IEN
+5 ;
+6 ;Output
+7 ; $$GETSTAT: Current Status (Internal format^External Format)
+8 ; or
+9 ; -1^error code
+10 ;
+11 NEW ETSCIEN,ETSCODE,ETSSTATI,ETSANS
+12 ;
+13 ;Check for missing variable, exit if not defined
+14 if $GET(ETSINPT)=""
QUIT "-1^Missing LOINC Code"
+15 ;
+16 ;Set Input Type to default of "C", if not defined
+17 if $GET(ETSTYP)=""
SET ETSTYP="C"
+18 SET ETSTYP=$$UP^XLFSTR(ETSTYP)
+19 IF (ETSTYP'="C")
IF (ETSTYP'="I")
QUIT "-1^Invalid Input Type"
+20 ;
+21 ;Check input for LOINC Code or IEN
+22 ;Assume the input type is an IEN
+23 if ETSTYP="I"
SET ETSCIEN=ETSINPT
+24 ;
+25 ;if the input type was a code, retrieve the IEN.
+26 IF ETSTYP="C"
SET ETSINPT=$$UP^XLFSTR(ETSINPT)
SET ETSCIEN=$$CHKCODE(ETSINPT)
+27 ;
+28 ;Exit if the IEN was either not passed in or not found.
+29 if (+ETSCIEN=-1)
QUIT ETSCIEN
+30 ;
+31 ;Exit if IEN, but no data for IEN
+32 if '$DATA(^ETSLNC(129.1,ETSCIEN,0))
QUIT "-1^LOINC IEN Not Found"
+33 ;
+34 ;Get LOINC Status
+35 SET ETSSTATI=$PIECE($GET(^ETSLNC(129.1,ETSCIEN,4)),"^",1)
+36 ;
+37 ;Set-up LOINC Status to return
+38 ;return Active if no status found (per field definition)
+39 if ETSSTATI=""
QUIT "^ACTIVE"
+40 ;
+41 ;return status (Internal^external) if found
+42 SET ETSANS=ETSSTATI_"^"_$$EXTERNAL^DILFD(129.1,20,"",ETSSTATI)
+43 QUIT $GET(ETSANS)
+44 ;
