XBKD3.m

XBKD3 ; IHS/ADC/GTH - KILLS DICs and GLOBALS (PART 3) ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; Part of XBKD

 ;

 ; 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("XBDSET",$J,file #) must be a valid

 ; global reference.

 ;

START ;

 W !!

 KILL ^UTILITY("XBKD",$J)

 S (XBKDFILE,XBKDFLG)=0

 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

 Q

 ;

KILL ;

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

 S XBKDNDIC=$P(^DIC(XBKDFILE,0),U,1)

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

 I XBKDTMP'="D" D SAVE

 KILL XBKDSFL

 S XBKDC=1,XBKDSFL(XBKDC)=XBKDFILE

 D SBTRACE

 KILL XBKDC,XBKDI,XBKDSF,XBKDSFL

 KILL ^DD("ACOMP",XBKDFILE)

 KILL ^DIC(XBKDFILE,"%"),^("%A"),^("%D"),^DIC("B",XBKDNDIC,XBKDFILE)

 I XBKDG'["DIC(",XBKDTMP="D" KILL ^DIC(XBKDFILE,0)

 K:XBKDDEL="D" @XBKDG

 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

 W !!

 Q

 ;

SBTRACE ; Delete all Sub-Files.

 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)

 Q

 ;

SBTRACE2 ;

 S XBKDI=0

 F XBKDL=0:0 S XBKDI=$O(^DD(XBKDSF,"SB",XBKDI)) Q:XBKDI=""  S XBKDC=XBKDC+1,XBKDSFL(XBKDC)=XBKDI

 Q

 ;

SAVE ; Save "PT", "TRB", and "ACOMP" node from ^DD.

 S XBKDFLD=""

 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

 KILL ^DD(XBKDFILE,0,"PT",XBKDFILE),XBKDFLE2

 W "."

 S FROM="^DD("_XBKDFILE_",0,""PT"",",TO="^UTILITY(""XBKD"",$J,"_XBKDFILE_",0,""PT"","

 D ^XBGXFR

 KILL ^DD(XBKDFILE,"TRB",XBKDFILE)

 W "."

 S FROM="^DD("_XBKDFILE_",""TRB"",",TO="^UTILITY(""XBKD"",$J,"_XBKDFILE_",""TRB"","

 D ^XBGXFR

 W "."

 S FROM="^DD(""ACOMP"","_XBKDFILE_",",TO="^UTILITY(""XBKD"",$J,""ACOMP"","_XBKDFILE_","

 D ^XBGXFR

 Q

 ;

SAVE2 ;

 I '$D(^DIC(XBKDFLE2))!(XBKDFILE=XBKDFLE2) W "." KILL ^DD("ACOMP",XBKDFILE,XBKDFLD,XBKDFLE2)

 Q

 ;

XBKD3     ; IHS/ADC/GTH - KILLS DICs and GLOBALS (PART 3) ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; Part of XBKD

 +4       ;

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

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

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

 +8       ; global reference.

 +9       ;

START     ;

 +1        WRITE !!

 +2        KILL ^UTILITY("XBKD",$JOB)

 +3        SET (XBKDFILE,XBKDFLG)=0

 +4        FOR XBKDL=0:0

               SET XBKDFILE=$ORDER(^UTILITY("XBDSET",$JOB,XBKDFILE))

               IF XBKDFILE=""

                   QUIT 

               SET XBKDDEL=$PIECE(^(XBKDFILE),U,1)

               SET XBKDTMP=$PIECE(^(XBKDFILE),U,2)

               SET XBKDG=$PIECE(^(XBKDFILE),U,3)

               DO KILL

               IF XBKDFLG

                   QUIT 

 +5        QUIT 

 +6       ;

KILL      ;

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

 +2        SET XBKDNDIC=$PIECE(^DIC(XBKDFILE,0),U,1)

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

 +4        IF XBKDTMP'="D"

               DO SAVE

 +5        KILL XBKDSFL

 +6        SET XBKDC=1

           SET XBKDSFL(XBKDC)=XBKDFILE

 +7        DO SBTRACE

 +8        KILL XBKDC,XBKDI,XBKDSF,XBKDSFL

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

 +10       KILL ^DIC(XBKDFILE,"%"),^("%A"),^("%D"),^DIC("B",XBKDNDIC,XBKDFILE)

 +11       IF XBKDG'["DIC("

               IF XBKDTMP="D"

                   KILL ^DIC(XBKDFILE,0)

 +12       IF XBKDDEL="D"

               KILL @XBKDG

 +13       IF XBKDTMP="D"

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

                   WRITE "."

                   KILL @(DIK_"""F""_XBKDFILE)")

                   FOR DA=.9:0

                       SET DA=$ORDER(@(DIK_"DA)"))

                       IF DA'>0

                           QUIT 

                       IF $DATA(^(DA,0))

                           SET %=$PIECE(^(0),U,4)

                           IF %=""!'$DATA(^DD(+%))

                               WRITE "."

                               DO ^DIK

 +14       WRITE !!

 +15       QUIT 

 +16      ;

SBTRACE   ; Delete all Sub-Files.

 +1        FOR XBKDL=0:0

               SET XBKDI=$ORDER(XBKDSFL(""))

               IF XBKDI=""

                   QUIT 

               SET XBKDSF=XBKDSFL(XBKDI)

               DO SBTRACE2

               SET XBKDI=$ORDER(XBKDSFL(""))

               WRITE "."

               KILL ^DD(XBKDSFL(XBKDI)),XBKDSFL(XBKDI)

 +2        QUIT 

 +3       ;

SBTRACE2  ;

 +1        SET XBKDI=0

 +2        FOR XBKDL=0:0

               SET XBKDI=$ORDER(^DD(XBKDSF,"SB",XBKDI))

               IF XBKDI=""

                   QUIT 

               SET XBKDC=XBKDC+1

               SET XBKDSFL(XBKDC)=XBKDI

 +3        QUIT 

 +4       ;

SAVE      ; Save "PT", "TRB", and "ACOMP" node from ^DD.

 +1        SET XBKDFLD=""

 +2        FOR XBKDL=0:0

               SET XBKDFLD=$ORDER(^DD("ACOMP",XBKDFILE,XBKDFLD))

               IF XBKDFLD=""

                   QUIT 

               SET XBKDFLE2=""

               FOR XBKDL=0:0

                   SET XBKDFLE2=$ORDER(^DD("ACOMP",XBKDFILE,XBKDFLD,XBKDFLE2))

                   IF XBKDFLE2=""

                       QUIT 

                   DO SAVE2

 +3        KILL ^DD(XBKDFILE,0,"PT",XBKDFILE),XBKDFLE2

 +4        WRITE "."

 +5        SET FROM="^DD("_XBKDFILE_",0,""PT"","

           SET TO="^UTILITY(""XBKD"",$J,"_XBKDFILE_",0,""PT"","

 +6        DO ^XBGXFR

 +7        KILL ^DD(XBKDFILE,"TRB",XBKDFILE)

 +8        WRITE "."

 +9        SET FROM="^DD("_XBKDFILE_",""TRB"","

           SET TO="^UTILITY(""XBKD"",$J,"_XBKDFILE_",""TRB"","

 +10       DO ^XBGXFR

 +11       WRITE "."

 +12       SET FROM="^DD(""ACOMP"","_XBKDFILE_","

           SET TO="^UTILITY(""XBKD"",$J,""ACOMP"","_XBKDFILE_","

 +13       DO ^XBGXFR

 +14       QUIT 

 +15      ;

SAVE2     ;

 +1        IF '$DATA(^DIC(XBKDFLE2))!(XBKDFILE=XBKDFLE2)

               WRITE "."

               KILL ^DD("ACOMP",XBKDFILE,XBKDFLD,XBKDFLE2)

 +2        QUIT 

 +3       ;