| 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 ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - Also delete Forms, Protocols, and List templates. Add support for routine XBPKDEL1.
|
|---|
| 4 | ;
|
|---|
| 5 | ; XBPKNSP must be set to the namespace, e.g. "AICD" if this
|
|---|
| 6 | ; routine is called from a preinit.
|
|---|
| 7 | ;
|
|---|
| 8 | ; If you want security keys deleted, set XBPKEY=1 if this
|
|---|
| 9 | ; routine is called from a preinit.
|
|---|
| 10 | ;
|
|---|
| 11 | ; Call LIST^XBPKDEL to list all namespaced options,
|
|---|
| 12 | ; templates, etc.
|
|---|
| 13 | ;
|
|---|
| 14 | ; Call RUN^XBPKDEL to delete all namespaced options,
|
|---|
| 15 | ; templates, etc.
|
|---|
| 16 | ;
|
|---|
| 17 | ; The RUN and LIST entry points are for programmer use and
|
|---|
| 18 | ; are not to be called from a preinit. Preinit calls
|
|---|
| 19 | ; XBPKDEL directly with variables set as indicated above.
|
|---|
| 20 | ;
|
|---|
| 21 | START ;
|
|---|
| 22 | I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
|
|---|
| 23 | I '$D(XBPKNSP) W !,*7,"Namespace variable does not exist!" Q
|
|---|
| 24 | S U="^",DUZ(0)="@",XBPKQUIT=XBPKNSP_"{"
|
|---|
| 25 | I $D(XBPKRUN) S XBPKDOC="This routine"
|
|---|
| 26 | E S XBPKDOC="The preinit for this package"
|
|---|
| 27 | D ASK
|
|---|
| 28 | G:XBPKSTP A
|
|---|
| 29 | ; F XBPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D DELETE ; XB*3*8
|
|---|
| 30 | 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
|
|---|
| 31 | I $D(XBPKEY) S XBPKGLO="^DIC(19.1," D DELETE ;DELETE SECURITY KEYS WITH THIS NAMESPACE
|
|---|
| 32 | W !
|
|---|
| 33 | S %=1 D ENASK^XQ3 ;CALL TO FIX OPTION POINTERS
|
|---|
| 34 | 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."
|
|---|
| 35 | A ;
|
|---|
| 36 | D EOJ
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | ASK ;ASK USER IF WANTS TO CONTINUE
|
|---|
| 40 | S XBPKSTP=0
|
|---|
| 41 | ; W !!,*7,XBPKDOC," will delete all options, sort, input," ; XB*3*8
|
|---|
| 42 | ; W !,"and print templates, bulletins, functions, " ; XB*3*8
|
|---|
| 43 | ; W $S($D(XBPKEY):"help frames and security keys",1:"and help frames") ; XB*3*8
|
|---|
| 44 | ; W !,"namespaced '",XBPKNSP,"' that are currently in this UCI. " ; XB*3*8
|
|---|
| 45 | ; XB*3*8 begin block
|
|---|
| 46 | KILL ^UTILITY($J,"W")
|
|---|
| 47 | NEW DIW,DIWL,DIWR,DIWF,DIWT
|
|---|
| 48 | S DIWL=1,DIWR=(IOM-10),DIWF="W"
|
|---|
| 49 | W !!,*7
|
|---|
| 50 | S X=XBPKDOC
|
|---|
| 51 | D ^DIWP
|
|---|
| 52 | S X="will delete all options, templates (sort, input, list, and print), forms, bulletins, functions, protocols, "
|
|---|
| 53 | D ^DIWP
|
|---|
| 54 | S X=$S($D(XBPKEY):"help frames and security keys",1:"and help frames")_" namespaced '"_XBPKNSP_"' that are currently in this UCI."
|
|---|
| 55 | D ^DIWP,^DIWW
|
|---|
| 56 | KILL ^UTILITY($J,"W")
|
|---|
| 57 | ; XB*3*8 end block
|
|---|
| 58 | W !,"Do you want to continue"
|
|---|
| 59 | S %=1
|
|---|
| 60 | D YN^DICN
|
|---|
| 61 | I %=0 W !!,"If you answer with a ""NO"" or a ""^"" I will stop package initialization.",! G ASK
|
|---|
| 62 | I %=2!(%=-1) W:'$D(XBPKRUN) !!,*7,"Package initialization process stopped!" S XBPKSTP=1 KILL DIFQ ;KILLING DIFQ STOPS THE INITIALIZATION PROCESS
|
|---|
| 63 | W !
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | DELETE ;
|
|---|
| 67 | W !!,"Now deleting `",XBPKNSP,"' namespaced ",$P(@(XBPKGLO_"0)"),U),"S..."
|
|---|
| 68 | S XBPKNSPC=XBPKNSP
|
|---|
| 69 | I $D(@(XBPKGLO_"""B"",XBPKNSPC)")) S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")),DIK=XBPKGLO D ^DIK KILL DIK,DA
|
|---|
| 70 | ; 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
|
|---|
| 71 | 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
|
|---|
| 72 | . ; XB*3*8 begin block
|
|---|
| 73 | . ; Delete key from holders
|
|---|
| 74 | . Q:XBPKGLO'="^DIC(19.1,"
|
|---|
| 75 | . S XBPKKIEN=DA
|
|---|
| 76 | . NEW DA
|
|---|
| 77 | . S XBPKHIEN=0
|
|---|
| 78 | . F S XBPKHIEN=$O(^XUSEC(XBPKNSPC,XBPKHIEN)) Q:'XBPKHIEN D
|
|---|
| 79 | .. S DIE="^VA(200,XBPKHIEN,51,",DA(1)=XBPKHIEN,DA=XBPKKIEN,DR=".01///@"
|
|---|
| 80 | .. D ^DIE
|
|---|
| 81 | .. Q
|
|---|
| 82 | . Q
|
|---|
| 83 | ; XB*3*8 end block
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | LIST ; ENTRY POINT FOR LISTING NAMESPACED ITEMS
|
|---|
| 87 | I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
|
|---|
| 88 | S U="^",DUZ(0)="@"
|
|---|
| 89 | W !!,"Utility to list all namespaced items in current UCI",!
|
|---|
| 90 | D GETNSP
|
|---|
| 91 | G:XBPKNSP["^"!("^"[XBPKNSP) EOJ
|
|---|
| 92 | ; W !!,"Listing of items in namespace ",XBPKNSP,! ; XB*3*8
|
|---|
| 93 | W @IOF,!!,"Listing of items in namespace ",XBPKNSP,! ; XB*3*8
|
|---|
| 94 | W "--------------------------------------",!
|
|---|
| 95 | S XBPKQUIT=XBPKNSP_"{",XBPKF=0
|
|---|
| 96 | ; F XBPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D LIST2 ; XB*3*8
|
|---|
| 97 | 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
|
|---|
| 98 | G EOJ
|
|---|
| 99 | ;
|
|---|
| 100 | LIST2 ;
|
|---|
| 101 | S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSP)"))
|
|---|
| 102 | I $P(XBPKNSPC,XBPKNSP)]"" W:XBPKF ! S XBPKF=0 W "NO ",$P(@(XBPKGLO_"0)"),"^",1),"S",! Q
|
|---|
| 103 | S XBPKF=1
|
|---|
| 104 | W !,$P(@(XBPKGLO_"0)"),"^",1),"S",!
|
|---|
| 105 | S XBPKNSPC=XBPKNSP
|
|---|
| 106 | 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
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | PAUSE ; Screen control for LIST
|
|---|
| 110 | S Y=$$DIR^XBDIR("E")
|
|---|
| 111 | ; W @IOF ; XB*3*8
|
|---|
| 112 | W @IOF,! ; XB*3*8
|
|---|
| 113 | Q
|
|---|
| 114 | ;
|
|---|
| 115 | RUN ; ENTRY POINT FOR ACQUIRING CONTROL ARGUMENTS AND DOING DELETIONS
|
|---|
| 116 | I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
|
|---|
| 117 | I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
|
|---|
| 118 | W !!,"Utility to delete all namespaced items in current UCI",!
|
|---|
| 119 | D GETNSP
|
|---|
| 120 | G:XBPKNSP["^"!("^"[XBPKNSP) EOJ
|
|---|
| 121 | D GETKEY
|
|---|
| 122 | I $D(XBPKEY),XBPKEY="^" G EOJ
|
|---|
| 123 | S XBPKRUN=""
|
|---|
| 124 | G XBPKDEL
|
|---|
| 125 | ;
|
|---|
| 126 | GETNSP ; CODE TO ACQUIRE NAMESPACE
|
|---|
| 127 | R "Namespace to process: ",XBPKNSP:600,!
|
|---|
| 128 | Q:("^"[XBPKNSP)!(XBPKNSP["^")
|
|---|
| 129 | I XBPKNSP["?" W "Enter null line or '^' to quit.",!
|
|---|
| 130 | I XBPKNSP'?1U1.7UN W "Namespace must begin with an upper-case letter and",!," consist only of upper-case letters and numbers",! G GETNSP
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | GETKEY ; CODE TO ACQUIRE SECURITY KEY FLAG
|
|---|
| 134 | W "Do you want to delete security keys"
|
|---|
| 135 | S %=1
|
|---|
| 136 | D YN^DICN
|
|---|
| 137 | I %=0 W !!,"If you answer with a ""NO"" security keys will not be deleted.",! G ASK
|
|---|
| 138 | I %=2!(%=-1) S:%=-1 XBPKEY="^"
|
|---|
| 139 | E S XBPKEY=""
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | EOJ ;EP - Clean up after this routine or XBPKDEL1 ; XB*3*8
|
|---|
| 143 | ; KILL XBPKF,XBPKGLO,XBPKEY,XBPKSTP,XBPKNSP,XBPKNSPC,XBPKQUIT,XBPKRUN,XBPKDOC,DUOUT,DTOUT ; XB*3*8
|
|---|
| 144 | KILL XBPKF,XBPKGLO,XBPKHIEN,XBPKKIEN,XBPKEY,XBPKSTP,XBPKNSP,XBPKNSPC,XBPKQUIT,XBPKRUN,XBPKDOC,DUOUT,DTOUT ; XB*3*8
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
