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

INTSUT.m

Go to the documentation of this file. 
  1. INTSUT ;JPD; 1 Feb 96 09:26; Generic receiver, enhanced functions 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1. INIT1(INDA,INBPN,INIP,CLISRV,INXDST,INDEST,INPOP) ;Init
  1.  ;Input:
  1.  ; INDA - ien of Criteria
  1.  ; INBPN = Background processor
  1.  ;Output:
  1.  ; INIP - Parameters
  1.  ; CLISRV - 0 Client, 1 - Server
  1.  ; INXDST - Destination Determination xeq
  1.  ; INDEST - destinations
  1.  ; INPOP - 0 stop processing, 1 continue processing
  1.  ;
  1.  N ING,INERR,INUIF,X,ER,INMEM,INQP,INQT,I,Y
  1.  S X="ERR^INTSAPR",@^%ZOSF("TRAP"),INPOP=1
  1.  ; initialize variables from background process file
  1.  D INIT(INDA,.INIP)
  1.  I INIP("PORT")="" D DISPLAY^INTSUT1("Port is not defined") S INPOP=0 Q
  1.  ;Determine if process will be client (default, with 0) or server (1)
  1.  S CLISRV=$$VAL^DWRA(4001.1,13.03,2,DIE,INDA)
  1.  ;server only lock if server
  1.  I CLISRV D  Q:'INPOP
  1.  .L +^INRHB("RUN","SRVR",INBPN,INIP("PORT")):0 I '$T D
  1.  ..S INPOP=0
  1.  ..D DISPLAY^INTSUT1("Port locked by another user")
  1.  I CLISRV S ^INRHB("RUN","SRVR",INBPN,INIP("PORT"))=$H
  1.  ;Set destination determination code
  1.  S INXDST=$$VAL^DWRA(4001.1,23.01,2,DIE,INDA)
  1.  ;Set array of valid destinations
  1.  D DISPLAY^INTSUT1("Setting valid destination(s)")
  1.  F I=1:1 S X=$T(DEST+I^INHVTAPR) Q:X'[";;"  D
  1.  .S Y=$TR($P(X,";;")," ",""),INDEST(Y)=$P(X,";;",2)
  1.  D DISPLAY^INTSUT1("Initialized variables from background process file")
  1.  Q
  1. OPEN(CLISRV,INIP,INMEM,INCHNL,INPOP,INNM) ;Open connection
  1.  ; Input:
  1.  ;  CLISRV - 0 Client, 1 Server
  1.  ;  INIP - Process parameters
  1.  ;  INNM - Name of what is being opened
  1.  ; Output:
  1.  ;  INMEM - memory location
  1.  ;  INCHNL - chanel of tcp/ip socket
  1.  ;  INPOP - 0 stop 1 continue
  1.  N INLOOP,OPENED,MSG,INX
  1.  K INCHNL
  1.  S INNM=$G(INNM) S:INNM="" INNM="Test Utility"
  1.  S INX=$S(CLISRV:"server",1:"client"),(INDEBUG,INDONE)=0
  1.  D DISPLAY^INTSUT1("Opening connection for "_INX_" process ") Q:'INPOP
  1.  ;Open %INET
  1.  F INLOOP=1:1:INIP("OTRY") D  Q:INCHNL!'INPOP  H INIP("OHNG")
  1.  .S MSG="Attempt "_INLOOP_" to open socket"
  1.  .D DISPLAY^INTSUT1(MSG)
  1.  .;If background process is server open Test Utility as SERVER
  1.  .I CLISRV D SRVOPN(.INIP,.INCHNL,.INMEM)
  1.  .;If background process is client open Test Utility as CLIENT
  1.  .I 'CLISRV D CLIOPN(.INIP,.INCHNL,.INMEM)
  1.  .Q:+INCHNL
  1.  .I $L(INCHNL) D DISPLAY^INTSUT1(INCHNL) S INCHNL=""
  1.  .;Hang and retry
  1.  .D DISPLAY^INTSUT1("Waiting "_INIP("OHNG")_" seconds for retry")
  1.  ;
  1.  I 'INCHNL D  Q
  1.  .D DISPLAY^INTSUT1("Unable to connect to "_INNM_" at "_INIP("ADDR")_" /    "_INIP("PORT"))
  1.  .S INPOP=0
  1.  D DISPLAY^INTSUT1("Channel "_+INCHNL_" opened.")
  1.  Q
  1. SRVOPN(INIP,INCHNL,INMEM) ;Open Server
  1.  ; Input:
  1.  ;   INIP - Parameters
  1.  ;   INCHNL - Port channel
  1.  ;   INMEM - Memory location
  1.  D DISPLAY^INTSUT1("Opening Server at port "_INIP("PORT"))
  1.  D OPEN^%INET(.INCHNL,.INMEM,"",INIP("PORT"),1)
  1.  Q
  1. CLIOPN(INIP,INCHNL,INMEM) ;open client
  1.  ; Input:
  1.  ;   INIP - Parameters
  1.  ;   INCHNL - Port channel
  1.  ;   INMEM - Memory location
  1.  D DISPLAY^INTSUT1("Opening Client at address "_INIP("ADDR")_" port "_INIP("PORT"))
  1.  D OPEN^%INET(.INCHNL,.INMEM,INIP("ADDR"),INIP("PORT"),1)
  1.  I 'INCHNL,INCHNL'="" D DISPLAY^INTSUT1(INCHNL_" "_INIP("ADDR")_" "_INIP("PORT"))
  1.  Q
  1. EXIT(INCHNL,INBPN,INIP,CLISRV) ;Main exit module
  1.  ;Input:
  1.  ; INCHNL - Port channel
  1.  ; INBPN - background process pointer
  1.  ; INIP - Array of tcp parameters
  1.  ; CLISRV - 1 Server 0 client
  1.  ;server
  1.  I CLISRV D
  1.  .L -^INRHB("RUN","SRVR",INBPN,INIP("PORT"))
  1.  .D CLOSE(.INCHNL,"Server")
  1.  .K ^INRHB("RUN","SRVR",INBPN,INIP("PORT"))
  1.  ;client
  1.  I 'CLISRV D
  1.  .D CLOSE(.INCHNL,"Client")
  1.  .L -^INRHB("RUN",INBPN,INIP("PORT"))
  1.  .K ^INRHB("RUN",INBPN,INIP("PORT"))
  1.  D DISPLAY^INTSUT1("Exiting TCP socket transmitter for the Test Utility")
  1.  Q
  1.  ;
  1. CLOSE(INCHNL,INTP) ;Close channel
  1.  ; Input:
  1.  ;  INCHNL - Cannel of Socket
  1.  ;  INTP - Client or Server
  1.  D DISPLAY^INTSUT1("Closing "_INTP_" channel "_(+INCHNL)),CLOSE^%INET(.INCHNL)
  1.  Q
  1. CLINIT(INIP,INCHNL,INMEM,INPOP) ;Init as a client send init string
  1.  ; Input:
  1.  ;  INIP - Input paramters
  1.  ;  INCHNL - TCP/IP socket channel
  1.  ;  INMEM - MEMORY LOCATION FOR TCP/IP
  1.  ;  INPOP - 0 Stop processing, 1 continue
  1.  N J,MS,INMS,I,ER,ING,INDATA,APREC,INSMIN,INSND,INOUT
  1.  D DISPLAY^INTSUT1("Opened as client")
  1.  S INOUT=0
  1.  I $L(INIP("INIT")) F INSND=1:1:INIP("STRY") D  Q:'INPOP!INOUT
  1.  .D SENDSTR^INHUVUT(INIP("INIT"),INCHNL)
  1.  .D DISPLAY^INTSUT1("Sent initilization string")
  1.  .;Receive initialization response, if specified
  1.  .I '$L(INIP("ACK")) S INOUT=1 Q
  1.  .D DISPLAY^INTSUT1("waiting to receive initialization response.")
  1.  .S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
  1.  .S ING="INDATA"
  1.  .F I=1:1:INIP("RTRY") D  Q:$D(ING)  H:I<INIP("RTRY") INIP("RHNG")
  1.  ..D RECSTR^INTSREC(.ING,.INCHNL,.INIP)
  1.  .I '$D(@ING) D  Q
  1.  ..D DISPLAY^INTSUT1("No response received to intialization string ")
  1.  .S INOUT=1
  1.  I '$D(@ING) S INPOP=0
  1.  Q:'INPOP
  1.  ;Diplay ack message
  1.  D PARSEDCT^INHUT9(ING,"INMS",IOM,3,"",1)
  1.  S J=0 F  S J=$O(INMS(J)) Q:'J  S MS=INMS(J) D:$L(MS) DISPLAY^INTSUT1(MS,INEXPAND)
  1.  K INMS,MS
  1.  ;response not same as what's in ACK
  1.  I @ING@(1)'[INIP("ACK") D
  1.  .S INPOP=0
  1.  .D DISPLAY^INTSUT1("Incorrect response "_@ING@(1)_" received to intialization string ")
  1.  Q
  1. SRVINIT(INIP,INCHNL,INMEM,INPOP) ;--If opening as server, receive initialization string
  1.  ; Input:
  1.  ;  INIP - Input paramters
  1.  ;  INCHNL - TCP/IP socket channel
  1.  ;  INMEM - MEMORY LOCATION FOR TCP/IP
  1.  ;  INPOP - 0 Stop processing, 1 continue
  1.  ;Receive initialization
  1.  N INLOOP
  1.  Q:'$L(INIP("INIT"))
  1.  D DISPLAY^INTSUT1("Waiting to receive initialization string")
  1.  S ING="INDATA" K @ING
  1.  F INLOOP=1:1:INIP("RTRY") D  Q:$D(@ING)  H:INLOOP<INIP("RTRY") INIP("RHNG")
  1.  .D DISPLAY^INTSUT1("Waiting to receive initialization string")
  1.  .D RECSTR^INTSREC(.ING,.INCHNL,.INIP)
  1.  I '$D(@ING) D  Q
  1.  .S INPOP=0
  1.  .D DISPLAY^INTSUT1("No initialization string received")
  1.  I @ING@(1)'[INIP("INIT") D  Q
  1.  .S INPOP=0
  1.  .D DISPLAY^INTSUT1("Incorrect intialization received: "_@ING@(1))
  1.  ;received something while waiting for Init string
  1.  D DISPLAY^INTSUT1("Received Initialization String")
  1.  ;Diplay ack message
  1.  D PARSEDCT^INHUT9(ING,"INMS",IOM,3,"",1)
  1.  S J=0 F  S J=$O(INMS(J)) Q:'J  S MS=INMS(J) D:$L(MS) DISPLAY^INTSUT1(MS,INEXPAND)
  1.  K INMS,MS
  1.  ;Send initialization response if specified
  1.  I $L(INIP("ACK")) D
  1.  .D SENDSTR^INHUVUT(INIP("ACK"),INCHNL)
  1.  .D DISPLAY^INTSUT1("Sent initialization response")
  1.  Q
  1. ERROR(ER,INERR,INRCVE,INPOP) ;receive error check
  1.  ; Input:
  1.  ;  ER - error
  1.  ;  INERR - Error description
  1.  ; Input/Output:
  1.  ;  INRCVE - Receive count
  1.  ;  INPOP - 0 stop 1 continue
  1.  N RUN
  1.  ;If ER, some error or timeout has occurred
  1.  ;Log transceiver error if fatal, don't update message status
  1.  I ER,$L($G(INERR)) D DISPLAY^INTSUT1(INERR)
  1.  S INRCVE=+$G(INRCVE)+1 I INRCVE>INIP("RTRY") S INPOP=0 H INIP("RHNG")
  1.  ;--Blank and/or error conditions from receive
  1.  ;If ER=3, the other side has dropped the connection.
  1.  I ER=3 D DISPLAY^INTSUT1("Remote end disconnect") S INPOP=0 Q 0
  1.  Q 1
  1. EVAL(INIP,ING,INDEST,ACKUIF,INERR,INXDST,ER,INMSG,INRONLY) ;Evaluate incoming msg
  1.  ;Input:
  1.  ; INIP - Parameters
  1.  ; ING - variable set = to variable that holds message
  1.  ; INDEST - destinations
  1.  ; INRONLY - 1 Receive only send no ack, 0 receive then send ack
  1.  ;Output:
  1.  ; ACKUIF - ien of Ack message in UIF
  1.  ; INERR - Error description
  1.  ; INXDST - Destination Determination xeq
  1.  ; ER - true or false
  1.  N INACKID,ER
  1.  ;get ack
  1.  S ER=$$IN^INTSUSN(.INIP,ING,.INDEST,.ACKUIF,.INERR,.INXDST,.INMSG,.INMSASTA,INRONLY)
  1.  ;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
  1.  ;ER=2 is fatal error
  1.  ;ER=1 is non-fatal error. Log it, but move on to next transmission
  1.  ;ER=0 is no error
  1.  ;Log error message
  1.  I 'ER,'$D(INERR)
  1.  I ER,$D(INERR) D  K INERR
  1.  .S ERNO=0 F  S ERNO=$O(INERR(ERNO)) Q:'ERNO  D DISPLAY^INTSUT1(INERR(ERNO),+$G(ACKUIF))
  1.  K @ING
  1.  Q
  1. INIT(INDA,INIP) ;Initialize IP variables
  1.  ; Input: INDA - ien of test case
  1.  ; Output: INIP - IP variables
  1.  N STR,STR13,STR17
  1.  S STR=$G(^DIZ(4001.1,INDA,16)),STR13=$G(^DIZ(4001.1,INDA,13)),STR17=$G(^DIZ(4001.1,INDA,17)),INIP("PRE")=$G(^DIZ(4001.1,INDA,21)),INIP("POST")=$G(^DIZ(4001.1,INDA,22))
  1.  S INIP("AATT")=$P(STR13,U)
  1.  S INIP("AAC")=$P(STR13,U,4)
  1.  S INIP("OTRY")=$S($L($P(STR,U,4)):$P(STR,U,4),1:10)
  1.  S INIP("OHNG")=$S($L($P(STR,U,3)):$P(STR,U,3),1:15)
  1.  S INIP("RTO")=$S($L($P(STR,U,11)):$P(STR,U,11),1:15)
  1.  S INIP("STO")=$S($L($P(STR,U,8)):$P(STR,U,8),1:60)
  1.  S INIP("RTRY")=$S($L($P(STR,U,10)):$P(STR,U,10),1:5)
  1.  S INIP("RHNG")=$S($L($P(STR,U,9)):$P(STR,U,9),1:10)
  1.  S INIP("EOL")=$$ASCII^INHUVUT($S($L($P(STR,U,12)):$P(STR,U,12),1:13))
  1.  S INIP("INIT")=$$ASCII^INHUVUT($P(STR17,U))
  1.  S INIP("ACK")=$$ASCII^INHUVUT($P(STR17,U,2))
  1.  S INIP("THNG")=$S($L($P(STR,U,5)):$P(STR,U,5),1:10)
  1.  S INIP("STRY")=$S($L($P(STR,U,7)):$P(STR,U,7),1:10)
  1.  S INIP("SHNG")=$S($L($P(STR,U,6)):$P(STR,U,6),1:10)
  1.  S INIP("NOSOM")=1
  1.  I $G(DUZ)>1 S INIP("TMAX")=$$DTIME^INHULOG(DUZ)
  1.  S INIP("ADDR")=$P(STR,U)
  1.  S INIP("PORT")=$P(STR,U,2)
  1.  Q