- DMSQP3 ;SFISC/EZ-DISPLAY POINTER COUNTS ;10/30/97 17:42
- ;;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.
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDMSQP3 8060 printed Feb 19, 2025@00:21:26 Page 2
- DMSQP3 ;SFISC/EZ-DISPLAY POINTER COUNTS ;10/30/97 17:42
- +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 ;
- 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