| 1 | TMGXUP ;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 | ;"===================================================================================
|
|---|
| 10 | XUP()
|
|---|
| 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 |
|
|---|
| 50 | XLp2
|
|---|
| 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 |
|
|---|
| 68 | XLp3
|
|---|
| 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
|
|---|
| 113 | ZIS2a
|
|---|
| 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 |
|
|---|
| 122 | ZIS2
|
|---|
| 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 |
|
|---|
| 143 | XUPDone
|
|---|
| 144 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"^XUP")
|
|---|
| 145 | quit result
|
|---|
| 146 |
|
|---|
| 147 | XUPAbort
|
|---|
| 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 |
|
|---|
| 155 | KILL1
|
|---|
| 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 | ;"===================================================================================
|
|---|
