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

XOBVTCP.m

Go to the documentation of this file. 
  1. XOBVTCP ;; mjk/alb - VistALink TCP Utilities ; 07/27/2002  13:00
  1.  ;;1.5;VistALink;;Sep 09, 2005
  1.  ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
  1.  ;
  1.  QUIT
  1.  ;
  1.  ; -- called from protocol action at START^XOBUM1 
  1. START(XOBPORT,XOBCFG) ;
  1.  ; 
  1.  ; -- set up environment
  1.  NEW XOBOK
  1.  SET XOBOK=0
  1.  SET U="^" DO HOME^%ZIS
  1.  ;
  1.  ; -- if no port, set to default
  1.  IF $GET(XOBPORT)="" NEW XOBPORT SET XOBPORT=8000
  1.  ;
  1.  IF $$LOCK(XOBPORT) DO
  1.  . DO UNLOCK(XOBPORT)
  1.  . ; -- JOB command same for CacheNT and DSM
  1.  . JOB LISTENER^XOBVTCPL(XOBPORT,$GET(XOBCFG))::5
  1.  . SET XOBOK=$TEST
  1.  ELSE  DO
  1.  . SET XOBOK=0
  1.  QUIT XOBOK
  1.  ;
  1. UCX ; -- VMS TCPIP (UCX) multi-thread entry point
  1.  ; -- Called from VistALink .com files
  1.  ;
  1.  NEW XOBEC
  1.  DO ESET
  1.  SET (IO,IO(0))="SYS$NET"
  1.  ; **VMS specific code, need to share device**
  1.  OPEN IO:(TCPDEV:BLOCKSIZE=512):60 ELSE  SET ^TMP("XOB DSM CONNECT FAILURE",$HOROLOG)="" QUIT
  1.  USE IO
  1.  SET XOBEC=$$NEWOK^XOBVTCPL()
  1.  IF XOBEC DO LOGINERR^XOBVTCPL(XOBEC,IO)
  1.  IF 'XOBEC DO SPAWN^XOBVLL
  1.  QUIT
  1.  ;
  1. CACHEVMS ; -- VMS TCPIP (UCX) multi-thread entry point for Cache for VMS
  1.  ; -- Called from VistALink .com files
  1.  ;
  1.  NEW XOBEC
  1.  DO ESET
  1.  SET (IO,IO(0))="SYS$NET"
  1.  ;
  1.  ; **Cache'/VMS specific code**
  1.  OPEN IO::5
  1.  USE IO:(::"-M") ;Packet mode like DSM
  1.  ;
  1.  SET XOBEC=$$NEWOK^XOBVTCPL()
  1.  IF XOBEC DO LOGINERR^XOBVTCPL(XOBEC,IO)
  1.  IF 'XOBEC DO SPAWN^XOBVLL
  1.  QUIT
  1.  ;
  1. ESET ;Set inital error trap
  1.  SET U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
  1.  QUIT
  1.  ;
  1. STARTUP ; -- called by TaskMan startup option [Option: XOBV LISTENER STARTUP]
  1.  ;           and could be called by VMS .com procedure
  1.  ;
  1.  ; -- quit if not Cache OS
  1.  IF $$GETOS()'["OpenM" GOTO STARTUPQ
  1.  ; -- clear log of non-active listeners
  1.  DO CLEARLOG
  1.  ; -- get config for BOX-VOL and start it!
  1.  DO STARTCFG($$GETCFG())
  1. STARTUPQ ;
  1.  QUIT
  1.  ;
  1. CLEARLOG ; -- clear log of non-active listeners
  1.  NEW DIK,DA,Y,XOBI,XOB0,XOBPORT
  1.  ;
  1.  SET XOBI=0
  1.  FOR  SET XOBI=$ORDER(^XOB(18.04,XOBI)) QUIT:'XOBI  DO
  1.  . SET XOB0=$GET(^XOB(18.04,XOBI,0))
  1.  . SET XOBPORT=+$PIECE(XOB0,U,2)
  1.  . ; -- make sure listener is not running
  1.  . IF $$LOCK(XOBPORT) DO
  1.  . . SET DIK="^XOB(18.04,",DA=XOBI DO ^DIK
  1.  . . DO UNLOCK(XOBPORT)
  1.  ;
  1.  QUIT
  1.  ;
  1. STARTCFG(XOBCFG) ; -- start a configurations listeners
  1.  NEW CFG0,LSTR,LSTR0,XOBPORT,STARTUP,XOBOK
  1.  SET CFG0=$GET(^XOB(18.03,XOBCFG,0))
  1.  ;
  1.  ; -- quit if no configuration
  1.  IF CFG0="" GOTO CFGQ
  1.  ;
  1.  ; -- quit if not Cache...for now!
  1.  IF $$GETOS()'["OpenM" GOTO CFGQ
  1.  ;
  1.  SET LSTR=0
  1.  FOR  SET LSTR=$ORDER(^XOB(18.03,XOBCFG,"PORTS",LSTR)) QUIT:'LSTR  DO
  1.  . SET LSTR0=$GET(^XOB(18.03,XOBCFG,"PORTS",LSTR,0))
  1.  . SET XOBPORT=+$PIECE(LSTR0,U,1)
  1.  . SET STARTUP=$PIECE(LSTR0,U,2)
  1.  . ;
  1.  . ; -- if ok to start, port # defined and not already started
  1.  . IF XOBPORT,STARTUP,$$LOCK^XOBVTCP(XOBPORT) DO
  1.  . . DO UNLOCK(XOBPORT)
  1.  . . DO UPDATE^XOBVTCP(XOBPORT,1,XOBCFG)
  1.  . . SET XOBOK=$$START(XOBPORT,XOBCFG)
  1.  . . IF 'XOBOK DO UPDATE(XOBPORT,5,XOBCFG)
  1.  ;
  1. CFGQ ;
  1.  QUIT
  1.  ;
  1. LOCK(XOBPORT) ;-- Lock port
  1.  ;
  1.  ;  Used to prevent another process from attempting to start the Listener
  1.  ;  when it is already running.
  1.  ;
  1.  ;    Input:
  1.  ;      XOBPORT - Port #
  1.  ;
  1.  ;   Output:
  1.  ;      Function Value - Returns 1 if lock was successful, 0 otherwise
  1.  ;
  1.  QUIT $$ACTION("LOCK",XOBPORT)
  1.  ;
  1.  ;
  1. UNLOCK(XOBPORT) ;-- Unlock port
  1.  ;
  1.  ;  Used to release a lock created by $$LOCK.
  1.  ;
  1.  ;    Input:
  1.  ;      XOBPORT - Port #
  1.  ;
  1.  ;   Output:
  1.  ;      None
  1.  ;
  1.  NEW X
  1.  SET X=$$ACTION("UNLOCK",XOBPORT)
  1.  QUIT
  1.  ;
  1. ACTION(ACTION,XOBPORT) ; -- do lock action
  1.  NEW ENV,VOL,UCI,BOX
  1.  ;
  1.  SET XOBPORT=+$GET(XOBPORT)
  1.  ;
  1.  SET ENV=$$GETENV()
  1.  SET VOL=$PIECE(ENV,U,2)
  1.  SET UCI=$PIECE(ENV,U)
  1.  SET BOX=$PIECE(ENV,U,4)
  1.  ;
  1.  IF ACTION="LOCK",XOBPORT LOCK +^XOB(18.01,"VistALink Listener",VOL,UCI,BOX,XOBPORT):1 QUIT $TEST
  1.  IF ACTION="UNLOCK",XOBPORT LOCK -^XOB(18.01,"VistALink Listener",VOL,UCI,BOX,XOBPORT) QUIT 1
  1.  QUIT 0
  1.  ;
  1.  ;
  1. UPDATE(XOBPORT,XOBSTAT,XOBCFG) ; -- update VISTALINK LISTENER STARTUP LOG for listener
  1.  NEW DIC,Y,X,XOBBOX
  1.  SET XOBBOX=$$GETBOXN()
  1.  ;
  1.  ; -- set up lookup call
  1.  SET DIC="^XOB(18.04,"
  1.  SET DIC(0)="MLX"
  1.  SET DIC("DR")=".02////"_XOBPORT
  1.  SET DIC("S")="IF $P(^(0),U,2)="_XOBPORT
  1.  SET X=XOBBOX
  1.  ;
  1.  DO ^DIC
  1.  ; -- quit if lookup failed
  1.  IF +Y>0 DO UPDLOG(+Y,XOBPORT,XOBSTAT,$GET(XOBCFG))
  1.  QUIT
  1.  ;
  1. UPDLOG(XOBDA,XOBPORT,XOBSTAT,XOBCFG) ; -- do edit
  1.  NEW DA,DIE,DR,Y,X
  1.  ;
  1.  LOCK +^XOB(18.04,XOBDA,0)
  1.  ; -- set basic fields
  1.  SET DA=XOBDA
  1.  SET DIE="^XOB(18.04,"
  1.  SET DR=".02////"_XOBPORT_";.03////"_XOBSTAT_";.05////^S X=$$NOW^XLFDT"
  1.  ; -- set config if defined, otherwise delete
  1.  SET DR=DR_";.06////"_$SELECT($GET(XOBCFG)]"":XOBCFG,1:"@")
  1.  ; -- set user if defined, otherwise delete
  1.  SET DR=DR_";.04////"_$SELECT($GET(DUZ)]"":DUZ,1:"@")
  1.  ;
  1.  DO ^DIE
  1.  LOCK -^XOB(18.04,XOBDA,0)
  1.  ;
  1.  QUIT
  1.  ;
  1. GETENV() ; -- get environment variable
  1.  ;-- Get environment of current system i.e. Y=UCI^VOL/DIR^NODE^BOX LOOKUP
  1.  NEW Y
  1.  DO GETENV^%ZOSV
  1.  QUIT Y
  1.  ;
  1. GETOS() ;-- Get operating system
  1.  ;
  1.  ;  This function will determine which operating system is being used.
  1.  ;
  1.  ;   Input:
  1.  ;     None
  1.  ;
  1.  ;  Output:
  1.  ;     Operating system value i.e. OpenM-NT for OpenM.
  1.  ;
  1.  ;-- Get operating system
  1.  QUIT $PIECE($GET(^%ZOSF("OS")),"^")
  1.  ;
  1.  ;
  1. GETBOX() ; -- get box ien
  1.  ;
  1.  QUIT $$FIND1^DIC(14.7,"","BX",$PIECE($$GETENV(),U,4),"","","")
  1.  ;
  1. GETBOXN() ; -- get box name
  1.  ;
  1.  QUIT $PIECE($$GETENV(),U,4)
  1.  ;
  1. GETCFG() ; -- get config ien for current BOX-VOL pair
  1.  QUIT +$PIECE($GET(^XOB(18.01,1,"CONFIG",+$ORDER(^XOB(18.01,1,"CONFIG","B",+$$GETBOX(),"")),0)),U,2)
  1.  ;