HLOQUE ;ALB/CJM/OAK/PIJ/RBN- HL7 QUEUE MANAGEMENT - 10/4/94 1pm ;03/07/2012
;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,138,143,147,153,158,166**;Oct 13, 1995;Build 1
;;Per VA Directive 6402, this routine should not be modified.
;
INQUE(FROM,QNAME,IEN778,ACTION,PURGE,ORIG) ;
;Will place the message=IEN778 on the IN queue, incoming
;Input:
; FROM - sending facility from message header.
; For actions other than incoming messages, its the specified link.
; QNAME - queue named by the application
; IEN778 = ien of the message in file 778
; ACTION - <tag^routine> that should be executed for the application
; PURGE (optional) - +PURGE>0 indicates that the purge dt/tm needs to be set by the infiler.
; ORIG - (optional, pass by reference)
; If ORIG("IEN") is set, it indicates that the the incomming message was an app ack, and the original message needs to be updated with the purge dtate, status (ORIG("STATUS")), and the msgid of the original (ORIG("ACK BY"))
;Output: none
;
N FLG
ZB36 I $G(FROM)="" S FROM="UNKNOWN"
I $$RCNT^HLOSITE L +RECOUNT("IN",FROM,QNAME):20 S:$T FLG=1
I '$L($G(QNAME)) S QNAME="DEFAULT"
S ^HLB("QUEUE","IN",FROM,QNAME,IEN778)=ACTION_"^"_$G(PURGE)_"^"_$G(ORIG("IEN"))_"^"_$G(ORIG("ACK BY"))_"^"_$G(ORIG("STATUS"))
I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","IN",FROM,QNAME)))
L:$G(FLG) -RECOUNT("IN",FROM,QNAME)
Q
;
OUTQUE(LINKNAME,PORT,QNAME,IEN778) ;
;Will place the message=IEN778 on the out-going queue
;Input:
; LINKNAME = name of (.01) the logical link
; PORT (optional) the port to connect to
; QNAME - queue named by the application
; IEN778 = ien of the message in file 778
;Output: none
;
;
N SUB,FLG
S SUB=LINKNAME
I PORT S SUB=SUB_":"_PORT
I '$L($G(QNAME)) S QNAME="DEFAULT"
;***Start HL*1.6*138 PIJ
;if recount in progress, give it up to 20 seconds to finish - if it takes longer than that the recount won't be exact, but a longer delay is unreasonable
I $$RCNT^HLOSITE L +RECOUNT("OUT",SUB,QNAME):20 S:$T FLG=1
;***End HL*1.6*138 PIJ"
S ^HLB("QUEUE","OUT",SUB,QNAME,IEN778)=""
I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","OUT",SUB,QNAME)))
L:$G(FLG) -RECOUNT("OUT",SUB,QNAME)
Q
;
DEQUE(FROMORTO,QNAME,DIR,IEN778) ;
;This routine will remove the message=IEN778 from its queue
;Input:
; DIR = "IN" or "OUT", denoting the direction that the message is going in
; FROMORTO = for outgoing: the .01 field of the logical link
; for incoming: sending facility
; IEN778 = ien of the message in file 778
;Output: none
;
Q:(FROMORTO="")
I ($G(QNAME)="") S QNAME="DEFAULT"
D
.I $E(DIR)="I" S DIR="IN" Q
.I $E(DIR)="O" S DIR="OUT" Q
I DIR'="IN",DIR'="OUT" Q
Q:'$G(IEN778)
D:$D(^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778))
.N FLG
.I $$RCNT^HLOSITE L +RECOUNT(DIR,FROMORTO,QNAME):20 S:$T FLG=1
.K ^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778)
.;don't let the count become negative
.I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)))
.L:$G(FLG) -RECOUNT(DIR,FROMORTO,QNAME)
Q
;
STOPQUE(DIR,QUEUE) ;
;This API is used to set a stop flag on a named queue.
;DIR=<"IN" or "OUT">
;QUEUE - the name of the queue to be stopped
;
Q:$G(DIR)=""
Q:$G(QUEUE)=""
S ^HLTMP("STOPPED QUEUES",DIR,QUEUE)=1
Q
STARTQUE(DIR,QUEUE) ;
;This API is used to REMOVE the stop flag on a named queue.
;DIR=<"IN" or "OUT">
;QUEUE - the name of the queue to be stopped
;
Q:$G(DIR)=""
Q:$G(QUEUE)=""
K ^HLTMP("STOPPED QUEUES",DIR,QUEUE)
Q
STOPPED(DIR,QUEUE) ;
;This API is used to DETERMINE if the stop flag on a named queue is set.
;Input:
; DIR=<"IN" or "OUT">
; QUEUE - the name of the queue to be checked
;Output:
; Function returns 1 if the queue is stopped, 0 otherwise
N RET
S RET=0
Q:$G(DIR)="" 0
Q:$G(QUEUE)="" 0
S:$G(^HLTMP("STOPPED QUEUES",DIR,QUEUE)) RET=1
ZB0 Q RET
;
SQUE(SQUE,LINKNAME,PORT,QNAME,IEN778) ;
;Will place the message=IEN778 on the sequencing queue. This is always done in the context of the application calling an HLO API to send a message.
;Input:
; SQUE - name of the sequencing queue
; LINKNAME = name of (.01) the logical link
; PORT (optional) the port to connect to
; QNAME (optional) outgoing queue
; IEN778 = ien of the message in file 778
;Output: 1 if placed on the outgoing queue, 0 if placed on the sequence queue
;
N NEXT,MOVED,FLG
S MOVED=0
;
;keep a count of messages pending on sequence queues for the HLO System Monitor
;
;***Start HL*1.6*138 PIJ
;if recount in progress, pause up to 20 seconds to finish - if it takes longer than that the recount won't be exact, but a longer delay is unreasonable
I $$RCNT^HLOSITE L +RECOUNT("SEQUENCE",SQUE):20 S:$T FLG=1
;***End HL*1.6*138 PIJ
;
;** START 143 CJM
L +^HLB("QUEUE","SEQUENCE",SQUE):200
;** END 143 CJM
;
S NEXT=+$G(^HLB("QUEUE","SEQUENCE",SQUE))
I NEXT=IEN778 L -^HLB("QUEUE","SEQUENCE",SQUE) Q 0 ;already queued!
;
;increment the counter for all sequence queues
I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")))
;
;*** Start HL*1.6*138 CJM
;also keep counter for the individual queue
I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE",SQUE)))
;*** End HL*1.6*138 CJM
;
;** START 143 CJM
;L +^HLB("QUEUE","SEQUENCE",SQUE):200
;** END 143 CJM
;
;if the sequence queue is empty and not waiting on a message, then the message can be put directly on the outgoing queue, bypassing the sequence queue
I '$O(^HLB("QUEUE","SEQUENCE",SQUE,0)),'NEXT D
.S ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778 ;to mean something moved to outgoing but not yet transmitted
.D OUTQUE(.LINKNAME,.PORT,.QNAME,IEN778)
.S MOVED=1
E D
.;Put the message on the sequence queue.
.S ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)=""
.;
.;**P143 START CJM
.I 'NEXT,$$ADVANCE(SQUE,"")
.;**P143 END CJM
.;
.;**P147 START CJM
.I NEXT,$L($P($G(^HLB(NEXT,0)),"^",7)) D ADVANCE(SQUE,NEXT)
.;**P147 END CJM
.;
L -^HLB("QUEUE","SEQUENCE",SQUE)
L:$G(FLG) -RECOUNT("SEQUENCE",SQUE)
Q MOVED
;
ADVANCE(SQUE,MSGIEN) ;
;Will move the specified sequencing queue to the next message.
;Input:
; SQUE - name of the sequencing queue
; MSGIEN - the ien of the message upon which the sequence queue was waiting. If it is NOT the correct ien, then the sequence queue will NOT be advance.
;Output:
; Function - 1 if advanced, 0 if not
;
N NODE,IEN778,LINKNAME,PORT,QNAME
Q:'$L($G(SQUE)) 0
;
;**P143 START CJM
;Q:'$G(MSGIEN) 0
Q:'$D(MSGIEN) 0
;**P143 END CJM
;
L +^HLB("QUEUE","SEQUENCE",SQUE):200
;
;do not advance if the queue wasn't pending the message=MSGIEN
;**P143 START CJM
;I (MSGIEN'=$P($G(^HLB("QUEUE","SEQUENCE",SQUE)),"^")) L -^HLB("QUEUE","SEQUENCE",SQUE) Q 0
I ($G(MSGIEN)'=$P($G(^HLB("QUEUE","SEQUENCE",SQUE)),"^")) L -^HLB("QUEUE","SEQUENCE",SQUE) Q 0
;**P143 END CJM
;
;decrement the count of messages pending on all sequence queues
I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")))
;
;**Start HL*1.6*138 CJM
;decrement the count of messages pending on this individual queue
I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE",SQUE)),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE",SQUE)))
;**End HL*1.6*138 CJM
;
S IEN778=0
;look for the first message on the sequence que. Make sure its valid, if not remove the invalid entry and keep looking.
F S IEN778=$O(^HLB("QUEUE","SEQUENCE",SQUE,0)) Q:'IEN778 S NODE=$G(^HLB(IEN778,0)) Q:$L(NODE) D
.;message does not exist! Remove from queue and try again.
.K ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)
.I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE"))) ;decrement the count of messages pending sequence queues
.;**Start HL*1.6*138 CJM
.; also decrement the count of messages pending on this individual queue
.I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE",SQUE)),-1)<0,$$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE",SQUE)))
.;**End HL*1.6*138 CJM
;
;IEN778 is the next pending msg on this sequence queue
I IEN778 D
.;
.;parse out info needed to move to outgoing queue
.S LINKNAME=$P(NODE,"^",5),PORT=$P(NODE,"^",8),QNAME=$P(NODE,"^",6)
.;
.S ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778 ;indicates this sequence queue is now waiting for msg=IEN778 before advancing. The second pieces is the timer, but will not be set until the message=IEN778 is actually transmitted.
.K ^HLB("QUEUE","SEQUENCE",SQUE,IEN778) ;remove from sequence queue
.L -^HLB("QUEUE","SEQUENCE",SQUE)
.S $P(^HLB(IEN778,5),"^",2)=1
.D OUTQUE(.LINKNAME,$G(PORT),$G(QNAME),IEN778) ;move to outgoing queue
E D
.K ^HLB("QUEUE","SEQUENCE",SQUE) ;this sequence queue is currently empty and not needed
.L -^HLB("QUEUE","SEQUENCE",SQUE)
Q 1
;
SEQCHK(WORK) ;functions under the HLO Process Manager
;check sequence queues for timeout
N QUE,NOW
S NOW=$$NOW^XLFDT
S QUE=""
F S QUE=$O(^HLB("QUEUE","SEQUENCE",QUE)) Q:QUE="" D
.N NODE,MSGIEN,ACTION,NODE
.S NODE=$G(^HLB("QUEUE","SEQUENCE",QUE))
.Q:'$P(NODE,"^",2)
.Q:$P(NODE,"^",2)>NOW
.Q:$P(NODE,"^",3)
.L +^HLB("QUEUE","SEQUENCE",QUE):2
.;don't report if a lock wasn't obtained
.Q:'$T
.S NODE=$G(^HLB("QUEUE","SEQUENCE",QUE))
.I '$P(NODE,"^",2) L -^HLB("QUEUE","SEQUENCE",QUE) Q
.I ($P(NODE,"^",2)>NOW) L -^HLB("QUEUE","SEQUENCE",QUE) Q
.I $P(NODE,"^",3) L -^HLB("QUEUE","SEQUENCE",QUE) Q ;exception already raised
.S MSGIEN=$P(NODE,"^")
.I 'MSGIEN L -^HLB("QUEUE","SEQUENCE",QUE) Q
.S ACTION=$$EXCEPT^HLOAPP($$GETSAP^HLOCLNT2(MSGIEN))
.S $P(^HLB(MSGIEN,5),"^",3)=1
.S $P(^HLB("QUEUE","SEQUENCE",QUE),"^",3)=1 ;indicates exception raised
.L -^HLB("QUEUE","SEQUENCE",QUE)
.D ;call the application to take action
..N HLMSGIEN,MCODE,DUZ,QUE,NOW
..N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOQUE"
..S HLMSGIEN=MSGIEN
..S MCODE="D "_ACTION
..N MSGIEN,X
..D DUZ^XUP(.5)
..X MCODE
..;kill the apps variables
..D
...N ZTSK
...D KILL^XUSCLEAN
Q
ERROR ;error trap for application context
S $ETRAP="D UNWIND^%ZTER"
D ^%ZTER
S $ECODE=",UAPPLICATION ERROR,"
;
;kill the apps variables
D
.N ZTSK,MSGIEN,QUEUE
.D KILL^XUSCLEAN
;
;release all the locks the app may have set, except Taskman lock
L:$D(ZTSK) +^%ZTSCH("TASK",ZTSK):$G(DILOCKTM,3)
L:'$D(ZTSK)
;reset HLO's lock
L +^HLTMP("HL7 RUNNING PROCESSES",$J):0
;return to processing the next message on the queue
D UNWIND^%ZTER
Q
;
; *** start HL*1.6*143 - RBN ***
;
; IMPLEMENTATION OF HL0 QUEUE COUNT SUMMARY
;
QUECNT(QUEARRAY) ;
;
; DESC : Functions eturns the total number of messages on all the queues and an the QUEARRAY
;
; INPUT : QUEARRAY - the array, passed by reference, to contain the queue counts.
;
; OUTPUT : Filled array
;
; Format:
;
; QUE("TOTAL") = Total number of messages on all queues.
; QUE("OUT") = Total number of outgoing messages.
; QUE("IN") = Total number of incoming messages.
; QUE("SEQ") = Total number of messages on sequence queues.
; QUE("IN",link_name,queue_name) = Number of messages on given link and queue.
; QUE("OUT",link_name,queue_name) = Number of messages on given link and queue.
; QUE("SEQ",queue_name) = Number of messages on given sequence queue.
;
; There are four possible calls ("entry points") to this API:
; 1. QUECNT - returns the referenced array with all of the above data.
; 2. IN - returns only the data related to the IN queues.
; 3. OUT - returns only the data related to the OUT queues.
; 4. SEQ - returns only the data related to the SEQUENCE queues.
;
N TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
S FLG=1
; Get incomming counts
D IN(.QUEARRAY)
; Get outgoing counts
D OUT(.QUEARRAY)
; Get sequence counts
D SEQ(.QUEARRAY)
;
; Total messages on all queues
;
S QUEARRAY("TOTAL")=INCNT+OUTCNT+SEQCNT
Q QUEARRAY("TOTAL")
;
IN(QUEARRAY) ;
; Count messages on incoming queues
;
I '$G(FLG) N TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
S (LINK,QUE)=""
S INCNT=0
F S LINK=$O(^HLC("QUEUECOUNT","IN",LINK)) Q:LINK="" D
. F S QUE=$O(^HLC("QUEUECOUNT","IN",LINK,QUE)) Q:QUE="" D
. . S INCNT=INCNT+^HLC("QUEUECOUNT","IN",LINK,QUE)
. . S QUEARRAY("IN",LINK,QUE)=^HLC("QUEUECOUNT","IN",LINK,QUE)
S QUEARRAY("IN")=INCNT
I '$G(FLG) Q INCNT
Q
;
OUT(QUEARRAY) ;
; Count messages on outgoing queues
;
I '$G(FLG) N TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
S (LINK,QUE)=""
S OUTCNT=0
F S LINK=$O(^HLC("QUEUECOUNT","OUT",LINK)) Q:LINK="" D
. F S QUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUE)) Q:QUE="" D
. . ;HL*1.6*166 QUIT IF QUE DOES NOT HAVE ANY MESSAGES TO COUNT
. . Q:'^HLC("QUEUECOUNT","OUT",LINK,QUE)
. . S OUTCNT=OUTCNT+^HLC("QUEUECOUNT","OUT",LINK,QUE)
. . S QUEARRAY("OUT",LINK,QUE)=^HLC("QUEUECOUNT","OUT",LINK,QUE)
S QUEARRAY("OUT")=OUTCNT
I '$G(FLG) Q OUTCNT
Q
;
SEQ(QUEARRAY) ;
; Count messages on sequence queues
;
I '$G(FLG) N TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
S QUE=""
S SEQCNT=0
F S QUE=$O(^HLC("QUEUECOUNT","SEQUENCE",QUE)) Q:QUE="" D
. S SEQCNT=SEQCNT+^HLC("QUEUECOUNT","SEQUENCE",QUE)
. S QUEARRAY("SEQ",QUE)=^HLC("QUEUECOUNT","SEQUENCE",QUE)
S QUEARRAY("SEQ")=^HLC("QUEUECOUNT","SEQUENCE")
I '$G(FLG) Q QUEARRAY("SEQ")
Q
;
; *** End HL*1.6*143 - RBN ***
;
;** P147 START CJM
RESETF(IEN) ;
;resets the "F" index on the HLO Priority Queues file (#779.9) for
;for record IEN
;
N DA
S DA(1)=IEN
S DA=0
F S DA=$O(^HLD(779.9,DA(1),1,DA)) Q:'DA D
.N DATA
.S DATA(.01)=$P($G(^HLD(779.9,DA(1),1,DA,0)),"^")
.Q:DATA(.01)=""
.D UPD^HLOASUB1(779.91,.DA,.DATA)
Q
;
GETPRTY(QUEUE,LINK) ;
;Inputs:
; QUEUE (required)
; LINK (required) the name of hte link, possibly with the port # appeded
;
;
N PRTY,LNK
S PRTY=0
S LNK=$P(LINK,":")
I $L(LNK) S PRTY=$G(^HLD(779.9,"F",QUEUE,"OUT",LNK))
I PRTY Q PRTY
S PRTY=$G(^HLD(779.9,"E",QUEUE,"OUT"))
Q:'PRTY 50
Q PRTY
;
SETPRTY ; User interface to set queue priority
;
N DIC,DA,DR,Y,DIE,QUEUE
S DIC="^HLD(779.9,"
S DIC(0)="QEAL"
S DIC("A")="Enter the name of an outgoing queue: "
S DIC("DR")=".01"
D ^DIC
I $G(DTOUT)!($G(DUOUT))!(Y=-1) D Q
. K DIC,DA,DR,Y,DIE
S DA=+Y,QUEUE=$P(Y,"^",2)
I $$ASKYESNO^HLOUSR2("Do you want to set "_QUEUE_"'s priority for just one specific logical link","YES") D
.N DATA
.S DATA(.02)="OUT"
.D UPD^HLOASUB1(779.9,DA,.DATA)
.S DIC="^HLD(779.9,"_DA_",1,"
.S DA(1)=DA,DA=""
.;S DIC("DR")=.02
.S DIC(0)="QEAL"
.S DIC("A")="Select the specific link: "
.D ^DIC
.I Y>0 D
..S DA=+Y
..S DIE="^HLD(779.9,"_DA(1)_",1,"
..S DR=.02
..D ^DIE
E D
.N DATA
.S DATA(.02)="OUT"
.S DATA(.03)=1
.D UPD^HLOASUB1(779.9,DA,.DATA)
.S DIE="^HLD(779.9,"
.S DR=.04
.D ^DIE
Q
SETP(QUEUE,PRIORITY,LINK) ;
;Description: API for setting an outgoing queue's priority
;Input:
; QUEUE (required) the name of the queue
; PRIORITY (required) the priority, 20-100
; LINK (optional) name or IEN of an HL Logical Link. If specified,
; the priority will be applied only to the specific
; link, otherwise the priority will be applied to all
; queues named QUEUE
;Output:
; function returns 1 on success, 0 on failure
;
N LINKIEN,DA,DATA
S LINKIEN=0
S PRIORITY=+$G(PRIORITY)
I $G(PRIORITY)<20 Q 0
I PRIORITY>100 Q 0
I '$L($G(QUEUE)) Q 0
I $L(QUEUE)>20 Q 0
I $L($G(LINK)) D Q:'LINKIEN 0
.S LINKIEN=0
.I LINK,$D(^HLCS(870,LINK,0)) S LINKIEN=LINK Q
.S LINKIEN=$O(^HLCS(870,"B",LINK,0))
S DA=$O(^HLD(779.9,"B",QUEUE,0))
I 'DA D
.S DATA(.02)="OUT"
.S DATA(.01)=QUEUE
.I 'LINKIEN S DATA(.03)=1,DATA(.04)=PRIORITY
.S DA=$$ADD^HLOASUB1(779.9,,.DATA)
E I 'LINKIEN D Q $$UPD^HLOASUB1(779.9,DA,.DATA)
.S DATA(.02)="OUT"
.S DATA(.03)=1
.S DATA(.04)=PRIORITY
Q:'DA 0
Q:'LINKIEN 1
S DA(1)=DA
S DA=$O(^HLD(779.9,DA(1),1,"B",LINKIEN,0))
K DATA
S DATA(.01)=LINKIEN
S DATA(.02)=PRIORITY
I DA Q $$UPD^HLOASUB1(779.91,.DA,.DATA)
I $$ADD^HLOASUB1(779.91,.DA,.DATA,.ERROR) Q 1
Q 0
;**P147 END CJM
;
;
;
;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOQUE 16527 printed Dec 13, 2024@01:59:06 Page 2
HLOQUE ;ALB/CJM/OAK/PIJ/RBN- HL7 QUEUE MANAGEMENT - 10/4/94 1pm ;03/07/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,138,143,147,153,158,166**;Oct 13, 1995;Build 1
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
INQUE(FROM,QNAME,IEN778,ACTION,PURGE,ORIG) ;
+1 ;Will place the message=IEN778 on the IN queue, incoming
+2 ;Input:
+3 ; FROM - sending facility from message header.
+4 ; For actions other than incoming messages, its the specified link.
+5 ; QNAME - queue named by the application
+6 ; IEN778 = ien of the message in file 778
+7 ; ACTION - <tag^routine> that should be executed for the application
+8 ; PURGE (optional) - +PURGE>0 indicates that the purge dt/tm needs to be set by the infiler.
+9 ; ORIG - (optional, pass by reference)
+10 ; If ORIG("IEN") is set, it indicates that the the incomming message was an app ack, and the original message needs to be updated with the purge dtate, status (ORIG("STATUS")), and the msgid of the original (ORIG("ACK BY"))
+11 ;Output: none
+12 ;
+13 NEW FLG
ZB36 IF $GET(FROM)=""
SET FROM="UNKNOWN"
+1 IF $$RCNT^HLOSITE
LOCK +RECOUNT("IN",FROM,QNAME):20
if $TEST
SET FLG=1
+2 IF '$LENGTH($GET(QNAME))
SET QNAME="DEFAULT"
+3 SET ^HLB("QUEUE","IN",FROM,QNAME,IEN778)=ACTION_"^"_$GET(PURGE)_"^"_$GET(ORIG("IEN"))_"^"_$GET(ORIG("ACK BY"))_"^"_$GET(ORIG("STATUS"))
+4 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","IN",FROM,QNAME)))
+5 if $GET(FLG)
LOCK -RECOUNT("IN",FROM,QNAME)
+6 QUIT
+7 ;
OUTQUE(LINKNAME,PORT,QNAME,IEN778) ;
+1 ;Will place the message=IEN778 on the out-going queue
+2 ;Input:
+3 ; LINKNAME = name of (.01) the logical link
+4 ; PORT (optional) the port to connect to
+5 ; QNAME - queue named by the application
+6 ; IEN778 = ien of the message in file 778
+7 ;Output: none
+8 ;
+9 ;
+10 NEW SUB,FLG
+11 SET SUB=LINKNAME
+12 IF PORT
SET SUB=SUB_":"_PORT
+13 IF '$LENGTH($GET(QNAME))
SET QNAME="DEFAULT"
+14 ;***Start HL*1.6*138 PIJ
+15 ;if recount in progress, give it up to 20 seconds to finish - if it takes longer than that the recount won't be exact, but a longer delay is unreasonable
+16 IF $$RCNT^HLOSITE
LOCK +RECOUNT("OUT",SUB,QNAME):20
if $TEST
SET FLG=1
+17 ;***End HL*1.6*138 PIJ"
+18 SET ^HLB("QUEUE","OUT",SUB,QNAME,IEN778)=""
+19 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","OUT",SUB,QNAME)))
+20 if $GET(FLG)
LOCK -RECOUNT("OUT",SUB,QNAME)
+21 QUIT
+22 ;
DEQUE(FROMORTO,QNAME,DIR,IEN778) ;
+1 ;This routine will remove the message=IEN778 from its queue
+2 ;Input:
+3 ; DIR = "IN" or "OUT", denoting the direction that the message is going in
+4 ; FROMORTO = for outgoing: the .01 field of the logical link
+5 ; for incoming: sending facility
+6 ; IEN778 = ien of the message in file 778
+7 ;Output: none
+8 ;
+9 if (FROMORTO="")
QUIT
+10 IF ($GET(QNAME)="")
SET QNAME="DEFAULT"
+11 Begin DoDot:1
+12 IF $EXTRACT(DIR)="I"
SET DIR="IN"
QUIT
+13 IF $EXTRACT(DIR)="O"
SET DIR="OUT"
QUIT
End DoDot:1
+14 IF DIR'="IN"
IF DIR'="OUT"
QUIT
+15 if '$GET(IEN778)
QUIT
+16 if $DATA(^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778))
Begin DoDot:1
+17 NEW FLG
+18 IF $$RCNT^HLOSITE
LOCK +RECOUNT(DIR,FROMORTO,QNAME):20
if $TEST
SET FLG=1
+19 KILL ^HLB("QUEUE",DIR,FROMORTO,QNAME,IEN778)
+20 ;don't let the count become negative
+21 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT",DIR,FROMORTO,QNAME)))
+22 if $GET(FLG)
LOCK -RECOUNT(DIR,FROMORTO,QNAME)
End DoDot:1
+23 QUIT
+24 ;
STOPQUE(DIR,QUEUE) ;
+1 ;This API is used to set a stop flag on a named queue.
+2 ;DIR=<"IN" or "OUT">
+3 ;QUEUE - the name of the queue to be stopped
+4 ;
+5 if $GET(DIR)=""
QUIT
+6 if $GET(QUEUE)=""
QUIT
+7 SET ^HLTMP("STOPPED QUEUES",DIR,QUEUE)=1
+8 QUIT
STARTQUE(DIR,QUEUE) ;
+1 ;This API is used to REMOVE the stop flag on a named queue.
+2 ;DIR=<"IN" or "OUT">
+3 ;QUEUE - the name of the queue to be stopped
+4 ;
+5 if $GET(DIR)=""
QUIT
+6 if $GET(QUEUE)=""
QUIT
+7 KILL ^HLTMP("STOPPED QUEUES",DIR,QUEUE)
+8 QUIT
STOPPED(DIR,QUEUE) ;
+1 ;This API is used to DETERMINE if the stop flag on a named queue is set.
+2 ;Input:
+3 ; DIR=<"IN" or "OUT">
+4 ; QUEUE - the name of the queue to be checked
+5 ;Output:
+6 ; Function returns 1 if the queue is stopped, 0 otherwise
+7 NEW RET
+8 SET RET=0
+9 if $GET(DIR)=""
QUIT 0
+10 if $GET(QUEUE)=""
QUIT 0
+11 if $GET(^HLTMP("STOPPED QUEUES",DIR,QUEUE))
SET RET=1
ZB0 QUIT RET
+1 ;
SQUE(SQUE,LINKNAME,PORT,QNAME,IEN778) ;
+1 ;Will place the message=IEN778 on the sequencing queue. This is always done in the context of the application calling an HLO API to send a message.
+2 ;Input:
+3 ; SQUE - name of the sequencing queue
+4 ; LINKNAME = name of (.01) the logical link
+5 ; PORT (optional) the port to connect to
+6 ; QNAME (optional) outgoing queue
+7 ; IEN778 = ien of the message in file 778
+8 ;Output: 1 if placed on the outgoing queue, 0 if placed on the sequence queue
+9 ;
+10 NEW NEXT,MOVED,FLG
+11 SET MOVED=0
+12 ;
+13 ;keep a count of messages pending on sequence queues for the HLO System Monitor
+14 ;
+15 ;***Start HL*1.6*138 PIJ
+16 ;if recount in progress, pause up to 20 seconds to finish - if it takes longer than that the recount won't be exact, but a longer delay is unreasonable
+17 IF $$RCNT^HLOSITE
LOCK +RECOUNT("SEQUENCE",SQUE):20
if $TEST
SET FLG=1
+18 ;***End HL*1.6*138 PIJ
+19 ;
+20 ;** START 143 CJM
+21 LOCK +^HLB("QUEUE","SEQUENCE",SQUE):200
+22 ;** END 143 CJM
+23 ;
+24 SET NEXT=+$GET(^HLB("QUEUE","SEQUENCE",SQUE))
+25 ;already queued!
IF NEXT=IEN778
LOCK -^HLB("QUEUE","SEQUENCE",SQUE)
QUIT 0
+26 ;
+27 ;increment the counter for all sequence queues
+28 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE")))
+29 ;
+30 ;*** Start HL*1.6*138 CJM
+31 ;also keep counter for the individual queue
+32 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE",SQUE)))
+33 ;*** End HL*1.6*138 CJM
+34 ;
+35 ;** START 143 CJM
+36 ;L +^HLB("QUEUE","SEQUENCE",SQUE):200
+37 ;** END 143 CJM
+38 ;
+39 ;if the sequence queue is empty and not waiting on a message, then the message can be put directly on the outgoing queue, bypassing the sequence queue
+40 IF '$ORDER(^HLB("QUEUE","SEQUENCE",SQUE,0))
IF 'NEXT
Begin DoDot:1
+41 ;to mean something moved to outgoing but not yet transmitted
SET ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778
+42 DO OUTQUE(.LINKNAME,.PORT,.QNAME,IEN778)
+43 SET MOVED=1
End DoDot:1
+44 IF '$TEST
Begin DoDot:1
+45 ;Put the message on the sequence queue.
+46 SET ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)=""
+47 ;
+48 ;**P143 START CJM
+49 IF 'NEXT
IF $$ADVANCE(SQUE,"")
+50 ;**P143 END CJM
+51 ;
+52 ;**P147 START CJM
+53 IF NEXT
IF $LENGTH($PIECE($GET(^HLB(NEXT,0)),"^",7))
DO ADVANCE(SQUE,NEXT)
+54 ;**P147 END CJM
+55 ;
End DoDot:1
+56 LOCK -^HLB("QUEUE","SEQUENCE",SQUE)
+57 if $GET(FLG)
LOCK -RECOUNT("SEQUENCE",SQUE)
+58 QUIT MOVED
+59 ;
ADVANCE(SQUE,MSGIEN) ;
+1 ;Will move the specified sequencing queue to the next message.
+2 ;Input:
+3 ; SQUE - name of the sequencing queue
+4 ; MSGIEN - the ien of the message upon which the sequence queue was waiting. If it is NOT the correct ien, then the sequence queue will NOT be advance.
+5 ;Output:
+6 ; Function - 1 if advanced, 0 if not
+7 ;
+8 NEW NODE,IEN778,LINKNAME,PORT,QNAME
+9 if '$LENGTH($GET(SQUE))
QUIT 0
+10 ;
+11 ;**P143 START CJM
+12 ;Q:'$G(MSGIEN) 0
+13 if '$DATA(MSGIEN)
QUIT 0
+14 ;**P143 END CJM
+15 ;
+16 LOCK +^HLB("QUEUE","SEQUENCE",SQUE):200
+17 ;
+18 ;do not advance if the queue wasn't pending the message=MSGIEN
+19 ;**P143 START CJM
+20 ;I (MSGIEN'=$P($G(^HLB("QUEUE","SEQUENCE",SQUE)),"^")) L -^HLB("QUEUE","SEQUENCE",SQUE) Q 0
+21 IF ($GET(MSGIEN)'=$PIECE($GET(^HLB("QUEUE","SEQUENCE",SQUE)),"^"))
LOCK -^HLB("QUEUE","SEQUENCE",SQUE)
QUIT 0
+22 ;**P143 END CJM
+23 ;
+24 ;decrement the count of messages pending on all sequence queues
+25 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE")))
+26 ;
+27 ;**Start HL*1.6*138 CJM
+28 ;decrement the count of messages pending on this individual queue
+29 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE",SQUE)),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE",SQUE)))
+30 ;**End HL*1.6*138 CJM
+31 ;
+32 SET IEN778=0
+33 ;look for the first message on the sequence que. Make sure its valid, if not remove the invalid entry and keep looking.
+34 FOR
SET IEN778=$ORDER(^HLB("QUEUE","SEQUENCE",SQUE,0))
if 'IEN778
QUIT
SET NODE=$GET(^HLB(IEN778,0))
if $LENGTH(NODE)
QUIT
Begin DoDot:1
+35 ;message does not exist! Remove from queue and try again.
+36 KILL ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)
+37 ;decrement the count of messages pending sequence queues
IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE")),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE")))
+38 ;**Start HL*1.6*138 CJM
+39 ; also decrement the count of messages pending on this individual queue
+40 IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE",SQUE)),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("QUEUECOUNT","SEQUENCE",SQUE)))
+41 ;**End HL*1.6*138 CJM
End DoDot:1
+42 ;
+43 ;IEN778 is the next pending msg on this sequence queue
+44 IF IEN778
Begin DoDot:1
+45 ;
+46 ;parse out info needed to move to outgoing queue
+47 SET LINKNAME=$PIECE(NODE,"^",5)
SET PORT=$PIECE(NODE,"^",8)
SET QNAME=$PIECE(NODE,"^",6)
+48 ;
+49 ;indicates this sequence queue is now waiting for msg=IEN778 before advancing. The second pieces is the timer, but will not be set until the message=IEN778 is actually transmitted.
SET ^HLB("QUEUE","SEQUENCE",SQUE)=IEN778
+50 ;remove from sequence queue
KILL ^HLB("QUEUE","SEQUENCE",SQUE,IEN778)
+51 LOCK -^HLB("QUEUE","SEQUENCE",SQUE)
+52 SET $PIECE(^HLB(IEN778,5),"^",2)=1
+53 ;move to outgoing queue
DO OUTQUE(.LINKNAME,$GET(PORT),$GET(QNAME),IEN778)
End DoDot:1
+54 IF '$TEST
Begin DoDot:1
+55 ;this sequence queue is currently empty and not needed
KILL ^HLB("QUEUE","SEQUENCE",SQUE)
+56 LOCK -^HLB("QUEUE","SEQUENCE",SQUE)
End DoDot:1
+57 QUIT 1
+58 ;
SEQCHK(WORK) ;functions under the HLO Process Manager
+1 ;check sequence queues for timeout
+2 NEW QUE,NOW
+3 SET NOW=$$NOW^XLFDT
+4 SET QUE=""
+5 FOR
SET QUE=$ORDER(^HLB("QUEUE","SEQUENCE",QUE))
if QUE=""
QUIT
Begin DoDot:1
+6 NEW NODE,MSGIEN,ACTION,NODE
+7 SET NODE=$GET(^HLB("QUEUE","SEQUENCE",QUE))
+8 if '$PIECE(NODE,"^",2)
QUIT
+9 if $PIECE(NODE,"^",2)>NOW
QUIT
+10 if $PIECE(NODE,"^",3)
QUIT
+11 LOCK +^HLB("QUEUE","SEQUENCE",QUE):2
+12 ;don't report if a lock wasn't obtained
+13 if '$TEST
QUIT
+14 SET NODE=$GET(^HLB("QUEUE","SEQUENCE",QUE))
+15 IF '$PIECE(NODE,"^",2)
LOCK -^HLB("QUEUE","SEQUENCE",QUE)
QUIT
+16 IF ($PIECE(NODE,"^",2)>NOW)
LOCK -^HLB("QUEUE","SEQUENCE",QUE)
QUIT
+17 ;exception already raised
IF $PIECE(NODE,"^",3)
LOCK -^HLB("QUEUE","SEQUENCE",QUE)
QUIT
+18 SET MSGIEN=$PIECE(NODE,"^")
+19 IF 'MSGIEN
LOCK -^HLB("QUEUE","SEQUENCE",QUE)
QUIT
+20 SET ACTION=$$EXCEPT^HLOAPP($$GETSAP^HLOCLNT2(MSGIEN))
+21 SET $PIECE(^HLB(MSGIEN,5),"^",3)=1
+22 ;indicates exception raised
SET $PIECE(^HLB("QUEUE","SEQUENCE",QUE),"^",3)=1
+23 LOCK -^HLB("QUEUE","SEQUENCE",QUE)
+24 ;call the application to take action
Begin DoDot:2
+25 NEW HLMSGIEN,MCODE,DUZ,QUE,NOW
+26 NEW $ETRAP,$ESTACK
SET $ETRAP="G ERROR^HLOQUE"
+27 SET HLMSGIEN=MSGIEN
+28 SET MCODE="D "_ACTION
+29 NEW MSGIEN,X
+30 DO DUZ^XUP(.5)
+31 XECUTE MCODE
+32 ;kill the apps variables
+33 Begin DoDot:3
+34 NEW ZTSK
+35 DO KILL^XUSCLEAN
End DoDot:3
End DoDot:2
End DoDot:1
+36 QUIT
ERROR ;error trap for application context
+1 SET $ETRAP="D UNWIND^%ZTER"
+2 DO ^%ZTER
+3 SET $ECODE=",UAPPLICATION ERROR,"
+4 ;
+5 ;kill the apps variables
+6 Begin DoDot:1
+7 NEW ZTSK,MSGIEN,QUEUE
+8 DO KILL^XUSCLEAN
End DoDot:1
+9 ;
+10 ;release all the locks the app may have set, except Taskman lock
+11 if $DATA(ZTSK)
LOCK +^%ZTSCH("TASK",ZTSK):$GET(DILOCKTM,3)
+12 if '$DATA(ZTSK)
LOCK
+13 ;reset HLO's lock
+14 LOCK +^HLTMP("HL7 RUNNING PROCESSES",$JOB):0
+15 ;return to processing the next message on the queue
+16 DO UNWIND^%ZTER
+17 QUIT
+18 ;
+19 ; *** start HL*1.6*143 - RBN ***
+20 ;
+21 ; IMPLEMENTATION OF HL0 QUEUE COUNT SUMMARY
+22 ;
QUECNT(QUEARRAY) ;
+1 ;
+2 ; DESC : Functions eturns the total number of messages on all the queues and an the QUEARRAY
+3 ;
+4 ; INPUT : QUEARRAY - the array, passed by reference, to contain the queue counts.
+5 ;
+6 ; OUTPUT : Filled array
+7 ;
+8 ; Format:
+9 ;
+10 ; QUE("TOTAL") = Total number of messages on all queues.
+11 ; QUE("OUT") = Total number of outgoing messages.
+12 ; QUE("IN") = Total number of incoming messages.
+13 ; QUE("SEQ") = Total number of messages on sequence queues.
+14 ; QUE("IN",link_name,queue_name) = Number of messages on given link and queue.
+15 ; QUE("OUT",link_name,queue_name) = Number of messages on given link and queue.
+16 ; QUE("SEQ",queue_name) = Number of messages on given sequence queue.
+17 ;
+18 ; There are four possible calls ("entry points") to this API:
+19 ; 1. QUECNT - returns the referenced array with all of the above data.
+20 ; 2. IN - returns only the data related to the IN queues.
+21 ; 3. OUT - returns only the data related to the OUT queues.
+22 ; 4. SEQ - returns only the data related to the SEQUENCE queues.
+23 ;
+24 NEW TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
+25 SET FLG=1
+26 ; Get incomming counts
+27 DO IN(.QUEARRAY)
+28 ; Get outgoing counts
+29 DO OUT(.QUEARRAY)
+30 ; Get sequence counts
+31 DO SEQ(.QUEARRAY)
+32 ;
+33 ; Total messages on all queues
+34 ;
+35 SET QUEARRAY("TOTAL")=INCNT+OUTCNT+SEQCNT
+36 QUIT QUEARRAY("TOTAL")
+37 ;
IN(QUEARRAY) ;
+1 ; Count messages on incoming queues
+2 ;
+3 IF '$GET(FLG)
NEW TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
+4 SET (LINK,QUE)=""
+5 SET INCNT=0
+6 FOR
SET LINK=$ORDER(^HLC("QUEUECOUNT","IN",LINK))
if LINK=""
QUIT
Begin DoDot:1
+7 FOR
SET QUE=$ORDER(^HLC("QUEUECOUNT","IN",LINK,QUE))
if QUE=""
QUIT
Begin DoDot:2
+8 SET INCNT=INCNT+^HLC("QUEUECOUNT","IN",LINK,QUE)
+9 SET QUEARRAY("IN",LINK,QUE)=^HLC("QUEUECOUNT","IN",LINK,QUE)
End DoDot:2
End DoDot:1
+10 SET QUEARRAY("IN")=INCNT
+11 IF '$GET(FLG)
QUIT INCNT
+12 QUIT
+13 ;
OUT(QUEARRAY) ;
+1 ; Count messages on outgoing queues
+2 ;
+3 IF '$GET(FLG)
NEW TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
+4 SET (LINK,QUE)=""
+5 SET OUTCNT=0
+6 FOR
SET LINK=$ORDER(^HLC("QUEUECOUNT","OUT",LINK))
if LINK=""
QUIT
Begin DoDot:1
+7 FOR
SET QUE=$ORDER(^HLC("QUEUECOUNT","OUT",LINK,QUE))
if QUE=""
QUIT
Begin DoDot:2
+8 ;HL*1.6*166 QUIT IF QUE DOES NOT HAVE ANY MESSAGES TO COUNT
+9 if '^HLC("QUEUECOUNT","OUT",LINK,QUE)
QUIT
+10 SET OUTCNT=OUTCNT+^HLC("QUEUECOUNT","OUT",LINK,QUE)
+11 SET QUEARRAY("OUT",LINK,QUE)=^HLC("QUEUECOUNT","OUT",LINK,QUE)
End DoDot:2
End DoDot:1
+12 SET QUEARRAY("OUT")=OUTCNT
+13 IF '$GET(FLG)
QUIT OUTCNT
+14 QUIT
+15 ;
SEQ(QUEARRAY) ;
+1 ; Count messages on sequence queues
+2 ;
+3 IF '$GET(FLG)
NEW TOTAL,INCNT,OUTCNT,SEQCNT,LINK,QUE,FLG
+4 SET QUE=""
+5 SET SEQCNT=0
+6 FOR
SET QUE=$ORDER(^HLC("QUEUECOUNT","SEQUENCE",QUE))
if QUE=""
QUIT
Begin DoDot:1
+7 SET SEQCNT=SEQCNT+^HLC("QUEUECOUNT","SEQUENCE",QUE)
+8 SET QUEARRAY("SEQ",QUE)=^HLC("QUEUECOUNT","SEQUENCE",QUE)
End DoDot:1
+9 SET QUEARRAY("SEQ")=^HLC("QUEUECOUNT","SEQUENCE")
+10 IF '$GET(FLG)
QUIT QUEARRAY("SEQ")
+11 QUIT
+12 ;
+13 ; *** End HL*1.6*143 - RBN ***
+14 ;
+15 ;** P147 START CJM
RESETF(IEN) ;
+1 ;resets the "F" index on the HLO Priority Queues file (#779.9) for
+2 ;for record IEN
+3 ;
+4 NEW DA
+5 SET DA(1)=IEN
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^HLD(779.9,DA(1),1,DA))
if 'DA
QUIT
Begin DoDot:1
+8 NEW DATA
+9 SET DATA(.01)=$PIECE($GET(^HLD(779.9,DA(1),1,DA,0)),"^")
+10 if DATA(.01)=""
QUIT
+11 DO UPD^HLOASUB1(779.91,.DA,.DATA)
End DoDot:1
+12 QUIT
+13 ;
GETPRTY(QUEUE,LINK) ;
+1 ;Inputs:
+2 ; QUEUE (required)
+3 ; LINK (required) the name of hte link, possibly with the port # appeded
+4 ;
+5 ;
+6 NEW PRTY,LNK
+7 SET PRTY=0
+8 SET LNK=$PIECE(LINK,":")
+9 IF $LENGTH(LNK)
SET PRTY=$GET(^HLD(779.9,"F",QUEUE,"OUT",LNK))
+10 IF PRTY
QUIT PRTY
+11 SET PRTY=$GET(^HLD(779.9,"E",QUEUE,"OUT"))
+12 if 'PRTY
QUIT 50
+13 QUIT PRTY
+14 ;
SETPRTY ; User interface to set queue priority
+1 ;
+2 NEW DIC,DA,DR,Y,DIE,QUEUE
+3 SET DIC="^HLD(779.9,"
+4 SET DIC(0)="QEAL"
+5 SET DIC("A")="Enter the name of an outgoing queue: "
+6 SET DIC("DR")=".01"
+7 DO ^DIC
+8 IF $GET(DTOUT)!($GET(DUOUT))!(Y=-1)
Begin DoDot:1
+9 KILL DIC,DA,DR,Y,DIE
End DoDot:1
QUIT
+10 SET DA=+Y
SET QUEUE=$PIECE(Y,"^",2)
+11 IF $$ASKYESNO^HLOUSR2("Do you want to set "_QUEUE_"'s priority for just one specific logical link","YES")
Begin DoDot:1
+12 NEW DATA
+13 SET DATA(.02)="OUT"
+14 DO UPD^HLOASUB1(779.9,DA,.DATA)
+15 SET DIC="^HLD(779.9,"_DA_",1,"
+16 SET DA(1)=DA
SET DA=""
+17 ;S DIC("DR")=.02
+18 SET DIC(0)="QEAL"
+19 SET DIC("A")="Select the specific link: "
+20 DO ^DIC
+21 IF Y>0
Begin DoDot:2
+22 SET DA=+Y
+23 SET DIE="^HLD(779.9,"_DA(1)_",1,"
+24 SET DR=.02
+25 DO ^DIE
End DoDot:2
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 NEW DATA
+28 SET DATA(.02)="OUT"
+29 SET DATA(.03)=1
+30 DO UPD^HLOASUB1(779.9,DA,.DATA)
+31 SET DIE="^HLD(779.9,"
+32 SET DR=.04
+33 DO ^DIE
End DoDot:1
+34 QUIT
SETP(QUEUE,PRIORITY,LINK) ;
+1 ;Description: API for setting an outgoing queue's priority
+2 ;Input:
+3 ; QUEUE (required) the name of the queue
+4 ; PRIORITY (required) the priority, 20-100
+5 ; LINK (optional) name or IEN of an HL Logical Link. If specified,
+6 ; the priority will be applied only to the specific
+7 ; link, otherwise the priority will be applied to all
+8 ; queues named QUEUE
+9 ;Output:
+10 ; function returns 1 on success, 0 on failure
+11 ;
+12 NEW LINKIEN,DA,DATA
+13 SET LINKIEN=0
+14 SET PRIORITY=+$GET(PRIORITY)
+15 IF $GET(PRIORITY)<20
QUIT 0
+16 IF PRIORITY>100
QUIT 0
+17 IF '$LENGTH($GET(QUEUE))
QUIT 0
+18 IF $LENGTH(QUEUE)>20
QUIT 0
+19 IF $LENGTH($GET(LINK))
Begin DoDot:1
+20 SET LINKIEN=0
+21 IF LINK
IF $DATA(^HLCS(870,LINK,0))
SET LINKIEN=LINK
QUIT
+22 SET LINKIEN=$ORDER(^HLCS(870,"B",LINK,0))
End DoDot:1
if 'LINKIEN
QUIT 0
+23 SET DA=$ORDER(^HLD(779.9,"B",QUEUE,0))
+24 IF 'DA
Begin DoDot:1
+25 SET DATA(.02)="OUT"
+26 SET DATA(.01)=QUEUE
+27 IF 'LINKIEN
SET DATA(.03)=1
SET DATA(.04)=PRIORITY
+28 SET DA=$$ADD^HLOASUB1(779.9,,.DATA)
End DoDot:1
+29 IF '$TEST
IF 'LINKIEN
Begin DoDot:1
+30 SET DATA(.02)="OUT"
+31 SET DATA(.03)=1
+32 SET DATA(.04)=PRIORITY
End DoDot:1
QUIT $$UPD^HLOASUB1(779.9,DA,.DATA)
+33 if 'DA
QUIT 0
+34 if 'LINKIEN
QUIT 1
+35 SET DA(1)=DA
+36 SET DA=$ORDER(^HLD(779.9,DA(1),1,"B",LINKIEN,0))
+37 KILL DATA
+38 SET DATA(.01)=LINKIEN
+39 SET DATA(.02)=PRIORITY
+40 IF DA
QUIT $$UPD^HLOASUB1(779.91,.DA,.DATA)
+41 IF $$ADD^HLOASUB1(779.91,.DA,.DATA,.ERROR)
QUIT 1
+42 QUIT 0
+43 ;**P147 END CJM
+44 ;
+45 ;
+46 ;
+47 ;
+48 ;
+49 ;
