Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m
r613 r623 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 1 HLOQUE ;ALB/CJM- HL7 QUEUE MANAGEMENT - 10/4/94 1pm ;01/05/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134**;Oct 13, 1995;Build 30 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
Note:
See TracChangeset
for help on using the changeset viewer.
