- DDMAP1 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;5/3/91 8:19 AM
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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)
- 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)
- NXFL S DDFL=$O(^UTILITY($J,"FD",DDFLE,"FR",DDFL)),DDFLD=0 I DDFL="" G END
- 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)
- NXUP I $D(^DD(DD5,0,"UP")) S DD5=^("UP"),DD7=$O(^("NM","")) S:(DD5'=$P(DDFRN,":",1)) DDFRN=DD7_":"_DDFRN G NXUP
- NXPT S DDFPT=$O(^UTILITY($J,"FD",DDFLE,"FR",DDFL,DDFLD,DDFPT)) G NXFLD:DDFPT'>0 S DDA2=^(DDFPT) D TO
- 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)
- G NXPT
- FSHORT I DDFNMAX-$L(DDFLE)-$L(DDPCK)<0 S DDPCK=$E(DDPCK,1,DDFNMAX-$L(DDFLE)-1)_"*"
- Q
- 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)
- S DDP=$E(DD5,1,DDMAX-1)_"*" Q
- OUT ;
- 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,!
- Q
- 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
- I '$D(^DD(DDPT)) S DDP="*** NONEXISTENT FILE ***" G TOOK
- S DDPTF=+DDPTF,DDTO=DDPT,DDPP=$P(DDA1,U,1)
- 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
- 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
- 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
- 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 ")->"
- Q
- DOT F I=$L(DDP):1:DDTB1-18 W "."
- Q
- EXT ;
- I DD5=DD9 S DDP=" "_$P(DDP,":",2,999),DDPT="" Q
- W " ",$S(IOST["C":$E(DD5,1,20),1:DD5)," (#",DDPT,")",?DDTB1,"|",?DDTB2,"|",!
- S DDP=" "_$P(DD7,":",2,999),DD9=DD5,DDPT="" Q
- 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
- I DDOUT S DDOUT=0 D VIIVA^DDMAP2 G NXF
- S DDPCK=+$O(^UTILITY($J,"FD",DDFLE)) I '$D(^DD(DDPCK,0,"UP")) D VIIVA^DDMAP2
- G NXF
- Q
- DDMAP1 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;5/3/91 8:19 AM
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- NXF SET DDFLE=$ORDER(^UTILITY($JOB,"FD",DDFLE))
- IF DDFLE'>0
- GOTO EXIT2^DDMAP
- SET DDLN=1
- SET DDOUT=0
- SET DD9=0
- IF $Y>DDMIOSL
- DO HDR^DDMAP2
- IF $DATA(DTOUT)
- GOTO KILL^DDMAP
- +1 DO VIIVA^DDMAP2
- DO TO
- SET DDPCK=$ORDER(^DD(DDFLE,0,"NM",""))
- DO FSHORT
- WRITE ?DDTB1,"| ",DDFLE," ",DDPCK
- WRITE ?DDTB2,"|",!
- SET DDFL=""
- IF $Y>DDMIOSL
- DO HDR^DDMAP2
- IF $DATA(DTOUT)
- GOTO KILL^DDMAP
- NXFL SET DDFL=$ORDER(^UTILITY($JOB,"FD",DDFLE,"FR",DDFL))
- SET DDFLD=0
- IF DDFL=""
- GOTO END
- NXFLD SET DDFLD=$ORDER(^UTILITY($JOB,"FD",DDFLE,"FR",DDFL,DDFLD))
- SET DDFPT=0
- SET DD5=DDFL
- IF DDFLD'>0
- GOTO NXFL
- SET DDFRN=$PIECE(^DD(DDFL,DDFLD,0),U,1)
- NXUP IF $DATA(^DD(DD5,0,"UP"))
- SET DD5=^("UP")
- SET DD7=$ORDER(^("NM",""))
- IF (DD5'=$PIECE(DDFRN,"
- SET DDFRN=DD7_":"_DDFRN
- GOTO NXUP
- NXPT SET DDFPT=$ORDER(^UTILITY($JOB,"FD",DDFLE,"FR",DDFL,DDFLD,DDFPT))
- IF DDFPT'>0
- GOTO NXFLD
- SET DDA2=^(DDFPT)
- DO TO
- REV SET DDA1=$SELECT($PIECE(DDA2,U,2)["M":"m",1:"")
- SET DDA2=$SELECT($PIECE(DDA2,U,2)["V":"v",1:"")
- SET DDMAX=DDFNMAX
- SET DDP=DDFRN
- DO SHORT
- WRITE ?DDTB1,"| "
- IF DDP]""
- WRITE DDA2,DDA1,?DDTB1+4,DDP
- WRITE ?DDTB2,"|"
- DO OUT
- SET DDFRN=""
- IF $Y>DDMIOSL
- DO HDR^DDMAP2
- IF $DATA(DTOUT)
- GOTO KILL^DDMAP
- +1 GOTO NXPT
- FSHORT IF DDFNMAX-$LENGTH(DDFLE)-$LENGTH(DDPCK)<0
- SET DDPCK=$EXTRACT(DDPCK,1,DDFNMAX-$LENGTH(DDFLE)-1)_"*"
- +1 QUIT
- SHORT IF $LENGTH(DDP)'>DDMAX
- QUIT
- SET DDPP=$LENGTH(DDP,":")
- SET DD5=DDP
- IF DDPP>1
- SET DD7=DDMAX-DDPP\DDPP
- SET DD5=$EXTRACT($PIECE(DDP,":",1),1,DD7)
- FOR I=2:1:DDPP
- SET DD5=DD5_":"_$EXTRACT($PIECE(DDP,":",I),1,DD7)
- +1 SET DDP=$EXTRACT(DD5,1,DDMAX-1)_"*"
- QUIT
- OUT ;
- +1 WRITE "->",$PIECE(DDFPT," ",2)
- WRITE " "
- SET DDP=$SELECT($ORDER(^DD(DDFPT,0,"NM",0))]"":$ORDER(^(0)),1:"*** NONEXISTENT FILE ***")
- SET DDMAX=IOM-$X
- DO SHORT
- WRITE DDP,!
- +2 QUIT
- TO SET DDP=""
- SET (DDCR,DDINC)=0
- IF '$DATA(^UTILITY($JOB,"FD",DDFLE,"TO",DDLN))
- QUIT
- SET DDPT=$ORDER(^(DDLN,""))
- SET DDPTF=$ORDER(^(DDPT,""))
- SET DDA1=$SELECT($DATA(^(DDPTF)):^(DDPTF),1:"")
- SET DDLN=DDLN+1
- IF DDPT'>0
- SET DDP="*** NONEXISTENT FILE ***"
- GOTO TOOK
- +1 IF '$DATA(^DD(DDPT))
- SET DDP="*** NONEXISTENT FILE ***"
- GOTO TOOK
- +2 SET DDPTF=+DDPTF
- SET DDTO=DDPT
- SET DDPP=$PIECE(DDA1,U,1)
- TOUP SET DD5=$ORDER(^DD(DDTO,0,"NM",""))
- IF $DATA(^DD(DDTO,0,"UP"))
- SET DDTO=^("UP")
- IF (DD5'=$PIECE(DDPP,"
- SET DDPP=DD5_":"_DDPP
- GOTO TOUP
- +1 SET DDINC=$DATA(^UTILITY($JOB,"F",DDTO))
- SET DDLGO=$PIECE(DDA1,U,2)'["'"
- SET DDA1=$PIECE(DDA1,U,2)["V"
- IF (DD5'=$PIECE(DDPP,"
- SET DDPP=DD5_":"_DDPP
- +2 SET DDCR=0
- SET DD5=""
- SET DD7=DDPT
- SET DDP=DDPP
- IF DD7?.E1"."2N
- SET DD7=+$PIECE(DD7,".",1,$LENGTH(DD7,".")-1)
- FOR I=1:1
- SET DD5=$ORDER(^DD(DD7,0,"IX",DD5))
- IF DD5=""
- QUIT
- IF $DATA(^DD(DD7,0,"IX",DD5,DDPT,DDPTF))
- SET DDCR=1
- TOOK IF $LENGTH(DDP)>0
- SET DDMAX=DDTB1-15
- SET DD5=$PIECE(DDP,":",1)
- SET DD7=DDP
- DO EXT
- DO SHORT
- SET DDW=$SELECT('DDINC:"N S",1:"N")
- WRITE " ",DDP," "
- IF DDA1
- WRITE "v "
- DO DOT
- WRITE ?DDTB1-12,"(",DDW," "
- IF '$DATA(DDLGO)
- SET DDLGO=0
- IF DDCR
- WRITE "C "
- IF DDLGO
- WRITE "L"
- WRITE ")->"
- +1 QUIT
- DOT FOR I=$LENGTH(DDP):1:DDTB1-18
- WRITE "."
- +1 QUIT
- EXT ;
- +1 IF DD5=DD9
- SET DDP=" "_$PIECE(DDP,":",2,999)
- SET DDPT=""
- QUIT
- +2 WRITE " ",$SELECT(IOST["C":$EXTRACT(DD5,1,20),1:DD5)," (#",DDPT,")",?DDTB1,"|",?DDTB2,"|",!
- +3 SET DDP=" "_$PIECE(DD7,":",2,999)
- SET DD9=DD5
- SET DDPT=""
- QUIT
- END IF $DATA(^UTILITY($JOB,"FD",DDFLE,"TO",DDLN))
- DO TO
- IF $X'>DDTB1
- WRITE ?DDTB1,"|"
- WRITE ?DDTB2,"|",!
- SET DDOUT=1
- IF $Y>DDMIOSL
- DO HDR^DDMAP2
- IF $DATA(DTOUT)
- GOTO KILL^DDMAP
- GOTO END
- +1 IF DDOUT
- SET DDOUT=0
- DO VIIVA^DDMAP2
- GOTO NXF
- +2 SET DDPCK=+$ORDER(^UTILITY($JOB,"FD",DDFLE))
- IF '$DATA(^DD(DDPCK,0,"UP"))
- DO VIIVA^DDMAP2
- +3 GOTO NXF
- +4 QUIT
