VDEFCONT ;INTEGIC/AM & BPOIFO/JG - VDEF CONTROL PROGRAM ; 16 Nov 2005 1:08 PM
;;1.0;VDEF;**3**;Dec 28, 2004
;Per VHA Directive 2004-038, this routine should not be modified.
;
; IA: 10063 - $$S^%ZTLOAD
; 10063 - $$ASKSTOP^%ZTLOAD
;
Q ; No bozos
;
START ; Main entry point for scheduling queue processor jobs at Taskman
; Startup time
I '$D(ZTQUEUED) W !,"Must be run from TaskMan." Q
;
; Start Request Queue processors
N QIEN F QIEN=0:0 S QIEN=$O(^VDEFHL7(579.3,QIEN)) Q:'QIEN D REQ(QIEN)
;
; Start the checked out request monitor job
D MONCHKO
;
; Start the Request Queue processor monitor job
D START^VDEFMON
Q
;
MONCHKO ; Start the VDEF job to monitor checked out requests
N ARR,ERR,FDA,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSK
;
; Check the status of the last VDEF Monitor task.
D GETS^DIQ(579.5,"1,",".01;.02;.06","I","ARR","ERR")
; Don't start a new one if old one is scheduled.
S ZTSK=+$G(ARR(579.5,"1,",.06,"I")) D STAT^%ZTLOAD
I ZTSK(1)=1 Q
;
; Schedule a new task.
S ZTRTN="MONITOR^VDEFCONT",ZTDESC="VDEF Checked Out Monitor"
;
; Calculate when to run the VDEF Monitor next time
S ZTDTH=$$FUTURE^VDEFUTIL($G(ARR(579.5,"1,",.02,"I")))
S (ZTPRI,ZTIO)=""
D ^%ZTLOAD
;
; Check that TaskMan successfully queued up the Monitor task
I '$G(ZTSK) D ALERT^VDEFUTIL("VDEF CHECKED OUT MONITOR FAILED TO START. CHECK ERROR TRAP.")
;
; File the task number of the task that has been queued up
I $G(ZTSK) S FDA(1,579.5,"1,",.06)=ZTSK D FILE^DIE("","FDA(1)","ERR(1)")
Q
;
MONITOR ; VDEF monitor task, executed on a schedule determined by queue
; parameter 'CHECK OUT TIME LIMIT'. Checks for potentially hung
; 'Checked Out' entries in the Request Queues
;
N QIEN S (ZTSTOP,QIEN)=0
F S QIEN=$O(^VDEFHL7(579.3,"C","C",QIEN)) Q:'QIEN D Q:ZTSTOP
. N IEN,LIMIT,QUEUE,QUEUENAM,QUIT
. ;
. ; Retrieve queue data
. D GETS^DIQ(579.3,QIEN_",",".01;.04;.05","I","QUEUE","ERR")
. S QUEUENAM=$G(QUEUE(579.3,QIEN_",",.01,"I"))
. ;
. ; Check-out Time Limit in seconds
. S LIMIT=$G(QUEUE(579.3,QIEN_",",.05,"I"))
. ;
. ; Get a list of currently Checked-out Requests in this queue
. S IEN=0 F S IEN=$O(^VDEFHL7(579.3,"C","C",QIEN,IEN)) Q:'IEN D Q:ZTSTOP
.. S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
.. N CHECKOUT,ENTRY,ERR,FDA
.. ;
.. ; Get the related data for the request
.. D GETS^DIQ(579.31,IEN_","_QIEN_",",".01;.02;.09;.15","I","ENTRY","ERR")
.. ;
.. ; Quit if Vista HL7 IRM already notified or if status is not "C"
.. Q:$G(ENTRY(579.31,IEN_","_QIEN_",",.15,"I"))'=""
.. Q:$G(ENTRY(579.31,IEN_","_QIEN_",",.02,"I"))'="C"
.. ;
.. ; Get the date when the request was checked out and compare with
.. ; CHECK OUT TIME LIMIT parameter.
.. S CHECKOUT=$G(ENTRY(579.31,IEN_","_QIEN_",",.09,"I"))
.. ;
.. ; If no checkout time, don't create a false alert.
.. Q:'CHECKOUT
.. Q:$$DIFF^VDEFUTIL(CHECKOUT,$H)'>LIMIT
.. ;
.. ; Request appears hung. Send a message to the Vista HL7 IRM.
.. D ALERT^VDEFUTIL("RECORD "_IEN_" IN VDEF QUEUE '"_$E(QUEUENAM,1,35)_"' HUNG IN CHECKED OUT STATUS.")
.. ;
.. ; Update the time stamp in the entry so that the VDEF Monitor
.. ; doesn't notify the Vista HL7 IRM more than once.
.. L +^VDEFHL7(579.3,QIEN,IEN)
.. D NOW^%DTC S FDA(1,579.31,IEN_","_QIEN_",",.15)=%
.. D FILE^DIE("","FDA(1)","ERR(1)")
.. L -^VDEFHL7(579.3,QIEN,IEN)
.. Q
;
; Check if TaskMan requested a stop
I ZTSTOP S X=$$ASKSTOP^%ZTLOAD(ZTSK),ZTREQ="@" Q
;
PURGE ; Purge old entries in Request Queues
S (ZTSTOP,QIEN)=0
F S QIEN=$O(^VDEFHL7(579.3,"C","P",QIEN)) Q:'QIEN D Q:ZTSTOP
. N ARCH,IEN,QUEUE,QUIT
. ; Retrieve queue data
. D GETS^DIQ(579.3,QIEN_",",".04","I","QUEUE","ERR")
. ; Retrieve the queue's Archival Parameter (in seconds)
. S ARCH=$G(QUEUE(579.3,QIEN_",",.04,"I"))
. ; Initialize the flag that indicates whether the oldest Processed
. ; entry in a given Request Queue is too recent to be purged
. S QUIT=0
. ; Loop through the list of "P"rocesses entries in this Request
. ; Queue, starting with the oldest
. F IEN=0:0 S IEN=$O(^VDEFHL7(579.3,"C","P",QIEN,IEN)) Q:'IEN D Q:QUIT!ZTSTOP
.. S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
.. N DTS,ENTRY,ERR,FDA
.. ; Get this entry's data
.. D GETS^DIQ(579.31,IEN_","_QIEN_",",".13","I","ENTRY","ERR")
.. I $D(ERR) ; Add error processing here
.. ; Retrieve the DTS when the Request was "P"rocessed
.. S DTS=$G(ENTRY(579.31,IEN_","_QIEN_",",.13,"I"))
.. ; Calculate how long it has been since this Request was "P"rocessed
.. ; and, if the Request is more recent than the Archival Parameter
.. ; for this Queue, set the "Quit" flag and stop processing the Queue
.. I $$DIFF^VDEFUTIL(DTS,$H)<ARCH S QUIT=1 Q
.. ; If we are here, then the entry is older than allowed by the
.. ; Archival Parameter - purge this entry from the Request Queue
.. S FDA(1,579.31,IEN_","_QIEN_",",.01)="@"
.. D FILE^DIE("","FDA(1)","ERR(1)")
;
; Stop if TaskMan requested
I ZTSTOP S X=$$ASKSTOP^%ZTLOAD(ZTSK),ZTREQ="@" Q
;
; Reschedule VDEF checked out monitor
D MONCHKO
S ZTREQ="@"
Q
;
REQ(QIEN) ; Start a Request Queue Processor task for a single queue
; Try locking the Request Queue - if we fail, then there is
; another Request Processor currently holding the lock, so skip it
L +^VDEFHL7(579.3,"QUEUE",QIEN):3 Q:'$T
N ERR,FDA,QNAME,QUEUE,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSAVE,ZTSK
; Retrieve queue data
D GETS^DIQ(579.3,QIEN_",",".01;.02;.07;.08;.09","I","QUEUE","ERR")
; If this Request Queue is suspended, quit
I $G(QUEUE(579.3,QIEN_",",.09,"I"))="S" G REQX
; TaskMan task number of the last Request Processor task for this queue
S ZTSK=+$G(QUEUE(579.3,QIEN_",",.08,"I"))
; Check the status of the last Request Processor task
D STAT^%ZTLOAD
; If the task is scheduled to run, then don't submit a new one - this
; means that the system is coming back after a restart which occurred
; while an old Request Processor task was scheduled for running
I ZTSK(1)=1 G REQX
;
; Create TaskMan variables
S ZTRTN="EN^VDEFREQ",(ZTIO,ZTPRI)=""
S QNAME=$G(QUEUE(579.3,QIEN_",",.01,"I"))
S ZTDESC="VDEF Request Processor for "_QNAME
S ZTSAVE("QIEN")=QIEN,ZTDTH=$H
D ^%ZTLOAD
; Check that TaskMan created the task.
I '$G(ZTSK) D ALERT^VDEFUTIL("VDEF REQUEST PROCESS "_$E(QNAME,1,20)_" FAILED TO START. CHECK ERROR TRAP.")
; File the task number of the task that has been queued up
I $G(ZTSK) D
. S FDA(1,579.3,QIEN_",",.08)=ZTSK
. D FILE^DIE("","FDA(1)","ERR(1)")
REQX L -^VDEFHL7(579.3,"QUEUE",QIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFCONT 6612 printed Apr 09, 2024@21:46:19 Page 2
VDEFCONT ;INTEGIC/AM & BPOIFO/JG - VDEF CONTROL PROGRAM ; 16 Nov 2005 1:08 PM
+1 ;;1.0;VDEF;**3**;Dec 28, 2004
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; IA: 10063 - $$S^%ZTLOAD
+5 ; 10063 - $$ASKSTOP^%ZTLOAD
+6 ;
+7 ; No bozos
QUIT
+8 ;
START ; Main entry point for scheduling queue processor jobs at Taskman
+1 ; Startup time
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Must be run from TaskMan."
QUIT
+3 ;
+4 ; Start Request Queue processors
+5 NEW QIEN
FOR QIEN=0:0
SET QIEN=$ORDER(^VDEFHL7(579.3,QIEN))
if 'QIEN
QUIT
DO REQ(QIEN)
+6 ;
+7 ; Start the checked out request monitor job
+8 DO MONCHKO
+9 ;
+10 ; Start the Request Queue processor monitor job
+11 DO START^VDEFMON
+12 QUIT
+13 ;
MONCHKO ; Start the VDEF job to monitor checked out requests
+1 NEW ARR,ERR,FDA,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSK
+2 ;
+3 ; Check the status of the last VDEF Monitor task.
+4 DO GETS^DIQ(579.5,"1,",".01;.02;.06","I","ARR","ERR")
+5 ; Don't start a new one if old one is scheduled.
+6 SET ZTSK=+$GET(ARR(579.5,"1,",.06,"I"))
DO STAT^%ZTLOAD
+7 IF ZTSK(1)=1
QUIT
+8 ;
+9 ; Schedule a new task.
+10 SET ZTRTN="MONITOR^VDEFCONT"
SET ZTDESC="VDEF Checked Out Monitor"
+11 ;
+12 ; Calculate when to run the VDEF Monitor next time
+13 SET ZTDTH=$$FUTURE^VDEFUTIL($GET(ARR(579.5,"1,",.02,"I")))
+14 SET (ZTPRI,ZTIO)=""
+15 DO ^%ZTLOAD
+16 ;
+17 ; Check that TaskMan successfully queued up the Monitor task
+18 IF '$GET(ZTSK)
DO ALERT^VDEFUTIL("VDEF CHECKED OUT MONITOR FAILED TO START. CHECK ERROR TRAP.")
+19 ;
+20 ; File the task number of the task that has been queued up
+21 IF $GET(ZTSK)
SET FDA(1,579.5,"1,",.06)=ZTSK
DO FILE^DIE("","FDA(1)","ERR(1)")
+22 QUIT
+23 ;
MONITOR ; VDEF monitor task, executed on a schedule determined by queue
+1 ; parameter 'CHECK OUT TIME LIMIT'. Checks for potentially hung
+2 ; 'Checked Out' entries in the Request Queues
+3 ;
+4 NEW QIEN
SET (ZTSTOP,QIEN)=0
+5 FOR
SET QIEN=$ORDER(^VDEFHL7(579.3,"C","C",QIEN))
if 'QIEN
QUIT
Begin DoDot:1
+6 NEW IEN,LIMIT,QUEUE,QUEUENAM,QUIT
+7 ;
+8 ; Retrieve queue data
+9 DO GETS^DIQ(579.3,QIEN_",",".01;.04;.05","I","QUEUE","ERR")
+10 SET QUEUENAM=$GET(QUEUE(579.3,QIEN_",",.01,"I"))
+11 ;
+12 ; Check-out Time Limit in seconds
+13 SET LIMIT=$GET(QUEUE(579.3,QIEN_",",.05,"I"))
+14 ;
+15 ; Get a list of currently Checked-out Requests in this queue
+16 SET IEN=0
FOR
SET IEN=$ORDER(^VDEFHL7(579.3,"C","C",QIEN,IEN))
if 'IEN
QUIT
Begin DoDot:2
+17 SET ZTSTOP=$$S^%ZTLOAD()
if ZTSTOP
QUIT
+18 NEW CHECKOUT,ENTRY,ERR,FDA
+19 ;
+20 ; Get the related data for the request
+21 DO GETS^DIQ(579.31,IEN_","_QIEN_",",".01;.02;.09;.15","I","ENTRY","ERR")
+22 ;
+23 ; Quit if Vista HL7 IRM already notified or if status is not "C"
+24 if $GET(ENTRY(579.31,IEN_","_QIEN_",",.15,"I"))'=""
QUIT
+25 if $GET(ENTRY(579.31,IEN_","_QIEN_",",.02,"I"))'="C"
QUIT
+26 ;
+27 ; Get the date when the request was checked out and compare with
+28 ; CHECK OUT TIME LIMIT parameter.
+29 SET CHECKOUT=$GET(ENTRY(579.31,IEN_","_QIEN_",",.09,"I"))
+30 ;
+31 ; If no checkout time, don't create a false alert.
+32 if 'CHECKOUT
QUIT
+33 if $$DIFF^VDEFUTIL(CHECKOUT,$HOROLOG)'>LIMIT
QUIT
+34 ;
+35 ; Request appears hung. Send a message to the Vista HL7 IRM.
+36 DO ALERT^VDEFUTIL("RECORD "_IEN_" IN VDEF QUEUE '"_$EXTRACT(QUEUENAM,1,35)_"' HUNG IN CHECKED OUT STATUS.")
+37 ;
+38 ; Update the time stamp in the entry so that the VDEF Monitor
+39 ; doesn't notify the Vista HL7 IRM more than once.
+40 LOCK +^VDEFHL7(579.3,QIEN,IEN)
+41 DO NOW^%DTC
SET FDA(1,579.31,IEN_","_QIEN_",",.15)=%
+42 DO FILE^DIE("","FDA(1)","ERR(1)")
+43 LOCK -^VDEFHL7(579.3,QIEN,IEN)
+44 QUIT
End DoDot:2
if ZTSTOP
QUIT
End DoDot:1
if ZTSTOP
QUIT
+45 ;
+46 ; Check if TaskMan requested a stop
+47 IF ZTSTOP
SET X=$$ASKSTOP^%ZTLOAD(ZTSK)
SET ZTREQ="@"
QUIT
+48 ;
PURGE ; Purge old entries in Request Queues
+1 SET (ZTSTOP,QIEN)=0
+2 FOR
SET QIEN=$ORDER(^VDEFHL7(579.3,"C","P",QIEN))
if 'QIEN
QUIT
Begin DoDot:1
+3 NEW ARCH,IEN,QUEUE,QUIT
+4 ; Retrieve queue data
+5 DO GETS^DIQ(579.3,QIEN_",",".04","I","QUEUE","ERR")
+6 ; Retrieve the queue's Archival Parameter (in seconds)
+7 SET ARCH=$GET(QUEUE(579.3,QIEN_",",.04,"I"))
+8 ; Initialize the flag that indicates whether the oldest Processed
+9 ; entry in a given Request Queue is too recent to be purged
+10 SET QUIT=0
+11 ; Loop through the list of "P"rocesses entries in this Request
+12 ; Queue, starting with the oldest
+13 FOR IEN=0:0
SET IEN=$ORDER(^VDEFHL7(579.3,"C","P",QIEN,IEN))
if 'IEN
QUIT
Begin DoDot:2
+14 SET ZTSTOP=$$S^%ZTLOAD()
if ZTSTOP
QUIT
+15 NEW DTS,ENTRY,ERR,FDA
+16 ; Get this entry's data
+17 DO GETS^DIQ(579.31,IEN_","_QIEN_",",".13","I","ENTRY","ERR")
+18 ; Add error processing here
IF $DATA(ERR)
+19 ; Retrieve the DTS when the Request was "P"rocessed
+20 SET DTS=$GET(ENTRY(579.31,IEN_","_QIEN_",",.13,"I"))
+21 ; Calculate how long it has been since this Request was "P"rocessed
+22 ; and, if the Request is more recent than the Archival Parameter
+23 ; for this Queue, set the "Quit" flag and stop processing the Queue
+24 IF $$DIFF^VDEFUTIL(DTS,$HOROLOG)<ARCH
SET QUIT=1
QUIT
+25 ; If we are here, then the entry is older than allowed by the
+26 ; Archival Parameter - purge this entry from the Request Queue
+27 SET FDA(1,579.31,IEN_","_QIEN_",",.01)="@"
+28 DO FILE^DIE("","FDA(1)","ERR(1)")
End DoDot:2
if QUIT!ZTSTOP
QUIT
End DoDot:1
if ZTSTOP
QUIT
+29 ;
+30 ; Stop if TaskMan requested
+31 IF ZTSTOP
SET X=$$ASKSTOP^%ZTLOAD(ZTSK)
SET ZTREQ="@"
QUIT
+32 ;
+33 ; Reschedule VDEF checked out monitor
+34 DO MONCHKO
+35 SET ZTREQ="@"
+36 QUIT
+37 ;
REQ(QIEN) ; Start a Request Queue Processor task for a single queue
+1 ; Try locking the Request Queue - if we fail, then there is
+2 ; another Request Processor currently holding the lock, so skip it
+3 LOCK +^VDEFHL7(579.3,"QUEUE",QIEN):3
if '$TEST
QUIT
+4 NEW ERR,FDA,QNAME,QUEUE,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSAVE,ZTSK
+5 ; Retrieve queue data
+6 DO GETS^DIQ(579.3,QIEN_",",".01;.02;.07;.08;.09","I","QUEUE","ERR")
+7 ; If this Request Queue is suspended, quit
+8 IF $GET(QUEUE(579.3,QIEN_",",.09,"I"))="S"
GOTO REQX
+9 ; TaskMan task number of the last Request Processor task for this queue
+10 SET ZTSK=+$GET(QUEUE(579.3,QIEN_",",.08,"I"))
+11 ; Check the status of the last Request Processor task
+12 DO STAT^%ZTLOAD
+13 ; If the task is scheduled to run, then don't submit a new one - this
+14 ; means that the system is coming back after a restart which occurred
+15 ; while an old Request Processor task was scheduled for running
+16 IF ZTSK(1)=1
GOTO REQX
+17 ;
+18 ; Create TaskMan variables
+19 SET ZTRTN="EN^VDEFREQ"
SET (ZTIO,ZTPRI)=""
+20 SET QNAME=$GET(QUEUE(579.3,QIEN_",",.01,"I"))
+21 SET ZTDESC="VDEF Request Processor for "_QNAME
+22 SET ZTSAVE("QIEN")=QIEN
SET ZTDTH=$HOROLOG
+23 DO ^%ZTLOAD
+24 ; Check that TaskMan created the task.
+25 IF '$GET(ZTSK)
DO ALERT^VDEFUTIL("VDEF REQUEST PROCESS "_$EXTRACT(QNAME,1,20)_" FAILED TO START. CHECK ERROR TRAP.")
+26 ; File the task number of the task that has been queued up
+27 IF $GET(ZTSK)
Begin DoDot:1
+28 SET FDA(1,579.3,QIEN_",",.08)=ZTSK
+29 DO FILE^DIE("","FDA(1)","ERR(1)")
End DoDot:1
REQX LOCK -^VDEFHL7(579.3,"QUEUE",QIEN)
+1 QUIT
