Routine: XBRESID

XBRESID ; IHS/ADC/GTH - CLEAN UP RESIDUAL ENTRIES IN ^DD ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ; This routine deletes residual entries in ^DD by a range of

 ; dictionary numbers.  A residual entry is one that has no

 ; parent.  The process is reiterative, so an entry who has a

 ; parent in ^DD, but the parent is deleted because it has no

 ; parent, will also be deleted.  The parent of an entry in

 ; ^DD is defined as another entry in ^DD for sub-files, and

 ; an entry in ^DIC for primary files.

 ; The range of dictionary numbers is inclusive but residual

 ; entries for the high file number will not be deleted at

 ; the sub-file level.  This is because sub-files are numbered

 ; with the primary file number with decimal numbers appended.

 ; The terminating check is ^DD entry greater than high file

 ; number specified, so by definition all sub-files for the

 ; high number are greater than the high number.

 ; This routine can be called by another routine by setting

 ; XBRLO and XBRHI and then D EN1^XBRESID.

START ;

 W !!,"This program deletes residual entries in ^DD by a range of dictionary numbers.",!!

LO ;

 R !,"Enter low  dictionary number: ",XBRLO:$G(DTIME,999)

 Q:XBRLO'=+XBRLO

HI ;

 R !,"Enter high dictionary number: ",XBRHI:$G(DTIME,999)

 Q:XBRHI'=+XBRHI!(XBRHI'>XBRLO)

EN1 ;PEP - Clean residual entries in ^DD(.  Hi/Lo file numbers must be set.

 I $D(XBRLO),$D(XBRHI),XBRLO=+XBRLO,XBRHI=+XBRHI,XBRHI>XBRLO,XBRLO'<2 G RESID

 W !!,"XBRLO and/or XBRHI missing or invalid!"

 G EOJ

RESID ;

 W !!,"Now checking for residual ^DD entries within range.",!

LOOP ;

 KILL ^TMP("XBRESID",$J)

 S XBRFILE=(XBRLO-.00000001)

 F XBRL=0:0 S XBRFILE=$O(^DD(XBRFILE)) Q:XBRFILE>XBRHI!(XBRFILE'=+XBRFILE)  D CHK

 S XBRFILE=0

 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"

 S (XBRFILE,XBRY)=0

 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)

 G:XBRY LOOP

 G EOJ

CHK ;

 W "."

 Q:$D(^DIC(XBRFILE))

 I $D(^DD(XBRFILE,0,"UP")),^("UP")]"",(^("UP")<XBRLO!(^("UP")>XBRHI)) Q

 S ^TMP("XBRESID",$J,XBRFILE)=$G(^DD(XBRFILE,0,"UP"))

EOJ ;

 D ^XBKTMP

 KILL XBRFILE,XBRHI,XBRL,XBRLO,XBRY

XBRESID   ; IHS/ADC/GTH - CLEAN UP RESIDUAL ENTRIES IN ^DD ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; This routine deletes residual entries in ^DD by a range of

 +4       ; dictionary numbers.  A residual entry is one that has no

 +5       ; parent.  The process is reiterative, so an entry who has a

 +6       ; parent in ^DD, but the parent is deleted because it has no

 +7       ; parent, will also be deleted.  The parent of an entry in

 +8       ; ^DD is defined as another entry in ^DD for sub-files, and

 +9       ; an entry in ^DIC for primary files.

 +10      ;

 +11      ; The range of dictionary numbers is inclusive but residual

 +12      ; entries for the high file number will not be deleted at

 +13      ; the sub-file level.  This is because sub-files are numbered

 +14      ; with the primary file number with decimal numbers appended.

 +15      ; The terminating check is ^DD entry greater than high file

 +16      ; number specified, so by definition all sub-files for the

 +17      ; high number are greater than the high number.

 +18      ;

 +19      ; This routine can be called by another routine by setting

 +20      ; XBRLO and XBRHI and then D EN1^XBRESID.

 +21      ;

START     ;

 +1        WRITE !!,"This program deletes residual entries in ^DD by a range of dictionary numbers.",!!

 +2       ;

LO        ;

 +1        READ !,"Enter low  dictionary number: ",XBRLO:$GET(DTIME,999)

 +2        IF XBRLO'=+XBRLO

               QUIT

HI        ;

 +1        READ !,"Enter high dictionary number: ",XBRHI:$GET(DTIME,999)

 +2        IF XBRHI'=+XBRHI!(XBRHI'>XBRLO)

               QUIT

 +3       ;

EN1       ;PEP - Clean residual entries in ^DD(.  Hi/Lo file numbers must be set.

 +1        IF $DATA(XBRLO)

               IF $DATA(XBRHI)

                   IF XBRLO=+XBRLO

                       IF XBRHI=+XBRHI

                           IF XBRHI>XBRLO

                               IF XBRLO'<2

                                   GOTO RESID

 +2        WRITE !!,"XBRLO and/or XBRHI missing or invalid!"

 +3        GOTO EOJ

 +4       ;

RESID     ;

 +1        WRITE !!,"Now checking for residual ^DD entries within range.",!

LOOP      ;

 +1        KILL ^TMP("XBRESID",$JOB)

 +2        SET XBRFILE=(XBRLO-.00000001)

 +3        FOR XBRL=0:0

               SET XBRFILE=$ORDER(^DD(XBRFILE))

               IF XBRFILE>XBRHI!(XBRFILE'=+XBRFILE)

                   QUIT

               DO CHK

 +4        SET XBRFILE=0

 +5        FOR XBRL=0:0

               SET XBRFILE=$ORDER(^TMP("XBRESID",$JOB,XBRFILE))

               IF XBRFILE=""

                   QUIT

               IF ^(XBRFILE)

                   IF $DATA(^TMP("XBRESID",$JOB,^TMP("XBRESID",$JOB,XBRFILE)))!($DATA(^DIC(^TMP("XBRESID",$JOB,XBRFILE))))

                       SET ^TMP("XBRESID",$JOB,XBRFILE)="I"

 +6        SET (XBRFILE,XBRY)=0

 +7        FOR XBRL=0:0

               SET XBRFILE=$ORDER(^TMP("XBRESID",$JOB,XBRFILE))

               IF XBRFILE=""

                   QUIT

               IF ^TMP("XBRESID",$JOB,XBRFILE)'="I"

                   SET XBRY=1

                   WRITE !,XBRFILE

                   KILL ^DD(XBRFILE)

 +8        IF XBRY

               GOTO LOOP

 +9        GOTO EOJ

 +10      ;

CHK       ;

 +1        WRITE "."

 +2        IF $DATA(^DIC(XBRFILE))

               QUIT

 +3        IF $DATA(^DD(XBRFILE,0,"UP"))

               IF ^("UP")]""

                   IF (^("UP")<XBRLO!(^("UP")>XBRHI))

                       QUIT

 +4        SET ^TMP("XBRESID",$JOB,XBRFILE)=$GET(^DD(XBRFILE,0,"UP"))

 +5        QUIT

 +6       ;

EOJ       ;

 +1        DO ^XBKTMP

 +2        KILL XBRFILE,XBRHI,XBRL,XBRLO,XBRY

 +3        QUIT

 +4       ;

XBRESID.m