| 1 | XPDIU ;SFISC/RSD - UNload/Convert/Rollup Distribution Global ;03/23/99 08:46
|
|---|
| 2 | ;;8.0;KERNEL;**15,41,44,51,58,101,108**;Jul 10, 1995
|
|---|
| 3 | EN1 ;unload
|
|---|
| 4 | N %,DA,DIK,DIR,DIRUT,X,XPD,XPDST,XPDT,XPDQ,XPDQUIT,Y
|
|---|
| 5 | ;remove dangling transport globals
|
|---|
| 6 | S DA=0 F S DA=$O(^XTMP("XPDI",DA)) Q:'DA I '$D(^XPD(9.7,DA)) K ^XTMP("XPDI",DA)
|
|---|
| 7 | ;must be Loaded or Queued and be the starting package
|
|---|
| 8 | S (DA,XPDST)=$$LOOK^XPDI1("I $P(^(0),U,9)<2,$D(^XPD(9.7,""ASP"",Y,1,Y))") Q:'DA
|
|---|
| 9 | S XPDQ=^XPD(9.7,DA,0),DIR(0)="Y",DIR("A")="Want to continue with the Unload of this Distribution",DIR("B")="NO"
|
|---|
| 10 | S DIR("?")="YES will delete the Transport Global and the entry in the Install file for these Packages."
|
|---|
| 11 | I $P(XPDQ,U,9)=1,$P(XPDQ,U,6) W !,"This Distribution is Queued for Install with task number ",$P(XPDQ,U,6),!,"Don't forget to delete Taskman Task."
|
|---|
| 12 | D ^DIR I 'Y!$D(DIRUT) D QUIT^XPDI1(XPDST) Q
|
|---|
| 13 | S XPD=0,DIK="^XPD(9.7,"
|
|---|
| 14 | ;need to kill the XTMP("XPDI") and the entry in the install file
|
|---|
| 15 | F S XPD=$O(XPDT(XPD)) Q:'XPD S DA=+XPDT(XPD) D ^DIK K ^XTMP("XPDI",DA)
|
|---|
| 16 | ;check if Out-Of-Order setname is defined, kill it
|
|---|
| 17 | I $D(^XTMP("XQOO",$P(XPDQ,U))) K ^($P(XPDQ,U))
|
|---|
| 18 | D QUIT^XPDI1(XPDST)
|
|---|
| 19 | Q
|
|---|
| 20 | EN2 ;convert
|
|---|
| 21 | N %,DA,DIK,DIR,DIRUT,X,XPD,XPDBLD,XPDI,XPDNM,XPDPKG,XPDPMT,XPDST,XPDT,XPDQUIT,Y
|
|---|
| 22 | S XPDI=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y))") Q:'XPDI
|
|---|
| 23 | K XPDT("DA"),XPDT("NM")
|
|---|
| 24 | ;make sure transport globals exist
|
|---|
| 25 | S XPDT=0 F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D
|
|---|
| 26 | .S Y=+XPDT(XPDT) Q:$D(^XTMP("XPDI",Y))
|
|---|
| 27 | .W !,$P(XPDT(XPDT),U,2)," ** Transport Global doesn't exist **",$C(7)
|
|---|
| 28 | .K XPDT(XPDT) S XPDQUIT=1
|
|---|
| 29 | I $D(XPDT)'>9!$D(XPDQUIT) D QUIT^XPDI1(XPDI) Q
|
|---|
| 30 | S DIR(0)="Y",DIR("A")="Want to make the Transport Globals Permanent",DIR("B")="NO"
|
|---|
| 31 | S DIR("?",1)="YES will leave the Transport Global so you can transport this TG in multiple Distributions."
|
|---|
| 32 | S DIR("?")="NO will remove the Transport Global after you transport this TG in the next Distribution."
|
|---|
| 33 | D ^DIR I $D(DIRUT) D QUIT^XPDI1(XPDI) Q
|
|---|
| 34 | S XPDPMT=Y,DIR("A")="Want to continue with the Conversion of the Package(s)",DIR("B")="NO"
|
|---|
| 35 | 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."
|
|---|
| 36 | D ^DIR I 'Y!$D(DIRUT) Q
|
|---|
| 37 | S XPDT=0,DIK="^XPD(9.7,"
|
|---|
| 38 | F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D Q:$D(XPDQUIT)
|
|---|
| 39 | .;kill Install file entry
|
|---|
| 40 | .S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDPKG=+$O(^XTMP("XPDI",XPDA,"PKG",0))
|
|---|
| 41 | .;resolve the Package file link
|
|---|
| 42 | .D:XPDPKG
|
|---|
| 43 | ..N DIC,X,Y
|
|---|
| 44 | ..S DIC="^DIC(9.4,",DIC(0)="X",X=$P(^XTMP("XPDI",XPDA,"PKG",XPDPKG,0),U)
|
|---|
| 45 | ..D ^DIC I Y<0 S XPDPKG=0 Q
|
|---|
| 46 | ..S XPDPKG=+Y
|
|---|
| 47 | .S DA=$$BLD^XPDIP(XPDBLD) D:DA
|
|---|
| 48 | ..K ^XTMP("XPDT",DA)
|
|---|
| 49 | ..S ^XTMP("XPDT",DA)=XPDPMT M ^XTMP("XPDT",DA)=^XTMP("XPDI",XPDA)
|
|---|
| 50 | .I 'DA W !,XPDNM," ** Couldn't add to Build file **" S XPDQUIT=1 Q
|
|---|
| 51 | .;kill Install file entry
|
|---|
| 52 | .S DA=XPDA D ^DIK
|
|---|
| 53 | .K ^XTMP("XPDI",XPDA)
|
|---|
| 54 | ;set expiration date to 1 year if global should be permanent, else 30
|
|---|
| 55 | S ^XTMP("XPDT",0)=$$FMADD^XLFDT(DT,$S(XPDPMT:365,1:30))_U_DT
|
|---|
| 56 | D QUIT^XPDI1(XPDI)
|
|---|
| 57 | W !," ** DONE **",!
|
|---|
| 58 | Q
|
|---|
