Microfocus for Windows:controlling what key is pressed? 2

[NIKOSK]

Hi,
i'm working with Microfocus Workbench ver 4.0.26 in a windows 2000 environment and i'd like to control the keyboard input
(for example when the user presses the down key, the program to navigate to the the other menu option).
Does anyone know how to do this?
And in general, where can i find the control code for each key?

Thanks in advance,
Nikos

 

[Truusvlugindewind]

Got the manuals? Go and read the "adis" sections.
(adis stands for "advanced accept display&quot

 

[webrabbit]

Actually ADIS stands for Accept/Display Interface System.

I have a pair of copybooks which I use to handle all my screen/keyboard processing, in conjuction with the SCREEN SECTION, or without it.

The copybooks, one for WORKING-STORAGE and one for PROCEDURE are very large.

There are three ways to accept keystrokes in Microfocus COBOL: The ACCEPT statement, a direct call to ADIS, and a call to "CBL_READ_KBD_CHAR". The results from the ACCEPT statment can be obtained in two ways, one using ADIS and an older way where you define the keystrokes you want to capture in a table. I have not used the older way in many years as the ADIS method is much simpler (in the program).

In order to use ADIS to capture such keystrokes as PAGEUP, you have to modify ADISCTRL, which your manuals will tell you how.

The direct call to ADIS produces results with are compatible with using ADIS with the ACCEPT statement. The call to "CBL_READ_KBD_CHAR" is not, but it is quite simple. The old table method does not produce results compatible with anything else.

If anyone would like the copybooks, I could post them here, but remember, they are quite large. They have 88-levels for all ADIS results and all "CBL_READ_KBD_CHAR" results.

 

[NIKOSK]

"...webrabbit (MIS) Apr 21, 2003
Actually ADIS stands for Accept/Display Interface System.

I have a pair of copybooks which I use to handle all my screen/keyboard processing, in conjuction with the SCREEN SECTION, or without it. "

Hi,
if you can, i'd like the copybooks you mentioned. I'm not familiar with the keybd handling issue, so it can be a reference for me.
If it's too big for the forum, email them to me (nikosk@pcs.gr)

thanks

 

[webrabbit]

Here are the copybooks:

The Working-Storage copybook.

 78  Read-Screen        Value 'CBL_READ_SCR_CHATTRS'.
 78  Write-Screen       Value 'CBL_WRITE_SCR_CHATTRS'.
 78  Read-Scr-Attrs     Value 'CBL_READ_SCR_ATTRS'.
 78  Paint-Bar          Value 'CBL_WRITE_SCR_N_ATTR'.
 78  Write-Scr-Attrs    Value 'CBL_WRITE_SCR_ATTRS'.
 78  Write-Scr-Chars    Value 'CBL_WRITE_SCR_CHARS'.
 78  Write-Scr-Field    Value 'CBL_WRITE_SCR_CHARS_ATTR'.
 78  Move-Cursor        Value 'CBL_SET_CSR_POS'.
 78  Find-Cursor        Value 'CBL_GET_CSR_POS'.
 78  Get-Scr-Size       Value 'CBL_GET_SCR_SIZE'.
 78  Test-Keyboard      Value 'CBL_GET_KBD_STATUS'.
 78  Read-Char          Value 'CBL_READ_KBD_CHAR'.
 78  Screen-Control     Value X'A7'.
 78  ADIS               Value X'AF'.
 78  Pack-Byte          Value X'F4'.
 78  Unpack-Byte        Value X'F5'.
 78  Black              Value 0.
 78  Blue               Value 1.
 78  Green              Value 2.
 78  Cyan               Value 3.
 78  Red                Value 4.
 78  Violet             Value 5.
 78  Brown              Value 6.
 78  White              Value 7.
 78  Brightness         Value 8.
 78  Flashing           Value 128.

 77  HIDE-CURSOR        Pic X(02) Value High-Value.
 77  SCREEN-START       Pic X(02) Value Low-Value.
 77  SCREEN-SIZE        Pic X(02) Value 2000 Comp-X.
 77  READ-CHAR-VIA-ADIS Pic X(01) Value   26 Comp-X.
 77  MONITOR-QUERY      Pic X(01) Value   25 Comp-X.
 77  SET-KEYS           Pic X(01) Value    1 Comp-X.
 77  SET-KEY-MAP        Pic X(01) Value    3 Comp-X.
 77  SET-CASE-UPPER     Pic X(04) Value X'01325501'.
 77  SET-CASE-MIXED     Pic X(04) Value X'00325501'.

 01  MONITOR-BYTE       Pic X(01).
     88  MONITOR-IS-TTY           Value X'00'.

 01  MONITOR-STRING.
     05                 Pic X(03).
     05                 Pic X(01).
         88  MONITOR-IS-VGA       Value X'01'.
     05                     Pic X(01).
         88  MONITOR-IS-EGA       Value X'01'.
     05                     Pic X(02).
     05                     Pic X(01).
         88  MONITOR-IS-COLOR     Value X'01'.

 01  ADIS-KEY-CONTROL.
     05  ADIS-KEY-SETTING   Pic 9(02) Comp-X.
         88  ADIS-KEY-DISABLE     Value Zero.
         88  ADIS-KEY-IS-FUNCTION Value 1.
         88  ADIS-KEY-NORMAL      Value 2.
         88  ADIS-KEY-NORMAL-PLUS Value 3.
     05                     Pic X(01) Value '2'.
     05  ADIS-KEY-1         Pic 9(02) Comp-X.
     05  ADIS-KEY-COUNT     Pic 9(02) Comp-X.

 01  ADIS-KEY-MAP.
     05  ADIS-MAP-FUNCTION  Pic 9(02) Comp-X.
     05  ADIS-MAP-KEY       Pic 9(02) Comp-X.

There are 28 ADIS Function "keys". These keys are named and
numbered below. The keystroke mapped to these "keys" is defined by the ADISCTRL file, which is updated by the ADISCF
program. The keystroke for each ADIS "key" as defined in the ADISCTRL file shipped with the Jackrabbit system is noted to the right of the definition. Note that some ADIS "keys" do not have a keystroke defined and therefore cannot be generated.

There are 37 ADIS functions. The first 28 are identical to the 28 ADIS "keys". Note that a "key" is not necessarily mapped to a function of the same name, although they are in most cases.

The default mapping of ADIS "key" to function is defined by the ADISCTRL file, which is updated by the ADISCF program. The default function for each ADIS "key" as defined in the ADISCTRL file shipped with the JackRabbit system is noted to the right of the keystroke mapping for each active ADIS "key".

The keystroke-to-"key" mapping cannot be changed by the application program, but the "key"-to-function mapping can. This is done with the following code:
MOVE function-name TO ADIS-MAP-FUNCTION
MOVE key-name TO ADIS-MAP-KEY
CALL ADIS USING SET-KEY-MAP ADIS-KEY-MAP
Note that mapping a "key" to ADIS-FUNCTION-NONE deactivates it.

Any ADIS "key" can be in one of four modes:
0 - disabled
1 - terminate accept, and if crt status is defined update
it
2 - normal
3 - normal unless the cursor would leave the field, then
[1]. Note that this mode works very much like the
AUTO option of the ACCEPT statement or a screen
definition, and is compatible with that option.

The default mode for all "keys" is 2. To change the mode, use the following code:

SET mode {see ADIS-KEY-SETTING} TO TRUE
or MOVE mode-number TO ADIS-KEY-SETTING
MOVE first-key-to-be-changed TO ADIS-KEY-1
MOVE number-of-keys-to-be-changed TO ADIS-KEY-COUNT
CALL ADIS USING SET-KEYS ADIS-KEY-CONTROL

Note that this code changes a number of contiguous keys. To
change non-contiguous keys, multiple moves and calls are required.

Note also that a "key" mapped to ADIS-FUNCTION-NONE [255] with mode ADIS-KEY-IS-FUNCTION [1] will terminate an ACCEPT, and the crt status, if defined, will contain the "key" value.

 78  ADIS-Key-Terminate-Accept  Value 0.   *>
 78  ADIS-Key-Terminate-Program Value 1.   *> Ctrl-K     1
 78  ADIS-Key-Carriage-Return   Value 2.   *> Enter     11
 78  ADIS-Key-Cursor-Left       Value 3.   *> Left       3
 78  ADIS-Key-Cursor-Right      Value 4.   *> Right      4
 78  ADIS-Key-Cursor-Up         Value 5.   *> Up         5
 78  ADIS-Key-Cursor-Down       Value 6.   *> Down       6
 78  ADIS-Key-Home              Value 7.   *> Home       7
 78  ADIS-Key-Tab               Value 8.   *> Tab       11
 78  ADIS-Key-Back-Tab          Value 9.   *> Shift-Tab 12
 78  ADIS-Key-End               Value 10.  *> End       10
 78  ADIS-Key-Next-Field        Value 11.  *>
 78  ADIS-Key-Previous-Field    Value 12.  *>
 78  ADIS-Key-Change-Case       Value 13.  *> Ctrl-F    13
 78  ADIS-Key-Erase-Character   Value 14.  *> Backspace 14
 78  ADIS-Key-Retype-Character  Value 15.  *> Ctrl-Y    15
 78  ADIS-Key-Insert-Character  Value 16.  *> Ctrl-O    16
 78  ADIS-Key-Delete-Character  Value 17.  *> Delete    17
 78  ADIS-Key-Restore-Character Value 18.  *> Ctrl-R    18
 78  ADIS-Key-Clear-To-EOF      Value 19.  *> Ctrl-Z    19
 78  ADIS-Key-Clear-Field       Value 20.  *> Ctrl-X    20
 78  ADIS-Key-Clear-TO-EOS      Value 21.  *> Ctrl-End  21
 78  ADIS-Key-Clear-Screen      Value 22.  *> Ctrl-Home 22
 78  ADIS-Key-Set-Insert-Mode   Value 23.  *> Insert    58
 78  ADIS-Key-Set-Replace-Mode  Value 24.  *>
 78  ADIS-Key-Reset-Field       Value 25.  *> Ctrl-A
 78  ADIS-Key-Start-Of-Field    Value 26.  *>
 78  ADIS-Key-Move-To-Mouse-Pos Value 27.  *>
 78  ADIS-Function-RM-Clear-Field Value 55.
 78  ADIS-Function-RM-Back-Space  Value 56.
 78  ADIS-Function-RM-Tab         Value 57.
 78  ADIS-Function-Insert-Toggle  Value 58.
 78  ADIS-Function-Replace-Toggle Value 59.
 78  ADIS-Function-Forwards-Tab   Value 60.
 78  ADIS-Function-Backwards-Tab  Value 61.
 78  ADIS-Function-Restore        Value 62.
 78  ADIS-Function-None           Value 255.

 01  SCREEN-IO-SIZE        Pic X(02) Comp-X.

 01  MSG-LINE              Pic X(02) Comp-X Value Zero.

 01  SCREEN-POSITION.
     05  SCREEN-LINE       Pic 9(02) Comp-X.
     05  SCREEN-COLUMN     Pic 9(02) Comp-X.

 01  WS-CURSOR             Pic 9(04).
 01  redefines WS-CURSOR.
     05  WS-LINE           Pic 9(02).
     05  WS-COLUMN         Pic 9(02).

 01  DATE-AND-TIME.
     05  WS-DATE-CYMD      Pic 9(08).
     05  redefines WS-DATE-CYMD.
         10  WS-DATE-C     Pic 9(02).
         10  WS-DATE-S.
             15  WS-DATE-Y Pic 9(02).
             15  WS-DATE-M Pic 9(02).
             15  WS-DATE-D Pic 9(02).
     05  WS-TIME.
         10  WS-HOUR       Pic 9(02).
         10  WS-MINUTE     Pic 9(02).
         10  WS-SECOND     Pic 9(02).
         10  WS-HUNDRETHS  Pic 9(02).

 01  FUTURE-DATE-AND-TIME.
     05  FUTURE-CCYY       Pic 9(04).
     05  redefines FUTURE-CCYY.
         10  FUTURE-CENTURY Pic 9(02).
         10  FUTURE-YEAR    Pic 9(02).
     05  FUTURE-MONTH       Pic 9(02).
     05  FUTURE-DAY         Pic 9(02).
     05  FUTURE-HOUR        Pic 9(02).
     05  FUTURE-MINUTE      Pic 9(02).
     05  FUTURE-SECOND      Pic 9(02).
     05                     Pic 9(02).

$IF DAYSIN NOT DEFINED
 78  DAYSIN Value 'Y'.
 01  Value '312831303130313130313031'.
     05  DAYS-IN            Pic 9(02) occurs 12 times.
$END

 01  WS-SCREEN-DATE.
     05                     Pic X(01) Value Space.
     05  WS-SCREEN-DATE-MM  Pic Z9.
     05                     Pic X(01) Value '/'.
     05  WS-SCREEN-DATE-DD  Pic 99.
     05                     Pic X(01) Value '/'.
     05  WS-SCREEN-DATE-YY  Pic 99.
     05                     Pic X(01) Value Space.

 01  WS-DISPLAY-TIME.
     05                     Pic X(01) Value Space.
     05  WS-HOUR-X          Pic X(02).
     05                     Pic X(01) Value ':'.
     05  WS-MINUTE-X        Pic X(02).
     05                     Pic X(01) Value ':'.
     05  WS-SECOND-X        Pic X(02).
     05                     Pic X(01) Value Space.

 01  DATE-TIME-ATTR         Pic X(01) Value X'17'.
 01  WS-TIMER               Pic 9(04).
 01  WS-TIMER-2             Pic 9(05).
 01  WS-MSG                 Pic X(80).
 01  WS-MSG-2               Pic X(80).
 01  Q1                     Pic 9(02) Comp-5.
 01  Q2                     Pic 9(02) Comp-5.
 01  MSG-MONO               Pic X(01)        Value 'X'.
 01  MSG-COLOR              Pic X(01) Comp-X Value Red.
 01  MSG-ATTR               Pic X(01) Comp-X.

 01  CRT-STATUS.
     05  CRT-STATUS-1       Pic X(01).
         88  CRT-STATUS-NORMAL-EXIT   Value Zero.
         88  CRT-STATUS-USER-FUNCTION Value '1'.
         88  CRT-STATUS-ADIS-FUNCTION Value '2'.
         88  CRT-STATUS-DATA-KEY      Value '3'.
         88  CRT-STATUS-ERROR         Value '9'.
     05  CRT-STATUS-2       Pic X(01).
         88  CRT-STATUS-TERMINATOR    Value '0'.
         88  CRT-STATUS-AUTO-SKIP     Value '1'.
     05  CRT-STATUS-3       Pic X(01).
         88  CRT-BACKSPACE            Value X'08'.
         88  CRT-C-6                  Value X'1E'.
         88  CRT-C-LEFT-BRACKET       Value X'1B'.
         88  CRT-C-MINUS              Value X'1F'.
         88  CRT-C-RIGHT-BRACKET      Value X'1D'.
         88  CRT-C-VERTICAL-BAR       Value X'1C'.
         88  CRT-ENTER                Value X'0D'.
         88  CRT-TAB                  Value X'09'.
     05  CRT-STATUS-3-N redefines
         CRT-STATUS-3       Pic X(01) Comp-X.
 01  redefines CRT-STATUS.
     05  CRT-STATUS-12      Pic X(02).
         88  CRT-A-0                  Value '1' & X'32'.
         88  CRT-A-1                  Value '1' & X'29'.
         88  CRT-A-2                  Value '1' & X'2A'.
         88  CRT-A-3                  Value '1' & X'2B'.
         88  CRT-A-4                  Value '1' & X'2C'.
         88  CRT-A-5                  Value '1' & X'2D'.
         88  CRT-A-6                  Value '1' & X'2E'.
         88  CRT-A-7                  Value '1' & X'2F'.
         88  CRT-A-8                  Value '1' & X'30'.
         88  CRT-A-9                  Value '1' & X'31'.
         88  CRT-A-A                  Value '1' & X'41'.
         88  CRT-A-B                  Value '1' & X'42'.
         88  CRT-A-C                  Value '1' & X'43'.
         88  CRT-A-D                  Value '1' & X'44'.
         88  CRT-A-E                  Value '1' & X'45'.
         88  CRT-A-EQUAL              Value '1' & X'34'.
         88  CRT-A-F                  Value '1' & X'46'.
         88  CRT-A-F1                 Value '1' & X'1F'.
         88  CRT-A-F10                Value '1' & X'28'.
         88  CRT-A-F11                Value '1' & X'61'.
         88  CRT-A-F12                Value '1' & X'62'.
         88  CRT-A-F2                 Value '1' & X'20'.
         88  CRT-A-F3                 Value '1' & X'21'.
         88  CRT-A-F4                 Value '1' & X'22'.
         88  CRT-A-F5                 Value '1' & X'23'.
         88  CRT-A-F6                 Value '1' & X'24'.
         88  CRT-A-F7                 Value '1' & X'25'.
         88  CRT-A-F8                 Value '1' & X'26'.
         88  CRT-A-F9                 Value '1' & X'27'.
         88  CRT-A-G                  Value '1' & X'47'.
         88  CRT-A-H                  Value '1' & X'48'.
         88  CRT-A-I                  Value '1' & X'49'.
         88  CRT-A-J                  Value '1' & X'4A'.
         88  CRT-A-K                  Value '1' & X'4B'.
         88  CRT-A-L                  Value '1' & X'4C'.
         88  CRT-A-M                  Value '1' & X'4D'.
         88  CRT-A-MINUS              Value '1' & X'33'.
         88  CRT-A-N                  Value '1' & X'4E'.
         88  CRT-A-O                  Value '1' & X'4F'.
         88  CRT-A-P                  Value '1' & X'50'.
         88  CRT-A-Q                  Value '1' & X'51'.
         88  CRT-A-R                  Value '1' & X'52'.
         88  CRT-A-S                  Value '1' & X'53'.
         88  CRT-A-T                  Value '1' & X'54'.
         88  CRT-A-U                  Value '1' & X'55'.
         88  CRT-A-V                  Value '1' & X'56'.
         88  CRT-A-W                  Value '1' & X'57'.
         88  CRT-A-X                  Value '1' & X'58'.
         88  CRT-A-Y                  Value '1' & X'59'.
         88  CRT-A-Z                  Value '1' & X'5A'.
         88  CRT-BACKTAB              Value '2' & X'09'.
         88  CRT-C-END                Value '2' & X'15'.
         88  CRT-C-F1                 Value '1' & X'15'.
         88  CRT-C-F10                Value '1' & X'1E'.
         88  CRT-C-F11                Value '1' & X'5F'.
         88  CRT-C-F12                Value '1' & X'60'.
         88  CRT-C-F2                 Value '1' & X'16'.
         88  CRT-C-F3                 Value '1' & X'17'.
         88  CRT-C-F4                 Value '1' & X'18'.
         88  CRT-C-F5                 Value '1' & X'19'.
         88  CRT-C-F6                 Value '1' & X'1A'.
         88  CRT-C-F7                 Value '1' & X'1B'.
         88  CRT-C-F8                 Value '1' & X'1C'.
         88  CRT-C-F9                 Value '1' & X'1D'.
         88  CRT-C-HOME               Value '2' & X'16'.
         88  CRT-C-LEFT               Value '2' & X'27'.
         88  CRT-C-PAGE-DOWN          Value '1' & X'38'.
         88  CRT-C-PAGE-UP            Value '1' & X'37'.
         88  CRT-C-RIGHT              Value '2' & X'26'.
         88  CRT-DELETE               Value '2' & X'11'.
         88  CRT-DOWN                 Value '2' & X'06'.
         88  CRT-END                  Value '2' & X'0A'.
         88  CRT-ESC                  Value '1' & X'00'.
         88  CRT-F1                   Value '1' & X'01'.
         88  CRT-F10                  Value '1' & X'0A'.
         88  CRT-F11                  Value '1' & X'5B'.
         88  CRT-F12                  Value '1' & X'5C'.
         88  CRT-F2                   Value '1' & X'02'.
         88  CRT-F3                   Value '1' & X'03'.
         88  CRT-F4                   Value '1' & X'04'.
         88  CRT-F5                   Value '1' & X'05'.
         88  CRT-F6                   Value '1' & X'06'.
         88  CRT-F7                   Value '1' & X'07'.
         88  CRT-F8                   Value '1' & X'08'.
         88  CRT-F9                   Value '1' & X'09'.
         88  CRT-HOME                 Value '2' & X'07'.
         88  CRT-INSERT               Value '2' & X'17'.
         88  CRT-LEFT                 Value '2' & X'03'.
         88  CRT-PAGE-UP              Value '1' & X'35'.
         88  CRT-PAGE-DOWN            Value '1' & X'36'.
         88  CRT-RIGHT                Value '2' & X'04'.
         88  CRT-S-F1                 Value '1' & X'0B'.
         88  CRT-S-F10                Value '1' & X'14'.
         88  CRT-S-F11                Value '1' & X'5D'.
         88  CRT-S-F12                Value '1' & X'5E'.
         88  CRT-S-F2                 Value '1' & X'0C'.
         88  CRT-S-F3                 Value '1' & X'0D'.
         88  CRT-S-F4                 Value '1' & X'0E'.
         88  CRT-S-F5                 Value '1' & X'0F'.
         88  CRT-S-F6                 Value '1' & X'10'.
         88  CRT-S-F7                 Value '1' & X'11'.
         88  CRT-S-F8                 Value '1' & X'12'.
         88  CRT-S-F9                 Value '1' & X'13'.
         88  CRT-S-TAB                Value '2' & X'12'.
         88  CRT-TAB-FUNCTION         Value '2' & X'08'.
         88  CRT-UP                   Value '2' & X'05'.

WS-CHARS is updated by the GET-CHAR and GET-CHAR-IF-ANY routines. The values returned are not compatible with the values returned from an ACCEPT statement in the CRT-STATUS field. Sometimes this incompatiblity is acceptable or even desirable. If not, the GET-CHAR-VIA-ADIS or GET-CHAR-VIA-ADIS-IF-ANY routines, which update CRT-STATUS, should be used.

"88" levels have been added for the alphabet. These include both upper and lower case. For other data keys, just check for "'x' & X'00'", where "x" is the value desired.

 01  WS-CHARS.
     05  WS-CHAR-1      Pic X(01).
     05  WS-CHAR-2      Pic X(01).
 01  redefines WS-CHARS Pic X(02).
     88  KEY-A-0          Value X'0081'.
     88  KEY-A-1          Value X'0078'.
     88  KEY-A-2          Value X'0079'.
     88  KEY-A-3          Value X'007A'.
     88  KEY-A-4          Value X'007B'.
     88  KEY-A-5          Value X'007C'.
     88  KEY-A-6          Value X'007D'.
     88  KEY-A-7          Value X'007E'.
     88  KEY-A-8          Value X'007F'.
     88  KEY-A-9          Value X'0080'.
     88  KEY-A-A          Value X'001E'.
     88  KEY-A-ACCENT     Value X'0029'.
     88  KEY-A-APOSTROPHE Value X'0028'.
     88  KEY-A-B          Value X'0030'.
     88  KEY-A-BACKSLASH  Value X'002B'.
     88  KEY-A-BACKSPACE  Value X'000E'.
     88  KEY-A-C          Value X'002E'.
     88  KEY-A-COMMA      Value X'0033'.
     88  KEY-A-D          Value X'0020'.
     88  KEY-A-DASH       Value X'0082'.
     88  KEY-A-DELETE     Value X'00A3'.
     88  KEY-A-DOWN       Value X'00A0'.
     88  KEY-A-E          Value X'0012'.
     88  KEY-A-END        Value X'009F'.
     88  KEY-A-ENTER      Value X'001C'.
     88  KEY-A-EQUAL      Value X'0083'.
     88  KEY-A-ESC        Value X'0001'.
     88  KEY-A-F          Value X'0021'.
     88  KEY-A-F1         Value X'0068'.
     88  KEY-A-F10        Value X'0071'.
     88  KEY-A-F11        Value X'008B'.
     88  KEY-A-F12        Value X'008C'.
     88  KEY-A-F2         Value X'0069'.
     88  KEY-A-F3         Value X'006A'.
     88  KEY-A-F4         Value X'006B'.
     88  KEY-A-F5         Value X'006C'.
     88  KEY-A-F6         Value X'006D'.
     88  KEY-A-F7         Value X'006E'.
     88  KEY-A-F8         Value X'006F'.
     88  KEY-A-F9         Value X'0070'.
     88  KEY-A-G          Value X'0022'.
     88  KEY-A-GREY-DASH  Value X'004A'.
     88  KEY-A-GREY-ENTER Value X'00A6'.
     88  KEY-A-GREY-PLUS  Value X'004E'.
     88  KEY-A-GREY-SLASH Value X'00A4'.
     88  KEY-A-GREY-STAR  Value X'0037'.
     88  KEY-A-H          Value X'0023'.
     88  KEY-A-HOME       Value X'0097'.
     88  KEY-A-I          Value X'0017'.
     88  KEY-A-INSERT     Value X'00A2'.
     88  KEY-A-J          Value X'0024'.
     88  KEY-A-K          Value X'0025'.
     88  KEY-A-L          Value X'0026'.
     88  KEY-A-L-BRACKET  Value X'001A'.
     88  KEY-A-LEFT       Value X'009B'.
     88  KEY-A-M          Value X'0032'.
     88  KEY-A-N          Value X'0031'.
     88  KEY-A-O          Value X'0018'.
     88  KEY-A-P          Value X'0019'.
     88  KEY-A-PAGE-DOWN  Value X'00A1'.
     88  KEY-A-PAGE-UP    Value X'0099'.
     88  KEY-A-PERIOD     Value X'0034'.
     88  KEY-A-Q          Value X'0010'.
     88  KEY-A-R          Value X'0013'.
     88  KEY-A-R-BRACKET  Value X'001B'.
     88  KEY-A-RIGHT      Value X'009D'.
     88  KEY-A-S          Value X'001F'.
     88  KEY-A-SEMICOLON  Value X'0027'.
     88  KEY-A-SLASH      Value X'0035'.
     88  KEY-A-T          Value X'0014'.
     88  KEY-A-TAB        Value X'00A5'.
     88  KEY-A-U          Value X'0016'.
     88  KEY-A-UP         Value X'0098'.
     88  KEY-A-V          Value X'002F'.
     88  KEY-A-W          Value X'0011'.
     88  KEY-A-X          Value X'002D'.
     88  KEY-A-Y          Value X'0015'.
     88  KEY-A-Z          Value X'002C'.
     88  KEY-BACKSPACE    Value X'0800'.
     88  KEY-BACKTAB      Value X'000F'.
     88  KEY-C-2          Value X'0003'.
     88  KEY-C-6          Value X'1E00'.
     88  KEY-C-A          Value X'0100'.
     88  KEY-C-B          Value X'0200'.
     88  KEY-C-BACKSLASH  Value X'1C00'.
     88  KEY-C-BACKSPACE  Value X'7F00'.
     88  KEY-C-C          Value X'0300'.
     88  KEY-C-D          Value X'0400'.
     88  KEY-C-DASH       Value X'1F00'.
     88  KEY-C-DELETE     Value X'0093'.
     88  KEY-C-DOWN       Value X'0091'.
     88  KEY-C-E          Value X'0500'.
     88  KEY-C-END        Value X'0075'.
     88  KEY-C-ENTER      Value X'0A00'.
     88  KEY-C-F          Value X'0600'.
     88  KEY-C-F1         Value X'005E'.
     88  KEY-C-F10        Value X'0067'.
     88  KEY-C-F11        Value X'0089'.
     88  KEY-C-F12        Value X'008A'.
     88  KEY-C-F2         Value X'005F'.
     88  KEY-C-F3         Value X'0060'.
     88  KEY-C-F4         Value X'0061'.
     88  KEY-C-F5         Value X'0062'.
     88  KEY-C-F6         Value X'0063'.
     88  KEY-C-F7         Value X'0064'.
     88  KEY-C-F8         Value X'0065'.
     88  KEY-C-F9         Value X'0066'.
     88  KEY-C-G          Value X'0700'.
     88  KEY-C-GREY-DASH  Value X'008E'.
     88  KEY-C-GREY-PLUS  Value X'0090'.
     88  KEY-C-GREY-SLASH Value X'0095'.
     88  KEY-C-GREY-STAR  Value X'0096'.
     88  KEY-C-H          Value X'0800'.
     88  KEY-C-HOME       Value X'0077'.
     88  KEY-C-I          Value X'0900'.
     88  KEY-C-INSERT     Value X'0092'.
     88  KEY-C-J          Value X'0A00'.
     88  KEY-C-K          Value X'0B00'.
     88  KEY-C-L          Value X'0C00'.
     88  KEY-C-L-BRACKET  Value X'1B00'.
     88  KEY-C-LEFT       Value X'0073'.
     88  KEY-C-M          Value X'0D00'.
     88  KEY-C-N          Value X'0E00'.
     88  KEY-C-O          Value X'0F00'.
     88  KEY-C-P          Value X'1000'.
     88  KEY-C-PAGE-DOWN  Value X'0076'.
     88  KEY-C-PAGE-UP    Value X'0084'.
     88  KEY-C-Q          Value X'1100'.
     88  KEY-C-R          Value X'1200'.
     88  KEY-C-R-BRACKET  Value X'1D00'.
     88  KEY-C-RIGHT      Value X'0074'.
     88  KEY-C-S          Value X'1300'.
     88  KEY-C-T          Value X'1400'.
     88  KEY-C-TAB        Value X'0094'.
     88  KEY-C-U          Value X'1500'.
     88  KEY-C-UP         Value X'008D'.
     88  KEY-C-V          Value X'1600'.
     88  KEY-C-W          Value X'1700'.
     88  KEY-C-X          Value X'1800'.
     88  KEY-C-Y          Value X'1900'.
     88  KEY-C-Z          Value X'1A00'.
     88  KEY-DELETE       Value X'0053'.
     88  KEY-DOWN         Value X'0050'.
     88  KEY-END          Value X'004F'.
     88  KEY-ENTER        Value X'0D00'.
     88  KEY-ESC          Value X'1B00'.
     88  KEY-F1           Value X'003B'.
     88  KEY-F10          Value X'0044'.
     88  KEY-F11          Value X'0085'.
     88  KEY-F12          Value X'0086'.
     88  KEY-F2           Value X'003C'.
     88  KEY-F3           Value X'003D'.
     88  KEY-F4           Value X'003E'.
     88  KEY-F5           Value X'003F'.
     88  KEY-F6           Value X'0040'.
     88  KEY-F7           Value X'0041'.
     88  KEY-F8           Value X'0042'.
     88  KEY-F9           Value X'0043'.
     88  KEY-HOME         Value X'0047'.
     88  KEY-INSERT       Value X'0052'.
     88  KEY-LEFT         Value X'004B'.
     88  KEY-PAGE-DOWN    Value X'0051'.
     88  KEY-PAGE-UP      Value X'0049'.
     88  KEY-RIGHT        Value X'004D'.
     88  KEY-S-F1         Value X'0054'.
     88  KEY-S-F10        Value X'005D'.
     88  KEY-S-F11        Value X'0087'.
     88  KEY-S-F12        Value X'0088'.
     88  KEY-S-F2         Value X'0055'.
     88  KEY-S-F3         Value X'0056'.
     88  KEY-S-F4         Value X'0057'.
     88  KEY-S-F5         Value X'0058'.
     88  KEY-S-F6         Value X'0059'.
     88  KEY-S-F7         Value X'005A'.
     88  KEY-S-F8         Value X'005B'.
     88  KEY-S-F9         Value X'005C'.
     88  KEY-S-TAB        Value X'000F'.
     88  KEY-TAB          Value X'0900'.
     88  KEY-UP           Value X'0048'.
     88  KEY-A            Value X'4100' X'6100'.
     88  KEY-B            Value X'4200' X'6200'.
     88  KEY-C            Value X'4300' X'6300'.
     88  KEY-D            Value X'4400' X'6400'.
     88  KEY-E            Value X'4500' X'6500'.
     88  KEY-F            Value X'4600' X'6600'.
     88  KEY-G            Value X'4700' X'6700'.
     88  KEY-H            Value X'4800' X'6800'.
     88  KEY-I            Value X'4900' X'6900'.
     88  KEY-J            Value X'4A00' X'6A00'.
     88  KEY-K            Value X'4B00' X'6B00'.
     88  KEY-L            Value X'4C00' X'6C00'.
     88  KEY-M            Value X'4D00' X'6D00'.
     88  KEY-N            Value X'4E00' X'6E00'.
     88  KEY-O            Value X'4F00' X'6F00'.
     88  KEY-P            Value X'5000' X'7000'.
     88  KEY-Q            Value X'5100' X'7100'.
     88  KEY-R            Value X'5200' X'7200'.
     88  KEY-S            Value X'5300' X'7300'.
     88  KEY-T            Value X'5400' X'7400'.
     88  KEY-U            Value X'5500' X'7500'.
     88  KEY-V            Value X'5600' X'7600'.
     88  KEY-W            Value X'5700' X'7700'.
     88  KEY-X            Value X'5800' X'7800'.
     88  KEY-Y            Value X'5900' X'7900'.
     88  KEY-Z            Value X'5A00' X'7A00'.
     88  KEY-SPACE        Value X'2000'.

The Procedure copybook:

 GET-CHAR-VIA-ADIS-IF-ANY.
     Call Test-Keyboard using CRT-STATUS-1
     If CRT-STATUS-1 = Low-Value
         Move Low-Value    to CRT-STATUS-2
         Move Low-Value    to CRT-STATUS-3
     Else
         Perform GET-CHAR-VIA-ADIS
     End-If
     .

 GET-CHAR-VIA-ADIS.
     Call ADIS using READ-CHAR-VIA-ADIS CRT-STATUS
     If CRT-STATUS-DATA-KEY 
     and CRT-STATUS-3 >= &quot;a&quot; and <= 'z'
         Subtract 32 from CRT-STATUS-3-N
     End-If
     .

 SET-ARROW-KEYS.
     Set ADIS-KEY-NORMAL-PLUS     to True
     Move ADIS-Key-Cursor-Left    to ADIS-KEY-1
     Move 2                       to ADIS-KEY-COUNT
     Call ADIS                 using SET-KEYS ADIS-KEY-CONTROL
     Move ADIS-Key-Previous-Field to ADIS-KEY-1
     Move 1                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     .

 RESET-ARROW-KEYS.
     Set ADIS-KEY-NORMAL          to True
     Move ADIS-Key-Cursor-Left    to ADIS-KEY-1
     Move 2                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     Move ADIS-Key-Previous-Field to ADIS-KEY-1
     Move 1                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     .

 GET-CHAR-IF-ANY.
     Call Test-Keyboard using WS-CHAR-1
     If WS-CHAR-1 = Low-Value
         Move Low-Value    to WS-CHAR-2
     Else
         Perform GET-CHAR
     End-If
     .

 GET-CHAR.
     Call Read-Char     using WS-CHAR-1
     If WS-CHAR-1 = Low-Value
         Call Read-Char using WS-CHAR-2
     Else
         Move Low-Value    to WS-CHAR-2
     End-If
     .

 GET-DATE-AND-TIME.
     Accept WS-TIME   from Time
     Move WS-HOUR       to WS-HOUR-X
     Move WS-MINUTE     to WS-MINUTE-X
     Move WS-SECOND     to WS-SECOND-X
     Accept WS-DATE-S from Date
     Move WS-DATE-M     to WS-SCREEN-DATE-MM
     Move WS-DATE-D     to WS-SCREEN-DATE-DD
     Move WS-DATE-Y     to WS-SCREEN-DATE-YY
     Move 20            to WS-DATE-C
     If WS-DATE-Y > 95
         Move 19        to WS-DATE-C
     End-If
     .

 DISPLAY-DATE-TIME.
     If MSG-MONO = 'X'
         Perform GET-MONITOR-TYPE
     End-If
     Perform GET-DATE-AND-TIME
     Move Zero               to SCREEN-LINE
     Move Zero               to SCREEN-COLUMN
     Move 10                 to SCREEN-IO-SIZE
     Call Write-Scr-Field using SCREEN-POSITION
                                WS-DISPLAY-TIME
                                SCREEN-IO-SIZE
                                DATE-TIME-ATTR
     Call Get-Scr-Size    using SCREEN-LINE SCREEN-COLUMN
     Move Zero               to SCREEN-LINE
     Subtract 10           from SCREEN-COLUMN
     Call Write-Scr-Field using SCREEN-POSITION
                                WS-SCREEN-DATE
                                SCREEN-IO-SIZE
                                DATE-TIME-ATTR
     .

 DISPLAY-MSG-AND-TIME.
     If MSG-MONO = 'X'
         Perform GET-MONITOR-TYPE
     End-If
     If WS-MSG = Space
         Move Space           to WS-MSG-2
         If MSG-MONO = 'Y'
             Move White       to MSG-COLOR
             Move Black       to MSG-ATTR
         Else
             Move Red         to MSG-COLOR
             Move Blue        to MSG-ATTR
             Multiply 16      by MSG-ATTR
         End-If
     Else
         Perform Varying Q1 from 80 by -1
                   Until WS-MSG(Q1:1) not = Space
             Continue
         End-Perform
         Compute Q2 = 41 - Q1 / 2
         Move Space           to WS-MSG-2
         Move WS-MSG          to WS-MSG-2(Q2:Q1)
         Move Space           to WS-MSG
         Move MSG-COLOR       to MSG-ATTR
         If MSG-MONO = 'Y'
             Move White       to MSG-COLOR
             Multiply 16      by MSG-ATTR
         Else
             Move Red         to MSG-COLOR
             Multiply 32      by MSG-ATTR
             Divide 2       into MSG-ATTR
             Add White        to MSG-ATTR
             Add Brightness   to MSG-ATTR
         End-If
     End-If
     If MSG-LINE = Zero
         Call Get-Scr-Size using SCREEN-LINE SCREEN-COLUMN
     Else
         Move MSG-LINE        to SCREEN-LINE
         Move Zero            to MSG-LINE
     End-If
     Subtract 1             from SCREEN-LINE
     Move 80                  to SCREEN-IO-SIZE
     Move Zero                to SCREEN-COLUMN
     Call Write-Scr-Field  using SCREEN-POSITION
                                 WS-MSG-2
                                 SCREEN-IO-SIZE
                                 MSG-ATTR
     Perform DISPLAY-DATE-TIME
     .

 BLANK-SCREEN.
     Display All X'02' 
         with FG-Clr White Highlight BG-Clr Blue
     .

 WAIT-ROUTINE.
     Perform GET-FUTURE-DATE-AND-TIME
     Move Low-Value to CRT-STATUS-1
     Perform Until CRT-STATUS-1 not = Low-Value
                or DATE-AND-TIME >= FUTURE-DATE-AND-TIME
         Perform GET-CHAR-VIA-ADIS-IF-ANY
         Perform GET-DATE-AND-TIME
     End-Perform
     .

 WAIT-ROUTINE-2.
     Perform GET-FUTURE-DATE-AND-TIME
     Move Low-Value to CRT-STATUS-1
     Perform Until CRT-STATUS-1 not = Low-Value
                or DATE-AND-TIME >= FUTURE-DATE-AND-TIME
         Perform GET-CHAR-VIA-ADIS-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 WAIT-ROUTINE-3.
     Perform GET-FUTURE-DATE-AND-TIME
     Move Low-Value to WS-CHARS
     Perform Until WS-CHARS not = Low-Value
                or DATE-AND-TIME >= FUTURE-DATE-AND-TIME
         Perform GET-CHAR-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 GET-FUTURE-DATE-AND-TIME.
     Perform GET-DATE-AND-TIME
     Move DATE-AND-TIME to FUTURE-DATE-AND-TIME
     Move WS-TIMER      to WS-TIMER-2
     Add FUTURE-SECOND  to WS-TIMER-2
     Divide 60        into WS-TIMER-2
                    Giving WS-TIMER-2
                 Remainder WS-TIMER
     Move WS-TIMER      to FUTURE-SECOND
     If WS-TIMER-2 = Zero
         Exit Paragraph
     End-If
     Add FUTURE-MINUTE  to WS-TIMER-2
     Divide 60        into WS-TIMER-2
                    Giving WS-TIMER-2
                 Remainder WS-TIMER
     Move WS-TIMER      to FUTURE-MINUTE
     Add WS-TIMER-2     to FUTURE-HOUR
     If FUTURE-HOUR < 24
         Exit Paragraph
     End-If
     Subtract 24      from FUTURE-HOUR
     Add 1              to FUTURE-DAY
     If FUTURE-DAY <= DAYS-IN(FUTURE-MONTH)
         Exit Paragraph
     End-If
     If FUTURE-MONTH = 2 and FUTURE-DAY = 29
         If FUTURE-YEAR = 00
             Move FUTURE-CENTURY
                        to WS-TIMER
         Else
             Move FUTURE-YEAR
                        to WS-TIMER
         End-If
         Divide 4     into WS-TIMER
                    Giving WS-TIMER
                 Remainder WS-TIMER-2
         If WS-TIMER-2 = Zero
             Exit Paragraph
         End-If
     End-If
     Move 1             to FUTURE-DAY
     Add 1              to FUTURE-MONTH
     If FUTURE-MONTH > 12
         Subtract 12  from FUTURE-MONTH
         Add 1          to FUTURE-CCYY
     End-If
     .

 WAIT-FOR-CHAR.
     Move Low-Value       to CRT-STATUS-1
     Perform Until CRT-STATUS-1 not = Low-Value
         Perform GET-CHAR-VIA-ADIS-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 WAIT-FOR-KEYSTROKE.
     Move Low-Value       to WS-CHARS
     Perform Until WS-CHARS not = Low-Value
         Perform GET-CHAR-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 WAIT-FOR-Y-OR-N.
     If WS-MSG = Space
         Move 'Are you sure?  Press &quot;Y&quot; or &quot;N&quot;.' to WS-MSG
     End-If
     Perform DISPLAY-MSG-AND-TIME
     Call Move-Cursor using HIDE-CURSOR
     Perform Until Exit
         Perform GET-CHAR-IF-ANY
         If KEY-Y or KEY-N
             Exit Perform
         End-If
         Perform DISPLAY-DATE-TIME
     End-Perform
     Perform DISPLAY-MSG-AND-TIME
     .

 GET-MONITOR-TYPE.
     Call Screen-Control using MONITOR-QUERY MONITOR-BYTE
     Call Unpack-Byte    using MONITOR-BYTE  MONITOR-STRING
     Move 'Y'               to MSG-MONO
     Move X'07'             to DATE-TIME-ATTR
     If MONITOR-IS-COLOR
         Move X'17'         to DATE-TIME-ATTR
         Move 'N'           to MSG-MONO
     End-If
     .

 

[webrabbit]

Here is the Working-Storage copybook:

 78  Read-Screen        Value 'CBL_READ_SCR_CHATTRS'.
 78  Write-Screen       Value 'CBL_WRITE_SCR_CHATTRS'.
 78  Read-Scr-Attrs     Value 'CBL_READ_SCR_ATTRS'.
 78  Paint-Bar          Value 'CBL_WRITE_SCR_N_ATTR'.
 78  Write-Scr-Attrs    Value 'CBL_WRITE_SCR_ATTRS'.
 78  Write-Scr-Chars    Value 'CBL_WRITE_SCR_CHARS'.
 78  Write-Scr-Field    Value 'CBL_WRITE_SCR_CHARS_ATTR'.
 78  Move-Cursor        Value 'CBL_SET_CSR_POS'.
 78  Find-Cursor        Value 'CBL_GET_CSR_POS'.
 78  Get-Scr-Size       Value 'CBL_GET_SCR_SIZE'.
 78  Test-Keyboard      Value 'CBL_GET_KBD_STATUS'.
 78  Read-Char          Value 'CBL_READ_KBD_CHAR'.
 78  Screen-Control     Value X'A7'.
 78  ADIS               Value X'AF'.
 78  Pack-Byte          Value X'F4'.
 78  Unpack-Byte        Value X'F5'.
 78  Black              Value 0.
 78  Blue               Value 1.
 78  Green              Value 2.
 78  Cyan               Value 3.
 78  Red                Value 4.
 78  Violet             Value 5.
 78  Brown              Value 6.
 78  White              Value 7.
 78  Brightness         Value 8.
 78  Flashing           Value 128.

 77  HIDE-CURSOR        Pic X(02) Value High-Value.
 77  SCREEN-START       Pic X(02) Value Low-Value.
 77  SCREEN-SIZE        Pic X(02) Value 2000 Comp-X.
 77  READ-CHAR-VIA-ADIS Pic X(01) Value   26 Comp-X.
 77  MONITOR-QUERY      Pic X(01) Value   25 Comp-X.
 77  SET-KEYS           Pic X(01) Value    1 Comp-X.
 77  SET-KEY-MAP        Pic X(01) Value    3 Comp-X.
 77  SET-CASE-UPPER     Pic X(04) Value X'01325501'.
 77  SET-CASE-MIXED     Pic X(04) Value X'00325501'.

 01  MONITOR-BYTE       Pic X(01).
     88  MONITOR-IS-TTY           Value X'00'.

 01  MONITOR-STRING.
     05                 Pic X(03).
     05                 Pic X(01).
         88  MONITOR-IS-VGA       Value X'01'.
     05                     Pic X(01).
         88  MONITOR-IS-EGA       Value X'01'.
     05                     Pic X(02).
     05                     Pic X(01).
         88  MONITOR-IS-COLOR     Value X'01'.

 01  ADIS-KEY-CONTROL.
     05  ADIS-KEY-SETTING   Pic 9(02) Comp-X.
         88  ADIS-KEY-DISABLE     Value Zero.
         88  ADIS-KEY-IS-FUNCTION Value 1.
         88  ADIS-KEY-NORMAL      Value 2.
         88  ADIS-KEY-NORMAL-PLUS Value 3.
     05                     Pic X(01) Value '2'.
     05  ADIS-KEY-1         Pic 9(02) Comp-X.
     05  ADIS-KEY-COUNT     Pic 9(02) Comp-X.

 01  ADIS-KEY-MAP.
     05  ADIS-MAP-FUNCTION  Pic 9(02) Comp-X.
     05  ADIS-MAP-KEY       Pic 9(02) Comp-X.

There are 28 ADIS Function "keys". These keys are named and
numbered below. The keystroke mapped to these "keys" is defined by the ADISCTRL file, which is updated by the ADISCF
program. The keystroke for each ADIS "key" as defined in the ADISCTRL file shipped with the Jackrabbit system is noted to the right of the definition. Note that some ADIS "keys" do not have a keystroke defined and therefore cannot be generated.

There are 37 ADIS functions. The first 28 are identical to the 28 ADIS "keys". Note that a "key" is not necessarily mapped to a function of the same name, although they are in most cases.

The default mapping of ADIS "key" to function is defined by the ADISCTRL file, which is updated by the ADISCF program. The default function for each ADIS "key" as defined in the ADISCTRL file shipped with the JackRabbit system is noted to the right of the keystroke mapping for each active ADIS "key".

The keystroke-to-"key" mapping cannot be changed by the application program, but the "key"-to-function mapping can. This is done with the following code:
MOVE function-name TO ADIS-MAP-FUNCTION
MOVE key-name TO ADIS-MAP-KEY
CALL ADIS USING SET-KEY-MAP ADIS-KEY-MAP
Note that mapping a "key" to ADIS-FUNCTION-NONE deactivates it.

Any ADIS "key" can be in one of four modes:
0 - disabled
1 - terminate accept, and if crt status is defined update
it
2 - normal
3 - normal unless the cursor would leave the field, then
[1]. Note that this mode works very much like the
AUTO option of the ACCEPT statement or a screen
definition, and is compatible with that option.

The default mode for all "keys" is 2. To change the mode, use the following code:

SET mode {see ADIS-KEY-SETTING} TO TRUE
or MOVE mode-number TO ADIS-KEY-SETTING
MOVE first-key-to-be-changed TO ADIS-KEY-1
MOVE number-of-keys-to-be-changed TO ADIS-KEY-COUNT
CALL ADIS USING SET-KEYS ADIS-KEY-CONTROL

Note that this code changes a number of contiguous keys. To
change non-contiguous keys, multiple moves and calls are required.

Note also that a "key" mapped to ADIS-FUNCTION-NONE [255] with mode ADIS-KEY-IS-FUNCTION [1] will terminate an ACCEPT, and the crt status, if defined, will contain the "key" value.

 78  ADIS-Key-Terminate-Accept  Value 0.   *>
 78  ADIS-Key-Terminate-Program Value 1.   *> Ctrl-K     1
 78  ADIS-Key-Carriage-Return   Value 2.   *> Enter     11
 78  ADIS-Key-Cursor-Left       Value 3.   *> Left       3
 78  ADIS-Key-Cursor-Right      Value 4.   *> Right      4
 78  ADIS-Key-Cursor-Up         Value 5.   *> Up         5
 78  ADIS-Key-Cursor-Down       Value 6.   *> Down       6
 78  ADIS-Key-Home              Value 7.   *> Home       7
 78  ADIS-Key-Tab               Value 8.   *> Tab       11
 78  ADIS-Key-Back-Tab          Value 9.   *> Shift-Tab 12
 78  ADIS-Key-End               Value 10.  *> End       10
 78  ADIS-Key-Next-Field        Value 11.  *>
 78  ADIS-Key-Previous-Field    Value 12.  *>
 78  ADIS-Key-Change-Case       Value 13.  *> Ctrl-F    13
 78  ADIS-Key-Erase-Character   Value 14.  *> Backspace 14
 78  ADIS-Key-Retype-Character  Value 15.  *> Ctrl-Y    15
 78  ADIS-Key-Insert-Character  Value 16.  *> Ctrl-O    16
 78  ADIS-Key-Delete-Character  Value 17.  *> Delete    17
 78  ADIS-Key-Restore-Character Value 18.  *> Ctrl-R    18
 78  ADIS-Key-Clear-To-EOF      Value 19.  *> Ctrl-Z    19
 78  ADIS-Key-Clear-Field       Value 20.  *> Ctrl-X    20
 78  ADIS-Key-Clear-TO-EOS      Value 21.  *> Ctrl-End  21
 78  ADIS-Key-Clear-Screen      Value 22.  *> Ctrl-Home 22
 78  ADIS-Key-Set-Insert-Mode   Value 23.  *> Insert    58
 78  ADIS-Key-Set-Replace-Mode  Value 24.  *>
 78  ADIS-Key-Reset-Field       Value 25.  *> Ctrl-A
 78  ADIS-Key-Start-Of-Field    Value 26.  *>
 78  ADIS-Key-Move-To-Mouse-Pos Value 27.  *>
 78  ADIS-Function-RM-Clear-Field Value 55.
 78  ADIS-Function-RM-Back-Space  Value 56.
 78  ADIS-Function-RM-Tab         Value 57.
 78  ADIS-Function-Insert-Toggle  Value 58.
 78  ADIS-Function-Replace-Toggle Value 59.
 78  ADIS-Function-Forwards-Tab   Value 60.
 78  ADIS-Function-Backwards-Tab  Value 61.
 78  ADIS-Function-Restore        Value 62.
 78  ADIS-Function-None           Value 255.

 01  SCREEN-IO-SIZE        Pic X(02) Comp-X.

 01  MSG-LINE              Pic X(02) Comp-X Value Zero.

 01  SCREEN-POSITION.
     05  SCREEN-LINE       Pic 9(02) Comp-X.
     05  SCREEN-COLUMN     Pic 9(02) Comp-X.

 01  WS-CURSOR             Pic 9(04).
 01  redefines WS-CURSOR.
     05  WS-LINE           Pic 9(02).
     05  WS-COLUMN         Pic 9(02).

 01  DATE-AND-TIME.
     05  WS-DATE-CYMD      Pic 9(08).
     05  redefines WS-DATE-CYMD.
         10  WS-DATE-C     Pic 9(02).
         10  WS-DATE-S.
             15  WS-DATE-Y Pic 9(02).
             15  WS-DATE-M Pic 9(02).
             15  WS-DATE-D Pic 9(02).
     05  WS-TIME.
         10  WS-HOUR       Pic 9(02).
         10  WS-MINUTE     Pic 9(02).
         10  WS-SECOND     Pic 9(02).
         10  WS-HUNDRETHS  Pic 9(02).

 01  FUTURE-DATE-AND-TIME.
     05  FUTURE-CCYY       Pic 9(04).
     05  redefines FUTURE-CCYY.
         10  FUTURE-CENTURY Pic 9(02).
         10  FUTURE-YEAR    Pic 9(02).
     05  FUTURE-MONTH       Pic 9(02).
     05  FUTURE-DAY         Pic 9(02).
     05  FUTURE-HOUR        Pic 9(02).
     05  FUTURE-MINUTE      Pic 9(02).
     05  FUTURE-SECOND      Pic 9(02).
     05                     Pic 9(02).

$IF DAYSIN NOT DEFINED
 78  DAYSIN Value 'Y'.
 01  Value '312831303130313130313031'.
     05  DAYS-IN            Pic 9(02) occurs 12 times.
$END

 01  WS-SCREEN-DATE.
     05                     Pic X(01) Value Space.
     05  WS-SCREEN-DATE-MM  Pic Z9.
     05                     Pic X(01) Value '/'.
     05  WS-SCREEN-DATE-DD  Pic 99.
     05                     Pic X(01) Value '/'.
     05  WS-SCREEN-DATE-YY  Pic 99.
     05                     Pic X(01) Value Space.

 01  WS-DISPLAY-TIME.
     05                     Pic X(01) Value Space.
     05  WS-HOUR-X          Pic X(02).
     05                     Pic X(01) Value ':'.
     05  WS-MINUTE-X        Pic X(02).
     05                     Pic X(01) Value ':'.
     05  WS-SECOND-X        Pic X(02).
     05                     Pic X(01) Value Space.

 01  DATE-TIME-ATTR         Pic X(01) Value X'17'.
 01  WS-TIMER               Pic 9(04).
 01  WS-TIMER-2             Pic 9(05).
 01  WS-MSG                 Pic X(80).
 01  WS-MSG-2               Pic X(80).
 01  Q1                     Pic 9(02) Comp-5.
 01  Q2                     Pic 9(02) Comp-5.
 01  MSG-MONO               Pic X(01)        Value 'X'.
 01  MSG-COLOR              Pic X(01) Comp-X Value Red.
 01  MSG-ATTR               Pic X(01) Comp-X.

 01  CRT-STATUS.
     05  CRT-STATUS-1       Pic X(01).
         88  CRT-STATUS-NORMAL-EXIT   Value Zero.
         88  CRT-STATUS-USER-FUNCTION Value '1'.
         88  CRT-STATUS-ADIS-FUNCTION Value '2'.
         88  CRT-STATUS-DATA-KEY      Value '3'.
         88  CRT-STATUS-ERROR         Value '9'.
     05  CRT-STATUS-2       Pic X(01).
         88  CRT-STATUS-TERMINATOR    Value '0'.
         88  CRT-STATUS-AUTO-SKIP     Value '1'.
     05  CRT-STATUS-3       Pic X(01).
         88  CRT-BACKSPACE            Value X'08'.
         88  CRT-C-6                  Value X'1E'.
         88  CRT-C-LEFT-BRACKET       Value X'1B'.
         88  CRT-C-MINUS              Value X'1F'.
         88  CRT-C-RIGHT-BRACKET      Value X'1D'.
         88  CRT-C-VERTICAL-BAR       Value X'1C'.
         88  CRT-ENTER                Value X'0D'.
         88  CRT-TAB                  Value X'09'.
     05  CRT-STATUS-3-N redefines
         CRT-STATUS-3       Pic X(01) Comp-X.
 01  redefines CRT-STATUS.
     05  CRT-STATUS-12      Pic X(02).
         88  CRT-A-0                  Value '1' & X'32'.
         88  CRT-A-1                  Value '1' & X'29'.
         88  CRT-A-2                  Value '1' & X'2A'.
         88  CRT-A-3                  Value '1' & X'2B'.
         88  CRT-A-4                  Value '1' & X'2C'.
         88  CRT-A-5                  Value '1' & X'2D'.
         88  CRT-A-6                  Value '1' & X'2E'.
         88  CRT-A-7                  Value '1' & X'2F'.
         88  CRT-A-8                  Value '1' & X'30'.
         88  CRT-A-9                  Value '1' & X'31'.
         88  CRT-A-A                  Value '1' & X'41'.
         88  CRT-A-B                  Value '1' & X'42'.
         88  CRT-A-C                  Value '1' & X'43'.
         88  CRT-A-D                  Value '1' & X'44'.
         88  CRT-A-E                  Value '1' & X'45'.
         88  CRT-A-EQUAL              Value '1' & X'34'.
         88  CRT-A-F                  Value '1' & X'46'.
         88  CRT-A-F1                 Value '1' & X'1F'.
         88  CRT-A-F10                Value '1' & X'28'.
         88  CRT-A-F11                Value '1' & X'61'.
         88  CRT-A-F12                Value '1' & X'62'.
         88  CRT-A-F2                 Value '1' & X'20'.
         88  CRT-A-F3                 Value '1' & X'21'.
         88  CRT-A-F4                 Value '1' & X'22'.
         88  CRT-A-F5                 Value '1' & X'23'.
         88  CRT-A-F6                 Value '1' & X'24'.
         88  CRT-A-F7                 Value '1' & X'25'.
         88  CRT-A-F8                 Value '1' & X'26'.
         88  CRT-A-F9                 Value '1' & X'27'.
         88  CRT-A-G                  Value '1' & X'47'.
         88  CRT-A-H                  Value '1' & X'48'.
         88  CRT-A-I                  Value '1' & X'49'.
         88  CRT-A-J                  Value '1' & X'4A'.
         88  CRT-A-K                  Value '1' & X'4B'.
         88  CRT-A-L                  Value '1' & X'4C'.
         88  CRT-A-M                  Value '1' & X'4D'.
         88  CRT-A-MINUS              Value '1' & X'33'.
         88  CRT-A-N                  Value '1' & X'4E'.
         88  CRT-A-O                  Value '1' & X'4F'.
         88  CRT-A-P                  Value '1' & X'50'.
         88  CRT-A-Q                  Value '1' & X'51'.
         88  CRT-A-R                  Value '1' & X'52'.
         88  CRT-A-S                  Value '1' & X'53'.
         88  CRT-A-T                  Value '1' & X'54'.
         88  CRT-A-U                  Value '1' & X'55'.
         88  CRT-A-V                  Value '1' & X'56'.
         88  CRT-A-W                  Value '1' & X'57'.
         88  CRT-A-X                  Value '1' & X'58'.
         88  CRT-A-Y                  Value '1' & X'59'.
         88  CRT-A-Z                  Value '1' & X'5A'.
         88  CRT-BACKTAB              Value '2' & X'09'.
         88  CRT-C-END                Value '2' & X'15'.
         88  CRT-C-F1                 Value '1' & X'15'.
         88  CRT-C-F10                Value '1' & X'1E'.
         88  CRT-C-F11                Value '1' & X'5F'.
         88  CRT-C-F12                Value '1' & X'60'.
         88  CRT-C-F2                 Value '1' & X'16'.
         88  CRT-C-F3                 Value '1' & X'17'.
         88  CRT-C-F4                 Value '1' & X'18'.
         88  CRT-C-F5                 Value '1' & X'19'.
         88  CRT-C-F6                 Value '1' & X'1A'.
         88  CRT-C-F7                 Value '1' & X'1B'.
         88  CRT-C-F8                 Value '1' & X'1C'.
         88  CRT-C-F9                 Value '1' & X'1D'.
         88  CRT-C-HOME               Value '2' & X'16'.
         88  CRT-C-LEFT               Value '2' & X'27'.
         88  CRT-C-PAGE-DOWN          Value '1' & X'38'.
         88  CRT-C-PAGE-UP            Value '1' & X'37'.
         88  CRT-C-RIGHT              Value '2' & X'26'.
         88  CRT-DELETE               Value '2' & X'11'.
         88  CRT-DOWN                 Value '2' & X'06'.
         88  CRT-END                  Value '2' & X'0A'.
         88  CRT-ESC                  Value '1' & X'00'.
         88  CRT-F1                   Value '1' & X'01'.
         88  CRT-F10                  Value '1' & X'0A'.
         88  CRT-F11                  Value '1' & X'5B'.
         88  CRT-F12                  Value '1' & X'5C'.
         88  CRT-F2                   Value '1' & X'02'.
         88  CRT-F3                   Value '1' & X'03'.
         88  CRT-F4                   Value '1' & X'04'.
         88  CRT-F5                   Value '1' & X'05'.
         88  CRT-F6                   Value '1' & X'06'.
         88  CRT-F7                   Value '1' & X'07'.
         88  CRT-F8                   Value '1' & X'08'.
         88  CRT-F9                   Value '1' & X'09'.
         88  CRT-HOME                 Value '2' & X'07'.
         88  CRT-INSERT               Value '2' & X'17'.
         88  CRT-LEFT                 Value '2' & X'03'.
         88  CRT-PAGE-UP              Value '1' & X'35'.
         88  CRT-PAGE-DOWN            Value '1' & X'36'.
         88  CRT-RIGHT                Value '2' & X'04'.
         88  CRT-S-F1                 Value '1' & X'0B'.
         88  CRT-S-F10                Value '1' & X'14'.
         88  CRT-S-F11                Value '1' & X'5D'.
         88  CRT-S-F12                Value '1' & X'5E'.
         88  CRT-S-F2                 Value '1' & X'0C'.
         88  CRT-S-F3                 Value '1' & X'0D'.
         88  CRT-S-F4                 Value '1' & X'0E'.
         88  CRT-S-F5                 Value '1' & X'0F'.
         88  CRT-S-F6                 Value '1' & X'10'.
         88  CRT-S-F7                 Value '1' & X'11'.
         88  CRT-S-F8                 Value '1' & X'12'.
         88  CRT-S-F9                 Value '1' & X'13'.
         88  CRT-S-TAB                Value '2' & X'12'.
         88  CRT-TAB-FUNCTION         Value '2' & X'08'.
         88  CRT-UP                   Value '2' & X'05'.

WS-CHARS is updated by the GET-CHAR and GET-CHAR-IF-ANY routines. The values returned are not compatible with the values returned from an ACCEPT statement in the CRT-STATUS field. Sometimes this incompatiblity is acceptable or even desirable. If not, the GET-CHAR-VIA-ADIS or GET-CHAR-VIA-ADIS-IF-ANY routines, which update CRT-STATUS, should be used.

"88" levels have been added for the alphabet. These include both upper and lower case. For other data keys, just check for "'x' & X'00'", where "x" is the value desired.

 01  WS-CHARS.
     05  WS-CHAR-1      Pic X(01).
     05  WS-CHAR-2      Pic X(01).
 01  redefines WS-CHARS Pic X(02).
     88  KEY-A-0          Value X'0081'.
     88  KEY-A-1          Value X'0078'.
     88  KEY-A-2          Value X'0079'.
     88  KEY-A-3          Value X'007A'.
     88  KEY-A-4          Value X'007B'.
     88  KEY-A-5          Value X'007C'.
     88  KEY-A-6          Value X'007D'.
     88  KEY-A-7          Value X'007E'.
     88  KEY-A-8          Value X'007F'.
     88  KEY-A-9          Value X'0080'.
     88  KEY-A-A          Value X'001E'.
     88  KEY-A-ACCENT     Value X'0029'.
     88  KEY-A-APOSTROPHE Value X'0028'.
     88  KEY-A-B          Value X'0030'.
     88  KEY-A-BACKSLASH  Value X'002B'.
     88  KEY-A-BACKSPACE  Value X'000E'.
     88  KEY-A-C          Value X'002E'.
     88  KEY-A-COMMA      Value X'0033'.
     88  KEY-A-D          Value X'0020'.
     88  KEY-A-DASH       Value X'0082'.
     88  KEY-A-DELETE     Value X'00A3'.
     88  KEY-A-DOWN       Value X'00A0'.
     88  KEY-A-E          Value X'0012'.
     88  KEY-A-END        Value X'009F'.
     88  KEY-A-ENTER      Value X'001C'.
     88  KEY-A-EQUAL      Value X'0083'.
     88  KEY-A-ESC        Value X'0001'.
     88  KEY-A-F          Value X'0021'.
     88  KEY-A-F1         Value X'0068'.
     88  KEY-A-F10        Value X'0071'.
     88  KEY-A-F11        Value X'008B'.
     88  KEY-A-F12        Value X'008C'.
     88  KEY-A-F2         Value X'0069'.
     88  KEY-A-F3         Value X'006A'.
     88  KEY-A-F4         Value X'006B'.
     88  KEY-A-F5         Value X'006C'.
     88  KEY-A-F6         Value X'006D'.
     88  KEY-A-F7         Value X'006E'.
     88  KEY-A-F8         Value X'006F'.
     88  KEY-A-F9         Value X'0070'.
     88  KEY-A-G          Value X'0022'.
     88  KEY-A-GREY-DASH  Value X'004A'.
     88  KEY-A-GREY-ENTER Value X'00A6'.
     88  KEY-A-GREY-PLUS  Value X'004E'.
     88  KEY-A-GREY-SLASH Value X'00A4'.
     88  KEY-A-GREY-STAR  Value X'0037'.
     88  KEY-A-H          Value X'0023'.
     88  KEY-A-HOME       Value X'0097'.
     88  KEY-A-I          Value X'0017'.
     88  KEY-A-INSERT     Value X'00A2'.
     88  KEY-A-J          Value X'0024'.
     88  KEY-A-K          Value X'0025'.
     88  KEY-A-L          Value X'0026'.
     88  KEY-A-L-BRACKET  Value X'001A'.
     88  KEY-A-LEFT       Value X'009B'.
     88  KEY-A-M          Value X'0032'.
     88  KEY-A-N          Value X'0031'.
     88  KEY-A-O          Value X'0018'.
     88  KEY-A-P          Value X'0019'.
     88  KEY-A-PAGE-DOWN  Value X'00A1'.
     88  KEY-A-PAGE-UP    Value X'0099'.
     88  KEY-A-PERIOD     Value X'0034'.
     88  KEY-A-Q          Value X'0010'.
     88  KEY-A-R          Value X'0013'.
     88  KEY-A-R-BRACKET  Value X'001B'.
     88  KEY-A-RIGHT      Value X'009D'.
     88  KEY-A-S          Value X'001F'.
     88  KEY-A-SEMICOLON  Value X'0027'.
     88  KEY-A-SLASH      Value X'0035'.
     88  KEY-A-T          Value X'0014'.
     88  KEY-A-TAB        Value X'00A5'.
     88  KEY-A-U          Value X'0016'.
     88  KEY-A-UP         Value X'0098'.
     88  KEY-A-V          Value X'002F'.
     88  KEY-A-W          Value X'0011'.
     88  KEY-A-X          Value X'002D'.
     88  KEY-A-Y          Value X'0015'.
     88  KEY-A-Z          Value X'002C'.
     88  KEY-BACKSPACE    Value X'0800'.
     88  KEY-BACKTAB      Value X'000F'.
     88  KEY-C-2          Value X'0003'.
     88  KEY-C-6          Value X'1E00'.
     88  KEY-C-A          Value X'0100'.
     88  KEY-C-B          Value X'0200'.
     88  KEY-C-BACKSLASH  Value X'1C00'.
     88  KEY-C-BACKSPACE  Value X'7F00'.
     88  KEY-C-C          Value X'0300'.
     88  KEY-C-D          Value X'0400'.
     88  KEY-C-DASH       Value X'1F00'.
     88  KEY-C-DELETE     Value X'0093'.
     88  KEY-C-DOWN       Value X'0091'.
     88  KEY-C-E          Value X'0500'.
     88  KEY-C-END        Value X'0075'.
     88  KEY-C-ENTER      Value X'0A00'.
     88  KEY-C-F          Value X'0600'.
     88  KEY-C-F1         Value X'005E'.
     88  KEY-C-F10        Value X'0067'.
     88  KEY-C-F11        Value X'0089'.
     88  KEY-C-F12        Value X'008A'.
     88  KEY-C-F2         Value X'005F'.
     88  KEY-C-F3         Value X'0060'.
     88  KEY-C-F4         Value X'0061'.
     88  KEY-C-F5         Value X'0062'.
     88  KEY-C-F6         Value X'0063'.
     88  KEY-C-F7         Value X'0064'.
     88  KEY-C-F8         Value X'0065'.
     88  KEY-C-F9         Value X'0066'.
     88  KEY-C-G          Value X'0700'.
     88  KEY-C-GREY-DASH  Value X'008E'.
     88  KEY-C-GREY-PLUS  Value X'0090'.
     88  KEY-C-GREY-SLASH Value X'0095'.
     88  KEY-C-GREY-STAR  Value X'0096'.
     88  KEY-C-H          Value X'0800'.
     88  KEY-C-HOME       Value X'0077'.
     88  KEY-C-I          Value X'0900'.
     88  KEY-C-INSERT     Value X'0092'.
     88  KEY-C-J          Value X'0A00'.
     88  KEY-C-K          Value X'0B00'.
     88  KEY-C-L          Value X'0C00'.
     88  KEY-C-L-BRACKET  Value X'1B00'.
     88  KEY-C-LEFT       Value X'0073'.
     88  KEY-C-M          Value X'0D00'.
     88  KEY-C-N          Value X'0E00'.
     88  KEY-C-O          Value X'0F00'.
     88  KEY-C-P          Value X'1000'.
     88  KEY-C-PAGE-DOWN  Value X'0076'.
     88  KEY-C-PAGE-UP    Value X'0084'.
     88  KEY-C-Q          Value X'1100'.
     88  KEY-C-R          Value X'1200'.
     88  KEY-C-R-BRACKET  Value X'1D00'.
     88  KEY-C-RIGHT      Value X'0074'.
     88  KEY-C-S          Value X'1300'.
     88  KEY-C-T          Value X'1400'.
     88  KEY-C-TAB        Value X'0094'.
     88  KEY-C-U          Value X'1500'.
     88  KEY-C-UP         Value X'008D'.
     88  KEY-C-V          Value X'1600'.
     88  KEY-C-W          Value X'1700'.
     88  KEY-C-X          Value X'1800'.
     88  KEY-C-Y          Value X'1900'.
     88  KEY-C-Z          Value X'1A00'.
     88  KEY-DELETE       Value X'0053'.
     88  KEY-DOWN         Value X'0050'.
     88  KEY-END          Value X'004F'.
     88  KEY-ENTER        Value X'0D00'.
     88  KEY-ESC          Value X'1B00'.
     88  KEY-F1           Value X'003B'.
     88  KEY-F10          Value X'0044'.
     88  KEY-F11          Value X'0085'.
     88  KEY-F12          Value X'0086'.
     88  KEY-F2           Value X'003C'.
     88  KEY-F3           Value X'003D'.
     88  KEY-F4           Value X'003E'.
     88  KEY-F5           Value X'003F'.
     88  KEY-F6           Value X'0040'.
     88  KEY-F7           Value X'0041'.
     88  KEY-F8           Value X'0042'.
     88  KEY-F9           Value X'0043'.
     88  KEY-HOME         Value X'0047'.
     88  KEY-INSERT       Value X'0052'.
     88  KEY-LEFT         Value X'004B'.
     88  KEY-PAGE-DOWN    Value X'0051'.
     88  KEY-PAGE-UP      Value X'0049'.
     88  KEY-RIGHT        Value X'004D'.
     88  KEY-S-F1         Value X'0054'.
     88  KEY-S-F10        Value X'005D'.
     88  KEY-S-F11        Value X'0087'.
     88  KEY-S-F12        Value X'0088'.
     88  KEY-S-F2         Value X'0055'.
     88  KEY-S-F3         Value X'0056'.
     88  KEY-S-F4         Value X'0057'.
     88  KEY-S-F5         Value X'0058'.
     88  KEY-S-F6         Value X'0059'.
     88  KEY-S-F7         Value X'005A'.
     88  KEY-S-F8         Value X'005B'.
     88  KEY-S-F9         Value X'005C'.
     88  KEY-S-TAB        Value X'000F'.
     88  KEY-TAB          Value X'0900'.
     88  KEY-UP           Value X'0048'.
     88  KEY-A            Value X'4100' X'6100'.
     88  KEY-B            Value X'4200' X'6200'.
     88  KEY-C            Value X'4300' X'6300'.
     88  KEY-D            Value X'4400' X'6400'.
     88  KEY-E            Value X'4500' X'6500'.
     88  KEY-F            Value X'4600' X'6600'.
     88  KEY-G            Value X'4700' X'6700'.
     88  KEY-H            Value X'4800' X'6800'.
     88  KEY-I            Value X'4900' X'6900'.
     88  KEY-J            Value X'4A00' X'6A00'.
     88  KEY-K            Value X'4B00' X'6B00'.
     88  KEY-L            Value X'4C00' X'6C00'.
     88  KEY-M            Value X'4D00' X'6D00'.
     88  KEY-N            Value X'4E00' X'6E00'.
     88  KEY-O            Value X'4F00' X'6F00'.
     88  KEY-P            Value X'5000' X'7000'.
     88  KEY-Q            Value X'5100' X'7100'.
     88  KEY-R            Value X'5200' X'7200'.
     88  KEY-S            Value X'5300' X'7300'.
     88  KEY-T            Value X'5400' X'7400'.
     88  KEY-U            Value X'5500' X'7500'.
     88  KEY-V            Value X'5600' X'7600'.
     88  KEY-W            Value X'5700' X'7700'.
     88  KEY-X            Value X'5800' X'7800'.
     88  KEY-Y            Value X'5900' X'7900'.
     88  KEY-Z            Value X'5A00' X'7A00'.
     88  KEY-SPACE        Value X'2000'.

 

[webrabbit]

Here is the rest of the Working-Storage copybook:

     88  KEY-F4           Value X'003E'.
     88  KEY-F5           Value X'003F'.
     88  KEY-F6           Value X'0040'.
     88  KEY-F7           Value X'0041'.
     88  KEY-F8           Value X'0042'.
     88  KEY-F9           Value X'0043'.
     88  KEY-HOME         Value X'0047'.
     88  KEY-INSERT       Value X'0052'.
     88  KEY-LEFT         Value X'004B'.
     88  KEY-PAGE-DOWN    Value X'0051'.
     88  KEY-PAGE-UP      Value X'0049'.
     88  KEY-RIGHT        Value X'004D'.
     88  KEY-S-F1         Value X'0054'.
     88  KEY-S-F10        Value X'005D'.
     88  KEY-S-F11        Value X'0087'.
     88  KEY-S-F12        Value X'0088'.
     88  KEY-S-F2         Value X'0055'.
     88  KEY-S-F3         Value X'0056'.
     88  KEY-S-F4         Value X'0057'.
     88  KEY-S-F5         Value X'0058'.
     88  KEY-S-F6         Value X'0059'.
     88  KEY-S-F7         Value X'005A'.
     88  KEY-S-F8         Value X'005B'.
     88  KEY-S-F9         Value X'005C'.
     88  KEY-S-TAB        Value X'000F'.
     88  KEY-TAB          Value X'0900'.
     88  KEY-UP           Value X'0048'.
     88  KEY-A            Value X'4100' X'6100'.
     88  KEY-B            Value X'4200' X'6200'.
     88  KEY-C            Value X'4300' X'6300'.
     88  KEY-D            Value X'4400' X'6400'.
     88  KEY-E            Value X'4500' X'6500'.
     88  KEY-F            Value X'4600' X'6600'.
     88  KEY-G            Value X'4700' X'6700'.
     88  KEY-H            Value X'4800' X'6800'.
     88  KEY-I            Value X'4900' X'6900'.
     88  KEY-J            Value X'4A00' X'6A00'.
     88  KEY-K            Value X'4B00' X'6B00'.
     88  KEY-L            Value X'4C00' X'6C00'.
     88  KEY-M            Value X'4D00' X'6D00'.
     88  KEY-N            Value X'4E00' X'6E00'.
     88  KEY-O            Value X'4F00' X'6F00'.
     88  KEY-P            Value X'5000' X'7000'.
     88  KEY-Q            Value X'5100' X'7100'.
     88  KEY-R            Value X'5200' X'7200'.
     88  KEY-S            Value X'5300' X'7300'.
     88  KEY-T            Value X'5400' X'7400'.
     88  KEY-U            Value X'5500' X'7500'.
     88  KEY-V            Value X'5600' X'7600'.
     88  KEY-W            Value X'5700' X'7700'.
     88  KEY-X            Value X'5800' X'7800'.
     88  KEY-Y            Value X'5900' X'7900'.
     88  KEY-Z            Value X'5A00' X'7A00'.
     88  KEY-SPACE        Value X'2000'.

 

[webrabbit]

Here is the Procedure copybook

 GET-CHAR-VIA-ADIS-IF-ANY.
     Call Test-Keyboard using CRT-STATUS-1
     If CRT-STATUS-1 = Low-Value
         Move Low-Value    to CRT-STATUS-2
         Move Low-Value    to CRT-STATUS-3
     Else
         Perform GET-CHAR-VIA-ADIS
     End-If
     .

 GET-CHAR-VIA-ADIS.
     Call ADIS using READ-CHAR-VIA-ADIS CRT-STATUS
     If CRT-STATUS-DATA-KEY 
     and CRT-STATUS-3 >= &quot;a&quot; and <= 'z'
         Subtract 32 from CRT-STATUS-3-N
     End-If
     .

 SET-ARROW-KEYS.
     Set ADIS-KEY-NORMAL-PLUS     to True
     Move ADIS-Key-Cursor-Left    to ADIS-KEY-1
     Move 2                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     Move ADIS-Key-Previous-Field to ADIS-KEY-1
     Move 1                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     .

 RESET-ARROW-KEYS.
     Set ADIS-KEY-NORMAL          to True
     Move ADIS-Key-Cursor-Left    to ADIS-KEY-1
     Move 2                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     Move ADIS-Key-Previous-Field to ADIS-KEY-1
     Move 1                       to ADIS-KEY-COUNT
     Call ADIS using SET-KEYS ADIS-KEY-CONTROL
     .

 GET-CHAR-IF-ANY.
     Call Test-Keyboard using WS-CHAR-1
     If WS-CHAR-1 = Low-Value
         Move Low-Value    to WS-CHAR-2
     Else
         Perform GET-CHAR
     End-If
     .

 GET-CHAR.
     Call Read-Char     using WS-CHAR-1
     If WS-CHAR-1 = Low-Value
         Call Read-Char using WS-CHAR-2
     Else
         Move Low-Value    to WS-CHAR-2
     End-If
     .

 GET-DATE-AND-TIME.
     Accept WS-TIME   from Time
     Move WS-HOUR       to WS-HOUR-X
     Move WS-MINUTE     to WS-MINUTE-X
     Move WS-SECOND     to WS-SECOND-X
     Accept WS-DATE-S from Date
     Move WS-DATE-M     to WS-SCREEN-DATE-MM
     Move WS-DATE-D     to WS-SCREEN-DATE-DD
     Move WS-DATE-Y     to WS-SCREEN-DATE-YY
     Move 20            to WS-DATE-C
     If WS-DATE-Y > 95
         Move 19        to WS-DATE-C
     End-If
     .

 DISPLAY-DATE-TIME.
     If MSG-MONO = 'X'
         Perform GET-MONITOR-TYPE
     End-If
     Perform GET-DATE-AND-TIME
     Move Zero               to SCREEN-LINE
     Move Zero               to SCREEN-COLUMN
     Move 10                 to SCREEN-IO-SIZE
     Call Write-Scr-Field using SCREEN-POSITION
                                WS-DISPLAY-TIME
                                SCREEN-IO-SIZE
                                DATE-TIME-ATTR
     Call Get-Scr-Size    using SCREEN-LINE SCREEN-COLUMN
     Move Zero               to SCREEN-LINE
     Subtract 10           from SCREEN-COLUMN
     Call Write-Scr-Field using SCREEN-POSITION
                                WS-SCREEN-DATE
                                SCREEN-IO-SIZE
                                DATE-TIME-ATTR
     .

 DISPLAY-MSG-AND-TIME.
     If MSG-MONO = 'X'
         Perform GET-MONITOR-TYPE
     End-If
     If WS-MSG = Space
         Move Space           to WS-MSG-2
         If MSG-MONO = 'Y'
             Move White       to MSG-COLOR
             Move Black       to MSG-ATTR
         Else
             Move Red         to MSG-COLOR
             Move Blue        to MSG-ATTR
             Multiply 16      by MSG-ATTR
         End-If
     Else
         Perform Varying Q1 from 80 by -1
                   Until WS-MSG(Q1:1) not = Space
             Continue
         End-Perform
         Compute Q2 = 41 - Q1 / 2
         Move Space           to WS-MSG-2
         Move WS-MSG          to WS-MSG-2(Q2:Q1)
         Move Space           to WS-MSG
         Move MSG-COLOR       to MSG-ATTR
         If MSG-MONO = 'Y'
             Move White       to MSG-COLOR
             Multiply 16      by MSG-ATTR
         Else
             Move Red         to MSG-COLOR
             Multiply 32      by MSG-ATTR
             Divide 2       into MSG-ATTR
             Add White        to MSG-ATTR
             Add Brightness   to MSG-ATTR
         End-If
     End-If
     If MSG-LINE = Zero
         Call Get-Scr-Size using SCREEN-LINE SCREEN-COLUMN
     Else
         Move MSG-LINE        to SCREEN-LINE
         Move Zero            to MSG-LINE
     End-If
     Subtract 1             from SCREEN-LINE
     Move 80                  to SCREEN-IO-SIZE
     Move Zero                to SCREEN-COLUMN
     Call Write-Scr-Field  using SCREEN-POSITION
                                 WS-MSG-2
                                 SCREEN-IO-SIZE
                                 MSG-ATTR
     Perform DISPLAY-DATE-TIME
     .

 BLANK-SCREEN.
     Display All X'02' 
         with FG-Clr White Highlight BG-Clr Blue
     .

 WAIT-ROUTINE.
     Perform GET-FUTURE-DATE-AND-TIME
     Move Low-Value to CRT-STATUS-1
     Perform Until CRT-STATUS-1 not = Low-Value
                or DATE-AND-TIME >= FUTURE-DATE-AND-TIME
         Perform GET-CHAR-VIA-ADIS-IF-ANY
         Perform GET-DATE-AND-TIME
     End-Perform
     .

 WAIT-ROUTINE-2.
     Perform GET-FUTURE-DATE-AND-TIME
     Move Low-Value to CRT-STATUS-1
     Perform Until CRT-STATUS-1 not = Low-Value
                or DATE-AND-TIME >= FUTURE-DATE-AND-TIME
         Perform GET-CHAR-VIA-ADIS-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 WAIT-ROUTINE-3.
     Perform GET-FUTURE-DATE-AND-TIME
     Move Low-Value to WS-CHARS
     Perform Until WS-CHARS not = Low-Value
                or DATE-AND-TIME >= FUTURE-DATE-AND-TIME
         Perform GET-CHAR-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 GET-FUTURE-DATE-AND-TIME.
     Perform GET-DATE-AND-TIME
     Move DATE-AND-TIME to FUTURE-DATE-AND-TIME
     Move WS-TIMER      to WS-TIMER-2
     Add FUTURE-SECOND  to WS-TIMER-2
     Divide 60        into WS-TIMER-2
                    Giving WS-TIMER-2
                 Remainder WS-TIMER
     Move WS-TIMER      to FUTURE-SECOND
     If WS-TIMER-2 = Zero
         Exit Paragraph
     End-If
     Add FUTURE-MINUTE  to WS-TIMER-2
     Divide 60        into WS-TIMER-2
                    Giving WS-TIMER-2
                 Remainder WS-TIMER
     Move WS-TIMER      to FUTURE-MINUTE
     Add WS-TIMER-2     to FUTURE-HOUR
     If FUTURE-HOUR < 24
         Exit Paragraph
     End-If
     Subtract 24      from FUTURE-HOUR
     Add 1              to FUTURE-DAY
     If FUTURE-DAY <= DAYS-IN(FUTURE-MONTH)
         Exit Paragraph
     End-If
     If FUTURE-MONTH = 2 and FUTURE-DAY = 29
         If FUTURE-YEAR = 00
             Move FUTURE-CENTURY
                        to WS-TIMER
         Else
             Move FUTURE-YEAR
                        to WS-TIMER
         End-If
         Divide 4     into WS-TIMER
                    Giving WS-TIMER
                 Remainder WS-TIMER-2
         If WS-TIMER-2 = Zero
             Exit Paragraph
         End-If
     End-If
     Move 1             to FUTURE-DAY
     Add 1              to FUTURE-MONTH
     If FUTURE-MONTH > 12
         Subtract 12  from FUTURE-MONTH
         Add 1          to FUTURE-CCYY
     End-If
     .

 WAIT-FOR-CHAR.
     Move Low-Value       to CRT-STATUS-1
     Perform Until CRT-STATUS-1 not = Low-Value
         Perform GET-CHAR-VIA-ADIS-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 WAIT-FOR-KEYSTROKE.
     Move Low-Value       to WS-CHARS
     Perform Until WS-CHARS not = Low-Value
         Perform GET-CHAR-IF-ANY
         Perform DISPLAY-DATE-TIME
     End-Perform
     .

 WAIT-FOR-Y-OR-N.
     If WS-MSG = Space
         Move 'Are you sure?  Press &quot;Y&quot; or &quot;N&quot;.' to WS-MSG
     End-If
     Perform DISPLAY-MSG-AND-TIME
     Call Move-Cursor using HIDE-CURSOR
     Perform Until Exit
         Perform GET-CHAR-IF-ANY
         If KEY-Y or KEY-N
             Exit Perform
         End-If
         Perform DISPLAY-DATE-TIME
     End-Perform
     Perform DISPLAY-MSG-AND-TIME
     .

 GET-MONITOR-TYPE.
     Call Screen-Control using MONITOR-QUERY MONITOR-BYTE
     Call Unpack-Byte    using MONITOR-BYTE  MONITOR-STRING
     Move 'Y'               to MSG-MONO
     Move X'07'             to DATE-TIME-ATTR
     If MONITOR-IS-COLOR
         Move X'17'         to DATE-TIME-ATTR
         Move 'N'           to MSG-MONO
     End-If
     .