Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDIU

XPDIU.m

Go to the documentation of this file.
  1. XPDIU ;SFISC/RSD - UNload/Convert/Rollup Distribution Global ;08/14/2008
  1. ;;8.0;KERNEL;**15,41,44,51,58,101,108,506**;Jul 10, 1995;Build 19
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. EN1 ;unload
  1. N %,DA,DIK,DIR,DIRUT,X,XPD,XPDST,XPDT,XPDQ,XPDQUIT,Y
  1. ;remove dangling transport globals
  1. S DA=0 F S DA=$O(^XTMP("XPDI",DA)) Q:'DA I '$D(^XPD(9.7,DA)) K ^XTMP("XPDI",DA)
  1. ;must be the starting package and still exist in the transport global
  1. S (DA,XPDST)=$$LOOK^XPDI1("I $D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))") Q:'DA
  1. S XPDQ=^XPD(9.7,DA,0),DIR(0)="Y",DIR("A")="Want to continue with the Unload of this Distribution",DIR("B")="NO"
  1. ;check if install has status of start
  1. I $P(XPDQ,U,9)=2 W !!,"***WARNING*** Install ",$P(XPDQ,U)," has already started!",!," Unloading this install might leave your system in an unstable state!!",!!
  1. S DIR("?")="YES will delete the Transport Global and the entry in the Install file for these Packages."
  1. 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.",!
  1. W ! D ^DIR I 'Y!$D(DIRUT) D QUIT^XPDI1(XPDST) Q
  1. S XPD=0,DIK="^XPD(9.7,"
  1. ;need to kill the XTMP("XPDI") and the entry in the install file
  1. F S XPD=$O(XPDT(XPD)) Q:'XPD S DA=+XPDT(XPD) D ^DIK K ^XTMP("XPDI",DA)
  1. ;check if Out-Of-Order setname is defined, kill it
  1. I $D(^XTMP("XQOO",$P(XPDQ,U))) K ^($P(XPDQ,U))
  1. D QUIT^XPDI1(XPDST)
  1. Q
  1. EN2 ;convert
  1. N %,DA,DIK,DIR,DIRUT,X,XPD,XPDBLD,XPDI,XPDNM,XPDPKG,XPDPMT,XPDST,XPDT,XPDQUIT,Y
  1. S XPDI=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y))") Q:'XPDI
  1. K XPDT("DA"),XPDT("NM")
  1. ;make sure transport globals exist
  1. S XPDT=0 F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D
  1. .S Y=+XPDT(XPDT) Q:$D(^XTMP("XPDI",Y))
  1. .W !,$P(XPDT(XPDT),U,2)," ** Transport Global doesn't exist **",$C(7)
  1. .K XPDT(XPDT) S XPDQUIT=1
  1. I $D(XPDT)'>9!$D(XPDQUIT) D QUIT^XPDI1(XPDI) Q
  1. S DIR(0)="Y",DIR("A")="Want to make the Transport Globals Permanent",DIR("B")="NO"
  1. S DIR("?",1)="YES will leave the Transport Global so you can transport this TG in multiple Distributions."
  1. S DIR("?")="NO will remove the Transport Global after you transport this TG in the next Distribution."
  1. D ^DIR I $D(DIRUT) D QUIT^XPDI1(XPDI) Q
  1. S XPDPMT=Y,DIR("A")="Want to continue with the Conversion of the Package(s)",DIR("B")="NO"
  1. 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."
  1. D ^DIR I 'Y!$D(DIRUT) Q
  1. S XPDT=0,DIK="^XPD(9.7,"
  1. F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D Q:$D(XPDQUIT)
  1. .;kill Install file entry
  1. .S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDPKG=+$O(^XTMP("XPDI",XPDA,"PKG",0))
  1. .;resolve the Package file link
  1. .D:XPDPKG
  1. ..N DIC,X,Y
  1. ..S DIC="^DIC(9.4,",DIC(0)="X",X=$P(^XTMP("XPDI",XPDA,"PKG",XPDPKG,0),U)
  1. ..D ^DIC I Y<0 S XPDPKG=0 Q
  1. ..S XPDPKG=+Y
  1. ..Q
  1. .S DA=$$BLD^XPDIP(XPDBLD) D:DA
  1. ..K ^XTMP("XPDT",DA)
  1. ..;check that component files exists
  1. ..S Y=$O(^XTMP("XPDI",XPDA,"BLD",0)),X=0 I Y F S X=+$O(^XTMP("XPDI",XPDA,"BLD",Y,"KRN",X)) Q:'X D
  1. ...;if file doesn't exist, kill it and 'B' x-ref
  1. ...I '$D(^DIC(X,0)) K ^XTMP("XPDI",XPDA,"BLD",Y,"KRN",X),^("B",X)
  1. ...Q
  1. ..S ^XTMP("XPDT",DA)=XPDPMT M ^XTMP("XPDT",DA)=^XTMP("XPDI",XPDA)
  1. ..Q
  1. .I 'DA W !,XPDNM," ** Couldn't add to Build file **" S XPDQUIT=1 Q
  1. .;kill Install file entry
  1. .S DA=XPDA D ^DIK
  1. .K ^XTMP("XPDI",XPDA)
  1. ;set expiration date to 1 year if global should be permanent, else 30
  1. S ^XTMP("XPDT",0)=$$FMADD^XLFDT(DT,$S(XPDPMT:365,1:30))_U_DT
  1. D QUIT^XPDI1(XPDI)
  1. W !," ** DONE **",!
  1. Q