source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDIJ.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1XPDIJ ;SFISC/RSD - Install Job ;06/01/2004 15:10
2 ;;8.0;KERNEL;**2,21,28,41,44,68,81,95,108,124,229,275**;Jul 10, 1995
3EN ;install all packages
4 ;XPDA=ien of first package
5 ;this is needed to restore XPDIJ1
6 D LNRF("XPDUTL") ;p275 SAVE calls RTNLOG^XPDUTL
7 D LNRF("XPDIJ1") ;See that XPDIJ1 is loaded befor it is called
8 N IEN,XPDI,XPD0,XPDSET,XPDABORT,XPDMENU,XPDQUIT,XPDVOL,X,Y,ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSK
9 M X=DUZ N DUZ M DUZ=X S DUZ(0)="@" ;See that install has full FM priv.
10 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XPDIJ"
11 E S X="ERR^XPDIJ",@^%ZOSF("TRAP")
12 Q:'$D(^XPD(9.7,+$G(XPDA),0)) S XPD0=^(0)
13 D INIT^XPDID
14 ;See if need to Inhibit Logons
15 I $$ANSWER^XPDIQ("XPI1") D INHIBIT^XPDIJ1("Y")
16 ;disable options & protocols for setname, XPDSET=1/0^setname^out of order msg.
17 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:"")
18 ;hang the number of seconds given in 0;10
19 I XPDSET D OFF^XQOO1($P(XPDSET,U,2)) I $P(XPD0,U,10) H ($P(XPD0,U,10)*60)
20 S Y=0
21 ;XPDABORT can be set in pre or post install to abort install
22 F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S %=$O(^(Y,0)) D:% Q:$D(XPDABORT)
23 .N XPD,XPDA,XPDNM,XPDV,XPDV0,XPDVOL,XPDX,XPDY,Y
24 .;Now do the Install
25 .S XPDA=%,XPDNM=$P($G(^XPD(9.7,XPDA,0)),U) D IN^XPDIJ1 Q:$D(XPDABORT)
26 ;
27 ;Now do Master Build Post INIT.
28 I '$D(XPDABORT),$D(XPDT("MASTER")) D
29 .S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
30 .D POST^XPDIJ1
31 ;ZTREQ tells taskman to delete task
32 I $G(ZTSK) S ZTREQ="@" D
33 .;remove task # from Install File
34 .N XPD S XPD(9.7,XPDA_",",5)="@"
35 .D FILE^DIE("","XPD")
36 ;quit if install was aborted
37 I $D(XPDABORT) D EXIT^XPDID("Install Aborted!!"),^%ZISC Q
38 ;put option back in order
39 I $P(XPDSET,U,2)]"" D ON^XQOO1($P(XPDSET,U,2)) K ^XTMP("XQOO",$P(XPDSET,U,2))
40 ;check if menu rebuild is wanted (only if option has been added)
41 I $$ANSWER^XPDIQ("XPO1") D
42 .D BMES^XPDUTL(" Call MENU rebuild"),KIDS^XQ81
43 .;check if need to queue menu rebuild on other CPUs
44 .D:$O(^XPD(9.7,XPDA,"VOL",0))
45 ..N XPDU,XPDY,XPDV,XPDV0,ZTUCI,ZTCPU
46 ..X ^%ZOSF("UCI") S XPDU=$P(Y,","),XPDY=$P(Y,",",2),XPDV=0
47 ..;loop thru VOLUMES SET and don't do current volume set
48 ..F S XPDV=$O(^XPD(9.7,XPDA,"VOL",XPDV)) Q:'XPDV S XPDV0=$P(^(XPDV,0),U) D:XPDV0'=XPDY
49 ...S ZTUCI=XPDU,ZTDTH=$H,ZTIO="",ZTDESC="Install Menu Rebuild",ZTCPU=XPDV0,ZTRTN="KIDS^XQ81" D ^%ZTLOAD
50 ;
51 ;See if need to reset inhibit logons
52 I $$ANSWER^XPDIQ("XPI1") D INHIBIT^XPDIJ1("N")
53 ;
54 ;clean up globals
55 S Y=0
56 F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S XPDI=$O(^(Y,0)) D:XPDI
57 . N %,Y,XPD,X
58 . ;See if need to delete Env,Pre,Post routines.
59 . S %=$O(^XTMP("XPDI",XPDI,"BLD",0)),XPD=$G(^XTMP("XPDI",XPDI,"BLD",%,"INID"))
60 . I '$$GET^XUPARAM("XPD NO_EPP_DELETE") F %=1:1:3 I $P(XPD,U,%)="y" D
61 . . S X=^XTMP("XPDI",XPDI,$P("PRE^INIT^INI",U,%)) S:X[U X=$P(X,U,2) X:X]"" ^%ZOSF("DEL")
62 . ;kill transport global
63 . K ^XTMP("XPDI",XPDI)
64 . ;update the status field
65 . S XPD(9.7,XPDI_",",.02)=3
66 . D FILE^DIE("","XPD")
67 D EXIT^XPDID("Install Completed"),^%ZISC
68 Q
69 ;
70SAVE(X) ;restore routine X
71 N %,DIE,XCM,XCN,XCS
72 S DIE="^XTMP(""XPDI"",XPDA,""RTN"",X,",XCN=0
73 X ^%ZOSF("SAVE") D RTNLOG^XPDUTL(X)
74 Q
75RTN(XPDA) ;restore all routines for package XPDA
76 ;^XPD("XPDI",XPDA,"RTN",routine name)=0-install, 1-delete, 2-skip^checksum
77 Q:$G(XPDA)=""
78 N X,XPDI,XPDJ S XPDI=""
79 F S XPDI=$O(^XTMP("XPDI",XPDA,"RTN",XPDI)) Q:XPDI="" S XPDJ=^(XPDI) D
80 .;if we are doing VT graphic display, set counter
81 .I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)
82 .I 'XPDJ D SAVE(XPDI) Q
83 .;set checksum to null, since routine wasn't loaded
84 .I $P(XPDJ,U,2) S $P(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"KRN",9.8,"NM",$P(XPDJ,U,2),0),U,4)=""
85 .I $P(XPDJ,U)=1 S X=XPDI X ^%ZOSF("DEL")
86 ;if graphic display, update full count
87 I $D(XPDIDVT) D UPDATE^XPDID(XPDIDCNT)
88 Q
89 ;
90VOLERR(V,F) ;volume set not updated,V=volume set, F=flag
91 N XQA,XQAMSG,XPDMES
92 S XPDMES(1)=" ",XPDMES(2)=" ** Job on VOLUME SET "_V_$S(F:" never started **",1:" has been idle for an hour.")
93 S XPDMES(3)=" ** "_V_" has NOT been updated! **"
94 S XQA(DUZ)="",XQAMSG="VOLUME SET "_V_" NOT updated for Install "_$E($P($G(^XPD(9.7,+$G(XPDA),0)),"^"),1,30)
95 D MES^XPDUTL(.XPDMES),SETUP^XQALERT
96 Q
97 ;come here on error, record error in Install file and cleanup var.
98ERR N XPDERROR,XQA,XQAMSG
99 S XPDERROR=$$EC^%ZOSV
100 ;record error, write message, reset terminal
101 D ^%ZTER,BMES^XPDUTL(XPDERROR),EXIT^XPDID()
102 S XQA(DUZ)="",XQAMSG="Install "_$E($P($G(^XPD(9.7,+$G(XPDA),0)),"^"),1,30)_" has encountered an Error."
103 D SETUP^XQALERT G UNWIND^%ZTER
104 ;
105LNRF(RN) ;Load needed routines first
106 I $D(^XTMP("XPDI",XPDA,"RTN",RN)) D
107 .N X
108 .D SAVE(RN)
109 .S XCN=$$RTNUP^XPDUTL(RN,2)
110 Q
Note: See TracBrowser for help on using the repository browser.