- DMSQP6 ;SFISC/EZ-DISPLAY TABLE GROUPINGS ;10/30/97 17:51
- ;;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.
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDMSQP6 6538 printed Jan 18, 2025@03:56:13 Page 2
- DMSQP6 ;SFISC/EZ-DISPLAY TABLE GROUPINGS ;10/30/97 17:51
- +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 ;
- 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