Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBPKDEL1

XBPKDEL1.m

Go to the documentation of this file. 
  1. XBPKDEL1 ; IHS/ADC/GTH - DELETE RETIRED AND REPLACED PACKAGES ; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**8,9**;FEB 07, 1997
  1.  ; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - New routine with patch 8.
  1.  ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Use $GLOBAL.
  1.  ;
  1.  ; DECERT subroutine processes a list of retired/replaced
  1.  ; packages, and gives the user the opportunity to delete all
  1.  ; the package components, the routines, and globals, in the
  1.  ; namspace of the package.
  1.  ;
  1. Q Q
  1.  ; -------------------------------------------------------------
  1. DECERT ;EP - Delete de-certified packages.
  1.  I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
  1.  I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
  1.  ;
  1.  W @IOF,!!,"You'll be given the opportunity to delete the following packages,",!,"Routines, and Globals in the indicated namespace, in 3 steps."
  1. L1 ;
  1.  W !,"NAMESPACE--DESCRIPTION----------------------------RTNS-----GBLS------"
  1.  ;
  1.  NEW C,G,L,R
  1.  ;
  1.  F C=1:1 S L=$T(KILLEM+C),L=$P(L,";",3) Q:L="###"  D
  1.  . W !,$P(L,"^",1),?11,$P(L,"^",2),?50,$J($$RSEL^ZIBRSEL($P(L,"^",1)_"*"),4),?59,$J($$CG($P(L,"^",1)),4)
  1.  . I $Y>(IOSL-3),$$DIR^XBDIR("E","Press RETURN for the rest of the list") W @IOF
  1.  .Q
  1.  ;
  1.  Q:$G(XBLIST)
  1.  ;
  1.  I '$$DIR^XBDIR("Y","Are you sure you want to continue","NO",$G(DTIME,300)) Q
  1.  ;
  1.  W !!,"There will be 3 steps:"
  1.  W !?10,"1)  Delete package via call to XBPKDEL;"
  1.  W !?10,"2)  Delete Routines (not asked if 0 routines);"
  1.  W !?10,"3)  Delete Globals (not asked if 0 globals)."
  1.  W !,"Of course, your wisdom will be questioned if you do this w/o a full b/u...",!
  1.  ;
  1.  Q:'$$DIR^XBDIR("E")
  1.  ;
  1.  F C=1:1 S L=$T(KILLEM+C),L=$P(L,";",3) Q:L="###"  D  Q:$G(XBPKSTP)
  1.  . W !!,$P(L,"^",1),?11,$P(L,"^",2)
  1.  . S XBPKEY=1,XBPKNSP=$P(L,"^",1)
  1.  . D DEL(XBPKNSP)
  1.  . Q:$G(XBPKSTP)
  1.  . D RTNS(XBPKNSP)
  1.  . Q:$G(XBPKSTP)
  1.  . D GBLS(XBPKNSP)
  1.  . Q:$G(XBPKSTP)
  1.  .Q
  1.  ;
  1.  D EOJ^XBPKDEL
  1.  Q
  1.  ;
  1.  ; -------------------------------------------------------------
  1. DEL(XBPKNSP) ;
  1.  W !,"Deleting the ",XBPKNSP," package components via call to XBPKDEL"
  1.  NEW C,G,L,R
  1.  S XBPKRUN=""
  1.  D ^XBPKDEL
  1.  Q
  1.  ; -------------------------------------------------------------
  1. RTNS(XBPKNSP) ;
  1.  NEW C,G,L,R,XB
  1.  S XB=$$RSEL^ZIBRSEL(XBPKNSP_"*")
  1.  Q:'XB
  1.  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
  1.  W !,"Deleting ",XB," ",XBPKNSP," routines",!
  1.  S X=""
  1.  F  S X=$O(^TMP("ZIBRSEL",$J,X)) Q:X=""  W X,$J("",10-$L(X)) X ^%ZOSF("DEL")
  1.  KILL ^TMP("ZIBRSEL",$J)
  1.  Q
  1.  ; -------------------------------------------------------------
  1. GBLS(XBPKNSP) ;
  1.  NEW C,G,L,R,XB
  1.  S XB=$$CG(XBPKNSP)
  1.  Q:'XB
  1.  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
  1.  W !,"Kill'ing ",$$CG(XBPKNSP)," ",XBPKNSP," globals",!
  1.  S G="^"_XBPKNSP,L=$L(XBPKNSP)
  1.  ;I '$$KILLOK^ZIBGCHAR(G) KILL @G ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  I '$$KILLOK^ZIBGCHAR(XBPKNSP) KILL @G ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;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
  1.  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
  1.  . I '$$KILLOK^ZIBGCHAR($E(G,2,$L(G))) KILL @G Q
  1.  . W !,"<KILL UNSUCCESSFUL>: ",$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($E(G,2,$L(G))))
  1.  .Q
  1.  Q
  1.  ; -------------------------------------------------------------
  1. CG(N) ; Count the globals in the N namespace.    
  1.  NEW C,G,L,R
  1.  S C=0,G="^"_N,L=$L(N)
  1.  I $D(@G) S C=1
  1.  ;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
  1.  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
  1.  Q C
  1.  ; -------------------------------------------------------------
  1. LIST ;EP - List retired/replaced packages.
  1.  NEW XBLIST
  1.  S XBLIST=1
  1.  W @IOF
  1.  D L1
  1.  Q
  1.  ; -------------------------------------------------------------
  1. KILLEM ; Add the packages to be deleted, below: Namespace^Description
  1.  ;;AAPC^Ambulatory Patient Care Data Entry
  1.  ;;ACI^Injury Report
  1.  ;;ACHA^Community Health Nursing
  1.  ;;ADB^Diabetic Tracking System
  1.  ;;AMAL^Malpractice Claims
  1.  ;;APCM^PCC Table Maintenance
  1.  ;;AMCP^Women's Health/Pap Smear
  1.  ;;AMR^Management Status
  1.  ;;AMS^Management Referral
  1.  ;;APCQ^PCC Quality Assurance
  1.  ;;APCG^Family Genetic Linkage
  1.  ;;APCR^PCC Register
  1.  ;;APCS^PCC Surveillance
  1.  ;;APCT^PCC Clinic Training
  1.  ;;APHR^Physician Tracking
  1.  ;;ATA^Original Time and Attendance
  1.  ;;ALP^Mainframe to RPMS data insertion
  1.  ;;BRB^Institutional Review Board
  1.  ;;###
  1.  ;