XUSC1C ;ISCSF/RWF - Client Interface to Server services.;04/17/14 11:43
;;8.0;KERNEL;**283,580,642**;Jul 10, 1995;Build 6
;Per VA Directive 6402, 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 '$$VALIDATE^XLFIPV(IPA) S IPA=$P($$ADDRESS^XLFNSLK(IPA),",") ;p642 ICR#5844
. I '$$VALIDATE^XLFIPV(IPA) Q ;p642 ICR#5844
. 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
N I ;p638
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 I=0:1:5 Q:$E(XUSCCMD,1,3)=220 D CREAD^XUSC1S ;p642 quit after 6 tries (read failed)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSC1C 2653 printed Dec 13, 2024@02:12:10 Page 2
XUSC1C ;ISCSF/RWF - Client Interface to Server services.;04/17/14 11:43
+1 ;;8.0;KERNEL;**283,580,642**;Jul 10, 1995;Build 6
+2 ;Per VA Directive 6402, 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 ;p642 ICR#5844
IF '$$VALIDATE^XLFIPV(IPA)
SET IPA=$PIECE($$ADDRESS^XLFNSLK(IPA),",")
+5 ;p642 ICR#5844
IF '$$VALIDATE^XLFIPV(IPA)
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 ;p638
NEW I
+2 SET X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
+3 IF $EXTRACT(X,1)'=2
SET XUSC("STAT")="-1^Initial HELO Failed"
SET XUSC("REC")=X
+4 IF $EXTRACT(X,1,3)="421"
SET XUSC("STAT")="-1^Busy"
+5 ;p642 quit after 6 tries (read failed)
FOR I=0:1:5
if $EXTRACT(XUSCCMD,1,3)=220
QUIT
DO CREAD^XUSC1S
+6 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
