Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DMSQP6

DMSQP6.m

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