Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOUSR6

HLOUSR6.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. EN ; Created list of outbound queues.
  1. N HLRFRSH,OLDRFRSH
  1. S OLDRFRSH=$G(HLRFRSH)
  1. D WAIT^DICD
  1. D EN^VALM("HLO DISPLAY OUT-GOING QUEUES")
  1. S HLRFRSH=OLDRFRSH
  1. I $L(HLRFRSH) D @HLRFRSH
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. D OUTQUE
  1. D HDR
  1. D SHOW^VALM
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. HDR ; Header info. for the outbound queue display.
  1. N COUNT,LINK,QUE,FROM,TIME,STATUS,TEMP,DIR,TODAY,LIST,HLSCREEN
  1. S HLRFRSH="OUTQUE^HLOUSR6"
  1. S HLSCREEN="HLO Outbound Queues"
  1. S VALM("TITLE")="HLO Outbound Queues"
  1. S VALMSG="Outgoing Queues *down links !stopped queues"
  1. ;;; START HL*1.6*147 RBN - Commmented the next line out - prevents list from scrolling.
  1. ;S VALMCNT=16
  1. ;;; End HL*1.6*147
  1. S VALMBG=1
  1. S VALMDDF("COL 1")="COL1^1^80^"
  1. K VALMDDF("COL 2"),VALMDDF("COL 3"),VALMDDF("COL 4"),VALMDDF("COL 5")
  1. Q
  1. ;
  1. OUTQUE ;
  1. N LINK,TOP,COUNT,LINE
  1. F LINE=1:1:16 D SET^VALM10(LINE,"")
  1. S VALMCNT=0
  1. S HLRFRSH="OUTQUE^HLOUSR6"
  1. S VALMAR="^TMP(""HLO OUTBOUND QUEUES"",$J)"
  1. S VALMBCK="R"
  1. S VALMDDF("COL 1")="COL 1^2^20^ Link^H"
  1. ;
  1. ;**p147 start cjm
  1. ;S VALMDDF("COL 2")="COL 2^28^20^Queue^H"
  1. S VALMDDF("COL 2")="COL 2^26^20^Queue/Priority^H"
  1. ;**P147 END CJM
  1. ;
  1. S VALMDDF("COL 3")="COL 3^50^20^Count^H"
  1. S VALMDDF("COL 4")="COL 4^65^20^Top Message^H"
  1. K VALMDDF("COL 5")
  1. D CHGCAP^VALM("COL 1"," Link")
  1. S LINK=""
  1. F S LINK=$O(^HLC("QUEUECOUNT","OUT",LINK)) Q:LINK="" D
  1. .N COUNT,QUE,SHOW
  1. .S SHOW=LINK
  1. .I $D(^HLTMP("FAILING LINKS",SHOW)) S SHOW="*"_SHOW
  1. .S (TOP,QUE)=""
  1. .F S QUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUE)) Q:QUE="" D
  1. ..S COUNT=$G(^HLC("QUEUECOUNT","OUT",LINK,QUE))
  1. ..Q:COUNT<1
  1. ..S VALMCNT=VALMCNT+1
  1. ..S TOP=$$GETTOP()
  1. ..I $E(SHOW)="*" D
  1. ...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=" "
  1. ...D CNTRL^VALM10(VALMCNT,1,1,IOBON,IOBOFF)
  1. ..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=" "
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CJ(STRING,LEN) ;
  1. Q $$CJ^XLFSTR($E(STRING,1,LEN),LEN)
  1. LJ(STRING,LEN) ;
  1. Q $$LJ^XLFSTR($E(STRING,1,LEN),LEN)
  1. RJ(STRING,LEN) ;
  1. Q $$RJ^XLFSTR($E(STRING,1,LEN),LEN)
  1. ;
  1. CLEAN ; Clean up before leaving
  1. K ^TMP("HLO OUTBOUND QUEUES",$J)
  1. Q
  1. ;
  1. GETTOP() ; Get top message in queue
  1. N TOP,QUIT
  1. S (TOP,QUIT)=0
  1. F S TOP=$O(^HLB("QUEUE","OUT",LINK,QUE,TOP)) Q:'TOP D Q:QUIT
  1. .N NODE
  1. .S NODE=$G(^HLB(TOP,0))
  1. .I NODE="" K ^HLB("QUEUE","OUT",LINK,QUE,TOP) Q
  1. .S TOP=$P(NODE,"^",1),QUIT=1
  1. Q TOP
  1. ;
  1. DELTOP ; Deletes the top message on a queue
  1. N CONF,HLOLNAM,HLOQNAM,LOCERR,TOP,LINKNAME,PORT,ERROR
  1. S VALMBCK="R"
  1. D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
  1. I CONF(0)'=1 D Q
  1. . W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1
  1. ;**P146 START CJM
  1. ;S LOCERR=$$GETLNK^HLOAPI5()
  1. ;Q:($G(LOCERR)="Q")
  1. ;I $G(LOCERR)=-1 W !,"Sorry, that was an invalid link" D PAUSE^VALM1 Q
  1. S LINKNAME=$$ASKLINK^HLOUSR
  1. I LINKNAME="" W !,"Sorry, that is are no messages pending on that link." D PAUSE^VALM1 Q
  1. D
  1. .N PORT2
  1. .S ERROR=0
  1. .S PORT=$O(^HLB("QUEUE","OUT",LINKNAME_":"))
  1. .I ($P(PORT,":")'=LINKNAME) S PORT="" Q
  1. .S PORT2=$O(^HLB("QUEUE","OUT",LINKNAME_":"_$P(PORT,":",2)))
  1. .I ($P(PORT2,":")'=LINKNAME) S PORT=$P(PORT,":",2) Q
  1. .S PORT=$$ASKPORT^HLOUSRA(LINKNAME)
  1. .I 'PORT S ERROR=1
  1. Q:ERROR
  1. S HLOLNAM=LINKNAME_":"_PORT
  1. ;S LOCERR=$$GETQUE^HLOAPI5()
  1. ;I $G(LOCERR)="Q" Q
  1. ;I $G(LOCERR)=-1 W !,"Sorry, that was an invalid queue" D PAUSE^VALM1 Q
  1. S HLOQNAM=$$ASKQUE(HLOLNAM)
  1. Q:HLOQNAM=""
  1. L +^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM):5 D
  1. .I '$T W !,"That queue is currently locked, please try again later." D PAUSE^VALM1 Q
  1. .D
  1. ..S TOP=$O(^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM,""))
  1. ..I 'TOP W !,"There are no messages pending on that queue!" D PAUSE^VALM1 Q
  1. ..Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to dequeue MsgID: "_$$MSGID^HLOPRS(TOP),"NO")
  1. ..;Q:$$VERIFY^HLOQUE1()=-1
  1. ..D DEQUE^HLOQUE(HLOLNAM,HLOQNAM,"OUT",TOP)
  1. ..D OUTQUE
  1. ..;
  1. .L -^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM)
  1. ;K ^HLB("QUEUE","OUT",HLOLNAM,HLOQNAM,TOP)
  1. ;S ^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)=^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)-1
  1. ;S:^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)<0 ^HLC("QUEUECOUNT","OUT",HLOLNAM,HLOQNAM)=0
  1. ;D OUTQUE
  1. ;**P146 END CJM
  1. Q
  1. ;
  1. ;
  1. ;**P146 START CJM
  1. ASKQUE(LINK) ;
  1. ;Input: LINK=<link>:<port>
  1. ;Ouput: function returns the queue name, or "" if not selected
  1. N X,QUE,Y,DUOUT,DEFAULT
  1. S DIR(0)="F"
  1. S DIR("A")="Enter queue name "
  1. S DEFAULT=$O(^HLB("QUEUE","OUT",LINK,""))
  1. I DEFAULT="" S DEFAULT="DEFAULT"
  1. S DIR("B")=DEFAULT
  1. S DIR("?",1)="Enter the queue name as displayed in the HLO System Monitor"
  1. S DIR("?",2)=" Outgoing Queue display."
  1. D ^DIR
  1. K DIR
  1. I $G(DUOUT)!(Y="") Q ""
  1. Q Y
  1. ;**P146 END CJM