source: IHS-VA_UTILITIES-XB/trunk/XBGXFR.m@ 1549

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

Modified directory structure; moved routines.

File size: 823 bytes
Line 
1XBGXFR ; 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 ;
7START ;
8 D SEARCH
9 KILL FROM,TO,TALK
10 Q
11 ;
12SEARCH ;
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
21EXTR ;
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 ;
28SUB ;
29 S Z=$P(TT,C,1,L+NT)_P,@Z=@Y
30 W:$D(TALK) "."
31 Q
32 ;
33EN(FROM,TO,TALK) ;PEP - Transfer global trees.
34 Q:$G(FROM)=""
35 Q:$G(TO)=""
36 S TALK=$G(TALK)
37 G START
38 ;
Note: See TracBrowser for help on using the repository browser.