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

XOBVSYSI.m

Go to the documentation of this file. 
  1. XOBVSYSI ;; ld,mjk/alb - VistaLink Interface Implementation ; [7/20/06 10:51am]
  1.  ;;1.5;VistALink;**1**;Sep 09, 2005;Build 3
  1.  ;;Foundations Toolbox Release v1.5 [Build: 1.5.1.001]
  1.  ;
  1. CALLBACK(CB) ; -- init callbacks implementation
  1.  SET CB("STARTELEMENT")="ELEST^XOBVSYSI"
  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.  . SET XOBDATA("MODE")=$GET(ATR("mode"),"single call")
  1.  ;
  1.  IF ELE="Request" DO  QUIT
  1.  . SET XOBDATA("XOB SYSTEM","TYPE")=$GET(ATR("type"),"unknown")
  1.  . SET XOBDATA("XOB SYSTEM","ENV")=$$LOW^XLFSTR($GET(ATR("environment"),"j2se"))
  1.  ;
  1.  QUIT
  1.  ;
  1. READER(XOBUF,XOBDATA) ; -- proprietary format reader implementation
  1.  QUIT
  1.  ;
  1. REQHDLR(XOBDATA) ; -- request handler implementation
  1.  NEW TYPE
  1.  SET TYPE=$GET(XOBDATA("XOB SYSTEM","TYPE"),"unknown")
  1.  ;
  1.  ; -- initialize socket partition request
  1.  IF TYPE="initializeSocket" DO INIT(.TYPE) GOTO REQHDLRQ
  1.  ;
  1.  ; -- set stop flag to close socket request
  1.  IF TYPE="closeSocket" DO CLOSE(.TYPE) GOTO REQHDLRQ
  1.  ;
  1.  ; -- cleanup partition request 
  1.  IF TYPE="cleanupPartition" DO CLEANUP(.TYPE) GOTO REQHDLRQ
  1.  ;
  1.  ; --  heartbeat request 
  1.  IF TYPE="heartbeat" DO HB(.TYPE) GOTO REQHDLRQ
  1.  ;
  1.  ; --  system info request 
  1.  IF TYPE="systemInfo" DO SYSINFO(.TYPE) GOTO REQHDLRQ
  1.  ;
  1.  ; -- failue if processing get here
  1.  DO RESPONSE(.TYPE,"failure")
  1.  ;
  1. REQHDLRQ ;
  1.  QUIT
  1.  ;
  1. ENV ; -- set env variable
  1.  SET XOBSYS("ENV")=$GET(XOBDATA("XOB SYSTEM","ENV"))
  1.  QUIT
  1.  ;
  1. PSTANUM ; -- set primary station number
  1.  SET XOBSYS("PRIMARY STATION#")=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1.  QUIT
  1.  ;
  1. INIT(TYPE) ; -- handle initialize request
  1.  KILL XOBSYS
  1.  DO ENV
  1.  DO PSTANUM
  1.  ;
  1.  IF "^j2se^j2ee^.net^"[(U_XOBSYS("ENV")_U) DO
  1.  . DO RESPONSE(.TYPE,"success",$$RATE()_$$JOB()_$$RASTO())
  1.  ELSE  DO
  1.  . DO RESPONSE(.TYPE,"failure")
  1.  QUIT
  1.  ;
  1. CLOSE(TYPE) ; -- handle close socket request
  1.  SET XOBSTOP=1
  1.  DO RESPONSE(.TYPE,"success")
  1.  QUIT
  1.  ;
  1. CLEANUP(TYPE) ; -- handle cleanup partition request
  1.  ; -- unlock any pending locks
  1.  LOCK
  1.  ;
  1.  ; -- clean ^TMP, ^UTILITY, ^XUTL
  1.  DO XUTL^XUSCLEAN
  1.  ;
  1.  ; -- restore DUZ to connector user
  1.  KILL DUZ
  1.  MERGE DUZ=XOBSYS("DUZ")
  1.  ;
  1.  ; -- clean symbol table
  1.  DO KILL^XOBVLL
  1.  ;
  1.  DO RESPONSE(.TYPE,"success")
  1.  QUIT
  1.  ;
  1. DUZSV(DUZ) ; -- save initial DUZ info for session
  1.  IF $GET(XOBSYS("ENV"))="j2ee" DO
  1.  . KILL XOBSYS("DUZ")
  1.  . MERGE XOBSYS("DUZ")=DUZ
  1.  QUIT
  1.  ;
  1. HB(TYPE) ; -- handle heartbeat request
  1.  DO ENV
  1.  DO RESPONSE(.TYPE,"success",$$RATE())
  1.  QUIT
  1.  ;
  1. RATE() ; -- set up rate attribute for response
  1.  NEW XOBRATE
  1.  ; -- get J2EE timeout value for app serv environment
  1.  IF $GET(XOBSYS("ENV"))="j2ee" DO
  1.  . SET XOBRATE=$$GETASTO^XOBVLIB()
  1.  ELSE  DO
  1.  . SET XOBRATE=$$GETRATE^XOBVLIB()
  1.  QUIT " rate="""_XOBRATE_""""
  1.  ;
  1. JOB() ; -- set up $JOB attribute for response
  1.  QUIT " mJob="""_$JOB_""""
  1.  ;
  1. RASTO() ; -- set up ReAuthenticated Session TimeOut
  1.  QUIT " reAuthSessionTimeout="""_$$GETRASTO^XOBVLIB()_""""
  1.  ;
  1. RESPONSE(TYPE,STATUS,ATTRS) ; -- build xml response
  1.  ; -- initialize
  1.  DO PRE^XOBVSKT
  1.  DO WRITE^XOBVSKT($$VLHDR^XOBVLIB(4))
  1.  DO WRITE^XOBVSKT("<Response type="""_$GET(TYPE)_""" status="""_$GET(STATUS)_""""_$GET(ATTRS,"")_" />")
  1.  DO WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
  1.  ; -- send eot and flush buffer
  1.  DO POST^XOBVSKT
  1.  QUIT
  1.  ;
  1. SYSINFO(TYPE) ; -- build system info response
  1.  NEW XOBINFO,XOBELE,XOBDEFLT,XOBINTRO,XOBI
  1.  ;
  1.  ; -- set up default value
  1.  SET XOBDEFLT="unknown"
  1.  ;
  1.  ; -- get system info array
  1.  DO GETSINFO(.XOBINFO)
  1.  ;
  1.  ; -- build <SystemInfo> element
  1.  SET XOBELE="<SystemInfo"
  1.  SET XOBELE=XOBELE_" vistalinkVersion="""_$GET(XOBINFO("version"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" vistalinkBuild="""_$GET(XOBINFO("build"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" appServerTimeout="""_$GET(XOBINFO("appServerTimeout"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" reAuthSessionTimeout="""_$GET(XOBINFO("reAuthSessionTimeout"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" uci="""_$GET(XOBINFO("uci"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" vol="""_$GET(XOBINFO("vol"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" boxVolume="""_$GET(XOBINFO("boxVolume"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" mVersion="""_$GET(XOBINFO("mVersion"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" operatingSystem="""_$GET(XOBINFO("operatingSystem"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" domainName="""_$GET(XOBINFO("domainName"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" vistaProduction="""_$GET(XOBINFO("vistaProduction"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" defaultInstitution="""_$GET(XOBINFO("defaultInstitution"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" cpName="""_$GET(XOBINFO("cpName"),XOBDEFLT)_""""
  1.  SET XOBELE=XOBELE_" />"
  1.  ;
  1.  SET XOBINTRO=$GET(XOBINFO("introductoryText"))
  1.  ;
  1.  ; -- build and send complate message
  1.  DO PRE^XOBVSKT
  1.  DO WRITE^XOBVSKT($$VLHDR^XOBVLIB(4))
  1.  DO WRITE^XOBVSKT("<Response type="""_$GET(TYPE)_""" status=""success"" >")
  1.  DO WRITE^XOBVSKT(XOBELE)
  1.  FOR XOBI=1:1  QUIT:'$DATA(XOBINFO("introductoryText",XOBI))  DO
  1.  . DO WRITE^XOBVSKT(XOBINFO("introductoryText",XOBI))
  1.  DO WRITE^XOBVSKT("</Response>")
  1.  DO WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
  1.  DO POST^XOBVSKT
  1.  ;
  1.  QUIT
  1.  ;
  1. GETSINFO(XOBINFO) ; -- gather system info into array
  1.  NEW X,Y
  1.  ;
  1.  ; -- get version
  1.  SET XOBINFO("version")=$PIECE($TEXT(XOBVSYSI+1),";",3)
  1.  ;
  1.  ; -- get build number
  1.  SET XOBINFO("build")=$PIECE($PIECE($TEXT(XOBVSYSI+2),"Build: ",2),"]")
  1.  ;
  1.  ; -- get application server connection timeout
  1.  SET XOBINFO("appServerTimeout")=$$GETASTO^XOBVLIB()
  1.  ;
  1.  ; -- get reauthentication session timeout
  1.  SET XOBINFO("reAuthSessionTimeout")=$$GETRASTO^XOBVLIB()
  1.  ;
  1.  ; -- get basic M environment information
  1.  SET Y=""
  1.  DO GETENV^%ZOSV
  1.  ;
  1.  ; -- get uci
  1.  SET XOBINFO("uci")=$PIECE(Y,U,1)
  1.  ;
  1.  ; -- get vol
  1.  SET XOBINFO("vol")=$PIECE(Y,U,2)
  1.  ;
  1.  ; -- get box volume
  1.  SET XOBINFO("boxVolume")=$PIECE(Y,U,4)
  1.  ;
  1.  ; -- get M version (full name)
  1.  SET XOBINFO("mVersion")=$$SYMENC^MXMLUTL($$VERSION^%ZOSV(1))
  1.  ;
  1.  ; -- get operating system
  1.  SET XOBINFO("operatingSystem")=$$SYMENC^MXMLUTL($$SYSOS^XOBVLIB(XOBOS))
  1.  ;
  1.  ; -- get domain name
  1.  SET XOBINFO("domainName")=$$SYMENC^MXMLUTL($$KSP^XUPARAM("WHERE"))
  1.  ;
  1.  ; -- production or test
  1.  SET XOBINFO("vistaProduction")=$S($$PROD^XUPROD(0):"true",1:"false")
  1.  ;
  1.  ; -- default institution
  1.  SET XOBINFO("defaultInstitution")=$$SYMENC^MXMLUTL($$STA^XUAF4($$KSP^XUPARAM("INST"))_"/"_$$NAME^XUAF4($$KSP^XUPARAM("INST")))
  1.  ;
  1.  ; -- get intro text
  1.  D GETINTRO^XOBSCAV2("XOBINFO(""introductoryText"")",1)
  1.  ;
  1.  ; -- get c/p username
  1.  SET XOBINFO("cpName")=$$NAME^XUSER(DUZ)
  1.  ;
  1.  QUIT
  1.  ;
  1. RPC(XOBY) ;
  1.  NEW XOBX,XOBLINE,XOBARR
  1.  D GETSINFO(.XOBARR)
  1.  SET XOBLINE=0
  1.  S XOBX="" F  S XOBX=$O(XOBARR(XOBX)) Q:XOBX']""  D
  1.  . SET XOBLINE=XOBLINE+1
  1.  . SET XOBY(XOBLINE)=XOBX_"~"_XOBARR(XOBX)
  1.  QUIT
  1.  ;