XTVGC2A ;ISC-SF/SEA/JLI - COMPARE SAVED AND CURRENT NAMESPACE DATA ;12/13/93 15:18 ;
;;7.3;TOOLKIT;;Apr 25, 1995
ENTRY ;
F XTTYJ=1:1:8 D
.K ^TMP($J) S XTTY=$P("OPTIONS;DIC(19,^KEYS;DIC(19.1,^HELP FRAMES;DIC(9.2,^BULLETINS;XMB(3.6,^FUNCTIONS;DD(""FUNC"",^EDIT TEMPLATES;DIE(^SORT TEMPLATES;DIBT(^PRINT TEMPLATES;DIPT(^S;SCRE(",U,XTTYJ)
.S XTNOD=U_$P(XTTY,";",2),XTTY=$P(XTTY,";"),XTBAS1="^XTV(8991.2,XTVPT,1,XTVD,2," S XTTYI=$O(@(XTBAS1_"""B"","""_XTTY_""",0)")) D D COMPAR
..W !,"********************************* Checking ",XTTY
..I XTTYI>0 S %X=XTBAS1_XTTYI_",1,""B"",",%Y="^TMP($J,""B""," D %XY^%RCR I XTTYJ>5,XTTYJ<9 D
. . . S XTTYA="" F S XTTYA=$O(^TMP($J,"B",XTTYA)) Q:XTTYA="" F XTTYK=0:0 S XTTYK=$O(^TMP($J,"B",XTTYA,XTTYK)) Q:XTTYK'>0 S XTTYM=^(XTTYK) D
. . . . S XTTYKM=$P($G(@(XTBAS1_XTTYI_",1,"_XTTYK_",1,1,1)")),U,4) I XTTYKM'="" K ^TMP($J,"B",XTTYA,XTTYK) S ^TMP($J,"Z",(XTTYA_" ("_XTTYKM_")"),XTTYK)=XTTYM
. . . S %X="^TMP($J,""Z"",",%Y="^TMP($J,""B""," D %XY^%RCR K ^TMP($J,"Z")
. . K ^TMP($J,"XB") S %X=XTNOD_"""B"",",%Y="^TMP($J,""XB""," D %XY^%RCR I XTTYJ>5,XTTYJ<9 D
. . . S XTTYA="" F S XTTYA=$O(^TMP($J,"XB",XTTYA)) Q:XTTYA="" F XTTYK=0:0 S XTTYK=$O(^TMP($J,"XB",XTTYA,XTTYK)) Q:XTTYK'>0 D
. . . . S XTTYKM=$P($G(@(XTNOD_XTTYK_",0)")),U,4) I XTTYKM'="" K ^TMP($J,"XB",XTTYA,XTTYK) S ^TMP($J,"Z",(XTTYA_" ("_XTTYKM_")"),XTTYK)=""
. . . S %X="^TMP($J,""Z"",",%Y="^TMP($J,""XB""," D %XY^%RCR K ^TMP($J,"Z")
K ^TMP($J),XTTYA,XTTYK,XTTYKM,XTTYM
Q
COMPAR ;
S:'$D(XTVPK) XTVPK=+^XTV(8991.2,XTVPT,0) S XTNS="" F XTNSI=0:0 S XTNSI=$O(^XTV(8991.19,XTVPK,2,XTNSI)) Q:XTNSI'>0 S XTNS($P(^(XTNSI,0),U))=""
F S XTNS=$O(XTNS(XTNS)) Q:XTNS="" S XTNSL=$L(XTNS),XTNS1=$E(XTNS,1,XTNSL-1)_$C($A($E(XTNS,XTNSL))-1)_"z",XTVAL=XTNS1 D COMPAR1
S XTVAL="" D COMPAR2
Q
COMPAR1 ;
F S XTVAL=$O(^TMP($J,"XB",XTVAL)) Q:$E(XTVAL,1,XTNSL)'=XTNS D
.K XTNUM,^TMP($J,"N") S XTNUMN=0 F XTNUM=0:0 S XTNUM=$O(^TMP($J,"XB",XTVAL,XTNUM)) D:XTNUM'>0 Q:XTNUM'>0 S XTNUM(XTNUM)="",XTNUMN=XTNUMN+1
..I XTNUMN>1 W !?2,XTNUMN," ENTRIES OF ",XTVAL," IN B X-REF OF CURRENT ",XTTY," FILE"
..F XTNUM=0:0 S XTNUM=$O(XTNUM(XTNUM)) Q:XTNUM'>0 I $D(@(XTNOD_XTNUM_",0)")) S ^TMP($J,"N",($P(^(0),U)_$S(XTTYJ>5&(XTTYJ<9):" ("_$P(^(0),U,4)_")",1:"")),XTNUM)=""
.. S XTVAL2="" F S XTVAL2=$O(^TMP($J,"N",XTVAL2)) Q:XTVAL2="" D COMPAR2
Q
COMPAR2 ;
S XTVAL1=""
K XTN S XTVAL1=$O(^TMP($J,"B",XTVAL1)) I XTVAL1'="" S XTNN=0 F XTN=0:0 S XTN=$O(^TMP($J,"B",XTVAL1,XTN)) Q:XTN'>0 S XTN(XTN)=^(XTN),XTNN=XTNN+1
Q:XTVAL1=""&(XTVAL2="")
I XTVAL1'="",XTVAL2=""!(XTVAL2]XTVAL1) D G COMPAR2 ; XTVAL1 BEFORE XTVAL
.I XTNN>1 W !?2,XTNN," ENTRIES OF ",XTVAL1," IN B X-REF OF OLD ",XTTY," FILE"
.K ^TMP($J,"O"),^("OB") F XTN=0:0 S XTN=$O(XTN(XTN)) Q:XTN'>0 I $D(@(XTBAS1_"XTTYI,1,XTN,1,1,1)")) S X=$P(^(1),U)_$S(XTTYJ>5&(XTTYJ<9):" ("_$P(^(1),U,4)_")",1:""),^TMP($J,"O",X,XTN(XTN))=XTN
.S X="" F S X=$O(^TMP($J,"O",X)) Q:X="" F XTNN=0:0 S XTNN=$O(^TMP($J,"O",X,XTNN)) Q:XTNN'>0 S XTIEN=XTNN,XTN=^(XTNN) D
..W !!,"DELETED ",$E(XTTY,1,$L(XTTY)-1),": ",X," OLD IEN=",XTN
..S XTBAS2=XTBAS1_"XTTYI,1,XTN,1," F I=0:0 S I=$O(@(XTBAS2_I_")")) Q:I'>0 S X1=@(XTBAS2_I_",0)"),X2=@(XTBAS2_I_",1)"),X1=$P(X1,"~IEN~")_XTIEN_$P(X1,"~IEN~",2) W !?5,X1," = ",X2
.K ^TMP($J,"B",XTVAL1)
I XTVAL1=""!(XTVAL1]XTVAL2) D Q ; XTVAL BEFORE XTVAL1
.S X="" F S X=$O(^TMP($J,"N",X)) Q:X="" F XTNN=0:0 S XTNN=$O(^TMP($J,"N",X,XTNN)) Q:XTNN'>0 S XTIEN=XTNN D K ^TMP($J,"N",X)
..W !!,"ADDED ",$E(XTTY,1,$L(XTTY)-1),": ",X," IEN=",XTIEN
..S XTBAS=XTNOD_XTIEN,XTBASI=XTBAS_",",XTBAS=XTBAS_")"
..F S XTBAS=$Q(@XTBAS) S XTVG=XTBAS D MSMQ^XTVGC2 S XTBAS=XTVG Q:XTBAS'[XTBASI W !?5,XTBAS," = ",@XTBAS
S XTSEEN=0 D D CHANGE K ^TMP($J,"B",XTVAL1)
.I XTNN>1 W !?2,XTNN," ENTRIES OF ",XTVAL1," IN B X-REF OF OLD ",XTTY," FILE"
.K ^TMP($J,"O"),^("OB") F XTN=0:0 S XTN=$O(XTN(XTN)) Q:XTN'>0 S X=$P(@(XTBAS1_"XTTYI,1,XTN,1,1,1)"),U),^TMP($J,"O",X,XTN(XTN))=XTN
.S X="" F S X=$O(^TMP($J,"O",X)) Q:X="" F XTNN=0:0 S XTNN=$O(^TMP($J,"O",X,XTNN)) Q:XTNN'>0 S XTIEN=XTNN,XTN=^(XTNN)
.S X="" F S X=$O(^TMP($J,"N",X)) Q:X="" F XTNN=0:0 S XTNN=$O(^TMP($J,"N",X,XTNN)) Q:XTNN'>0 S XTNN(1)=XTNN
.S XTNN=XTNN(1)
Q
CHANGE ;
S XTVG=XTNOD_XTNN_")",XTVG1=XTNOD_XTNN_",",XTVF0=XTBAS1_"XTTYI,1,XTN,1,M,0)"
F M=1:1 S:XTVG'="" XTVG=$Q(@XTVG) D MSMQ^XTVGC2 S:XTVG'[XTVG1 XTVG="" S XTVGY=$S(XTVG="":"",1:@XTVG) S XTVX=$S('$D(@XTVF0):"",1:^(0)),XTVY=$S(XTVX="":"",1:^(1)) Q:XTVG=""&(XTVX="") D CHECK^XTVGC2A1 ; Naked is based on @XTVF0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVGC2A 4576 printed Apr 09, 2024@21:43:54 Page 2
XTVGC2A ;ISC-SF/SEA/JLI - COMPARE SAVED AND CURRENT NAMESPACE DATA ;12/13/93 15:18 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
ENTRY ;
+1 FOR XTTYJ=1:1:8
Begin DoDot:1
+2 KILL ^TMP($JOB)
SET XTTY=$PIECE("OPTIONS;DIC(19,^KEYS;DIC(19.1,^HELP FRAMES;DIC(9.2,^BULLETINS;XMB(3.6,^FUNCTIONS;DD(""FUNC"",^EDIT TEMPLATES;DIE(^SORT TEMPLATES;DIBT(^PRINT TEMPLATES;DIPT(^S;SCRE(",U,XTTYJ)
+3 SET XTNOD=U_$PIECE(XTTY,";",2)
SET XTTY=$PIECE(XTTY,";")
SET XTBAS1="^XTV(8991.2,XTVPT,1,XTVD,2,"
SET XTTYI=$ORDER(@(XTBAS1_"""B"","""_XTTY_""",0)"))
Begin DoDot:2
+4 WRITE !,"********************************* Checking ",XTTY
+5 IF XTTYI>0
SET %X=XTBAS1_XTTYI_",1,""B"","
SET %Y="^TMP($J,""B"","
DO %XY^%RCR
IF XTTYJ>5
IF XTTYJ<9
Begin DoDot:3
+6 SET XTTYA=""
FOR
SET XTTYA=$ORDER(^TMP($JOB,"B",XTTYA))
if XTTYA=""
QUIT
FOR XTTYK=0:0
SET XTTYK=$ORDER(^TMP($JOB,"B",XTTYA,XTTYK))
if XTTYK'>0
QUIT
SET XTTYM=^(XTTYK)
Begin DoDot:4
+7 SET XTTYKM=$PIECE($GET(@(XTBAS1_XTTYI_",1,"_XTTYK_",1,1,1)")),U,4)
IF XTTYKM'=""
KILL ^TMP($JOB,"B",XTTYA,XTTYK)
SET ^TMP($JOB,"Z",(XTTYA_" ("_XTTYKM_")"),XTTYK)=XTTYM
End DoDot:4
+8 SET %X="^TMP($J,""Z"","
SET %Y="^TMP($J,""B"","
DO %XY^%RCR
KILL ^TMP($JOB,"Z")
End DoDot:3
+9 KILL ^TMP($JOB,"XB")
SET %X=XTNOD_"""B"","
SET %Y="^TMP($J,""XB"","
DO %XY^%RCR
IF XTTYJ>5
IF XTTYJ<9
Begin DoDot:3
+10 SET XTTYA=""
FOR
SET XTTYA=$ORDER(^TMP($JOB,"XB",XTTYA))
if XTTYA=""
QUIT
FOR XTTYK=0:0
SET XTTYK=$ORDER(^TMP($JOB,"XB",XTTYA,XTTYK))
if XTTYK'>0
QUIT
Begin DoDot:4
+11 SET XTTYKM=$PIECE($GET(@(XTNOD_XTTYK_",0)")),U,4)
IF XTTYKM'=""
KILL ^TMP($JOB,"XB",XTTYA,XTTYK)
SET ^TMP($JOB,"Z",(XTTYA_" ("_XTTYKM_")"),XTTYK)=""
End DoDot:4
+12 SET %X="^TMP($J,""Z"","
SET %Y="^TMP($J,""XB"","
DO %XY^%RCR
KILL ^TMP($JOB,"Z")
End DoDot:3
End DoDot:2
DO COMPAR
End DoDot:1
+13 KILL ^TMP($JOB),XTTYA,XTTYK,XTTYKM,XTTYM
+14 QUIT
COMPAR ;
+1 if '$DATA(XTVPK)
SET XTVPK=+^XTV(8991.2,XTVPT,0)
SET XTNS=""
FOR XTNSI=0:0
SET XTNSI=$ORDER(^XTV(8991.19,XTVPK,2,XTNSI))
if XTNSI'>0
QUIT
SET XTNS($PIECE(^(XTNSI,0),U))=""
+2 FOR
SET XTNS=$ORDER(XTNS(XTNS))
if XTNS=""
QUIT
SET XTNSL=$LENGTH(XTNS)
SET XTNS1=$EXTRACT(XTNS,1,XTNSL-1)_$CHAR($ASCII($EXTRACT(XTNS,XTNSL))-1)_"z"
SET XTVAL=XTNS1
DO COMPAR1
+3 SET XTVAL=""
DO COMPAR2
+4 QUIT
COMPAR1 ;
+1 FOR
SET XTVAL=$ORDER(^TMP($JOB,"XB",XTVAL))
if $EXTRACT(XTVAL,1,XTNSL)'=XTNS
QUIT
Begin DoDot:1
+2 KILL XTNUM,^TMP($JOB,"N")
SET XTNUMN=0
FOR XTNUM=0:0
SET XTNUM=$ORDER(^TMP($JOB,"XB",XTVAL,XTNUM))
if XTNUM'>0
Begin DoDot:2
+3 IF XTNUMN>1
WRITE !?2,XTNUMN," ENTRIES OF ",XTVAL," IN B X-REF OF CURRENT ",XTTY," FILE"
+4 FOR XTNUM=0:0
SET XTNUM=$ORDER(XTNUM(XTNUM))
if XTNUM'>0
QUIT
IF $DATA(@(XTNOD_XTNUM_",0)"))
SET ^TMP($JOB,"N",($PIECE(^(0),U)_$SELECT(XTTYJ>5&(XTTYJ<9):" ("_$PIECE(^(0),U,4)_")",1:"")),XTNUM)=""
+5 SET XTVAL2=""
FOR
SET XTVAL2=$ORDER(^TMP($JOB,"N",XTVAL2))
if XTVAL2=""
QUIT
DO COMPAR2
End DoDot:2
if XTNUM'>0
QUIT
SET XTNUM(XTNUM)=""
SET XTNUMN=XTNUMN+1
End DoDot:1
+6 QUIT
COMPAR2 ;
+1 SET XTVAL1=""
+2 KILL XTN
SET XTVAL1=$ORDER(^TMP($JOB,"B",XTVAL1))
IF XTVAL1'=""
SET XTNN=0
FOR XTN=0:0
SET XTN=$ORDER(^TMP($JOB,"B",XTVAL1,XTN))
if XTN'>0
QUIT
SET XTN(XTN)=^(XTN)
SET XTNN=XTNN+1
+3 if XTVAL1=""&(XTVAL2="")
QUIT
+4 ; XTVAL1 BEFORE XTVAL
IF XTVAL1'=""
IF XTVAL2=""!(XTVAL2]XTVAL1)
Begin DoDot:1
+5 IF XTNN>1
WRITE !?2,XTNN," ENTRIES OF ",XTVAL1," IN B X-REF OF OLD ",XTTY," FILE"
+6 KILL ^TMP($JOB,"O"),^("OB")
FOR XTN=0:0
SET XTN=$ORDER(XTN(XTN))
if XTN'>0
QUIT
IF $DATA(@(XTBAS1_"XTTYI,1,XTN,1,1,1)"))
SET X=$PIECE(^(1),U)_$SELECT(XTTYJ>5&(XTTYJ<9):" ("_$PIECE(^(1),U,4)_")",1:"")
SET ^TMP($JOB,"O",X,XTN(XTN))=XTN
+7 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"O",X))
if X=""
QUIT
FOR XTNN=0:0
SET XTNN=$ORDER(^TMP($JOB,"O",X,XTNN))
if XTNN'>0
QUIT
SET XTIEN=XTNN
SET XTN=^(XTNN)
Begin DoDot:2
+8 WRITE !!,"DELETED ",$EXTRACT(XTTY,1,$LENGTH(XTTY)-1),": ",X," OLD IEN=",XTN
+9 SET XTBAS2=XTBAS1_"XTTYI,1,XTN,1,"
FOR I=0:0
SET I=$ORDER(@(XTBAS2_I_")"))
if I'>0
QUIT
SET X1=@(XTBAS2_I_",0)")
SET X2=@(XTBAS2_I_",1)")
SET X1=$PIECE(X1,"~IEN~")_XTIEN_$PIECE(X1,"~IEN~",2)
WRITE !?5,X1," = ",X2
End DoDot:2
+10 KILL ^TMP($JOB,"B",XTVAL1)
End DoDot:1
GOTO COMPAR2
+11 ; XTVAL BEFORE XTVAL1
IF XTVAL1=""!(XTVAL1]XTVAL2)
Begin DoDot:1
+12 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"N",X))
if X=""
QUIT
FOR XTNN=0:0
SET XTNN=$ORDER(^TMP($JOB,"N",X,XTNN))
if XTNN'>0
QUIT
SET XTIEN=XTNN
Begin DoDot:2
+13 WRITE !!,"ADDED ",$EXTRACT(XTTY,1,$LENGTH(XTTY)-1),": ",X," IEN=",XTIEN
+14 SET XTBAS=XTNOD_XTIEN
SET XTBASI=XTBAS_","
SET XTBAS=XTBAS_")"
+15 FOR
SET XTBAS=$QUERY(@XTBAS)
SET XTVG=XTBAS
DO MSMQ^XTVGC2
SET XTBAS=XTVG
if XTBAS'[XTBASI
QUIT
WRITE !?5,XTBAS," = ",@XTBAS
End DoDot:2
KILL ^TMP($JOB,"N",X)
End DoDot:1
QUIT
+16 SET XTSEEN=0
Begin DoDot:1
+17 IF XTNN>1
WRITE !?2,XTNN," ENTRIES OF ",XTVAL1," IN B X-REF OF OLD ",XTTY," FILE"
+18 KILL ^TMP($JOB,"O"),^("OB")
FOR XTN=0:0
SET XTN=$ORDER(XTN(XTN))
if XTN'>0
QUIT
SET X=$PIECE(@(XTBAS1_"XTTYI,1,XTN,1,1,1)"),U)
SET ^TMP($JOB,"O",X,XTN(XTN))=XTN
+19 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"O",X))
if X=""
QUIT
FOR XTNN=0:0
SET XTNN=$ORDER(^TMP($JOB,"O",X,XTNN))
if XTNN'>0
QUIT
SET XTIEN=XTNN
SET XTN=^(XTNN)
+20 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"N",X))
if X=""
QUIT
FOR XTNN=0:0
SET XTNN=$ORDER(^TMP($JOB,"N",X,XTNN))
if XTNN'>0
QUIT
SET XTNN(1)=XTNN
+21 SET XTNN=XTNN(1)
End DoDot:1
DO CHANGE
KILL ^TMP($JOB,"B",XTVAL1)
+22 QUIT
CHANGE ;
+1 SET XTVG=XTNOD_XTNN_")"
SET XTVG1=XTNOD_XTNN_","
SET XTVF0=XTBAS1_"XTTYI,1,XTN,1,M,0)"
+2 ; Naked is based on @XTVF0
FOR M=1:1
if XTVG'=""
SET XTVG=$QUERY(@XTVG)
DO MSMQ^XTVGC2
if XTVG'[XTVG1
SET XTVG=""
SET XTVGY=$SELECT(XTVG="":"",1:@XTVG)
SET XTVX=$SELECT('$DATA(@XTVF0):"",1:^(0))
SET XTVY=$SELECT(XTVX="":"",1:^(1))
if XTVG=""&(XTVX="")
QUIT
DO CHECK^XTVGC2A1
+3 QUIT
