XUSC1C ;ISCSF/RWF - Client Interface to Server services. ;04/06/12 09:01
;;8.0;KERNEL;**283,580**;Jul 10, 1995;Build 47
;Per VHA Directive 2004-038, this routine should not be modified.
;Return 0 = OK, else -1^msg
EN(INPUT,OUTPUT,TYPE) ;Call to connect to Server
N X,Y,XUSCCMD,XUSCDAT,XUSCER,XUSCTIME,XUSCTRC,XUSCEXIT
D SETUP
D TRACE("IP:"_XUSC("IP")_" Port: "_XUSC("SOCK"))
N $ESTACK,$ETRAP S $ETRAP="D ERROR^XUSC1C"
D OPEN G:XUSC("STAT") ERR
D HELO G:XUSC("STAT") ERR
;D SERV G:XUSC("STAT") ERR
D DATA G:XUSC("STAT") ERR
D TURN G:XUSC("STAT") ERR
D GET G:XUSC("STAT") ERR
D QUIT
Q 0
ERR ;Report back an error
D TRACE("ERROR "_XUSC("STAT"))
D:'POP QUIT
Q XUSC("STAT")
;
ERROR ;Trap an error
S XUSC("STAT")="-1^M error: "_$ECODE
D ^%ZTER G UNWIND^%ZTER
;
OPEN ;Open connection
N IPCNT,IPA
D TRACE("Make Connection")
F IPCNT=1:1 S IPA=$P(XUSC("IP"),",",IPCNT) Q:IPA="" D
. I IPA'?1.3N1P1.3N1P1.3N1P1.3N S IPA=$P($$ADDRESS^XLFNSLK(IPA),",")
. I IPA'?1.3N1P1.3N1P1.3N1P1.3N Q
. D TRACE("Call IP "_IPA)
. F XUSCCNT=0:1:5 D Q:'POP
. . D CALL^%ZISTCP(IPA,XUSC("SOCK"),1)
I POP S XUSC("STAT")="-1^Initial Connection Failed" Q
D TRACE("Got Connection")
U IO
Q
HELO ;start conversation
S X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
I $E(X,1)'=2 S XUSC("STAT")="-1^Initial HELO Failed",XUSC("REC")=X
I $E(X,1,3)="421" S XUSC("STAT")="-1^Busy"
F Q:$E(XUSCCMD,1,3)=220 D CREAD^XUSC1S
Q
SERV ;Requested Service
D TRACE("Service Request: "_TYPE)
S X=$$POST("SERV "_TYPE)
I $E(X,1)'=2 S XUSC("STAT")="-1^"_X,XUSC("REC")=X
Q
DATA ;Send data
D TRACE("Send Data")
D SDATA^XUSC1S1(INPUT,$G(TYPE,"MPI")),CREAD^XUSC1S
I $E(XUSCCMD,1)'=2 S XUSC("STAT")="-1^No 220 after send "_XUSCDAT Q
Q
;
TURN ;Turn channel
S X=$$POST("TURN ") I $E(X,1)'=2 S XUSC("STAT")="-1^No 220 after Turn"
Q
GET ;Get responce
D CREAD^XUSC1S I XUSCCMD[220 G GET
I XUSCCMD'["DATA" S XUSC("STAT")="-1^No DATA cmd "_XUSCCMD Q
D DATA^XUSC1S1(OUTPUT)
Q
QUIT ;Shut down
D SEND^XUSC1S("QUIT ")
D CLOSE^%ZISTCP
Q
POST(MSG) ;Send a command and get responce
D SEND^XUSC1S(MSG)
D CREAD^XUSC1S
Q XUSCCMD
;
TRACE(S1) ;
N %,H
I S1=-1 K ^TMP("XUSC1",$J) Q
Q:'$G(XUSCDBUG)
S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
L +^TMP("XUSC1",$J):1
S %=$G(^TMP("XUSC1",$J,0))+1,^(0)=%,^(%)=H_XUSCTRC_S1
L -^TMP("XUSC1",$J)
Q
SETUP ;
S (XUSC("STAT"),XUSCEXIT)=0,XUSCTIME=30,XUSCTRC="C: "
S XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
D TRACE(-1),TRACE("Client Setup")
Q
XUSC1C ;ISCSF/RWF - Client Interface to Server services. ;04/06/12 09:01
+1 ;;8.0;KERNEL;**283,580**;Jul 10, 1995;Build 47
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;Return 0 = OK, else -1^msg
EN(INPUT,OUTPUT,TYPE) ;Call to connect to Server
+1 NEW X,Y,XUSCCMD,XUSCDAT,XUSCER,XUSCTIME,XUSCTRC,XUSCEXIT
+2 DO SETUP
+3 DO TRACE("IP:"_XUSC("IP")_" Port: "_XUSC("SOCK"))
+4 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERROR^XUSC1C"
+5 DO OPEN
IF XUSC("STAT")
GOTO ERR
+6 DO HELO
IF XUSC("STAT")
GOTO ERR
+7 ;D SERV G:XUSC("STAT") ERR
+8 DO DATA
IF XUSC("STAT")
GOTO ERR
+9 DO TURN
IF XUSC("STAT")
GOTO ERR
+10 DO GET
IF XUSC("STAT")
GOTO ERR
+11 DO QUIT
+12 QUIT 0
ERR ;Report back an error
+1 DO TRACE("ERROR "_XUSC("STAT"))
+2 IF 'POP
DO QUIT
+3 QUIT XUSC("STAT")
+4 ;
ERROR ;Trap an error
+1 SET XUSC("STAT")="-1^M error: "_$ECODE
+2 DO ^%ZTER
GOTO UNWIND^%ZTER
+3 ;
OPEN ;Open connection
+1 NEW IPCNT,IPA
+2 DO TRACE("Make Connection")
+3 FOR IPCNT=1:1
SET IPA=$PIECE(XUSC("IP"),",",IPCNT)
IF IPA=""
QUIT
Begin DoDot:1
+4 IF IPA'?1.3N1P1.3N1P1.3N1P1.3N
SET IPA=$PIECE($$ADDRESS^XLFNSLK(IPA),",")
+5 IF IPA'?1.3N1P1.3N1P1.3N1P1.3N
QUIT
+6 DO TRACE("Call IP "_IPA)
+7 FOR XUSCCNT=0:1:5
Begin DoDot:2
+8 DO CALL^%ZISTCP(IPA,XUSC("SOCK"),1)
End DoDot:2
IF 'POP
QUIT
End DoDot:1
+9 IF POP
SET XUSC("STAT")="-1^Initial Connection Failed"
QUIT
+10 DO TRACE("Got Connection")
+11 USE IO
+12 QUIT
HELO ;start conversation
+1 SET X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
+2 IF $EXTRACT(X,1)'=2
SET XUSC("STAT")="-1^Initial HELO Failed"
SET XUSC("REC")=X
+3 IF $EXTRACT(X,1,3)="421"
SET XUSC("STAT")="-1^Busy"
+4 FOR
IF $EXTRACT(XUSCCMD,1,3)=220
QUIT
DO CREAD^XUSC1S
+5 QUIT
SERV ;Requested Service
+1 DO TRACE("Service Request: "_TYPE)
+2 SET X=$$POST("SERV "_TYPE)
+3 IF $EXTRACT(X,1)'=2
SET XUSC("STAT")="-1^"_X
SET XUSC("REC")=X
+4 QUIT
DATA ;Send data
+1 DO TRACE("Send Data")
+2 DO SDATA^XUSC1S1(INPUT,$GET(TYPE,"MPI"))
DO CREAD^XUSC1S
+3 IF $EXTRACT(XUSCCMD,1)'=2
SET XUSC("STAT")="-1^No 220 after send "_XUSCDAT
QUIT
+4 QUIT
+5 ;
TURN ;Turn channel
+1 SET X=$$POST("TURN ")
IF $EXTRACT(X,1)'=2
SET XUSC("STAT")="-1^No 220 after Turn"
+2 QUIT
GET ;Get responce
+1 DO CREAD^XUSC1S
IF XUSCCMD[220
GOTO GET
+2 IF XUSCCMD'["DATA"
SET XUSC("STAT")="-1^No DATA cmd "_XUSCCMD
QUIT
+3 DO DATA^XUSC1S1(OUTPUT)
+4 QUIT
QUIT ;Shut down
+1 DO SEND^XUSC1S("QUIT ")
+2 DO CLOSE^%ZISTCP
+3 QUIT
POST(MSG) ;Send a command and get responce
+1 DO SEND^XUSC1S(MSG)
+2 DO CREAD^XUSC1S
+3 QUIT XUSCCMD
+4 ;
TRACE(S1) ;
+1 NEW %,H
+2 IF S1=-1
KILL ^TMP("XUSC1",$JOB)
QUIT
+3 IF '$GET(XUSCDBUG)
QUIT
+4 SET H=$PIECE($HOROLOG,",",2)
SET H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
+5 LOCK +^TMP("XUSC1",$JOB):1
+6 SET %=$GET(^TMP("XUSC1",$JOB,0))+1
SET ^(0)=%
SET ^(%)=H_XUSCTRC_S1
+7 LOCK -^TMP("XUSC1",$JOB)
+8 QUIT
SETUP ;
+1 SET (XUSC("STAT"),XUSCEXIT)=0
SET XUSCTIME=30
SET XUSCTRC="C: "
+2 SET XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
+3 DO TRACE(-1)
DO TRACE("Client Setup")
+4 QUIT
