source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCLNT1.m@ 1195

Last change on this file since 1195 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.9 KB
Line 
1HLOCLNT1 ;IRMFO-ALB/CJM - Writing messages, reading acks;03/24/2004 14:43 ;03/19/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134**;Oct 13, 1995;Build 30
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6WRITEMSG(HLCSTATE,HLMSTATE) ;
7 ;Description: This function uses the services offered by the transport layer to send a message over an open communication channel.
8 ;
9 ;Input:
10 ; HLCSTATE (pass by reference, required) Defines the LLP & its state
11 ; HLMSTATE (pass by reference, required) The message
12 ;Output:
13 ; Function returns 1 on success, 0 on failure
14 ;
15 N SEG,QUIT,HDR
16 S QUIT=0
17 Q:'$G(HLMSTATE("IEN")) 0
18 S HDR(1)=HLMSTATE("HDR",1),HDR(2)=HLMSTATE("HDR",2)
19 Q:'$$WRITEHDR^HLOT(.HLCSTATE,.HDR) 0
20 I HLMSTATE("BATCH") D
21 .N LAST S LAST=0
22 .S HLMSTATE("BATCH","CURRENT MESSAGE")=0
23 .F Q:'$$NEXTMSG^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT
24 ..S LAST=HLMSTATE("BATCH","CURRENT MESSAGE")
25 ..I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q
26 ..F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT
27 ...I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q
28 .K SEG S SEG(1)="BTS"_HLMSTATE("HDR","FIELD SEPARATOR")_LAST
29 .S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1
30 E D
31 .F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT
32 ..S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1
33 S:'$$ENDMSG^HLOT(.HLCSTATE) QUIT=1
34 Q 'QUIT
35 ;
36READACK(HLCSTATE,HDR,MSA) ;
37 ;Description: This function uses the services offered by the transport layer to read an accept ack.
38 ;
39 ;Input:
40 ; HLCSTATE (pass by reference, required) Defines the communication channel and its state.
41 ;Output:
42 ; Function returns 1 on success, 0 on failure
43 ; HDR (pass by reference) the message header:
44 ; HDR(1) is components 1-6
45 ; HDR(2) is components 7-end
46 ; MSA (pass by reference) the MSA segment as an unsubscripted variable
47 ;
48 N SEG
49 K HDR,MSA,MAX,I
50 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
51 Q:'$$READHDR^HLOT(.HLCSTATE,.HDR) 0
52 F Q:'$$READSEG^HLOT(.HLCSTATE,.SEG) D
53 .I $E($E(SEG(1),1,3)_$E($G(SEG(2)),1,3),1,3)="MSA" D
54 ..S MSA=""
55 ..F I=1:1 Q:'$D(SEG(I)) S MSA=MSA_$S((MAX-$L(MSA))<1:"",1:$E(SEG(I),1,MAX))
56 I $D(MSA),HLCSTATE("MESSAGE ENDED") D Q 1
57 .D SPLITHDR^HLOSRVR1(.HDR)
58 .S HLCSTATE("COUNTS","ACKS")=$G(HLCSTATE("COUNTS","ACKS"))+1
59 Q 0
60 ;
61CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ;
62 ;sets up HLCSTATE() and opens a client connection
63 ;Input:
64 ; LINK - name of the link to connect to
65 ; PORT (optional) port # to connect to, defaults to that specified by the link
66 ; TIMEOUT (optional) specifies the open timeout in seconds, defaults to 30
67 ;Output:
68 ; HLCSTATE - array to hold the connection state
69 ;
70 I $G(HLCSTATE("CONNECTED")) D Q:HLCSTATE("CONNECTED")
71 .I $G(HLCSTATE("LINK","NAME"))]"",($G(HLCSTATE("LINK","NAME"))'=LINK) D CLOSE^HLOT(.HLCSTATE) Q
72 .I $G(HLCSTATE("LINK","NAME"))]"",$G(PORT),($G(HLCSTATE("LINK","PORT"))'=PORT) D CLOSE^HLOT(.HLCSTATE) Q
73 .I (HLCSTATE("SYSTEM","OS")="CACHE") D Q
74 ..U HLCSTATE("DEVICE") S HLCSTATE("CONNECTED")=($ZA\8192#2)
75 ..I 'HLCSTATE("CONNECTED") D CLOSE^HLOT(.HLCSTATE)
76 .;D CLOSE^HLOT(.HLCSTATE)
77 K HLCSTATE
78 N ARY,NODE
79 I '$$GETLINK^HLOTLNK(LINK,.ARY) S HLCSTATE("LINK","NAME")=LINK,HLCSTATE("LINK","PORT")=$G(PORT) D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
80 M HLCSTATE("LINK")=ARY
81 I HLCSTATE("LINK","SHUTDOWN") S HLCSTATE("CONNECTED")=0 D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
82 ;overlay the port if supplied from the queue
83 S:$G(PORT) HLCSTATE("LINK","PORT")=PORT
84 S HLCSTATE("READ TIMEOUT")=20
85 S HLCSTATE("OPEN TIMEOUT")=$S($G(TIMEOUT):TIMEOUT,1:30)
86 S HLCSTATE("COUNTS")=0
87 S HLCSTATE("READ")="" ;where the reads are stored
88 ;
89 ;HLCSTATE("BUFFER",<seg>,<line>) serves as a write buffer so that a lot can be written all at once
90 S HLCSTATE("BUFFER","BYTE COUNT")=0 ;count of BYTES in buffer
91 S HLCSTATE("BUFFER","SEGMENT COUNT")=0 ;count of segments in buffer
92 ;
93 S HLCSTATE("MESSAGE ENDED")=0 ;end of message flag
94 S NODE=^%ZOSF("OS")
95 S HLCSTATE("SERVER")=0
96 S HLCSTATE("SYSTEM","OS")=$S(NODE["DSM":"DSM",NODE["OpenM":"CACHE",NODE["G.TM":"G.TM",1:"")
97 I HLCSTATE("SYSTEM","OS")="" D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0
98 D
99 .N SYS
100 .D SYSPARMS^HLOSITE(.SYS)
101 .S HLCSTATE("SYSTEM","BUFFER")=SYS("HL7 BUFFER")
102 .S HLCSTATE("SYSTEM","MAXSTRING")=SYS("MAXSTRING")
103 .S HLCSTATE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
104 .S HLCSTATE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
105 I HLCSTATE("LINK","LLP")="TCP" D
106 .S HLCSTATE("OPEN")="OPEN^HLOTCP"
107 E ;no other LLP implemented
108 D OPEN^HLOT(.HLCSTATE)
109 ;
110 ;mark the failure time for the link so other processes know not to try for a while
111 I 'HLCSTATE("CONNECTED") D LINKDOWN^HLOCLNT(.HLCSTATE)
112 Q HLCSTATE("CONNECTED")
113 ;
114BADMSGS(WORK) ;
115 ;finds messages that won't transmit after 8 hours of trying and takes them off the outgoing queue
116 N LINK
117 S LINK=""
118 F S LINK=$O(^HLTMP("FAILING LINKS",LINK)) Q:LINK="" D
119 .N TIME,QUE,COUNT
120 .S TIME=$G(^HLTMP("FAILING LINKS",LINK)) Q:TIME=""
121 .Q:$$HDIFF^XLFDT($H,TIME,2)<28800 ;8 hours
122 .Q:'$$IFOPEN^HLOUSR1(LINK)
123 .L +^HLB("QUEUE","OUT",LINK):0
124 .S QUE=""
125 .F S QUE=$O(^HLB("QUEUE","OUT",LINK,QUE)) Q:QUE="" D
126 ..N MSG S MSG=0
127 ..S MSG=$O(^HLB("QUEUE","OUT",LINK,QUE,MSG))
128 ..Q:'MSG
129 ..S COUNT=$G(^HLB(MSG,"TRIES"))
130 ..I COUNT>20 D
131 ...N NODE0,NODE1,NODE2,TIME,RAPP,SAPP,FS,CS,ACTION,MTYPE,EVENT
132 ...S NODE0=$G(^HLB(MSG,0))
133 ...Q:'$P(NODE0,"^",2)
134 ...S TIME=$$NOW^XLFDT
135 ...S NODE1=$G(^HLB(MSG,1))
136 ...S NODE2=$G(^HLB(MSG,2))
137 ...S FS=$E(NODE1,4)
138 ...Q:FS=""
139 ...S CS=$E(NODE1,5)
140 ...Q:CS=""
141 ...S SAPP=$P(NODE1,FS,3)
142 ...S:SAPP="" SAPP="UNKNOWN"
143 ...S RAPP=$P(NODE1,FS,5)
144 ...S MTYPE=$P($P(NODE2,FS,4),CS)
145 ...S EVENT=$P($P(NODE2,FS,4),CS,2)
146 ...S $P(^HLB(MSG,0),"^",21)=COUNT_" FAILED TRANSMISSIONS"
147 ...S $P(^HLB(MSG,0),"^",20)="TF"
148 ...S ^HLB("ERRORS","TF",SAPP,TIME,MSG)=""
149 ...D COUNT^HLOESTAT("OUT",RAPP,SAPP,MTYPE,EVENT)
150 ...S ACTION=$P(NODE0,"^",14,15)
151 ...I ACTION'="^",ACTION]"" D INQUE^HLOQUE(LINK,QUE,MSG,ACTION,1)
152 ...D DEQUE^HLOQUE(LINK,QUE,"OUT",MSG)
153 .L -^HLB("QUEUE","OUT",LINK)
154 Q
Note: See TracBrowser for help on using the repository browser.