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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVGC2 4985 printed Nov 22, 2024@17:51:49 Page 2
XTVGC2 ;ISC-SF/JLI - COMPARE SAVED GLOBALS FOR PACKAGE WITH CURRENT ;12/13/93 13:38 ; 01/16/89
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 WRITE !!,"PREPARE A LIST OF GLOBAL NODES WHICH HAVE BEEN ALTERED",!!
ASK KILL DIC
SET DIC=8991.2
SET DIC(0)="AEQM"
DO ^DIC
if Y'>0
QUIT
SET XTVPT=+Y
+1 IF '$DATA(^XTV(8991.2,XTVPT))
WRITE $CHAR(7)," ??",!?5,"There is no global data saved for this package",!!
GOTO ASK
+2 SET XTVD=0
FOR I=0:0
SET I=$ORDER(^XTV(8991.2,XTVPT,1,I))
if I'>0
QUIT
SET XTVD=I
+3 WRITE !!,"This analysis will be QUEUED to device other than HOME"
SET %ZIS="MNQ"
DO ^%ZIS
if POP
GOTO KILL
+4 IF IO'=IO(0)
SET ZTRTN="DQ^XTVGC2"
SET ZTSAVE("XTVPT")=""
SET ZTSAVE("XTVD")=""
SET ZTDESC="Compare Global Nodes"
DO ^%ZTLOAD
KILL ZTRTN,ZTSAVE,ZTDESC,ZTSK,ZTIO
GOTO KILL
+5 SET IOP=ION_";"_IOST_";"_$SELECT($DATA(IO("DOC")):IO("DOC"),1:IOM_";"_IOSL)
DO ^%ZIS
+6 ;
DQ ;
+1 KILL ^TMP($JOB),X
SET XTVPK=+^XTV(8991.2,XTVPT,0)
WRITE !!,"GLOBAL COMPARISON FOR VERIFICATION PACKAGE: ",$PIECE(^XTV(8991.19,XTVPK,0),U),!!
+2 FOR I=0:0
SET I=$ORDER(^XTV(8991.19,XTVPK,1,I))
if I'>0
QUIT
SET GLBN=+^(I,0)
IF '$DATA(^TMP($JOB,GLBN))
SET ^(GLBN)=GLBN
SET ^TMP($JOB,"A",GLBN)=""
KILL X
DO CHK
+3 DO COMP
DO ^XTVGC2A
KILL DO ^%ZISC
+1 KILL %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
+2 KILL XTVG5,XTVG6,XTVGF,XTVGNM,XTVGNU,XTVGY,XTVI,XTVL,XTVM,XTVN,XTVO,XTVPK,XTVPT,XTVTYP,XTVX,XTVX5,XTVX6,XTVY,Y,ZTDESC,ZTIO,ZTRTN
+3 QUIT
+4 ;
CHK SET L=0
FOR J=0:0
SET J=$ORDER(^DD(GLBN,"SB",J))
if J'>0
QUIT
SET X(L,J)=""
+1 FOR L=0:1
if '$DATA(X(L))
QUIT
SET M=L+1
FOR K=0:0
SET K=$ORDER(X(L,K))
if K'>0
QUIT
FOR J=0:0
SET J=$ORDER(^DD(K,"SB",J))
if J'>0
QUIT
SET X(M,J)=""
+2 FOR L=-1:0
SET L=$ORDER(X(L))
if L=""
QUIT
FOR J=0:0
SET J=$ORDER(X(L,J))
if J'>0
QUIT
if '$DATA(^TMP($JOB,J))
SET ^(J)=GLBN
SET ^TMP($JOB,"A",GLBN,J)=""
+3 QUIT
+4 ;
COMP ;
+1 SET XTVO=0
SET XTVN=0
FOR J=0:0
SET XTVO=$ORDER(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO))
SET XTVN=$ORDER(^TMP($JOB,"A",XTVN))
if XTVO'>0&(XTVN'>0)
QUIT
if XTVO'=XTVN
DO COMP1
IF XTVO=XTVN
DO COMP2
+2 QUIT
+3 ;
COMP1 IF XTVO>0&(XTVN'>0)
WRITE !,"FILE # ",XTVO," IS NOT PRESENT IN NEW VERSION."
QUIT
+1 IF XTVO'>0&(XTVN>0)
WRITE !,"FILE # ",XTVN," APPEARS AS A **NEW** FILE."
QUIT
+2 IF XTVO>XTVN
WRITE !,"FILE # ",XTVN," APPEARS AS A **NEW** FILE."
SET XTVN=$ORDER(^TMP($JOB,"A",XTVN))
if XTVN'=XTVO
GOTO COMP1
QUIT
+3 IF XTVN>XTVO
WRITE !,"FILE # ",XTVO," IS NOT PRESENT IN NEW VERSION."
SET XTVO=$ORDER(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO))
if XTVN'=XTVO
GOTO COMP1
QUIT
+4 QUIT
+5 ;
COMP2 ;
+1 WRITE !,"...FILE ",XTVO
+2 ;,DIE,DIBT,DIPT
DO DIC
DO DD
+3 QUIT
DIC SET XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,""C"",M,0)"
SET XTVG="^DIC("_XTVO
SET XTVG1=XTVG_",0"
SET XTVG=XTVG_")"
DO COMPAR
+1 QUIT
DD FOR XTVF=0:0
SET XTVF=$ORDER(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,"D",XTVF))
if XTVF'>0
QUIT
SET XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,""D"",XTVF,1,M,0)"
SET XTVG="^DD("_XTVF_")"
SET XTVG1="^DD("_XTVF_","
DO COMPAR
+1 QUIT
DIE ;
+1 SET XTVTYP="Edit"
SET XTVL="E"
SET XTVM="^DIE("
DO TEMP
+2 QUIT
DIPT SET XTVTYP="Print"
SET XTVL="P"
SET XTVM="^DIPT("
DO TEMP
+1 QUIT
DIBT SET XTVTYP="Sort"
SET XTVL="S"
SET XTVM="^DIBT("
DO TEMP
+1 QUIT
TEMP ;
+1 SET XTVFNM=""
SET XTVGNM=""
SET XTVFNU=0
SET XTVGNU=0
SET XTVGF=XTVM_"""F"_XTVO_""",XTVGNM)"
+2 FOR XTVI=0:0
if XTVFNU'=""
SET XTVFNM=$ORDER(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,XTVL,"B",XTVFNM))
SET XTVFNU=$SELECT(XTVFNM="":"",1:$ORDER(^(XTVFNM,0)))
if XTVGNU'=""
SET XTVGNM=$ORDER(@XTVGF)
SET XTVGNU=$SELECT(XTVGNM="":"",1:$ORDER(^(XTVGNM,0)))
if XTVGNM=""&(XTVFNM="")
QUIT
DO TPAR
+3 QUIT
TPAR ;
+1 IF XTVFNM=""
WRITE !,XTVTYP," template ",XTVGNM," has been ** ADDED **"
QUIT
+2 IF XTVGNM=""
WRITE !,XTVTYP," template ",XTVFNM," has been ** DELETED **"
QUIT
+3 IF XTVGNM]XTVFNM
WRITE !,XTVTYP," template ",XTVFNM," has been ** DELETED **"
SET XTVFNM=$ORDER(^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,XTVL,"B",XTVFNM))
SET XTVFNU=$SELECT(XTVFNM="":"",1:$ORDER(^(XTVFNM,0)))
GOTO TPAR
+4 ; Naked is based on @XTVGF
IF XTVFNM]XTVGNM
WRITE !,XTVTYP," template ",XTVGNM," has been ** ADDED **"
SET XTVGNM=$ORDER(@XTVGF)
SET XTVGNU=$SELECT(XTVGNM="":"",1:$ORDER(^(XTVGNM,0)))
GOTO TPAR
+5 SET XTVF0="^XTV(8991.2,XTVPT,1,XTVD,1,XTVO,"""_XTVL_""",XTVFNU,1,M,0)"
SET XTVG=XTVM_XTVGNU
SET XTVG1=XTVG_","
SET XTVG=XTVG_")"
DO COMPAR
+6 QUIT
COMPAR FOR M=1:1
if XTVG'=""
SET XTVG=$QUERY(@XTVG)
DO MSMQ
if XTVG'[XTVG1
SET XTVG=""
SET XTVGY=$SELECT(XTVG="":"",1:@XTVG)
Begin DoDot:1
+1 ; Naked is based on @XTVF0
SET XTVX=$SELECT('$DATA(@XTVF0):"",$EXTRACT(^(0),1)=U:^(0),1:U_^(0))
SET XTVY=$SELECT(XTVX="":"",1:^(1))
if XTVG=""&(XTVX="")
QUIT
DO CHECK
End DoDot:1
if XTVG=""&(XTVX="")
QUIT
+2 QUIT
CHECK if '$DATA(XTVTYP)
SET XTVTYP=""
IF XTVG=""
WRITE !,"* DEL * ",XTVX," = ",XTVY
QUIT
+1 IF XTVX=""
WRITE !,"* ADD * ",XTVG," = ",XTVGY
QUIT
+2 SET XTVB=$SELECT(XTVX=XTVG:0,1:1)
+3 IF XTVB
SET XTVX5=$EXTRACT(XTVX,1,$LENGTH(XTVX)-1)
SET XTVG5=$EXTRACT(XTVG,1,$LENGTH(XTVG)-1)
FOR XTVI=1:1
SET XTVG6=$PIECE(XTVG5,",",XTVI)
SET XTVX6=$PIECE(XTVX5,",",XTVI)
IF XTVG6'=XTVX6
SET XTVB=$SELECT(+XTVX6=XTVX6:$SELECT(+XTVG6'=XTVG6:-1,XTVX6<XTVG6:-1,1:1),+XTVG6=XTVG6:1,XTVG6]XTVX6:-1,1:1)
QUIT
+4 ; Naked is based on @XTVF0
IF XTVB<0
WRITE !,"* DEL * ",XTVX," = ",XTVY
SET M=M+1
SET XTVX=$SELECT('$DATA(@XTVF0):"",$EXTRACT(^(0),1)=U:^(0),1:U_^(0))
SET XTVY=$SELECT(XTVX="":"",1:^(1))
GOTO CHECK
+5 IF XTVB>0
if (XTVTYP="")!($PIECE(XTVG,",",2)'="""AB""")
WRITE !,"* ADD * ",XTVG," = ",XTVGY
SET XTVG=$QUERY(@XTVG)
DO MSMQ
if XTVG'[XTVG1
SET XTVG=""
SET XTVGY=$SELECT(XTVG="":"",1:@XTVG)
GOTO CHECK
+6 IF XTVGY'=XTVY
WRITE !,"* OLD * ",XTVX," = ",XTVY,!,"* NEW * ",XTVX," = ",XTVGY
+7 QUIT
MSMQ SET XTVG=$SELECT($EXTRACT(XTVG,1,2)="^|":U_$PIECE(XTVG,"|",3,99),$EXTRACT(XTVG,1,2)="^[":U_$PIECE(XTVG,"]",2,99),1:XTVG)
+1 QUIT
