Return to DICL3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Initial commit

DICL3	;SEA/TOAD-VA FileMan: Lookup: Lister, Part 4 ;7/29/94  10:01 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
POINT	;
	;BRANCH^DICL--perform recursive list for pointer index
	N DICODE,DIFIENP,DILVL,DIPLVL,DISCREEN
	S DIPLVL=+$G(DIFILE("LVL"))
	N DIFILE
	S DIFILE=+$P($P(DINDEX("NODE"),U,2),"P",2)
	S DILVL=DIPLVL+1
	S DIFILE("LVL")=DILVL
	S DISCREEN="X "_$NA(^TMP("DILVL",$J,DILVL))
	S DICODE="N DIPLVL,DIROOT S DIPLVL="_DIPLVL_",DIROOT=$NA("_$NA(@DIROOT@(DINDEX))_"),DIFIENP=$O(@DIROOT@(Y,"""")) I DIFIENP'="""""
	I DIPLVL S DICODE=DICODE_" X "_$NA(^TMP("DILVL",$J,DIPLVL))
	S ^TMP("DILVL",$J,DILVL)=DICODE
RECUR	;
	;perform recursive call
	D LIST^DICL(.DIFILE,"","",DIFLAGS_"f",DINUMBER,DIFROM,DIPART,"B",DICALSCR,"",DILIST)
	K ^TMP("DILVL",$J,DILVL)
	I $D(DIERR) D CALLOUT^DIEFU($G(DIMSGA)):$G(DIMSGA)'="" Q
	Q
	;
	
FOLLOW(DIFILE,DIROOT,DIPOINT,DIDEF)	;
	; follow pointer to end, building stack along the way
	N DILVL S DILVL=0
	F  D  Q:DIPOINT=""
	. S DILVL=DILVL+1
	. S DIFILE("STACK",DILVL)=DIFILE_DIROOT_U_DIFILE("INDEX")
	. I 'DIPOINT S DIPOINT="" Q
	. S (DIFILE,DIFILE("INDEX"))=DIPOINT
	. S DIROOT=$$CREF^DIQGU(U_$P(DIDEF,U,3))
	. S DIDEF=$G(^DD(DIFILE,.01,0))
	. S DIPOINT=+$P($P(DIDEF,U,2),"P",2)
	S DIFILE("STACK")=DILVL
	Q
	
BACKTRAK(DIFILE,DIEN,DILVL)	;
	; follow pointer chain to root, considering all pointing records
	; formal parameter list includes only those needed for recursion
	; for rest of list, see $$SCREEN and ACCEPT calls within loop
	S DILVL=DILVL-1
	S DIFILE=$P(DIFILE("STACK",DILVL),U)
	N DIROOT1 S DIROOT1=U_$P(DIFILE("STACK",DILVL),U,2)
	S DIFILE("INDEX")=$P(DIFILE("STACK",DILVL),U,3)
	N DIVALUE S DIVALUE=DIEN
B1	S DIEN="" F  D  Q:DIEN=""!(DIFLAGS["q")
	. N DINDEX1 S DINDEX1=$S(DILVL>1:"B",1:DINDEX("MAIN"))
	. S DIEN=$O(@DIROOT1@(DINDEX1,DIVALUE,DIEN),DINDEX("WAY"))
	. Q:DIEN=""
	. I DILVL>1 D
	. . D BACKTRAK(.DIFILE,DIEN,DILVL) Q:DIFLAGS["q"
	. E  D
	. . I DITOIN'="",DITO=DIENTRY,DIEN=DITOIN D  Q
	. . . S DIFLAGS=DIFLAGS_"q",DIEN="",DIENTRY="",DIOUT1=1,DIOUT2=1 Q
	. . I DIFROM("LOOKING FOR START") N DISKIP S DISKIP=0 D  Q:DISKIP
	. . . I DIFROM=DIENTRY,DIFROM("IEN")'=DIEN S DISKIP=1 Q
	. . . S DIFROM("LOOKING FOR START")=0 Q:DIFROM'=DIENTRY  S DISKIP=1
B2	. . N DIROOT2
	. . S DIROOT2=DIROOT("MAIN")
	. . S DIROOT2("O")=DIROOT("MAIN O")
	. . N DINDEX2 D
	. . . M DINDEX2=DINDEX("MAIN")
	. . . M DINDEX2("END")=DINDEX
	. . . K DINDEX2("END","MAIN"),DINDEX2("MAIN")
	. . Q:$$SCREEN^DICL2(DIFILE,.DIEN,DIFLAGS,.DIROOT2,DIFIEN,DISCREEN,DICALSCR,DIFILSCR,DINDEX2)
	. . I 'DICOUNT("JUST LOOKING") S DICOUNT("LAST IEN")=DIEN
	. . D ACCEPT^DICL2(.DIFILE,.DIEN,DIFLAGS,.DIROOT2,DIFIEN,.DIENTRY,.DICOUNT,.DINDEX2,.DIDENT,.DILIST)
	. . I DIOUT2 S DIFLAGS=DIFLAGS_"q"
	K DIFILE("INDEX")
	Q