XUSC1.m

XUSC1 ;SFISC/RWF - Interface to Server services. ;10/09/2002  16:53 [ 07/29/2004   9:01 AM ]

 ;;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")

XUSC1     ;SFISC/RWF - Interface to Server services. ;10/09/2002  16:53 [ 07/29/2004   9:01 AM ]

 +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")