source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ82.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1XQ82 ;SF-ISC.SEA/JLI - CLEAN OLD $JOB DATA OUT OF XUTL("XQ", & OTHERS ;05/26/2005 11:36
2 ;;8.0;KERNEL;**59,67,157,258,312,353**;Jul 10, 1995;Build 1
3 ;Make sure that can run from a DCL script
4 N A,X,%DT,Y,J,K,DDATE,HDATA,HPID3,XQOS
5 S DT=$$DT^XLFDT
6 S HDATE=$H-7 ;Get seven days ago in $H days
7 S DDATE=$$HTFM^XLFDT(HDATE) ;Get seven days ago in FM format
8 S XQOS=^%ZOSF("OS"),HPID3=$E($$CNV^XLFUTL($J,16),1,3)
9 S HJOB=$J
10 ;Do work as a set of sub routines
11 D L0,L1,L2,L3,L4,L5,L6
12EXIT ;
13 Q
14 ;We keep track of jobs by putting data in ^XUTL("XQ",$J).
15 ;Sign-on time is in ^($J,0) points to sign-on log.
16 ;Holds the Menu stack.
17 ;For any entry in user stack w/ date older than 7 days or w/o zero node
18 ;kill XUTL("XQ",n) and corresponding UTILITY(n) and TMP(n) nodes.
19L0 N %T
20 F J=0:0 S J=$O(^XUTL("XQ",J)) Q:J'>0 I $S('$D(^(J,0)):1,1:^(0)<DDATE) D
21 . I $G(^XUTL("XQ",J,"KEEPALIVE"))>HDATE Q ;For long running jobs
22 . I $D(^XUTL("XQ",J,"ZTSKNUM")) L +^%ZTSCH("TASK",^XUTL("XQ",J,"ZTSKNUM")):0 Q:'$T L -^%ZTSCH("TASK",^XUTL("XQ",J,"ZTSKNUM"))
23 . K ^XUTL("XQ",J),^UTILITY(J),^TMP(J)
24 . Q
25 Q:'$$CHECK ;Check if we should skip pass 2.
26 ;Now to check again for DEAD jobs on local node
27 F J=0:0 S J=$O(^XUTL("XQ",J)) Q:J'>0 D
28 . I $$DEAD(J) K ^XUTL("XQ",J),^UTILITY(J),^TMP(J)
29 Q
30 ;
31 ;Loop thru UTILITY and look for nodes w/o corresponding XUTL("XQ",n)
32L1 S A="" F S A=$O(^UTILITY(A)) Q:A="" D
33 . I A>0,'$D(^XUTL("XQ",A)) K ^UTILITY(A) Q ;UTILITY($J) w/o XUTL("XQ",$J) node.
34 . Q:A>0 Q:"^ROU^GLO^LRLTR^"[("^"_A_"^")
35 . 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)
36 . Q
37 Q
38 ;
39 ;Loop thru TMP and look for nodes w/o corresponding XUTL("XQ",n)
40L2 S A="" F S A=$O(^TMP(A)) Q:A="" D
41 . I A>0,'$D(^XUTL("XQ",A)) K ^TMP(A) Q ;TMP($J) w/o XUTL("XQ",$J) node.
42 . Q:A>0 ;Q:"^ROU^GLO^LRLTR^"[("^"_A_"^")
43 . 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)
44 . Q
45 Q
46 ;
47L3 ;Now to cleanup the XTMP global w/ XTMP(namespace,0)<DT
48 S A="" F S A=$O(^XTMP(A)) Q:A="" S J=$G(^XTMP(A,0)) I J<DT K ^XTMP(A)
49 Q
50 ;
51L4 ;Now go thru and clean old ^XUSEC(0,"CUR",duz,sign-on) nodes.
52 D L51("CUR")
53 Q
54 ;
55L5 ;Now go through and clean old ^XUSEC(0,"AS*" nodes.
56 D L51("AS1"),L51("AS2")
57 Q
58 ;
59L6 ;Clean out old build nodes from ^XUTL
60 S K=""
61 F S K=$O(^XUTL("XQO",K)) Q:K="" D
62 . I $D(^XUTL("XQO",K,"^BUILD")),($P($H,",",2)-^("^BUILD")>1800)!(^("^BUILD")>$P($H,",",2)) K ^("^BUILD")
63 Q
64 ;
65L51(NDX) ;Clean old Sign-on log entries from X-ref
66 N I,J,FDA,NOW,ERR,IEN
67 S I="",NOW=$$NOW^XLFDT
68 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
69 . ;Look at every entry in the X-ref, check for data record
70 . I $D(^XUSEC(0,J,0))[0 K ^XUSEC(0,NDX,I,J) Q ;No data record.
71 . Q:J'<DDATE ;Keep for now
72 . S FDA(3.081,J_",",3)=NOW,FDA(3.081,J_",",16)=1 D UPDATE^DIE("","FDA","IEN","ERR")
73 . K FDA,IEN,ERR
74 . Q
75 Q
76 ;
77DEAD(X1) ;Check if X1 is a PID and DEAD
78 ;Return 1 if should clean, 0 to skip
79 I X1\1'=X1 Q 0
80 I $E($$CNV^XLFUTL(X1,16),1,3)'=HPID3 Q 0
81 ; X1 is a PID on this node, is PID active?..
82 I $D(^$JOB(X1))=0 Q 1 ; Job is DEAD
83 Q 0
84 ;
85CHECK() ;Check that we have the right enviroment to do pass 2
86 ;Are we on VMS, is ^$JOB supported
87 I XQOS["GT.M" Q 0
88 I XQOS["DSM" Q 1
89 I XQOS["OpenM" X "I $ZV[""VMS""" Q $T
90 Q 0
91 ;
Note: See TracBrowser for help on using the repository browser.