HLCSDL1 ;ALB/MTC/JC - X3.28 LOWER LAYER PROTOCOL 2.2 - 2/28/95 ;08/19/97 [ 04/02/2003 8:38 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;;1.6;HEALTH LEVEL SEVEN;**2,34**;Oct 13, 1995
;
;This is an implemetation of the X3.28 LLP
;
START ;
N HLIND0,HLIND1,HLNXST,HLTRANS,HLCHK,HLACKBLK,HLDOUT0,HLDOUT1,X,HLRETRY
N HLNXST,HLLINE,HLXOR,HLTOUT,HLLINE,HLC1,HLC2
N HLDLX,HLM
;S X=10 X ^%ZOSF("PRIORITY")
S HLM=0,HLNXST=1
;-- enter loop for polling for i/o
D POLL
;-- exit and clean-up
D EXIT
Q
;
;
POLL ;-- This function will check if any messages should be sent
; then if anything is in the buffer to read in. If there is data
; to write out then the system will bid for master status and if
; successful x-mit the message. If the system receives a request to
; receive data, then it will attemp to enter a slave mode and read
; data in.
;
N HLFLAG
S HLFLAG=1
D TRACE^HLCSDL2("Logging IO to ^XTMP('HL',N")
;-- enter loop
F D MONITOR^HLCSDR2("POLLING",5,HLDP) Q:'HLFLAG D
.; should we still be running
. I '$$RUN^HLCSDL2 D MONITOR^HLCSDR2("SHUTDOWN",5,HLDP) S HLFLAG=0 Q
.;-- check for data to read in
. D TRACE^HLCSDL2("Slave Check"),SLAVE
. I '$$RUN^HLCSDL2 D MONITOR^HLCSDR2("SHUTDOWN",5,HLDP) S HLFLAG=0 Q
.;-- check for out going data
. D TRACE^HLCSDL2("Master Check"),MASTER
Q
;
SLAVE ;-- this function will check if anything is ready to read in from
; the port. If nothing is ready then return to polling, else
; start slave process.
;
N HLX
;-- check if anything is ready to read in.
D TRACE^HLCSDL2("Slave Request")
;-- read for enq (request for slave)
I '$$READENQ^HLCSDL2 G SLAVEQ
;-- ack0
D TRACE^HLCSDL2("Slave Ack0")
D SENDACK^HLCSDL2(0)
;-- read data
D TRACE^HLCSDL2("Slave Read Data")
D READ
;-- exit and return to polling
SLAVEQ ;
Q
;
READ ;-- This function will take the incoming data from the device and
; store in file 870. After each read an ack will be sent to the
; client application. Once an EOT has been received, return to
; polling.
;
N HLX,HLI,HLBK,HLETXB,HLLINE,HLDATA,BTERM
;-- prepare for incoming data
S HLLINE=1,HLI=0
LOOP ;-- main loop for reading in message
;
;-- update status
D MONITOR^HLCSDR2("READING",5,HLDP)
;-- read block of data
S HLX=$$READBK^HLCSDL2("HLDATA",.HLLEN,.HLBK,.HLCK,.BTERM)
;-- check for TIMEOUT
I $G(HLDATA)["TIMEOUT" G READQ
;-- check for EOT
I $G(HLDATA)=HLEOT G READQ
;-- check if vaild data
I '$$VALID^HLCSDL2("HLDATA",HLLINE#8,HLLEN,HLBK,HLCK,BTERM) D G LOOP
.;-- update status
. D TRACE^HLCSDL2("Slave Write NAK")
. D MONITOR^HLCSDR2("SEND NAK",5,HLDP)
.;-- send nak
. D SENDNAK^HLCSDL2
;
;-- write data to file 870
S HLDOUT0=$$ENQUEUE^HLCSQUE(HLDP,"IN"),HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0
D APPEND^HLCSUTL("HLDATA",HLDOUT0,HLDOUT1)
S HLLINE=HLLINE+1
;
;-- If end of text set status
I +BTERM=+HLETX D
. D MONITOR^HLCSDR2("P",2,HLDOUT0,HLDOUT1,"IN")
. D MONITOR^HLCSDR2("A",3,HLDOUT0,HLDOUT1,"IN")
;-- ack
D SENDACK^HLCSDL2(HLBK)
;-- read next line of data
G LOOP
;
READQ Q
;
MASTER ;-- if outgoing messages are present then establish m/s and begin
; transmission of message.
;
N HLBID,HLDOUT0,HLDOUT1
;-- check queue
D TRACE^HLCSDL2("Master Check Queue")
S HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")
;-- nothing on queue quit
I +HLDOUT0<0 D TRACE^HLCSDL2("*Out Queue Empty") G MASTERQ
S HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0
;-- have item in queue to write, bid for master status
S HLBID=$$BID(5)
;-- if attemp fails quit
I 'HLBID D PUSH^HLCSQUE(HLDOUT0,HLDOUT1) G MASTERQ
;-- if successful goto write state
I HLBID D
. D WRITE(HLDOUT0,HLDOUT1)
. D EOT^HLCSDL2
;
MASTERQ Q
;
BID(MAXTRY) ;-- This function will bid for Master status MAXTRY times
; and return a 1 if succesful, 0 if fails
; INPUT - MAXTRY - Maximum number of attemps before failing
; OUTPUT - 1 for ok; 0 fails
;
N RESULT,HLTRIES,HLDLX
S RESULT=0,HLTRIES=0
;-- update status
D MONITOR^HLCSDR2("BIDDING",5,HLDP)
BIDRET ;-- bid for master status
D TRACE^HLCSDL2("Master Bid")
D ENQ^HLCSDL2
;-- update status
D TRACE^HLCSDL2("Master Bid Wait Ack0")
D MONITOR^HLCSDR2("WAIT ACK",5,HLDP)
;-- if read ack if block 0 OK else fail
I $$READACK^HLCSDL2(0) S RESULT=1 G BIDQ
;-- if nak or timeout
S HLTRIES=HLTRIES+1
I HLTRIES>(MAXTRY-1) G BIDQ
G BIDRET
BIDQ ;-- exit
Q RESULT
;
WRITE(HLDOUT0,HLDOUT1) ;-- This function will take the message contained
; in file 870 specified by HLDOUT0 and HLDOUT1 and write the data out.
; after each write the system will wait for an ack.
; INPUT : HLDOUT0 - IEN of file #870
; HLDOUT1 - IEN of out queue multiple
;
N HLHEAD,HLTEXT1,HLFOOT,HLX1,HLX2,HLX3,HLTEMP
;-- loop to process message
S HLX1="",HLX2="HLTEXT1"
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
. S HLX3=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLX1,"HLTEMP","OUT")
. D BUILD^HLCSDL2(HLX2,HLI,$S(HLX3:HLETB,1:HLETX),.HLHEAD,.HLFOOT)
;
WRITEQ Q
;
SEND(HLTEXT,HLHEAD,HLFOOT,HLRETRY,HLBK) ;-- This function will write the X3.28 formatted
; string out the port and wait for an ack. If this function fails
; 0 will be returned, else 1.
;
; Input - HLTEXT - Array containing segment to send
; - HLHEAD - Block header <STX><BLK><LEN>
; - HLFOOT - Block footer <ETX or ETB><BCC><TERM>
; - HLRETRY- Maximum retries before failure
; - HLBK - Current block 0-7
; Output- 0 Fails, 1 = OK
;
N RESULT,HLTRY,X
S RESULT=1,HLTRY=0
RETRY ;-- write data
;-- update status
D TRACE^HLCSDL2("Master Write")
D MONITOR^HLCSDR2("WRITING",5,HLDP)
;
U IO
;-- write header
W HLHEAD
D LOG(HLHEAD,"WRITE: ")
S X="" F S X=$O(@HLTEXT@(X)) Q:'X W @HLTEXT@(X) D LOG(@HLTEXT@(X),"Write: ")
;-- write footer
W HLFOOT D LOG(HLFOOT,"WRITE: ")
;-- Wait for ack
D TRACE^HLCSDL2("Master Wait for Ack"_HLBK)
D MONITOR^HLCSDR2("WAITING ACK",5,HLDP)
;-- if ack
I $$READACK^HLCSDL2(HLBK) S RESULT=1 D MONITOR^HLCSDR2("D",2,HLDP,HLDOUT1,"OUT") G SENDQ
;-- if nak then retry
S HLTRY=HLTRY+1
I HLTRY>(HLRETRY-1) S RESULT=0 G SENDQ
G RETRY
SENDQ ;-- exit
Q RESULT
;
EXIT ;-- Cleanup
Q
;
LOG(ST1,OP) ;Log reads/writes (translates ctrls)
;ST1=string to file
;OP=operation "read" or "write"
I $G(HLTRACE) D
.N X S X=$G(^XTMP("HL",0)),$P(X,U)=DT+1,$P(X,U,2)=DT
.S $P(X,U,3)="HL7 Debug Log",HLLOG=$P(X,U,4)
.S HLN=$$TRANS(ST1)
.S HLLOG=HLLOG+1,^XTMP("HL",HLLOG)=OP_HLN,$P(X,U,4)=HLLOG
.S ^XTMP("HL",0)=X
Q
TRANS(ST) ;Translate controls in string
;ST=String containing embedded x3.28 control characters
S ST2="" F I=1:1:$L(ST) S J=$E(ST,I) D
.I $D(HLCTRL($A(J))) S J=HLCTRL($A(J))
.S ST2=$G(ST2)_J
Q ST2
HLCSDL1 ;ALB/MTC/JC - X3.28 LOWER LAYER PROTOCOL 2.2 - 2/28/95 ;08/19/97 [ 04/02/2003 8:38 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;;1.6;HEALTH LEVEL SEVEN;**2,34**;Oct 13, 1995
+3 ;
+4 ;This is an implemetation of the X3.28 LLP
+5 ;
START ;
+1 NEW HLIND0,HLIND1,HLNXST,HLTRANS,HLCHK,HLACKBLK,HLDOUT0,HLDOUT1,X,HLRETRY
+2 NEW HLNXST,HLLINE,HLXOR,HLTOUT,HLLINE,HLC1,HLC2
+3 NEW HLDLX,HLM
+4 ;S X=10 X ^%ZOSF("PRIORITY")
+5 SET HLM=0
SET HLNXST=1
+6 ;-- enter loop for polling for i/o
+7 DO POLL
+8 ;-- exit and clean-up
+9 DO EXIT
+10 QUIT
+11 ;
+12 ;
POLL ;-- This function will check if any messages should be sent
+1 ; then if anything is in the buffer to read in. If there is data
+2 ; to write out then the system will bid for master status and if
+3 ; successful x-mit the message. If the system receives a request to
+4 ; receive data, then it will attemp to enter a slave mode and read
+5 ; data in.
+6 ;
+7 NEW HLFLAG
+8 SET HLFLAG=1
+9 DO TRACE^HLCSDL2("Logging IO to ^XTMP('HL',N")
+10 ;-- enter loop
+11 FOR
DO MONITOR^HLCSDR2("POLLING",5,HLDP)
IF 'HLFLAG
QUIT
Begin DoDot:1
+12 ; should we still be running
+13 IF '$$RUN^HLCSDL2
DO MONITOR^HLCSDR2("SHUTDOWN",5,HLDP)
SET HLFLAG=0
QUIT
+14 ;-- check for data to read in
+15 DO TRACE^HLCSDL2("Slave Check")
DO SLAVE
+16 IF '$$RUN^HLCSDL2
DO MONITOR^HLCSDR2("SHUTDOWN",5,HLDP)
SET HLFLAG=0
QUIT
+17 ;-- check for out going data
+18 DO TRACE^HLCSDL2("Master Check")
DO MASTER
End DoDot:1
+19 QUIT
+20 ;
SLAVE ;-- this function will check if anything is ready to read in from
+1 ; the port. If nothing is ready then return to polling, else
+2 ; start slave process.
+3 ;
+4 NEW HLX
+5 ;-- check if anything is ready to read in.
+6 DO TRACE^HLCSDL2("Slave Request")
+7 ;-- read for enq (request for slave)
+8 IF '$$READENQ^HLCSDL2
GOTO SLAVEQ
+9 ;-- ack0
+10 DO TRACE^HLCSDL2("Slave Ack0")
+11 DO SENDACK^HLCSDL2(0)
+12 ;-- read data
+13 DO TRACE^HLCSDL2("Slave Read Data")
+14 DO READ
+15 ;-- exit and return to polling
SLAVEQ ;
+1 QUIT
+2 ;
READ ;-- This function will take the incoming data from the device and
+1 ; store in file 870. After each read an ack will be sent to the
+2 ; client application. Once an EOT has been received, return to
+3 ; polling.
+4 ;
+5 NEW HLX,HLI,HLBK,HLETXB,HLLINE,HLDATA,BTERM
+6 ;-- prepare for incoming data
+7 SET HLLINE=1
SET HLI=0
LOOP ;-- main loop for reading in message
+1 ;
+2 ;-- update status
+3 DO MONITOR^HLCSDR2("READING",5,HLDP)
+4 ;-- read block of data
+5 SET HLX=$$READBK^HLCSDL2("HLDATA",.HLLEN,.HLBK,.HLCK,.BTERM)
+6 ;-- check for TIMEOUT
+7 IF $GET(HLDATA)["TIMEOUT"
GOTO READQ
+8 ;-- check for EOT
+9 IF $GET(HLDATA)=HLEOT
GOTO READQ
+10 ;-- check if vaild data
+11 IF '$$VALID^HLCSDL2("HLDATA",HLLINE#8,HLLEN,HLBK,HLCK,BTERM)
Begin DoDot:1
+12 ;-- update status
+13 DO TRACE^HLCSDL2("Slave Write NAK")
+14 DO MONITOR^HLCSDR2("SEND NAK",5,HLDP)
+15 ;-- send nak
+16 DO SENDNAK^HLCSDL2
End DoDot:1
GOTO LOOP
+17 ;
+18 ;-- write data to file 870
+19 SET HLDOUT0=$$ENQUEUE^HLCSQUE(HLDP,"IN")
SET HLDOUT1=$PIECE(HLDOUT0,U,2)
SET HLDOUT0=+HLDOUT0
+20 DO APPEND^HLCSUTL("HLDATA",HLDOUT0,HLDOUT1)
+21 SET HLLINE=HLLINE+1
+22 ;
+23 ;-- If end of text set status
+24 IF +BTERM=+HLETX
Begin DoDot:1
+25 DO MONITOR^HLCSDR2("P",2,HLDOUT0,HLDOUT1,"IN")
+26 DO MONITOR^HLCSDR2("A",3,HLDOUT0,HLDOUT1,"IN")
End DoDot:1
+27 ;-- ack
+28 DO SENDACK^HLCSDL2(HLBK)
+29 ;-- read next line of data
+30 GOTO LOOP
+31 ;
READQ QUIT
+1 ;
MASTER ;-- if outgoing messages are present then establish m/s and begin
+1 ; transmission of message.
+2 ;
+3 NEW HLBID,HLDOUT0,HLDOUT1
+4 ;-- check queue
+5 DO TRACE^HLCSDL2("Master Check Queue")
+6 SET HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")
+7 ;-- nothing on queue quit
+8 IF +HLDOUT0<0
DO TRACE^HLCSDL2("*Out Queue Empty")
GOTO MASTERQ
+9 SET HLDOUT1=$PIECE(HLDOUT0,U,2)
SET HLDOUT0=+HLDOUT0
+10 ;-- have item in queue to write, bid for master status
+11 SET HLBID=$$BID(5)
+12 ;-- if attemp fails quit
+13 IF 'HLBID
DO PUSH^HLCSQUE(HLDOUT0,HLDOUT1)
GOTO MASTERQ
+14 ;-- if successful goto write state
+15 IF HLBID
Begin DoDot:1
+16 DO WRITE(HLDOUT0,HLDOUT1)
+17 DO EOT^HLCSDL2
End DoDot:1
+18 ;
MASTERQ QUIT
+1 ;
BID(MAXTRY) ;-- This function will bid for Master status MAXTRY times
+1 ; and return a 1 if succesful, 0 if fails
+2 ; INPUT - MAXTRY - Maximum number of attemps before failing
+3 ; OUTPUT - 1 for ok; 0 fails
+4 ;
+5 NEW RESULT,HLTRIES,HLDLX
+6 SET RESULT=0
SET HLTRIES=0
+7 ;-- update status
+8 DO MONITOR^HLCSDR2("BIDDING",5,HLDP)
BIDRET ;-- bid for master status
+1 DO TRACE^HLCSDL2("Master Bid")
+2 DO ENQ^HLCSDL2
+3 ;-- update status
+4 DO TRACE^HLCSDL2("Master Bid Wait Ack0")
+5 DO MONITOR^HLCSDR2("WAIT ACK",5,HLDP)
+6 ;-- if read ack if block 0 OK else fail
+7 IF $$READACK^HLCSDL2(0)
SET RESULT=1
GOTO BIDQ
+8 ;-- if nak or timeout
+9 SET HLTRIES=HLTRIES+1
+10 IF HLTRIES>(MAXTRY-1)
GOTO BIDQ
+11 GOTO BIDRET
BIDQ ;-- exit
+1 QUIT RESULT
+2 ;
WRITE(HLDOUT0,HLDOUT1) ;-- This function will take the message contained
+1 ; in file 870 specified by HLDOUT0 and HLDOUT1 and write the data out.
+2 ; after each write the system will wait for an ack.
+3 ; INPUT : HLDOUT0 - IEN of file #870
+4 ; HLDOUT1 - IEN of out queue multiple
+5 ;
+6 NEW HLHEAD,HLTEXT1,HLFOOT,HLX1,HLX2,HLX3,HLTEMP
+7 ;-- loop to process message
+8 SET HLX1=""
SET HLX2="HLTEXT1"
+9 FOR HLI=1:1
KILL HLTEXT1
SET HLX1=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLX1,HLX2,"OUT")
IF 'HLX1
QUIT
Begin DoDot:1
+10 SET HLX3=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLX1,"HLTEMP","OUT")
+11 DO BUILD^HLCSDL2(HLX2,HLI,$SELECT(HLX3:HLETB,1:HLETX),.HLHEAD,.HLFOOT)
End DoDot:1
IF '$$SEND(HLX2,HLHEAD,HLFOOT,5,HLI#8)
QUIT
+12 ;
WRITEQ QUIT
+1 ;
SEND(HLTEXT,HLHEAD,HLFOOT,HLRETRY,HLBK) ;-- This function will write the X3.28 formatted
+1 ; string out the port and wait for an ack. If this function fails
+2 ; 0 will be returned, else 1.
+3 ;
+4 ; Input - HLTEXT - Array containing segment to send
+5 ; - HLHEAD - Block header <STX><BLK><LEN>
+6 ; - HLFOOT - Block footer <ETX or ETB><BCC><TERM>
+7 ; - HLRETRY- Maximum retries before failure
+8 ; - HLBK - Current block 0-7
+9 ; Output- 0 Fails, 1 = OK
+10 ;
+11 NEW RESULT,HLTRY,X
+12 SET RESULT=1
SET HLTRY=0
RETRY ;-- write data
+1 ;-- update status
+2 DO TRACE^HLCSDL2("Master Write")
+3 DO MONITOR^HLCSDR2("WRITING",5,HLDP)
+4 ;
+5 USE IO
+6 ;-- write header
+7 WRITE HLHEAD
+8 DO LOG(HLHEAD,"WRITE: ")
+9 SET X=""
FOR
SET X=$ORDER(@HLTEXT@(X))
IF 'X
QUIT
WRITE @HLTEXT@(X)
DO LOG(@HLTEXT@(X),"Write: ")
+10 ;-- write footer
+11 WRITE HLFOOT
DO LOG(HLFOOT,"WRITE: ")
+12 ;-- Wait for ack
+13 DO TRACE^HLCSDL2("Master Wait for Ack"_HLBK)
+14 DO MONITOR^HLCSDR2("WAITING ACK",5,HLDP)
+15 ;-- if ack
+16 IF $$READACK^HLCSDL2(HLBK)
SET RESULT=1
DO MONITOR^HLCSDR2("D",2,HLDP,HLDOUT1,"OUT")
GOTO SENDQ
+17 ;-- if nak then retry
+18 SET HLTRY=HLTRY+1
+19 IF HLTRY>(HLRETRY-1)
SET RESULT=0
GOTO SENDQ
+20 GOTO RETRY
SENDQ ;-- exit
+1 QUIT RESULT
+2 ;
EXIT ;-- Cleanup
+1 QUIT
+2 ;
LOG(ST1,OP) ;Log reads/writes (translates ctrls)
+1 ;ST1=string to file
+2 ;OP=operation "read" or "write"
+3 IF $GET(HLTRACE)
Begin DoDot:1
+4 NEW X
SET X=$GET(^XTMP("HL",0))
SET $PIECE(X,U)=DT+1
SET $PIECE(X,U,2)=DT
+5 SET $PIECE(X,U,3)="HL7 Debug Log"
SET HLLOG=$PIECE(X,U,4)
+6 SET HLN=$$TRANS(ST1)
+7 SET HLLOG=HLLOG+1
SET ^XTMP("HL",HLLOG)=OP_HLN
SET $PIECE(X,U,4)=HLLOG
+8 SET ^XTMP("HL",0)=X
End DoDot:1
+9 QUIT
TRANS(ST) ;Translate controls in string
+1 ;ST=String containing embedded x3.28 control characters
+2 SET ST2=""
FOR I=1:1:$LENGTH(ST)
SET J=$EXTRACT(ST,I)
Begin DoDot:1
+3 IF $DATA(HLCTRL($ASCII(J)))
SET J=HLCTRL($ASCII(J))
+4 SET ST2=$GET(ST2)_J
End DoDot:1
+5 QUIT ST2
