HLCSQUE1 ;ALB/MFK HL7 UTILITY FUNCTIONS - 10/4/94 11AM ;02/17/2011
;;1.6;HEALTH LEVEL SEVEN;**14,59,100,153**;Oct 13, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
;
;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
.;P153 Start PIJ
.;I $P($G(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D" D QUIT:STOP ;->
.I $P($G(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D",$P($G(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="U" D QUIT:STOP ;->
..;P153 End PIJ
..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...
..Q:$P($G(^HLCS(870,IEN,HLDIR,+HLX,0)),U,2)="U" ;-> All OK...
..S STOP=1
.S STOP=$$DELMSG(IEN,HLDIR,MSG)
K IEN,HLDIR,FRONT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSQUE1 2226 printed Dec 13, 2024@01:56:51 Page 2
HLCSQUE1 ;ALB/MFK HL7 UTILITY FUNCTIONS - 10/4/94 11AM ;02/17/2011
+1 ;;1.6;HEALTH LEVEL SEVEN;**14,59,100,153**;Oct 13, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;Utilities used by HLCSQUE
+5 ;
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 ;P153 Start PIJ
+15 ;I $P($G(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D" D QUIT:STOP ;->
+16 ;->
IF $PIECE($GET(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="D"
IF $PIECE($GET(^HLCS(870,IEN,HLDIR,MSG,0)),"^",2)'="U"
Begin DoDot:2
+17 ;P153 End PIJ
+18 ;->
IF $DATA(^HLCS(870,IEN,HLDIR,MSG))
Begin DoDot:3
+19 ;->
SET HLX=$ORDER(^HLCS(870,IEN,HLDIR,MSG))
if HLX>0
QUIT
+20 SET STOP=1
End DoDot:3
if STOP
QUIT
+21 SET HLX=+$GET(HLX)
+22 ;->
IF '$DATA(^HLCS(870,IEN,HLDIR,+HLX,0))
SET STOP=1
QUIT
+23 ;-> All OK...
if $PIECE($GET(^HLCS(870,IEN,HLDIR,+HLX,0)),U,2)="D"
QUIT
+24 ;-> All OK...
if $PIECE($GET(^HLCS(870,IEN,HLDIR,+HLX,0)),U,2)="U"
QUIT
+25 SET STOP=1
End DoDot:2
if STOP
QUIT
+26 SET STOP=$$DELMSG(IEN,HLDIR,MSG)
End DoDot:1
+27 KILL IEN,HLDIR,FRONT
+28 QUIT
