XPDIL ;SFISC/RSD - load Distribution Global ; Oct 25, 2022@09:00:45
;;8.0;KERNEL;**15,44,58,68,108,422,525,672,778**;Jul 10, 1995;Build 4
;Per VHA Directive 2004-038, this routine should not be modified.
;
EN1 N POP,XPDA,XPDST,XPDIT,XPDT,XPDGP,XPDQUIT,XPDREQAB,XPDSKPE
S:'$D(DT) DT=$$DT^XLFDT S:'$D(U) U="^"
S XPDST=0
D ST I $G(XPDQUIT) D ABRTALL^XPDI(1) G NONE
;XPDST= starting Build
;XPDT("DA",ien)=seq # to install
;XPDT("NM",build name)=seq #
;XPDT(seq #)=ien^Build name
;XPDT("GP",global)= 1-replace, 0-overwrite^ien
;XPDGP=globals from a Global Package
;XPDSKPE=1 don't run Environment Check^has question been asked
S XPDIT=0,XPDSKPE="0^0"
F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT S XPDA=+XPDT(XPDIT) D I '$D(XPDT) Q
.;check if this Build has an Envir. Check
.I $G(^XTMP("XPDI",XPDA,"PRE"))]"" D I $G(XPDQUIT) D ABRTALL^XPDI(1) Q
..;quit if we already asked this question
..Q:$P(XPDSKPE,U,2)
..S $P(XPDSKPE,U,2)=1
..N DIR,DIRUT
..S DIR(0)="Y",DIR("A")="Want to RUN the Environment Check Routine",DIR("B")="YES"
..S DIR("A",1)="Build "_$P(XPDT(XPDIT),U,2)_" has an Environmental Check Routine"
..D ^DIR I $D(DIRUT) S XPDQUIT=1 Q
..S:'Y XPDSKPE="1^1"
.D PKG^XPDIL1(XPDA)
;Global Package
G:$D(XPDGP) ^XPDIGP
I $D(XPDT),$D(^XPD(9.7,+XPDST,0)) W !,"Use INSTALL NAME: ",$P(^(0),U)," to install this Distribution.",!
Q
ST ;global input
N DIR,DIRUT,GR,IOP,X,Y,Z,%ZIS
G:'$D(^DD(3.5,0)) OPEN
I '$D(^%ZIS(1,"B","HFS")) W !!,"You must have a device called 'HFS' in order to load a distribution!",*7 S XPDQUIT=1 Q
D HOME^%ZIS
S DIR(0)="F^3:245",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to input Distribution, 3 to 245 characters."
D ^DIR I $D(DIRUT) S XPDQUIT=1 Q
S %ZIS="",%ZIS("HFSNAME")=Y,%ZIS("HFSMODE")="R",IOP="HFS"
D ^%ZIS I POP W !,"Couldn't open file or HFS device!!",*7 S XPDQUIT=1 Q
;don't close device if we have a global package, we need to bring in the globals now
D GI,^%ZISC:'$D(XPDGP)!$G(XPDQUIT)
Q
;
;if no device file, Virgin Install
OPEN ;use open command
N IO,IOPAR,DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="F^3:245",DIR("A")="Device Name" ;p778
S DIR("?")="Device Name is either the name of the HFS file or the name of the HFS Device, 3 TO 245 characters."
D ^DIR I $D(DIRUT) S POP=1 Q
S IO=Y,DIR(0)="FO^1:79",DIR("A")="Device Parameters"
S DIR("?",1)="Device Parameter is the Open parameter this M operating system needs to",DIR("?",2)="open the Device Name, 1 to 79 characters."
D ^DIR I $D(DTOUT)!$D(DUOUT) S POP=1 Q
S IOPAR=Y
X "O IO:"_IOPAR_":10" E U $P W !,"Couldn't open ",IO S POP=1 Q
S IO(0)=$P
D GI D ^%ZISC
Q
;
GI N X,XPDSEQ,Y,Z
U IO R X:10,Y:10 ;rwf was :0
U IO(0) W !!,X,!,"Comment: ",Y
S XPDST("H")=Y,XPDST("H1")=Y_" ;Created on "_$P(X,"KIDS Distribution saved on ",2)
;Z is the string of Builds in this file
U IO F X=1:1 R Z:1 S Z=$P(Z,"**KIDS**",2,99) Q:Z="" S X(X)=Z
U IO(0) I $G(X(1))="" W !!,"This is not a Distribution HFS File!" S XPDQUIT=1 Q
;global package, set XPDGP=flag;global^flag;global^... flag=1 replace
I $P(X(1),":")="GLOBALS" S XPDGP=$P(X(1),U,2,99),X(1)=$P(X(1),U)
S XPDIT=0,X(1)=$P(X(1),":",2,99)
W !!,"This Distribution contains Transport Globals for the following Package(s):"
F X=1:1:X-1 F Z=1:1 S Y=$P(X(X),U,Z) Q:Y="" D Q:$G(XPDQUIT)
. ;can't install if global exist, that means Build never finish install
. ;INST will show name
. S XPDIT=XPDIT+1 I '$$INST^XPDIL1(Y) S XPDQUIT=1 Q
Q:$G(XPDQUIT)
W !,"Distribution OK!",!
D:$D(XPDGP) DISP^XPDIGP
S DIR(0)="Y",DIR("A")="Want to Continue with Load",DIR("B")="YES"
D ^DIR I $D(DIRUT)!'Y S XPDQUIT=1 Q
W !,"Loading Distribution...",!
;reset expiration date to T+7 on transport global
S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
;start reading the HFS again
U IO R X:10,Y:10 ;rwf was :0
;the next read must be the INSTALL NAME
I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) U IO(0) W !!,"ERROR in HFS file format!" S XPDQUIT=1 Q
;XPDSEQ is the disk sequence number
S %=XPDT("NM",Y),GR="^XTMP(""XPDI"","_+XPDT(%)_",",XPDSEQ=1
;X=global ref, Y=global value. DIRUT is when user aborts
;rwf next line was :0
F R X:10,Y:10 Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
.I X="**INSTALL NAME**" D Q
..S %=+$G(XPDT("NM",Y)) I '% S DIRUT=1 Q
..S GR="^XTMP(""XPDI"","_+XPDT(%)_","
.S @(GR_X)=Y
U IO(0)
Q
;
NONE W !!,"**NOTHING LOADED**",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDIL 4440 printed Apr 09, 2024@21:12:25 Page 2
XPDIL ;SFISC/RSD - load Distribution Global ; Oct 25, 2022@09:00:45
+1 ;;8.0;KERNEL;**15,44,58,68,108,422,525,672,778**;Jul 10, 1995;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN1 NEW POP,XPDA,XPDST,XPDIT,XPDT,XPDGP,XPDQUIT,XPDREQAB,XPDSKPE
+1 if '$DATA(DT)
SET DT=$$DT^XLFDT
if '$DATA(U)
SET U="^"
+2 SET XPDST=0
+3 DO ST
IF $GET(XPDQUIT)
DO ABRTALL^XPDI(1)
GOTO NONE
+4 ;XPDST= starting Build
+5 ;XPDT("DA",ien)=seq # to install
+6 ;XPDT("NM",build name)=seq #
+7 ;XPDT(seq #)=ien^Build name
+8 ;XPDT("GP",global)= 1-replace, 0-overwrite^ien
+9 ;XPDGP=globals from a Global Package
+10 ;XPDSKPE=1 don't run Environment Check^has question been asked
+11 SET XPDIT=0
SET XPDSKPE="0^0"
+12 FOR
SET XPDIT=$ORDER(XPDT(XPDIT))
if 'XPDIT
QUIT
SET XPDA=+XPDT(XPDIT)
Begin DoDot:1
+13 ;check if this Build has an Envir. Check
+14 IF $GET(^XTMP("XPDI",XPDA,"PRE"))]""
Begin DoDot:2
+15 ;quit if we already asked this question
+16 if $PIECE(XPDSKPE,U,2)
QUIT
+17 SET $PIECE(XPDSKPE,U,2)=1
+18 NEW DIR,DIRUT
+19 SET DIR(0)="Y"
SET DIR("A")="Want to RUN the Environment Check Routine"
SET DIR("B")="YES"
+20 SET DIR("A",1)="Build "_$PIECE(XPDT(XPDIT),U,2)_" has an Environmental Check Routine"
+21 DO ^DIR
IF $DATA(DIRUT)
SET XPDQUIT=1
QUIT
+22 if 'Y
SET XPDSKPE="1^1"
End DoDot:2
IF $GET(XPDQUIT)
DO ABRTALL^XPDI(1)
QUIT
+23 DO PKG^XPDIL1(XPDA)
End DoDot:1
IF '$DATA(XPDT)
QUIT
+24 ;Global Package
+25 if $DATA(XPDGP)
GOTO ^XPDIGP
+26 IF $DATA(XPDT)
IF $DATA(^XPD(9.7,+XPDST,0))
WRITE !,"Use INSTALL NAME: ",$PIECE(^(0),U)," to install this Distribution.",!
+27 QUIT
ST ;global input
+1 NEW DIR,DIRUT,GR,IOP,X,Y,Z,%ZIS
+2 if '$DATA(^DD(3.5,0))
GOTO OPEN
+3 IF '$DATA(^%ZIS(1,"B","HFS"))
WRITE !!,"You must have a device called 'HFS' in order to load a distribution!",*7
SET XPDQUIT=1
QUIT
+4 DO HOME^%ZIS
+5 SET DIR(0)="F^3:245"
SET DIR("A")="Enter a Host File"
SET DIR("?")="Enter a filename and/or path to input Distribution, 3 to 245 characters."
+6 DO ^DIR
IF $DATA(DIRUT)
SET XPDQUIT=1
QUIT
+7 SET %ZIS=""
SET %ZIS("HFSNAME")=Y
SET %ZIS("HFSMODE")="R"
SET IOP="HFS"
+8 DO ^%ZIS
IF POP
WRITE !,"Couldn't open file or HFS device!!",*7
SET XPDQUIT=1
QUIT
+9 ;don't close device if we have a global package, we need to bring in the globals now
+10 DO GI
if '$DATA(XPDGP)!$GET(XPDQUIT)
DO ^%ZISC
+11 QUIT
+12 ;
+13 ;if no device file, Virgin Install
OPEN ;use open command
+1 NEW IO,IOPAR,DIR,DIRUT,DTOUT,DUOUT
+2 ;p778
SET DIR(0)="F^3:245"
SET DIR("A")="Device Name"
+3 SET DIR("?")="Device Name is either the name of the HFS file or the name of the HFS Device, 3 TO 245 characters."
+4 DO ^DIR
IF $DATA(DIRUT)
SET POP=1
QUIT
+5 SET IO=Y
SET DIR(0)="FO^1:79"
SET DIR("A")="Device Parameters"
+6 SET DIR("?",1)="Device Parameter is the Open parameter this M operating system needs to"
SET DIR("?",2)="open the Device Name, 1 to 79 characters."
+7 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET POP=1
QUIT
+8 SET IOPAR=Y
+9 XECUTE "O IO:"_IOPAR_":10"
IF '$TEST
USE $PRINCIPAL
WRITE !,"Couldn't open ",IO
SET POP=1
QUIT
+10 SET IO(0)=$PRINCIPAL
+11 DO GI
DO ^%ZISC
+12 QUIT
+13 ;
GI NEW X,XPDSEQ,Y,Z
+1 ;rwf was :0
USE IO
READ X:10,Y:10
+2 USE IO(0)
WRITE !!,X,!,"Comment: ",Y
+3 SET XPDST("H")=Y
SET XPDST("H1")=Y_" ;Created on "_$PIECE(X,"KIDS Distribution saved on ",2)
+4 ;Z is the string of Builds in this file
+5 USE IO
FOR X=1:1
READ Z:1
SET Z=$PIECE(Z,"**KIDS**",2,99)
if Z=""
QUIT
SET X(X)=Z
+6 USE IO(0)
IF $GET(X(1))=""
WRITE !!,"This is not a Distribution HFS File!"
SET XPDQUIT=1
QUIT
+7 ;global package, set XPDGP=flag;global^flag;global^... flag=1 replace
+8 IF $PIECE(X(1),":")="GLOBALS"
SET XPDGP=$PIECE(X(1),U,2,99)
SET X(1)=$PIECE(X(1),U)
+9 SET XPDIT=0
SET X(1)=$PIECE(X(1),":",2,99)
+10 WRITE !!,"This Distribution contains Transport Globals for the following Package(s):"
+11 FOR X=1:1:X-1
FOR Z=1:1
SET Y=$PIECE(X(X),U,Z)
if Y=""
QUIT
Begin DoDot:1
+12 ;can't install if global exist, that means Build never finish install
+13 ;INST will show name
+14 SET XPDIT=XPDIT+1
IF '$$INST^XPDIL1(Y)
SET XPDQUIT=1
QUIT
End DoDot:1
if $GET(XPDQUIT)
QUIT
+15 if $GET(XPDQUIT)
QUIT
+16 WRITE !,"Distribution OK!",!
+17 if $DATA(XPDGP)
DO DISP^XPDIGP
+18 SET DIR(0)="Y"
SET DIR("A")="Want to Continue with Load"
SET DIR("B")="YES"
+19 DO ^DIR
IF $DATA(DIRUT)!'Y
SET XPDQUIT=1
QUIT
+20 WRITE !,"Loading Distribution...",!
+21 ;reset expiration date to T+7 on transport global
+22 SET ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
+23 ;start reading the HFS again
+24 ;rwf was :0
USE IO
READ X:10,Y:10
+25 ;the next read must be the INSTALL NAME
+26 IF X'="**INSTALL NAME**"!'$DATA(XPDT("NM",Y))
USE IO(0)
WRITE !!,"ERROR in HFS file format!"
SET XPDQUIT=1
QUIT
+27 ;XPDSEQ is the disk sequence number
+28 SET %=XPDT("NM",Y)
SET GR="^XTMP(""XPDI"","_+XPDT(%)_","
SET XPDSEQ=1
+29 ;X=global ref, Y=global value. DIRUT is when user aborts
+30 ;rwf next line was :0
+31 FOR
READ X:10,Y:10
if X="**END**"
QUIT
Begin DoDot:1
+32 IF X="**INSTALL NAME**"
Begin DoDot:2
+33 SET %=+$GET(XPDT("NM",Y))
IF '%
SET DIRUT=1
QUIT
+34 SET GR="^XTMP(""XPDI"","_+XPDT(%)_","
End DoDot:2
QUIT
+35 SET @(GR_X)=Y
End DoDot:1
IF $DATA(DIRUT)
SET XPDQUIT=1
QUIT
+36 USE IO(0)
+37 QUIT
+38 ;
NONE WRITE !!,"**NOTHING LOADED**",!
+1 QUIT
