HLOCLNT1 ;IRMFO-ALB/CJM/RBN - Writing messages, reading acks;03/24/2004 14:43 ;02/27/2012
;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134,137,139,146,155,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
WRITEMSG(HLCSTATE,HLMSTATE) ;
;Description: This function uses the services offered by the transport layer to send a message over an open communication channel.
;
;Input:
; HLCSTATE (pass by reference, required) Defines the LLP & its state
; HLMSTATE (pass by reference, required) The message
;Output:
; Function returns 1 on success, 0 on failure
;
ZB6 ;
N SEG,QUIT,HDR
S QUIT=0
I '$G(HLMSTATE("IEN")) S QUIT=1 G ZB7
S HDR(1)=HLMSTATE("HDR",1),HDR(2)=HLMSTATE("HDR",2)
I '$$WRITEHDR^HLOT(.HLCSTATE,.HDR) S QUIT=1 G ZB7
I HLMSTATE("BATCH") D
.N LAST S LAST=0
.S HLMSTATE("BATCH","CURRENT MESSAGE")=0
.F Q:'$$NEXTMSG^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT
..S LAST=HLMSTATE("BATCH","CURRENT MESSAGE")
..I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q
..F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT
...I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q
.K SEG S SEG(1)="BTS"_HLMSTATE("HDR","FIELD SEPARATOR")_LAST
.S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1
E D
.F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT
..S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1
S:'$$ENDMSG^HLOT(.HLCSTATE) QUIT=1
ZB7 ;
Q 'QUIT
;
READACK(HLCSTATE,HDR,MSA) ;
;Description: This function uses the services offered by the transport layer to read an accept ack.
;
;Input:
; HLCSTATE (pass by reference, required) Defines the communication channel and its state.
;Output:
; Function returns 1 on success, 0 on failure
; HDR (pass by reference) the message header:
; HDR(1) is components 1-6
; HDR(2) is components 7-end
; MSA (pass by reference) the MSA segment as an unsubscripted variable
;
ZB8 ;
N SEG,SUCCESS
S SUCCESS=0
K HDR,MSA,MAX,I
S MAX=HLCSTATE("SYSTEM","MAXSTRING")-40 ;MAX is the maximum that can be safely stored on a node, leaving room for the other fields stored with MSA seg
G:'$$READHDR^HLOT(.HLCSTATE,.HDR) ZB9
F Q:'$$READSEG^HLOT(.HLCSTATE,.SEG) D
.I $E($E(SEG(1),1,3)_$E($G(SEG(2)),1,3),1,3)="MSA" D
..S MSA=""
..F I=1:1 Q:'$D(SEG(I)) S MSA=MSA_$S((MAX-$L(MSA))<1:"",1:$E(SEG(I),1,MAX))
I $D(MSA),HLCSTATE("MESSAGE ENDED") D S SUCCESS=1
.D SPLITHDR^HLOSRVR1(.HDR)
.S HLCSTATE("COUNTS","ACKS")=$G(HLCSTATE("COUNTS","ACKS"))+1
ZB9 Q SUCCESS
;
CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ;
ZB1 ;sets up HLCSTATE() and opens a client connection
;Input:
; LINK - name of the link to connect to
; PORT (optional) port # to connect to, defaults to that specified by the link
; TIMEOUT (optional) specifies the open timeout in seconds, defaults to 30
;Output:
; HLCSTATE - array to hold the connection state
;
I '$G(HLCSTATE("CONNECTED")) S HLCSTATE("CONNECTED")=0
I HLCSTATE("CONNECTED") D G:HLCSTATE("CONNECTED") ZB2
.I $G(HLCSTATE("LINK","NAME"))]"",($G(HLCSTATE("LINK","NAME"))'=LINK) D CLOSE^HLOT(.HLCSTATE) Q
.I $G(HLCSTATE("LINK","NAME"))]"",$G(PORT),($G(HLCSTATE("LINK","PORT"))'=PORT) D CLOSE^HLOT(.HLCSTATE) Q
.I (HLCSTATE("SYSTEM","OS")="CACHE") D Q
..U HLCSTATE("DEVICE") S HLCSTATE("CONNECTED")=($ZA\8192#2)
..I 'HLCSTATE("CONNECTED") D CLOSE^HLOT(.HLCSTATE)
.;D CLOSE^HLOT(.HLCSTATE)
K HLCSTATE
N ARY,NODE
I '$$GETLINK^HLOTLNK(LINK,.ARY) S HLCSTATE("LINK","NAME")=LINK,HLCSTATE("LINK","PORT")=$G(PORT) D LINKDOWN^HLOCLNT(.HLCSTATE) G ZB2
M HLCSTATE("LINK")=ARY
ZB24 ;
I HLCSTATE("LINK","SHUTDOWN") S HLCSTATE("CONNECTED")=0 D LINKDOWN^HLOCLNT(.HLCSTATE) G ZB2
;overlay the port if supplied from the queue
S:$G(PORT) HLCSTATE("LINK","PORT")=PORT
;
; *** Begin HL*1.6*146 - RBN ***
;S HLCSTATE("READ TIMEOUT")=20
;get the dynamic value of the client read timeout
D GETTIME^HLOTCP(.HLCSTATE)
; *** End HL*1.6*146 - RBN ***
; ;
S HLCSTATE("OPEN TIMEOUT")=$S($G(TIMEOUT):TIMEOUT,1:30)
S HLCSTATE("COUNTS")=0
S HLCSTATE("READ")="" ;where the reads are stored
;
;HLCSTATE("BUFFER",<seg>,<line>) serves as a write buffer so that a lot can be written all at once
S HLCSTATE("BUFFER","BYTE COUNT")=0 ;count of BYTES in buffer
S HLCSTATE("BUFFER","SEGMENT COUNT")=0 ;count of segments in buffer
;
S HLCSTATE("MESSAGE ENDED")=0 ;end of message flag
S NODE=^%ZOSF("OS")
S HLCSTATE("SERVER")=0
S HLCSTATE("SYSTEM","OS")=$S(NODE["DSM":"DSM",NODE["OpenM":"CACHE",NODE["G.TM":"G.TM",1:"")
I HLCSTATE("SYSTEM","OS")="" D LINKDOWN^HLOCLNT(.HLCSTATE) G ZB2
D
.N SYS
.D SYSPARMS^HLOSITE(.SYS)
.S HLCSTATE("SYSTEM","BUFFER")=SYS("HL7 BUFFER")
.S HLCSTATE("SYSTEM","MAXSTRING")=SYS("MAXSTRING")
.S HLCSTATE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
.S HLCSTATE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
I HLCSTATE("LINK","LLP")="TCP" D
.S HLCSTATE("OPEN")="OPEN^HLOTCP"
E ;no other LLP implemented
D OPEN^HLOT(.HLCSTATE)
;
;mark the failure time for the link so other processes know not to try for a while
I 'HLCSTATE("CONNECTED"),'HLCSTATE("LINK","SINGLE THREADED") D LINKDOWN^HLOCLNT(.HLCSTATE)
I 'HLCSTATE("CONNECTED"),HLCSTATE("LINK","SINGLE THREADED"),'HLCSTATE("LOCK FAILED") D LINKDOWN^HLOCLNT(.HLCSTATE)
ZB2 ;
Q HLCSTATE("CONNECTED")
;
;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOCLNT1 5335 printed Oct 16, 2024@17:59:23 Page 2
HLOCLNT1 ;IRMFO-ALB/CJM/RBN - Writing messages, reading acks;03/24/2004 14:43 ;02/27/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134,137,139,146,155,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
WRITEMSG(HLCSTATE,HLMSTATE) ;
+1 ;Description: This function uses the services offered by the transport layer to send a message over an open communication channel.
+2 ;
+3 ;Input:
+4 ; HLCSTATE (pass by reference, required) Defines the LLP & its state
+5 ; HLMSTATE (pass by reference, required) The message
+6 ;Output:
+7 ; Function returns 1 on success, 0 on failure
+8 ;
ZB6 ;
+1 NEW SEG,QUIT,HDR
+2 SET QUIT=0
+3 IF '$GET(HLMSTATE("IEN"))
SET QUIT=1
GOTO ZB7
+4 SET HDR(1)=HLMSTATE("HDR",1)
SET HDR(2)=HLMSTATE("HDR",2)
+5 IF '$$WRITEHDR^HLOT(.HLCSTATE,.HDR)
SET QUIT=1
GOTO ZB7
+6 IF HLMSTATE("BATCH")
Begin DoDot:1
+7 NEW LAST
SET LAST=0
+8 SET HLMSTATE("BATCH","CURRENT MESSAGE")=0
+9 FOR
if '$$NEXTMSG^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:2
+10 SET LAST=HLMSTATE("BATCH","CURRENT MESSAGE")
+11 IF '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
QUIT
+12 FOR
if '$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:3
+13 IF '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
QUIT
End DoDot:3
if QUIT
QUIT
End DoDot:2
if QUIT
QUIT
+14 KILL SEG
SET SEG(1)="BTS"_HLMSTATE("HDR","FIELD SEPARATOR")_LAST
+15 if '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 FOR
if '$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:2
+18 if '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
End DoDot:2
if QUIT
QUIT
End DoDot:1
+19 if '$$ENDMSG^HLOT(.HLCSTATE)
SET QUIT=1
ZB7 ;
+1 QUIT 'QUIT
+2 ;
READACK(HLCSTATE,HDR,MSA) ;
+1 ;Description: This function uses the services offered by the transport layer to read an accept ack.
+2 ;
+3 ;Input:
+4 ; HLCSTATE (pass by reference, required) Defines the communication channel and its state.
+5 ;Output:
+6 ; Function returns 1 on success, 0 on failure
+7 ; HDR (pass by reference) the message header:
+8 ; HDR(1) is components 1-6
+9 ; HDR(2) is components 7-end
+10 ; MSA (pass by reference) the MSA segment as an unsubscripted variable
+11 ;
ZB8 ;
+1 NEW SEG,SUCCESS
+2 SET SUCCESS=0
+3 KILL HDR,MSA,MAX,I
+4 ;MAX is the maximum that can be safely stored on a node, leaving room for the other fields stored with MSA seg
SET MAX=HLCSTATE("SYSTEM","MAXSTRING")-40
+5 if '$$READHDR^HLOT(.HLCSTATE,.HDR)
GOTO ZB9
+6 FOR
if '$$READSEG^HLOT(.HLCSTATE,.SEG)
QUIT
Begin DoDot:1
+7 IF $EXTRACT($EXTRACT(SEG(1),1,3)_$EXTRACT($GET(SEG(2)),1,3),1,3)="MSA"
Begin DoDot:2
+8 SET MSA=""
+9 FOR I=1:1
if '$DATA(SEG(I))
QUIT
SET MSA=MSA_$SELECT((MAX-$LENGTH(MSA))<1:"",1:$EXTRACT(SEG(I),1,MAX))
End DoDot:2
End DoDot:1
+10 IF $DATA(MSA)
IF HLCSTATE("MESSAGE ENDED")
Begin DoDot:1
+11 DO SPLITHDR^HLOSRVR1(.HDR)
+12 SET HLCSTATE("COUNTS","ACKS")=$GET(HLCSTATE("COUNTS","ACKS"))+1
End DoDot:1
SET SUCCESS=1
ZB9 QUIT SUCCESS
+1 ;
CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ;
ZB1 ;sets up HLCSTATE() and opens a client connection
+1 ;Input:
+2 ; LINK - name of the link to connect to
+3 ; PORT (optional) port # to connect to, defaults to that specified by the link
+4 ; TIMEOUT (optional) specifies the open timeout in seconds, defaults to 30
+5 ;Output:
+6 ; HLCSTATE - array to hold the connection state
+7 ;
+8 IF '$GET(HLCSTATE("CONNECTED"))
SET HLCSTATE("CONNECTED")=0
+9 IF HLCSTATE("CONNECTED")
Begin DoDot:1
+10 IF $GET(HLCSTATE("LINK","NAME"))]""
IF ($GET(HLCSTATE("LINK","NAME"))'=LINK)
DO CLOSE^HLOT(.HLCSTATE)
QUIT
+11 IF $GET(HLCSTATE("LINK","NAME"))]""
IF $GET(PORT)
IF ($GET(HLCSTATE("LINK","PORT"))'=PORT)
DO CLOSE^HLOT(.HLCSTATE)
QUIT
+12 IF (HLCSTATE("SYSTEM","OS")="CACHE")
Begin DoDot:2
+13 USE HLCSTATE("DEVICE")
SET HLCSTATE("CONNECTED")=($ZA\8192#2)
+14 IF 'HLCSTATE("CONNECTED")
DO CLOSE^HLOT(.HLCSTATE)
End DoDot:2
QUIT
+15 ;D CLOSE^HLOT(.HLCSTATE)
End DoDot:1
if HLCSTATE("CONNECTED")
GOTO ZB2
+16 KILL HLCSTATE
+17 NEW ARY,NODE
+18 IF '$$GETLINK^HLOTLNK(LINK,.ARY)
SET HLCSTATE("LINK","NAME")=LINK
SET HLCSTATE("LINK","PORT")=$GET(PORT)
DO LINKDOWN^HLOCLNT(.HLCSTATE)
GOTO ZB2
+19 MERGE HLCSTATE("LINK")=ARY
ZB24 ;
+1 IF HLCSTATE("LINK","SHUTDOWN")
SET HLCSTATE("CONNECTED")=0
DO LINKDOWN^HLOCLNT(.HLCSTATE)
GOTO ZB2
+2 ;overlay the port if supplied from the queue
+3 if $GET(PORT)
SET HLCSTATE("LINK","PORT")=PORT
+4 ;
+5 ; *** Begin HL*1.6*146 - RBN ***
+6 ;S HLCSTATE("READ TIMEOUT")=20
+7 ;get the dynamic value of the client read timeout
+8 DO GETTIME^HLOTCP(.HLCSTATE)
+9 ; *** End HL*1.6*146 - RBN ***
+10 ; ;
+11 SET HLCSTATE("OPEN TIMEOUT")=$SELECT($GET(TIMEOUT):TIMEOUT,1:30)
+12 SET HLCSTATE("COUNTS")=0
+13 ;where the reads are stored
SET HLCSTATE("READ")=""
+14 ;
+15 ;HLCSTATE("BUFFER",<seg>,<line>) serves as a write buffer so that a lot can be written all at once
+16 ;count of BYTES in buffer
SET HLCSTATE("BUFFER","BYTE COUNT")=0
+17 ;count of segments in buffer
SET HLCSTATE("BUFFER","SEGMENT COUNT")=0
+18 ;
+19 ;end of message flag
SET HLCSTATE("MESSAGE ENDED")=0
+20 SET NODE=^%ZOSF("OS")
+21 SET HLCSTATE("SERVER")=0
+22 SET HLCSTATE("SYSTEM","OS")=$SELECT(NODE["DSM":"DSM",NODE["OpenM":"CACHE",NODE["G.TM":"G.TM",1:"")
+23 IF HLCSTATE("SYSTEM","OS")=""
DO LINKDOWN^HLOCLNT(.HLCSTATE)
GOTO ZB2
+24 Begin DoDot:1
+25 NEW SYS
+26 DO SYSPARMS^HLOSITE(.SYS)
+27 SET HLCSTATE("SYSTEM","BUFFER")=SYS("HL7 BUFFER")
+28 SET HLCSTATE("SYSTEM","MAXSTRING")=SYS("MAXSTRING")
+29 SET HLCSTATE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
+30 SET HLCSTATE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
End DoDot:1
+31 IF HLCSTATE("LINK","LLP")="TCP"
Begin DoDot:1
+32 SET HLCSTATE("OPEN")="OPEN^HLOTCP"
End DoDot:1
+33 ;no other LLP implemented
IF '$TEST
+34 DO OPEN^HLOT(.HLCSTATE)
+35 ;
+36 ;mark the failure time for the link so other processes know not to try for a while
+37 IF 'HLCSTATE("CONNECTED")
IF 'HLCSTATE("LINK","SINGLE THREADED")
DO LINKDOWN^HLOCLNT(.HLCSTATE)
+38 IF 'HLCSTATE("CONNECTED")
IF HLCSTATE("LINK","SINGLE THREADED")
IF 'HLCSTATE("LOCK FAILED")
DO LINKDOWN^HLOCLNT(.HLCSTATE)
ZB2 ;
+1 QUIT HLCSTATE("CONNECTED")
+2 ;
+3 ;
+4 ;
+5 ;
