source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTVGC2.m@ 1764

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