- 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 Feb 18, 2025@23:31:31 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
