* Program SMXTERM_TYPE.COB
identification division.
program-id.     SMXTERM_TYPE.
*       This program illustrates the use of the $QIOW system
*       service to get a terminal type report from the terminal
environment division.
configuration section.
special-names.
        symbolic characters escape-char are 27.
data division.
working-storage section.
*   set up the prompt string that is used with the $QIOW
*   the prompt is ESC Z
01  prompt-string.
    03  escape-character        pic x value "".
    03  filler                  pic x value 'Z'.
01  position-report             pic x(32).
01  nposition.
    03 nblank                   pic x.
    03 filler                   pic x(31).
01  term_chan                   pic s9(9) comp.
01  io$_readprompt              pic s9(9) comp value
                                          external io$_readprompt.
01  io$m_escape                 pic s9(9) comp value
                                          external io$m_escape.
01  io$m_purge                  pic s9(9) comp value
                                          external io$m_purge.
01  function-code               pic s9(9) comp.
01  return-status               pic s9(9) comp.
01  ws-hold                     pic x(24) value spaces.
01  ws-hold1                    pic x(10) value spaces.
01  ws-pointer                  pic s9(4) comp.
01  symbol-name			pic x(9) value "TERM_TYPE".
01  symbol-value		pic x(5) value "     ".
01  symbol-table		pic s9(4) comp value 2.
01  symbol-name1		pic x(7) value "DECMATE".
01  symbol-value1		pic x    value " ".
procedure division.
begin.
*
*       assign the channel to the terminal
        call 'sys$assign' using by descriptor 'TT'
                                by reference term_chan
                                by value 0 0
                        giving return-status.
        if return-status is failure
                call 'lib$stop' using by value return-status.
*
        compute function-code = io$_readprompt + io$m_escape + io$m_purge.
*
*       output the prompt to the terminal
        call 'sys$qiow' using by value 0,
                              by value term_chan,
                              by value function-code,
                              by value 0, 0, 0,
                              by reference position-report,
                              by value 32,
                              by value 0, 0,
                              by reference prompt-string,
                              by value 4,
                        giving return-status.
        if return-status is failure
                call 'lib$stop' using by value return-status.
*
*	get the first 8 characters of the return
*
        move 1 to ws-pointer.
        unstring position-report into ws-hold with pointer ws-pointer.
*
*	move position_report to nposition.
*	move space to nblank.
*	display nposition.
*
*
        if ws-hold = "[?1;2c"
		move "DECMA" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?1;3c" 
		move "VT100" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?1;0c" 
		move "B22  " to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?6c" 
		move "RNBO " to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?61;1;2;3c" 
		move "RNBOR" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?62;1;2c"
		move "DECMA" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?62;1;2;6;7;8c" 
		move "VT220" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?62;1;2;6;7;8;9c" 
		move "VT220" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?62;1;2;3;4;6;7;8;9c" 
		move "VT241" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
        if ws-hold = "[?62;1;2;3;4;6;7;8c" 
		move "VT241" to symbol-value
		go to Set-symbol
	else 
		move "     " to symbol-value.
Set-symbol.
	call "lib$set_symbol" using by descriptor symbol-name
				    by descriptor symbol-value
				    by reference symbol-table
				giving return-status.
        if return-status is failure
                call 'lib$stop' using by value return-status.
*
*	get the first 8 characters of the return
*       
        move 1 to ws-pointer.
        unstring position-report into ws-hold1 with pointer ws-pointer.
*
*	move position_report to nposition.
*	move space to nblank.
*	display nposition.
*
*	if the device is a DECmate, set the symbol "DECMATE" to "Y" 
*	otherwise set the symbol to "N"
*
        if ws-hold1 = "[?1;2c" or  "[?61;1c" or "[?62;1c" or "[?62;1;2c" 
*		display 'This is a DECMATE'
		move "Y" to symbol-value1
		go to Set-symbol1
	else 
		move "N" to symbol-value1.
Set-symbol1.
	call "lib$set_symbol" using by descriptor symbol-name1
				    by descriptor symbol-value1
				    by reference symbol-table
				giving return-status.
        if return-status is failure
                call 'lib$stop' using by value return-status.
*
 	go to endit.
*
endit.
        stop run.