XOBSRA1 ;mjk,esd/alb - VistALink Reauthentication Code ; 05/22/2003 07:00
;;1.6;VistALink Security;;May 08, 2009;Build 15
;Per VHA directive 2004-038, this routine should not be modified.
QUIT
;
KILL ; -- clean up partition's local symbol table ; called from INIT^XOBSRA
;SET AAXOB="before" DO ^%ZTER ; -- used to view symbol table 'before' state
;
IF XOBOS["OpenM" DO
. ; -- Stack: CACHEVMS^XOBVTCP
. ; SPAWN^XOBVLL
. ; NXTCALL^XOBVLL
. ; EN^XOBVRM
. ; EN^XOBVRPC()
. ; SETUPDUZ^XOBSRA()
. ;
. ; -- NEW non-XOB variables created in above stack
. NEW DIQUIET,DX,DY,RPC0,RPCNAME,RPCIEN,TAG,ROU,METHSIG,XRTN
. DO CACHE("XOB")
ELSE DO
. DO OTHER
;
;SET AAXOB="after" DO ^%ZTER ; -- used to view symbol table 'after' state
QUIT
;
CACHE(%NS) ; -- KILL all 'L'ocal 'VAR'iables except for a 'N'ame'S'pace (%NS) and Kernel for Cache systems
NEW %LVAR,%NSLEN
SET %NSLEN=$LENGTH(%NS)
SET %LVAR=%NS
FOR SET %LVAR=$ORDER(@%LVAR) QUIT:%LVAR=""!($EXTRACT(%LVAR,1,%NSLEN)'=%NS) NEW @%LVAR
; -- NEW Kernel variables and do the big KILL
DO KILL^XUSCLEAN
QUIT
;
OTHER ; -- explicit NEW'ing for other for non-Cache M implementations
; -- The following are NEW'ed as part KILL^XOBVLL call:
; XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK
; -- additional NEW'ing needed to preserve for CACHEVMS^XOBVTCP
NEW XOBEC
; -- additional NEW'ing needed to preserve for SPAWN^XOBVLL
NEW XOBLASTR
; -- additional NEW'ing needed to preserve for NXTCALL^XOBVLL
NEW XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBDATA,DIQUIET
; -- additional NEW'ing needed to preserve for EN^XOBVRM
NEW XOBOPT
; -- additional NEW'ing needed to preserve for EN^XOBVRPC()
NEW DX,DY,RPC0,RPCNAME,RPCIEN,TAG,ROU,METHSIG,XOBERR,XOBR,XOBSEC,XOBWRAP,XRTN,XOBRA,XOBVER,XOBPTYPE
; -- additional NEW'ing needed to preserve for SETUPDUZ^XOBSRA()
NEW XOBERR,XOBID,XOBTYPE
; -- call KILL^XOBVLL to finish NEW'ing and execute Kernel call to kill
DO KILL^XOBVLL
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBSRA1 2065 printed Dec 13, 2024@02:45:07 Page 2
XOBSRA1 ;mjk,esd/alb - VistALink Reauthentication Code ; 05/22/2003 07:00
+1 ;;1.6;VistALink Security;;May 08, 2009;Build 15
+2 ;Per VHA directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
KILL ; -- clean up partition's local symbol table ; called from INIT^XOBSRA
+1 ;SET AAXOB="before" DO ^%ZTER ; -- used to view symbol table 'before' state
+2 ;
+3 IF XOBOS["OpenM"
Begin DoDot:1
+4 ; -- Stack: CACHEVMS^XOBVTCP
+5 ; SPAWN^XOBVLL
+6 ; NXTCALL^XOBVLL
+7 ; EN^XOBVRM
+8 ; EN^XOBVRPC()
+9 ; SETUPDUZ^XOBSRA()
+10 ;
+11 ; -- NEW non-XOB variables created in above stack
+12 NEW DIQUIET,DX,DY,RPC0,RPCNAME,RPCIEN,TAG,ROU,METHSIG,XRTN
+13 DO CACHE("XOB")
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 DO OTHER
End DoDot:1
+16 ;
+17 ;SET AAXOB="after" DO ^%ZTER ; -- used to view symbol table 'after' state
+18 QUIT
+19 ;
CACHE(%NS) ; -- KILL all 'L'ocal 'VAR'iables except for a 'N'ame'S'pace (%NS) and Kernel for Cache systems
+1 NEW %LVAR,%NSLEN
+2 SET %NSLEN=$LENGTH(%NS)
+3 SET %LVAR=%NS
+4 FOR
SET %LVAR=$ORDER(@%LVAR)
if %LVAR=""!($EXTRACT(%LVAR,1,%NSLEN)'=%NS)
QUIT
NEW @%LVAR
+5 ; -- NEW Kernel variables and do the big KILL
+6 DO KILL^XUSCLEAN
+7 QUIT
+8 ;
OTHER ; -- explicit NEW'ing for other for non-Cache M implementations
+1 ; -- The following are NEW'ed as part KILL^XOBVLL call:
+2 ; XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK
+3 ; -- additional NEW'ing needed to preserve for CACHEVMS^XOBVTCP
+4 NEW XOBEC
+5 ; -- additional NEW'ing needed to preserve for SPAWN^XOBVLL
+6 NEW XOBLASTR
+7 ; -- additional NEW'ing needed to preserve for NXTCALL^XOBVLL
+8 NEW XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBDATA,DIQUIET
+9 ; -- additional NEW'ing needed to preserve for EN^XOBVRM
+10 NEW XOBOPT
+11 ; -- additional NEW'ing needed to preserve for EN^XOBVRPC()
+12 NEW DX,DY,RPC0,RPCNAME,RPCIEN,TAG,ROU,METHSIG,XOBERR,XOBR,XOBSEC,XOBWRAP,XRTN,XOBRA,XOBVER,XOBPTYPE
+13 ; -- additional NEW'ing needed to preserve for SETUPDUZ^XOBSRA()
+14 NEW XOBERR,XOBID,XOBTYPE
+15 ; -- call KILL^XOBVLL to finish NEW'ing and execute Kernel call to kill
+16 DO KILL^XOBVLL
+17 QUIT
+18 ;
