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