- XPDIU ;SFISC/RSD - UNload/Convert/Rollup Distribution Global ;08/14/2008
- ;;8.0;KERNEL;**15,41,44,51,58,101,108,506**;Jul 10, 1995;Build 19
- ;Per VHA Directive 2004-038, this routine should not be modified.
- EN1 ;unload
- N %,DA,DIK,DIR,DIRUT,X,XPD,XPDST,XPDT,XPDQ,XPDQUIT,Y
- ;remove dangling transport globals
- S DA=0 F S DA=$O(^XTMP("XPDI",DA)) Q:'DA I '$D(^XPD(9.7,DA)) K ^XTMP("XPDI",DA)
- ;must be the starting package and still exist in the transport global
- S (DA,XPDST)=$$LOOK^XPDI1("I $D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))") Q:'DA
- S XPDQ=^XPD(9.7,DA,0),DIR(0)="Y",DIR("A")="Want to continue with the Unload of this Distribution",DIR("B")="NO"
- ;check if install has status of start
- 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!!",!!
- S DIR("?")="YES will delete the Transport Global and the entry in the Install file for these Packages."
- 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.",!
- W ! D ^DIR I 'Y!$D(DIRUT) D QUIT^XPDI1(XPDST) Q
- S XPD=0,DIK="^XPD(9.7,"
- ;need to kill the XTMP("XPDI") and the entry in the install file
- F S XPD=$O(XPDT(XPD)) Q:'XPD S DA=+XPDT(XPD) D ^DIK K ^XTMP("XPDI",DA)
- ;check if Out-Of-Order setname is defined, kill it
- I $D(^XTMP("XQOO",$P(XPDQ,U))) K ^($P(XPDQ,U))
- D QUIT^XPDI1(XPDST)
- Q
- EN2 ;convert
- N %,DA,DIK,DIR,DIRUT,X,XPD,XPDBLD,XPDI,XPDNM,XPDPKG,XPDPMT,XPDST,XPDT,XPDQUIT,Y
- S XPDI=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y))") Q:'XPDI
- K XPDT("DA"),XPDT("NM")
- ;make sure transport globals exist
- S XPDT=0 F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D
- .S Y=+XPDT(XPDT) Q:$D(^XTMP("XPDI",Y))
- .W !,$P(XPDT(XPDT),U,2)," ** Transport Global doesn't exist **",$C(7)
- .K XPDT(XPDT) S XPDQUIT=1
- I $D(XPDT)'>9!$D(XPDQUIT) D QUIT^XPDI1(XPDI) Q
- S DIR(0)="Y",DIR("A")="Want to make the Transport Globals Permanent",DIR("B")="NO"
- S DIR("?",1)="YES will leave the Transport Global so you can transport this TG in multiple Distributions."
- S DIR("?")="NO will remove the Transport Global after you transport this TG in the next Distribution."
- D ^DIR I $D(DIRUT) D QUIT^XPDI1(XPDI) Q
- S XPDPMT=Y,DIR("A")="Want to continue with the Conversion of the Package(s)",DIR("B")="NO"
- 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."
- D ^DIR I 'Y!$D(DIRUT) Q
- S XPDT=0,DIK="^XPD(9.7,"
- F S XPDT=$O(XPDT(XPDT)) Q:'XPDT D Q:$D(XPDQUIT)
- .;kill Install file entry
- .S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDPKG=+$O(^XTMP("XPDI",XPDA,"PKG",0))
- .;resolve the Package file link
- .D:XPDPKG
- ..N DIC,X,Y
- ..S DIC="^DIC(9.4,",DIC(0)="X",X=$P(^XTMP("XPDI",XPDA,"PKG",XPDPKG,0),U)
- ..D ^DIC I Y<0 S XPDPKG=0 Q
- ..S XPDPKG=+Y
- ..Q
- .S DA=$$BLD^XPDIP(XPDBLD) D:DA
- ..K ^XTMP("XPDT",DA)
- ..;check that component files exists
- ..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
- ...;if file doesn't exist, kill it and 'B' x-ref
- ...I '$D(^DIC(X,0)) K ^XTMP("XPDI",XPDA,"BLD",Y,"KRN",X),^("B",X)
- ...Q
- ..S ^XTMP("XPDT",DA)=XPDPMT M ^XTMP("XPDT",DA)=^XTMP("XPDI",XPDA)
- ..Q
- .I 'DA W !,XPDNM," ** Couldn't add to Build file **" S XPDQUIT=1 Q
- .;kill Install file entry
- .S DA=XPDA D ^DIK
- .K ^XTMP("XPDI",XPDA)
- ;set expiration date to 1 year if global should be permanent, else 30
- S ^XTMP("XPDT",0)=$$FMADD^XLFDT(DT,$S(XPDPMT:365,1:30))_U_DT
- D QUIT^XPDI1(XPDI)
- W !," ** DONE **",!
- Q
- 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
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- EN1 ;unload
- +1 NEW %,DA,DIK,DIR,DIRUT,X,XPD,XPDST,XPDT,XPDQ,XPDQUIT,Y
- +2 ;remove dangling transport globals
- +3 SET DA=0
- FOR
- SET DA=$ORDER(^XTMP("XPDI",DA))
- IF 'DA
- QUIT
- IF '$DATA(^XPD(9.7,DA))
- KILL ^XTMP("XPDI",DA)
- +4 ;must be the starting package and still exist in the transport global
- +5 SET (DA,XPDST)=$$LOOK^XPDI1("I $D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))")
- IF 'DA
- QUIT
- +6 SET XPDQ=^XPD(9.7,DA,0)
- SET DIR(0)="Y"
- SET DIR("A")="Want to continue with the Unload of this Distribution"
- SET DIR("B")="NO"
- +7 ;check if install has status of start
- +8 IF $PIECE(XPDQ,U,9)=2
- WRITE !!,"***WARNING*** Install ",$PIECE(XPDQ,U)," has already started!",!," Unloading this install might leave your system in an unstable state!!",!!
- +9 SET DIR("?")="YES will delete the Transport Global and the entry in the Install file for these Packages."
- +10 IF $PIECE(XPDQ,U,9)=1
- IF $PIECE(XPDQ,U,6)
- WRITE !,"This Distribution is Queued for Install with task number ",$PIECE(XPDQ,U,6),!,"Don't forget to delete Taskman Task.",!
- +11 WRITE !
- DO ^DIR
- IF 'Y!$DATA(DIRUT)
- DO QUIT^XPDI1(XPDST)
- QUIT
- +12 SET XPD=0
- SET DIK="^XPD(9.7,"
- +13 ;need to kill the XTMP("XPDI") and the entry in the install file
- +14 FOR
- SET XPD=$ORDER(XPDT(XPD))
- IF 'XPD
- QUIT
- SET DA=+XPDT(XPD)
- DO ^DIK
- KILL ^XTMP("XPDI",DA)
- +15 ;check if Out-Of-Order setname is defined, kill it
- +16 IF $DATA(^XTMP("XQOO",$PIECE(XPDQ,U)))
- KILL ^($PIECE(XPDQ,U))
- +17 DO QUIT^XPDI1(XPDST)
- +18 QUIT
- EN2 ;convert
- +1 NEW %,DA,DIK,DIR,DIRUT,X,XPD,XPDBLD,XPDI,XPDNM,XPDPKG,XPDPMT,XPDST,XPDT,XPDQUIT,Y
- +2 SET XPDI=$$LOOK^XPDI1("I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y))")
- IF 'XPDI
- QUIT
- +3 KILL XPDT("DA"),XPDT("NM")
- +4 ;make sure transport globals exist
- +5 SET XPDT=0
- FOR
- SET XPDT=$ORDER(XPDT(XPDT))
- IF 'XPDT
- QUIT
- Begin DoDot:1
- +6 SET Y=+XPDT(XPDT)
- IF $DATA(^XTMP("XPDI",Y))
- QUIT
- +7 WRITE !,$PIECE(XPDT(XPDT),U,2)," ** Transport Global doesn't exist **",$CHAR(7)
- +8 KILL XPDT(XPDT)
- SET XPDQUIT=1
- End DoDot:1
- +9 IF $DATA(XPDT)'>9!$DATA(XPDQUIT)
- DO QUIT^XPDI1(XPDI)
- QUIT
- +10 SET DIR(0)="Y"
- SET DIR("A")="Want to make the Transport Globals Permanent"
- SET DIR("B")="NO"
- +11 SET DIR("?",1)="YES will leave the Transport Global so you can transport this TG in multiple Distributions."
- +12 SET DIR("?")="NO will remove the Transport Global after you transport this TG in the next Distribution."
- +13 DO ^DIR
- IF $DATA(DIRUT)
- DO QUIT^XPDI1(XPDI)
- QUIT
- +14 SET XPDPMT=Y
- SET DIR("A")="Want to continue with the Conversion of the Package(s)"
- SET DIR("B")="NO"
- +15 SET DIR("?",1)="YES will convert the Packages to globals that can be transported."
- SET DIR("?")="An entry will be added to the Build file and the entry in the Install file will be deleted."
- +16 DO ^DIR
- IF 'Y!$DATA(DIRUT)
- QUIT
- +17 SET XPDT=0
- SET DIK="^XPD(9.7,"
- +18 FOR
- SET XPDT=$ORDER(XPDT(XPDT))
- IF 'XPDT
- QUIT
- Begin DoDot:1
- +19 ;kill Install file entry
- +20 SET XPDA=+XPDT(XPDT)
- SET XPDNM=$PIECE(XPDT(XPDT),U,2)
- SET XPDBLD=$ORDER(^XTMP("XPDI",XPDA,"BLD",0))
- SET XPDPKG=+$ORDER(^XTMP("XPDI",XPDA,"PKG",0))
- +21 ;resolve the Package file link
- +22 IF XPDPKG
- Begin DoDot:2
- +23 NEW DIC,X,Y
- +24 SET DIC="^DIC(9.4,"
- SET DIC(0)="X"
- SET X=$PIECE(^XTMP("XPDI",XPDA,"PKG",XPDPKG,0),U)
- +25 DO ^DIC
- IF Y<0
- SET XPDPKG=0
- QUIT
- +26 SET XPDPKG=+Y
- +27 QUIT
- End DoDot:2
- +28 SET DA=$$BLD^XPDIP(XPDBLD)
- IF DA
- Begin DoDot:2
- +29 KILL ^XTMP("XPDT",DA)
- +30 ;check that component files exists
- +31 SET Y=$ORDER(^XTMP("XPDI",XPDA,"BLD",0))
- SET X=0
- IF Y
- FOR
- SET X=+$ORDER(^XTMP("XPDI",XPDA,"BLD",Y,"KRN",X))
- IF 'X
- QUIT
- Begin DoDot:3
- +32 ;if file doesn't exist, kill it and 'B' x-ref
- +33 IF '$DATA(^DIC(X,0))
- KILL ^XTMP("XPDI",XPDA,"BLD",Y,"KRN",X),^("B",X)
- +34 QUIT
- End DoDot:3
- +35 SET ^XTMP("XPDT",DA)=XPDPMT
- MERGE ^XTMP("XPDT",DA)=^XTMP("XPDI",XPDA)
- +36 QUIT
- End DoDot:2
- +37 IF 'DA
- WRITE !,XPDNM," ** Couldn't add to Build file **"
- SET XPDQUIT=1
- QUIT
- +38 ;kill Install file entry
- +39 SET DA=XPDA
- DO ^DIK
- +40 KILL ^XTMP("XPDI",XPDA)
- End DoDot:1
- IF $DATA(XPDQUIT)
- QUIT
- +41 ;set expiration date to 1 year if global should be permanent, else 30
- +42 SET ^XTMP("XPDT",0)=$$FMADD^XLFDT(DT,$SELECT(XPDPMT:365,1:30))_U_DT
- +43 DO QUIT^XPDI1(XPDI)
- +44 WRITE !," ** DONE **",!
- +45 QUIT