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
