XBCDIC2 ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; Part of XBCDIC
;
START ;
S (Y,XBCDUCI)=""
X:$D(^%ZOSF("UCI"))#2 ^("UCI")
I Y'="" S XBCDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"
KILL Y
W !!,"Now checking dictionary names and data globals."
S XBCDFILE=""
F XBCDL=0:0 S XBCDFILE=$O(^UTILITY("XBDSET",$J,XBCDFILE)) Q:XBCDFILE="" W !?5,"Checking ",XBCDFILE D XBCDNC
KILL XBCDFILE,XBCDANS,XBCDC,XBCDG,XBCDGG,XBCDGNM,XBCDGNR,XBCDNDD,XBCDNDIC,XBCDNTBL,XBCDX,XBCDY,XBCDL,XBCDY
Q
;
XBCDNC ;
S XBCDNDIC=$G(^DIC(XBCDFILE,0)),XBCDNDIC=$P(XBCDNDIC,U,1)
D GCHK
I XBCDNDIC]"",$D(^DD(XBCDFILE,0,"NM",XBCDNDIC))#2 KILL ^DD(XBCDFILE,0,"NM") S ^DD(XBCDFILE,0,"NM",XBCDNDIC)=""
S XBCDNDD=$O(^DD(XBCDFILE,0,"NM",""))
I XBCDNDIC=XBCDNDD,XBCDNDIC=XBCDGNM,XBCDFILE=XBCDGNR Q
I XBCDNDIC]"",XBCDNDIC=XBCDNDD G GNMCHK
I XBCDNDIC]"",XBCDNDD="" W !?10,"No name in ^DD. Using name in ^DIC." S XBCDNDD=XBCDNDIC,^DD(XBCDFILE,0,"NM",XBCDNDIC)="" G GNMCHK
I XBCDNDIC="",XBCDNDD]"" W !?10,"No name in ^DIC. Using name in ^DD." S XBCDNDIC=XBCDNDD,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="" G GNMCHK
I XBCDNDIC="",XBCDNDD="",XBCDGNM]"",XBCDFILE=XBCDGNR W !?10,"No name in ^DIC or ^DD. Using name in data global." S (XBCDNDIC,XBCDNDD)=XBCDGNM,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)="" Q
I XBCDNDIC]"",XBCDNDD]"",XBCDNDIC'=XBCDNDD W !?10,"Name in ^DIC and ^DD differ. Using name in ^DIC." KILL ^DD(XBCDFILE,0,"NM") S XBCDNDD=XBCDNDIC,^DD(XBCDFILE,0,"NM",XBCDNDD)="" G GNMCHK
W !?10,"Unable to deduce name. Searching DIC(""B"")."
D DICB
G:XBCDNDIC]"" GNMCHK
D READNAME
G GNMCHK
;
READNAME ;
W !?10,"Unable to deduce name. Enter File Name or ""^"": ",XBCDX
I $L(XBCDX)>2,$L(XBCDX)<31,XBCDX?.ANP S (XBCDNDIC,XBCDNDD)=XBCDX,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)="" Q
I XBCDX'="^" W *7," ??" G READNAME
S ^UTILITY("XBDSET",$J,XBCDFILE,"ERR",1)="File "_XBCDFILE_" has no name."
Q
;
GCHK ; CHECK DATA GLOBAL
S (XBCDGNM,XBCDGNR)="",XBCDGG=0,XBCDG=$G(^DIC(XBCDFILE,0,"GL"))
S:XBCDG?1"^"1U.UN1"(".UNP!(XBCDG?1"^"1"%"1U.UN1"(".UNP) XBCDGG=1
I XBCDG="" W !?10,"File ",XBCDFILE," has no data global specified in ^DIC." D READGBL G:XBCDG]"" GCHK Q
I 'XBCDGG W !?10,"File ",XBCDFILE," data global=",XBCDG," is invalid." D READGBL G:XBCDG]"" GCHK Q
S XBCDG="^"_XBCDUCI_$E(XBCDG,2,99),^UTILITY("XBDSET",$J,XBCDFILE)=XBCDG
Q:XBCDG["%"
S XBCDX=$E(XBCDG,1,$L(XBCDG)-1)_$S($E(XBCDG,$L(XBCDG))=",":")",1:""),XBCDX=$D(@XBCDX)
S XBCDY=$L(XBCDG),XBCDY=$E(XBCDG,1,XBCDY-1)_$E(")",$E(XBCDG,XBCDY)=","),XBCDY=$S(XBCDY[")":$E(XBCDY,1,$L(XBCDY)-1)_",0)",1:XBCDY_"(0)")
I 'XBCDX W !?10,"Data global ",XBCDG," does not exist. Creating 0th node!" S @XBCDY="CREATED BY XBCD"_U_XBCDFILE Q
S XBCDX=$D(@XBCDY)
I XBCDX S XBCDGNM=@XBCDY,XBCDGNR=+$P(XBCDGNM,U,2),XBCDGNM=$P(XBCDGNM,U,1) S:'XBCDGNR XBCDGNR="" G GCHK2
W !?10,"File ",XBCDFILE," data global exists but has no 0th node.",!?12,"Creating 0th node. Piece 3 and 4 must be set!"
S @XBCDY="CREATED BY XBCD"_U_XBCDFILE
Q
;
GCHK2 ; CHECK 3RD AND 4TH PIECE
S XBCDX=$P(@XBCDY,U,3,4),XBCDX1=$P(XBCDX,U,2),XBCDX=+XBCDX
S XBCDX2=$O(@XBCDY)
I 'XBCDX2,XBCDX!(XBCDX1) W !?10,"Data global 0th node inconsistent with data. Fixing." S $P(@XBCDY,U,3)=0,$P(@XBCDY,U,4)=0 G GCHK3
I XBCDX2,'XBCDX!('XBCDX1) W !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix." G GCHK3
I XBCDX,'$D(@(XBCDG_XBCDX_")")) W !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix." G GCHK3
GCHK3 ; CHECK FILE NUMBER IN DATA GLOBAL
KILL XBCDX1,XBCDX2
Q:XBCDGNR=XBCDFILE
W !?10,"Data global has different number than ^DIC. ",$P(@XBCDY,U,1,2)
G2R1 ;
R !?12,"Change number in data global? (Y/N) ",XBCDX:$G(DTIME,999)
I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G G2R1
I XBCDX="Y" S XBCDX=@XBCDY,XBCDX1=$P(XBCDX,U,2),XBCDX2=+XBCDX1,XBCDX3=$P(XBCDX1,XBCDX2,2),$P(XBCDX,U,2)=XBCDFILE_XBCDX3,@XBCDY=XBCDX,XBCDGNR=XBCDFILE KILL XBCDX1,XBCDX2,XBCDX3 KILL XBCDX3 Q
D READGBL
I XBCDG="" W !?10,"Removing ^DIC(",XBCDFILE,",""0"",""GL"") node." KILL ^DIC(XBCDFILE,0,"GL")
G GCHK
;
READGBL ;
R !!,"Enter Data Global or ""^"": ",XBCDG:$G(DTIME,999)
I XBCDG="^" S XBCDG="",^UTILITY("XBDSET",$J,XBCDFILE,"ERR",2)="File "_XBCDFILE_" data global missing or invalid." Q
I XBCDG'?1"^"1U.UN1"(".UNP,XBCDG'?1"^"1"%"1U.UN1"(".UNP W *7," ??" G READGBL
S ^DIC(XBCDFILE,0,"GL")=XBCDG
Q
;
DICB ; CHECK DIC("B"
KILL XBCDNTBL
S (XBCDX,XBCDC)=0
F XBCDL=0:0 S XBCDX=$O(^DIC("B",XBCDX)) Q:XBCDX="" I $D(^(XBCDX,XBCDFILE)) S XBCDC=XBCDC+1,XBCDNTBL(XBCDC)=XBCDX
Q:'XBCDC
I XBCDC=1 S XBCDANS=1 D NAMESET KILL XBCDNTBL Q
W !?12,"Multiple entries were found in ^DIC(""B""). Select one name or enter ""^""",!?12," All unselected names will be removed."
D PICKNAME
I XBCDANS'="^" D NAMESET KILL XBCDNTBL(XBCDANS) W !
S XBCDX=""
F XBCDL=0:0 S XBCDX=$O(XBCDNTBL(XBCDX)) Q:XBCDX="" W !?12,"Deleting ^DIC(""B"",""",XBCDNTBL(XBCDX),""",",XBCDFILE,")" KILL ^DIC("B",XBCDNTBL(XBCDX),XBCDFILE)
W !
KILL XBCDNTBL
Q
;
PICKNAME ;
F XBCDX=1:1:XBCDC W !?14,XBCDNTBL(XBCDX)
P1 ;
R !!?14,"Which one: ",XBCDANS:$G(DTIME,999)
Q:XBCDANS="^"
S:XBCDANS="" XBCDANS="?"
I '$D(XBCDNTBL(XBCDANS)) W *7," ??" G P1
Q
;
NAMESET ;
W !?12,"Setting names to '",XBCDNTBL(XBCDANS),"'"
S (XBCDNDIC,XBCDNDD)=XBCDNTBL(XBCDANS),$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)=""
KILL ^DD(XBCDFILE,0,"NM")
S ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
Q
;
GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
Q:'XBCDGG
I XBCDGNM]""!(XBCDGNR),XBCDNDIC'=XBCDGNM W !?10,"Data global name does not match ^DIC.",!?12,"Data global: ",XBCDGNM,!?12," ^DIC: ",XBCDNDIC D GNMFIX
S XBCDX=XBCDG_"0)"
I XBCDGNM="",XBCDGNR="",$D(@XBCDX)#2 S $P(@XBCDX,U,1)=XBCDNDIC
Q
;
GNMFIX ;
R !?12,"Change name in data global? (Y/N) ",XBCDX:$G(DTIME,999)
I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G GNMFIX
I XBCDX="Y" S XBCDX=XBCDG_"0)",$P(@XBCDX,U,1)=XBCDNDIC,XBCDGNM=XBCDNDIC Q
GNMR1 ;
R !?12,"Change names in ^DIC and ^DD to name in data global? (Y/N) ",XBCDX:$G(DTIME,999)
I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G GNMR1
I XBCDX'="Y" S ^UTILITY("XBDSET",$J,XBCDFILE,"ERR",3)="File "_XBCDFILE_" data global name does not match ^DIC name." Q
KILL ^DIC("B",XBCDNDIC,XBCDFILE),^DD(XBCDFILE,0,"NM")
S (XBCDNDIC,XBCDNDD)=XBCDGNM,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)=""
Q
;
XBCDIC2 ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; Part of XBCDIC
+4 ;
START ;
+1 SET (Y,XBCDUCI)=""
+2 IF $DATA(^%ZOSF("UCI"))#2
XECUTE ^("UCI")
+3 IF Y'=""
SET XBCDUCI="["""_$PIECE(Y,",",1)_""""_$SELECT($PIECE(Y,",",2)'="":","""_$PIECE(Y,",",2)_"""",1:"")_"]"
+4 KILL Y
+5 WRITE !!,"Now checking dictionary names and data globals."
+6 SET XBCDFILE=""
+7 FOR XBCDL=0:0
SET XBCDFILE=$ORDER(^UTILITY("XBDSET",$JOB,XBCDFILE))
IF XBCDFILE=""
QUIT
WRITE !?5,"Checking ",XBCDFILE
DO XBCDNC
+8 KILL XBCDFILE,XBCDANS,XBCDC,XBCDG,XBCDGG,XBCDGNM,XBCDGNR,XBCDNDD,XBCDNDIC,XBCDNTBL,XBCDX,XBCDY,XBCDL,XBCDY
+9 QUIT
+10 ;
XBCDNC ;
+1 SET XBCDNDIC=$GET(^DIC(XBCDFILE,0))
SET XBCDNDIC=$PIECE(XBCDNDIC,U,1)
+2 DO GCHK
+3 IF XBCDNDIC]""
IF $DATA(^DD(XBCDFILE,0,"NM",XBCDNDIC))#2
KILL ^DD(XBCDFILE,0,"NM")
SET ^DD(XBCDFILE,0,"NM",XBCDNDIC)=""
+4 SET XBCDNDD=$ORDER(^DD(XBCDFILE,0,"NM",""))
+5 IF XBCDNDIC=XBCDNDD
IF XBCDNDIC=XBCDGNM
IF XBCDFILE=XBCDGNR
QUIT
+6 IF XBCDNDIC]""
IF XBCDNDIC=XBCDNDD
GOTO GNMCHK
+7 IF XBCDNDIC]""
IF XBCDNDD=""
WRITE !?10,"No name in ^DD. Using name in ^DIC."
SET XBCDNDD=XBCDNDIC
SET ^DD(XBCDFILE,0,"NM",XBCDNDIC)=""
GOTO GNMCHK
+8 IF XBCDNDIC=""
IF XBCDNDD]""
WRITE !?10,"No name in ^DIC. Using name in ^DD."
SET XBCDNDIC=XBCDNDD
SET $PIECE(^DIC(XBCDFILE,0),U,1)=XBCDNDIC
SET ^DIC("B",XBCDNDIC,XBCDFILE)=""
GOTO GNMCHK
+9 IF XBCDNDIC=""
IF XBCDNDD=""
IF XBCDGNM]""
IF XBCDFILE=XBCDGNR
WRITE !?10,"No name in ^DIC or ^DD. Using name in data global."
SET (XBCDNDIC,XBCDNDD)=XBCDGNM
SET $PIECE(^DIC(XBCDFILE,0),U,1)=XBCDNDIC
SET ^DIC("B",XBCDNDIC,XBCDFILE)=""
SET ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
QUIT
+10 IF XBCDNDIC]""
IF XBCDNDD]""
IF XBCDNDIC'=XBCDNDD
WRITE !?10,"Name in ^DIC and ^DD differ. Using name in ^DIC."
KILL ^DD(XBCDFILE,0,"NM")
SET XBCDNDD=XBCDNDIC
SET ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
GOTO GNMCHK
+11 WRITE !?10,"Unable to deduce name. Searching DIC(""B"")."
+12 DO DICB
+13 IF XBCDNDIC]""
GOTO GNMCHK
+14 DO READNAME
+15 GOTO GNMCHK
+16 ;
READNAME ;
+1 WRITE !?10,"Unable to deduce name. Enter File Name or ""^"": ",XBCDX
+2 IF $LENGTH(XBCDX)>2
IF $LENGTH(XBCDX)<31
IF XBCDX?.ANP
SET (XBCDNDIC,XBCDNDD)=XBCDX
SET $PIECE(^DIC(XBCDFILE,0),U,1)=XBCDNDIC
SET ^DIC("B",XBCDNDIC,XBCDFILE)=""
SET ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
QUIT
+3 IF XBCDX'="^"
WRITE *7," ??"
GOTO READNAME
+4 SET ^UTILITY("XBDSET",$JOB,XBCDFILE,"ERR",1)="File "_XBCDFILE_" has no name."
+5 QUIT
+6 ;
GCHK ; CHECK DATA GLOBAL
+1 SET (XBCDGNM,XBCDGNR)=""
SET XBCDGG=0
SET XBCDG=$GET(^DIC(XBCDFILE,0,"GL"))
+2 IF XBCDG?1"^"1U.UN1"(".UNP!(XBCDG?1"^"1"%"1U.UN1"(".UNP)
SET XBCDGG=1
+3 IF XBCDG=""
WRITE !?10,"File ",XBCDFILE," has no data global specified in ^DIC."
DO READGBL
IF XBCDG]""
GOTO GCHK
QUIT
+4 IF 'XBCDGG
WRITE !?10,"File ",XBCDFILE," data global=",XBCDG," is invalid."
DO READGBL
IF XBCDG]""
GOTO GCHK
QUIT
+5 SET XBCDG="^"_XBCDUCI_$EXTRACT(XBCDG,2,99)
SET ^UTILITY("XBDSET",$JOB,XBCDFILE)=XBCDG
+6 IF XBCDG["%"
QUIT
+7 SET XBCDX=$EXTRACT(XBCDG,1,$LENGTH(XBCDG)-1)_$SELECT($EXTRACT(XBCDG,$LENGTH(XBCDG))=",":")",1:"")
SET XBCDX=$DATA(@XBCDX)
+8 SET XBCDY=$LENGTH(XBCDG)
SET XBCDY=$EXTRACT(XBCDG,1,XBCDY-1)_$EXTRACT(")",$EXTRACT(XBCDG,XBCDY)=",")
SET XBCDY=$SELECT(XBCDY[")":$EXTRACT(XBCDY,1,$LENGTH(XBCDY)-1)_",0)",1:XBCDY_"(0)")
+9 IF 'XBCDX
WRITE !?10,"Data global ",XBCDG," does not exist. Creating 0th node!"
SET @XBCDY="CREATED BY XBCD"_U_XBCDFILE
QUIT
+10 SET XBCDX=$DATA(@XBCDY)
+11 IF XBCDX
SET XBCDGNM=@XBCDY
SET XBCDGNR=+$PIECE(XBCDGNM,U,2)
SET XBCDGNM=$PIECE(XBCDGNM,U,1)
IF 'XBCDGNR
SET XBCDGNR=""
GOTO GCHK2
+12 WRITE !?10,"File ",XBCDFILE," data global exists but has no 0th node.",!?12,"Creating 0th node. Piece 3 and 4 must be set!"
+13 SET @XBCDY="CREATED BY XBCD"_U_XBCDFILE
+14 QUIT
+15 ;
GCHK2 ; CHECK 3RD AND 4TH PIECE
+1 SET XBCDX=$PIECE(@XBCDY,U,3,4)
SET XBCDX1=$PIECE(XBCDX,U,2)
SET XBCDX=+XBCDX
+2 SET XBCDX2=$ORDER(@XBCDY)
+3 IF 'XBCDX2
IF XBCDX!(XBCDX1)
WRITE !?10,"Data global 0th node inconsistent with data. Fixing."
SET $PIECE(@XBCDY,U,3)=0
SET $PIECE(@XBCDY,U,4)=0
GOTO GCHK3
+4 IF XBCDX2
IF 'XBCDX!('XBCDX1)
WRITE !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix."
GOTO GCHK3
+5 IF XBCDX
IF '$DATA(@(XBCDG_XBCDX_")"))
WRITE !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix."
GOTO GCHK3
GCHK3 ; CHECK FILE NUMBER IN DATA GLOBAL
+1 KILL XBCDX1,XBCDX2
+2 IF XBCDGNR=XBCDFILE
QUIT
+3 WRITE !?10,"Data global has different number than ^DIC. ",$PIECE(@XBCDY,U,1,2)
G2R1 ;
+1 READ !?12,"Change number in data global? (Y/N) ",XBCDX:$GET(DTIME,999)
+2 IF XBCDX'="Y"&(XBCDX'="N")
WRITE *7," ??"
GOTO G2R1
+3 IF XBCDX="Y"
SET XBCDX=@XBCDY
SET XBCDX1=$PIECE(XBCDX,U,2)
SET XBCDX2=+XBCDX1
SET XBCDX3=$PIECE(XBCDX1,XBCDX2,2)
SET $PIECE(XBCDX,U,2)=XBCDFILE_XBCDX3
SET @XBCDY=XBCDX
SET XBCDGNR=XBCDFILE
KILL XBCDX1,XBCDX2,XBCDX3
KILL XBCDX3
QUIT
+4 DO READGBL
+5 IF XBCDG=""
WRITE !?10,"Removing ^DIC(",XBCDFILE,",""0"",""GL"") node."
KILL ^DIC(XBCDFILE,0,"GL")
+6 GOTO GCHK
+7 ;
READGBL ;
+1 READ !!,"Enter Data Global or ""^"": ",XBCDG:$GET(DTIME,999)
+2 IF XBCDG="^"
SET XBCDG=""
SET ^UTILITY("XBDSET",$JOB,XBCDFILE,"ERR",2)="File "_XBCDFILE_" data global missing or invalid."
QUIT
+3 IF XBCDG'?1"^"1U.UN1"(".UNP
IF XBCDG'?1"^"1"%"1U.UN1"(".UNP
WRITE *7," ??"
GOTO READGBL
+4 SET ^DIC(XBCDFILE,0,"GL")=XBCDG
+5 QUIT
+6 ;
DICB ; CHECK DIC("B"
+1 KILL XBCDNTBL
+2 SET (XBCDX,XBCDC)=0
+3 FOR XBCDL=0:0
SET XBCDX=$ORDER(^DIC("B",XBCDX))
IF XBCDX=""
QUIT
IF $DATA(^(XBCDX,XBCDFILE))
SET XBCDC=XBCDC+1
SET XBCDNTBL(XBCDC)=XBCDX
+4 IF 'XBCDC
QUIT
+5 IF XBCDC=1
SET XBCDANS=1
DO NAMESET
KILL XBCDNTBL
QUIT
+6 WRITE !?12,"Multiple entries were found in ^DIC(""B""). Select one name or enter ""^""",!?12," All unselected names will be removed."
+7 DO PICKNAME
+8 IF XBCDANS'="^"
DO NAMESET
KILL XBCDNTBL(XBCDANS)
WRITE !
+9 SET XBCDX=""
+10 FOR XBCDL=0:0
SET XBCDX=$ORDER(XBCDNTBL(XBCDX))
IF XBCDX=""
QUIT
WRITE !?12,"Deleting ^DIC(""B"",""",XBCDNTBL(XBCDX),""",",XBCDFILE,")"
KILL ^DIC("B",XBCDNTBL(XBCDX),XBCDFILE)
+11 WRITE !
+12 KILL XBCDNTBL
+13 QUIT
+14 ;
PICKNAME ;
+1 FOR XBCDX=1:1:XBCDC
WRITE !?14,XBCDNTBL(XBCDX)
P1 ;
+1 READ !!?14,"Which one: ",XBCDANS:$GET(DTIME,999)
+2 IF XBCDANS="^"
QUIT
+3 IF XBCDANS=""
SET XBCDANS="?"
+4 IF '$DATA(XBCDNTBL(XBCDANS))
WRITE *7," ??"
GOTO P1
+5 QUIT
+6 ;
NAMESET ;
+1 WRITE !?12,"Setting names to '",XBCDNTBL(XBCDANS),"'"
+2 SET (XBCDNDIC,XBCDNDD)=XBCDNTBL(XBCDANS)
SET $PIECE(^DIC(XBCDFILE,0),U,1)=XBCDNDIC
SET ^DIC("B",XBCDNDIC,XBCDFILE)=""
+3 KILL ^DD(XBCDFILE,0,"NM")
+4 SET ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
+5 QUIT
+6 ;
GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
+1 IF 'XBCDGG
QUIT
+2 IF XBCDGNM]""!(XBCDGNR)
IF XBCDNDIC'=XBCDGNM
WRITE !?10,"Data global name does not match ^DIC.",!?12,"Data global: ",XBCDGNM,!?12," ^DIC: ",XBCDNDIC
DO GNMFIX
+3 SET XBCDX=XBCDG_"0)"
+4 IF XBCDGNM=""
IF XBCDGNR=""
IF $DATA(@XBCDX)#2
SET $PIECE(@XBCDX,U,1)=XBCDNDIC
+5 QUIT
+6 ;
GNMFIX ;
+1 READ !?12,"Change name in data global? (Y/N) ",XBCDX:$GET(DTIME,999)
+2 IF XBCDX'="Y"&(XBCDX'="N")
WRITE *7," ??"
GOTO GNMFIX
+3 IF XBCDX="Y"
SET XBCDX=XBCDG_"0)"
SET $PIECE(@XBCDX,U,1)=XBCDNDIC
SET XBCDGNM=XBCDNDIC
QUIT
GNMR1 ;
+1 READ !?12,"Change names in ^DIC and ^DD to name in data global? (Y/N) ",XBCDX:$GET(DTIME,999)
+2 IF XBCDX'="Y"&(XBCDX'="N")
WRITE *7," ??"
GOTO GNMR1
+3 IF XBCDX'="Y"
SET ^UTILITY("XBDSET",$JOB,XBCDFILE,"ERR",3)="File "_XBCDFILE_" data global name does not match ^DIC name."
QUIT
+4 KILL ^DIC("B",XBCDNDIC,XBCDFILE),^DD(XBCDFILE,0,"NM")
+5 SET (XBCDNDIC,XBCDNDD)=XBCDGNM
SET $PIECE(^DIC(XBCDFILE,0),U,1)=XBCDNDIC
SET ^DIC("B",XBCDNDIC,XBCDFILE)=""
SET ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
+6 QUIT
+7 ;
