| 1 | XBKD3 ; IHS/ADC/GTH - KILLS DICs and GLOBALS (PART 3) ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; Part of XBKD
|
|---|
| 5 | ;
|
|---|
| 6 | ; Upon entry into this routine ^DIC(file #,0) must contain
|
|---|
| 7 | ; the file name, and, if the data global is to be deleted
|
|---|
| 8 | ; piece 3 of ^UTILITY("XBDSET",$J,file #) must be a valid
|
|---|
| 9 | ; global reference.
|
|---|
| 10 | ;
|
|---|
| 11 | START ;
|
|---|
| 12 | W !!
|
|---|
| 13 | KILL ^UTILITY("XBKD",$J)
|
|---|
| 14 | S (XBKDFILE,XBKDFLG)=0
|
|---|
| 15 | F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S XBKDDEL=$P(^(XBKDFILE),U,1),XBKDTMP=$P(^(XBKDFILE),U,2),XBKDG=$P(^(XBKDFILE),U,3) D KILL Q:XBKDFLG
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | KILL ;
|
|---|
| 19 | S XBKDG="^"_$E(XBKDG,1,$L(XBKDG)-1)_$S($E(XBKDG,$L(XBKDG))=",":")",1:"")
|
|---|
| 20 | S XBKDNDIC=$P(^DIC(XBKDFILE,0),U,1)
|
|---|
| 21 | W XBKDFILE,?14,$P(^DIC(XBKDFILE,0),U,1)," <WAIT>"
|
|---|
| 22 | I XBKDTMP'="D" D SAVE
|
|---|
| 23 | KILL XBKDSFL
|
|---|
| 24 | S XBKDC=1,XBKDSFL(XBKDC)=XBKDFILE
|
|---|
| 25 | D SBTRACE
|
|---|
| 26 | KILL XBKDC,XBKDI,XBKDSF,XBKDSFL
|
|---|
| 27 | KILL ^DD("ACOMP",XBKDFILE)
|
|---|
| 28 | KILL ^DIC(XBKDFILE,"%"),^("%A"),^("%D"),^DIC("B",XBKDNDIC,XBKDFILE)
|
|---|
| 29 | I XBKDG'["DIC(",XBKDTMP="D" KILL ^DIC(XBKDFILE,0)
|
|---|
| 30 | K:XBKDDEL="D" @XBKDG
|
|---|
| 31 | I XBKDTMP="D" F DIK="^DIE(","^DIPT(","^DIBT(" W "." KILL @(DIK_"""F""_XBKDFILE)") F DA=.9:0 S DA=$O(@(DIK_"DA)")) Q:DA'>0 I $D(^(DA,0)) S %=$P(^(0),U,4) I %=""!'$D(^DD(+%)) W "." D ^DIK
|
|---|
| 32 | W !!
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | SBTRACE ; Delete all Sub-Files.
|
|---|
| 36 | F XBKDL=0:0 S XBKDI=$O(XBKDSFL("")) Q:XBKDI="" S XBKDSF=XBKDSFL(XBKDI) D SBTRACE2 S XBKDI=$O(XBKDSFL("")) W "." KILL ^DD(XBKDSFL(XBKDI)),XBKDSFL(XBKDI)
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | SBTRACE2 ;
|
|---|
| 40 | S XBKDI=0
|
|---|
| 41 | F XBKDL=0:0 S XBKDI=$O(^DD(XBKDSF,"SB",XBKDI)) Q:XBKDI="" S XBKDC=XBKDC+1,XBKDSFL(XBKDC)=XBKDI
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | SAVE ; Save "PT", "TRB", and "ACOMP" node from ^DD.
|
|---|
| 45 | S XBKDFLD=""
|
|---|
| 46 | F XBKDL=0:0 S XBKDFLD=$O(^DD("ACOMP",XBKDFILE,XBKDFLD)) Q:XBKDFLD="" S XBKDFLE2="" F XBKDL=0:0 S XBKDFLE2=$O(^DD("ACOMP",XBKDFILE,XBKDFLD,XBKDFLE2)) Q:XBKDFLE2="" D SAVE2
|
|---|
| 47 | KILL ^DD(XBKDFILE,0,"PT",XBKDFILE),XBKDFLE2
|
|---|
| 48 | W "."
|
|---|
| 49 | S FROM="^DD("_XBKDFILE_",0,""PT"",",TO="^UTILITY(""XBKD"",$J,"_XBKDFILE_",0,""PT"","
|
|---|
| 50 | D ^XBGXFR
|
|---|
| 51 | KILL ^DD(XBKDFILE,"TRB",XBKDFILE)
|
|---|
| 52 | W "."
|
|---|
| 53 | S FROM="^DD("_XBKDFILE_",""TRB"",",TO="^UTILITY(""XBKD"",$J,"_XBKDFILE_",""TRB"","
|
|---|
| 54 | D ^XBGXFR
|
|---|
| 55 | W "."
|
|---|
| 56 | S FROM="^DD(""ACOMP"","_XBKDFILE_",",TO="^UTILITY(""XBKD"",$J,""ACOMP"","_XBKDFILE_","
|
|---|
| 57 | D ^XBGXFR
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | SAVE2 ;
|
|---|
| 61 | I '$D(^DIC(XBKDFLE2))!(XBKDFILE=XBKDFLE2) W "." KILL ^DD("ACOMP",XBKDFILE,XBKDFLD,XBKDFLE2)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
