HLCSREP ;ALB/MFK - HL7 QUEUE MANAGEMENT ;10/17/2007 08:56
;;1.6;HEALTH LEVEL SEVEN;**109,122**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
REPMSG ;Duplicate messages on a queue
; INPUT: MSG - Array which contains the queue and the
; message numbers for msgs to be re-queued
; MSG(QUEUE,NUMBER)
; OUTPUT: NONE
N DIC,LLE,X,Y,DA,ERROR,FROMID,MSGID
N TOID,ENTRY,LLE
Q:('$D(MSG))
; create new entries
S (LLE,ERROR)=""
F S LLE=$O(MSG(LLE)) Q:(LLE="")!(ERROR) D
.S ENTRY=""
.F S ENTRY=$O(MSG(LLE,ENTRY)) Q:(ENTRY="")!(ERROR) D
..S MSGID=$$ENQUEUE^HLCSQUE(LLE,"OUT")
..I +MSGID'>0 S ERROR=1 Q
..S TOID=$P(MSGID,"^",2)
..M ^HLCS(870,LLE,2,TOID)=^HLCS(870,LLE,2,ENTRY)
..; Change .01 of new record to be IEN
..S $P(^HLCS(870,LLE,2,TOID,0),"^",1)=TOID
..S $P(^HLCS(870,LLE,2,TOID,0),"^",2)="P"
EXIT ;
Q
;
ENQUE(LINK,DIR,IEN773) ;
;This routine will place the message=IEN773 on the "AC" xref of file 773.
;Input:
; DIR = "I" or "O", denoting the direction that the message is going in
; LINK = the ien of the logical link
; IEN773 = ien of the message in file 773
;
Q:'$G(LINK)
I DIR'="I",DIR'="O" Q
Q:'$G(IEN773)
;
; patch HL*1.6*122: MPI-client/server
F L +^HLMA("AC",DIR,LINK,IEN773):10 Q:$T H 1
S ^HLMA("AC",DIR,LINK,IEN773)=""
L -^HLMA("AC",DIR,LINK,IEN773)
;
S $P(^HLMA(+IEN773,0),U,17)=+LINK ; HL*1.6*109 - lja
I DIR="O" D LLCNT^HLCSTCP(LINK,3)
Q
;
DEQUE(LINK,DIR,IEN773) ;
;This routine will remove the message=IEN773 on the "AC" xref of file 773.
;Input:
; DIR = "I" or "O", denoting the direction that the message is going in
; LINK = the ien of the logical link
; IEN773 = ien of the message in file 773
;
Q:'$G(LINK)
I DIR'="I",DIR'="O" Q
Q:'$G(IEN773)
;
; patch HL*1.6*122: MPI-client/server
F L +^HLMA("AC",DIR,LINK,IEN773):10 Q:$T H 1
K ^HLMA("AC",DIR,LINK,IEN773)
L -^HLMA("AC",DIR,LINK,IEN773)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSREP 2024 printed Oct 16, 2024@17:57:42 Page 2
HLCSREP ;ALB/MFK - HL7 QUEUE MANAGEMENT ;10/17/2007 08:56
+1 ;;1.6;HEALTH LEVEL SEVEN;**109,122**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
REPMSG ;Duplicate messages on a queue
+1 ; INPUT: MSG - Array which contains the queue and the
+2 ; message numbers for msgs to be re-queued
+3 ; MSG(QUEUE,NUMBER)
+4 ; OUTPUT: NONE
+5 NEW DIC,LLE,X,Y,DA,ERROR,FROMID,MSGID
+6 NEW TOID,ENTRY,LLE
+7 if ('$DATA(MSG))
QUIT
+8 ; create new entries
+9 SET (LLE,ERROR)=""
+10 FOR
SET LLE=$ORDER(MSG(LLE))
if (LLE="")!(ERROR)
QUIT
Begin DoDot:1
+11 SET ENTRY=""
+12 FOR
SET ENTRY=$ORDER(MSG(LLE,ENTRY))
if (ENTRY="")!(ERROR)
QUIT
Begin DoDot:2
+13 SET MSGID=$$ENQUEUE^HLCSQUE(LLE,"OUT")
+14 IF +MSGID'>0
SET ERROR=1
QUIT
+15 SET TOID=$PIECE(MSGID,"^",2)
+16 MERGE ^HLCS(870,LLE,2,TOID)=^HLCS(870,LLE,2,ENTRY)
+17 ; Change .01 of new record to be IEN
+18 SET $PIECE(^HLCS(870,LLE,2,TOID,0),"^",1)=TOID
+19 SET $PIECE(^HLCS(870,LLE,2,TOID,0),"^",2)="P"
End DoDot:2
End DoDot:1
EXIT ;
+1 QUIT
+2 ;
ENQUE(LINK,DIR,IEN773) ;
+1 ;This routine will place the message=IEN773 on the "AC" xref of file 773.
+2 ;Input:
+3 ; DIR = "I" or "O", denoting the direction that the message is going in
+4 ; LINK = the ien of the logical link
+5 ; IEN773 = ien of the message in file 773
+6 ;
+7 if '$GET(LINK)
QUIT
+8 IF DIR'="I"
IF DIR'="O"
QUIT
+9 if '$GET(IEN773)
QUIT
+10 ;
+11 ; patch HL*1.6*122: MPI-client/server
+12 FOR
LOCK +^HLMA("AC",DIR,LINK,IEN773):10
if $TEST
QUIT
HANG 1
+13 SET ^HLMA("AC",DIR,LINK,IEN773)=""
+14 LOCK -^HLMA("AC",DIR,LINK,IEN773)
+15 ;
+16 ; HL*1.6*109 - lja
SET $PIECE(^HLMA(+IEN773,0),U,17)=+LINK
+17 IF DIR="O"
DO LLCNT^HLCSTCP(LINK,3)
+18 QUIT
+19 ;
DEQUE(LINK,DIR,IEN773) ;
+1 ;This routine will remove the message=IEN773 on the "AC" xref of file 773.
+2 ;Input:
+3 ; DIR = "I" or "O", denoting the direction that the message is going in
+4 ; LINK = the ien of the logical link
+5 ; IEN773 = ien of the message in file 773
+6 ;
+7 if '$GET(LINK)
QUIT
+8 IF DIR'="I"
IF DIR'="O"
QUIT
+9 if '$GET(IEN773)
QUIT
+10 ;
+11 ; patch HL*1.6*122: MPI-client/server
+12 FOR
LOCK +^HLMA("AC",DIR,LINK,IEN773):10
if $TEST
QUIT
HANG 1
+13 KILL ^HLMA("AC",DIR,LINK,IEN773)
+14 LOCK -^HLMA("AC",DIR,LINK,IEN773)
+15 ;
+16 QUIT
