source: IHS-VA_UTILITIES-XB/XBPKDEL1.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 4.4 KB
Line 
1XBPKDEL1 ; IHS/ADC/GTH - DELETE RETIRED AND REPLACED PACKAGES ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - New routine with patch 8.
4 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Use $GLOBAL.
5 ;
6 ; DECERT subroutine processes a list of retired/replaced
7 ; packages, and gives the user the opportunity to delete all
8 ; the package components, the routines, and globals, in the
9 ; namspace of the package.
10 ;
11Q Q
12 ; -------------------------------------------------------------
13DECERT ;EP - Delete de-certified packages.
14 I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
15 I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
16 ;
17 W @IOF,!!,"You'll be given the opportunity to delete the following packages,",!,"Routines, and Globals in the indicated namespace, in 3 steps."
18L1 ;
19 W !,"NAMESPACE--DESCRIPTION----------------------------RTNS-----GBLS------"
20 ;
21 NEW C,G,L,R
22 ;
23 F C=1:1 S L=$T(KILLEM+C),L=$P(L,";",3) Q:L="###" D
24 . W !,$P(L,"^",1),?11,$P(L,"^",2),?50,$J($$RSEL^ZIBRSEL($P(L,"^",1)_"*"),4),?59,$J($$CG($P(L,"^",1)),4)
25 . I $Y>(IOSL-3),$$DIR^XBDIR("E","Press RETURN for the rest of the list") W @IOF
26 .Q
27 ;
28 Q:$G(XBLIST)
29 ;
30 I '$$DIR^XBDIR("Y","Are you sure you want to continue","NO",$G(DTIME,300)) Q
31 ;
32 W !!,"There will be 3 steps:"
33 W !?10,"1) Delete package via call to XBPKDEL;"
34 W !?10,"2) Delete Routines (not asked if 0 routines);"
35 W !?10,"3) Delete Globals (not asked if 0 globals)."
36 W !,"Of course, your wisdom will be questioned if you do this w/o a full b/u...",!
37 ;
38 Q:'$$DIR^XBDIR("E")
39 ;
40 F C=1:1 S L=$T(KILLEM+C),L=$P(L,";",3) Q:L="###" D Q:$G(XBPKSTP)
41 . W !!,$P(L,"^",1),?11,$P(L,"^",2)
42 . S XBPKEY=1,XBPKNSP=$P(L,"^",1)
43 . D DEL(XBPKNSP)
44 . Q:$G(XBPKSTP)
45 . D RTNS(XBPKNSP)
46 . Q:$G(XBPKSTP)
47 . D GBLS(XBPKNSP)
48 . Q:$G(XBPKSTP)
49 .Q
50 ;
51 D EOJ^XBPKDEL
52 Q
53 ;
54 ; -------------------------------------------------------------
55DEL(XBPKNSP) ;
56 W !,"Deleting the ",XBPKNSP," package components via call to XBPKDEL"
57 NEW C,G,L,R
58 S XBPKRUN=""
59 D ^XBPKDEL
60 Q
61 ; -------------------------------------------------------------
62RTNS(XBPKNSP) ;
63 NEW C,G,L,R,XB
64 S XB=$$RSEL^ZIBRSEL(XBPKNSP_"*")
65 Q:'XB
66 I '$$DIR^XBDIR("Y","Delete "_XB_" routines in the "_XBPKNSP_" namespace","NO","","If you answer 'YES', the routines will be deleted") S:X=U XBPKSTP=1 Q
67 W !,"Deleting ",XB," ",XBPKNSP," routines",!
68 S X=""
69 F S X=$O(^TMP("ZIBRSEL",$J,X)) Q:X="" W X,$J("",10-$L(X)) X ^%ZOSF("DEL")
70 KILL ^TMP("ZIBRSEL",$J)
71 Q
72 ; -------------------------------------------------------------
73GBLS(XBPKNSP) ;
74 NEW C,G,L,R,XB
75 S XB=$$CG(XBPKNSP)
76 Q:'XB
77 I '$$DIR^XBDIR("Y","Delete "_XB_" globals in the "_XBPKNSP_" namespace","NO","","If you answer 'YES', the globals will be deleted") S:X=U XBPKSTP=1 Q
78 W !,"Kill'ing ",$$CG(XBPKNSP)," ",XBPKNSP," globals",!
79 S G="^"_XBPKNSP,L=$L(XBPKNSP)
80 ;I '$$KILLOK^ZIBGCHAR(G) KILL @G ;IHS/SET/GTH XB*3*9 10/29/2002
81 I '$$KILLOK^ZIBGCHAR(XBPKNSP) KILL @G ;IHS/SET/GTH XB*3*9 10/29/2002
82 ;F S G=$O(@G) Q:'($E(G,1,L)=XBPKNSP) S G="^"_G W G,$J("",10-$L(G)) D ;IHS/SET/GTH XB*3*9 10/29/2002
83 F S G=$O(^$G(G)) Q:'($E(G,2,L+1)=XBPKNSP) W G,$J("",10-$L(G)) D ;IHS/SET/GTH XB*3*9 10/29/2002
84 . I '$$KILLOK^ZIBGCHAR($E(G,2,$L(G))) KILL @G Q
85 . W !,"<KILL UNSUCCESSFUL>: ",$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($E(G,2,$L(G))))
86 .Q
87 Q
88 ; -------------------------------------------------------------
89CG(N) ; Count the globals in the N namespace.
90 NEW C,G,L,R
91 S C=0,G="^"_N,L=$L(N)
92 I $D(@G) S C=1
93 ;F S G=$O(@G) Q:'($E(G,1,L)=N) S G="^"_G,C=C+1 ;IHS/SET/GTH XB*3*9 10/29/2002
94 F S G=$O(^$G(G)) Q:'($E(G,2,L+1)=N) S C=C+1 ;IHS/SET/GTH XB*3*9 10/29/2002
95 Q C
96 ; -------------------------------------------------------------
97LIST ;EP - List retired/replaced packages.
98 NEW XBLIST
99 S XBLIST=1
100 W @IOF
101 D L1
102 Q
103 ; -------------------------------------------------------------
104KILLEM ; Add the packages to be deleted, below: Namespace^Description
105 ;;AAPC^Ambulatory Patient Care Data Entry
106 ;;ACI^Injury Report
107 ;;ACHA^Community Health Nursing
108 ;;ADB^Diabetic Tracking System
109 ;;AMAL^Malpractice Claims
110 ;;APCM^PCC Table Maintenance
111 ;;AMCP^Women's Health/Pap Smear
112 ;;AMR^Management Status
113 ;;AMS^Management Referral
114 ;;APCQ^PCC Quality Assurance
115 ;;APCG^Family Genetic Linkage
116 ;;APCR^PCC Register
117 ;;APCS^PCC Surveillance
118 ;;APCT^PCC Clinic Training
119 ;;APHR^Physician Tracking
120 ;;ATA^Original Time and Attendance
121 ;;ALP^Mainframe to RPMS data insertion
122 ;;BRB^Institutional Review Board
123 ;;###
124 ;
Note: See TracBrowser for help on using the repository browser.