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