      SUBROUTINE PLS.DIALOG(TCP.HANDLE,OBUF,IBUF,CODE.LIST,INPUT.MODE,WORK.FLG,CODE,PARM,ERRSTR)
*PIC-LAN
*
*ALL
*PC
*N
*
*
*
*
*
*     TCP.HANDLE   - PLCB Handle for open connection
*     OBUF         - String to transmit
*     IBUF         - String received
*     CODE.LIST    - List of valid result codes
*     INPUT.MODE   - Mode to gather input        LINE
*                                                DOT
*                                                TEXT
*                                                NUM
*     WORK.FLG     - Flag to indicate that some network traffic sent/rcvd
*     CODE         - Result code       ### - Numeric code
*                                      000 - Complete, but no code
*     ERRSTR          - Error string
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.COMMON
      INCLUDE PL.COMMON.DEFS
      INCLUDE PL.DEFS
      INCLUDE PLIP.COMMON
      INCLUDE PLW.COMMON
*
      INCLUDE CAT.INCLUDE.EQU
*
      IF INPUT.MODE <> 'DOT' THEN
         GOSUB 100
         RETURN
      END
*
      IBUF0 = IBUF
      IF IBUF0<1,1> = '~EXTERNAL~' THEN
         READ IBUF FROM PL$CONN.FD , ST$PLCB 'R%8' : '*IBUF*' : IBUF0<1,2> ELSE IBUF = ''
      END
*
      TM0 = PL_NOW()
      TM1 = TM0
      L0 = LEN(IBUF)
      C.FLG = YES
      LOOP
         GOSUB 100
         IF CODE <> '' THEN C.FLG = NO
         IF ERRSTR <> '' THEN C.FLG = NO
         L1 = LEN(IBUF)
         IF L1 > 50000 THEN
            C.FLG = NO
         END ELSE
            NW = PL_NOW()
            IF L0 <> L1 THEN
               L0 = L1
               TM1 = NW
            END ELSE
               IF NW - TM1 >= 3 THEN
                  C.FLG = NO
                  PL_RQM
               END
            END
         END
      WHILE C.FLG DO REPEAT
*
      IF CODE <> '' OR ERRSTR <> '' THEN
         IF IBUF0<1,1> = '~EXTERNAL~' THEN
            S = ''
            I1 = IBUF0<1,2> - 1
            FOR I = 0 TO I1 - 1 STEP 100
               FOR J = 1 TO 100
                  K = I + J
                  IF K <= I1 THEN
                     N = J
                     ID = ST$PLCB 'R%8' : '*IBUF*' : K
                     READ R(J) FROM PL$CONN.FD , ID ELSE R(J) = ''
                     DELETE PL$CONN.FD , ID
*$*PRINT 'PLS.DIALOG: DELETE CONN ' : ID
                  END
               NEXT J
               GOSUB 80000
            NEXT I
            IBUF = S : IBUF
         END
         RETURN
      END
*
      N = LEN(IBUF)
      IF IBUF0<1,1> = '~EXTERNAL~' THEN
         IF N > 50000 THEN
            N = N - 10
            WRITE IBUF[1,N] ON PL$CONN.FD , ST$PLCB 'R%8' : '*IBUF*' : IBUF0<1,2>
            IBUF0<1,2> = IBUF0<1,2> + 1
            WRITE IBUF[N+1,10] ON PL$CONN.FD , ST$PLCB 'R%8' : '*IBUF*' : IBUF0<1,2>
         END ELSE
            WRITE IBUF ON PL$CONN.FD , ST$PLCB 'R%8' : '*IBUF*' : IBUF0<1,2>
         END
         IBUF = IBUF0
      END ELSE
         IF N > 50000 THEN
            N = N - 10
            WRITE IBUF[1,N] ON PL$CONN.FD , ST$PLCB 'R%8' : '*IBUF*1'
            WRITE IBUF[N+1,10] ON PL$CONN.FD , ST$PLCB 'R%8' : '*IBUF*2'
            IBUF = '~EXTERNAL~' : VM : 2
         END
      END
*
      RETURN
*
100   REM Main-line routine
*
      CODE = ''
      PARM = ''
      ERRSTR = ''
      WORK.FLG = NO
*
      IF INPUT.MODE = 'DOT' THEN
         IN.LEN = 16000
      END ELSE
         IN.LEN = 1000
      END
*
      PL_PLCB.STATUS TCP.HANDLE ELSE
*$*PRINT 'PLS.DIALOG:  Error getting TCP status'
         CODE = '902'
         ERRSTR = 'Error getting TCP connection status'
         RETURN
      END
*
*
      IF PL_TCP.STATUS_STATE() < 3 THEN
         CODE = '906'
         ERRSTR = 'TCP connection not open'
         RETURN
      END
*
      IF PL_TCP.STATUS_STATE() < 5 THEN
*$*PRINT 'PLS.DIALOG:  Status = ' : PL_TCP.STATUS_STATE()
         RETURN
      END
*
      IF PL_TCP.STATUS_STATE() > 8 THEN
*$*PRINT 'PLS.DIALOG:  Status > 8'
         CODE = '906'
         ERRSTR = 'TCP connection has been reset'
         RETURN
      END
*
      O.OBUF.CNT = ST$OBUF.CNT
*
      BEGIN CASE
         CASE OBUF <> ''
            IBUF = ''
*$*PRINT '==> ' : OBUF
            PL_BCB.SND OBUF
            OBUF = ''
         CASE NOT(NUM(ST$OBUF.CNT))
         CASE ST$OBUF.CNT
            PL_BCB.SND ''
      END CASE
*
      IF NOT(NUM(ST$OBUF.CNT)) THEN
         CODE = '903'
         ERRSTR = 'Error during TCP write.'
         RETURN
      END
*
      ERRSTR = ''
      IF ST$OBUF.CNT THEN
         IF O.OBUF.CNT <> ST$OBUF.CNT THEN
            WORK.FLG = YES
         END
         RETURN
      END
*
      IBUF2 = ''
      LOOP
         PL_TCP_READ X FROM TCP.HANDLE , IN.LEN ELSE
            CODE = '904'
            ERRSTR = 'Error during TCP read.  ERRSTR = ' : ERRSTR : '  RES = ' : RES
            RETURN
         END
         IF RES > 0 THEN
*$*PRINT '<== ' : X
            IBUF2 = IBUF2 : X
            X = ''
         END
      WHILE RES > 0 AND LEN(IBUF2) < 200000 DO REPEAT
      IBUF = IBUF : IBUF2
      ERRSTR = ''
*
      IF IBUF2 <> '' THEN
         WORK.FLG = YES
      END
      IF IBUF <> '' THEN
*
         BEGIN CASE
            CASE INPUT.MODE = 'LINE'
               T = INDEX(IBUF,CRLF,1)
               IF T THEN
*$*               IF T <> LEN(IBUF) - 1 THEN
*$*                  CODE = '905'
*$*                  ERRSTR = 'Extra input after response read'
*$*                  RETURN
*$*               END
                  CODE = FIELD(IBUF,' ',1)
                  CODE = FIELD(CODE,CR,1)
                  CODE = FIELD(CODE,LF,1)
                  IF CODE = '' THEN CODE = '000'
                  PARM = IBUF[1,T-1]
                  IBUF = IBUF[T+2,BIG.STR]
               END
            CASE INPUT.MODE = 'NUM'
               T = INDEX(IBUF,CRLF,1)
               IF T THEN
*$*               IF T <> LEN(IBUF) - 1 THEN
*$*                  CODE = '905'
*$*                  ERRSTR = 'Extra input after response read'
*$*                  RETURN
*$*               END
                  CODE = FIELD(IBUF,' ',1)
                  CODE = FIELD(CODE,'-',1)
                  CODE = FIELD(CODE,CR,1)
                  CODE = FIELD(CODE,LF,1)
                  CODE = CODE[1,3]
                  IF CODE = '' THEN CODE = '000'
                  PARM = IBUF[1,T-1]
                  IBUF = IBUF[T+2,BIG.STR]
               END
            CASE INPUT.MODE = 'TEXT'
               T = INDEX(IBUF,PL$CRLFCRLF,1)
               IF T THEN
                  IF T <> LEN(IBUF) - 3 THEN
                     CODE = '905'
                     ERRSTR = 'Extra input after response read'
                     RETURN
                  END
                  CODE = FIELD(IBUF,' ',1)
                  IF CODE = '' THEN CODE = '000'
               END
            CASE INPUT.MODE = 'DOT'
               IF INDEX(IBUF2,'.',1) THEN
                  T = INDEX(IBUF,CRLF:'.':CRLF,1)
                  IF T THEN
                     IF T <> LEN(IBUF) - 4 THEN
                        CODE = '905'
                        ERRSTR = 'Extra input after response read'
                        RETURN
                     END
                     CODE = '000'
                  END
               END
         END CASE
      END ELSE
         RETURN
      END
*
      IF CODE = '' THEN
         PL_PLCB.STATUS TCP.HANDLE ELSE
            CODE = '902'
            ERRSTR = 'Error getting TCP connection status'
            RETURN
         END
   *
         IF PL_TCP.STATUS_STATE() < 5 THEN
            CODE = '906'
            ERRSTR = 'TCP connection has been deleted'
            RETURN
         END
   *
         IF PL_TCP.STATUS_STATE() > 8 THEN
            CODE = '906'
            ERRSTR = 'TCP connection has been reset'
            RETURN
         END
         RETURN
      END
      IF CODE.LIST = '' THEN RETURN
*
*$*PRINT 'PLS.DIALOG:  CODE = ' : CODE : '  CODE.LIST = ' : CODE.LIST
      IF INDEX(CODE.LIST,' ':CODE:' ',1) = 0 THEN
         ERRSTR = 'Invalid response code'
         RETURN
      END
*
      RETURN
*
      INCLUDE CAT.INCLUDE
   END
