Return to DICL3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICL3	;SEA/TOAD-VA FileMan: Lookup: Lister, Part 4 ;7/29/94  10:01 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: POINT	;
    6: 	;BRANCH^DICL--perform recursive list for pointer index
    7: 	N DICODE,DIFIENP,DILVL,DIPLVL,DISCREEN
    8: 	S DIPLVL=+$G(DIFILE("LVL"))
    9: 	N DIFILE
   10: 	S DIFILE=+$P($P(DINDEX("NODE"),U,2),"P",2)
   11: 	S DILVL=DIPLVL+1
   12: 	S DIFILE("LVL")=DILVL
   13: 	S DISCREEN="X "_$NA(^TMP("DILVL",$J,DILVL))
   14: 	S DICODE="N DIPLVL,DIROOT S DIPLVL="_DIPLVL_",DIROOT=$NA("_$NA(@DIROOT@(DINDEX))_"),DIFIENP=$O(@DIROOT@(Y,"""")) I DIFIENP'="""""
   15: 	I DIPLVL S DICODE=DICODE_" X "_$NA(^TMP("DILVL",$J,DIPLVL))
   16: 	S ^TMP("DILVL",$J,DILVL)=DICODE
   17: RECUR	;
   18: 	;perform recursive call
   19: 	D LIST^DICL(.DIFILE,"","",DIFLAGS_"f",DINUMBER,DIFROM,DIPART,"B",DICALSCR,"",DILIST)
   20: 	K ^TMP("DILVL",$J,DILVL)
   21: 	I $D(DIERR) D CALLOUT^DIEFU($G(DIMSGA)):$G(DIMSGA)'="" Q
   22: 	Q
   23: 	;
   24: 	
   25: FOLLOW(DIFILE,DIROOT,DIPOINT,DIDEF)	;
   26: 	; follow pointer to end, building stack along the way
   27: 	N DILVL S DILVL=0
   28: 	F  D  Q:DIPOINT=""
   29: 	. S DILVL=DILVL+1
   30: 	. S DIFILE("STACK",DILVL)=DIFILE_DIROOT_U_DIFILE("INDEX")
   31: 	. I 'DIPOINT S DIPOINT="" Q
   32: 	. S (DIFILE,DIFILE("INDEX"))=DIPOINT
   33: 	. S DIROOT=$$CREF^DIQGU(U_$P(DIDEF,U,3))
   34: 	. S DIDEF=$G(^DD(DIFILE,.01,0))
   35: 	. S DIPOINT=+$P($P(DIDEF,U,2),"P",2)
   36: 	S DIFILE("STACK")=DILVL
   37: 	Q
   38: 	
   39: BACKTRAK(DIFILE,DIEN,DILVL)	;
   40: 	; follow pointer chain to root, considering all pointing records
   41: 	; formal parameter list includes only those needed for recursion
   42: 	; for rest of list, see $$SCREEN and ACCEPT calls within loop
   43: 	S DILVL=DILVL-1
   44: 	S DIFILE=$P(DIFILE("STACK",DILVL),U)
   45: 	N DIROOT1 S DIROOT1=U_$P(DIFILE("STACK",DILVL),U,2)
   46: 	S DIFILE("INDEX")=$P(DIFILE("STACK",DILVL),U,3)
   47: 	N DIVALUE S DIVALUE=DIEN
   48: B1	S DIEN="" F  D  Q:DIEN=""!(DIFLAGS["q")
   49: 	. N DINDEX1 S DINDEX1=$S(DILVL>1:"B",1:DINDEX("MAIN"))
   50: 	. S DIEN=$O(@DIROOT1@(DINDEX1,DIVALUE,DIEN),DINDEX("WAY"))
   51: 	. Q:DIEN=""
   52: 	. I DILVL>1 D
   53: 	. . D BACKTRAK(.DIFILE,DIEN,DILVL) Q:DIFLAGS["q"
   54: 	. E  D
   55: 	. . I DITOIN'="",DITO=DIENTRY,DIEN=DITOIN D  Q
   56: 	. . . S DIFLAGS=DIFLAGS_"q",DIEN="",DIENTRY="",DIOUT1=1,DIOUT2=1 Q
   57: 	. . I DIFROM("LOOKING FOR START") N DISKIP S DISKIP=0 D  Q:DISKIP
   58: 	. . . I DIFROM=DIENTRY,DIFROM("IEN")'=DIEN S DISKIP=1 Q
   59: 	. . . S DIFROM("LOOKING FOR START")=0 Q:DIFROM'=DIENTRY  S DISKIP=1
   60: B2	. . N DIROOT2
   61: 	. . S DIROOT2=DIROOT("MAIN")
   62: 	. . S DIROOT2("O")=DIROOT("MAIN O")
   63: 	. . N DINDEX2 D
   64: 	. . . M DINDEX2=DINDEX("MAIN")
   65: 	. . . M DINDEX2("END")=DINDEX
   66: 	. . . K DINDEX2("END","MAIN"),DINDEX2("MAIN")
   67: 	. . Q:$$SCREEN^DICL2(DIFILE,.DIEN,DIFLAGS,.DIROOT2,DIFIEN,DISCREEN,DICALSCR,DIFILSCR,DINDEX2)
   68: 	. . I 'DICOUNT("JUST LOOKING") S DICOUNT("LAST IEN")=DIEN
   69: 	. . D ACCEPT^DICL2(.DIFILE,.DIEN,DIFLAGS,.DIROOT2,DIFIEN,.DIENTRY,.DICOUNT,.DINDEX2,.DIDENT,.DILIST)
   70: 	. . I DIOUT2 S DIFLAGS=DIFLAGS_"q"
   71: 	K DIFILE("INDEX")
   72: 	Q
   73: