AUCDIC2.m

AUCDIC2 ; CHECK DICTIONARY NAMES AND DATA GLOBALS [ 06/13/87  8:47 AM ]

 ;

 S (Y,AUCDUCI)="" X:$D(^%ZOSF("UCI"))#2 ^("UCI") I Y'="" S AUCDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"

 K Y

 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

 K AUCDFILE,AUCDANS,AUCDC,AUCDG,AUCDGG,AUCDGNM,AUCDGNR,AUCDNDD,AUCDNDIC,AUCDNTBL,AUCDX,AUCDY,AUCDL,AUCDY

 Q

 ;

AUCDNC ;

 S AUCDNDIC=$S($D(^DIC(AUCDFILE,0))#2:^(0),1:""),AUCDNDIC=$P(AUCDNDIC,U,1)

 D GCHK

 I AUCDNDIC'="",$D(^DD(AUCDFILE,0,"NM",AUCDNDIC))#2 K ^DD(AUCDFILE,0,"NM") S ^DD(AUCDFILE,0,"NM",AUCDNDIC)=""

 S AUCDNDD=$O(^DD(AUCDFILE,0,"NM",""))

 I AUCDNDIC=AUCDNDD,AUCDNDIC=AUCDGNM,AUCDFILE=AUCDGNR Q

 I AUCDNDIC'="",AUCDNDIC=AUCDNDD G GNMCHK

 I AUCDNDIC'="",AUCDNDD="" W !,?10,"No name in ^DD.  Using name in ^DIC." S AUCDNDD=AUCDNDIC,^DD(AUCDFILE,0,"NM",AUCDNDIC)="" G GNMCHK

 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

 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

 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

 W !,?10,"Unable to deduce name.  Searching DIC(""B"")." D DICB

 G:AUCDNDIC'="" GNMCHK

 D READNAME

 G GNMCHK

 ;

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

 I AUCDX'="^" W *7,"  ??" G READNAME

 S ^UTILITY("AUDSET",$J,AUCDFILE,"ERR",1)= "File "_AUCDFILE_" has no name."

 Q

 ;

GCHK ; CHECK DATA GLOBAL

 S (AUCDGNM,AUCDGNR)=""

 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

 I AUCDG="" W !,?10,"File ",AUCDFILE," has no data global specified in ^DIC." D READGBL G:AUCDG'="" GCHK Q

 I 'AUCDGG W !,?10,"File ",AUCDFILE," data global=",AUCDG," is invalid." D READGBL G:AUCDG'="" GCHK Q

 S AUCDG="^"_AUCDUCI_$E(AUCDG,2,99),^UTILITY("AUDSET",$J,AUCDFILE)=AUCDG

 Q:AUCDG["%"

 S AUCDX=$E(AUCDG,1,$L(AUCDG)-1)_$S($E(AUCDG,$L(AUCDG))=",":")",1:""),AUCDX=$D(@AUCDX)

 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)")

 I 'AUCDX W !,?10,"Data global ",AUCDG," does not exist.  Creating 0th node!" S @AUCDY="CREATED BY AUCD"_U_AUCDFILE Q

 S AUCDX=$D(@AUCDY)

 I AUCDX S AUCDGNM=@AUCDY,AUCDGNR=+$P(AUCDGNM,U,2),AUCDGNM=$P(AUCDGNM,U,1) S:'AUCDGNR AUCDGNR="" G GCHK2

 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

 Q

 ;

GCHK2 ; CHECK 3RD AND 4TH PIECE

 S AUCDX=$P(@AUCDY,U,3,4),AUCDX1=$P(AUCDX,U,2),AUCDX=+AUCDX

 S AUCDX2=$O(@AUCDY)

 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

 I AUCDX2,'AUCDX!('AUCDX1) W !,?10,"Data global 0th node inconsistent with data.  Run ^%AUCOUNT to fix." G GCHK3

 I AUCDX,'$D(@(AUCDG_AUCDX_")")) W !,?10,"Data global 0th node inconsistent with data.  Run ^%AUCOUNT to fix." G GCHK3

GCHK3 ; CHECK FILE NUMBER IN DATA GLOBAL

 K AUCDX1,AUCDX2

 Q:AUCDGNR=AUCDFILE

 W !,?10,"Data global has different number than ^DIC.  ",$P(@AUCDY,U,1,2)

G2R1 R !,?12,"Change number in data global? (Y/N) ",AUCDX I AUCDX'="Y"&(AUCDX'="N") W *7,"  ??" G G2R1

 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

 D READGBL 

 I AUCDG="" W !,?10,"Removing ^DIC(",AUCDFILE,",""0"",""GL"") node." K ^DIC(AUCDFILE,0,"GL")

 G GCHK

 ;

READGBL R !!,"Enter Data Global or ""^"": ",AUCDG

 I AUCDG="^" S AUCDG="",^UTILITY("AUDSET",$J,AUCDFILE,"ERR",2)="File "_AUCDFILE_" data global missing or invalid." Q

 I AUCDG'?1"^"1U.UN1"(".UNP,AUCDG'?1"^"1"%"1U.UN1"(".UNP W *7,"  ??" G READGBL

 S ^DIC(AUCDFILE,0,"GL")=AUCDG

 Q

 ;

DICB ; CHECK DIC("B"

 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

 Q:'AUCDC

 I AUCDC=1 S AUCDANS=1 D NAMESET K AUCDNTBL 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 AUCDANS'="^" D NAMESET K AUCDNTBL(AUCDANS) W !

 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)

 W !

 K AUCDNTBL

 Q

PICKNAME ;

 F AUCDX=1:1:AUCDC W !,?14,AUCDNTBL(AUCDX)

P1 R !!,?14,"Which one: ",AUCDANS Q:AUCDANS="^"  S:AUCDANS="" AUCDANS="?" I '$D(AUCDNTBL(AUCDANS)) W *7,"  ??" G P1

 Q

NAMESET ;

 W !,?12,"Setting names to '",AUCDNTBL(AUCDANS),"'"

 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)=""

 Q

 ;

GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC

 Q:'AUCDGG

 I AUCDGNM'=""!(AUCDGNR),AUCDNDIC'=AUCDGNM W !,?10,"Data global name does not match ^DIC.",!,?12,"Data global: ",AUCDGNM,!,?12,"       ^DIC: ",AUCDNDIC D GNMFIX

 S AUCDX=AUCDG_"0)" I AUCDGNM="",AUCDGNR="",$D(@AUCDX)#2 S $P(@AUCDX,U,1)=AUCDNDIC

 Q

GNMFIX ;

 R !,?12,"Change name in data global? (Y/N) ",AUCDX I AUCDX'="Y"&(AUCDX'="N") W *7,"  ??" G GNMFIX

 I AUCDX="Y" S AUCDX=AUCDG_"0)",$P(@AUCDX,U,1)=AUCDNDIC,AUCDGNM=AUCDNDIC Q

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

 I AUCDX'="Y" S ^UTILITY("AUDSET",$J,AUCDFILE,"ERR",3)="File "_AUCDFILE_" data global name does not match ^DIC name." Q

 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)=""

 Q

AUCDIC2   ; CHECK DICTIONARY NAMES AND DATA GLOBALS [ 06/13/87  8:47 AM ]

 +1       ;

 +2        SET (Y,AUCDUCI)=""

           IF $DATA(^%ZOSF("UCI"))#2

               XECUTE ^("UCI")

           IF Y'=""

               SET AUCDUCI="["""_$PIECE(Y,",",1)_""""_$SELECT($PIECE(Y,",",2)'="":","""_$PIECE(Y,",",2)_"""",1:"")_"]"

 +3        KILL Y

 +4        WRITE !!,"Now checking dictionary names and data globals."

           SET AUCDFILE=""

           FOR AUCDL=0:0

               SET AUCDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUCDFILE))

               IF AUCDFILE=""

                   QUIT 

               WRITE !,?5,"Checking ",AUCDFILE

               DO AUCDNC

 +5        KILL AUCDFILE,AUCDANS,AUCDC,AUCDG,AUCDGG,AUCDGNM,AUCDGNR,AUCDNDD,AUCDNDIC,AUCDNTBL,AUCDX,AUCDY,AUCDL,AUCDY

 +6        QUIT 

 +7       ;

AUCDNC    ;

 +1        SET AUCDNDIC=$SELECT($DATA(^DIC(AUCDFILE,0))#2:^(0),1:"")

           SET AUCDNDIC=$PIECE(AUCDNDIC,U,1)

 +2        DO GCHK

 +3        IF AUCDNDIC'=""

               IF $DATA(^DD(AUCDFILE,0,"NM",AUCDNDIC))#2

                   KILL ^DD(AUCDFILE,0,"NM")

                   SET ^DD(AUCDFILE,0,"NM",AUCDNDIC)=""

 +4        SET AUCDNDD=$ORDER(^DD(AUCDFILE,0,"NM",""))

 +5        IF AUCDNDIC=AUCDNDD

               IF AUCDNDIC=AUCDGNM

                   IF AUCDFILE=AUCDGNR

                       QUIT 

 +6        IF AUCDNDIC'=""

               IF AUCDNDIC=AUCDNDD

                   GOTO GNMCHK

 +7        IF AUCDNDIC'=""

               IF AUCDNDD=""

                   WRITE !,?10,"No name in ^DD.  Using name in ^DIC."

                   SET AUCDNDD=AUCDNDIC

                   SET ^DD(AUCDFILE,0,"NM",AUCDNDIC)=""

                   GOTO GNMCHK

 +8        IF AUCDNDIC=""

               IF AUCDNDD'=""

                   WRITE !,?10,"No name in ^DIC.  Using name in ^DD."

                   SET AUCDNDIC=AUCDNDD

                   SET $PIECE(^DIC(AUCDFILE,0),U,1)=AUCDNDIC

                   SET ^DIC("B",AUCDNDIC,AUCDFILE)=""

                   GOTO GNMCHK

 +9        IF AUCDNDIC=""

               IF AUCDNDD=""

                   IF AUCDGNM'=""

                       IF AUCDFILE=AUCDGNR

                           WRITE !,?10,"No name in ^DIC or ^DD.  Using name in data global."

                           SET (AUCDNDIC,AUCDNDD)=AUCDGNM

                           SET $PIECE(^DIC(AUCDFILE,0),U,1)=AUCDNDIC

                           SET ^DIC("B",AUCDNDIC,AUCDFILE)=""

                           SET ^DD(AUCDFILE,0,"NM",AUCDNDD)=""

                           QUIT 

 +10       IF AUCDNDIC'=""

               IF AUCDNDD'=""

                   IF AUCDNDIC'=AUCDNDD

                       WRITE !,?10,"Name in ^DIC and ^DD differ.  Using name in ^DIC."

                       KILL ^DD(AUCDFILE,0,"NM")

                       SET AUCDNDD=AUCDNDIC

                       SET ^DD(AUCDFILE,0,"NM",AUCDNDD)=""

                       GOTO GNMCHK

 +11       WRITE !,?10,"Unable to deduce name.  Searching DIC(""B"")."

           DO DICB

 +12       IF AUCDNDIC'=""

               GOTO GNMCHK

 +13       DO READNAME

 +14       GOTO GNMCHK

 +15      ;

READNAME   WRITE !,?10,"Unable to deduce name.  Enter File Name or ""^"":  ",AUCDX

           IF $LENGTH(AUCDX)>2

               IF $LENGTH(AUCDX)<31

                   IF AUCDX?.ANP

                       SET (AUCDNDIC,AUCDNDD)=AUCDX

                       SET $PIECE(^DIC(AUCDFILE,0),U,1)=AUCDNDIC

                       SET ^DIC("B",AUCDNDIC,AUCDFILE)=""

                       SET ^DD(AUCDFILE,0,"NM",AUCDNDD)=""

                       QUIT 

 +1        IF AUCDX'="^"

               WRITE *7,"  ??"

               GOTO READNAME

 +2        SET ^UTILITY("AUDSET",$JOB,AUCDFILE,"ERR",1)=