source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYMBT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 931 bytes
RevLine 
[613]1DGYMBT ;ALB/REW - DGBT(392,B) X-REF CLEANUP - 12/9/94
2 ;;5.3;Registration;**35**;Aug 13, 1993
3EN ; remove corrupt pointers from B x-REF OF DGBT(392,
4 ;
5 ; Optional input:
6 ; DGNOKILL - If set to 1 will show corrupt nodes w/o deleting
7 ; this is killed at end of routine
8 ;
9 N DGBTFL,DGBTIEN,DGBT
10 W !,"Searching for corrupt 'B' cross-reference entries ...",!
11 S DGBTFL=0
12 S DGBT="" F S DGBT=$O(^DGBT(392,"B",DGBT)) Q:DGBT=+DGBT D CLEAN
13 S DGBT=9999999.9999 F S DGBT=$O(^DGBT(392,"B",DGBT)) Q:DGBT="" D CLEAN
14 W:'DGBTFL !!?5,"...None found."
15 W !!,"Done."
16 K DGNOKILL
17 Q
18CLEAN ;
19 S DGBTFL=1
20 S DGBTIEN=$O(^DGBT(392,"B",DGBT,""))
21 W !,?5,"Bad cross-reference: ^DGBT(392,""B"",",DGBT,",",DGBTIEN,")"
22 I DGBTIEN'=DGBT!(DGBT=+DGBT)!(DGBT'>0) D
23 .W !?5,"Non-standard corruption. Please review above record and remove manually."
24 E D
25 .Q:$G(DGNOKILL)
26 .K ^DGBT(392,DGBT)
27 .K ^DGBT(392,"B",DGBT)
28 .W ?50,"...deleted."
29 Q
Note: See TracBrowser for help on using the repository browser.