Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLMA3

HLMA3.m

Go to the documentation of this file.
  1. HLMA3 ;OIFO-O/RJH-API TO LOGICAL LINK FILE ;12/29/04 17:03
  1. ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
  1. Q
  1. ;
  1. IEDOMAIN() ;
  1. ; API for retrieving domain of site's local Interface Engine
  1. ; from logical link VA-VIE
  1. ;
  1. ; no input
  1. ; output:
  1. ; return DNS domain if available, else return null string.
  1. ;
  1. N HLTEMP
  1. ; retrive data from DNS Domain field of file #870
  1. S HLTEMP("VA-VIE-IEN")=$O(^HLCS(870,"B","VA-VIE",0))
  1. S HLTEMP("DOMAIN")=$P($G(^HLCS(870,+$G(HLTEMP("VA-VIE-IEN")),0)),"^",8)
  1. Q HLTEMP("DOMAIN")
  1. ;
  1. LINKAPI(LINK,DOMAIN,AUTOSTAR) ;
  1. ; API for updating fields, DNS Domain and Autostart, of logical link
  1. ; the API may only be applied to production account.
  1. ; inputs:
  1. ; LINK - 1. ien of HL Logical Link file (#870), or
  1. ; 2. name (field 'Node'- #.01) of HL Logical Link file
  1. ; (#870)
  1. ; DOMAIN - data for DNS domain field (field #.08)
  1. ; AUTOSTAR - data for Autostart field (field #4.5),
  1. ; 0 for Disabled, 1 for Enabled.
  1. ; Otherwise, data won't be updated
  1. ;
  1. ; output could be either of the following:
  1. ; 1^DOMAIN,AUTOSTART have been updated
  1. ; 1^DOMAIN has been updated
  1. ; 1^AUTOSTART has been updated
  1. ; -1^none has been updated
  1. ; -1^the api may not be applied to non-production account
  1. ;
  1. N HLTEMP,HLZ
  1. ;retrieve data from HL Communication Server Parameter file (#869.3)
  1. ; - Default Processing Id (#.03)
  1. ;
  1. S HLTEMP("PARAM")=$$PARAM^HLCS2
  1. S HLTEMP("DEFAULT-PROCESSING-ID")=$P(HLTEMP("PARAM"),"^",3)
  1. ;
  1. ; quit if this is a non-production account
  1. Q:HLTEMP("DEFAULT-PROCESSING-ID")'="P" "-1^the api may not be applied to non-production account"
  1. ;
  1. ; get input data for link ien or name
  1. S HLTEMP("IEN")=$G(LINK)
  1. I 'HLTEMP("IEN")&($L(HLTEMP("IEN"))) S HLTEMP("IEN")=+$O(^HLCS(870,"B",HLTEMP("IEN"),0))
  1. ;
  1. ; quit if no ien
  1. Q:'HLTEMP("IEN") "-1^none has been updated"
  1. ;
  1. ; get input data for DNS domain field
  1. S HLTEMP("DOMAIN")=$G(DOMAIN)
  1. ;
  1. ; get IP address for the domain
  1. I $L(HLTEMP("DOMAIN")) S HLTEMP("IP")=$$ADDRESS^XLFNSLK(HLTEMP("DOMAIN"))
  1. ;
  1. ; invalid domain, set it to null
  1. I $L(HLTEMP("DOMAIN")),'$G(HLTEMP("IP")) S HLTEMP("DOMAIN")=""
  1. ;
  1. ; get input data for Autostart field
  1. S HLTEMP("AUTOSTART")=$G(AUTOSTAR)
  1. ;
  1. ; quit if invalid data for both fields
  1. Q:($L(HLTEMP("DOMAIN"),".")'>2)&'((HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1")) "-1^none has been updated"
  1. I $L(HLTEMP("DOMAIN"),".")>2 D
  1. . S HLZ(870,HLTEMP("IEN")_",",.08)=HLTEMP("DOMAIN")
  1. I (HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1") D
  1. . S HLZ(870,HLTEMP("IEN")_",",4.5)=HLTEMP("AUTOSTART")
  1. D FILE^DIE("S","HLZ","HLZ")
  1. ;
  1. ; both fields are updated
  1. Q:$D(HLZ(870,HLTEMP("IEN")_",",.08))&($D(HLZ(870,HLTEMP("IEN")_",",4.5))) "1^DOMAIN,AUTOSTART have been updated"
  1. ;
  1. ; only update DNS Domain field
  1. Q:$D(HLZ(870,HLTEMP("IEN")_",",.08)) "1^DOMAIN has been updated"
  1. ;
  1. ; only update Autostart field
  1. Q:$D(HLZ(870,HLTEMP("IEN")_",",4.5)) "1^AUTOSTART has been updated"
  1. ;
  1. IP(DA,HLIP) ;
  1. ; 1. API to update field TCP/IP Address, #870,400.01.
  1. ; 2. called from input transform of #870,.08 DNS Domain to update
  1. ; field TCP/IP Address, #870,400.01.
  1. ;
  1. ; input:
  1. ; DA - 1. ien of HL Logical Link file (#870), or
  1. ; 2. name (field 'Node'- #.01) of HL Logical Link file (#870)
  1. ; HLIP - IP addresses
  1. ;
  1. ; output:
  1. ; return IP address updated to the field if valid,
  1. ; else return null string.
  1. ;
  1. N HLZ,HLI,HLTEMP
  1. ;
  1. ; get input data
  1. S DA=$G(DA)
  1. I 'DA&($L(DA)) S DA=+$O(^HLCS(870,"B",DA,0))
  1. ;
  1. ; invalid ien
  1. Q:'DA ""
  1. ;
  1. ; invalid ip
  1. Q:('HLIP) ""
  1. ;
  1. ; get port number
  1. S HLTEMP("PORT")=+$P($G(^HLCS(870,DA,400)),"^",2)
  1. ;
  1. ; invalid port
  1. Q:'HLTEMP("PORT") ""
  1. ;
  1. S HLTEMP("IP")=""
  1. S HLTEMP("IP-VALID")=0
  1. S HLTEMP("IP-COUNT")=$L($G(HLIP),",")
  1. F HLI=1:1:HLTEMP("IP-COUNT") D Q:HLTEMP("IP-VALID")
  1. . S HLTEMP("IP")=$P(HLIP,",",HLI)
  1. . D CALL^%ZISTCP(HLTEMP("IP"),HLTEMP("PORT"))
  1. . I 'POP D
  1. .. D CLOSE^%ZISTCP
  1. .. S HLTEMP("IP-VALID")=HLTEMP("IP")
  1. ;
  1. ; invalid ip, return null
  1. Q:'HLTEMP("IP-VALID") ""
  1. ;
  1. ; valid data to update the field
  1. S HLZ(870,DA_",",400.01)=HLTEMP("IP-VALID")
  1. D FILE^DIE("E","HLZ","HLZ")
  1. ;
  1. ; return the valid ip
  1. Q HLTEMP("IP-VALID")
  1. ;
  1. FACILITY(LINK,DELIMITR) ;
  1. ; API for retrieving the station number and domain fields of logical
  1. ; link (file #870) and to be usd for populating in field MSH-6
  1. ; (receiving facility) of message header.
  1. ;
  1. ; output format: institution number<delimiter>domain<delimiter>DNS
  1. ;
  1. ; inputs:
  1. ; LINK - 1. ien of HL Logical Link file (#870), or
  1. ; 2. name (field 'Node'- #.01) of HL Logical Link file
  1. ; (#870)
  1. ; DELIMITR - such as "~", "^", etc.
  1. ;
  1. ; output:
  1. ; 1. institution number<delimiter>domain<delimiter>DNS
  1. ; 2. <null> if input data is invalid
  1. ;
  1. ; note: if the domain retrieved from DNS domain field with "HL7."
  1. ; or "MPI." prefixed at the beginning of the domain, the
  1. ; prifixed "HL7." or "MPI." will be removed, in order to
  1. ; meet the current implementation of Vista HL7. Current
  1. ; VISTA HL7 domain is retrieved from MailMan domain field,
  1. ; the "HL7." or "MPI." is not prefixed at the beginning of
  1. ; the domain when it is populated in field MSH-6 (receiving
  1. ; facility) of message header.
  1. ;
  1. N HLLINK,HLCINS,HLCDOM
  1. ;
  1. ; get input data for link ien or name
  1. S HLLINK=$G(LINK)
  1. I 'HLLINK,HLLINK]"" D
  1. .S HLLINK=$O(^HLCS(870,"B",HLLINK,0))
  1. ;
  1. ; quit if no ien
  1. Q:'HLLINK ""
  1. ;
  1. ; get DELIMITR
  1. S DELIMITR=$G(DELIMITR)
  1. ;
  1. ; quit if invalid DELIMITR
  1. Q:$L(DELIMITR)'=1 ""
  1. ;
  1. ; retrive data from DNS Domain field of file #870
  1. S HLCDOM("DNS")=$P($G(^HLCS(870,+HLLINK,0)),"^",8)
  1. ;
  1. ; remove the first piece if the first piece is "HL7" or "MPI"
  1. I ($P(HLCDOM("DNS"),".")="HL7")!($P(HLCDOM("DNS"),".")="MPI") D
  1. . S HLCDOM("DNS")=$P(HLCDOM("DNS"),".",2,99)
  1. ;
  1. S (HLCINS,HLCDOM)=""
  1. S HLCINS=$P(^HLCS(870,HLLINK,0),U,2)
  1. S HLCDOM=$P(^HLCS(870,HLLINK,0),U,7)
  1. ;
  1. ; quit if no data in institution and domain fields
  1. Q:('HLCINS)&('HLCDOM)&('$L(HLCDOM("DNS"))) ""
  1. ;
  1. ; initialize result
  1. S HLLINK("RESULT")=""
  1. ;
  1. ; if instition ien exists
  1. I HLCINS D
  1. . S HLCINS=$P($G(^DIC(4,HLCINS,99)),U)
  1. . ;
  1. . ; if valid station number exists
  1. . I HLCINS D
  1. .. ; set station number to the first piece of the result
  1. .. S HLLINK("RESULT")=HLCINS
  1. ;
  1. ; if MailMan domain ien exists
  1. I HLCDOM D
  1. . ;get MailMan domain name
  1. . S HLCDOM=$P(^DIC(4.2,HLCDOM,0),U)
  1. ;
  1. ; DNS domain overides MailMan domain
  1. I ($L(HLCDOM("DNS"),".")>2) D
  1. . S HLCDOM=HLCDOM("DNS")
  1. ;
  1. ; set third piece as "DNS" if domain is valid
  1. I ($L(HLCDOM,".")>2) D
  1. . ; set domain to the 2nd and 3rd pieces of the result
  1. . S HLLINK("RESULT")=HLLINK("RESULT")_DELIMITR_HLCDOM_DELIMITR_"DNS"
  1. Q HLLINK("RESULT")
  1. ;