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