- 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
