- 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
