| [613] | 1 | LRNITEG ;SLC/FHS - INTEGRITY CHECKER FOR LAB SERVICE PACKAGE ;8/3/89 17:52 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**1**;Sep 27, 1994
|
|---|
| 3 | EN ;set %ZOSF variables
|
|---|
| 4 | ; This routine stores routines (variable X) in ^TMP("LRNITEG" returns
|
|---|
| 5 | ; XBIT which is = $A(X) and SIZE which is the $L(X)
|
|---|
| 6 | NEW ;
|
|---|
| 7 | N I,A,DIF,DIC,Y,II,XCNP,XCS,XCM,XCN,%,X
|
|---|
| 8 | K ^TMP("LRNITEG",$J) S XLOAD=^%ZOSF("LOAD"),XTEST=^("TEST"),DIF="^TMP(""LRNITEG"""_","_$J_","
|
|---|
| 9 | S XSIZE="S SIZE=0,I=1 F A=0:0 S I=$O(^TMP(""LRNITEG"",$J,I)) Q:I="""" S SIZE=SIZE+$L(^(I,0))+2"
|
|---|
| 10 | Q
|
|---|
| 11 | VER ; Select or add version #
|
|---|
| 12 | K DIC S U="^",DIC("A")=" Select Version # "
|
|---|
| 13 | S DIC(0)="AQEZ",DIC="^LAB(69.91,"
|
|---|
| 14 | I $D(LOAD) S DIC(0)=DIC(0)_"L",DLAYGO=69
|
|---|
| 15 | D ^DIC G:Y<0 STOP S VNODE=+Y,VER=$P(Y,U,2),VERDDT=$P(Y(0),U,2)
|
|---|
| 16 | Q
|
|---|
| 17 | LOOP ; Loop thru intire file checking for mis-match between file directory
|
|---|
| 18 | K %DT S %DT="RX",X="NOW" D ^%DT W !,Y
|
|---|
| 19 | D EN,VER Q:Y<1 S II=0,LRST=""
|
|---|
| 20 | ASK R !," Enter Routine to start checking from ",X:DTIME Q:'$T!(X[U) W:X["?" !!,"Enter a program name to start with " G:X["?" ASK I $L(X),$E(X)="L" S II=X
|
|---|
| 21 | S:'$L(X) X="L" I $E(X)'="L" W $C(7),!!?7,"ENTER RETURN OR ROUTINE BEGINNING WITH 'L' " G ASK
|
|---|
| 22 | S II=X
|
|---|
| 23 | ASK1 R !!," Enter EXACT routine to stop checking : ALL// ",X:DTIME Q:'$T!(X[U) W:X["?" !!,"Enter the name of a program to stop this routine " G:X["?" ASK1 I $L(X),$E(X)="L" S LRST=X
|
|---|
| 24 | S:'$L(X) X="" I $L(X),$E(X)'="L" W $C(7),!!?7,"ROUTINE MUST START WITH 'L' " G ASK1
|
|---|
| 25 | K ZTSK,IO("Q"),%ZIS S LRST=X,%ZIS="0NQ" D ^%ZIS G:POP STOP I $D(IO("Q"))!(IO'=IO(0)) G QUE
|
|---|
| 26 | W !!?7,"Enter '^' to stop ",!!
|
|---|
| 27 | DQ ;
|
|---|
| 28 | S PN=$S($G(^TMP("LRNITEGL")):^("LRNITEGL"),1:0)
|
|---|
| 29 | F A=0:0 R X:.1 Q:X="^" S II=$O(^LAB(69.91,VNODE,"ROU","B",II)) Q:II=""!(II=LRST) W "." S IX=$O(^(II,0)),X=$P(^LAB(69.91,VNODE,"ROU",IX,0),U),SIZE=$P(^(0),U,2),YBIT=$P(^(0),U,3),ER=0 I $E(X,1,5)'="LRINI" D SIZE I 'ER,XBIT'=YBIT D LOG
|
|---|
| 30 | Q
|
|---|
| 31 | LOG W !,"EDIT/CHANGE IN ",X,!,$C(7) S PN=PN+1,^TMP("LRNITEGL")=PN,^("LRNITEGL",X,DT)=PN
|
|---|
| 32 | Q
|
|---|
| 33 | SIZE ; Test for existence of X, load routine into ^TMP("LRNITEG" AND COUNT $L(X)
|
|---|
| 34 | ;Entry point for trigger of ^lab(69.911,.01 Caution if changed.
|
|---|
| 35 | N DIF,XCNP S DIF="^TMP(""LRNITEG"""_","_$J_"," X XTEST G:'$T ER S XCNP=0 K ^TMP("LRNITEG",$J) X XLOAD,XSIZE
|
|---|
| 36 | BIT ;
|
|---|
| 37 | S XBIT=0 F I=2:1 Q:'$D(^TMP("LRNITEG",$J,I,0)) S L=^(0),LN=$L(L) F NT=1:1:LN S XBIT=$A(L,NT)+XBIT
|
|---|
| 38 | CKSUM ; Compute Check Sum
|
|---|
| 39 | I '$D(^%ZOSF("RSUM")) S XSUM=1 Q
|
|---|
| 40 | X ^%ZOSF("RSUM") S XSUM=Y
|
|---|
| 41 | Q
|
|---|
| 42 | ER ; Error msg for when attempt to use a routine that doen't exist
|
|---|
| 43 | S ER=1 W !,"There is not a routine called '",X,"' in this directory ",$C(7),! K X Q
|
|---|
| 44 | ER2 ; Error msg when the version being loaded does not match the version selected for auto loading
|
|---|
| 45 | W !?10,ROU," is version ",$S($L($P(^TMP("LRNITEG",$J,2,0),";",3)):$P(^(0),";",3),1:"Unknown ")," NOT LOADED",$C(7),! Q
|
|---|
| 46 | STOP ; clean-up
|
|---|
| 47 | K A,BIT,CNT,DIF,ER,I,II,IX,L,LN,LOAD,NT,ROU,SIZE,VER,VERDDT,VNODE,XBIT,XCM,XCN,XCMP,XCNP,XCS,XLOAD,XSIZE,XSUM,XTEST,YBIT,^TMP("LRNITEG",$J),DLAYGO Q
|
|---|
| 48 | Q
|
|---|
| 49 | LOOK ; Entry point to look thru the whole selected version routine, checking for mis-matches Prints the DA every tenth time
|
|---|
| 50 | G LOOP
|
|---|
| 51 | SING ; Entry point for a single routine data look-up
|
|---|
| 52 | K DIC D EN,VER G STOP:Y<0 K DIC S DIC(0)="EQAL",DIC="^LAB(69.91,"_VNODE_",""ROU"",",DLAYGO=69,DA(1)=VNODE
|
|---|
| 53 | SING1 ; Loop point
|
|---|
| 54 | D ^DIC G STOP:Y<0 S X=$P(Y,U,2),YBIT=$P(^LAB(69.91,VNODE,"ROU",+Y,0),U,3),ER=0 D SIZE I ER G SING1
|
|---|
| 55 | W !,$S(XBIT'=YBIT:" The "_X_" routine has been EDITED ",1:" The "_X_" routine is unedited"),!,"$(A) SIZE = ",XBIT," $(L) SIZE = ",SIZE
|
|---|
| 56 | W !?10,"Check Sum = ",XSUM,! G SING1
|
|---|
| 57 | Q
|
|---|
| 58 | QUE ;
|
|---|
| 59 | S ZTDESC="PRINT CHANGES IN THE LAB INTEGRITY FILE ",ZTRTN="^DQ^LRNITEG",ZTIO=ION F I="VER","VERDDT","II","VNODE","LRST","XLOAD","XSIZE" S ZTSAVE(I)=""
|
|---|
| 60 | D ^%ZTLOAD W !!?10,"Queued to device "_ION,!!,$C(7) G STOP
|
|---|
| 61 | SCREEN ;Screen routine for version number
|
|---|
| 62 | N XCNP,DIF,% S VER=$P(^LAB(69.91,DA(1),0),U) S XCNP=0,DIF="^TMP(""LRNITEG"","_$J_"," X ^%ZOSF("LOAD") I $P(@(DIF_"2,0)"),";",3)'=VER K X
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | SUM(REF) ; Sum -> Position-relative Ascii total
|
|---|
| 66 | N LRASC,LRDATA,LRPOS,LRTOT,LRREF,X
|
|---|
| 67 | ;
|
|---|
| 68 | ; Various quits...
|
|---|
| 69 | QUIT:$G(REF)']""!(REF="^") "Invalid reference passed" ;->
|
|---|
| 70 | QUIT:$TR(REF,"^","")']"" 0 ;->
|
|---|
| 71 | ;
|
|---|
| 72 | ; Does node exist?
|
|---|
| 73 | K X S (LRREF,X)="I $D("_REF_")#2" D ^DIM
|
|---|
| 74 | I '$D(X) QUIT "Node does not exist..." ;->
|
|---|
| 75 | I $D(X) X LRREF QUIT:'$T "Node does not exist..." ;->
|
|---|
| 76 | ;
|
|---|
| 77 | ; Now, build sum...
|
|---|
| 78 | S LRTOT=0,LRDATA=@REF
|
|---|
| 79 | I $L(LRDATA) F LRPOS=1:1:$L(LRDATA) D
|
|---|
| 80 | . S LRASC=$A($E(LRDATA,+LRPOS))
|
|---|
| 81 | . S LRTOT=LRTOT+(LRASC*LRPOS)
|
|---|
| 82 | ;
|
|---|
| 83 | QUIT LRTOT
|
|---|
| 84 | ;
|
|---|
