Return to DITMU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITMU2.m, revision 1.1

1.1     ! snw         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