| [796] | 1 | TMGXPDIQ ;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
|
|---|
| 9 | DIR(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 | ;
|
|---|
| 56 | QUES(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 | ;
|
|---|
| 65 | ANSWER(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
|
|---|
| 74 | XPF1 ;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
|
|---|
| 89 | XPF2 ;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
|
|---|
| 102 | XPQ(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
|
|---|
| 108 | XPI1 ;Inhibit Logons
|
|---|
| 109 | D XPQ("XPI1")
|
|---|
| 110 | Q
|
|---|
| 111 | XPM1 ;mail groups
|
|---|
| 112 | S FLAG=XPDANS
|
|---|
| 113 | D XPQ("XPM1")
|
|---|
| 114 | Q
|
|---|
| 115 | XPO1 ;rebuild menu trees
|
|---|
| 116 | D XPQ("XPO1")
|
|---|
| 117 | Q
|
|---|
| 118 | XPZ1 ;disable options
|
|---|
| 119 | D XPQ("XPZ1")
|
|---|
| 120 | Q
|
|---|
| 121 | XPZ2 ;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
|
|---|
