HLCSDL2 ;ALB/MTC/JC - X3.28 LOWER LAYER PROTOCOL UTILITIES 2.2 - 2/28/95 ;04/25/96 10:52
;;1.6;HEALTH LEVEL SEVEN;**2**;Oct 13, 1995
Q
;
SENDNAK ;-- This function will send an nack for the block specified
; by the parameter HLBK.
; OUTPUT: NONE
;
;
U IO
W $C(HLNAK)_$C(HLTERM)
D LOG^HLCSDL1($C(HLNAK)_$C(HLTERM),"WRITE: ")
Q
;
SENDACK(HLBK) ;-- This function will send an ack for the block specified
; by the parameter HLBK.
; INPUT : HLBK current sequence (block)
; OUTPUT: NONE
;
N HLACKN
;
S HLACKN="HLACK"_(HLBK#8)
U IO W $C(HLDLE)_$C(@(HLACKN))_$C(HLTERM)
D LOG^HLCSDL1($C(HLDLE)_$C(@(HLACKN))_$C(HLTERM),"WRITE: ")
Q
;
READACK(HLBK) ;-- This function will read the input device for an ackN
; specified by HLBK.
; INPUT : HLBK - Expected AckN
; OUTPUT: 1- Ok 0-Fails
;
N HLACKN,X,Y,RESULT,HLTRM
;
S RESULT=0,HLTRM=""
S HLACKN=@("HLACK"_(HLBK#8))
;-- do read for HLDLE
S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
D TRACE^HLCSDL2("FINISHED READ FOR DLE:"_HLTRM_U_X_U)
I HLTRM'=HLDLE G RDACKQ
S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
I X'=$C(HLACKN),HLTRM'=HLTERM G RDACKQ
S RESULT=1
;
RDACKQ Q RESULT
;
READENQ() ;-- This function will read the input device for an ENQ
;
; INPUT : NONE
; OUTPUT: 1- Ok 0-Fails
;
N X,Y,RESULT,HLTRM,HLX
;
S HLX=0
RETRY S RESULT=0,HLTRM=""
;-- do read for HLENQ
S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
D TRACE^HLCSDL2("FINISHED READ FOR ENQ:"_HLTRM_U_X_U)
S HLX=HLX+1 I HLX>5 G RDENQ
I HLTRM'=+HLENQ G RETRY
;-- do read for HLTERM
S X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(X_$C(HLTRM),"READ: ")
I HLTRM'=+HLTERM G RDENQ
S RESULT=1
;
RDENQ Q RESULT
;
READBK(HLTEXT,LEN,BLOCK,CHKSUM,BTERM) ; This function will read a block of data from the input device
; and store the result in the array specified by HLTEXT.
; INPUT : HLTEXT - Array reference to store data
; LEN - Passed by reference will get message lenght
; BLOCK - Passed by refence will get message block #
; CHKSUM - Passed by refence will get message BCC
; BTERM - Passed by reference will block termination char
; OUTPUT : 1 - OK, 0 - Fails
; If EOT is encountered HLTEXT=EOT
; If TimeOut is encountered then HLTEXT="-1^TIMEOUT"
;
N RESULT,HLX,HLTRM
S (RESULT,LEN,CHKSUM,BTERM,BLOCK)=0
;-- read expect either SOH or STX will ignore header info
S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
;-- check for timeout
I HLX["TIMEOUT" S @HLTEXT=HLX G READBKQ
;-- check for eot
I HLTRM=+HLEOT S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM),@HLTEXT=HLEOT,RESULT=1 D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ") G READBKQ
;-- if header read and ignore
I HLTRM=+HLSOH S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM) D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ") I HLX["TIMEOUT" S @HLTEXT=HLX
;-- start of data block
I HLTRM'=+HLSTX G READBKQ
;-- read expect either HLDBLOCK characters or CR for end of data
S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
;-- check for timeout
I HLX["TIMEOUT" S @HLTEXT=HLX G READBKQ
;-- get block and length -- <blk><len><data><cr>
S HLI=0
S BLOCK=$E(HLX),LEN=$E(HLX,2,6)
;
BLOOP ;-- block read loop
;
;-- first pass get data leave blk and lenght
I HLI=0 S HLX=$E(HLX,7,$L(HLX))
;-- save data
BLOOP2 S HLI=HLI+1,@HLTEXT@(HLI)=HLX
;-- long line
I HLTRM=0 D
. S HLDONE=0,HLJ=0
. F S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM) D I HLDONE Q
.. D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
.. I +HLX<0 S HLDONE=1 Q
.. S HLJ=HLJ+1,@HLTEXT@(HLI,HLJ)=HLX
.. I HLTRM=+HLTERM S HLDONE=1
;
;-- read upto next ctrl char
S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
;-- check for timeout
I HLX["TIMEOUT" S @HLTEXT=HLX G READBKQ
;-- more data to read
I (HLTRM=+HLTERM)!(HLTRM=0) G BLOOP2
;-- read expect ETX or ETB
I (HLTRM=+HLETB)!(HLTRM=+HLETX) S BTERM=HLTRM D
.;-- read expect <BCC><TERM>
. S HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
. D LOG^HLCSDL1(HLX_$C(HLTRM),"READ: ")
.;-- get BCC
. S CHKSUM=HLX
;-- OK
S RESULT=1
;
READBKQ Q RESULT
;
BUILD(HLTEXT,HLSEQ,HLEND,HLHEAD,HLFOOT) ;-- This function will build the block to write.
; INPUT : HLTEXT - Array to write/format
; : HLSEQ - Sequence in message
; : HLEND - ETX or ETB
; : HLHEAD - Passed by reference - will be the header portion
; : HLFOOT - Passed by reference - will be the footer portion
;
; OUTPUT: HLHEAD = <STX><BLK><LENGTH>
; HLFOOT = <ETX or ETB><BCC><TERM>
;
N HLBL,HLHEX,X,Y
;-- get checksum information
S HLCHK=$$CHKSUM^HLCSUTL(HLTEXT)
;-- determine block number
S HLBL=HLSEQ#8
;-- determine length
S HLLN=$P(HLCHK,U,2)
S HLLN=$E("00000",1,5-$L(HLLN))_$P(HLCHK,U,2)
S X=HLBL_HLLN_$C($P(HLCHK,U))_$C(HLEND) X ^%ZOSF("LPC")
;-- build two byte check sum
S HLHEX=$$HEXCON(Y)
;-- build string
S HLHEAD=$C(HLSTX)_HLBL_HLLN,HLFOOT=$C(HLEND)_HLHEX_$C(HLTERM)
Q
;
ENQ ;-- this function will send an ENQ to the secondary station
; to establish a master/slave relationship for transmissions.
;
U IO
W $C(HLENQ)_$C(HLTERM)
D LOG^HLCSDL1($C(HLENQ)_$C(HLTERM),"WRITE: ")
Q
;
EOT ;-- this function will send an EOT to the secondary station
; to end the master/stave relationship.
;
U IO
W $C(HLEOT)_$C(HLTERM)
D LOG^HLCSDL1($C(HLEOT)_$C(HLTERM),"WRITE: ")
Q
;
HEXCON(%) ;-- converts a decimal #<128 to a two byte hex #
; INPUT : % - Decimal to convert
;
;
N H,H1,H2
;-- error if # not between 0 - 127
I (%<0)!(%>127)!(%'=+%) S (H1,H2)=0 G HEXQ
I %<10 S H1=0,H2=% G HEXQ
S H=%\16 S:H>9 H=$E(" ABCDEF",H) S H1=H
S H=%#16 S:H>9 H=$E(" ABCDEF",H) S H2=H
HEXQ Q H1_H2
;
RUN() ;-- This function will determine if this occurance of the LLP
; should still be running.
; INPUT : NONE
;OUTPUT : 1 - Yes, 0 No
;
N RESULT
;-- default to Yes
S RESULT=1
;-- check if should shut down
I $P($G(^HLCS(870,HLDP,0)),U,15)=1 S RESULT=0
;-- if running in forground ask
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
;
Q RESULT
;
VALID(HLTEXT,HLBLK,LEN,BLOCK,CHKSUM,BTERM) ;-- This function will validate the incoming message as in should
; conform to the X3.28 protocol. No other error checking is perfomred
; for this validation. If this function is successful a
; 1 is returned else 0.
; INPUT : HLTEXT - The block that was read in from the device
; : HLBLK - Current block expected
; : LEN - xmitted length
; : BLOCK - xmitted block number
; : CHKSUM - xmitted checksum
; : BTERM - Block termination char (ETX or ETB)
; OUTPUT : 1 ok, 0 fails
;
; The following validation checks are made by this function:
; 1 - BCC matches calculated BCC
; 2 - Message lenght matches calculated message length
; 3 - Block matches the expected block number
; 4 - Block termination is either ETX or ETB
;
N HLBCC,HLLEN,HLBCC1,RESULT,X,Y
S RESULT=0
;-- calculate checksum
S HLBCC=$$CHKSUM2^HLCSUTL(HLTEXT)
;-- add in BLOCK LEN and BTERM
S X=BLOCK_LEN_$C($P(HLBCC,U))_$C(BTERM) X ^%ZOSF("LPC") S HLBCC1=Y
;-- convert to hex
S HLBCC1=$$HEXCON(HLBCC1)
;-- checksum
I HLBCC1'=CHKSUM G VALIDQ
;-- length
I $P(HLBCC,U,2)'=+LEN G VALIDQ
;-- block
I HLBLK'=BLOCK G VALIDQ
;-- ok
S RESULT=1
;
VALIDQ Q RESULT
;
TRACE(HLSTATE) ;-- This function is used during for debug. It will print
; the current state of the X3.28 protocol. Each state is passed in
; through the variable HLSTATE
;
; INPUT - HLSTATE : Current state of FSM
; OUTPUT - If HLTRACE is defined then write HLSTATE to IO(0)
;
I '$G(HLTRACE) Q
U IO(0)
W !,"In State : ",HLSTATE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSDL2 8111 printed Nov 22, 2024@17:06:31 Page 2
HLCSDL2 ;ALB/MTC/JC - X3.28 LOWER LAYER PROTOCOL UTILITIES 2.2 - 2/28/95 ;04/25/96 10:52
+1 ;;1.6;HEALTH LEVEL SEVEN;**2**;Oct 13, 1995
+2 QUIT
+3 ;
SENDNAK ;-- This function will send an nack for the block specified
+1 ; by the parameter HLBK.
+2 ; OUTPUT: NONE
+3 ;
+4 ;
+5 USE IO
+6 WRITE $CHAR(HLNAK)_$CHAR(HLTERM)
+7 DO LOG^HLCSDL1($CHAR(HLNAK)_$CHAR(HLTERM),"WRITE: ")
+8 QUIT
+9 ;
SENDACK(HLBK) ;-- This function will send an ack for the block specified
+1 ; by the parameter HLBK.
+2 ; INPUT : HLBK current sequence (block)
+3 ; OUTPUT: NONE
+4 ;
+5 NEW HLACKN
+6 ;
+7 SET HLACKN="HLACK"_(HLBK#8)
+8 USE IO
WRITE $CHAR(HLDLE)_$CHAR(@(HLACKN))_$CHAR(HLTERM)
+9 DO LOG^HLCSDL1($CHAR(HLDLE)_$CHAR(@(HLACKN))_$CHAR(HLTERM),"WRITE: ")
+10 QUIT
+11 ;
READACK(HLBK) ;-- This function will read the input device for an ackN
+1 ; specified by HLBK.
+2 ; INPUT : HLBK - Expected AckN
+3 ; OUTPUT: 1- Ok 0-Fails
+4 ;
+5 NEW HLACKN,X,Y,RESULT,HLTRM
+6 ;
+7 SET RESULT=0
SET HLTRM=""
+8 SET HLACKN=@("HLACK"_(HLBK#8))
+9 ;-- do read for HLDLE
+10 SET X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
+11 DO LOG^HLCSDL1(X_$CHAR(HLTRM),"READ: ")
+12 DO TRACE^HLCSDL2("FINISHED READ FOR DLE:"_HLTRM_U_X_U)
+13 IF HLTRM'=HLDLE
GOTO RDACKQ
+14 SET X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
+15 DO LOG^HLCSDL1(X_$CHAR(HLTRM),"READ: ")
+16 IF X'=$CHAR(HLACKN)
IF HLTRM'=HLTERM
GOTO RDACKQ
+17 SET RESULT=1
+18 ;
RDACKQ QUIT RESULT
+1 ;
READENQ() ;-- This function will read the input device for an ENQ
+1 ;
+2 ; INPUT : NONE
+3 ; OUTPUT: 1- Ok 0-Fails
+4 ;
+5 NEW X,Y,RESULT,HLTRM,HLX
+6 ;
+7 SET HLX=0
RETRY SET RESULT=0
SET HLTRM=""
+1 ;-- do read for HLENQ
+2 SET X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
+3 DO LOG^HLCSDL1(X_$CHAR(HLTRM),"READ: ")
+4 DO TRACE^HLCSDL2("FINISHED READ FOR ENQ:"_HLTRM_U_X_U)
+5 SET HLX=HLX+1
IF HLX>5
GOTO RDENQ
+6 IF HLTRM'=+HLENQ
GOTO RETRY
+7 ;-- do read for HLTERM
+8 SET X=$$READ^HLCSUTL(HLTIMA,HLDBLOCK,.HLTRM)
+9 DO LOG^HLCSDL1(X_$CHAR(HLTRM),"READ: ")
+10 IF HLTRM'=+HLTERM
GOTO RDENQ
+11 SET RESULT=1
+12 ;
RDENQ QUIT RESULT
+1 ;
READBK(HLTEXT,LEN,BLOCK,CHKSUM,BTERM) ; This function will read a block of data from the input device
+1 ; and store the result in the array specified by HLTEXT.
+2 ; INPUT : HLTEXT - Array reference to store data
+3 ; LEN - Passed by reference will get message lenght
+4 ; BLOCK - Passed by refence will get message block #
+5 ; CHKSUM - Passed by refence will get message BCC
+6 ; BTERM - Passed by reference will block termination char
+7 ; OUTPUT : 1 - OK, 0 - Fails
+8 ; If EOT is encountered HLTEXT=EOT
+9 ; If TimeOut is encountered then HLTEXT="-1^TIMEOUT"
+10 ;
+11 NEW RESULT,HLX,HLTRM
+12 SET (RESULT,LEN,CHKSUM,BTERM,BLOCK)=0
+13 ;-- read expect either SOH or STX will ignore header info
+14 SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
+15 DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
+16 ;-- check for timeout
+17 IF HLX["TIMEOUT"
SET @HLTEXT=HLX
GOTO READBKQ
+18 ;-- check for eot
+19 IF HLTRM=+HLEOT
SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
SET @HLTEXT=HLEOT
SET RESULT=1
DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
GOTO READBKQ
+20 ;-- if header read and ignore
+21 IF HLTRM=+HLSOH
SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
IF HLX["TIMEOUT"
SET @HLTEXT=HLX
+22 ;-- start of data block
+23 IF HLTRM'=+HLSTX
GOTO READBKQ
+24 ;-- read expect either HLDBLOCK characters or CR for end of data
+25 SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
+26 DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
+27 ;-- check for timeout
+28 IF HLX["TIMEOUT"
SET @HLTEXT=HLX
GOTO READBKQ
+29 ;-- get block and length -- <blk><len><data><cr>
+30 SET HLI=0
+31 SET BLOCK=$EXTRACT(HLX)
SET LEN=$EXTRACT(HLX,2,6)
+32 ;
BLOOP ;-- block read loop
+1 ;
+2 ;-- first pass get data leave blk and lenght
+3 IF HLI=0
SET HLX=$EXTRACT(HLX,7,$LENGTH(HLX))
+4 ;-- save data
BLOOP2 SET HLI=HLI+1
SET @HLTEXT@(HLI)=HLX
+1 ;-- long line
+2 IF HLTRM=0
Begin DoDot:1
+3 SET HLDONE=0
SET HLJ=0
+4 FOR
SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
Begin DoDot:2
+5 DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
+6 IF +HLX<0
SET HLDONE=1
QUIT
+7 SET HLJ=HLJ+1
SET @HLTEXT@(HLI,HLJ)=HLX
+8 IF HLTRM=+HLTERM
SET HLDONE=1
End DoDot:2
IF HLDONE
QUIT
End DoDot:1
+9 ;
+10 ;-- read upto next ctrl char
+11 SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
+12 DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
+13 ;-- check for timeout
+14 IF HLX["TIMEOUT"
SET @HLTEXT=HLX
GOTO READBKQ
+15 ;-- more data to read
+16 IF (HLTRM=+HLTERM)!(HLTRM=0)
GOTO BLOOP2
+17 ;-- read expect ETX or ETB
+18 IF (HLTRM=+HLETB)!(HLTRM=+HLETX)
SET BTERM=HLTRM
Begin DoDot:1
+19 ;-- read expect <BCC><TERM>
+20 SET HLX=$$READ^HLCSUTL(HLTIMB,HLDBLOCK,.HLTRM)
+21 DO LOG^HLCSDL1(HLX_$CHAR(HLTRM),"READ: ")
+22 ;-- get BCC
+23 SET CHKSUM=HLX
End DoDot:1
+24 ;-- OK
+25 SET RESULT=1
+26 ;
READBKQ QUIT RESULT
+1 ;
BUILD(HLTEXT,HLSEQ,HLEND,HLHEAD,HLFOOT) ;-- This function will build the block to write.
+1 ; INPUT : HLTEXT - Array to write/format
+2 ; : HLSEQ - Sequence in message
+3 ; : HLEND - ETX or ETB
+4 ; : HLHEAD - Passed by reference - will be the header portion
+5 ; : HLFOOT - Passed by reference - will be the footer portion
+6 ;
+7 ; OUTPUT: HLHEAD = <STX><BLK><LENGTH>
+8 ; HLFOOT = <ETX or ETB><BCC><TERM>
+9 ;
+10 NEW HLBL,HLHEX,X,Y
+11 ;-- get checksum information
+12 SET HLCHK=$$CHKSUM^HLCSUTL(HLTEXT)
+13 ;-- determine block number
+14 SET HLBL=HLSEQ#8
+15 ;-- determine length
+16 SET HLLN=$PIECE(HLCHK,U,2)
+17 SET HLLN=$EXTRACT("00000",1,5-$LENGTH(HLLN))_$PIECE(HLCHK,U,2)
+18 SET X=HLBL_HLLN_$CHAR($PIECE(HLCHK,U))_$CHAR(HLEND)
XECUTE ^%ZOSF("LPC")
+19 ;-- build two byte check sum
+20 SET HLHEX=$$HEXCON(Y)
+21 ;-- build string
+22 SET HLHEAD=$CHAR(HLSTX)_HLBL_HLLN
SET HLFOOT=$CHAR(HLEND)_HLHEX_$CHAR(HLTERM)
+23 QUIT
+24 ;
ENQ ;-- this function will send an ENQ to the secondary station
+1 ; to establish a master/slave relationship for transmissions.
+2 ;
+3 USE IO
+4 WRITE $CHAR(HLENQ)_$CHAR(HLTERM)
+5 DO LOG^HLCSDL1($CHAR(HLENQ)_$CHAR(HLTERM),"WRITE: ")
+6 QUIT
+7 ;
EOT ;-- this function will send an EOT to the secondary station
+1 ; to end the master/stave relationship.
+2 ;
+3 USE IO
+4 WRITE $CHAR(HLEOT)_$CHAR(HLTERM)
+5 DO LOG^HLCSDL1($CHAR(HLEOT)_$CHAR(HLTERM),"WRITE: ")
+6 QUIT
+7 ;
HEXCON(%) ;-- converts a decimal #<128 to a two byte hex #
+1 ; INPUT : % - Decimal to convert
+2 ;
+3 ;
+4 NEW H,H1,H2
+5 ;-- error if # not between 0 - 127
+6 IF (%<0)!(%>127)!(%'=+%)
SET (H1,H2)=0
GOTO HEXQ
+7 IF %<10
SET H1=0
SET H2=%
GOTO HEXQ
+8 SET H=%\16
if H>9
SET H=$EXTRACT(" ABCDEF",H)
SET H1=H
+9 SET H=%#16
if H>9
SET H=$EXTRACT(" ABCDEF",H)
SET H2=H
HEXQ QUIT H1_H2
+1 ;
RUN() ;-- This function will determine if this occurance of the LLP
+1 ; should still be running.
+2 ; INPUT : NONE
+3 ;OUTPUT : 1 - Yes, 0 No
+4 ;
+5 NEW RESULT
+6 ;-- default to Yes
+7 SET RESULT=1
+8 ;-- check if should shut down
+9 IF $PIECE($GET(^HLCS(870,HLDP,0)),U,15)=1
SET RESULT=0
+10 ;-- if running in forground ask
+11 IF $GET(HLTRACE)
USE IO(0)
WRITE !,"Type Q to Quit: "
READ X:1
IF $GET(X)'=""&("Qq"[X)
SET $PIECE(^HLCS(870,HLDP,0),U,15)=1
SET RESULT=0
+12 ;
+13 QUIT RESULT
+14 ;
VALID(HLTEXT,HLBLK,LEN,BLOCK,CHKSUM,BTERM) ;-- This function will validate the incoming message as in should
+1 ; conform to the X3.28 protocol. No other error checking is perfomred
+2 ; for this validation. If this function is successful a
+3 ; 1 is returned else 0.
+4 ; INPUT : HLTEXT - The block that was read in from the device
+5 ; : HLBLK - Current block expected
+6 ; : LEN - xmitted length
+7 ; : BLOCK - xmitted block number
+8 ; : CHKSUM - xmitted checksum
+9 ; : BTERM - Block termination char (ETX or ETB)
+10 ; OUTPUT : 1 ok, 0 fails
+11 ;
+12 ; The following validation checks are made by this function:
+13 ; 1 - BCC matches calculated BCC
+14 ; 2 - Message lenght matches calculated message length
+15 ; 3 - Block matches the expected block number
+16 ; 4 - Block termination is either ETX or ETB
+17 ;
+18 NEW HLBCC,HLLEN,HLBCC1,RESULT,X,Y
+19 SET RESULT=0
+20 ;-- calculate checksum
+21 SET HLBCC=$$CHKSUM2^HLCSUTL(HLTEXT)
+22 ;-- add in BLOCK LEN and BTERM
+23 SET X=BLOCK_LEN_$CHAR($PIECE(HLBCC,U))_$CHAR(BTERM)
XECUTE ^%ZOSF("LPC")
SET HLBCC1=Y
+24 ;-- convert to hex
+25 SET HLBCC1=$$HEXCON(HLBCC1)
+26 ;-- checksum
+27 IF HLBCC1'=CHKSUM
GOTO VALIDQ
+28 ;-- length
+29 IF $PIECE(HLBCC,U,2)'=+LEN
GOTO VALIDQ
+30 ;-- block
+31 IF HLBLK'=BLOCK
GOTO VALIDQ
+32 ;-- ok
+33 SET RESULT=1
+34 ;
VALIDQ QUIT RESULT
+1 ;
TRACE(HLSTATE) ;-- This function is used during for debug. It will print
+1 ; the current state of the X3.28 protocol. Each state is passed in
+2 ; through the variable HLSTATE
+3 ;
+4 ; INPUT - HLSTATE : Current state of FSM
+5 ; OUTPUT - If HLTRACE is defined then write HLSTATE to IO(0)
+6 ;
+7 IF '$GET(HLTRACE)
QUIT
+8 USE IO(0)
+9 WRITE !,"In State : ",HLSTATE
+10 QUIT
+11 ;
