source: cprs/branches/tmg-cprs/m_files/TMGXPDIU.m@ 896

Last change on this file since 896 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 4.4 KB
RevLine 
[796]1TMGXPDIU ;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
9EN1(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
53EN2 ;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
Note: See TracBrowser for help on using the repository browser.