- 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 Feb 18, 2025@23:25:47 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