source: IHS-VA_UTILITIES-XB/trunk/XBGC.m@ 1535

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

Modified directory structure; moved routines.

File size: 2.3 KB
Line 
1XBGC ; IHS/ADC/GTH - COPY GLOBAL (ANY LEVEL) ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4START ;
5 NEW (%)
6GSGL ;
7 R !,"Source global: ",SG:$G(DTIME,999),!
8 Q:SG=""
9 S:$E(SG)'="^" SG="^"_SG
10 S:SG'["(" SG=SG_"("
11 S:$E(SG,$L(SG))="," SG=$E(SG,1,$L(SG)-1)
12 I SG'?1"^"1U.U1"(".UNP W $C(7) G GSGL
13 I $E(SG,$L(SG))=")" W !!,"Global must be partial!,",!,$C(7) G GSGL
14 KILL SUB,SCNT,NSUB
15 I $E(SG,$L(SG))="(" I $D(@($E(SG,1,$L(SG)-1)))=0 W !!,"Global ",SG," does not exist!",!,$C(7) G GSGL
16 I $E(SG,$L(SG))'="(" I $D(@(SG_")"))=0 W !!,"Partial global ",SG," does not exist!",!,$C(7) G GSGL
17GDGL ;
18 R !,"Destination global: ",DG:$G(DTIME,999),!
19 Q:DG=""
20 S:$E(DG)'="^" DG="^"_DG
21 S:DG'["(" DG=DG_"("
22 S:$E(DG,$L(DG))="," DG=$E(DG,1,$L(DG)-1)
23 I DG'?1"^"1U.U1"(".UNP W $C(7) G GDGL
24 I $E(DG,$L(DG))=")" W !!,"Global must be partial!,",!,$C(7) G GDGL
25 KILL SUB,SCNT,NSUB
26 I SG=DG W !!,"Output same as input!",$C(7),! G GSGL
27 I $L(DG)>$L(SG) I $E(DG,1,$L(SG))=SG W !!,"Output contained in input!",$C(7),! G GSGL
28 I $L(DG)<$L(SG) I $E(SG,1,$L(DG))=DG W !!,"Input contained in output!",$C(7),! G GSGL
29 I $E(DG,$L(DG))="(" I $D(@($P(DG,"(",1)))'=0 W !!,"Destination global """,$P(DG,"(",1),""" already exists!",! S IS=""
30 I $E(DG,$L(DG))'="(" I $D(@(DG_")"))'=0 W !!,"Partial global ",DG," already exists.",! S IS=""
31 I $D(IS) W !,"KILL (Y/N) " R ANS:$G(DTIME,999) I $E(ANS)="Y" K:$E(DG,$L(DG))="(" @($E(DG,1,$L(DG)-1)) K:$E(DG,$L(DG))'="(" @(DG_")")
32 I $D(IS),ANS'="Y" W !,"Copy anyway? (Y/N) N//" R ANS:$G(DTIME,999) S:ANS="" ANS="N" Q:ANS'="Y"
33 I $E(SG,$L(SG))="(" S FROM=$E(SG,1,$L(SG)-1)
34 E S FROM=SG_")"
35 I $E(DG,$L(DG))="(" S TO=$E(DG,1,$L(DG)-1)
36 E S TO=DG_")"
37 S:$D(@(FROM))#10 @(TO)=@(FROM)
38 S (SCMA,DCMA)=""
39 S:$E(SG,$L(SG))'="(" SCMA=","
40 S:$E(DG,$L(DG))'="(" DCMA=","
41 S CTR=0
42 D WALK
43 W !!,"All done!",!
44 G START
45 ;
46WALK ; TRAVERSE TREE AT CURRENT SUBSCRIPT LEVEL
47 NEW (CTR,SCMA,DCMA,SG,DG)
48 S NL=""
49 F L=0:0 S NL=$O(@(SG_SCMA_""""_NL_""")")) Q:NL="" D GOTNODE
50 Q
51 ;
52GOTNODE ; PROCESS ONE NODE
53 S CTR=CTR+1
54 W:'(CTR#100) "."
55 S FROM=SG_SCMA_"NL)",TO=DG_DCMA_"NL)"
56 I $D(@(FROM))#10 S VAL=@(FROM),@(TO)=VAL
57 I $D(@(FROM))\10 S LNL=$L(NL),SG=SG_SCMA_""""_NL_"""",DG=DG_DCMA_""""_NL_"""",SVSCMA=SCMA,SVDCMA=DCMA,(SCMA,DCMA)="," D WALK S SCMA=SVSCMA,DCMA=SVDCMA,SG=$E(SG,1,$L(SG)-(LNL+2+$L(SCMA))),DG=$E(DG,1,$L(DG)-(LNL+2+$L(DCMA)))
58 Q
59 ;
Note: See TracBrowser for help on using the repository browser.