source: cprs/branches/tmg-cprs/m_files/TMGXPDI1.m@ 838

Last change on this file since 838 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 5.3 KB
RevLine 
[796]1TMGXPDI1 ;TMG/kst/Custom version of XPDI1 ;09/17/08
2 ;;1.0;TMG-LIB;**1**;09/17/08
3
4 ;"Original header:
5 ;"XPDI1 ;SFISC/RSD - Cont of Install Process ;10/28/2002 17:14
6 ;" ;;8.0;KERNEL;**58,61,95,108,229**;Jul 10, 1995
7
8LOOK(XPDS,XPDL,InstallName,Msg) ;"Lookup Install
9 ;"Purpose: Lookup into file 9.7, XPDS=DIC("S") for lookup
10 ;"Input: XPDS -- screen for ^DIC
11 ;" XPDL -- optional. Something regarding locking record.
12 ;" InstallName -- optional. Name of install to auto-search for
13 ;" Msg -- PASS BY REFERANCE, an OUT PARAMETER
14 ;" Errors are stored in Msg("ERROR",x)=Message
15 ;" Msg("ERROR")=count of last error
16 ;" Message are store in Msg(x)=Message
17 ;" Msg=count of last message+1
18 ;"return 0-fail or ien, XPDT=array of linked builds
19
20 N DIC,X,Y,XPD,XPDIT,%
21 S DIC="^XPD(9.7,",DIC("S")=$get(XPDS)
22 set InstallName=$get(InstallName)
23 if InstallName'="" do
24 . S DIC(0)="QMZ"
25 . set X=InstallName
26 else S DIC(0)="QAMZ"
27 D ^DIC
28 Q:Y<0 0
29
30 I '$G(XPDL) L +^XPD(9.7,+Y,0):0 E W !,"Being accessed by another user" Q 0
31 S XPD=+Y,XPDIT=0
32 W !!,"This Distribution was loaded on ",$$FMTE^XLFDT($P(Y(0),U,3))," with header of ",!?3,$G(^XPD(9.7,XPD,2)),!
33 W ?3,"It consisted of the following Install(s):",!
34 ;"Build XPDT array
35 I '$D(^XPD(9.7,"ASP",XPD)) D XPDT(1,XPD) Q XPD
36 F S XPDIT=$O(^XPD(9.7,"ASP",XPD,XPDIT)) Q:'XPDIT do
37 . S Y=+$O(^(XPDIT,0))
38 . D XPDT(XPDIT,Y)
39 I '$O(XPDT(0)) S XPDQUIT=1 D QUIT(XPD)
40 Q XPD
41 ;
42QUIT(Y) ;unlock ien Y
43 L -^XPD(9.7,+Y) Q
44 ;
45XPDT(P1,P2) ;Build XPDT array
46 N % S %=$P($G(^XPD(9.7,P2,0)),U)
47 I %="" W:$X ! W "**ERROR in Install, You need to remove the Distribution and reload it**",! S XPDQUIT=1 Q
48 S XPDT(P1)=P2_U_%,(XPDT("DA",P2),XPDT("NM",%))=P1 W:$X>64 ! W $J(%,15)
49 Q
50 ;
51QUES(XPDA,Option) ;"install questions; XPDA=ien in file 9.7
52 N XPDANS,XPDFIL,XPDFILN,XPDFILO,XPDFLG,XPDNM,XPDQUES,X,Y
53 S XPDNM=$P(^XPD(9.7,XPDA,0),U) W !!,"Install Questions for ",XPDNM,!
54 ;"pre-init questions
55 D DIR^TMGXPDIQ("PRE",,.Option) I $D(XPDQUIT) D ASKABRT^XPDI Q
56 ;"file install questions
57 S (XPDFIL,XPDFLG)=0
58 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)
59 .;"check for DD screening logic
60 .I $G(^(10))]"" N XPDSCR S XPDSCR=^(10) ;^(10) is ref to ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,10) from prev line
61 .;XPDFILN=file name^global ref^partial DD
62 .;XPDANS=new file^DD screen failed^Data exists^update file name^user
63 .;"doesn't want to update data 1=yes,0=no
64 .S XPDFILN=X_X(0)_U_X(1),XPDANS='($D(^DIC(XPDFIL,0))#2)_"^^"_''$O(@(X(0)_"0)"))
65 .I 'XPDFLG W !,"Incoming Files:" S XPDFLG=1
66 .W ! D DIR^TMGXPDIQ("XPF",XPDFIL_"#",.Option) Q:$D(XPDQUIT)
67 .S:$G(XPDQUES("XPF"_XPDFIL_"#2"))=0 $P(XPDANS,U,5)=1
68 .S ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,2)=XPDANS
69 .;"kill the answers so we can re-ask for next file
70 .F I=1:1:2 K XPDQUES("XPF"_XPDFIL_"#"_I)
71 ;XPDQUIT is by file questions in previous do loop, set in TMGXPDIQ
72 I $D(XPDQUIT) D ASKABRT^XPDI Q
73 ;"ask for coordinators to incoming mail groups
74 S (XPDFIL,XPDFLG)=0
75 F S XPDFIL=$O(^XTMP("XPDI",XPDA,"KRN",3.8,XPDFIL)) Q:'XPDFIL S X=^(XPDFIL,0),Y=$G(^(-1)) D Q:$D(XPDQUIT)
76 .;XPDANS=Mail Group name
77 .Q:$P(Y,U)=1 ;Don't ask if deleting
78 .S XPDANS=$P(X,U)
79 .I 'XPDFLG W !!,"Incoming Mail Groups:" S XPDFLG=1
80 .W ! D DIR^TMGXPDIQ("XPM",XPDFIL_"#",.Option) Q:$D(XPDQUIT)
81 .;kill the answers so we can re-ask for next MG
82 .K XPDQUES("XPM"_XPDFIL_"#1")
83 .Q
84 I $D(XPDQUIT) D ASKABRT^XPDI Q
85 ;"ask to rebuild menus if Option is added
86 S (XPDFIL,XPDFLG)=0
87 S XPDFIL=$O(^XTMP("XPDI",XPDA,"KRN",19,XPDFIL)) D:XPDFIL
88 .S X=^XTMP("XPDI",XPDA,"KRN",19,XPDFIL,0)
89 .;XPDANS=Menu Rebuild Answer
90 .S XPDANS=$P(X,U)
91 .W ! D DIR^TMGXPDIQ("XPO",,.Option) Q:$D(XPDQUIT)
92 I $D(XPDQUIT) D ASKABRT^XPDI Q
93 ;"post-init questions
94 W ! D DIR^TMGXPDIQ("POS",,.Option) I $D(DIRUT)!$D(XPDQUIT) D ASKABRT^XPDI Q
95 Q
96 ;
97XQSET(XPDA) ;get options & protocols to disable
98 ;put in ^TMP($J,"XQOO",starting build name)
99 N A,I,X,Y
100 S I=0 F S I=$O(^XTMP("XPDI",XPDA,"KRN",19,I)) Q:'I S X=^(I,0),A=^(-1) D
101 .S Y=$O(^DIC(19,"B",$P(X,U),0))
102 .;check that option exist and 0=send,1=delete,3=merge or 5=disable
103 .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)
104 S I=0 F S I=$O(^XTMP("XPDI",XPDA,"KRN",101,I)) Q:'I S X=^(I,0),A=^(-1) D
105 .S Y=$O(^ORD(101,"B",$P(X,U),0))
106 .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)
107 Q
108 ;XPDIJ need to install XPDIJ now & set routine flag to skip
109XPDIJ N DIE,XPDA,XCM,XCN,XCS,X
110 S XPDA=XPDIJ,DIE="^XTMP(""XPDI"",XPDIJ,""RTN"",""XPDIJ"",",XCN=0,X="XPDIJ"
111 X ^%ZOSF("SAVE")
112 S XCN=$$RTNUP^XPDUTL("XPDIJ",2)
113 Q
Note: See TracBrowser for help on using the repository browser.