- 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 Mar 13, 2025@20:58:39 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
