HLOUSR6 ;OAK/RBN -ListManager screen for reporting outbound queues;12 JUN 1997 10:00 am ;07/02/2010
;;1.6;HEALTH LEVEL SEVEN;**138,146,147**;Oct 13, 1995;Build 15
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
EN ; Created list of outbound queues.
N HLRFRSH,OLDRFRSH
S OLDRFRSH=$G(HLRFRSH)
D WAIT^DICD
D EN^VALM("HLO DISPLAY OUT-GOING QUEUES")
S HLRFRSH=OLDRFRSH
I $L(HLRFRSH) D @HLRFRSH
S VALMBCK="R"
Q
;
INIT ; -- init variables and list array
D OUTQUE
D HDR
D SHOW^VALM
S VALMBCK="R"
Q
;
HDR ; Header info. for the outbound queue display.
N COUNT,LINK,QUE,FROM,TIME,STATUS,TEMP,DIR,TODAY,LIST,HLSCREEN
S HLRFRSH="OUTQUE^HLOUSR6"
S HLSCREEN="HLO Outbound Queues"
S VALM("TITLE")="HLO Outbound Queues"
S VALMSG="Outgoing Queues *down links !stopped queues"
;;; START HL*1.6*147 RBN - Commmented the next line out - prevents list from scrolling.
;S VALMCNT=16
;;; End HL*1.6*147
S VALMBG=1
S VALMDDF("COL 1")="COL1^1^80^"
K VALMDDF("COL 2"),VALMDDF("COL 3"),VALMDDF("COL 4"),VALMDDF("COL 5")
Q
;
OUTQUE ;
N LINK,TOP,COUNT,LINE
F LINE=1:1:16 D SET^VALM10(LINE,"")
S VALMCNT=0
S HLRFRSH="OUTQUE^HLOUSR6"
S VALMAR="^TMP(""HLO OUTBOUND QUEUES"",$J)"
S VALMBCK="R"
S VALMDDF("COL 1")="COL 1^2^20^ Link^H"
;
;**p147 start cjm
;S VALMDDF("COL 2")="COL 2^28^20^Queue^H"
S VALMDDF("COL 2")="COL 2^26^20^Queue/Priority^H"
;**P147 END CJM
;
S VALMDDF("COL 3")="COL 3^50^20^Count^H"
S VALMDDF("COL 4")="COL 4^65^20^Top Message^H"
K VALMDDF("COL 5")
D CHGCAP^VALM("COL 1"," Link")
S LINK=""
F S LINK=$O(^HLC("QUEUECOUNT","OUT",LINK)) Q:LINK="" D
.N COUNT,QUE,SHOW
.S SHOW=LINK
.I $D(^HLTMP("FAILING LINKS",SHOW)) S SHOW="*"_SHOW
.S (TOP,QUE)=""
.F S QUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUE)) Q:QUE="" D
..S COUNT=$G(^HLC("QUEUECOUNT","OUT",LINK,QUE))
..Q:COUNT<1
..S VALMCNT=VALMCNT+1
..S TOP=$$GETTOP()
..I $E(SHOW)="*" D
...S @VALMAR@(VALMCNT,0)=$$LJ(SHOW,20)_$$CJ($S($$STOPPED^HLOQUE("OUT",QUE):"!",1:"")_QUE_"/"_$$GETPRTY^HLOQUE(QUE,LINK),21)_" "_$$RJ(COUNT,10)_$$RJ(TOP,20),SHOW=" "
...D CNTRL^VALM10(VALMCNT,1,1,IOBON,IOBOFF)
..E S @VALMAR@(VALMCNT,0)=$$LJ(SHOW,20)_$$CJ($S($$STOPPED^HLOQUE("OUT",QUE):"!",1:"")_QUE_"/"_$$GETPRTY^HLOQUE(QUE,LINK),21)_" "_$$RJ(COUNT,10)_$$RJ(TOP,20),SHOW=" "
S VALMBCK="R"
Q
;
CJ(STRING,LEN) ;
Q $$CJ^XLFSTR($E(STRING,1,LEN),LEN)
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR($E(STRING,1,LEN),LEN)
RJ(STRING,LEN) ;
Q $$RJ^XLFSTR($E(STRING,1,LEN),LEN)
;
CLEAN ; Clean up before leaving
K ^TMP("HLO OUTBOUND QUEUES",$J)
Q
;
GETTOP() ; Get top message in queue
N TOP,QUIT
S (TOP,QUIT)=0
F S TOP=$O(^HLB("QUEUE","OUT",LINK,QUE,TOP)) Q:'TOP D Q:QUIT
.N NODE
.S NODE=$G(^HLB(TOP,0))
.I NODE="" K ^HLB("QUEUE","OUT",LINK,QUE,TOP) Q
.S TOP=$P(NODE,"^",1),QUIT=1
Q TOP
;
DELTOP ; Deletes the top message on a queue
N CONF,HLOLNAM,HLOQNAM,LOCERR,TOP,LINKNAME,PORT,ERROR
S VALMBCK="R"
D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
I CONF(0)'=1 D Q
. W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1
;**P146 START CJM
;S LOCERR=$$GETLNK^HLOAPI5()
;Q:($G(LOCERR)="Q")
;I $G(LOCERR)=-1 W !,"Sorry, that was an invalid link" D PAUSE^VALM1 Q
S LINKNAME=$$ASKLINK^HLOUSR
I LINKNAME="" W !,"Sorry, that is are no messages pending on that link." D PAUSE^VALM1 Q
D
.N PORT2
.S ERROR=0
.S PORT=$O(^HLB("QUEUE","OUT",LINKNAME_":"))
.I ($P(PORT,":")'=LINKNAME) S PORT="" Q
.S PORT2=$O(^HLB("QUEUE","OUT",LINKNAME_":"_$P(PORT,":",2)))
.I ($P(PORT2,":")'=LINKNAME) S PORT=$P(PORT,":",2) Q
.S PORT=$$ASKPORT^HLOUSRA(LINKNAME)
.I 'PORT S ERROR=1
Q:ERROR
S HLOLNAM=LINKNAME_":"_PORT
;S LOCERR=$$GETQUE^HLOAPI5()
;I $G(LOCERR)="Q" Q
;I $G(LOCERR)=-1 W !,"Sorry, that was an invalid queue" D PAUSE^VALM1 Q
S HLOQNAM=$$ASKQUE(HLOLNAM)
Q:HLOQNAM=""
L +^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM):5 D
.I '$T W !,"That queue is currently locked, please try again later." D PAUSE^VALM1 Q
.D
..S TOP=$O(^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM,""))
..I 'TOP W !,"There are no messages pending on that queue!" D PAUSE^VALM1 Q
..Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to dequeue MsgID: "_$$MSGID^HLOPRS(TOP),"NO")
..;Q:$$VERIFY^HLOQUE1()=-1
..D DEQUE^HLOQUE(HLOLNAM,HLOQNAM,"OUT",TOP)
..D OUTQUE
..;
.L -^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM)
;K ^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM,TOP)
;S ^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)=^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)-1
;S:^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)<0 ^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)=0
;D OUTQUE
;**P146 END CJM
Q
;
;
;**P146 START CJM
ASKQUE(LINK) ;
;Input: LINK=<link>:<port>
;Ouput: function returns the queue name, or "" if not selected
N X,QUE,Y,DUOUT,DEFAULT
S DIR(0)="F"
S DIR("A")="Enter queue name "
S DEFAULT=$O(^HLB("QUEUE","OUT",LINK,""))
I DEFAULT="" S DEFAULT="DEFAULT"
S DIR("B")=DEFAULT
S DIR("?",1)="Enter the queue name as displayed in the HLO System Monitor"
S DIR("?",2)=" Outgoing Queue display."
D ^DIR
K DIR
I $G(DUOUT)!(Y="") Q ""
Q Y
;**P146 END CJM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOUSR6 5185 printed Dec 13, 2024@01:59:23 Page 2
HLOUSR6 ;OAK/RBN -ListManager screen for reporting outbound queues;12 JUN 1997 10:00 am ;07/02/2010
+1 ;;1.6;HEALTH LEVEL SEVEN;**138,146,147**;Oct 13, 1995;Build 15
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
EN ; Created list of outbound queues.
+1 NEW HLRFRSH,OLDRFRSH
+2 SET OLDRFRSH=$GET(HLRFRSH)
+3 DO WAIT^DICD
+4 DO EN^VALM("HLO DISPLAY OUT-GOING QUEUES")
+5 SET HLRFRSH=OLDRFRSH
+6 IF $LENGTH(HLRFRSH)
DO @HLRFRSH
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
INIT ; -- init variables and list array
+1 DO OUTQUE
+2 DO HDR
+3 DO SHOW^VALM
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
HDR ; Header info. for the outbound queue display.
+1 NEW COUNT,LINK,QUE,FROM,TIME,STATUS,TEMP,DIR,TODAY,LIST,HLSCREEN
+2 SET HLRFRSH="OUTQUE^HLOUSR6"
+3 SET HLSCREEN="HLO Outbound Queues"
+4 SET VALM("TITLE")="HLO Outbound Queues"
+5 SET VALMSG="Outgoing Queues *down links !stopped queues"
+6 ;;; START HL*1.6*147 RBN - Commmented the next line out - prevents list from scrolling.
+7 ;S VALMCNT=16
+8 ;;; End HL*1.6*147
+9 SET VALMBG=1
+10 SET VALMDDF("COL 1")="COL1^1^80^"
+11 KILL VALMDDF("COL 2"),VALMDDF("COL 3"),VALMDDF("COL 4"),VALMDDF("COL 5")
+12 QUIT
+13 ;
OUTQUE ;
+1 NEW LINK,TOP,COUNT,LINE
+2 FOR LINE=1:1:16
DO SET^VALM10(LINE,"")
+3 SET VALMCNT=0
+4 SET HLRFRSH="OUTQUE^HLOUSR6"
+5 SET VALMAR="^TMP(""HLO OUTBOUND QUEUES"",$J)"
+6 SET VALMBCK="R"
+7 SET VALMDDF("COL 1")="COL 1^2^20^ Link^H"
+8 ;
+9 ;**p147 start cjm
+10 ;S VALMDDF("COL 2")="COL 2^28^20^Queue^H"
+11 SET VALMDDF("COL 2")="COL 2^26^20^Queue/Priority^H"
+12 ;**P147 END CJM
+13 ;
+14 SET VALMDDF("COL 3")="COL 3^50^20^Count^H"
+15 SET VALMDDF("COL 4")="COL 4^65^20^Top Message^H"
+16 KILL VALMDDF("COL 5")
+17 DO CHGCAP^VALM("COL 1"," Link")
+18 SET LINK=""
+19 FOR
SET LINK=$ORDER(^HLC("QUEUECOUNT","OUT",LINK))
if LINK=""
QUIT
Begin DoDot:1
+20 NEW COUNT,QUE,SHOW
+21 SET SHOW=LINK
+22 IF $DATA(^HLTMP("FAILING LINKS",SHOW))
SET SHOW="*"_SHOW
+23 SET (TOP,QUE)=""
+24 FOR
SET QUE=$ORDER(^HLC("QUEUECOUNT","OUT",LINK,QUE))
if QUE=""
QUIT
Begin DoDot:2
+25 SET COUNT=$GET(^HLC("QUEUECOUNT","OUT",LINK,QUE))
+26 if COUNT<1
QUIT
+27 SET VALMCNT=VALMCNT+1
+28 SET TOP=$$GETTOP()
+29 IF $EXTRACT(SHOW)="*"
Begin DoDot:3
+30 SET @VALMAR@(VALMCNT,0)=$$LJ(SHOW,20)_$$CJ($SELECT($$STOPPED^HLOQUE("OUT",QUE):"!",1:"")_QUE_"/"_$$GETPRTY^HLOQUE(QUE,LINK),21)_" "_$$RJ(COUNT,10)_$$RJ(TOP,20)
SET SHOW=" "
+31 DO CNTRL^VALM10(VALMCNT,1,1,IOBON,IOBOFF)
End DoDot:3
+32 IF '$TEST
SET @VALMAR@(VALMCNT,0)=$$LJ(SHOW,20)_$$CJ($SELECT($$STOPPED^HLOQUE("OUT",QUE):"!",1:"")_QUE_"/"_$$GETPRTY^HLOQUE(QUE,LINK),21)_" "_$$RJ(COUNT,10)_$$RJ(TOP,20)
SET SHOW=" "
End DoDot:2
End DoDot:1
+33 SET VALMBCK="R"
+34 QUIT
+35 ;
CJ(STRING,LEN) ;
+1 QUIT $$CJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
RJ(STRING,LEN) ;
+1 QUIT $$RJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
+2 ;
CLEAN ; Clean up before leaving
+1 KILL ^TMP("HLO OUTBOUND QUEUES",$JOB)
+2 QUIT
+3 ;
GETTOP() ; Get top message in queue
+1 NEW TOP,QUIT
+2 SET (TOP,QUIT)=0
+3 FOR
SET TOP=$ORDER(^HLB("QUEUE","OUT",LINK,QUE,TOP))
if 'TOP
QUIT
Begin DoDot:1
+4 NEW NODE
+5 SET NODE=$GET(^HLB(TOP,0))
+6 IF NODE=""
KILL ^HLB("QUEUE","OUT",LINK,QUE,TOP)
QUIT
+7 SET TOP=$PIECE(NODE,"^",1)
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+8 QUIT TOP
+9 ;
DELTOP ; Deletes the top message on a queue
+1 NEW CONF,HLOLNAM,HLOQNAM,LOCERR,TOP,LINKNAME,PORT,ERROR
+2 SET VALMBCK="R"
+3 DO OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
+4 IF CONF(0)'=1
Begin DoDot:1
+5 WRITE !,"**** You are not authorized to use this option ****"
DO PAUSE^VALM1
End DoDot:1
QUIT
+6 ;**P146 START CJM
+7 ;S LOCERR=$$GETLNK^HLOAPI5()
+8 ;Q:($G(LOCERR)="Q")
+9 ;I $G(LOCERR)=-1 W !,"Sorry, that was an invalid link" D PAUSE^VALM1 Q
+10 SET LINKNAME=$$ASKLINK^HLOUSR
+11 IF LINKNAME=""
WRITE !,"Sorry, that is are no messages pending on that link."
DO PAUSE^VALM1
QUIT
+12 Begin DoDot:1
+13 NEW PORT2
+14 SET ERROR=0
+15 SET PORT=$ORDER(^HLB("QUEUE","OUT",LINKNAME_":"))
+16 IF ($PIECE(PORT,":")'=LINKNAME)
SET PORT=""
QUIT
+17 SET PORT2=$ORDER(^HLB("QUEUE","OUT",LINKNAME_":"_$PIECE(PORT,":",2)))
+18 IF ($PIECE(PORT2,":")'=LINKNAME)
SET PORT=$PIECE(PORT,":",2)
QUIT
+19 SET PORT=$$ASKPORT^HLOUSRA(LINKNAME)
+20 IF 'PORT
SET ERROR=1
End DoDot:1
+21 if ERROR
QUIT
+22 SET HLOLNAM=LINKNAME_":"_PORT
+23 ;S LOCERR=$$GETQUE^HLOAPI5()
+24 ;I $G(LOCERR)="Q" Q
+25 ;I $G(LOCERR)=-1 W !,"Sorry, that was an invalid queue" D PAUSE^VALM1 Q
+26 SET HLOQNAM=$$ASKQUE(HLOLNAM)
+27 if HLOQNAM=""
QUIT
+28 LOCK +^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM):5
Begin DoDot:1
+29 IF '$TEST
WRITE !,"That queue is currently locked, please try again later."
DO PAUSE^VALM1
QUIT
+30 Begin DoDot:2
+31 SET TOP=$ORDER(^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM,""))
+32 IF 'TOP
WRITE !,"There are no messages pending on that queue!"
DO PAUSE^VALM1
QUIT
+33 if '$$ASKYESNO^HLOUSR2("Are you SURE you want to dequeue MsgID
QUIT
+34 ;Q:$$VERIFY^HLOQUE1()=-1
+35 DO DEQUE^HLOQUE(HLOLNAM,HLOQNAM,"OUT",TOP)
+36 DO OUTQUE
+37 ;
End DoDot:2
+38 LOCK -^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM)
End DoDot:1
+39 ;K ^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM,TOP)
+40 ;S ^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)=^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)-1
+41 ;S:^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)<0 ^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)=0
+42 ;D OUTQUE
+43 ;**P146 END CJM
+44 QUIT
+45 ;
+46 ;
+47 ;**P146 START CJM
ASKQUE(LINK) ;
+1 ;Input: LINK=<link>:<port>
+2 ;Ouput: function returns the queue name, or "" if not selected
+3 NEW X,QUE,Y,DUOUT,DEFAULT
+4 SET DIR(0)="F"
+5 SET DIR("A")="Enter queue name "
+6 SET DEFAULT=$ORDER(^HLB("QUEUE","OUT",LINK,""))
+7 IF DEFAULT=""
SET DEFAULT="DEFAULT"
+8 SET DIR("B")=DEFAULT
+9 SET DIR("?",1)="Enter the queue name as displayed in the HLO System Monitor"
+10 SET DIR("?",2)=" Outgoing Queue display."
+11 DO ^DIR
+12 KILL DIR
+13 IF $GET(DUOUT)!(Y="")
QUIT ""
+14 QUIT Y
+15 ;**P146 END CJM
