- 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 Feb 18, 2025@23:22:51 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