source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m@ 1713

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1HLOQUE ;ALB/CJM- HL7 QUEUE MANAGEMENT - 10/4/94 1pm ;07/31/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137**;Oct 13, 1995;Build 21
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5INQUE(FROM,QNAME,IEN778,ACTION,PURGE) ;
6 ;Will place the message=IEN778 on the IN queue, incoming
7 ;Input:
8 ; FROM - sending facility from message header.
9 ; For actions other than incoming messages, its the specified link.
10 ; QNAME - queue named by the application
11 ; IEN778 = ien of the message in file 778
12 ; ACTION - <tag^routine> that should be executed for the application
13 ; PURGE (optional) - PURGE=1 indicates that the purge dt/tm needs to be set by the infiler
14 ; If PURGE("ACKTOIEN") is set, it indicates that the purge dt/tm of
15 ; the original message to this application ack also needs to be set.
16 ;Output: none
17 ;
18 I $G(FROM)="" S FROM="UNKNOWN"
19 I '$L($G(QNAME)) S QNAME="DEFAULT"
20 S ^HLB("QUEUE","IN",FROM,QNAME,IEN778)=ACTION_"^"_$G(PURGE)_"^"_$G(PURGE("ACKTOIEN"))
21 I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","IN",FROM,QNAME)))
22 Q
23 ;
24OUTQUE(LINKNAME,PORT,QNAME,IEN778) ;
25 ;Will place the message=IEN778 on the out-going queue
26 ;Input:
27 ; LINKNAME = name of (.01) the logical link
28 ; PORT (optional) the port to connect to
29 ; QNAME - queue named by the application
30 ; IEN778 = ien of the message in file 778
31 ;Output: none
32 ;
33 N SUB
34 S SUB=LINKNAME
35 I PORT S SUB=SUB_":"_PORT
36 I '$L($G(QNAME)) S QNAME="DEFAULT"
37 S ^HLB("QUEUE","OUT",SUB,QNAME,IEN778)=""
38 I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","OUT",SUB,QNAME)))
39 Q
40 ;
41DEQUE(FROMORTO,QNAME,DIR,IEN778) ;
42 ;This routine will remove the message=IEN778 from its queue
43 ;Input:
44 ; DIR = "IN" or "OUT", denoting the direction that the message is going in
45 ; FROMORTO = for outgoing: the .01 field of the logical link
46 ; for incoming: sending facility
47 ; IEN778 = ien of the message in file 778
48 ;Output: none
49 ;
50 Q:(FROMORTO="")
51 I ($G(QNAME)="") S QNAME="DEFAULT"
52 D
53 .I $E(DIR)="I" S DIR="IN" Q
54 .I $E(DIR)="O" S DIR="OUT" Q
55 I DIR'="IN",DIR'="OUT" Q
56 Q:'$G(IEN778)
57 D:$D(^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778))
58 .K ^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778)
59 .;don't let the count become negative
60 .I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)))
61 Q
62 ;
63STOPQUE(DIR,QUEUE) ;
64 ;This API is used to set a stop flag on a named queue.
65 ;DIR=<"IN" or "OUT">
66 ;QUEUE - the name of the queue to be stopped
67 ;
68 Q:$G(DIR)=""
69 Q:$G(QUEUE)=""
70 S ^HLTMP("STOPPED QUEUES",DIR,QUEUE)=1
71 Q
72STARTQUE(DIR,QUEUE) ;
73 ;This API is used to REMOVE the stop flag on a named queue.
74 ;DIR=<"IN" or "OUT">
75 ;QUEUE - the name of the queue to be stopped
76 ;
77 Q:$G(DIR)=""
78 Q:$G(QUEUE)=""
79 K ^HLTMP("STOPPED QUEUES",DIR,QUEUE)
80 Q
81STOPPED(DIR,QUEUE) ;
82 ;This API is used to DETERMINE if the stop flag on a named queue is set.
83 ;Input:
84 ; DIR=<"IN" or "OUT">
85 ; QUEUE - the name of the queue to be checked
86 ;Output:
87 ; Function returns 1 if the queue is stopped, 0 otherwise
88 Q:$G(DIR)="" 0
89 Q:$G(QUEUE)="" 0
90 I $G(^HLTMP("STOPPED QUEUES",DIR,QUEUE)) Q 1
91 Q 0
92 ;
93SQUE(SQUE,LINKNAME,PORT,QNAME,IEN778) ;
94 ;Will place the message=IEN778 on the sequencing queue. This is always done in the context of the application calling an HLO API to send a message.
95 ;Input:
96 ; SQUE - name of the sequencing queue
97 ; LINKNAME = name of (.01) the logical link
98 ; PORT (optional) the port to connect to
99 ; QNAME (optional) outgoing queue
100 ; IEN778 = ien of the message in file 778
101 ;Output: 1 if placed on the outgoing queue, 0 if placed on the sequence queue
102 ;
103 N NEXT,MOVED
104 S MOVED=0
105 ;
106 ;keep a count of messages pending on sequence queues for the HLO System Monitor
107 I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")))
108 ;
109 L +^HLB("QUEUE","SEQUENCE",SQUE):200
110 ;
111 S NEXT=+$G(^HLB("QUEUE","SEQUENCE",SQUE))
112 Q:NEXT=IEN778 0 ;already queued!
113 ;if the sequence queue is empty and not waiting on a message, then the message can be put directly on the outgoing queue, bypassing the sequence queue
114 I '$O(^HLB("QUEUE","SEQUENCE",SQUE,0)),'NEXT D
115 .S ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778 ;to mean something moved to outgoing but not yet transmitted
116 .L -^HLB("QUEUE","SEQUENCE",SQUE)
117 .D OUTQUE(.LINKNAME,.PORT,.QNAME,IEN778)
118 .S MOVED=1
119 E D
120 .;Put the message on the sequence queue.
121 .S ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)=""
122 .L -^HLB("QUEUE","SEQUENCE",SQUE)
123 Q MOVED
124 ;
125ADVANCE(SQUE,MSGIEN) ;
126 ;Will move the specified sequencing queue to the next message.
127 ;Input:
128 ; SQUE - name of the sequencing queue
129 ; MSGIEN - the ien of the message upon which the sequence queue was waiting. If it is NOT the correct ien, then the sequence queue will NOT be advance.
130 ;Output:
131 ; Function - 1 if advanced, 0 if not
132 ;
133 N NODE,IEN778,LINKNAME,PORT,QNAME
134 Q:'$L($G(SQUE)) 0
135 Q:'$G(MSGIEN) 0
136 L +^HLB("QUEUE","SEQUENCE",SQUE):200
137 ;
138 ;do not advance if the queue wasn't pending the message=MSGIEN
139 I (MSGIEN'=$P($G(^HLB("QUEUE","SEQUENCE",SQUE)),"^")) L -^HLB("QUEUE","SEQUENCE",SQUE) Q 0
140 ;
141 I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE"))) ;decrement the count of messages pending sequence queues
142 ;
143 S IEN778=0
144 ;look for the first message on the sequence que. Make sure its valid, if not remove the invalid entry and keep looking.
145 F S IEN778=$O(^HLB("QUEUE","SEQUENCE",SQUE,0)) Q:'IEN778 S NODE=$G(^HLB(IEN778,0)) Q:$L(NODE) D
146 .;message does not exist! Remove from queue and try again.
147 .K ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)
148 .I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE"))) ;decrement the count of messages pending sequence queues
149 ;
150 ;IEN778 is the next pending msg on this sequence queue
151 I IEN778 D
152 .;
153 .;parse out info needed to move to outgoing queue
154 .S LINKNAME=$P(NODE,"^",5),PORT=$P(NODE,"^",8),QNAME=$P(NODE,"^",6)
155 .;
156 .S ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778 ;indicates this sequence queue is now waiting for msg=IEN778 before advancing. The second pieces is the timer, but will not be set until the message=IEN778 is actually transmitted.
157 .K ^HLB("QUEUE","SEQUENCE",SQUE,IEN778) ;remove from sequence queue
158 .L -^HLB("QUEUE","SEQUENCE",SQUE)
159 .S $P(^HLB(IEN778,5),"^",2)=1
160 .D OUTQUE(.LINKNAME,$G(PORT),$G(QNAME),IEN778) ;move to outgoing queue
161 E D
162 .K ^HLB("QUEUE","SEQUENCE",SQUE) ;this sequence queue is currently empty and not needed
163 .L -^HLB("QUEUE","SEQUENCE",SQUE)
164 Q 1
165 ;
166SEQCHK(WORK) ;functions under the HLO Process Manager
167 ;check sequence queues for timeout
168 N QUE,NOW
169 S NOW=$$NOW^XLFDT
170 S QUE=""
171 F S QUE=$O(^HLB("QUEUE","SEQUENCE",QUE)) Q:QUE="" D
172 .N NODE,MSGIEN,ACTION,NODE
173 .S NODE=$G(^HLB("QUEUE","SEQUENCE",QUE))
174 .Q:'$P(NODE,"^",2)
175 .Q:$P(NODE,"^",2)>NOW
176 .Q:$P(NODE,"^",3)
177 .L +^HLB("QUEUE","SEQUENCE",QUE):2
178 .;don't report if a lock wasn't obtained
179 .Q:'$T
180 .S NODE=$G(^HLB("QUEUE","SEQUENCE",QUE))
181 .I '$P(NODE,"^",2) L -^HLB("QUEUE","SEQUENCE",QUE) Q
182 .I ($P(NODE,"^",2)>NOW) L -^HLB("QUEUE","SEQUENCE",QUE) Q
183 .I $P(NODE,"^",3) L -^HLB("QUEUE","SEQUENCE",QUE) Q ;exception already raised
184 .S MSGIEN=$P(NODE,"^")
185 .I 'MSGIEN L -^HLB("QUEUE","SEQUENCE",QUE) Q
186 .S ACTION=$$EXCEPT^HLOAPP($$GETSAP^HLOCLNT2(MSGIEN))
187 .S $P(^HLB(MSGIEN,5),"^",3)=1
188 .S $P(^HLB("QUEUE","SEQUENCE",QUE),"^",3)=1 ;indicates exception raised
189 .L -^HLB("QUEUE","SEQUENCE",QUE)
190 .D ;call the application to take action
191 ..N HLMSGIEN,MCODE,DUZ,QUE,NOW
192 ..N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOQUE"
193 ..S HLMSGIEN=MSGIEN
194 ..S MCODE="D "_ACTION
195 ..N MSGIEN,X
196 ..D DUZ^XUP(.5)
197 ..X MCODE
198 ..;kill the apps variables
199 ..D
200 ...N ZTSK
201 ...D KILL^XUSCLEAN
202 Q
203ERROR ;error trap for application context
204 S $ETRAP="D UNWIND^%ZTER"
205 D ^%ZTER
206 S $ECODE=",UAPPLICATION ERROR,"
207 ;
208 ;kill the apps variables
209 D
210 .N ZTSK,MSGIEN,QUEUE
211 .D KILL^XUSCLEAN
212 ;
213 ;release all the locks the app may have set, except Taskman lock
214 L:$D(ZTSK) ^%ZTSCH("TASK",ZTSK):1
215 L:'$D(ZTSK)
216 ;reset HLO's lock
217 L +^HLTMP("HL7 RUNNING PROCESSES",$J):0
218 ;return to processing the next message on the queue
219 D UNWIND^%ZTER
220 Q
Note: See TracBrowser for help on using the repository browser.