| 1 | XBRESID ; IHS/ADC/GTH - CLEAN UP RESIDUAL ENTRIES IN ^DD ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine deletes residual entries in ^DD by a range of
|
|---|
| 5 | ; dictionary numbers. A residual entry is one that has no
|
|---|
| 6 | ; parent. The process is reiterative, so an entry who has a
|
|---|
| 7 | ; parent in ^DD, but the parent is deleted because it has no
|
|---|
| 8 | ; parent, will also be deleted. The parent of an entry in
|
|---|
| 9 | ; ^DD is defined as another entry in ^DD for sub-files, and
|
|---|
| 10 | ; an entry in ^DIC for primary files.
|
|---|
| 11 | ;
|
|---|
| 12 | ; The range of dictionary numbers is inclusive but residual
|
|---|
| 13 | ; entries for the high file number will not be deleted at
|
|---|
| 14 | ; the sub-file level. This is because sub-files are numbered
|
|---|
| 15 | ; with the primary file number with decimal numbers appended.
|
|---|
| 16 | ; The terminating check is ^DD entry greater than high file
|
|---|
| 17 | ; number specified, so by definition all sub-files for the
|
|---|
| 18 | ; high number are greater than the high number.
|
|---|
| 19 | ;
|
|---|
| 20 | ; This routine can be called by another routine by setting
|
|---|
| 21 | ; XBRLO and XBRHI and then D EN1^XBRESID.
|
|---|
| 22 | ;
|
|---|
| 23 | START ;
|
|---|
| 24 | W !!,"This program deletes residual entries in ^DD by a range of dictionary numbers.",!!
|
|---|
| 25 | ;
|
|---|
| 26 | LO ;
|
|---|
| 27 | R !,"Enter low dictionary number: ",XBRLO:$G(DTIME,999)
|
|---|
| 28 | Q:XBRLO'=+XBRLO
|
|---|
| 29 | HI ;
|
|---|
| 30 | R !,"Enter high dictionary number: ",XBRHI:$G(DTIME,999)
|
|---|
| 31 | Q:XBRHI'=+XBRHI!(XBRHI'>XBRLO)
|
|---|
| 32 | ;
|
|---|
| 33 | EN1 ;PEP - Clean residual entries in ^DD(. Hi/Lo file numbers must be set.
|
|---|
| 34 | I $D(XBRLO),$D(XBRHI),XBRLO=+XBRLO,XBRHI=+XBRHI,XBRHI>XBRLO,XBRLO'<2 G RESID
|
|---|
| 35 | W !!,"XBRLO and/or XBRHI missing or invalid!"
|
|---|
| 36 | G EOJ
|
|---|
| 37 | ;
|
|---|
| 38 | RESID ;
|
|---|
| 39 | W !!,"Now checking for residual ^DD entries within range.",!
|
|---|
| 40 | LOOP ;
|
|---|
| 41 | KILL ^TMP("XBRESID",$J)
|
|---|
| 42 | S XBRFILE=(XBRLO-.00000001)
|
|---|
| 43 | F XBRL=0:0 S XBRFILE=$O(^DD(XBRFILE)) Q:XBRFILE>XBRHI!(XBRFILE'=+XBRFILE) D CHK
|
|---|
| 44 | S XBRFILE=0
|
|---|
| 45 | F XBRL=0:0 S XBRFILE=$O(^TMP("XBRESID",$J,XBRFILE)) Q:XBRFILE="" I ^(XBRFILE),$D(^TMP("XBRESID",$J,^TMP("XBRESID",$J,XBRFILE)))!($D(^DIC(^TMP("XBRESID",$J,XBRFILE)))) S ^TMP("XBRESID",$J,XBRFILE)="I"
|
|---|
| 46 | S (XBRFILE,XBRY)=0
|
|---|
| 47 | F XBRL=0:0 S XBRFILE=$O(^TMP("XBRESID",$J,XBRFILE)) Q:XBRFILE="" I ^TMP("XBRESID",$J,XBRFILE)'="I" S XBRY=1 W !,XBRFILE KILL ^DD(XBRFILE)
|
|---|
| 48 | G:XBRY LOOP
|
|---|
| 49 | G EOJ
|
|---|
| 50 | ;
|
|---|
| 51 | CHK ;
|
|---|
| 52 | W "."
|
|---|
| 53 | Q:$D(^DIC(XBRFILE))
|
|---|
| 54 | I $D(^DD(XBRFILE,0,"UP")),^("UP")]"",(^("UP")<XBRLO!(^("UP")>XBRHI)) Q
|
|---|
| 55 | S ^TMP("XBRESID",$J,XBRFILE)=$G(^DD(XBRFILE,0,"UP"))
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | EOJ ;
|
|---|
| 59 | D ^XBKTMP
|
|---|
| 60 | KILL XBRFILE,XBRHI,XBRL,XBRLO,XBRY
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
