| [613] | 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
|
|---|
