source: IHS-VA_UTILITIES-XB/trunk/XBDANGLE.m@ 1061

Last change on this file since 1061 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 4.2 KB
Line 
1XBDANGLE ;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 ;
22OFIX ;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
25L1 ;
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 ;
31L2 ;
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 ;
40ITEM ;
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 ;
48XREFS ;
49 S K=":"
50L3 ;
51 S K=$O(^DIC(19,I,10,K))
52 I K="" G L1 ;Loop through cross references
53 S L=-1
54L4 ;
55 S L=$O(^DIC(19,I,10,K,L))
56 I L="" G L3
57 S J=0
58L5 ;
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
62L6 ;
63 S M=^DIC(19,I,10,J,0)
64 I (M=L)!(M[L_"^") G L5
65KILLXR ;
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 ;
72HFFIX ; 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 ;
79HF1 ;
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 ;
84HF2 ;
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 ;
90HF3 ;
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 ;
95HF4 ;
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 ;
102PFIX ;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
105P1 ;
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 ;
111P2 ;
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 ;
120PITEM ;
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 ;
128PXREFS ;
129 S K=":"
130P3 ;
131 S K=$O(^ORD(101,I,10,K))
132 I K="" G P1 ;Loop through cross references
133 S L=-1
134P4 ;
135 S L=$O(^ORD(101,I,10,K,L))
136 I L="" G P3
137 S J=0
138P5 ;
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
142P6 ;
143 S M=^ORD(101,I,10,J,0)
144 I (M=L)!(M[L_"^") G P5
145PKILLXR ;
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 ;
150RSLT(%) S ^(0)=$G(^TMP("XBDANGLE",$J,0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q
151 ;
152 ;
153INIT ; Set up.
154 NEW XMSUB,XMDUZ,XMTEXT,XMY
155 KILL ^TMP("XBDANGLE",$J)
156 Q
157 ;
158MAIL ; 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 ;
164EXIT ;
165 KILL ^TMP("XBDANGLE",$J)
166 I $D(ZTQUEUED) S ZTREQ="@" Q
167 Q
168 ;
169SINGLE(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 ;
Note: See TracBrowser for help on using the repository browser.