| [613] | 1 | HLCSQUE1 ;ALB/MFK HL7 UTILITY FUNCTIONS - 10/4/94 11AM ;05/08/2000 11:22
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**14,59,100**;Oct 13, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ;Utilities used by HLCSQUE
|
|---|
| 5 | ;
|
|---|
| 6 | DELMSG(IEN,HLDIR,MSG) ;DELETE A SINGLE MESSAGE FROM A QUEUE
|
|---|
| 7 | ;INPUT: IEN - Internal Entry Number for queue
|
|---|
| 8 | ; HLDIR - Direction of queue
|
|---|
| 9 | ; MSG - Message number to remove
|
|---|
| 10 | ;OUTPUT: 0 - Success
|
|---|
| 11 | ; -1 - Error
|
|---|
| 12 | N DIK,DA
|
|---|
| 13 | ; Check for required variables
|
|---|
| 14 | S IEN=$G(IEN)
|
|---|
| 15 | Q:(IEN="") "-1^Internal Entry Number missing"
|
|---|
| 16 | I +IEN<1 S IEN=$O(^HLCS(870,"B",IEN,""))
|
|---|
| 17 | Q:(IEN="") "-1^Invalid IEN"
|
|---|
| 18 | S HLDIR=$G(HLDIR)
|
|---|
| 19 | S HLDIR=$S(HLDIR="IN":1,HLDIR="OUT":2,HLDIR=2:2,HLDIR=1:1,1:"")
|
|---|
| 20 | Q:(HLDIR="") "-1^Invalid direction"
|
|---|
| 21 | S MSG=$G(MSG)
|
|---|
| 22 | Q:(MSG="") "-1^No message number"
|
|---|
| 23 | L +^HLCS(870,IEN,HLDIR,MSG):1
|
|---|
| 24 | ;If lock fails, another process is doing the work.
|
|---|
| 25 | I '$T Q 1
|
|---|
| 26 | S DIK="^HLCS(870,"_IEN_","_HLDIR_",",DA(1)=IEN,DA=MSG
|
|---|
| 27 | D ^DIK
|
|---|
| 28 | L -^HLCS(870,IEN,HLDIR,MSG)
|
|---|
| 29 | K IEN,HLDIR,MSG
|
|---|
| 30 | Q 0
|
|---|
| 31 | DELETE(IEN,HLDIR,FRONT) ; Delete messages outside the 'queue size' window
|
|---|
| 32 | N MSG,TMP,QSIZE,STOP,HLX
|
|---|
| 33 | ; Make sure required variables exist
|
|---|
| 34 | S IEN=$G(IEN) Q:(IEN="")
|
|---|
| 35 | S HLDIR=$G(HLDIR) Q:(HLDIR="")
|
|---|
| 36 | S FRONT=$G(FRONT) Q:(FRONT="")
|
|---|
| 37 | S TMP=^HLCS(870,IEN,0)
|
|---|
| 38 | S QSIZE=$P(TMP,"^",21)
|
|---|
| 39 | I FRONT'>0 Q
|
|---|
| 40 | I QSIZE'>0 S QSIZE=10
|
|---|
| 41 | S MSG=0,STOP=0
|
|---|
| 42 | ; For each message from the beginning of the queue to the front
|
|---|
| 43 | ; of the queue-queue size, delete that message if it's done
|
|---|
| 44 | F S MSG=$O(^HLCS(870,IEN,HLDIR,MSG)) Q:(MSG>(FRONT-QSIZE))!(STOP'=0)!(MSG'>0) D
|
|---|
| 45 | .I $P($G(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D" D QUIT:STOP ;->
|
|---|
| 46 | ..I $D(^HLCS(870,IEN,HLDIR,MSG)) D QUIT:STOP ;->
|
|---|
| 47 | ...S HLX=$O(^HLCS(870,IEN,HLDIR,MSG)) QUIT:HLX>0 ;->
|
|---|
| 48 | ...S STOP=1
|
|---|
| 49 | ..S HLX=+$G(HLX)
|
|---|
| 50 | ..I '$D(^HLCS(870,IEN,HLDIR,+HLX,0)) S STOP=1 QUIT ;->
|
|---|
| 51 | ..Q:$P($G(^HLCS(870,IEN,HLDIR,+HLX,0)),U,2)="D" ;-> All OK...
|
|---|
| 52 | ..S STOP=1
|
|---|
| 53 | .S STOP=$$DELMSG(IEN,HLDIR,MSG)
|
|---|
| 54 | K IEN,HLDIR,FRONT
|
|---|
| 55 | Q
|
|---|
