/* BSTTPREP - Converts CSI EXEC TCP commands to EZASOKET Calls */
 
/* this exec works in both VSE and CMS */
 
/* VSE:
// EXEC REXX=BSTTPREP,SIZE=256K
  <program source here>
/*                                          */ */
 
/* CMS:
BSTTPREP fn ft fm
                                               */
 
 
 /* ********************************************* */
 /*                                               */
 /* Copyright 2000-2011 Thigpen Enterprises, Inc. */
 /*                                               */
 /* ********************************************* */
 
trace off
parse source os .
if os = 'CMS'
  then do
    arg fn ft fm . '(' options
    if find(options,'TRACE') ¬= 0
      then trace i
    infile = fn ft fm
    outfile = fn strip(left(ft,5))'BSI A'
    'ERASE' outfile
    say 'BSTT003I COPYRIGHT (C) 2000-2009 BARNARD SOFTWARE, INC.'
  end
  else do
    xxx = assgn(STDOUT,SYSLOG)
    say 'BSTT003I COPYRIGHT (C) 2000-2009 BARNARD SOFTWARE, INC.'
    xxx = assgn(STDOUT,SYSLST)
    say 'BSTT003I COPYRIGHT (C) 2000-2009 BARNARD SOFTWARE, INC.'
  end
 
verbs = 'CONTROL OPEN CLOSE SEND RECEIVE'
options = 'ACTIVE PASSIVE PUSH TRACE'
operands = 'DESCRIPTOR DOUBLE ERROR FOREIGNIP FOREIGNPORT FROM',
           'LENGTH LOCALPORT RESULTAREA SYSID TO END-EXEC. END-EXEC'
operignore = 'ECB2 FIXED PUSH TIMEOUT'
 
cicstrace = 0
qu = "'"
in. = ''
pd. = ''
pd.0 = 0
lastused = 0
if os = 'VSE'
  then do
    call new_pd '$$DITTO SET HEADERPG=NO'
    call new_pd '$$DITTO CC'
  end
 
call READ_INPUT
if in.0 = 0
  then exit 1
call CONVERT_WS
call CONVERT_LINKAGE
call CONVERT_PROCEDURE
call WRITE_OUTPUT
exit 0
 
READ_INPUT:
in.0 = 0
if os = 'CMS'
  then 'EXECIO * DISKR' infile '(STEM IN. FINIS'
  else 'EXECIO * DISKR SYSIPT (OPEN STEM IN. FINIS'
say 'records read:' in.0
return 0
 
CONVERT_WS:
do i = 1 to in.0
  parse var in.i . 7 comment 8 line 73 .
  test12 = word(line,1) word(line,2)
  test12 = strip(test12,'T','.')
  test12 = space(test12)
  wordcount = words(line)
  if wordcount > 0
    then testlast = word(line,wordcount)
    else testlast = ''
  testperiod = testlast
  testlast = strip(testlast,'T','.')
 
  if comment ¬= '*'
    then do
      if test12 = 'LINKAGE SECTION' | ,
        test12 = 'PROCEDURE DIVISION'
        then leave i
    end
 
  if comment = '*'
    then call new_pd in.i
    else do
      if test12 = 'EXEC TCP'
        then do
          exectcp = 1
          execinfo = ''
          telnet = 0
          in.i = overlay('BSI   *',in.i)
          call new_pd in.i
          if testlast = 'END-EXEC'
            then do
              exectcp = 0
              period = length(testperiod) - length(testlast)
              if \period
              then do
                say 'Period not found after END-EXEC. Verify output.'
                call new_pd 'BSI-E  *NO PERIOD AFTER END-EXEC**'
              end
              execinfo = execinfo strip(line,'T')
              call PROCESS_EXECINFO
            end
            else do
              execinfo = execinfo strip(line,'T')
            end
        end
        else call new_pd in.i
    end
end
 
call new_pd 'BSI'
call new_pd 'BSI     01 EZA-WORK.'
call new_pd 'BSI                                    COPY BSTTEZA.'
call new_pd 'BSI                                    COPY BSTTEZAC.'
call new_pd 'BSI'
 
lastused = i - 1
 
return 0
 
CONVERT_LINKAGE:
do i = lastused+1 to in.0
  parse var in.i . 7 comment 8 line 73 .
  test12 = word(line,1) word(line,2)
  test12 = strip(test12,'T','.')
  test12 = space(test12)
  if comment ¬= '*'
    then do
      if test12 = 'PROCEDURE DIVISION'
        then leave i
    end
  call new_pd in.i
end
lastused = i - 1
 
return 0
 
CONVERT_PROCEDURE:
exectcp = 0
period = 0
do i = lastused+1 to in.0
  parse var in.i . 7 comment 8 line 73 .
  test12 = word(line,1) word(line,2)
  test12 = strip(test12,'T','.')
  test12 = space(test12)
  wordcount = words(line)
  if wordcount > 0
    then testlast = word(line,wordcount)
    else testlast = ''
  testperiod = testlast
  testlast = strip(testlast,'T','.')
 
  if comment = '*'
    then call new_pd in.i
    else do
      if test12 = 'EXEC UDP' |,
         test12 = 'EXEC FTP' |,
         test12 = 'EXEC CLIENT' |,
         test12 = 'EXEC CONTROL' |,
         test12 = 'EXEC RAW'
        then do
          say 'Unsupported CSI TCP API function found. 'test12'.'
          call new_pd 'BSI-E  *UNSUPORTED CSI TCP API IGNORED**'
        end
      if test12 = 'EXEC TCP'
        then do
          exectcp = 1
          execinfo = ''
          telnet = 0
        end
      if test12 = 'EXEC TELNET'
        then do
          exectcp = 1
          execinfo = ''
          telnet = 1
          say 'The CSI EXEC TELNET API is not fully supported.'
          call new_pd 'BSI-W **CSI EXEC TELNET API REQUIRES REVIEW**'
        end
      if exectcp
        then do
          in.i = overlay('BSI   *',in.i)
          call new_pd in.i
          if testlast = 'END-EXEC'
            then do
              exectcp = 0
              period = length(testperiod) - length(testlast)
              if \period
              then do
                say 'Period not found after END-EXEC. Verify output.'
                call new_pd 'BSI-E  *NO PERIOD AFTER END-EXEC**'
              end
              execinfo = execinfo strip(line,'T')
              call PROCESS_EXECINFO
            end
            else do
              execinfo = execinfo strip(line,'T')
            end
        end
        else call new_pd in.i
    end
end
lastused = i - 1
 
return 0
 
PROCESS_EXECINFO:
 
type = word(execinfo,2)
verb = word(execinfo,3)
verbnbr = wordpos(verb,verbs)
if vernbr = 0
  then do
    say 'Unreconized verb' verb
    return 0
  end
oper. = ''
do k = 4 to words(execinfo)
  parse value word(execinfo,k) with key '(' keyvalue ')'
  opernbr = wordpos(key,operands)
  ignnbr = wordpos(key,operignore)
  optnbr = wordpos(key,options)
 
  if key = 'LOCAL'
    then do
      say 'The CSI LOCAL option is not converable.'
      call new_pd 'BSI-E  *KEYWORD LOCAL IS RESTRICTED**'
      iterate k
    end
 
  if key = 'WAIT' & keyvalue = 'NO'
    then do
      say 'The CSI WAIT(NO) option is not converable.'
      call new_pd 'BSI-E  *OPTION WAIT(NO) IS RESTRICTED**'
    end
  if key = 'WAIT'
    then iterate k
 
  if opernbr + optnbr + ignnbr = 0
    then do
      say 'Unknown keyword' key
      call new_pd 'BSI-E  *KEYWORD' key 'IS UNKNOWN**'
      iterate k
    end
 
  if ignnbr > 0
    then do
      say 'The CSI option' key ' is ignored.'
      call new_pd 'BSI-W **KEYWORD' key 'IS IGNORED**'
    end
 
  if optnbr > 0
    then do
      oper.key = 'YES'
    end
  if opernbr > 0
    then do
      oper.key = keyvalue
    end
 
end
 
interpret call 'PROCESS_'verb
 
return 0
 
PROCESS_CONTROL:
 
if oper.double = 'YES'
  then qu = '"'
if oper.trace = 'YES'
  then cicstrace = 1
  else cicstrace = 0
 
return 0
 
PROCESS_OPEN:
 
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'INITAPI'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE +0 TO EZA-MAXSOC.'
call new_pd 'BSI        MOVE SPACES TO EZA-IDENT.'
if symbol('oper.sysid') = 'VAR' & oper.sysid \= ''
  then do
call new_pd 'BSI        MOVE 'qu'SOCKET'qu' TO EZA-IDENT-TAG.'
call new_pd 'BSI        MOVE 'oper.sysid' TO EZA-IDENT-SYSID.'
  end
call new_pd 'BSI        MOVE SPACES TO EZA-SUBTASK.'
call new_pd 'BSI        MOVE +0 TO EZA-MAXSNO.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-MAXSOC'
call new_pd 'BSI            EZA-IDENT'
call new_pd 'BSI            EZA-SUBTASK'
call new_pd 'BSI            EZA-MAXSNO'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI'
if oper.passive = 'YES'
  then call OPEN_PASSIVE
  else call OPEN_ACTIVE
 
return 0
 
OPEN_ACTIVE:
 
call new_pd 'BSI        MOVE 'qu'SOCKET'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE +2 TO EZA-AF.'
call new_pd 'BSI        MOVE +1 TO EZA-SOCTYPE.'
call new_pd 'BSI        MOVE +0 TO EZA-PROTO.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-AF'
call new_pd 'BSI            EZA-SOCTYPE'
call new_pd 'BSI            EZA-PROTO'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE EZA-RETCODE TO EZA-S.'
call new_pd 'BSI        MOVE EZA-S-X TO 'oper.descriptor'.'
if symbol('oper.localport') = 'VAR'
  then do
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'BIND'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE +2 TO EZA-NAME-FAMILY.'
call new_pd 'BSI        MOVE 'oper.localport' TO EZA-NAME-PORT.'
call new_pd 'BSI        MOVE LOW-VALUES TO EZA-NAME-IPADDRESS.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S-ACCEPT'
call new_pd 'BSI            EZA-NAME'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
  end
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'CONNECT'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE LOW-VALUES TO EZA-NAME.'
call new_pd 'BSI        MOVE +2 TO EZA-NAME-FAMILY.'
call new_pd 'BSI        MOVE 'oper.foreignport' TO EZA-NAME-PORT.'
call new_pd 'BSI        MOVE 'oper.foreignip' TO EZA-NAME-IPADDRESS.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S'
call new_pd 'BSI            EZA-NAME'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE EZA-S-X TO 'oper.descriptor'.'
call new_pd 'BSI        MOVE EZA-NAME-PORT TO CSI-FOREIGN-PORT.'
call new_pd 'BSI        MOVE EZA-NAME-IPADDRESS TO CSI-FOREIGN-ADDRESS.'
call new_pd 'BSI        MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
call new_pd 'BSI'
 
return 0
 
OPEN_PASSIVE:
 
call new_pd 'BSI        MOVE 'qu'SOCKET'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE +2 TO EZA-AF.'
call new_pd 'BSI        MOVE +1 TO EZA-SOCTYPE.'
call new_pd 'BSI        MOVE +0 TO EZA-PROTO.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-AF'
call new_pd 'BSI            EZA-SOCTYPE'
call new_pd 'BSI            EZA-PROTO'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE EZA-RETCODE TO EZA-S-ACCEPT.'
call new_pd 'BSI        MOVE EZA-S-X TO 'oper.descriptor'.'
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'BIND'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE +2 TO EZA-NAME-FAMILY.'
call new_pd 'BSI        MOVE 'oper.localport' TO EZA-NAME-PORT.'
call new_pd 'BSI        MOVE LOW-VALUES TO EZA-NAME-IPADDRESS.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S-ACCEPT'
call new_pd 'BSI            EZA-NAME'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE EZA-NAME-PORT TO CSI-LOCAL-PORT.'
call new_pd 'BSI        MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
call new_pd 'BSI'
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'LISTEN'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE +10 TO EZA-BACKLOG.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S-ACCEPT'
call new_pd 'BSI            EZA-BACKLOG'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'ACCEPT'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE LOW-VALUES TO EZA-NAME.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S-ACCEPT'
call new_pd 'BSI            EZA-NAME'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE EZA-RETCODE TO EZA-S.'
call new_pd 'BSI        MOVE EZA-S-X TO 'oper.descriptor'.'
call new_pd 'BSI        MOVE EZA-NAME-PORT TO CSI-FOREIGN-PORT.'
call new_pd 'BSI        MOVE EZA-NAME-IPADDRESS TO CSI-FOREIGN-ADDRESS.'
call new_pd 'BSI        MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
call new_pd 'BSI'
      call new_pd 'BSI-W **A CLOSE WILL NEED TO BE ADDED FOR THE',
                           'EZA-S-ACCEPT SOCKET'
call new_pd 'BSI'
 
return 0
 
PROCESS_CLOSE:
 
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'CLOSE'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S'
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE +0 TO CSI-RETURN-CODE'
call new_pd 'BSI        MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'TERMAPI'qu' TO EZA-FUNCTION.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI'
 
return 0
 
PROCESS_SEND:
 
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'SEND'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE +0 TO EZA-FLAGS.'
call new_pd 'BSI        MOVE 'oper.length' TO EZA-NBYTE.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
call new_pd 'BSI'
if telnet
  then do
call new_pd 'BSI        CALL 'qu'EZACIC04'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            'oper.from
call new_pd 'BSI            EZA-NBYTE.'
call new_pd 'BSI'
  end
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S'
call new_pd 'BSI            EZA-FLAGS'
call new_pd 'BSI            EZA-NBYTE'
call new_pd 'BSI            'oper.from
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
call new_pd 'BSI        MOVE +0 TO CSI-BYTE-COUNT.'
call new_pd 'BSI        MOVE +0 TO CSI-RETURN-CODE'
call new_pd 'BSI        MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
call new_pd 'BSI'
 
return 0
 
PROCESS_RECEIVE:
 
call new_pd 'BSI'
call new_pd 'BSI        MOVE 'qu'RECV'qu' TO EZA-FUNCTION.'
call new_pd 'BSI        MOVE 'oper.descriptor' TO EZA-S-X.'
call new_pd 'BSI        MOVE +0 TO EZA-FLAGS.'
call new_pd 'BSI        MOVE 'oper.length' TO EZA-NBYTE.'
call new_pd 'BSI        MOVE +0 TO EZA-ERRNO.'
call new_pd 'BSI        MOVE +0 TO EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 1
call new_pd 'BSI        CALL 'qu'EZASOKET'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            EZA-FUNCTION'
call new_pd 'BSI            EZA-S'
call new_pd 'BSI            EZA-FLAGS'
call new_pd 'BSI            EZA-NBYTE'
call new_pd 'BSI            'oper.to
call new_pd 'BSI            EZA-ERRNO'
call new_pd 'BSI            EZA-RETCODE.'
if cicstrace
  then call CICS_TRACE 2
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            MOVE +4 TO CSI-RETURN-CODE'
call new_pd 'BSI            MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
if symbol('oper.error') = 'VAR' & oper.error \= 'IGNORE'
  then do
call new_pd 'BSI        IF EZA-RETCODE IS LESS THAN +0'
call new_pd 'BSI            GO TO 'oper.error'.'
  end
if telnet
  then do
call new_pd 'BSI        CALL 'qu'EZACIC05'qu
call new_pd 'BSI            USING'
call new_pd 'BSI            'oper.to
call new_pd 'BSI            EZA-NBYTE.'
call new_pd 'BSI'
  end
call new_pd 'BSI        MOVE EZA-RETCODE TO CSI-BYTE-COUNT.'
call new_pd 'BSI        MOVE +0 TO CSI-RETURN-CODE'
call new_pd 'BSI        MOVE CSI-RESULT-AREA TO 'oper.resultarea'.'
call new_pd 'BSI'
 
return 0
 
CICS_TRACE:
arg traceid
 
call new_pd 'BSI        EXEC CICS ENTER'
call new_pd 'BSI            TRACEID('traceid')'
call new_pd 'BSI            FROM(EZA-FUNCTION)'
call new_pd 'BSI            RESOURCE(EZA-NAME)'
call new_pd 'BSI            END-EXEC.'
 
return 0
 
NEW_PD: procedure expose pd.
arg new_line
 
j = pd.0 + 1
pd.j = new_line
pd.0 = j
 
return 0
 
WRITE_OUTPUT:
 
if os = 'CMS'
  then do
    'EXECIO' pd.0 'DISKW' outfile '0 F 80 (STEM PD. FINIS'
  end
  else do
    xc = REXXIPT('pd.')
    address jcl '// UPSI 1'
    address link 'DITTO'
  end
 
return 0