| 1 | HLCSDL2 ;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 | ;
|
|---|
| 5 | SENDNAK ;-- 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 | ;
|
|---|
| 15 | SENDACK(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 | ;
|
|---|
| 27 | READACK(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 | ;
|
|---|
| 46 | RDACKQ Q RESULT
|
|---|
| 47 | ;
|
|---|
| 48 | READENQ() ;-- 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
|
|---|
| 56 | RETRY 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 | ;
|
|---|
| 69 | RDENQ Q RESULT
|
|---|
| 70 | ;
|
|---|
| 71 | READBK(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 | ;
|
|---|
| 104 | BLOOP ;-- 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
|
|---|
| 109 | BLOOP2 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 | ;
|
|---|
| 136 | READBKQ Q RESULT
|
|---|
| 137 | ;
|
|---|
| 138 | BUILD(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 | ;
|
|---|
| 163 | ENQ ;-- 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 | ;
|
|---|
| 171 | EOT ;-- 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 | ;
|
|---|
| 179 | HEXCON(%) ;-- 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
|
|---|
| 189 | HEXQ Q H1_H2
|
|---|
| 190 | ;
|
|---|
| 191 | RUN() ;-- 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 | ;
|
|---|
| 206 | VALID(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 | ;
|
|---|
| 241 | VALIDQ Q RESULT
|
|---|
| 242 | ;
|
|---|
| 243 | TRACE(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 | ;
|
|---|
