| 1 | HLOUSR4 ;ALB/CJM -ListManager screen for reporting sequence queues;12 JUN 1997 10:00 am ;08/14/2007
 | 
|---|
| 2 |         ;;1.6;HEALTH LEVEL SEVEN;**137**;Oct 13, 1995;Build 21
 | 
|---|
| 3 |         ;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
| 4 |         ;
 | 
|---|
| 5 |         ;
 | 
|---|
| 6 | EN      ;
 | 
|---|
| 7 |         K HLPARMS ;not newed so they'll be left for realtime mode
 | 
|---|
| 8 |         N OLDRFRSH
 | 
|---|
| 9 |         S OLDRFRSH=$G(HLRFRSH)
 | 
|---|
| 10 |         D CLEAN^VALM10
 | 
|---|
| 11 |         D FULL^VALM1
 | 
|---|
| 12 |         S HLRFRSH="SEARCH^HLOUSR4(.HLPARMS)"
 | 
|---|
| 13 |         I '$$ASK(.HLPARMS) S VALMBCK="R" Q
 | 
|---|
| 14 |         D EN^VALM("HLO SEQUENCE QUEUES")
 | 
|---|
| 15 |         S HLRFRSH=OLDRFRSH
 | 
|---|
| 16 |         I $L(HLRFRSH) D @HLRFRSH
 | 
|---|
| 17 |         Q
 | 
|---|
| 18 | HDR     ;
 | 
|---|
| 19 |         S (HLSCREEN,VALMSG)="Sequence Queues"
 | 
|---|
| 20 |         Q
 | 
|---|
| 21 |         ;
 | 
|---|
| 22 | SEARCH(HLPARMS) ;
 | 
|---|
| 23 |         N MIN,LATEONLY,NS,QUE,ARY,COUNT,NOW,IEN,TIME,NODE
 | 
|---|
| 24 |         S MIN=+$G(HLPARMS("MIN")),LATEONLY=+$G(HLPARMS("LATEONLY")),NS=$G(HLPARMS("NS"))
 | 
|---|
| 25 |         S VALMCNT=0
 | 
|---|
| 26 |         S NOW=$$NOW^XLFDT
 | 
|---|
| 27 |         D CLEAN^VALM10
 | 
|---|
| 28 |         ;
 | 
|---|
| 29 |         S ARY="^HLB(""QUEUE"",""SEQUENCE"")"
 | 
|---|
| 30 |         S QUE=NS
 | 
|---|
| 31 |         D:$L(NS)  F  S QUE=$O(@ARY@(QUE)) Q:QUE=""  Q:'($E(QUE,1,$L(NS))=NS)  D
 | 
|---|
| 32 |         .S NODE=$G(@ARY@(QUE))
 | 
|---|
| 33 |         .S TIME=$P(NODE,"^",2)
 | 
|---|
| 34 |         .I LATEONLY Q:'TIME  Q:TIME>NOW
 | 
|---|
| 35 |         .S IEN=0
 | 
|---|
| 36 |         .S COUNT=$S($L($P(NODE,"^")):1,1:0)
 | 
|---|
| 37 |         .F  S IEN=$O(@ARY@(QUE,IEN)) Q:'IEN  S COUNT=COUNT+1
 | 
|---|
| 38 |         .I MIN,COUNT<MIN,'(TIME&(TIME<NOW)) Q
 | 
|---|
| 39 |         .D ADDTO(QUE,COUNT,NODE)
 | 
|---|
| 40 | END     S VALMBCK="R"
 | 
|---|
| 41 |         ;
 | 
|---|
| 42 |         Q
 | 
|---|
| 43 | ADDTO(QUE,COUNT,NODE)   ;
 | 
|---|
| 44 |         N LINE,MSGID
 | 
|---|
| 45 |         ;
 | 
|---|
| 46 |         S MSGID=""
 | 
|---|
| 47 |         I $P(NODE,"^") S MSGID=$P($G(^HLB(+NODE,0)),"^",1)
 | 
|---|
| 48 |         S LINE=$$LJ(QUE,30)_$$RJ(COUNT,7)_"  "_$$LJ(MSGID,18)
 | 
|---|
| 49 |         I $P(NODE,"^",2),$P(NODE,"^",2)<NOW S LINE=LINE_$$FMTE^XLFDT($P(NODE,"^",2),"2FM")_"  "_$S($P(NODE,"^",3):"YES",1:"NO")
 | 
|---|
| 50 |         S @VALMAR@($$I,0)=LINE
 | 
|---|
| 51 |         Q
 | 
|---|
| 52 |         ;
 | 
|---|
| 53 | LJ(STRING,LEN)  ;
 | 
|---|
| 54 |         Q $$LJ^XLFSTR(STRING,LEN)
 | 
|---|
| 55 |         ;
 | 
|---|
| 56 | RJ(STRING,LEN)  ;
 | 
|---|
| 57 |         Q $$RJ^XLFSTR(STRING,LEN)
 | 
|---|
| 58 |         ;
 | 
|---|
| 59 | I()     ;
 | 
|---|
| 60 |         S VALMCNT=VALMCNT+1
 | 
|---|
| 61 |         Q VALMCNT
 | 
|---|
| 62 |         ;
 | 
|---|
| 63 | ASK(PARMS)      ;
 | 
|---|
| 64 |         N SUB
 | 
|---|
| 65 |         F SUB="NS","MIN","LATEONLY" S PARMS(SUB)=""
 | 
|---|
| 66 |         S PARMS("NS")=$$ASKQUE
 | 
|---|
| 67 |         Q:(PARMS("NS")=-1) 0
 | 
|---|
| 68 |         S PARMS("LATEONLY")=$$ASKYESNO^HLOUSR2("Include only queues that are late","NO")
 | 
|---|
| 69 |         Q:(PARMS("LATEONLY")=-1) 0
 | 
|---|
| 70 |         S PARMS("MIN")=$$ASKMIN
 | 
|---|
| 71 |         Q:(PARMS("MIN")<0) 0
 | 
|---|
| 72 |         Q 1
 | 
|---|
| 73 |         ;
 | 
|---|
| 74 | ASKMIN()        ;
 | 
|---|
| 75 |         N DIR
 | 
|---|
| 76 |         S DIR(0)="N^1:999999:0"
 | 
|---|
| 77 |         S DIR("A")="Minimum Queue Size"
 | 
|---|
| 78 |         S DIR("B")=1
 | 
|---|
| 79 |         S DIR("?",1)="If you would like to limit the report to include only the"
 | 
|---|
| 80 |         S DIR("?")="longer queues then you must specify the minimum size to include."
 | 
|---|
| 81 |         D ^DIR
 | 
|---|
| 82 |         Q:$D(DTOUT)!$D(DUOUT) -1
 | 
|---|
| 83 |         Q X
 | 
|---|
| 84 | ASKQUE()        ;
 | 
|---|
| 85 |         N DIR
 | 
|---|
| 86 |         S DIR(0)="FO^0:40"
 | 
|---|
| 87 |         S DIR("A")="Sequence Queue Namespace"
 | 
|---|
| 88 |         S DIR("?")="Enter the namespace for the queues, or '^' to exit."
 | 
|---|
| 89 |         D ^DIR
 | 
|---|
| 90 |         Q:$D(DTOUT)!$D(DUOUT) -1
 | 
|---|
| 91 |         Q X
 | 
|---|
| 92 |         ;
 | 
|---|
| 93 | ADVANCE ;
 | 
|---|
| 94 |         N DIR,QUE,MSG,RET
 | 
|---|
| 95 |         S VALMBCK="R"
 | 
|---|
| 96 |         S DIR(0)="FO^0:40"
 | 
|---|
| 97 |         S DIR("A")="Sequence Queue"
 | 
|---|
| 98 |         S DIR("?")="Enter the full name of the queue, or '^' to exit."
 | 
|---|
| 99 |         D ^DIR K DIR
 | 
|---|
| 100 |         Q:$D(DTOUT)!$D(DUOUT)
 | 
|---|
| 101 |         S QUE=X
 | 
|---|
| 102 |         Q:'$L(QUE)
 | 
|---|
| 103 |         S MSG=$$PICKMSG^HLOUSR1()
 | 
|---|
| 104 |         Q:'MSG
 | 
|---|
| 105 |         S RET=$$ADVANCE^HLOQUE(QUE,MSG)
 | 
|---|
| 106 |         I 'RET D
 | 
|---|
| 107 |         .W !,"Sorry, that queue was not pending that message!" D PAUSE^VALM1
 | 
|---|
| 108 |         E  D
 | 
|---|
| 109 |         .W !,"The queue has been advanced!" D PAUSE^VALM1
 | 
|---|
| 110 |         ;
 | 
|---|
| 111 |         D SEARCH(.HLPARMS)
 | 
|---|
| 112 |         Q
 | 
|---|