source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDIU.m@ 1621

Last change on this file since 1621 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1XPDIU ;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
3EN1 ;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
20EN2 ;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
Note: See TracBrowser for help on using the repository browser.