[613] | 1 | HLOQUE ;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 | ;
|
---|
| 5 | INQUE(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 | ;
|
---|
| 24 | OUTQUE(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 | ;
|
---|
| 41 | DEQUE(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 | ;
|
---|
| 63 | STOPQUE(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
|
---|
| 72 | STARTQUE(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
|
---|
| 81 | STOPPED(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 | ;
|
---|
| 93 | SQUE(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 | ;
|
---|
| 125 | ADVANCE(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 | ;
|
---|
| 166 | SEQCHK(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
|
---|
| 203 | ERROR ;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
|
---|