VDEFMNU ;INTEGIC/YG & BPOIFO/JG - Edit VDEF parameters & status ; 20 Dec 2005 12:57 PM
;;1.0;VDEF;**3**;Dec 28, 2004;
;Per VHA Directive 2004-038, this routine should not be modified.
;
; IA's: #4322 - ^HLCS(870,<link>,0)
; #1373 - Lookup to file #101
; #10063 - $$JOB^%ZTLOAD
;
Q ; No bozos
;
SITE ; Edit Site-Wide Parameters
N DA,DIC,DIE,DR S DIE=579.5,DA=1,DR=".01;.02;" D ^DIE
Q
;
REQUEST ; Edit Request Queue Parameters
N DIC,DLAYGO,X,Y,DIE,DA,DR
REQUEST1 K DIC S DIC=579.3,DIC(0)="AQE",DIC("A")="Select Request Queue: " W ! D ^DIC Q:Y=-1
K DIC S DIE=579.3,DA=$P(Y,U),DR=".04;.05;.02" D ^DIE
G REQUEST1
;
REQOFF ; Toggle Requestor On/Off
N DIC,DLAYGO,X,Y,DIE,DA,DR
REQOFF1 K DIC S DIC=579.1,DIC(0)="AQE",DIC("A")="Select Requestor: " W ! D ^DIC Q:Y=-1
I $$GET1^DIQ(579.1,$P(Y,U)_",",.05,"I")="A" D
. W !,!,"Inactivating a requestor has a significant effect on the synchronization"
. W !,"of VistA and remote system(s). All VDEF requests made while the requestor"
. W !,"is inactive will be PERMANENTLY lost. Make sure you really want to"
. W !,"turn it off.",!
K DIC S DIE=579.1,DA=$P(Y,U),DR=".05" D ^DIE
G REQOFF1
;
QUEOFF ; Toggle Request Processor Queue on/off
N DIC,DLAYGO,X,Y,DIE,DA,DR,QUEUE,STAT,TMTASK
QUEOFF1 K DIC S DIC=579.3,DIC(0)="AQE",DIC("A")="Select Request Queue: " W ! D ^DIC Q:Y=-1
K DIC S QUEUE=$P(Y,U) S DIE=579.3,DA=QUEUE,DR=".09" D ^DIE
;
; Get the new status of the Request Processor
S STAT=$$GET1^DIQ(579.3,QUEUE_",",.09,"I")
;
; Start the Request Processor
I STAT="R" D REQ^VDEFCONT(QUEUE)
;
; Stop the Request Processor
I STAT="S" D
. S TMTASK=$$GET1^DIQ(579.3,QUEUE_",",.08,"I") S:TMTASK'="" X=$$ASKSTOP^%ZTLOAD(TMTASK)
. S TMTASK=$$GET1^DIQ(579.3,QUEUE_",",.11,"I") S:TMTASK'="" X=$$ASKSTOP^%ZTLOAD(TMTASK)
G QUEOFF1
;
SCHED ; Schedule processor
N DIC,DLAYGO,X,Y,SIEN,DIE,DA,DR,QUEUE,STAT,TMTASK,ENTRY
SCHED1 K DIC S DIC=579.3,DIC(0)="AQE",DIC("A")="Select Request Queue: " W ! D ^DIC Q:Y=-1
K DIC S QUEUE=$P(Y,U) D DISP S DA(1)=QUEUE,DIC="^VDEFHL7(579.3,"_QUEUE_",2,"
S DIC(0)="AQEL",DIC("A")="Select Entry: " D ^DIC G SCHED1:Y=-1
S ENTRY=$P(Y,U),DIE=DIC,DA=ENTRY
S DR=".01;.02;.03;D SCHFORM^VDEFMNU;.04;D SCHFORM^VDEFMNU;.05" D ^DIE
W ! D DISP
;
; Now reschedule the processor task back
S ZTSK=$P(^VDEFHL7(579.3,QUEUE,0),U,8) D ISQED^%ZTLOAD
;
; If old task not found or not running, start it.
I $G(ZTSK("E"))'="" D REQ^VDEFCONT(QUEUE) G SCHED1
I ZTSK(0)=0 D REQ^VDEFCONT(QUEUE) G SCHED1
;
; Task is scheduled, so reschedule it.
K ZTDESC,ZTIO,ZTRTN,ZTSAVE S ZTDTH=$H D REQ^%ZTLOAD
G SCHED1
;
SCHFORM W !,"Enter time in military form as HH:MM"
Q
;
DISP ; Display scheduling rules.
I '$O(^VDEFHL7(579.3,QUEUE,2,0)) W !,"No Scheduling Rules currently defined for this queue"
E S SIEN=0 D
. W !,"Currently defined Scheduling Rules are :"
. F S SIEN=$O(^VDEFHL7(579.3,QUEUE,2,SIEN)) Q:'SIEN D
.. W !,$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.01,"E")
.. W ") On ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.02,"E")
.. W " the request processor is "
.. S STAT=$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.03,"E")
.. W STAT," from ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.04,"I")
.. W " to ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.05,"I")
Q
;
CUSTOD ; Edit Custodial Package Status
N DIC,DLAYGO,X,Y,DIE,DA,DR,PACK
CUSTOD1 K DIC S DIC=579.6,DIC(0)="AQE",DIC("A")="Select Custodial Package: "
W ! D ^DIC Q:Y=-1 S PACK=$P(Y,U)
I $P(Y,U,2)="REGISTRATION" D G CUSTOD1
. W !,"Registration custodial package can't be edited"
I $$GET1^DIQ(579.6,PACK_",",.02,"I")="A" D
. W !!,"Inactivating a custodial package has a significant effect on the"
. W !,"synchronization of VistA and remote system(s). All VDEF requests for HL7"
. W !,"messages associated with this custodial package made while the package is"
. W !,"inactivated will be PERMANENTLY lost. Make sure you really want to turn"
. W !,"this custodial package off.",!
K DIC S DIE=579.6,DA=PACK,DR=".02" D ^DIE
G CUSTOD1
;
EVENT ; Edit VDEF API Event Status
N DIC,DLAYGO,X,Y,DIE,DA,DR,EVENT
EVENT1 K DIC S DIC("W")="N Z,DESC S Z=^(0),DESC=$G(^(1)) W:$P(Z,U,9)'="""" DESC_"" ""_""Status: ""_$S($P(Z,U,11)=""A"":""ACTIVE"",1:""INACTIVE""),!,?8,""Pkg: ""_$P($G(^DIC(9.4,$P($G(^VDEFHL7(579.6,$P(Z,U,9),0),-1),U),0)),U)"
S DIC=577,DIC(0)="AQES",DIC("A")="Select VDEF API Event: "
W ! D ^DIC Q:Y=-1 S EVENT=$P(Y,U)
I $$GET1^DIQ(577,EVENT_",",.2,"I")="A" D
. W !!,"Inactivating a VDEF API event will cause all requests for that"
. W !,"API to be PERMANENTLY lost. Make sure you really want to turn"
. W !,"this API event off.",!
K DIC S DIE=577,DA=EVENT,DR=".2" D ^DIE
G EVENT1
;
REPORT ; Display VDEF status/parameters
N LL,LLN,SUBS,LINX,TNN,TNF,IEN,NZ,VDI,VDJ,VDK,VDA,PROT,STATS,%H,Y
REPORT1 W @IOF,?22,"VDEF Status - " S %H=$H D YX^%DTC W Y
W !,"Logical Link Status" K LINX
S VDI=0 F S VDI=$O(^VDEFHL7(577,VDI)) Q:VDI="" D
. K RES S PROT=$P($G(^VDEFHL7(577,VDI,0)),U,7) Q:PROT=""
. D GETS^DIQ(101,PROT_",","775*","I","RES")
. S VDJ=0 F S VDJ=$O(RES(101.0775,VDJ)) Q:VDJ="" D
.. S SUBS=RES(101.0775,VDJ,.01,"I")
.. I SUBS S LLN=$$GET1^DIQ(101,SUBS_",",770.7,"E") I LLN'="" S LINX(LLN)=1
S LLN=0 F S LLN=$O(LINX(LLN)) Q:LLN="" D
. W !?2,LLN,": " S LL=$O(^HLCS(870,"B",LLN,"")) Q:LL=""
. N ZTSK S ZTSK=$P($G(^HLCS(870,LL,0)),U,12)
. I ZTSK'="" D STAT^%ZTLOAD W:$G(ZTSK(1))=2 "running task #",ZTSK K ZTSK
. E W "stopped or caught up"
W !!,"Requestor Status"
S IEN=0 F S IEN=$O(^VDEFHL7(579.1,IEN)) Q:'IEN D
. S NZ=^VDEFHL7(579.1,IEN,0) W !?2,$P(NZ,U),": "
. W $S($P(NZ,U,5)="A":"Activated",1:"Inactivated")
. W ?32,"Dest.: ",$P(^VDEFHL7(579.2,$P(NZ,U,3),0),U)
. W ?52,"Req. Queue: ",$P(^VDEFHL7(579.3,$P(NZ,U,4),0),U,1)
W !!,"Request Processor Status"
S IEN=0 F S IEN=$O(^VDEFHL7(579.3,IEN)) Q:'IEN D
. S NZ=^VDEFHL7(579.3,IEN,0) W !?2,$P(NZ,U),": "
. W $S($P(NZ,U,9)="R":"Running",1:"Suspended")
. N ZTSK S TNN=$P(NZ,U,11),ZTSK=TNN D STAT^%ZTLOAD
. W !?2,"Current Task # [Proc]: ",TNN
. W " ["_$$CNV^XLFUTL($$JOB^%ZTLOAD(TNN),16)_"]"
. W " Task status: "
. I 'ZTSK(0) W "Undefined"
. E W $S(ZTSK(1)=0:"Undefined",ZTSK(1)=1:"Active-Pending",ZTSK(1)=2:"Active-Running",ZTSK(1)=3:"Finished",ZTSK(1)=4:"Available",ZTSK(1)=5:"Interrupted",1:"Unknown")
. S NZ=$G(^VDEFHL7(579.3,IEN,1,0))
. I NZ="" W !?2,"No requests in the queue"
. E W !?2,"Requests waiting for purge: ",$P(NZ,U,4)," Last request#: ",$P(NZ,U,3)
. S STATS="" W !?2
. F STAT="C","Q","E" D
.. S (VDJ,VDK)=0 F VDJ=0:1:100+(STAT="Q"*900) S VDK=$O(^VDEFHL7(579.3,"C",STAT,IEN,VDK)) Q:VDK=""
.. W $S(STAT="C":"Checked Out",STAT="Q":" Queued Up",STAT="E":" Errored Out")
.. W $S(VDJ<(100+(STAT="Q"*900)):"("_VDJ_")",1:"(> "_(100+(STAT="Q"*900))_")")
;
; Loop added for dashboard monitoring
R !!,"Hit <return/enter> to continue or '^' to terminate: ",VDA:5
Q:VDA="^" G REPORT1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFMNU 7020 printed Sep 11, 2024@03:03:39 Page 2
VDEFMNU ;INTEGIC/YG & BPOIFO/JG - Edit VDEF parameters & status ; 20 Dec 2005 12:57 PM
+1 ;;1.0;VDEF;**3**;Dec 28, 2004;
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; IA's: #4322 - ^HLCS(870,<link>,0)
+5 ; #1373 - Lookup to file #101
+6 ; #10063 - $$JOB^%ZTLOAD
+7 ;
+8 ; No bozos
QUIT
+9 ;
SITE ; Edit Site-Wide Parameters
+1 NEW DA,DIC,DIE,DR
SET DIE=579.5
SET DA=1
SET DR=".01;.02;"
DO ^DIE
+2 QUIT
+3 ;
REQUEST ; Edit Request Queue Parameters
+1 NEW DIC,DLAYGO,X,Y,DIE,DA,DR
REQUEST1 KILL DIC
SET DIC=579.3
SET DIC(0)="AQE"
SET DIC("A")="Select Request Queue: "
WRITE !
DO ^DIC
if Y=-1
QUIT
+1 KILL DIC
SET DIE=579.3
SET DA=$PIECE(Y,U)
SET DR=".04;.05;.02"
DO ^DIE
+2 GOTO REQUEST1
+3 ;
REQOFF ; Toggle Requestor On/Off
+1 NEW DIC,DLAYGO,X,Y,DIE,DA,DR
REQOFF1 KILL DIC
SET DIC=579.1
SET DIC(0)="AQE"
SET DIC("A")="Select Requestor: "
WRITE !
DO ^DIC
if Y=-1
QUIT
+1 IF $$GET1^DIQ(579.1,$PIECE(Y,U)_",",.05,"I")="A"
Begin DoDot:1
+2 WRITE !,!,"Inactivating a requestor has a significant effect on the synchronization"
+3 WRITE !,"of VistA and remote system(s). All VDEF requests made while the requestor"
+4 WRITE !,"is inactive will be PERMANENTLY lost. Make sure you really want to"
+5 WRITE !,"turn it off.",!
End DoDot:1
+6 KILL DIC
SET DIE=579.1
SET DA=$PIECE(Y,U)
SET DR=".05"
DO ^DIE
+7 GOTO REQOFF1
+8 ;
QUEOFF ; Toggle Request Processor Queue on/off
+1 NEW DIC,DLAYGO,X,Y,DIE,DA,DR,QUEUE,STAT,TMTASK
QUEOFF1 KILL DIC
SET DIC=579.3
SET DIC(0)="AQE"
SET DIC("A")="Select Request Queue: "
WRITE !
DO ^DIC
if Y=-1
QUIT
+1 KILL DIC
SET QUEUE=$PIECE(Y,U)
SET DIE=579.3
SET DA=QUEUE
SET DR=".09"
DO ^DIE
+2 ;
+3 ; Get the new status of the Request Processor
+4 SET STAT=$$GET1^DIQ(579.3,QUEUE_",",.09,"I")
+5 ;
+6 ; Start the Request Processor
+7 IF STAT="R"
DO REQ^VDEFCONT(QUEUE)
+8 ;
+9 ; Stop the Request Processor
+10 IF STAT="S"
Begin DoDot:1
+11 SET TMTASK=$$GET1^DIQ(579.3,QUEUE_",",.08,"I")
if TMTASK'=""
SET X=$$ASKSTOP^%ZTLOAD(TMTASK)
+12 SET TMTASK=$$GET1^DIQ(579.3,QUEUE_",",.11,"I")
if TMTASK'=""
SET X=$$ASKSTOP^%ZTLOAD(TMTASK)
End DoDot:1
+13 GOTO QUEOFF1
+14 ;
SCHED ; Schedule processor
+1 NEW DIC,DLAYGO,X,Y,SIEN,DIE,DA,DR,QUEUE,STAT,TMTASK,ENTRY
SCHED1 KILL DIC
SET DIC=579.3
SET DIC(0)="AQE"
SET DIC("A")="Select Request Queue: "
WRITE !
DO ^DIC
if Y=-1
QUIT
+1 KILL DIC
SET QUEUE=$PIECE(Y,U)
DO DISP
SET DA(1)=QUEUE
SET DIC="^VDEFHL7(579.3,"_QUEUE_",2,"
+2 SET DIC(0)="AQEL"
SET DIC("A")="Select Entry: "
DO ^DIC
if Y=-1
GOTO SCHED1
+3 SET ENTRY=$PIECE(Y,U)
SET DIE=DIC
SET DA=ENTRY
+4 SET DR=".01;.02;.03;D SCHFORM^VDEFMNU;.04;D SCHFORM^VDEFMNU;.05"
DO ^DIE
+5 WRITE !
DO DISP
+6 ;
+7 ; Now reschedule the processor task back
+8 SET ZTSK=$PIECE(^VDEFHL7(579.3,QUEUE,0),U,8)
DO ISQED^%ZTLOAD
+9 ;
+10 ; If old task not found or not running, start it.
+11 IF $GET(ZTSK("E"))'=""
DO REQ^VDEFCONT(QUEUE)
GOTO SCHED1
+12 IF ZTSK(0)=0
DO REQ^VDEFCONT(QUEUE)
GOTO SCHED1
+13 ;
+14 ; Task is scheduled, so reschedule it.
+15 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE
SET ZTDTH=$HOROLOG
DO REQ^%ZTLOAD
+16 GOTO SCHED1
+17 ;
SCHFORM WRITE !,"Enter time in military form as HH:MM"
+1 QUIT
+2 ;
DISP ; Display scheduling rules.
+1 IF '$ORDER(^VDEFHL7(579.3,QUEUE,2,0))
WRITE !,"No Scheduling Rules currently defined for this queue"
+2 IF '$TEST
SET SIEN=0
Begin DoDot:1
+3 WRITE !,"Currently defined Scheduling Rules are :"
+4 FOR
SET SIEN=$ORDER(^VDEFHL7(579.3,QUEUE,2,SIEN))
if 'SIEN
QUIT
Begin DoDot:2
+5 WRITE !,$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.01,"E")
+6 WRITE ") On ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.02,"E")
+7 WRITE " the request processor is "
+8 SET STAT=$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.03,"E")
+9 WRITE STAT," from ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.04,"I")
+10 WRITE " to ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.05,"I")
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
CUSTOD ; Edit Custodial Package Status
+1 NEW DIC,DLAYGO,X,Y,DIE,DA,DR,PACK
CUSTOD1 KILL DIC
SET DIC=579.6
SET DIC(0)="AQE"
SET DIC("A")="Select Custodial Package: "
+1 WRITE !
DO ^DIC
if Y=-1
QUIT
SET PACK=$PIECE(Y,U)
+2 IF $PIECE(Y,U,2)="REGISTRATION"
Begin DoDot:1
+3 WRITE !,"Registration custodial package can't be edited"
End DoDot:1
GOTO CUSTOD1
+4 IF $$GET1^DIQ(579.6,PACK_",",.02,"I")="A"
Begin DoDot:1
+5 WRITE !!,"Inactivating a custodial package has a significant effect on the"
+6 WRITE !,"synchronization of VistA and remote system(s). All VDEF requests for HL7"
+7 WRITE !,"messages associated with this custodial package made while the package is"
+8 WRITE !,"inactivated will be PERMANENTLY lost. Make sure you really want to turn"
+9 WRITE !,"this custodial package off.",!
End DoDot:1
+10 KILL DIC
SET DIE=579.6
SET DA=PACK
SET DR=".02"
DO ^DIE
+11 GOTO CUSTOD1
+12 ;
EVENT ; Edit VDEF API Event Status
+1 NEW DIC,DLAYGO,X,Y,DIE,DA,DR,EVENT
EVENT1 KILL DIC
SET DIC("W")="N Z,DESC S Z=^(0),DESC=$G(^(1)) W:$P(Z,U,9)'="""" DESC_"" ""_""Status: ""_$S($P(Z,U,11)=""A"":""ACTIVE"",1:""INACTIVE""),!,?8,""Pkg: ""_$P($G(^DIC(9.4,$P($G(^VDEFHL7(579.6,$P(Z,U,9),0),-1),U),0)),U)"
+1 SET DIC=577
SET DIC(0)="AQES"
SET DIC("A")="Select VDEF API Event: "
+2 WRITE !
DO ^DIC
if Y=-1
QUIT
SET EVENT=$PIECE(Y,U)
+3 IF $$GET1^DIQ(577,EVENT_",",.2,"I")="A"
Begin DoDot:1
+4 WRITE !!,"Inactivating a VDEF API event will cause all requests for that"
+5 WRITE !,"API to be PERMANENTLY lost. Make sure you really want to turn"
+6 WRITE !,"this API event off.",!
End DoDot:1
+7 KILL DIC
SET DIE=577
SET DA=EVENT
SET DR=".2"
DO ^DIE
+8 GOTO EVENT1
+9 ;
REPORT ; Display VDEF status/parameters
+1 NEW LL,LLN,SUBS,LINX,TNN,TNF,IEN,NZ,VDI,VDJ,VDK,VDA,PROT,STATS,%H,Y
REPORT1 WRITE @IOF,?22,"VDEF Status - "
SET %H=$HOROLOG
DO YX^%DTC
WRITE Y
+1 WRITE !,"Logical Link Status"
KILL LINX
+2 SET VDI=0
FOR
SET VDI=$ORDER(^VDEFHL7(577,VDI))
if VDI=""
QUIT
Begin DoDot:1
+3 KILL RES
SET PROT=$PIECE($GET(^VDEFHL7(577,VDI,0)),U,7)
if PROT=""
QUIT
+4 DO GETS^DIQ(101,PROT_",","775*","I","RES")
+5 SET VDJ=0
FOR
SET VDJ=$ORDER(RES(101.0775,VDJ))
if VDJ=""
QUIT
Begin DoDot:2
+6 SET SUBS=RES(101.0775,VDJ,.01,"I")
+7 IF SUBS
SET LLN=$$GET1^DIQ(101,SUBS_",",770.7,"E")
IF LLN'=""
SET LINX(LLN)=1
End DoDot:2
End DoDot:1
+8 SET LLN=0
FOR
SET LLN=$ORDER(LINX(LLN))
if LLN=""
QUIT
Begin DoDot:1
+9 WRITE !?2,LLN,": "
SET LL=$ORDER(^HLCS(870,"B",LLN,""))
if LL=""
QUIT
+10 NEW ZTSK
SET ZTSK=$PIECE($GET(^HLCS(870,LL,0)),U,12)
+11 IF ZTSK'=""
DO STAT^%ZTLOAD
if $GET(ZTSK(1))=2
WRITE "running task #",ZTSK
KILL ZTSK
+12 IF '$TEST
WRITE "stopped or caught up"
End DoDot:1
+13 WRITE !!,"Requestor Status"
+14 SET IEN=0
FOR
SET IEN=$ORDER(^VDEFHL7(579.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+15 SET NZ=^VDEFHL7(579.1,IEN,0)
WRITE !?2,$PIECE(NZ,U),": "
+16 WRITE $SELECT($PIECE(NZ,U,5)="A":"Activated",1:"Inactivated")
+17 WRITE ?32,"Dest.: ",$PIECE(^VDEFHL7(579.2,$PIECE(NZ,U,3),0),U)
+18 WRITE ?52,"Req. Queue: ",$PIECE(^VDEFHL7(579.3,$PIECE(NZ,U,4),0),U,1)
End DoDot:1
+19 WRITE !!,"Request Processor Status"
+20 SET IEN=0
FOR
SET IEN=$ORDER(^VDEFHL7(579.3,IEN))
if 'IEN
QUIT
Begin DoDot:1
+21 SET NZ=^VDEFHL7(579.3,IEN,0)
WRITE !?2,$PIECE(NZ,U),": "
+22 WRITE $SELECT($PIECE(NZ,U,9)="R":"Running",1:"Suspended")
+23 NEW ZTSK
SET TNN=$PIECE(NZ,U,11)
SET ZTSK=TNN
DO STAT^%ZTLOAD
+24 WRITE !?2,"Current Task # [Proc]: ",TNN
+25 WRITE " ["_$$CNV^XLFUTL($$JOB^%ZTLOAD(TNN),16)_"]"
+26 WRITE " Task status: "
+27 IF 'ZTSK(0)
WRITE "Undefined"
+28 IF '$TEST
WRITE $SELECT(ZTSK(1)=0:"Undefined",ZTSK(1)=1:"Active-Pending",ZTSK(1)=2:"Active-Running",ZTSK(1)=3:"Finished",ZTSK(1)=4:"Available",ZTSK(1)=5:"Interrupted",1:"Unknown")
+29 SET NZ=$GET(^VDEFHL7(579.3,IEN,1,0))
+30 IF NZ=""
WRITE !?2,"No requests in the queue"
+31 IF '$TEST
WRITE !?2,"Requests waiting for purge: ",$PIECE(NZ,U,4)," Last request#: ",$PIECE(NZ,U,3)
+32 SET STATS=""
WRITE !?2
+33 FOR STAT="C","Q","E"
Begin DoDot:2
+34 SET (VDJ,VDK)=0
FOR VDJ=0:1:100+(STAT="Q"*900)
SET VDK=$ORDER(^VDEFHL7(579.3,"C",STAT,IEN,VDK))
if VDK=""
QUIT
+35 WRITE $SELECT(STAT="C":"Checked Out",STAT="Q":" Queued Up",STAT="E":" Errored Out")
+36 WRITE $SELECT(VDJ<(100+(STAT="Q"*900)):"("_VDJ_")",1:"(> "_(100+(STAT="Q"*900))_")")
End DoDot:2
End DoDot:1
+37 ;
+38 ; Loop added for dashboard monitoring
+39 READ !!,"Hit <return/enter> to continue or '^' to terminate: ",VDA:5
+40 if VDA="^"
QUIT
GOTO REPORT1
