- 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 ;
