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")
;
HLMA3 ;OIFO-O/RJH-API TO LOGICAL LINK FILE ;12/29/04 17:03
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
+2 QUIT
+3 ;
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 DO CALL^%ZISTCP(HLTEMP("IP"),HLTEMP("PORT"))
+38 IF 'POP
Begin DoDot:2
+39 DO CLOSE^%ZISTCP
+40 SET HLTEMP("IP-VALID")=HLTEMP("IP")
End DoDot:2
End DoDot:1
IF HLTEMP("IP-VALID")
QUIT
+41 ;
+42 ; invalid ip, return null
+43 IF 'HLTEMP("IP-VALID")
QUIT ""
+44 ;
+45 ; valid data to update the field
+46 SET HLZ(870,DA_",",400.01)=HLTEMP("IP-VALID")
+47 DO FILE^DIE("E","HLZ","HLZ")
+48 ;
+49 ; return the valid ip
+50 QUIT HLTEMP("IP-VALID")
+51 ;
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 ;
