1 | XTRMON ;ISCSF/RWF - Watch for changes in routine checksums. ;02 Jul 2003 2:59 pm
|
---|
2 | ;;7.3;TOOLKIT;**27,59,70**;Apr 25, 1995
|
---|
3 | A N CNT,NOW,MODE,RTN,RN,RSUM,TEST,XMB,DA,DIC,X0,OS
|
---|
4 | K ^TMP($J)
|
---|
5 | S CNT=0,NOW=$$HTFM^XLFDT($H),U="^"
|
---|
6 | S RSUM=^%ZOSF("RSUM"),TEST=^%ZOSF("TEST")
|
---|
7 | S OS=^%ZOSF("OS")
|
---|
8 | S MODE=$G(^XTV(8989.3,1,"RM")) I "n"[$E(MODE) Q
|
---|
9 | G ALL:"a"=$E(MODE)
|
---|
10 | SEL S RTN=""
|
---|
11 | F S RTN=$O(^XTV(8989.3,1,"RM1","B",RTN)) Q:RTN="" D
|
---|
12 | . I RTN["*" D RANGE($P(RTN,"*")) Q
|
---|
13 | . D CHK(RTN)
|
---|
14 | . Q
|
---|
15 | EXIT ;
|
---|
16 | D LOST
|
---|
17 | S XMB="XTRMON",XMTEXT="^TMP($J,",XMB(1)=$$FMTE^XLFDT(NOW,1),XMB(2)=CNT
|
---|
18 | X ^%ZOSF("UCI") S XMB(3)=Y
|
---|
19 | D:CNT>0 ^XMB
|
---|
20 | K XMB,CNT,RN,RTN
|
---|
21 | Q
|
---|
22 | ;
|
---|
23 | RANGE(RTN) ;Check a N-space
|
---|
24 | S RN=RTN D CHK(RTN) ;Check for rtn with namespace name
|
---|
25 | I OS["GT.M" G GRNG
|
---|
26 | F S RN=$O(^$ROUTINE(RN)) Q:$E(RN,1,$L(RTN))'=RTN D CHK(RN)
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | GRNG ;Check a N-space in GT.M
|
---|
30 | N X,RA,RY,RX S RSUM="S Y=$$RSUM^%ZOSV2(X)"
|
---|
31 | I '$D(ZTQUEUED) W !,"Namespace: "_RTN
|
---|
32 | S X=$ZSEARCH("*.X"),RA=$$RTNDIR^%ZOSV_RTN,RY=RA_"*.m"
|
---|
33 | F S RX=$ZSEARCH(RY) Q:(RX="")!(RX'[RA) D
|
---|
34 | . S RX=$TR(RX,"]","/"),RN=$P($P(RX,"/",$L(RX,"/")),".",1)
|
---|
35 | . D CHK(RN)
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | ALL ;Check all routines
|
---|
39 | I OS["GT.M" G GALL
|
---|
40 | S RN="" F S RN=$O(^$ROUTINE(RN)) Q:RN="" D CHK(RN)
|
---|
41 | G EXIT
|
---|
42 | ;
|
---|
43 | GALL ;GT.M all routines
|
---|
44 | N X,RY,RX S RSUM="S Y=$$RSUM^%ZOSV2(X)"
|
---|
45 | S X=$ZSEARCH("*.X"),RY=$$RTNDIR^%ZOSV_"A.m"
|
---|
46 | F S RX=$ZSEARCH(RY) Q:(RX="")!(RX'["*") D
|
---|
47 | . S RX=$TR(RX,"]","/"),RN=$P($P(RX,"/",$L(RX,"/")),".",1) D CHK(RN)
|
---|
48 | G EXIT
|
---|
49 | ;
|
---|
50 | CHK(RN) ;Check one routine
|
---|
51 | N $ET,$ES S $ET="D CHKERR^XTRMON Q"
|
---|
52 | S X=RN X TEST Q:'$T
|
---|
53 | S DA=$O(^DIC(9.8,"B",RN,0)) I DA<1 D Q:DA'>0 ;See if RN is in file
|
---|
54 | . S X=RN,DIC="^DIC(9.8,",DIC(0)="ML" D FILE^DICN ;No, so add
|
---|
55 | . S DA=+Y I DA>0 S DIE=DIC,DR="1///R" D ^DIE ;Set routine flag
|
---|
56 | . Q
|
---|
57 | S X0=^DIC(9.8,DA,0),X=RN X RSUM I '$D(ZTQUEUED) W "." ;Test
|
---|
58 | Q:(Y<0)!(Y=+$P(X0,U,5))
|
---|
59 | D LOG($E(RN_" ",1,10)_$S($P(X0,U,5)>0:"Has changed, Old: "_$P(X0,U,5)_" New: "_Y,1:"Is new"))
|
---|
60 | I '$D(ZTQUEUED) W !,RN,?10,$S($P(X0,U,5)>0:"Has changed",1:"Is new")
|
---|
61 | S $P(^DIC(9.8,DA,0),U,5,6)=Y_U_NOW
|
---|
62 | Q
|
---|
63 | ;
|
---|
64 | CHKERR ;Handle an error during check
|
---|
65 | S $ET="D ^%ZTER G UNWIND^%ZTER"
|
---|
66 | D LOG(RN_" Caused an error: "_$$EC^%ZOSV)
|
---|
67 | S Y=-1,$EC="" ;Set Y=-1 to stop test
|
---|
68 | Q
|
---|
69 | ;
|
---|
70 | LOG(MSG) ;Record message
|
---|
71 | S CNT=CNT+1,^TMP($J,CNT,0)=MSG
|
---|
72 | Q
|
---|
73 | ;
|
---|
74 | LOST ;Look for routines no-longer in the system
|
---|
75 | I '$D(ZTQUEUED) W !,"Starting LOST routine check."
|
---|
76 | S RTN=""
|
---|
77 | F S RTN=$O(^DIC(9.8,"B",RTN)) Q:RTN="" D
|
---|
78 | . Q:$E(RTN)="%"
|
---|
79 | . S IX=$O(^DIC(9.8,"B",RTN,0)),X0=$G(^DIC(9.8,+IX,0)) Q:$P(X0,U,2)="PK"
|
---|
80 | . S X=RTN X TEST Q:$T
|
---|
81 | . D LOG($E(X_" ",1,10)_"Not in UCI")
|
---|
82 | . S DA=IX,DIK="^DIC(9.8," D ^DIK
|
---|
83 | . Q
|
---|
84 | Q
|
---|