source: IHS-VA_UTILITIES-XB/trunk/XBKD3.m@ 1641

Last change on this file since 1641 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.2 KB
Line 
1XBKD3 ; 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 ;
11START ;
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 ;
18KILL ;
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 ;
35SBTRACE ; 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 ;
39SBTRACE2 ;
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 ;
44SAVE ; 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 ;
60SAVE2 ;
61 I '$D(^DIC(XBKDFLE2))!(XBKDFILE=XBKDFLE2) W "." KILL ^DD("ACOMP",XBKDFILE,XBKDFLD,XBKDFLE2)
62 Q
63 ;
Note: See TracBrowser for help on using the repository browser.