Routine: AURESID

AURESID ; CLEAN UP RESIDUAL ENTRIES IN ^DD [ 04/07/88  2:41 PM ]

 ;  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

 ;  AURLO and AURHI and then D EN1^AURESID

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

LO R !,"Enter low  dictionary number: ",AURLO Q:AURLO'=+AURLO

HI R !,"Enter high dictionary number: ",AURHI Q:AURHI'=+AURHI!(AURHI'>AURLO)

EN1 ; ENTRY POINT FOR CALLING ROUTINE

 I $D(AURLO),$D(AURHI),AURLO=+AURLO,AURHI=+AURHI,AURHI>AURLO,AURLO'<2 G RESID

 W !!,"AURLO and/or AURHI missing or invalid!"

 G EOJ

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

LOOP K ^UTILITY("AURESID",$J) S AURFILE=(AURLO-.00000001) F AURL=0:0 S AURFILE=$O(^DD(AURFILE)) Q:AURFILE>AURHI!(AURFILE'=+AURFILE)  D CHK

 S AURFILE=0 F AURL=0:0 S AURFILE=$O(^UTILITY("AURESID",$J,AURFILE)) Q:AURFILE=""  I ^(AURFILE),$D(^UTILITY("AURESID",$J,^UTILITY("AURESID",$J,AURFILE)))!($D(^DIC(^UTILITY("AURESID",$J,AURFILE)))) S ^UTILITY("AURESID",$J,AURFILE)="I"

 S (AURFILE,AURY)=0 F AURL=0:0 S AURFILE=$O(^UTILITY("AURESID",$J,AURFILE)) Q:AURFILE=""  I ^UTILITY("AURESID",$J,AURFILE)'="I" S AURY=1 W !,AURFILE K ^DD(AURFILE)

 G:AURY LOOP

 G EOJ

CHK ;

 W "."

 Q:$D(^DIC(AURFILE))

 I $D(^DD(AURFILE,0,"UP")),^("UP")'="",(^("UP")<AURLO!(^("UP")>AURHI)) Q

 S ^UTILITY("AURESID",$J,AURFILE)=$S($D(^DD(AURFILE,0,"UP"))#2:^("UP"),1:"")

EOJ ;

 K ^UTILITY("AURESID",$J)

 K AURFILE,AURHI,AURL,AURLO,AURY

AURESID   ; CLEAN UP RESIDUAL ENTRIES IN ^DD [ 04/07/88  2:41 PM ]

 +1       ;

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

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

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

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

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

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

 +8       ;  and an entry in ^DIC for primary files.

 +9       ;

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

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

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

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

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

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

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

 +17      ;

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

 +19      ;  AURLO and AURHI and then D EN1^AURESID

 +20      ;

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

 +22      ;

LO         READ !,"Enter low  dictionary number: ",AURLO

           IF AURLO'=+AURLO

               QUIT

HI         READ !,"Enter high dictionary number: ",AURHI

           IF AURHI'=+AURHI!(AURHI'>AURLO)

               QUIT

 +1       ;

EN1       ; ENTRY POINT FOR CALLING ROUTINE

 +1        IF $DATA(AURLO)

               IF $DATA(AURHI)

                   IF AURLO=+AURLO

                       IF AURHI=+AURHI

                           IF AURHI>AURLO

                               IF AURLO'<2

                                   GOTO RESID

 +2        WRITE !!,"AURLO and/or AURHI missing or invalid!"

 +3        GOTO EOJ

 +4       ;

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

LOOP       KILL ^UTILITY("AURESID",$JOB)

           SET AURFILE=(AURLO-.00000001)

           FOR AURL=0:0

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

               IF AURFILE>AURHI!(AURFILE'=+AURFILE)

                   QUIT

               DO CHK

 +1        SET AURFILE=0

           FOR AURL=0:0

               SET AURFILE=$ORDER(^UTILITY("AURESID",$JOB,AURFILE))

               IF AURFILE=""

                   QUIT

               IF ^(AURFILE)

                   IF $DATA(^UTILITY("AURESID",$JOB,^UTILITY("AURESID",$JOB,AURFILE)))!($DATA(^DIC(^UTILITY("AURESID",$JOB,AURFILE))))

                       SET ^UTILITY("AURESID",$JOB,AURFILE)="I"

 +2        SET (AURFILE,AURY)=0

           FOR AURL=0:0

               SET AURFILE=$ORDER(^UTILITY("AURESID",$JOB,AURFILE))

               IF AURFILE=""

                   QUIT

               IF ^UTILITY("AURESID",$JOB,AURFILE)'="I"

                   SET AURY=1

                   WRITE !,AURFILE

                   KILL ^DD(AURFILE)

 +3        IF AURY

               GOTO LOOP

 +4        GOTO EOJ

 +5       ;

CHK       ;

 +1        WRITE "."

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

               QUIT

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

               IF ^("UP")'=""

                   IF (^("UP")<AURLO!(^("UP")>AURHI))

                       QUIT

 +4        SET ^UTILITY("AURESID",$JOB,AURFILE)=$SELECT($DATA(^DD(AURFILE,0,"UP"))#2:^("UP"),1:"")

 +5        QUIT

 +6       ;

EOJ       ;

 +1        KILL ^UTILITY("AURESID",$JOB)

 +2        KILL AURFILE,AURHI,AURL,AURLO,AURY

 +3        QUIT

AURESID.m