XQ82 ;SF-ISC.SEA/JLI - CLEAN OLD $JOB DATA OUT OF XUTL("XQ", & OTHERS ;12/03/14 08:32
;;8.0;KERNEL;**59,67,157,258,312,353,542,554,638**;Jul 10, 1995;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
;Make sure that can run from a DCL script
N A,X,%DT,Y,J,K,DDATE,HDATE,HJOB,HPID3,XQOS,XQVND
S U="^",DT=$$DT^XLFDT
S HDATE=$H-7 ;Get seven days ago in $H days
S DDATE=$$HTFM^XLFDT(HDATE) ;Get seven days ago in FM format
S XQVND=^%ZOSF("OS"),XQOS=$$OS^%ZOSV,HPID3=$$CNV^XLFUTL($J,16)
S HJOB=$J,DILOCKTM=$G(DILOCKTM,+$G(^DD("DILOCKTM"),1))
;Do work as a set of sub routines
D L0,L1,L2,L3,L4,L5,L6,L7,L8
EXIT ;
Q
L0 ;We keep track of jobs by putting data in ^XUTL("XQ",$J).
;Sign-on time is in ^($J,0) points to sign-on log.
;Holds the Menu stack.
;For any entry in user stack '^XUTL("XQ",$J)' w/ date older than 7 days or w/o zero node
;kill XUTL("XQ",n) and corresponding UTILITY(n), TMP(n), & XUTL(n) nodes.
;Long running jobs should call TOUCH^XUSCLEAN once a day to update KEEPALIVE.
N %T S J=0
F S J=$O(^XUTL("XQ",J)) Q:J'>0 I $S('$D(^(J,0)):1,1:^(0)<DDATE) D
. I '$D(^XUTL("XQ",J,0)) K ^XUTL("XQ",J) Q ;Missing zero node
. I $G(^XUTL("XQ",J,"KEEPALIVE"))>HDATE Q ;For long running jobs
. I $D(^XUTL("XQ",J,"ZTSKNUM")) L +^%ZTSCH("TASK",^XUTL("XQ",J,"ZTSKNUM")):DILOCKTM Q:'$T L -^%ZTSCH("TASK",^XUTL("XQ",J,"ZTSKNUM"))
. K ^XUTL("XQ",J),^UTILITY(J),^TMP(J),^XUTL(J)
. Q
Q:'$$CHECK ;Check if we should skip pass 2.
;Now to check again for DEAD jobs on local node
F J=0:0 S J=$O(^XUTL("XQ",J)) Q:J'>0 D
. I $$DEAD(J) K ^XUTL("XQ",J),^UTILITY(J),^TMP(J),^XUTL(J)
Q
;
L1 ;Loop thru UTILITY and look for nodes w/o corresponding XUTL("XQ",n)
N A,J
S A="" F S A=$O(^UTILITY(A)) Q:A="" D
. I A>0,'$D(^XUTL("XQ",A)) K ^UTILITY(A) Q ;UTILITY($J) w/o XUTL("XQ",$J) node.
. Q:A>0 Q:"^ROU^GLO^LRLTR^"[("^"_A_"^")
. F J=0:0 S J=$O(^UTILITY(A,J)) Q:J'>0 I '$D(^XUTL("XQ",J)) K ^UTILITY(A,J) ;Remove UTILITY(namespace,$J) w/o XUTL("XQ",$J)
. Q
Q
;
L2 ;Loop thru TMP and look for nodes w/o corresponding XUTL("XQ",n)
N A,J
S A="" F S A=$O(^TMP(A)) Q:A="" D
. I A>0,'$D(^XUTL("XQ",A)) K ^TMP(A) Q ;TMP($J) w/o XUTL("XQ",$J) node.
. Q:A>0 ;Q:"^ROU^GLO^LRLTR^"[("^"_A_"^")
. F J=0:0 S J=$O(^TMP(A,J)) Q:J'>0 I '$D(^XUTL("XQ",J)) K ^TMP(A,J) ;Remove TMP(namespace,$J) w/o XUTL("XQ",$J)
. Q
Q
;
L3 ;Now to cleanup the XTMP global w/ XTMP(namespace,0)<DT
N A,J
S A="" F S A=$O(^XTMP(A)) Q:A="" S J=$G(^XTMP(A,0)) I J<DT K ^XTMP(A)
Q
;
L4 ;Now go thru and clean old ^XUSEC(0,"CUR",duz,sign-on) nodes.
D L51("CUR")
Q
;
L5 ;Now go through and clean old ^XUSEC(0,"AS*" nodes.
D L51("AS1"),L51("AS2"),L51("AS4")
Q
;
L6 ;Clean out old build nodes from ^XUTL
N K
S K=""
F S K=$O(^XUTL("XQO",K)) Q:K="" D
. I $D(^XUTL("XQO",K,"^BUILD")),($P($H,",",2)-^("^BUILD")>1800)!(^("^BUILD")>$P($H,",",2)) K ^("^BUILD")
Q
;
L7 ;Kill ^DISV for TERMINATED or DISUSER Users.
N DA,USER
S DA="",U="^"
F S DA=$O(^DISV(DA)) Q:DA="" S USER=$$ACTIVE^XUSER(DA) I '(+USER) K ^DISV(DA)
Q
;
L8 ;Loop top level of ^XUTL
N A
S A=0
F S A=$O(^XUTL(A)) Q:'A I '$D(^XUTL("XQ",A)) K ^XUTL(A)
Q
;
L51(NDX) ;Clean old Sign-on log entries from X-ref
N I,J,FDA,NOW,ERR,IEN
S I="",NOW=$$NOW^XLFDT
F S I=$O(^XUSEC(0,NDX,I)) Q:I="" F J=0:0 S J=$O(^XUSEC(0,NDX,I,J)) Q:(J'>0) D
. ;Look at every entry in the X-ref, check for data record
. I $D(^XUSEC(0,J,0))[0 K ^XUSEC(0,NDX,I,J) Q ;No data record.
. Q:J'<DDATE ;Keep for now
. S FDA(3.081,J_",",3)=NOW,FDA(3.081,J_",",16)=1 D UPDATE^DIE("","FDA","IEN","ERR")
. K FDA,IEN,ERR
. Q
Q
;
DEAD(X1) ;Check if X1 is a PID and DEAD
;Return 1 if should clean, 0 to skip
I X1\1'=X1 Q 0
;a PID on VMS has a part that is fixed, not so under Linux so the following line was dropped.
I XQOS="VMS",$E($$CNV^XLFUTL(X1,16),1,3)'=$E(HPID3,1,3) Q 0
;We should only come here
;is X1 a PID on this node and is PID active?..
I $D(^$JOB(X1))=0 Q 1 ; Job is DEAD
Q 0
;
CHECK() ;Check that we have the right enviroment to do pass 2
;GTM must be on one big box.
I XQVND["GT.M" Q 0
;Are we on Cache, ^$JOB is supported.
;Get value of LOCAL TMP (.07) to see if ^TMP, ^UTILITY and ^XUTL("XQ" are local.
I XQVND["OpenM" Q +$P($G(^XTV(8989.3,1,0)),"^",7) ;p554
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ82 4388 printed Apr 09, 2024@21:13:11 Page 2
XQ82 ;SF-ISC.SEA/JLI - CLEAN OLD $JOB DATA OUT OF XUTL("XQ", & OTHERS ;12/03/14 08:32
+1 ;;8.0;KERNEL;**59,67,157,258,312,353,542,554,638**;Jul 10, 1995;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Make sure that can run from a DCL script
+5 NEW A,X,%DT,Y,J,K,DDATE,HDATE,HJOB,HPID3,XQOS,XQVND
+6 SET U="^"
SET DT=$$DT^XLFDT
+7 ;Get seven days ago in $H days
SET HDATE=$HOROLOG-7
+8 ;Get seven days ago in FM format
SET DDATE=$$HTFM^XLFDT(HDATE)
+9 SET XQVND=^%ZOSF("OS")
SET XQOS=$$OS^%ZOSV
SET HPID3=$$CNV^XLFUTL($JOB,16)
+10 SET HJOB=$JOB
SET DILOCKTM=$GET(DILOCKTM,+$GET(^DD("DILOCKTM"),1))
+11 ;Do work as a set of sub routines
+12 DO L0
DO L1
DO L2
DO L3
DO L4
DO L5
DO L6
DO L7
DO L8
EXIT ;
+1 QUIT
L0 ;We keep track of jobs by putting data in ^XUTL("XQ",$J).
+1 ;Sign-on time is in ^($J,0) points to sign-on log.
+2 ;Holds the Menu stack.
+3 ;For any entry in user stack '^XUTL("XQ",$J)' w/ date older than 7 days or w/o zero node
+4 ;kill XUTL("XQ",n) and corresponding UTILITY(n), TMP(n), & XUTL(n) nodes.
+5 ;Long running jobs should call TOUCH^XUSCLEAN once a day to update KEEPALIVE.
+6 NEW %T
SET J=0
+7 FOR
SET J=$ORDER(^XUTL("XQ",J))
if J'>0
QUIT
IF $SELECT('$DATA(^(J,0)):1,1:^(0)<DDATE)
Begin DoDot:1
+8 ;Missing zero node
IF '$DATA(^XUTL("XQ",J,0))
KILL ^XUTL("XQ",J)
QUIT
+9 ;For long running jobs
IF $GET(^XUTL("XQ",J,"KEEPALIVE"))>HDATE
QUIT
+10 IF $DATA(^XUTL("XQ",J,"ZTSKNUM"))
LOCK +^%ZTSCH("TASK",^XUTL("XQ",J,"ZTSKNUM")):DILOCKTM
if '$TEST
QUIT
LOCK -^%ZTSCH("TASK",^XUTL("XQ",J,"ZTSKNUM"))
+11 KILL ^XUTL("XQ",J),^UTILITY(J),^TMP(J),^XUTL(J)
+12 QUIT
End DoDot:1
+13 ;Check if we should skip pass 2.
if '$$CHECK
QUIT
+14 ;Now to check again for DEAD jobs on local node
+15 FOR J=0:0
SET J=$ORDER(^XUTL("XQ",J))
if J'>0
QUIT
Begin DoDot:1
+16 IF $$DEAD(J)
KILL ^XUTL("XQ",J),^UTILITY(J),^TMP(J),^XUTL(J)
End DoDot:1
+17 QUIT
+18 ;
L1 ;Loop thru UTILITY and look for nodes w/o corresponding XUTL("XQ",n)
+1 NEW A,J
+2 SET A=""
FOR
SET A=$ORDER(^UTILITY(A))
if A=""
QUIT
Begin DoDot:1
+3 ;UTILITY($J) w/o XUTL("XQ",$J) node.
IF A>0
IF '$DATA(^XUTL("XQ",A))
KILL ^UTILITY(A)
QUIT
+4 if A>0
QUIT
if "^ROU^GLO^LRLTR^"[("^"_A_"^")
QUIT
+5 ;Remove UTILITY(namespace,$J) w/o XUTL("XQ",$J)
FOR J=0:0
SET J=$ORDER(^UTILITY(A,J))
if J'>0
QUIT
IF '$DATA(^XUTL("XQ",J))
KILL ^UTILITY(A,J)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
L2 ;Loop thru TMP and look for nodes w/o corresponding XUTL("XQ",n)
+1 NEW A,J
+2 SET A=""
FOR
SET A=$ORDER(^TMP(A))
if A=""
QUIT
Begin DoDot:1
+3 ;TMP($J) w/o XUTL("XQ",$J) node.
IF A>0
IF '$DATA(^XUTL("XQ",A))
KILL ^TMP(A)
QUIT
+4 ;Q:"^ROU^GLO^LRLTR^"[("^"_A_"^")
if A>0
QUIT
+5 ;Remove TMP(namespace,$J) w/o XUTL("XQ",$J)
FOR J=0:0
SET J=$ORDER(^TMP(A,J))
if J'>0
QUIT
IF '$DATA(^XUTL("XQ",J))
KILL ^TMP(A,J)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
L3 ;Now to cleanup the XTMP global w/ XTMP(namespace,0)<DT
+1 NEW A,J
+2 SET A=""
FOR
SET A=$ORDER(^XTMP(A))
if A=""
QUIT
SET J=$GET(^XTMP(A,0))
IF J<DT
KILL ^XTMP(A)
+3 QUIT
+4 ;
L4 ;Now go thru and clean old ^XUSEC(0,"CUR",duz,sign-on) nodes.
+1 DO L51("CUR")
+2 QUIT
+3 ;
L5 ;Now go through and clean old ^XUSEC(0,"AS*" nodes.
+1 DO L51("AS1")
DO L51("AS2")
DO L51("AS4")
+2 QUIT
+3 ;
L6 ;Clean out old build nodes from ^XUTL
+1 NEW K
+2 SET K=""
+3 FOR
SET K=$ORDER(^XUTL("XQO",K))
if K=""
QUIT
Begin DoDot:1
+4 IF $DATA(^XUTL("XQO",K,"^BUILD"))
IF ($PIECE($HOROLOG,",",2)-^("^BUILD")>1800)!(^("^BUILD")>$PIECE($HOROLOG,",",2))
KILL ^("^BUILD")
End DoDot:1
+5 QUIT
+6 ;
L7 ;Kill ^DISV for TERMINATED or DISUSER Users.
+1 NEW DA,USER
+2 SET DA=""
SET U="^"
+3 FOR
SET DA=$ORDER(^DISV(DA))
if DA=""
QUIT
SET USER=$$ACTIVE^XUSER(DA)
IF '(+USER)
KILL ^DISV(DA)
+4 QUIT
+5 ;
L8 ;Loop top level of ^XUTL
+1 NEW A
+2 SET A=0
+3 FOR
SET A=$ORDER(^XUTL(A))
if 'A
QUIT
IF '$DATA(^XUTL("XQ",A))
KILL ^XUTL(A)
+4 QUIT
+5 ;
L51(NDX) ;Clean old Sign-on log entries from X-ref
+1 NEW I,J,FDA,NOW,ERR,IEN
+2 SET I=""
SET NOW=$$NOW^XLFDT
+3 FOR
SET I=$ORDER(^XUSEC(0,NDX,I))
if I=""
QUIT
FOR J=0:0
SET J=$ORDER(^XUSEC(0,NDX,I,J))
if (J'>0)
QUIT
Begin DoDot:1
+4 ;Look at every entry in the X-ref, check for data record
+5 ;No data record.
IF $DATA(^XUSEC(0,J,0))[0
KILL ^XUSEC(0,NDX,I,J)
QUIT
+6 ;Keep for now
if J'<DDATE
QUIT
+7 SET FDA(3.081,J_",",3)=NOW
SET FDA(3.081,J_",",16)=1
DO UPDATE^DIE("","FDA","IEN","ERR")
+8 KILL FDA,IEN,ERR
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
DEAD(X1) ;Check if X1 is a PID and DEAD
+1 ;Return 1 if should clean, 0 to skip
+2 IF X1\1'=X1
QUIT 0
+3 ;a PID on VMS has a part that is fixed, not so under Linux so the following line was dropped.
+4 IF XQOS="VMS"
IF $EXTRACT($$CNV^XLFUTL(X1,16),1,3)'=$EXTRACT(HPID3,1,3)
QUIT 0
+5 ;We should only come here
+6 ;is X1 a PID on this node and is PID active?..
+7 ; Job is DEAD
