DDMAP1 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;22MAY2007
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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=$$FILENAME^DIALOGZ(DDFLE) D FSHORT
W ?DDTB1,"| ",DDFLE," ",DDPCK W ?DDTB2,"|",! S DDFL="" ;write File name and number in box
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=$$LABEL^DIALOGZ(DDFL,DDFLD)
NXUP I $D(^DD(DD5,0,"UP")) S DD5=^("UP"),DD7=$$FILENAME^DIALOGZ(DD5) 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=$$FILENAME^DIALOGZ(DDFPT) S:DDP="" DDP="*** NONEXISTENT FILE "_DDFPT_"***" S DDMAX=IOM-$X D SHORT W DDP,!
Q
;
;
TO N DDLGO ;WRITE LEFT SIDE OF BOX
S DDP="",(DDCR,DDINC)=0 Q:'$D(^UTILITY($J,"FD",DDFLE,"TO",DDLN))
S DDPT=$O(^(DDLN,"")),DDPTF=$O(^(DDPT,"")),DDA1=$$LABEL^DIALOGZ(DDPT,DDPTF)_U_$P(^DD(DDPT,DDPTF,0),U,2),DDLN=DDLN+1 I DDPT'>0 S DDP="*** NONEXISTENT FILE ***",DDTO="" G TOOK
I '$D(^DD(DDPT)) S DDP="*** NONEXISTENT FILE "_DDPT_"***" G TOOK
S DDPTF=+DDPTF,DDTO=DDPT,DDPP=$P(DDA1,U,1)
TOUP S DD5=$$FILENAME^DIALOGZ(DDTO) 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 Q:DDP=""
S DDMAX=DDTB1-15,DD5=$P(DDP,":",1),DD7=DDP D D SHORT
.I DD5=DD9 S DDP=" "_$P(DDP,":",2,999),DDPT="" Q
.W " ",$S(IOST["C":$E(DD5,1,20),1:DD5)," (#",DDTO,")",?DDTB1,"|",?DDTB2,"|",!
.S DDP=" "_$P(DD7,":",2,999),DD9=DD5,DDPT="" Q
S DDW=$S('DDINC:"N S",1:"N") D
.W " ",DDP," " W:DDA1 "v " D W ?DDTB1-12,"(",DDW," " S:'$D(DDLGO) DDLGO=0 W:DDCR "C " W:DDLGO "L" W ")->"
..F I=$L(DDP):1:DDTB1-18 W "."
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDMAP1 3371 printed Dec 13, 2024@02:42:42 Page 2
DDMAP1 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;22MAY2007
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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=$$FILENAME^DIALOGZ(DDFLE)
DO FSHORT
+2 ;write File name and number in box
WRITE ?DDTB1,"| ",DDFLE," ",DDPCK
WRITE ?DDTB2,"|",!
SET DDFL=""
+3 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=$$LABEL^DIALOGZ(DDFL,DDFLD)
NXUP IF $DATA(^DD(DD5,0,"UP"))
SET DD5=^("UP")
SET DD7=$$FILENAME^DIALOGZ(DD5)
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=$$FILENAME^DIALOGZ(DDFPT)
if DDP=""
SET DDP="*** NONEXISTENT FILE "_DDFPT_"***"
SET DDMAX=IOM-$X
DO SHORT
WRITE DDP,!
+2 QUIT
+3 ;
+4 ;
TO ;WRITE LEFT SIDE OF BOX
NEW DDLGO
+1 SET DDP=""
SET (DDCR,DDINC)=0
if '$DATA(^UTILITY($JOB,"FD",DDFLE,"TO",DDLN))
QUIT
+2 SET DDPT=$ORDER(^(DDLN,""))
SET DDPTF=$ORDER(^(DDPT,""))
SET DDA1=$$LABEL^DIALOGZ(DDPT,DDPTF)_U_$PIECE(^DD(DDPT,DDPTF,0),U,2)
SET DDLN=DDLN+1
IF DDPT'>0
SET DDP="*** NONEXISTENT FILE ***"
SET DDTO=""
GOTO TOOK
+3 IF '$DATA(^DD(DDPT))
SET DDP="*** NONEXISTENT FILE "_DDPT_"***"
GOTO TOOK
+4 SET DDPTF=+DDPTF
SET DDTO=DDPT
SET DDPP=$PIECE(DDA1,U,1)
TOUP SET DD5=$$FILENAME^DIALOGZ(DDTO)
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)
+3 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 DDP=""
QUIT
+1 SET DDMAX=DDTB1-15
SET DD5=$PIECE(DDP,":",1)
SET DD7=DDP
Begin DoDot:1
+2 IF DD5=DD9
SET DDP=" "_$PIECE(DDP,":",2,999)
SET DDPT=""
QUIT
+3 WRITE " ",$SELECT(IOST["C":$EXTRACT(DD5,1,20),1:DD5)," (#",DDTO,")",?DDTB1,"|",?DDTB2,"|",!
+4 SET DDP=" "_$PIECE(DD7,":",2,999)
SET DD9=DD5
SET DDPT=""
QUIT
End DoDot:1
DO SHORT
+5 SET DDW=$SELECT('DDINC:"N S",1:"N")
Begin DoDot:1
+6 WRITE " ",DDP," "
if DDA1
WRITE "v "
Begin DoDot:2
+7 FOR I=$LENGTH(DDP):1:DDTB1-18
WRITE "."
End DoDot:2
WRITE ?DDTB1-12,"(",DDW," "
if '$DATA(DDLGO)
SET DDLGO=0
if DDCR
WRITE "C "
if DDLGO
WRITE "L"
WRITE ")->"
End DoDot:1
+8 QUIT
+9 ;
+10 ;
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
