- ETSLNC ;O-OIFO/FM23 - LOINC APIs ;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
- ;
- HIST(ETSCODE,ETSSYS,ARY) ; Get Activation History for a Code
- ;
- ; Input:
- ;
- ; ETSCODE LOINC Code with Check Digit (required)
- ; ETSSYS Coding System (required) [hard coded to LNC]
- ; .ARY Array, passed by Reference (required)
- ;
- ; Output:
- ;
- ; $$HIST Number of Histories Found
- ; or
- ; -1 ^ error message
- ;
- ; ARY(0) = Number of Activation History
- ; ARY(0,0) = Code ^ "LNC" ^ "LOINC"
- ; ARY(<date>,<status>) = Comment
- ;
- ;Note:
- ; This software was written based upon the current
- ; standard of a 1 to 1 relationship between the LOINC
- ; Code and its associated IEN.
- ;
- N ETSSI,ETSTD,ETSSTAT,ETSDATE,ETSIEN,ETSN,ETSFLG
- N ETSDIEN,ETSDATA
- K ARY
- ;
- ;Validate the input
- Q:'$G(ETSCODE) "-1^Code missing"
- ;
- ; Check for valid LOINC Code and retrieve the IEN
- S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
- Q:(+ETSIEN=-1) ETSIEN
- ;
- S:$G(ETSSYS)="" ETSSYS="LNC"
- Q:ETSSYS'="LNC" "-1^Invalid source"
- ;
- S ETSSI="LNC^LOINC"
- S ETSTD=$$DT^XLFDT
- ;
- ; Loop through Activation History Multiple to get the information.
- S ETSDATE=0
- F S ETSDATE=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE)) Q:'ETSDATE D
- . S ETSDIEN=0
- . F S ETSDIEN=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE,ETSDIEN)) Q:'ETSDIEN D
- . . S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
- . . Q:ETSDATA="" ; validate that the IEN and history exists
- . . S ETSSTAT=$P(ETSDATA,U,2)
- . . I '$D(ARY(ETSDATE,ETSSTAT)) D
- . . . S ARY(0)=+($G(ARY(0)))+1
- . . . S ARY(ETSDATE,ETSSTAT)=""
- ;
- ; Loop through and update the comment portion of the array
- S ETSDATE=0,ETSFLG=0
- F S ETSDATE=$O(ARY(ETSDATE)) Q:+ETSDATE'>0 D
- . S ETSSTAT=""
- . F S ETSSTAT=$O(ARY(ETSDATE,ETSSTAT)) Q:'$L(ETSSTAT) D
- . . I +ETSSTAT>0,ETSFLG'=1 S ARY(ETSDATE,ETSSTAT)="Activated",ETSFLG=1 Q
- . . I +ETSSTAT'>0 S ARY(ETSDATE,ETSSTAT)="Inactivated" Q
- . . I +ETSSTAT>0 D
- . . . S ARY(ETSDATE,ETSSTAT)="Re-activated"
- . . . I $D(ARY(ETSDATE,0)) D
- . . . . S ARY(ETSDATE,ETSSTAT)="Revised" K ARY(ETSDATE,0)
- ;
- ; Count the # entries and update the comments for any future changes with the word Pending.
- K ARY(0)
- S ETSN=0,ETSDATE=""
- F S ETSDATE=$O(ARY(ETSDATE)) Q:'$L(ETSDATE) D
- . S ETSSTAT="" F S ETSSTAT=$O(ARY(ETSDATE,ETSSTAT)) Q:'$L(ETSSTAT) D
- . . I ETSSTAT?1N,ETSDATE?7N,ETSDATE>ETSTD,$L($G(ARY(ETSDATE,ETSSTAT))) D
- . . . S ARY(ETSDATE,ETSSTAT)=$G(ARY(ETSDATE,ETSSTAT))_" (Pending)"
- . . S ETSN=ETSN+1
- ;
- Q:+ETSN'>0 "-1^No History Found"
- ;
- S ARY(0)=ETSN
- S:ETSN>0&($L(ETSSI))&($L(ETSCODE)) ARY(0,0)=ETSCODE_"^"_ETSSI
- Q ETSN
- ;
- PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
- ;
- ; Input:
- ;
- ; ETSCODE LOINC Code with Check digit (required)
- ; ETSSYS Coding System (Hardcode to look for LNC, required)
- ; .ARY Array, passed by Reference (required)
- ;
- ; Output:
- ;
- ; $$PERIOD Multiple piece "^" delimited string
- ;
- ; 1 Number of Activation Periods found
- ; 2 NULL
- ; 3 "LNC"
- ; 4 "LOINC"
- ; 5 "Logical Observation Identifier Names and Codes"
- ;
- ; or
- ;
- ; -1^Message (no entries or other error message)
- ;
- ; ARY(0) Same as $$PERIOD (above)
- ;
- ; ARY(Activation Date) = 4 piece "^" delimited string
- ;
- ; 1 Inactivation Date
- ; (conditional)
- ;
- ; 2 n/a
- ;
- ; 3 Variable Pointer IEN;ETSLNC(129.1,
- ;
- ; 4 Long Common Name (field #83)
- ;
- ; ARY(Activation Date,0) = Fully Specified Name (field #80
- ;
- ; Looks through the Activation History to build the information
- ;
- N ETSACT,ETSINA,ETSDT,ETSIEN,ETSIDT,ETSPER,ETSFSN
- N ETSCT,ETSLCN,ETSSD,ETSVP,ETSDATE
- ;
- Q:'$L($G(ETSCODE)) "-1^Missing Code"
- ;
- ; Check for valid LOINC Code and retrieve the IEN
- S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
- Q:(+ETSIEN=-1) ETSIEN
- ;
- S:$G(ETSSYS)="" ETSSYS="LNC"
- Q:ETSSYS'="LNC" "-1^Missing/Invalid Coding System"
- ;
- ; Hardcode the Coding system information for now.
- S ETSSD="LNC^LOINC^Logical Observation Identifier Names and Codes"
- K ARY
- ;
- ;Retrieve the entries
- S ETSDIEN=0
- F S ETSDIEN=$O(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN)) Q:'ETSDIEN D
- . S ETSDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
- . Q:ETSDATA=""
- . S ETSSTAT=$P(ETSDATA,U,2),ETSDATE=$P(ETSDATA,U)
- . ;If status is active, update active array
- . I ETSSTAT S ETSACT(ETSDATE)="" Q
- . ;Else update inactive array
- . S ETSINA(ETSDATE)=""
- ;
- ;Check for activation periods - if none, quit
- I '$D(ETSACT) D Q ARY(0)
- . S ARY(0)="-1^No activation periods found"
- ;
- ;Build the temp array for return to the user
- S ETSDT=""
- F S ETSDT=$O(ETSACT(ETSDT)) Q:'$L(ETSDT) D
- . ; Inactive Date
- . S ETSIDT=$O(ETSINA(ETSDT))
- . ; if no future inactivation, check for same day
- . S:ETSIDT="" ETSIDT=$G(ETSINA(ETSDT))
- . ; Fully specified name and Long Common Name
- . S ETSFSN=$G(^ETSLNC(129.1,+ETSIEN,80))
- . S ETSLCN=$G(^ETSLNC(129.1,+ETSIEN,83))
- . ; Kill inactive entry
- . K:ETSIDT?7N ETSINA(ETSIDT)
- . ; Variable Pointer
- . S ETSVP=ETSIEN_";ETSLNC(129.1,"
- . ; Set array
- . S ETSPER(ETSDT)=ETSIDT_"^^"_ETSVP_"^"_ETSLCN
- . S:$L(ETSFSN) ETSPER(ETSDT,0)=ETSFSN
- ;
- ;Count the # of entries
- S (ETSDT,ETSCT)=0 F S ETSDT=$O(ETSPER(ETSDT)) Q:ETSDT'?7N S ETSCT=ETSCT+1
- ;
- ;If no entries, exit with error message
- I ETSCT'>0 S ARY(0)="-1^No activation periods found" Q
- ;
- ;Merge the temp array to the returning array and set the 0 node.
- M ARY=ETSPER
- S ARY(0)=ETSCT_U_U_ETSSD
- ;
- ;Exit with the Number of entries
- Q $G(ARY(0))
- ;
- CSYS(ETSSYS) ;Retrieve the Coding System Information
- ; Hardcoded to specifically provide LEXICON users System Information
- ; Currently hardcoded - ETS does not have a Coding System dictionary
- ;
- ; Input
- ;
- ; ETSSYS Coding System Abbreviation (757.03,.01)
- ; or pointer to file 757.03
- ;
- ; Output
- ;
- ; A 13 piece caret (^) delimited string
- ;
- ; 1 Not Used
- ; 2 SAB (3 character source abbreviation)
- ; 3 Source Abbreviation (3-7 char)
- ; 4 Nomenclature (2-11 char)
- ; 5 Source Title (2-52 char)
- ; 6 Source (2-50 char)
- ; 7-11 Not used
- ; 12 Version Id (1-40 char) [optional]
- ; 13 Implementation Date (date) [optional]
- ; 14 Lookup Threshold
- ;
- N ETSDATA
- S ETSDATA=""
- S:$G(ETSSYS)="" ETSSYS="LNC"
- Q:ETSSYS'="LNC" "-1^Invalid Coding System"
- S ETSDATA="^LNC^LNC^LOINC^Logical Observation Identifier Names and Codes^Duke University Medical Center"
- S $P(ETSDATA,U,12)=$P($G(^DD(129.1,0,"VRRV")),U) ;Get the Current Version
- S $P(ETSDATA,U,13)=$P($G(^DD(129.1,0,"VRRV")),U,2) ;Get the Current Version implementation date
- S $P(ETSDATA,U,14)=20000 ; Search Max similar to LEX Lookup threshold
- Q ETSDATA
- ;
- CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
- ;
- ; Input:
- ;
- ; ETSCODE LOINC Code with Check Digit (Required)
- ; ETSCSYS "LNC" hardcoded for LOINC
- ; ETSCDT Code Set Versioning Date in
- ; FileMan date Format (default = TODAY)
- ; .ARY Output array passed by reference
- ;
- ; Output:
- ;
- ; $$CSDATA 1 if successful (in LOINC Table)
- ; 0 if unsuccessful
- ;
- ; or
- ;
- ; -1 ^ Error Message
- ;
- ;
- ; ARY()
- ;
- ;
- ; Lexicon Data
- ;
- ; ARY("LEX",1) IEN ^ Preferred Term
- ; ARY("LEX",2) Status ^ Effective Date
- ; ARY("LEX",8) Deactivated Concept Flag
- ;
- ; Coding System Data
- ;
- ; ARY("SYS",1) IEN
- ; ARY("SYS",2) Long Common Name
- ;
- ; Each data element will be in the following format:
- ;
- ; ARY(ID,SUB) = DATA
- ; ARY(ID,SUB,"N") = NAME of the Data Element
- ;
- ; Where
- ;
- ; ID Identifier, may be:
- ;
- ; "LEX" for Lexicon data
- ; "SYS" for Coding System data
- ;
- ; SUB Numeric Subscript
- ;
- ; DATA This may be:
- ;
- ; A value if it applies and is found
- ; Null if it applies but not found
- ; N/A if it does not apply
- ;
- ; NAME This is the common name given to the
- ; data element
- ;
- N ETSIEN,ETSDATA,ETSX,ETSHDATA,ETSHDT,ETSHIEN,ETSHIEN2
- ;
- ; Clear array in case older information present
- K ARY
- ;
- Q:'$L($G(ETSCODE)) "-1^Code missing"
- ;
- ; Check for valid LOINC Code and retrieve the IEN
- S ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
- Q:(+ETSIEN=-1) ETSIEN
- ;
- S:$G(ETSCSYS)="" ETSCSYS="LNC"
- Q:ETSCSYS'="LNC" "-1^Invalid source"
- ;
- ; Set default date if no date sent
- I $G(ETSCDT)="" S ETSCDT=$$DT^XLFDT
- ;
- ; Make sure Date is a valid FileMan Date
- Q:+$$CHKDATE(ETSCDT)=-1 "-1^Invalid Date"
- ;
- ; Lex Node
- ;
- ; IEN and Fully specified Name
- S ARY("LEX",1)=ETSIEN_U_$G(^ETSLNC(129.1,ETSIEN,80))
- S ARY("LEX",1,"N")="IEN ^ Fully Specified Name"
- ;
- ; Activation Status information
- S ETSSTAT=0
- ;
- ; Get the activation status based on the date
- ; Locate the correct activation status - if activation occurred on the day sent in use that date
- S ETSHDT=""
- S:$D(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT)) ETSHDT=ETSCDT
- ; or get the last activation
- S:'ETSHDT ETSHDT=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT),-1)
- ;
- ; Only process if activation history found
- I ETSHDT'="" D
- . S ETSHIEN=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,""))
- . ;
- . ; If node not corrupted
- . I ETSHIEN'="" D
- . . ; get the node data
- . . S ETSHDATA=$G(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN,0))
- . . ; if data is present, set the 2nd node of LEX
- . . I ETSHDATA'="" D
- . . . S ETSSTAT=$P(ETSHDATA,U,2)
- . . . I ETSSTAT=0 D
- . . . . S ETSHIEN2=$O(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,ETSHIEN))
- . . . . I ETSHIEN2'="" S ETSSTAT=$P(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN2,0),U,2)
- . . . S ARY("LEX",2)=ETSSTAT_U_ETSHDT
- . . S ARY("LEX",2,"N")="Status ^ Effective Date"
- ;
- ; Status Flag (1 if status INACTIVE, otherwise "")
- S ARY("LEX",8)=$S(ETSSTAT=0:1,1:"")
- S ARY("LEX",8,"N")="Deactivated Concept"
- ;
- ; SYS Node
- S ARY("SYS",1)=ETSIEN
- S ARY("SYS",1,"N")="IEN"
- ;
- ; Long Common Name
- S ARY("SYS",2)=$G(^ETSLNC(129.1,ETSIEN,83))
- S ARY("SYS",2,"N")="Long Common Name"
- ;
- Q 1
- ;
- TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Taxonomy lookup for Clinical Reminders
- ;Redirecting to ETSLNCTX for processing
- Q $$TAX^ETSLNCTX($G(ETSX),$G(ETSSRC),$G(ETSDT),$G(ETSSUB),$G(ETSVER))
- ;
- CHKDATE(ETSX) ;Check to see if the date is in proper FileMan format
- ;
- N %DT,X,Y,DTOUT
- S %DT="X",X=ETSX D ^%DT
- S:$G(DTOUT)'="" Y=-1 ;set error condition if timeout occurs
- Q Y
- ;
- CHKCODE(ETSCODE) ;Entry point for routine $$CHKCODE
- ;Check for missing variable, exit if not defined
- I $G(ETSCODE)="" Q "-1^LOINC Code missing"
- ;
- ;Redirect to ETSLNC1 where the code resides
- Q $$CHKCODE^ETSLNC1(ETSCODE)
- ;
- GETCODE(ETSIEN) ;Entry point for routine $$GETCODE
- ;Check for missing variable, exit if not defined
- Q:$G(ETSIEN)="" "-1^Missing Parameter"
- ;
- ;Redirect to ETSLNC1 where the code resides
- Q $$GETCODE^ETSLNC1(ETSIEN)
- ;
- GETNAME(ETSINPT,ETSINTY,NAME) ;Entry point for routine $$GETNAME
- ;Redirect to ETSLNC1 where the code resides
- Q $$GETNAME^ETSLNC1($G(ETSINPT),$G(ETSINTY),.NAME)
- ;
- GETSTAT(ETSINPT,ETSINTY) ;Entry point for routine $$GETSTAT
- ;Redirect to ETSLNC1 where the code resides
- Q $$GETSTAT^ETSLNC1($G(ETSINPT),$G(ETSINTY))
- ;
- GETREC(ETSINPT,ETSINTY,ETSSUB) ;Entry point for routine $$GETREC
- ;Redirect to ETSLNC1 where the code resides
- Q $$GETREC^ETSLNC3($G(ETSINPT),$G(ETSINTY),$G(ETSSUB))
- ;
- VERSION() ;Entry point for routine $$VERSION
- ;Redirect to ETSLNC1 where the code resides
- Q $$VERSION^ETSLNC2()
- ;
- COMLST(ETSCOM,ETSTYP,ETSSUB) ;Entry point for routine $$COMLST
- ;Redirect to ETSLNC2 where the code resides
- Q $$COMLST^ETSLNC2($G(ETSCOM),$G(ETSTYP),$G(ETSSUB))
- ;
- DEPLST(ETSSUB) ;Entry point for routine $$DEPLST
- ;Redirect to ETSLNC1 where the code resides
- Q $$DEPLST^ETSLNC2($G(ETSSUB))
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSLNC 12790 printed Jan 18, 2025@02:55:09 Page 2
- ETSLNC ;O-OIFO/FM23 - LOINC APIs ;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 ;
- HIST(ETSCODE,ETSSYS,ARY) ; Get Activation History for a Code
- +1 ;
- +2 ; Input:
- +3 ;
- +4 ; ETSCODE LOINC Code with Check Digit (required)
- +5 ; ETSSYS Coding System (required) [hard coded to LNC]
- +6 ; .ARY Array, passed by Reference (required)
- +7 ;
- +8 ; Output:
- +9 ;
- +10 ; $$HIST Number of Histories Found
- +11 ; or
- +12 ; -1 ^ error message
- +13 ;
- +14 ; ARY(0) = Number of Activation History
- +15 ; ARY(0,0) = Code ^ "LNC" ^ "LOINC"
- +16 ; ARY(<date>,<status>) = Comment
- +17 ;
- +18 ;Note:
- +19 ; This software was written based upon the current
- +20 ; standard of a 1 to 1 relationship between the LOINC
- +21 ; Code and its associated IEN.
- +22 ;
- +23 NEW ETSSI,ETSTD,ETSSTAT,ETSDATE,ETSIEN,ETSN,ETSFLG
- +24 NEW ETSDIEN,ETSDATA
- +25 KILL ARY
- +26 ;
- +27 ;Validate the input
- +28 if '$GET(ETSCODE)
- QUIT "-1^Code missing"
- +29 ;
- +30 ; Check for valid LOINC Code and retrieve the IEN
- +31 SET ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
- +32 if (+ETSIEN=-1)
- QUIT ETSIEN
- +33 ;
- +34 if $GET(ETSSYS)=""
- SET ETSSYS="LNC"
- +35 if ETSSYS'="LNC"
- QUIT "-1^Invalid source"
- +36 ;
- +37 SET ETSSI="LNC^LOINC"
- +38 SET ETSTD=$$DT^XLFDT
- +39 ;
- +40 ; Loop through Activation History Multiple to get the information.
- +41 SET ETSDATE=0
- +42 FOR
- SET ETSDATE=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE))
- if 'ETSDATE
- QUIT
- Begin DoDot:1
- +43 SET ETSDIEN=0
- +44 FOR
- SET ETSDIEN=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSDATE,ETSDIEN))
- if 'ETSDIEN
- QUIT
- Begin DoDot:2
- +45 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
- +46 ; validate that the IEN and history exists
- if ETSDATA=""
- QUIT
- +47 SET ETSSTAT=$PIECE(ETSDATA,U,2)
- +48 IF '$DATA(ARY(ETSDATE,ETSSTAT))
- Begin DoDot:3
- +49 SET ARY(0)=+($GET(ARY(0)))+1
- +50 SET ARY(ETSDATE,ETSSTAT)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +51 ;
- +52 ; Loop through and update the comment portion of the array
- +53 SET ETSDATE=0
- SET ETSFLG=0
- +54 FOR
- SET ETSDATE=$ORDER(ARY(ETSDATE))
- if +ETSDATE'>0
- QUIT
- Begin DoDot:1
- +55 SET ETSSTAT=""
- +56 FOR
- SET ETSSTAT=$ORDER(ARY(ETSDATE,ETSSTAT))
- if '$LENGTH(ETSSTAT)
- QUIT
- Begin DoDot:2
- +57 IF +ETSSTAT>0
- IF ETSFLG'=1
- SET ARY(ETSDATE,ETSSTAT)="Activated"
- SET ETSFLG=1
- QUIT
- +58 IF +ETSSTAT'>0
- SET ARY(ETSDATE,ETSSTAT)="Inactivated"
- QUIT
- +59 IF +ETSSTAT>0
- Begin DoDot:3
- +60 SET ARY(ETSDATE,ETSSTAT)="Re-activated"
- +61 IF $DATA(ARY(ETSDATE,0))
- Begin DoDot:4
- +62 SET ARY(ETSDATE,ETSSTAT)="Revised"
- KILL ARY(ETSDATE,0)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +63 ;
- +64 ; Count the # entries and update the comments for any future changes with the word Pending.
- +65 KILL ARY(0)
- +66 SET ETSN=0
- SET ETSDATE=""
- +67 FOR
- SET ETSDATE=$ORDER(ARY(ETSDATE))
- if '$LENGTH(ETSDATE)
- QUIT
- Begin DoDot:1
- +68 SET ETSSTAT=""
- FOR
- SET ETSSTAT=$ORDER(ARY(ETSDATE,ETSSTAT))
- if '$LENGTH(ETSSTAT)
- QUIT
- Begin DoDot:2
- +69 IF ETSSTAT?1N
- IF ETSDATE?7N
- IF ETSDATE>ETSTD
- IF $LENGTH($GET(ARY(ETSDATE,ETSSTAT)))
- Begin DoDot:3
- +70 SET ARY(ETSDATE,ETSSTAT)=$GET(ARY(ETSDATE,ETSSTAT))_" (Pending)"
- End DoDot:3
- +71 SET ETSN=ETSN+1
- End DoDot:2
- End DoDot:1
- +72 ;
- +73 if +ETSN'>0
- QUIT "-1^No History Found"
- +74 ;
- +75 SET ARY(0)=ETSN
- +76 if ETSN>0&($LENGTH(ETSSI))&($LENGTH(ETSCODE))
- SET ARY(0,0)=ETSCODE_"^"_ETSSI
- +77 QUIT ETSN
- +78 ;
- PERIOD(ETSCODE,ETSSYS,ARY) ; Get Activation/Inactivation Periods for a Code
- +1 ;
- +2 ; Input:
- +3 ;
- +4 ; ETSCODE LOINC Code with Check digit (required)
- +5 ; ETSSYS Coding System (Hardcode to look for LNC, required)
- +6 ; .ARY Array, passed by Reference (required)
- +7 ;
- +8 ; Output:
- +9 ;
- +10 ; $$PERIOD Multiple piece "^" delimited string
- +11 ;
- +12 ; 1 Number of Activation Periods found
- +13 ; 2 NULL
- +14 ; 3 "LNC"
- +15 ; 4 "LOINC"
- +16 ; 5 "Logical Observation Identifier Names and Codes"
- +17 ;
- +18 ; or
- +19 ;
- +20 ; -1^Message (no entries or other error message)
- +21 ;
- +22 ; ARY(0) Same as $$PERIOD (above)
- +23 ;
- +24 ; ARY(Activation Date) = 4 piece "^" delimited string
- +25 ;
- +26 ; 1 Inactivation Date
- +27 ; (conditional)
- +28 ;
- +29 ; 2 n/a
- +30 ;
- +31 ; 3 Variable Pointer IEN;ETSLNC(129.1,
- +32 ;
- +33 ; 4 Long Common Name (field #83)
- +34 ;
- +35 ; ARY(Activation Date,0) = Fully Specified Name (field #80
- +36 ;
- +37 ; Looks through the Activation History to build the information
- +38 ;
- +39 NEW ETSACT,ETSINA,ETSDT,ETSIEN,ETSIDT,ETSPER,ETSFSN
- +40 NEW ETSCT,ETSLCN,ETSSD,ETSVP,ETSDATE
- +41 ;
- +42 if '$LENGTH($GET(ETSCODE))
- QUIT "-1^Missing Code"
- +43 ;
- +44 ; Check for valid LOINC Code and retrieve the IEN
- +45 SET ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
- +46 if (+ETSIEN=-1)
- QUIT ETSIEN
- +47 ;
- +48 if $GET(ETSSYS)=""
- SET ETSSYS="LNC"
- +49 if ETSSYS'="LNC"
- QUIT "-1^Missing/Invalid Coding System"
- +50 ;
- +51 ; Hardcode the Coding system information for now.
- +52 SET ETSSD="LNC^LOINC^Logical Observation Identifier Names and Codes"
- +53 KILL ARY
- +54 ;
- +55 ;Retrieve the entries
- +56 SET ETSDIEN=0
- +57 FOR
- SET ETSDIEN=$ORDER(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN))
- if 'ETSDIEN
- QUIT
- Begin DoDot:1
- +58 SET ETSDATA=$GET(^ETSLNC(129.1,ETSIEN,"SS",ETSDIEN,0))
- +59 if ETSDATA=""
- QUIT
- +60 SET ETSSTAT=$PIECE(ETSDATA,U,2)
- SET ETSDATE=$PIECE(ETSDATA,U)
- +61 ;If status is active, update active array
- +62 IF ETSSTAT
- SET ETSACT(ETSDATE)=""
- QUIT
- +63 ;Else update inactive array
- +64 SET ETSINA(ETSDATE)=""
- End DoDot:1
- +65 ;
- +66 ;Check for activation periods - if none, quit
- +67 IF '$DATA(ETSACT)
- Begin DoDot:1
- +68 SET ARY(0)="-1^No activation periods found"
- End DoDot:1
- QUIT ARY(0)
- +69 ;
- +70 ;Build the temp array for return to the user
- +71 SET ETSDT=""
- +72 FOR
- SET ETSDT=$ORDER(ETSACT(ETSDT))
- if '$LENGTH(ETSDT)
- QUIT
- Begin DoDot:1
- +73 ; Inactive Date
- +74 SET ETSIDT=$ORDER(ETSINA(ETSDT))
- +75 ; if no future inactivation, check for same day
- +76 if ETSIDT=""
- SET ETSIDT=$GET(ETSINA(ETSDT))
- +77 ; Fully specified name and Long Common Name
- +78 SET ETSFSN=$GET(^ETSLNC(129.1,+ETSIEN,80))
- +79 SET ETSLCN=$GET(^ETSLNC(129.1,+ETSIEN,83))
- +80 ; Kill inactive entry
- +81 if ETSIDT?7N
- KILL ETSINA(ETSIDT)
- +82 ; Variable Pointer
- +83 SET ETSVP=ETSIEN_";ETSLNC(129.1,"
- +84 ; Set array
- +85 SET ETSPER(ETSDT)=ETSIDT_"^^"_ETSVP_"^"_ETSLCN
- +86 if $LENGTH(ETSFSN)
- SET ETSPER(ETSDT,0)=ETSFSN
- End DoDot:1
- +87 ;
- +88 ;Count the # of entries
- +89 SET (ETSDT,ETSCT)=0
- FOR
- SET ETSDT=$ORDER(ETSPER(ETSDT))
- if ETSDT'?7N
- QUIT
- SET ETSCT=ETSCT+1
- +90 ;
- +91 ;If no entries, exit with error message
- +92 IF ETSCT'>0
- SET ARY(0)="-1^No activation periods found"
- QUIT
- +93 ;
- +94 ;Merge the temp array to the returning array and set the 0 node.
- +95 MERGE ARY=ETSPER
- +96 SET ARY(0)=ETSCT_U_U_ETSSD
- +97 ;
- +98 ;Exit with the Number of entries
- +99 QUIT $GET(ARY(0))
- +100 ;
- CSYS(ETSSYS) ;Retrieve the Coding System Information
- +1 ; Hardcoded to specifically provide LEXICON users System Information
- +2 ; Currently hardcoded - ETS does not have a Coding System dictionary
- +3 ;
- +4 ; Input
- +5 ;
- +6 ; ETSSYS Coding System Abbreviation (757.03,.01)
- +7 ; or pointer to file 757.03
- +8 ;
- +9 ; Output
- +10 ;
- +11 ; A 13 piece caret (^) delimited string
- +12 ;
- +13 ; 1 Not Used
- +14 ; 2 SAB (3 character source abbreviation)
- +15 ; 3 Source Abbreviation (3-7 char)
- +16 ; 4 Nomenclature (2-11 char)
- +17 ; 5 Source Title (2-52 char)
- +18 ; 6 Source (2-50 char)
- +19 ; 7-11 Not used
- +20 ; 12 Version Id (1-40 char) [optional]
- +21 ; 13 Implementation Date (date) [optional]
- +22 ; 14 Lookup Threshold
- +23 ;
- +24 NEW ETSDATA
- +25 SET ETSDATA=""
- +26 if $GET(ETSSYS)=""
- SET ETSSYS="LNC"
- +27 if ETSSYS'="LNC"
- QUIT "-1^Invalid Coding System"
- +28 SET ETSDATA="^LNC^LNC^LOINC^Logical Observation Identifier Names and Codes^Duke University Medical Center"
- +29 ;Get the Current Version
- SET $PIECE(ETSDATA,U,12)=$PIECE($GET(^DD(129.1,0,"VRRV")),U)
- +30 ;Get the Current Version implementation date
- SET $PIECE(ETSDATA,U,13)=$PIECE($GET(^DD(129.1,0,"VRRV")),U,2)
- +31 ; Search Max similar to LEX Lookup threshold
- SET $PIECE(ETSDATA,U,14)=20000
- +32 QUIT ETSDATA
- +33 ;
- CSDATA(ETSCODE,ETSCSYS,ETSCDT,ARY) ; Get Information about a Code
- +1 ;
- +2 ; Input:
- +3 ;
- +4 ; ETSCODE LOINC Code with Check Digit (Required)
- +5 ; ETSCSYS "LNC" hardcoded for LOINC
- +6 ; ETSCDT Code Set Versioning Date in
- +7 ; FileMan date Format (default = TODAY)
- +8 ; .ARY Output array passed by reference
- +9 ;
- +10 ; Output:
- +11 ;
- +12 ; $$CSDATA 1 if successful (in LOINC Table)
- +13 ; 0 if unsuccessful
- +14 ;
- +15 ; or
- +16 ;
- +17 ; -1 ^ Error Message
- +18 ;
- +19 ;
- +20 ; ARY()
- +21 ;
- +22 ;
- +23 ; Lexicon Data
- +24 ;
- +25 ; ARY("LEX",1) IEN ^ Preferred Term
- +26 ; ARY("LEX",2) Status ^ Effective Date
- +27 ; ARY("LEX",8) Deactivated Concept Flag
- +28 ;
- +29 ; Coding System Data
- +30 ;
- +31 ; ARY("SYS",1) IEN
- +32 ; ARY("SYS",2) Long Common Name
- +33 ;
- +34 ; Each data element will be in the following format:
- +35 ;
- +36 ; ARY(ID,SUB) = DATA
- +37 ; ARY(ID,SUB,"N") = NAME of the Data Element
- +38 ;
- +39 ; Where
- +40 ;
- +41 ; ID Identifier, may be:
- +42 ;
- +43 ; "LEX" for Lexicon data
- +44 ; "SYS" for Coding System data
- +45 ;
- +46 ; SUB Numeric Subscript
- +47 ;
- +48 ; DATA This may be:
- +49 ;
- +50 ; A value if it applies and is found
- +51 ; Null if it applies but not found
- +52 ; N/A if it does not apply
- +53 ;
- +54 ; NAME This is the common name given to the
- +55 ; data element
- +56 ;
- +57 NEW ETSIEN,ETSDATA,ETSX,ETSHDATA,ETSHDT,ETSHIEN,ETSHIEN2
- +58 ;
- +59 ; Clear array in case older information present
- +60 KILL ARY
- +61 ;
- +62 if '$LENGTH($GET(ETSCODE))
- QUIT "-1^Code missing"
- +63 ;
- +64 ; Check for valid LOINC Code and retrieve the IEN
- +65 SET ETSIEN=$$CHKCODE^ETSLNC1(ETSCODE)
- +66 if (+ETSIEN=-1)
- QUIT ETSIEN
- +67 ;
- +68 if $GET(ETSCSYS)=""
- SET ETSCSYS="LNC"
- +69 if ETSCSYS'="LNC"
- QUIT "-1^Invalid source"
- +70 ;
- +71 ; Set default date if no date sent
- +72 IF $GET(ETSCDT)=""
- SET ETSCDT=$$DT^XLFDT
- +73 ;
- +74 ; Make sure Date is a valid FileMan Date
- +75 if +$$CHKDATE(ETSCDT)=-1
- QUIT "-1^Invalid Date"
- +76 ;
- +77 ; Lex Node
- +78 ;
- +79 ; IEN and Fully specified Name
- +80 SET ARY("LEX",1)=ETSIEN_U_$GET(^ETSLNC(129.1,ETSIEN,80))
- +81 SET ARY("LEX",1,"N")="IEN ^ Fully Specified Name"
- +82 ;
- +83 ; Activation Status information
- +84 SET ETSSTAT=0
- +85 ;
- +86 ; Get the activation status based on the date
- +87 ; Locate the correct activation status - if activation occurred on the day sent in use that date
- +88 SET ETSHDT=""
- +89 if $DATA(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT))
- SET ETSHDT=ETSCDT
- +90 ; or get the last activation
- +91 if 'ETSHDT
- SET ETSHDT=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSCDT),-1)
- +92 ;
- +93 ; Only process if activation history found
- +94 IF ETSHDT'=""
- Begin DoDot:1
- +95 SET ETSHIEN=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,""))
- +96 ;
- +97 ; If node not corrupted
- +98 IF ETSHIEN'=""
- Begin DoDot:2
- +99 ; get the node data
- +100 SET ETSHDATA=$GET(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN,0))
- +101 ; if data is present, set the 2nd node of LEX
- +102 IF ETSHDATA'=""
- Begin DoDot:3
- +103 SET ETSSTAT=$PIECE(ETSHDATA,U,2)
- +104 IF ETSSTAT=0
- Begin DoDot:4
- +105 SET ETSHIEN2=$ORDER(^ETSLNC(129.1,ETSIEN,"SS","B",ETSHDT,ETSHIEN))
- +106 IF ETSHIEN2'=""
- SET ETSSTAT=$PIECE(^ETSLNC(129.1,ETSIEN,"SS",ETSHIEN2,0),U,2)
- End DoDot:4
- +107 SET ARY("LEX",2)=ETSSTAT_U_ETSHDT
- End DoDot:3
- +108 SET ARY("LEX",2,"N")="Status ^ Effective Date"
- End DoDot:2
- End DoDot:1
- +109 ;
- +110 ; Status Flag (1 if status INACTIVE, otherwise "")
- +111 SET ARY("LEX",8)=$SELECT(ETSSTAT=0:1,1:"")
- +112 SET ARY("LEX",8,"N")="Deactivated Concept"
- +113 ;
- +114 ; SYS Node
- +115 SET ARY("SYS",1)=ETSIEN
- +116 SET ARY("SYS",1,"N")="IEN"
- +117 ;
- +118 ; Long Common Name
- +119 SET ARY("SYS",2)=$GET(^ETSLNC(129.1,ETSIEN,83))
- +120 SET ARY("SYS",2,"N")="Long Common Name"
- +121 ;
- +122 QUIT 1
- +123 ;
- TAX(ETSX,ETSSRC,ETSDT,ETSSUB,ETSVER) ; Taxonomy lookup for Clinical Reminders
- +1 ;Redirecting to ETSLNCTX for processing
- +2 QUIT $$TAX^ETSLNCTX($GET(ETSX),$GET(ETSSRC),$GET(ETSDT),$GET(ETSSUB),$GET(ETSVER))
- +3 ;
- CHKDATE(ETSX) ;Check to see if the date is in proper FileMan format
- +1 ;
- +2 NEW %DT,X,Y,DTOUT
- +3 SET %DT="X"
- SET X=ETSX
- DO ^%DT
- +4 ;set error condition if timeout occurs
- if $GET(DTOUT)'=""
- SET Y=-1
- +5 QUIT Y
- +6 ;
- CHKCODE(ETSCODE) ;Entry point for routine $$CHKCODE
- +1 ;Check for missing variable, exit if not defined
- +2 IF $GET(ETSCODE)=""
- QUIT "-1^LOINC Code missing"
- +3 ;
- +4 ;Redirect to ETSLNC1 where the code resides
- +5 QUIT $$CHKCODE^ETSLNC1(ETSCODE)
- +6 ;
- GETCODE(ETSIEN) ;Entry point for routine $$GETCODE
- +1 ;Check for missing variable, exit if not defined
- +2 if $GET(ETSIEN)=""
- QUIT "-1^Missing Parameter"
- +3 ;
- +4 ;Redirect to ETSLNC1 where the code resides
- +5 QUIT $$GETCODE^ETSLNC1(ETSIEN)
- +6 ;
- GETNAME(ETSINPT,ETSINTY,NAME) ;Entry point for routine $$GETNAME
- +1 ;Redirect to ETSLNC1 where the code resides
- +2 QUIT $$GETNAME^ETSLNC1($GET(ETSINPT),$GET(ETSINTY),.NAME)
- +3 ;
- GETSTAT(ETSINPT,ETSINTY) ;Entry point for routine $$GETSTAT
- +1 ;Redirect to ETSLNC1 where the code resides
- +2 QUIT $$GETSTAT^ETSLNC1($GET(ETSINPT),$GET(ETSINTY))
- +3 ;
- GETREC(ETSINPT,ETSINTY,ETSSUB) ;Entry point for routine $$GETREC
- +1 ;Redirect to ETSLNC1 where the code resides
- +2 QUIT $$GETREC^ETSLNC3($GET(ETSINPT),$GET(ETSINTY),$GET(ETSSUB))
- +3 ;
- VERSION() ;Entry point for routine $$VERSION
- +1 ;Redirect to ETSLNC1 where the code resides
- +2 QUIT $$VERSION^ETSLNC2()
- +3 ;
- COMLST(ETSCOM,ETSTYP,ETSSUB) ;Entry point for routine $$COMLST
- +1 ;Redirect to ETSLNC2 where the code resides
- +2 QUIT $$COMLST^ETSLNC2($GET(ETSCOM),$GET(ETSTYP),$GET(ETSSUB))
- +3 ;
- DEPLST(ETSSUB) ;Entry point for routine $$DEPLST
- +1 ;Redirect to ETSLNC1 where the code resides
- +2 QUIT $$DEPLST^ETSLNC2($GET(ETSSUB))
- +3 ;