Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSDL2

HLCSDL2.m

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