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 ---[H[J[2J[HDITMU2 1663 printed Sep 23, 2025@20:30:32 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
