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 ;
