| 1 | DITMU2(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 | ;
|
|---|
| 23 | START ;
|
|---|
| 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 | ;
|
|---|
| 36 | BACKUP ; 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
|
|---|
