ETSLNC3 ;O-OIFO/FM23 - LOINC APIs 4 ;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
;
GETREC(ETSINPT,ETSINTY,ETSSUB) ;Get LOINC Information by Code or IEN
; Input -- ETSINPT LOINC Code (with check digit) or IEN
; ETSINTY Input Type (Optional- Default "C")
; "C"=LOINC Code
; "I"=LOINC IEN
; ETSSUB (Optional) Subscript for ^TMP array storing the
; results (default = ETSREC)
; Output --
; $$GETREC - 1 (record found), 0 - no record found, -1^<error message>
;
; ^TMP(ETSSUB,$J,"RECORD", Results in the following subscripts:
; "ACTIVATION HISTORY") = Activation History Multiple (#95) [Not Returned]
; "ACTIVATION HISTORY",#,"ACTIVATION EFFECTIVE DATE") = FM Date ^ External Date (#129.103, #.01)
; "ACTIVATION HISTORY",#,"ACTIVATION STATUS") = Status ^ External Status (#129.103, #1)
; "ADJUSTMENT")=Adjustment field (#1.6)
; "CHALLENGE")=Challenge Field (#1.5)
; "CHANGE REASON")=Challenge Field (#24)
; "CHANGE TYPE")=Change Type field (#23)
; "CHECK DIGIT")=Check Digit Field (#15)
; "CLASS")=Class field(#7)
; "CLASSTYPE")=Internal^External Class Type field(#41)
; "CODE")=Code Field (#.01)_Check Digit (#15)
; "COMMENTS")= # lines in the comment multiple
; "COMMENTS",#)=Comments Multiple field (#99)
; "COMPONENT")=Component field (#1)
; "DATE LAST CHANGED")=Internal^Date Last Changed field (#22)
; "EXAMPLE UCUM UNITS")=Units field (#85)
; "EXTERNAL COPYRIGHT NOTICE")= # lines in word processing field
; "EXTERNAL COPYRIGHT NOTICE",#)= Line of data in the word processing field
; "FULLY SPECIFIED NAME")=Fully Specified Name field (#80)
; "IEN")= IEN of entry
; "LONG COMMON NAME")=Long Common Name field (#82)
; "MASTER ENTRY FOR VUID")=Master Entry for VUID (#99.98)
; "METHOD TYPE")=Method Type field (#6)
; "NON-PATIENT SPECIMEN")=Non-Patient Specimen field (#1.7)
; "PROPERTY")=Property field (#2)
; "REPEAT OBSERVATION")=Repeat Observation field (#86)
; "SCALE TYPE")=Scale Type field (#5)
; "SHORTNAME")=Short Name field (#81)
; "SNOMED CODE")=Short Name field (#33)
; "SOURCE")=Source field (#8)
; "STATUS")=Internal^External Status field (#20)
; "SYSTEM")=System field (#4)
; "TIME ASPECT")=Time Aspect field (#3)
; "TIME MODIFIER")=Time Aspect field (#3.1)
; "UNITS")=Time Aspect field (#10)
; "VA COMMON DISPLAY NAME")=VA Common Display Name field (#82)
; "VERSION NUMBER")=Version Number field (#25)
; "VUID")=VUID (#99.99)
; "VUID EFFECTIVE DATE") = VUID Effective Date Multiple (#99.991) [Not Returned]
; "VUID EFFECTIVE DATE",#,"EFFECTIVE DATE/TIME") = FM Date ^ External Date (#129.104, #.01)
; "VUID EFFECTIVE DATE",#,"STATUS") = Status ^ External Status (#129.104, #1)
;
;
N ETSCIEN,ETSCODE,ETSARY,ETSLIEN,I,CT
;
;Set the default for the subscript if not sent
S:$G(ETSSUB)="" ETSSUB="ETSREC"
;
;Clear previous search to prevent result contamination
K ^TMP(ETSSUB,$J)
;
;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"
S ETSINTY=$$UP^XLFSTR(ETSINTY)
I (ETSINTY'="C"),(ETSINTY'="I") Q "-1^Invalid Input Type"
;
;Check input for LOINC Code or IEN
;Assume the input type is an IEN,find the code.
I ETSINTY="I" S ETSCIEN=ETSINPT,ETSCODE=$$GETCODE^ETSLNC1(ETSCIEN) I +ETSCODE=-1 Q "-1^LOINC IEN not found"
;if the input type was a code, retrieve the IEN.
S:ETSINTY="C" ETSCIEN=$$CHKCODE^ETSLNC1(ETSINPT),ETSCODE=ETSINPT
;
;Exit if the IEN was either not passed in or not found.
Q:+ETSCIEN=-1 ETSCIEN
;
;Set-up LOINC Record array to return
;
;Start with the code and the IEN
S ^TMP(ETSSUB,$J,"RECORD","IEN")=ETSCIEN
;
;Query data
D GETS^DIQ(129.1,ETSCIEN_",","**","IE","ETSARY")
;
;If results returned, store into Structure
I $D(ETSARY(129.1)) D
. ;retrieve fields needing external values only
. S ^TMP(ETSSUB,$J,"RECORD","ADJUSTMENT")=$G(ETSARY(129.1,ETSCIEN_",",1.6,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","CHALLENGE")=$G(ETSARY(129.1,ETSCIEN_",",1.5,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","CHANGE REASON")=$G(ETSARY(129.1,ETSCIEN_",",24,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","CHANGE TYPE")=$G(ETSARY(129.1,ETSCIEN_",",23,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","CHECK DIGIT")=$G(ETSARY(129.1,ETSCIEN_",",15,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","CLASS")=$G(ETSARY(129.1,ETSCIEN_",",7,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","CODE")=$G(ETSARY(129.1,ETSCIEN_",",.01,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","COMPONENT")=$G(ETSARY(129.1,ETSCIEN_",",1,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","EXAMPLE UCUM UNITS")=$G(ETSARY(129.1,ETSCIEN_",",85,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","FULLY SPECIFIED NAME")=$G(ETSARY(129.1,ETSCIEN_",",80,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","LONG COMMON NAME")=$G(ETSARY(129.1,ETSCIEN_",",83,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","MASTER ENTRY FOR VUID")=$G(ETSARY(129.1,ETSCIEN_",",99.98,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","METHOD TYPE")=$G(ETSARY(129.1,ETSCIEN_",",6,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","NON-PATIENT SPECIMEN")=$G(ETSARY(129.1,ETSCIEN_",",1.7,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","PROPERTY")=$G(ETSARY(129.1,ETSCIEN_",",2,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","REPEAT OBSERVATION")=$G(ETSARY(129.1,ETSCIEN_",",86,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","SCALE TYPE")=$G(ETSARY(129.1,ETSCIEN_",",5,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","SHORTNAME")=$G(ETSARY(129.1,ETSCIEN_",",81,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","SNOMED CODE")=$G(ETSARY(129.1,ETSCIEN_",",33,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","SOURCE")=$G(ETSARY(129.1,ETSCIEN_",",8,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","SYSTEM")=$G(ETSARY(129.1,ETSCIEN_",",4,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","TIME ASPECT")=$G(ETSARY(129.1,ETSCIEN_",",3,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","TIME MODIFIER")=$G(ETSARY(129.1,ETSCIEN_",",3.1,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","UNITS")=$G(ETSARY(129.1,ETSCIEN_",",10,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","VA COMMON DISPLAY NAME")=$G(ETSARY(129.1,ETSCIEN_",",82,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","VERSION NUMBER")=$G(ETSARY(129.1,ETSCIEN_",",25,"E"))
. S ^TMP(ETSSUB,$J,"RECORD","VUID")=$G(ETSARY(129.1,ETSCIEN_",",99.99,"E"))
. ;
. ;Retrieve the comments multiple, if present
. S ^TMP(ETSSUB,$J,"RECORD","COMMENTS")=""
. I $G(ETSARY(129.1,ETSCIEN_",",99,"I"))'="" D
.. ;Add the multiple lines
.. S I=0,CT=0
.. F S I=$O(ETSARY(129.1,ETSCIEN_",",99,I)) Q:'I D
... S ^TMP(ETSSUB,$J,"RECORD","COMMENTS",I)=$G(ETSARY(129.1,ETSCIEN_",",99,I)),CT=CT+1
.. ;Change the top node to equal the # lines in the comment
.. S ^TMP(ETSSUB,$J,"RECORD","COMMENTS")=CT
. ;
. ;Retrieve the External Copyright Notice word processing field multiple, if present
. S ^TMP(ETSSUB,$J,"RECORD","EXTERNAL COPYRIGHT NOTICE")=""
. I $G(ETSARY(129.1,ETSCIEN_",",84,"I"))'="" D
.. ;Add the multiple lines
.. S I=0,CT=0
.. F S I=$O(ETSARY(129.1,ETSCIEN_",",84,I)) Q:'I D
... S ^TMP(ETSSUB,$J,"RECORD","EXTERNAL COPYRIGHT NOTICE",I)=$G(ETSARY(129.1,ETSCIEN_",",84,I)),CT=CT+1
.. ;Change the top node to equal the # lines in the comment
.. S ^TMP(ETSSUB,$J,"RECORD","EXTERNAL COPYRIGHT NOTICE")=CT
. ;
. ;Convert Date Last Changed to FM format + External, if present
. I $G(ETSARY(129.1,ETSCIEN_",",22,"I"))'="" D
.. S ^TMP(ETSSUB,$J,"RECORD","DATE LAST CHANGED")=$G(ETSARY(129.1,ETSCIEN_",",22,"I"))_"^"_$G(ETSARY(129.1,ETSCIEN_",",22,"E"))
. ;
. ;Convert Class Type to Internal and External, if present
. I $G(ETSARY(129.1,ETSCIEN_",",41,"I"))'="" D
.. S ^TMP(ETSSUB,$J,"RECORD","CLASSTYPE")=$G(ETSARY(129.1,ETSCIEN_",",41,"I"))_"^"_$G(ETSARY(129.1,ETSCIEN_",",41,"E"))
. ;
. ;Convert Status to Internal and External, if present
. I $G(ETSARY(129.1,ETSCIEN_",",20,"I"))'="" D
.. S ^TMP(ETSSUB,$J,"RECORD","STATUS")=$G(ETSARY(129.1,ETSCIEN_",",20,"I"))_"^"_$G(ETSARY(129.1,ETSCIEN_",",20,"E"))
. ;
. ;Extract Activation dates from the multiple
. S ETSLIEN=""
. F S ETSLIEN=$O(ETSARY(129.103,ETSLIEN)) Q:ETSLIEN="" D
.. S ^TMP(ETSSUB,$J,"RECORD","ACTIVATION HISTORY",$P(ETSLIEN,","),"ACTIVATION EFFECTIVE DATE")=$G(ETSARY(129.103,ETSLIEN,.01,"I"))_"^"_$G(ETSARY(129.103,ETSLIEN,.01,"E"))
.. S ^TMP(ETSSUB,$J,"RECORD","ACTIVATION HISTORY",$P(ETSLIEN,","),"ACTIVATION STATUS")=$G(ETSARY(129.103,ETSLIEN,1,"I"))_"^"_$G(ETSARY(129.103,ETSLIEN,1,"E"))
. ;
. ;Extract VUID Effective dates from the multiple
. S ETSLIEN=""
. F S ETSLIEN=$O(ETSARY(129.104,ETSLIEN)) Q:ETSLIEN="" D
.. S ^TMP(ETSSUB,$J,"RECORD","VUID EFFECTIVE DATE",$P(ETSLIEN,","),"EFFECTIVE DATE/TIME")=$G(ETSARY(129.104,ETSLIEN,.01,"I"))_"^"_$G(ETSARY(129.104,ETSLIEN,.01,"E"))
.. S ^TMP(ETSSUB,$J,"RECORD","VUID EFFECTIVE DATE",$P(ETSLIEN,","),"STATUS")=$G(ETSARY(129.104,ETSLIEN,.02,"I"))_"^"_$G(ETSARY(129.104,ETSLIEN,.02,"E"))
;
;Exit - Requested entry found
Q:$D(^TMP(ETSSUB,$J,"RECORD")) 1
;Exit - Requested entry not found
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HETSLNC3 10088 printed Sep 23, 2025@19:30:12 Page 2
ETSLNC3 ;O-OIFO/FM23 - LOINC APIs 4 ;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 ;
GETREC(ETSINPT,ETSINTY,ETSSUB) ;Get LOINC Information by Code or IEN
+1 ; Input -- ETSINPT LOINC Code (with check digit) or IEN
+2 ; ETSINTY Input Type (Optional- Default "C")
+3 ; "C"=LOINC Code
+4 ; "I"=LOINC IEN
+5 ; ETSSUB (Optional) Subscript for ^TMP array storing the
+6 ; results (default = ETSREC)
+7 ; Output --
+8 ; $$GETREC - 1 (record found), 0 - no record found, -1^<error message>
+9 ;
+10 ; ^TMP(ETSSUB,$J,"RECORD", Results in the following subscripts:
+11 ; "ACTIVATION HISTORY") = Activation History Multiple (#95) [Not Returned]
+12 ; "ACTIVATION HISTORY",#,"ACTIVATION EFFECTIVE DATE") = FM Date ^ External Date (#129.103, #.01)
+13 ; "ACTIVATION HISTORY",#,"ACTIVATION STATUS") = Status ^ External Status (#129.103, #1)
+14 ; "ADJUSTMENT")=Adjustment field (#1.6)
+15 ; "CHALLENGE")=Challenge Field (#1.5)
+16 ; "CHANGE REASON")=Challenge Field (#24)
+17 ; "CHANGE TYPE")=Change Type field (#23)
+18 ; "CHECK DIGIT")=Check Digit Field (#15)
+19 ; "CLASS")=Class field(#7)
+20 ; "CLASSTYPE")=Internal^External Class Type field(#41)
+21 ; "CODE")=Code Field (#.01)_Check Digit (#15)
+22 ; "COMMENTS")= # lines in the comment multiple
+23 ; "COMMENTS",#)=Comments Multiple field (#99)
+24 ; "COMPONENT")=Component field (#1)
+25 ; "DATE LAST CHANGED")=Internal^Date Last Changed field (#22)
+26 ; "EXAMPLE UCUM UNITS")=Units field (#85)
+27 ; "EXTERNAL COPYRIGHT NOTICE")= # lines in word processing field
+28 ; "EXTERNAL COPYRIGHT NOTICE",#)= Line of data in the word processing field
+29 ; "FULLY SPECIFIED NAME")=Fully Specified Name field (#80)
+30 ; "IEN")= IEN of entry
+31 ; "LONG COMMON NAME")=Long Common Name field (#82)
+32 ; "MASTER ENTRY FOR VUID")=Master Entry for VUID (#99.98)
+33 ; "METHOD TYPE")=Method Type field (#6)
+34 ; "NON-PATIENT SPECIMEN")=Non-Patient Specimen field (#1.7)
+35 ; "PROPERTY")=Property field (#2)
+36 ; "REPEAT OBSERVATION")=Repeat Observation field (#86)
+37 ; "SCALE TYPE")=Scale Type field (#5)
+38 ; "SHORTNAME")=Short Name field (#81)
+39 ; "SNOMED CODE")=Short Name field (#33)
+40 ; "SOURCE")=Source field (#8)
+41 ; "STATUS")=Internal^External Status field (#20)
+42 ; "SYSTEM")=System field (#4)
+43 ; "TIME ASPECT")=Time Aspect field (#3)
+44 ; "TIME MODIFIER")=Time Aspect field (#3.1)
+45 ; "UNITS")=Time Aspect field (#10)
+46 ; "VA COMMON DISPLAY NAME")=VA Common Display Name field (#82)
+47 ; "VERSION NUMBER")=Version Number field (#25)
+48 ; "VUID")=VUID (#99.99)
+49 ; "VUID EFFECTIVE DATE") = VUID Effective Date Multiple (#99.991) [Not Returned]
+50 ; "VUID EFFECTIVE DATE",#,"EFFECTIVE DATE/TIME") = FM Date ^ External Date (#129.104, #.01)
+51 ; "VUID EFFECTIVE DATE",#,"STATUS") = Status ^ External Status (#129.104, #1)
+52 ;
+53 ;
+54 NEW ETSCIEN,ETSCODE,ETSARY,ETSLIEN,I,CT
+55 ;
+56 ;Set the default for the subscript if not sent
+57 if $GET(ETSSUB)=""
SET ETSSUB="ETSREC"
+58 ;
+59 ;Clear previous search to prevent result contamination
+60 KILL ^TMP(ETSSUB,$JOB)
+61 ;
+62 ;Check for existence of an IEN/Code
+63 if $GET(ETSINPT)=""
QUIT "-1^Missing Code or IEN"
+64 ;
+65 ;Set Input Type to default of "C", if not defined
+66 if $GET(ETSINTY)=""
SET ETSINTY="C"
+67 SET ETSINTY=$$UP^XLFSTR(ETSINTY)
+68 IF (ETSINTY'="C")
IF (ETSINTY'="I")
QUIT "-1^Invalid Input Type"
+69 ;
+70 ;Check input for LOINC Code or IEN
+71 ;Assume the input type is an IEN,find the code.
+72 IF ETSINTY="I"
SET ETSCIEN=ETSINPT
SET ETSCODE=$$GETCODE^ETSLNC1(ETSCIEN)
IF +ETSCODE=-1
QUIT "-1^LOINC IEN not found"
+73 ;if the input type was a code, retrieve the IEN.
+74 if ETSINTY="C"
SET ETSCIEN=$$CHKCODE^ETSLNC1(ETSINPT)
SET ETSCODE=ETSINPT
+75 ;
+76 ;Exit if the IEN was either not passed in or not found.
+77 if +ETSCIEN=-1
QUIT ETSCIEN
+78 ;
+79 ;Set-up LOINC Record array to return
+80 ;
+81 ;Start with the code and the IEN
+82 SET ^TMP(ETSSUB,$JOB,"RECORD","IEN")=ETSCIEN
+83 ;
+84 ;Query data
+85 DO GETS^DIQ(129.1,ETSCIEN_",","**","IE","ETSARY")
+86 ;
+87 ;If results returned, store into Structure
+88 IF $DATA(ETSARY(129.1))
Begin DoDot:1
+89 ;retrieve fields needing external values only
+90 SET ^TMP(ETSSUB,$JOB,"RECORD","ADJUSTMENT")=$GET(ETSARY(129.1,ETSCIEN_",",1.6,"E"))
+91 SET ^TMP(ETSSUB,$JOB,"RECORD","CHALLENGE")=$GET(ETSARY(129.1,ETSCIEN_",",1.5,"E"))
+92 SET ^TMP(ETSSUB,$JOB,"RECORD","CHANGE REASON")=$GET(ETSARY(129.1,ETSCIEN_",",24,"E"))
+93 SET ^TMP(ETSSUB,$JOB,"RECORD","CHANGE TYPE")=$GET(ETSARY(129.1,ETSCIEN_",",23,"E"))
+94 SET ^TMP(ETSSUB,$JOB,"RECORD","CHECK DIGIT")=$GET(ETSARY(129.1,ETSCIEN_",",15,"E"))
+95 SET ^TMP(ETSSUB,$JOB,"RECORD","CLASS")=$GET(ETSARY(129.1,ETSCIEN_",",7,"E"))
+96 SET ^TMP(ETSSUB,$JOB,"RECORD","CODE")=$GET(ETSARY(129.1,ETSCIEN_",",.01,"E"))
+97 SET ^TMP(ETSSUB,$JOB,"RECORD","COMPONENT")=$GET(ETSARY(129.1,ETSCIEN_",",1,"E"))
+98 SET ^TMP(ETSSUB,$JOB,"RECORD","EXAMPLE UCUM UNITS")=$GET(ETSARY(129.1,ETSCIEN_",",85,"E"))
+99 SET ^TMP(ETSSUB,$JOB,"RECORD","FULLY SPECIFIED NAME")=$GET(ETSARY(129.1,ETSCIEN_",",80,"E"))
+100 SET ^TMP(ETSSUB,$JOB,"RECORD","LONG COMMON NAME")=$GET(ETSARY(129.1,ETSCIEN_",",83,"E"))
+101 SET ^TMP(ETSSUB,$JOB,"RECORD","MASTER ENTRY FOR VUID")=$GET(ETSARY(129.1,ETSCIEN_",",99.98,"E"))
+102 SET ^TMP(ETSSUB,$JOB,"RECORD","METHOD TYPE")=$GET(ETSARY(129.1,ETSCIEN_",",6,"E"))
+103 SET ^TMP(ETSSUB,$JOB,"RECORD","NON-PATIENT SPECIMEN")=$GET(ETSARY(129.1,ETSCIEN_",",1.7,"E"))
+104 SET ^TMP(ETSSUB,$JOB,"RECORD","PROPERTY")=$GET(ETSARY(129.1,ETSCIEN_",",2,"E"))
+105 SET ^TMP(ETSSUB,$JOB,"RECORD","REPEAT OBSERVATION")=$GET(ETSARY(129.1,ETSCIEN_",",86,"E"))
+106 SET ^TMP(ETSSUB,$JOB,"RECORD","SCALE TYPE")=$GET(ETSARY(129.1,ETSCIEN_",",5,"E"))
+107 SET ^TMP(ETSSUB,$JOB,"RECORD","SHORTNAME")=$GET(ETSARY(129.1,ETSCIEN_",",81,"E"))
+108 SET ^TMP(ETSSUB,$JOB,"RECORD","SNOMED CODE")=$GET(ETSARY(129.1,ETSCIEN_",",33,"E"))
+109 SET ^TMP(ETSSUB,$JOB,"RECORD","SOURCE")=$GET(ETSARY(129.1,ETSCIEN_",",8,"E"))
+110 SET ^TMP(ETSSUB,$JOB,"RECORD","SYSTEM")=$GET(ETSARY(129.1,ETSCIEN_",",4,"E"))
+111 SET ^TMP(ETSSUB,$JOB,"RECORD","TIME ASPECT")=$GET(ETSARY(129.1,ETSCIEN_",",3,"E"))
+112 SET ^TMP(ETSSUB,$JOB,"RECORD","TIME MODIFIER")=$GET(ETSARY(129.1,ETSCIEN_",",3.1,"E"))
+113 SET ^TMP(ETSSUB,$JOB,"RECORD","UNITS")=$GET(ETSARY(129.1,ETSCIEN_",",10,"E"))
+114 SET ^TMP(ETSSUB,$JOB,"RECORD","VA COMMON DISPLAY NAME")=$GET(ETSARY(129.1,ETSCIEN_",",82,"E"))
+115 SET ^TMP(ETSSUB,$JOB,"RECORD","VERSION NUMBER")=$GET(ETSARY(129.1,ETSCIEN_",",25,"E"))
+116 SET ^TMP(ETSSUB,$JOB,"RECORD","VUID")=$GET(ETSARY(129.1,ETSCIEN_",",99.99,"E"))
+117 ;
+118 ;Retrieve the comments multiple, if present
+119 SET ^TMP(ETSSUB,$JOB,"RECORD","COMMENTS")=""
+120 IF $GET(ETSARY(129.1,ETSCIEN_",",99,"I"))'=""
Begin DoDot:2
+121 ;Add the multiple lines
+122 SET I=0
SET CT=0
+123 FOR
SET I=$ORDER(ETSARY(129.1,ETSCIEN_",",99,I))
if 'I
QUIT
Begin DoDot:3
+124 SET ^TMP(ETSSUB,$JOB,"RECORD","COMMENTS",I)=$GET(ETSARY(129.1,ETSCIEN_",",99,I))
SET CT=CT+1
End DoDot:3
+125 ;Change the top node to equal the # lines in the comment
+126 SET ^TMP(ETSSUB,$JOB,"RECORD","COMMENTS")=CT
End DoDot:2
+127 ;
+128 ;Retrieve the External Copyright Notice word processing field multiple, if present
+129 SET ^TMP(ETSSUB,$JOB,"RECORD","EXTERNAL COPYRIGHT NOTICE")=""
+130 IF $GET(ETSARY(129.1,ETSCIEN_",",84,"I"))'=""
Begin DoDot:2
+131 ;Add the multiple lines
+132 SET I=0
SET CT=0
+133 FOR
SET I=$ORDER(ETSARY(129.1,ETSCIEN_",",84,I))
if 'I
QUIT
Begin DoDot:3
+134 SET ^TMP(ETSSUB,$JOB,"RECORD","EXTERNAL COPYRIGHT NOTICE",I)=$GET(ETSARY(129.1,ETSCIEN_",",84,I))
SET CT=CT+1
End DoDot:3
+135 ;Change the top node to equal the # lines in the comment
+136 SET ^TMP(ETSSUB,$JOB,"RECORD","EXTERNAL COPYRIGHT NOTICE")=CT
End DoDot:2
+137 ;
+138 ;Convert Date Last Changed to FM format + External, if present
+139 IF $GET(ETSARY(129.1,ETSCIEN_",",22,"I"))'=""
Begin DoDot:2
+140 SET ^TMP(ETSSUB,$JOB,"RECORD","DATE LAST CHANGED")=$GET(ETSARY(129.1,ETSCIEN_",",22,"I"))_"^"_$GET(ETSARY(129.1,ETSCIEN_",",22,"E"))
End DoDot:2
+141 ;
+142 ;Convert Class Type to Internal and External, if present
+143 IF $GET(ETSARY(129.1,ETSCIEN_",",41,"I"))'=""
Begin DoDot:2
+144 SET ^TMP(ETSSUB,$JOB,"RECORD","CLASSTYPE")=$GET(ETSARY(129.1,ETSCIEN_",",41,"I"))_"^"_$GET(ETSARY(129.1,ETSCIEN_",",41,"E"))
End DoDot:2
+145 ;
+146 ;Convert Status to Internal and External, if present
+147 IF $GET(ETSARY(129.1,ETSCIEN_",",20,"I"))'=""
Begin DoDot:2
+148 SET ^TMP(ETSSUB,$JOB,"RECORD","STATUS")=$GET(ETSARY(129.1,ETSCIEN_",",20,"I"))_"^"_$GET(ETSARY(129.1,ETSCIEN_",",20,"E"))
End DoDot:2
+149 ;
+150 ;Extract Activation dates from the multiple
+151 SET ETSLIEN=""
+152 FOR
SET ETSLIEN=$ORDER(ETSARY(129.103,ETSLIEN))
if ETSLIEN=""
QUIT
Begin DoDot:2
+153 SET ^TMP(ETSSUB,$JOB,"RECORD","ACTIVATION HISTORY",$PIECE(ETSLIEN,","),"ACTIVATION EFFECTIVE DATE")=$GET(ETSARY(129.103,ETSLIEN,.01,"I"))_"^"_$GET(ETSARY(129.103,ETSLIEN,.01,"E"))
+154 SET ^TMP(ETSSUB,$JOB,"RECORD","ACTIVATION HISTORY",$PIECE(ETSLIEN,","),"ACTIVATION STATUS")=$GET(ETSARY(129.103,ETSLIEN,1,"I"))_"^"_$GET(ETSARY(129.103,ETSLIEN,1,"E"))
End DoDot:2
+155 ;
+156 ;Extract VUID Effective dates from the multiple
+157 SET ETSLIEN=""
+158 FOR
SET ETSLIEN=$ORDER(ETSARY(129.104,ETSLIEN))
if ETSLIEN=""
QUIT
Begin DoDot:2
+159 SET ^TMP(ETSSUB,$JOB,"RECORD","VUID EFFECTIVE DATE",$PIECE(ETSLIEN,","),"EFFECTIVE DATE/TIME")=$GET(ETSARY(129.104,ETSLIEN,.01,"I"))_"^"_$GET(ETSARY(129.104,ETSLIEN,.01,"E"))
+160 SET ^TMP(ETSSUB,$JOB,"RECORD","VUID EFFECTIVE DATE",$PIECE(ETSLIEN,","),"STATUS")=$GET(ETSARY(129.104,ETSLIEN,.02,"I"))_"^"_$GET(ETSARY(129.104,ETSLIEN,.02,"E"))
End DoDot:2
End DoDot:1
+161 ;
+162 ;Exit - Requested entry found
+163 if $DATA(^TMP(ETSSUB,$JOB,"RECORD"))
QUIT 1
+164 ;Exit - Requested entry not found
+165 QUIT 0
