| [641] | 1 | XBSFGBL(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 | ;
|
|---|
| 27 | START ;
|
|---|
| 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 | ;
|
|---|
| 48 | BACKUP ; 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 | ;
|
|---|
| 56 | NOPARENT ; 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 | ;
|
|---|
| 62 | DIC(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 | ;
|
|---|
| 68 | EN(S,G,F) ;PEP - RETURN SUBFILE GLOBAL REFERENCE
|
|---|
| 69 | G START
|
|---|
| 70 | ;--------------------
|
|---|
