XUSC1 ;SFISC/RWF - Interface to Server services. ;10/09/2002 16:53
;;8.0;KERNEL;**283**;Jul 10, 1995
;XUSC("STAT") is used to pass subroutine status around.
;The entry points EN, OPEN, DATA, CLOSE are supported ref.
;Calls a server service on a port depending on service.
;Service:port; "ECHO":10250, "CRC32":10255, "SHA1":10260, "DSIG":10265,1:23)
;Return 0 = OK, else -1^msg
EN(XUSC3,XUSC1,XUSC2) ;
;XUSC3 is the service we want.
;XUSC1 input data array
;XUSC2 return data array.
N %,R,XUSC ;XUSC holds data not passed as a parameter.
I "DSIG/ECHO/SHA1/DES/CRC32/CRL /"'[XUSC3 S R="-1^Bad service" G EXIT
D SAVDEV^%ZISUTL("XUSC-HOME"),IP
I $G(XUSC("IP"))="" S R="-1^Server not defined" G EXIT
S R=$$EN^XUSC1C(XUSC1,XUSC2,$G(XUSC3,"MPI"))
EXIT D USE^%ZISUTL("XUSC-HOME"),RMDEV^%ZISUTL("XUSC-HOME")
Q R
;
OPEN(XUSCITE) ;Open Connection, Setup
K XUSC N R
D IP(XUSCITE),SAVDEV^%ZISUTL("XUSC-HOME")
I $G(XUSC("IP"))="" Q "-1^Bad site"
D SETUP^XUSC1C S XUSC("HOME")=IO
N $ESTACK,$ETRAP S $ETRAP="D ERROR^XUSC1C"
D OPEN^XUSC1C I 'XUSC("STAT") D SAVDEV^%ZISUTL("XUSC-IP") U IO D HELO^XUSC1C
D USE^%ZISUTL("XUSC-HOME")
Q $S('XUSC("STAT"):0,1:XUSC("STAT"))
;
DATA(INPUT,OUTPUT,TYPE) ;Pass Data, Get Responce
S XUSC("STAT")=0 D USE^%ZISUTL("XUSC-IP")
D DATA^XUSC1C G:XUSC("STAT") ERR
D TURN^XUSC1C G:XUSC("STAT") ERR
D GET^XUSC1C G:XUSC("STAT") ERR
D USE^%ZISUTL("XUSC-HOME")
Q 0
;
CLOSE() ;Close connection
D USE^%ZISUTL("XUSC-IP"),QUIT^XUSC1C,USE^%ZISUTL("XUSC-HOME")
D RMDEV^%ZISUTL("XUSC-IP"),RMDEV^%ZISUTL("XUSC-HOME")
K XUSC Q 0
;
ERR ;Report an error
D TRACE^XUSC1C("ERROR "_XUSC("STAT"))
D QUIT^XUSC1C,USE^%ZISUTL("XUSC-HOME")
Q XUSC("STAT")
;
IP ;Lookup name pass back parameters in XUSC
N %,XUSCY,XUSCE
S %=$P(XUSC3," ") D
. I $L($T(@%)) D @% Q
. D ASK Q
Q
;
DSIG S XUSC("IP")=$P($G(^XTV(8989.3,1,"IP1")),"^",1)
S XUSC("SOCK")=10265
Q
CRL S XUSC("IP")=$P($G(^XTV(8989.3,1,"IP1")),"^",1)
S XUSC("SOCK")=10270
Q
SHA1 S XUSC("IP")=$P($G(^XTV(8989.3,1,"IP1")),"^",1)
S XUSC("SOCK")=10260
Q
ASK ; ASK USER FOR IP AND PORT
S XUSC("IP")="",XUSC("SOCK")=""
R !,"IP Address to use: ",%:DTIME Q:"^"[% S XUSC("IP")=%
R !," Port TO use: ",%:DTIME Q:"^"[% S XUSC("SOCK")=%
Q
;
NOOP() ;
S XUSC("STAT")=0 D USE^%ZISUTL("XUSC-IP")
S XUSC("OK")=$$POST^XUSC1C("NOOP")
D USE^%ZISUTL("XUSC-HOME")
Q XUSC("OK")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSC1 2434 printed Dec 13, 2024@02:12:09 Page 2
XUSC1 ;SFISC/RWF - Interface to Server services. ;10/09/2002 16:53
+1 ;;8.0;KERNEL;**283**;Jul 10, 1995
+2 ;XUSC("STAT") is used to pass subroutine status around.
+3 ;The entry points EN, OPEN, DATA, CLOSE are supported ref.
+4 ;Calls a server service on a port depending on service.
+5 ;Service:port; "ECHO":10250, "CRC32":10255, "SHA1":10260, "DSIG":10265,1:23)
+6 ;Return 0 = OK, else -1^msg
EN(XUSC3,XUSC1,XUSC2) ;
+1 ;XUSC3 is the service we want.
+2 ;XUSC1 input data array
+3 ;XUSC2 return data array.
+4 ;XUSC holds data not passed as a parameter.
NEW %,R,XUSC
+5 IF "DSIG/ECHO/SHA1/DES/CRC32/CRL /"'[XUSC3
SET R="-1^Bad service"
GOTO EXIT
+6 DO SAVDEV^%ZISUTL("XUSC-HOME")
DO IP
+7 IF $GET(XUSC("IP"))=""
SET R="-1^Server not defined"
GOTO EXIT
+8 SET R=$$EN^XUSC1C(XUSC1,XUSC2,$GET(XUSC3,"MPI"))
EXIT DO USE^%ZISUTL("XUSC-HOME")
DO RMDEV^%ZISUTL("XUSC-HOME")
+1 QUIT R
+2 ;
OPEN(XUSCITE) ;Open Connection, Setup
+1 KILL XUSC
NEW R
+2 DO IP(XUSCITE)
DO SAVDEV^%ZISUTL("XUSC-HOME")
+3 IF $GET(XUSC("IP"))=""
QUIT "-1^Bad site"
+4 DO SETUP^XUSC1C
SET XUSC("HOME")=IO
+5 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERROR^XUSC1C"
+6 DO OPEN^XUSC1C
IF 'XUSC("STAT")
DO SAVDEV^%ZISUTL("XUSC-IP")
USE IO
DO HELO^XUSC1C
+7 DO USE^%ZISUTL("XUSC-HOME")
+8 QUIT $SELECT('XUSC("STAT"):0,1:XUSC("STAT"))
+9 ;
DATA(INPUT,OUTPUT,TYPE) ;Pass Data, Get Responce
+1 SET XUSC("STAT")=0
DO USE^%ZISUTL("XUSC-IP")
+2 DO DATA^XUSC1C
if XUSC("STAT")
GOTO ERR
+3 DO TURN^XUSC1C
if XUSC("STAT")
GOTO ERR
+4 DO GET^XUSC1C
if XUSC("STAT")
GOTO ERR
+5 DO USE^%ZISUTL("XUSC-HOME")
+6 QUIT 0
+7 ;
CLOSE() ;Close connection
+1 DO USE^%ZISUTL("XUSC-IP")
DO QUIT^XUSC1C
DO USE^%ZISUTL("XUSC-HOME")
+2 DO RMDEV^%ZISUTL("XUSC-IP")
DO RMDEV^%ZISUTL("XUSC-HOME")
+3 KILL XUSC
QUIT 0
+4 ;
ERR ;Report an error
+1 DO TRACE^XUSC1C("ERROR "_XUSC("STAT"))
+2 DO QUIT^XUSC1C
DO USE^%ZISUTL("XUSC-HOME")
+3 QUIT XUSC("STAT")
+4 ;
IP ;Lookup name pass back parameters in XUSC
+1 NEW %,XUSCY,XUSCE
+2 SET %=$PIECE(XUSC3," ")
Begin DoDot:1
+3 IF $LENGTH($TEXT(@%))
DO @%
QUIT
+4 DO ASK
QUIT
End DoDot:1
+5 QUIT
+6 ;
DSIG SET XUSC("IP")=$PIECE($GET(^XTV(8989.3,1,"IP1")),"^",1)
+1 SET XUSC("SOCK")=10265
+2 QUIT
CRL SET XUSC("IP")=$PIECE($GET(^XTV(8989.3,1,"IP1")),"^",1)
+1 SET XUSC("SOCK")=10270
+2 QUIT
SHA1 SET XUSC("IP")=$PIECE($GET(^XTV(8989.3,1,"IP1")),"^",1)
+1 SET XUSC("SOCK")=10260
+2 QUIT
ASK ; ASK USER FOR IP AND PORT
+1 SET XUSC("IP")=""
SET XUSC("SOCK")=""
+2 READ !,"IP Address to use: ",%:DTIME
if "^"[%
QUIT
SET XUSC("IP")=%
+3 READ !," Port TO use: ",%:DTIME
if "^"[%
QUIT
SET XUSC("SOCK")=%
+4 QUIT
+5 ;
NOOP() ;
+1 SET XUSC("STAT")=0
DO USE^%ZISUTL("XUSC-IP")
+2 SET XUSC("OK")=$$POST^XUSC1C("NOOP")
+3 DO USE^%ZISUTL("XUSC-HOME")
+4 QUIT XUSC("OK")