ROUTINE DIDH

Entryref POINT^DIDH

CALLED BY ^DD(1,.01,"DEL",.5,0) -- "DEL" node of FILE of FILEs (File#1) field NAME (field#.01)

lvn DIC == "^DIC"

CALLED FROM PAGE1+34^DIDH1

lvn DIC == global root of file or subfile

when double loop active

sometimes WRITE text

when loop finishes

sometimes init lvn DG == -1

sometimes init lvn X == -1

sometimes KILLs lvn W1

sometimes KILLs lvn DOPT

when loop stopped by undef lvn DIU

sometimes KILLs DDV

sometimes KILLs %F

sometimes KILLs M1

QUIT

Code

POINT ; CALLED BY ^DD(1,.01,"DEL",.5,0)

S W1="W:$Y ! W !,""POINTED TO BY: "",?15" I $O(^DD(DA,0,"PT",""))'="" S DDPT=1

S X="" F S X=$O(^DD(DA,0,"PT",X)) Q:X="" S DG=0 F S DG=$O(^DD(DA,0,"PT",X,DG)) Q:DG="" D PD W:$D(^DD(DA,0,"PT",X,DG)) !?15 I '$D(DIU) D H G Q:M=U

S (DG,X)=-1 K W1,DDPT Q

TAG POINT^DIDH

FALLSTHRU none

INPUT VARS

DA == DDnumber

$ORDER(^DD(DA,0,"PT","")) -- what files point at this one.

OUTPUT VARS

sometimes inits lvn DDPT=1

always inits lvn W1 == XECUTE-able code with WRITE

TAG POINT^DIDH

FALLSTHRU from POINT^DIDH

INPUT VARS

lvn DA

$ORDER(^DD(DA,0,"PT",

always evals $ORDER(^DD(DA,0,"PT",X))

OUTPUT VARS

lvn X

always inits to ""

always exits line ==""

after command=5 then == subscript of ^DD(DA,0,"PT", ...

LOOP start with X over $ORDER(^DD(DA,0,"PT",X))

lvn DG

always inits to 0

always exits line == 0

after command=8 then == subscript of ^DD(DA,0,"PT",X, ...

DOUBLE LOOP start with DG over $ORDER(^DD(DA,0,"PT",X,DG))

Calls PD^DIDH

sometimes WRITEs

sometimes calls H^DIDH

IF undef lvn DIU

AND lvn M == U == "^"

GOTO out of double loop to Q^DIDH

entryref PD^DIDH

Code

PD I $S('$D(^DD(X,DG,0)):1,$P(^(0),U,2)["V":0,1:$P($P(^(0),U,2),"P",2)-DA) K ^DD(DA,0,"PT",X,DG) Q

S %=X,%F=DG

; fallsthru to WR^DIDH