source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLMA3.m@ 635

Last change on this file since 635 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.6 KB
Line 
1HLMA3 ;OIFO-O/RJH-API TO LOGICAL LINK FILE ;12/29/04 17:03
2 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
3 Q
4 ;
5IEDOMAIN() ;
6 ; API for retrieving domain of site's local Interface Engine
7 ; from logical link VA-VIE
8 ;
9 ; no input
10 ; output:
11 ; return DNS domain if available, else return null string.
12 ;
13 N HLTEMP
14 ; retrive data from DNS Domain field of file #870
15 S HLTEMP("VA-VIE-IEN")=$O(^HLCS(870,"B","VA-VIE",0))
16 S HLTEMP("DOMAIN")=$P($G(^HLCS(870,+$G(HLTEMP("VA-VIE-IEN")),0)),"^",8)
17 Q HLTEMP("DOMAIN")
18 ;
19LINKAPI(LINK,DOMAIN,AUTOSTAR) ;
20 ; API for updating fields, DNS Domain and Autostart, of logical link
21 ; the API may only be applied to production account.
22 ; inputs:
23 ; LINK - 1. ien of HL Logical Link file (#870), or
24 ; 2. name (field 'Node'- #.01) of HL Logical Link file
25 ; (#870)
26 ; DOMAIN - data for DNS domain field (field #.08)
27 ; AUTOSTAR - data for Autostart field (field #4.5),
28 ; 0 for Disabled, 1 for Enabled.
29 ; Otherwise, data won't be updated
30 ;
31 ; output could be either of the following:
32 ; 1^DOMAIN,AUTOSTART have been updated
33 ; 1^DOMAIN has been updated
34 ; 1^AUTOSTART has been updated
35 ; -1^none has been updated
36 ; -1^the api may not be applied to non-production account
37 ;
38 N HLTEMP,HLZ
39 ;retrieve data from HL Communication Server Parameter file (#869.3)
40 ; - Default Processing Id (#.03)
41 ;
42 S HLTEMP("PARAM")=$$PARAM^HLCS2
43 S HLTEMP("DEFAULT-PROCESSING-ID")=$P(HLTEMP("PARAM"),"^",3)
44 ;
45 ; quit if this is a non-production account
46 Q:HLTEMP("DEFAULT-PROCESSING-ID")'="P" "-1^the api may not be applied to non-production account"
47 ;
48 ; get input data for link ien or name
49 S HLTEMP("IEN")=$G(LINK)
50 I 'HLTEMP("IEN")&($L(HLTEMP("IEN"))) S HLTEMP("IEN")=+$O(^HLCS(870,"B",HLTEMP("IEN"),0))
51 ;
52 ; quit if no ien
53 Q:'HLTEMP("IEN") "-1^none has been updated"
54 ;
55 ; get input data for DNS domain field
56 S HLTEMP("DOMAIN")=$G(DOMAIN)
57 ;
58 ; get IP address for the domain
59 I $L(HLTEMP("DOMAIN")) S HLTEMP("IP")=$$ADDRESS^XLFNSLK(HLTEMP("DOMAIN"))
60 ;
61 ; invalid domain, set it to null
62 I $L(HLTEMP("DOMAIN")),'$G(HLTEMP("IP")) S HLTEMP("DOMAIN")=""
63 ;
64 ; get input data for Autostart field
65 S HLTEMP("AUTOSTART")=$G(AUTOSTAR)
66 ;
67 ; quit if invalid data for both fields
68 Q:($L(HLTEMP("DOMAIN"),".")'>2)&'((HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1")) "-1^none has been updated"
69 I $L(HLTEMP("DOMAIN"),".")>2 D
70 . S HLZ(870,HLTEMP("IEN")_",",.08)=HLTEMP("DOMAIN")
71 I (HLTEMP("AUTOSTART")="0")!(HLTEMP("AUTOSTART")="1") D
72 . S HLZ(870,HLTEMP("IEN")_",",4.5)=HLTEMP("AUTOSTART")
73 D FILE^DIE("S","HLZ","HLZ")
74 ;
75 ; both fields are updated
76 Q:$D(HLZ(870,HLTEMP("IEN")_",",.08))&($D(HLZ(870,HLTEMP("IEN")_",",4.5))) "1^DOMAIN,AUTOSTART have been updated"
77 ;
78 ; only update DNS Domain field
79 Q:$D(HLZ(870,HLTEMP("IEN")_",",.08)) "1^DOMAIN has been updated"
80 ;
81 ; only update Autostart field
82 Q:$D(HLZ(870,HLTEMP("IEN")_",",4.5)) "1^AUTOSTART has been updated"
83 ;
84IP(DA,HLIP) ;
85 ; 1. API to update field TCP/IP Address, #870,400.01.
86 ; 2. called from input transform of #870,.08 DNS Domain to update
87 ; field TCP/IP Address, #870,400.01.
88 ;
89 ; input:
90 ; DA - 1. ien of HL Logical Link file (#870), or
91 ; 2. name (field 'Node'- #.01) of HL Logical Link file (#870)
92 ; HLIP - IP addresses
93 ;
94 ; output:
95 ; return IP address updated to the field if valid,
96 ; else return null string.
97 ;
98 N HLZ,HLI,HLTEMP
99 ;
100 ; get input data
101 S DA=$G(DA)
102 I 'DA&($L(DA)) S DA=+$O(^HLCS(870,"B",DA,0))
103 ;
104 ; invalid ien
105 Q:'DA ""
106 ;
107 ; invalid ip
108 Q:('HLIP) ""
109 ;
110 ; get port number
111 S HLTEMP("PORT")=+$P($G(^HLCS(870,DA,400)),"^",2)
112 ;
113 ; invalid port
114 Q:'HLTEMP("PORT") ""
115 ;
116 S HLTEMP("IP")=""
117 S HLTEMP("IP-VALID")=0
118 S HLTEMP("IP-COUNT")=$L($G(HLIP),",")
119 F HLI=1:1:HLTEMP("IP-COUNT") D Q:HLTEMP("IP-VALID")
120 . S HLTEMP("IP")=$P(HLIP,",",HLI)
121 . D CALL^%ZISTCP(HLTEMP("IP"),HLTEMP("PORT"))
122 . I 'POP D
123 .. D CLOSE^%ZISTCP
124 .. S HLTEMP("IP-VALID")=HLTEMP("IP")
125 ;
126 ; invalid ip, return null
127 Q:'HLTEMP("IP-VALID") ""
128 ;
129 ; valid data to update the field
130 S HLZ(870,DA_",",400.01)=HLTEMP("IP-VALID")
131 D FILE^DIE("E","HLZ","HLZ")
132 ;
133 ; return the valid ip
134 Q HLTEMP("IP-VALID")
135 ;
136FACILITY(LINK,DELIMITR) ;
137 ; API for retrieving the station number and domain fields of logical
138 ; link (file #870) and to be usd for populating in field MSH-6
139 ; (receiving facility) of message header.
140 ;
141 ; output format: institution number<delimiter>domain<delimiter>DNS
142 ;
143 ; inputs:
144 ; LINK - 1. ien of HL Logical Link file (#870), or
145 ; 2. name (field 'Node'- #.01) of HL Logical Link file
146 ; (#870)
147 ; DELIMITR - such as "~", "^", etc.
148 ;
149 ; output:
150 ; 1. institution number<delimiter>domain<delimiter>DNS
151 ; 2. <null> if input data is invalid
152 ;
153 ; note: if the domain retrieved from DNS domain field with "HL7."
154 ; or "MPI." prefixed at the beginning of the domain, the
155 ; prifixed "HL7." or "MPI." will be removed, in order to
156 ; meet the current implementation of Vista HL7. Current
157 ; VISTA HL7 domain is retrieved from MailMan domain field,
158 ; the "HL7." or "MPI." is not prefixed at the beginning of
159 ; the domain when it is populated in field MSH-6 (receiving
160 ; facility) of message header.
161 ;
162 N HLLINK,HLCINS,HLCDOM
163 ;
164 ; get input data for link ien or name
165 S HLLINK=$G(LINK)
166 I 'HLLINK,HLLINK]"" D
167 .S HLLINK=$O(^HLCS(870,"B",HLLINK,0))
168 ;
169 ; quit if no ien
170 Q:'HLLINK ""
171 ;
172 ; get DELIMITR
173 S DELIMITR=$G(DELIMITR)
174 ;
175 ; quit if invalid DELIMITR
176 Q:$L(DELIMITR)'=1 ""
177 ;
178 ; retrive data from DNS Domain field of file #870
179 S HLCDOM("DNS")=$P($G(^HLCS(870,+HLLINK,0)),"^",8)
180 ;
181 ; remove the first piece if the first piece is "HL7" or "MPI"
182 I ($P(HLCDOM("DNS"),".")="HL7")!($P(HLCDOM("DNS"),".")="MPI") D
183 . S HLCDOM("DNS")=$P(HLCDOM("DNS"),".",2,99)
184 ;
185 S (HLCINS,HLCDOM)=""
186 S HLCINS=$P(^HLCS(870,HLLINK,0),U,2)
187 S HLCDOM=$P(^HLCS(870,HLLINK,0),U,7)
188 ;
189 ; quit if no data in institution and domain fields
190 Q:('HLCINS)&('HLCDOM)&('$L(HLCDOM("DNS"))) ""
191 ;
192 ; initialize result
193 S HLLINK("RESULT")=""
194 ;
195 ; if instition ien exists
196 I HLCINS D
197 . S HLCINS=$P($G(^DIC(4,HLCINS,99)),U)
198 . ;
199 . ; if valid station number exists
200 . I HLCINS D
201 .. ; set station number to the first piece of the result
202 .. S HLLINK("RESULT")=HLCINS
203 ;
204 ; if MailMan domain ien exists
205 I HLCDOM D
206 . ;get MailMan domain name
207 . S HLCDOM=$P(^DIC(4.2,HLCDOM,0),U)
208 ;
209 ; DNS domain overides MailMan domain
210 I ($L(HLCDOM("DNS"),".")>2) D
211 . S HLCDOM=HLCDOM("DNS")
212 ;
213 ; set third piece as "DNS" if domain is valid
214 I ($L(HLCDOM,".")>2) D
215 . ; set domain to the 2nd and 3rd pieces of the result
216 . S HLLINK("RESULT")=HLLINK("RESULT")_DELIMITR_HLCDOM_DELIMITR_"DNS"
217 Q HLLINK("RESULT")
218 ;
Note: See TracBrowser for help on using the repository browser.