AUGXFR.m

%AUGXFR ; TRANSFERS GLOBAL TREES [ 12/22/86  1:12 PM ]

 ; CREATED BY GIS 7/17/85 FOR MSM UNIX MUMPS (2.3)

 ; MODIFIED AND RENAMED BY EDE 12/21/86

 D SEARCH K FROM,TO,TALK Q

SEARCH ; 

 N (FROM,TO,TALK)

 S F="F",T="T",C=",",P=")",NF=$L(FROM,C)-1,NT=$L(TO,C)-1,L=1,F1=""

 S TF=FROM F I=1:1:30 S TF=TF_F_I_C

 S TT=TO F I=1:1:30 S TT=TT_F_I_C

 S Y=$E(FROM,1,$L(FROM)-1)_$S($E(FROM,$L(FROM))=",":")",1:"")

 I $D(@(Y))#2 S Z=TO_$P(FROM,"(",2),Z=$E(Z,1,$L(Z)-1)_")",@Z=@Y

EXTR S X=F_L,Y=$P(TF,C,1,L+NF)_P,@X=$O(@Y)

 I @X'="" D:$D(@(Y))#2 SUB S L=L+1,@(F_L)="" G EXTR

 S L=L-1 Q:L=0  G EXTR

SUB S Z=$P(TT,C,1,L+NT)_P,@Z=@Y W:$D(TALK) "." Q

%AUGXFR   ; TRANSFERS GLOBAL TREES [ 12/22/86  1:12 PM ]

 +1       ; CREATED BY GIS 7/17/85 FOR MSM UNIX MUMPS (2.3)

 +2       ; MODIFIED AND RENAMED BY EDE 12/21/86

 +3        DO SEARCH

           KILL FROM,TO,TALK

           QUIT 

SEARCH    ; 

 +1        NEW (FROM,TO,TALK)

 +2        SET F="F"

           SET T="T"

           SET C=","

           SET P=")"

           SET NF=$LENGTH(FROM,C)-1

           SET NT=$LENGTH(TO,C)-1

           SET L=1

           SET F1=""

 +3        SET TF=FROM

           FOR I=1:1:30

               SET TF=TF_F_I_C

 +4        SET TT=TO

           FOR I=1:1:30

               SET TT=TT_F_I_C

 +5        SET Y=$EXTRACT(FROM,1,$LENGTH(FROM)-1)_$SELECT($EXTRACT(FROM,$LENGTH(FROM))=",":")",1:"")

 +6        IF $DATA(@(Y))#2

               SET Z=TO_$PIECE(FROM,"(",2)

               SET Z=$EXTRACT(Z,1,$LENGTH(Z)-1)_")"

               SET @Z=@Y

EXTR       SET X=F_L

           SET Y=$PIECE(TF,C,1,L+NF)_P

           SET @X=$ORDER(@Y)

 +1        IF @X'=""

               IF $DATA(@(Y))#2

                   DO SUB

               SET L=L+1

               SET @(F_L)=""

               GOTO EXTR

 +2        SET L=L-1

           IF L=0

               QUIT 

           GOTO EXTR

SUB        SET Z=$PIECE(TT,C,1,L+NT)_P

           SET @Z=@Y

           IF $DATA(TALK)

               WRITE "."

           QUIT