Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XOBVRPCI

XOBVRPCI.m

Go to the documentation of this file.
  1. XOBVRPCI ;; ld,mjk/alb - VistaLink Interface Implementation for RPCs; 07/27/2002 13:00
  1. ;;1.6;VistALink;;May 08, 2009;Build 15
  1. ;Per VHA directive 2004-038, this routine should not be modified.
  1. ;
  1. CALLBACK(CB) ; -- init callbacks implementation
  1. SET CB("STARTELEMENT")="ELEST^XOBVRPCI"
  1. SET CB("ENDELEMENT")="ELEND^XOBVRPCI"
  1. SET CB("CHARACTERS")="CHR^XOBVRPCI"
  1. QUIT
  1. ;
  1. READER(XOBUF,XOBDATA) ; -- proprietary format reader implementation
  1. DO START^XOBVRPCX(.XOBUF,.XOBDATA)
  1. QUIT
  1. ;
  1. REQHDLR(XOBDATA) ; -- request handler implementation
  1. DO EN^XOBVRPC(.XOBDATA)
  1. QUIT
  1. ;
  1. ; ------------------------------------------------------------------------
  1. ; RPC Server: Request Message XML SAX Parser Callbacks
  1. ; ------------------------------------------------------------------------
  1. ELEST(ELE,ATR) ; -- element start event handler
  1. IF ELE="VistaLink" DO QUIT
  1. . KILL XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
  1. . ; -- if called from VL v1.0 client then set up J2SE defaults
  1. . IF $GET(XOBDATA("VL VERSION"))="1.0" DO V1^XOBVRPCX
  1. ;
  1. IF ELE="RpcHandler" SET XOBDATA("XOB RPC","RPC HANDLER VERSION")=$GET(ATR("version")) QUIT
  1. ;
  1. IF ELE="Request" DO QUIT
  1. . SET XOBDATA("XOB RPC","RPC NAME")=$$ESC^XOBVRMX($GET(ATR("rpcName"),"##Unkown RPC##"))
  1. . NEW X
  1. . SET X=$$SETTO^XOBVLIB($GET(ATR("rpcClientTimeOut"),9000))
  1. . SET X=$$SETVER^XOBVRPCX($GET(ATR("rpcVersion"),0))
  1. ;
  1. IF ELE="RpcContext" SET XOBCTXT="" QUIT
  1. ;
  1. ; -------------------- Param Node Start Event Processing ---------------------------
  1. ;
  1. IF ELE="Param" DO QUIT
  1. . SET XOBPARAM=""
  1. . SET XOBPN="XOBP"_ATR("position")
  1. . SET XOBDATA("XOB RPC","PARAMS",ATR("position"))=XOBPN
  1. . SET XOBPTYPE=ATR("type")
  1. . SET:XOBPTYPE="array" @XOBPN=""
  1. ;
  1. IF ELE="Index" DO QUIT
  1. . KILL XOBPARAM
  1. . IF $DATA(ATR("name"))&$DATA(ATR("value")) DO
  1. . . SET @XOBPN@($$ESC^XOBVRMX(ATR("name")))=$$ESC^XOBVRMX(ATR("value"))
  1. ;
  1. IF ELE="Name" DO QUIT
  1. . SET XOBPARNM=""
  1. ;
  1. IF ELE="Value" DO QUIT
  1. . SET XOBPARVL=""
  1. ;
  1. ; -------------------- Security Node Start Event Processing ---------------------------
  1. ;
  1. IF ELE="Security" DO QUIT
  1. . SET XOBDATA("XOB RPC","SECURITY","TYPE")=$GET(ATR("type"))
  1. . SET XOBDATA("XOB RPC","SECURITY","DIV")=$GET(ATR("division"))
  1. . SET XOBDATA("XOB RPC","SECURITY","STATE")=$GET(ATR("state"),"notauthenticated")
  1. . KILL XOBSECFL
  1. . ;
  1. . ; -- use to make sure child nodes are from Security
  1. . ; parent when processing child node names
  1. . SET XOBSECFL=1
  1. ;
  1. IF ELE="AccessVerify",$GET(XOBSECFL),$EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av" DO QUIT
  1. . SET XOBAVCOD=""
  1. ;
  1. IF ELE="KernelCcowToken",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow" DO QUIT
  1. . SET XOBCCOWT=""
  1. ;
  1. IF ELE="Duz",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="duz" DO QUIT
  1. . SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
  1. ;
  1. IF ELE="Vpid",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="vpid" DO QUIT
  1. . SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
  1. ;
  1. IF ELE="ApplicationProxyName",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="appproxy" DO QUIT
  1. . SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
  1. ;
  1. ; ---------------------------------------------------------------------------
  1. ;
  1. QUIT
  1. ;
  1. ELEND(ELE) ; -- element end event handler
  1. IF ELE="VistaLink" DO QUIT
  1. . SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
  1. . KILL XOBPOS,XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
  1. ;
  1. IF ELE="RpcContext" DO QUIT
  1. . SET XOBDATA("XOB RPC","RPC CONTEXT")=$GET(XOBCTXT)
  1. ;
  1. IF ELE="Param" DO KILL XOBPARAM QUIT
  1. . IF XOBPTYPE="string" SET @XOBPN=$$ESC^XOBVRMX(XOBPARAM) QUIT
  1. . IF XOBPTYPE="ref" SET @XOBPN=$GET(@$$ESC^XOBVRMX(XOBPARAM)) QUIT
  1. ;
  1. IF ELE="Params" DO QUIT
  1. . NEW POS,PARAMS
  1. . SET PARAMS="",POS=0
  1. . FOR SET POS=$ORDER(XOBDATA("XOB RPC","PARAMS",POS)) QUIT:'POS SET PARAMS=PARAMS_",."_XOBDATA("XOB RPC","PARAMS",POS)
  1. . SET XOBDATA("XOB RPC","PARAMS")=PARAMS
  1. ;
  1. IF ELE="Index" DO QUIT
  1. . IF $DATA(XOBPARNM)&$DATA(XOBPARVL) DO
  1. . . KILL XOBPARAM
  1. . . IF $EXTRACT(XOBPARNM,1)=$CHAR(13) DO
  1. . . . SET @("@XOBPN@("_$$ESC^XOBVRMX($EXTRACT(XOBPARNM,2,$LENGTH(XOBPARNM)))_")=$$ESC^XOBVRMX(XOBPARVL)")
  1. . . ELSE DO
  1. . . . SET @XOBPN@($$ESC^XOBVRMX(XOBPARNM))=$$ESC^XOBVRMX(XOBPARVL)
  1. . . KILL XOBPARNM,XOBPARVL
  1. ;
  1. IF ELE="Name" DO QUIT
  1. . SET XOBPARNM("DONE")=1
  1. ;
  1. IF ELE="Value" DO QUIT
  1. . SET XOBPARVL("DONE")=1
  1. ;
  1. IF ELE="AccessVerify",$GET(XOBSECFL),$EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av" DO QUIT
  1. . SET XOBDATA("XOB RPC","SECURITY","TYPE","AVCODE")=XOBAVCOD KILL XOBAVCOD
  1. IF ELE="KernelCcowToken",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow" DO QUIT
  1. . SET XOBDATA("XOB RPC","SECURITY","TYPE","CCOW")=XOBCCOWT KILL XOBCCOWT
  1. IF ELE="Security" KILL XOBSECFL QUIT
  1. ;
  1. QUIT
  1. ;
  1. CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
  1. ; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
  1. ; callback gets hit multiple times even though the tag text value is just one piece of data.
  1. ; (Yes, this seems kludgie!)
  1. IF $DATA(XOBPARAM) SET XOBPARAM=XOBPARAM_TEXT
  1. IF $DATA(XOBPARNM),'+$GET(XOBPARNM("DONE")) SET XOBPARNM=XOBPARNM_TEXT QUIT
  1. IF $DATA(XOBPARVL),'+$GET(XOBPARVL("DONE")) SET XOBPARVL=XOBPARVL_TEXT QUIT
  1. IF $DATA(XOBCTXT) SET XOBCTXT=XOBCTXT_TEXT QUIT
  1. IF $DATA(XOBAVCOD) SET XOBAVCOD=XOBAVCOD_TEXT QUIT
  1. IF $DATA(XOBCCOWT) SET XOBCCOWT=XOBCCOWT_TEXT QUIT
  1. QUIT
  1. ;