74 lines
4.8 KiB
Mathematica
74 lines
4.8 KiB
Mathematica
XTVGC2 ;ISC-SF/JLI - COMPARE SAVED GLOBALS FOR PACKAGE WITH CURRENT ;12/13/93 13:38 ; 01/16/89
|
|
;;7.3;TOOLKIT;;Apr 25, 1995
|
|
W !!,"PREPARE A LIST OF GLOBAL NODES WHICH HAVE BEEN ALTERED",!!
|
|
ASK K DIC S DIC=8991.2,DIC(0)="AEQM" D ^DIC Q:Y'>0 S XTVPT=+Y
|
|
I '$D(^XTV(8991.2,XTVPT)) W $C(7)," ??",!?5,"There is no global data saved for this package",!! G ASK
|
|
S XTVD=0 F I=0:0 S I=$O(^XTV(8991.2,XTVPT,1,I)) Q:I'>0 S XTVD=I
|
|
W !!,"This analysis will be QUEUED to device other than HOME" S %ZIS="MNQ" D ^%ZIS G:POP KILL
|
|
I IO'=IO(0) S ZTRTN="DQ^XTVGC2",ZTSAVE("XTVPT")="",ZTSAVE("XTVD")="",ZTDESC="Compare Global Nodes" D ^%ZTLOAD K ZTRTN,ZTSAVE,ZTDESC,ZTSK,ZTIO G KILL
|
|
S IOP=ION_";"_IOST_";"_$S($D(IO("DOC")):IO("DOC"),1:IOM_";"_IOSL) D ^%ZIS
|
|
;
|
|
DQ ;
|
|
K ^TMP($J),X S XTVPK=+^XTV(8991.2,XTVPT,0) W !!,"GLOBAL COMPARISON FOR VERIFICATION PACKAGE: ",$P(^XTV(8991.19,XTVPK,0),U),!!
|
|
F I=0:0 S I=$O(^XTV(8991.19,XTVPK,1,I)) Q:I'>0 S GLBN=+^(I,0) I '$D(^TMP($J,GLBN)) S ^(GLBN)=GLBN,^TMP($J,"A",GLBN)="" K X D CHK
|
|
D COMP,^XTVGC2A
|
|
KILL D ^%ZISC
|
|
K %X,%Y,%ZIS,DIC,I,J,K,L,M,ION,IOP,POP,GLBN,X,X1,X2,XTBAS,XTBAS1,XTBAS2,XTBASI,XTIEN,XTN,XTNN,XTNOD,XTNS,XTNS1,XTNSI,XTNSL,XTNUM,XTNUMN,XTSEEN,XTTY,XTTYI,XTTYJ,XTVAL,XTVAL1,XTVB,XTVD,XTVF,XTVF0,XTVFNM,XTVFNU,XTVG,XTVG1
|
|
K XTVG5,XTVG6,XTVGF,XTVGNM,XTVGNU,XTVGY,XTVI,XTVL,XTVM,XTVN,XTVO,XTVPK,XTVPT,XTVTYP,XTVX,XTVX5,XTVX6,XTVY,Y,ZTDESC,ZTIO,ZTRTN
|
|
Q
|
|
;
|
|
CHK S L=0 F J=0:0 S J=$O(^DD(GLBN,"SB",J)) Q:J'>0 S X(L,J)=""
|
|
F L=0:1 Q:'$D(X(L)) S M=L+1 F K=0:0 S K=$O(X(L,K)) Q:K'>0 F J=0:0 S J=$O(^DD(K,"SB",J)) Q:J'>0 S X(M,J)=""
|
|
F L=-1:0 S L=$O(X(L)) Q:L="" F J=0:0 S J=$O(X(L,J)) Q:J'>0 S:'$D(^TMP($J,J)) ^(J)=GLBN,^TMP($J,"A",GLBN,J)=""
|
|
Q
|
|
;
|
|
COMP ;
|
|
S XTVO=0,XTVN=0 F J=0:0 S XTVO=$O(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO)),XTVN=$O(^TMP($J,"A",XTVN)) Q:XTVO'>0&(XTVN'>0) D:XTVO'=XTVN COMP1 I XTVO=XTVN D COMP2
|
|
Q
|
|
;
|
|
COMP1 I XTVO>0&(XTVN'>0) W !,"FILE # ",XTVO," IS NOT PRESENT IN NEW VERSION." Q
|
|
I XTVO'>0&(XTVN>0) W !,"FILE # ",XTVN," APPEARS AS A **NEW** FILE." Q
|
|
I XTVO>XTVN W !,"FILE # ",XTVN," APPEARS AS A **NEW** FILE." S XTVN=$O(^TMP($J,"A",XTVN)) G:XTVN'=XTVO COMP1 Q
|
|
I XTVN>XTVO W !,"FILE # ",XTVO," IS NOT PRESENT IN NEW VERSION." S XTVO=$O(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO)) G:XTVN'=XTVO COMP1 Q
|
|
Q
|
|
;
|
|
COMP2 ;
|
|
W !,"...FILE ",XTVO
|
|
D DIC,DD ;,DIE,DIBT,DIPT
|
|
Q
|
|
DIC S XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,""C"",M,0)",XTVG="^DIC("_XTVO,XTVG1=XTVG_",0",XTVG=XTVG_")" D COMPAR
|
|
Q
|
|
DD F XTVF=0:0 S XTVF=$O(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,"D",XTVF)) Q:XTVF'>0 S XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,""D"",XTVF,1,M,0)",XTVG="^DD("_XTVF_")",XTVG1="^DD("_XTVF_"," D COMPAR
|
|
Q
|
|
DIE ;
|
|
S XTVTYP="Edit",XTVL="E",XTVM="^DIE(" D TEMP
|
|
Q
|
|
DIPT S XTVTYP="Print",XTVL="P",XTVM="^DIPT(" D TEMP
|
|
Q
|
|
DIBT S XTVTYP="Sort",XTVL="S",XTVM="^DIBT(" D TEMP
|
|
Q
|
|
TEMP ;
|
|
S XTVFNM="",XTVGNM="",XTVFNU=0,XTVGNU=0,XTVGF=XTVM_"""F"_XTVO_""",XTVGNM)"
|
|
F XTVI=0:0 S:XTVFNU'="" XTVFNM=$O(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,XTVL,"B",XTVFNM)),XTVFNU=$S(XTVFNM="":"",1:$O(^(XTVFNM,0))) S:XTVGNU'="" XTVGNM=$O(@XTVGF),XTVGNU=$S(XTVGNM="":"",1:$O(^(XTVGNM,0))) Q:XTVGNM=""&(XTVFNM="") D TPAR
|
|
Q
|
|
TPAR ;
|
|
I XTVFNM="" W !,XTVTYP," template ",XTVGNM," has been ** ADDED **" Q
|
|
I XTVGNM="" W !,XTVTYP," template ",XTVFNM," has been ** DELETED **" Q
|
|
I XTVGNM]XTVFNM W !,XTVTYP," template ",XTVFNM," has been ** DELETED **" S XTVFNM=$O(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,XTVL,"B",XTVFNM)),XTVFNU=$S(XTVFNM="":"",1:$O(^(XTVFNM,0))) G TPAR
|
|
I XTVFNM]XTVGNM W !,XTVTYP," template ",XTVGNM," has been ** ADDED **" S XTVGNM=$O(@XTVGF),XTVGNU=$S(XTVGNM="":"",1:$O(^(XTVGNM,0))) G TPAR ; Naked is based on @XTVGF
|
|
S XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,"""_XTVL_""",XTVFNU,1,M,0)",XTVG=XTVM_XTVGNU,XTVG1=XTVG_",",XTVG=XTVG_")" D COMPAR
|
|
Q
|
|
COMPAR F M=1:1 S:XTVG'="" XTVG=$Q(@XTVG) D MSMQ S:XTVG'[XTVG1 XTVG="" S XTVGY=$S(XTVG="":"",1:@XTVG) D Q:XTVG=""&(XTVX="")
|
|
.S XTVX=$S('$D(@XTVF0):"",$E(^(0),1)=U:^(0),1:U_^(0)),XTVY=$S(XTVX="":"",1:^(1)) Q:XTVG=""&(XTVX="") D CHECK ; Naked is based on @XTVF0
|
|
Q
|
|
CHECK S:'$D(XTVTYP) XTVTYP="" I XTVG="" W !,"* DEL * ",XTVX," = ",XTVY Q
|
|
I XTVX="" W !,"* ADD * ",XTVG," = ",XTVGY Q
|
|
S XTVB=$S(XTVX=XTVG:0,1:1)
|
|
I XTVB S XTVX5=$E(XTVX,1,$L(XTVX)-1),XTVG5=$E(XTVG,1,$L(XTVG)-1) F XTVI=1:1 S XTVG6=$P(XTVG5,",",XTVI),XTVX6=$P(XTVX5,",",XTVI) I XTVG6'=XTVX6 S XTVB=$S(+XTVX6=XTVX6:$S(+XTVG6'=XTVG6:-1,XTVX6<XTVG6:-1,1:1),+XTVG6=XTVG6:1,XTVG6]XTVX6:-1,1:1) Q
|
|
I XTVB<0 W !,"* DEL * ",XTVX," = ",XTVY S M=M+1,XTVX=$S('$D(@XTVF0):"",$E(^(0),1)=U:^(0),1:U_^(0)),XTVY=$S(XTVX="":"",1:^(1)) G CHECK ; Naked is based on @XTVF0
|
|
I XTVB>0 W:(XTVTYP="")!($P(XTVG,",",2)'="""AB""") !,"* ADD * ",XTVG," = ",XTVGY S XTVG=$Q(@XTVG) D MSMQ S:XTVG'[XTVG1 XTVG="" S XTVGY=$S(XTVG="":"",1:@XTVG) G CHECK
|
|
I XTVGY'=XTVY W !,"* OLD * ",XTVX," = ",XTVY,!,"* NEW * ",XTVX," = ",XTVGY
|
|
Q
|
|
MSMQ S XTVG=$S($E(XTVG,1,2)="^|":U_$P(XTVG,"|",3,99),$E(XTVG,1,2)="^[":U_$P(XTVG,"]",2,99),1:XTVG)
|
|
Q
|