| 1 | XBGCMP ; IHS/ADC/GTH - COMPARES TWO DIFFERENT GLOBALS ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ;;This utility is to be used to compare two globals. The initial
|
|---|
| 5 | ;;globals entered must be identically subscripted. The utility will
|
|---|
| 6 | ;;indicate which nodes of the first global have values different
|
|---|
| 7 | ;;than similarly subscipted nodes of the second global. It will
|
|---|
| 8 | ;;also indicate if a node in one global exists and if a similarly
|
|---|
| 9 | ;;subscripted node in the other does not exist. You may utilize the
|
|---|
| 10 | ;;[UCI,VOLUME] syntax to compare across UCIs and volume groups.
|
|---|
| 11 | ;;
|
|---|
| 12 | ;;###
|
|---|
| 13 | ;
|
|---|
| 14 | NEW X
|
|---|
| 15 | D INIT
|
|---|
| 16 | A ;
|
|---|
| 17 | D ASK
|
|---|
| 18 | I XBQ G X1
|
|---|
| 19 | D SETUP ; sets up up print/display, calls subrtn to process gbls
|
|---|
| 20 | G A
|
|---|
| 21 | X1 ;
|
|---|
| 22 | D EOJ
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | INIT ; Setup
|
|---|
| 26 | D ^XBKVAR
|
|---|
| 27 | S (XBS,XBQ)=0
|
|---|
| 28 | X ^%ZOSF("UCI")
|
|---|
| 29 | S XBVOL=$P(Y,",",2)
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ASK ; Get globals to be compared
|
|---|
| 33 | 1 ;
|
|---|
| 34 | R !,"First global to compare, i.e., NAME, NAME(1) or NAME(""B""): ^",X:DTIME
|
|---|
| 35 | D:X["?" HELP^XBHELP("XBGCMP","XBGCMP")
|
|---|
| 36 | G:X["?" 1
|
|---|
| 37 | I "^"[X S XBQ=1 G X2
|
|---|
| 38 | D CHECK
|
|---|
| 39 | I XBS S XBS=0 G 1
|
|---|
| 40 | S XBG1=X
|
|---|
| 41 | 2 ;
|
|---|
| 42 | R !,"Second global to compare: ^",X:DTIME
|
|---|
| 43 | D:X["?" HELP^XBHELP("XBGCMP","XBGCMP")
|
|---|
| 44 | G:X["?" 2
|
|---|
| 45 | I "^"[X S XBQ=1 G X2
|
|---|
| 46 | D CHECK
|
|---|
| 47 | I XBS S XBS=0 G 2
|
|---|
| 48 | S XBG2=X
|
|---|
| 49 | D CHECK2
|
|---|
| 50 | I XBS S XBS=0 G 1
|
|---|
| 51 | X2 ;
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | CHECK ; Check each global
|
|---|
| 55 | I X["(",X'[")" S XBS=1 W !,*7," Must end in "")""" G X6
|
|---|
| 56 | S XBT=$P(X,"(")
|
|---|
| 57 | I XBT["[" D
|
|---|
| 58 | . I XBT'["]" W !,*7," Invalid cross UCI notation" S XBS=1 G X4
|
|---|
| 59 | . S XBT=$P(XBT,"]")
|
|---|
| 60 | . I XBT["""" F XBI=1:1:$L(XBT) I $E(XBT,XBI)="""" S $E(XBT,XBI)="",XBI=XBI-1
|
|---|
| 61 | . I XBT?1"["3U1","3U!(XBT?1"["3U)
|
|---|
| 62 | . E W !,*7," Invalid cross UCI notation" S XBS=1 G X4
|
|---|
| 63 | . I XBT'[","!($P(XBT,",",2)'=XBVOL) S X="["""_$P(XBT,"[",2)_"""]"_$P(X,"]",2) G X4
|
|---|
| 64 | . S X="["""_$P($P(XBT,"[",2),",")_"""]"_$P(X,"]",2)
|
|---|
| 65 | X4 . Q
|
|---|
| 66 | S XBT(1)=$S($P(X,"(")["[":$P($P(X,"]",2),"("),1:$P(X,"("))
|
|---|
| 67 | I $L(XBT(1))>8 W !,*7," Invalid global name" S XBS=1 G X6
|
|---|
| 68 | I XBT(1)?1A.AN!(XBT(1)?1"XB".AN)
|
|---|
| 69 | E W !,*7," Invalid global name" S XBS=1 G X6
|
|---|
| 70 | S XBT(2)=X,X="TRAP^XBGCMP",@^%ZOSF("TRAP"),X=XBT(2)
|
|---|
| 71 | I '$D(@("^"_X)) W !,*7," Global does not exist" S XBS=1
|
|---|
| 72 | X6 ;
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | TRAP ; Error trap for missing quotes
|
|---|
| 76 | I $$Z^ZIBNSSV("ERROR")["<UNDEF" W !,*7,"*** Probably missing quotes",! S XBS=1
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | CHECK2 ; Check both globals
|
|---|
| 80 | I (XBG1["("&(XBG2'["("))!(XBG1'["("&(XBG2["(")) W !,*7," Starting globals must be identically subscripted",! S XBS=1 G X5
|
|---|
| 81 | I XBG1'["("
|
|---|
| 82 | E I $P(XBG1,"(",2)'=$P(XBG2,"(",2) W !,*7," Starting globals must be identically subscripted",! S XBS=1 G X5
|
|---|
| 83 | E I $E(XBG1,$L(XBG1))'=")"!($E(XBG2,$L(XBG2))'=")") W !,*7," Starting globals must end in a "")""",! S XBS=1
|
|---|
| 84 | X5 ;
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | SETUP ; Get print parameters, task?
|
|---|
| 88 | KILL ZTSK,IOP,%ZIS
|
|---|
| 89 | S %ZIS="PQM"
|
|---|
| 90 | D ^%ZIS
|
|---|
| 91 | Q:POP
|
|---|
| 92 | I $D(IO("Q")) D QUE I 1
|
|---|
| 93 | E D NOQUE
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | NOQUE ;
|
|---|
| 97 | S ^DISV($I,"^%ZIS(1,")=$O(^%ZIS(1,"C",IO,""))
|
|---|
| 98 | U IO
|
|---|
| 99 | D PROCESS
|
|---|
| 100 | D ^%ZISC
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | QUE ;
|
|---|
| 104 | S XBION=ION
|
|---|
| 105 | KILL ZTSAVE
|
|---|
| 106 | F %="XBG1","XBG2","XBION" S ZTSAVE(%)=""
|
|---|
| 107 | S ZTRTN="PROCESS^XBGCMP",ZTDESC="COMPARE TWO GLOBALS",ZTIO="",ZTDTH=""
|
|---|
| 108 | D ^%ZTLOAD
|
|---|
| 109 | KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 110 | D ^%ZISC
|
|---|
| 111 | W !
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | PROCESS ; Compare
|
|---|
| 115 | S XBG1="^"_XBG1,XBG2="^"_XBG2,XBN=$J_$H,XBC=0
|
|---|
| 116 | I '$D(ZTQUEUED) W:$D(IOF) @IOF W !!,"Comparison of globals ",XBG1," and ",XBG2,!
|
|---|
| 117 | I $D(@XBG1)#2,'($D(@XBG2)#2) S XBC=XBC+1,XBTEMP=XBG1 D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Exists~"_XBG2_" Missing"
|
|---|
| 118 | I '($D(@XBG1)#2),$D(@XBG2)#2 S XBC=XBC+1,XBTEMP=XBG1 D CHANGE S ^TMP("XBGCMP",XBN,XBTEMP)=XBG1_" Missing~"_XBG2_" Exists"
|
|---|
| 119 | 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
|
|---|
| 120 | S XBA=$P(XBG1,"("),XBB=$P(XBG2,"("),XB=XBG1
|
|---|
| 121 | F S XB=$Q(@XB) Q:XB="" D
|
|---|
| 122 | . 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
|
|---|
| 123 | . 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)
|
|---|
| 124 | X3 . Q
|
|---|
| 125 | S XBA=$P(XBG2,"("),XBB=$P(XBG1,"("),XB=XBG2
|
|---|
| 126 | F S XB=$Q(@XB) Q:XB="" D
|
|---|
| 127 | . 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"
|
|---|
| 128 | I '$D(ZTQUEUED) D PRINT I 1
|
|---|
| 129 | E D SCHED
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | CHANGE ; Temp change double quotes to single
|
|---|
| 133 | I XBTEMP["""" S XBTMP="",XBQTE=$L(XBTEMP,"""") F XBI=1:1:(XBQTE-1) S XBTMP=XBTMP_$P(XBTEMP,"""",XBI)_"" I XBI=(XBQTE-1) D
|
|---|
| 134 | . S XBTEMP=XBTMP_$P(XBTEMP,"""",XBQTE)
|
|---|
| 135 | KILL XBTMP,XBQTE
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | PRINT ; Prints or displays results
|
|---|
| 139 | I $D(ZTQUEUED) W:$D(IOF) @IOF W !!,"Comparison of globals ",XBG1," and ",XBG2,!
|
|---|
| 140 | S XBL=IOSL-3,XB=""
|
|---|
| 141 | F S XB=$O(^TMP("XBGCMP",XBN,XB)) Q:XB="" D I XBL'>0 D PAUSE Q:$G(XBSTP) S XBL=IOSL-3 W !
|
|---|
| 142 | . I $L(^TMP("XBGCMP",XBN,XB))>76 W !,$P(^(XB),"~"),!,$P(^(XB),"~",2),! S XBL=XBL-3.25
|
|---|
| 143 | . E W !,$P(^TMP("XBGCMP",XBN,XB),"~")," ",$P(^(XB),"~",2),! S XBL=XBL-2
|
|---|
| 144 | I '$G(XBSTP) W !,"Comparison completed with ",XBC," difference",$S(XBC'=1:"s",1:"")," found.",!
|
|---|
| 145 | KILL ^TMP("XBGCMP",XBN)
|
|---|
| 146 | I $D(ZTQUEUED) S ZTREQ="@" D EOJ
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | PAUSE ; Quit display?
|
|---|
| 150 | I $E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E") S:$D(DIRUT)!($D(DUOUT)) XBSTP=1 KILL DIRUT,DUOUT W !
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | SCHED ; Schedules another task to print
|
|---|
| 154 | KILL ZTSAVE
|
|---|
| 155 | F %="XBN","XBG1","XBG2","XBC" S ZTSAVE(%)=""
|
|---|
| 156 | S ZTRTN="PRINT^XBGCMP",ZTDESC="PRINT COMPARISON OF TWO GLOBALS",ZTIO=XBION,ZTDTH=DT
|
|---|
| 157 | D ^%ZTLOAD
|
|---|
| 158 | KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 159 | Q
|
|---|
| 160 | ;
|
|---|
| 161 | EOJ ;
|
|---|
| 162 | KILL XB,XBA,XBB,XBC,XBI,XBL,XBG1,XBG2,XBION,XBN,XBQ,XBS,XBSTP,XBT,XBTEMP,XBTMP,XBVOL
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | HELP ;EP - Dooda about the utility
|
|---|
| 166 | ;;@;!
|
|---|
