Merge lp:~jontai/openvista-gtm-integration/bug430855 into lp:openvista-gtm-integration

Proposed by Jon Tai
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
Reviewer Review Type Date Requested Status
jeff.apple Approve
Review via email: mp+14088@code.launchpad.net
To post a comment you must log in.
Revision history for this message
jeff.apple (jeff-apple) wrote :

Keep in mind that the new line
I HLZOS["GT.M" S HLZTCP=$S(IOPAR["server":1,1:2)
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.

review: Approve
Revision history for this message
jeff.apple (jeff-apple) wrote :

> Keep in mind that the new line
> I HLZOS["GT.M" S HLZTCP=$S(IOPAR["server":1,1:2)
> 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.

review: Needs Information
Revision history for this message
Jon Tai (jontai) wrote :

> Keep in mind that the new line
> I HLZOS["GT.M" S HLZTCP=$S(IOPAR["server":1,1:2)
> 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?

Revision history for this message
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.

Revision history for this message
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://www.hardhats.org/kernel/html/zis.shtml One of the output variables is IOPAR, which contains the OPEN PARAMETERS. The OPEN PARAMETERS are configured differently depending on your platform, see http://<email address hidden>/msg00927.html.

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":(connect="10.0.0.1:10004:TCP":attach="client"):10:"SOCKET"
  POST-CLOSE EXECUTE: C "TCP10004"

So I think the check we need to do in HLZTCP is:

  I HLZOS["GT.M" S HLZTCP=$S(^%ZIS(1,IOS,"POX")["connect=":2,1:1)

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.

Revision history for this message
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.

98. By Jon Tai

hard code HLZTCP=2

Revision history for this message
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.

review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
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

Subscribers

People subscribed via source and target branches