source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTVGC2.m@ 949

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1XTVGC2 ;ISC-SF/JLI - COMPARE SAVED GLOBALS FOR PACKAGE WITH CURRENT ;12/13/93 13:38 ; 01/16/89
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 W !!,"PREPARE A LIST OF GLOBAL NODES WHICH HAVE BEEN ALTERED",!!
4ASK K DIC S DIC=8991.2,DIC(0)="AEQM" D ^DIC Q:Y'>0 S XTVPT=+Y
5 I '$D(^XTV(8991.2,XTVPT)) W $C(7)," ??",!?5,"There is no global data saved for this package",!! G ASK
6 S XTVD=0 F I=0:0 S I=$O(^XTV(8991.2,XTVPT,1,I)) Q:I'>0 S XTVD=I
7 W !!,"This analysis will be QUEUED to device other than HOME" S %ZIS="MNQ" D ^%ZIS G:POP KILL
8 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
9 S IOP=ION_";"_IOST_";"_$S($D(IO("DOC")):IO("DOC"),1:IOM_";"_IOSL) D ^%ZIS
10 ;
11DQ ;
12 K ^TMP($J),X S XTVPK=+^XTV(8991.2,XTVPT,0) W !!,"GLOBAL COMPARISON FOR VERIFICATION PACKAGE: ",$P(^XTV(8991.19,XTVPK,0),U),!!
13 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
14 D COMP,^XTVGC2A
15KILL D ^%ZISC
16 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
17 K XTVG5,XTVG6,XTVGF,XTVGNM,XTVGNU,XTVGY,XTVI,XTVL,XTVM,XTVN,XTVO,XTVPK,XTVPT,XTVTYP,XTVX,XTVX5,XTVX6,XTVY,Y,ZTDESC,ZTIO,ZTRTN
18 Q
19 ;
20CHK S L=0 F J=0:0 S J=$O(^DD(GLBN,"SB",J)) Q:J'>0 S X(L,J)=""
21 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)=""
22 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)=""
23 Q
24 ;
25COMP ;
26 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
27 Q
28 ;
29COMP1 I XTVO>0&(XTVN'>0) W !,"FILE # ",XTVO," IS NOT PRESENT IN NEW VERSION." Q
30 I XTVO'>0&(XTVN>0) W !,"FILE # ",XTVN," APPEARS AS A **NEW** FILE." Q
31 I XTVO>XTVN W !,"FILE # ",XTVN," APPEARS AS A **NEW** FILE." S XTVN=$O(^TMP($J,"A",XTVN)) G:XTVN'=XTVO COMP1 Q
32 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
33 Q
34 ;
35COMP2 ;
36 W !,"...FILE ",XTVO
37 D DIC,DD ;,DIE,DIBT,DIPT
38 Q
39DIC S XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,""C"",M,0)",XTVG="^DIC("_XTVO,XTVG1=XTVG_",0",XTVG=XTVG_")" D COMPAR
40 Q
41DD 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
42 Q
43DIE ;
44 S XTVTYP="Edit",XTVL="E",XTVM="^DIE(" D TEMP
45 Q
46DIPT S XTVTYP="Print",XTVL="P",XTVM="^DIPT(" D TEMP
47 Q
48DIBT S XTVTYP="Sort",XTVL="S",XTVM="^DIBT(" D TEMP
49 Q
50TEMP ;
51 S XTVFNM="",XTVGNM="",XTVFNU=0,XTVGNU=0,XTVGF=XTVM_"""F"_XTVO_""",XTVGNM)"
52 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
53 Q
54TPAR ;
55 I XTVFNM="" W !,XTVTYP," template ",XTVGNM," has been ** ADDED **" Q
56 I XTVGNM="" W !,XTVTYP," template ",XTVFNM," has been ** DELETED **" Q
57 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
58 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
59 S XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,"""_XTVL_""",XTVFNU,1,M,0)",XTVG=XTVM_XTVGNU,XTVG1=XTVG_",",XTVG=XTVG_")" D COMPAR
60 Q
61COMPAR 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="")
62 .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
63 Q
64CHECK S:'$D(XTVTYP) XTVTYP="" I XTVG="" W !,"* DEL * ",XTVX," = ",XTVY Q
65 I XTVX="" W !,"* ADD * ",XTVG," = ",XTVGY Q
66 S XTVB=$S(XTVX=XTVG:0,1:1)
67 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
68 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
69 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
70 I XTVGY'=XTVY W !,"* OLD * ",XTVX," = ",XTVY,!,"* NEW * ",XTVX," = ",XTVGY
71 Q
72MSMQ S XTVG=$S($E(XTVG,1,2)="^|":U_$P(XTVG,"|",3,99),$E(XTVG,1,2)="^[":U_$P(XTVG,"]",2,99),1:XTVG)
73 Q
Note: See TracBrowser for help on using the repository browser.