DGYMBT ;ALB/REW - DGBT(392,B) X-REF CLEANUP - 12/9/94
 ;;5.3;Registration;**35**;Aug 13, 1993
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
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYMBT   960     printed  Sep 23, 2025@20:36:11                                                                                                                                                                                                       Page 2
DGYMBT    ;ALB/REW - DGBT(392,B) X-REF CLEANUP - 12/9/94
 +1       ;;5.3;Registration;**35**;Aug 13, 1993
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