HLOUSR5 ;OAK/RBN -ListManager screen for reporting sequence queues;12 JUN 1997 10:00 am ;07/10/2008
;;1.6;HEALTH LEVEL SEVEN;**138**;Oct 13, 1995;Build 34
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
EN ;
K HLPARMS ;not newed so they'll be left for realtime mode
N OLDRFRSH
S OLDRFRSH=$G(HLRFRSH)
D CLEAN^VALM10
D FULL^VALM1
S HLRFRSH="SEARCH^HLOUSR4(.HLPARMS)"
I '$$ASK(.HLPARMS) S VALMBCK="R" Q
D EN^VALM("HLO SEQUENCE QUEUES")
S HLRFRSH=OLDRFRSH
I $L(HLRFRSH) D @HLRFRSH
Q
HDR ;
S (HLSCREEN,VALMSG)="Outbound Queues"
Q
;
SEARCH(HLPARMS) ;
N MIN,LATEONLY,NS,QUE,ARY,COUNT,NOW,IEN,TIME,NODE
S MIN=+$G(HLPARMS("MIN")),LATEONLY=+$G(HLPARMS("LATEONLY")),NS=$G(HLPARMS("NS"))
S VALMCNT=0
S NOW=$$NOW^XLFDT
D CLEAN^VALM10
;
S ARY="^HLB(""QUEUE"",""SEQUENCE"")"
S QUE=NS
D:$L(NS) F S QUE=$O(@ARY@(QUE)) Q:QUE="" Q:'($E(QUE,1,$L(NS))=NS) D
.S NODE=$G(@ARY@(QUE))
.S TIME=$P(NODE,"^",2)
.I LATEONLY Q:'TIME Q:TIME>NOW
.S IEN=0
.S COUNT=$S($L($P(NODE,"^")):1,1:0)
.F S IEN=$O(@ARY@(QUE,IEN)) Q:'IEN S COUNT=COUNT+1
.I MIN,COUNT<MIN,'(TIME&(TIME<NOW)) Q
.D ADDTO(QUE,COUNT,NODE)
END S VALMBCK="R"
;
Q
ADDTO(QUE,COUNT,NODE) ;
N LINE,MSGID
;
S MSGID=""
I $P(NODE,"^") S MSGID=$P($G(^HLB(+NODE,0)),"^",1)
S LINE=$$LJ(QUE,30)_$$RJ(COUNT,7)_" "_$$LJ(MSGID,18)
I $P(NODE,"^",2),$P(NODE,"^",2)<NOW S LINE=LINE_$$FMTE^XLFDT($P(NODE,"^",2),"2FM")_" "_$S($P(NODE,"^",3):"YES",1:"NO")
S @VALMAR@($$I,0)=LINE
Q
;
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR(STRING,LEN)
;
RJ(STRING,LEN) ;
Q $$RJ^XLFSTR(STRING,LEN)
;
I() ;
S VALMCNT=VALMCNT+1
Q VALMCNT
;
ASK(PARMS) ;
N SUB
F SUB="NS","MIN","LATEONLY" S PARMS(SUB)=""
S PARMS("NS")=$$ASKQUE
Q:(PARMS("NS")=-1) 0
S PARMS("LATEONLY")=$$ASKYESNO^HLOUSR2("Include only queues that are late","NO")
Q:(PARMS("LATEONLY")=-1) 0
S PARMS("MIN")=$$ASKMIN
Q:(PARMS("MIN")<0) 0
Q 1
;
ASKMIN() ;
N DIR
S DIR(0)="N^1:999999:0"
S DIR("A")="Minimum Queue Size"
S DIR("B")=1
S DIR("?",1)="If you would like to limit the report to include only the"
S DIR("?")="longer queues then you must specify the minimum size to include."
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q X
ASKQUE() ;
N DIR
S DIR(0)="FO^0:40"
S DIR("A")="Sequence Queue Namespace"
S DIR("?")="Enter the namespace for the queues, or '^' to exit."
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q X
;
ADVANCE ;
N DIR,QUE,MSG,RET
S VALMBCK="R"
S DIR(0)="FO^0:40"
S DIR("A")="Sequence Queue"
S DIR("?")="Enter the full name of the queue, or '^' to exit."
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
S QUE=X
Q:'$L(QUE)
S MSG=$$PICKMSG^HLOUSR1()
Q:'MSG
S RET=$$ADVANCE^HLOQUE(QUE,MSG)
I 'RET D
.W !,"Sorry, that queue was not pending that message!" D PAUSE^VALM1
E D
.W !,"The queue has been advanced!" D PAUSE^VALM1
;
D SEARCH(.HLPARMS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOUSR5 2908 printed Sep 23, 2025@19:35:27 Page 2
HLOUSR5 ;OAK/RBN -ListManager screen for reporting sequence queues;12 JUN 1997 10:00 am ;07/10/2008
+1 ;;1.6;HEALTH LEVEL SEVEN;**138**;Oct 13, 1995;Build 34
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
EN ;
+1 ;not newed so they'll be left for realtime mode
KILL HLPARMS
+2 NEW OLDRFRSH
+3 SET OLDRFRSH=$GET(HLRFRSH)
+4 DO CLEAN^VALM10
+5 DO FULL^VALM1
+6 SET HLRFRSH="SEARCH^HLOUSR4(.HLPARMS)"
+7 IF '$$ASK(.HLPARMS)
SET VALMBCK="R"
QUIT
+8 DO EN^VALM("HLO SEQUENCE QUEUES")
+9 SET HLRFRSH=OLDRFRSH
+10 IF $LENGTH(HLRFRSH)
DO @HLRFRSH
+11 QUIT
HDR ;
+1 SET (HLSCREEN,VALMSG)="Outbound Queues"
+2 QUIT
+3 ;
SEARCH(HLPARMS) ;
+1 NEW MIN,LATEONLY,NS,QUE,ARY,COUNT,NOW,IEN,TIME,NODE
+2 SET MIN=+$GET(HLPARMS("MIN"))
SET LATEONLY=+$GET(HLPARMS("LATEONLY"))
SET NS=$GET(HLPARMS("NS"))
+3 SET VALMCNT=0
+4 SET NOW=$$NOW^XLFDT
+5 DO CLEAN^VALM10
+6 ;
+7 SET ARY="^HLB(""QUEUE"",""SEQUENCE"")"
+8 SET QUE=NS
+9 if $LENGTH(NS)
Begin DoDot:1
+10 SET NODE=$GET(@ARY@(QUE))
+11 SET TIME=$PIECE(NODE,"^",2)
+12 IF LATEONLY
if 'TIME
QUIT
if TIME>NOW
QUIT
+13 SET IEN=0
+14 SET COUNT=$SELECT($LENGTH($PIECE(NODE,"^")):1,1:0)
+15 FOR
SET IEN=$ORDER(@ARY@(QUE,IEN))
if 'IEN
QUIT
SET COUNT=COUNT+1
+16 IF MIN
IF COUNT<MIN
IF '(TIME&(TIME<NOW))
QUIT
+17 DO ADDTO(QUE,COUNT,NODE)
End DoDot:1
FOR
SET QUE=$ORDER(@ARY@(QUE))
if QUE=""
QUIT
if '($EXTRACT(QUE,1,$LENGTH(NS))=NS)
QUIT
Begin DoDot:1
End DoDot:1
END SET VALMBCK="R"
+1 ;
+2 QUIT
ADDTO(QUE,COUNT,NODE) ;
+1 NEW LINE,MSGID
+2 ;
+3 SET MSGID=""
+4 IF $PIECE(NODE,"^")
SET MSGID=$PIECE($GET(^HLB(+NODE,0)),"^",1)
+5 SET LINE=$$LJ(QUE,30)_$$RJ(COUNT,7)_" "_$$LJ(MSGID,18)
+6 IF $PIECE(NODE,"^",2)
IF $PIECE(NODE,"^",2)<NOW
SET LINE=LINE_$$FMTE^XLFDT($PIECE(NODE,"^",2),"2FM")_" "_$SELECT($PIECE(NODE,"^",3):"YES",1:"NO")
+7 SET @VALMAR@($$I,0)=LINE
+8 QUIT
+9 ;
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR(STRING,LEN)
+2 ;
RJ(STRING,LEN) ;
+1 QUIT $$RJ^XLFSTR(STRING,LEN)
+2 ;
I() ;
+1 SET VALMCNT=VALMCNT+1
+2 QUIT VALMCNT
+3 ;
ASK(PARMS) ;
+1 NEW SUB
+2 FOR SUB="NS","MIN","LATEONLY"
SET PARMS(SUB)=""
+3 SET PARMS("NS")=$$ASKQUE
+4 if (PARMS("NS")=-1)
QUIT 0
+5 SET PARMS("LATEONLY")=$$ASKYESNO^HLOUSR2("Include only queues that are late","NO")
+6 if (PARMS("LATEONLY")=-1)
QUIT 0
+7 SET PARMS("MIN")=$$ASKMIN
+8 if (PARMS("MIN")<0)
QUIT 0
+9 QUIT 1
+10 ;
ASKMIN() ;
+1 NEW DIR
+2 SET DIR(0)="N^1:999999:0"
+3 SET DIR("A")="Minimum Queue Size"
+4 SET DIR("B")=1
+5 SET DIR("?",1)="If you would like to limit the report to include only the"
+6 SET DIR("?")="longer queues then you must specify the minimum size to include."
+7 DO ^DIR
+8 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+9 QUIT X
ASKQUE() ;
+1 NEW DIR
+2 SET DIR(0)="FO^0:40"
+3 SET DIR("A")="Sequence Queue Namespace"
+4 SET DIR("?")="Enter the namespace for the queues, or '^' to exit."
+5 DO ^DIR
+6 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+7 QUIT X
+8 ;
ADVANCE ;
+1 NEW DIR,QUE,MSG,RET
+2 SET VALMBCK="R"
+3 SET DIR(0)="FO^0:40"
+4 SET DIR("A")="Sequence Queue"
+5 SET DIR("?")="Enter the full name of the queue, or '^' to exit."
+6 DO ^DIR
KILL DIR
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+8 SET QUE=X
+9 if '$LENGTH(QUE)
QUIT
+10 SET MSG=$$PICKMSG^HLOUSR1()
+11 if 'MSG
QUIT
+12 SET RET=$$ADVANCE^HLOQUE(QUE,MSG)
+13 IF 'RET
Begin DoDot:1
+14 WRITE !,"Sorry, that queue was not pending that message!"
DO PAUSE^VALM1
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 WRITE !,"The queue has been advanced!"
DO PAUSE^VALM1
End DoDot:1
+17 ;
+18 DO SEARCH(.HLPARMS)
+19 QUIT
