- 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 Jan 18, 2025@03:43:02 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