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

HLOCLNT1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. WRITEMSG(HLCSTATE,HLMSTATE) ;
  1.  ;Description:  This function uses the services offered by the transport layer to send a message over an open communication channel.
  1.  ;
  1.  ;Input:
  1.  ;  HLCSTATE (pass by reference, required) Defines the LLP & its state
  1.  ;  HLMSTATE (pass by reference, required) The message
  1.  ;Output:
  1.  ;  Function returns 1 on success, 0 on failure
  1.  ;
  1.  N SEG,QUIT,HDR
  1.  S QUIT=0
  1.  Q:'$G(HLMSTATE("IEN")) 0
  1.  S HDR(1)=HLMSTATE("HDR",1),HDR(2)=HLMSTATE("HDR",2)
  1.  Q:'$$WRITEHDR^HLOT(.HLCSTATE,.HDR) 0
  1.  I HLMSTATE("BATCH") D
  1.  .N LAST S LAST=0
  1.  .S HLMSTATE("BATCH","CURRENT MESSAGE")=0
  1.  .F  Q:'$$NEXTMSG^HLOMSG(.HLMSTATE,.SEG)  D  Q:QUIT
  1.  ..S LAST=HLMSTATE("BATCH","CURRENT MESSAGE")
  1.  ..I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q
  1.  ..F  Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)  D  Q:QUIT
  1.  ...I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q
  1.  .K SEG S SEG(1)="BTS"_HLMSTATE("HDR","FIELD SEPARATOR")_LAST
  1.  .S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1
  1.  E  D
  1.  .F  Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG)  D  Q:QUIT
  1.  ..S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1
  1.  S:'$$ENDMSG^HLOT(.HLCSTATE) QUIT=1
  1.  Q 'QUIT
  1.  ;
  1. READACK(HLCSTATE,HDR,MSA) ;
  1.  ;Description:  This function uses the services offered by the transport layer to read an accept ack.
  1.  ;
  1.  ;Input:
  1.  ;  HLCSTATE (pass by reference, required) Defines the communication channel and its state.
  1.  ;Output:
  1.  ;  Function returns 1 on success, 0 on failure
  1.  ;  HDR (pass by reference) the message header:
  1.  ;   HDR(1) is components 1-6
  1.  ;   HDR(2) is components 7-end
  1.  ;  MSA (pass by reference) the MSA segment as an unsubscripted variable
  1.  ;
  1.  N SEG
  1.  K HDR,MSA,MAX,I
  1.  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
  1.  Q:'$$READHDR^HLOT(.HLCSTATE,.HDR) 0
  1.  F  Q:'$$READSEG^HLOT(.HLCSTATE,.SEG)  D
  1.  .I $E($E(SEG(1),1,3)_$E($G(SEG(2)),1,3),1,3)="MSA" D
  1.  ..S MSA=""
  1.  ..F I=1:1 Q:'$D(SEG(I))  S MSA=MSA_$S((MAX-$L(MSA))<1:"",1:$E(SEG(I),1,MAX))
  1.  I $D(MSA),HLCSTATE("MESSAGE ENDED") D  Q 1
  1.  .D SPLITHDR^HLOSRVR1(.HDR)
  1.  .S HLCSTATE("COUNTS","ACKS")=$G(HLCSTATE("COUNTS","ACKS"))+1
  1.  Q 0
  1.  ;
  1. CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ;
  1.  ;sets up HLCSTATE() and opens a client connection
  1.  ;Input:
  1.  ;  LINK - name of the link to connect to
  1.  ;  PORT (optional) port # to connect to, defaults to that specified by the link
  1.  ;  TIMEOUT (optional) specifies the open timeout in seconds, defaults to 30
  1.  ;Output:
  1.  ;   HLCSTATE - array to hold the connection state
  1.  ;
  1.  I $G(HLCSTATE("CONNECTED")) D  Q:HLCSTATE("CONNECTED")
  1.  .I $G(HLCSTATE("LINK","NAME"))]"",($G(HLCSTATE("LINK","NAME"))'=LINK) D CLOSE^HLOT(.HLCSTATE) Q
  1.  .I $G(HLCSTATE("LINK","NAME"))]"",$G(PORT),($G(HLCSTATE("LINK","PORT"))'=PORT) D CLOSE^HLOT(.HLCSTATE) Q
  1.  .I (HLCSTATE("SYSTEM","OS")="CACHE") D  Q
  1.  ..U HLCSTATE("DEVICE") S HLCSTATE("CONNECTED")=($ZA\8192#2)
  1.  ..I 'HLCSTATE("CONNECTED") D CLOSE^HLOT(.HLCSTATE)
  1.  .;D CLOSE^HLOT(.HLCSTATE)
  1.  K HLCSTATE
  1.  N ARY,NODE
  1.  I '$$GETLINK^HLOTLNK(LINK,.ARY) S HLCSTATE("LINK","NAME")=LINK,HLCSTATE("LINK","PORT")=$G(PORT) D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
  1.  M HLCSTATE("LINK")=ARY
  1.  I HLCSTATE("LINK","SHUTDOWN") S HLCSTATE("CONNECTED")=0 D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
  1.  ;overlay the port if supplied from the queue
  1.  S:$G(PORT) HLCSTATE("LINK","PORT")=PORT
  1.  S HLCSTATE("READ TIMEOUT")=20
  1.  S HLCSTATE("OPEN TIMEOUT")=$S($G(TIMEOUT):TIMEOUT,1:30)
  1.  S HLCSTATE("COUNTS")=0
  1.  S HLCSTATE("READ")="" ;where the reads are stored
  1.  ;
  1.  ;HLCSTATE("BUFFER",<seg>,<line>) serves as a write buffer so that a lot can be written all at once
  1.  S HLCSTATE("BUFFER","BYTE COUNT")=0 ;count of BYTES in buffer
  1.  S HLCSTATE("BUFFER","SEGMENT COUNT")=0 ;count of segments in buffer
  1.  ;
  1.  S HLCSTATE("MESSAGE ENDED")=0 ;end of message flag
  1.  S NODE=^%ZOSF("OS")
  1.  S HLCSTATE("SERVER")=0
  1.  S HLCSTATE("SYSTEM","OS")=$S(NODE["DSM":"DSM",NODE["OpenM":"CACHE",NODE["G.TM":"G.TM",1:"")
  1.  I HLCSTATE("SYSTEM","OS")="" D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
  1.  D
  1.  .N SYS
  1.  .D SYSPARMS^HLOSITE(.SYS)
  1.  .S HLCSTATE("SYSTEM","BUFFER")=SYS("HL7 BUFFER")
  1.  .S HLCSTATE("SYSTEM","MAXSTRING")=SYS("MAXSTRING")
  1.  .S HLCSTATE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
  1.  .S HLCSTATE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
  1.  I HLCSTATE("LINK","LLP")="TCP" D
  1.  .S HLCSTATE("OPEN")="OPEN^HLOTCP"
  1.  E  ;no other LLP implemented
  1.  D OPEN^HLOT(.HLCSTATE)
  1.  ;
  1.  ;mark the failure time for the link so other processes know not to try for a while
  1.  I 'HLCSTATE("CONNECTED") D LINKDOWN^HLOCLNT(.HLCSTATE)
  1.  Q HLCSTATE("CONNECTED")
  1.  ;
  1. BADMSGS(WORK) ;
  1.  ;finds messages that won't transmit and takes them off the outgoing queue
  1.  N LINK
  1.  S LINK=""
  1.  F  S LINK=$O(^HLTMP("FAILING LINKS",LINK)) Q:LINK=""  D
  1.  .N TIME,QUE,COUNT
  1.  .S TIME=$G(^HLTMP("FAILING LINKS",LINK)) Q:TIME=""
  1.  .Q:$$HDIFF^XLFDT($H,TIME,2)<7200
  1.  .Q:'$$IFOPEN^HLOUSR1(LINK)
  1.  .L +^HLB("QUEUE","OUT",LINK):0
  1.  .S QUE=""
  1.  .F  S QUE=$O(^HLB("QUEUE","OUT",LINK,QUE)) Q:QUE=""  D
  1.  ..N MSG S MSG=0
  1.  ..S MSG=$O(^HLB("QUEUE","OUT",LINK,QUE,MSG))
  1.  ..Q:'MSG
  1.  ..S COUNT=$G(^HLB(MSG,"TRIES"))
  1.  ..I COUNT>20 D
  1.  ...N NODE,TIME,APP,FS,ACTION
  1.  ...S NODE=$G(^HLB(MSG,0))
  1.  ...Q:'$P(NODE,"^",2)
  1.  ...S TIME=+$G(^HLA($P(NODE,"^",2),0))
  1.  ...S NODE=$G(^HLB(MSG,1))
  1.  ...S FS=$E(NODE,4)
  1.  ...Q:FS=""
  1.  ...S APP=$P(NODE,FS,3)
  1.  ...Q:APP=""
  1.  ...S $P(^HLB(MSG,0),"^",21)=COUNT_" FAILED TRANSMISSIONS"
  1.  ...S $P(^HLB(MSG,0),"^",20)="TF"
  1.  ...S ^HLB("ERRORS","TF",APP,TIME,MSG)=""
  1.  ...S ACTION=$P(NODE,"^",14,15)
  1.  ...I ACTION'="^",ACTION]"" D INQUE^HLOQUE(LINK,QUE,MSG,ACTION,1)
  1.  ...D DEQUE^HLOQUE(LINK,QUE,"OUT",MSG)
  1.  .L -^HLB("QUEUE","OUT",LINK)
  1.  Q