HLMA3 ;OIFO-O/RJH-API TO LOGICAL LINK FILE ;05/30/08 16:05
;;1.6;HEALTH LEVEL SEVEN;**126,142**;Oct 13, 1995;Build 17
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
IEDOMAIN() ;
; API for retrieving domain of site's local Interface Engine
; from logical link VA-VIE
;
; no input
; output:
; return DNS domain if available, else return null string.
;
N HLTEMP
; retrive data from DNS Domain field of file #870
S HLTEMP("VA-VIE-IEN")=$O(^HLCS(870,"B","VA-VIE",0))
S HLTEMP("DOMAIN")=$P($G(^HLCS(870,+$G(HLTEMP("VA-VIE-IEN")),0)),"^",8)
Q HLTEMP("DOMAIN")
;
LINKAPI(LINK,DOMAIN,AUTOSTAR) ;
; API for updating fields, DNS Domain and Autostart, of logical link
; the API may only be applied to production account.
; inputs:
; LINK - 1. ien of HL Logical Link file (#870), or
; 2. name (field 'Node'- #.01) of HL Logical Link file
; (#870)
; DOMAIN - data for DNS domain field (field #.08)
; AUTOSTAR - data for Autostart field (field #4.5),
; 0 for Disabled, 1 for Enabled.
; Otherwise, data won't be updated
;
; output could be either of the following:
; 1^DOMAIN,AUTOSTART have been updated
; 1^DOMAIN has been updated
; 1^AUTOSTART has been updated
; -1^none has been updated
; -1^the api may not be applied to non-production account
;
N HLTEMP,HLZ
;retrieve data from HL Communication Server Parameter file (#869.3)
; - Default Processing Id (#.03)
;
S HLTEMP("PARAM")=$$PARAM^HLCS2
S HLTEMP("DEFAULT-PROCESSING-ID")=$P(HLTEMP("PARAM"),"^",3)
;
; quit if this is a non-production account
Q:HLTEMP("DEFAULT-PROCESSING-ID")'="P" "-1^the api may not be applied to non-production account"
;
; get input data for link ien or name
S HLTEMP("IEN")=$G(LINK)
I 'HLTEMP("IEN")&($L(HLTEMP("IEN"))) S HLTEMP("IEN")=+$O(^HLCS(870,"B",HLTEMP("IEN"),0))
;
; quit if no ien
Q:'HLTEMP("IEN") "-1^none has been updated"
;
; get input data for DNS domain field
S HLTEMP("DOMAIN")=$G(DOMAIN)
;
; get IP address for the domain
I $L(HLTEMP("DOMAIN")) S HLTEMP("IP")=$$ADDRESS^XLFNSLK(HLTEMP("DOMAIN"))
;
; invalid domain, set it to null
I $L(HLTEMP("DOMAIN")),'$G(HLTEMP("IP")) S HLTEMP("DOMAIN")=""
;
; get input data for Autostart field
S HLTEMP("AUTOSTART")=$G(AUTOSTAR)
;
; quit if invalid data for both fields
Q:($L(HLTEMP("DOMAIN"),".")'>2)&'((HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1")) "-1^none has been updated"
I $L(HLTEMP("DOMAIN"),".")>2 D
. S HLZ(870,HLTEMP("IEN")_",",.08)=HLTEMP("DOMAIN")
I (HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1") D
. S HLZ(870,HLTEMP("IEN")_",",4.5)=HLTEMP("AUTOSTART")
D FILE^DIE("S","HLZ","HLZ")
;
; both fields are updated
Q:$D(HLZ(870,HLTEMP("IEN")_",",.08))&($D(HLZ(870,HLTEMP("IEN")_",",4.5))) "1^DOMAIN,AUTOSTART have been updated"
;
; only update DNS Domain field
Q:$D(HLZ(870,HLTEMP("IEN")_",",.08)) "1^DOMAIN has been updated"
;
; only update Autostart field
Q:$D(HLZ(870,HLTEMP("IEN")_",",4.5)) "1^AUTOSTART has been updated"
;
IP(DA,HLIP) ;
; 1. API to update field TCP/IP Address, #870,400.01.
; 2. called from input transform of #870,.08 DNS Domain to update
; field TCP/IP Address, #870,400.01.
;
; input:
; DA - 1. ien of HL Logical Link file (#870), or
; 2. name (field 'Node'- #.01) of HL Logical Link file (#870)
; HLIP - IP addresses
;
; output:
; return IP address updated to the field if valid,
; else return null string.
;
N HLZ,HLI,HLTEMP
;
; get input data
S DA=$G(DA)
I 'DA&($L(DA)) S DA=+$O(^HLCS(870,"B",DA,0))
;
; invalid ien
Q:'DA ""
;
; invalid ip
Q:('HLIP) ""
;
; get port number
S HLTEMP("PORT")=+$P($G(^HLCS(870,DA,400)),"^",2)
;
; invalid port
Q:'HLTEMP("PORT") ""
;
S HLTEMP("IP")=""
S HLTEMP("IP-VALID")=0
S HLTEMP("IP-COUNT")=$L($G(HLIP),",")
F HLI=1:1:HLTEMP("IP-COUNT") D Q:HLTEMP("IP-VALID")
. S HLTEMP("IP")=$P(HLIP,",",HLI)
. I '$G(HLTCPLNK("TIMEOUT")) S HLTCPLNK("TIMEOUT")=5
. D CALL^%ZISTCP(HLTEMP("IP"),HLTEMP("PORT"),HLTCPLNK("TIMEOUT"))
. I 'POP D
.. D CLOSE^%ZISTCP
.. S HLTEMP("IP-VALID")=HLTEMP("IP")
;
; invalid ip, return null
Q:'HLTEMP("IP-VALID") ""
;
; valid data to update the field
S HLZ(870,DA_",",400.01)=HLTEMP("IP-VALID")
D FILE^DIE("E","HLZ","HLZ")
;
; return the valid ip
Q HLTEMP("IP-VALID")
;
FACILITY(LINK,DELIMITR) ;
; API for retrieving the station number and domain fields of logical
; link (file #870) and to be usd for populating in field MSH-6
; (receiving facility) of message header.
;
; output format: institution number<delimiter>domain<delimiter>DNS
;
; inputs:
; LINK - 1. ien of HL Logical Link file (#870), or
; 2. name (field 'Node'- #.01) of HL Logical Link file
; (#870)
; DELIMITR - such as "~", "^", etc.
;
; output:
; 1. institution number<delimiter>domain<delimiter>DNS
; 2. <null> if input data is invalid
;
; note: if the domain retrieved from DNS domain field with "HL7."
; or "MPI." prefixed at the beginning of the domain, the
; prifixed "HL7." or "MPI." will be removed, in order to
; meet the current implementation of Vista HL7. Current
; VISTA HL7 domain is retrieved from MailMan domain field,
; the "HL7." or "MPI." is not prefixed at the beginning of
; the domain when it is populated in field MSH-6 (receiving
; facility) of message header.
;
N HLLINK,HLCINS,HLCDOM
;
; get input data for link ien or name
S HLLINK=$G(LINK)
I 'HLLINK,HLLINK]"" D
.S HLLINK=$O(^HLCS(870,"B",HLLINK,0))
;
; quit if no ien
Q:'HLLINK ""
;
; get DELIMITR
S DELIMITR=$G(DELIMITR)
;
; quit if invalid DELIMITR
Q:$L(DELIMITR)'=1 ""
;
; retrive data from DNS Domain field of file #870
S HLCDOM("DNS")=$P($G(^HLCS(870,+HLLINK,0)),"^",8)
;
; remove the first piece if the first piece is "HL7" or "MPI"
I ($P(HLCDOM("DNS"),".")="HL7")!($P(HLCDOM("DNS"),".")="MPI") D
. S HLCDOM("DNS")=$P(HLCDOM("DNS"),".",2,99)
;
S (HLCINS,HLCDOM)=""
S HLCINS=$P(^HLCS(870,HLLINK,0),U,2)
S HLCDOM=$P(^HLCS(870,HLLINK,0),U,7)
;
; quit if no data in institution and domain fields
Q:('HLCINS)&('HLCDOM)&('$L(HLCDOM("DNS"))) ""
;
; initialize result
S HLLINK("RESULT")=""
;
; if instition ien exists
I HLCINS D
. S HLCINS=$P($G(^DIC(4,HLCINS,99)),U)
. ;
. ; if valid station number exists
. I HLCINS D
.. ; set station number to the first piece of the result
.. S HLLINK("RESULT")=HLCINS
;
; if MailMan domain ien exists
I HLCDOM D
. ;get MailMan domain name
. S HLCDOM=$P(^DIC(4.2,HLCDOM,0),U)
;
; DNS domain overides MailMan domain
I ($L(HLCDOM("DNS"),".")>2) D
. S HLCDOM=HLCDOM("DNS")
;
; set third piece as "DNS" if domain is valid
I ($L(HLCDOM,".")>2) D
. ; set domain to the 2nd and 3rd pieces of the result
. S HLLINK("RESULT")=HLLINK("RESULT")_DELIMITR_HLCDOM_DELIMITR_"DNS"
Q HLLINK("RESULT")
;
VIEDOMNM() ;
; API for generating the domain of site's local Interface Engine
; if it could be generated based on the VISN, Station number, and
; the site's multi-listener, named beginning with "VA". It returns
; null string if this API is executed in 'test' account.
;
; The real DNS Domain of the VIE server should be the one registered
; in the DNS service.
; The Domain gernerated by this API should not be used if it is not
; the same one gegistered in DNS.
;
; no input
; output:
; return DNS domain if available, else return null string.
;
;retrieve data from HL Communication Server Parameter file (#869.3)
; - Default Processing Id (#.03)
; - Institution (#.04)
;
N HLPARAM
N HLSITE,INSIEN,NODEIEN,FLAG
;
S HLPARAM=$$PARAM^HLCS2
S HLSITE("DEFAULT-PROCESSING-ID")=$P(HLPARAM,"^",3)
;
; ien of "Institution" (#4) file
S INSIEN=$P(HLPARAM,"^",4)
;
; if this is a production accout and found the ien in the
; "Institution" file
I HLSITE("DEFAULT-PROCESSING-ID")="P",INSIEN D
. S FLAG=0
. S NODEIEN=0
. F D Q:('NODEIEN)!(FLAG=1)
.. ;
.. ; find the node ien of file #870
.. S NODEIEN=$O(^HLCS(870,"C",INSIEN,NODEIEN))
.. Q:'NODEIEN
.. ;
.. ; check if multi-listener
.. Q:'$D(^HLCS(870,"E","M",NODEIEN))
.. ;
.. ; get node name
.. S HLSITE("NODE")=$P(^HLCS(870,NODEIEN,0),"^")
.. ;
.. ; check first 2 characters of node name
.. Q:$E(HLSITE("NODE"),1,2)'["VA"
.. ;
.. ; chech the port number if it is 5000
.. Q:$P(^HLCS(870,NODEIEN,400),"^",2)'=5000
.. ;
.. S FLAG=1
. ;
. Q:'FLAG
. ;
. ; get station number
. S HLSITE("STATION")=$P($$NNT^XUAF4(INSIEN),"^",2)
. ;
. Q:'HLSITE("STATION")
. ;
. ; find the VISN number
. D PARENT^XUAF4("HLSITE",HLSITE("STATION"),"VISN")
. S HLSITE("VISN-IEN")=$O(HLSITE("P",0))
. Q:'HLSITE("VISN-IEN")
. ;
. S HLSITE("VISN-NAME")=$G(HLSITE("P",+HLSITE("VISN-IEN")))
. S HLSITE("VISN-NUMBER")=+$P(HLSITE("VISN-NAME")," ",2)
. Q:'HLSITE("VISN-NUMBER")
. ;
. I $L(HLSITE("VISN-NUMBER"))=1 D
.. S HLSITE("VISN-NUMBER")="0"_HLSITE("VISN-NUMBER")
. S HLSITE("DOMAIN")="VHA"_$E(HLSITE("NODE"),3,5)_"VIEV1.V"_HLSITE("VISN-NUMBER")_".DOMAIN.EXT"
;
Q $G(HLSITE("DOMAIN"))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLMA3 9370 printed Nov 22, 2024@17:08:27 Page 2
HLMA3 ;OIFO-O/RJH-API TO LOGICAL LINK FILE ;05/30/08 16:05
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,142**;Oct 13, 1995;Build 17
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
IEDOMAIN() ;
+1 ; API for retrieving domain of site's local Interface Engine
+2 ; from logical link VA-VIE
+3 ;
+4 ; no input
+5 ; output:
+6 ; return DNS domain if available, else return null string.
+7 ;
+8 NEW HLTEMP
+9 ; retrive data from DNS Domain field of file #870
+10 SET HLTEMP("VA-VIE-IEN")=$ORDER(^HLCS(870,"B","VA-VIE",0))
+11 SET HLTEMP("DOMAIN")=$PIECE($GET(^HLCS(870,+$GET(HLTEMP("VA-VIE-IEN")),0)),"^",8)
+12 QUIT HLTEMP("DOMAIN")
+13 ;
LINKAPI(LINK,DOMAIN,AUTOSTAR) ;
+1 ; API for updating fields, DNS Domain and Autostart, of logical link
+2 ; the API may only be applied to production account.
+3 ; inputs:
+4 ; LINK - 1. ien of HL Logical Link file (#870), or
+5 ; 2. name (field 'Node'- #.01) of HL Logical Link file
+6 ; (#870)
+7 ; DOMAIN - data for DNS domain field (field #.08)
+8 ; AUTOSTAR - data for Autostart field (field #4.5),
+9 ; 0 for Disabled, 1 for Enabled.
+10 ; Otherwise, data won't be updated
+11 ;
+12 ; output could be either of the following:
+13 ; 1^DOMAIN,AUTOSTART have been updated
+14 ; 1^DOMAIN has been updated
+15 ; 1^AUTOSTART has been updated
+16 ; -1^none has been updated
+17 ; -1^the api may not be applied to non-production account
+18 ;
+19 NEW HLTEMP,HLZ
+20 ;retrieve data from HL Communication Server Parameter file (#869.3)
+21 ; - Default Processing Id (#.03)
+22 ;
+23 SET HLTEMP("PARAM")=$$PARAM^HLCS2
+24 SET HLTEMP("DEFAULT-PROCESSING-ID")=$PIECE(HLTEMP("PARAM"),"^",3)
+25 ;
+26 ; quit if this is a non-production account
+27 if HLTEMP("DEFAULT-PROCESSING-ID")'="P"
QUIT "-1^the api may not be applied to non-production account"
+28 ;
+29 ; get input data for link ien or name
+30 SET HLTEMP("IEN")=$GET(LINK)
+31 IF 'HLTEMP("IEN")&($LENGTH(HLTEMP("IEN")))
SET HLTEMP("IEN")=+$ORDER(^HLCS(870,"B",HLTEMP("IEN"),0))
+32 ;
+33 ; quit if no ien
+34 if 'HLTEMP("IEN")
QUIT "-1^none has been updated"
+35 ;
+36 ; get input data for DNS domain field
+37 SET HLTEMP("DOMAIN")=$GET(DOMAIN)
+38 ;
+39 ; get IP address for the domain
+40 IF $LENGTH(HLTEMP("DOMAIN"))
SET HLTEMP("IP")=$$ADDRESS^XLFNSLK(HLTEMP("DOMAIN"))
+41 ;
+42 ; invalid domain, set it to null
+43 IF $LENGTH(HLTEMP("DOMAIN"))
IF '$GET(HLTEMP("IP"))
SET HLTEMP("DOMAIN")=""
+44 ;
+45 ; get input data for Autostart field
+46 SET HLTEMP("AUTOSTART")=$GET(AUTOSTAR)
+47 ;
+48 ; quit if invalid data for both fields
+49 if ($LENGTH(HLTEMP("DOMAIN"),".")'>2)&'((HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1"))
QUIT "-1^none has been updated"
+50 IF $LENGTH(HLTEMP("DOMAIN"),".")>2
Begin DoDot:1
+51 SET HLZ(870,HLTEMP("IEN")_",",.08)=HLTEMP("DOMAIN")
End DoDot:1
+52 IF (HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1")
Begin DoDot:1
+53 SET HLZ(870,HLTEMP("IEN")_",",4.5)=HLTEMP("AUTOSTART")
End DoDot:1
+54 DO FILE^DIE("S","HLZ","HLZ")
+55 ;
+56 ; both fields are updated
+57 if $DATA(HLZ(870,HLTEMP("IEN")_",",.08))&($DATA(HLZ(870,HLTEMP("IEN")_",",4.5)))
QUIT "1^DOMAIN,AUTOSTART have been updated"
+58 ;
+59 ; only update DNS Domain field
+60 if $DATA(HLZ(870,HLTEMP("IEN")_",",.08))
QUIT "1^DOMAIN has been updated"
+61 ;
+62 ; only update Autostart field
+63 if $DATA(HLZ(870,HLTEMP("IEN")_",",4.5))
QUIT "1^AUTOSTART has been updated"
+64 ;
IP(DA,HLIP) ;
+1 ; 1. API to update field TCP/IP Address, #870,400.01.
+2 ; 2. called from input transform of #870,.08 DNS Domain to update
+3 ; field TCP/IP Address, #870,400.01.
+4 ;
+5 ; input:
+6 ; DA - 1. ien of HL Logical Link file (#870), or
+7 ; 2. name (field 'Node'- #.01) of HL Logical Link file (#870)
+8 ; HLIP - IP addresses
+9 ;
+10 ; output:
+11 ; return IP address updated to the field if valid,
+12 ; else return null string.
+13 ;
+14 NEW HLZ,HLI,HLTEMP
+15 ;
+16 ; get input data
+17 SET DA=$GET(DA)
+18 IF 'DA&($LENGTH(DA))
SET DA=+$ORDER(^HLCS(870,"B",DA,0))
+19 ;
+20 ; invalid ien
+21 if 'DA
QUIT ""
+22 ;
+23 ; invalid ip
+24 if ('HLIP)
QUIT ""
+25 ;
+26 ; get port number
+27 SET HLTEMP("PORT")=+$PIECE($GET(^HLCS(870,DA,400)),"^",2)
+28 ;
+29 ; invalid port
+30 if 'HLTEMP("PORT")
QUIT ""
+31 ;
+32 SET HLTEMP("IP")=""
+33 SET HLTEMP("IP-VALID")=0
+34 SET HLTEMP("IP-COUNT")=$LENGTH($GET(HLIP),",")
+35 FOR HLI=1:1:HLTEMP("IP-COUNT")
Begin DoDot:1
+36 SET HLTEMP("IP")=$PIECE(HLIP,",",HLI)
+37 IF '$GET(HLTCPLNK("TIMEOUT"))
SET HLTCPLNK("TIMEOUT")=5
+38 DO CALL^%ZISTCP(HLTEMP("IP"),HLTEMP("PORT"),HLTCPLNK("TIMEOUT"))
+39 IF 'POP
Begin DoDot:2
+40 DO CLOSE^%ZISTCP
+41 SET HLTEMP("IP-VALID")=HLTEMP("IP")
End DoDot:2
End DoDot:1
if HLTEMP("IP-VALID")
QUIT
+42 ;
+43 ; invalid ip, return null
+44 if 'HLTEMP("IP-VALID")
QUIT ""
+45 ;
+46 ; valid data to update the field
+47 SET HLZ(870,DA_",",400.01)=HLTEMP("IP-VALID")
+48 DO FILE^DIE("E","HLZ","HLZ")
+49 ;
+50 ; return the valid ip
+51 QUIT HLTEMP("IP-VALID")
+52 ;
FACILITY(LINK,DELIMITR) ;
+1 ; API for retrieving the station number and domain fields of logical
+2 ; link (file #870) and to be usd for populating in field MSH-6
+3 ; (receiving facility) of message header.
+4 ;
+5 ; output format: institution number<delimiter>domain<delimiter>DNS
+6 ;
+7 ; inputs:
+8 ; LINK - 1. ien of HL Logical Link file (#870), or
+9 ; 2. name (field 'Node'- #.01) of HL Logical Link file
+10 ; (#870)
+11 ; DELIMITR - such as "~", "^", etc.
+12 ;
+13 ; output:
+14 ; 1. institution number<delimiter>domain<delimiter>DNS
+15 ; 2. <null> if input data is invalid
+16 ;
+17 ; note: if the domain retrieved from DNS domain field with "HL7."
+18 ; or "MPI." prefixed at the beginning of the domain, the
+19 ; prifixed "HL7." or "MPI." will be removed, in order to
+20 ; meet the current implementation of Vista HL7. Current
+21 ; VISTA HL7 domain is retrieved from MailMan domain field,
+22 ; the "HL7." or "MPI." is not prefixed at the beginning of
+23 ; the domain when it is populated in field MSH-6 (receiving
+24 ; facility) of message header.
+25 ;
+26 NEW HLLINK,HLCINS,HLCDOM
+27 ;
+28 ; get input data for link ien or name
+29 SET HLLINK=$GET(LINK)
+30 IF 'HLLINK
IF HLLINK]""
Begin DoDot:1
+31 SET HLLINK=$ORDER(^HLCS(870,"B",HLLINK,0))
End DoDot:1
+32 ;
+33 ; quit if no ien
+34 if 'HLLINK
QUIT ""
+35 ;
+36 ; get DELIMITR
+37 SET DELIMITR=$GET(DELIMITR)
+38 ;
+39 ; quit if invalid DELIMITR
+40 if $LENGTH(DELIMITR)'=1
QUIT ""
+41 ;
+42 ; retrive data from DNS Domain field of file #870
+43 SET HLCDOM("DNS")=$PIECE($GET(^HLCS(870,+HLLINK,0)),"^",8)
+44 ;
+45 ; remove the first piece if the first piece is "HL7" or "MPI"
+46 IF ($PIECE(HLCDOM("DNS"),".")="HL7")!($PIECE(HLCDOM("DNS"),".")="MPI")
Begin DoDot:1
+47 SET HLCDOM("DNS")=$PIECE(HLCDOM("DNS"),".",2,99)
End DoDot:1
+48 ;
+49 SET (HLCINS,HLCDOM)=""
+50 SET HLCINS=$PIECE(^HLCS(870,HLLINK,0),U,2)
+51 SET HLCDOM=$PIECE(^HLCS(870,HLLINK,0),U,7)
+52 ;
+53 ; quit if no data in institution and domain fields
+54 if ('HLCINS)&('HLCDOM)&('$LENGTH(HLCDOM("DNS")))
QUIT ""
+55 ;
+56 ; initialize result
+57 SET HLLINK("RESULT")=""
+58 ;
+59 ; if instition ien exists
+60 IF HLCINS
Begin DoDot:1
+61 SET HLCINS=$PIECE($GET(^DIC(4,HLCINS,99)),U)
+62 ;
+63 ; if valid station number exists
+64 IF HLCINS
Begin DoDot:2
+65 ; set station number to the first piece of the result
+66 SET HLLINK("RESULT")=HLCINS
End DoDot:2
End DoDot:1
+67 ;
+68 ; if MailMan domain ien exists
+69 IF HLCDOM
Begin DoDot:1
+70 ;get MailMan domain name
+71 SET HLCDOM=$PIECE(^DIC(4.2,HLCDOM,0),U)
End DoDot:1
+72 ;
+73 ; DNS domain overides MailMan domain
+74 IF ($LENGTH(HLCDOM("DNS"),".")>2)
Begin DoDot:1
+75 SET HLCDOM=HLCDOM("DNS")
End DoDot:1
+76 ;
+77 ; set third piece as "DNS" if domain is valid
+78 IF ($LENGTH(HLCDOM,".")>2)
Begin DoDot:1
+79 ; set domain to the 2nd and 3rd pieces of the result
+80 SET HLLINK("RESULT")=HLLINK("RESULT")_DELIMITR_HLCDOM_DELIMITR_"DNS"
End DoDot:1
+81 QUIT HLLINK("RESULT")
+82 ;
VIEDOMNM() ;
+1 ; API for generating the domain of site's local Interface Engine
+2 ; if it could be generated based on the VISN, Station number, and
+3 ; the site's multi-listener, named beginning with "VA". It returns
+4 ; null string if this API is executed in 'test' account.
+5 ;
+6 ; The real DNS Domain of the VIE server should be the one registered
+7 ; in the DNS service.
+8 ; The Domain gernerated by this API should not be used if it is not
+9 ; the same one gegistered in DNS.
+10 ;
+11 ; no input
+12 ; output:
+13 ; return DNS domain if available, else return null string.
+14 ;
+15 ;retrieve data from HL Communication Server Parameter file (#869.3)
+16 ; - Default Processing Id (#.03)
+17 ; - Institution (#.04)
+18 ;
+19 NEW HLPARAM
+20 NEW HLSITE,INSIEN,NODEIEN,FLAG
+21 ;
+22 SET HLPARAM=$$PARAM^HLCS2
+23 SET HLSITE("DEFAULT-PROCESSING-ID")=$PIECE(HLPARAM,"^",3)
+24 ;
+25 ; ien of "Institution" (#4) file
+26 SET INSIEN=$PIECE(HLPARAM,"^",4)
+27 ;
+28 ; if this is a production accout and found the ien in the
+29 ; "Institution" file
+30 IF HLSITE("DEFAULT-PROCESSING-ID")="P"
IF INSIEN
Begin DoDot:1
+31 SET FLAG=0
+32 SET NODEIEN=0
+33 FOR
Begin DoDot:2
+34 ;
+35 ; find the node ien of file #870
+36 SET NODEIEN=$ORDER(^HLCS(870,"C",INSIEN,NODEIEN))
+37 if 'NODEIEN
QUIT
+38 ;
+39 ; check if multi-listener
+40 if '$DATA(^HLCS(870,"E","M",NODEIEN))
QUIT
+41 ;
+42 ; get node name
+43 SET HLSITE("NODE")=$PIECE(^HLCS(870,NODEIEN,0),"^")
+44 ;
+45 ; check first 2 characters of node name
+46 if $EXTRACT(HLSITE("NODE"),1,2)'["VA"
QUIT
+47 ;
+48 ; chech the port number if it is 5000
+49 if $PIECE(^HLCS(870,NODEIEN,400),"^",2)'=5000
QUIT
+50 ;
+51 SET FLAG=1
End DoDot:2
if ('NODEIEN)!(FLAG=1)
QUIT
+52 ;
+53 if 'FLAG
QUIT
+54 ;
+55 ; get station number
+56 SET HLSITE("STATION")=$PIECE($$NNT^XUAF4(INSIEN),"^",2)
+57 ;
+58 if 'HLSITE("STATION")
QUIT
+59 ;
+60 ; find the VISN number
+61 DO PARENT^XUAF4("HLSITE",HLSITE("STATION"),"VISN")
+62 SET HLSITE("VISN-IEN")=$ORDER(HLSITE("P",0))
+63 if 'HLSITE("VISN-IEN")
QUIT
+64 ;
+65 SET HLSITE("VISN-NAME")=$GET(HLSITE("P",+HLSITE("VISN-IEN")))
+66 SET HLSITE("VISN-NUMBER")=+$PIECE(HLSITE("VISN-NAME")," ",2)
+67 if 'HLSITE("VISN-NUMBER")
QUIT
+68 ;
+69 IF $LENGTH(HLSITE("VISN-NUMBER"))=1
Begin DoDot:2
+70 SET HLSITE("VISN-NUMBER")="0"_HLSITE("VISN-NUMBER")
End DoDot:2
+71 SET HLSITE("DOMAIN")="VHA"_$EXTRACT(HLSITE("NODE"),3,5)_"VIEV1.V"_HLSITE("VISN-NUMBER")_".DOMAIN.EXT"
End DoDot:1
+72 ;
+73 QUIT $GET(HLSITE("DOMAIN"))
+74 ;
