DITMU2.m

DITMU2 ;SFISC/EDE(OHPRD)-RETURN SUBFILE GLOBAL REFERENCE ;2015-01-03  10:14 AM

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

 ; Given a subfile number and global reference form, this routine

 ; will return the global reference for a subfile in the form

 ; specified.

 ;

 ; FORM is optional but if passed should equal 1 or 2.  If FORM is

 ; not passed the default form will be 1.

 ;

 ;     FORM = 1 will be in the form ^GBL(DA(2),11,DA(1),11,DA,

 ;     FORM = 2 will be in the form ^GBL(D0,11,D1,11,D2,

 ;

 ; Formal list:

 ;

 ; 1) SUBFILE = subfile number (call by value)

 ; 2) GBL     = global reference (call by reference)

 ; 3) FORM    = global reference form (call by value)

 ;

 ; *** NO ERROR CHECKING DONE ***

 ;

EN(SUBFILE,GBL,FORM) ;

START ;

 NEW FIELD,I,LVL,NODE,PARENT

 S GBL="",LVL=1

 D BACKUP

 S GBL=^DIC(PARENT,0,"GL")

 I $G(FORM)=2 D  S GBL=GBL_"D"_(I+1)_"," I 1

 . F I=0:1 S GBL=GBL_"D"_I_","_NODE(99-LVL)_",",LVL=LVL-1 Q:LVL=0

 . Q

 E  D  S GBL=GBL_"DA,"

 . F LVL=LVL:-1:0 Q:LVL=0  S GBL=GBL_"DA("_LVL_"),"_NODE(99-LVL)_","

 . Q

 Q

 ;

BACKUP ; BACKUP TREE (CALLED RECURSIVELY)

 S PARENT=^DD(SUBFILE,0,"UP")

 S FIELD=$O(^DD(PARENT,"SB",SUBFILE,""))

 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)_""""

 I $D(^DD(PARENT,0,"UP")) S SUBFILE=PARENT,LVL=LVL+1 D BACKUP ; Recurse

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DITMU2   1663     printed  Apr 09, 2024@21:55:15                                                                                                                                                                                                      Page 2

DITMU2    ;SFISC/EDE(OHPRD)-RETURN SUBFILE GLOBAL REFERENCE ;2015-01-03  10:14 AM

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

 +7       ; Given a subfile number and global reference form, this routine

 +8       ; will return the global reference for a subfile in the form

 +9       ; specified.

 +10      ;

 +11      ; FORM is optional but if passed should equal 1 or 2.  If FORM is

 +12      ; not passed the default form will be 1.

 +13      ;

 +14      ;     FORM = 1 will be in the form ^GBL(DA(2),11,DA(1),11,DA,

 +15      ;     FORM = 2 will be in the form ^GBL(D0,11,D1,11,D2,

 +16      ;

 +17      ; Formal list:

 +18      ;

 +19      ; 1) SUBFILE = subfile number (call by value)

 +20      ; 2) GBL     = global reference (call by reference)

 +21      ; 3) FORM    = global reference form (call by value)

 +22      ;

 +23      ; *** NO ERROR CHECKING DONE ***

 +24      ;

EN(SUBFILE,GBL,FORM) ;

START     ;

 +1        NEW FIELD,I,LVL,NODE,PARENT

 +2        SET GBL=""

           SET LVL=1

 +3        DO BACKUP

 +4        SET GBL=^DIC(PARENT,0,"GL")

 +5        IF $GET(FORM)=2

               Begin DoDot:1

 +6                FOR I=0:1

                       SET GBL=GBL_"D"_I_","_NODE(99-LVL)_","

                       SET LVL=LVL-1

                       if LVL=0

                           QUIT 

 +7                QUIT 

               End DoDot:1

               SET GBL=GBL_"D"_(I+1)_","

               IF 1

 +8       IF '$TEST

               Begin DoDot:1

 +9                FOR LVL=LVL:-1:0

                       if LVL=0

                           QUIT 

                       SET GBL=GBL_"DA("_LVL_"),"_NODE(99-LVL)_","

 +10               QUIT 

               End DoDot:1

               SET GBL=GBL_"DA,"

 +11       QUIT 

 +12      ;

BACKUP    ; BACKUP TREE (CALLED RECURSIVELY)

 +1        SET PARENT=^DD(SUBFILE,0,"UP")

 +2        SET FIELD=$ORDER(^DD(PARENT,"SB",SUBFILE,""))

 +3        SET NODE(99-LVL)=$PIECE($PIECE(^DD(PARENT,FIELD,0),"^",4),";",1)

           if NODE(99-LVL)'=+NODE(99-LVL)

               SET NODE(99-LVL)=""""_NODE(99-LVL)_""""

 +4       ; Recurse

           IF $DATA(^DD(PARENT,0,"UP"))

               SET SUBFILE=PARENT

               SET LVL=LVL+1

               DO BACKUP

 +5        QUIT