- 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
