TMGXUP ;TMG/kst/Altered version of XUP ;03/25/06 ;;1.0;TMG-LIB;**1**;12/23/05 ;"Customized version of Vista XUP module ;"=================================================================================== ;"The following section started as essentially a copy of ^XUP code, to allow me to ;" use just part of it to set up the programmers environment ;"...As time has gone on, though, I have added more tweaks... ;"=================================================================================== XUP() ;"Purpose: Because this configurator will be working with the database, ;" it must have a proper environment setup. And user must have ;" proper access. So this function will set up everything needed. ;"Output: Environmental variables are setup. ;"Result: 1=OK to continue. 0=Abort ;"Consider: ;"DT^DICRW: Required Variables ;"Sets up the required variables of VA FileMan. There are no input variables; ;"simply call the routine at this entry point. ;"NOTE: This entry point kills the variables DIC and DIK. new result set result=cOKToCont if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"^XUP") if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Inside XML Scripter, setting up programmer environment.") ;"MSC/SGS: added to allow processes to be interrupted set $ZINT="X ^%ZOSF(""INTERRUPT"")" Set U="^" goto XLp2 ;"bypass next section ;"-------------------------------------------------------------------- ;"Set up user info. set DIC=200 ;"file 200 = ^VA(200,*) set DIC(0)="MZ" ;" "AEQMZ" set X="TMGXINST,BOT" ;"set X="Dodd,Norman" ;"Note: came pre-installed in OpenVistA do ^DIC if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Y=",Y) if Y<0 set result=cAbort goto XUPDone kill DIC set DUZ=+Y set DUZ(0)=$piece(Y(0),U,4) set DTIME=600 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"DUZ(0)=",DUZ(0)) if DUZ(0)'="@" do goto XUPAbort . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to setup a user with programmer's access privilages.") ;"-------------------------------------------------------------------- XLp2 new User,UName set User=$get(^VA(200,1,0)) if User="" do goto XUPAbort . 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.") set UName=$piece(User,"^",1) if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Logging in as user: ",UName) set LoggedUsr=UName ;" setup global-scope variable that script can access set UName=$piece(User,"^",1) kill DIC set DUZ=1 set DUZ(0)=$piece(User,"^",4) set DTIME=600 if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"DUZ(0)=",DUZ(0)) if DUZ(0)'="@" do . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Temporarily giving install-user '@' privilages.") . set DUZ(0)="@" XLp3 do HOME^%ZIS ;"Reset Home Device IO Variables new $ESTACK,$ETRAP set $ECODE="",$ETRAP="" ;"Clear and error trap xecute ^%ZOSF("TYPE-AHEAD") kill ^UTILITY($J) kill ^XUTL("XQ",$J) do KILL1 ;"do KILL1^XUSCLEAN set DT=$$DT^XLFDT ;"DT is a system=wide date variable set XUEOFF=^%ZOSF("EOFF") set XUEON=^%ZOSF("EON") set U="^" set XUTT=0 set XUIOP="" do GETENV^%ZOSV set XUENV=Y set XUVOL=$piece(Y,U,2) set XUCI=$piece(Y,U,1) ;"Get user info if $get(DUZ)>0 do . kill XUDUZ . if $data(DUZ(0)) set XUDUZ=DUZ(0) . do DUZ^XUP(DUZ) . if $data(XUDUZ) set DUZ(0)=XUDUZ . kill XUDUZ if ($get(DUZ)'>0)!(('$data(DUZ(0)))) do ASKDUZ^XUP goto:Y'>0 XUPAbort if '$data(XQUSER) set XQUSER=$S($data(^VA(200,DUZ,20)):$piece(^(20),"^",2),1:"Unk") set DTIME=600 ;Set a temp DTIME ;"Getting Terminal Type ;"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 if 'XUTT goto ZIS2a do ENQ^XUS1 if $data(XUIOP(1)) goto ZIS2 set Y=0 do TT^XUS3 if Y>0 set XUIOP(1)=$P(XUIOP,";",2) goto ZIS2 ZIS2a set X="`"_+$G(^VA(200,DUZ,1.2)) set DIC="^%ZIS(2," set DIC(0)="MQ"_$S(X]"`0":"",1:"AE") do ^DIC if Y'>0 goto XUPAbort set XUIOP(1)=$P(Y,U,2) if DIC(0)["A",$get(^VA(200,+DUZ,0))]"" set $piece(^VA(200,DUZ,1.2),U,1)=+Y ZIS2 set %ZIS="L" ;"will cause IO("ZIO") to contain static physical port name set IOP="HOME;"_XUIOP(1) do ^%ZIS ;"Set up device handler if POP goto XUPAbort ;"POP has error from ^%ZIS if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Using terminal type: ",IOST) set DTIME=$$DTIME^XUP(DUZ,IOS) set DUZ("BUF")=1 set XUDEV=IOS ;"Save info, Set last sign-on do SAVE^XUS1 set $piece(^VA(200,DUZ,1.1),"^",1)=$$NOW^XLFDT ;DT ;"Setup error trap if $$GET^XPAR("USR^SYS","XUS-XUP SET ERROR TRAP",1,"Q") set $ETRAP="D ERR^XUP" ;do KILL1 ;"do KILL1^XUSCLEAN set $piece(XQXFLG,U,3)="XUP" ;"D ^XQ1 ;<----- one major change made to this code... XUPDone if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"^XUP") quit result XUPAbort do KILL1 ;"do KILL1^XUSCLEAN kill XQY,XQY0 if $$GET^XPAR("USR^SYS","XUS-XUP VPE",1,"Q"),$data(^%ZVEMS) xecute ^%ZVEMS ;"Run VPE set result=cAbort goto XUPDone KILL1 ;"-------------------------------- ;"KILL1^XUSCLEAN is included and modified below. ;"Purpose: To clean up ALL but kernel variables. ;"------------------------------- If $$BROKER^XWBLIB do . set %2=$piece($text(VARLST^XWBLIB),";;",2) . if %2]"" new @%2 ;"Protect Broker variables. new KWAPI,XGWIN,XGDI,XGEVENT new XQAEXIT,XQAUSER,XQX1,XQAKILL,XQAID kill IO("C"),IO("Q") ;"Note: kill (x) mean kill everything EXCEPT x ;"I can't kill everthing because it will crash my script--so I'll just not do it. ;"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) quit ;"===================================================================================