source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSDL2.m@ 623

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1HLCSDL2 ;ALB/MTC/JC - X3.28 LOWER LAYER PROTOCOL UTILITIES 2.2 - 2/28/95 ;04/25/96 10:52
2 ;;1.6;HEALTH LEVEL SEVEN;**2**;Oct 13, 1995
3 Q
4 ;
5SENDNAK ;-- This function will send an nack for the block specified
6 ; by the parameter HLBK.
7 ; OUTPUT: NONE
8 ;
9 ;
10 U IO
11 W $C(HLNAK)_$C(HLTERM)
12 D LOG^HLCSDL1($C(HLNAK)_$C(HLTERM),"WRITE: ")
13 Q
14 ;
15SENDACK(HLBK) ;-- This function will send an ack for the block specified
16 ; by the parameter HLBK.
17 ; INPUT : HLBK current sequence (block)
18 ; OUTPUT: NONE
19 ;
20 N HLACKN
21 ;
22 S HLACKN="HLACK"_(HLBK#8)
23 U IO W $C(HLDLE)_$C(@(HLACKN))_$C(HLTERM)
24 D LOG^HLCSDL1($C(HLDLE)_$C(@(HLACKN))_$C(HLTERM),"WRITE: ")
25 Q
26 ;
27READACK(HLBK) ;-- This function will read the input device for an ackN
28 ; specified by HLBK.
29 ; INPUT : HLBK - Expected AckN
30 ; OUTPUT: 1- Ok 0-Fails
31 ;
32 N HLACKN,X,Y,RESULT,HLTRM
33 ;
34 S RESULT=0,HLTRM=""
35 S HLACKN=@("HLACK"_(HLBK#8))
36 ;-- do read for HLDLE
37 S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
38 D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
39 D TRACE^HLCSDL2("FINISHED READ FOR DLE:"_HLTRM_U_X_U)
40 I HLTRM'=HLDLE G RDACKQ
41 S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
42 D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
43 I X'=$C(HLACKN),HLTRM'=HLTERM G RDACKQ
44 S RESULT=1
45 ;
46RDACKQ Q RESULT
47 ;
48READENQ() ;-- This function will read the input device for an ENQ
49 ;
50 ; INPUT : NONE
51 ; OUTPUT: 1- Ok 0-Fails
52 ;
53 N X,Y,RESULT,HLTRM,HLX
54 ;
55 S HLX=0
56RETRY S RESULT=0,HLTRM=""
57 ;-- do read for HLENQ
58 S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
59 D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
60 D TRACE^HLCSDL2("FINISHED READ FOR ENQ:"_HLTRM_U_X_U)
61 S HLX=HLX+1 I HLX>5 G RDENQ
62 I HLTRM'=+HLENQ G RETRY
63 ;-- do read for HLTERM
64 S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
65 D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
66 I HLTRM'=+HLTERM G RDENQ
67 S RESULT=1
68 ;
69RDENQ Q RESULT
70 ;
71READBK(HLTEXT,LEN,BLOCK,CHKSUM,BTERM) ; This function will read a block of data from the input device
72 ; and store the result in the array specified by HLTEXT.
73 ; INPUT : HLTEXT - Array reference to store data
74 ; LEN - Passed by reference will get message lenght
75 ; BLOCK - Passed by refence will get message block #
76 ; CHKSUM - Passed by refence will get message BCC
77 ; BTERM - Passed by reference will block termination char
78 ; OUTPUT : 1 - OK, 0 - Fails
79 ; If EOT is encountered HLTEXT=EOT
80 ; If TimeOut is encountered then HLTEXT="-1^TIMEOUT"
81 ;
82 N RESULT,HLX,HLTRM
83 S (RESULT,LEN,CHKSUM,BTERM,BLOCK)=0
84 ;-- read expect either SOH or STX will ignore header info
85 S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
86 D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
87 ;-- check for timeout
88 I HLX["TIMEOUT" S @HLTEXT=HLX G READBKQ
89 ;-- check for eot
90 I HLTRM=+HLEOT S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM),@HLTEXT=HLEOT,RESULT=1 D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ") G READBKQ
91 ;-- if header read and ignore
92 I HLTRM=+HLSOH S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM) D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ") I HLX["TIMEOUT" S @HLTEXT=HLX
93 ;-- start of data block
94 I HLTRM'=+HLSTX G READBKQ
95 ;-- read expect either HLDBLOCK characters or CR for end of data
96 S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
97 D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
98 ;-- check for timeout
99 I HLX["TIMEOUT" S @HLTEXT=HLX G READBKQ
100 ;-- get block and length -- <blk><len><data><cr>
101 S HLI=0
102 S BLOCK=$E(HLX),LEN=$E(HLX,2,6)
103 ;
104BLOOP ;-- block read loop
105 ;
106 ;-- first pass get data leave blk and lenght
107 I HLI=0 S HLX=$E(HLX,7,$L(HLX))
108 ;-- save data
109BLOOP2 S HLI=HLI+1,@HLTEXT@(HLI)=HLX
110 ;-- long line
111 I HLTRM=0 D
112 . S HLDONE=0,HLJ=0
113 . F S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM) D I HLDONE Q
114 .. D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
115 .. I +HLX<0 S HLDONE=1 Q
116 .. S HLJ=HLJ+1,@HLTEXT@(HLI,HLJ)=HLX
117 .. I HLTRM=+HLTERM S HLDONE=1
118 ;
119 ;-- read upto next ctrl char
120 S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
121 D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
122 ;-- check for timeout
123 I HLX["TIMEOUT" S @HLTEXT=HLX G READBKQ
124 ;-- more data to read
125 I (HLTRM=+HLTERM)!(HLTRM=0) G BLOOP2
126 ;-- read expect ETX or ETB
127 I (HLTRM=+HLETB)!(HLTRM=+HLETX) S BTERM=HLTRM D
128 .;-- read expect <BCC><TERM>
129 . S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
130 . D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
131 .;-- get BCC
132 . S CHKSUM=HLX
133 ;-- OK
134 S RESULT=1
135 ;
136READBKQ Q RESULT
137 ;
138BUILD(HLTEXT,HLSEQ,HLEND,HLHEAD,HLFOOT) ;-- This function will build the block to write.
139 ; INPUT : HLTEXT - Array to write/format
140 ; : HLSEQ - Sequence in message
141 ; : HLEND - ETX or ETB
142 ; : HLHEAD - Passed by reference - will be the header portion
143 ; : HLFOOT - Passed by reference - will be the footer portion
144 ;
145 ; OUTPUT: HLHEAD = <STX><BLK><LENGTH>
146 ; HLFOOT = <ETX or ETB><BCC><TERM>
147 ;
148 N HLBL,HLHEX,X,Y
149 ;-- get checksum information
150 S HLCHK=$$CHKSUM^HLCSUTL(HLTEXT)
151 ;-- determine block number
152 S HLBL=HLSEQ#8
153 ;-- determine length
154 S HLLN=$P(HLCHK,U,2)
155 S HLLN=$E("00000",1,5-$L(HLLN))_$P(HLCHK,U,2)
156 S X=HLBL_HLLN_$C($P(HLCHK,U))_$C(HLEND) X ^%ZOSF("LPC")
157 ;-- build two byte check sum
158 S HLHEX=$$HEXCON(Y)
159 ;-- build string
160 S HLHEAD=$C(HLSTX)_HLBL_HLLN,HLFOOT=$C(HLEND)_HLHEX_$C(HLTERM)
161 Q
162 ;
163ENQ ;-- this function will send an ENQ to the secondary station
164 ; to establish a master/slave relationship for transmissions.
165 ;
166 U IO
167 W $C(HLENQ)_$C(HLTERM)
168 D LOG^HLCSDL1($C(HLENQ)_$C(HLTERM),"WRITE: ")
169 Q
170 ;
171EOT ;-- this function will send an EOT to the secondary station
172 ; to end the master/stave relationship.
173 ;
174 U IO
175 W $C(HLEOT)_$C(HLTERM)
176 D LOG^HLCSDL1($C(HLEOT)_$C(HLTERM),"WRITE: ")
177 Q
178 ;
179HEXCON(%) ;-- converts a decimal #<128 to a two byte hex #
180 ; INPUT : % - Decimal to convert
181 ;
182 ;
183 N H,H1,H2
184 ;-- error if # not between 0 - 127
185 I (%<0)!(%>127)!(%'=+%) S (H1,H2)=0 G HEXQ
186 I %<10 S H1=0,H2=% G HEXQ
187 S H=%\16 S:H>9 H=$E(" ABCDEF",H) S H1=H
188 S H=%#16 S:H>9 H=$E(" ABCDEF",H) S H2=H
189HEXQ Q H1_H2
190 ;
191RUN() ;-- This function will determine if this occurance of the LLP
192 ; should still be running.
193 ; INPUT : NONE
194 ;OUTPUT : 1 - Yes, 0 No
195 ;
196 N RESULT
197 ;-- default to Yes
198 S RESULT=1
199 ;-- check if should shut down
200 I $P($G(^HLCS(870,HLDP,0)),U,15)=1 S RESULT=0
201 ;-- if running in forground ask
202 I $G(HLTRACE) U IO(0) W !,"Type Q to Quit: " R X:1 I $G(X)'=""&("Qq"[X) S $P(^HLCS(870,HLDP,0),U,15)=1,RESULT=0
203 ;
204 Q RESULT
205 ;
206VALID(HLTEXT,HLBLK,LEN,BLOCK,CHKSUM,BTERM) ;-- This function will validate the incoming message as in should
207 ; conform to the X3.28 protocol. No other error checking is perfomred
208 ; for this validation. If this function is successful a
209 ; 1 is returned else 0.
210 ; INPUT : HLTEXT - The block that was read in from the device
211 ; : HLBLK - Current block expected
212 ; : LEN - xmitted length
213 ; : BLOCK - xmitted block number
214 ; : CHKSUM - xmitted checksum
215 ; : BTERM - Block termination char (ETX or ETB)
216 ; OUTPUT : 1 ok, 0 fails
217 ;
218 ; The following validation checks are made by this function:
219 ; 1 - BCC matches calculated BCC
220 ; 2 - Message lenght matches calculated message length
221 ; 3 - Block matches the expected block number
222 ; 4 - Block termination is either ETX or ETB
223 ;
224 N HLBCC,HLLEN,HLBCC1,RESULT,X,Y
225 S RESULT=0
226 ;-- calculate checksum
227 S HLBCC=$$CHKSUM2^HLCSUTL(HLTEXT)
228 ;-- add in BLOCK LEN and BTERM
229 S X=BLOCK_LEN_$C($P(HLBCC,U))_$C(BTERM) X ^%ZOSF("LPC") S HLBCC1=Y
230 ;-- convert to hex
231 S HLBCC1=$$HEXCON(HLBCC1)
232 ;-- checksum
233 I HLBCC1'=CHKSUM G VALIDQ
234 ;-- length
235 I $P(HLBCC,U,2)'=+LEN G VALIDQ
236 ;-- block
237 I HLBLK'=BLOCK G VALIDQ
238 ;-- ok
239 S RESULT=1
240 ;
241VALIDQ Q RESULT
242 ;
243TRACE(HLSTATE) ;-- This function is used during for debug. It will print
244 ; the current state of the X3.28 protocol. Each state is passed in
245 ; through the variable HLSTATE
246 ;
247 ; INPUT - HLSTATE : Current state of FSM
248 ; OUTPUT - If HLTRACE is defined then write HLSTATE to IO(0)
249 ;
250 I '$G(HLTRACE) Q
251 U IO(0)
252 W !,"In State : ",HLSTATE
253 Q
254 ;
Note: See TracBrowser for help on using the repository browser.