File:  [Coherent Logic Development] / freem_fileman / USER / DITMU2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DITMU2(SUBFILE,GBL,FORM)	;SFISC/EDE(OHPRD)-RETURN SUBFILE GLOBAL REFERENCE ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>