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

XBPKDEL.m

Go to the documentation of this file. 
  1. XBPKDEL ; IHS/ADC/GTH - REMOVE OPTIONS, INPUT,SORT,PRINT TEMPLATES, HELP FRAMES, BULLETINS, FUNCTIONS, AND IF INDICATED, SECURITY KEYS FOR A PACKAGE ; [ 12/11/2000   3:13 PM ]
  1.  ;;3.0;IHS/VA UTILITIES;**8**;FEB 07, 1997
  1.  ; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - Also delete Forms, Protocols, and List templates. Add support for routine XBPKDEL1.
  1.  ;
  1.  ; XBPKNSP must be set to the namespace, e.g. "AICD" if this
  1.  ; routine is called from a preinit.
  1.  ;
  1.  ; If you want security keys deleted, set XBPKEY=1 if this
  1.  ; routine is called from a preinit.
  1.  ;
  1.  ; Call LIST^XBPKDEL to list all namespaced options,
  1.  ; templates, etc.
  1.  ;
  1.  ; Call RUN^XBPKDEL to delete all namespaced options,
  1.  ; templates, etc.
  1.  ;
  1.  ; The RUN and LIST entry points are for programmer use and
  1.  ; are not to be called from a preinit.  Preinit calls
  1.  ; XBPKDEL directly with variables set as indicated above.
  1.  ;
  1. START ;
  1.  I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
  1.  I '$D(XBPKNSP) W !,*7,"Namespace variable does not exist!" Q
  1.  S U="^",DUZ(0)="@",XBPKQUIT=XBPKNSP_"{"
  1.  I $D(XBPKRUN) S XBPKDOC="This routine"
  1.  E  S XBPKDOC="The preinit for this package"
  1.  D ASK
  1.  G:XBPKSTP A
  1.  ; F XBPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D DELETE ; XB*3*8
  1.  F XBPKGLO="^DIBT(","^DIPT(","^SD(409.61,","^DIE(","^DIST(.403,","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC"",","^ORD(101," D DELETE ; XB*3*8
  1.  I $D(XBPKEY) S XBPKGLO="^DIC(19.1," D DELETE ;DELETE SECURITY KEYS WITH THIS NAMESPACE
  1.  W !
  1.  S %=1 D ENASK^XQ3 ;CALL TO FIX OPTION POINTERS
  1.  W !,*7,"Be sure to give users a new primary menu option if one of the menu options",!,"deleted within this namespace had been used as a primary menu option."
  1. A ;
  1.  D EOJ
  1.  Q
  1.  ;
  1. ASK ;ASK USER IF WANTS TO CONTINUE
  1.  S XBPKSTP=0
  1.  ; W !!,*7,XBPKDOC," will delete all options, sort, input," ; XB*3*8
  1.  ; W !,"and print templates, bulletins, functions, " ; XB*3*8
  1.  ; W $S($D(XBPKEY):"help frames and security keys",1:"and help frames") ; XB*3*8
  1.  ; W !,"namespaced '",XBPKNSP,"' that are currently in this UCI.  " ; XB*3*8
  1.  ; XB*3*8 begin block
  1.  KILL ^UTILITY($J,"W")
  1.  NEW DIW,DIWL,DIWR,DIWF,DIWT
  1.  S DIWL=1,DIWR=(IOM-10),DIWF="W"
  1.  W !!,*7
  1.  S X=XBPKDOC
  1.  D ^DIWP
  1.  S X="will delete all options, templates (sort, input, list, and print), forms, bulletins, functions, protocols, "
  1.  D ^DIWP
  1.  S X=$S($D(XBPKEY):"help frames and security keys",1:"and help frames")_" namespaced '"_XBPKNSP_"' that are currently in this UCI."
  1.  D ^DIWP,^DIWW
  1.  KILL ^UTILITY($J,"W")
  1.  ; XB*3*8 end block
  1.  W !,"Do you want to continue"
  1.  S %=1
  1.  D YN^DICN
  1.  I %=0 W !!,"If you answer with a ""NO"" or a ""^"" I will stop package initialization.",! G ASK
  1.  I %=2!(%=-1) W:'$D(XBPKRUN) !!,*7,"Package initialization process stopped!" S XBPKSTP=1 KILL DIFQ ;KILLING DIFQ STOPS THE INITIALIZATION PROCESS
  1.  W !
  1.  Q
  1.  ;
  1. DELETE ;
  1.  W !!,"Now deleting `",XBPKNSP,"' namespaced ",$P(@(XBPKGLO_"0)"),U),"S..."
  1.  S XBPKNSPC=XBPKNSP
  1.  I $D(@(XBPKGLO_"""B"",XBPKNSPC)")) S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")),DIK=XBPKGLO D ^DIK KILL DIK,DA
  1.  ; F L=0:0 S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSPC)")) Q:XBPKNSPC=""!(XBPKNSPC]XBPKQUIT)  S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")) W !?3,XBPKNSPC S DIK=XBPKGLO D ^DIK KILL DIK,DA ; XB*3*8
  1.  F L=0:0 S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSPC)")) Q:XBPKNSPC=""!(XBPKNSPC]XBPKQUIT)  S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")) W !?3,XBPKNSPC D  S DIK=XBPKGLO D ^DIK KILL DIK,DA ; XB*3*8
  1.  . ; XB*3*8 begin block
  1.  . ; Delete key from holders
  1.  . Q:XBPKGLO'="^DIC(19.1,"
  1.  . S XBPKKIEN=DA
  1.  . NEW DA
  1.  . S XBPKHIEN=0
  1.  . F  S XBPKHIEN=$O(^XUSEC(XBPKNSPC,XBPKHIEN)) Q:'XBPKHIEN  D
  1.  .. S DIE="^VA(200,XBPKHIEN,51,",DA(1)=XBPKHIEN,DA=XBPKKIEN,DR=".01///@"
  1.  .. D ^DIE
  1.  .. Q
  1.  . Q
  1.  ; XB*3*8 end block
  1.  Q
  1.  ;
  1. LIST ; ENTRY POINT FOR LISTING NAMESPACED ITEMS
  1.  I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
  1.  S U="^",DUZ(0)="@"
  1.  W !!,"Utility to list all namespaced items in current UCI",!
  1.  D GETNSP
  1.  G:XBPKNSP["^"!("^"[XBPKNSP) EOJ
  1.  ; W !!,"Listing of items in namespace ",XBPKNSP,! ; XB*3*8
  1.  W @IOF,!!,"Listing of items in namespace ",XBPKNSP,! ; XB*3*8
  1.  W "--------------------------------------",!
  1.  S XBPKQUIT=XBPKNSP_"{",XBPKF=0
  1.  ; F XBPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D LIST2 ; XB*3*8
  1.  F XBPKGLO="^DIBT(","^DIPT(","^SD(409.61,","^DIE(","^DIST(.403,","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC"",","^ORD(101," D LIST2 ; XB*3*8
  1.  G EOJ
  1.  ;
  1. LIST2 ;
  1.  S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSP)"))
  1.  I $P(XBPKNSPC,XBPKNSP)]"" W:XBPKF ! S XBPKF=0 W "NO ",$P(@(XBPKGLO_"0)"),"^",1),"S",! Q
  1.  S XBPKF=1
  1.  W !,$P(@(XBPKGLO_"0)"),"^",1),"S",!
  1.  S XBPKNSPC=XBPKNSP
  1.  F  Q:$D(DUOUT)  S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSPC)")) Q:XBPKNSPC=""!(XBPKNSPC]XBPKQUIT)  S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")) W ?3,XBPKNSPC,! I $Y>(IOSL-5) D PAUSE
  1.  Q
  1.  ;
  1. PAUSE ; Screen control for LIST
  1.  S Y=$$DIR^XBDIR("E")
  1.  ; W @IOF ; XB*3*8
  1.  W @IOF,! ; XB*3*8
  1.  Q
  1.  ;
  1. RUN ; ENTRY POINT FOR ACQUIRING CONTROL ARGUMENTS AND DOING DELETIONS
  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.  W !!,"Utility to delete all namespaced items in current UCI",!
  1.  D GETNSP
  1.  G:XBPKNSP["^"!("^"[XBPKNSP) EOJ
  1.  D GETKEY
  1.  I $D(XBPKEY),XBPKEY="^" G EOJ
  1.  S XBPKRUN=""
  1.  G XBPKDEL
  1.  ;
  1. GETNSP ; CODE TO ACQUIRE NAMESPACE
  1.  R "Namespace to process: ",XBPKNSP:600,!
  1.  Q:("^"[XBPKNSP)!(XBPKNSP["^")
  1.  I XBPKNSP["?" W "Enter null line or '^' to quit.",!
  1.  I XBPKNSP'?1U1.7UN W "Namespace must begin with an upper-case letter and",!," consist only of upper-case letters and numbers",! G GETNSP
  1.  Q
  1.  ;
  1. GETKEY ; CODE TO ACQUIRE SECURITY KEY FLAG
  1.  W "Do you want to delete security keys"
  1.  S %=1
  1.  D YN^DICN
  1.  I %=0 W !!,"If you answer with a ""NO"" security keys will not be deleted.",! G ASK
  1.  I %=2!(%=-1) S:%=-1 XBPKEY="^"
  1.  E  S XBPKEY=""
  1.  Q
  1.  ;
  1. EOJ ;EP - Clean up after this routine or XBPKDEL1 ; XB*3*8
  1.  ; KILL XBPKF,XBPKGLO,XBPKEY,XBPKSTP,XBPKNSP,XBPKNSPC,XBPKQUIT,XBPKRUN,XBPKDOC,DUOUT,DTOUT ; XB*3*8
  1.  KILL XBPKF,XBPKGLO,XBPKHIEN,XBPKKIEN,XBPKEY,XBPKSTP,XBPKNSP,XBPKNSPC,XBPKQUIT,XBPKRUN,XBPKDOC,DUOUT,DTOUT ; XB*3*8
  1.  Q
  1.  ;