DDMAP2 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;2/4/91 3:38 PM
;;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 ;Loop thru file selected and get to/from pointers
F DDFLE=0:0 S DDFLE=$O(^UTILITY($J,"F",DDFLE)) G:DDFLE'>0 ST D GETTO,GETFR
GETTO ;Look down "PT" X-ref to find files that point to me.
F DDPT=0:0 S DDPT=$O(^DD(DDFLE,0,"PT",DDPT)) Q:DDPT'>0 F DDPTF=0:0 S DDPTF=$O(^DD(DDFLE,0,"PT",DDPT,DDPTF)) Q:DDPTF'>0 D NOT I DDW D NOT1
Q
NOT1 S DDTO(DDFLE)=$S('$D(DDTO(DDFLE)):1,1:DDTO(DDFLE)+1) S ^UTILITY($J,"FD",DDFLE,"TO",DDTO(DDFLE),DDPT,DDPTF)=DDA1
Q
NOT S DDW=0 I $D(^DD(DDPT,DDPTF,0)) S DDA1=$P(^(0),U,1,2),X=$P(DDA1,U,2) S:(X[("P"_DDFLE))!(X["V") DDW=1 Q
Q
GETFR S DDPTF=DDFLE ;Look at all fields (and subs) to find pointers to others.
NXTF F DDPCK=0:0 S DDPCK=$O(^DD(DDPTF,DDPCK)) G:DDPCK'>0 SUB S DDA1=$P(^DD(DDPTF,DDPCK,0),U,1,2),DDA2=$P(DDA1,U,2) D SETF:DDA2?.E1"P"1N.E,SETV:DDA2["V"
Q
SUB F DDMAPC=0:0 S DDPTF=$O(^DD(DDPTF)) Q:'$D(^DD(DDPTF,0,"UP"))!(DDPTF'[DDFLE) D NXFLD
Q
NXFLD F DDPCK=0:0 S DDPCK=$O(^DD(DDPTF,DDPCK)) Q:DDPCK'>0 S DDA1=$P(^(DDPCK,0),U,1,2),DDA2=$P(DDA1,U,2) D SETF:DDA2?.E1"P"1N.E,SETV:DDA2["V"
Q
SETF S DDPT=+$P(DDA2,"P",2) S:DDPT ^UTILITY($J,"FD",DDFLE,"FR",DDPTF,DDPCK,DDPT)=DDA1
Q
SETV F X=0:0 S X=$O(^DD(DDPTF,DDPCK,"V",X)) Q:X'>0 S DDPT=$P(^(X,0),U),^UTILITY($J,"FD",DDFLE,"FR",DDPTF,DDPCK,DDPT)=$P(DDA1,U,1)_U_"V"_DDPT
Q
ST S DD9=0,DDFLE="",DDTB1=IOM\2,DDTB2=$S(IOM/4>30:30,1:IOM\4)+DDTB1,DDFNMAX=DDTB2-DDTB1-5,DDMIOSL=IOSL-4 D HDR G KILL^DDMAP:$D(DTOUT),^DDMAP1
VIIVA S DD5=$S($X<DDTB1:1,1:0) W:DD5 ?DDTB1,"-" W:'DD5 " " S DD5=$S(DD5:DDTB1,1:$X-1) F I=1:1:(DDTB2-DD5-1) W "-"
W "-",! Q
HDR I "C"[$E(IOST) R !,"Enter ""^"" to exit or return to continue: ",X:$S($D(DTIME):DTIME,1:300) I X="^"!'$T S DTOUT=1 Q
S Y=DT X ^DD("DD") W:$Y @IOF W !," File/Package: ",DDPCKN,?DDTB1+3,"Date: ",Y,!!
W " FILE (#)",?DDTB1-12,"POINTER"," (#) FILE",!," POINTER FIELD",?DDTB1-12," TYPE" W " POINTER FIELD",?DDTB2+1,"FILE POINTED TO",! F I=1:1:IOM W "-"
W !," L=Laygo S=File not in set N=Normal Ref. C=Xref.",!," *=Truncated m=Multiple v=Variable Pointer",!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDMAP2 2478 printed Dec 13, 2024@02:42:43 Page 2
DDMAP2 ;SFISC/JKS(Helsinki)-GRAPH OF FILEMAN PTRS ;2/4/91 3:38 PM
+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 ;Loop thru file selected and get to/from pointers
+1 FOR DDFLE=0:0
SET DDFLE=$ORDER(^UTILITY($JOB,"F",DDFLE))
if DDFLE'>0
GOTO ST
DO GETTO
DO GETFR
GETTO ;Look down "PT" X-ref to find files that point to me.
+1 FOR DDPT=0:0
SET DDPT=$ORDER(^DD(DDFLE,0,"PT",DDPT))
if DDPT'>0
QUIT
FOR DDPTF=0:0
SET DDPTF=$ORDER(^DD(DDFLE,0,"PT",DDPT,DDPTF))
if DDPTF'>0
QUIT
DO NOT
IF DDW
DO NOT1
+2 QUIT
NOT1 SET DDTO(DDFLE)=$SELECT('$DATA(DDTO(DDFLE)):1,1:DDTO(DDFLE)+1)
SET ^UTILITY($JOB,"FD",DDFLE,"TO",DDTO(DDFLE),DDPT,DDPTF)=DDA1
+1 QUIT
NOT SET DDW=0
IF $DATA(^DD(DDPT,DDPTF,0))
SET DDA1=$PIECE(^(0),U,1,2)
SET X=$PIECE(DDA1,U,2)
if (X[("P"_DDFLE))!(X["V")
SET DDW=1
QUIT
+1 QUIT
GETFR ;Look at all fields (and subs) to find pointers to others.
SET DDPTF=DDFLE
NXTF FOR DDPCK=0:0
SET DDPCK=$ORDER(^DD(DDPTF,DDPCK))
if DDPCK'>0
GOTO SUB
SET DDA1=$PIECE(^DD(DDPTF,DDPCK,0),U,1,2)
SET DDA2=$PIECE(DDA1,U,2)
if DDA2?.E1"P"1N.E
DO SETF
if DDA2["V"
DO SETV
+1 QUIT
SUB FOR DDMAPC=0:0
SET DDPTF=$ORDER(^DD(DDPTF))
if '$DATA(^DD(DDPTF,0,"UP"))!(DDPTF'[DDFLE)
QUIT
DO NXFLD
+1 QUIT
NXFLD FOR DDPCK=0:0
SET DDPCK=$ORDER(^DD(DDPTF,DDPCK))
if DDPCK'>0
QUIT
SET DDA1=$PIECE(^(DDPCK,0),U,1,2)
SET DDA2=$PIECE(DDA1,U,2)
if DDA2?.E1"P"1N.E
DO SETF
if DDA2["V"
DO SETV
+1 QUIT
SETF SET DDPT=+$PIECE(DDA2,"P",2)
if DDPT
SET ^UTILITY($JOB,"FD",DDFLE,"FR",DDPTF,DDPCK,DDPT)=DDA1
+1 QUIT
SETV FOR X=0:0
SET X=$ORDER(^DD(DDPTF,DDPCK,"V",X))
if X'>0
QUIT
SET DDPT=$PIECE(^(X,0),U)
SET ^UTILITY($JOB,"FD",DDFLE,"FR",DDPTF,DDPCK,DDPT)=$PIECE(DDA1,U,1)_U_"V"_DDPT
+1 QUIT
ST SET DD9=0
SET DDFLE=""
SET DDTB1=IOM\2
SET DDTB2=$SELECT(IOM/4>30:30,1:IOM\4)+DDTB1
SET DDFNMAX=DDTB2-DDTB1-5
SET DDMIOSL=IOSL-4
DO HDR
if $DATA(DTOUT)
GOTO KILL^DDMAP
GOTO ^DDMAP1
VIIVA SET DD5=$SELECT($X<DDTB1:1,1:0)
if DD5
WRITE ?DDTB1,"-"
if 'DD5
WRITE " "
SET DD5=$SELECT(DD5:DDTB1,1:$X-1)
FOR I=1:1:(DDTB2-DD5-1)
WRITE "-"
+1 WRITE "-",!
QUIT
HDR IF "C"[$EXTRACT(IOST)
READ !,"Enter ""^"" to exit or return to continue: ",X:$SELECT($DATA(DTIME):DTIME,1:300)
IF X="^"!'$TEST
SET DTOUT=1
QUIT
+1 SET Y=DT
XECUTE ^DD("DD")
if $Y
WRITE @IOF
WRITE !," File/Package: ",DDPCKN,?DDTB1+3,"Date: ",Y,!!
+2 WRITE " FILE (#)",?DDTB1-12,"POINTER"," (#) FILE",!," POINTER FIELD",?DDTB1-12," TYPE"
WRITE " POINTER FIELD",?DDTB2+1,"FILE POINTED TO",!
FOR I=1:1:IOM
WRITE "-"
+3 WRITE !," L=Laygo S=File not in set N=Normal Ref. C=Xref.",!," *=Truncated m=Multiple v=Variable Pointer",!!
+4 QUIT
