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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1XPDIL ;SFISC/RSD - load Distribution Global ;05/17/2006
2 ;;8.0;KERNEL;**15,44,58,68,108,422**;Jul 10, 1995;Build 2
3 ;This routine has the changes made for patch 345 but was released as 422 to fix a read HFS problem
4 ;
5EN1 N POP,XPDA,XPDST,XPDIT,XPDT,XPDGP,XPDQUIT,XPDREQAB,XPDSKPE
6 S:'$D(DT) DT=$$DT^XLFDT S:'$D(U) U="^"
7 S XPDST=0
8 D ST I $G(XPDQUIT) D ABRTALL^XPDI(1) G NONE
9 ;XPDST= starting Build
10 ;XPDT("DA",ien)=seq # to install
11 ;XPDT("NM",build name)=seq #
12 ;XPDT(seq #)=ien^Build name
13 ;XPDT("GP",global)= 1-replace, 0-overwrite^ien
14 ;XPDGP=globals from a Global Package
15 ;XPDSKPE=1 don't run Environment Check^has question been asked
16 S XPDIT=0,XPDSKPE="0^0"
17 F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT S XPDA=+XPDT(XPDIT) D I '$D(XPDT) Q
18 .;check if this Build has an Envir. Check
19 .I $G(^XTMP("XPDI",XPDA,"PRE"))]"" D I $G(XPDQUIT) D ABRTALL^XPDI(1) Q
20 ..;quit if we already asked this question
21 ..Q:$P(XPDSKPE,U,2)
22 ..S $P(XPDSKPE,U,2)=1
23 ..N DIR,DIRUT
24 ..S DIR(0)="Y",DIR("A")="Want to RUN the Environment Check Routine",DIR("B")="YES"
25 ..S DIR("A",1)="Build "_$P(XPDT(XPDIT),U,2)_" has an Enviromental Check Routine"
26 ..;p345-rename AND* to XPD*
27 ..I '$G(XPDAUTO) D ^DIR I $D(DIRUT) S XPDQUIT=1 Q
28 ..I $G(XPDAUTO) S Y=1
29 ..S:'Y XPDSKPE="1^1"
30 .D PKG^XPDIL1(XPDA)
31 ;Global Package
32 G:$D(XPDGP) ^XPDIGP
33 ;p345-rename AND* to XPD*
34 I $D(XPDT),$D(^XPD(9.7,+XPDST,0)) S:$G(XPDAUTO) XPDANM=$P(^(0),U) W:'$G(XPDAUTO) !,"Use INSTALL NAME: ",$P(^(0),U)," to install this Distribution.",!
35 Q
36ST ;global input
37 N DIR,DIRUT,GR,IOP,X,Y,Z,%ZIS
38 G:'$D(^DD(3.5,0)) OPEN
39 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
40 ;p345-rename AND* to XPD*
41 I '$G(XPDAUTO) D HOME^%ZIS
42 I $G(XPDAUTO) S IO(0)=XPDDEV
43 S DIR(0)="F^3:75",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to input Distribution."
44 ;p345-rename AND* to XPD*
45 I '$G(XPDAUTO) D ^DIR I $D(DIRUT) S XPDQUIT=1 Q
46 I $G(XPDAUTO) S (X,Y)=XPDFTPF
47 S %ZIS="",%ZIS("HFSNAME")=Y,%ZIS("HFSMODE")="R",IOP="HFS"
48 D ^%ZIS I POP W !,"Couldn't open file or HFS device!!",*7 S XPDQUIT=1 Q
49 ;don't close device if we have a global package, we need to bring in the globals now
50 D GI,^%ZISC:'$D(XPDGP)!$G(XPDQUIT)
51 Q
52 ;
53 ;if no device file, Virgin Install
54OPEN ;use open command
55 N IO,IOPAR,DIR,DIRUT
56 S DIR(0)="F^1:79",DIR("A")="Device Name"
57 S DIR("?",1)="Device Name is either the name of the HFS file or the name of the HFS Device.",DIR("?",2)="i.e. for MSM enter 51",DIR("?")=" for DSM enter DISK$USER::[ANONYMOUS]:KRN8.KID"
58 D ^DIR I $D(DIRUT) S POP=1 Q
59 S IO=Y,DIR(0)="FO^1:79",DIR("A")="Device Parameters"
60 S DIR("?",1)="Device Parameter is the Open parameter this M operating system needs to",DIR("?",2)="open the Device Name.",DIR("?",3)="i.e. for MSM enter (""B:\KRN8.KID"":""R"")",DIR("?")=" for DSM enter READONLY"
61 D ^DIR I $D(DTOUT)!$D(DUOUT) S POP=1 Q
62 S IOPAR=Y
63 X "O IO:"_IOPAR_":10" E U $P W !,"Couldn't open ",IO S POP=1 Q
64 S IO(0)=$P
65 D GI D ^%ZISC
66 Q
67 ;
68GI N X,XPDSEQ,Y,Z
69 U IO R X:10,Y:10 ;rwf was :0
70 U IO(0) W !!,X,!,"Comment: ",Y
71 S XPDST("H")=Y,XPDST("H1")=Y_" ;Created on "_$P(X,"KIDS Distribution saved on ",2)
72 ;Z is the string of Builds in this file
73 U IO F X=1:1 R Z:1 S Z=$P(Z,"**KIDS**",2,99) Q:Z="" S X(X)=Z
74 U IO(0) I $G(X(1))="" W !!,"This is not a Distribution HFS File!" S XPDQUIT=1 Q
75 ;global package, set XPDGP=flag;global^flag;global^... flag=1 replace
76 I $P(X(1),":")="GLOBALS" S XPDGP=$P(X(1),U,2,99),X(1)=$P(X(1),U)
77 S XPDIT=0,X(1)=$P(X(1),":",2,99)
78 W !!,"This Distribution contains Transport Globals for the following Package(s):"
79 F X=1:1:X-1 F Z=1:1 S Y=$P(X(X),U,Z) Q:Y="" D Q:$G(XPDQUIT)
80 . ;can't install if global exist, that means Build never finish install
81 . ;INST will show name
82 . S XPDIT=XPDIT+1 I '$$INST^XPDIL1(Y) S XPDQUIT=1 Q
83 Q:$G(XPDQUIT)
84 W !,"Distribution OK!",!
85 D:$D(XPDGP) DISP^XPDIGP
86 S DIR(0)="Y",DIR("A")="Want to Continue with Load",DIR("B")="YES"
87 ;p345-rename AND* to XPD*
88 I '$G(XPDAUTO) D ^DIR I $D(DIRUT)!'Y S XPDQUIT=1 Q
89 I $G(XPDAUTO) S Y=1
90 W !,"Loading Distribution...",!
91 ;reset expiration date to T+7 on transport global
92 S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
93 ;start reading the HFS again
94 U IO R X:10,Y:10 ;rwf was :0
95 ;the next read must be the INSTALL NAME
96 I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) U IO(0) W !!,"ERROR in HFS file format!" S XPDQUIT=1 Q
97 ;XPDSEQ is the disk sequence number
98 S %=XPDT("NM",Y),GR="^XTMP(""XPDI"","_+XPDT(%)_",",XPDSEQ=1
99 ;X=global ref, Y=global value. DIRUT is when user is prompted for next disk in NEXTD and they abort
100 ;rwf next line was :0
101 F R X:10,Y:10 Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
102 .I X="**INSTALL NAME**" D Q
103 ..S %=+$G(XPDT("NM",Y)) I '% S DIRUT=1 Q
104 ..S GR="^XTMP(""XPDI"","_+XPDT(%)_","
105 .;I X="**CONTINUE**" D NEXTD Q
106 .S @(GR_X)=Y
107 U IO(0)
108 Q
109 ;
110NEXTD I ^%ZOSF("OS")'["MSM" U IO(0) W !!,"Error in disk, ABORTING load!!" S XPDQUIT=1 Q
111 N DIR
112 ;close current device
113 C IO U IO(0)
114 S XPDSEQ=XPDSEQ+1,DIR(0)="E",DIR("A")="Insert the next diskette, #"_XPDSEQ_", and Press the return key",DIR("?")="This distribution is continued on another diskette"
115 D ^DIR Q:$D(DIRUT)
116 W " OK",!
117 ;MSM specific code to open HFS
118 O @(""""_IO_""":"_IOPAR) U IO
119 R X:10,Y:10 ;rwf was :0
120 ;quit if comments are not the same on each diskette
121 G:Y'=XPDST("H") NEXTQ
122 ;quit if not the expected sequence, Z is for the blank line
123 R Y:10,Z:10 G:Y'=("**SEQ**:"_XPDSEQ) NEXTQ ;rwf was :0
124 Q
125NEXTQ U IO(0) W !!,"This is NOT the correct diskette!! The comment on this diskette is:",!,X,!!
126 S XPDSEQ=XPDSEQ-1
127 G NEXTD
128 ;
129NONE W !!,"**NOTHING LOADED**",!
130 Q
Note: See TracBrowser for help on using the repository browser.