XPDI1 ;SFISC/RSD - Cont of Install Process ;10/28/2002 17:14
;;8.0;KERNEL;**58,61,95,108,229,275**;Jul 10, 1995
;lookup into file 9.7, XPDS=DIC("S") for lookup
;return 0-fail or ien, XPDT=array of linked builds
LOOK(XPDS,XPDL) ;lookup Install
N DIC,Y,XPD,XPDIT,%
S DIC(0)="QEAMZ",DIC="^XPD(9.7,"
S:$L($G(XPDS)) DIC("S")=XPDS
D ^DIC Q:Y<0 0
I '$G(XPDL) L +^XPD(9.7,+Y,0):0 E W !,"Being accessed by another user" Q 0
S XPD=+Y,XPDIT=0
W !!,"This Distribution was loaded on ",$$FMTE^XLFDT($P(Y(0),U,3))," with header of ",!?3,$G(^XPD(9.7,XPD,2)),!?3,"It consisted of the following Install(s):",!
;build XPDT array
I '$D(^XPD(9.7,"ASP",XPD)) D XPDT(1,XPD) Q XPD
F S XPDIT=$O(^XPD(9.7,"ASP",XPD,XPDIT)) Q:'XPDIT S Y=+$O(^(XPDIT,0)) D XPDT(XPDIT,Y)
I '$O(XPDT(0)) S XPDQUIT=1 D QUIT(XPD)
Q XPD
;
QUIT(Y) ;unlock ien Y
L -^XPD(9.7,+Y) Q
;
XPDT(P1,P2) ;Build XPDT array
N % S %=$P($G(^XPD(9.7,P2,0)),U)
I %="" W:$X ! W "**ERROR in Install, You need to remove the Distribution and reload it**",! S XPDQUIT=1 Q
S XPDT(P1)=P2_U_%,(XPDT("DA",P2),XPDT("NM",%))=P1 W:$X>64 ! W $J(%,15)
Q
;
QUES(XPDA) ;install questions; XPDA=ien in file 9.7
N XPDANS,XPDFIL,XPDFILN,XPDFILO,XPDFLG,XPDNM,XPDQUES,X,Y
S XPDNM=$P(^XPD(9.7,XPDA,0),U) W !!,"Install Questions for ",XPDNM,!
;pre-init questions
D DIR^XPDIQ("PRE") I $D(XPDQUIT) D ASKABRT^XPDI Q
;file install questions
S (XPDFIL,XPDFLG)=0
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)
.;check for DD screening logic
.I $G(^(10))]"" N XPDSCR S XPDSCR=^(10) ;^(10) is ref to ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,10) from prev line
.;XPDFILN=file name^global ref^partial DD
.;XPDANS=new file^DD screen failed^Data exists^update file name^user
.;doesn't want to update data 1=yes,0=no
.S XPDFILN=X_X(0)_U_X(1),XPDANS='($D(^DIC(XPDFIL,0))#2)_"^^"_''$O(@(X(0)_"0)"))
.I 'XPDFLG W !,"Incoming Files:" S XPDFLG=1
.W ! D DIR^XPDIQ("XPF",XPDFIL_"#") Q:$D(XPDQUIT)
.S:$G(XPDQUES("XPF"_XPDFIL_"#2"))=0 $P(XPDANS,U,5)=1
.S ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,2)=XPDANS
.;kill the answers so we can re-ask for next file
.F I=1:1:2 K XPDQUES("XPF"_XPDFIL_"#"_I)
;XPDQUIT is by file questions in previous do loop, set in XPDIQ
I $D(XPDQUIT) D ASKABRT^XPDI Q
;ask for coordinators to incoming mail groups
S (XPDFIL,XPDFLG)=0
F S XPDFIL=$O(^XTMP("XPDI",XPDA,"KRN",3.8,XPDFIL)) Q:'XPDFIL S X=^(XPDFIL,0),Y=$G(^(-1)) D Q:$D(XPDQUIT)
.;XPDANS=Mail Group name
.Q:$P(Y,U)=1 ;Don't ask if deleting
.S XPDANS=$P(X,U)
.I 'XPDFLG W !!,"Incoming Mail Groups:" S XPDFLG=1
.W ! D DIR^XPDIQ("XPM",XPDFIL_"#") Q:$D(XPDQUIT)
.;kill the answers so we can re-ask for next MG
.K XPDQUES("XPM"_XPDFIL_"#1")
.Q
I $D(XPDQUIT) D ASKABRT^XPDI Q
;ask to rebuild menus if Option is added
S (XPDFIL,XPDFLG)=0
S XPDFIL=$O(^XTMP("XPDI",XPDA,"KRN",19,XPDFIL)) D:XPDFIL
.S X=^XTMP("XPDI",XPDA,"KRN",19,XPDFIL,0)
.;XPDANS=Menu Rebuild Answer
.S XPDANS=$P(X,U)
.W ! D DIR^XPDIQ("XPO") Q:$D(XPDQUIT)
I $D(XPDQUIT) D ASKABRT^XPDI Q
;post-init questions
W ! D DIR^XPDIQ("POS") I $D(DIRUT)!$D(XPDQUIT) D ASKABRT^XPDI Q
Q
;
XQSET(XPDA) ;get options & protocols to disable
;put in ^TMP($J,"XQOO",starting build name)
N A,I,X,Y
S I=0 F S I=$O(^XTMP("XPDI",XPDA,"KRN",19,I)) Q:'I S X=^(I,0),A=^(-1) D
.S Y=$O(^DIC(19,"B",$P(X,U),0))
.;check that option exist and 0=send,1=delete,3=merge or 5=disable
.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)
S I=0 F S I=$O(^XTMP("XPDI",XPDA,"KRN",101,I)) Q:'I S X=^(I,0),A=^(-1) D
.S Y=$O(^ORD(101,"B",$P(X,U),0))
.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)
Q
;XPDIJ need to install XPDIJ now & set routine flag to skip
XPDIJ N DIE,XPDA,XCM,XCN,XCS,X
S XPDA=XPDIJ,DIE="^XTMP(""XPDI"",XPDIJ,""RTN"",""XPDIJ"",",XCN=0,X="XPDIJ"
X ^%ZOSF("SAVE") D RTNLOG^XPDUTL("XPDIJ") ;Save and update ROUTINE file
S XCN=$$RTNUP^XPDUTL("XPDIJ",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDI1 4094 printed Apr 09, 2024@21:17:42 Page 2
XPDI1 ;SFISC/RSD - Cont of Install Process ;10/28/2002 17:14
+1 ;;8.0;KERNEL;**58,61,95,108,229,275**;Jul 10, 1995
+2 ;lookup into file 9.7, XPDS=DIC("S") for lookup
+3 ;return 0-fail or ien, XPDT=array of linked builds
LOOK(XPDS,XPDL) ;lookup Install
+1 NEW DIC,Y,XPD,XPDIT,%
+2 SET DIC(0)="QEAMZ"
SET DIC="^XPD(9.7,"
+3 if $LENGTH($GET(XPDS))
SET DIC("S")=XPDS
+4 DO ^DIC
if Y<0
QUIT 0
+5 IF '$GET(XPDL)
LOCK +^XPD(9.7,+Y,0):0
IF '$TEST
WRITE !,"Being accessed by another user"
QUIT 0
+6 SET XPD=+Y
SET XPDIT=0
+7 WRITE !!,"This Distribution was loaded on ",$$FMTE^XLFDT($PIECE(Y(0),U,3))," with header of ",!?3,$GET(^XPD(9.7,XPD,2)),!?3,"It consisted of the following Install(s):",!
+8 ;build XPDT array
+9 IF '$DATA(^XPD(9.7,"ASP",XPD))
DO XPDT(1,XPD)
QUIT XPD
+10 FOR
SET XPDIT=$ORDER(^XPD(9.7,"ASP",XPD,XPDIT))
if 'XPDIT
QUIT
SET Y=+$ORDER(^(XPDIT,0))
DO XPDT(XPDIT,Y)
+11 IF '$ORDER(XPDT(0))
SET XPDQUIT=1
DO QUIT(XPD)
+12 QUIT XPD
+13 ;
QUIT(Y) ;unlock ien Y
+1 LOCK -^XPD(9.7,+Y)
QUIT
+2 ;
XPDT(P1,P2) ;Build XPDT array
+1 NEW %
SET %=$PIECE($GET(^XPD(9.7,P2,0)),U)
+2 IF %=""
if $X
WRITE !
WRITE "**ERROR in Install, You need to remove the Distribution and reload it**",!
SET XPDQUIT=1
QUIT
+3 SET XPDT(P1)=P2_U_%
SET (XPDT("DA",P2),XPDT("NM",%))=P1
if $X>64
WRITE !
WRITE $JUSTIFY(%,15)
+4 QUIT
+5 ;
QUES(XPDA) ;install questions; XPDA=ien in file 9.7
+1 NEW XPDANS,XPDFIL,XPDFILN,XPDFILO,XPDFLG,XPDNM,XPDQUES,X,Y
+2 SET XPDNM=$PIECE(^XPD(9.7,XPDA,0),U)
WRITE !!,"Install Questions for ",XPDNM,!
+3 ;pre-init questions
+4 DO DIR^XPDIQ("PRE")
IF $DATA(XPDQUIT)
DO ASKABRT^XPDI
QUIT
+5 ;file install questions
+6 SET (XPDFIL,XPDFLG)=0
+7 FOR
SET XPDFIL=$ORDER(^XTMP("XPDI",XPDA,"FIA",XPDFIL))
if 'XPDFIL
QUIT
SET X=^(XPDFIL)
SET X(0)=^(XPDFIL,0)
SET X(1)=^(XPDFIL)
SET XPDFILO=^(0,1)
Begin DoDot:1
+8 ;check for DD screening logic
+9 ;^(10) is ref to ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,10) from prev line
IF $GET(^(10))]""
NEW XPDSCR
SET XPDSCR=^(10)
+10 ;XPDFILN=file name^global ref^partial DD
+11 ;XPDANS=new file^DD screen failed^Data exists^update file name^user
+12 ;doesn't want to update data 1=yes,0=no
+13 SET XPDFILN=X_X(0)_U_X(1)
SET XPDANS='($DATA(^DIC(XPDFIL,0))#2)_"^^"_''$ORDER(@(X(0)_"0)"))
+14 IF 'XPDFLG
WRITE !,"Incoming Files:"
SET XPDFLG=1
+15 WRITE !
DO DIR^XPDIQ("XPF",XPDFIL_"#")
if $DATA(XPDQUIT)
QUIT
+16 if $GET(XPDQUES("XPF"_XPDFIL_"#2"))=0
SET $PIECE(XPDANS,U,5)=1
+17 SET ^XTMP("XPDI",XPDA,"FIA",XPDFIL,0,2)=XPDANS
+18 ;kill the answers so we can re-ask for next file
+19 FOR I=1:1:2
KILL XPDQUES("XPF"_XPDFIL_"#"_I)
End DoDot:1
if $DATA(XPDQUIT)
QUIT
+20 ;XPDQUIT is by file questions in previous do loop, set in XPDIQ
+21 IF $DATA(XPDQUIT)
DO ASKABRT^XPDI
QUIT
+22 ;ask for coordinators to incoming mail groups
+23 SET (XPDFIL,XPDFLG)=0
+24 FOR
SET XPDFIL=$ORDER(^XTMP("XPDI",XPDA,"KRN",3.8,XPDFIL))
if 'XPDFIL
QUIT
SET X=^(XPDFIL,0)
SET Y=$GET(^(-1))
Begin DoDot:1
+25 ;XPDANS=Mail Group name
+26 ;Don't ask if deleting
if $PIECE(Y,U)=1
QUIT
+27 SET XPDANS=$PIECE(X,U)
+28 IF 'XPDFLG
WRITE !!,"Incoming Mail Groups:"
SET XPDFLG=1
+29 WRITE !
DO DIR^XPDIQ("XPM",XPDFIL_"#")
if $DATA(XPDQUIT)
QUIT
+30 ;kill the answers so we can re-ask for next MG
+31 KILL XPDQUES("XPM"_XPDFIL_"#1")
+32 QUIT
End DoDot:1
if $DATA(XPDQUIT)
QUIT
+33 IF $DATA(XPDQUIT)
DO ASKABRT^XPDI
QUIT
+34 ;ask to rebuild menus if Option is added
+35 SET (XPDFIL,XPDFLG)=0
+36 SET XPDFIL=$ORDER(^XTMP("XPDI",XPDA,"KRN",19,XPDFIL))
if XPDFIL
Begin DoDot:1
+37 SET X=^XTMP("XPDI",XPDA,"KRN",19,XPDFIL,0)
+38 ;XPDANS=Menu Rebuild Answer
+39 SET XPDANS=$PIECE(X,U)
+40 WRITE !
DO DIR^XPDIQ("XPO")
if $DATA(XPDQUIT)
QUIT
End DoDot:1
+41 IF $DATA(XPDQUIT)
DO ASKABRT^XPDI
QUIT
+42 ;post-init questions
+43 WRITE !
DO DIR^XPDIQ("POS")
IF $DATA(DIRUT)!$DATA(XPDQUIT)
DO ASKABRT^XPDI
QUIT
+44 QUIT
+45 ;
XQSET(XPDA) ;get options & protocols to disable
+1 ;put in ^TMP($J,"XQOO",starting build name)
+2 NEW A,I,X,Y
+3 SET I=0
FOR
SET I=$ORDER(^XTMP("XPDI",XPDA,"KRN",19,I))
if 'I
QUIT
SET X=^(I,0)
SET A=^(-1)
Begin DoDot:1
+4 SET Y=$ORDER(^DIC(19,"B",$PIECE(X,U),0))
+5 ;check that option exist and 0=send,1=delete,3=merge or 5=disable
+6 IF Y
IF $DATA(^DIC(19,Y,0))
IF $SELECT('A:1,1:A#2)
SET ^TMP($JOB,"XQOO",XPDSET,19,Y)=$PIECE(^(0),U,1,2)
End DoDot:1
+7 SET I=0
FOR
SET I=$ORDER(^XTMP("XPDI",XPDA,"KRN",101,I))
if 'I
QUIT
SET X=^(I,0)
SET A=^(-1)
Begin DoDot:1
+8 SET Y=$ORDER(^ORD(101,"B",$PIECE(X,U),0))
+9 IF Y
IF $DATA(^ORD(101,Y,0))
IF $SELECT(A=3:1,A=5:1,1:'A)
SET ^TMP($JOB,"XQOO",XPDSET,101,Y)=$PIECE(^(0),U,1,2)
End DoDot:1
+10 QUIT
+11 ;XPDIJ need to install XPDIJ now & set routine flag to skip
XPDIJ NEW DIE,XPDA,XCM,XCN,XCS,X
+1 SET XPDA=XPDIJ
SET DIE="^XTMP(""XPDI"",XPDIJ,""RTN"",""XPDIJ"","
SET XCN=0
SET X="XPDIJ"
+2 ;Save and update ROUTINE file
XECUTE ^%ZOSF("SAVE")
DO RTNLOG^XPDUTL("XPDIJ")
+3 SET XCN=$$RTNUP^XPDUTL("XPDIJ",2)
+4 QUIT
