AZAXGLD ;IHS/PHXAO/AEF - CLEAN UP GLD NAMESPACE
;1.0;ANNE'S SPECIAL ROUTINES;;OCT 19, 2004
;
;
;============================================================
;===== THIS SECTION CLEANS UP THE LAB TEST FILE #60 =====
;============================================================
LAB60 ;EP
;----- CLEAN UP LAB TEST FILE #60
;
N IEN0
;
S IEN0=0
F S IEN0=$O(^LAB(60,IEN0)) Q:'IEN0 D
. D LABONE(IEN0)
Q
LABONE(IEN0) ;
;----- DELETE DATA FROM ONE ENTRY
;
N SUBS
;
D LABFLDS(IEN0)
;
F SUBS=2,3,5,6,7,8,9,9.1,11 D LABSUB(IEN0,SUBS)
;
Q
LABFLDS(IEN0) ;
;----- DELETE FIELDS FROM ONE FILE 60 ENTRY
;
N DA,DIE,DR,X,Y
;
S DA=IEN0
S DIE="^LAB(60,"
S DR="400///@;99.1///@;99.2///@;504///@;999999901///@"
D ^DIE
Q
LABSUB(IEN0,SUBS) ;
;----- DELETE DATA FROM ONE SUBSCRIPT NODE OF ONE ENTRY
;
N IEN1
;
S IEN1=0
F S IEN1=$O(^LAB(60,IEN0,SUBS,IEN1)) Q:'IEN1 D
. D LABDEL(IEN0,SUBS,IEN1)
Q
LABDEL(IEN0,SUBS,IEN1) ;
;----- ACTUALLY DELETE THE DATA
;
N DA,DIK,X,Y
;
S DA=IEN1
S DA(1)=IEN0
S DIK="^LAB(60,"_DA(1)_","_SUBS_","
D ^DIK
Q
;
;================================================================
;===== THIS SECTION CLEANS UP THE V FILES =====
;================================================================
;
VFILES ;EP
;----- CLEAN UP V FILES
;
N FNUM,GL,GLOB,I,X
;
D ^XBKVAR
;
F I=1:1 S X=$T(VFLS+I) Q:X["$$END" D
. S FNUM=$P(X,";;",2)
. Q:'FNUM
. S GL=$P($G(^DIC(FNUM,0,"GL")),U,2)
. S GLOB=$P(GL,"(")
. D VK1G(GLOB)
Q
VK1G(GLOB) ;
;----- KILL ONE ENTIRE GLOBAL AND PUT BACK THE ZERO NODE
;
W !,GLOB
;
S GLOB(GLOB)=@(U_GLOB_"(0)")
S $P(GLOB(GLOB),U,3,4)=U
K @(U_GLOB)
S @(U_GLOB_"(0)")=GLOB(GLOB)
Q
VFLS ;----- THE V FILE NUMBERS TO BE CLEANED UP
;;9000010
;;9000010.01
;;9000010.02
;;9000010.03
;;9000010.04
;;9000010.05
;;9000010.06
;;9000010.07
;;9000010.08
;;9000010.09
;;9000010.11
;;9000010.12
;;9000010.13
;;9000010.14
;;9000010.15
;;9000010.16
;;9000010.17
;;9000010.18
;;9000010.19
;;9000010.21
;;9000010.22
;;9000010.23
;;9000010.24
;;9000010.25
;;9000010.28
;;9000010.29
;;9000010.31
;;9000010.32
;;9000010.33
;;9000010.34
;;9000010.35
;;9000010.37
;;9000010.38
;;9000010.39
;;9000010.41
;;9000010.42
;;$$END
AZAXGLD ;IHS/PHXAO/AEF - CLEAN UP GLD NAMESPACE
+1 ;1.0;ANNE'S SPECIAL ROUTINES;;OCT 19, 2004
+2 ;
+3 ;
+4 ;============================================================
+5 ;===== THIS SECTION CLEANS UP THE LAB TEST FILE #60 =====
+6 ;============================================================
LAB60 ;EP
+1 ;----- CLEAN UP LAB TEST FILE #60
+2 ;
+3 NEW IEN0
+4 ;
+5 SET IEN0=0
+6 FOR
SET IEN0=$ORDER(^LAB(60,IEN0))
IF 'IEN0
QUIT
Begin DoDot:1
+7 DO LABONE(IEN0)
End DoDot:1
+8 QUIT
LABONE(IEN0) ;
+1 ;----- DELETE DATA FROM ONE ENTRY
+2 ;
+3 NEW SUBS
+4 ;
+5 DO LABFLDS(IEN0)
+6 ;
+7 FOR SUBS=2,3,5,6,7,8,9,9.1,11
DO LABSUB(IEN0,SUBS)
+8 ;
+9 QUIT
LABFLDS(IEN0) ;
+1 ;----- DELETE FIELDS FROM ONE FILE 60 ENTRY
+2 ;
+3 NEW DA,DIE,DR,X,Y
+4 ;
+5 SET DA=IEN0
+6 SET DIE="^LAB(60,"
+7 SET DR="400///@;99.1///@;99.2///@;504///@;999999901///@"
+8 DO ^DIE
+9 QUIT
LABSUB(IEN0,SUBS) ;
+1 ;----- DELETE DATA FROM ONE SUBSCRIPT NODE OF ONE ENTRY
+2 ;
+3 NEW IEN1
+4 ;
+5 SET IEN1=0
+6 FOR
SET IEN1=$ORDER(^LAB(60,IEN0,SUBS,IEN1))
IF 'IEN1
QUIT
Begin DoDot:1
+7 DO LABDEL(IEN0,SUBS,IEN1)
End DoDot:1
+8 QUIT
LABDEL(IEN0,SUBS,IEN1) ;
+1 ;----- ACTUALLY DELETE THE DATA
+2 ;
+3 NEW DA,DIK,X,Y
+4 ;
+5 SET DA=IEN1
+6 SET DA(1)=IEN0
+7 SET DIK="^LAB(60,"_DA(1)_","_SUBS_","
+8 DO ^DIK
+9 QUIT
+10 ;
+11 ;================================================================
+12 ;===== THIS SECTION CLEANS UP THE V FILES =====
+13 ;================================================================
+14 ;
VFILES ;EP
+1 ;----- CLEAN UP V FILES
+2 ;
+3 NEW FNUM,GL,GLOB,I,X
+4 ;
+5 DO ^XBKVAR
+6 ;
+7 FOR I=1:1
SET X=$TEXT(VFLS+I)
IF X["$$END"
QUIT
Begin DoDot:1
+8 SET FNUM=$PIECE(X,";;",2)
+9 IF 'FNUM
QUIT
+10 SET GL=$PIECE($GET(^DIC(FNUM,0,"GL")),U,2)
+11 SET GLOB=$PIECE(GL,"(")
+12 DO VK1G(GLOB)
End DoDot:1
+13 QUIT
VK1G(GLOB) ;
+1 ;----- KILL ONE ENTIRE GLOBAL AND PUT BACK THE ZERO NODE
+2 ;
+3 WRITE !,GLOB
+4 ;
+5 SET GLOB(GLOB)=@(U_GLOB_"(0)")
+6 SET $PIECE(GLOB(GLOB),U,3,4)=U
+7 KILL @(U_GLOB)
+8 SET @(U_GLOB_"(0)")=GLOB(GLOB)
+9 QUIT
VFLS ;----- THE V FILE NUMBERS TO BE CLEANED UP
+1 ;;9000010
+2 ;;9000010.01
+3 ;;9000010.02
+4 ;;9000010.03
+5 ;;9000010.04
+6 ;;9000010.05
+7 ;;9000010.06
+8 ;;9000010.07
+9 ;;9000010.08
+10 ;;9000010.09
+11 ;;9000010.11
+12 ;;9000010.12
+13 ;;9000010.13
+14 ;;9000010.14
+15 ;;9000010.15
+16 ;;9000010.16
+17 ;;9000010.17
+18 ;;9000010.18
+19 ;;9000010.19
+20 ;;9000010.21
+21 ;;9000010.22
+22 ;;9000010.23
+23 ;;9000010.24
+24 ;;9000010.25
+25 ;;9000010.28
+26 ;;9000010.29
+27 ;;9000010.31
+28 ;;9000010.32
+29 ;;9000010.33
+30 ;;9000010.34
+31 ;;9000010.35
+32 ;;9000010.37
+33 ;;9000010.38
+34 ;;9000010.39
+35 ;;9000010.41
+36 ;;9000010.42
+37 ;;$$END
