AUCDIC.m

AUCDIC ; CLEAN UP ^DIC AND ^DD [ 06/13/87  9:46 AM ]

 ;

NOTES ; This routine cleans up ^DIC and ^DD by a range of

 ; dictionary numbers.  All files in ^DIC within the range

 ; of dictionary numbers are checked for the following:

 ;   They must have a NAME in ^DIC.

 ;   The NAME in ^DIC must match the NAME in ^DD.

 ;   The NAME must exist in ^DIC("B" with the correct number,

 ;     and that number cannot occur more than once in ^DIC("B".

 ;   They must have a data global specified in ^DIC.

 ;   The data global must be in the correct form.

 ;   The data global must exist.

 ;   The data global must have a 0th node.

 ;   The NAME and NUMBER in the data global must match ^DIC.

 ;   The data globals 0th node must be consistent with

 ;     the data (Exact count not checked).

 ;   They must have valid entries in ^DD as follows:

 ;     The ^DD entry must have a .01 field.

 ;     All "SB" pointers must point to existing sub-files.

 ;     All sub-files must point back to correct parent.

 ;     All "TRB" entries must exist.

 ;     All "PT" entries must exist.

 ;     All "ACOMP" entries must exist.

 ;

 ; When descrepencies are found the entries are corrected

 ; automatically where ever possible.  If this is not possible

 ; operator interaction occurs to make the corrections.  If

 ; the file cannot be corrected, it will be deleted.

 ;

 ; After all dictionaries within the range of dictionary

 ; numbers are checked, all other entries within the range

 ; will be deleted.

 ;

 ; The last step is to set the 0th node of the FILE OF FILES

 ; to the correct high DFN and the correct count of entries.

 ;

BEGIN S U="^"

 W !!,"This routine cleans up ^DIC and ^DD by a range of dictionary numbers."

LO R !!,"Enter low  number of range: ",AUCDLO G:AUCDLO'=+AUCDLO EOJ

HI R !,"Enter high number of range: ",AUCDHI S:AUCDHI="" AUCDHI=AUCDLO G:AUCDHI'=+AUCDHI!(AUCDHI<AUCDLO) EOJ

 I AUCDLO<2 W !!,"*** Don't mess with files less than 2!! ***",*7 G EOJ

 S AUDSLO=AUCDLO,AUDSHI=AUCDHI D EN1^%AUDSET

 I '$D(^UTILITY("AUDSET",$J)) W !!,"No dictionaries were selected!" G EOJ

 D ^AUCDIC2 ; CHECK NAMES AND DATA GLOBALS *****

 D ^AUCDICD ; DELETE BAD FILES FOUND BY ^AUCDIC2 *****

 S AUDSLO=AUCDLO,AUDSHI=AUCDHI D EN1^%AUDSET ; GET LIST AGAIN

 D ^AUCDIC3 ; CHECK ^DD ENTRIES *****

 S AURLO=AUCDLO,AURHI=AUCDHI D EN1^%AURESID ; CHECK DANGLING ^DD ENTRIES

 W !!,"Now confirming ^DIC(""B"")"

 S AUCDX="" F AUCDL=0:0 S AUCDX=$O(^DIC("B",AUCDX)) Q:AUCDX=""  S AUCDFILE="" F AUCDL=0:0 S AUCDFILE=$O(^DIC("B",AUCDX,AUCDFILE)) Q:AUCDFILE=""  I AUCDFILE'<AUCDLO,AUCDFILE'>AUCDHI W "." D BCHK

 S AUCDFILE=AUCDLO-.00000001 F AUCDL=0:0 S AUCDFILE=$O(^DIC(AUCDFILE)) Q:AUCDFILE'=+AUCDFILE  I AUCDFILE'>AUCDHI W "." S AUCDNDIC=$P(^DIC(AUCDFILE,0),U,1) I AUCDNDIC'="",'$D(^DIC("B",AUCDNDIC,AUCDFILE)) S ^(AUCDFILE)="" W "|"

 G EOJ

 ;

BCHK ;

 I '$D(^DIC(AUCDFILE,0))#2 K ^DIC("B",AUCDX,AUCDFILE) W "|" Q

 I AUCDX'=$P(^DIC(AUCDFILE,0),U,1) K ^DIC("B",AUCDX,AUCDFILE) W "|"

 Q

EOJ ;

 K AUCDLO,AUCDHI,AUCDUCI,AUCDL,AUCDFILE,AUCDX,AUCDNDIC

 K ^UTILITY("AUDSET",$J)

 Q

AUCDIC    ; CLEAN UP ^DIC AND ^DD [ 06/13/87  9:46 AM ]

 +1       ;

NOTES     ; This routine cleans up ^DIC and ^DD by a range of

 +1       ; dictionary numbers.  All files in ^DIC within the range

 +2       ; of dictionary numbers are checked for the following:

 +3       ;   They must have a NAME in ^DIC.

 +4       ;   The NAME in ^DIC must match the NAME in ^DD.

 +5       ;   The NAME must exist in ^DIC("B" with the correct number,

 +6       ;     and that number cannot occur more than once in ^DIC("B".

 +7       ;   They must have a data global specified in ^DIC.

 +8       ;   The data global must be in the correct form.

 +9       ;   The data global must exist.

 +10      ;   The data global must have a 0th node.

 +11      ;   The NAME and NUMBER in the data global must match ^DIC.

 +12      ;   The data globals 0th node must be consistent with

 +13      ;     the data (Exact count not checked).

 +14      ;   They must have valid entries in ^DD as follows:

 +15      ;     The ^DD entry must have a .01 field.

 +16      ;     All "SB" pointers must point to existing sub-files.

 +17      ;     All sub-files must point back to correct parent.

 +18      ;     All "TRB" entries must exist.

 +19      ;     All "PT" entries must exist.

 +20      ;     All "ACOMP" entries must exist.

 +21      ;

 +22      ; When descrepencies are found the entries are corrected

 +23      ; automatically where ever possible.  If this is not possible

 +24      ; operator interaction occurs to make the corrections.  If

 +25      ; the file cannot be corrected, it will be deleted.

 +26      ;

 +27      ; After all dictionaries within the range of dictionary

 +28      ; numbers are checked, all other entries within the range

 +29      ; will be deleted.

 +30      ;

 +31      ; The last step is to set the 0th node of the FILE OF FILES

 +32      ; to the correct high DFN and the correct count of entries.

 +33      ;

BEGIN      SET U="^"

 +1        WRITE !!,"This routine cleans up ^DIC and ^DD by a range of dictionary numbers."

LO         READ !!,"Enter low  number of range: ",AUCDLO

           IF AUCDLO'=+AUCDLO

               GOTO EOJ

HI         READ !,"Enter high number of range: ",AUCDHI

           IF AUCDHI=""

               SET AUCDHI=AUCDLO

           IF AUCDHI'=+AUCDHI!(AUCDHI<AUCDLO)

               GOTO EOJ

 +1        IF AUCDLO<2

               WRITE !!,"*** Don't mess with files less than 2!! ***",*7

               GOTO EOJ

 +2        SET AUDSLO=AUCDLO

           SET AUDSHI=AUCDHI

           DO EN1^%AUDSET

 +3        IF '$DATA(^UTILITY("AUDSET",$JOB))

               WRITE !!,"No dictionaries were selected!"

               GOTO EOJ

 +4       ; CHECK NAMES AND DATA GLOBALS *****

           DO ^AUCDIC2

 +5       ; DELETE BAD FILES FOUND BY ^AUCDIC2 *****

           DO ^AUCDICD

 +6       ; GET LIST AGAIN

           SET AUDSLO=AUCDLO

           SET AUDSHI=AUCDHI

           DO EN1^%AUDSET

 +7       ; CHECK ^DD ENTRIES *****

           DO ^AUCDIC3

 +8       ; CHECK DANGLING ^DD ENTRIES

           SET AURLO=AUCDLO

           SET AURHI=AUCDHI

           DO EN1^%AURESID

 +9        WRITE !!,"Now confirming ^DIC(""B"")"

 +10       SET AUCDX=""

           FOR AUCDL=0:0

               SET AUCDX=$ORDER(^DIC("B",AUCDX))

               IF AUCDX=""

                   QUIT 

               SET AUCDFILE=""

               FOR AUCDL=0:0

                   SET AUCDFILE=$ORDER(^DIC("B",AUCDX,AUCDFILE))

                   IF AUCDFILE=""

                       QUIT 

                   IF AUCDFILE'<AUCDLO

                       IF AUCDFILE'>AUCDHI

                           WRITE "."

                           DO BCHK

 +11       SET AUCDFILE=AUCDLO-.00000001

           FOR AUCDL=0:0

               SET AUCDFILE=$ORDER(^DIC(AUCDFILE))

               IF AUCDFILE'=+AUCDFILE

                   QUIT 

               IF AUCDFILE'>AUCDHI

                   WRITE "."

                   SET AUCDNDIC=$PIECE(^DIC(AUCDFILE,0),U,1)

                   IF AUCDNDIC'=""

                       IF '$DATA(^DIC("B",AUCDNDIC,AUCDFILE))

                           SET ^(AUCDFILE)=""

                           WRITE "|"

 +12       GOTO EOJ

 +13      ;

BCHK      ;

 +1        IF '$DATA(^DIC(AUCDFILE,0))#2

               KILL ^DIC("B",AUCDX,AUCDFILE)

               WRITE "|"

               QUIT 

 +2        IF AUCDX'=$PIECE(^DIC(AUCDFILE,0),U,1)

               KILL ^DIC("B",AUCDX,AUCDFILE)

               WRITE "|"

 +3        QUIT 

EOJ       ;

 +1        KILL AUCDLO,AUCDHI,AUCDUCI,AUCDL,AUCDFILE,AUCDX,AUCDNDIC

 +2        KILL ^UTILITY("AUDSET",$JOB)

 +3        QUIT