Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AUKD2

AUKD2.m

Go to the documentation of this file.
  1. AUKD2 ; CHECK DICTIONARY NAMES AND DATA GLOBALS [ 04/07/88 2:37 PM ]
  1. ;
  1. S (Y,AUKDUCI)="" X:$D(^%ZOSF("UCI"))#2 ^("UCI") I Y'="" S AUKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"
  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
  1. K AUKDANS,AUKDC,AUKDG,AUKDGG,AUKDGNM,AUKDGNR,AUKDNDD,AUKDNDIC,AUKDNTBL,AUKDX,AUKDY
  1. Q
  1. ;
  1. AUKDNC ;
  1. 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
  1. S AUKDNDIC=$S($D(^DIC(AUKDFILE,0))#2:^(0),1:""),AUKDNDIC=$P(AUKDNDIC,U,1)
  1. D GCHK
  1. I AUKDG["%" W !,*7,?10,"Data global for ",AUKDFILE," is a % global. Removing from ^UTILITY(""AUDSET"")." K ^UTILITY("AUDSET",$J,AUKDFILE) Q
  1. S AUKDNDD=$O(^DD(AUKDFILE,0,"NM",""))
  1. I AUKDNDIC=AUKDNDD,AUKDNDIC=AUKDGNM,AUKDFILE=AUKDGNR Q
  1. I AUKDNDIC'="",AUKDNDIC=AUKDNDD G GNMCHK
  1. I AUKDNDIC'="",AUKDNDD="" W !,?10,"No name in ^DD. Using name in ^DIC." S AUKDNDD=AUKDNDIC,^DD(AUKDFILE,0,"NM",AUKDNDD)="" G GNMCHK
  1. 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
  1. 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
  1. 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
  1. W !,?10,"Unable to deduce name. Searching DIC(""B"")." D DICB
  1. G:AUKDNDIC'="" GNMCHK
  1. 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)=""
  1. G GNMCHK
  1. ;
  1. GCHK ; CHECK DATA GLOBAL
  1. S (AUKDGNM,AUKDGNR)=""
  1. S AUKDGG=0,AUKDG=$S($D(^DIC(AUKDFILE,0,"GL"))#2:^("GL"),1:"") S:AUKDG?1"^"1U.UN1"(".UNP AUKDGG=1
  1. I AUKDG="" W !,?10,"File ",AUKDFILE," has no data global specified in ^DIC." S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="?" Q
  1. I 'AUKDGG W !,?10,"File ",AUKDFILE," data global=",AUKDG," is invalid." S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="?" Q
  1. S AUKDG="^"_AUKDUCI_$E(AUKDG,2,99),$P(^UTILITY("AUDSET",$J,AUKDFILE),U,3)=$E(AUKDG,2,99)
  1. S AUKDX=$E(AUKDG,1,$L(AUKDG)-1)_$S($E(AUKDG,$L(AUKDG))=",":")",1:""),AUKDX=$D(@AUKDX)
  1. I 'AUKDX W !,?10,"Data global ",AUKDG," does not exist!" S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="?" Q
  1. 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)")
  1. S AUKDX=$D(@AUKDY)
  1. I AUKDX S AUKDGNM=@AUKDY,AUKDGNR=+$P(AUKDGNM,U,2),AUKDGNM=$P(AUKDGNM,U,1) S:'AUKDGNR AUKDGNR="" Q
  1. 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
  1. Q
  1. ;
  1. DICB ; CHECK DIC("B"
  1. 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
  1. Q:'AUKDC
  1. I AUKDC=1 S AUKDANS=1 D NAMESET K AUKDNTBL Q
  1. W !,?12,"Multiple entries were found in ^DIC(""B""). Selecting first name",!,?12," found. All other names will be removed."
  1. W ! S AUKDANS=1 D NAMESET K AUKDNTBL(AUKDANS) W !
  1. 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)
  1. W !
  1. K AUKDNTBL
  1. Q
  1. NAMESET ;
  1. W !,?12,"Setting names to '",AUKDNTBL(AUKDANS),"'"
  1. K ^DD(AUKDFILE,0,"NM")
  1. S (AUKDNDIC,AUKDNDD)=AUKDNTBL(AUKDANS),$P(^DIC(AUKDFILE,0),U,1)=AUKDNDIC,^DD(AUKDFILE,0,"NM",AUKDNDD)=""
  1. Q
  1. ;
  1. GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
  1. Q:'AUKDGG
  1. I AUKDGNM'=""!(AUKDGNR),AUKDFILE'=AUKDGNR!(AUKDNDIC'=AUKDGNM) D GNMCHK2
  1. S AUKDX=AUKDG_"0)" I AUKDGNM="",AUKDGNR="",$D(@AUKDX)#2 S $P(@AUKDX,U,1)=AUKDNDIC
  1. Q
  1. ;
  1. GNMCHK2 ; DATA GLOBAL MISMATCH
  1. 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)
  1. Q