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

XBCFXREF.m

Go to the documentation of this file. 
  1. XBCFXREF ; IHS/ADC/GTH - CHECK/FIX XREFS ; [ 02/07/97   3:02 PM ]
  1.  ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
  1.  ;
  1.  ; This routine checks all REGULAR xrefs at the file level
  1.  ; for selected files to insure all pointed to entries exist.
  1.  ;
  1. START ;
  1.  D INIT
  1.  I XBCFXREF("QFLG") D EOJ Q
  1.  D FILES
  1.  D EOJ
  1.  Q
  1.  ;
  1. INIT ;
  1.  S XBCFXREF("QFLG")=0
  1.  D ^XBKVAR
  1.  W !,"This routine will check the xrefs for the files you select and display",!,"  all errors found.  You may also delete the bad xrefs."
  1.  W !!,"You should probably capture the output to an aux printer."
  1.  S XBCFXREF("DF")=$$DIR^XBDIR("S^1:DISPLAY ONLY;2:DISPLAY & FIX","","1")
  1.  I $D(DIRUT) S XBCFXREF("QFLG")=1 Q
  1.  D ^XBDSET
  1.  I '$D(^UTILITY("XBDSET")) S XBCFXREF("QFLG")=1 Q
  1.  Q
  1.  ;
  1. FILES ; CHECK FILES
  1.  S XBCFXREF("C")=0
  1.  F XBCFXREF("FILE")=0:0 S XBCFXREF("FILE")=$O(^UTILITY("XBDSET",$J,XBCFXREF("FILE"))) Q:XBCFXREF("FILE")=""  D FILE
  1.  Q
  1.  ;
  1.  ;---------------------------------------------------------------------
  1.  ; Gather up xrefs to check
  1.  ;
  1. FILE ; CHECK ONE FILE
  1.  W !!,"Checking the ",$P(^DIC(XBCFXREF("FILE"),0),U,1)," (",XBCFXREF("FILE"),") file"
  1.  KILL XBCFXREF("TBL")
  1.  S XBCFXREF("XREF")=""
  1.  F  S XBCFXREF("XREF")=$O(^DD(XBCFXREF("FILE"),0,"IX",XBCFXREF("XREF"))) Q:XBCFXREF("XREF")=""  S XBCFXREF("XREF FILE")=$O(^(XBCFXREF("XREF"),0)),XBCFXREF("XREF FIELD")=$O(^(XBCFXREF("XREF FILE"),0)) D
  1.  . S XBCFXREF("TBL",XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"),XBCFXREF("XREF"))=""
  1.  .Q
  1.  I $D(XBCFXREF("TBL")) D XREFILE KILL XBCFXREF("TBL")
  1.  I $D(XBCFXREF("TBL2")) D CHECK KILL XBCFXREF("TBL2")
  1.  Q
  1.  ;
  1. XREFILE ; CHECK EACH FILE/FIELD CREATING XREFS
  1.  F XBCFXREF("XREF FILE")=0:0 S XBCFXREF("XREF FILE")=$O(XBCFXREF("TBL",XBCFXREF("XREF FILE"))) Q:XBCFXREF("XREF FILE")=""  D  D XREFIELD
  1.  . S XBCFXREF("TOP DA")=0,XBCFXREF("PARENT")=""
  1.  . Q:'$D(^DD(XBCFXREF("XREF FILE"),0,"UP"))  ; quit if not subfile
  1.  . NEW SUBFILE,PARENT,FIELD,LVL
  1.  . S SUBFILE=XBCFXREF("XREF FILE"),PARENT="",LVL=1
  1.  . D BACKUP
  1.  . S XBCFXREF("TOP DA")=LVL,XBCFXREF("PARENT")=PARENT
  1.  . Q
  1.  Q
  1.  ;
  1. BACKUP ; BACKUP TREE (CALLED RECURSIVELY)
  1.  S PARENT=^DD(SUBFILE,0,"UP")
  1.  S FIELD=$O(^DD(PARENT,"SB",SUBFILE,""))
  1.  I $D(^DD(PARENT,0,"UP")) S SUBFILE=PARENT,LVL=LVL+1 D BACKUP ; Recurse
  1.  Q
  1.  ;
  1. XREFIELD ; CHECK EACH FIELD CREATING XREFS
  1.  F XBCFXREF("XREF FIELD")=0:0 S XBCFXREF("XREF FIELD")=$O(XBCFXREF("TBL",XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"))) Q:XBCFXREF("XREF FIELD")=""  D XREF
  1.  Q
  1.  ;
  1. XREF ; CHECK XREFS ON FIELD
  1.  NEW G,L,S,X,Y
  1.  KILL XBCFXRT,XBCFXREF("XREFS")
  1.  D ^XBGXREFS(XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"),.XBCFXRT)
  1.  F XBCFXREF("XN")=0:0 S XBCFXREF("XN")=$O(XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN"))) Q:XBCFXREF("XN")=""  S X=XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN")) D
  1.  . Q:$P(X,U,2)=""  ; must be trigger
  1.  . Q:$P(X,U,3)]""  ; not REGULAR xref
  1.  . Q:'$D(XBCFXREF("TBL",XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"),$P(X,U,2)))  ; not of interest
  1.  . Q:'$D(XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN"),"S"))  ; no set
  1.  . S Y=XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN"),"S")
  1.  . I '$F(Y,",DA"),'$F(Y,",D0") D  Q
  1.  .. W !?2,$P(X,U,2)," doesn't use DA or D0.  Skipping."
  1.  .. Q
  1.  . I $F(Y,",D0)=") D SAVE Q
  1.  . I XBCFXREF("PARENT")="",$F(Y,",DA)=") D SAVE Q
  1.  . I XBCFXREF("PARENT")]"" S S=",DA("_XBCFXREF("TOP DA")_"))=" I $F(Y,S) D SAVE Q
  1.  . Q
  1.  KILL XBCFXRT
  1.  Q
  1.  ;
  1. SAVE ; SAVE XREF TO CHECK
  1.  S XBCFXREF("C")=XBCFXREF("C")+1
  1.  S XBCFXREF("TBL2",XBCFXREF("C"))=$P(X,U,2) ; save it
  1.  Q
  1.  ;
  1.  ;---------------------------------------------------------------------
  1.  ; Check data global for xrefs previously gathered
  1.  ;
  1. CHECK ; CHECK DATA GLOBAL FOR XREFS
  1.  W !!,"  Checking the following xrefs:"
  1.  NEW I
  1.  F I=0:0 S I=$O(XBCFXREF("TBL2",I)) Q:I=""  W:$X>73 ! W "  ",XBCFXREF("TBL2",I)
  1.  F XBCFXREF("C")=0:0 S XBCFXREF("C")=$O(XBCFXREF("TBL2",XBCFXREF("C"))) Q:XBCFXREF("C")=""  S XBCFXREF("XREF")=XBCFXREF("TBL2",XBCFXREF("C")) D CHKXREF
  1.  Q
  1.  ;
  1. CHKXREF ; CHECK ONE XREF
  1.  W !!,"  Checking the """,XBCFXREF("XREF"),""" xref."
  1.  NEW G,L,R,V,X,Y
  1.  S X=XBCFXREF("XREF")
  1.  S G=^DIC(XBCFXREF("FILE"),0,"GL"),R=G_""""_X_""",",X=$E(R,1,$L(R)-1)_")",L=$L(R)
  1.  F  S X=$Q(@X) Q:$E(X,1,L)'=R  D
  1.  . Q:@X  ; quit if mnemonic xref
  1.  . S Y=+$P(X,",",$L(X,","))
  1.  . Q:$D(@(G_Y_",0)"))
  1.  . W !?4,$$MSMZR^ZIBNSSV," does not exist.",!?6,"XREF node=",X
  1.  . I XBCFXREF("DF")=2 KILL @X W " deleted."
  1.  .Q
  1.  Q
  1.  ;
  1.  ;---------------------------------------------------------------------
  1. EOJ ;
  1.  KILL ^UTILITY("XBDSET",$J)
  1.  KILL XBCFXREF,XBCFXRT
  1.  KILL DIRUT,DUOUT,DTOUT
  1.  W !!,"All done",!
  1.  Q
  1.  ;