DGYMBT.m

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 ---DGYMBT   960     printed  Apr 09, 2024@22:03:36                                                                                                                                                                                                       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