Routine: XPDIJ

XPDIJ ;SFISC/RSD - Install Job ;08/14/2008

 ;;8.0;KERNEL;**2,21,28,41,44,68,81,95,108,124,229,275,506,672,796**;Jul 10, 1995;Build 4

 ;Per VHA Directive 2004-038, this routine should not be modified.

EN ;install all packages

 ;XPDA=ien of first package

 ;this is needed to restore XPDIJ1

 D LNRF("XPDUTL") ;p275 SAVE calls RTNLOG^XPDUTL

 D LNRF("XPDIJ1") ;See that XPDIJ1 is loaded befor it is called

 N IEN,XPDI,XPD0,XPDSET,XPDABORT,XPDMENU,XPDQUIT,XPDVOL,X,Y,ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSK

 M X=DUZ N DUZ M DUZ=X S DUZ(0)="@" ;See that install has full FM priv.

 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XPDIJ"

 E  S X="ERR^XPDIJ",@^%ZOSF("TRAP")

 ;check that Install entry exists, set status to "Start of Install"

 Q:'$D(^XPD(9.7,+$G(XPDA),0))  S XPD0=^(0),$P(^(0),U,9)=2

 D INIT^XPDID

 ;See if need to Inhibit Logons

 I $$ANSWER^XPDIQ("XPI1") D INHIBIT^XPDIJ1("Y")

 ;disable options & protocols for setname, XPDSET=1/0^setname^out of order msg.

 S Y=$P(XPD0,U,8),XPDSET=+Y_U_$E(Y,2,99)_U_$S($L(Y):$P($G(^XTMP("XQOO",$E(Y,2,99),0)),U),1:"")

 ;hang the number of seconds given in 0;10

 I XPDSET D OFF^XQOO1($P(XPDSET,U,2)) I $P(XPD0,U,10) H ($P(XPD0,U,10)*60)

 ;check that Install still exists, wasn't unloaded p672

 I '$D(^XPD(9.7,XPDA,0))!'$D(^XTMP("XPDI",XPDA)) D EXIT^XPDID(" Build NOT installed, Transport Global missing!!!!") Q

 S Y=0

 ;XPDABORT can be set in pre or post install to abort install

 F  S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y  S %=$O(^(Y,0)) D:%  Q:$D(XPDABORT)

 .N XPD,XPDA,XPDNM,XPDV,XPDV0,XPDVOL,XPDX,XPDY,Y

 .;Now do the Install

 .S XPDA=%,XPDNM=$P($G(^XPD(9.7,XPDA,0)),U) D IN^XPDIJ1 Q:$D(XPDABORT)

 ;Now do Master Build Post INIT.

 I '$D(XPDABORT),$D(XPDT("MASTER")) D

 .N XPDBLD,XPDGREF

 .S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDGREF="^XTMP(""XPDI"","_XPDA_",""TEMP"")"

 .D POST^XPDIJ1

 ;ZTREQ tells taskman to delete task

 I $G(ZTSK) S ZTREQ="@" D

 .;remove task # from Install File

 .N XPD S XPD(9.7,XPDA_",",5)="@"

 .D FILE^DIE("","XPD")

 ;quit if install was aborted

 I $D(XPDABORT) D EXIT^XPDID("Install Aborted!!"),^%ZISC Q

 ;put option back in order

 I $P(XPDSET,U,2)]"" D ON^XQOO1($P(XPDSET,U,2)) K ^XTMP("XQOO",$P(XPDSET,U,2))

 ;check if menu rebuild is wanted (only if option has been added to any installs)

 ;XPDMENU is used to check that it is only done once

 S (Y,XPDMENU)=0

 F  S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y  S %=$O(^(Y,0)) D:%  Q:XPDMENU

 .N XPDA,Y

 .S XPDA=%

 .I $$ANSWER^XPDIQ("XPO1") D BMES^XPDUTL(" Call MENU rebuild"),KIDS^XQ81 S XPDMENU=1

 .;There should be no reason to check other CPUs anymore, patch 496

.Q

 .;check if need to queue menu rebuild on other CPUs

 .D:$O(^XPD(9.7,XPDA,"VOL",0))

 ..N XPDU,XPDY,XPDV,XPDV0,ZTUCI,ZTCPU

 ..X ^%ZOSF("UCI") S XPDU=$P(Y,","),XPDY=$P(Y,",",2),XPDV=0

 ..;loop thru VOLUMES SET and don't do current volume set

 ..F  S XPDV=$O(^XPD(9.7,XPDA,"VOL",XPDV)) Q:'XPDV  S XPDV0=$P(^(XPDV,0),U) D:XPDV0'=XPDY

 ...S ZTUCI=XPDU,ZTDTH=$H,ZTIO="",ZTDESC="Install Menu Rebuild",ZTCPU=XPDV0,ZTRTN="KIDS^XQ81" D ^%ZTLOAD

 ;See if need to reset inhibit logons

 I $$ANSWER^XPDIQ("XPI1") D INHIBIT^XPDIJ1("N")

 ;clean up globals

 S Y=0

 F  S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y  S XPDI=$O(^(Y,0)) D:XPDI

 . N %,Y,XPD,X

 . ;See if need to delete Env,Pre,Post routines.

 . S %=$O(^XTMP("XPDI",XPDI,"BLD",0)),XPD=$G(^XTMP("XPDI",XPDI,"BLD",%,"INID"))

 . I '$$GET^XUPARAM("XPD NO_EPP_DELETE") F %=1:1:3 I $P(XPD,U,%)="y" D

 . . S X=^XTMP("XPDI",XPDI,$P("PRE^INIT^INI",U,%)) S:X[U X=$P(X,U,2) X:X]"" ^%ZOSF("DEL")

 . ;kill transport global

 . K ^XTMP("XPDI",XPDI)

 . ;update the status field

 . S XPD(9.7,XPDI_",",.02)=3

 . D FILE^DIE("","XPD")

 D EXIT^XPDID("Install Completed"),^%ZISC

SAVE(X) ;restore routine X

 N %,DIE,XCM,XCN,XCS

 S DIE="^XTMP(""XPDI"",XPDA,""RTN"",X,",XCN=0

 X ^%ZOSF("SAVE") D RTNLOG^XPDUTL(X)

RTN(XPDA) ;restore all routines for package XPDA

 ;^XPD("XPDI",XPDA,"RTN",routine name)=0-install, 1-delete, 2-skip^checksum

 Q:$G(XPDA)=""

 N X,XPDI,XPDJ S XPDI=""

 F  S XPDI=$O(^XTMP("XPDI",XPDA,"RTN",XPDI)) Q:XPDI=""  S XPDJ=^(XPDI) D

 .;if we are doing VT graphic display, set counter

 .I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)

 .I 'XPDJ D SAVE(XPDI) Q

 .;set checksum to null, since routine wasn't loaded

 .I $P(XPDJ,U,2) S $P(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"KRN",9.8,"NM",$P(XPDJ,U,2),0),U,4)=""

 .I $P(XPDJ,U)=1 S X=XPDI X ^%ZOSF("DEL")

 ;if graphic display, update full count

 I $D(XPDIDVT) D UPDATE^XPDID(XPDIDCNT)

VOLERR(V,F) ;volume set not updated,V=volume set, F=flag

 N XQA,XQAMSG,XPDMES

 S XPDMES(1)=" ",XPDMES(2)=" ** Job on VOLUME SET "_V_$S(F:" never started **",1:" has been idle for an hour.")

 S XPDMES(3)=" ** "_V_" has NOT been updated! **"

 S XQA(DUZ)="",XQAMSG="VOLUME SET "_V_" NOT updated for Install "_$E($P($G(^XPD(9.7,+$G(XPDA),0)),"^"),1,30)

 D MES^XPDUTL(.XPDMES),SETUP^XQALERT

 ;come here on error, record error in Install file and cleanup var.

ERR N XPDERROR,XQA,XQAMSG

 S XPDERROR=$$EC^%ZOSV

 ;record error

 D ^%ZTER

 ;reset primary device back to home device

 I $G(IO(0))]"" U IO(0) ;p796

 ;write message, reset terminal

 D BMES^XPDUTL(XPDERROR),EXIT^XPDID()

 S XQA(DUZ)="",XQAMSG="Install "_$E($P($G(^XPD(9.7,+$G(XPDA),0)),"^"),1,30)_" has encountered an Error."

 D SETUP^XQALERT G UNWIND^%ZTER

LNRF(RN) ;Load needed routines first

 I $D(^XTMP("XPDI",XPDA,"RTN",RN)) D

 .N X

 .D SAVE(RN)

 .S XCN=$$RTNUP^XPDUTL(RN,2)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDIJ   5549     printed  Feb 18, 2025@23:30:03                                                                                                                                                                                                       Page 2

XPDIJ     ;SFISC/RSD - Install Job ;08/14/2008

 +1       ;;8.0;KERNEL;**2,21,28,41,44,68,81,95,108,124,229,275,506,672,796**;Jul 10, 1995;Build 4

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

EN        ;install all packages

 +1       ;XPDA=ien of first package

 +2       ;this is needed to restore XPDIJ1

 +3       ;p275 SAVE calls RTNLOG^XPDUTL

           DO LNRF("XPDUTL")

 +4       ;See that XPDIJ1 is loaded befor it is called

           DO LNRF("XPDIJ1")

 +5        NEW IEN,XPDI,XPD0,XPDSET,XPDABORT,XPDMENU,XPDQUIT,XPDVOL,X,Y,ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSK

 +6       ;See that install has full FM priv.

           MERGE X=DUZ

           NEW DUZ

           MERGE DUZ=X

           SET DUZ(0)="@"

 +7        IF $$NEWERR^%ZTER

               NEW $ETRAP,$ESTACK

               SET $ETRAP="D ERR^XPDIJ"

 +8       IF '$TEST

               SET X="ERR^XPDIJ"

               SET @^%ZOSF("TRAP")

 +9       ;check that Install entry exists, set status to "Start of Install"

 +10       if '$DATA(^XPD(9.7,+$GET(XPDA),0))

               QUIT

           SET XPD0=^(0)

           SET $PIECE(^(0),U,9)=2

 +11       DO INIT^XPDID

 +12      ;See if need to Inhibit Logons

 +13       IF $$ANSWER^XPDIQ("XPI1")

               DO INHIBIT^XPDIJ1("Y")

 +14      ;disable options & protocols for setname, XPDSET=1/0^setname^out of order msg.

 +15       SET Y=$PIECE(XPD0,U,8)

           SET XPDSET=+Y_U_$EXTRACT(Y,2,99)_U_$SELECT($LENGTH(Y):$PIECE($GET(^XTMP("XQOO",$EXTRACT(Y,2,99),0)),U),1:"")

 +16      ;hang the number of seconds given in 0;10

 +17       IF XPDSET

               DO OFF^XQOO1($PIECE(XPDSET,U,2))

               IF $PIECE(XPD0,U,10)

                   HANG ($PIECE(XPD0,U,10)*60)

 +18      ;check that Install still exists, wasn't unloaded p672

 +19       IF '$DATA(^XPD(9.7,XPDA,0))!'$DATA(^XTMP("XPDI",XPDA))

               DO EXIT^XPDID(" Build NOT installed, Transport Global missing!!!!")

               QUIT

 +20       SET Y=0

 +21      ;XPDABORT can be set in pre or post install to abort install

 +22       FOR

               SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))

               if 'Y

                   QUIT

               SET %=$ORDER(^(Y,0))

               if %

                   Begin DoDot:1

 +23                   NEW XPD,XPDA,XPDNM,XPDV,XPDV0,XPDVOL,XPDX,XPDY,Y

 +24      ;Now do the Install

 +25                   SET XPDA=%

                       SET XPDNM=$PIECE($GET(^XPD(9.7,XPDA,0)),U)

                       DO IN^XPDIJ1

                       if $DATA(XPDABORT)

                           QUIT

                   End DoDot:1

               if $DATA(XPDABORT)

                   QUIT

 +26      ;

 +27      ;Now do Master Build Post INIT.

 +28       IF '$DATA(XPDABORT)

               IF $DATA(XPDT("MASTER"))

                   Begin DoDot:1

 +29                   NEW XPDBLD,XPDGREF

 +30                   SET XPDBLD=$ORDER(^XTMP("XPDI",XPDA,"BLD",0))

                       SET XPDGREF="^XTMP(""XPDI"","_XPDA_",""TEMP"")"

 +31                   DO POST^XPDIJ1

                   End DoDot:1

 +32      ;ZTREQ tells taskman to delete task

 +33       IF $GET(ZTSK)

               SET ZTREQ="@"

               Begin DoDot:1

 +34      ;remove task # from Install File

 +35               NEW XPD

                   SET XPD(9.7,XPDA_",",5)="@"

 +36               DO FILE^DIE("","XPD")

               End DoDot:1

 +37      ;quit if install was aborted

 +38       IF $DATA(XPDABORT)

               DO EXIT^XPDID("Install Aborted!!")

               DO ^%ZISC

               QUIT

 +39      ;put option back in order

 +40       IF $PIECE(XPDSET,U,2)]""

               DO ON^XQOO1($PIECE(XPDSET,U,2))

               KILL ^XTMP("XQOO",$PIECE(XPDSET,U,2))

 +41      ;check if menu rebuild is wanted (only if option has been added to any installs)

 +42      ;XPDMENU is used to check that it is only done once

 +43       SET (Y,XPDMENU)=0

 +44       FOR

               SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))

               if 'Y

                   QUIT

               SET %=$ORDER(^(Y,0))

               if %

                   Begin DoDot:1

 +45                   NEW XPDA,Y

 +46                   SET XPDA=%

 +47                   IF $$ANSWER^XPDIQ("XPO1")

                           DO BMES^XPDUTL(" Call MENU rebuild")

                           DO KIDS^XQ81

                           SET XPDMENU=1

 +48      ;There should be no reason to check other CPUs anymore, patch 496

 +49                   QUIT

 +50      ;check if need to queue menu rebuild on other CPUs

 +51                   if $ORDER(^XPD(9.7,XPDA,"VOL",0))

                           Begin DoDot:2

 +52                           NEW XPDU,XPDY,XPDV,XPDV0,ZTUCI,ZTCPU

 +53                           XECUTE ^%ZOSF("UCI")

                               SET XPDU=$PIECE(Y,",")

                               SET XPDY=$PIECE(Y,",",2)

                               SET XPDV=0

 +54      ;loop thru VOLUMES SET and don't do current volume set

 +55                           FOR

                                   SET XPDV=$ORDER(^XPD(9.7,XPDA,"VOL",XPDV))

                                   if 'XPDV

                                       QUIT

                                   SET XPDV0=$PIECE(^(XPDV,0),U)

                                   if XPDV0'=XPDY

                                       Begin DoDot:3

 +56                                       SET ZTUCI=XPDU

                                           SET ZTDTH=$HOROLOG

                                           SET ZTIO=""

                                           SET ZTDESC="Install Menu Rebuild"

                                           SET ZTCPU=XPDV0

                                           SET ZTRTN="KIDS^XQ81"

                                           DO ^%ZTLOAD

                                       End DoDot:3

                           End DoDot:2

                   End DoDot:1

               if XPDMENU

                   QUIT

 +57      ;

 +58      ;See if need to reset inhibit logons

 +59       IF $$ANSWER^XPDIQ("XPI1")

               DO INHIBIT^XPDIJ1("N")

 +60      ;

 +61      ;clean up globals

 +62       SET Y=0

 +63       FOR

               SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))

               if 'Y

                   QUIT

               SET XPDI=$ORDER(^(Y,0))

               if XPDI

                   Begin DoDot:1

 +64                   NEW %,Y,XPD,X

 +65      ;See if need to delete Env,Pre,Post routines.

 +66                   SET %=$ORDER(^XTMP("XPDI",XPDI,"BLD",0))

                       SET XPD=$GET(^XTMP("XPDI",XPDI,"BLD",%,"INID"))

 +67                   IF '$$GET^XUPARAM("XPD NO_EPP_DELETE")

                           FOR %=1:1:3

                               IF $PIECE(XPD,U,%)="y"

                                   Begin DoDot:2

 +68                                   SET X=^XTMP("XPDI",XPDI,$PIECE("PRE^INIT^INI",U,%))

                                       if X[U

                                           SET X=$PIECE(X,U,2)

                                       if X]""

                                           XECUTE ^%ZOSF("DEL")

                                   End DoDot:2

 +69      ;kill transport global

 +70                   KILL ^XTMP("XPDI",XPDI)

 +71      ;update the status field

 +72                   SET XPD(9.7,XPDI_",",.02)=3

 +73                   DO FILE^DIE("","XPD")

                   End DoDot:1

 +74       DO EXIT^XPDID("Install Completed")

           DO ^%ZISC

 +75       QUIT

 +76      ;

SAVE(X)   ;restore routine X

 +1        NEW %,DIE,XCM,XCN,XCS

 +2        SET DIE="^XTMP(""XPDI"",XPDA,""RTN"",X,"

           SET XCN=0

 +3        XECUTE ^%ZOSF("SAVE")

           DO RTNLOG^XPDUTL(X)

 +4        QUIT

RTN(XPDA) ;restore all routines for package XPDA

 +1       ;^XPD("XPDI",XPDA,"RTN",routine name)=0-install, 1-delete, 2-skip^checksum

 +2        if $GET(XPDA)=""

               QUIT

 +3        NEW X,XPDI,XPDJ

           SET XPDI=""

 +4        FOR

               SET XPDI=$ORDER(^XTMP("XPDI",XPDA,"RTN",XPDI))

               if XPDI=""

                   QUIT

               SET XPDJ=^(XPDI)

               Begin DoDot:1

 +5       ;if we are doing VT graphic display, set counter

 +6                IF $DATA(XPDIDVT)

                       SET XPDIDCNT=XPDIDCNT+1

                       if '(XPDIDCNT#XPDIDMOD)

                           DO UPDATE^XPDID(XPDIDCNT)

 +7                IF 'XPDJ

                       DO SAVE(XPDI)

                       QUIT

 +8       ;set checksum to null, since routine wasn't loaded

 +9                IF $PIECE(XPDJ,U,2)

                       SET $PIECE(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"KRN",9.8,"NM",$PIECE(XPDJ,U,2),0),U,4)=""

 +10               IF $PIECE(XPDJ,U)=1

                       SET X=XPDI

                       XECUTE ^%ZOSF("DEL")

               End DoDot:1

 +11      ;if graphic display, update full count

 +12       IF $DATA(XPDIDVT)

               DO UPDATE^XPDID(XPDIDCNT)

 +13       QUIT

 +14      ;

VOLERR(V,F) ;volume set not updated,V=volume set, F=flag

 +1        NEW XQA,XQAMSG,XPDMES

 +2        SET XPDMES(1)=" "

           SET XPDMES(2)=" ** Job on VOLUME SET "_V_$SELECT(F:" never started **",1:" has been idle for an hour.")

 +3        SET XPDMES(3)=" ** "_V_" has NOT been updated! **"

 +4        SET XQA(DUZ)=""

           SET XQAMSG="VOLUME SET "_V_" NOT updated for Install "_$EXTRACT($PIECE($GET(^XPD(9.7,+$GET(XPDA),0)),"^"),1,30)

 +5        DO MES^XPDUTL(.XPDMES)

           DO SETUP^XQALERT

 +6        QUIT

 +7       ;come here on error, record error in Install file and cleanup var.

ERR        NEW XPDERROR,XQA,XQAMSG

 +1        SET XPDERROR=$$EC^%ZOSV

 +2       ;record error

 +3        DO ^%ZTER

 +4       ;reset primary device back to home device

 +5       ;p796

           IF $GET(IO(0))]""

               USE IO(0)

 +6       ;write message, reset terminal

 +7        DO BMES^XPDUTL(XPDERROR)

           DO EXIT^XPDID()

 +8        SET XQA(DUZ)=""

           SET XQAMSG="Install "_$EXTRACT($PIECE($GET(^XPD(9.7,+$GET(XPDA),0)),"^"),1,30)_" has encountered an Error."

 +9        DO SETUP^XQALERT

           GOTO UNWIND^%ZTER

 +10      ;

LNRF(RN)  ;Load needed routines first

 +1        IF $DATA(^XTMP("XPDI",XPDA,"RTN",RN))

               Begin DoDot:1

 +2                NEW X

 +3                DO SAVE(RN)

 +4                SET XCN=$$RTNUP^XPDUTL(RN,2)

               End DoDot:1

 +5        QUIT

XPDIJ.m