Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSC1C

XUSC1C.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;Return 0 = OK, else -1^msg
  1. EN(INPUT,OUTPUT,TYPE) ;Call to connect to Server
  1. N X,Y,XUSCCMD,XUSCDAT,XUSCER,XUSCTIME,XUSCTRC,XUSCEXIT
  1. D SETUP
  1. D TRACE("IP:"_XUSC("IP")_" Port: "_XUSC("SOCK"))
  1. N $ESTACK,$ETRAP S $ETRAP="D ERROR^XUSC1C"
  1. D OPEN G:XUSC("STAT") ERR
  1. D HELO G:XUSC("STAT") ERR
  1. ;D SERV G:XUSC("STAT") ERR
  1. D DATA G:XUSC("STAT") ERR
  1. D TURN G:XUSC("STAT") ERR
  1. D GET G:XUSC("STAT") ERR
  1. D QUIT
  1. Q 0
  1. ERR ;Report back an error
  1. D TRACE("ERROR "_XUSC("STAT"))
  1. D:'POP QUIT
  1. Q XUSC("STAT")
  1. ;
  1. ERROR ;Trap an error
  1. S XUSC("STAT")="-1^M error: "_$ECODE
  1. D ^%ZTER G UNWIND^%ZTER
  1. ;
  1. OPEN ;Open connection
  1. N IPCNT,IPA
  1. D TRACE("Make Connection")
  1. F IPCNT=1:1 S IPA=$P(XUSC("IP"),",",IPCNT) Q:IPA="" D
  1. . I '$$VALIDATE^XLFIPV(IPA) S IPA=$P($$ADDRESS^XLFNSLK(IPA),",") ;p642 ICR#5844
  1. . I '$$VALIDATE^XLFIPV(IPA) Q ;p642 ICR#5844
  1. . D TRACE("Call IP "_IPA)
  1. . F XUSCCNT=0:1:5 D Q:'POP
  1. . . D CALL^%ZISTCP(IPA,XUSC("SOCK"),1)
  1. I POP S XUSC("STAT")="-1^Initial Connection Failed" Q
  1. D TRACE("Got Connection")
  1. U IO
  1. Q
  1. HELO ;start conversation
  1. N I ;p638
  1. S X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
  1. I $E(X,1)'=2 S XUSC("STAT")="-1^Initial HELO Failed",XUSC("REC")=X
  1. I $E(X,1,3)="421" S XUSC("STAT")="-1^Busy"
  1. F I=0:1:5 Q:$E(XUSCCMD,1,3)=220 D CREAD^XUSC1S ;p642 quit after 6 tries (read failed)
  1. Q
  1. SERV ;Requested Service
  1. D TRACE("Service Request: "_TYPE)
  1. S X=$$POST("SERV "_TYPE)
  1. I $E(X,1)'=2 S XUSC("STAT")="-1^"_X,XUSC("REC")=X
  1. Q
  1. DATA ;Send data
  1. D TRACE("Send Data")
  1. D SDATA^XUSC1S1(INPUT,$G(TYPE,"MPI")),CREAD^XUSC1S
  1. I $E(XUSCCMD,1)'=2 S XUSC("STAT")="-1^No 220 after send "_XUSCDAT Q
  1. Q
  1. ;
  1. TURN ;Turn channel
  1. S X=$$POST("TURN ") I $E(X,1)'=2 S XUSC("STAT")="-1^No 220 after Turn"
  1. Q
  1. GET ;Get responce
  1. D CREAD^XUSC1S I XUSCCMD[220 G GET
  1. I XUSCCMD'["DATA" S XUSC("STAT")="-1^No DATA cmd "_XUSCCMD Q
  1. D DATA^XUSC1S1(OUTPUT)
  1. Q
  1. QUIT ;Shut down
  1. D SEND^XUSC1S("QUIT ")
  1. D CLOSE^%ZISTCP
  1. Q
  1. POST(MSG) ;Send a command and get responce
  1. D SEND^XUSC1S(MSG)
  1. D CREAD^XUSC1S
  1. Q XUSCCMD
  1. ;
  1. TRACE(S1) ;
  1. N %,H
  1. I S1=-1 K ^TMP("XUSC1",$J) Q
  1. Q:'$G(XUSCDBUG)
  1. S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
  1. L +^TMP("XUSC1",$J):1
  1. S %=$G(^TMP("XUSC1",$J,0))+1,^(0)=%,^(%)=H_XUSCTRC_S1
  1. L -^TMP("XUSC1",$J)
  1. Q
  1. SETUP ;
  1. S (XUSC("STAT"),XUSCEXIT)=0,XUSCTIME=30,XUSCTRC="C: "
  1. S XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
  1. D TRACE(-1),TRACE("Client Setup")
  1. Q