OpenVista/GT.M Integration

Merge lp://staging/~jeff-apple/openvista-gtm-integration/bug336102 into lp://staging/openvista-gtm-integration

  1. bug336102
  2. Merge into mainline
Proposed by jeff.apple
Status: Merged
Merged at revision: not available
Proposed branch: lp://staging/~jeff-apple/openvista-gtm-integration/bug336102
Merge into: lp://staging/openvista-gtm-integration
Diff against target: None lines
To merge this branch: bzr merge lp://staging/~jeff-apple/openvista-gtm-integration/bug336102
Reviewer Review Type Date Requested Status
Jon Tai Approve
Review via email: mp+5450@code.staging.launchpad.net
To post a comment you must log in.
Revision history for this message
Jon Tai (jontai) :
review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1=== added file 'mumps/HLCSTCP1.m'
2--- mumps/HLCSTCP1.m 1970-01-01 00:00:00 +0000
3+++ mumps/HLCSTCP1.m 2009-04-10 21:55:26 +0000
4@@ -0,0 +1,178 @@
5+HLCSTCP1 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;11/21/2001 17:09
6+ ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,64,71**;JUL 17,1995
7+ ;Receiver
8+ ;connection is initiated by sender and listener accepts connection
9+ ;and calls this routine
10+ ;
11+ N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLCSTCP1"
12+ N HLMIEN,HLASTMSG
13+ D MON^HLCSTCP("Open")
14+ K ^TMP("HLCSTCP",$J,0)
15+ S HLMIEN=0,HLASTMSG=""
16+ F D Q:$$STOP^HLCSTCP I 'HLMIEN D MON^HLCSTCP("Idle") H 3
17+ . S HLMIEN=$$READ
18+ . Q:'HLMIEN
19+ . D PROCESS
20+ Q
21+ ;
22+PROCESS ;check message and reply
23+ ;HLDP=LL in 870, update monitor, received msg.
24+ N HLTCP,HLTCPI,HLTCPO
25+ S HLTCP="",HLTCPO=HLDP,HLTCPI=+HLMIEN
26+ ;update monitor, msg. received
27+ D LLCNT^HLCSTCP(HLDP,1)
28+ D NEW^HLTP3(HLMIEN)
29+ ;update monitor, msg. processed
30+ D LLCNT^HLCSTCP(HLDP,2)
31+ Q
32+ ;
33+READ() ;read 1 message, returns ien in 773^ien in 772 for message
34+ D MON^HLCSTCP("Reading")
35+ N HLDB,HLDT,HLDEND,HLACKWT,HLDSTRT,HLHDR,HLIND1,HLINE,HLMSG,HLRDOUT,HLRS,HLX,X
36+ ;HLDSTRT=start char., HLDEND=end char., HLRS=record seperator
37+ S HLDSTRT=$C(11),HLDEND=$C(28),HLRS=$C(13)
38+ ;HLRDOUT=exit read loop, HLINE=line count, HLIND1=ien 773^ien 772
39+ ;HLHDR=have a header, ^TMP(...)=excess from last read, HLACKWT=wait for ack
40+ S (HLRDOUT,HLINE,HLIND1,HLHDR)=0,HLX=$G(^TMP("HLCSTCP",$J,0)),HLACKWT=HLDBACK
41+ K ^TMP("HLCSTCP",$J,0)
42+ F D RDBLK Q:HLRDOUT
43+ ;save any excess for next time
44+ S:$L(HLX) ^TMP("HLCSTCP",$J,0)=HLX
45+ I +HLIND1,'$P(HLIND1,U,3) D DELMSG(HLIND1) S HLIND1=0
46+ Q HLIND1
47+ ;
48+RDBLK S HLDB=HLDBSIZE-$L(HLX)
49+ U IO D:$D ERROR R X#HLDB:HLDREAD
50+ ; timedout or error, check ack timeout, clean up
51+ I '$T,X="",HLX="" S HLACKWT=HLACKWT-HLDREAD D:HLACKWT<0&'HLHDR CLEAN Q
52+ ;data stream: <sb>dddd<cr><eb><cr>
53+ ;add incoming line to what wasn't processed in last read
54+ S HLX=$G(HLX)_X
55+ ; look for segment= <CR>
56+ F Q:HLX'[HLRS D Q:HLRDOUT
57+ . ; Get the first piece, save the rest of the line
58+ . S HLINE=HLINE+1,HLMSG(HLINE,0)=$P(HLX,HLRS),HLX=$P(HLX,HLRS,2,999)
59+ . ; check for start block, Quit if no ien
60+ . I HLMSG(HLINE,0)[HLDSTRT!HLHDR D Q
61+ .. D:HLMSG(HLINE,0)[HLDSTRT
62+ ... S X=$L(HLMSG(HLINE,0),HLDSTRT)
63+ ... S:X>2 HLMSG(HLINE,0)=HLDSTRT_$P(HLMSG(HLINE,0),HLDSTRT,X)
64+ ... S HLMSG(HLINE,0)=$P(HLMSG(HLINE,0),HLDSTRT,2)
65+ ... D RESET:(HLINE>1)
66+ .. ;ping message
67+ .. I $E(HLMSG(1,0),1,9)="MSH^PING^" D PING Q
68+ .. ; get next ien to store
69+ .. D MIEN
70+ .. K HLMSG
71+ .. S (HLINE,HLHDR)=0
72+ . ; check for end block; HLMSG(HLINE) = <eb><cr>
73+ . I HLMSG(HLINE,0)[HLDEND D
74+ .. ;no msg. ien
75+ .. Q:'HLIND1
76+ .. ; Kill just the last line
77+ .. K HLMSG(HLINE,0) S HLINE=HLINE-1
78+ .. ; move into 772
79+ .. D SAVE(.HLMSG,"^HL(772,"_+$P(HLIND1,U,2)_",""IN"")")
80+ .. ;mark that end block has been received
81+ .. ;HLIND1=ien in 773^ien in 772^1 if end block was received
82+ .. S $P(HLIND1,U,3)=1
83+ .. ;reset variables for next message
84+ .. D CLEAN
85+ . ;add blank line for carriage return
86+ . I HLINE'=0,HLMSG(HLINE,0)]"" S HLINE=HLINE+1,HLMSG(HLINE,0)=""
87+ Q:HLRDOUT
88+ ;If the line is long and no <CR> move it into the array.
89+ I ($L(HLX)=HLDBSIZE),(HLX'[HLRS),(HLX'[HLDEND),(HLX'[HLDSTRT) D Q
90+ . S HLINE=HLINE+1,HLMSG(HLINE,0)=HLX,HLX=""
91+ ;have start block but no record seperator
92+ I HLX[HLDSTRT D Q
93+ . ;check for more than 1 start block
94+ . S X=$L(HLX,HLDSTRT) S:X>2 HLX=HLDSTRT_$P(HLX,HLDSTRT,X)
95+ . S:$L($P(HLX,HLDSTRT,2))>8 HLINE=HLINE+1,HLMSG(HLINE,0)=$P(HLX,HLDSTRT,2),HLX="",HLHDR=1
96+ . D RESET:(HLHDR&(HLINE>1))
97+ ;if no ien, then we don't have start block, reset
98+ I 'HLIND1 D CLEAN Q
99+ ; big message-merge from local to global every 100 lines
100+ I (HLINE-$O(HLMSG(0)))>100 D
101+ . M ^HL(772,+$P(HLIND1,U,2),"IN")=HLMSG
102+ . ; reset working array
103+ . K HLMSG
104+ Q
105+ ;
106+SAVE(SRC,DEST) ;save into global & set top node
107+ ;SRC=source array (passed by ref.), DEST=destination global
108+ M @DEST=SRC
109+ S @DEST@(0)="^^"_HLINE_"^"_HLINE_"^"_DT_"^"
110+ Q
111+ ;
112+DELMSG(HLMAMT) ;delete message from Message Administration/Message Text files.
113+ N DIK,DA
114+ S DA=+HLMAMT,DIK="^HLMA("
115+ D ^DIK
116+ S DA=$P(HLMAMT,U,2),DIK="^HL(772,"
117+ D ^DIK
118+ Q
119+MIEN ; sets HLIND1=ien in 773^ien in 772 for message
120+ N HLMID,X
121+ I HLIND1 D
122+ . S:'$G(^HLMA(+HLIND1,0)) HLIND1=0
123+ . S:'$G(^HL(772,+$P(HLIND1,U,2),0)) HLIND1=0
124+ ;msg. id is 10th of MSH & 11th for BSH or FSH
125+ S X=10+($E(HLMSG(1,0),1,3)'="MSH"),HLMID=$$PMSH(.HLMSG,X)
126+ ;if HLIND1 is set, kill old message, use HLIND1 for new
127+ ;message, it means we never got end block for 1st msg.
128+ I HLIND1 D Q
129+ . ;get pointer to 772, kill header
130+ . K ^HLMA(+HLIND1,"MSH")
131+ . I $D(^HL(772,+$P(HLIND1,U,2),"IN")) K ^("IN")
132+ . S X=$$MAID^HLTF(+HLIND1,HLMID)
133+ . D SAVE(.HLMSG,"^HLMA("_+HLIND1_",""MSH"")")
134+ . S:$P(HLIND1,U,3) $P(HLIND1,U,3)=""
135+ D TCP^HLTF(.HLMID,.X,.HLDT)
136+ I 'X D Q
137+ . ;error - record and reset array
138+ . ;killing HLLSTN will allow MON^HLCSTCP to work with multi-server
139+ . D CLEAN K HLLSTN
140+ . ;error 100=LLP Could not Enqueue the Message, reset array
141+ . D MONITOR^HLCSDR2(100,19,HLDP),MON^HLCSTCP("ERROR") H 30
142+ ;HLIND1=ien in 773^ien in 772
143+ S HLIND1=X_U_+$G(^HLMA(X,0))
144+ ;save MSH into 773
145+ D SAVE(.HLMSG,"^HLMA("_+HLIND1_",""MSH"")")
146+ Q
147+ ;
148+PMSH(MSH,P) ;get piece P from MSH array (passed by ref.)
149+ N FS,I,L,L1,L2,X,Y
150+ S FS=$E(MSH(1,0),4),(L2,Y)=0,X=""
151+ F I=1:1 S L1=$L($G(MSH(I,0)),FS),L=L1+Y-1 D Q:$L(X)!'$D(MSH(I,0))
152+ . S:L1=1 L=L+1
153+ . S:P'>L X=$P($G(MSH(I-1,0)),FS,P-L2)_$P($G(MSH(I,0)),FS,(P-Y))
154+ . S L2=Y,Y=L
155+ Q X
156+ ;
157+PING ;process PING message
158+ S X=HLMSG(1,0)
159+ I X[HLDEND U IO W X,!
160+CLEAN ;reset var. for next message
161+ K HLMSG
162+ S HLINE=0,HLRDOUT=1
163+ Q
164+ ;
165+ERROR ; Error trap for disconnect error and return back to the read loop.
166+ S $ETRAP="D UNWIND^%ZTER"
167+ I $$EC^%ZOSV["READ"!($$EC^%ZOSV["NOTOPEN")!($$EC^%ZOSV["DEVNOTOPN") D UNWIND^%ZTER Q
168+ I $$EC^%ZOSV["WRITE" D CC("Wr-err") D UNWIND^%ZTER Q
169+ S HLCSOUT=1 D ^%ZTER,CC("Error")
170+ D UNWIND^%ZTER
171+ Q
172+ ;
173+CC(X) ;cleanup and close
174+ D MON^HLCSTCP(X)
175+ H 2
176+ Q
177+RESET ;reset info as a result of no end block
178+ N %
179+ S HLMSG(1,0)=HLMSG(HLINE,0)
180+ F %=2:1:HLINE K HLMSG(%,0)
181+ S HLINE=1
182+ Q

Subscribers

People subscribed via source and target branches