source: cprs/branches/tmg-cprs/m_files/TMGXUP.m@ 1099

Last change on this file since 1099 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 6.6 KB
Line 
1TMGXUP ;TMG/kst/Altered version of XUP ;03/25/06
2 ;;1.0;TMG-LIB;**1**;12/23/05
3
4 ;"Customized version of Vista XUP module
5 ;"===================================================================================
6 ;"The following section started as essentially a copy of ^XUP code, to allow me to
7 ;" use just part of it to set up the programmers environment
8 ;"...As time has gone on, though, I have added more tweaks...
9 ;"===================================================================================
10XUP()
11 ;"Purpose: Because this configurator will be working with the database,
12 ;" it must have a proper environment setup. And user must have
13 ;" proper access. So this function will set up everything needed.
14 ;"Output: Environmental variables are setup.
15 ;"Result: 1=OK to continue. 0=Abort
16
17 ;"Consider:
18 ;"DT^DICRW: Required Variables
19 ;"Sets up the required variables of VA FileMan. There are no input variables;
20 ;"simply call the routine at this entry point.
21 ;"NOTE: This entry point kills the variables DIC and DIK.
22
23 new result set result=cOKToCont
24 if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"^XUP")
25 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Inside XML Scripter, setting up programmer environment.")
26
27 ;"MSC/SGS: added to allow processes to be interrupted
28 set $ZINT="X ^%ZOSF(""INTERRUPT"")"
29 Set U="^"
30
31 goto XLp2 ;"bypass next section
32 ;"--------------------------------------------------------------------
33 ;"Set up user info.
34 set DIC=200 ;"file 200 = ^VA(200,*)
35 set DIC(0)="MZ" ;" "AEQMZ"
36 set X="TMGXINST,BOT"
37 ;"set X="Dodd,Norman" ;"Note: came pre-installed in OpenVistA
38 do ^DIC
39 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Y=",Y)
40 if Y<0 set result=cAbort goto XUPDone
41 kill DIC
42 set DUZ=+Y
43 set DUZ(0)=$piece(Y(0),U,4)
44 set DTIME=600
45 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"DUZ(0)=",DUZ(0))
46 if DUZ(0)'="@" do goto XUPAbort
47 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to setup a user with programmer's access privilages.")
48 ;"--------------------------------------------------------------------
49
50XLp2
51 new User,UName
52 set User=$get(^VA(200,1,0))
53 if User="" do goto XUPAbort
54 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to access user #1 (expected to be IRM,MGR). The installer should be modified to log in as another user. Sorry. Quiting.")
55 set UName=$piece(User,"^",1)
56 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Logging in as user: ",UName)
57 set LoggedUsr=UName ;" setup global-scope variable that script can access
58 set UName=$piece(User,"^",1)
59 kill DIC
60 set DUZ=1
61 set DUZ(0)=$piece(User,"^",4)
62 set DTIME=600
63 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"DUZ(0)=",DUZ(0))
64 if DUZ(0)'="@" do
65 . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Temporarily giving install-user '@' privilages.")
66 . set DUZ(0)="@"
67
68XLp3
69 do HOME^%ZIS ;"Reset Home Device IO Variables
70
71 new $ESTACK,$ETRAP
72 set $ECODE="",$ETRAP="" ;"Clear and error trap
73 xecute ^%ZOSF("TYPE-AHEAD")
74
75 kill ^UTILITY($J)
76 kill ^XUTL("XQ",$J)
77 do KILL1 ;"do KILL1^XUSCLEAN
78
79 set DT=$$DT^XLFDT ;"DT is a system=wide date variable
80
81 set XUEOFF=^%ZOSF("EOFF")
82 set XUEON=^%ZOSF("EON")
83 set U="^"
84 set XUTT=0
85 set XUIOP=""
86 do GETENV^%ZOSV
87 set XUENV=Y
88 set XUVOL=$piece(Y,U,2)
89 set XUCI=$piece(Y,U,1)
90
91 ;"Get user info
92 if $get(DUZ)>0 do
93 . kill XUDUZ
94 . if $data(DUZ(0)) set XUDUZ=DUZ(0)
95 . do DUZ^XUP(DUZ)
96 . if $data(XUDUZ) set DUZ(0)=XUDUZ
97 . kill XUDUZ
98
99 if ($get(DUZ)'>0)!(('$data(DUZ(0)))) do ASKDUZ^XUP goto:Y'>0 XUPAbort
100
101 if '$data(XQUSER) set XQUSER=$S($data(^VA(200,DUZ,20)):$piece(^(20),"^",2),1:"Unk")
102 set DTIME=600 ;Set a temp DTIME
103
104 ;"Getting Terminal Type
105 ;"if XUTT do ENQ^XUS1 G:$D(XUIOP(1)) ZIS2 S Y=0 D TT^XUS3 I Y>0 S XUIOP(1)=$P(XUIOP,";",2) G ZIS2
106 if 'XUTT goto ZIS2a
107 do ENQ^XUS1
108 if $data(XUIOP(1)) goto ZIS2
109 set Y=0
110 do TT^XUS3
111 if Y>0 set XUIOP(1)=$P(XUIOP,";",2)
112 goto ZIS2
113ZIS2a
114 set X="`"_+$G(^VA(200,DUZ,1.2))
115 set DIC="^%ZIS(2,"
116 set DIC(0)="MQ"_$S(X]"`0":"",1:"AE")
117 do ^DIC
118 if Y'>0 goto XUPAbort
119 set XUIOP(1)=$P(Y,U,2)
120 if DIC(0)["A",$get(^VA(200,+DUZ,0))]"" set $piece(^VA(200,DUZ,1.2),U,1)=+Y
121
122ZIS2
123 set %ZIS="L" ;"will cause IO("ZIO") to contain static physical port name
124 set IOP="HOME;"_XUIOP(1)
125 do ^%ZIS ;"Set up device handler
126 if POP goto XUPAbort ;"POP has error from ^%ZIS
127 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Using terminal type: ",IOST)
128 set DTIME=$$DTIME^XUP(DUZ,IOS)
129 set DUZ("BUF")=1
130 set XUDEV=IOS
131
132 ;"Save info, Set last sign-on
133 do SAVE^XUS1
134 set $piece(^VA(200,DUZ,1.1),"^",1)=$$NOW^XLFDT ;DT
135
136 ;"Setup error trap
137 if $$GET^XPAR("USR^SYS","XUS-XUP SET ERROR TRAP",1,"Q") set $ETRAP="D ERR^XUP"
138 ;do KILL1 ;"do KILL1^XUSCLEAN
139 set $piece(XQXFLG,U,3)="XUP"
140
141 ;"D ^XQ1 ;<----- one major change made to this code...
142
143XUPDone
144 if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"^XUP")
145 quit result
146
147XUPAbort
148 do KILL1 ;"do KILL1^XUSCLEAN
149 kill XQY,XQY0
150 if $$GET^XPAR("USR^SYS","XUS-XUP VPE",1,"Q"),$data(^%ZVEMS) xecute ^%ZVEMS ;"Run VPE
151
152 set result=cAbort
153 goto XUPDone
154
155KILL1
156 ;"--------------------------------
157 ;"KILL1^XUSCLEAN is included and modified below.
158 ;"Purpose: To clean up ALL but kernel variables.
159 ;"-------------------------------
160 If $$BROKER^XWBLIB do
161 . set %2=$piece($text(VARLST^XWBLIB),";;",2)
162 . if %2]"" new @%2 ;"Protect Broker variables.
163
164 new KWAPI,XGWIN,XGDI,XGEVENT
165 new XQAEXIT,XQAUSER,XQX1,XQAKILL,XQAID
166
167 kill IO("C"),IO("Q")
168
169 ;"Note: kill (x) mean kill everything EXCEPT x
170 ;"I can't kill everthing because it will crash my script--so I'll just not do it.
171 ;"kill (DISYS,IO,IOBS,IOF,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,XRTL,%ZH0,XQVOL,XQY,XQY0,XQDIC,XQPSM,XQPT,XQAUDIT,XQXFLG,ZTSTOP,ZTQUEUED,ZTREQ,U,DUZ,DUZ,DTIME,DT)
172
173 quit
174
175 ;"===================================================================================
Note: See TracBrowser for help on using the repository browser.