Merge lp:~jontai/openvista-gtm-integration/bug430855 into lp:openvista-gtm-integration
- bug430855
- Merge into mainline
Status: | Merged | ||||
---|---|---|---|---|---|
Merged at revision: | not available | ||||
Proposed branch: | lp:~jontai/openvista-gtm-integration/bug430855 | ||||
Merge into: | lp:openvista-gtm-integration | ||||
Diff against target: |
206 lines 1 file modified
mumps/HLZTCP.m (+202/-0) |
||||
To merge this branch: | bzr merge lp:~jontai/openvista-gtm-integration/bug430855 | ||||
Related bugs: |
|
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
jeff.apple | Approve | ||
Review via email: mp+14088@code.launchpad.net |
Commit message
Description of the change
jeff.apple (jeff-apple) wrote : | # |
> Keep in mind that the new line
> I HLZOS["GT.M" S HLZTCP=
> works by checking if IOPAR contains "server". It never actually contains that
> string, however. The only reason this worked for us was that all of our
> connections were client connections, so we were OK with always setting HLZTCP
> to 2. Overall, this is not a correct fix.
I didn't mean to actually "Approve" that.
Jon Tai (jontai) wrote : | # |
> Keep in mind that the new line
> I HLZOS["GT.M" S HLZTCP=
> works by checking if IOPAR contains "server". It never actually contains that
> string, however. The only reason this worked for us was that all of our
> connections were client connections, so we were OK with always setting HLZTCP
> to 2. Overall, this is not a correct fix.
Hrm... do you know what string we need to search for to make it correct?
jeff.apple (jeff-apple) wrote : | # |
> Hrm... do you know what string we need to search for to make it correct?
Not off the top of my head. I think right now there's no way of really knowing. I think the intent was to name the device something with "server" in it for outgoing connections. I don't know at this time where the device name is determined.
Jon Tai (jontai) wrote : | # |
> > Hrm... do you know what string we need to search for to make it correct?
>
> Not off the top of my head. I think right now there's no way of really
> knowing. I think the intent was to name the device something with "server" in
> it for outgoing connections. I don't know at this time where the device name
> is determined.
I can't really run this code to test, but I think this is what's going on... IOPAR is set by %ZIS. Documentation for %ZIS is here: http://
On GT.M, because the OPEN command's syntax is different, and because we didn't modify the right routines to handle this, we're using the PRE-OPEN EXECUTE to do the actual device opening and we're leaving the OPEN PARAMETERS blank, e.g.:
$I: TCP10004
OPEN PARAMETERS:
PRE-OPEN EXECUTE: O "TCP10004"
POST-CLOSE EXECUTE: C "TCP10004"
So I think the check we need to do in HLZTCP is:
I HLZOS["GT.M" S HLZTCP=
This check uses IOS, the IEN of the open device file entry, to look up the PRE-OPEN EXECUTE in the DEVICE file and searches for "connect=". If found, it's a client connection.
Of course, the *right* way to do this would be to use the OPEN PARAMETERS like all the other platforms, but that's probably beyond the scope of this bug. I can file another bug for that and add a note to remove (or update) HLZTCP to inspect the OPEN PARAMETERS instead of the PRE-OPEN EXECUTE once it's fixed.
Jon Tai (jontai) wrote : | # |
Alternatively, we could just hardcode HLZTCP to be 2 if HLZOS["GT.M". As previously mentioned, this is old code that should be replaced with newer code from the VA, and we only use it to do outbound connections. Robert favors this approach.
We can still file a new bug to handle outbound connections in the DEVICE file more like the other platforms.
jeff.apple (jeff-apple) wrote : | # |
> Alternatively, we could just hardcode HLZTCP to be 2 if HLZOS["GT.M". As
> previously mentioned, this is old code that should be replaced with newer code
> from the VA, and we only use it to do outbound connections. Robert favors
> this approach.
>
> We can still file a new bug to handle outbound connections in the DEVICE file
> more like the other platforms.
I heartily endorse this product and/or service.
This looks fine.
Preview Diff
1 | === added file 'mumps/HLZTCP.m' |
2 | --- mumps/HLZTCP.m 1970-01-01 00:00:00 +0000 |
3 | +++ mumps/HLZTCP.m 2009-10-28 19:11:09 +0000 |
4 | @@ -0,0 +1,202 @@ |
5 | +HLZTCP ;MILW/JMC MSC/JKT - HL7 TCP/IP Hybrid Lower Level Protocol Receiver/Sender ;28OCT2009 |
6 | + ;;1.5;HEALTH LEVEL SEVEN;**MSC**;JUL 09, 1993 |
7 | + ; |
8 | +INIT ;Initialize Variables |
9 | + N HLZIO,HLZOS,HLZSTATE |
10 | + S HLZOS=$G(^%ZOSF("OS")) |
11 | + ; |
12 | + I $D(ZTQUEUED) S ZTREQ="@" |
13 | + ; |
14 | + I $$NEWERR^%ZTER N $ETRAP S $ETRAP="" |
15 | + S X="ERR^HLZTCP",@^%ZOSF("TRAP") |
16 | + ; |
17 | + I '$D(HLION) D Q:POP |
18 | + . D HOME^%ZIS |
19 | + . I POP Q |
20 | + . S HLION=$S(ION']"":"UNKNOWN",1:ION) |
21 | + ; |
22 | + S HLZIO(0)=IO |
23 | + ; |
24 | + ; Figure out type of connection: 1=Server, 2=Client. |
25 | + I HLZOS["DSM" S HLZTCP=$S(IOPAR["ADDRESS":2,1:1) |
26 | + I HLZOS["OpenM" D |
27 | + . N IP |
28 | + . S IP=$P(IOPAR,"""",2) ; Extract IP address |
29 | + . S HLZTCP=$S(IP?1.3N1P1.3N1P1.3N1P1.3N:2,1:1) |
30 | + ; |
31 | + ; IOPAR is not available to us because of the way we're setting up devices on |
32 | + ; GT.M. This routine is only called from a few places, and always in "Client" |
33 | + ; mode, so hard code a return value of 2. This entire routine should be |
34 | + ; abandoned in the future, so it's an acceptable workaround for now. |
35 | + ; See https://code.launchpad.net/~jontai/openvista-gtm-integration/bug430855/+merge/14088 |
36 | + I HLZOS["GT.M" S HLZTCP=2 |
37 | + ; |
38 | + S IOP="NULL DEVICE" D ^%ZIS |
39 | + I POP G EXIT |
40 | + S HLZIO=IO K IOP |
41 | + ; |
42 | + S HLTIME=$$NOW^XLFDT |
43 | + ; |
44 | + U HLZIO(0) |
45 | + ; If TCP client, send a "space" to initiate connection. |
46 | + I HLZTCP=2 W " ",! |
47 | + ; |
48 | + K %,%H,%I,X |
49 | + S DTIME=$P($G(HLNDAP0),"^",9),HLTRIES=$P($G(HLNDAP0),"^",5) |
50 | + S:DTIME'>0 DTIME=60 S:HLTRIES'>0 HLTRIES=3 |
51 | + S HLLPC=^%ZOSF("LPC") |
52 | + ; |
53 | +LOOP ; Infinite loop to check for HL7 messages to send/receive |
54 | + F D I $$S^%ZTLOAD S ZTSTOP=1 Q |
55 | + . S HLLOG=$S($D(^HL(770,"ALOG",HLION)):1,1:0) |
56 | + . D CHKREC,CHKSEND |
57 | +EXIT Q |
58 | + ; |
59 | +ERR ; Trap error |
60 | + ; Reset current device to "NULL DEVICE". |
61 | + U HLZIO |
62 | + ; Reschedule task. |
63 | + I $$EC^%ZOSV["WRITE"!($$EC^%ZOSV["READ") D |
64 | + . N ZTDTH,ZTSK |
65 | + . S ZTSK=ZTQUEUED,ZTDTH="60S",ZTREQ="" |
66 | + . D REQ^%ZTLOAD ; Requeue task in 60 seconds. |
67 | + K HLL(1),^TMP("HLR",$J),^TMP("HLS",$J) |
68 | + Q |
69 | + ; |
70 | +CHKREC ; Check if there are HL7 messages to receive |
71 | + ; Set flag to receive state. |
72 | + S HLZSTATE="recv" |
73 | + D REC |
74 | + ; Received "NAK" message don't know what it goes to. |
75 | + I $G(HLZNAK) K HLERR Q |
76 | + I '$D(HLDTOUT),'HLERR D SENDNAK G CHKREC |
77 | + I '$D(HLDTOUT) U HLZIO K HLERR D ^HLCHK |
78 | + U HLZIO |
79 | + Q |
80 | + ; |
81 | +CHKSEND ; Check if there are HL7 messages to send |
82 | + ; Set flag to send state. |
83 | + S HLZSTATE="send" |
84 | + Q:'$D(HLNDAP) |
85 | + I '$D(HLNDAP0) S HLNDAP0=$G(^HL(770,HLNDAP,0)) |
86 | + S HLDA=+$O(^HL(772,"AC","O",+$P(HLNDAP0,U,12),0)) G:'HLDA EX |
87 | + S HLDA0=$G(^HL(772,HLDA,0)) G:HLDA0']"" EX |
88 | + S HLXMZ=+$P(HLDA0,"^",5) |
89 | + I 'HLXMZ D G EX |
90 | + . D STATUS^HLTF0(HLDA,4,"","No pointer to Message file(#3.9)") |
91 | + I '$D(^XMB(3.9,HLXMZ)) D G EX |
92 | + . D STATUS^HLTF0(HLDA,4,"","No message found at #"_HLXMZ_" in Message file(#3.9)") |
93 | + I '$O(^XMB(3.9,HLXMZ,2,0)) D G EX |
94 | + . D STATUS^HLTF0(HLDA,4,"","No message contents at #"_HLXMZ_" in Message file(#3.9)") |
95 | + S (HLI,HLTRIED)=0,HLSDT=+HLDA0 |
96 | + F HLJ=1:1 S HLI=$O(^XMB(3.9,HLXMZ,2,HLI)) Q:HLI'>0 S ^TMP("HLS",$J,HLSDT,HLJ)=$G(^XMB(3.9,HLXMZ,2,HLI,0)) |
97 | +CS1 S HLTRIED=HLTRIED+1 |
98 | + K ^TMP("HLR",$J),HLSDATA |
99 | + D SEND |
100 | + ; Set flag to awaiting acknowledgement state. |
101 | + S HLZSTATE="awaiting ack" |
102 | + D REC |
103 | + I HLTRIED'=HLTRIES G CS1:$D(HLDTOUT) G CS1:HLZNAK |
104 | + G EX:$D(HLDTOUT) |
105 | + I HLZNAK D G EX |
106 | + . S HLAC=4,HLMSG="Lower Level Protocol Error - "_$S($E(HLL(1))="X":"Checksum",1:"Character Count")_" Did Not Match" |
107 | + . D STATUS^HLTF0(HLDA,HLAC,HLMSG) |
108 | + I $S('$D(HLL(1)):1,"BHS,MSH"'[$E(HLL(1),1,3):1,1:0) D G EX |
109 | + . S HLAC=4,HLMSG="Application Level error - Header Segment Missing" |
110 | + . D STATUS^HLTF0(HLDA,HLAC,HLMSG) |
111 | + K HLXMZ |
112 | + U HLZIO |
113 | + D CHK^HLCHK,IN^HLTF(HLMTN,HLMID,HLTIME) |
114 | + ; |
115 | +EX K HLAC,HLDA,HLDA0,HLERR,HLMSG,HLI,HLJ,HLSDATA,HLSDT,HLTRIED |
116 | + K ^TMP("HLS",$J),^TMP("HLR",$J) |
117 | + Q |
118 | + ; |
119 | +CSUM ;Calculate Checksum |
120 | + S HLC1=HLC1+$L(X),X=X_HLC2 X HLLPC S HLC2=$C(Y) |
121 | + Q |
122 | + ; |
123 | +REC ;Receive a Message |
124 | + S %=$$NOW^XLFDT |
125 | + I HLTIME<% S HLTIME=% |
126 | + E S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1) |
127 | + I HLLOG F Q:'$D(^TMP("HL",HLION,HLTIME)) S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1) |
128 | + K HLL,^TMP("HLR",$J) |
129 | + S (HLC2,X0)="",(HLC1,HLI,HLK,HLZEB,HLZNAK)=0 |
130 | + U HLZIO(0) |
131 | + F R X1#1:DTIME Q:X1=$C(11) I '$T S HLDTOUT=1 Q |
132 | + ; Did not find "Start of block" character. |
133 | + I X1'=$C(11) Q |
134 | + S X0=X1,HLZLEN=1 |
135 | +REC1 U HLZIO(0) K HLDTOUT |
136 | + R X1#1:DTIME I '$T S HLDTOUT=1 |
137 | + ; Timed out and buffer empty. |
138 | + I $G(HLDTOUT),'$L(X1) Q |
139 | + ; |
140 | + S X0=X0_X1,HLZLEN=HLZLEN+1 |
141 | + ; Set "NAK" block type flag. |
142 | + I X1="N",HLZLEN=2 S HLZNAK=1 |
143 | + ; Set "End Block" flag. |
144 | + I X1=$C(28) S HLZEB=1 |
145 | + I X1'=$C(13) G REC1 |
146 | + I HLZEB,HLZNAK D RECNAK Q |
147 | + ; |
148 | + ; Process "End Block" if not a "NAK" record. |
149 | + I HLZEB S HLC=+$E(X0,6,8),HLB=+$E(X0,1,5),X0="" |
150 | + I $L(X0) D |
151 | + . I HLLOG D ;Record Incoming Transmission in Log |
152 | + . . S HLII=X0 S:$P(X0,$E(X0,5))="MSH" $P(X0,$E(X0,5),8)="" |
153 | + . . S HLI=HLI+1,^TMP("HL",HLION,HLTIME,"REC",HLI)=$TR(X0,$C(11,13)),X0=HLII |
154 | + . I HLK,HLK'>2 S HLL(HLK)=$TR(X0,$C(11,13)) |
155 | + . I HLK S ^TMP("HLR",$J,HLTIME,HLK)=$TR(X0,$C(11,13)) |
156 | + . S HLK=HLK+1,X=X0 D CSUM |
157 | + . S X0="" |
158 | + I 'HLZEB G REC1 |
159 | + S X=HLC2 X HLLPC S HLCSUM=Y,HLERR=$S(HLCSUM'=HLC:"X",HLC1'=HLB:"C",1:1) |
160 | + I HLLOG S ^TMP("HL",HLION,HLTIME,"REC","CKS")="Our checksum="_HLCSUM_"/Their checksum="_HLC_"^Our character count="_HLC1_"/Their character count="_HLB |
161 | + Q |
162 | + ; |
163 | +RECNAK ; Process Received "NAK" message. |
164 | + S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1) |
165 | + S HLC=+$E(X0,7,9),HLB=+$E(X0,2,6),X=$E(X0,1) D CSUM |
166 | + S X=HLC2 X HLLPC S HLCSUM=Y,HLERR=$S(HLCSUM'=HLC:"X",HLC1'=HLB:"C",1:1) |
167 | + S HLL(1)=$TR(X0,$C(11,13,28)),^TMP("HLR",$J,HLTIME,1)=HLL(1) |
168 | + I HLLOG D |
169 | + . S ^TMP("HL",HLION,HLTIME,"REC",1)=HLL(1) |
170 | + . S ^TMP("HL",HLION,HLTIME,"REC","CKS")="Our checksum="_HLCSUM_"/Their checksum="_HLC_"^Our character count="_HLC1_"/Their character count="_HLB |
171 | + Q |
172 | + ; |
173 | +SEND ;Send a Message |
174 | + N X,Y |
175 | + S %=$$NOW^XLFDT |
176 | + I HLTIME<% S HLTIME=% |
177 | + E S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1) |
178 | + I HLLOG F Q:'$D(^TMP("HL",HLION,HLTIME)) S HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1) |
179 | + S (HLI,HLC1)=0,HLC2="" |
180 | + D WRITE($C(11)_"D21"_$C(13)) |
181 | + I '$D(HLSDT) F S HLI=$O(HLSDATA(HLI)) Q:HLI="" D WRITE(HLSDATA(HLI)_$C(13)) |
182 | + I $D(HLSDT) F S HLI=$O(^TMP("HLS",$J,HLSDT,HLI)) Q:HLI="" S HLSDATA=^(HLI) D WRITE(HLSDATA_$C(13)) |
183 | + D FLUSH |
184 | + Q |
185 | + ; |
186 | +SENDNAK ; Send a "NAK" message. |
187 | + S (HLC1,HLI)=0,HLC2="",HLTIME=$$FMADD^XLFDT(HLTIME,0,0,0,1) |
188 | + D WRITE($C(11)_"N21"_$C(13)_HLERR) |
189 | + D FLUSH |
190 | + K HLSDATA,HLERR |
191 | + Q |
192 | + ; |
193 | +WRITE(X) ; Write data in buffer. |
194 | + U HLZIO(0) |
195 | + W X,! |
196 | + I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND",HLI)=$TR(X,$C(11,13)) |
197 | + D CSUM |
198 | + Q |
199 | + ; |
200 | +FLUSH ; Write checksum and flush buffer. |
201 | + S X=HLC2 X HLLPC S X=$E("0000",1,(5-$L(HLC1)))_HLC1_$E("00",1,(3-$L(Y)))_Y_$C(28)_$C(13) |
202 | + U HLZIO(0) |
203 | + ; Do final write for this block and flush buffer. |
204 | + W X,! |
205 | + I HLLOG S ^TMP("HL",HLION,HLTIME,"SEND","CKS")=$TR(X,$C(11,13,28)) |
206 | + Q |
Keep in mind that the new line $S(IOPAR[ "server" :1,1:2)
I HLZOS["GT.M" S HLZTCP=
works by checking if IOPAR contains "server". It never actually contains that string, however. The only reason this worked for us was that all of our connections were client connections, so we were OK with always setting HLZTCP to 2. Overall, this is not a correct fix.