XBKD2.m

XBKD2 ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 10/29/2002   7:42 AM ]

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

 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.

 ;

 ; Part of XBKD

 ;

START ;

 S (Y,XBKDUCI)=""

 X:$D(^%ZOSF("UCI"))#2 ^("UCI")

 ;I Y'="" S XBKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]" ;IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.

 I Y'="" S XBKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'=""&($$VERSION^%ZOSV(1)'["Cache"):","""_$P(Y,",",2)_"""",1:"")_"]" ;IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.

 W !!,"Now checking dictionary names and data globals."

 S XBKDFILE=""

 F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE=""  W !?5,"Checking ",XBKDFILE D XBKDNC

 KILL XBKDANS,XBKDC,XBKDG,XBKDGG,XBKDGNM,XBKDGNR,XBKDNDD,XBKDNDIC,XBKDNTBL,XBKDX,XBKDY

 Q

 ;

XBKDNC ;

 I '$D(^DIC(XBKDFILE)),'$D(^DD(XBKDFILE)) W !,*7,?10,"Not in ^DIC or ^DD.  Removing from ^UTILITY(""XBDSET"")." KILL ^UTILITY("XBDSET",$J,XBKDFILE) Q

 S XBKDNDIC=$G(^DIC(XBKDFILE,0)),XBKDNDIC=$P(XBKDNDIC,U,1)

 D GCHK

 I XBKDG["%" W !,*7,?10,"Data global for ",XBKDFILE," is a % global.  Removing from ^UTILITY(""XBDSET"")." KILL ^UTILITY("XBDSET",$J,XBKDFILE) Q

 S XBKDNDD=$O(^DD(XBKDFILE,0,"NM",""))

 I XBKDNDIC=XBKDNDD,XBKDNDIC=XBKDGNM,XBKDFILE=XBKDGNR Q

 I XBKDNDIC]"",XBKDNDIC=XBKDNDD G GNMCHK

 I XBKDNDIC]"",XBKDNDD="" W !?10,"No name in ^DD.  Using name in ^DIC." S XBKDNDD=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)="" G GNMCHK

 I XBKDNDIC="",XBKDNDD]"" W !?10,"No name in ^DIC.  Using name in ^DD." S $P(^DIC(XBKDFILE,0),U,1)=XBKDNDD,XBKDNDIC=XBKDNDD G GNMCHK

 I XBKDNDIC="",XBKDNDD="",XBKDGNM]"",XBKDFILE=XBKDGNR W !?10,"No name in ^DIC or ^DD.  Using name in data global." S $P(^DIC(XBKDFILE,0),U,1)=XBKDGNM,^DD(XBKDFILE,0,"NM",XBKDGNM)="",(XBKDNDIC,XBKDNDD)=XBKDGNM Q

 I XBKDNDIC]"",XBKDNDD]"",XBKDNDIC'=XBKDNDD W !?10,"Name in ^DIC and ^DD differ.  Using name in ^DIC." KILL ^DD(XBKDFILE,0,"NM") S XBKDNDD=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)="" G GNMCHK

 W !?10,"Unable to deduce name.  Searching DIC(""B"")."

 D DICB

 G:XBKDNDIC]"" GNMCHK

 W !?10,"Unable to deduce name.  Setting to 'NO NAME'"

 S (XBKDNDIC,XBKDNDD)="NO NAME",$P(^DIC(XBKDFILE,0),U,1)=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)=""

 G GNMCHK

 ;

GCHK ; CHECK DATA GLOBAL

 S (XBKDGNM,XBKDGNR)=""

 S XBKDGG=0,XBKDG=$G(^DIC(XBKDFILE,0,"GL"))

 S:XBKDG?1"^"1U.UN1"(".UNP XBKDGG=1

 I XBKDG="" W !?10,"File ",XBKDFILE," has no data global specified in ^DIC." S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="?" Q

 I 'XBKDGG W !?10,"File ",XBKDFILE," data global=",XBKDG," is invalid." S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="?" Q

 S XBKDG="^"_XBKDUCI_$E(XBKDG,2,99),$P(^UTILITY("XBDSET",$J,XBKDFILE),U,3)=$E(XBKDG,2,99)

 S XBKDX=$E(XBKDG,1,$L(XBKDG)-1)_$S($E(XBKDG,$L(XBKDG))=",":")",1:""),XBKDX=$D(@XBKDX)

 I 'XBKDX W !?10,"Data global ",XBKDG," does not exist!" S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="?" Q

 S XBKDY=$L(XBKDG),XBKDY=$E(XBKDG,1,XBKDY-1)_$E(")",$E(XBKDG,XBKDY)=","),XBKDY=$S(XBKDY[")":$E(XBKDY,1,$L(XBKDY)-1)_",0)",1:XBKDY_"(0)")

 S XBKDX=$D(@XBKDY)

 I XBKDX S XBKDGNM=@XBKDY,XBKDGNR=+$P(XBKDGNM,U,2),XBKDGNM=$P(XBKDGNM,U,1) S:'XBKDGNR XBKDGNR="" Q

 I 'XBKDX W !?10,"File ",XBKDFILE," data global has entries but no 0th node.",!?12,"If global not being deleted, piece 3 and 4 must be reset!",!?12,"Creating 0th node." S @XBKDY="CREATED BY XBKD"_U_XBKDFILE

 Q

 ;

DICB ; CHECK DIC("B"

 KILL XBKDNTBL

 S (XBKDX,XBKDC)=0

 F XBKDL=0:0 S XBKDX=$O(^DIC("B",XBKDX)) Q:XBKDX=""  I $D(^(XBKDX,XBKDFILE)) S XBKDC=XBKDC+1,XBKDNTBL(XBKDC)=XBKDX

 Q:'XBKDC

 I XBKDC=1 S XBKDANS=1 D NAMESET KILL XBKDNTBL Q

 W !?12,"Multiple entries were found in ^DIC(""B""). Selecting first name",!?12,"  found.  All other names will be removed."

 W !

 S XBKDANS=1

 D NAMESET

 KILL XBKDNTBL(XBKDANS)

 W !

 S XBKDX=""

 F XBKDL=0:0 S XBKDX=$O(XBKDNTBL(XBKDX)) Q:XBKDX=""  W !?12,"Deleting ^DIC(""B"",""",XBKDNTBL(XBKDX),""",",XBKDFILE,")" KILL ^DIC("B",XBKDNTBL(XBKDX),XBKDFILE)

 W !

 KILL XBKDNTBL

 Q

NAMESET ;

 W !?12,"Setting names to '",XBKDNTBL(XBKDANS),"'"

 KILL ^DD(XBKDFILE,0,"NM")

 S (XBKDNDIC,XBKDNDD)=XBKDNTBL(XBKDANS),$P(^DIC(XBKDFILE,0),U,1)=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)=""

 Q

 ;

GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC

 Q:'XBKDGG

 I XBKDGNM]""!(XBKDGNR),XBKDFILE'=XBKDGNR!(XBKDNDIC'=XBKDGNM) D GNMCHK2

 S XBKDX=XBKDG_"0)"

 I XBKDGNM="",XBKDGNR="",$D(@XBKDX)#2 S $P(@XBKDX,U,1)=XBKDNDIC

 Q

 ;

GNMCHK2 ; DATA GLOBAL MISMATCH

 W !?10,"Data global name and/or number do not match ^DIC.  Data global will",!?12,"not be deleted!!  "

 S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="S",XBKDX=XBKDG_"0)="_@(XBKDG_"0)")

 W $E(XBKDX,1,47)

 Q

 ;

XBKD2     ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 10/29/2002   7:42 AM ]

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

 +2       ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.

 +3       ;

 +4       ; Part of XBKD

 +5       ;

START     ;

 +1        SET (Y,XBKDUCI)=""

 +2        IF $DATA(^%ZOSF("UCI"))#2

               XECUTE ^("UCI")

 +3       ;I Y'="" S XBKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]" ;IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.

 +4       ;IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.

           IF Y'=""

               SET XBKDUCI="["""_$PIECE(Y,",",1)_""""_$SELECT($PIECE(Y,",",2)'=""&($$VERSION^%ZOSV(1)'["Cache"):","""_$PIECE(Y,",",2)_"""",1:"")_"]"

 +5        WRITE !!,"Now checking dictionary names and data globals."

 +6        SET XBKDFILE=""

 +7        FOR XBKDL=0:0

               SET XBKDFILE=$ORDER(^UTILITY("XBDSET",$JOB,XBKDFILE))

               IF XBKDFILE=""

                   QUIT 

               WRITE !?5,"Checking ",XBKDFILE

               DO XBKDNC

 +8        KILL XBKDANS,XBKDC,XBKDG,XBKDGG,XBKDGNM,XBKDGNR,XBKDNDD,XBKDNDIC,XBKDNTBL,XBKDX,XBKDY

 +9        QUIT 

 +10      ;

XBKDNC    ;

 +1        IF '$DATA(^DIC(XBKDFILE))

               IF '$DATA(^DD(XBKDFILE))

                   WRITE !,*7,?10,"Not in ^DIC or ^DD.  Removing from ^UTILITY(""XBDSET"")."

                   KILL ^UTILITY("XBDSET",$JOB,XBKDFILE)

                   QUIT 

 +2        SET XBKDNDIC=$GET(^DIC(XBKDFILE,0))

           SET XBKDNDIC=$PIECE(XBKDNDIC,U,1)

 +3        DO GCHK

 +4        IF XBKDG["%"

               WRITE !,*7,?10,"Data global for ",XBKDFILE," is a % global.  Removing from ^UTILITY(""XBDSET"")."

               KILL ^UTILITY("XBDSET",$JOB,XBKDFILE)

               QUIT 

 +5        SET XBKDNDD=$ORDER(^DD(XBKDFILE,0,"NM",""))

 +6        IF XBKDNDIC=XBKDNDD

               IF XBKDNDIC=XBKDGNM

                   IF XBKDFILE=XBKDGNR

                       QUIT 

 +7        IF XBKDNDIC]""

               IF XBKDNDIC=XBKDNDD

                   GOTO GNMCHK

 +8        IF XBKDNDIC]""

               IF XBKDNDD=""

                   WRITE !?10,"No name in ^DD.  Using name in ^DIC."

                   SET XBKDNDD=XBKDNDIC

                   SET ^DD(XBKDFILE,0,"NM",XBKDNDD)=""

                   GOTO GNMCHK

 +9        IF XBKDNDIC=""

               IF XBKDNDD]""

                   WRITE !?10,"No name in ^DIC.  Using name in ^DD."

                   SET $PIECE(^DIC(XBKDFILE,0),U,1)=XBKDNDD

                   SET XBKDNDIC=XBKDNDD

                   GOTO GNMCHK

 +10       IF XBKDNDIC=""

               IF XBKDNDD=""

                   IF XBKDGNM]""

                       IF XBKDFILE=XBKDGNR

                           WRITE !?10,"No name in ^DIC or ^DD.  Using name in data global."

                           SET $PIECE(^DIC(XBKDFILE,0),U,1)=XBKDGNM

                           SET ^DD(XBKDFILE,0,"NM",XBKDGNM)=""

                           SET (XBKDNDIC,XBKDNDD)=XBKDGNM

                           QUIT 

 +11       IF XBKDNDIC]""

               IF XBKDNDD]""

                   IF XBKDNDIC'=XBKDNDD

                       WRITE !?10,"Name in ^DIC and ^DD differ.  Using name in ^DIC."

                       KILL ^DD(XBKDFILE,0,"NM")

                       SET XBKDNDD=XBKDNDIC

                       SET ^DD(XBKDFILE,0,"NM",XBKDNDD)=""

                       GOTO GNMCHK

 +12       WRITE !?10,"Unable to deduce name.  Searching DIC(""B"")."

 +13       DO DICB

 +14       IF XBKDNDIC]""

               GOTO GNMCHK

 +15       WRITE !?10,"Unable to deduce name.  Setting to 'NO NAME'"

 +16       SET (XBKDNDIC,XBKDNDD)="NO NAME"

           SET $PIECE(^DIC(XBKDFILE,0),U,1)=XBKDNDIC

           SET ^DD(XBKDFILE,0,"NM",XBKDNDD)=""

 +17       GOTO GNMCHK

 +18      ;

GCHK      ; CHECK DATA GLOBAL

 +1        SET (XBKDGNM,XBKDGNR)=""

 +2        SET XBKDGG=0

           SET XBKDG=$GET(^DIC(XBKDFILE,0,"GL"))

 +3        IF XBKDG?1"^"1U.UN1"(".UNP

               SET XBKDGG=1

 +4        IF XBKDG=""

               WRITE !?10,"File ",XBKDFILE," has no data global specified in ^DIC."

               SET $PIECE(^UTILITY("XBDSET",$JOB,XBKDFILE),U,1)="?"

               QUIT 

 +5        IF 'XBKDGG

               WRITE !?10,"File ",XBKDFILE," data global=",XBKDG," is invalid."

               SET $PIECE(^UTILITY("XBDSET",$JOB,XBKDFILE),U,1)="?"

               QUIT 

 +6        SET XBKDG="^"_XBKDUCI_$EXTRACT(XBKDG,2,99)

           SET $PIECE(^UTILITY("XBDSET",$JOB,XBKDFILE),U,3)=$EXTRACT(XBKDG,2,99)

 +7        SET XBKDX=$EXTRACT(XBKDG,1,$LENGTH(XBKDG)-1)_$SELECT($EXTRACT(XBKDG,$LENGTH(XBKDG))=",":")",1:"")

           SET XBKDX=$DATA(@XBKDX)

 +8        IF 'XBKDX

               WRITE !?10,"Data global ",XBKDG," does not exist!"

               SET $PIECE(^UTILITY("XBDSET",$JOB,XBKDFILE),U,1)="?"

               QUIT 

 +9        SET XBKDY=$LENGTH(XBKDG)

           SET XBKDY=$EXTRACT(XBKDG,1,XBKDY-1)_$EXTRACT(")",$EXTRACT(XBKDG,XBKDY)=",")

           SET XBKDY=$SELECT(XBKDY[")":$EXTRACT(XBKDY,1,$LENGTH(XBKDY)-1)_",0)",1:XBKDY_"(0)")

 +10       SET XBKDX=$DATA(@XBKDY)

 +11       IF XBKDX

               SET XBKDGNM=@XBKDY

               SET XBKDGNR=+$PIECE(XBKDGNM,U,2)

               SET XBKDGNM=$PIECE(XBKDGNM,U,1)

               IF 'XBKDGNR

                   SET XBKDGNR=""

               QUIT 

 +12       IF 'XBKDX

               WRITE !?10,"File ",XBKDFILE," data global has entries but no 0th node.",!?12,"If global not being deleted, piece 3 and 4 must be reset!",!?12,"Creating 0th node."

               SET @XBKDY="CREATED BY XBKD"_U_XBKDFILE

 +13       QUIT 

 +14      ;

DICB      ; CHECK DIC("B"

 +1        KILL XBKDNTBL

 +2        SET (XBKDX,XBKDC)=0

 +3        FOR XBKDL=0:0

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

               IF XBKDX=""

                   QUIT 

               IF $DATA(^(XBKDX,XBKDFILE))

                   SET XBKDC=XBKDC+1

                   SET XBKDNTBL(XBKDC)=XBKDX

 +4        IF 'XBKDC

               QUIT 

 +5        IF XBKDC=1

               SET XBKDANS=1

               DO NAMESET

               KILL XBKDNTBL

               QUIT 

 +6        WRITE !?12,"Multiple entries were found in ^DIC(""B""). Selecting first name",!?12,"  found.  All other names will be removed."

 +7        WRITE !

 +8        SET XBKDANS=1

 +9        DO NAMESET

 +10       KILL XBKDNTBL(XBKDANS)

 +11       WRITE !

 +12       SET XBKDX=""

 +13       FOR XBKDL=0:0

               SET XBKDX=$ORDER(XBKDNTBL(XBKDX))

               IF XBKDX=""

                   QUIT 

               WRITE !?12,"Deleting ^DIC(""B"",""",XBKDNTBL(XBKDX),""",",XBKDFILE,")"

               KILL ^DIC("B",XBKDNTBL(XBKDX),XBKDFILE)

 +14       WRITE !

 +15       KILL XBKDNTBL

 +16       QUIT 

NAMESET   ;

 +1        WRITE !?12,"Setting names to '",XBKDNTBL(XBKDANS),"'"

 +2        KILL ^DD(XBKDFILE,0,"NM")

 +3        SET (XBKDNDIC,XBKDNDD)=XBKDNTBL(XBKDANS)

           SET $PIECE(^DIC(XBKDFILE,0),U,1)=XBKDNDIC

           SET ^DD(XBKDFILE,0,"NM",XBKDNDD)=""

 +4        QUIT 

 +5       ;

GNMCHK    ; CHECK DATA GLOBAL NAME AGAINST ^DIC

 +1        IF 'XBKDGG

               QUIT 

 +2        IF XBKDGNM]""!(XBKDGNR)

               IF XBKDFILE'=XBKDGNR!(XBKDNDIC'=XBKDGNM)

                   DO GNMCHK2

 +3        SET XBKDX=XBKDG_"0)"

 +4        IF XBKDGNM=""

               IF XBKDGNR=""

                   IF $DATA(@XBKDX)#2

                       SET $PIECE(@XBKDX,U,1)=XBKDNDIC

 +5        QUIT 

 +6       ;

GNMCHK2   ; DATA GLOBAL MISMATCH

 +1        WRITE !?10,"Data global name and/or number do not match ^DIC.  Data global will",!?12,"not be deleted!!  "

 +2        SET $PIECE(^UTILITY("XBDSET",$JOB,XBKDFILE),U,1)="S"

           SET XBKDX=XBKDG_"0)="_@(XBKDG_"0)")

 +3        WRITE $EXTRACT(XBKDX,1,47)

 +4        QUIT 

 +5       ;