source: IHS-VA_UTILITIES-XB/trunk/XBGCMP.m@ 830

Last change on this file since 830 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 5.4 KB
Line 
1XBGCMP ; 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
16A ;
17 D ASK
18 I XBQ G X1
19 D SETUP ; sets up up print/display, calls subrtn to process gbls
20 G A
21X1 ;
22 D EOJ
23 Q
24 ;
25INIT ; Setup
26 D ^XBKVAR
27 S (XBS,XBQ)=0
28 X ^%ZOSF("UCI")
29 S XBVOL=$P(Y,",",2)
30 Q
31 ;
32ASK ; Get globals to be compared
331 ;
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
412 ;
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
51X2 ;
52 Q
53 ;
54CHECK ; 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)
65X4 . 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
72X6 ;
73 Q
74 ;
75TRAP ; Error trap for missing quotes
76 I $$Z^ZIBNSSV("ERROR")["<UNDEF" W !,*7,"*** Probably missing quotes",! S XBS=1
77 Q
78 ;
79CHECK2 ; 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
84X5 ;
85 Q
86 ;
87SETUP ; 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 ;
96NOQUE ;
97 S ^DISV($I,"^%ZIS(1,")=$O(^%ZIS(1,"C",IO,""))
98 U IO
99 D PROCESS
100 D ^%ZISC
101 Q
102 ;
103QUE ;
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 ;
114PROCESS ; 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)
124X3 . 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 ;
132CHANGE ; 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 ;
138PRINT ; 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 ;
149PAUSE ; 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 ;
153SCHED ; 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 ;
161EOJ ;
162 KILL XB,XBA,XBB,XBC,XBI,XBL,XBG1,XBG2,XBION,XBN,XBQ,XBS,XBSTP,XBT,XBTEMP,XBTMP,XBVOL
163 Q
164 ;
165HELP ;EP - Dooda about the utility
166 ;;@;!
Note: See TracBrowser for help on using the repository browser.