DGYMBT ;ALB/REW - DGBT(392,B) X-REF CLEANUP - 12/9/94
;;5.3;Registration;**35,1015**;Aug 13, 1993;Build 21
EN ; remove corrupt pointers from B x-REF OF DGBT(392,
;
; Optional input:
; DGNOKILL - If set to 1 will show corrupt nodes w/o deleting
; this is killed at end of routine
;
N DGBTFL,DGBTIEN,DGBT
W !,"Searching for corrupt 'B' cross-reference entries ...",!
S DGBTFL=0
S DGBT="" F S DGBT=$O(^DGBT(392,"B",DGBT)) Q:DGBT=+DGBT D CLEAN
S DGBT=9999999.9999 F S DGBT=$O(^DGBT(392,"B",DGBT)) Q:DGBT="" D CLEAN
W:'DGBTFL !!?5,"...None found."
W !!,"Done."
K DGNOKILL
Q
CLEAN ;
S DGBTFL=1
S DGBTIEN=$O(^DGBT(392,"B",DGBT,""))
W !,?5,"Bad cross-reference: ^DGBT(392,""B"",",DGBT,",",DGBTIEN,")"
I DGBTIEN'=DGBT!(DGBT=+DGBT)!(DGBT'>0) D
.W !?5,"Non-standard corruption. Please review above record and remove manually."
E D
.Q:$G(DGNOKILL)
.K ^DGBT(392,DGBT)
.K ^DGBT(392,"B",DGBT)
.W ?50,"...deleted."
Q
DGYMBT ;ALB/REW - DGBT(392,B) X-REF CLEANUP - 12/9/94
+1 ;;5.3;Registration;**35,1015**;Aug 13, 1993;Build 21
EN ; remove corrupt pointers from B x-REF OF DGBT(392,
+1 ;
+2 ; Optional input:
+3 ; DGNOKILL - If set to 1 will show corrupt nodes w/o deleting
+4 ; this is killed at end of routine
+5 ;
+6 NEW DGBTFL,DGBTIEN,DGBT
+7 WRITE !,"Searching for corrupt 'B' cross-reference entries ...",!
+8 SET DGBTFL=0
+9 SET DGBT=""
FOR
SET DGBT=$ORDER(^DGBT(392,"B",DGBT))
IF DGBT=+DGBT
QUIT
DO CLEAN
+10 SET DGBT=9999999.9999
FOR
SET DGBT=$ORDER(^DGBT(392,"B",DGBT))
IF DGBT=""
QUIT
DO CLEAN
+11 IF 'DGBTFL
WRITE !!?5,"...None found."
+12 WRITE !!,"Done."
+13 KILL DGNOKILL
+14 QUIT
CLEAN ;
+1 SET DGBTFL=1
+2 SET DGBTIEN=$ORDER(^DGBT(392,"B",DGBT,""))
+3 WRITE !,?5,"Bad cross-reference: ^DGBT(392,""B"",",DGBT,",",DGBTIEN,")"
+4 IF DGBTIEN'=DGBT!(DGBT=+DGBT)!(DGBT'>0)
Begin DoDot:1
+5 WRITE !?5,"Non-standard corruption. Please review above record and remove manually."
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 IF $GET(DGNOKILL)
QUIT
+8 KILL ^DGBT(392,DGBT)
+9 KILL ^DGBT(392,"B",DGBT)
+10 WRITE ?50,"...deleted."
End DoDot:1
+11 QUIT