source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTRMON.m@ 668

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1XTRMON ;ISCSF/RWF - Watch for changes in routine checksums. ;02 Jul 2003 2:59 pm
2 ;;7.3;TOOLKIT;**27,59,70**;Apr 25, 1995
3A 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)
10SEL 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
15EXIT ;
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 ;
23RANGE(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 ;
29GRNG ;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 ;
38ALL ;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 ;
43GALL ;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 ;
50CHK(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 ;
64CHKERR ;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 ;
70LOG(MSG) ;Record message
71 S CNT=CNT+1,^TMP($J,CNT,0)=MSG
72 Q
73 ;
74LOST ;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
Note: See TracBrowser for help on using the repository browser.