source: WorldVistAEHR/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@ 1270

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1XPDIL ;SFISC/RSD - load Distribution Global ;10/10/06 17:00
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:$D(AAQFILE) DIR("B")=AAQFILE ;L33 used only by XPDZPAT
44 S:$D(AAQFILE) DIR("B")=AAQFILE ;L33 used only by XPDZPAT - line added for VOE
45 S DIR(0)="F^3:75",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to input Distribution."
46 ;p345-rename AND* to XPD*
47 I '$G(XPDAUTO) D ^DIR I $D(DIRUT) S XPDQUIT=1 Q
48 I $G(XPDAUTO) S (X,Y)=XPDFTPF
49 S %ZIS="",%ZIS("HFSNAME")=Y,%ZIS("HFSMODE")="R",IOP="HFS"
50 D ^%ZIS I POP W !,"Couldn't open file or HFS device!!",*7 S XPDQUIT=1 Q
51 ;don't close device if we have a global package, we need to bring in the globals now
52 D GI,^%ZISC:'$D(XPDGP)!$G(XPDQUIT)
53 Q
54 ;
55 ;if no device file, Virgin Install
56OPEN ;use open command
57 N IO,IOPAR,DIR,DIRUT
58 S DIR(0)="F^1:79",DIR("A")="Device Name"
59 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"
60 D ^DIR I $D(DIRUT) S POP=1 Q
61 S IO=Y,DIR(0)="FO^1:79",DIR("A")="Device Parameters"
62 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"
63 D ^DIR I $D(DTOUT)!$D(DUOUT) S POP=1 Q
64 S IOPAR=Y
65 X "O IO:"_IOPAR_":10" E U $P W !,"Couldn't open ",IO S POP=1 Q
66 S IO(0)=$P
67 D GI D ^%ZISC
68 Q
69 ;
70GI N X,XPDSEQ,Y,Z
71 U IO R X:10,Y:10 ;rwf was :0
72 U IO(0) W !!,X,!,"Comment: ",Y
73 S XPDST("H")=Y,XPDST("H1")=Y_" ;Created on "_$P(X,"KIDS Distribution saved on ",2)
74 ;Z is the string of Builds in this file
75 U IO F X=1:1 R Z:1 S Z=$P(Z,"**KIDS**",2,99) Q:Z="" S X(X)=Z
76 U IO(0) I $G(X(1))="" W !!,"This is not a Distribution HFS File!" S XPDQUIT=1 Q
77 ;global package, set XPDGP=flag;global^flag;global^... flag=1 replace
78 I $P(X(1),":")="GLOBALS" S XPDGP=$P(X(1),U,2,99),X(1)=$P(X(1),U)
79 S XPDIT=0,X(1)=$P(X(1),":",2,99)
80 W !!,"This Distribution contains Transport Globals for the following Package(s):"
81 F X=1:1:X-1 F Z=1:1 S Y=$P(X(X),U,Z) Q:Y="" D Q:$G(XPDQUIT)
82 . ;can't install if global exist, that means Build never finish install
83 . ;INST will show name
84 . S XPDIT=XPDIT+1 I '$$INST^XPDIL1(Y) S XPDQUIT=1 Q
85 Q:$G(XPDQUIT)
86 W !,"Distribution OK!",!
87 D:$D(XPDGP) DISP^XPDIGP
88 S DIR(0)="Y",DIR("A")="Want to Continue with Load",DIR("B")="YES"
89 ;p345-rename AND* to XPD*
90 I '$G(XPDAUTO) D ^DIR I $D(DIRUT)!'Y S XPDQUIT=1 Q
91 I $G(XPDAUTO) S Y=1
92 W !,"Loading Distribution...",!
93 ;reset expiration date to T+7 on transport global
94 S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
95 ;start reading the HFS again
96 U IO R X:10,Y:10 ;rwf was :0
97 ;the next read must be the INSTALL NAME
98 I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) U IO(0) W !!,"ERROR in HFS file format!" S XPDQUIT=1 Q
99 ;XPDSEQ is the disk sequence number
100 S %=XPDT("NM",Y),GR="^XTMP(""XPDI"","_+XPDT(%)_",",XPDSEQ=1
101 ;X=global ref, Y=global value. DIRUT is when user is prompted for next disk in NEXTD and they abort
102 ;rwf next line was :0
103 F R X:10,Y:10 Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
104 .I X="**INSTALL NAME**" D Q
105 ..S %=+$G(XPDT("NM",Y)) I '% S DIRUT=1 Q
106 ..S GR="^XTMP(""XPDI"","_+XPDT(%)_","
107 .;I X="**CONTINUE**" D NEXTD Q
108 .S @(GR_X)=Y
109 U IO(0)
110 Q
111 ;
112NEXTD I ^%ZOSF("OS")'["MSM" U IO(0) W !!,"Error in disk, ABORTING load!!" S XPDQUIT=1 Q
113 N DIR
114 ;close current device
115 C IO U IO(0)
116 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"
117 D ^DIR Q:$D(DIRUT)
118 W " OK",!
119 ;MSM specific code to open HFS
120 O @(""""_IO_""":"_IOPAR) U IO
121 R X:10,Y:10 ;rwf was :0
122 ;quit if comments are not the same on each diskette
123 G:Y'=XPDST("H") NEXTQ
124 ;quit if not the expected sequence, Z is for the blank line
125 R Y:10,Z:10 G:Y'=("**SEQ**:"_XPDSEQ) NEXTQ ;rwf was :0
126 Q
127NEXTQ U IO(0) W !!,"This is NOT the correct diskette!! The comment on this diskette is:",!,X,!!
128 S XPDSEQ=XPDSEQ-1
129 G NEXTD
130 ;
131NONE W !!,"**NOTHING LOADED**",!
132 Q
Note: See TracBrowser for help on using the repository browser.