Return to DICL3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICL3.m, revision 1.1.1.1

1.1       snw         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: