Annotation of freem_fileman/DDMAP1.m, revision 1.1

1.1     ! snw         1: DDMAP1 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;5/3/91  8:19 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: NXF    S DDFLE=$O(^UTILITY($J,"FD",DDFLE)) G EXIT2^DDMAP:DDFLE'>0 S DDLN=1,DDOUT=0,DD9=0 I $Y>DDMIOSL D HDR^DDMAP2 G KILL^DDMAP:$D(DTOUT)
        !             5:        D VIIVA^DDMAP2,TO S DDPCK=$O(^DD(DDFLE,0,"NM","")) D FSHORT W ?DDTB1,"|  ",DDFLE," ",DDPCK W ?DDTB2,"|",! S DDFL="" I $Y>DDMIOSL D HDR^DDMAP2 G KILL^DDMAP:$D(DTOUT)
        !             6: NXFL   S DDFL=$O(^UTILITY($J,"FD",DDFLE,"FR",DDFL)),DDFLD=0 I DDFL="" G END
        !             7: NXFLD  S DDFLD=$O(^UTILITY($J,"FD",DDFLE,"FR",DDFL,DDFLD)),DDFPT=0,DD5=DDFL G:DDFLD'>0 NXFL S DDFRN=$P(^DD(DDFL,DDFLD,0),U,1)
        !             8: NXUP   I $D(^DD(DD5,0,"UP")) S DD5=^("UP"),DD7=$O(^("NM","")) S:(DD5'=$P(DDFRN,":",1)) DDFRN=DD7_":"_DDFRN G NXUP
        !             9: NXPT   S DDFPT=$O(^UTILITY($J,"FD",DDFLE,"FR",DDFL,DDFLD,DDFPT)) G NXFLD:DDFPT'>0 S DDA2=^(DDFPT) D TO
        !            10: REV    S DDA1=$S($P(DDA2,U,2)["M":"m",1:""),DDA2=$S($P(DDA2,U,2)["V":"v",1:""),DDMAX=DDFNMAX,DDP=DDFRN D SHORT W ?DDTB1,"| " W:DDP]"" DDA2,DDA1,?DDTB1+4,DDP W ?DDTB2,"|" D OUT S DDFRN="" I $Y>DDMIOSL D HDR^DDMAP2 G KILL^DDMAP:$D(DTOUT)
        !            11:        G NXPT
        !            12: FSHORT I DDFNMAX-$L(DDFLE)-$L(DDPCK)<0 S DDPCK=$E(DDPCK,1,DDFNMAX-$L(DDFLE)-1)_"*"
        !            13:        Q
        !            14: SHORT  Q:$L(DDP)'>DDMAX  S DDPP=$L(DDP,":"),DD5=DDP I DDPP>1 S DD7=DDMAX-DDPP\DDPP,DD5=$E($P(DDP,":",1),1,DD7) F I=2:1:DDPP S DD5=DD5_":"_$E($P(DDP,":",I),1,DD7)
        !            15:        S DDP=$E(DD5,1,DDMAX-1)_"*" Q
        !            16: OUT    ;
        !            17:        W "->",$P(DDFPT," ",2) W " " S DDP=$S($O(^DD(DDFPT,0,"NM",0))]"":$O(^(0)),1:"*** NONEXISTENT FILE ***"),DDMAX=IOM-$X D SHORT W DDP,!
        !            18:        Q
        !            19: TO     S DDP="",(DDCR,DDINC)=0 Q:'$D(^UTILITY($J,"FD",DDFLE,"TO",DDLN))  S DDPT=$O(^(DDLN,"")),DDPTF=$O(^(DDPT,"")),DDA1=$S($D(^(DDPTF)):^(DDPTF),1:""),DDLN=DDLN+1 I DDPT'>0 S DDP="*** NONEXISTENT FILE ***" G TOOK
        !            20:        I '$D(^DD(DDPT)) S DDP="*** NONEXISTENT FILE ***" G TOOK
        !            21:        S DDPTF=+DDPTF,DDTO=DDPT,DDPP=$P(DDA1,U,1)
        !            22: TOUP   S DD5=$O(^DD(DDTO,0,"NM","")) I $D(^DD(DDTO,0,"UP")) S DDTO=^("UP") S:(DD5'=$P(DDPP,":",1)) DDPP=DD5_":"_DDPP G TOUP
        !            23:        S DDINC=$D(^UTILITY($J,"F",DDTO)),DDLGO=$P(DDA1,U,2)'["'",DDA1=$P(DDA1,U,2)["V" S:(DD5'=$P(DDPP,":",1)) DDPP=DD5_":"_DDPP
        !            24:        S DDCR=0,DD5="",DD7=DDPT,DDP=DDPP S:DD7?.E1"."2N DD7=+$P(DD7,".",1,$L(DD7,".")-1) F I=1:1 S DD5=$O(^DD(DD7,0,"IX",DD5)) Q:DD5=""  I $D(^DD(DD7,0,"IX",DD5,DDPT,DDPTF)) S DDCR=1
        !            25: TOOK   I $L(DDP)>0 S DDMAX=DDTB1-15,DD5=$P(DDP,":",1),DD7=DDP D EXT,SHORT S DDW=$S('DDINC:"N S",1:"N") W "  ",DDP," " W:DDA1 "v " D DOT W ?DDTB1-12,"(",DDW," " S:'$D(DDLGO) DDLGO=0 W:DDCR "C " W:DDLGO "L" W ")->"
        !            26:        Q
        !            27: DOT    F I=$L(DDP):1:DDTB1-18 W "."
        !            28:        Q
        !            29: EXT    ;
        !            30:        I DD5=DD9 S DDP="  "_$P(DDP,":",2,999),DDPT="" Q
        !            31:        W "  ",$S(IOST["C":$E(DD5,1,20),1:DD5)," (#",DDPT,")",?DDTB1,"|",?DDTB2,"|",!
        !            32:        S DDP="  "_$P(DD7,":",2,999),DD9=DD5,DDPT="" Q
        !            33: END    I $D(^UTILITY($J,"FD",DDFLE,"TO",DDLN)) D TO W:$X'>DDTB1 ?DDTB1,"|" W ?DDTB2,"|",! S DDOUT=1 D:$Y>DDMIOSL HDR^DDMAP2 G KILL^DDMAP:$D(DTOUT),END
        !            34:        I DDOUT S DDOUT=0 D VIIVA^DDMAP2 G NXF
        !            35:        S DDPCK=+$O(^UTILITY($J,"FD",DDFLE)) I '$D(^DD(DDPCK,0,"UP")) D VIIVA^DDMAP2
        !            36:        G NXF
        !            37:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>