AUKD2 ; CHECK DICTIONARY NAMES AND DATA GLOBALS [ 04/07/88 2:37 PM ]
;
S (Y,AUKDUCI)="" X:$D(^%ZOSF("UCI"))#2 ^("UCI") I Y'="" S AUKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"
W !!,"Now checking dictionary names and data globals." S AUKDFILE="" F AUKDL=0:0 S AUKDFILE=$O(^UTILITY("AUDSET",$J,AUKDFILE)) Q:AUKDFILE="" W !,?5,"Checking ",AUKDFILE D AUKDNC
K AUKDANS,AUKDC,AUKDG,AUKDGG,AUKDGNM,AUKDGNR,AUKDNDD,AUKDNDIC,AUKDNTBL,AUKDX,AUKDY
Q
;
AUKDNC ;
I '$D(^DIC(AUKDFILE)),'$D(^DD(AUKDFILE)) W !,*7,?10,"Not in ^DIC or ^DD. Removing from ^UTILITY(""AUDSET"")." K ^UTILITY("AUDSET",$J,AUKDFILE) Q
S AUKDNDIC=$S($D(^DIC(AUKDFILE,0))#2:^(0),1:""),AUKDNDIC=$P(AUKDNDIC,U,1)
D GCHK
I AUKDG["%" W !,*7,?10,"Data global for ",AUKDFILE," is a % global. Removing from ^UTILITY(""AUDSET"")." K ^UTILITY("AUDSET",$J,AUKDFILE) Q
S AUKDNDD=$O(^DD(AUKDFILE,0,"NM",""))
I AUKDNDIC=AUKDNDD,AUKDNDIC=AUKDGNM,AUKDFILE=AUKDGNR Q
I AUKDNDIC'="",AUKDNDIC=AUKDNDD G GNMCHK
I AUKDNDIC'="",AUKDNDD="" W !,?10,"No name in ^DD. Using name in ^DIC." S AUKDNDD=AUKDNDIC,^DD(AUKDFILE,0,"NM",AUKDNDD)="" G GNMCHK
I AUKDNDIC="",AUKDNDD'="" W !,?10,"No name in ^DIC. Using name in ^DD." S $P(^DIC(AUKDFILE,0),U,1)=AUKDNDD,AUKDNDIC=AUKDNDD G GNMCHK
I AUKDNDIC="",AUKDNDD="",AUKDGNM'="",AUKDFILE=AUKDGNR W !,?10,"No name in ^DIC or ^DD. Using name in data global." S $P(^DIC(AUKDFILE,0),U,1)=AUKDGNM,^DD(AUKDFILE,0,"NM",AUKDGNM)="",(AUKDNDIC,AUKDNDD)=AUKDGNM Q
I AUKDNDIC'="",AUKDNDD'="",AUKDNDIC'=AUKDNDD W !,?10,"Name in ^DIC and ^DD differ. Using name in ^DIC." K ^DD(AUKDFILE,0,"NM") S AUKDNDD=AUKDNDIC,^DD(AUKDFILE,0,"NM",AUKDNDD)="" G GNMCHK
W !,?10,"Unable to deduce name. Searching DIC(""B"")." D DICB
G:AUKDNDIC'="" GNMCHK
W !,?10,"Unable to deduce name. Setting to 'NO NAME'" S (AUKDNDIC,AUKDNDD)="NO NAME",$P(^DIC(AUKDFILE,0),U,1)=AUKDNDIC,^DD(AUKDFILE,0,"NM",AUKDNDD)=""
G GNMCHK
;
GCHK ; CHECK DATA GLOBAL
S (AUKDGNM,AUKDGNR)=""
S AUKDGG=0,AUKDG=$S($D(^DIC(AUKDFILE,0,"GL"))#2:^("GL"),1:"") S:AUKDG?1"^"1U.UN1"(".UNP AUKDGG=1
I AUKDG="" W !,?10,"File ",AUKDFILE," has no data global specified in ^DIC." S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="?" Q
I 'AUKDGG W !,?10,"File ",AUKDFILE," data global=",AUKDG," is invalid." S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="?" Q
S AUKDG="^"_AUKDUCI_$E(AUKDG,2,99),$P(^UTILITY("AUDSET",$J,AUKDFILE),U,3)=$E(AUKDG,2,99)
S AUKDX=$E(AUKDG,1,$L(AUKDG)-1)_$S($E(AUKDG,$L(AUKDG))=",":")",1:""),AUKDX=$D(@AUKDX)
I 'AUKDX W !,?10,"Data global ",AUKDG," does not exist!" S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="?" Q
S AUKDY=$L(AUKDG),AUKDY=$E(AUKDG,1,AUKDY-1)_$E(")",$E(AUKDG,AUKDY)=","),AUKDY=$S(AUKDY[")":$E(AUKDY,1,$L(AUKDY)-1)_",0)",1:AUKDY_"(0)")
S AUKDX=$D(@AUKDY)
I AUKDX S AUKDGNM=@AUKDY,AUKDGNR=+$P(AUKDGNM,U,2),AUKDGNM=$P(AUKDGNM,U,1) S:'AUKDGNR AUKDGNR="" Q
I 'AUKDX W !,?10,"File ",AUKDFILE," 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 @AUKDY="CREATED BY AUKD"_U_AUKDFILE
Q
;
DICB ; CHECK DIC("B"
K AUKDNTBL S (AUKDX,AUKDC)=0 F AUKDL=0:0 S AUKDX=$O(^DIC("B",AUKDX)) Q:AUKDX="" I $D(^(AUKDX,AUKDFILE)) S AUKDC=AUKDC+1,AUKDNTBL(AUKDC)=AUKDX
Q:'AUKDC
I AUKDC=1 S AUKDANS=1 D NAMESET K AUKDNTBL Q
W !,?12,"Multiple entries were found in ^DIC(""B""). Selecting first name",!,?12," found. All other names will be removed."
W ! S AUKDANS=1 D NAMESET K AUKDNTBL(AUKDANS) W !
S AUKDX="" F AUKDL=0:0 S AUKDX=$O(AUKDNTBL(AUKDX)) Q:AUKDX="" W !,?12,"Deleting ^DIC(""B"",""",AUKDNTBL(AUKDX),""",",AUKDFILE,")" K ^DIC("B",AUKDNTBL(AUKDX),AUKDFILE)
W !
K AUKDNTBL
Q
NAMESET ;
W !,?12,"Setting names to '",AUKDNTBL(AUKDANS),"'"
K ^DD(AUKDFILE,0,"NM")
S (AUKDNDIC,AUKDNDD)=AUKDNTBL(AUKDANS),$P(^DIC(AUKDFILE,0),U,1)=AUKDNDIC,^DD(AUKDFILE,0,"NM",AUKDNDD)=""
Q
;
GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
Q:'AUKDGG
I AUKDGNM'=""!(AUKDGNR),AUKDFILE'=AUKDGNR!(AUKDNDIC'=AUKDGNM) D GNMCHK2
S AUKDX=AUKDG_"0)" I AUKDGNM="",AUKDGNR="",$D(@AUKDX)#2 S $P(@AUKDX,U,1)=AUKDNDIC
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("AUDSET",$J,AUKDFILE),U,1)="S",AUKDX=AUKDG_"0)="_@(AUKDG_"0)") W $E(AUKDX,1,47)
Q
AUKD2 ; CHECK DICTIONARY NAMES AND DATA GLOBALS [ 04/07/88 2:37 PM ]
+1 ;
+2 SET (Y,AUKDUCI)=""
IF $DATA(^%ZOSF("UCI"))#2
XECUTE ^("UCI")
IF Y'=""
SET AUKDUCI="["""_$PIECE(Y,",",1)_""""_$SELECT($PIECE(Y,",",2)'="":","""_$PIECE(Y,",",2)_"""",1:"")_"]"
+3 WRITE !!,"Now checking dictionary names and data globals."
SET AUKDFILE=""
FOR AUKDL=0:0
SET AUKDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUKDFILE))
IF AUKDFILE=""
QUIT
WRITE !,?5,"Checking ",AUKDFILE
DO AUKDNC
+4 KILL AUKDANS,AUKDC,AUKDG,AUKDGG,AUKDGNM,AUKDGNR,AUKDNDD,AUKDNDIC,AUKDNTBL,AUKDX,AUKDY
+5 QUIT
+6 ;
AUKDNC ;
+1 IF '$DATA(^DIC(AUKDFILE))
IF '$DATA(^DD(AUKDFILE))
WRITE !,*7,?10,"Not in ^DIC or ^DD. Removing from ^UTILITY(""AUDSET"")."
KILL ^UTILITY("AUDSET",$JOB,AUKDFILE)
QUIT
+2 SET AUKDNDIC=$SELECT($DATA(^DIC(AUKDFILE,0))#2:^(0),1:"")
SET AUKDNDIC=$PIECE(AUKDNDIC,U,1)
+3 DO GCHK
+4 IF AUKDG["%"
WRITE !,*7,?10,"Data global for ",AUKDFILE," is a % global. Removing from ^UTILITY(""AUDSET"")."
KILL ^UTILITY("AUDSET",$JOB,AUKDFILE)
QUIT
+5 SET AUKDNDD=$ORDER(^DD(AUKDFILE,0,"NM",""))
+6 IF AUKDNDIC=AUKDNDD
IF AUKDNDIC=AUKDGNM
IF AUKDFILE=AUKDGNR
QUIT
+7 IF AUKDNDIC'=""
IF AUKDNDIC=AUKDNDD
GOTO GNMCHK
+8 IF AUKDNDIC'=""
IF AUKDNDD=""
WRITE !,?10,"No name in ^DD. Using name in ^DIC."
SET AUKDNDD=AUKDNDIC
SET ^DD(AUKDFILE,0,"NM",AUKDNDD)=""
GOTO GNMCHK
+9 IF AUKDNDIC=""
IF AUKDNDD'=""
WRITE !,?10,"No name in ^DIC. Using name in ^DD."
SET $PIECE(^DIC(AUKDFILE,0),U,1)=AUKDNDD
SET AUKDNDIC=AUKDNDD
GOTO GNMCHK
+10 IF AUKDNDIC=""
IF AUKDNDD=""
IF AUKDGNM'=""
IF AUKDFILE=AUKDGNR
WRITE !,?10,"No name in ^DIC or ^DD. Using name in data global."
SET $PIECE(^DIC(AUKDFILE,0),U,1)=AUKDGNM
SET ^DD(AUKDFILE,0,"NM",AUKDGNM)=""
SET (AUKDNDIC,AUKDNDD)=AUKDGNM
QUIT
+11 IF AUKDNDIC'=""
IF AUKDNDD'=""
IF AUKDNDIC'=AUKDNDD
WRITE !,?10,"Name in ^DIC and ^DD differ. Using name in ^DIC."
KILL ^DD(AUKDFILE,0,"NM")
SET AUKDNDD=AUKDNDIC
SET ^DD(AUKDFILE,0,"NM",AUKDNDD)=""
GOTO GNMCHK
+12 WRITE !,?10,"Unable to deduce name. Searching DIC(""B"")."
DO DICB
+13 IF AUKDNDIC'=""
GOTO GNMCHK
+14 WRITE !,?10,"Unable to deduce name. Setting to 'NO NAME'"
SET (AUKDNDIC,AUKDNDD)="NO NAME"
SET $PIECE(^DIC(AUKDFILE,0),U,1)=AUKDNDIC
SET ^DD(AUKDFILE,0,"NM",AUKDNDD)=""
+15 GOTO GNMCHK
+16 ;
GCHK ; CHECK DATA GLOBAL
+1 SET (AUKDGNM,AUKDGNR)=""
+2 SET AUKDGG=0
SET AUKDG=$SELECT($DATA(^DIC(AUKDFILE,0,"GL"))#2:^("GL"),1:"")
IF AUKDG?1"^"1U.UN1"(".UNP
SET AUKDGG=1
+3 IF AUKDG=""
WRITE !,?10,"File ",AUKDFILE," has no data global specified in ^DIC."
SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,1)="?"
QUIT
+4 IF 'AUKDGG
WRITE !,?10,"File ",AUKDFILE," data global=",AUKDG," is invalid."
SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,1)="?"
QUIT
+5 SET AUKDG="^"_AUKDUCI_$EXTRACT(AUKDG,2,99)
SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,3)=$EXTRACT(AUKDG,2,99)
+6 SET AUKDX=$EXTRACT(AUKDG,1,$LENGTH(AUKDG)-1)_$SELECT($EXTRACT(AUKDG,$LENGTH(AUKDG))=",":")",1:"")
SET AUKDX=$DATA(@AUKDX)
+7 IF 'AUKDX
WRITE !,?10,"Data global ",AUKDG," does not exist!"
SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,1)="?"
QUIT
+8 SET AUKDY=$LENGTH(AUKDG)
SET AUKDY=$EXTRACT(AUKDG,1,AUKDY-1)_$EXTRACT(")",$EXTRACT(AUKDG,AUKDY)=",")
SET AUKDY=$SELECT(AUKDY[")":$EXTRACT(AUKDY,1,$LENGTH(AUKDY)-1)_",0)",1:AUKDY_"(0)")
+9 SET AUKDX=$DATA(@AUKDY)
+10 IF AUKDX
SET AUKDGNM=@AUKDY
SET AUKDGNR=+$PIECE(AUKDGNM,U,2)
SET AUKDGNM=$PIECE(AUKDGNM,U,1)
IF 'AUKDGNR
SET AUKDGNR=""
QUIT
+11 IF 'AUKDX
WRITE !,?10,"File ",AUKDFILE," 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 @AUKDY="CREATED BY AUKD"_U_AUKDFILE
+12 QUIT
+13 ;
DICB ; CHECK DIC("B"
+1 KILL AUKDNTBL
SET (AUKDX,AUKDC)=0
FOR AUKDL=0:0
SET AUKDX=$ORDER(^DIC("B",AUKDX))
IF AUKDX=""
QUIT
IF $DATA(^(AUKDX,AUKDFILE))
SET AUKDC=AUKDC+1
SET AUKDNTBL(AUKDC)=AUKDX
+2 IF 'AUKDC
QUIT
+3 IF AUKDC=1
SET AUKDANS=1
DO NAMESET
KILL AUKDNTBL
QUIT
+4 WRITE !,?12,"Multiple entries were found in ^DIC(""B""). Selecting first name",!,?12," found. All other names will be removed."
+5 WRITE !
SET AUKDANS=1
DO NAMESET
KILL AUKDNTBL(AUKDANS)
WRITE !
+6 SET AUKDX=""
FOR AUKDL=0:0
SET AUKDX=$ORDER(AUKDNTBL(AUKDX))
IF AUKDX=""
QUIT
WRITE !,?12,"Deleting ^DIC(""B"",""",AUKDNTBL(AUKDX),""",",AUKDFILE,")"
KILL ^DIC("B",AUKDNTBL(AUKDX),AUKDFILE)
+7 WRITE !
+8 KILL AUKDNTBL
+9 QUIT
NAMESET ;
+1 WRITE !,?12,"Setting names to '",AUKDNTBL(AUKDANS),"'"
+2 KILL ^DD(AUKDFILE,0,"NM")
+3 SET (AUKDNDIC,AUKDNDD)=AUKDNTBL(AUKDANS)
SET $PIECE(^DIC(AUKDFILE,0),U,1)=AUKDNDIC
SET ^DD(AUKDFILE,0,"NM",AUKDNDD)=""
+4 QUIT
+5 ;
GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
+1 IF 'AUKDGG
QUIT
+2 IF AUKDGNM'=""!(AUKDGNR)
IF AUKDFILE'=AUKDGNR!(AUKDNDIC'=AUKDGNM)
DO GNMCHK2
+3 SET AUKDX=AUKDG_"0)"
IF AUKDGNM=""
IF AUKDGNR=""
IF $DATA(@AUKDX)#2
SET $PIECE(@AUKDX,U,1)=AUKDNDIC
+4 QUIT
+5 ;
GNMCHK2 ; DATA GLOBAL MISMATCH
+1 WRITE !,?10,"Data global name and/or number do not match ^DIC. Data global will",!,?12,"not be deleted!! "
SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,1)="S"
SET AUKDX=AUKDG_"0)="_@(AUKDG_"0)")
WRITE $EXTRACT(AUKDX,1,47)
+2 QUIT
