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

VDEFCONT.m

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