AUKD3.m

AUKD3 ; KILLS DICs and GLOBALS (PART 3) [ 08/10/88  9:16 AM ]

 ;

 ; Upon entry into this routine ^DIC(file #,0) must contain

 ; the file name, and, if the data global is to be deleted

 ; piece 3 of ^UTILITY("AUDSET",$J,file #) must be a valid

 ; global reference.

 ;

 W !!

 K ^UTILITY("AUKD",$J)

 S (AUKDFILE,AUKDFLG)=0 F AUKDL=0:0 S AUKDFILE=$O(^UTILITY("AUDSET",$J,AUKDFILE)) Q:AUKDFILE=""  S AUKDDEL=$P(^(AUKDFILE),U,1),AUKDTMP=$P(^(AUKDFILE),U,2),AUKDG=$P(^(AUKDFILE),U,3) D KILL Q:AUKDFLG

 Q

 ;

KILL ;

 S AUKDG="^"_$E(AUKDG,1,$L(AUKDG)-1)_$S($E(AUKDG,$L(AUKDG))=",":")",1:"")

 S AUKDNDIC=$P(^DIC(AUKDFILE,0),U,1)

 W AUKDFILE,?14,$P(^DIC(AUKDFILE,0),U,1),"  <WAIT>"

 ;I AUKDDEL'="D",AUKDDEL'="?" D SAVE

 I AUKDTMP'="D" D SAVE

 K AUKDSFL S AUKDC=1,AUKDSFL(AUKDC)=AUKDFILE

 D SBTRACE

 K AUKDC,AUKDI,AUKDSF,AUKDSFL

 K ^DD("ACOMP",AUKDFILE)

 K ^DIC(AUKDFILE,"%"),^("%A"),^("%D"),^DIC("B",AUKDNDIC,AUKDFILE) I AUKDG'["DIC(",AUKDTMP="D" K ^DIC(AUKDFILE,0)

 K:AUKDDEL="D" @AUKDG

 I AUKDTMP="D" F DIK="^DIE(","^DIPT(","^DIBT(" W "." K @(DIK_"""F""_AUKDFILE)") F DA=.9:0 S DA=$N(@(DIK_"DA)")) Q:DA'>0  I $D(^(DA,0)) S %=$P(^(0),U,4) I %=""!'$D(^DD(+%)) W "." D ^DIK

 W !!

 Q

 ;

SBTRACE ; DELETE ALL SUB-FILES

 F AUKDL=0:0 S AUKDI=$O(AUKDSFL("")) Q:AUKDI=""  S AUKDSF=AUKDSFL(AUKDI) D SBTRACE2 S AUKDI=$O(AUKDSFL("")) W "." K ^DD(AUKDSFL(AUKDI)),AUKDSFL(AUKDI)

 Q

SBTRACE2 ;

 S AUKDI=0 F AUKDL=0:0 S AUKDI=$O(^DD(AUKDSF,"SB",AUKDI)) Q:AUKDI=""  S AUKDC=AUKDC+1,AUKDSFL(AUKDC)=AUKDI

 Q

 ;

SAVE ; SAVE "PT", "TRB", AND "ACOMP" NODE FROM ^DD

 S AUKDFLD="" F AUKDL=0:0 S AUKDFLD=$O(^DD("ACOMP",AUKDFILE,AUKDFLD)) Q:AUKDFLD=""  S AUKDFLE2="" F AUKDL=0:0 S AUKDFLE2=$O(^DD("ACOMP",AUKDFILE,AUKDFLD,AUKDFLE2)) Q:AUKDFLE2=""  D SAVE2

 K ^DD(AUKDFILE,0,"PT",AUKDFILE)

 W "." S FROM="^DD("_AUKDFILE_",0,""PT"",",TO="^UTILITY(""AUKD"",$J,"_AUKDFILE_",0,""PT""," D ^%AUGXFR

 K ^DD(AUKDFILE,"TRB",AUKDFILE)

 W "." S FROM="^DD("_AUKDFILE_",""TRB"",",TO="^UTILITY(""AUKD"",$J,"_AUKDFILE_",""TRB""," D ^%AUGXFR

 W "." S FROM="^DD(""ACOMP"","_AUKDFILE_",",TO="^UTILITY(""AUKD"",$J,""ACOMP"","_AUKDFILE_"," D ^%AUGXFR

 Q

SAVE2 ;

 I '$D(^DIC(AUKDFLE2))!(AUKDFILE=AUKDFLE2) W "." K ^DD("ACOMP",AUKDFILE,AUKDFLD,AUKDFLE2)

 Q

AUKD3     ; KILLS DICs and GLOBALS (PART 3) [ 08/10/88  9:16 AM ]

 +1       ;

 +2       ; Upon entry into this routine ^DIC(file #,0) must contain

 +3       ; the file name, and, if the data global is to be deleted

 +4       ; piece 3 of ^UTILITY("AUDSET",$J,file #) must be a valid

 +5       ; global reference.

 +6       ;

 +7        WRITE !!

 +8        KILL ^UTILITY("AUKD",$JOB)

 +9        SET (AUKDFILE,AUKDFLG)=0

           FOR AUKDL=0:0

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

               IF AUKDFILE=""

                   QUIT 

               SET AUKDDEL=$PIECE(^(AUKDFILE),U,1)

               SET AUKDTMP=$PIECE(^(AUKDFILE),U,2)

               SET AUKDG=$PIECE(^(AUKDFILE),U,3)

               DO KILL

               IF AUKDFLG

                   QUIT 

 +10       QUIT 

 +11      ;

KILL      ;

 +1        SET AUKDG="^"_$EXTRACT(AUKDG,1,$LENGTH(AUKDG)-1)_$SELECT($EXTRACT(AUKDG,$LENGTH(AUKDG))=",":")",1:"")

 +2        SET AUKDNDIC=$PIECE(^DIC(AUKDFILE,0),U,1)

 +3        WRITE AUKDFILE,?14,$PIECE(^DIC(AUKDFILE,0),U,1),"  <WAIT>"

 +4       ;I AUKDDEL'="D",AUKDDEL'="?" D SAVE

 +5        IF AUKDTMP'="D"

               DO SAVE

 +6        KILL AUKDSFL

           SET AUKDC=1

           SET AUKDSFL(AUKDC)=AUKDFILE

 +7        DO SBTRACE

 +8        KILL AUKDC,AUKDI,AUKDSF,AUKDSFL

 +9        KILL ^DD("ACOMP",AUKDFILE)

 +10       KILL ^DIC(AUKDFILE,"%"),^("%A"),^("%D"),^DIC("B",AUKDNDIC,AUKDFILE)

           IF AUKDG'["DIC("

               IF AUKDTMP="D"

                   KILL ^DIC(AUKDFILE,0)

 +11       IF AUKDDEL="D"

               KILL @AUKDG

 +12       IF AUKDTMP="D"

               FOR DIK="^DIE(","^DIPT(","^DIBT("

                   WRITE "."

                   KILL @(DIK_"""F""_AUKDFILE)")

                   FOR DA=.9:0