SDECSFGR ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
; NOTE TO PROGRAMMERS; Use entry point EN. Do not use the
; first line of this routine, as pending initiatives in MDC
; might make a formal list on the first line of a routine
; invalid. GTH 07-10-95
;
; Given a file or subfile number and global reference form,
; this routine will return the global reference in the form
; specified.
;
; F (form) is optional but if passed should equal 1 or 2.
; If F is not passed the default form will be 1.
;
; F = 1 will be in the form ^GLOBAL(DA(2),11,DA(1),11,DA,
; F = 2 will be in the form ^GLOBAL(D0,11,D1,11,D2,
;
; Formal list:
;
; 1) S = subfile number (call by value)
; 2) G = global reference (call by reference)
; 3) F = global reference form (call by value)
;
; *** NO ERROR CHECKING DONE ***
;
START ;
; D = Field
; I = Counter
; L = Level
; N = Node
; P = Parent
;
NEW D,I,L,N,P
;
S G="",L=1
I '$D(^DD(S,0,"UP")) D NOPARENT Q
D BACKUP
S G=^DIC(P,0,"GL")
I $G(F)=2 D S G=G_"D"_(I+1)_"," I 1
. F I=0:1 S G=G_"D"_I_","_N(99-L)_",",L=L-1 Q:L=0
. Q
E D S G=G_"DA,"
. F L=L:-1:0 Q:L=0 S G=G_"DA("_L_"),"_N(99-L)_","
. Q
Q
;
BACKUP ; BACKUP TREE
S P=^DD(S,0,"UP")
S D=$O(^DD(P,"SB",S,""))
S N(99-L)=$P($P(^DD(P,D,0),"^",4),";",1)
S:N(99-L)'=+N(99-L) N(99-L)=""""_N(99-L)_""""
I $D(^DD(P,0,"UP")) S S=P,L=L+1 D BACKUP
Q
;
NOPARENT ; for no parent
S G=^DIC(S,0,"GL")
I $G(F)=2 S G=G_"D0" I 1
E S G=G_"DA,"
Q
;
DIC(S) ;PEP - Extrinsic entry to return root global from FILE number
NEW G
D EN(S,.G)
S G=$P(G,"DA,")
Q G
;
EN(S,G,F) ;PEP - RETURN SUBFILE GLOBAL REFERENCE
G START
;--------------------
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECSFGR 1800 printed Nov 22, 2024@18:02:42 Page 2
SDECSFGR ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
+5 ; NOTE TO PROGRAMMERS; Use entry point EN. Do not use the
+6 ; first line of this routine, as pending initiatives in MDC
+7 ; might make a formal list on the first line of a routine
+8 ; invalid. GTH 07-10-95
+9 ;
+10 ; Given a file or subfile number and global reference form,
+11 ; this routine will return the global reference in the form
+12 ; specified.
+13 ;
+14 ; F (form) is optional but if passed should equal 1 or 2.
+15 ; If F is not passed the default form will be 1.
+16 ;
+17 ; F = 1 will be in the form ^GLOBAL(DA(2),11,DA(1),11,DA,
+18 ; F = 2 will be in the form ^GLOBAL(D0,11,D1,11,D2,
+19 ;
+20 ; Formal list:
+21 ;
+22 ; 1) S = subfile number (call by value)
+23 ; 2) G = global reference (call by reference)
+24 ; 3) F = global reference form (call by value)
+25 ;
+26 ; *** NO ERROR CHECKING DONE ***
+27 ;
START ;
+1 ; D = Field
+2 ; I = Counter
+3 ; L = Level
+4 ; N = Node
+5 ; P = Parent
+6 ;
+7 NEW D,I,L,N,P
+8 ;
+9 SET G=""
SET L=1
+10 IF '$DATA(^DD(S,0,"UP"))
DO NOPARENT
QUIT
+11 DO BACKUP
+12 SET G=^DIC(P,0,"GL")
+13 IF $GET(F)=2
Begin DoDot:1
+14 FOR I=0:1
SET G=G_"D"_I_","_N(99-L)_","
SET L=L-1
if L=0
QUIT
+15 QUIT
End DoDot:1
SET G=G_"D"_(I+1)_","
IF 1
+16 IF '$TEST
Begin DoDot:1
+17 FOR L=L:-1:0
if L=0
QUIT
SET G=G_"DA("_L_"),"_N(99-L)_","
+18 QUIT
End DoDot:1
SET G=G_"DA,"
+19 QUIT
+20 ;
BACKUP ; BACKUP TREE
+1 SET P=^DD(S,0,"UP")
+2 SET D=$ORDER(^DD(P,"SB",S,""))
+3 SET N(99-L)=$PIECE($PIECE(^DD(P,D,0),"^",4),";",1)
+4 if N(99-L)'=+N(99-L)
SET N(99-L)=""""_N(99-L)_""""
+5 IF $DATA(^DD(P,0,"UP"))
SET S=P
SET L=L+1
DO BACKUP
+6 QUIT
+7 ;
NOPARENT ; for no parent
+1 SET G=^DIC(S,0,"GL")
+2 IF $GET(F)=2
SET G=G_"D0"
IF 1
+3 IF '$TEST
SET G=G_"DA,"
+4 QUIT
+5 ;
DIC(S) ;PEP - Extrinsic entry to return root global from FILE number
+1 NEW G
+2 DO EN(S,.G)
+3 SET G=$PIECE(G,"DA,")
+4 QUIT G
+5 ;
EN(S,G,F) ;PEP - RETURN SUBFILE GLOBAL REFERENCE
+1 GOTO START
+2 ;--------------------
