- 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