DMSQP6 ;SFISC/EZ-DISPLAY TABLE GROUPINGS ;10/30/97 17:51
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
INIT ; initialize variables and clear tmp arrays
D DT^DICRW
S DMUCI="" I $D(^%ZOSF("UCI"))#2 X ^%ZOSF("UCI") S DMUCI=Y
CLEAR K ^TMP("DMPAIRS",$J),^TMP("DMCNT",$J),^TMP("DMLIST",$J)
K ^TMP("DMFLAT",$J),^TMP("DMFIN",$J),^TMP("DMSHR",$J)
Q
EXIT ; kill vars
K DMANS,DMFILE,DMFTIEN,DMTTIEN,DMFK,DMDM,DMTR,DM3,J
K DMCT,DM,DM1,DM2,DMX,DMX1,DMGRP,DMGCNT,DMG,DMAX,DMT,DMTOT,DMQ
K DMSHRC,DMUCI,DMSPEC,DMSPECN,DMSPECG,DMQQ
Q
PREASK ; confirm that it's okay to wait for interactive processing
S DIR(0)="Y",DIR("A")="This can take 5-10 minutes. Continue"
S DIR("B")="NO" D ^DIR K DIR S:Y=0 DMQQ=1
Q
ASK ; ask for a cutoff on pointed-to file references
S DIR(0)="NO^0:1000",DIR("A")="Maximum pointing references",DIR("B")=5
S DIR("?",1)="This cutoff is used as an upper limit on pointer links. Tables with"
S DIR("?",2)="more links than this upper limit are displayed as the set of shared tables.",DIR("?",3)=" "
S DIR("?",4)="Others with common pointer links are then grouped together. The resulting"
S DIR("?",5)="subsets could be used in SQL Grant statements.",DIR("?",6)=" "
S DIR("?")="Try using cutoffs between 3 and 10, comparing results."
D ^DIR K DIR S DMANS=Y S:$D(DIRUT) DMQQ=1
Q
ASK1 ; ask for a specific table of interest
S DIC="1.5215",DIC(0)="QEAM",DIC("S")="I '$P(^(0),U,4)"
S DIC("A")="Select a Table of Special Interest (Optional): "
D ^DIC K DIC S DMSPEC=$S(Y=-1:"",1:+Y) S:$D(DTOUT)!$D(DUOUT) DMQQ=1
S:DMSPEC DMSPECN=$P(^DMSQ("T",DMSPEC,0),U,1) S DMSPECG=""
Q
EN ; find groups of tables that point to one another
I '$O(^DMSQ("S",0)) W !?5,"Sorry, SQLI files are empty.",! Q
I $$WAIT^DMSQT1 D Q
. W !?5,"Try later. SQLI is being re-built right now."
S DMQQ="" D PREASK I $D(DIRUT)!(DMQQ) K DMQQ Q
D D CLEAR,EXIT
. D INIT,ASK Q:DMQQ D ASK1 Q:DMQQ
. D PAIRS,CNT,OTH,GRP,PRT D:DMSPEC PRT3 D PRT2
Q
PRT ; print shared table list
W !!,?9,"LISTING OF SHARED TABLES"
S DIC="1.5215",L=0
S DHD="SHARED TABLES = "_DMSHRC_" (CUTOFF OF "_DMANS_") "_DMUCI
S FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
S BY(0)="^TMP(""DMSHR"",$J,",L(0)=2
D EN1^DIP Q
PRT1 ; detailed report showing pointer links within groups
W !!,?9,"DETAILED GROUP REPORT"
S DIC="1.5215",L=0
S DHD="DETAIL OF GROUPS = "_DMGCNT_" (CUTOFF OF "_DMANS_") "_DMUCI
S FLDS="""FROM TABLE: "";C5,.01;X,"" (""_INTERNAL(#6)_"")"";X"
S BY(0)="^TMP(""DMLIST"",$J,",L(0)=3
S DISPAR(0,1)="^;""GROUP: "";S2"
S DISPAR(0,1,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
S DISPAR(0,2)="^;""TO TABLE: "";S;C1"
S DISPAR(0,2,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
D EN1^DIP Q
PRT2 ; print final list of tables by group
W !!,?9,"COMPLETE REPORT OF ALL GROUPS"
S DIC="1.5215",L=0
S DHD="TABLE GROUPS = "_DMGCNT_" (CUTOFF OF "_DMANS_") "_DMUCI
S FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
S BY(0)="^TMP(""DMFIN"",$J,",L(0)=4
S DISPAR(0,2)="^;""TABLE COUNT="";C1;S2"
S DISPAR(0,3)="^;""GROUP: "";C15"
S DISPAR(0,3,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
D EN1^DIP Q
PRT3 ; just show the group that includes the specified table
W !!,?9,"PRINT OF JUST ONE GROUP (INCLUDING THE SPECIFIED TABLE)"
I 'DMSPECG&$D(^TMP("DMCNT",$J,DMSPEC)) W !!,"The selected table doesn't fall in a group; see the shared set." Q
I 'DMSPECG W !!,"There isn't a group for the selected table; it doesn't have pointer links." Q
S DIC="1.5215",L=0
S DHD="GROUP INCLUDING "_DMSPECN_" (CUTOFF OF "_DMANS_") "_DMUCI
S FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
S BY(0)="^TMP(""DMFIN"",$J,",L(0)=4
S DISPAR(0,2)="^;""TABLE COUNT="";C1;S2"
S DISPAR(0,3)="^;""GROUP: "";C15",(FR(0,3),TO(0,3))=DMSPECG
S DISPAR(0,3,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
D EN1^DIP Q
PAIRS ; build array with to-table and from-tables that link
S DMFILE=0
W !,"...... Please wait. Reports take a few minutes to process ...... "
F S DMFILE=$O(^DMSQ("T","C",DMFILE)) Q:DMFILE'>0 D
. S DMFTIEN=$O(^DMSQ("T","C",DMFILE,0))
. S DMFK=0
. F S DMFK=$O(^DMSQ("E","F",DMFTIEN,"F",DMFK)) Q:DMFK'>0 D
.. S DMDM=$P(^DMSQ("E",DMFK,0),U,2)
.. S DMTTIEN=$P(^DMSQ("DM",DMDM,0),U,4)
.. S:(DMTTIEN'=DMFTIEN) ^TMP("DMPAIRS",$J,DMTTIEN,DMFTIEN)=""
Q
CNT ; get reference counts
S DM1=0
F S DM1=$O(^TMP("DMPAIRS",$J,DM1)) Q:DM1'>0 D
. S DM2=0,DMCT=0,DMFILE=$P(^DMSQ("T",DM1,0),U,7)
. F S DM2=$O(^TMP("DMPAIRS",$J,DM1,DM2)) Q:DM2'>0 D
.. S DMCT=DMCT+1
. S ^TMP("DMCNT",$J,DM1)=DMCT
Q
GRP ; group the sets of shared tables
S DMGRP=0
F S DMGRP=$O(^TMP("DMPAIRS",$J,DMGRP)) Q:DMGRP'>0 W "." D
. K DMSCR S DMSCR(DMGRP)="" F J=1:1:5 D
.. S DM1=0 F S DM1=$O(^TMP("DMPAIRS",$J,DM1)) Q:DM1'>0 D
... S DM2=0 F S DM2=$O(^TMP("DMPAIRS",$J,DM1,DM2)) Q:DM2'>0 D
.... S (DMX,DMQ)=0
.... F Q:DMQ S DMX=$O(DMSCR(DMX)) Q:DMX'>0 D
..... S:DMX=DM1 DMSCR(DM2)="",DMQ=1
..... S:DMX=DM2 DMSCR(DM1)="",DMQ=1
.... I DMQ D
..... S ^TMP("DMLIST",$J,DMGRP,DM1,DM2)=""
..... S ^TMP("DMFLAT",$J,DMGRP,DM1)="",^TMP("DMFLAT",$J,DMGRP,DM2)=""
..... K ^TMP("DMPAIRS",$J,DM1,DM2)
S (DMGCNT,DM)=0
F S DM=$O(^TMP("DMLIST",$J,DM)) Q:DM'>0 S DMGCNT=DMGCNT+1
S DM=0 F S DM=$O(^TMP("DMFLAT",$J,DM)) Q:DM'>0 D
. S (DMX,DMT,DMAX)=0 F S DMX=$O(^TMP("DMFLAT",$J,DM,DMX)) Q:DMX'>0 D
.. S DMTOT=$G(^TMP("DMCNT",$J,DMX)),DMT=DMT+1
.. I DMTOT>DMAX S DMAX=DMTOT,DMG=DMX
. S DMX1=0 F S DMX1=$O(^TMP("DMFLAT",$J,DM,DMX1)) Q:DMX1'>0 D
.. S DMTR=99999999-DMT,^TMP("DMFIN",$J,DMTR,DMT,DMG,DMX1)=""
.. S:DMSPEC=DMX1 DMSPECG=DMG
Q
OTH ; process with other factor, i.e. cutoff on pointer link limit
S (DM1,DMSHRC)=0,^TMP("DMSHR",$J,0,0)=""
F S DM1=$O(^TMP("DMPAIRS",$J,DM1)) Q:DM1'>0 D
. I $G(^TMP("DMCNT",$J,DM1))>DMANS D
.. S DM2=0,DMSHRC=DMSHRC+1
.. S ^TMP("DMSHR",$J,99999-($G(^TMP("DMCNT",$J,DM1))),DM1)=""
.. F S DM2=$O(^TMP("DMPAIRS",$J,DM1,DM2)) Q:DM2'>0 D
... K ^TMP("DMPAIRS",$J,DM1,DM2)
.. S DM2=0 F S DM2=$O(^TMP("DMPAIRS",$J,DM2)) Q:DM2'>0 D
... S DM3=0 F S DM3=$O(^TMP("DMPAIRS",$J,DM2,DM3)) Q:DM3'>0 D
.... I DM1=DM3 K ^TMP("DMPAIRS",$J,DM2,DM3)
Q
DMSQP6 ;SFISC/EZ-DISPLAY TABLE GROUPINGS ;10/30/97 17:51
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
INIT ; initialize variables and clear tmp arrays
+1 DO DT^DICRW
+2 SET DMUCI=""
IF $DATA(^%ZOSF("UCI"))#2
XECUTE ^%ZOSF("UCI")
SET DMUCI=Y
CLEAR KILL ^TMP("DMPAIRS",$JOB),^TMP("DMCNT",$JOB),^TMP("DMLIST",$JOB)
+1 KILL ^TMP("DMFLAT",$JOB),^TMP("DMFIN",$JOB),^TMP("DMSHR",$JOB)
+2 QUIT
EXIT ; kill vars
+1 KILL DMANS,DMFILE,DMFTIEN,DMTTIEN,DMFK,DMDM,DMTR,DM3,J
+2 KILL DMCT,DM,DM1,DM2,DMX,DMX1,DMGRP,DMGCNT,DMG,DMAX,DMT,DMTOT,DMQ
+3 KILL DMSHRC,DMUCI,DMSPEC,DMSPECN,DMSPECG,DMQQ
+4 QUIT
PREASK ; confirm that it's okay to wait for interactive processing
+1 SET DIR(0)="Y"
SET DIR("A")="This can take 5-10 minutes. Continue"
+2 SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y=0
SET DMQQ=1
+3 QUIT
ASK ; ask for a cutoff on pointed-to file references
+1 SET DIR(0)="NO^0:1000"
SET DIR("A")="Maximum pointing references"
SET DIR("B")=5
+2 SET DIR("?",1)="This cutoff is used as an upper limit on pointer links. Tables with"
+3 SET DIR("?",2)="more links than this upper limit are displayed as the set of shared tables."
SET DIR("?",3)=" "
+4 SET DIR("?",4)="Others with common pointer links are then grouped together. The resulting"
+5 SET DIR("?",5)="subsets could be used in SQL Grant statements."
SET DIR("?",6)=" "
+6 SET DIR("?")="Try using cutoffs between 3 and 10, comparing results."
+7 DO ^DIR
KILL DIR
SET DMANS=Y
IF $DATA(DIRUT)
SET DMQQ=1
+8 QUIT
ASK1 ; ask for a specific table of interest
+1 SET DIC="1.5215"
SET DIC(0)="QEAM"
SET DIC("S")="I '$P(^(0),U,4)"
+2 SET DIC("A")="Select a Table of Special Interest (Optional): "
+3 DO ^DIC
KILL DIC
SET DMSPEC=$SELECT(Y=-1:"",1:+Y)
IF $DATA(DTOUT)!$DATA(DUOUT)
SET DMQQ=1
+4 IF DMSPEC
SET DMSPECN=$PIECE(^DMSQ("T",DMSPEC,0),U,1)
SET DMSPECG=""
+5 QUIT
EN ; find groups of tables that point to one another
+1 IF '$ORDER(^DMSQ("S",0))
WRITE !?5,"Sorry, SQLI files are empty.",!
QUIT
+2 IF $$WAIT^DMSQT1
Begin DoDot:1
+3 WRITE !?5,"Try later. SQLI is being re-built right now."
End DoDot:1
QUIT
+4 SET DMQQ=""
DO PREASK
IF $DATA(DIRUT)!(DMQQ)
KILL DMQQ
QUIT
+5 Begin DoDot:1
+6 DO INIT
DO ASK
IF DMQQ
QUIT
DO ASK1
IF DMQQ
QUIT
+7 DO PAIRS
DO CNT
DO OTH
DO GRP
DO PRT
IF DMSPEC
DO PRT3
DO PRT2
End DoDot:1
DO CLEAR
DO EXIT
+8 QUIT
PRT ; print shared table list
+1 WRITE !!,?9,"LISTING OF SHARED TABLES"
+2 SET DIC="1.5215"
SET L=0
+3 SET DHD="SHARED TABLES = "_DMSHRC_" (CUTOFF OF "_DMANS_") "_DMUCI
+4 SET FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
+5 SET BY(0)="^TMP(""DMSHR"",$J,"
SET L(0)=2
+6 DO EN1^DIP
QUIT
PRT1 ; detailed report showing pointer links within groups
+1 WRITE !!,?9,"DETAILED GROUP REPORT"
+2 SET DIC="1.5215"
SET L=0
+3 SET DHD="DETAIL OF GROUPS = "_DMGCNT_" (CUTOFF OF "_DMANS_") "_DMUCI
+4 SET FLDS="""FROM TABLE: "";C5,.01;X,"" (""_INTERNAL(#6)_"")"";X"
+5 SET BY(0)="^TMP(""DMLIST"",$J,"
SET L(0)=3
+6 SET DISPAR(0,1)="^;""GROUP: "";S2"
+7 SET DISPAR(0,1,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
+8 SET DISPAR(0,2)="^;""TO TABLE: "";S;C1"
+9 SET DISPAR(0,2,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
+10 DO EN1^DIP
QUIT
PRT2 ; print final list of tables by group
+1 WRITE !!,?9,"COMPLETE REPORT OF ALL GROUPS"
+2 SET DIC="1.5215"
SET L=0
+3 SET DHD="TABLE GROUPS = "_DMGCNT_" (CUTOFF OF "_DMANS_") "_DMUCI
+4 SET FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
+5 SET BY(0)="^TMP(""DMFIN"",$J,"
SET L(0)=4
+6 SET DISPAR(0,2)="^;""TABLE COUNT="";C1;S2"
+7 SET DISPAR(0,3)="^;""GROUP: "";C15"
+8 SET DISPAR(0,3,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
+9 DO EN1^DIP
QUIT
PRT3 ; just show the group that includes the specified table
+1 WRITE !!,?9,"PRINT OF JUST ONE GROUP (INCLUDING THE SPECIFIED TABLE)"
+2 IF 'DMSPECG&$DATA(^TMP("DMCNT",$JOB,DMSPEC))
WRITE !!,"The selected table doesn't fall in a group; see the shared set."
QUIT
+3 IF 'DMSPECG
WRITE !!,"There isn't a group for the selected table; it doesn't have pointer links."
QUIT
+4 SET DIC="1.5215"
SET L=0
+5 SET DHD="GROUP INCLUDING "_DMSPECN_" (CUTOFF OF "_DMANS_") "_DMUCI
+6 SET FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
+7 SET BY(0)="^TMP(""DMFIN"",$J,"
SET L(0)=4
+8 SET DISPAR(0,2)="^;""TABLE COUNT="";C1;S2"
+9 SET DISPAR(0,3)="^;""GROUP: "";C15"
SET (FR(0,3),TO(0,3))=DMSPECG
+10 SET DISPAR(0,3,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
+11 DO EN1^DIP
QUIT
PAIRS ; build array with to-table and from-tables that link
+1 SET DMFILE=0
+2 WRITE !,"...... Please wait. Reports take a few minutes to process ...... "
+3 FOR
SET DMFILE=$ORDER(^DMSQ("T","C",DMFILE))
IF DMFILE'>0
QUIT
Begin DoDot:1
+4 SET DMFTIEN=$ORDER(^DMSQ("T","C",DMFILE,0))
+5 SET DMFK=0
+6 FOR
SET DMFK=$ORDER(^DMSQ("E","F",DMFTIEN,"F",DMFK))
IF DMFK'>0
QUIT
Begin DoDot:2
+7 SET DMDM=$PIECE(^DMSQ("E",DMFK,0),U,2)
+8 SET DMTTIEN=$PIECE(^DMSQ("DM",DMDM,0),U,4)
+9 IF (DMTTIEN'=DMFTIEN)
SET ^TMP("DMPAIRS",$JOB,DMTTIEN,DMFTIEN)=""
End DoDot:2
End DoDot:1
+10 QUIT
CNT ; get reference counts
+1 SET DM1=0
+2 FOR
SET DM1=$ORDER(^TMP("DMPAIRS",$JOB,DM1))
IF DM1'>0
QUIT
Begin DoDot:1
+3 SET DM2=0
SET DMCT=0
SET DMFILE=$PIECE(^DMSQ("T",DM1,0),U,7)
+4 FOR
SET DM2=$ORDER(^TMP("DMPAIRS",$JOB,DM1,DM2))
IF DM2'>0
QUIT
Begin DoDot:2
+5 SET DMCT=DMCT+1
End DoDot:2
+6 SET ^TMP("DMCNT",$JOB,DM1)=DMCT
End DoDot:1
+7 QUIT
GRP ; group the sets of shared tables
+1 SET DMGRP=0
+2 FOR
SET DMGRP=$ORDER(^TMP("DMPAIRS",$JOB,DMGRP))
IF DMGRP'>0
QUIT
WRITE "."
Begin DoDot:1
+3 KILL DMSCR
SET DMSCR(DMGRP)=""
FOR J=1:1:5
Begin DoDot:2
+4 SET DM1=0
FOR
SET DM1=$ORDER(^TMP("DMPAIRS",$JOB,DM1))
IF DM1'>0
QUIT
Begin DoDot:3
+5 SET DM2=0
FOR
SET DM2=$ORDER(^TMP("DMPAIRS",$JOB,DM1,DM2))
IF DM2'>0
QUIT
Begin DoDot:4
+6 SET (DMX,DMQ)=0
+7 FOR
IF DMQ
QUIT
SET DMX=$ORDER(DMSCR(DMX))
IF DMX'>0
QUIT
Begin DoDot:5
+8 IF DMX=DM1
SET DMSCR(DM2)=""
SET DMQ=1
+9 IF DMX=DM2
SET DMSCR(DM1)=""
SET DMQ=1
End DoDot:5
+10 IF DMQ
Begin DoDot:5
+11 SET ^TMP("DMLIST",$JOB,DMGRP,DM1,DM2)=""
+12 SET ^TMP("DMFLAT",$JOB,DMGRP,DM1)=""
SET ^TMP("DMFLAT",$JOB,DMGRP,DM2)=""
+13 KILL ^TMP("DMPAIRS",$JOB,DM1,DM2)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET (DMGCNT,DM)=0
+15 FOR
SET DM=$ORDER(^TMP("DMLIST",$JOB,DM))
IF DM'>0
QUIT
SET DMGCNT=DMGCNT+1
+16 SET DM=0
FOR
SET DM=$ORDER(^TMP("DMFLAT",$JOB,DM))
IF DM'>0
QUIT
Begin DoDot:1
+17 SET (DMX,DMT,DMAX)=0
FOR
SET DMX=$ORDER(^TMP("DMFLAT",$JOB,DM,DMX))
IF DMX'>0
QUIT
Begin DoDot:2
+18 SET DMTOT=$GET(^TMP("DMCNT",$JOB,DMX))
SET DMT=DMT+1
+19 IF DMTOT>DMAX
SET DMAX=DMTOT
SET DMG=DMX
End DoDot:2
+20 SET DMX1=0
FOR
SET DMX1=$ORDER(^TMP("DMFLAT",$JOB,DM,DMX1))
IF DMX1'>0
QUIT
Begin DoDot:2
+21 SET DMTR=99999999-DMT
SET ^TMP("DMFIN",$JOB,DMTR,DMT,DMG,DMX1)=""
+22 IF DMSPEC=DMX1
SET DMSPECG=DMG
End DoDot:2
End DoDot:1
+23 QUIT
OTH ; process with other factor, i.e. cutoff on pointer link limit
+1 SET (DM1,DMSHRC)=0
SET ^TMP("DMSHR",$JOB,0,0)=""
+2 FOR
SET DM1=$ORDER(^TMP("DMPAIRS",$JOB,DM1))
IF DM1'>0
QUIT
Begin DoDot:1
+3 IF $GET(^TMP("DMCNT",$JOB,DM1))>DMANS
Begin DoDot:2
+4 SET DM2=0
SET DMSHRC=DMSHRC+1
+5 SET ^TMP("DMSHR",$JOB,99999-($GET(^TMP("DMCNT",$JOB,DM1))),DM1)=""
+6 FOR
SET DM2=$ORDER(^TMP("DMPAIRS",$JOB,DM1,DM2))
IF DM2'>0
QUIT
Begin DoDot:3
+7 KILL ^TMP("DMPAIRS",$JOB,DM1,DM2)
End DoDot:3
+8 SET DM2=0
FOR
SET DM2=$ORDER(^TMP("DMPAIRS",$JOB,DM2))
IF DM2'>0
QUIT
Begin DoDot:3
+9 SET DM3=0
FOR
SET DM3=$ORDER(^TMP("DMPAIRS",$JOB,DM2,DM3))
IF DM3'>0
QUIT
Begin DoDot:4
+10 IF DM1=DM3
KILL ^TMP("DMPAIRS",$JOB,DM2,DM3)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
