XBGCMP ; IHS/ADC/GTH - COMPARES TWO DIFFERENT GLOBALS ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
;;This utility is to be used to compare two globals. The initial
;;globals entered must be identically subscripted. The utility will
;;indicate which nodes of the first global have values different
;;than similarly subscipted nodes of the second global. It will
;;also indicate if a node in one global exists and if a similarly
;;subscripted node in the other does not exist. You may utilize the
;;[UCI,VOLUME] syntax to compare across UCIs and volume groups.
;;
;;###
;
NEW X
D INIT
A ;
D ASK
I XBQ G X1
D SETUP ; sets up up print/display, calls subrtn to process gbls
G A
X1 ;
D EOJ
Q
;
INIT ; Setup
D ^XBKVAR
S (XBS,XBQ)=0
X ^%ZOSF("UCI")
S XBVOL=$P(Y,",",2)
Q
;
ASK ; Get globals to be compared
1 ;
R !,"First global to compare, i.e., NAME, NAME(1) or NAME(""B""): ^",X:DTIME
D:X["?" HELP^XBHELP("XBGCMP","XBGCMP")
G:X["?" 1
I "^"[X S XBQ=1 G X2
D CHECK
I XBS S XBS=0 G 1
S XBG1=X
2 ;
R !,"Second global to compare: ^",X:DTIME
D:X["?" HELP^XBHELP("XBGCMP","XBGCMP")
G:X["?" 2
I "^"[X S XBQ=1 G X2
D CHECK
I XBS S XBS=0 G 2
S XBG2=X
D CHECK2
I XBS S XBS=0 G 1
X2 ;
Q
;
CHECK ; Check each global
I X["(",X'[")" S XBS=1 W !,*7," Must end in "")""" G X6
S XBT=$P(X,"(")
I XBT["[" D
. I XBT'["]" W !,*7," Invalid cross UCI notation" S XBS=1 G X4
. S XBT=$P(XBT,"]")
. I XBT["""" F XBI=1:1:$L(XBT) I $E(XBT,XBI)="""" S $E(XBT,XBI)="",XBI=XBI-1
. I XBT?1"["3U1","3U!(XBT?1"["3U)
. E W !,*7," Invalid cross UCI notation" S XBS=1 G X4
. I XBT'[","!($P(XBT,",",2)'=XBVOL) S X="["""_$P(XBT,"[",2)_"""]"_$P(X,"]",2) G X4
. S X="["""_$P($P(XBT,"[",2),",")_"""]"_$P(X,"]",2)
X4 . Q
S XBT(1)=$S($P(X,"(")["[":$P($P(X,"]",2),"("),1:$P(X,"("))
I $L(XBT(1))>8 W !,*7," Invalid global name" S XBS=1 G X6
I XBT(1)?1A.AN!(XBT(1)?1"XB".AN)
E W !,*7," Invalid global name" S XBS=1 G X6
S XBT(2)=X,X="TRAP^XBGCMP",@^%ZOSF("TRAP"),X=XBT(2)
I '$D(@("^"_X)) W !,*7," Global does not exist" S XBS=1
X6 ;
Q
;
TRAP ; Error trap for missing quotes
I $$Z^ZIBNSSV("ERROR")["<UNDEF" W !,*7,"*** Probably missing quotes",! S XBS=1
Q
;
CHECK2 ; Check both globals
I (XBG1["("&(XBG2'["("))!(XBG1'["("&(XBG2["(")) W !,*7," Starting globals must be identically subscripted",! S XBS=1 G X5
I XBG1'["("
E I $P(XBG1,"(",2)'=$P(XBG2,"(",2) W !,*7," Starting globals must be identically subscripted",! S XBS=1 G X5
E I $E(XBG1,$L(XBG1))'=")"!($E(XBG2,$L(XBG2))'=")") W !,*7," Starting globals must end in a "")""",! S XBS=1
X5 ;
Q
;
SETUP ; Get print parameters, task?
KILL ZTSK,IOP,%ZIS
S %ZIS="PQM"
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUE I 1
E D NOQUE
Q
;
NOQUE ;
S ^DISV($I,"^%ZIS(1,")=$O(^%ZIS(1,"C",IO,""))
U IO
D PROCESS
D ^%ZISC
Q
;
QUE ;
S XBION=ION
KILL ZTSAVE
F %="XBG1","XBG2","XBION" S ZTSAVE(%)=""
S ZTRTN="PROCESS^XBGCMP",ZTDESC="COMPARE TWO GLOBALS",ZTIO="",ZTDTH=""
D ^%ZTLOAD
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
D ^%ZISC
W !
Q
;
PROCESS ; Compare
S XBG1="^"_XBG1,XBG2="^"_XBG2,XBN=$J_$H,XBC=0
I '$D(ZTQUEUED) W:$D(IOF) @IOF W !!,"Comparison of globals ",XBG1," and ",XBG2,!
I $D(@XBG1)#2,'($D(@XBG2)#2) S XBC=XBC+1,XBTEMP=XBG1 D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Exists~"_XBG2_" Missing"
I '($D(@XBG1)#2),$D(@XBG2)#2 S XBC=XBC+1,XBTEMP=XBG1 D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Missing~"_XBG2_" Exists"
I $D(@XBG1)#2,$D(@XBG2)#2,'(@XBG1=@XBG2) S XBTEMP=XBG1 D CHANGE S XBC=XBC+1,^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Not Equal To~"_XBG2
S XBA=$P(XBG1,"("),XBB=$P(XBG2,"("),XB=XBG1
F S XB=$Q(@XB) Q:XB="" D
. I '($D(@(XBB_$P(XB,XBA,2)))#2) S XBC=XBC+1,XBTEMP=XB D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XB_" Exists~"_XBB_$P(XB,XBA,2)_" Missing" G X3
. I @XB'=@(XBB_$P(XB,XBA,2)) S XBC=XBC+1,XBTEMP=XB D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XB_" Not Equal To~"_XBB_$P(XB,XBA,2)
X3 . Q
S XBA=$P(XBG2,"("),XBB=$P(XBG1,"("),XB=XBG2
F S XB=$Q(@XB) Q:XB="" D
. I '($D(@(XBB_$P(XB,XBA,2)))#2) S XBC=XBC+1,XBTEMP=XBB_$P(XB,XBA,2) D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBB_$P(XB,XBA,2)_" Missing~"_XB_" Exists"
I '$D(ZTQUEUED) D PRINT I 1
E D SCHED
Q
;
CHANGE ; Temp change double quotes to single
I XBTEMP["""" S XBTMP="",XBQTE=$L(XBTEMP,"""") F XBI=1:1:(XBQTE-1) S XBTMP=XBTMP_$P(XBTEMP,"""",XBI)_"" I XBI=(XBQTE-1) D
. S XBTEMP=XBTMP_$P(XBTEMP,"""",XBQTE)
KILL XBTMP,XBQTE
Q
;
PRINT ; Prints or displays results
I $D(ZTQUEUED) W:$D(IOF) @IOF W !!,"Comparison of globals ",XBG1," and ",XBG2,!
S XBL=IOSL-3,XB=""
F S XB=$O(^TMP("XBGCMP",XBN,XB)) Q:XB="" D I XBL'>0 D PAUSE Q:$G(XBSTP) S XBL=IOSL-3 W !
. I $L(^TMP("XBGCMP",XBN,XB))>76 W !,$P(^(XB),"~"),!,$P(^(XB),"~",2),! S XBL=XBL-3.25
. E W !,$P(^TMP("XBGCMP",XBN,XB),"~")," ",$P(^(XB),"~",2),! S XBL=XBL-2
I '$G(XBSTP) W !,"Comparison completed with ",XBC," difference",$S(XBC'=1:"s",1:"")," found.",!
KILL ^TMP("XBGCMP",XBN)
I $D(ZTQUEUED) S ZTREQ="@" D EOJ
Q
;
PAUSE ; Quit display?
I $E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E") S:$D(DIRUT)!($D(DUOUT)) XBSTP=1 KILL DIRUT,DUOUT W !
Q
;
SCHED ; Schedules another task to print
KILL ZTSAVE
F %="XBN","XBG1","XBG2","XBC" S ZTSAVE(%)=""
S ZTRTN="PRINT^XBGCMP",ZTDESC="PRINT COMPARISON OF TWO GLOBALS",ZTIO=XBION,ZTDTH=DT
D ^%ZTLOAD
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
;
EOJ ;
KILL XB,XBA,XBB,XBC,XBI,XBL,XBG1,XBG2,XBION,XBN,XBQ,XBS,XBSTP,XBT,XBTEMP,XBTMP,XBVOL
Q
;
HELP ;EP - Dooda about the utility
;;@;!
XBGCMP ; IHS/ADC/GTH - COMPARES TWO DIFFERENT GLOBALS ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ;;This utility is to be used to compare two globals. The initial
+4 ;;globals entered must be identically subscripted. The utility will
+5 ;;indicate which nodes of the first global have values different
+6 ;;than similarly subscipted nodes of the second global. It will
+7 ;;also indicate if a node in one global exists and if a similarly
+8 ;;subscripted node in the other does not exist. You may utilize the
+9 ;;[UCI,VOLUME] syntax to compare across UCIs and volume groups.
+10 ;;
+11 ;;###
+12 ;
+13 NEW X
+14 DO INIT
A ;
+1 DO ASK
+2 IF XBQ
GOTO X1
+3 ; sets up up print/display, calls subrtn to process gbls
DO SETUP
+4 GOTO A
X1 ;
+1 DO EOJ
+2 QUIT
+3 ;
INIT ; Setup
+1 DO ^XBKVAR
+2 SET (XBS,XBQ)=0
+3 XECUTE ^%ZOSF("UCI")
+4 SET XBVOL=$PIECE(Y,",",2)
+5 QUIT
+6 ;
ASK ; Get globals to be compared
1 ;
+1 READ !,"First global to compare, i.e., NAME, NAME(1) or NAME(""B""): ^",X:DTIME
+2 IF X["?"
DO HELP^XBHELP("XBGCMP","XBGCMP")
+3 IF X["?"
GOTO 1
+4 IF "^"[X
SET XBQ=1
GOTO X2
+5 DO CHECK
+6 IF XBS
SET XBS=0
GOTO 1
+7 SET XBG1=X
2 ;
+1 READ !,"Second global to compare: ^",X:DTIME
+2 IF X["?"
DO HELP^XBHELP("XBGCMP","XBGCMP")
+3 IF X["?"
GOTO 2
+4 IF "^"[X
SET XBQ=1
GOTO X2
+5 DO CHECK
+6 IF XBS
SET XBS=0
GOTO 2
+7 SET XBG2=X
+8 DO CHECK2
+9 IF XBS
SET XBS=0
GOTO 1
X2 ;
+1 QUIT
+2 ;
CHECK ; Check each global
+1 IF X["("
IF X'[")"
SET XBS=1
WRITE !,*7," Must end in "")"""
GOTO X6
+2 SET XBT=$PIECE(X,"(")
+3 IF XBT["["
Begin DoDot:1
+4 IF XBT'["]"
WRITE !,*7," Invalid cross UCI notation"
SET XBS=1
GOTO X4
+5 SET XBT=$PIECE(XBT,"]")
+6 IF XBT[""""
FOR XBI=1:1:$LENGTH(XBT)
IF $EXTRACT(XBT,XBI)=""""
SET $EXTRACT(XBT,XBI)=""
SET XBI=XBI-1
+7 IF XBT?1"["3U1","3U!(XBT?1"["3U)
+8 IF '$TEST
WRITE !,*7," Invalid cross UCI notation"
SET XBS=1
GOTO X4
+9 IF XBT'[","!($PIECE(XBT,",",2)'=XBVOL)
SET X="["""_$PIECE(XBT,"[",2)_"""]"_$PIECE(X,"]",2)
GOTO X4
+10 SET X="["""_$PIECE($PIECE(XBT,"[",2),",")_"""]"_$PIECE(X,"]",2)
X4 QUIT
End DoDot:1
+1 SET XBT(1)=$SELECT($PIECE(X,"(")["[":$PIECE($PIECE(X,"]",2),"("),1:$PIECE(X,"("))
+2 IF $LENGTH(XBT(1))>8
WRITE !,*7," Invalid global name"
SET XBS=1
GOTO X6
+3 IF XBT(1)?1A.AN!(XBT(1)?1"XB".AN)
+4 IF '$TEST
WRITE !,*7," Invalid global name"
SET XBS=1
GOTO X6
+5 SET XBT(2)=X
SET X="TRAP^XBGCMP"
SET @^%ZOSF("TRAP")
SET X=XBT(2)
+6 IF '$DATA(@("^"_X))
WRITE !,*7," Global does not exist"
SET XBS=1
X6 ;
+1 QUIT
+2 ;
TRAP ; Error trap for missing quotes
+1 IF $$Z^ZIBNSSV("ERROR")["<UNDEF"
WRITE !,*7,"*** Probably missing quotes",!
SET XBS=1
+2 QUIT
+3 ;
CHECK2 ; Check both globals
+1 IF (XBG1["("&(XBG2'["("))!(XBG1'["("&(XBG2["("))
WRITE !,*7," Starting globals must be identically subscripted",!
SET XBS=1
GOTO X5
+2 IF XBG1'["("
+3 IF '$TEST
IF $PIECE(XBG1,"(",2)'=$PIECE(XBG2,"(",2)
WRITE !,*7," Starting globals must be identically subscripted",!
SET XBS=1
GOTO X5
+4 IF '$TEST
IF $EXTRACT(XBG1,$LENGTH(XBG1))'=")"!($EXTRACT(XBG2,$LENGTH(XBG2))'=")")
WRITE !,*7," Starting globals must end in a "")""",!
SET XBS=1
X5 ;
+1 QUIT
+2 ;
SETUP ; Get print parameters, task?
+1 KILL ZTSK,IOP,%ZIS
+2 SET %ZIS="PQM"
+3 DO ^%ZIS
+4 IF POP
QUIT
+5 IF $DATA(IO("Q"))
DO QUE
IF 1
+6 IF '$TEST
DO NOQUE
+7 QUIT
+8 ;
NOQUE ;
+1 SET ^DISV($IO,"^%ZIS(1,")=$ORDER(^%ZIS(1,"C",IO,""))
+2 USE IO
+3 DO PROCESS
+4 DO ^%ZISC
+5 QUIT
+6 ;
QUE ;
+1 SET XBION=ION
+2 KILL ZTSAVE
+3 FOR %="XBG1","XBG2","XBION"
SET ZTSAVE(%)=""
+4 SET ZTRTN="PROCESS^XBGCMP"
SET ZTDESC="COMPARE TWO GLOBALS"
SET ZTIO=""
SET ZTDTH=""
+5 DO ^%ZTLOAD
+6 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+7 DO ^%ZISC
+8 WRITE !
+9 QUIT
+10 ;
PROCESS ; Compare
+1 SET XBG1="^"_XBG1
SET XBG2="^"_XBG2
SET XBN=$JOB_$HOROLOG
SET XBC=0
+2 IF '$DATA(ZTQUEUED)
IF $DATA(IOF)
WRITE @IOF
WRITE !!,"Comparison of globals ",XBG1," and ",XBG2,!
+3 IF $DATA(@XBG1)#2
IF '($DATA(@XBG2)#2)
SET XBC=XBC+1
SET XBTEMP=XBG1
DO CHANGE
SET ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Exists~"_XBG2_" Missing"
+4 IF '($DATA(@XBG1)#2)
IF $DATA(@XBG2)#2
SET XBC=XBC+1
SET XBTEMP=XBG1
DO CHANGE
SET ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Missing~"_XBG2_" Exists"
+5 IF $DATA(@XBG1)#2
IF $DATA(@XBG2)#2
IF '(@XBG1=@XBG2)
SET XBTEMP=XBG1
DO CHANGE
SET XBC=XBC+1
SET ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Not Equal To~"_XBG2
+6 SET XBA=$PIECE(XBG1,"(")
SET XBB=$PIECE(XBG2,"(")
SET XB=XBG1
+7 FOR
SET XB=$QUERY(@XB)
IF XB=""
QUIT
Begin DoDot:1
+8 IF '($DATA(@(XBB_$PIECE(XB,XBA,2)))#2)
SET XBC=XBC+1
SET XBTEMP=XB
DO CHANGE
SET ^TMP("XBGCMP",XBN,XBTEMP)=XB_" Exists~"_XBB_$PIECE(XB,XBA,2)_" Missing"
GOTO X3
+9 IF @XB'=@(XBB_$PIECE(XB,XBA,2))
SET XBC=XBC+1
SET XBTEMP=XB
DO CHANGE
SET ^TMP("XBGCMP",XBN,XBTEMP)=XB_" Not Equal To~"_XBB_$PIECE(XB,XBA,2)
X3 QUIT
End DoDot:1
+1 SET XBA=$PIECE(XBG2,"(")
SET XBB=$PIECE(XBG1,"(")
SET XB=XBG2
+2 FOR
SET XB=$QUERY(@XB)
IF XB=""
QUIT
Begin DoDot:1
+3 IF '($DATA(@(XBB_$PIECE(XB,XBA,2)))#2)
SET XBC=XBC+1
SET XBTEMP=XBB_$PIECE(XB,XBA,2)
DO CHANGE
SET ^TMP("XBGCMP",XBN,XBTEMP)=XBB_$PIECE(XB,XBA,2)_" Missing~"_XB_" Exists"
End DoDot:1
+4 IF '$DATA(ZTQUEUED)
DO PRINT
IF 1
+5 IF '$TEST
DO SCHED
+6 QUIT
+7 ;
CHANGE ; Temp change double quotes to single
+1 IF XBTEMP[""""
SET XBTMP=""
SET XBQTE=$LENGTH(XBTEMP,"""")
FOR XBI=1:1:(XBQTE-1)
SET XBTMP=XBTMP_$PIECE(XBTEMP,"""",XBI)_""
IF XBI=(XBQTE-1)
Begin DoDot:1
+2 SET XBTEMP=XBTMP_$PIECE(XBTEMP,"""",XBQTE)
End DoDot:1
+3 KILL XBTMP,XBQTE
+4 QUIT
+5 ;
PRINT ; Prints or displays results
+1 IF $DATA(ZTQUEUED)
IF $DATA(IOF)
WRITE @IOF
WRITE !!,"Comparison of globals ",XBG1," and ",XBG2,!
+2 SET XBL=IOSL-3
SET XB=""
+3 FOR
SET XB=$ORDER(^TMP("XBGCMP",XBN,XB))
IF XB=""
QUIT
Begin DoDot:1
+4 IF $LENGTH(^TMP("XBGCMP",XBN,XB))>76
WRITE !,$PIECE(^(XB),"~"),!,$PIECE(^(XB),"~",2),!
SET XBL=XBL-3.25
+5 IF '$TEST
WRITE !,$PIECE(^TMP("XBGCMP",XBN,XB),"~")," ",$PIECE(^(XB),"~",2),!
SET XBL=XBL-2
End DoDot:1
IF XBL'>0
DO PAUSE
IF $GET(XBSTP)
QUIT
SET XBL=IOSL-3
WRITE !
+6 IF '$GET(XBSTP)
WRITE !,"Comparison completed with ",XBC," difference",$SELECT(XBC'=1:"s",1:"")," found.",!
+7 KILL ^TMP("XBGCMP",XBN)
+8 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO EOJ
+9 QUIT
+10 ;
PAUSE ; Quit display?
+1 IF $EXTRACT(IOST,1,2)="C-"
SET Y=$$DIR^XBDIR("E")
IF $DATA(DIRUT)!($DATA(DUOUT))
SET XBSTP=1
KILL DIRUT,DUOUT
WRITE !
+2 QUIT
+3 ;
SCHED ; Schedules another task to print
+1 KILL ZTSAVE
+2 FOR %="XBN","XBG1","XBG2","XBC"
SET ZTSAVE(%)=""
+3 SET ZTRTN="PRINT^XBGCMP"
SET ZTDESC="PRINT COMPARISON OF TWO GLOBALS"
SET ZTIO=XBION
SET ZTDTH=DT
+4 DO ^%ZTLOAD
+5 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+6 QUIT
+7 ;
EOJ ;
+1 KILL XB,XBA,XBB,XBC,XBI,XBL,XBG1,XBG2,XBION,XBN,XBQ,XBS,XBSTP,XBT,XBTEMP,XBTMP,XBVOL
+2 QUIT
+3 ;
HELP ;EP - Dooda about the utility
+1 ;;@;!
