XPDIJ ;SFISC/RSD - Install Job ;08/17/98 13:34
;;8.0;KERNEL;**1005**;FEB 09, 1999
;;8.0;KERNEL;**2,21,28,41,44,68,81,95**;Jul 10, 1995
EN ;install all packages
;XPDA=ien of first package
;this is needed to restore XPDIJ1
I $D(^XTMP("XPDI",XPDA,"RTN","XPDIJ1")) D
.N DIE,XCM,XCN,XCS,X
.S DIE="^XTMP(""XPDI"",XPDA,""RTN"",""XPDIJ1"",",XCN=0,X="XPDIJ1"
.X ^%ZOSF("SAVE")
.S XCN=$$RTNUP^XPDUTL("XPDIJ1",2)
N IEN,XPDI,XPD0,XPDSET,XPDABORT,XPDMENU,XPDQUIT,XPDVOL,X,Y,ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSK
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XPDIJ"
E S X="ERR^XPDIJ",@^%ZOSF("TRAP")
Q:'$D(^XPD(9.7,+$G(XPDA),0)) S XPD0=^(0)
D INIT^XPDID
;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)
;XPDVOL is set only if they want to update other CPUs
I $O(^XPD(9.7,XPDA,"VOL",0)) M XPDVOL=^XPD(9.7,XPDA,"VOL") D
.S Y=0
.F S Y=$O(XPDVOL(Y)) Q:'Y S $P(XPDVOL(Y,0),U,2,3)="^" K XPDVOL(Y,1)
.;jobup RTN^XPDIJ(XPDA), to install routines on other CPU if Taskman is running
.;check that taskman is running
.D:$$TM^%ZTLOAD
..N XPDU,XPDY,XPDV,XPDV0,XPDVOL,ZTUCI,ZTCPU,ZTDESC,ZTRTN,ZTDTH,ZTIO,ZTSK
..X ^%ZOSF("UCI") S XPDU=$P(Y,","),XPDY=$P(Y,",",2),XPDV=0
..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="KIDS update CPUs "_XPDV0,ZTCPU=XPDV0,ZTRTN="EN^XPDCPU("_XPDA_","_XPDV_")"
...D ^%ZTLOAD
...;save task number under Volume set multiple
...Q:'$G(ZTSK) K XPD
...S XPD(9.703,XPDV_","_XPDA_",",3)=ZTSK D FILE^DIE("","XPD")
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)
.;build volume multiple for each package
.I $D(XPDVOL),'$D(^XPD(9.7,%,"VOL")) M ^("VOL")=XPDVOL
.N XPD,XPDA,XPDNM,XPDV,XPDV0,XPDVOL,XPDX,XPDY,Y
.S XPDA=%,XPDNM=$P($G(^XPD(9.7,XPDA,0)),U) D IN^XPDIJ1 Q:$D(XPDABORT)
.;check status of other cpu jobs, do if not this volume
.X ^%ZOSF("UCI") S XPDY=$P(Y,",",2),XPDV=0
.F S XPDV=$O(^XPD(9.7,XPDA,"VOL",XPDV)) Q:'XPDV S XPDV0=^(XPDV,0) D:$P(XPDV0,U)'=XPDY
..;if completed time,write message and quit
..I $P(XPDV0,U,2) D BMES^XPDUTL(" Job on VOLUME SET "_$P(XPDV0,U)_" Completed.") Q
..;if job had no start time, write message and quit
..I '$P(XPDV0,U,3) D I '$P(XPDV0,U,3) D VOLERR($P(XPDV0,U),1) Q
...D BMES^XPDUTL(" Waiting for job on VOLUME SET "_$P(XPDV0,U)_" to start.")
...;hang 1 minute, try 5 times
...F %=1:1:5 H 60 S XPDV0=^XPD(9.7,XPDA,"VOL",XPDV,0) Q:$P(XPDV0,U,3)
..D BMES^XPDUTL(" Waiting for job on VOLUME SET "_$P(XPDV0,U)_" to complete.")
..S XPD=0,XPDX=$G(^XPD(9.7,XPDA,"VOL",XPDV,1))
..;check the last update node
..F S Y=$P(^XPD(9.7,XPDA,"VOL",XPDV,0),U,2),X=$G(^(1)),XPD=XPD+1 Q:XPD>360!Y S:X'=XPDX XPD=0,XPDX=X H 10
..;quit if we have a complete time
..I Y D BMES^XPDUTL(" Job on VOLUME SET "_$P(XPDV0,U)_" Completed.") Q
..D VOLERR($P(XPDV0,U),0)
;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)
S IEN=""
S IEN=$O(^XPD(9.7,XPDA,"QUES","B","XPO1",IEN))
D:IEN
.I ^XPD(9.7,XPDA,"QUES",IEN,1) D
..D KIDS^XQ81
..;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
;
;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
.;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
Q
;
SAVE(X) ;restore routine X
N %,DIE,XCM,XCN,XCS
S DIE="^XTMP(""XPDI"",XPDA,""RTN"",X,",XCN=0
X ^%ZOSF("SAVE")
Q
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)
Q
;
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
Q
;come here on error, record error in Install file and cleanup var.
ERR N XPDERROR,XQA,XQAMSG
S XPDERROR=$$EC^%ZOSV
;record error, write message, reset terminal
D ^%ZTER,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
XPDIJ ;SFISC/RSD - Install Job ;08/17/98 13:34
+1 ;;8.0;KERNEL;**1005**;FEB 09, 1999
+2 ;;8.0;KERNEL;**2,21,28,41,44,68,81,95**;Jul 10, 1995
EN ;install all packages
+1 ;XPDA=ien of first package
+2 ;this is needed to restore XPDIJ1
+3 IF $DATA(^XTMP("XPDI",XPDA,"RTN","XPDIJ1"))
Begin DoDot:1
+4 NEW DIE,XCM,XCN,XCS,X
+5 SET DIE="^XTMP(""XPDI"",XPDA,""RTN"",""XPDIJ1"","
SET XCN=0
SET X="XPDIJ1"
+6 XECUTE ^%ZOSF("SAVE")
+7 SET XCN=$$RTNUP^XPDUTL("XPDIJ1",2)
End DoDot:1
+8 NEW IEN,XPDI,XPD0,XPDSET,XPDABORT,XPDMENU,XPDQUIT,XPDVOL,X,Y,ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSK
+9 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^XPDIJ"
+10 IF '$TEST
SET X="ERR^XPDIJ"
SET @^%ZOSF("TRAP")
+11 IF '$DATA(^XPD(9.7,+$GET(XPDA),0))
QUIT
SET XPD0=^(0)
+12 DO INIT^XPDID
+13 ;disable options & protocols for setname, XPDSET=1/0^setname^out of order msg.
+14 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:"")
+15 ;hang the number of seconds given in 0;10
+16 IF XPDSET
DO OFF^XQOO1($PIECE(XPDSET,U,2))
IF $PIECE(XPD0,U,10)
HANG ($PIECE(XPD0,U,10)*60)
+17 ;XPDVOL is set only if they want to update other CPUs
+18 IF $ORDER(^XPD(9.7,XPDA,"VOL",0))
MERGE XPDVOL=^XPD(9.7,XPDA,"VOL")
Begin DoDot:1
+19 SET Y=0
+20 FOR
SET Y=$ORDER(XPDVOL(Y))
IF 'Y
QUIT
SET $PIECE(XPDVOL(Y,0),U,2,3)="^"
KILL XPDVOL(Y,1)
+21 ;jobup RTN^XPDIJ(XPDA), to install routines on other CPU if Taskman is running
+22 ;check that taskman is running
+23 IF $$TM^%ZTLOAD
Begin DoDot:2
+24 NEW XPDU,XPDY,XPDV,XPDV0,XPDVOL,ZTUCI,ZTCPU,ZTDESC,ZTRTN,ZTDTH,ZTIO,ZTSK
+25 XECUTE ^%ZOSF("UCI")
SET XPDU=$PIECE(Y,",")
SET XPDY=$PIECE(Y,",",2)
SET XPDV=0
+26 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
+27 SET ZTUCI=XPDU
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="KIDS update CPUs "_XPDV0
SET ZTCPU=XPDV0
SET ZTRTN="EN^XPDCPU("_XPDA_","_XPDV_")"
+28 DO ^%ZTLOAD
+29 ;save task number under Volume set multiple
+30 IF '$GET(ZTSK)
QUIT
KILL XPD
+31 SET XPD(9.703,XPDV_","_XPDA_",",3)=ZTSK
DO FILE^DIE("","XPD")
End DoDot:3
End DoDot:2
End DoDot:1
+32 SET Y=0
+33 ;XPDABORT can be set in pre or post install to abort install
+34 FOR
SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))
IF 'Y
QUIT
SET %=$ORDER(^(Y,0))
IF %
Begin DoDot:1
+35 ;build volume multiple for each package
+36 IF $DATA(XPDVOL)
IF '$DATA(^XPD(9.7,%,"VOL"))
MERGE ^("VOL")=XPDVOL
+37 NEW XPD,XPDA,XPDNM,XPDV,XPDV0,XPDVOL,XPDX,XPDY,Y
+38 SET XPDA=%
SET XPDNM=$PIECE($GET(^XPD(9.7,XPDA,0)),U)
DO IN^XPDIJ1
IF $DATA(XPDABORT)
QUIT
+39 ;check status of other cpu jobs, do if not this volume
+40 XECUTE ^%ZOSF("UCI")
SET XPDY=$PIECE(Y,",",2)
SET XPDV=0
+41 FOR
SET XPDV=$ORDER(^XPD(9.7,XPDA,"VOL",XPDV))
IF 'XPDV
QUIT
SET XPDV0=^(XPDV,0)
IF $PIECE(XPDV0,U)'=XPDY
Begin DoDot:2
+42 ;if completed time,write message and quit
+43 IF $PIECE(XPDV0,U,2)
DO BMES^XPDUTL(" Job on VOLUME SET "_$PIECE(XPDV0,U)_" Completed.")
QUIT
+44 ;if job had no start time, write message and quit
+45 IF '$PIECE(XPDV0,U,3)
Begin DoDot:3
+46 DO BMES^XPDUTL(" Waiting for job on VOLUME SET "_$PIECE(XPDV0,U)_" to start.")
+47 ;hang 1 minute, try 5 times
+48 FOR %=1:1:5
HANG 60
SET XPDV0=^XPD(9.7,XPDA,"VOL",XPDV,0)
IF $PIECE(XPDV0,U,3)
QUIT
End DoDot:3
IF '$PIECE(XPDV0,U,3)
DO VOLERR($PIECE(XPDV0,U),1)
QUIT
+49 DO BMES^XPDUTL(" Waiting for job on VOLUME SET "_$PIECE(XPDV0,U)_" to complete.")
+50 SET XPD=0
SET XPDX=$GET(^XPD(9.7,XPDA,"VOL",XPDV,1))
+51 ;check the last update node
+52 FOR
SET Y=$PIECE(^XPD(9.7,XPDA,"VOL",XPDV,0),U,2)
SET X=$GET(^(1))
SET XPD=XPD+1
IF XPD>360!Y
QUIT
IF X'=XPDX
SET XPD=0
SET XPDX=X
HANG 10
+53 ;quit if we have a complete time
+54 IF Y
DO BMES^XPDUTL(" Job on VOLUME SET "_$PIECE(XPDV0,U)_" Completed.")
QUIT
+55 DO VOLERR($PIECE(XPDV0,U),0)
End DoDot:2
End DoDot:1
IF $DATA(XPDABORT)
QUIT
+56 ;ZTREQ tells taskman to delete task
+57 IF $GET(ZTSK)
SET ZTREQ="@"
Begin DoDot:1
+58 ;remove task # from Install File
+59 NEW XPD
SET XPD(9.7,XPDA_",",5)="@"
+60 DO FILE^DIE("","XPD")
End DoDot:1
+61 ;quit if install was aborted
+62 IF $DATA(XPDABORT)
DO EXIT^XPDID("Install Aborted!!")
DO ^%ZISC
QUIT
+63 ;put option back in order
+64 IF $PIECE(XPDSET,U,2)]""
DO ON^XQOO1($PIECE(XPDSET,U,2))
KILL ^XTMP("XQOO",$PIECE(XPDSET,U,2))
+65 ;check if menu rebuild is wanted (only if option has been added)
+66 SET IEN=""
+67 SET IEN=$ORDER(^XPD(9.7,XPDA,"QUES","B","XPO1",IEN))
+68 IF IEN
Begin DoDot:1
+69 IF ^XPD(9.7,XPDA,"QUES",IEN,1)
Begin DoDot:2
+70 DO KIDS^XQ81
+71 ;check if need to queue menu rebuild on other CPUs
+72 IF $ORDER(^XPD(9.7,XPDA,"VOL",0))
Begin DoDot:3
+73 NEW XPDU,XPDY,XPDV,XPDV0,ZTUCI,ZTCPU
+74 XECUTE ^%ZOSF("UCI")
SET XPDU=$PIECE(Y,",")
SET XPDY=$PIECE(Y,",",2)
SET XPDV=0
+75 ;loop thru VOLUMES SET and don't do current volume set
+76 FOR
SET XPDV=$ORDER(^XPD(9.7,XPDA,"VOL",XPDV))
IF 'XPDV
QUIT
SET XPDV0=$PIECE(^(XPDV,0),U)
IF XPDV0'=XPDY
Begin DoDot:4
+77 SET ZTUCI=XPDU
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="Install Menu Rebuild"
SET ZTCPU=XPDV0
SET ZTRTN="KIDS^XQ81"
DO ^%ZTLOAD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+78 ;
+79 ;clean up globals
+80 SET Y=0
+81 FOR
SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))
IF 'Y
QUIT
SET XPDI=$ORDER(^(Y,0))
IF XPDI
Begin DoDot:1
+82 NEW Y,XPD
+83 ;kill transport global
+84 KILL ^XTMP("XPDI",XPDI)
+85 ;update the status field
+86 SET XPD(9.7,XPDI_",",.02)=3
+87 DO FILE^DIE("","XPD")
End DoDot:1
+88 DO EXIT^XPDID("Install Completed")
DO ^%ZISC
+89 QUIT
+90 ;
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")
+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, write message, reset terminal
+3 DO ^%ZTER
DO BMES^XPDUTL(XPDERROR)
DO EXIT^XPDID()
+4 SET XQA(DUZ)=""
SET XQAMSG="Install "_$EXTRACT($PIECE($GET(^XPD(9.7,+$GET(XPDA),0)),"^"),1,30)_" has encountered an Error."
+5 DO SETUP^XQALERT
GOTO UNWIND^%ZTER
