219 lines
6.6 KiB
Mathematica
219 lines
6.6 KiB
Mathematica
HLMA3 ;OIFO-O/RJH-API TO LOGICAL LINK FILE ;12/29/04 17:03
|
|
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
|
|
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)
|
|
. D CALL^%ZISTCP(HLTEMP("IP"),HLTEMP("PORT"))
|
|
. 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")
|
|
;
|