- 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 Feb 19, 2025@00:11:38 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 ;