MAGQCBP ;WOIFO/RP,JSL - Background Processor Queue Processor Monitor ; 28 JUL 2014 3:25 PM
;;3.0;IMAGING;**39,154**;Mar 19, 2002;Build 9;JUL 28, 2014
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
; This Code evaluates whether the last queue processed or the queuing of the next queue is the later event
; So if and only if there is a queue waiting to be processed and that queue has been clear to be processed
; for a period of 15 minutes then and only then would a message event be triggered (See message event BPMSG)
CBP(MIN) ;Entry point for job to check the BP queue processing activity
; I Suggest 15 minutes as a reasonably sensitive value; value is site configurable
; An additional alert has been added for failed queues over 1K
N DATA,FQLIM,LASTDT,LQP,NQ,NQP,QU,SPAN,PL,WS,WSNAME
;Variable MAGEVAL, MAGMIN & FQLIM are site configurable when scheduling the task.
S FQLIM=$S(+$G(MAGFQ)>0:MAGFQ,1:1000) ;T23 was setting to 1k if MAGFQ was less than 1k
S MIN=$S(+$G(MAGMIN)>0:MAGMIN,1:+$G(MIN))
S MAGEVAL=$S(+$G(MAGEVAL)>0:MAGEVAL,1:10000) ;this variable will be used for reviewing EVAL queues
S U="^",PL=0
F S PL=$O(^MAG(2006.1,PL)) Q:'PL D
. S WS=0,WSNAME=""
. F S WSNAME=$O(^MAG(2006.8,"C",PL,WSNAME)) Q:WSNAME="" D
. . S WS=$O(^MAG(2006.8,"C",PL,WSNAME,"")) Q:'WS
. . ; quit if this bp has not been active today - removed because we only report on active BP Servers
. . ;Q:$P($P($G(^MAG(2006.8,WS,1)),U,5),"@",1)'=$P($$FMTE^XLFDT($$NOW^XLFDT),"@",1)
. . S NQP=$$NQP(WS,PL,.NQ),RETURN=0
. . I NQP>0 D
. . . Q:WSNAME="Unassigned Tasks"
. . . S LQP=$$LQP(WS,PL)
. . . S SPAN=$S(LQP>NQP:LQP,1:NQP)
. . . D CNT(NQ,PL,.RETURN) ; get counts for message.
. . . I $$NOW^XLFDT>$$FMADD^XLFDT(SPAN,"","",MIN,"") D BPMSG(PL,WSNAME,MIN,NQ,LQP,NQP,RETURN)
. . . Q
. . Q
. D:+PL FAILQ(PL,FQLIM)
. D:+PL EVALQ(PL,MAGEVAL)
. D:+PL CAUTO(PL) ; check for scheduled Purge and Verifier
. D:+PL CISU(PL) ; check for active Imaging Site Usage task
. Q
K MAGEVAL,MAGMIN,MAGFQ ;Variables passed from scheduled task
Q
LQP(WS,PLACE) ; Returns the date and time of the Last Queue Processed by this BP Server
N LDATE,QI,QP,TDATE,ZNODE,QUE,QSTR
S QSTR="^^^^^^^^^^^^ABSTRACT^JUKEBOX^JBTOHD^PREFET^IMPORT^GCC^^^^^DELETE^"
S ZNODE=$G(^MAG(2006.8,WS,0))
S LDATE=0
;Priority: JBTOHD, PREFET, ABSTRACT, IMPORT JUKEBOX, DELETE and GCC
F QI=15,16,13,17,14,23,18 D:$P(ZNODE,U,QI)
. S QUE=$P(QSTR,U,QI)
. S QP=$O(^MAGQUEUE(2006.031,"C",PLACE,QUE,"")) Q:'QP
. S TDATE=$P($G(^MAGQUEUE(2006.031,QP,0)),U,6)
. I TDATE>LDATE S LDATE=TDATE
. Q
Q LDATE
NQP(WS,PLACE,NQ) ; Returns the date and time that the next queue to be processed by this BP Server was queued
N LDATE,QCNT,QI,QP,TDATE,ZNODE,QUEIEN
S QSTR="^^^^^^^^^^^^ABSTRACT^JUKEBOX^JBTOHD^PREFET^IMPORT^GCC^^^^^DELETE^"
S ZNODE=$G(^MAG(2006.8,WS,0))
S TDATE=0
;Priority: JBTOHD, PREFET, ABSTRACT, IMPORT JUKEBOX, DELETE and GCC
F QI=15,16,13,17,14,23,18 Q:'QI I $P(ZNODE,U,QI) D Q:TDATE>0
. S NQ=$P(QSTR,U,QI)
. S QP=$O(^MAGQUEUE(2006.031,"C",PLACE,NQ,"")) Q:'QP
. Q:'+$P(^MAGQUEUE(2006.031,QP,0),U,3) ; Queue count - no entries
. I +$P(^MAGQUEUE(2006.031,QP,0),U,3) D ;Queue count
. . S QUEIEN=$P($G(^MAGQUEUE(2006.031,QP,0)),U,2)
. . S TDATE=$P($G(^MAGQUEUE(2006.03,QP,0)),U,4)
. . I '+TDATE S TDATE=$$NQENTRY(NQ,PLACE)
. . ;above line is needed - if queien value doesn't exist in the 2006.03
. . ;then get the next entry using x-ref "D","NOT_Processed" for queue type.
. Q
Q TDATE
BPMSG(PLACE,WS,MIN,NQ,LASTDT,NQDATE,DATA) ;
N MSG,TMP,SITE
S MSG="VistA Imaging BP Server, "_WS_", has failed to process"
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="a "_NQ_" queue within "_MIN_" minutes."
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="The last date/time a queue was processed was on: "_$$FMTE^XLFDT(LASTDT,1)
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="The next queue to process was created on: "_$$FMTE^XLFDT(NQDATE,1)
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="Total "_NQ_" queues is: "_$P(DATA,U,2)_"."
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S SITE=$P($G(^MAG(2006.1,PLACE,0)),U,1) S:(SITE'="") SITE=$$LKUP^XUAF4(SITE) ;Get Division #
S TMP=$$GET1^DIQ(4,SITE,.01,"E")
S MSG="This BP Queue processor was supporting the VI implementation serving: "_TMP_"."
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="VI_BP_Queue_Processor_failure"
D DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP")
Q
BMSGF(PLACE,WS,NQ,DATA) ;
N MSG,TMP,SITE
;DATA=FAILQUECNT_U_QUEUE CNT_U_TOTAL QUE TYPE
S MSG="VistA Imaging BP Server "_WS_" has "_NQ_" failed queues ("_$P(DATA,U)_")."
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="Please review this BP server activity."
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="The last date/time this queue was processed was on: "_$$FMTE^XLFDT($P(DATA,U,4))_"."
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S SITE=$P($G(^MAG(2006.1,PLACE,0)),U,1) S:(SITE'="") SITE=$$LKUP^XUAF4(SITE) ;Get Division #
S TMP=$$GET1^DIQ(4,SITE,.01,"E") ;IA fix
S MSG="This BP Queue processor was supporting the VI implementation serving: "_TMP
D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
S MSG="VI_BP_Queue_Processor_failure"
D DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP")
Q
CAUTO(PLACE) ;
N ASSIGN,BPPURGE,BPTIME,BPVER,MSG,NODE5,TMP,AUTO,SITE
S BPPURGE=$G(^MAG(2006.1,PLACE,"BPPURGE")),BPTIME=0
S ASSIGN=$$GTASK(PLACE,3),ASSIGN=$S(ASSIGN["is not currently assigned":0,1:1)
; ASSIGN is a flag whether the AUTO PURGE task has been assigned to a BP Server.
I +$P(BPPURGE,U,6),+ASSIGN D ; If Scheduled is ON (#62.5) and assigned to a BP Server.
. ; Add 20 min to schedule time to compensate the BP to perform MAGQ FS CHNGE.
. S BPTIME=$P(BPPURGE,U,10)_"."_$P(BPPURGE,U,11) Q:'+BPTIME S BPTIME=$$FMADD^XLFDT(BPTIME,"","",21)
. Q:($$NOW^XLFDT)<BPTIME
. ;DATE OF SCHEDULED PURGE (#61.3) & SCHEDULED PURGE TIME (#61.4) of SITE PARAMETERS (2006.1)
. I ($$NOW^XLFDT)>BPTIME D ;2006.1
. . Q:($P(BPPURGE,U,7)=$P(BPPURGE,U,10)) ; DATE OF LAST PURGE (#61.1) & DATE OF SCHEDULED PURGE (#61.3) of SITE PARAMETERS 2006.1 - Purge active
. . S SITE=$P($G(^MAG(2006.1,PLACE,0)),U,1) S:(SITE'="") SITE=$$LKUP^XUAF4(SITE) ;Get Division #
. . S TMP=$$GET1^DIQ(4,SITE,.01,"E")
. . S MSG="The "_TMP_" implementation of VistA Imaging has failed to start the schedule Purge activity!"
. . D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
. . S MSG="The task is currently assigned to BP Server: "_$$GTASK(PLACE,3) ;AUTO PURGE is assigned to BP Server field #3
. . D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
. . S MSG="Scheduled_Purge_failure"
. . D DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP") ; Send
. . Q
. Q
S BPVER=$G(^MAG(2006.1,PLACE,"BPVERIFIER")),BPTIME=0
S ASSIGN=$$GTASK(PLACE,4),ASSIGN=$S(ASSIGN["is not currently assigned":0,1:1)
I $P(BPVER,U,1),+ASSIGN D ; If Scheduled Verifier is ON (#62) and assigned to a BP Server ;
. ; DATE OF SCHEDULED VERIFY (#62.3) & SCHEDULED VERIFIER TIME (62.4) of SITE PARAMETERS 2006.1
. ; Add 20 min to schedule time to compensate the BP to perform MAGQ FS CHNGE.
. S BPTIME=($P(BPVER,U,4)_"."_$P(BPVER,U,5)) Q:'+BPTIME S BPTIME=$$FMADD^XLFDT(BPTIME,"","",21)
. Q:($$NOW^XLFDT)<BPTIME
. I ($$NOW^XLFDT)>BPTIME D
. . ;Quit if the verifier has already processed.
. . Q:($P(BPVER,U,2)=$P(BPVER,U,4)) ; DATE OF LAST VERIFY (#62.1) & DATE OF SCHEDULED VERIFY (#62.3) - Verifier is active
. . S SITE=$P($G(^MAG(2006.1,PLACE,0)),U,1) S:(SITE'="") SITE=$$LKUP^XUAF4(SITE) ;Get Division #
. . S TMP=$$GET1^DIQ(4,SITE,.01,"E")
. . S MSG="The "_TMP_" implementation of VistA Imaging has failed to start the schedule Verifier activity!"
. . D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
. . S MSG="The task is currently assigned to BP Server: "_$$GTASK(PLACE,4) ;AUTO VERIFY is assigned to BP Server field #3
. . D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
. . S MSG="Scheduled_Verifier_failure"
. . D DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP") ; Send
. . Q
. Q
Q
GTASK(PLACE,TASK) ;
;AUTO PURGE(3), AUTO VERIFY(4), ABSTRACT(12), JUKEBOX(13), JBTOHD(14), PREFET(15), IMPORT(16), GCC(17), DELETE(20)
N MAGFLD,IEN,WS,ASSIGNED,WSIEN
S ASSIGNED=0
D FIELD^DID(2006.8,TASK,"","LABEL","MAGFLD")
S WS="" F S WS=$O(^MAG(2006.8,"C",PLACE,WS)) Q:WS="" D Q:ASSIGNED
. Q:($$UPPER^MAGQE4(WS)="UNASSIGNED TASKS")
. S WSIEN=$O(^MAG(2006.8,"C",PLACE,WS,""))
. S ASSIGNED=+$$GET1^DIQ(2006.8,WSIEN_",",TASK,"I","","")
. Q
I 'ASSIGNED Q $G(MAGFLD("LABEL"))_" is not currently assigned"
Q WS
CISU(PLACE) ;
N ZTSK,ACTIVE,MESSAGE
Q:'+PLACE
S ACTIVE=0,MESSAGE="Unknown"
S ZTSK=$$GET1^DIQ(2006.1,PLACE_",",10,"I","","")
I ZTSK D
. D STAT^%ZTLOAD ; IA#10063
. I ZTSK(0)=1,ZTSK(1)<3 S ACTIVE=1
. S MESSAGE=ZTSK(2)
. I $$UPPER^MAGQE4(MESSAGE)="UNDEFINED" S MESSAGE="Task is undefined"
. Q
Q:+ACTIVE
;else START A NEW TASK,SEND A MESSAGE
D STTASK^MAGQE4
D DFNIQ^MAGQBPG1("","The inactive monthly Imaging Site Usage report task was restarted",0,PLACE,"MAGQCBP")
D DFNIQ^MAGQBPG1("","The problem was: "_MESSAGE,0,PLACE,"MAGQCBP")
D DFNIQ^MAGQBPG1("","Site_report_task_was_restarted",1,PLACE,"MAGQCBP") ; Send
K ZTSK
Q
CNT(QUE,PL,RET) ; Return the number of failed queues, queue pointer, queue type total count and last date processed.
; failed queues= queue count - total queue type count.
;^MAGQUEUE(2006.031,D0,0)= (#.01) QUEUE NAME [1F] ^ (#1) QUEUE POINTER
; ==>[2P:2006.03] ^ (#2) QUEUE COUNT [3N] ^ (#.04) PLACE
; ==>[4P:2006.1] ^ (#3) QUEUE TYPE TOTAL [5N] ^ (#4)
; ==>LAST_QUEUE_PROCESSED_DATE_TIME [6D] ^
N QP,FAIL,QTOTAL,QCNT S RET=0
Q:QUE=""!('PL)
Q:'$D(^MAGQUEUE(2006.031,"C",PL,QUE))
S QP=$O(^MAGQUEUE(2006.031,"C",PL,QUE,"")) Q:'QP!'$D(^MAGQUEUE(2006.031,QP))
S QCNT=$P($G(^MAGQUEUE(2006.031,+QP,0)),U,3),QTOTAL=$P($G(^MAGQUEUE(2006.031,+QP,0)),U,5)
S FAIL=(+QTOTAL)-(+QCNT),RET=FAIL_U_QCNT_U_QTOTAL_U_$P($G(^MAGQUEUE(2006.031,+QP,0)),U,6)
Q
NQENTRY(NQ,PLACE) ;
;Get the date the queue entry was entered into 2006.03 file.
N I
Q:NQ=""!'PLACE
S I=$O(^MAGQUEUE(2006.03,"D",PLACE,NQ,"NOT_PROCESSED",""))
I +I,$D(^MAGQUEUE(2006.03,I,0)) Q $P(^MAGQUEUE(2006.03,I,0),U,4)
Q 0
FAILQ(PLACE,FQLIM) ;
N QU,RETURN,FAILQ,BPSERV
F QU="JUKEBOX","ABSTRACT","IMPORT","JBTOHD","DELETE","GCC" D
. D CNT(QU,PLACE,.RETURN)
. S FAILQ=$S(+$P(RETURN,U)>+FQLIM:1,1:0),BPSERV="("_$$GTASK(PLACE,QU)_")"
. ;send msg if failed queues are greater then specified value.
. D:+FAILQ BMSGF(PLACE,BPSERV,QU,RETURN)
. Q
EVALQ(PL,QLIM) ;
N RETURN,MSG
D CNT("EVAL",PL,.RETURN)
S QCNT=$P(RETURN,U,2)
Q:QCNT'>QLIM
S MSG="The total number of EVAL queues is "_QCNT_". Please review the DICOM Gateways"
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="to ensure Routing is appropriately setup with the correct destination."
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="If your site is not using DICOM Gateway for Routing then review "
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="the Imaging DICOM Gateway Installation Guide, Section 4.3."
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP"),BLNKLN
S MSG="On-Demand Routing will not generate EVAL queues, if your site is doing"
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="only On-Demand Routing then the DICOM Gateway parameters are set incorrectly."
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP"),BLNKLN
S MSG="Check the following DICOM parameters on all your Gateways:"
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="(On-Demand routing does not require these parameters to be set.)"
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP"),BLNKLN
S MSG="Will this computer be a Routing Processor? // NO "
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="Will this computer be part of a system where 'autorouting' is active? // NO "
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
S MSG="VI_BP_Eval_Queue"
D DFNIQ^MAGQBPG1("",MSG,1,PL,"MAGQCBP")
Q
BLNKLN ;
S MSG=" "
D DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQCBP 13109 printed Apr 09, 2024@21:09:56 Page 2
MAGQCBP ;WOIFO/RP,JSL - Background Processor Queue Processor Monitor ; 28 JUL 2014 3:25 PM
+1 ;;3.0;IMAGING;**39,154**;Mar 19, 2002;Build 9;JUL 28, 2014
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ; This Code evaluates whether the last queue processed or the queuing of the next queue is the later event
+19 ; So if and only if there is a queue waiting to be processed and that queue has been clear to be processed
+20 ; for a period of 15 minutes then and only then would a message event be triggered (See message event BPMSG)
CBP(MIN) ;Entry point for job to check the BP queue processing activity
+1 ; I Suggest 15 minutes as a reasonably sensitive value; value is site configurable
+2 ; An additional alert has been added for failed queues over 1K
+3 NEW DATA,FQLIM,LASTDT,LQP,NQ,NQP,QU,SPAN,PL,WS,WSNAME
+4 ;Variable MAGEVAL, MAGMIN & FQLIM are site configurable when scheduling the task.
+5 ;T23 was setting to 1k if MAGFQ was less than 1k
SET FQLIM=$SELECT(+$GET(MAGFQ)>0:MAGFQ,1:1000)
+6 SET MIN=$SELECT(+$GET(MAGMIN)>0:MAGMIN,1:+$GET(MIN))
+7 ;this variable will be used for reviewing EVAL queues
SET MAGEVAL=$SELECT(+$GET(MAGEVAL)>0:MAGEVAL,1:10000)
+8 SET U="^"
SET PL=0
+9 FOR
SET PL=$ORDER(^MAG(2006.1,PL))
if 'PL
QUIT
Begin DoDot:1
+10 SET WS=0
SET WSNAME=""
+11 FOR
SET WSNAME=$ORDER(^MAG(2006.8,"C",PL,WSNAME))
if WSNAME=""
QUIT
Begin DoDot:2
+12 SET WS=$ORDER(^MAG(2006.8,"C",PL,WSNAME,""))
if 'WS
QUIT
+13 ; quit if this bp has not been active today - removed because we only report on active BP Servers
+14 ;Q:$P($P($G(^MAG(2006.8,WS,1)),U,5),"@",1)'=$P($$FMTE^XLFDT($$NOW^XLFDT),"@",1)
+15 SET NQP=$$NQP(WS,PL,.NQ)
SET RETURN=0
+16 IF NQP>0
Begin DoDot:3
+17 if WSNAME="Unassigned Tasks"
QUIT
+18 SET LQP=$$LQP(WS,PL)
+19 SET SPAN=$SELECT(LQP>NQP:LQP,1:NQP)
+20 ; get counts for message.
DO CNT(NQ,PL,.RETURN)
+21 IF $$NOW^XLFDT>$$FMADD^XLFDT(SPAN,"","",MIN,"")
DO BPMSG(PL,WSNAME,MIN,NQ,LQP,NQP,RETURN)
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 if +PL
DO FAILQ(PL,FQLIM)
+25 if +PL
DO EVALQ(PL,MAGEVAL)
+26 ; check for scheduled Purge and Verifier
if +PL
DO CAUTO(PL)
+27 ; check for active Imaging Site Usage task
if +PL
DO CISU(PL)
+28 QUIT
End DoDot:1
+29 ;Variables passed from scheduled task
KILL MAGEVAL,MAGMIN,MAGFQ
+30 QUIT
LQP(WS,PLACE) ; Returns the date and time of the Last Queue Processed by this BP Server
+1 NEW LDATE,QI,QP,TDATE,ZNODE,QUE,QSTR
+2 SET QSTR="^^^^^^^^^^^^ABSTRACT^JUKEBOX^JBTOHD^PREFET^IMPORT^GCC^^^^^DELETE^"
+3 SET ZNODE=$GET(^MAG(2006.8,WS,0))
+4 SET LDATE=0
+5 ;Priority: JBTOHD, PREFET, ABSTRACT, IMPORT JUKEBOX, DELETE and GCC
+6 FOR QI=15,16,13,17,14,23,18
if $PIECE(ZNODE,U,QI)
Begin DoDot:1
+7 SET QUE=$PIECE(QSTR,U,QI)
+8 SET QP=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,QUE,""))
if 'QP
QUIT
+9 SET TDATE=$PIECE($GET(^MAGQUEUE(2006.031,QP,0)),U,6)
+10 IF TDATE>LDATE
SET LDATE=TDATE
+11 QUIT
End DoDot:1
+12 QUIT LDATE
NQP(WS,PLACE,NQ) ; Returns the date and time that the next queue to be processed by this BP Server was queued
+1 NEW LDATE,QCNT,QI,QP,TDATE,ZNODE,QUEIEN
+2 SET QSTR="^^^^^^^^^^^^ABSTRACT^JUKEBOX^JBTOHD^PREFET^IMPORT^GCC^^^^^DELETE^"
+3 SET ZNODE=$GET(^MAG(2006.8,WS,0))
+4 SET TDATE=0
+5 ;Priority: JBTOHD, PREFET, ABSTRACT, IMPORT JUKEBOX, DELETE and GCC
+6 FOR QI=15,16,13,17,14,23,18
if 'QI
QUIT
IF $PIECE(ZNODE,U,QI)
Begin DoDot:1
+7 SET NQ=$PIECE(QSTR,U,QI)
+8 SET QP=$ORDER(^MAGQUEUE(2006.031,"C",PLACE,NQ,""))
if 'QP
QUIT
+9 ; Queue count - no entries
if '+$PIECE(^MAGQUEUE(2006.031,QP,0),U,3)
QUIT
+10 ;Queue count
IF +$PIECE(^MAGQUEUE(2006.031,QP,0),U,3)
Begin DoDot:2
+11 SET QUEIEN=$PIECE($GET(^MAGQUEUE(2006.031,QP,0)),U,2)
+12 SET TDATE=$PIECE($GET(^MAGQUEUE(2006.03,QP,0)),U,4)
+13 IF '+TDATE
SET TDATE=$$NQENTRY(NQ,PLACE)
+14 ;above line is needed - if queien value doesn't exist in the 2006.03
+15 ;then get the next entry using x-ref "D","NOT_Processed" for queue type.
End DoDot:2
+16 QUIT
End DoDot:1
if TDATE>0
QUIT
+17 QUIT TDATE
BPMSG(PLACE,WS,MIN,NQ,LASTDT,NQDATE,DATA) ;
+1 NEW MSG,TMP,SITE
+2 SET MSG="VistA Imaging BP Server, "_WS_", has failed to process"
+3 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+4 SET MSG="a "_NQ_" queue within "_MIN_" minutes."
+5 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+6 SET MSG="The last date/time a queue was processed was on: "_$$FMTE^XLFDT(LASTDT,1)
+7 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+8 SET MSG="The next queue to process was created on: "_$$FMTE^XLFDT(NQDATE,1)
+9 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+10 SET MSG="Total "_NQ_" queues is: "_$PIECE(DATA,U,2)_"."
+11 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+12 ;Get Division #
SET SITE=$PIECE($GET(^MAG(2006.1,PLACE,0)),U,1)
if (SITE'="")
SET SITE=$$LKUP^XUAF4(SITE)
+13 SET TMP=$$GET1^DIQ(4,SITE,.01,"E")
+14 SET MSG="This BP Queue processor was supporting the VI implementation serving: "_TMP_"."
+15 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+16 SET MSG="VI_BP_Queue_Processor_failure"
+17 DO DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP")
+18 QUIT
BMSGF(PLACE,WS,NQ,DATA) ;
+1 NEW MSG,TMP,SITE
+2 ;DATA=FAILQUECNT_U_QUEUE CNT_U_TOTAL QUE TYPE
+3 SET MSG="VistA Imaging BP Server "_WS_" has "_NQ_" failed queues ("_$PIECE(DATA,U)_")."
+4 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+5 SET MSG="Please review this BP server activity."
+6 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+7 SET MSG="The last date/time this queue was processed was on: "_$$FMTE^XLFDT($PIECE(DATA,U,4))_"."
+8 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+9 ;Get Division #
SET SITE=$PIECE($GET(^MAG(2006.1,PLACE,0)),U,1)
if (SITE'="")
SET SITE=$$LKUP^XUAF4(SITE)
+10 ;IA fix
SET TMP=$$GET1^DIQ(4,SITE,.01,"E")
+11 SET MSG="This BP Queue processor was supporting the VI implementation serving: "_TMP
+12 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+13 SET MSG="VI_BP_Queue_Processor_failure"
+14 DO DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP")
+15 QUIT
CAUTO(PLACE) ;
+1 NEW ASSIGN,BPPURGE,BPTIME,BPVER,MSG,NODE5,TMP,AUTO,SITE
+2 SET BPPURGE=$GET(^MAG(2006.1,PLACE,"BPPURGE"))
SET BPTIME=0
+3 SET ASSIGN=$$GTASK(PLACE,3)
SET ASSIGN=$SELECT(ASSIGN["is not currently assigned":0,1:1)
+4 ; ASSIGN is a flag whether the AUTO PURGE task has been assigned to a BP Server.
+5 ; If Scheduled is ON (#62.5) and assigned to a BP Server.
IF +$PIECE(BPPURGE,U,6)
IF +ASSIGN
Begin DoDot:1
+6 ; Add 20 min to schedule time to compensate the BP to perform MAGQ FS CHNGE.
+7 SET BPTIME=$PIECE(BPPURGE,U,10)_"."_$PIECE(BPPURGE,U,11)
if '+BPTIME
QUIT
SET BPTIME=$$FMADD^XLFDT(BPTIME,"","",21)
+8 if ($$NOW^XLFDT)<BPTIME
QUIT
+9 ;DATE OF SCHEDULED PURGE (#61.3) & SCHEDULED PURGE TIME (#61.4) of SITE PARAMETERS (2006.1)
+10 ;2006.1
IF ($$NOW^XLFDT)>BPTIME
Begin DoDot:2
+11 ; DATE OF LAST PURGE (#61.1) & DATE OF SCHEDULED PURGE (#61.3) of SITE PARAMETERS 2006.1 - Purge active
if ($PIECE(BPPURGE,U,7)=$PIECE(BPPURGE,U,10))
QUIT
+12 ;Get Division #
SET SITE=$PIECE($GET(^MAG(2006.1,PLACE,0)),U,1)
if (SITE'="")
SET SITE=$$LKUP^XUAF4(SITE)
+13 SET TMP=$$GET1^DIQ(4,SITE,.01,"E")
+14 SET MSG="The "_TMP_" implementation of VistA Imaging has failed to start the schedule Purge activity!"
+15 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+16 ;AUTO PURGE is assigned to BP Server field #3
SET MSG="The task is currently assigned to BP Server: "_$$GTASK(PLACE,3)
+17 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+18 SET MSG="Scheduled_Purge_failure"
+19 ; Send
DO DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP")
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 SET BPVER=$GET(^MAG(2006.1,PLACE,"BPVERIFIER"))
SET BPTIME=0
+23 SET ASSIGN=$$GTASK(PLACE,4)
SET ASSIGN=$SELECT(ASSIGN["is not currently assigned":0,1:1)
+24 ; If Scheduled Verifier is ON (#62) and assigned to a BP Server ;
IF $PIECE(BPVER,U,1)
IF +ASSIGN
Begin DoDot:1
+25 ; DATE OF SCHEDULED VERIFY (#62.3) & SCHEDULED VERIFIER TIME (62.4) of SITE PARAMETERS 2006.1
+26 ; Add 20 min to schedule time to compensate the BP to perform MAGQ FS CHNGE.
+27 SET BPTIME=($PIECE(BPVER,U,4)_"."_$PIECE(BPVER,U,5))
if '+BPTIME
QUIT
SET BPTIME=$$FMADD^XLFDT(BPTIME,"","",21)
+28 if ($$NOW^XLFDT)<BPTIME
QUIT
+29 IF ($$NOW^XLFDT)>BPTIME
Begin DoDot:2
+30 ;Quit if the verifier has already processed.
+31 ; DATE OF LAST VERIFY (#62.1) & DATE OF SCHEDULED VERIFY (#62.3) - Verifier is active
if ($PIECE(BPVER,U,2)=$PIECE(BPVER,U,4))
QUIT
+32 ;Get Division #
SET SITE=$PIECE($GET(^MAG(2006.1,PLACE,0)),U,1)
if (SITE'="")
SET SITE=$$LKUP^XUAF4(SITE)
+33 SET TMP=$$GET1^DIQ(4,SITE,.01,"E")
+34 SET MSG="The "_TMP_" implementation of VistA Imaging has failed to start the schedule Verifier activity!"
+35 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+36 ;AUTO VERIFY is assigned to BP Server field #3
SET MSG="The task is currently assigned to BP Server: "_$$GTASK(PLACE,4)
+37 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQCBP")
+38 SET MSG="Scheduled_Verifier_failure"
+39 ; Send
DO DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQCBP")
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 QUIT
GTASK(PLACE,TASK) ;
+1 ;AUTO PURGE(3), AUTO VERIFY(4), ABSTRACT(12), JUKEBOX(13), JBTOHD(14), PREFET(15), IMPORT(16), GCC(17), DELETE(20)
+2 NEW MAGFLD,IEN,WS,ASSIGNED,WSIEN
+3 SET ASSIGNED=0
+4 DO FIELD^DID(2006.8,TASK,"","LABEL","MAGFLD")
+5 SET WS=""
FOR
SET WS=$ORDER(^MAG(2006.8,"C",PLACE,WS))
if WS=""
QUIT
Begin DoDot:1
+6 if ($$UPPER^MAGQE4(WS)="UNASSIGNED TASKS")
QUIT
+7 SET WSIEN=$ORDER(^MAG(2006.8,"C",PLACE,WS,""))
+8 SET ASSIGNED=+$$GET1^DIQ(2006.8,WSIEN_",",TASK,"I","","")
+9 QUIT
End DoDot:1
if ASSIGNED
QUIT
+10 IF 'ASSIGNED
QUIT $GET(MAGFLD("LABEL"))_" is not currently assigned"
+11 QUIT WS
CISU(PLACE) ;
+1 NEW ZTSK,ACTIVE,MESSAGE
+2 if '+PLACE
QUIT
+3 SET ACTIVE=0
SET MESSAGE="Unknown"
+4 SET ZTSK=$$GET1^DIQ(2006.1,PLACE_",",10,"I","","")
+5 IF ZTSK
Begin DoDot:1
+6 ; IA#10063
DO STAT^%ZTLOAD
+7 IF ZTSK(0)=1
IF ZTSK(1)<3
SET ACTIVE=1
+8 SET MESSAGE=ZTSK(2)
+9 IF $$UPPER^MAGQE4(MESSAGE)="UNDEFINED"
SET MESSAGE="Task is undefined"
+10 QUIT
End DoDot:1
+11 if +ACTIVE
QUIT
+12 ;else START A NEW TASK,SEND A MESSAGE
+13 DO STTASK^MAGQE4
+14 DO DFNIQ^MAGQBPG1("","The inactive monthly Imaging Site Usage report task was restarted",0,PLACE,"MAGQCBP")
+15 DO DFNIQ^MAGQBPG1("","The problem was: "_MESSAGE,0,PLACE,"MAGQCBP")
+16 ; Send
DO DFNIQ^MAGQBPG1("","Site_report_task_was_restarted",1,PLACE,"MAGQCBP")
+17 KILL ZTSK
+18 QUIT
CNT(QUE,PL,RET) ; Return the number of failed queues, queue pointer, queue type total count and last date processed.
+1 ; failed queues= queue count - total queue type count.
+2 ;^MAGQUEUE(2006.031,D0,0)= (#.01) QUEUE NAME [1F] ^ (#1) QUEUE POINTER
+3 ; ==>[2P:2006.03] ^ (#2) QUEUE COUNT [3N] ^ (#.04) PLACE
+4 ; ==>[4P:2006.1] ^ (#3) QUEUE TYPE TOTAL [5N] ^ (#4)
+5 ; ==>LAST_QUEUE_PROCESSED_DATE_TIME [6D] ^
+6 NEW QP,FAIL,QTOTAL,QCNT
SET RET=0
+7 if QUE=""!('PL)
QUIT
+8 if '$DATA(^MAGQUEUE(2006.031,"C",PL,QUE))
QUIT
+9 SET QP=$ORDER(^MAGQUEUE(2006.031,"C",PL,QUE,""))
if 'QP!'$DATA(^MAGQUEUE(2006.031,QP))
QUIT
+10 SET QCNT=$PIECE($GET(^MAGQUEUE(2006.031,+QP,0)),U,3)
SET QTOTAL=$PIECE($GET(^MAGQUEUE(2006.031,+QP,0)),U,5)
+11 SET FAIL=(+QTOTAL)-(+QCNT)
SET RET=FAIL_U_QCNT_U_QTOTAL_U_$PIECE($GET(^MAGQUEUE(2006.031,+QP,0)),U,6)
+12 QUIT
NQENTRY(NQ,PLACE) ;
+1 ;Get the date the queue entry was entered into 2006.03 file.
+2 NEW I
+3 if NQ=""!'PLACE
QUIT
+4 SET I=$ORDER(^MAGQUEUE(2006.03,"D",PLACE,NQ,"NOT_PROCESSED",""))
+5 IF +I
IF $DATA(^MAGQUEUE(2006.03,I,0))
QUIT $PIECE(^MAGQUEUE(2006.03,I,0),U,4)
+6 QUIT 0
FAILQ(PLACE,FQLIM) ;
+1 NEW QU,RETURN,FAILQ,BPSERV
+2 FOR QU="JUKEBOX","ABSTRACT","IMPORT","JBTOHD","DELETE","GCC"
Begin DoDot:1
+3 DO CNT(QU,PLACE,.RETURN)
+4 SET FAILQ=$SELECT(+$PIECE(RETURN,U)>+FQLIM:1,1:0)
SET BPSERV="("_$$GTASK(PLACE,QU)_")"
+5 ;send msg if failed queues are greater then specified value.
+6 if +FAILQ
DO BMSGF(PLACE,BPSERV,QU,RETURN)
+7 QUIT
End DoDot:1
EVALQ(PL,QLIM) ;
+1 NEW RETURN,MSG
+2 DO CNT("EVAL",PL,.RETURN)
+3 SET QCNT=$PIECE(RETURN,U,2)
+4 if QCNT'>QLIM
QUIT
+5 SET MSG="The total number of EVAL queues is "_QCNT_". Please review the DICOM Gateways"
+6 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+7 SET MSG="to ensure Routing is appropriately setup with the correct destination."
+8 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+9 SET MSG="If your site is not using DICOM Gateway for Routing then review "
+10 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+11 SET MSG="the Imaging DICOM Gateway Installation Guide, Section 4.3."
+12 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
DO BLNKLN
+13 SET MSG="On-Demand Routing will not generate EVAL queues, if your site is doing"
+14 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+15 SET MSG="only On-Demand Routing then the DICOM Gateway parameters are set incorrectly."
+16 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
DO BLNKLN
+17 SET MSG="Check the following DICOM parameters on all your Gateways:"
+18 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+19 SET MSG="(On-Demand routing does not require these parameters to be set.)"
+20 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
DO BLNKLN
+21 SET MSG="Will this computer be a Routing Processor? // NO "
+22 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+23 SET MSG="Will this computer be part of a system where 'autorouting' is active? // NO "
+24 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+25 SET MSG="VI_BP_Eval_Queue"
+26 DO DFNIQ^MAGQBPG1("",MSG,1,PL,"MAGQCBP")
+27 QUIT
BLNKLN ;
+1 SET MSG=" "
+2 DO DFNIQ^MAGQBPG1("",MSG,0,PL,"MAGQCBP")
+3 QUIT
