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

HLCSDR2.m

Go to the documentation of this file.
  1. HLCSDR2 ;ALB/RJS - HYBRID LOWER LAYER PROTOCOL UTILITIES 2.2 - ;08/22/2001 11:23
  1. ;;1.6;HEALTH LEVEL SEVEN;**2,9,62,109**;Oct 13, 1995
  1. Q
  1. WRITE(HLDOUT0,HLDOUT1) ; This function writes a message from the Logical
  1. ; Link file (#870) to the specified device in the following format:
  1. ; <Start Block><Data Block><End Block>
  1. ; The data block is the complete HL7 message terminated by a <CR>.
  1. ; INPUT : HLDOUT0 - IFN of file 870
  1. ; HLDOUT1 - IFN of Out Queue Multiple
  1. ; OUTPUT: None
  1. I HLDOUT0']""!(HLDOUT1']"") Q
  1. ;-- HLLINE,HLC1,HLC2 are initialized in INITIZE
  1. N HLCLN,HLCHK,I,X
  1. D INITIZE
  1. ;
  1. ;-- write start block
  1. S X=$C(HLDSTRT)_"D"_HLDVER_$C(13) D CHKSUM
  1. U IO W X
  1. ;
  1. S HLWFLG=0
  1. ;-- process and write data block
  1. F S HLLINE=$$NEXTLINE^HLCSUTL(HLDOUT0,HLDOUT1,HLLINE,"HLCLN","OUT") Q:'HLLINE D
  1. . S HLCHK=$$CHKSUM^HLCSUTL("HLCLN")
  1. . S HLC2=HLC2_$C($P(HLCHK,U)),HLC1=HLC1+$P(HLCHK,U,2)
  1. . I $E(HLCLN(1),1,3)="MSA" S HLWFLG=1
  1. . ;U IO
  1. . S I=0 F S I=$O(HLCLN(I)) Q:'I W $G(HLCLN(I))
  1. . K HLCLN,HLCHK
  1. ;
  1. D CHKSUM1
  1. ;-- store checksum values
  1. D MONITOR(HLC1,4,HLDP,HLDOUT1,"OUT"),MONITOR(HLC2,5,HLDP,HLDOUT1,"OUT")
  1. ;
  1. S HLC1=$$RJ(HLC1,5)
  1. S HLC2=$$RJ(HLC2,3)
  1. ;
  1. ;-- write end block
  1. S X=HLC1_HLC2_$C(HLDEND)_$C(13)
  1. U IO W X
  1. Q
  1. SETNODE(HLD0,HLD1,CR) ;
  1. S HLLINE=HLLINE+1,^HLCS(870,HLD0,1,HLD1,1,HLLINE,0)=$G(X)
  1. I CR="CR" S HLLINE=HLLINE+1,^HLCS(870,HLD0,1,HLD1,1,HLLINE,0)=""
  1. Q
  1. SETNODE2 ;
  1. S HLLINE=HLLINE+1,^TMP("HLCSDR1",$J,HLDP,HLLINE)=$G(X)
  1. Q
  1. TRANS(HLTOUT,HLTRANS) ; This function returns the state of the read operation.
  1. ; INPUT : HLTOUT - Data returned from read (Will contain TIMEOUT)
  1. ; HLTRANS - Variable passed by reference containing how
  1. ; the read was terminated.
  1. ; OUTPUT: HLTRANS - Translation of read termination.
  1. S HLTRANS=$S($G(HLTOUT)["TIMEOUT":"TIMEOUT",HLTRANS=0:"LONGLINE",HLTRANS=1:"SOH",HLTRANS=4:"EOT",HLTRANS=HLDSTRT:"VT",HLTRANS=13:"CR",HLTRANS=HLDEND:"FS",1:"OTHER")
  1. I $D(HLTRACE) U IO(0) W !,"HLTRANS=",HLTRANS
  1. Q
  1. INITIZE ;Initialize Line counter and Checksum variables
  1. S (HLLINE,HLC1)=0,HLC2=""
  1. Q
  1. NAK(HLTRANS) ; Send NAK
  1. N HLDATA
  1. D INITIZE
  1. ;-- start block and data
  1. S (X,HLDATA)=$C(HLDSTRT)_"N"_HLDVER_$C(13)_HLTRANS
  1. D CHKSUM,CHKSUM1
  1. S HLC1=$$RJ(HLC1,5)
  1. S HLC2=$$RJ(HLC2,3)
  1. ;-- end block
  1. S X=HLDATA_HLC1_HLC2_$C(HLDEND)_$C(13)
  1. U IO W X
  1. Q
  1. ACK ; Send ACK
  1. N HLDATA
  1. D INITIZE
  1. ;-- start block and data
  1. S (X,HLDATA)=$C(HLDSTRT)_"D"_HLDVER_$C(13)
  1. D CHKSUM,CHKSUM1
  1. S HLC1=$$RJ(HLC1,5)
  1. S HLC2=$$RJ(HLC2,3)
  1. ;-- end block
  1. S X=HLDATA_HLC1_HLC2_$C(HLDEND)_$C(13)
  1. U IO W X
  1. Q
  1. DUMP ;
  1. Q:'$D(HLTRACE)
  1. U IO(0)
  1. W !,"DUMP"
  1. I '$D(HLC1) S HLC1=-1
  1. I '$D(HLC2) S HLC2=-1
  1. I '$D(HLBLOCK) S HLBLOCK=-1
  1. I '$D(HLXOR) S HLXOR=-1
  1. W !,"HLC1=",HLC1," ","HLBLOCK=",HLBLOCK
  1. W !,"HLC2=",HLC2," ","HLXOR=",HLXOR
  1. Q
  1. CHKSUM ;
  1. X ^%ZOSF("LPC") S HLC1=HLC1+$L(X),HLC2=HLC2_$C(Y)
  1. I $L(HLC2)>240 D CHKSUM1
  1. Q
  1. CHKSUM1 ;
  1. S X=HLC2 X ^%ZOSF("LPC") S HLC2=Y
  1. Q
  1. VALID1(FLAG,CHK,HLIND0,HLIND1) ;
  1. ;This function extracts the checksum sent with a message and then
  1. ;compares it to the checksums that have been calculated and stored
  1. ;in the HLC1 and HLC2 variables. HLC1 and HLC2 are not passed as
  1. ;parameters, their scope is "communication server-wide"
  1. ;FLAG tells the function what type of message this is, should the
  1. ;last block of data be written to an "in queue" ? or a TMP variable ?
  1. ;this depends on whether the incoming message is a message or just
  1. ;a lower level acknowledgement "LLP-ACK"
  1. ;CHK contains the 8 character cheksum that was sent with the message
  1. ;HLIND0,HLIND1 are just D0 and D1 for the "input queue" in file #870
  1. N HLBLOCK,HLXOR
  1. ;WRITE LAST BLOCK 'O DATA TO GLOBAL
  1. I $G(X)'="",FLAG="INCOMING MESSAGE" D SETNODE(HLIND0,HLIND1,HLTRANS),CHKSUM
  1. I $G(X)'="",FLAG="LLP-ACK" D SETNODE2,CHKSUM
  1. ;Extract checksums
  1. S HLBLOCK=+$E(CHK,1,5),HLXOR=+$E(CHK,6,8)
  1. D CHKSUM1,DUMP
  1. S X="$$CHK$$^"_CHK_"^HLCHK^"_$$RJ(HLC1,5)_$$RJ(HLC2,3)
  1. I FLAG="INCOMING MESSAGE" D MONITOR(HLBLOCK,5,HLDP,HLIND1,"IN"),MONITOR(HLXOR,6,HLDP,HLIND1,"IN"),MONITOR(HLC1,7,HLDP,HLIND1,"IN"),MONITOR(HLC2,8,HLDP,HLIND1,"IN")
  1. I FLAG="LLP-ACK" D SETNODE2
  1. I HLXOR="999" Q "VALID"
  1. I HLBLOCK=HLC1,HLC2=HLXOR Q "VALID"
  1. I HLBLOCK'=HLC1 Q "C"
  1. I HLXOR'=HLC2 Q "X"
  1. Q "G"
  1. TRACE ;When HLTRACE is instantiated this subroutine simply writes out the
  1. ;states that the finite state machine (Lower Layer Protocol) goes thru
  1. Q:'$D(HLTRACE)
  1. U IO(0) W !,"IN STATE ",HLNXST
  1. Q
  1. MONITOR(VALUE,PIECE,HLD0,HLD1,QUEUE) ;
  1. ;This subroutine simply updates a particular piece in a global node
  1. ;in file #870. It can be a zero node, or a node in a queue multiple
  1. I '$D(^HLCS(870,HLD0,0)) Q
  1. I $G(HLD1)']"" S $P(^HLCS(870,HLD0,0),U,PIECE)=VALUE Q
  1. I PIECE=2,$G(QUEUE)="IN" D Q
  1. . N HLJ
  1. . S HLJ(870.019,HLD1_","_HLD0_",",1)=VALUE
  1. . D FILE^HLDIE("","HLJ","","MONITOR","HLCSDR2") ; HL*1.6*109
  1. S $P(^HLCS(870,HLD0,$S(QUEUE="IN":1,1:2),HLD1,0),U,PIECE)=VALUE
  1. Q
  1. FORMAT(HLC,LENGTH) ;Function to stuff leading zeroes for checksums
  1. ;HLC is the checksum, Length is self-documenting
  1. Q $E("00000",1,LENGTH-$L(HLC))
  1. RJ(HLC,LENGTH) ;Function to stuff leading zeroes for checksums
  1. ;HLC is the checksum, Length is self-documenting
  1. ;Functionally equivalent to $$RJ^XLFSTR(HLC,LENGTH,"0")
  1. ;Also equivalent to $$FORMAT(HLC,LENGTH)_HLC
  1. Q $E("00000",1,LENGTH-$L(HLC))_HLC