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

AUPKDEL.m

Go to the documentation of this file. 
  1. %AUPKDEL ;DG/TPA;REMOVE OPTIONS, INPUT,SORT,PRINT TEMPLATES, HELP FRAMES, BULLETINS, FUNCTIONS,, AND IF INDICATED, SECURITY KEYS FOR A PACKAGE [ 07/19/89  11:48 AM ]
  1.  ;
  1.  ;;AUPKNSP must be set to the namespace, i.e. "AICD" if this routine is called from a preinit.
  1.  ;;If you want security keys deleted, set AUPKEY=1 if this routine is called from a preinit
  1.  ;;
  1.  ;;Call LIST^%AUPKDEL to list all namespaced options, templates, etc.
  1.  ;;Call RUN^%AUPKDEL to delete all namespaced options, templates, etc.
  1.  ;;The RUN and LIST entry points are for programmer use and are not to
  1.  ;;be called from a preinit.  Preinit calls %AUPKDEL directly with
  1.  ;;variables set as indicated above
  1.  ;
  1.  I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
  1.  I '$D(AUPKNSP) W !,*7,"Namespace variable does not exist!" Q
  1.  S U="^",DUZ(0)="@",AUPKQUIT=AUPKNSP_"{"
  1.  I $D(AUPKRUN) S AUPKDOC="This routine"
  1.  E  S AUPKDOC="The preinit for this package"
  1.  D ASK G:AUPKSTP A
  1.  F AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D DELETE
  1.  I $D(AUPKEY) S AUPKGLO="^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 D EOJ
  1.  Q
  1.  ;
  1. ASK ;ASK USER IF WANTS TO CONTINUE
  1.  S AUPKSTP=0
  1.  W !!,*7,AUPKDOC," will delete all options, sort,input,print templates,",!,"bulletins, functions, ",$S($D(AUPKEY):"help frames and security keys",1:"and help frames")," namespaced `",AUPKNSP,"' "
  1.  I $D(AUPKEY) W !,"that are currently in this UCI.  "
  1.  E  W !,"that are currently in this UCI.  "
  1.  W "Do you want to continue" S %=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(AUPKRUN) !!,*7,"Package initialization process stopped!" S AUPKSTP=1 K DIFQ ;KILLING DIFQ STOPS THE INITIALIZATION PROCESS
  1.  W ! Q
  1.  ;
  1. DELETE ;
  1.  W !!,"Now deleting `",AUPKNSP,"' namespaced ",$P(@(AUPKGLO_"0)"),U)_"S..."
  1.  S AUPKNSPC=AUPKNSP
  1.  I $D(@(AUPKGLO_"""B"",AUPKNSPC)")) S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")),DIK=AUPKGLO D ^DIK K DIK,DA
  1.  F L=0:0 S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSPC)")) Q:AUPKNSPC=""!(AUPKNSPC]AUPKQUIT)  S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")) W !,?3,AUPKNSPC S DIK=AUPKGLO D ^DIK K DIK,DA
  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 G:AUPKNSP="" EOJ
  1.  W !!,"Listing of items in namespace ",AUPKNSP,!
  1.  W "--------------------------------------",!
  1.  S AUPKQUIT=AUPKNSP_"{"
  1.  S %=0
  1.  F AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D LIST2
  1.  G EOJ
  1. LIST2 ;
  1.  S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSP)"))
  1.  I $P(AUPKNSPC,AUPKNSP)'="" W:% ! S %=0 W "NO ",$P(@(AUPKGLO_"0)"),"^",1),"S",! Q
  1.  S %=1
  1.  W !,$P(@(AUPKGLO_"0)"),"^",1),"S",!
  1.  S AUPKNSPC=AUPKNSP
  1.  F L=0:0 S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSPC)")) Q:AUPKNSPC=""!(AUPKNSPC]AUPKQUIT)  S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")) W ?3,AUPKNSPC,!
  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 G:AUPKNSP["^"!("^"[AUPKNSP) EOJ
  1.  D GETKEY I $D(AUPKEY),AUPKEY="^" G EOJ
  1.  S AUPKRUN="" G %AUPKDEL
  1.  ;
  1. GETNSP ; CODE TO ACQUIRE NAMESPACE
  1.  R "Namespace to process: ",AUPKNSP:600,!
  1.  Q:("^"[AUPKNSP)!(AUPKNSP["^")
  1.  I AUPKNSP["?" W "Enter null line or '^' to quit.",!
  1.  I AUPKNSP'?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. GETKEY ; CODE TO ACQUIRE SECURITY KEY FLAG
  1.  W "Do you want to delete security keys" S %=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 AUPKEY="^"
  1.  E  S AUPKEY=""
  1.  Q
  1.  ;
  1. EOJ ;
  1.  K AUPKGLO,AUPKEY,AUPKSTP,AUPKNSP,AUPKNSPC,AUPKQUIT,AUPKRUN,AUPKDOC
  1.  Q
  1.  ;