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/XPDI1.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1XPDI1 ;SFISC/RSD - Cont of Install Process ; 8/30/04 9:45am
2 ;;8.0;KERNEL;**58,61,95,108,229,275,L33**;Jul 10, 1995
3 ;lookup into file 9.7, XPDS=DIC("S") for lookup
4 ;return 0-fail or ien, XPDT=array of linked builds
5LOOK(XPDS,XPDL) ;lookup Install
6 N DIC,Y,XPD,XPDIT,%
7 S:$D(AAQP) DIC("B")=AAQP ;MPLS XU*L33 used only by XPDZPAT and AAQMENU
8 S DIC(0)="QEAMZ",DIC="^XPD(9.7,"
9 S:$L($G(XPDS)) DIC("S")=XPDS
10 D ^DIC Q:Y<0 0
11 I '$G(XPDL) L +^XPD(9.7,+Y,0):0 E W !,"Being accessed by another user" Q 0
12 S XPD=+Y,XPDIT=0
13 W !!,"This Distribution was loaded on ",$$FMTE^XLFDT($P(Y(0),U,3))," with header of ",!?3,$G(^XPD(9.7,XPD,2)),!?3,"It consisted of the following Install(s):",!
14 ;build XPDT array
15 I '$D(^XPD(9.7,"ASP",XPD)) D XPDT(1,XPD) Q XPD
16 F S XPDIT=$O(^XPD(9.7,"ASP",XPD,XPDIT)) Q:'XPDIT S Y=+$O(^(XPDIT,0)) D XPDT(XPDIT,Y)
17 I '$O(XPDT(0)) S XPDQUIT=1 D QUIT(XPD)
18 Q XPD
19 ;
20QUIT(Y) ;unlock ien Y
21 L -^XPD(9.7,+Y) Q
22 ;
23XPDT(P1,P2) ;Build XPDT array
24 N % S %=$P($G(^XPD(9.7,P2,0)),U)
25 I %="" W:$X ! W "**ERROR in Install, You need to remove the Distribution and reload it**",! S XPDQUIT=1 Q
26 S XPDT(P1)=P2_U_%,(XPDT("DA",P2),XPDT("NM",%))=P1 W:$X>64 ! W $J(%,15)
27 Q
28 ;
29QUES(XPDA) ;install questions; XPDA=ien in file 9.7
30 N XPDANS,XPDFIL,XPDFILN,XPDFILO,XPDFLG,XPDNM,XPDQUES,X,Y
31 S XPDNM=$P(^XPD(9.7,XPDA,0),U) W !!,"Install Questions for ",XPDNM,!
32 ;pre-init questions
33 D DIR^XPDIQ("PRE") I $D(XPDQUIT) D ASKABRT^XPDI Q
34 ;file install questions
35 S (XPDFIL,XPDFLG)=0
36 F S XPDFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPDFIL)) Q:'XPDFIL S X=^(XPDFIL),X(0)=^(XPDFIL,0),X(1)=^(XPDFIL),XPDFILO=^(0,1) D Q:$D(XPDQUIT)
37 .;check for DD screening logic
38 .I $G(^(10))]"" N XPDSCR S XPDSCR=^(10) ;^(10) is ref to ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,10) from prev line
39 .;XPDFILN=file name^global ref^partial DD
40 .;XPDANS=new file^DD screen failed^Data exists^update file name^user
41 .;doesn't want to update data 1=yes,0=no
42 .S XPDFILN=X_X(0)_U_X(1),XPDANS='($D(^DIC(XPDFIL,0))#2)_"^^"_''$O(@(X(0)_"0)"))
43 .I 'XPDFLG W !,"Incoming Files:" S XPDFLG=1
44 .W ! D DIR^XPDIQ("XPF",XPDFIL_"#") Q:$D(XPDQUIT)
45 .S:$G(XPDQUES("XPF"_XPDFIL_"#2"))=0 $P(XPDANS,U,5)=1
46 .S ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,2)=XPDANS
47 .;kill the answers so we can re-ask for next file
48 .F I=1:1:2 K XPDQUES("XPF"_XPDFIL_"#"_I)
49 ;XPDQUIT is by file questions in previous do loop, set in XPDIQ
50 I $D(XPDQUIT) D ASKABRT^XPDI Q
51 ;ask for coordinators to incoming mail groups
52 S (XPDFIL,XPDFLG)=0
53 F S XPDFIL=$O(^XTMP("XPDI",XPDA,"KRN",3.8,XPDFIL)) Q:'XPDFIL S X=^(XPDFIL,0),Y=$G(^(-1)) D Q:$D(XPDQUIT)
54 .;XPDANS=Mail Group name
55 .Q:$P(Y,U)=1 ;Don't ask if deleting
56 .S XPDANS=$P(X,U)
57 .I 'XPDFLG W !!,"Incoming Mail Groups:" S XPDFLG=1
58 .W ! D DIR^XPDIQ("XPM",XPDFIL_"#") Q:$D(XPDQUIT)
59 .;kill the answers so we can re-ask for next MG
60 .K XPDQUES("XPM"_XPDFIL_"#1")
61 .Q
62 I $D(XPDQUIT) D ASKABRT^XPDI Q
63 ;ask to rebuild menus if Option is added
64 S (XPDFIL,XPDFLG)=0
65 S XPDFIL=$O(^XTMP("XPDI",XPDA,"KRN",19,XPDFIL)) D:XPDFIL
66 .S X=^XTMP("XPDI",XPDA,"KRN",19,XPDFIL,0)
67 .;XPDANS=Menu Rebuild Answer
68 .S XPDANS=$P(X,U)
69 .W ! D DIR^XPDIQ("XPO") Q:$D(XPDQUIT)
70 I $D(XPDQUIT) D ASKABRT^XPDI Q
71 ;post-init questions
72 W ! D DIR^XPDIQ("POS") I $D(DIRUT)!$D(XPDQUIT) D ASKABRT^XPDI Q
73 Q
74 ;
75XQSET(XPDA) ;get options & protocols to disable
76 ;put in ^TMP($J,"XQOO",starting build name)
77 N A,I,X,Y
78 S I=0 F S I=$O(^XTMP("XPDI",XPDA,"KRN",19,I)) Q:'I S X=^(I,0),A=^(-1) D
79 .S Y=$O(^DIC(19,"B",$P(X,U),0))
80 .;check that option exist and 0=send,1=delete,3=merge or 5=disable
81 .I Y,$D(^DIC(19,Y,0)),$S('A:1,1:A#2) S ^TMP($J,"XQOO",XPDSET,19,Y)=$P(^(0),U,1,2)
82 S I=0 F S I=$O(^XTMP("XPDI",XPDA,"KRN",101,I)) Q:'I S X=^(I,0),A=^(-1) D
83 .S Y=$O(^ORD(101,"B",$P(X,U),0))
84 .I Y,$D(^ORD(101,Y,0)),$S(A=3:1,A=5:1,1:'A) S ^TMP($J,"XQOO",XPDSET,101,Y)=$P(^(0),U,1,2)
85 Q
86 ;XPDIJ need to install XPDIJ now & set routine flag to skip
87XPDIJ N DIE,XPDA,XCM,XCN,XCS,X
88 S XPDA=XPDIJ,DIE="^XTMP(""XPDI"",XPDIJ,""RTN"",""XPDIJ"",",XCN=0,X="XPDIJ"
89 X ^%ZOSF("SAVE") D RTNLOG^XPDUTL("XPDIJ") ;Save and update ROUTINE file
90 S XCN=$$RTNUP^XPDUTL("XPDIJ",2)
91 Q
Note: See TracBrowser for help on using the repository browser.