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/XPDIQ.m@ 1141

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

initial load of WorldVistAEHR

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