- 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 Feb 19, 2025@00:08:22 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
