source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ3.m@ 701

Last change on this file since 701 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 3.8 KB
Line 
1XQ3 ;LL/THM,SF/GJL,SEA/JLI - CLEANUP DANGLING POINTERS IN OPTION OR HELP FRAME FILES ;04/21/98 13:20
2 ;;8.0;KERNEL;**80**;Jul 10, 1995
3 Q
4ENASK ;Ask to fix up dirty OPTION/HELP FRAME File
5 I '$D(%) W !,$C(7),"ENTRY MUST BE WITH THE VARIABLE '%' SET TO INDICATE DESIRED FILE.",$C(7),! Q
6 S XQFL=$S(%=1:"OPTION",%=2:"PROTOCOL",1:"HELP FRAME")
7 W !,"Do you want to remove any 'Dangling Pointers' from your ",XQFL," File? Y// " R X:$S($D(DTIME):DTIME,1:300) I '$T Q
8 W ! I X="" S X="Y"
9 I X["?" G SYNTAX
10 I X["^" S X="^" Q
11STRIP I X'="",X'?1A.E S X=$E(X,2,256) G STRIP
12 S X=$E(X,1) I X="" G SYNTAX
13 I "Nn"[X S X="N" Q
14 I "Yy"[X W !,"PLEASE WAIT while I check this out . . . " G REMOVE
15SYNTAX W ! I X'["?" W ?11,"I'm sorry, but I don't understand your answer. Please"
16 W !,"Enter: YES (or press the RETURN key) if you want me to remove from"
17 W !,?11,"your ",XQFL," File any pointers left over from incompletely"
18 W !,?11,"deleted ",XQFL,". If such pointers do exist and are not"
19 W !,?11,"removed, the ",XQFL," File (i.e. the menus) could become"
20 W !,?11,"messed up by an INIT."
21 W !!,"Enter: NO or ^ to continue on without effecting the ",XQFL," File."
22 W ! G ENASK
23REMOVE D:%=1 ENFIX D:%=2 PFIX D:'% HFFIX W !,"Your ",XQFL," File is OK " I 'X W "(no bad pointers)."
24 E W "now (",X," pointer" W:X>1 "s" W " fixed)."
25 W ! S X="Y" Q
26ENFIX ;Kill any dangling pointers in the OPTION File (#19)
27 S (I,X)=0 ;X=Total Deletions
28L1 S I=$O(^DIC(19,I)) I I>0 S (Y,J)=0 G L2 ;Loop through menus
29 Q
30L2 S J=$O(^DIC(19,I,10,J)) I J>0 G ITEM ;Loop through menu items
31 I '$D(^DIC(19,I,10,0)) G L1
32 S (K,J)=0 F L=1:1 S J=$O(^DIC(19,I,10,J)) Q:J'>0 S K=J ;K=Last item
33 S J=^DIC(19,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
34 G XREFS
35ITEM S K=+^DIC(19,I,10,J,0) I $D(^DIC(19,K,0)) S Y=Y+1 G L2 ;Y=No. of items
36 W !,"Option ",$P(^DIC(19,I,0),U,1)," points to missing option ",K
37 S X=X+1 K ^DIC(19,I,10,J) ;Kill invalid menu item
38 G L2
39XREFS S K=":"
40L3 S K=$O(^DIC(19,I,10,K)) I K="" G L1 ;Loop through cross references
41 S L=-1
42L4 S L=$O(^DIC(19,I,10,K,L)) I L="" G L3
43 S J=0
44L5 S J=$O(^DIC(19,I,10,K,L,J)) I J'>0 G L4
45 I '$D(^DIC(19,I,10,J,0)) G KILLXR ;kill xref to invalid item
46L6 S M=^DIC(19,I,10,J,0) I (M=L)!(M[L_"^") G L5
47KILLXR K ^DIC(19,I,10,K,L,J) I $O(^DIC(19,I,10,K,L,-1))="" K ^DIC(19,I,10,K,L)
48 G L5
49HFFIX ; Fix dangling pointers on help frame file
50 S (X,I)=0 F S I=$O(^DIC(9.2,I)) Q:I'>0 I $D(^(I,2)) D HF1,HF2,HF3
51 Q
52HF1 S (Y,J)=0 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)
53 Q
54HF2 S (K,J)=0 F S J=$O(^DIC(9.2,I,2,J)) Q:J'>0 S K=J
55 S J=^DIC(9.2,I,2,0),^(0)=$P(J,U,1,2)_U_K_U_Y
56 Q
57HF3 S K=":" 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
58 Q
59HF4 S JJ=0 F S JJ=$O(^DIC(9.2,I,2,K,J,JJ)) Q:JJ'>0 I '$D(^DIC(9.2,I,2,JJ,0)) K ^DIC(9.2,I,2,K,J,JJ)
60 Q
61PFIX ;Kill any dangling pointers in the PROTOCOL File (#101)
62 S (I,X)=0 ;X=Total Deletions
63P1 S I=$O(^ORD(101,I)) I I>0 S (Y,J)=0 G P2 ;Loop through protocols
64 Q
65P2 S J=$O(^ORD(101,I,10,J)) I J>0 G PITEM ;Loop through items
66 I '$D(^ORD(101,I,10,0)) G P1
67 S (K,J)=0 F L=1:1 S J=$O(^ORD(101,I,10,J)) Q:J'>0 S K=J ;K=Last item
68 S J=^ORD(101,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
69 G PXREFS
70PITEM S K=+^ORD(101,I,10,J,0) I $D(^ORD(101,K,0)) S Y=Y+1 G P2 ;Y=No. of items
71 W !,"Option ",$P(^ORD(101,I,0),U,1)," points to missing option ",K
72 S X=X+1 K ^ORD(101,I,10,J) ;Kill invalid menu item
73 G P2
74PXREFS S K=":"
75P3 S K=$O(^ORD(101,I,10,K)) I K="" G P1 ;Loop through cross references
76 S L=-1
77P4 S L=$O(^ORD(101,I,10,K,L)) I L="" G P3
78 S J=0
79P5 S J=$O(^ORD(101,I,10,K,L,J)) I J'>0 G P4
80 I '$D(^ORD(101,I,10,J,0)) G PKILLXR ;kill xref to invalid item
81P6 S M=^ORD(101,I,10,J,0) I (M=L)!(M[L_"^") G P5
82PKILLXR K ^ORD(101,I,10,K,L,J) I $O(^ORD(101,I,10,K,L,-1))="" K ^ORD(101,I,10,K,L)
83 G P5
Note: See TracBrowser for help on using the repository browser.