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

AUCDIC2.m

Go to the documentation of this file. 
  1. AUCDIC2 ; CHECK DICTIONARY NAMES AND DATA GLOBALS [ 06/13/87  8:47 AM ]
  1.  ;
  1.  S (Y,AUCDUCI)="" X:$D(^%ZOSF("UCI"))#2 ^("UCI") I Y'="" S AUCDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"
  1.  K Y
  1.  W !!,"Now checking dictionary names and data globals." S AUCDFILE="" F AUCDL=0:0 S AUCDFILE=$O(^UTILITY("AUDSET",$J,AUCDFILE)) Q:AUCDFILE=""  W !,?5,"Checking ",AUCDFILE D AUCDNC
  1.  K AUCDFILE,AUCDANS,AUCDC,AUCDG,AUCDGG,AUCDGNM,AUCDGNR,AUCDNDD,AUCDNDIC,AUCDNTBL,AUCDX,AUCDY,AUCDL,AUCDY
  1.  Q
  1.  ;
  1. AUCDNC ;
  1.  S AUCDNDIC=$S($D(^DIC(AUCDFILE,0))#2:^(0),1:""),AUCDNDIC=$P(AUCDNDIC,U,1)
  1.  D GCHK
  1.  I AUCDNDIC'="",$D(^DD(AUCDFILE,0,"NM",AUCDNDIC))#2 K ^DD(AUCDFILE,0,"NM") S ^DD(AUCDFILE,0,"NM",AUCDNDIC)=""
  1.  S AUCDNDD=$O(^DD(AUCDFILE,0,"NM",""))
  1.  I AUCDNDIC=AUCDNDD,AUCDNDIC=AUCDGNM,AUCDFILE=AUCDGNR Q
  1.  I AUCDNDIC'="",AUCDNDIC=AUCDNDD G GNMCHK
  1.  I AUCDNDIC'="",AUCDNDD="" W !,?10,"No name in ^DD.  Using name in ^DIC." S AUCDNDD=AUCDNDIC,^DD(AUCDFILE,0,"NM",AUCDNDIC)="" G GNMCHK
  1.  I AUCDNDIC="",AUCDNDD'="" W !,?10,"No name in ^DIC.  Using name in ^DD."  S AUCDNDIC=AUCDNDD,$P(^DIC(AUCDFILE,0),U,1)=AUCDNDIC,^DIC("B",AUCDNDIC,AUCDFILE)="" G GNMCHK
  1.  I AUCDNDIC="",AUCDNDD="",AUCDGNM'="",AUCDFILE=AUCDGNR W !,?10,"No name in ^DIC or ^DD.  Using name in data global." S (AUCDNDIC,AUCDNDD)=AUCDGNM,$P(^DIC(AUCDFILE,0),U,1)=AUCDNDIC,^DIC("B",AUCDNDIC,AUCDFILE)="",^DD(AUCDFILE,0,"NM",AUCDNDD)="" Q
  1.  I AUCDNDIC'="",AUCDNDD'="",AUCDNDIC'=AUCDNDD W !,?10,"Name in ^DIC and ^DD differ.  Using name in ^DIC." K ^DD(AUCDFILE,0,"NM") S AUCDNDD=AUCDNDIC,^DD(AUCDFILE,0,"NM",AUCDNDD)="" G GNMCHK
  1.  W !,?10,"Unable to deduce name.  Searching DIC(""B"")." D DICB
  1.  G:AUCDNDIC'="" GNMCHK
  1.  D READNAME
  1.  G GNMCHK
  1.  ;
  1. READNAME W !,?10,"Unable to deduce name.  Enter File Name or ""^"":  ",AUCDX I $L(AUCDX)>2,$L(AUCDX)<31,AUCDX?.ANP S (AUCDNDIC,AUCDNDD)=AUCDX,$P(^DIC(AUCDFILE,0),U,1)=AUCDNDIC,^DIC("B",AUCDNDIC,AUCDFILE)="",^DD(AUCDFILE,0,"NM",AUCDNDD)="" Q
  1.  I AUCDX'="^" W *7,"  ??" G READNAME
  1.  S ^UTILITY("AUDSET",$J,AUCDFILE,"ERR",1)= "File "_AUCDFILE_" has no name."
  1.  Q
  1.  ;
  1. GCHK ; CHECK DATA GLOBAL
  1.  S (AUCDGNM,AUCDGNR)=""
  1.  S AUCDGG=0,AUCDG=$S($D(^DIC(AUCDFILE,0,"GL"))#2:^("GL"),1:"") S:AUCDG?1"^"1U.UN1"(".UNP!(AUCDG?1"^"1"%"1U.UN1"(".UNP) AUCDGG=1
  1.  I AUCDG="" W !,?10,"File ",AUCDFILE," has no data global specified in ^DIC." D READGBL G:AUCDG'="" GCHK Q
  1.  I 'AUCDGG W !,?10,"File ",AUCDFILE," data global=",AUCDG," is invalid." D READGBL G:AUCDG'="" GCHK Q
  1.  S AUCDG="^"_AUCDUCI_$E(AUCDG,2,99),^UTILITY("AUDSET",$J,AUCDFILE)=AUCDG
  1.  Q:AUCDG["%"
  1.  S AUCDX=$E(AUCDG,1,$L(AUCDG)-1)_$S($E(AUCDG,$L(AUCDG))=",":")",1:""),AUCDX=$D(@AUCDX)
  1.  S AUCDY=$L(AUCDG),AUCDY=$E(AUCDG,1,AUCDY-1)_$E(")",$E(AUCDG,AUCDY)=","),AUCDY=$S(AUCDY[")":$E(AUCDY,1,$L(AUCDY)-1)_",0)",1:AUCDY_"(0)")
  1.  I 'AUCDX W !,?10,"Data global ",AUCDG," does not exist.  Creating 0th node!" S @AUCDY="CREATED BY AUCD"_U_AUCDFILE Q
  1.  S AUCDX=$D(@AUCDY)
  1.  I AUCDX S AUCDGNM=@AUCDY,AUCDGNR=+$P(AUCDGNM,U,2),AUCDGNM=$P(AUCDGNM,U,1) S:'AUCDGNR AUCDGNR="" G GCHK2
  1.  W !,?10,"File ",AUCDFILE," data global exists but has no 0th node.",!,?12,"Creating 0th node.  Piece 3 and 4 must be set!" S @AUCDY="CREATED BY AUCD"_U_AUCDFILE
  1.  Q
  1.  ;
  1. GCHK2 ; CHECK 3RD AND 4TH PIECE
  1.  S AUCDX=$P(@AUCDY,U,3,4),AUCDX1=$P(AUCDX,U,2),AUCDX=+AUCDX
  1.  S AUCDX2=$O(@AUCDY)
  1.  I 'AUCDX2,AUCDX!(AUCDX1) W !,?10,"Data global 0th node inconsistent with data.  Fixing." S $P(@AUCDY,U,3)=0,$P(@AUCDY,U,4)=0 G GCHK3
  1.  I AUCDX2,'AUCDX!('AUCDX1) W !,?10,"Data global 0th node inconsistent with data.  Run ^%AUCOUNT to fix." G GCHK3
  1.  I AUCDX,'$D(@(AUCDG_AUCDX_")")) W !,?10,"Data global 0th node inconsistent with data.  Run ^%AUCOUNT to fix." G GCHK3
  1. GCHK3 ; CHECK FILE NUMBER IN DATA GLOBAL
  1.  K AUCDX1,AUCDX2
  1.  Q:AUCDGNR=AUCDFILE
  1.  W !,?10,"Data global has different number than ^DIC.  ",$P(@AUCDY,U,1,2)
  1. G2R1 R !,?12,"Change number in data global? (Y/N) ",AUCDX I AUCDX'="Y"&(AUCDX'="N") W *7,"  ??" G G2R1
  1.  I AUCDX="Y" S AUCDX=@AUCDY,AUCDX1=$P(AUCDX,U,2),AUCDX2=+AUCDX1,AUCDX3=$P(AUCDX1,AUCDX2,2),$P(AUCDX,U,2)=AUCDFILE_AUCDX3,@AUCDY=AUCDX,AUCDGNR=AUCDFILE K AUCDX1,AUCDX2,AUCDX3 Q
  1.  D READGBL 
  1.  I AUCDG="" W !,?10,"Removing ^DIC(",AUCDFILE,",""0"",""GL"") node." K ^DIC(AUCDFILE,0,"GL")
  1.  G GCHK
  1.  ;
  1. READGBL R !!,"Enter Data Global or ""^"": ",AUCDG
  1.  I AUCDG="^" S AUCDG="",^UTILITY("AUDSET",$J,AUCDFILE,"ERR",2)="File "_AUCDFILE_" data global missing or invalid." Q
  1.  I AUCDG'?1"^"1U.UN1"(".UNP,AUCDG'?1"^"1"%"1U.UN1"(".UNP W *7,"  ??" G READGBL
  1.  S ^DIC(AUCDFILE,0,"GL")=AUCDG
  1.  Q
  1.  ;
  1. DICB ; CHECK DIC("B"
  1.  K AUCDNTBL S (AUCDX,AUCDC)=0 F AUCDL=0:0 S AUCDX=$O(^DIC("B",AUCDX)) Q:AUCDX=""  I $D(^(AUCDX,AUCDFILE)) S AUCDC=AUCDC+1,AUCDNTBL(AUCDC)=AUCDX
  1.  Q:'AUCDC
  1.  I AUCDC=1 S AUCDANS=1 D NAMESET K AUCDNTBL Q
  1.  W !,?12,"Multiple entries were found in ^DIC(""B""). Select one name or enter ""^""",!,?12,"  All unselected names will be removed." D PICKNAME
  1.  I AUCDANS'="^" D NAMESET K AUCDNTBL(AUCDANS) W !
  1.  S AUCDX="" F AUCDL=0:0 S AUCDX=$O(AUCDNTBL(AUCDX)) Q:AUCDX=""  W !,?12,"Deleting ^DIC(""B"",""",AUCDNTBL(AUCDX),""",",AUCDFILE,")" K ^DIC("B",AUCDNTBL(AUCDX),AUCDFILE)
  1.  W !
  1.  K AUCDNTBL
  1.  Q
  1. PICKNAME ;
  1.  F AUCDX=1:1:AUCDC W !,?14,AUCDNTBL(AUCDX)
  1. P1 R !!,?14,"Which one: ",AUCDANS Q:AUCDANS="^"  S:AUCDANS="" AUCDANS="?" I '$D(AUCDNTBL(AUCDANS)) W *7,"  ??" G P1
  1.  Q
  1. NAMESET ;
  1.  W !,?12,"Setting names to '",AUCDNTBL(AUCDANS),"'"
  1.  S (AUCDNDIC,AUCDNDD)=AUCDNTBL(AUCDANS),$P(^DIC(AUCDFILE,0),U,1)=AUCDNDIC,^DIC("B",AUCDNDIC,AUCDFILE)="" K ^DD(AUCDFILE,0,"NM") S ^DD(AUCDFILE,0,"NM",AUCDNDD)=""
  1.  Q
  1.  ;
  1. GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
  1.  Q:'AUCDGG
  1.  I AUCDGNM'=""!(AUCDGNR),AUCDNDIC'=AUCDGNM W !,?10,"Data global name does not match ^DIC.",!,?12,"Data global: ",AUCDGNM,!,?12,"       ^DIC: ",AUCDNDIC D GNMFIX
  1.  S AUCDX=AUCDG_"0)" I AUCDGNM="",AUCDGNR="",$D(@AUCDX)#2 S $P(@AUCDX,U,1)=AUCDNDIC
  1.  Q
  1. GNMFIX ;
  1.  R !,?12,"Change name in data global? (Y/N) ",AUCDX I AUCDX'="Y"&(AUCDX'="N") W *7,"  ??" G GNMFIX
  1.  I AUCDX="Y" S AUCDX=AUCDG_"0)",$P(@AUCDX,U,1)=AUCDNDIC,AUCDGNM=AUCDNDIC Q
  1. GNMR1 R !,?12,"Change names in ^DIC and ^DD to name in data global? (Y/N) ",AUCDX I AUCDX'="Y"&(AUCDX'="N") W *7,"  ??" G GNMR1
  1.  I AUCDX'="Y" S ^UTILITY("AUDSET",$J,AUCDFILE,"ERR",3)="File "_AUCDFILE_" data global name does not match ^DIC name." Q
  1.  K ^DIC("B",AUCDNDIC,AUCDFILE),^DD(AUCDFILE,0,"NM") S (AUCDNDIC,AUCDNDD)=AUCDGNM,$P(^DIC(AUCDFILE,0),U,1)=AUCDNDIC,^DIC("B",AUCDNDIC,AUCDFILE)="",^DD(AUCDFILE,0,"NM",AUCDNDD)=""
  1.  Q