71 lines
1.7 KiB
Mathematica
71 lines
1.7 KiB
Mathematica
XBSFGBL(S,G,F) ; IHS/ADC/GTH - RETURN SUBFILE GLOBAL REFERENCE ; [ 02/07/97 3:02 PM ]
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
|
;
|
|
; NOTE TO PROGRAMMERS; Use entry point EN. Do not use the
|
|
; first line of this routine, as pending initiatives in MDC
|
|
; might make a formal list on the first line of a routine
|
|
; invalid. GTH 07-10-95
|
|
;
|
|
; Given a file or subfile number and global reference form,
|
|
; this routine will return the global reference in the form
|
|
; specified.
|
|
;
|
|
; F (form) is optional but if passed should equal 1 or 2.
|
|
; If F is not passed the default form will be 1.
|
|
;
|
|
; F = 1 will be in the form ^GLOBAL(DA(2),11,DA(1),11,DA,
|
|
; F = 2 will be in the form ^GLOBAL(D0,11,D1,11,D2,
|
|
;
|
|
; Formal list:
|
|
;
|
|
; 1) S = subfile number (call by value)
|
|
; 2) G = global reference (call by reference)
|
|
; 3) F = global reference form (call by value)
|
|
;
|
|
; *** NO ERROR CHECKING DONE ***
|
|
;
|
|
START ;
|
|
; D = Field
|
|
; I = Counter
|
|
; L = Level
|
|
; N = Node
|
|
; P = Parent
|
|
;
|
|
NEW D,I,L,N,P
|
|
;
|
|
S G="",L=1
|
|
I '$D(^DD(S,0,"UP")) D NOPARENT Q
|
|
D BACKUP
|
|
S G=^DIC(P,0,"GL")
|
|
I $G(F)=2 D S G=G_"D"_(I+1)_"," I 1
|
|
. F I=0:1 S G=G_"D"_I_","_N(99-L)_",",L=L-1 Q:L=0
|
|
. Q
|
|
E D S G=G_"DA,"
|
|
. F L=L:-1:0 Q:L=0 S G=G_"DA("_L_"),"_N(99-L)_","
|
|
. Q
|
|
Q
|
|
;
|
|
BACKUP ; BACKUP TREE
|
|
S P=^DD(S,0,"UP")
|
|
S D=$O(^DD(P,"SB",S,""))
|
|
S N(99-L)=$P($P(^DD(P,D,0),"^",4),";",1)
|
|
S:N(99-L)'=+N(99-L) N(99-L)=""""_N(99-L)_""""
|
|
I $D(^DD(P,0,"UP")) S S=P,L=L+1 D BACKUP
|
|
Q
|
|
;
|
|
NOPARENT ; for no parent
|
|
S G=^DIC(S,0,"GL")
|
|
I $G(F)=2 S G=G_"D0" I 1
|
|
E S G=G_"DA,"
|
|
Q
|
|
;
|
|
DIC(S) ;PEP - Extrinsic entry to return root global from FILE number
|
|
NEW G
|
|
D EN(S,.G)
|
|
S G=$P(G,"DA,")
|
|
Q G
|
|
;
|
|
EN(S,G,F) ;PEP - RETURN SUBFILE GLOBAL REFERENCE
|
|
G START
|
|
;--------------------
|