source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DMSQP6.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1DMSQP6 ;SFISC/EZ-DISPLAY TABLE GROUPINGS ;10/30/97 17:51
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4INIT ; initialize variables and clear tmp arrays
5 D DT^DICRW
6 S DMUCI="" I $D(^%ZOSF("UCI"))#2 X ^%ZOSF("UCI") S DMUCI=Y
7CLEAR K ^TMP("DMPAIRS",$J),^TMP("DMCNT",$J),^TMP("DMLIST",$J)
8 K ^TMP("DMFLAT",$J),^TMP("DMFIN",$J),^TMP("DMSHR",$J)
9 Q
10EXIT ; kill vars
11 K DMANS,DMFILE,DMFTIEN,DMTTIEN,DMFK,DMDM,DMTR,DM3,J
12 K DMCT,DM,DM1,DM2,DMX,DMX1,DMGRP,DMGCNT,DMG,DMAX,DMT,DMTOT,DMQ
13 K DMSHRC,DMUCI,DMSPEC,DMSPECN,DMSPECG,DMQQ
14 Q
15PREASK ; confirm that it's okay to wait for interactive processing
16 S DIR(0)="Y",DIR("A")="This can take 5-10 minutes. Continue"
17 S DIR("B")="NO" D ^DIR K DIR S:Y=0 DMQQ=1
18 Q
19ASK ; ask for a cutoff on pointed-to file references
20 S DIR(0)="NO^0:1000",DIR("A")="Maximum pointing references",DIR("B")=5
21 S DIR("?",1)="This cutoff is used as an upper limit on pointer links. Tables with"
22 S DIR("?",2)="more links than this upper limit are displayed as the set of shared tables.",DIR("?",3)=" "
23 S DIR("?",4)="Others with common pointer links are then grouped together. The resulting"
24 S DIR("?",5)="subsets could be used in SQL Grant statements.",DIR("?",6)=" "
25 S DIR("?")="Try using cutoffs between 3 and 10, comparing results."
26 D ^DIR K DIR S DMANS=Y S:$D(DIRUT) DMQQ=1
27 Q
28ASK1 ; ask for a specific table of interest
29 S DIC="1.5215",DIC(0)="QEAM",DIC("S")="I '$P(^(0),U,4)"
30 S DIC("A")="Select a Table of Special Interest (Optional): "
31 D ^DIC K DIC S DMSPEC=$S(Y=-1:"",1:+Y) S:$D(DTOUT)!$D(DUOUT) DMQQ=1
32 S:DMSPEC DMSPECN=$P(^DMSQ("T",DMSPEC,0),U,1) S DMSPECG=""
33 Q
34EN ; find groups of tables that point to one another
35 I '$O(^DMSQ("S",0)) W !?5,"Sorry, SQLI files are empty.",! Q
36 I $$WAIT^DMSQT1 D Q
37 . W !?5,"Try later. SQLI is being re-built right now."
38 S DMQQ="" D PREASK I $D(DIRUT)!(DMQQ) K DMQQ Q
39 D D CLEAR,EXIT
40 . D INIT,ASK Q:DMQQ D ASK1 Q:DMQQ
41 . D PAIRS,CNT,OTH,GRP,PRT D:DMSPEC PRT3 D PRT2
42 Q
43PRT ; print shared table list
44 W !!,?9,"LISTING OF SHARED TABLES"
45 S DIC="1.5215",L=0
46 S DHD="SHARED TABLES = "_DMSHRC_" (CUTOFF OF "_DMANS_") "_DMUCI
47 S FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
48 S BY(0)="^TMP(""DMSHR"",$J,",L(0)=2
49 D EN1^DIP Q
50PRT1 ; detailed report showing pointer links within groups
51 W !!,?9,"DETAILED GROUP REPORT"
52 S DIC="1.5215",L=0
53 S DHD="DETAIL OF GROUPS = "_DMGCNT_" (CUTOFF OF "_DMANS_") "_DMUCI
54 S FLDS="""FROM TABLE: "";C5,.01;X,"" (""_INTERNAL(#6)_"")"";X"
55 S BY(0)="^TMP(""DMLIST"",$J,",L(0)=3
56 S DISPAR(0,1)="^;""GROUP: "";S2"
57 S DISPAR(0,1,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
58 S DISPAR(0,2)="^;""TO TABLE: "";S;C1"
59 S DISPAR(0,2,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
60 D EN1^DIP Q
61PRT2 ; print final list of tables by group
62 W !!,?9,"COMPLETE REPORT OF ALL GROUPS"
63 S DIC="1.5215",L=0
64 S DHD="TABLE GROUPS = "_DMGCNT_" (CUTOFF OF "_DMANS_") "_DMUCI
65 S FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
66 S BY(0)="^TMP(""DMFIN"",$J,",L(0)=4
67 S DISPAR(0,2)="^;""TABLE COUNT="";C1;S2"
68 S DISPAR(0,3)="^;""GROUP: "";C15"
69 S DISPAR(0,3,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
70 D EN1^DIP Q
71PRT3 ; just show the group that includes the specified table
72 W !!,?9,"PRINT OF JUST ONE GROUP (INCLUDING THE SPECIFIED TABLE)"
73 I 'DMSPECG&$D(^TMP("DMCNT",$J,DMSPEC)) W !!,"The selected table doesn't fall in a group; see the shared set." Q
74 I 'DMSPECG W !!,"There isn't a group for the selected table; it doesn't have pointer links." Q
75 S DIC="1.5215",L=0
76 S DHD="GROUP INCLUDING "_DMSPECN_" (CUTOFF OF "_DMANS_") "_DMUCI
77 S FLDS=".01;C5;"""","" (""_INTERNAL(#6)_"")"";X"
78 S BY(0)="^TMP(""DMFIN"",$J,",L(0)=4
79 S DISPAR(0,2)="^;""TABLE COUNT="";C1;S2"
80 S DISPAR(0,3)="^;""GROUP: "";C15",(FR(0,3),TO(0,3))=DMSPECG
81 S DISPAR(0,3,"OUT")="S Y=$P(^DMSQ(""T"",Y,0),U,1)_"" (""_$P(^(0),U,7)_"")"""
82 D EN1^DIP Q
83PAIRS ; build array with to-table and from-tables that link
84 S DMFILE=0
85 W !,"...... Please wait. Reports take a few minutes to process ...... "
86 F S DMFILE=$O(^DMSQ("T","C",DMFILE)) Q:DMFILE'>0 D
87 . S DMFTIEN=$O(^DMSQ("T","C",DMFILE,0))
88 . S DMFK=0
89 . F S DMFK=$O(^DMSQ("E","F",DMFTIEN,"F",DMFK)) Q:DMFK'>0 D
90 .. S DMDM=$P(^DMSQ("E",DMFK,0),U,2)
91 .. S DMTTIEN=$P(^DMSQ("DM",DMDM,0),U,4)
92 .. S:(DMTTIEN'=DMFTIEN) ^TMP("DMPAIRS",$J,DMTTIEN,DMFTIEN)=""
93 Q
94CNT ; get reference counts
95 S DM1=0
96 F S DM1=$O(^TMP("DMPAIRS",$J,DM1)) Q:DM1'>0 D
97 . S DM2=0,DMCT=0,DMFILE=$P(^DMSQ("T",DM1,0),U,7)
98 . F S DM2=$O(^TMP("DMPAIRS",$J,DM1,DM2)) Q:DM2'>0 D
99 .. S DMCT=DMCT+1
100 . S ^TMP("DMCNT",$J,DM1)=DMCT
101 Q
102GRP ; group the sets of shared tables
103 S DMGRP=0
104 F S DMGRP=$O(^TMP("DMPAIRS",$J,DMGRP)) Q:DMGRP'>0 W "." D
105 . K DMSCR S DMSCR(DMGRP)="" F J=1:1:5 D
106 .. S DM1=0 F S DM1=$O(^TMP("DMPAIRS",$J,DM1)) Q:DM1'>0 D
107 ... S DM2=0 F S DM2=$O(^TMP("DMPAIRS",$J,DM1,DM2)) Q:DM2'>0 D
108 .... S (DMX,DMQ)=0
109 .... F Q:DMQ S DMX=$O(DMSCR(DMX)) Q:DMX'>0 D
110 ..... S:DMX=DM1 DMSCR(DM2)="",DMQ=1
111 ..... S:DMX=DM2 DMSCR(DM1)="",DMQ=1
112 .... I DMQ D
113 ..... S ^TMP("DMLIST",$J,DMGRP,DM1,DM2)=""
114 ..... S ^TMP("DMFLAT",$J,DMGRP,DM1)="",^TMP("DMFLAT",$J,DMGRP,DM2)=""
115 ..... K ^TMP("DMPAIRS",$J,DM1,DM2)
116 S (DMGCNT,DM)=0
117 F S DM=$O(^TMP("DMLIST",$J,DM)) Q:DM'>0 S DMGCNT=DMGCNT+1
118 S DM=0 F S DM=$O(^TMP("DMFLAT",$J,DM)) Q:DM'>0 D
119 . S (DMX,DMT,DMAX)=0 F S DMX=$O(^TMP("DMFLAT",$J,DM,DMX)) Q:DMX'>0 D
120 .. S DMTOT=$G(^TMP("DMCNT",$J,DMX)),DMT=DMT+1
121 .. I DMTOT>DMAX S DMAX=DMTOT,DMG=DMX
122 . S DMX1=0 F S DMX1=$O(^TMP("DMFLAT",$J,DM,DMX1)) Q:DMX1'>0 D
123 .. S DMTR=99999999-DMT,^TMP("DMFIN",$J,DMTR,DMT,DMG,DMX1)=""
124 .. S:DMSPEC=DMX1 DMSPECG=DMG
125 Q
126OTH ; process with other factor, i.e. cutoff on pointer link limit
127 S (DM1,DMSHRC)=0,^TMP("DMSHR",$J,0,0)=""
128 F S DM1=$O(^TMP("DMPAIRS",$J,DM1)) Q:DM1'>0 D
129 . I $G(^TMP("DMCNT",$J,DM1))>DMANS D
130 .. S DM2=0,DMSHRC=DMSHRC+1
131 .. S ^TMP("DMSHR",$J,99999-($G(^TMP("DMCNT",$J,DM1))),DM1)=""
132 .. F S DM2=$O(^TMP("DMPAIRS",$J,DM1,DM2)) Q:DM2'>0 D
133 ... K ^TMP("DMPAIRS",$J,DM1,DM2)
134 .. S DM2=0 F S DM2=$O(^TMP("DMPAIRS",$J,DM2)) Q:DM2'>0 D
135 ... S DM3=0 F S DM3=$O(^TMP("DMPAIRS",$J,DM2,DM3)) Q:DM3'>0 D
136 .... I DM1=DM3 K ^TMP("DMPAIRS",$J,DM2,DM3)
137 Q
Note: See TracBrowser for help on using the repository browser.