Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBDANGLE

XBDANGLE.m

Go to the documentation of this file. 
  1. XBDANGLE ;IHS/SET/GTH - Q'ABLE CLEANUP DANGLING POINTERS OPTION HELP FRAME PROTOCOL FILES ; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1.  ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cleanup dangling pointers.
  1.  ;
  1.  ; This utility can be scheduled to run via TaskMan.
  1.  ;
  1.  ; Actions are delivered to XUPROG key holders via MailMan.
  1.  ;
  1.  ; You can also run this interactively, but you'll still
  1.  ; get the MailMan note, even after the interactive run.
  1.  ;
  1.  ; Thanks to the VA for the original interactive routine, XQ3.
  1.  ;
  1.  D INIT
  1.  D OFIX,HFFIX,PFIX
  1.  D MAIL
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ; ----------------------------------------------------------
  1.  ;
  1. OFIX ;Kill any dangling pointers in the OPTION File (#19)
  1.  NEW I,J,K,L,M,X,Y
  1.  S (I,X)=0 ;X=Total Deletions
  1. L1 ;
  1.  S I=$O(^DIC(19,I))
  1.  I I>0 S (Y,J)=0 G L2 ;Loop through menus
  1.  D RSLT(X_" pointer"_$S(X=1:"",1:"s")_" fixed in your OPTION file.")
  1.  Q
  1.  ;
  1. L2 ;
  1.  S J=$O(^DIC(19,I,10,J))
  1.  I J>0 G ITEM ;Loop through menu items
  1.  I '$D(^DIC(19,I,10,0)) G L1
  1.  S (K,J)=0
  1.  F L=1:1 S J=$O(^DIC(19,I,10,J)) Q:J'>0  S K=J ;K=Last item
  1.  S J=^DIC(19,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
  1.  G XREFS
  1.  ;
  1. ITEM ;
  1.  S K=+^DIC(19,I,10,J,0)
  1.  I $D(^DIC(19,K,0)) S Y=Y+1 G L2 ;Y=No. of items
  1.  D RSLT("Option "_$P(^DIC(19,I,0),U,1)_" points to missing option "_K)
  1.  S X=X+1
  1.  KILL ^DIC(19,I,10,J) ;Kill invalid menu item
  1.  G L2
  1.  ;
  1. XREFS ;
  1.  S K=":"
  1. L3 ;
  1.  S K=$O(^DIC(19,I,10,K))
  1.  I K="" G L1 ;Loop through cross references
  1.  S L=-1
  1. L4 ;
  1.  S L=$O(^DIC(19,I,10,K,L))
  1.  I L="" G L3
  1.  S J=0
  1. L5 ;
  1.  S J=$O(^DIC(19,I,10,K,L,J))
  1.  I J'>0 G L4
  1.  I '$D(^DIC(19,I,10,J,0)) G KILLXR ;kill xref to invalid item
  1. L6 ;
  1.  S M=^DIC(19,I,10,J,0)
  1.  I (M=L)!(M[L_"^") G L5
  1. KILLXR ;
  1.  KILL ^DIC(19,I,10,K,L,J)
  1.  I $O(^DIC(19,I,10,K,L,-1))="" KILL ^DIC(19,I,10,K,L)
  1.  G L5
  1.  ;
  1.  ; ----------------------------------------------------------
  1.  ;
  1. HFFIX ; Fix dangling pointers on help frame file
  1.  NEW I,J,K,L,X,Y
  1.  S (X,I)=0
  1.  F  S I=$O(^DIC(9.2,I)) Q:I'>0  I $D(^(I,2)) D HF1,HF2,HF3
  1.  D RSLT(X_" pointer"_$S(X=1:"",1:"s")_" fixed in your HELP FRAME file.")
  1.  Q
  1.  ;
  1. HF1 ;
  1.  S (Y,J)=0
  1.  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)
  1.  Q
  1.  ;
  1. HF2 ;
  1.  S (K,J)=0
  1.  F  S J=$O(^DIC(9.2,I,2,J)) Q:J'>0  S K=J
  1.  S J=^DIC(9.2,I,2,0),^(0)=$P(J,U,1,2)_U_K_U_Y
  1.  Q
  1.  ;
  1. HF3 ;
  1.  S K=":"
  1.  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
  1.  Q
  1.  ;
  1. HF4 ;
  1.  S L=0
  1.  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)
  1.  Q
  1.  ;
  1.  ; ----------------------------------------------------------
  1.  ;
  1. PFIX ;Kill any dangling pointers in the PROTOCOL File (#101)
  1.  NEW I,J,K,L,M,X,Y
  1.  S (I,X)=0 ;X=Total Deletions
  1. P1 ;
  1.  S I=$O(^ORD(101,I))
  1.  I I>0 S (Y,J)=0 G P2 ;Loop through protocols
  1.  D RSLT(X_" pointer"_$S(X=1:"",1:"s")_" fixed in your PROTOCOL file.")
  1.  Q
  1.  ;
  1. P2 ;
  1.  S J=$O(^ORD(101,I,10,J))
  1.  I J>0 G PITEM ;Loop through items
  1.  I '$D(^ORD(101,I,10,0)) G P1
  1.  S (K,J)=0
  1.  F L=1:1 S J=$O(^ORD(101,I,10,J)) Q:J'>0  S K=J ;K=Last item
  1.  S J=^ORD(101,I,10,0),^(0)=$P(J,"^",1,2)_"^"_K_"^"_Y ;fix counters
  1.  G PXREFS
  1.  ;
  1. PITEM ;
  1.  S K=+^ORD(101,I,10,J,0)
  1.  I $D(^ORD(101,K,0)) S Y=Y+1 G P2 ;Y=No. of items
  1.  D RSLT("Protocol "_$P(^ORD(101,I,0),U,1)_" points to missing option "_K)
  1.  S X=X+1
  1.  KILL ^ORD(101,I,10,J) ;Kill invalid menu item
  1.  G P2
  1.  ;
  1. PXREFS ;
  1.  S K=":"
  1. P3 ;
  1.  S K=$O(^ORD(101,I,10,K))
  1.  I K="" G P1 ;Loop through cross references
  1.  S L=-1
  1. P4 ;
  1.  S L=$O(^ORD(101,I,10,K,L))
  1.  I L="" G P3
  1.  S J=0
  1. P5 ;
  1.  S J=$O(^ORD(101,I,10,K,L,J))
  1.  I J'>0 G P4
  1.  I '$D(^ORD(101,I,10,J,0)) G PKILLXR ;kill xref to invalid item
  1. P6 ;
  1.  S M=^ORD(101,I,10,J,0)
  1.  I (M=L)!(M[L_"^") G P5
  1. PKILLXR ;
  1.  KILL ^ORD(101,I,10,K,L,J)
  1.  I $O(^ORD(101,I,10,K,L,-1))="" KILL ^ORD(101,I,10,K,L)
  1.  G P5
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("XBDANGLE",$J,0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q
  1.  ;
  1.  ;
  1. INIT ; Set up.
  1.  NEW XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("XBDANGLE",$J)
  1.  Q
  1.  ;
  1. MAIL ; Send a note to local programmers 'bout these results.
  1.  S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""XBDANGLE"",$J,",XMY(DUZ)=""
  1.  F %="XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  Q
  1.  ;
  1. EXIT ;
  1.  KILL ^TMP("XBDANGLE",$J)
  1.  I $D(ZTQUEUED) S ZTREQ="@" Q
  1.  Q
  1.  ;
  1. SINGLE(K) ; Get holders of a single key K.
  1.  NEW Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q
  1.  ;