| 1 | TMGXPDIU ;TMG/kst/Custom version of XPDIU ;09/24/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;09/24/08
|
|---|
| 3 |
|
|---|
| 4 | ;"Original header....
|
|---|
| 5 |
|
|---|
| 6 | ;"XPDIU ;SFISC/RSD - UNload/Convert/Rollup Distribution Global ;03/23/99 08:46
|
|---|
| 7 | ;" ;;8.0;KERNEL;**15,41,44,51,58,101,108**;Jul 10, 1995
|
|---|
| 8 |
|
|---|
| 9 | EN1(IEN)
|
|---|
| 10 | ;"Purpose: Unload a distribution
|
|---|
| 11 | ;"Input: IEN -- optional. IEN of entry in INSTALL (9.7) file to delete.
|
|---|
| 12 | N %,DA,DIK,DIR,DIRUT,X,XPD,XPDST,XPDT,XPDQ,XPDQUIT,Y
|
|---|
| 13 | ;"Remove dangling transport globals
|
|---|
| 14 | S DA=0
|
|---|
| 15 | F S DA=$O(^XTMP("XPDI",DA)) Q:'DA do
|
|---|
| 16 | . I '$D(^XPD(9.7,DA)) K ^XTMP("XPDI",DA)
|
|---|
| 17 | ;"Must be Loaded or Queued and be the starting package
|
|---|
| 18 | if +$get(IEN)>0 do
|
|---|
| 19 | . S (DA,XPDST)=+IEN
|
|---|
| 20 | . ;"Build XPDT array
|
|---|
| 21 | . new XPD,XPDIT,Y
|
|---|
| 22 | . S XPD=+IEN,XPDIT=0
|
|---|
| 23 | . I '$D(^XPD(9.7,"ASP",XPD)) D XPDT^TMGXPDI1(1,XPD) Q
|
|---|
| 24 | . F S XPDIT=$O(^XPD(9.7,"ASP",XPD,XPDIT)) Q:'XPDIT do
|
|---|
| 25 | . . S Y=+$O(^(XPDIT,0))
|
|---|
| 26 | . . D XPDT^TMGXPDI1(XPDIT,Y)
|
|---|
| 27 | . I '$O(XPDT(0)) S XPDQUIT=1 D QUIT^TMGXPDI1(XPD)
|
|---|
| 28 | else do
|
|---|
| 29 | . new Scrn
|
|---|
| 30 | .;" set Scrn="I $P(^(0),U,9)<2,$D(^XPD(9.7,""ASP"",Y,1,Y))" ;//kt original screen code.
|
|---|
| 31 | . set Scrn="I $D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))" ;"As per suggestion from George Timpson
|
|---|
| 32 | . S (DA,XPDST)=$$LOOK^XPDI1(Scrn)
|
|---|
| 33 | Q:('DA)!($get(XPDQUIT)=1)
|
|---|
| 34 | S XPDQ=^XPD(9.7,DA,0)
|
|---|
| 35 | S DIR(0)="Y",DIR("A")="Want to continue with the Unload of this Distribution",DIR("B")="NO"
|
|---|
| 36 | S DIR("?")="YES will delete the Transport Global and the entry in the Install file for these Packages."
|
|---|
| 37 | I $P(XPDQ,U,9)=1,$P(XPDQ,U,6) do
|
|---|
| 38 | . W !,"This Distribution is Queued for Install with task number ",$P(XPDQ,U,6),!
|
|---|
| 39 | . W "Don't forget to delete Taskman Task."
|
|---|
| 40 | D ^DIR write !
|
|---|
| 41 | I 'Y!$D(DIRUT) D QUIT^XPDI1(XPDST) Q
|
|---|
| 42 | S XPD=0,DIK="^XPD(9.7,"
|
|---|
| 43 | ;"Need to kill the XTMP("XPDI") and the entry in the install file
|
|---|
| 44 | F S XPD=$O(XPDT(XPD)) Q:'XPD do
|
|---|
| 45 | . S DA=+XPDT(XPD)
|
|---|
| 46 | . D ^DIK
|
|---|
| 47 | . K ^XTMP("XPDI",DA)
|
|---|
| 48 | ;"check if Out-Of-Order setname is defined, kill it
|
|---|
| 49 | I $D(^XTMP("XQOO",$P(XPDQ,U))) K ^($P(XPDQ,U))
|
|---|
| 50 | D QUIT^XPDI1(XPDST)
|
|---|
| 51 | Q
|
|---|
| 52 |
|
|---|
| 53 | EN2 ;convert
|
|---|
| 54 | N %,DA,DIK,DIR,DIRUT,X,XPD,XPDBLD,XPDI,XPDNM,XPDPKG,XPDPMT,XPDST,XPDT,XPDQUIT,Y
|
|---|
| 55 | S XPDI=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y))") Q:'XPDI
|
|---|
| 56 | K XPDT("DA"),XPDT("NM")
|
|---|
| 57 | ;make sure transport globals exist
|
|---|
| 58 | S XPDT=0 F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D
|
|---|
| 59 | .S Y=+XPDT(XPDT) Q:$D(^XTMP("XPDI",Y))
|
|---|
| 60 | .W !,$P(XPDT(XPDT),U,2)," ** Transport Global doesn't exist **",$C(7)
|
|---|
| 61 | .K XPDT(XPDT) S XPDQUIT=1
|
|---|
| 62 | I $D(XPDT)'>9!$D(XPDQUIT) D QUIT^XPDI1(XPDI) Q
|
|---|
| 63 | S DIR(0)="Y",DIR("A")="Want to make the Transport Globals Permanent",DIR("B")="NO"
|
|---|
| 64 | S DIR("?",1)="YES will leave the Transport Global so you can transport this TG in multiple Distributions."
|
|---|
| 65 | S DIR("?")="NO will remove the Transport Global after you transport this TG in the next Distribution."
|
|---|
| 66 | D ^DIR I $D(DIRUT) D QUIT^XPDI1(XPDI) Q
|
|---|
| 67 | S XPDPMT=Y,DIR("A")="Want to continue with the Conversion of the Package(s)",DIR("B")="NO"
|
|---|
| 68 | S DIR("?",1)="YES will convert the Packages to globals that can be transported.",DIR("?")="An entry will be added to the Build file and the entry in the Install file will be deleted."
|
|---|
| 69 | D ^DIR I 'Y!$D(DIRUT) Q
|
|---|
| 70 | S XPDT=0,DIK="^XPD(9.7,"
|
|---|
| 71 | F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D Q:$D(XPDQUIT)
|
|---|
| 72 | .;kill Install file entry
|
|---|
| 73 | .S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDPKG=+$O(^XTMP("XPDI",XPDA,"PKG",0))
|
|---|
| 74 | .;resolve the Package file link
|
|---|
| 75 | .D:XPDPKG
|
|---|
| 76 | ..N DIC,X,Y
|
|---|
| 77 | ..S DIC="^DIC(9.4,",DIC(0)="X",X=$P(^XTMP("XPDI",XPDA,"PKG",XPDPKG,0),U)
|
|---|
| 78 | ..D ^DIC I Y<0 S XPDPKG=0 Q
|
|---|
| 79 | ..S XPDPKG=+Y
|
|---|
| 80 | .S DA=$$BLD^XPDIP(XPDBLD) D:DA
|
|---|
| 81 | ..K ^XTMP("XPDT",DA)
|
|---|
| 82 | ..S ^XTMP("XPDT",DA)=XPDPMT M ^XTMP("XPDT",DA)=^XTMP("XPDI",XPDA)
|
|---|
| 83 | .I 'DA W !,XPDNM," ** Couldn't add to Build file **" S XPDQUIT=1 Q
|
|---|
| 84 | .;kill Install file entry
|
|---|
| 85 | .S DA=XPDA D ^DIK
|
|---|
| 86 | .K ^XTMP("XPDI",XPDA)
|
|---|
| 87 | ;set expiration date to 1 year if global should be permanent, else 30
|
|---|
| 88 | S ^XTMP("XPDT",0)=$$FMADD^XLFDT(DT,$S(XPDPMT:365,1:30))_U_DT
|
|---|
| 89 | D QUIT^XPDI1(XPDI)
|
|---|
| 90 | W !," ** DONE **",!
|
|---|
| 91 | Q
|
|---|
