source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DITMU2.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DITMU2(SUBFILE,GBL,FORM) ;SFISC/EDE(OHPRD)-RETURN SUBFILE GLOBAL REFERENCE ;
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Given a subfile number and global reference form, this routine
6 ; will return the global reference for a subfile in the form
7 ; specified.
8 ;
9 ; FORM is optional but if passed should equal 1 or 2. If FORM is
10 ; not passed the default form will be 1.
11 ;
12 ; FORM = 1 will be in the form ^GBL(DA(2),11,DA(1),11,DA,
13 ; FORM = 2 will be in the form ^GBL(D0,11,D1,11,D2,
14 ;
15 ; Formal list:
16 ;
17 ; 1) SUBFILE = subfile number (call by value)
18 ; 2) GBL = global reference (call by reference)
19 ; 3) FORM = global reference form (call by value)
20 ;
21 ; *** NO ERROR CHECKING DONE ***
22 ;
23START ;
24 NEW FIELD,I,LVL,NODE,PARENT
25 S GBL="",LVL=1
26 D BACKUP
27 S GBL=^DIC(PARENT,0,"GL")
28 I $G(FORM)=2 D S GBL=GBL_"D"_(I+1)_"," I 1
29 . F I=0:1 S GBL=GBL_"D"_I_","_NODE(99-LVL)_",",LVL=LVL-1 Q:LVL=0
30 . Q
31 E D S GBL=GBL_"DA,"
32 . F LVL=LVL:-1:0 Q:LVL=0 S GBL=GBL_"DA("_LVL_"),"_NODE(99-LVL)_","
33 . Q
34 Q
35 ;
36BACKUP ; BACKUP TREE (CALLED RECURSIVELY)
37 S PARENT=^DD(SUBFILE,0,"UP")
38 S FIELD=$O(^DD(PARENT,"SB",SUBFILE,""))
39 S NODE(99-LVL)=$P($P(^DD(PARENT,FIELD,0),"^",4),";",1) S:NODE(99-LVL)'=+NODE(99-LVL) NODE(99-LVL)=""""_NODE(99-LVL)_""""
40 I $D(^DD(PARENT,0,"UP")) S SUBFILE=PARENT,LVL=LVL+1 D BACKUP ; Recurse
41 Q
Note: See TracBrowser for help on using the repository browser.