- XOBVTCP ;; mjk/alb - VistALink TCP Utilities ; 07/27/2002 13:00
- ;;1.6;VistALink Security;**4**;May 08, 2009;Build 7
- ; ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- ; -- called from protocol action at START^XOBUM1
- START(XOBPORT,XOBCFG) ;
- ;
- ; -- set up environment
- N XOBOK
- S XOBOK=0
- S U="^" D HOME^%ZIS
- ;
- ; -- if no port, set to default
- I $G(XOBPORT)="" N XOBPORT S XOBPORT=8000
- ;
- I $$LOCK(XOBPORT) D
- . D UNLOCK(XOBPORT)
- . ; -- JOB command same for CacheNT and DSM
- . J LISTENER^XOBVTCPL(XOBPORT,$G(XOBCFG))::5
- . S XOBOK=$T
- E D
- . S XOBOK=0
- Q XOBOK
- ;
- UCX ; -- old VMS TCPIP (UCX) multi-thread entry point [for DSM]
- ; -- Called from VistALink .com files
- ;
- N XOBEC
- D ESET
- S (IO,IO(0))="SYS$NET"
- ; **VMS specific code, need to share device**
- O IO:(TCPDEV:BLOCKSIZE=512):60 E S ^TMP("XOB DSM CONNECT FAILURE",$H)="" Q
- U IO
- S XOBEC=$$NEWOK^XOBVTCPL()
- I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
- I 'XOBEC D SPAWN^XOBVLL
- Q
- ;
- CACHEVMS ; -- VMS TCPIP (UCX) multi-thread entry point for Cache for VMS
- ; -- Called from VistALink .com files
- ;
- N XOBEC
- D ESET
- S (IO,IO(0))="SYS$NET"
- ;
- O IO::5
- U IO:(::"-M") ;Packet mode like DSM
- ;
- S XOBEC=$$NEWOK^XOBVTCPL()
- I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
- I 'XOBEC D SPAWN^XOBVLL
- Q
- ;
- CACHELNX ; -- multi-thread entry point for Cache for Linux
- ; -- Called from XINETD service files
- ;
- N XOBEC
- D ESET
- S (IO,IO(0))=$P
- ;
- O IO::5
- U IO:(::"-M") ;Packet mode like DSM
- ;
- S XOBEC=$$NEWOK^XOBVTCPL()
- I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
- I 'XOBEC D SPAWN^XOBVLL
- Q
- ;
- GTMLNX ; -- Linux xinetd multi-thread entry point for GT.M
- ;
- N XOBEC,TMP,X,%
- D ESET
- ;
- ; **GTM/linux specific code**
- S (IO,IO(0))=$P,@("$ZT=""""")
- X "U IO:(nowrap:nodelimiter:IOERROR=""TRAP"")" ;Setup device
- S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)"""),X=""
- X "ZSHOW ""D"":TMP"
- F %=1:1 Q:'$D(TMP("D",%)) S X=TMP("D",%) Q:X["LOCAL"
- S IO("IP")=$P($P(X,"REMOTE=",2),"@"),IO("PORT")=+$P($P(X,"LOCAL=",2),"@",2)
- ;End GT.M code
- ;
- S XOBEC=$$NEWOK^XOBVTCPL()
- I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
- I 'XOBEC D COUNT^XUSCNT(1),SPAWN^XOBVLL,COUNT^XUSCNT(-1)
- Q
- ;
- ;Sample linux scripts
- ;xinetd script
- ;vvvvvvvvvvvvvvvvvvvvvvvvv
- ;service vistalink
- ;{
- ; socket_type = stream
- ; port = 18001
- ; type = UNLISTED
- ; user = vista
- ; wait = no
- ; disable = no
- ; server = /bin/bash
- ; server_args = /home/vista/dev/vistalink.sh
- ; passenv = REMOTE_HOST
- ;}
- ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- ;
- ;cat /home/vista/dev/vistalink.sh
- ;vvvvvvvvvvvvvvvvvvvvvvvvvvvv
- ;#!/bin/bash
- ;#RPC Broker
- ;cd /home/vista/dev
- ;. ./gtmprofile
- ;$gtm_dist/mumps -r GTMLNX^XOBVTCP
- ;exit 0
- ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- ;
- SERVICE ; -- service entry point (for VMS TCP/IP & LINUX XINETD utilities)
- ; TODO: possible single entry point for os service calls; needs work and has not been tested
- N XOBEC,XOBMOS,XOBSOS
- D ESET
- S XOBMOS=$$OS^XOBVSKT()
- I XOBMOS'["OpenM" S $EC=",U98,"
- S XOBSOS=$$SYSOS^XOBVLIB(XOBMOS)
- I XOBMOS'["VMS"!(XOBMOS'["UNIX") S $EC=",U97,"
- ;
- S (IO,IO(0))=$S(XOBSOS="VMS":"SYS$NET","UNIX":$P)
- ;
- O IO::5
- U IO:(::"-M") ;Packet mode like DSM
- ;
- S XOBEC=$$NEWOK^XOBVTCPL()
- I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
- I 'XOBEC D SPAWN^XOBVLL
- Q
- ;
- ESET ;Set initial error trap
- N $ET,$ES
- S U="^",$ET="D APPERROR^%ZTER(""VistALink Error - TCP Utilities"") H" ;Set up the error trap ;*4
- Q
- ;
- STARTUP ; -- called by TaskMan startup option [Option: XOBV LISTENER STARTUP]
- ; and could be called by VMS .com procedure
- ;
- ; -- quit if not Cache OS
- I $$GETOS()'["OpenM" G STARTUPQ
- ; -- clear log of non-active listeners
- D CLEARLOG
- ; -- get config for BOX-VOL and start it!
- D STARTCFG($$GETCFG())
- STARTUPQ ;
- Q
- ;
- CLEARLOG ; -- clear log of non-active listeners
- N DIK,DA,Y,XOBI,XOB0,XOBPORT
- ;
- S XOBI=0
- F S XOBI=$O(^XOB(18.04,XOBI)) Q:'XOBI D
- . S XOB0=$G(^XOB(18.04,XOBI,0))
- . S XOBPORT=+$P(XOB0,U,2)
- . ; -- make sure listener is not running
- . I $$LOCK(XOBPORT) D
- . . S DIK="^XOB(18.04,",DA=XOBI D ^DIK
- . . D UNLOCK(XOBPORT)
- ;
- Q
- ;
- STARTCFG(XOBCFG) ; -- start a configurations listeners
- N CFG0,LSTR,LSTR0,XOBPORT,STARTUP,XOBOK
- S CFG0=$G(^XOB(18.03,XOBCFG,0))
- ;
- ; -- quit if no configuration
- I CFG0="" G CFGQ
- ;
- ; -- quit if not Cache...for now!
- I $$GETOS()'["OpenM" G CFGQ
- ;
- S LSTR=0
- F S LSTR=$O(^XOB(18.03,XOBCFG,"PORTS",LSTR)) Q:'LSTR D
- . S LSTR0=$G(^XOB(18.03,XOBCFG,"PORTS",LSTR,0))
- . S XOBPORT=+$P(LSTR0,U,1)
- . S STARTUP=$P(LSTR0,U,2)
- . ;
- . ; -- if ok to start, port # defined and not already started
- . I XOBPORT,STARTUP,$$LOCK^XOBVTCP(XOBPORT) D
- . . D UNLOCK(XOBPORT)
- . . D UPDATE^XOBVTCP(XOBPORT,1,XOBCFG)
- . . S XOBOK=$$START(XOBPORT,XOBCFG)
- . . I 'XOBOK D UPDATE(XOBPORT,5,XOBCFG)
- ;
- CFGQ ;
- Q
- ;
- 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
- ;
- Q $$ACTION("LOCK",XOBPORT)
- ;
- ;
- UNLOCK(XOBPORT) ;-- Unlock port
- ;
- ; Used to release a lock created by $$LOCK.
- ;
- ; Input:
- ; XOBPORT - Port #
- ;
- ; Output:
- ; None
- ;
- N X
- S X=$$ACTION("UNLOCK",XOBPORT)
- Q
- ;
- ACTION(ACTION,XOBPORT) ; -- do lock action
- N ENV,VOL,UCI,BOX
- ;
- S XOBPORT=+$G(XOBPORT)
- ;
- S ENV=$$GETENV()
- S VOL=$P(ENV,U,2)
- S UCI=$P(ENV,U)
- S BOX=$P(ENV,U,4)
- ;
- I ACTION="LOCK",XOBPORT L +^XOB(18.01,"VistALink Listener",VOL,UCI,BOX,XOBPORT):1 Q $T
- I ACTION="UNLOCK",XOBPORT L -^XOB(18.01,"VistALink Listener",VOL,UCI,BOX,XOBPORT) Q 1
- Q 0
- ;
- ;
- UPDATE(XOBPORT,XOBSTAT,XOBCFG) ; -- update VISTALINK LISTENER STARTUP LOG for listener
- N DIC,Y,X,XOBBOX
- S XOBBOX=$$GETBOXN()
- ;
- ; -- set up lookup call
- S DIC="^XOB(18.04,"
- S DIC(0)="MLX"
- S DIC("DR")=".02////"_XOBPORT
- S DIC("S")="IF $P(^(0),U,2)="_XOBPORT
- S X=XOBBOX
- ;
- D ^DIC
- ; -- quit if lookup failed
- I +Y>0 D UPDLOG(+Y,XOBPORT,XOBSTAT,$G(XOBCFG))
- Q
- ;
- UPDLOG(XOBDA,XOBPORT,XOBSTAT,XOBCFG) ; -- do edit
- N DA,DIE,DR,Y,X
- ;
- L +^XOB(18.04,XOBDA,0)
- ; -- set basic fields
- S DA=XOBDA
- S DIE="^XOB(18.04,"
- S DR=".02////"_XOBPORT_";.03////"_XOBSTAT_";.05////^S X=$$NOW^XLFDT"
- ; -- set config if defined, otherwise delete
- S DR=DR_";.06////"_$S($G(XOBCFG)]"":XOBCFG,1:"@")
- ; -- set user if defined, otherwise delete
- S DR=DR_";.04////"_$S($G(DUZ)]"":DUZ,1:"@")
- ;
- D ^DIE
- L -^XOB(18.04,XOBDA,0)
- ;
- Q
- ;
- GETENV() ; -- get environment variable
- ;-- Get environment of current system i.e. Y=UCI^VOL/DIR^NODE^BOX LOOKUP
- N Y
- D GETENV^%ZOSV
- Q 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
- Q $P($G(^%ZOSF("OS")),"^")
- ;
- ;
- GETBOX() ; -- get box ien
- ;
- Q $$FIND1^DIC(14.7,"","BX",$P($$GETENV(),U,4),"","","")
- ;
- GETBOXN() ; -- get box name
- ;
- Q $P($$GETENV(),U,4)
- ;
- GETCFG() ; -- get config ien for current BOX-VOL pair
- Q +$P($G(^XOB(18.01,1,"CONFIG",+$O(^XOB(18.01,1,"CONFIG","B",+$$GETBOX(),"")),0)),U,2)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBVTCP 7479 printed Jan 18, 2025@03:46:04 Page 2
- XOBVTCP ;; mjk/alb - VistALink TCP Utilities ; 07/27/2002 13:00
- +1 ;;1.6;VistALink Security;**4**;May 08, 2009;Build 7
- +2 ; ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ; -- 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 ; -- old VMS TCPIP (UCX) multi-thread entry point [for DSM]
- +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 OPEN IO::5
- +8 ;Packet mode like DSM
- USE IO:(::"-M")
- +9 ;
- +10 SET XOBEC=$$NEWOK^XOBVTCPL()
- +11 IF XOBEC
- DO LOGINERR^XOBVTCPL(XOBEC,IO)
- +12 IF 'XOBEC
- DO SPAWN^XOBVLL
- +13 QUIT
- +14 ;
- CACHELNX ; -- multi-thread entry point for Cache for Linux
- +1 ; -- Called from XINETD service files
- +2 ;
- +3 NEW XOBEC
- +4 DO ESET
- +5 SET (IO,IO(0))=$PRINCIPAL
- +6 ;
- +7 OPEN IO::5
- +8 ;Packet mode like DSM
- USE IO:(::"-M")
- +9 ;
- +10 SET XOBEC=$$NEWOK^XOBVTCPL()
- +11 IF XOBEC
- DO LOGINERR^XOBVTCPL(XOBEC,IO)
- +12 IF 'XOBEC
- DO SPAWN^XOBVLL
- +13 QUIT
- +14 ;
- GTMLNX ; -- Linux xinetd multi-thread entry point for GT.M
- +1 ;
- +2 NEW XOBEC,TMP,X,%
- +3 DO ESET
- +4 ;
- +5 ; **GTM/linux specific code**
- +6 SET (IO,IO(0))=$PRINCIPAL
- SET @("$ZT=""""")
- +7 ;Setup device
- XECUTE "U IO:(nowrap:nodelimiter:IOERROR=""TRAP"")"
- +8 SET @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
- SET X=""
- +9 XECUTE "ZSHOW ""D"":TMP"
- +10 FOR %=1:1
- if '$DATA(TMP("D",%))
- QUIT
- SET X=TMP("D",%)
- if X["LOCAL"
- QUIT
- +11 SET IO("IP")=$PIECE($PIECE(X,"REMOTE=",2),"@")
- SET IO("PORT")=+$PIECE($PIECE(X,"LOCAL=",2),"@",2)
- +12 ;End GT.M code
- +13 ;
- +14 SET XOBEC=$$NEWOK^XOBVTCPL()
- +15 IF XOBEC
- DO LOGINERR^XOBVTCPL(XOBEC,IO)
- +16 IF 'XOBEC
- DO COUNT^XUSCNT(1)
- DO SPAWN^XOBVLL
- DO COUNT^XUSCNT(-1)
- +17 QUIT
- +18 ;
- +19 ;Sample linux scripts
- +20 ;xinetd script
- +21 ;vvvvvvvvvvvvvvvvvvvvvvvvv
- +22 ;service vistalink
- +23 ;{
- +24 ; socket_type = stream
- +25 ; port = 18001
- +26 ; type = UNLISTED
- +27 ; user = vista
- +28 ; wait = no
- +29 ; disable = no
- +30 ; server = /bin/bash
- +31 ; server_args = /home/vista/dev/vistalink.sh
- +32 ; passenv = REMOTE_HOST
- +33 ;}
- +34 ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- +35 ;
- +36 ;cat /home/vista/dev/vistalink.sh
- +37 ;vvvvvvvvvvvvvvvvvvvvvvvvvvvv
- +38 ;#!/bin/bash
- +39 ;#RPC Broker
- +40 ;cd /home/vista/dev
- +41 ;. ./gtmprofile
- +42 ;$gtm_dist/mumps -r GTMLNX^XOBVTCP
- +43 ;exit 0
- +44 ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- +45 ;
- SERVICE ; -- service entry point (for VMS TCP/IP & LINUX XINETD utilities)
- +1 ; TODO: possible single entry point for os service calls; needs work and has not been tested
- +2 NEW XOBEC,XOBMOS,XOBSOS
- +3 DO ESET
- +4 SET XOBMOS=$$OS^XOBVSKT()
- +5 IF XOBMOS'["OpenM"
- SET $ECODE=",U98,"
- +6 SET XOBSOS=$$SYSOS^XOBVLIB(XOBMOS)
- +7 IF XOBMOS'["VMS"!(XOBMOS'["UNIX")
- SET $ECODE=",U97,"
- +8 ;
- +9 SET (IO,IO(0))=$SELECT(XOBSOS="VMS":"SYS$NET","UNIX":$PRINCIPAL)
- +10 ;
- +11 OPEN IO::5
- +12 ;Packet mode like DSM
- USE IO:(::"-M")
- +13 ;
- +14 SET XOBEC=$$NEWOK^XOBVTCPL()
- +15 IF XOBEC
- DO LOGINERR^XOBVTCPL(XOBEC,IO)
- +16 IF 'XOBEC
- DO SPAWN^XOBVLL
- +17 QUIT
- +18 ;
- ESET ;Set initial error trap
- +1 NEW $ETRAP,$ESTACK
- +2 ;Set up the error trap ;*4
- SET U="^"
- SET $ETRAP="D APPERROR^%ZTER(""VistALink Error - TCP Utilities"") H"
- +3 QUIT
- +4 ;
- 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 ;