Routine: XPDI1

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)

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

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)

 ;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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDI1   4094     printed  Mar 13, 2025@21:08:23                                                                                                                                                                                                       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

XPDI1.m