HLOCLNT1 ;IRMFO-ALB/CJM - Writing messages, reading acks;03/24/2004 14:43
;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10
;
;
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
;
N SEG,QUIT,HDR
S QUIT=0
Q:'$G(HLMSTATE("IEN")) 0
S HDR(1)=HLMSTATE("HDR",1),HDR(2)=HLMSTATE("HDR",2)
Q:'$$WRITEHDR^HLOT(.HLCSTATE,.HDR) 0
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
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
;
N SEG
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
Q:'$$READHDR^HLOT(.HLCSTATE,.HDR) 0
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 Q 1
.D SPLITHDR^HLOSRVR1(.HDR)
.S HLCSTATE("COUNTS","ACKS")=$G(HLCSTATE("COUNTS","ACKS"))+1
Q 0
;
CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ;
;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")) D Q:HLCSTATE("CONNECTED")
.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) Q 0
M HLCSTATE("LINK")=ARY
I HLCSTATE("LINK","SHUTDOWN") S HLCSTATE("CONNECTED")=0 D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
;overlay the port if supplied from the queue
S:$G(PORT) HLCSTATE("LINK","PORT")=PORT
S HLCSTATE("READ TIMEOUT")=20
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) Q 0
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") D LINKDOWN^HLOCLNT(.HLCSTATE)
Q HLCSTATE("CONNECTED")
;
BADMSGS(WORK) ;
;finds messages that won't transmit and takes them off the outgoing queue
N LINK
S LINK=""
F S LINK=$O(^HLTMP("FAILING LINKS",LINK)) Q:LINK="" D
.N TIME,QUE,COUNT
.S TIME=$G(^HLTMP("FAILING LINKS",LINK)) Q:TIME=""
.Q:$$HDIFF^XLFDT($H,TIME,2)<7200
.Q:'$$IFOPEN^HLOUSR1(LINK)
.L +^HLB("QUEUE","OUT",LINK):0
.S QUE=""
.F S QUE=$O(^HLB("QUEUE","OUT",LINK,QUE)) Q:QUE="" D
..N MSG S MSG=0
..S MSG=$O(^HLB("QUEUE","OUT",LINK,QUE,MSG))
..Q:'MSG
..S COUNT=$G(^HLB(MSG,"TRIES"))
..I COUNT>20 D
...N NODE,TIME,APP,FS,ACTION
...S NODE=$G(^HLB(MSG,0))
...Q:'$P(NODE,"^",2)
...S TIME=+$G(^HLA($P(NODE,"^",2),0))
...S NODE=$G(^HLB(MSG,1))
...S FS=$E(NODE,4)
...Q:FS=""
...S APP=$P(NODE,FS,3)
...Q:APP=""
...S $P(^HLB(MSG,0),"^",21)=COUNT_" FAILED TRANSMISSIONS"
...S $P(^HLB(MSG,0),"^",20)="TF"
...S ^HLB("ERRORS","TF",APP,TIME,MSG)=""
...S ACTION=$P(NODE,"^",14,15)
...I ACTION'="^",ACTION]"" D INQUE^HLOQUE(LINK,QUE,MSG,ACTION,1)
...D DEQUE^HLOQUE(LINK,QUE,"OUT",MSG)
.L -^HLB("QUEUE","OUT",LINK)
Q
HLOCLNT1 ;IRMFO-ALB/CJM - Writing messages, reading acks;03/24/2004 14:43
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10
+2 ;
+3 ;
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 ;
+9 NEW SEG,QUIT,HDR
+10 SET QUIT=0
+11 IF '$GET(HLMSTATE("IEN"))
QUIT 0
+12 SET HDR(1)=HLMSTATE("HDR",1)
SET HDR(2)=HLMSTATE("HDR",2)
+13 IF '$$WRITEHDR^HLOT(.HLCSTATE,.HDR)
QUIT 0
+14 IF HLMSTATE("BATCH")
Begin DoDot:1
+15 NEW LAST
SET LAST=0
+16 SET HLMSTATE("BATCH","CURRENT MESSAGE")=0
+17 FOR
IF '$$NEXTMSG^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:2
+18 SET LAST=HLMSTATE("BATCH","CURRENT MESSAGE")
+19 IF '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
QUIT
+20 FOR
IF '$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:3
+21 IF '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
QUIT
End DoDot:3
IF QUIT
QUIT
End DoDot:2
IF QUIT
QUIT
+22 KILL SEG
SET SEG(1)="BTS"_HLMSTATE("HDR","FIELD SEPARATOR")_LAST
+23 IF '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 FOR
IF '$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)
QUIT
Begin DoDot:2
+26 IF '$$WRITESEG^HLOT(.HLCSTATE,.SEG)
SET QUIT=1
End DoDot:2
IF QUIT
QUIT
End DoDot:1
+27 IF '$$ENDMSG^HLOT(.HLCSTATE)
SET QUIT=1
+28 QUIT 'QUIT
+29 ;
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 ;
+12 NEW SEG
+13 KILL HDR,MSA,MAX,I
+14 ;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
+15 IF '$$READHDR^HLOT(.HLCSTATE,.HDR)
QUIT 0
+16 FOR
IF '$$READSEG^HLOT(.HLCSTATE,.SEG)
QUIT
Begin DoDot:1
+17 IF $EXTRACT($EXTRACT(SEG(1),1,3)_$EXTRACT($GET(SEG(2)),1,3),1,3)="MSA"
Begin DoDot:2
+18 SET MSA=""
+19 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
+20 IF $DATA(MSA)
IF HLCSTATE("MESSAGE ENDED")
Begin DoDot:1
+21 DO SPLITHDR^HLOSRVR1(.HDR)
+22 SET HLCSTATE("COUNTS","ACKS")=$GET(HLCSTATE("COUNTS","ACKS"))+1
End DoDot:1
QUIT 1
+23 QUIT 0
+24 ;
CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ;
+1 ;sets up HLCSTATE() and opens a client connection
+2 ;Input:
+3 ; LINK - name of the link to connect to
+4 ; PORT (optional) port # to connect to, defaults to that specified by the link
+5 ; TIMEOUT (optional) specifies the open timeout in seconds, defaults to 30
+6 ;Output:
+7 ; HLCSTATE - array to hold the connection state
+8 ;
+9 IF $GET(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")
QUIT
+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)
QUIT 0
+19 MERGE HLCSTATE("LINK")=ARY
+20 IF HLCSTATE("LINK","SHUTDOWN")
SET HLCSTATE("CONNECTED")=0
DO LINKDOWN^HLOCLNT(.HLCSTATE)
QUIT 0
+21 ;overlay the port if supplied from the queue
+22 IF $GET(PORT)
SET HLCSTATE("LINK","PORT")=PORT
+23 SET HLCSTATE("READ TIMEOUT")=20
+24 SET HLCSTATE("OPEN TIMEOUT")=$SELECT($GET(TIMEOUT):TIMEOUT,1:30)
+25 SET HLCSTATE("COUNTS")=0
+26 ;where the reads are stored
SET HLCSTATE("READ")=""
+27 ;
+28 ;HLCSTATE("BUFFER",<seg>,<line>) serves as a write buffer so that a lot can be written all at once
+29 ;count of BYTES in buffer
SET HLCSTATE("BUFFER","BYTE COUNT")=0
+30 ;count of segments in buffer
SET HLCSTATE("BUFFER","SEGMENT COUNT")=0
+31 ;
+32 ;end of message flag
SET HLCSTATE("MESSAGE ENDED")=0
+33 SET NODE=^%ZOSF("OS")
+34 SET HLCSTATE("SERVER")=0
+35 SET HLCSTATE("SYSTEM","OS")=$SELECT(NODE["DSM":"DSM",NODE["OpenM":"CACHE",NODE["G.TM":"G.TM",1:"")
+36 IF HLCSTATE("SYSTEM","OS")=""
DO LINKDOWN^HLOCLNT(.HLCSTATE)
QUIT 0
+37 Begin DoDot:1
+38 NEW SYS
+39 DO SYSPARMS^HLOSITE(.SYS)
+40 SET HLCSTATE("SYSTEM","BUFFER")=SYS("HL7 BUFFER")
+41 SET HLCSTATE("SYSTEM","MAXSTRING")=SYS("MAXSTRING")
+42 SET HLCSTATE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
+43 SET HLCSTATE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
End DoDot:1
+44 IF HLCSTATE("LINK","LLP")="TCP"
Begin DoDot:1
+45 SET HLCSTATE("OPEN")="OPEN^HLOTCP"
End DoDot:1
+46 ;no other LLP implemented
IF '$TEST
+47 DO OPEN^HLOT(.HLCSTATE)
+48 ;
+49 ;mark the failure time for the link so other processes know not to try for a while
+50 IF 'HLCSTATE("CONNECTED")
DO LINKDOWN^HLOCLNT(.HLCSTATE)
+51 QUIT HLCSTATE("CONNECTED")
+52 ;
BADMSGS(WORK) ;
+1 ;finds messages that won't transmit and takes them off the outgoing queue
+2 NEW LINK
+3 SET LINK=""
+4 FOR
SET LINK=$ORDER(^HLTMP("FAILING LINKS",LINK))
IF LINK=""
QUIT
Begin DoDot:1
+5 NEW TIME,QUE,COUNT
+6 SET TIME=$GET(^HLTMP("FAILING LINKS",LINK))
IF TIME=""
QUIT
+7 IF $$HDIFF^XLFDT($HOROLOG,TIME,2)<7200
QUIT
+8 IF '$$IFOPEN^HLOUSR1(LINK)
QUIT
+9 LOCK +^HLB("QUEUE","OUT",LINK):0
+10 SET QUE=""
+11 FOR
SET QUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUE))
IF QUE=""
QUIT
Begin DoDot:2
+12 NEW MSG
SET MSG=0
+13 SET MSG=$ORDER(^HLB("QUEUE","OUT",LINK,QUE,MSG))
+14 IF 'MSG
QUIT
+15 SET COUNT=$GET(^HLB(MSG,"TRIES"))
+16 IF COUNT>20
Begin DoDot:3
+17 NEW NODE,TIME,APP,FS,ACTION
+18 SET NODE=$GET(^HLB(MSG,0))
+19 IF '$PIECE(NODE,"^",2)
QUIT
+20 SET TIME=+$GET(^HLA($PIECE(NODE,"^",2),0))
+21 SET NODE=$GET(^HLB(MSG,1))
+22 SET FS=$EXTRACT(NODE,4)
+23 IF FS=""
QUIT
+24 SET APP=$PIECE(NODE,FS,3)
+25 IF APP=""
QUIT
+26 SET $PIECE(^HLB(MSG,0),"^",21)=COUNT_" FAILED TRANSMISSIONS"
+27 SET $PIECE(^HLB(MSG,0),"^",20)="TF"
+28 SET ^HLB("ERRORS","TF",APP,TIME,MSG)=""
+29 SET ACTION=$PIECE(NODE,"^",14,15)
+30 IF ACTION'="^"
IF ACTION]""
DO INQUE^HLOQUE(LINK,QUE,MSG,ACTION,1)
+31 DO DEQUE^HLOQUE(LINK,QUE,"OUT",MSG)
End DoDot:3
End DoDot:2
+32 LOCK -^HLB("QUEUE","OUT",LINK)
End DoDot:1
+33 QUIT
