| [641] | 1 | XBGXFR ; IHS/ADC/GTH - TRANSFERS GLOBAL TREES ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; CREATED BY GIS 7/17/85 FOR MSM UNIX MUMPS (2.3)
|
|---|
| 5 | ; MODIFIED AND RENAMED BY EDE 12/21/86
|
|---|
| 6 | ;
|
|---|
| 7 | START ;
|
|---|
| 8 | D SEARCH
|
|---|
| 9 | KILL FROM,TO,TALK
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | SEARCH ;
|
|---|
| 13 | NEW (FROM,TO,TALK)
|
|---|
| 14 | S F="F",T="T",C=",",P=")",NF=$L(FROM,C)-1,NT=$L(TO,C)-1,L=1,F1=""
|
|---|
| 15 | S TF=FROM
|
|---|
| 16 | F I=1:1:30 S TF=TF_F_I_C
|
|---|
| 17 | S TT=TO
|
|---|
| 18 | F I=1:1:30 S TT=TT_F_I_C
|
|---|
| 19 | S Y=$E(FROM,1,$L(FROM)-1)_$S($E(FROM,$L(FROM))=",":")",1:"")
|
|---|
| 20 | I $D(@(Y))#2 S Z=TO_$P(FROM,"(",2),Z=$E(Z,1,$L(Z)-1)_")",@Z=@Y
|
|---|
| 21 | EXTR ;
|
|---|
| 22 | S X=F_L,Y=$P(TF,C,1,L+NF)_P,@X=$O(@Y)
|
|---|
| 23 | I @X]"" D:$D(@(Y))#2 SUB S L=L+1,@(F_L)="" G EXTR
|
|---|
| 24 | S L=L-1
|
|---|
| 25 | Q:L=0
|
|---|
| 26 | G EXTR
|
|---|
| 27 | ;
|
|---|
| 28 | SUB ;
|
|---|
| 29 | S Z=$P(TT,C,1,L+NT)_P,@Z=@Y
|
|---|
| 30 | W:$D(TALK) "."
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | EN(FROM,TO,TALK) ;PEP - Transfer global trees.
|
|---|
| 34 | Q:$G(FROM)=""
|
|---|
| 35 | Q:$G(TO)=""
|
|---|
| 36 | S TALK=$G(TALK)
|
|---|
| 37 | G START
|
|---|
| 38 | ;
|
|---|
