| [641] | 1 | XBDANGLE ;IHS/SET/GTH - Q'ABLE CLEANUP DANGLING POINTERS OPTION HELP FRAME PROTOCOL FILES ; [ 10/29/2002 7:42 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cleanup dangling pointers.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This utility can be scheduled to run via TaskMan.
|
|---|
| 6 | ;
|
|---|
| 7 | ; Actions are delivered to XUPROG key holders via MailMan.
|
|---|
| 8 | ;
|
|---|
| 9 | ; You can also run this interactively, but you'll still
|
|---|
| 10 | ; get the MailMan note, even after the interactive run.
|
|---|
| 11 | ;
|
|---|
| 12 | ; Thanks to the VA for the original interactive routine, XQ3.
|
|---|
| 13 | ;
|
|---|
| 14 | D INIT
|
|---|
| 15 | D OFIX,HFFIX,PFIX
|
|---|
| 16 | D MAIL
|
|---|
| 17 | D EXIT
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ; ----------------------------------------------------------
|
|---|
| 21 | ;
|
|---|
| 22 | OFIX ;Kill any dangling pointers in the OPTION File (#19)
|
|---|
| 23 | NEW I,J,K,L,M,X,Y
|
|---|
| 24 | S (I,X)=0 ;X=Total Deletions
|
|---|
| 25 | L1 ;
|
|---|
| 26 | S I=$O(^DIC(19,I))
|
|---|
| 27 | I I>0 S (Y,J)=0 G L2 ;Loop through menus
|
|---|
| 28 | D RSLT(X_" pointer"_$S(X=1:"",1:"s")_" fixed in your OPTION file.")
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | L2 ;
|
|---|
| 32 | S J=$O(^DIC(19,I,10,J))
|
|---|
| 33 | I J>0 G ITEM ;Loop through menu items
|
|---|
| 34 | I '$D(^DIC(19,I,10,0)) G L1
|
|---|
| 35 | S (K,J)=0
|
|---|
| 36 | F L=1:1 S J=$O(^DIC(19,I,10,J)) Q:J'>0 S K=J ;K=Last item
|
|---|
| 37 | S J=^DIC(19,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
|
|---|
| 38 | G XREFS
|
|---|
| 39 | ;
|
|---|
| 40 | ITEM ;
|
|---|
| 41 | S K=+^DIC(19,I,10,J,0)
|
|---|
| 42 | I $D(^DIC(19,K,0)) S Y=Y+1 G L2 ;Y=No. of items
|
|---|
| 43 | D RSLT("Option "_$P(^DIC(19,I,0),U,1)_" points to missing option "_K)
|
|---|
| 44 | S X=X+1
|
|---|
| 45 | KILL ^DIC(19,I,10,J) ;Kill invalid menu item
|
|---|
| 46 | G L2
|
|---|
| 47 | ;
|
|---|
| 48 | XREFS ;
|
|---|
| 49 | S K=":"
|
|---|
| 50 | L3 ;
|
|---|
| 51 | S K=$O(^DIC(19,I,10,K))
|
|---|
| 52 | I K="" G L1 ;Loop through cross references
|
|---|
| 53 | S L=-1
|
|---|
| 54 | L4 ;
|
|---|
| 55 | S L=$O(^DIC(19,I,10,K,L))
|
|---|
| 56 | I L="" G L3
|
|---|
| 57 | S J=0
|
|---|
| 58 | L5 ;
|
|---|
| 59 | S J=$O(^DIC(19,I,10,K,L,J))
|
|---|
| 60 | I J'>0 G L4
|
|---|
| 61 | I '$D(^DIC(19,I,10,J,0)) G KILLXR ;kill xref to invalid item
|
|---|
| 62 | L6 ;
|
|---|
| 63 | S M=^DIC(19,I,10,J,0)
|
|---|
| 64 | I (M=L)!(M[L_"^") G L5
|
|---|
| 65 | KILLXR ;
|
|---|
| 66 | KILL ^DIC(19,I,10,K,L,J)
|
|---|
| 67 | I $O(^DIC(19,I,10,K,L,-1))="" KILL ^DIC(19,I,10,K,L)
|
|---|
| 68 | G L5
|
|---|
| 69 | ;
|
|---|
| 70 | ; ----------------------------------------------------------
|
|---|
| 71 | ;
|
|---|
| 72 | HFFIX ; Fix dangling pointers on help frame file
|
|---|
| 73 | NEW I,J,K,L,X,Y
|
|---|
| 74 | S (X,I)=0
|
|---|
| 75 | F S I=$O(^DIC(9.2,I)) Q:I'>0 I $D(^(I,2)) D HF1,HF2,HF3
|
|---|
| 76 | D RSLT(X_" pointer"_$S(X=1:"",1:"s")_" fixed in your HELP FRAME file.")
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | HF1 ;
|
|---|
| 80 | S (Y,J)=0
|
|---|
| 81 | F S J=$O(^DIC(9.2,I,2,J)) Q:J'>0 I $D(^(J,0)) S K=$P(^(0),U,2),Y=Y+1 I $L(K),'$D(^DIC(9.2,K)) S Y=Y-1,X=X+1 K ^DIC(9.2,I,2,J,0)
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | HF2 ;
|
|---|
| 85 | S (K,J)=0
|
|---|
| 86 | F S J=$O(^DIC(9.2,I,2,J)) Q:J'>0 S K=J
|
|---|
| 87 | S J=^DIC(9.2,I,2,0),^(0)=$P(J,U,1,2)_U_K_U_Y
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | HF3 ;
|
|---|
| 91 | S K=":"
|
|---|
| 92 | F S K=$O(^DIC(9.2,I,2,K)) Q:K="" S J=-1 F S J=$O(^DIC(9.2,I,2,K,J)) Q:J="" D HF4
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | HF4 ;
|
|---|
| 96 | S L=0
|
|---|
| 97 | F S L=$O(^DIC(9.2,I,2,K,J,L)) Q:L'>0 I '$D(^DIC(9.2,I,2,L,0)) K ^DIC(9.2,I,2,K,J,L)
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | ; ----------------------------------------------------------
|
|---|
| 101 | ;
|
|---|
| 102 | PFIX ;Kill any dangling pointers in the PROTOCOL File (#101)
|
|---|
| 103 | NEW I,J,K,L,M,X,Y
|
|---|
| 104 | S (I,X)=0 ;X=Total Deletions
|
|---|
| 105 | P1 ;
|
|---|
| 106 | S I=$O(^ORD(101,I))
|
|---|
| 107 | I I>0 S (Y,J)=0 G P2 ;Loop through protocols
|
|---|
| 108 | D RSLT(X_" pointer"_$S(X=1:"",1:"s")_" fixed in your PROTOCOL file.")
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | P2 ;
|
|---|
| 112 | S J=$O(^ORD(101,I,10,J))
|
|---|
| 113 | I J>0 G PITEM ;Loop through items
|
|---|
| 114 | I '$D(^ORD(101,I,10,0)) G P1
|
|---|
| 115 | S (K,J)=0
|
|---|
| 116 | F L=1:1 S J=$O(^ORD(101,I,10,J)) Q:J'>0 S K=J ;K=Last item
|
|---|
| 117 | S J=^ORD(101,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
|
|---|
| 118 | G PXREFS
|
|---|
| 119 | ;
|
|---|
| 120 | PITEM ;
|
|---|
| 121 | S K=+^ORD(101,I,10,J,0)
|
|---|
| 122 | I $D(^ORD(101,K,0)) S Y=Y+1 G P2 ;Y=No. of items
|
|---|
| 123 | D RSLT("Protocol "_$P(^ORD(101,I,0),U,1)_" points to missing option "_K)
|
|---|
| 124 | S X=X+1
|
|---|
| 125 | KILL ^ORD(101,I,10,J) ;Kill invalid menu item
|
|---|
| 126 | G P2
|
|---|
| 127 | ;
|
|---|
| 128 | PXREFS ;
|
|---|
| 129 | S K=":"
|
|---|
| 130 | P3 ;
|
|---|
| 131 | S K=$O(^ORD(101,I,10,K))
|
|---|
| 132 | I K="" G P1 ;Loop through cross references
|
|---|
| 133 | S L=-1
|
|---|
| 134 | P4 ;
|
|---|
| 135 | S L=$O(^ORD(101,I,10,K,L))
|
|---|
| 136 | I L="" G P3
|
|---|
| 137 | S J=0
|
|---|
| 138 | P5 ;
|
|---|
| 139 | S J=$O(^ORD(101,I,10,K,L,J))
|
|---|
| 140 | I J'>0 G P4
|
|---|
| 141 | I '$D(^ORD(101,I,10,J,0)) G PKILLXR ;kill xref to invalid item
|
|---|
| 142 | P6 ;
|
|---|
| 143 | S M=^ORD(101,I,10,J,0)
|
|---|
| 144 | I (M=L)!(M[L_"^") G P5
|
|---|
| 145 | PKILLXR ;
|
|---|
| 146 | KILL ^ORD(101,I,10,K,L,J)
|
|---|
| 147 | I $O(^ORD(101,I,10,K,L,-1))="" KILL ^ORD(101,I,10,K,L)
|
|---|
| 148 | G P5
|
|---|
| 149 | ;
|
|---|
| 150 | RSLT(%) S ^(0)=$G(^TMP("XBDANGLE",$J,0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q
|
|---|
| 151 | ;
|
|---|
| 152 | ;
|
|---|
| 153 | INIT ; Set up.
|
|---|
| 154 | NEW XMSUB,XMDUZ,XMTEXT,XMY
|
|---|
| 155 | KILL ^TMP("XBDANGLE",$J)
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | MAIL ; Send a note to local programmers 'bout these results.
|
|---|
| 159 | S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""XBDANGLE"",$J,",XMY(DUZ)=""
|
|---|
| 160 | F %="XUPROGMODE" D SINGLE(%)
|
|---|
| 161 | D ^XMD
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | EXIT ;
|
|---|
| 165 | KILL ^TMP("XBDANGLE",$J)
|
|---|
| 166 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 167 | Q
|
|---|
| 168 | ;
|
|---|
| 169 | SINGLE(K) ; Get holders of a single key K.
|
|---|
| 170 | NEW Y
|
|---|
| 171 | S Y=0
|
|---|
| 172 | Q:'$D(^XUSEC(K))
|
|---|
| 173 | F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
|
|---|
| 174 | Q
|
|---|
| 175 | ;
|
|---|
