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

HLCSDL1.m

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