Return to DICL3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICL3.m, revision 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: