source: IHS-VA_UTILITIES-XB/trunk/XBPKDEL1.m@ 1718

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

Modified directory structure; moved routines.
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.