source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDCOMG.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1XPDCOMG ;SFISC/RSD - compare globals ;07/15/2003 10:22
2 ;;8.0;KERNEL;**304**;Jul 10, 1995
3EN D FIA,KRN
4 Q
5FIA N DIC,OLDA,XPDFIL,XPDFILO,XPDFILS,XPDS,XPDS0,XPDX,XPDX0,XPDY,XPDY1,XPDZ,XPDZ1,X,Y
6 S XPDFIL=0
7 F S XPDFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPDFIL)) Q:'XPDFIL S XPDZ1=^(XPDFIL,0),XPDFILO=^(0,1) D
8 .I '$D(^DIC(XPDFIL)) W !!," File # ",XPDFIL," is NEW",! Q
9 .S XPDZ="^XTMP(""XPDI"","_XPDA
10 .I $P(XPDFILO,U)="y" D
11 ..W !!," File # ",XPDFIL," Data Dictionary ",!
12 ..S XPDY=XPDZ_",""^DIC"","_XPDFIL_","_XPDFIL_",0",XPDX=XPDY_")",XPDY=XPDY_",",XPDY1="^DIC("_XPDFIL_",0",XPDS=XPDY1_")",XPDY1=XPDY1_","
13 ..D COMPAR(1)
14 ..S XPDFILS=0 F S XPDFILS=$O(^XTMP("XPDI",XPDA,"^DD",XPDFIL,XPDFILS)) Q:'XPDFILS D
15 ...S XPDY=XPDZ_",""^DD"","_XPDFIL_","_XPDFILS,XPDX=XPDY_")",XPDY=XPDY_",",XPDY1="^DD("_XPDFILS,XPDS=XPDY1_")",XPDY1=XPDY1_","
16 ...D COMPAR(1)
17 .Q:'$D(^XTMP("XPDI",XPDA,"DATA",XPDFIL))
18 .W !!," File # ",XPDFIL," Data ",!
19 .K DIC
20 .S DIC=XPDFIL,DIC(0)="X",XPDZ=XPDZ_",""DATA"","_XPDFIL,OLDA=0
21 .F S OLDA=$O(^XTMP("XPDI",XPDA,"DATA",XPDFIL,OLDA)) Q:'OLDA S OLDA(0)=^(OLDA,0) D
22 ..S X=$P(OLDA(0),U) D ^DIC
23 ..I Y<0 W !,X," will be ADDED " Q
24 ..S XPDY=XPDZ_","_OLDA_",",XPDX=XPDZ_","_OLDA_")",XPDY1=XPDZ1_+Y_",",XPDS=XPDZ1_+Y_")"
25 ..D COMPAR(0)
26 W !! Q
27KRN N DEL,DIC,OLDA,ORD,X,XPDFIL,XPDFILNM,XPDI,XPDS,XPDS0,XPDX,XPDX0,XPDY,XPDY1,XPDZ,XPDZ1,Y
28 S ORD=0
29 F S ORD=$O(^XTMP("XPDI",XPDA,"ORD",ORD)) Q:'ORD S XPDFIL=+$O(^(ORD,0)),XPDFILNM=$G(^(XPDFIL,0)) D:XPDFIL
30 .I $P($G(^DIC(XPDFIL,0)),U)'=XPDFILNM W !!," File "_XPDFIL_" is not "_XPDFILNM_", nothing can be installed.",! Q
31 .W !!,XPDFILNM,! K DIC
32 .S DIC=XPDFIL,DIC(0)="X",XPDZ="^XTMP(""XPDI"","_XPDA_",""KRN"","_XPDFIL_",",XPDZ1=^DIC(XPDFIL,0,"GL"),OLDA=0
33 .F S OLDA=$O(^XTMP("XPDI",XPDA,"KRN",XPDFIL,OLDA)) Q:'OLDA S DEL=+$G(^(OLDA,-1)),OLDA(0)=^(0) D
34 ..I XPDFIL<.44 S DIC("S")="I $P(^(0),U,"_$S(XPDFIL'=.403:"4)",1:"8)")_"="_$P(OLDA(0),U,$S(XPDFIL'=.403:4,1:8))
35 ..I DEL=1,XPDFIL<.44 S %=$P(OLDA(0),U),$P(OLDA(0),U)=$P(%," FILE #"),DIC("S")="I $P(^(0),U,"_$S(XPDFIL'=.403:4,1:8)_")="_+$P(%," FILE #",2)
36 ..S X=$P(OLDA(0),U) D ^DIC
37 ..I Y<0,DEL'=1 W !,XPDFILNM,": ",X," will be ADDED " Q
38 ..I DEL=1 W:Y>0 !,XPDFILNM,": ",X," will be DELETED " Q
39 ..S XPDY=XPDZ_OLDA_",",XPDX=XPDZ_OLDA_",-1)",XPDY1=XPDZ1_+Y_",",XPDS=XPDZ1_+Y_")" D COMPAR(0)
40 Q
41 ;taken from XTVGC2 routine
42COMPAR(XPDFL) S XPDFL=$G(XPDFL)
43 N XPDS1,XPDX1
44 F D Q:XPDX=""&(XPDS="")
45 .S XPDX0=$$QU(.XPDX,XPDY),XPDX1=$P(XPDX,XPDY,2)
46 .S XPDS0=$$QU(.XPDS,XPDY1),XPDS1=$P(XPDS,XPDY1,2) Q:XPDX=""&(XPDS="")
47 .D CHECK
48 Q
49CHECK N FL,I,X1,X1,S1,S2
50CHK1 I XPDX="" W:'XPDFL !,"* DEL * ",XPDS," = ",XPDS0 Q
51 I XPDS="" W !,"* ADD * ",XPDY1_XPDX1," = ",XPDX0 Q
52 S FL=$S(XPDX1=XPDS1:0,1:1)
53 I FL S X1=$E(XPDX1,1,$L(XPDX1)-1),S1=$E(XPDS1,1,$L(XPDS1)-1) D
54 .F I=1:1 S X2=$P(X1,",",I),S2=$P(S1,",",I) I X2'=S2 S FL=$S(+X2=X2:$S(+S2'=S2:1,X2<S2:1,1:-1),+S2=S2:-1,S2]X2:1,1:-1) Q
55 I FL<0 W:'XPDFL !,"* DEL * ",XPDS," = ",XPDS0 S XPDS0=$$QU(.XPDS,XPDY1),XPDS1=$P(XPDS,XPDY1,2) G CHK1
56 I FL>0 W !,"* ADD * ",XPDY1_XPDX1," = ",XPDX0 S XPDX0=$$QU(.XPDX,XPDY),XPDX1=$P(XPDX,XPDY,2) G CHK1
57 I XPDX0'=XPDS0 W !,"* OLD * ",XPDS," = ",XPDS0,!,"* NEW * ",XPDY1_XPDX1," = ",XPDX0
58 Q
59QU(X,Y) ;X=gr, Y=root
60 Q:$G(X)="" ""
61 S X=$Q(@X)
62 I X=""!(X'[$G(Y)) S X="" Q ""
63 Q @X
Note: See TracBrowser for help on using the repository browser.