XPDI ;SFISC/RSD - Install Process ; Mar 21, 2023@09:46:08
;;8.0;KERNEL;**10,21,39,41,44,58,68,108,145,184,229,768,785**;Jul 10, 1995;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
EN ;install
N DIR,DIRUT,POP,XPD,XPDA,XPDD,XPDIJ,XPDDIQ,XPDIT,XPDIABT,XPDNM,XPDNOQUE,XPDPKG,XPDREQAB,XPDST,XPDSET,XPDSET1,XPDT,XPDQUIT,XPDQUES,Y,ZTSK,%
S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",XPDST=$$LOOK^XPDI1(%)
Q:'XPDST!$D(XPDQUIT)
S XPDIT=0,(XPDSET,XPDSET1)=$P(^XPD(9.7,XPDST,0),U) K ^TMP($J)
;Check each part of XPDT array
F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D Q:'$D(XPDT)!$D(XPDQUIT)
.S XPDA=+XPDT(XPDIT),XPDNM=$P(XPDT(XPDIT),U,2),XPDPKG=+$P($G(^XPD(9.7,+XPDT(XPDIT),0)),U,2),%=$P(^(0),U,5)
.W !,"Checking Install for Package ",XPDNM
.;check that Install file was created correctly
.I '$D(^XPD(9.7,XPDA,"INI"))!'$D(^("INIT")) W !,"**INSTALL FILE IS CORRUPTED**",!,*7 S XPDQUIT=1 Q
.;run enviroment check routine
.;XPDREQAB req. build missing, =2 global killed
.I $$ENV^XPDIL1(1) S:$G(XPDREQAB)=2 XPDQUIT=1 Q
.;save variables that are setup in environ. chck. routine
.I $D(XPDNOQUE)!$D(XPDDIQ) D
..S:$D(XPDNOQUE) ^XTMP("XPDI",XPDA,"ENVVAR","XPDNOQUE")=XPDNOQUE
..I $D(XPDDIQ) M ^XTMP("XPDI",XPDA,"ENVVAR","XPDDIQ")=XPDDIQ
.D QUES^XPDI1(XPDA) Q:'$D(XPDT(+XPDIT))!$D(XPDQUIT)
.;XPDIJ=XPDA if XPDIJ routine is part of Build
.S:$D(^XTMP("XPDI",XPDA,"RTN","XPDIJ")) XPDIJ=XPDA
.D XQSET^XPDI1(XPDA)
;NONE = no Build to install
G NONE:'$O(XPDT(""))!$D(XPDQUIT)!($G(XPDREQAB))
;check that we have all Builds to install
S XPDA=XPDST,XPDNM=XPDSET,Y=0
F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S %=+$O(^(Y,0)) I '$D(XPDT("DA",%)) G NONE
W !
;See if a Master Build
S %=$O(^XTMP("XPDI",XPDA,"BLD",0)),%=$P(^(%,0),U,3) S:%=1 XPDT("MASTER")=XPDA
;Inhibit Logon Question
D DIR^XPDIQ("XPI") I $D(DIRUT) D ABRTALL(2) Q
;disable options question
D DIR^XPDIQ("XPZ") I $D(DIRUT) D ABRTALL(2) Q
;XPDSET=set name,(also build name), of options that will be disabled
;XPDSET1=setname or null if they don't want to disable
D I XPDSET1="^" D ABRTALL(2) Q
.;if they say no, set XPDET1=""
.S:'$G(XPDQUES("XPZ1")) XPDSET1="",Y=0
.S ^XTMP("XQOO",XPDSET,0)=XPDSET_" is being installed by KIDS^"_DT_U_DUZ
.I XPDSET1]"" D Q:XPDSET1="^"!(XPDSET1="")
..;merge the options/protocols that were put in ^TMP($J,"XQOO",build name)
..M ^XTMP("XQOO",XPDSET)=^TMP($J,"XQOO",XPDSET)
..D INIT^XQOO(.XPDSET1) Q:"^"[XPDSET1
..N DIR S DIR(0)="N^0:60:0",DIR("B")=0
..S DIR("A")="Delay Install (Minutes)",DIR("?")="Enter the number of minutes to delay the installing of Routines after the Disable of Options"
..;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
..W ! D:'$G(XPDAUTO) ^DIR S:$G(XPDAUTO) Y=0 I $D(DIRUT) S XPDSET1="^"
.;Y is set in the call to DIR in previous .DO
.;save setname into first Build and the Delay in minutes, Y
.K XPD S XPD(9.7,XPDST_",",7)=(XPDSET1]"")_XPDSET,XPD(9.7,XPDST_",",8)=Y
.D FILE^DIE("","XPD")
;check if they want to update other CPUs
I $G(XPDQUES("XPZ2")) D I $D(DIRUT) D ABRTALL(2) Q
.N DA,DIE,DIR,DR,I,XPD,X,Y,Z
.;if they haven't already added Volume Sets, populate the mulitple
.I '$O(^XPD(9.7,XPDA,"VOL",0)) D I $D(XPD) D UPDATE^DIE("","XPD")
..X ^%ZOSF("UCI") S Y=$P(Y,",",2),(I,Z)=0
..F S I=$O(^%ZIS(14.5,I)) Q:'I S X=$G(^(I,0)) S:$P(X,U)]""&$P(X,U,11)&($P(X,U)'=Y) Z=Z+1,XPD(9.703,"+"_Z_","_XPDA_",",.01)=$P(X,U)
.W !!,"I will Update the following VOLUME SETS:",!
.S I=0 F S I=$O(^XPD(9.7,XPDA,"VOL",I)) Q:'I W ?3,$P(^(I,0),U),!
.W ! S DIR(0)="Y",DIR("A")="Want to edit this list",DIR("B")="NO"
.D ^DIR Q:$D(DIRUT) D:Y
..S DA=XPDA,DIE="^XPD(9.7,",DR=30,DR(2,9.703)=".01"
..D ^DIE
.I '$O(^XPD(9.7,XPDA,"VOL",0)) W !!,"No VOLUME SETS selected!!" Q
.Q:$$TM^%ZTLOAD ;quit if Taskman is running
.W !!,"TASKMAN is not running. If you install now, you must run the routine XPDCPU",!,"in the production UCI for each of the VOLUME SETS you have listed once"
.W !,"the installation starts!!",!,"If you Queue the install, the VOLUME SETS will be updated automatically.",*7,*7,!!
DEV S POP=0 S:'$D(^DD(3.5,0)) POP=1
;check if home device is defined
I 'POP S IOP="",%ZIS=0 D ^%ZIS
;Kernel Virgin Install
I POP S XPDA=XPDST D:$G(XPDIJ) XPDIJ^XPDI1 G EN^XPDIJ
;set XPDA=starting Build, ask for device for messages
;XPDNOQUE is defined means don't let them queue output
W !!,"Enter the Device you want to print the Install messages."
W:'$D(XPDNOQUE) !,"You can queue the install by enter a 'Q' at the device prompt."
W !,"Enter a '^' to abort the install.",!
S XPDA=XPDST,%ZIS=$P("Q",U,'$D(XPDNOQUE))
;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
I '$G(XPDAUTO) D ^%ZIS G:POP ASKABRT
;can't queue to a video Subtype device, ask device again
I $G(IO("Q")),$E(IOST,1,2)="C-" W !!,"You can't queue to a Video Terminal device!",! G DEV ;p768
I $G(XPDAUTO) U XPDDEV
;reset expiration date to T+15 on transport global
S XPDD=$$FMADD^XLFDT(DT,15),^XTMP("XPDI",0)=XPDD_U_DT ;p785
I $D(IO("Q")) D G ASKABRT:$D(ZTSK)[0 D XPDIJ^XPDI1:$G(XPDIJ),QUIT^XPDI1(XPDST) Q
. N DIR,NOW S NOW=$$HTFM^XLFDT($$HADD^XLFDT($H,,,2)) ;Must be in future
. S DIR(0)="DA^"_NOW_":"_XPDD_":AEFRSX"
. S DIR("A")="Request Start Time: "
. S DIR("B")=$$FMTE^XLFDT(NOW)
. S DIR("?",1)="Enter a Date including Time"
. S DIR("?",2)="The time must be in the future and not to exceed 15 days in the future."
. S DIR("?")="Current date/time: "_DIR("B")
. D ^DIR
.Q:$D(DIRUT)
.S ZTDTH=Y,ZTRTN="EN^XPDIJ",ZTDESC=XPDNM_" KIDS install",ZTSAVE("XPDA")=""
.D ^%ZTLOAD,HOME^%ZIS K IO("Q")
.Q:$D(ZTSK)[0
.W !,"Install Queued!",!!
.;save task into first Build
.K XPD S XPD(9.7,XPDST_",",5)=ZTSK,XPDIT=0
.F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT S XPD(9.7,+XPDT(XPDIT)_",",.02)=1 D FILE^DIE("","XPD") K XPD
;run install
;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
I '$G(XPDAUTO) U IO D XPDIJ^XPDI1:$G(XPDIJ),QUIT^XPDI1(XPDST) G EN^XPDIJ
I $G(XPDAUTO) U XPDDEV D XPDIJ^XPDI1:$G(XPDIJ),QUIT^XPDI1(XPDST) G EN^XPDIJ
Q
;
;XPDA=ien to del, XPDK=1 kill global, XPDALL=1 deleting all
;XPDST=starting package.
ABORT(XPDA,XPDK,XPDALL) ;abort install of Build XPDA
N %,DA,DIK,XPDJ,XPDNM,Y
Q:'$D(^XPD(9.7,XPDA,0)) S XPDNM=$P(^(0),U)
D BMES^XPDUTL(XPDNM_" Build will not be installed"_$S(XPDK=1:", Transport Global deleted!",1:"")),MES^XPDUTL(" "_$$HTE^XLFDT($H))
S DIK="^XPD(9.7,",XPDJ=XPDT("NM",XPDNM),DA=XPDA
;kill XPDT array, but don't kill global if XPDK=2
K XPDT("NM",XPDNM),XPDT("DA",XPDA),XPDT(XPDJ),XPDT("GP") Q:XPDK=2
K ^XTMP("XPDI",XPDA)
;if we are not deleting all packages and we are deleting the starting package
;set the next package to the starting package. It must always be 1.
I '$G(XPDALL),XPDA=XPDST S Y=$O(XPDT(0)) D:Y
.;unlock starting install
.L -^XPD(9.7,XPDST)
.S XPDST=+XPDT(Y),XPDT(1)=XPDT(Y),XPDT("DA",XPDST)=1,XPDT("NM",$P(XPDT(Y),U,2))=1,XPDIT=0
.K XPDT(Y) N XPD
.S %="XPD(9.7,"""_XPDST_","")",@%@(3)=XPDST,@%@(4)=1
.;loop thru the rest of the packages and reset the starting package field
.F S Y=$O(XPDT(Y)) Q:'Y D
..S XPD(9.7,+XPDT(Y)_",",3)=XPDST
.D FILE^DIE("","XPD")
D ^DIK
Q
ASKABRT ;ask if want to unload distribution
N DIR,DIRUT,X,Y
S XPDQUIT=1,DIR(0)="Y",DIR("A")="Install ABORTED, Want to remove the Transport Globals",DIR("B")="YES"
W ! D ^DIR I Y D ABRTALL(1) Q
L -^XPD(9.7,XPDST)
Q
ABRTALL(XPDK) ;abort all Builds
N XPDA
S XPDT=0
F S XPDT=$O(XPDT(XPDT)) Q:'XPDT S XPDA=+XPDT(XPDT) D ABORT(XPDA,XPDK,1)
;unlock starting install
L -^XPD(9.7,XPDST)
Q
NONE W !!,"**NOTHING INSTALLED**",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDI 7773 printed Sep 02, 2024@18:48:51 Page 2
XPDI ;SFISC/RSD - Install Process ; Mar 21, 2023@09:46:08
+1 ;;8.0;KERNEL;**10,21,39,41,44,58,68,108,145,184,229,768,785**;Jul 10, 1995;Build 5
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
EN ;install
+1 NEW DIR,DIRUT,POP,XPD,XPDA,XPDD,XPDIJ,XPDDIQ,XPDIT,XPDIABT,XPDNM,XPDNOQUE,XPDPKG,XPDREQAB,XPDST,XPDSET,XPDSET1,XPDT,XPDQUIT,XPDQUES,Y,ZTSK,%
+2 SET %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"
SET XPDST=$$LOOK^XPDI1(%)
+3 if 'XPDST!$DATA(XPDQUIT)
QUIT
+4 SET XPDIT=0
SET (XPDSET,XPDSET1)=$PIECE(^XPD(9.7,XPDST,0),U)
KILL ^TMP($JOB)
+5 ;Check each part of XPDT array
+6 FOR
SET XPDIT=$ORDER(XPDT(XPDIT))
if 'XPDIT
QUIT
Begin DoDot:1
+7 SET XPDA=+XPDT(XPDIT)
SET XPDNM=$PIECE(XPDT(XPDIT),U,2)
SET XPDPKG=+$PIECE($GET(^XPD(9.7,+XPDT(XPDIT),0)),U,2)
SET %=$PIECE(^(0),U,5)
+8 WRITE !,"Checking Install for Package ",XPDNM
+9 ;check that Install file was created correctly
+10 IF '$DATA(^XPD(9.7,XPDA,"INI"))!'$DATA(^("INIT"))
WRITE !,"**INSTALL FILE IS CORRUPTED**",!,*7
SET XPDQUIT=1
QUIT
+11 ;run enviroment check routine
+12 ;XPDREQAB req. build missing, =2 global killed
+13 IF $$ENV^XPDIL1(1)
if $GET(XPDREQAB)=2
SET XPDQUIT=1
QUIT
+14 ;save variables that are setup in environ. chck. routine
+15 IF $DATA(XPDNOQUE)!$DATA(XPDDIQ)
Begin DoDot:2
+16 if $DATA(XPDNOQUE)
SET ^XTMP("XPDI",XPDA,"ENVVAR","XPDNOQUE")=XPDNOQUE
+17 IF $DATA(XPDDIQ)
MERGE ^XTMP("XPDI",XPDA,"ENVVAR","XPDDIQ")=XPDDIQ
End DoDot:2
+18 DO QUES^XPDI1(XPDA)
if '$DATA(XPDT(+XPDIT))!$DATA(XPDQUIT)
QUIT
+19 ;XPDIJ=XPDA if XPDIJ routine is part of Build
+20 if $DATA(^XTMP("XPDI",XPDA,"RTN","XPDIJ"))
SET XPDIJ=XPDA
+21 DO XQSET^XPDI1(XPDA)
End DoDot:1
if '$DATA(XPDT)!$DATA(XPDQUIT)
QUIT
+22 ;NONE = no Build to install
+23 if '$ORDER(XPDT(""))!$DATA(XPDQUIT)!($GET(XPDREQAB))
GOTO NONE
+24 ;check that we have all Builds to install
+25 SET XPDA=XPDST
SET XPDNM=XPDSET
SET Y=0
+26 FOR
SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))
if 'Y
QUIT
SET %=+$ORDER(^(Y,0))
IF '$DATA(XPDT("DA",%))
GOTO NONE
+27 WRITE !
+28 ;See if a Master Build
+29 SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",0))
SET %=$PIECE(^(%,0),U,3)
if %=1
SET XPDT("MASTER")=XPDA
+30 ;Inhibit Logon Question
+31 DO DIR^XPDIQ("XPI")
IF $DATA(DIRUT)
DO ABRTALL(2)
QUIT
+32 ;disable options question
+33 DO DIR^XPDIQ("XPZ")
IF $DATA(DIRUT)
DO ABRTALL(2)
QUIT
+34 ;XPDSET=set name,(also build name), of options that will be disabled
+35 ;XPDSET1=setname or null if they don't want to disable
+36 Begin DoDot:1
+37 ;if they say no, set XPDET1=""
+38 if '$GET(XPDQUES("XPZ1"))
SET XPDSET1=""
SET Y=0
+39 SET ^XTMP("XQOO",XPDSET,0)=XPDSET_" is being installed by KIDS^"_DT_U_DUZ
+40 IF XPDSET1]""
Begin DoDot:2
+41 ;merge the options/protocols that were put in ^TMP($J,"XQOO",build name)
+42 MERGE ^XTMP("XQOO",XPDSET)=^TMP($JOB,"XQOO",XPDSET)
+43 DO INIT^XQOO(.XPDSET1)
if "^"[XPDSET1
QUIT
+44 NEW DIR
SET DIR(0)="N^0:60:0"
SET DIR("B")=0
+45 SET DIR("A")="Delay Install (Minutes)"
SET DIR("?")="Enter the number of minutes to delay the installing of Routines after the Disable of Options"
+46 ;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
+47 WRITE !
if '$GET(XPDAUTO)
DO ^DIR
if $GET(XPDAUTO)
SET Y=0
IF $DATA(DIRUT)
SET XPDSET1="^"
End DoDot:2
if XPDSET1="^"!(XPDSET1="")
QUIT
+48 ;Y is set in the call to DIR in previous .DO
+49 ;save setname into first Build and the Delay in minutes, Y
+50 KILL XPD
SET XPD(9.7,XPDST_",",7)=(XPDSET1]"")_XPDSET
SET XPD(9.7,XPDST_",",8)=Y
+51 DO FILE^DIE("","XPD")
End DoDot:1
IF XPDSET1="^"
DO ABRTALL(2)
QUIT
+52 ;check if they want to update other CPUs
+53 IF $GET(XPDQUES("XPZ2"))
Begin DoDot:1
+54 NEW DA,DIE,DIR,DR,I,XPD,X,Y,Z
+55 ;if they haven't already added Volume Sets, populate the mulitple
+56 IF '$ORDER(^XPD(9.7,XPDA,"VOL",0))
Begin DoDot:2
+57 XECUTE ^%ZOSF("UCI")
SET Y=$PIECE(Y,",",2)
SET (I,Z)=0
+58 FOR
SET I=$ORDER(^%ZIS(14.5,I))
if 'I
QUIT
SET X=$GET(^(I,0))
if $PIECE(X,U)]""&$PIECE(X,U,11)&($PIECE(X,U)'=Y)
SET Z=Z+1
SET XPD(9.703,"+"_Z_","_XPDA_",",.01)=$PIECE(X,U)
End DoDot:2
IF $DATA(XPD)
DO UPDATE^DIE("","XPD")
+59 WRITE !!,"I will Update the following VOLUME SETS:",!
+60 SET I=0
FOR
SET I=$ORDER(^XPD(9.7,XPDA,"VOL",I))
if 'I
QUIT
WRITE ?3,$PIECE(^(I,0),U),!
+61 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Want to edit this list"
SET DIR("B")="NO"
+62 DO ^DIR
if $DATA(DIRUT)
QUIT
if Y
Begin DoDot:2
+63 SET DA=XPDA
SET DIE="^XPD(9.7,"
SET DR=30
SET DR(2,9.703)=".01"
+64 DO ^DIE
End DoDot:2
+65 IF '$ORDER(^XPD(9.7,XPDA,"VOL",0))
WRITE !!,"No VOLUME SETS selected!!"
QUIT
+66 ;quit if Taskman is running
if $$TM^%ZTLOAD
QUIT
+67 WRITE !!,"TASKMAN is not running. If you install now, you must run the routine XPDCPU",!,"in the production UCI for each of the VOLUME SETS you have listed once"
+68 WRITE !,"the installation starts!!",!,"If you Queue the install, the VOLUME SETS will be updated automatically.",*7,*7,!!
End DoDot:1
IF $DATA(DIRUT)
DO ABRTALL(2)
QUIT
DEV SET POP=0
if '$DATA(^DD(3.5,0))
SET POP=1
+1 ;check if home device is defined
+2 IF 'POP
SET IOP=""
SET %ZIS=0
DO ^%ZIS
+3 ;Kernel Virgin Install
+4 IF POP
SET XPDA=XPDST
if $GET(XPDIJ)
DO XPDIJ^XPDI1
GOTO EN^XPDIJ
+5 ;set XPDA=starting Build, ask for device for messages
+6 ;XPDNOQUE is defined means don't let them queue output
+7 WRITE !!,"Enter the Device you want to print the Install messages."
+8 if '$DATA(XPDNOQUE)
WRITE !,"You can queue the install by enter a 'Q' at the device prompt."
+9 WRITE !,"Enter a '^' to abort the install.",!
+10 SET XPDA=XPDST
SET %ZIS=$PIECE("Q",U,'$DATA(XPDNOQUE))
+11 ;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
+12 IF '$GET(XPDAUTO)
DO ^%ZIS
if POP
GOTO ASKABRT
+13 ;can't queue to a video Subtype device, ask device again
+14 ;p768
IF $GET(IO("Q"))
IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"You can't queue to a Video Terminal device!",!
GOTO DEV
+15 IF $GET(XPDAUTO)
USE XPDDEV
+16 ;reset expiration date to T+15 on transport global
+17 ;p785
SET XPDD=$$FMADD^XLFDT(DT,15)
SET ^XTMP("XPDI",0)=XPDD_U_DT
+18 IF $DATA(IO("Q"))
Begin DoDot:1
+19 ;Must be in future
NEW DIR,NOW
SET NOW=$$HTFM^XLFDT($$HADD^XLFDT($HOROLOG,,,2))
+20 SET DIR(0)="DA^"_NOW_":"_XPDD_":AEFRSX"
+21 SET DIR("A")="Request Start Time: "
+22 SET DIR("B")=$$FMTE^XLFDT(NOW)
+23 SET DIR("?",1)="Enter a Date including Time"
+24 SET DIR("?",2)="The time must be in the future and not to exceed 15 days in the future."
+25 SET DIR("?")="Current date/time: "_DIR("B")
+26 DO ^DIR
+27 if $DATA(DIRUT)
QUIT
+28 SET ZTDTH=Y
SET ZTRTN="EN^XPDIJ"
SET ZTDESC=XPDNM_" KIDS install"
SET ZTSAVE("XPDA")=""
+29 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
+30 if $DATA(ZTSK)[0
QUIT
+31 WRITE !,"Install Queued!",!!
+32 ;save task into first Build
+33 KILL XPD
SET XPD(9.7,XPDST_",",5)=ZTSK
SET XPDIT=0
+34 FOR
SET XPDIT=$ORDER(XPDT(XPDIT))
if 'XPDIT
QUIT
SET XPD(9.7,+XPDT(XPDIT)_",",.02)=1
DO FILE^DIE("","XPD")
KILL XPD
End DoDot:1
if $DATA(ZTSK)[0
GOTO ASKABRT
if $GET(XPDIJ)
DO XPDIJ^XPDI1
DO QUIT^XPDI1(XPDST)
QUIT
+35 ;run install
+36 ;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
+37 IF '$GET(XPDAUTO)
USE IO
if $GET(XPDIJ)
DO XPDIJ^XPDI1
DO QUIT^XPDI1(XPDST)
GOTO EN^XPDIJ
+38 IF $GET(XPDAUTO)
USE XPDDEV
if $GET(XPDIJ)
DO XPDIJ^XPDI1
DO QUIT^XPDI1(XPDST)
GOTO EN^XPDIJ
+39 QUIT
+40 ;
+41 ;XPDA=ien to del, XPDK=1 kill global, XPDALL=1 deleting all
+42 ;XPDST=starting package.
ABORT(XPDA,XPDK,XPDALL) ;abort install of Build XPDA
+1 NEW %,DA,DIK,XPDJ,XPDNM,Y
+2 if '$DATA(^XPD(9.7,XPDA,0))
QUIT
SET XPDNM=$PIECE(^(0),U)
+3 DO BMES^XPDUTL(XPDNM_" Build will not be installed"_$SELECT(XPDK=1:", Transport Global deleted!",1:""))
DO MES^XPDUTL(" "_$$HTE^XLFDT($HOROLOG))
+4 SET DIK="^XPD(9.7,"
SET XPDJ=XPDT("NM",XPDNM)
SET DA=XPDA
+5 ;kill XPDT array, but don't kill global if XPDK=2
+6 KILL XPDT("NM",XPDNM),XPDT("DA",XPDA),XPDT(XPDJ),XPDT("GP")
if XPDK=2
QUIT
+7 KILL ^XTMP("XPDI",XPDA)
+8 ;if we are not deleting all packages and we are deleting the starting package
+9 ;set the next package to the starting package. It must always be 1.
+10 IF '$GET(XPDALL)
IF XPDA=XPDST
SET Y=$ORDER(XPDT(0))
if Y
Begin DoDot:1
+11 ;unlock starting install
+12 LOCK -^XPD(9.7,XPDST)
+13 SET XPDST=+XPDT(Y)
SET XPDT(1)=XPDT(Y)
SET XPDT("DA",XPDST)=1
SET XPDT("NM",$PIECE(XPDT(Y),U,2))=1
SET XPDIT=0
+14 KILL XPDT(Y)
NEW XPD
+15 SET %="XPD(9.7,"""_XPDST_","")"
SET @%@(3)=XPDST
SET @%@(4)=1
+16 ;loop thru the rest of the packages and reset the starting package field
+17 FOR
SET Y=$ORDER(XPDT(Y))
if 'Y
QUIT
Begin DoDot:2
+18 SET XPD(9.7,+XPDT(Y)_",",3)=XPDST
End DoDot:2
+19 DO FILE^DIE("","XPD")
End DoDot:1
+20 DO ^DIK
+21 QUIT
ASKABRT ;ask if want to unload distribution
+1 NEW DIR,DIRUT,X,Y
+2 SET XPDQUIT=1
SET DIR(0)="Y"
SET DIR("A")="Install ABORTED, Want to remove the Transport Globals"
SET DIR("B")="YES"
+3 WRITE !
DO ^DIR
IF Y
DO ABRTALL(1)
QUIT
+4 LOCK -^XPD(9.7,XPDST)
+5 QUIT
ABRTALL(XPDK) ;abort all Builds
+1 NEW XPDA
+2 SET XPDT=0
+3 FOR
SET XPDT=$ORDER(XPDT(XPDT))
if 'XPDT
QUIT
SET XPDA=+XPDT(XPDT)
DO ABORT(XPDA,XPDK,1)
+4 ;unlock starting install
+5 LOCK -^XPD(9.7,XPDST)
+6 QUIT
NONE WRITE !!,"**NOTHING INSTALLED**",!
+1 QUIT
