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

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

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