HLCSQUE1 ;ALB/MFK HL7 UTILITY FUNCTIONS - 10/4/94 11AM ;05/08/2000 11:22 [ 12/23/2003 3:46 PM ]
;;1.6;HEALTH LEVEL SEVEN;**14,59,100,1005**;Oct 13, 1995
;
;Utilities used by HLCSQUE
;
DELMSG(IEN,HLDIR,MSG) ;DELETE A SINGLE MESSAGE FROM A QUEUE
;INPUT: IEN - Internal Entry Number for queue
; HLDIR - Direction of queue
; MSG - Message number to remove
;OUTPUT: 0 - Success
; -1 - Error
N DIK,DA
; Check for required variables
S IEN=$G(IEN)
Q:(IEN="") "-1^Internal Entry Number missing"
I +IEN<1 S IEN=$O(^HLCS(870,"B",IEN,""))
Q:(IEN="") "-1^Invalid IEN"
S HLDIR=$G(HLDIR)
S HLDIR=$S(HLDIR="IN":1,HLDIR="OUT":2,HLDIR=2:2,HLDIR=1:1,1:"")
Q:(HLDIR="") "-1^Invalid direction"
S MSG=$G(MSG)
Q:(MSG="") "-1^No message number"
L +^HLCS(870,IEN,HLDIR,MSG):1
;If lock fails, another process is doing the work.
I '$T Q 1
S DIK="^HLCS(870,"_IEN_","_HLDIR_",",DA(1)=IEN,DA=MSG
D ^DIK
L -^HLCS(870,IEN,HLDIR,MSG)
K IEN,HLDIR,MSG
Q 0
DELETE(IEN,HLDIR,FRONT) ; Delete messages outside the 'queue size' window
N MSG,TMP,QSIZE,STOP,HLX
; Make sure required variables exist
S IEN=$G(IEN) Q:(IEN="")
S HLDIR=$G(HLDIR) Q:(HLDIR="")
S FRONT=$G(FRONT) Q:(FRONT="")
S TMP=^HLCS(870,IEN,0)
S QSIZE=$P(TMP,"^",21)
I FRONT'>0 Q
I QSIZE'>0 S QSIZE=10
S MSG=0,STOP=0
; For each message from the beginning of the queue to the front
; of the queue-queue size, delete that message if it's done
F S MSG=$O(^HLCS(870,IEN,HLDIR,MSG)) Q:(MSG>(FRONT-QSIZE))!(STOP'=0)!(MSG'>0) D
.I $P($G(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D" D QUIT:STOP ;->
..I $D(^HLCS(870,IEN,HLDIR,MSG)) D QUIT:STOP ;->
...S HLX=$O(^HLCS(870,IEN,HLDIR,MSG)) QUIT:HLX>0 ;->
...S STOP=1
..S HLX=+$G(HLX)
..I '$D(^HLCS(870,IEN,HLDIR,+HLX,0)) S STOP=1 QUIT ;->
..Q:$P($G(^HLCS(870,IEN,HLDIR,+HLX,0)),U,2)="D" ;-> All OK...
..S STOP=1
.S STOP=$$DELMSG(IEN,HLDIR,MSG)
K IEN,HLDIR,FRONT
Q
HLCSQUE1 ;ALB/MFK HL7 UTILITY FUNCTIONS - 10/4/94 11AM ;05/08/2000 11:22 [ 12/23/2003 3:46 PM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**14,59,100,1005**;Oct 13, 1995
+2 ;
+3 ;Utilities used by HLCSQUE
+4 ;
DELMSG(IEN,HLDIR,MSG) ;DELETE A SINGLE MESSAGE FROM A QUEUE
+1 ;INPUT: IEN - Internal Entry Number for queue
+2 ; HLDIR - Direction of queue
+3 ; MSG - Message number to remove
+4 ;OUTPUT: 0 - Success
+5 ; -1 - Error
+6 NEW DIK,DA
+7 ; Check for required variables
+8 SET IEN=$GET(IEN)
+9 IF (IEN="")
QUIT "-1^Internal Entry Number missing"
+10 IF +IEN<1
SET IEN=$ORDER(^HLCS(870,"B",IEN,""))
+11 IF (IEN="")
QUIT "-1^Invalid IEN"
+12 SET HLDIR=$GET(HLDIR)
+13 SET HLDIR=$SELECT(HLDIR="IN":1,HLDIR="OUT":2,HLDIR=2:2,HLDIR=1:1,1:"")
+14 IF (HLDIR="")
QUIT "-1^Invalid direction"
+15 SET MSG=$GET(MSG)
+16 IF (MSG="")
QUIT "-1^No message number"
+17 LOCK +^HLCS(870,IEN,HLDIR,MSG):1
+18 ;If lock fails, another process is doing the work.
+19 IF '$TEST
QUIT 1
+20 SET DIK="^HLCS(870,"_IEN_","_HLDIR_","
SET DA(1)=IEN
SET DA=MSG
+21 DO ^DIK
+22 LOCK -^HLCS(870,IEN,HLDIR,MSG)
+23 KILL IEN,HLDIR,MSG
+24 QUIT 0
DELETE(IEN,HLDIR,FRONT) ; Delete messages outside the 'queue size' window
+1 NEW MSG,TMP,QSIZE,STOP,HLX
+2 ; Make sure required variables exist
+3 SET IEN=$GET(IEN)
IF (IEN="")
QUIT
+4 SET HLDIR=$GET(HLDIR)
IF (HLDIR="")
QUIT
+5 SET FRONT=$GET(FRONT)
IF (FRONT="")
QUIT
+6 SET TMP=^HLCS(870,IEN,0)
+7 SET QSIZE=$PIECE(TMP,"^",21)
+8 IF FRONT'>0
QUIT
+9 IF QSIZE'>0
SET QSIZE=10
+10 SET MSG=0
SET STOP=0
+11 ; For each message from the beginning of the queue to the front
+12 ; of the queue-queue size, delete that message if it's done
+13 FOR
SET MSG=$ORDER(^HLCS(870,IEN,HLDIR,MSG))
IF (MSG>(FRONT-QSIZE))!(STOP'=0)!(MSG'>0)
QUIT
Begin DoDot:1
+14 ;->
IF $PIECE($GET(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D"
Begin DoDot:2
+15 ;->
IF $DATA(^HLCS(870,IEN,HLDIR,MSG))
Begin DoDot:3
+16 ;->
SET HLX=$ORDER(^HLCS(870,IEN,HLDIR,MSG))
IF HLX>0
QUIT
+17 SET STOP=1
End DoDot:3
IF STOP
QUIT
+18 SET HLX=+$GET(HLX)
+19 ;->
IF '$DATA(^HLCS(870,IEN,HLDIR,+HLX,0))
SET STOP=1
QUIT
+20 ;-> All OK...
IF $PIECE($GET(^HLCS(870,IEN,HLDIR,+HLX,0)),U,2)="D"
QUIT
+21 SET STOP=1
End DoDot:2
IF STOP
QUIT
+22 SET STOP=$$DELMSG(IEN,HLDIR,MSG)
End DoDot:1
+23 KILL IEN,HLDIR,FRONT
+24 QUIT
