Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDIQ

XPDIQ.m

Go to the documentation of this file.
  1. XPDIQ ;SFISC/RSD - Install Questions ;03/21/2008
  1. ;;8.0;KERNEL;**21,28,58,61,95,108,399**;Jul 10, 1995;Build 12
  1. Q
  1. DIR(XPFR,XPFP) ;XPFR=prefix, XPFP=file no._# or Mail Group ien
  1. ;XPFP is for XPF or XPM questions
  1. N DIR,DR,XPDI,XPDJ,X,Y,Z
  1. S XPFP=$G(XPFP),XPDI=$S(XPFP:XPFR_XPFP,1:XPFR)
  1. D QUES(XPDI)
  1. ;ask questions
  1. S X=XPFR
  1. F S X=$O(^XTMP("XPDI",XPDA,"QUES",X)),Z="" Q:X=""!($P(X,XPFR)]"") D I $D(DIRUT) S XPDQUIT=1 Q
  1. .S XPDJ=$S('XPFP:X,1:XPDI_$P(X,XPFR,2))
  1. .F S Z=$O(^XTMP("XPDI",XPDA,"QUES",X,Z)) Q:Z="" M DIR(Z)=^(Z)
  1. .;if there was a previous answer, reset DIR("B") to external or internal answer
  1. .S:$L($G(XPDQUES(XPDJ))) DIR("B")=$G(XPDQUES(XPDJ,"B"),XPDQUES(XPDJ)) D Q:'$D(Y)
  1. ..N FLAG,X,Z K Y
  1. ..;this is the M CODE node that was set to DIR("M") in prev for loop
  1. ..;FLAG is used by KIDS questions
  1. ..I $D(DIR("M")) S %=DIR("M"),FLAG="" K DIR("M") X %
  1. ..Q:'$D(DIR)
  1. ..;'|' is used to mark variable in prompt, reset prompt with value of variable
  1. ..S:$G(DIR("A"))["|" DIR("A")=$P(DIR("A"),"|")_@$P(DIR("A"),"|",2)_$P(DIR("A"),"|",3)
  1. ..K:$G(DIR("B"))="" DIR("B")
  1. ..D ^DIR
  1. .S %=$P(DIR(0),U)
  1. .;read was optional and didn't timeout and user didn't enter anything
  1. .I %["O",'$D(DTOUT),$S(%["P":Y=-1,1:Y="") K DIRUT Q
  1. .;quit if the user up-arrowed out
  1. .Q:$D(DIRUT)
  1. .;if pointer, reset Y & Y(0)
  1. .I %["P" S Y(0)=$S(%["Z":$P(Y(0),U),1:$P(Y,U,2)),Y=+Y
  1. .;if Y(0) is not defined, but Y is
  1. .S:$D(Y)#2&'($D(Y(0))#2) Y(0)=Y
  1. .S XPDQUES(XPDJ)=Y,XPDQUES(XPDJ,"A")=$G(DIR("A")),XPDQUES(XPDJ,"B")=$G(Y(0))
  1. .K DIR
  1. K XPDJ S XPDI=XPFR
  1. ;code to save XPDQUES to INSTALL ANSWERS in file 9.7, loop thru the answers starting with the from value, XPFR
  1. F Y=1:1 S XPDI=$O(XPDQUES(XPDI)) Q:XPDI=""!($P(XPDI,XPFR)]"") D
  1. .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)
  1. K XPDI D:$D(XPDJ)>9 UPDATE^DIE("","XPDJ","XPDI")
  1. Q
  1. ;
  1. QUES(X) ;build XPDQUES array, X="INI","INIT","XPF","XPM"
  1. ;move INSTALL ANSWERS from file 9.7 to XPDQUES
  1. ;XPDQUES(X)=internal answer, XPDQUES(X,"A")=prompt, XPDQUES(X,"B")=external answer.
  1. N Y,Z K XPDQUES S Z=X
  1. F S Z=$O(^XPD(9.7,XPDA,"QUES","B",Z)) Q:Z=""!($P(Z,X)]"") S Y=$O(^(Z,0)) D
  1. .Q:'$D(^XPD(9.7,XPDA,"QUES",Y,0))
  1. .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)
  1. Q
  1. ;
  1. ANSWER(QUES) ;E.F. Return answer to question
  1. N IEN I '$D(XPDA)!($G(QUES)="") Q ""
  1. S IEN=$O(^XPD(9.7,XPDA,"QUES","B",QUES,0)) I IEN'>0 Q ""
  1. Q $G(^XPD(9.7,XPDA,"QUES",IEN,1))
  1. ;codes for install process questions
  1. ;XPDFIL=file #, XPDFILN=file name^global ref^partial DD
  1. ;XPDFILO=update DD^security codes^^^resolve pt^list template^data with file^add,merge,overwrite,replace^user override data update
  1. ;XPDSCR=screen to determine DD update
  1. ;XPDANS is define in QUES^XPDI
  1. XPF1 ;write over existing file
  1. N XPDI
  1. W !!?3,XPDFIL,?13,$P(XPDFILN,U),$P(" (Partial Definition)",U,$P(XPDFILN,U,3)),$P(" (including data)",U,$P(XPDFILO,U,7)="y")
  1. ;file doesn't exists
  1. I XPDANS K DIR Q
  1. I $L($G(XPDSCR)) S XPDI=1 D Q:'XPDI
  1. .X XPDSCR S XPDI=$T Q:XPDI
  1. .W !,"Data Dictionary FAILED the screening logic, file will NOT be installed!"
  1. .S $P(XPDANS,U,2)="1" K DIR
  1. S FLAG=$P($G(^DIC(XPDFIL,0)),U)
  1. ;file exist and has the same name
  1. I $P(FLAG,$P(XPDFILN,U))="" W !,"Note: You already have the '",$P(XPDFILN,U),"' File." K DIR Q
  1. W *7,!,"*BUT YOU ALREADY HAVE '",FLAG,"' AS FILE #",XPDFIL,"!"
  1. S $P(XPDANS,U,4)=1
  1. Q
  1. XPF2 ;data
  1. ;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
  1. I $G(XPDQUES("XPF"_XPFP_1))=0 S DIRUT=1 K DIR Q
  1. ;if Data doesn't exists or DD failed screen or data wasn't sent, don't ask question
  1. I '$P(XPDANS,U,3)!$P(XPDANS,U,2)!($P(XPDFILO,U,7)'="y") K DIR Q
  1. S %=$F("amor",$P(XPDFILO,U,8))-1
  1. ;if this is add and file is not new
  1. I %=1 W !,"Data will NOT be added." K DIR Q
  1. ;check if dev. doesn't want to ask user
  1. I $P(XPDFILO,U,9)'="y" W !,"I will ",$P("^MERGE^OVERWRITE^REPLACE",U,%)," your data with mine." K DIR Q
  1. S FLAG=$P("^merged with^to overwrite^to replace",U,%)
  1. Q
  1. ;XPDDIQ(name)=internal value, (name,"A")=prompt, (name,"B")=external
  1. XPQ(NM) ;Build XPDDIQ
  1. Q:'$D(XPDDIQ(NM))
  1. I $D(XPDDIQ(NM))#2 S XPDQUES(NM)=XPDDIQ(NM) K DIR Q
  1. S:$D(XPDDIQ(NM,"A")) DIR("A")=XPDDIQ(NM,"A")
  1. S:$D(XPDDIQ(NM,"B")) DIR("B")=XPDDIQ(NM,"B")
  1. Q
  1. XPI1 ;Inhibit Logons
  1. D XPQ("XPI1")
  1. Q
  1. XPM1 ;mail groups
  1. S FLAG=XPDANS
  1. ;DIR("B") is null if first time here
  1. I DIR("B")="" D
  1. .;check if mail group already exist
  1. .S X=$$FIND1^DIC(3.8,"","XQf",XPDANS,"","","")
  1. .;get the current coordinator
  1. .Q:'X S X=$P($G(^XMB(3.8,X,0)),U,7)
  1. .;set the default to current coordinator
  1. .I X,$D(^VA(200,X,0))#10 S DIR("B")=$P(^(0),U)
  1. D XPQ("XPM1")
  1. Q
  1. XPO1 ;rebuild menu trees
  1. D XPQ("XPO1")
  1. Q
  1. XPZ1 ;disable options
  1. D XPQ("XPZ1")
  1. Q
  1. XPZ2 ;move routines
  1. N Y
  1. ;if they are not in production UCI don't ask
  1. X ^%ZOSF("UCI") I Y'=^%ZOSF("PROD") K DIR Q
  1. ;if they are not running MSM don't ask
  1. I ^%ZOSF("OS")'["MSM" K DIR Q
  1. Q:'$D(XPDDIQ("XPZ2"))
  1. I $D(XPDDIQ("XPZ2"))#2 S XPDQUES("XPZ2")=XPDDIQ("XPZ2") K DIR Q
  1. S:$D(XPDDIQ("XPZ2","A")) DIR("A")=XPDDIQ("XPZ2","A")
  1. S:$D(XPDDIQ("XPZ2","B")) DIR("B")=XPDDIQ("XPZ2","B")
  1. Q