DMSQP3 ;SFISC/EZ-DISPLAY POINTER COUNTS ;10/30/97 17:42
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
EN ; show individual table counts of links
S DMQ="" D OK I DMQ K DMQ Q
D PREASK I $D(DIRUT)!(DMQ) K DMQ Q
D DT^DICRW,HOME^%ZIS
D ASK D:'DMQ ASK1 D:'DMQ CLEAR,PAIRS,CNT,BUILD,PRT D EXIT Q
EN1 ; show summary counts of table links
S DMQ="" D OK I DMQ K DMQ Q
D PREASK I $D(DIRUT)!(DMQ) K DMQ Q
D DT^DICRW,HOME^%ZIS D D EXIT
. D ASK2 Q:DMQ D CLEAR,PAIRS,CNT,BUILD,TOTS
. S DMDHD=$S(DMYN:"LISTING",1:"COUNTS")
. S DMFLDS=$S(DMYN:"!INTERNAL(#6);"""",.01;""""",1:"!(#.01);""""")
. S DMANS=""
. F D MENU Q:$D(DIRUT) D READ Q:$D(DIRUT)!(DMANS=9) D
.. D:DMANS=1 PRT3^DMSQP4
.. D:DMANS=2 PRT4^DMSQP4
.. D:DMANS=3 PRT5^DMSQP4
.. D:DMANS=4 PRT6^DMSQP4
.. D:DMANS=5 PRT7^DMSQP4
.. ; word-processing tables could be done calling PRT2^DMSQP4,
.. ; see commented code in BUILD for some ideas about how.
Q
S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT) W @IOF
W !!!!!?9,"(1) SELF Tables with Self-referential Pointers"
W !?9,"(2) UP Tables with Upward Links"
W !?9,"(3) DOWN Tables Linked from Below"
W !?9,"(4) OUT Tables Pointing Outward"
W !?9,"(5) IN Tables with Incoming Pointers"
W !!?9,"(9) QUIT Exit this Menu"
W !! Q
READ ; reader for the menu
S DIR(0)="SMA^1:SELF;2:UP;3:DOWN;4:OUT;5:IN;9:QUIT"
S DIR("A")="Select a report: " D ^DIR S DMANS=Y K DIR
Q
EXIT K DOT,DMANS,DMFILE,DMWP,DMFK,DMPFK,DMSR,DME,DMF,DMCOL,DMDM,DMYN
K DMX,DMY,DMCT,DMBFK,DMBPFK,DMQ,DMFN,DMFN1,DMTBL,DMCI,DMEI,DMDI
K DM1,DM2,DM3,DM4,DM5,DM6,DM7,DMDHD,DMFLDS
K DMC1,DMC2,DMC3,DMC4,DMC5,DMC6,DMC7
K DMCN2,DMCN3,DMCN4,DMCN5,DMCN6,DMCN7,DMCN8
CLEAR K ^TMP("DM",$J),^TMP("DMT",$J),^TMP("DMTN",$J)
K ^TMP("DMP1",$J),^TMP("DMP2",$J)
K ^TMP("DMCT1",$J),^TMP("DMCT2",$J),^TMP("DMFQ2",$J),^TMP("DMFQ3",$J)
K ^TMP("DMFQ4",$J),^TMP("DMFQ5",$J),^TMP("DMFQ6",$J),^TMP("DMFQ7",$J)
Q
OK ; check of okay to run
I '$O(^DMSQ("S",0)) W !?5,"Sorry, SQLI files are empty.",! S DMQ=1 Q
I $$WAIT^DMSQT1 D S DMQ=1 Q
. W !?5,"Try later. SQLI is being re-built right now."
Q
PREASK ; confirm that it's okay to wait for interactive processing
S DIR(0)="Y",DIR("A")="This can take 1-2 minutes. Continue"
S DIR("B")="NO" D ^DIR K DIR S:Y=0 DMQ=1
Q
ASK ; select file numbers
S DM1=$O(^DMSQ("T","C",0)),DM2=$O(^DMSQ("T","C",99999999999),-1)
S DIR(0)="NO^"_DM1_":"_DM2_":999999999",DIR("A")="Starting File Number"
S DIR("?")="Enter the number of the file, e.g. 200 or 1.5215"
S DIR("B")=.401 D ^DIR S:$D(DIRUT) DMQ=1 K DIR Q:DMQ S DMFN=Y
I '$D(^DMSQ("T","C",DMFN)) W !,"SQLI table not found." G ASK
Q
ASK1 S DIR("B")=DMFN ; default to one file (not a range)
S DIR(0)="NO^"_DM1_":"_DM2_":999999999",DIR("A")=" Ending File Number"
S DIR("?")="Optionally enter a larger number for a range, e.g. 1.5217"
D ^DIR S:$D(DTOUT)!$D(DUOUT) DMQ=1 K DIR Q:DMQ S DMFN1=Y
I '$D(^DMSQ("T","C",DMFN1)) D G ASK1
. W !!?5,"There isn't a table for the file number you've entered."
. W !?5,"(The highest possible number is "_DM2_".)",!
I DMFN1'=DMFN,DMFN1'>DMFN D G ASK1
. W !!?5,"Enter a LARGER number to get a range."
. W !?5,"The highest possible number here is "_DM2_".",!
Q
ASK2 ; prompt for style of listing (summary counts or detail)
S DIR("A")="These reports show counts. Or would you prefer details"
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR S DMYN=Y S:$D(DIRUT) DMQ=1
Q
BUILD ;
S (DOT,DMFILE)=0
F S DMFILE=$O(^DMSQ("T","C",DMFILE)) Q:DMFILE'>0 D
. S DOT=DOT+1 W:DOT#20=1 "."
. S (DMWP,DMFK,DMPFK,DMSR)=0,DMX=$O(^DMSQ("T","C",DMFILE,0))
. I '$D(^DMSQ("E","F",DMX,"F")) D DEFINE Q
. ;word-processing domains are character, so DMWP never set
. ;perhaps use dbs field retriever to get type (e.g. wp)
. ;S DMCI=$O(^DMSQ("C","D",DMFILE,.01,0)) D:DMCI
. ;. S DMEI=$P(^DMSQ("C",DMCI,0),U,1)
. ;. S DMDI=$P(^DMSQ("E",DMEI,0),U,2)
. ;. S:DMDI=$O(^DMSQ("DM","B","WORD_PROCESSING",0)) DMWP=DMWP+1
. S DME=0 F S DME=$O(^DMSQ("E","F",DMX,"F",DME)) Q:DME'>0 D
.. S DMF=$O(^DMSQ("F","B",DME,0))
.. S DMCOL=$P(^DMSQ("F",DMF,0),U,3)
.. S:$P(^DMSQ("C",DMCOL,0),U,5) DMFK=DMFK+1
.. S:'$P(^DMSQ("C",DMCOL,0),U,5) DMPFK=DMPFK+1
.. S DMDM=$P(^DMSQ("E",DME,0),U,2)
.. S DMY=$P(^DMSQ("DM",DMDM,0),U,4)
.. S:DMX=DMY DMSR=DMSR+1
.. D:$O(^DMSQ("E","F",DMX,"F",DME))="" DEFINE
Q
DEFINE ;
S DMBFK=0 S:$D(^TMP("DMCT1",$J,DMX))=1 DMBFK=^(DMX)
S DMBPFK=0 S:$D(^TMP("DMCT2",$J,DMX))=1 DMBPFK=^(DMX)
S ^TMP("DM",$J,DMFILE,DMWP,DMSR,DMPFK,DMBPFK,DMFK,DMBFK,DMX)=""
Q
TOTS ;
S (DOT,DM1,DMC1,DMC2,DMC3,DMC4,DMC5,DMC6,DMC7)=0
S (DMCN2,DMCN3,DMCN4,DMCN5,DMCN6,DMCN7,DMCN8)=0
F S DM1=$O(^TMP("DM",$J,DM1)) Q:DM1="" D
. S DOT=DOT+1 W:DOT#20=1 "."
. S DMTBL=$O(^DMSQ("T","C",DM1,0)),DMC1=DMC1+1,DM2=""
. F S DM2=$O(^TMP("DM",$J,DM1,DM2)) Q:DM2="" D
.. S ^TMP("DMFQ2",$J,999-DM2,DM2,DMTBL)=""
.. S:DM2 DMCN2=DMCN2+1 S DMC2=DMC2+DM2,DM3=""
.. F S DM3=$O(^TMP("DM",$J,DM1,DM2,DM3)) Q:DM3="" D
... S ^TMP("DMFQ3",$J,9999-DM3,DM3,DMTBL)=""
... S:DM3 DMCN3=DMCN3+1 S DMC3=DMC3+DM3,DM4=""
... F S DM4=$O(^TMP("DM",$J,DM1,DM2,DM3,DM4)) Q:DM4="" D
.... S ^TMP("DMFQ4",$J,DM2,9999-DM4,DM4,DMTBL)=""
.... S:DM4 DMCN4=DMCN4+1 S DMC4=DMC4+DM4,DM5=""
.... F S DM5=$O(^TMP("DM",$J,DM1,DM2,DM3,DM4,DM5)) Q:DM5="" D
..... S ^TMP("DMFQ5",$J,9999-DM5,DM5,DMTBL)=""
..... S:DM5 DMCN5=DMCN5+1 S DMC5=DMC5+DM5,DM6=""
..... F S DM6=$O(^TMP("DM",$J,DM1,DM2,DM3,DM4,DM5,DM6)) Q:DM6="" D
...... S ^TMP("DMFQ6",$J,9999-DM6,DM6,DMTBL)=""
...... S:DM6 DMCN6=DMCN6+1 S DMC6=DMC6+DM6,DM7=""
...... F S DM7=$O(^TMP("DM",$J,DM1,DM2,DM3,DM4,DM5,DM6,DM7)) Q:DM7="" D
....... S ^TMP("DMFQ7",$J,9999-DM7,DM7,DMTBL)=""
....... S:DM7 DMCN7=DMCN7+1 S DMC7=DMC7+DM7
....... S:'(DM4+DM5+DM6+DM7) DMCN8=DMCN8+1
S ^TMP("DMTN",$J,DMC1,DMCN2,DMCN3,DMCN4,DMCN5,DMCN6,DMCN7,DMCN8)=""
S ^TMP("DMT",$J,DMC1,DMC2,DMC3,DMC4,DMC5,DMC6,DMC7)=""
Q
PAIRS ; build array with to-table and from-tables that point
S (DOT,DMFILE)=0 W !,"Please wait..."
F S DMFILE=$O(^DMSQ("T","C",DMFILE)) Q:DMFILE'>0 D
. S DOT=DOT+1 W:DOT#20=1 "."
. S DMX=$O(^DMSQ("T","C",DMFILE,0))
. S DME=0 F S DME=$O(^DMSQ("E","F",DMX,"F",DME)) Q:DME'>0 D
.. S DMDM=$P(^DMSQ("E",DME,0),U,2)
.. S DMY=$P(^DMSQ("DM",DMDM,0),U,4)
.. S DMF=$O(^DMSQ("F","B",DME,0)) ; get foreign key ien
.. S DMCOL=$P(^DMSQ("F",DMF,0),U,3) ; get column pointer
.. I $P(^DMSQ("C",DMCOL,0),U,5) S ^TMP("DMP1",$J,DMY,DMX,DMF)=""
.. E S ^TMP("DMP2",$J,DMY,DMX)=""
Q
CNT ; get reference counts
S DM1=0 W "." F S DM1=$O(^TMP("DMP1",$J,DM1)) Q:DM1'>0 D
. S (DM2,DMCT)=0
. F S DM2=$O(^TMP("DMP1",$J,DM1,DM2)) Q:DM2'>0 D
.. S DM3=0
.. F S DM3=$O(^TMP("DMP1",$J,DM1,DM2,DM3)) Q:DM3'>0 S DMCT=DMCT+1
.. S ^TMP("DMCT1",$J,DM1)=DMCT
S DM1=0 F S DM1=$O(^TMP("DMP2",$J,DM1)) Q:DM1'>0 D
. S (DM2,DMCT)=0
. F S DM2=$O(^TMP("DMP2",$J,DM1,DM2)) Q:DM2'>0 S DMCT=DMCT+1
. S ^TMP("DMCT2",$J,DM1)=DMCT
Q
PRT ;
S DIC="1.5215",L=0,DHD="SQLI TABLE POINTER COUNTS"
S FLDS="""SQLI TABLE NAME: "";C28;S,.01;X"
S BY(0)="^TMP(""DM"",$J,",L(0)=8,FR(0,1)=DMFN,TO(0,1)=DMFN1
S DISPAR(0,1)="^;""FILE/SUBFILE: "";C1;S"
S DISPAR(0,1,"OUT")="S Y=Y_"" ""_$S($D(^DIC(Y)):$P(^(Y,0),U),1:$O(^DD(Y,0,""NM"",0)))"
;S DISPAR(0,2)="^;""WORD-PROCESSING TABLE? "";C50"
;S DISPAR(0,2,"OUT")="S Y=$S(+Y:""YES"",1:""NO"")"
S DISPAR(0,3)="^;""SELF-REFERENTIAL POINTERS: "";C18"
S DISPAR(0,4)="^;""POINTERS DOWNWARD TO THIS SUBFILE: "";C10;S"
S DISPAR(0,5)="^;""POINTERS UPWARD FROM DEEPER SUBFILES: "";C7"
S DISPAR(0,6)="^;""POINTERS OUTWARD TO OTHER FILES: "";C12;S"
S DISPAR(0,7)="^;""POINTERS INWARD FROM OTHER FILES: "";C11"
D EN1^DIP Q
DMSQP3 ;SFISC/EZ-DISPLAY POINTER COUNTS ;10/30/97 17:42
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
EN ; show individual table counts of links
+1 SET DMQ=""
DO OK
IF DMQ
KILL DMQ
QUIT
+2 DO PREASK
IF $DATA(DIRUT)!(DMQ)
KILL DMQ
QUIT
+3 DO DT^DICRW
DO HOME^%ZIS
+4 DO ASK
IF 'DMQ
DO ASK1
IF 'DMQ
DO CLEAR
DO PAIRS
DO CNT
DO BUILD
DO PRT
DO EXIT
QUIT
EN1 ; show summary counts of table links
+1 SET DMQ=""
DO OK
IF DMQ
KILL DMQ
QUIT
+2 DO PREASK
IF $DATA(DIRUT)!(DMQ)
KILL DMQ
QUIT
+3 DO DT^DICRW
DO HOME^%ZIS
Begin DoDot:1
+4 DO ASK2
IF DMQ
QUIT
DO CLEAR
DO PAIRS
DO CNT
DO BUILD
DO TOTS
+5 SET DMDHD=$SELECT(DMYN:"LISTING",1:"COUNTS")
+6 SET DMFLDS=$SELECT(DMYN:"!INTERNAL(#6);"""",.01;""""",1:"!(#.01);""""")
+7 SET DMANS=""
+8 FOR
DO MENU
IF $DATA(DIRUT)
QUIT
DO READ
IF $DATA(DIRUT)!(DMANS=9)
QUIT
Begin DoDot:2
+9 IF DMANS=1
DO PRT3^DMSQP4
+10 IF DMANS=2
DO PRT4^DMSQP4
+11 IF DMANS=3
DO PRT5^DMSQP4
+12 IF DMANS=4
DO PRT6^DMSQP4
+13 IF DMANS=5
DO PRT7^DMSQP4
+14 ; word-processing tables could be done calling PRT2^DMSQP4,
+15 ; see commented code in BUILD for some ideas about how.
End DoDot:2
End DoDot:1
DO EXIT
+16 QUIT
+1 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
WRITE @IOF
+2 WRITE !!!!!?9,"(1) SELF Tables with Self-referential Pointers"
+3 WRITE !?9,"(2) UP Tables with Upward Links"
+4 WRITE !?9,"(3) DOWN Tables Linked from Below"
+5 WRITE !?9,"(4) OUT Tables Pointing Outward"
+6 WRITE !?9,"(5) IN Tables with Incoming Pointers"
+7 WRITE !!?9,"(9) QUIT Exit this Menu"
+8 WRITE !!
QUIT
READ ; reader for the menu
+1 SET DIR(0)="SMA^1:SELF;2:UP;3:DOWN;4:OUT;5:IN;9:QUIT"
+2 SET DIR("A")="Select a report: "
DO ^DIR
SET DMANS=Y
KILL DIR
+3 QUIT
EXIT KILL DOT,DMANS,DMFILE,DMWP,DMFK,DMPFK,DMSR,DME,DMF,DMCOL,DMDM,DMYN
+1 KILL DMX,DMY,DMCT,DMBFK,DMBPFK,DMQ,DMFN,DMFN1,DMTBL,DMCI,DMEI,DMDI
+2 KILL DM1,DM2,DM3,DM4,DM5,DM6,DM7,DMDHD,DMFLDS
+3 KILL DMC1,DMC2,DMC3,DMC4,DMC5,DMC6,DMC7
+4 KILL DMCN2,DMCN3,DMCN4,DMCN5,DMCN6,DMCN7,DMCN8
CLEAR KILL ^TMP("DM",$JOB),^TMP("DMT",$JOB),^TMP("DMTN",$JOB)
+1 KILL ^TMP("DMP1",$JOB),^TMP("DMP2",$JOB)
+2 KILL ^TMP("DMCT1",$JOB),^TMP("DMCT2",$JOB),^TMP("DMFQ2",$JOB),^TMP("DMFQ3",$JOB)
+3 KILL ^TMP("DMFQ4",$JOB),^TMP("DMFQ5",$JOB),^TMP("DMFQ6",$JOB),^TMP("DMFQ7",$JOB)
+4 QUIT
OK ; check of okay to run
+1 IF '$ORDER(^DMSQ("S",0))
WRITE !?5,"Sorry, SQLI files are empty.",!
SET DMQ=1
QUIT
+2 IF $$WAIT^DMSQT1
Begin DoDot:1
+3 WRITE !?5,"Try later. SQLI is being re-built right now."
End DoDot:1
SET DMQ=1
QUIT
+4 QUIT
PREASK ; confirm that it's okay to wait for interactive processing
+1 SET DIR(0)="Y"
SET DIR("A")="This can take 1-2 minutes. Continue"
+2 SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y=0
SET DMQ=1
+3 QUIT
ASK ; select file numbers
+1 SET DM1=$ORDER(^DMSQ("T","C",0))
SET DM2=$ORDER(^DMSQ("T","C",99999999999),-1)
+2 SET DIR(0)="NO^"_DM1_":"_DM2_":999999999"
SET DIR("A")="Starting File Number"
+3 SET DIR("?")="Enter the number of the file, e.g. 200 or 1.5215"
+4 SET DIR("B")=.401
DO ^DIR
IF $DATA(DIRUT)
SET DMQ=1
KILL DIR
IF DMQ
QUIT
SET DMFN=Y
+5 IF '$DATA(^DMSQ("T","C",DMFN))
WRITE !,"SQLI table not found."
GOTO ASK
+6 QUIT
ASK1 ; default to one file (not a range)
SET DIR("B")=DMFN
+1 SET DIR(0)="NO^"_DM1_":"_DM2_":999999999"
SET DIR("A")=" Ending File Number"
+2 SET DIR("?")="Optionally enter a larger number for a range, e.g. 1.5217"
+3 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET DMQ=1
KILL DIR
IF DMQ
QUIT
SET DMFN1=Y
+4 IF '$DATA(^DMSQ("T","C",DMFN1))
Begin DoDot:1
+5 WRITE !!?5,"There isn't a table for the file number you've entered."
+6 WRITE !?5,"(The highest possible number is "_DM2_".)",!
End DoDot:1
GOTO ASK1
+7 IF DMFN1'=DMFN
IF DMFN1'>DMFN
Begin DoDot:1
+8 WRITE !!?5,"Enter a LARGER number to get a range."
+9 WRITE !?5,"The highest possible number here is "_DM2_".",!
End DoDot:1
GOTO ASK1
+10 QUIT
ASK2 ; prompt for style of listing (summary counts or detail)
+1 SET DIR("A")="These reports show counts. Or would you prefer details"
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
SET DMYN=Y
IF $DATA(DIRUT)
SET DMQ=1
+3 QUIT
BUILD ;
+1 SET (DOT,DMFILE)=0
+2 FOR
SET DMFILE=$ORDER(^DMSQ("T","C",DMFILE))
IF DMFILE'>0
QUIT
Begin DoDot:1
+3 SET DOT=DOT+1
IF DOT#20=1
WRITE "."
+4 SET (DMWP,DMFK,DMPFK,DMSR)=0
SET DMX=$ORDER(^DMSQ("T","C",DMFILE,0))
+5 IF '$DATA(^DMSQ("E","F",DMX,"F"))
DO DEFINE
QUIT
+6 ;word-processing domains are character, so DMWP never set
+7 ;perhaps use dbs field retriever to get type (e.g. wp)
+8 ;S DMCI=$O(^DMSQ("C","D",DMFILE,.01,0)) D:DMCI
+9 ;. S DMEI=$P(^DMSQ("C",DMCI,0),U,1)
+10 ;. S DMDI=$P(^DMSQ("E",DMEI,0),U,2)
+11 ;. S:DMDI=$O(^DMSQ("DM","B","WORD_PROCESSING",0)) DMWP=DMWP+1
+12 SET DME=0
FOR
SET DME=$ORDER(^DMSQ("E","F",DMX,"F",DME))
IF DME'>0
QUIT
Begin DoDot:2
+13 SET DMF=$ORDER(^DMSQ("F","B",DME,0))
+14 SET DMCOL=$PIECE(^DMSQ("F",DMF,0),U,3)
+15 IF $PIECE(^DMSQ("C",DMCOL,0),U,5)
SET DMFK=DMFK+1
+16 IF '$PIECE(^DMSQ("C",DMCOL,0),U,5)
SET DMPFK=DMPFK+1
+17 SET DMDM=$PIECE(^DMSQ("E",DME,0),U,2)
+18 SET DMY=$PIECE(^DMSQ("DM",DMDM,0),U,4)
+19 IF DMX=DMY
SET DMSR=DMSR+1
+20 IF $ORDER(^DMSQ("E","F",DMX,"F",DME))=""
DO DEFINE
End DoDot:2
End DoDot:1
+21 QUIT
DEFINE ;
+1 SET DMBFK=0
IF $DATA(^TMP("DMCT1",$JOB,DMX))=1
SET DMBFK=^(DMX)
+2 SET DMBPFK=0
IF $DATA(^TMP("DMCT2",$JOB,DMX))=1
SET DMBPFK=^(DMX)
+3 SET ^TMP("DM",$JOB,DMFILE,DMWP,DMSR,DMPFK,DMBPFK,DMFK,DMBFK,DMX)=""
+4 QUIT
TOTS ;
+1 SET (DOT,DM1,DMC1,DMC2,DMC3,DMC4,DMC5,DMC6,DMC7)=0
+2 SET (DMCN2,DMCN3,DMCN4,DMCN5,DMCN6,DMCN7,DMCN8)=0
+3 FOR
SET DM1=$ORDER(^TMP("DM",$JOB,DM1))
IF DM1=""
QUIT
Begin DoDot:1
+4 SET DOT=DOT+1
IF DOT#20=1
WRITE "."
+5 SET DMTBL=$ORDER(^DMSQ("T","C",DM1,0))
SET DMC1=DMC1+1
SET DM2=""
+6 FOR
SET DM2=$ORDER(^TMP("DM",$JOB,DM1,DM2))
IF DM2=""
QUIT
Begin DoDot:2
+7 SET ^TMP("DMFQ2",$JOB,999-DM2,DM2,DMTBL)=""
+8 IF DM2
SET DMCN2=DMCN2+1
SET DMC2=DMC2+DM2
SET DM3=""
+9 FOR
SET DM3=$ORDER(^TMP("DM",$JOB,DM1,DM2,DM3))
IF DM3=""
QUIT
Begin DoDot:3
+10 SET ^TMP("DMFQ3",$JOB,9999-DM3,DM3,DMTBL)=""
+11 IF DM3
SET DMCN3=DMCN3+1
SET DMC3=DMC3+DM3
SET DM4=""
+12 FOR
SET DM4=$ORDER(^TMP("DM",$JOB,DM1,DM2,DM3,DM4))
IF DM4=""
QUIT
Begin DoDot:4
+13 SET ^TMP("DMFQ4",$JOB,DM2,9999-DM4,DM4,DMTBL)=""
+14 IF DM4
SET DMCN4=DMCN4+1
SET DMC4=DMC4+DM4
SET DM5=""
+15 FOR
SET DM5=$ORDER(^TMP("DM",$JOB,DM1,DM2,DM3,DM4,DM5))
IF DM5=""
QUIT
Begin DoDot:5
+16 SET ^TMP("DMFQ5",$JOB,9999-DM5,DM5,DMTBL)=""
+17 IF DM5
SET DMCN5=DMCN5+1
SET DMC5=DMC5+DM5
SET DM6=""
+18 FOR
SET DM6=$ORDER(^TMP("DM",$JOB,DM1,DM2,DM3,DM4,DM5,DM6))
IF DM6=""
QUIT
Begin DoDot:6
+19 SET ^TMP("DMFQ6",$JOB,9999-DM6,DM6,DMTBL)=""
+20 IF DM6
SET DMCN6=DMCN6+1
SET DMC6=DMC6+DM6
SET DM7=""
+21 FOR
SET DM7=$ORDER(^TMP("DM",$JOB,DM1,DM2,DM3,DM4,DM5,DM6,DM7))
IF DM7=""
QUIT
Begin DoDot:7
+22 SET ^TMP("DMFQ7",$JOB,9999-DM7,DM7,DMTBL)=""
+23 IF DM7
SET DMCN7=DMCN7+1
SET DMC7=DMC7+DM7
+24 IF '(DM4+DM5+DM6+DM7)
SET DMCN8=DMCN8+1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 SET ^TMP("DMTN",$JOB,DMC1,DMCN2,DMCN3,DMCN4,DMCN5,DMCN6,DMCN7,DMCN8)=""
+26 SET ^TMP("DMT",$JOB,DMC1,DMC2,DMC3,DMC4,DMC5,DMC6,DMC7)=""
+27 QUIT
PAIRS ; build array with to-table and from-tables that point
+1 SET (DOT,DMFILE)=0
WRITE !,"Please wait..."
+2 FOR
SET DMFILE=$ORDER(^DMSQ("T","C",DMFILE))
IF DMFILE'>0
QUIT
Begin DoDot:1
+3 SET DOT=DOT+1
IF DOT#20=1
WRITE "."
+4 SET DMX=$ORDER(^DMSQ("T","C",DMFILE,0))
+5 SET DME=0
FOR
SET DME=$ORDER(^DMSQ("E","F",DMX,"F",DME))
IF DME'>0
QUIT
Begin DoDot:2
+6 SET DMDM=$PIECE(^DMSQ("E",DME,0),U,2)
+7 SET DMY=$PIECE(^DMSQ("DM",DMDM,0),U,4)
+8 ; get foreign key ien
SET DMF=$ORDER(^DMSQ("F","B",DME,0))
+9 ; get column pointer
SET DMCOL=$PIECE(^DMSQ("F",DMF,0),U,3)
+10 IF $PIECE(^DMSQ("C",DMCOL,0),U,5)
SET ^TMP("DMP1",$JOB,DMY,DMX,DMF)=""
+11 IF '$TEST
SET ^TMP("DMP2",$JOB,DMY,DMX)=""
End DoDot:2
End DoDot:1
+12 QUIT
CNT ; get reference counts
+1 SET DM1=0
WRITE "."
FOR
SET DM1=$ORDER(^TMP("DMP1",$JOB,DM1))
IF DM1'>0
QUIT
Begin DoDot:1
+2 SET (DM2,DMCT)=0
+3 FOR
SET DM2=$ORDER(^TMP("DMP1",$JOB,DM1,DM2))
IF DM2'>0
QUIT
Begin DoDot:2
+4 SET DM3=0
+5 FOR
SET DM3=$ORDER(^TMP("DMP1",$JOB,DM1,DM2,DM3))
IF DM3'>0
QUIT
SET DMCT=DMCT+1
+6 SET ^TMP("DMCT1",$JOB,DM1)=DMCT
End DoDot:2
End DoDot:1
+7 SET DM1=0
FOR
SET DM1=$ORDER(^TMP("DMP2",$JOB,DM1))
IF DM1'>0
QUIT
Begin DoDot:1
+8 SET (DM2,DMCT)=0
+9 FOR
SET DM2=$ORDER(^TMP("DMP2",$JOB,DM1,DM2))
IF DM2'>0
QUIT
SET DMCT=DMCT+1
+10 SET ^TMP("DMCT2",$JOB,DM1)=DMCT
End DoDot:1
+11 QUIT
PRT ;
+1 SET DIC="1.5215"
SET L=0
SET DHD="SQLI TABLE POINTER COUNTS"
+2 SET FLDS="""SQLI TABLE NAME: "";C28;S,.01;X"
+3 SET BY(0)="^TMP(""DM"",$J,"
SET L(0)=8
SET FR(0,1)=DMFN
SET TO(0,1)=DMFN1
+4 SET DISPAR(0,1)="^;""FILE/SUBFILE: "";C1;S"
+5 SET DISPAR(0,1,"OUT")="S Y=Y_"" ""_$S($D(^DIC(Y)):$P(^(Y,0),U),1:$O(^DD(Y,0,""NM"",0)))"
+6 ;S DISPAR(0,2)="^;""WORD-PROCESSING TABLE? "";C50"
+7 ;S DISPAR(0,2,"OUT")="S Y=$S(+Y:""YES"",1:""NO"")"
+8 SET DISPAR(0,3)="^;""SELF-REFERENTIAL POINTERS: "";C18"
+9 SET DISPAR(0,4)="^;""POINTERS DOWNWARD TO THIS SUBFILE: "";C10;S"
+10 SET DISPAR(0,5)="^;""POINTERS UPWARD FROM DEEPER SUBFILES: "";C7"
+11 SET DISPAR(0,6)="^;""POINTERS OUTWARD TO OTHER FILES: "";C12;S"
+12 SET DISPAR(0,7)="^;""POINTERS INWARD FROM OTHER FILES: "";C11"
+13 DO EN1^DIP
QUIT
