source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSDL1.m@ 813

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

initial load of FOIAVistA 6/30/08 version

File size: 6.5 KB
Line 
1HLCSDL1 ;ALB/MTC/JC - X3.28 LOWER LAYER PROTOCOL 2.2 - 2/28/95 ;08/19/97
2 ;;1.6;HEALTH LEVEL SEVEN;**2,34**;Oct 13, 1995
3 ;
4 ;This is an implemetation of the X3.28 LLP
5 ;
6START ;
7 N HLIND0,HLIND1,HLNXST,HLTRANS,HLCHK,HLACKBLK,HLDOUT0,HLDOUT1,X,HLRETRY
8 N HLNXST,HLLINE,HLXOR,HLTOUT,HLLINE,HLC1,HLC2
9 N HLDLX,HLM
10 ;S X=10 X ^%ZOSF("PRIORITY")
11 S HLM=0,HLNXST=1
12 ;-- enter loop for polling for i/o
13 D POLL
14 ;-- exit and clean-up
15 D EXIT
16 Q
17 ;
18 ;
19POLL ;-- This function will check if any messages should be sent
20 ; then if anything is in the buffer to read in. If there is data
21 ; to write out then the system will bid for master status and if
22 ; successful x-mit the message. If the system receives a request to
23 ; receive data, then it will attemp to enter a slave mode and read
24 ; data in.
25 ;
26 N HLFLAG
27 S HLFLAG=1
28 D TRACE^HLCSDL2("Logging IO to ^XTMP('HL',N")
29 ;-- enter loop
30 F D MONITOR^HLCSDR2("POLLING",5,HLDP) Q:'HLFLAG D
31 .; should we still be running
32 . I '$$RUN^HLCSDL2 D MONITOR^HLCSDR2("SHUTDOWN",5,HLDP) S HLFLAG=0 Q
33 .;-- check for data to read in
34 . D TRACE^HLCSDL2("Slave Check"),SLAVE
35 . I '$$RUN^HLCSDL2 D MONITOR^HLCSDR2("SHUTDOWN",5,HLDP) S HLFLAG=0 Q
36 .;-- check for out going data
37 . D TRACE^HLCSDL2("Master Check"),MASTER
38 Q
39 ;
40SLAVE ;-- this function will check if anything is ready to read in from
41 ; the port. If nothing is ready then return to polling, else
42 ; start slave process.
43 ;
44 N HLX
45 ;-- check if anything is ready to read in.
46 D TRACE^HLCSDL2("Slave Request")
47 ;-- read for enq (request for slave)
48 I '$$READENQ^HLCSDL2 G SLAVEQ
49 ;-- ack0
50 D TRACE^HLCSDL2("Slave Ack0")
51 D SENDACK^HLCSDL2(0)
52 ;-- read data
53 D TRACE^HLCSDL2("Slave Read Data")
54 D READ
55 ;-- exit and return to polling
56SLAVEQ ;
57 Q
58 ;
59READ ;-- This function will take the incoming data from the device and
60 ; store in file 870. After each read an ack will be sent to the
61 ; client application. Once an EOT has been received, return to
62 ; polling.
63 ;
64 N HLX,HLI,HLBK,HLETXB,HLLINE,HLDATA,BTERM
65 ;-- prepare for incoming data
66 S HLLINE=1,HLI=0
67LOOP ;-- main loop for reading in message
68 ;
69 ;-- update status
70 D MONITOR^HLCSDR2("READING",5,HLDP)
71 ;-- read block of data
72 S HLX=$$READBK^HLCSDL2("HLDATA",.HLLEN,.HLBK,.HLCK,.BTERM)
73 ;-- check for TIMEOUT
74 I $G(HLDATA)["TIMEOUT" G READQ
75 ;-- check for EOT
76 I $G(HLDATA)=HLEOT G READQ
77 ;-- check if vaild data
78 I '$$VALID^HLCSDL2("HLDATA",HLLINE#8,HLLEN,HLBK,HLCK,BTERM) D G LOOP
79 .;-- update status
80 . D TRACE^HLCSDL2("Slave Write NAK")
81 . D MONITOR^HLCSDR2("SEND NAK",5,HLDP)
82 .;-- send nak
83 . D SENDNAK^HLCSDL2
84 ;
85 ;-- write data to file 870
86 S HLDOUT0=$$ENQUEUE^HLCSQUE(HLDP,"IN"),HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0
87 D APPEND^HLCSUTL("HLDATA",HLDOUT0,HLDOUT1)
88 S HLLINE=HLLINE+1
89 ;
90 ;-- If end of text set status
91 I +BTERM=+HLETX D
92 . D MONITOR^HLCSDR2("P",2,HLDOUT0,HLDOUT1,"IN")
93 . D MONITOR^HLCSDR2("A",3,HLDOUT0,HLDOUT1,"IN")
94 ;-- ack
95 D SENDACK^HLCSDL2(HLBK)
96 ;-- read next line of data
97 G LOOP
98 ;
99READQ Q
100 ;
101MASTER ;-- if outgoing messages are present then establish m/s and begin
102 ; transmission of message.
103 ;
104 N HLBID,HLDOUT0,HLDOUT1
105 ;-- check queue
106 D TRACE^HLCSDL2("Master Check Queue")
107 S HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")
108 ;-- nothing on queue quit
109 I +HLDOUT0<0 D TRACE^HLCSDL2("*Out Queue Empty") G MASTERQ
110 S HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0
111 ;-- have item in queue to write, bid for master status
112 S HLBID=$$BID(5)
113 ;-- if attemp fails quit
114 I 'HLBID D PUSH^HLCSQUE(HLDOUT0,HLDOUT1) G MASTERQ
115 ;-- if successful goto write state
116 I HLBID D
117 . D WRITE(HLDOUT0,HLDOUT1)
118 . D EOT^HLCSDL2
119 ;
120MASTERQ Q
121 ;
122BID(MAXTRY) ;-- This function will bid for Master status MAXTRY times
123 ; and return a 1 if succesful, 0 if fails
124 ; INPUT - MAXTRY - Maximum number of attemps before failing
125 ; OUTPUT - 1 for ok; 0 fails
126 ;
127 N RESULT,HLTRIES,HLDLX
128 S RESULT=0,HLTRIES=0
129 ;-- update status
130 D MONITOR^HLCSDR2("BIDDING",5,HLDP)
131BIDRET ;-- bid for master status
132 D TRACE^HLCSDL2("Master Bid")
133 D ENQ^HLCSDL2
134 ;-- update status
135 D TRACE^HLCSDL2("Master Bid Wait Ack0")
136 D MONITOR^HLCSDR2("WAIT ACK",5,HLDP)
137 ;-- if read ack if block 0 OK else fail
138 I $$READACK^HLCSDL2(0) S RESULT=1 G BIDQ
139 ;-- if nak or timeout
140 S HLTRIES=HLTRIES+1
141 I HLTRIES>(MAXTRY-1) G BIDQ
142 G BIDRET
143BIDQ ;-- exit
144 Q RESULT
145 ;
146WRITE(HLDOUT0,HLDOUT1) ;-- This function will take the message contained
147 ; in file 870 specified by HLDOUT0 and HLDOUT1 and write the data out.
148 ; after each write the system will wait for an ack.
149 ; INPUT : HLDOUT0 - IEN of file #870
150 ; HLDOUT1 - IEN of out queue multiple
151 ;
152 N HLHEAD,HLTEXT1,HLFOOT,HLX1,HLX2,HLX3,HLTEMP
153 ;-- loop to process message
154 S HLX1="",HLX2="HLTEXT1"
155 F HLI=1:1 K HLTEXT1 S HLX1=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLX1,HLX2,"OUT") Q:'HLX1 D I '$$SEND(HLX2,HLHEAD,HLFOOT,5,HLI#8) Q
156 . S HLX3=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLX1,"HLTEMP","OUT")
157 . D BUILD^HLCSDL2(HLX2,HLI,$S(HLX3:HLETB,1:HLETX),.HLHEAD,.HLFOOT)
158 ;
159WRITEQ Q
160 ;
161SEND(HLTEXT,HLHEAD,HLFOOT,HLRETRY,HLBK) ;-- This function will write the X3.28 formatted
162 ; string out the port and wait for an ack. If this function fails
163 ; 0 will be returned, else 1.
164 ;
165 ; Input - HLTEXT - Array containing segment to send
166 ; - HLHEAD - Block header <STX><BLK><LEN>
167 ; - HLFOOT - Block footer <ETX or ETB><BCC><TERM>
168 ; - HLRETRY- Maximum retries before failure
169 ; - HLBK - Current block 0-7
170 ; Output- 0 Fails, 1 = OK
171 ;
172 N RESULT,HLTRY,X
173 S RESULT=1,HLTRY=0
174RETRY ;-- write data
175 ;-- update status
176 D TRACE^HLCSDL2("Master Write")
177 D MONITOR^HLCSDR2("WRITING",5,HLDP)
178 ;
179 U IO
180 ;-- write header
181 W HLHEAD
182 D LOG(HLHEAD,"WRITE: ")
183 S X="" F S X=$O(@HLTEXT@(X)) Q:'X W @HLTEXT@(X) D LOG(@HLTEXT@(X),"Write: ")
184 ;-- write footer
185 W HLFOOT D LOG(HLFOOT,"WRITE: ")
186 ;-- Wait for ack
187 D TRACE^HLCSDL2("Master Wait for Ack"_HLBK)
188 D MONITOR^HLCSDR2("WAITING ACK",5,HLDP)
189 ;-- if ack
190 I $$READACK^HLCSDL2(HLBK) S RESULT=1 D MONITOR^HLCSDR2("D",2,HLDP,HLDOUT1,"OUT") G SENDQ
191 ;-- if nak then retry
192 S HLTRY=HLTRY+1
193 I HLTRY>(HLRETRY-1) S RESULT=0 G SENDQ
194 G RETRY
195SENDQ ;-- exit
196 Q RESULT
197 ;
198EXIT ;-- Cleanup
199 Q
200 ;
201LOG(ST1,OP) ;Log reads/writes (translates ctrls)
202 ;ST1=string to file
203 ;OP=operation "read" or "write"
204 I $G(HLTRACE) D
205 .N X S X=$G(^XTMP("HL",0)),$P(X,U)=DT+1,$P(X,U,2)=DT
206 .S $P(X,U,3)="HL7 Debug Log",HLLOG=$P(X,U,4)
207 .S HLN=$$TRANS(ST1)
208 .S HLLOG=HLLOG+1,^XTMP("HL",HLLOG)=OP_HLN,$P(X,U,4)=HLLOG
209 .S ^XTMP("HL",0)=X
210 Q
211TRANS(ST) ;Translate controls in string
212 ;ST=String containing embedded x3.28 control characters
213 S ST2="" F I=1:1:$L(ST) S J=$E(ST,I) D
214 .I $D(HLCTRL($A(J))) S J=HLCTRL($A(J))
215 .S ST2=$G(ST2)_J
216 Q ST2
Note: See TracBrowser for help on using the repository browser.