Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• HEALTH_LEVEL_SEVEN-HL/HLOQUE.m (modified) (2 diffs)

FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLOQUE.m

@@ -1 @@
-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
+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.
  ;
@@ -90 +90 @@
  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