source: cprs/branches/tmg-cprs/m_files/TMGXPDIQ.m@ 1044

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

Initial upload

File size: 6.2 KB
Line 
1TMGXPDIQ ;TMG/kst/Custom version of XPDIQ ;10/7/08
2 ;;1.0;TMG-LIB;**1**;10/7/08
3
4 ;"Original header....
5 ;"XPDIQ ;SFISC/RSD - Install Questions ;12/16/98 12:06
6 ;" ;;8.0;KERNEL;**21,28,58,61,95,108**;Jul 10, 1995
7
8 Q
9DIR(XPFR,XPFP,Option)
10 ;"Input: XPFR -- prefix
11 ;" XPFP -- file no._# or Mail Group ien
12 ;" Option -- an array for supply answers to user questions, so not asked.
13 ;" Option(QuestionText)=1 for YES, 0 for NO
14 ;" Option(QuestionText,"DEFAULT")=default user answer
15 ;"NOTE: XPFP is for XPF or XPM questions
16 N DIR,DR,XPDI,XPDJ,X,Y,Z
17 S XPFP=$G(XPFP),XPDI=$S(XPFP:XPFR_XPFP,1:XPFR)
18 D QUES(XPDI)
19 ;"ask questions
20 S X=XPFR
21 F S X=$O(^XTMP("XPDI",XPDA,"QUES",X)),Z="" Q:X=""!($P(X,XPFR)]"") D I $D(DIRUT) S XPDQUIT=1 Q
22 . S XPDJ=$S('XPFP:X,1:XPDI_$P(X,XPFR,2))
23 . F S Z=$O(^XTMP("XPDI",XPDA,"QUES",X,Z)) Q:Z="" M DIR(Z)=^(Z)
24 . ;"if there was a previous answer, reset DIR("B") to external or internal answer
25 . S:$L($G(XPDQUES(XPDJ))) DIR("B")=$G(XPDQUES(XPDJ,"B"),XPDQUES(XPDJ))
26 . D Q:'$D(Y)
27 . . N FLAG,X,Z K Y
28 . . ;"this is the M CODE node that was set to DIR("M") in prev for loop
29 . . ;"FLAG is used by KIDS questions
30 . . I $D(DIR("M")) S %=DIR("M"),FLAG="" K DIR("M") X %
31 . . Q:'$D(DIR)
32 . . ;"'|' is used to mark variable in prompt, reset prompt with value of variable
33 . . S:$G(DIR("A"))["|" DIR("A")=$P(DIR("A"),"|")_@$P(DIR("A"),"|",2)_$P(DIR("A"),"|",3)
34 . . if $data(Option(DIR("A"),"DEFAULT")) set DIR("B")=$get(Option(DIR("A"),"DEFAULT")) ;"//KT
35 . . K:$G(DIR("B"))="" DIR("B")
36 . . kill Y set Y=$get(Option(DIR("A")))
37 . . if Y="" D ^DIR
38 . S %=$P(DIR(0),U)
39 . ;"read was optional and didn't timeout and user didn't enter anything
40 . I %["O",'$D(DTOUT),$S(%["P":Y=-1,1:Y="") K DIRUT Q
41 . ;"quit if the user up-arrowed out
42 . Q:$D(DIRUT)
43 . ;"if pointer, reset Y & Y(0)
44 . I %["P" S Y(0)=$S(%["Z":$P(Y(0),U),1:$P(Y,U,2)),Y=+Y
45 . ;"if Y(0) is not defined, but Y is
46 . S:$D(Y)#2&'($D(Y(0))#2) Y(0)=Y
47 . S XPDQUES(XPDJ)=Y,XPDQUES(XPDJ,"A")=$G(DIR("A")),XPDQUES(XPDJ,"B")=$G(Y(0))
48 . K DIR
49 K XPDJ S XPDI=XPFR
50 ;"code to save XPDQUES to INSTALL ANSWERS in file 9.7, loop thru the answers starting with the from value, XPFR
51 F Y=1:1 S XPDI=$O(XPDQUES(XPDI)) Q:XPDI=""!($P(XPDI,XPFR)]"") D
52 .S X="XPDJ(9.701,""?+"_Y_","_XPDA_","")",@X@(.01)=XPDI,@X@(1)=$G(XPDQUES(XPDI,"A")),@X@(2)=$G(XPDQUES(XPDI,"B")),@X@(3)=XPDQUES(XPDI)
53 K XPDI D:$D(XPDJ)>9 UPDATE^DIE("","XPDJ","XPDI")
54 Q
55 ;
56QUES(X) ;build XPDQUES array, X="INI","INIT","XPF","XPM"
57 ;move INSTALL ANSWERS from file 9.7 to XPDQUES
58 ;XPDQUES(X)=internal answer, XPDQUES(X,"A")=prompt, XPDQUES(X,"B")=external answer.
59 N Y,Z K XPDQUES S Z=X
60 F S Z=$O(^XPD(9.7,XPDA,"QUES","B",Z)) Q:Z=""!($P(Z,X)]"") S Y=$O(^(Z,0)) D
61 .Q:'$D(^XPD(9.7,XPDA,"QUES",Y,0))
62 .S XPDQUES(Z)=$G(^(1)),XPDQUES(Z,"A")=$G(^("A")),XPDQUES(Z,"B")=$G(^("B")) ; ^(1) refer to prev line ^XPD(9.7,XPDA,"QUES","B",Z)
63 Q
64 ;
65ANSWER(QUES) ;E.F. Return answer to question
66 N IEN I '$D(XPDA)!($G(QUES)="") Q ""
67 S IEN=$O(^XPD(9.7,XPDA,"QUES","B",QUES,0)) I IEN'>0 Q ""
68 Q $G(^XPD(9.7,XPDA,"QUES",IEN,1))
69 ;codes for install process questions
70 ;XPDFIL=file #, XPDFILN=file name^global ref^partial DD
71 ;XPDFILO=update DD^security codes^^^resolve pt^list template^data with file^add,merge,overwrite,replace^user override data update
72 ;XPDSCR=screen to determine DD update
73 ;XPDANS is define in QUES^XPDI
74XPF1 ;write over existing file
75 N XPDI
76 W !!?3,XPDFIL,?13,$P(XPDFILN,U),$P(" (Partial Definition)",U,$P(XPDFILN,U,3)),$P(" (including data)",U,$P(XPDFILO,U,7)="y")
77 ;file doesn't exists
78 I XPDANS K DIR Q
79 I $L($G(XPDSCR)) S XPDI=1 D Q:'XPDI
80 .X XPDSCR S XPDI=$T Q:XPDI
81 .W !,"Data Dictionary FAILED the screening logic, file will NOT be installed!"
82 .S $P(XPDANS,U,2)="1" K DIR
83 S FLAG=$P($G(^DIC(XPDFIL,0)),U)
84 ;file exist and has the same name
85 I $P(FLAG,$P(XPDFILN,U))="" W !,"Note: You already have the '",$P(XPDFILN,U),"' File." K DIR Q
86 W *7,!,"*BUT YOU ALREADY HAVE '",FLAG,"' AS FILE #",XPDFIL,"!"
87 S $P(XPDANS,U,4)=1
88 Q
89XPF2 ;data
90 ;if they don't want to overwrite a file with a different name then set the DIRUT flag and ABORT, this will stop the rest of the questions and abort the install
91 I $G(XPDQUES("XPF"_XPFP_1))=0 S DIRUT=1 K DIR Q
92 ;if Data doesn't exists or DD failed screen or data wasn't sent, don't ask question
93 I '$P(XPDANS,U,3)!$P(XPDANS,U,2)!($P(XPDFILO,U,7)'="y") K DIR Q
94 S %=$F("amor",$P(XPDFILO,U,8))-1
95 ;if this is add and file is not new
96 I %=1 W !,"Data will NOT be added." K DIR Q
97 ;check if dev. doesn't want to ask user
98 I $P(XPDFILO,U,9)'="y" W !,"I will ",$P("^MERGE^OVERWRITE^REPLACE",U,%)," your data with mine." K DIR Q
99 S FLAG=$P("^merged with^to overwrite^to replace",U,%)
100 Q
101 ;XPDDIQ(name)=internal value, (name,"A")=prompt, (name,"B")=external
102XPQ(NM) ;Build XPDDIQ
103 Q:'$D(XPDDIQ(NM))
104 I $D(XPDDIQ(NM))#2 S XPDQUES(NM)=XPDDIQ(NM) K DIR Q
105 S:$D(XPDDIQ(NM,"A")) DIR("A")=XPDDIQ(NM,"A")
106 S:$D(XPDDIQ(NM,"B")) DIR("B")=XPDDIQ(NM,"B")
107 Q
108XPI1 ;Inhibit Logons
109 D XPQ("XPI1")
110 Q
111XPM1 ;mail groups
112 S FLAG=XPDANS
113 D XPQ("XPM1")
114 Q
115XPO1 ;rebuild menu trees
116 D XPQ("XPO1")
117 Q
118XPZ1 ;disable options
119 D XPQ("XPZ1")
120 Q
121XPZ2 ;move routines
122 N Y
123 ;if they are not in production UCI don't ask
124 X ^%ZOSF("UCI") I Y'=^%ZOSF("PROD") K DIR Q
125 ;if they are not running MSM don't ask
126 I ^%ZOSF("OS")'["MSM" K DIR Q
127 Q:'$D(XPDDIQ("XPZ2"))
128 I $D(XPDDIQ("XPZ2"))#2 S XPDQUES("XPZ2")=XPDDIQ("XPZ2") K DIR Q
129 S:$D(XPDDIQ("XPZ2","A")) DIR("A")=XPDDIQ("XPZ2","A")
130 S:$D(XPDDIQ("XPZ2","B")) DIR("B")=XPDDIQ("XPZ2","B")
131 Q
Note: See TracBrowser for help on using the repository browser.