source: IHS-VA_UTILITIES-XB/trunk/XBSFGBL.m@ 1745

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

Modified directory structure; moved routines.

File size: 1.7 KB
RevLine 
[641]1XBSFGBL(S,G,F) ; IHS/ADC/GTH - RETURN SUBFILE GLOBAL REFERENCE ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; NOTE TO PROGRAMMERS; Use entry point EN. Do not use the
5 ; first line of this routine, as pending initiatives in MDC
6 ; might make a formal list on the first line of a routine
7 ; invalid. GTH 07-10-95
8 ;
9 ; Given a file or subfile number and global reference form,
10 ; this routine will return the global reference in the form
11 ; specified.
12 ;
13 ; F (form) is optional but if passed should equal 1 or 2.
14 ; If F is not passed the default form will be 1.
15 ;
16 ; F = 1 will be in the form ^GLOBAL(DA(2),11,DA(1),11,DA,
17 ; F = 2 will be in the form ^GLOBAL(D0,11,D1,11,D2,
18 ;
19 ; Formal list:
20 ;
21 ; 1) S = subfile number (call by value)
22 ; 2) G = global reference (call by reference)
23 ; 3) F = global reference form (call by value)
24 ;
25 ; *** NO ERROR CHECKING DONE ***
26 ;
27START ;
28 ; D = Field
29 ; I = Counter
30 ; L = Level
31 ; N = Node
32 ; P = Parent
33 ;
34 NEW D,I,L,N,P
35 ;
36 S G="",L=1
37 I '$D(^DD(S,0,"UP")) D NOPARENT Q
38 D BACKUP
39 S G=^DIC(P,0,"GL")
40 I $G(F)=2 D S G=G_"D"_(I+1)_"," I 1
41 . F I=0:1 S G=G_"D"_I_","_N(99-L)_",",L=L-1 Q:L=0
42 . Q
43 E D S G=G_"DA,"
44 . F L=L:-1:0 Q:L=0 S G=G_"DA("_L_"),"_N(99-L)_","
45 . Q
46 Q
47 ;
48BACKUP ; BACKUP TREE
49 S P=^DD(S,0,"UP")
50 S D=$O(^DD(P,"SB",S,""))
51 S N(99-L)=$P($P(^DD(P,D,0),"^",4),";",1)
52 S:N(99-L)'=+N(99-L) N(99-L)=""""_N(99-L)_""""
53 I $D(^DD(P,0,"UP")) S S=P,L=L+1 D BACKUP
54 Q
55 ;
56NOPARENT ; for no parent
57 S G=^DIC(S,0,"GL")
58 I $G(F)=2 S G=G_"D0" I 1
59 E S G=G_"DA,"
60 Q
61 ;
62DIC(S) ;PEP - Extrinsic entry to return root global from FILE number
63 NEW G
64 D EN(S,.G)
65 S G=$P(G,"DA,")
66 Q G
67 ;
68EN(S,G,F) ;PEP - RETURN SUBFILE GLOBAL REFERENCE
69 G START
70 ;--------------------
Note: See TracBrowser for help on using the repository browser.