XBGXFR.m

XBGXFR ; IHS/ADC/GTH - TRANSFERS GLOBAL TREES ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

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

 ; MODIFIED AND RENAMED BY EDE 12/21/86

 ;

START ;

 D SEARCH

 KILL FROM,TO,TALK

 Q

 ;

SEARCH ; 

 NEW (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

 ;

EN(FROM,TO,TALK) ;PEP - Transfer global trees.

 Q:$G(FROM)=""

 Q:$G(TO)=""

 S TALK=$G(TALK)

 G START

 ;

XBGXFR    ; IHS/ADC/GTH - TRANSFERS GLOBAL TREES ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

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

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

 +5       ;

START     ;

 +1        DO SEARCH

 +2        KILL FROM,TO,TALK

 +3        QUIT 

 +4       ;

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

 +4        FOR I=1:1:30

               SET TF=TF_F_I_C

 +5        SET TT=TO

 +6        FOR I=1:1:30

               SET TT=TT_F_I_C

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

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

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

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

               SET @Z=@Y

EXTR      ;

 +1        SET X=F_L

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

           SET @X=$ORDER(@Y)

 +2        IF @X]""

               IF $DATA(@(Y))#2

                   DO SUB

               SET L=L+1

               SET @(F_L)=""

               GOTO EXTR

 +3        SET L=L-1

 +4        IF L=0

               QUIT 

 +5        GOTO EXTR

 +6       ;

SUB       ;

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

           SET @Z=@Y

 +2        IF $DATA(TALK)

               WRITE "."

 +3        QUIT 

 +4       ;

EN(FROM,TO,TALK) ;PEP - Transfer global trees.

 +1        IF $GET(FROM)=""

               QUIT 

 +2        IF $GET(TO)=""

               QUIT 

 +3        SET TALK=$GET(TALK)

 +4        GOTO START

 +5       ;