| 1 | XBGC ; IHS/ADC/GTH - COPY GLOBAL (ANY LEVEL) ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | START ;
|
|---|
| 5 | NEW (%)
|
|---|
| 6 | GSGL ;
|
|---|
| 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
|
|---|
| 17 | GDGL ;
|
|---|
| 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 | ;
|
|---|
| 46 | WALK ; 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 | ;
|
|---|
| 52 | GOTNODE ; 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 | ;
|
|---|
