Changeset 636 for FOIAVistA/tag/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

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/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 (modified) (2 diffs)

FOIAVistA/tag/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

@@ -1 @@
-XQ3 ;LL/THM,SF/GJL,SEA/JLI - CLEANUP DANGLING POINTERS IN OPTION OR HELP FRAME FILES ;04/30/08  17:06
- ;;8.0;KERNEL;**80,501**;Jul 10, 1995;Build 1
+XQ3 ;LL/THM,SF/GJL,SEA/JLI - CLEANUP DANGLING POINTERS IN OPTION OR HELP FRAME FILES ;04/21/98  13:20
+ ;;8.0;KERNEL;**80**;Jul 10, 1995
  Q
 ENASK ;Ask to fix up dirty OPTION/HELP FRAME File
- N IX,XUT,J,K,XQFL,X
  I '$D(%) W !,$C(7),"ENTRY MUST BE WITH THE VARIABLE '%' SET TO INDICATE DESIRED FILE.",$C(7),! Q
  S XQFL=$S(%=1:"OPTION",%=2:"PROTOCOL",1:"HELP FRAME")
@@ -22 +21 @@
  W !!,"Enter:  NO or ^ to continue on without effecting the ",XQFL," File."
  W ! G ENASK
-REMOVE D:%=1 OPFIX D:%=2 PFIX D:'% HFFIX W !,"Your ",XQFL," File is OK " I 'XUT W "(no bad pointers)."
- E  W "now (",XUT," pointer" W:XUT>1 "s" W " fixed)."
- W ! S X="Y"
+REMOVE D:%=1 ENFIX D:%=2 PFIX D:'% HFFIX W !,"Your ",XQFL," File is OK " I 'X W "(no bad pointers)."
+ E  W "now (",X," pointer" W:X>1 "s" W " fixed)."
+ W ! S X="Y" Q
+ENFIX ;Kill any dangling pointers in the OPTION File (#19)
+ S (I,X)=0 ;X=Total Deletions
+L1 S I=$O(^DIC(19,I)) I I>0 S (Y,J)=0 G L2 ;Loop through menus
  Q
-OPFIX ;Kill any dangling pointers in the OPTION File (#19)
- N %,IX,J,XQ3
- S (IX,XUT)=0 ;XUT=Total Deletions
- F  S IX=$O(^DIC(19,IX)) Q:'IX  W:'(IX#100) ". " S (XQ3,J)=0 D L2 ;Loop through Options
- D NPF
+L2 S J=$O(^DIC(19,I,10,J)) I J>0 G ITEM ;Loop through menu items
+ I '$D(^DIC(19,I,10,0)) G L1
+ 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
+ S J=^DIC(19,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
+ G XREFS
+ITEM S K=+^DIC(19,I,10,J,0) I $D(^DIC(19,K,0)) S Y=Y+1 G L2 ;Y=No. of items
+ W !,"Option ",$P(^DIC(19,I,0),U,1)," points to missing option ",K
+ S X=X+1 K ^DIC(19,I,10,J) ;Kill invalid menu item
+ G L2
+XREFS S K=":"
+L3 S K=$O(^DIC(19,I,10,K)) I K="" G L1 ;Loop through cross references
+ S L=-1
+L4 S L=$O(^DIC(19,I,10,K,L)) I L="" G L3
+ S J=0
+L5 S J=$O(^DIC(19,I,10,K,L,J)) I J'>0 G L4
+ I '$D(^DIC(19,I,10,J,0)) G KILLXR ;kill xref to invalid item
+L6 S M=^DIC(19,I,10,J,0) I (M=L)!(M[L_"^") G L5
+KILLXR K ^DIC(19,I,10,K,L,J) I $O(^DIC(19,I,10,K,L,-1))="" K ^DIC(19,I,10,K,L)
+ G L5
+HFFIX ; Fix dangling pointers on help frame file
+ S (X,I)=0 F  S I=$O(^DIC(9.2,I)) Q:I'>0  I $D(^(I,2)) D HF1,HF2,HF3
  Q
-L2 ;One Option
- I '$D(^DIC(19,IX,10,0)) Q  ;Not a Menu
- K ^DIC(19,IX,10,"B") ;Rebuild "B" X-ref
- F  S J=$O(^DIC(19,IX,10,J)) Q:'J  D ITEM ;Loop through menu items
- S (K,J)=0 F  S J=$O(^DIC(19,IX,10,J)) Q:J'>0  S K=J ;K=Last item
- S J=^DIC(19,IX,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_XQ3 ;fix counters
+HF1 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)
  Q
- ;
-ITEM ;One Menu item
- N DA,DIK
- S K=+^DIC(19,IX,10,J,0)
- I $D(^DIC(19,K,0)) S XQ3=XQ3+1,^DIC(19,IX,10,"B",K,J)="" Q  ;Y=No. of items
- W !,"Option ",$P(^DIC(19,IX,0),U,1)," points to missing option ",K
- ;S XUT=XUT+1 K ^DIC(19,IX,10,J) ;Kill invalid menu item
- S XUT=XUT+1,DIK="^DIC(19,DA(1),10,",DA=J,DA(1)=IX D ^DIK ;Trigger Menu-rebuild
+HF2 S (K,J)=0 F  S J=$O(^DIC(9.2,I,2,J)) Q:J'>0  S K=J
+ S J=^DIC(9.2,I,2,0),^(0)=$P(J,U,1,2)_U_K_U_Y
  Q
- ;
-NPF ;Fix the New Person File Option Pointers
- N IX,I2,J,P,DIK,DIE,DR,DA,XUT
- S (XUT,IX)=0
- F  S IX=$O(^VA(200,IX)) Q:'IX  D
- . S P=+$G(^VA(200,IX,201))
- . I P,'$D(^DIC(19,P,0)) D
- . . W !,"User: ",$P(^VA(200,IX,0),U),", Primary Menu points to missing option ",P
- . . S XUT=XUT+1,DIE="^VA(200,",DA=IX,DR="201///@" D ^DIE
- . . Q
- . S I2=0
- . F  S I2=$O(^VA(200,IX,203,I2)) Q:'I2  D
- . . S P=+$G(^VA(200,IX,203,I2,0))
- . . I P,'$D(^DIC(19,P,0)) D
- . . . W !,"User: ",$P(^VA(200,IX,0),U),", Secondary Menu points to missing option ",P
- . . . S XUT=XUT+1,DIK="^VA(200,DA(1),203,",DA=I2,DA(1)=IX D ^DIK
- . . . Q
- . . Q
- . Q
- I XUT W !,"Menu pointers fixed."
+HF3 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
  Q
-HFFIX ; Fix dangling pointers on help frame file
- N %
- S (XUT,IX)=0 F  S IX=$O(^DIC(9.2,IX)) Q:IX'>0  I $D(^(IX,2)) D HF1,HF2,HF3
- Q
-HF1 S (Y,J)=0 F  S J=$O(^DIC(9.2,IX,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,XUT=XUT+1 K ^DIC(9.2,IX,2,J,0)
- Q
-HF2 S (K,J)=0 F  S J=$O(^DIC(9.2,IX,2,J)) Q:J'>0  S K=J
- S J=^DIC(9.2,IX,2,0),^(0)=$P(J,U,1,2)_U_K_U_Y
- Q
-HF3 S K=":" F  S K=$O(^DIC(9.2,IX,2,K)) Q:K=""  S J=-1 F  S J=$O(^DIC(9.2,IX,2,K,J)) Q:J=""  D HF4
- Q
-HF4 S JJ=0 F  S JJ=$O(^DIC(9.2,IX,2,K,J,JJ)) Q:JJ'>0  I '$D(^DIC(9.2,IX,2,JJ,0)) K ^DIC(9.2,IX,2,K,J,JJ)
+HF4 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)
  Q
 PFIX ;Kill any dangling pointers in the PROTOCOL File (#101)
- N %
- S (IX,XUT)=0 ;XUT=Total Deletions
-P1 S IX=$O(^ORD(101,IX)) I IX>0 S (Y,J)=0 G P2 ;Loop through protocols
+ S (I,X)=0 ;X=Total Deletions
+P1 S I=$O(^ORD(101,I)) I I>0 S (Y,J)=0 G P2 ;Loop through protocols
  Q
-P2 S J=$O(^ORD(101,IX,10,J)) I J>0 G PITEM ;Loop through items
- I '$D(^ORD(101,IX,10,0)) G P1
- S (K,J)=0 F L=1:1 S J=$O(^ORD(101,IX,10,J)) Q:J'>0  S K=J ;K=Last item
- S J=^ORD(101,IX,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
+P2 S J=$O(^ORD(101,I,10,J)) I J>0 G PITEM ;Loop through items
+ I '$D(^ORD(101,I,10,0)) G P1
+ 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
+ S J=^ORD(101,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
  G PXREFS
-PITEM S K=+^ORD(101,IX,10,J,0) I $D(^ORD(101,K,0)) S Y=Y+1 G P2 ;Y=No. of items
- W !,"Protocol ",$P(^ORD(101,IX,0),U,1)," points to missing protocol ",K
- ;S XUT=XUT+1 K ^ORD(101,IX,10,J) ;Kill invalid menu item
- S XUT=XUT+1,DIK="^ORD(101,IX,10,",DA=J,DA(1)=IX D ^DIK ;Delete invalid menu item
+PITEM S K=+^ORD(101,I,10,J,0) I $D(^ORD(101,K,0)) S Y=Y+1 G P2 ;Y=No. of items
+ W !,"Option ",$P(^ORD(101,I,0),U,1)," points to missing option ",K
+ S X=X+1 K ^ORD(101,I,10,J) ;Kill invalid menu item
  G P2
 PXREFS S K=":"
-P3 S K=$O(^ORD(101,IX,10,K)) I K="" G P1 ;Loop through cross references
+P3 S K=$O(^ORD(101,I,10,K)) I K="" G P1 ;Loop through cross references
  S L=-1
-P4 S L=$O(^ORD(101,IX,10,K,L)) I L="" G P3
+P4 S L=$O(^ORD(101,I,10,K,L)) I L="" G P3
  S J=0
-P5 S J=$O(^ORD(101,IX,10,K,L,J)) I J'>0 G P4
- I '$D(^ORD(101,IX,10,J,0)) G PKILLXR ;kill xref to invalid item
-P6 S M=^ORD(101,IX,10,J,0) I (M=L)!(M[L_"^") G P5
-PKILLXR K ^ORD(101,IX,10,K,L,J) I $O(^ORD(101,IX,10,K,L,-1))="" K ^ORD(101,IX,10,K,L)
+P5 S J=$O(^ORD(101,I,10,K,L,J)) I J'>0 G P4
+ I '$D(^ORD(101,I,10,J,0)) G PKILLXR ;kill xref to invalid item
+P6 S M=^ORD(101,I,10,J,0) I (M=L)!(M[L_"^") G P5
+PKILLXR K ^ORD(101,I,10,K,L,J) I $O(^ORD(101,I,10,K,L,-1))="" K ^ORD(101,I,10,K,L)
  G P5