- LRINTEG ;SLC/FHS - INTEGRITY CHECKER FOR LAB SERVICE PACKAGE ;8/3/89 17:52 ;
- ;;V~5.0~;LAB;;02/27/90 17:09
- EN ;set %zosf variables
- ; This routine stores routines (variable X) in ^UTILITY("LRINTEG" returns
- ; XBIT which is = $A(X) and SIZE which is the $L(X)
- NEW ;
- N I,A,DIF,DIC,Y,II,XCNP,XCS,XCM,XCN,%,X
- K ^UTILITY("LRINTEG",$J) S XLOAD=^%ZOSF("LOAD"),XTEST=^("TEST"),DIF="^UTILITY(""LRINTEG"""_","_$J_","
- S XSIZE="S SIZE=0,I=1 F A=0:0 S I=$O(^UTILITY(""LRINTEG"",$J,I)) Q:I="""" S SIZE=SIZE+$L(^(I,0))+2"
- Q
- VER ; Select or add version #
- K DIC S U="^",DIC("A")=" Select Version # ",DIC(0)="AQEZ",DIC="^LAB(69.91," S:$D(LOAD) DIC(0)=DIC(0)_"L" D ^DIC G:Y<0 STOP S VNODE=+Y,VER=$P(Y,U,2),VERDDT=$P(Y(0),U,2)
- Q
- LOOP ; Loop thru intire file checking for mis-match between file directory
- K %DT S %DT="RX",X="NOW" D ^%DT W !,Y
- D EN,VER Q:Y<1 S II=0,LRST=""
- 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
- S:'$L(X) X="L" I $E(X)'="L" W *7,!!?7,"ENTER RETURN OR ROUTINE BEGINNING WITH 'L' " G ASK
- S II=X
- 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
- S:'$L(X) X="" I $L(X),$E(X)'="L" W *7,!!?7,"ROUTINE MUST START WITH 'L' " G ASK1
- S LRST=X
- W !!?7,"Enter '^' to stop ",!!
- 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 D SIZE Q:ER I XBIT'=YBIT W !,"EDIT/CHANGE IN ",X,!,*7
- Q
- SIZE ; Test for existence of X, load routine into ^UTILITY("LRINTEG" AND COUNT $L(X)
- ;Entry point for trigger of ^lab(69.911,.01 Caution if changed.
- N DIF,XCNP S DIF="^UTILITY(""LRINTEG"""_","_$J_"," X XTEST G:'$T ER S XCNP=0 K ^UTILITY("LRINTEG",$J) X XLOAD,XSIZE
- BIT ;
- S XBIT=0 F I=2:1 Q:'$D(^UTILITY("LRINTEG",$J,I,0)) S L=^(0),LN=$L(L) F NT=1:1:LN S XBIT=$A(L,NT)+XBIT
- Q
- ER ; Error msg for when attempt to use a routine that doen't exist
- S ER=1 W !,"There is not a routine called '",X,"' in this directory ",*7,! K X Q
- ER2 ; Error msg when the version being loaded does not match the version selected for auto loading
- W !?10,ROU," is version ",$S($L($P(^UTILITY("LRINTEG",$J,2,0),"~",2)):$P(^(0),"~",2),1:"Unknown ")," NOT LOADED",*7,! Q
- STOP ; clean-up
- 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,XTEST,YBIT,^UTILITY("LRINTEG",$J) Q
- Q
- LOOK ; Entry point to look thru the whole selected version routine, checking for mis-matches Prints the DA every tenth time
- D EN,VER Q:Y<0 D LOOP Q
- SING ; Entry point for a single routine data look-up
- K DIC D EN,VER G STOP:Y<0 K DIC S DIC(0)="EQA",DIC="^LAB(69.91,"_VNODE_",""ROU"","
- SING1 ; Loop point
- 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
- W !,$S(XBIT'=YBIT:" The "_X_" routine has been EDITED ",1:" The "_X_" routine is unedited"),!,"$(A) SIZE = ",XBIT," $(L) SIZE = ",SIZE,! G SING1
- LRINTEG ;SLC/FHS - INTEGRITY CHECKER FOR LAB SERVICE PACKAGE ;8/3/89 17:52 ;
- +1 ;;V~5.0~;LAB;;02/27/90 17:09
- EN ;set %zosf variables
- +1 ; This routine stores routines (variable X) in ^UTILITY("LRINTEG" returns
- +2 ; XBIT which is = $A(X) and SIZE which is the $L(X)
- NEW ;
- +1 NEW I,A,DIF,DIC,Y,II,XCNP,XCS,XCM,XCN,%,X
- +2 KILL ^UTILITY("LRINTEG",$JOB)
- SET XLOAD=^%ZOSF("LOAD")
- SET XTEST=^("TEST")
- SET DIF="^UTILITY(""LRINTEG"""_","_$JOB_","
- +3 SET XSIZE="S SIZE=0,I=1 F A=0:0 S I=$O(^UTILITY(""LRINTEG"",$J,I)) Q:I="""" S SIZE=SIZE+$L(^(I,0))+2"
- +4 QUIT
- VER ; Select or add version #
- +1 KILL DIC
- SET U="^"
- SET DIC("A")=" Select Version # "
- SET DIC(0)="AQEZ"
- SET DIC="^LAB(69.91,"
- IF $DATA(LOAD)
- SET DIC(0)=DIC(0)_"L"
- DO ^DIC
- IF Y<0
- GOTO STOP
- SET VNODE=+Y
- SET VER=$PIECE(Y,U,2)
- SET VERDDT=$PIECE(Y(0),U,2)
- +2 QUIT
- LOOP ; Loop thru intire file checking for mis-match between file directory
- +1 KILL %DT
- SET %DT="RX"
- SET X="NOW"
- DO ^%DT
- WRITE !,Y
- +2 DO EN
- DO VER
- IF Y<1
- QUIT
- SET II=0
- SET LRST=""
- ASK READ !," Enter Routine to start checking from ",X:DTIME
- IF '$TEST!(X[U)
- QUIT
- IF X["?"
- WRITE !!,"Enter a program name to start with "
- IF X["?"
- GOTO ASK
- IF $LENGTH(X)
- IF $EXTRACT(X)="L"
- SET II=X
- +1 IF '$LENGTH(X)
- SET X="L"
- IF $EXTRACT(X)'="L"
- WRITE *7,!!?7,"ENTER RETURN OR ROUTINE BEGINNING WITH 'L' "
- GOTO ASK
- +2 SET II=X
- ASK1 READ !!," Enter EXACT routine to stop checking : ALL// ",X:DTIME
- IF '$TEST!(X[U)
- QUIT
- IF X["?"
- WRITE !!,"Enter the name of a program to stop this routine "
- IF X["?"
- GOTO ASK1
- IF $LENGTH(X)
- IF $EXTRACT(X)="L"
- SET LRST=X
- +1 IF '$LENGTH(X)
- SET X=""
- IF $LENGTH(X)
- IF $EXTRACT(X)'="L"
- WRITE *7,!!?7,"ROUTINE MUST START WITH 'L' "
- GOTO ASK1
- +2 SET LRST=X
- +3 WRITE !!?7,"Enter '^' to stop ",!!
- +4 FOR A=0:0
- READ X:.1
- IF X="^"
- QUIT
- SET II=$ORDER(^LAB(69.91,VNODE,"ROU","B",II))
- IF II=""!(II=LRST)
- QUIT
- WRITE "."
- SET IX=$ORDER(^(II,0))
- SET X=$PIECE(^LAB(69.91,VNODE,"ROU",IX,0),U)
- SET SIZE=$PIECE(^(0),U,2)
- SET YBIT=$PIECE(^(0),U,3)
- SET ER=0
- DO SIZE
- IF ER
- QUIT
- IF XBIT'=YBIT
- WRITE !,"EDIT/CHANGE IN ",X,!,*7
- +5 QUIT
- SIZE ; Test for existence of X, load routine into ^UTILITY("LRINTEG" AND COUNT $L(X)
- +1 ;Entry point for trigger of ^lab(69.911,.01 Caution if changed.
- +2 NEW DIF,XCNP
- SET DIF="^UTILITY(""LRINTEG"""_","_$JOB_","
- XECUTE XTEST
- IF '$TEST
- GOTO ER
- SET XCNP=0
- KILL ^UTILITY("LRINTEG",$JOB)
- XECUTE XLOAD
- XECUTE XSIZE
- BIT ;
- +1 SET XBIT=0
- FOR I=2:1
- IF '$DATA(^UTILITY("LRINTEG",$JOB,I,0))
- QUIT
- SET L=^(0)
- SET LN=$LENGTH(L)
- FOR NT=1:1:LN
- SET XBIT=$ASCII(L,NT)+XBIT
- +2 QUIT
- ER ; Error msg for when attempt to use a routine that doen't exist
- +1 SET ER=1
- WRITE !,"There is not a routine called '",X,"' in this directory ",*7,!
- KILL X
- QUIT
- ER2 ; Error msg when the version being loaded does not match the version selected for auto loading
- +1 WRITE !?10,ROU," is version ",$SELECT($LENGTH($PIECE(^UTILITY("LRINTEG",$JOB,2,0),"~",2)):$PIECE(^(0),"~",2),1:"Unknown ")," NOT LOADED",*7,!
- QUIT
- STOP ; clean-up
- +1 KILL 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,XTEST,YBIT,^UTILITY("LRINTEG",$JOB)
- QUIT
- +2 QUIT
- LOOK ; Entry point to look thru the whole selected version routine, checking for mis-matches Prints the DA every tenth time
- +1 DO EN
- DO VER
- IF Y<0
- QUIT
- DO LOOP
- QUIT
- SING ; Entry point for a single routine data look-up
- +1 KILL DIC
- DO EN
- DO VER
- IF Y<0
- GOTO STOP
- KILL DIC
- SET DIC(0)="EQA"
- SET DIC="^LAB(69.91,"_VNODE_",""ROU"","
- SING1 ; Loop point
- +1 DO ^DIC
- IF Y<0
- GOTO STOP
- SET X=$PIECE(Y,U,2)
- SET YBIT=$PIECE(^LAB(69.91,VNODE,"ROU",+Y,0),U,3)
- SET ER=0
- DO SIZE
- IF ER
- GOTO SING1
- +2 WRITE !,$SELECT(XBIT'=YBIT:" The "_X_" routine has been EDITED ",1:" The "_X_" routine is unedited"),!,"$(A) SIZE = ",XBIT," $(L) SIZE = ",SIZE,!
- GOTO SING1