- 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 Feb 18, 2025@23:38:35 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")