Index: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m	(revision 623)
@@ -1,220 +1,91 @@
-HLOQUE	;ALB/CJM- HL7 QUEUE MANAGEMENT - 10/4/94 1pm ;07/31/2007
-	;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137**;Oct 13, 1995;Build 21
-	;Per VHA Directive 2004-038, this routine should not be modified.
-	;
-INQUE(FROM,QNAME,IEN778,ACTION,PURGE)	;
-	;Will place the message=IEN778 on the IN queue, incoming
-	;Input:
-	;  FROM - sending facility from message header.
-	;         For actions other than incoming messages, its the specified link.
-	;  QNAME - queue named by the application
-	;  IEN778 = ien of the message in file 778
-	;  ACTION - <tag^routine> that should be executed for the application
-	;  PURGE (optional) - PURGE=1 indicates that the purge dt/tm needs to be set by the infiler
-	;     If PURGE("ACKTOIEN") is set, it indicates that the purge dt/tm of
-	;     the original message to this application ack also needs to be set.
-	;Output: none
-	;
-	I $G(FROM)="" S FROM="UNKNOWN"
-	I '$L($G(QNAME)) S QNAME="DEFAULT"
-	S ^HLB("QUEUE","IN",FROM,QNAME,IEN778)=ACTION_"^"_$G(PURGE)_"^"_$G(PURGE("ACKTOIEN"))
-	I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","IN",FROM,QNAME)))
-	Q
-	;
-OUTQUE(LINKNAME,PORT,QNAME,IEN778)	;
-	;Will place the message=IEN778 on the out-going queue
-	;Input:
-	;  LINKNAME = name of (.01) the logical link
-	;  PORT (optional) the port to connect to
-	;  QNAME - queue named by the application
-	;  IEN778 = ien of the message in file 778
-	;Output: none
-	;
-	N SUB
-	S SUB=LINKNAME
-	I PORT S SUB=SUB_":"_PORT
-	I '$L($G(QNAME)) S QNAME="DEFAULT"
-	S ^HLB("QUEUE","OUT",SUB,QNAME,IEN778)=""
-	I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","OUT",SUB,QNAME)))
-	Q
-	;
-DEQUE(FROMORTO,QNAME,DIR,IEN778)	;
-	;This routine will remove the message=IEN778 from its queue
-	;Input:
-	;  DIR = "IN" or "OUT", denoting the direction that the message is going in
-	;  FROMORTO = for outgoing: the .01 field of the logical link
-	;         for incoming: sending facility
-	;  IEN778 = ien of the message in file 778
-	;Output: none
-	;
-	Q:(FROMORTO="")
-	I ($G(QNAME)="") S QNAME="DEFAULT"
-	D
-	.I $E(DIR)="I" S DIR="IN" Q
-	.I $E(DIR)="O" S DIR="OUT" Q
-	I DIR'="IN",DIR'="OUT" Q
-	Q:'$G(IEN778)
-	D:$D(^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778))
-	.K ^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778)
-	.;don't let the count become negative
-	.I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)))
-	Q
-	;
-STOPQUE(DIR,QUEUE)	;
-	;This API is used to set a stop flag on a named queue.
-	;DIR=<"IN" or "OUT">
-	;QUEUE - the name of the queue to be stopped
-	;
-	Q:$G(DIR)=""
-	Q:$G(QUEUE)=""
-	S ^HLTMP("STOPPED QUEUES",DIR,QUEUE)=1
-	Q
-STARTQUE(DIR,QUEUE)	;
-	;This API is used to REMOVE the stop flag on a named queue.
-	;DIR=<"IN" or "OUT">
-	;QUEUE - the name of the queue to be stopped
-	;
-	Q:$G(DIR)=""
-	Q:$G(QUEUE)=""
-	K ^HLTMP("STOPPED QUEUES",DIR,QUEUE)
-	Q
-STOPPED(DIR,QUEUE)	;
-	;This API is used to DETERMINE if the stop flag on a named queue is set.
-	;Input:
-	;  DIR=<"IN" or "OUT">
-	;  QUEUE - the name of the queue to be checked
-	;Output:
-	;  Function returns 1 if the queue is stopped, 0 otherwise
-	Q:$G(DIR)="" 0
-	Q:$G(QUEUE)="" 0
-	I $G(^HLTMP("STOPPED QUEUES",DIR,QUEUE)) Q 1
-	Q 0
-	;
-SQUE(SQUE,LINKNAME,PORT,QNAME,IEN778)	;
-	;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.
-	;Input:
-	;  SQUE - name of the sequencing queue
-	;  LINKNAME = name of (.01) the logical link
-	;  PORT (optional) the port to connect to
-	;  QNAME (optional) outgoing queue
-	;  IEN778 = ien of the message in file 778
-	;Output: 1 if placed on the outgoing queue, 0 if placed on the sequence queue
-	;
-	N NEXT,MOVED
-	S MOVED=0
-	;
-	;keep a count of messages pending on sequence queues for the HLO System Monitor
-	I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")))
-	;
-	L +^HLB("QUEUE","SEQUENCE",SQUE):200
-	;
-	S NEXT=+$G(^HLB("QUEUE","SEQUENCE",SQUE))
-	Q:NEXT=IEN778 0  ;already queued!
-	;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
-	I '$O(^HLB("QUEUE","SEQUENCE",SQUE,0)),'NEXT D
-	.S ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778 ;to mean something moved to outgoing but not yet transmitted
-	.L -^HLB("QUEUE","SEQUENCE",SQUE)
-	.D OUTQUE(.LINKNAME,.PORT,.QNAME,IEN778)
-	.S MOVED=1
-	E  D
-	.;Put the message on the sequence queue.
-	.S ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)=""
-	.L -^HLB("QUEUE","SEQUENCE",SQUE)
-	Q MOVED
-	;
-ADVANCE(SQUE,MSGIEN)	;
-	;Will move the specified sequencing queue to the next message. 
-	;Input:
-	;  SQUE - name of the sequencing queue
-	;  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.
-	;Output:
-	;  Function - 1 if advanced, 0 if not
-	;
-	N NODE,IEN778,LINKNAME,PORT,QNAME
-	Q:'$L($G(SQUE)) 0
-	Q:'$G(MSGIEN) 0
-	L +^HLB("QUEUE","SEQUENCE",SQUE):200
-	;
-	;do not advance if the queue wasn't pending the message=MSGIEN
-	I (MSGIEN'=$P($G(^HLB("QUEUE","SEQUENCE",SQUE)),"^")) L -^HLB("QUEUE","SEQUENCE",SQUE) Q 0
-	;
-	I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE"))) ;decrement the count of messages pending sequence queues
-	;
-	S IEN778=0
-	;look for the first message on the sequence que.  Make sure its valid, if not remove the invalid entry and keep looking.
-	F  S IEN778=$O(^HLB("QUEUE","SEQUENCE",SQUE,0)) Q:'IEN778  S NODE=$G(^HLB(IEN778,0)) Q:$L(NODE)  D
-	.;message does not exist! Remove from queue and try again.
-	.K ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)
-	.I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE"))) ;decrement the count of messages pending sequence queues
-	;
-	;IEN778 is the next pending msg on this sequence queue
-	I IEN778 D
-	.;
-	.;parse out info needed to move to outgoing queue
-	.S LINKNAME=$P(NODE,"^",5),PORT=$P(NODE,"^",8),QNAME=$P(NODE,"^",6)
-	.;
-	.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.
-	.K ^HLB("QUEUE","SEQUENCE",SQUE,IEN778) ;remove from sequence queue
-	.L -^HLB("QUEUE","SEQUENCE",SQUE)
-	.S $P(^HLB(IEN778,5),"^",2)=1
-	.D OUTQUE(.LINKNAME,$G(PORT),$G(QNAME),IEN778) ;move to outgoing queue
-	E  D
-	.K ^HLB("QUEUE","SEQUENCE",SQUE) ;this sequence queue is currently empty and not needed
-	.L -^HLB("QUEUE","SEQUENCE",SQUE)
-	Q 1
-	;
-SEQCHK(WORK)	;functions under the HLO Process Manager
-	;check sequence queues for timeout
-	N QUE,NOW
-	S NOW=$$NOW^XLFDT
-	S QUE=""
-	F  S QUE=$O(^HLB("QUEUE","SEQUENCE",QUE)) Q:QUE=""  D
-	.N NODE,MSGIEN,ACTION,NODE
-	.S NODE=$G(^HLB("QUEUE","SEQUENCE",QUE))
-	.Q:'$P(NODE,"^",2)
-	.Q:$P(NODE,"^",2)>NOW
-	.Q:$P(NODE,"^",3)
-	.L +^HLB("QUEUE","SEQUENCE",QUE):2
-	.;don't report if a lock wasn't obtained
-	.Q:'$T
-	.S NODE=$G(^HLB("QUEUE","SEQUENCE",QUE))
-	.I '$P(NODE,"^",2) L -^HLB("QUEUE","SEQUENCE",QUE) Q
-	.I ($P(NODE,"^",2)>NOW) L -^HLB("QUEUE","SEQUENCE",QUE) Q
-	.I $P(NODE,"^",3) L -^HLB("QUEUE","SEQUENCE",QUE) Q  ;exception already raised
-	.S MSGIEN=$P(NODE,"^")
-	.I 'MSGIEN L -^HLB("QUEUE","SEQUENCE",QUE) Q
-	.S ACTION=$$EXCEPT^HLOAPP($$GETSAP^HLOCLNT2(MSGIEN))
-	.S $P(^HLB(MSGIEN,5),"^",3)=1
-	.S $P(^HLB("QUEUE","SEQUENCE",QUE),"^",3)=1 ;indicates exception raised
-	.L -^HLB("QUEUE","SEQUENCE",QUE)
-	.D  ;call the application to take action
-	..N HLMSGIEN,MCODE,DUZ,QUE,NOW
-	..N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOQUE"
-	..S HLMSGIEN=MSGIEN
-	..S MCODE="D "_ACTION
-	..N MSGIEN,X
-	..D DUZ^XUP(.5)
-	..X MCODE
-	..;kill the apps variables
-	..D
-	...N ZTSK
-	...D KILL^XUSCLEAN
-	Q
-ERROR	;error trap for application context
-	S $ETRAP="D UNWIND^%ZTER"
-	D ^%ZTER
-	S $ECODE=",UAPPLICATION ERROR,"
-	;
-	;kill the apps variables
-	D
-	.N ZTSK,MSGIEN,QUEUE
-	.D KILL^XUSCLEAN
-	;
-	;release all the locks the app may have set, except Taskman lock
-	L:$D(ZTSK) ^%ZTSCH("TASK",ZTSK):1
-	L:'$D(ZTSK)
-	;reset HLO's lock
-	L +^HLTMP("HL7 RUNNING PROCESSES",$J):0
-	;return to processing the next message on the queue
-	D UNWIND^%ZTER
-	Q
+HLOQUE ;ALB/CJM- HL7 QUEUE MANAGEMENT - 10/4/94 1pm ;01/05/2007
+ ;;1.6;HEALTH LEVEL SEVEN;**126,132,134**;Oct 13, 1995;Build 30
+ ;Per VHA Directive 2004-038, this routine should not be modified.
+ ;
+INQUE(FROM,QNAME,IEN778,ACTION,PURGE) ;
+ ;Will place the message=IEN778 on the IN queue, incoming
+ ;Input:
+ ;  FROM - sending facility from message header.
+ ;         For actions other than incoming messages, its the specified link.
+ ;  QNAME - queue named by the application
+ ;  IEN778 = ien of the message in file 778
+ ;  ACTION - <tag^routine> that should be executed for the application
+ ;  PURGE (optional) - PURGE=1 indicates that the purge dt/tm needs to be set by the infiler
+ ;     If PURGE("ACKTOIEN") is set, it indicates that the purge dt/tm of
+ ;     the original message to this application ack also needs to be set.
+ ;Output: none
+ ;
+ I $G(FROM)="" S FROM="UNKNOWN"
+ I '$L($G(QNAME)) S QNAME="DEFAULT"
+ S ^HLB("QUEUE","IN",FROM,QNAME,IEN778)=ACTION_"^"_$G(PURGE)_"^"_$G(PURGE("ACKTOIEN"))
+ I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","IN",FROM,QNAME)))
+ Q
+ ;
+OUTQUE(LINKNAME,PORT,QNAME,IEN778) ;
+ ;Will place the message=IEN778 on the out-going queue
+ ;Input:
+ ;  LINKNAME = name of (.01) the logical link
+ ;  PORT (optional) the port to connect to
+ ;  QNAME - queue named by the application
+ ;  IEN778 = ien of the message in file 778
+ ;Output: none
+ ;
+ N SUB
+ S SUB=LINKNAME
+ I PORT S SUB=SUB_":"_PORT
+ I '$L($G(QNAME)) S QNAME="DEFAULT"
+ S ^HLB("QUEUE","OUT",SUB,QNAME,IEN778)=""
+ I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","OUT",SUB,QNAME)))
+ Q
+ ;
+DEQUE(FROMORTO,QNAME,DIR,IEN778) ;
+ ;This routine will remove the message=IEN778 from its queue
+ ;Input:
+ ;  DIR = "IN" or "OUT", denoting the direction that the message is going in
+ ;  FROMORTO = for outgoing: the .01 field of the logical link
+ ;         for incoming: sending facility
+ ;  IEN778 = ien of the message in file 778
+ ;Output: none
+ ;
+ Q:(FROMORTO="")
+ I ($G(QNAME)="") S QNAME="DEFAULT"
+ D
+ .I $E(DIR)="I" S DIR="IN" Q
+ .I $E(DIR)="O" S DIR="OUT" Q
+ I DIR'="IN",DIR'="OUT" Q
+ Q:'$G(IEN778)
+ D:$D(^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778))
+ .K ^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778)
+ .;don't let the count become negative
+ .I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)))
+ Q
+ ;
+STOPQUE(DIR,QUEUE) ;
+ ;This API is used to set a stop flag on a named queue.
+ ;DIR=<"IN" or "OUT">
+ ;QUEUE - the name of the queue to be stopped
+ ;
+ Q:$G(DIR)=""
+ Q:$G(QUEUE)=""
+ S ^HLTMP("STOPPED QUEUES",DIR,QUEUE)=1
+ Q
+STARTQUE(DIR,QUEUE) ;
+ ;This API is used to REMOVE the stop flag on a named queue.
+ ;DIR=<"IN" or "OUT">
+ ;QUEUE - the name of the queue to be stopped
+ ;
+ Q:$G(DIR)=""
+ Q:$G(QUEUE)=""
+ K ^HLTMP("STOPPED QUEUES",DIR,QUEUE)
+ Q
+STOPPED(DIR,QUEUE) ;
+ ;This API is used to DETERMINE if the stop flag on a named queue is set.
+ ;Input:
+ ;  DIR=<"IN" or "OUT">
+ ;  QUEUE - the name of the queue to be checked
+ ;Output:
+ ;  Function returns 1 if the queue is stopped, 0 otherwise
+ Q:$G(DIR)="" 0
+ Q:$G(QUEUE)="" 0
+ I $G(^HLTMP("STOPPED QUEUES",DIR,QUEUE)) Q 1
+ Q 0
