home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / HAPI.ZIP / HAPI / HAPI_CBL / HSMPLCBL.CBL < prev    next >
Text File  |  1991-10-24  |  41KB  |  1,231 lines
  1.       ******************************************************************
  2.       *                                                                *
  3.       * FILE NAME: HSMPLCBL.CBL                                        *
  4.       *                                                                *
  5.       * MODULE NAME= HSMPLCBL.CBL                                      *
  6.       *                                                                *
  7.       * MODULE TYPE= MICROFOCUS COBOL                                  *
  8.       *                                                                *
  9.       * DESCRIPTIVE NAME= COBOL SAMPLE PROGRAM FOR EHLLAPI             *
  10.       *                                                                *
  11.       *                                                                *
  12.       * Displays EHLLAPI and session information.                      *
  13.       * Writes string to host.                                         *
  14.       * Searches for written string on host.                           *
  15.       * Displays host session screen.                                  *
  16.       * Manipulates the Presentation Manager properties of             *
  17.       * the emulator session to: change window title name, switch      *
  18.       * list name, make window invisible, query window status,         *
  19.       * window coordinates, change window size, and restore the        *
  20.       * emulator session window to its original conditions.            *
  21.       *                                                                *
  22.       *                                                                *
  23.       *   COPYRIGHT:  XXXXXXXXX  (C) COPYRIGHT IBM CORP. 1987,1988,    *
  24.       *               1989, 1991 LICENSED MATERIAL - PROGRAM PROPERTY  *
  25.       *               OF IBM ALL RIGHTS RESERVED                       *
  26.       *                                                                *
  27.       * NOTES=                                                         *
  28.       *                                                                *
  29.       **********************-END OF SPECIFICATIONS-*********************
  30.        IDENTIFICATION DIVISION.
  31.        PROGRAM-ID. EHLLAPI-SAMPLE-PROGRAM.
  32.        ENVIRONMENT DIVISION.
  33.        DATA DIVISION.
  34.        WORKING-STORAGE SECTION.
  35.  
  36.       ******************************************************************
  37.       ************************ CONSTANTS *******************************
  38.       ******************************************************************
  39.  
  40.        78  MAX-DATA-SIZE            VALUE 3840.
  41.       *                                      The maximum data
  42.       *                                      size for this
  43.       *                                      application.
  44.  
  45.        78  EABS                     VALUE 128.
  46.       *                                      Extended attribute bit
  47.  
  48.        78  PSS                      VALUE 64.
  49.       *                                      Programmed Symbol bit
  50.  
  51.        77  ZRO                      PIC 9(4) COMP-5 VALUE 0.
  52.  
  53.        77  MDS                      PIC 9(4) COMP-5 VALUE 3840.
  54.  
  55.        77  DUMMY                    PIC X(1).
  56.  
  57.        77  PRESS-ENT-MSG            PIC X(26) VALUE
  58.            "Press ENTER to continue...".
  59.  
  60.        77  PRESS-CTRL-ESC           PIC X(26) VALUE
  61.            "(press CTRL-ESC to verify)".
  62.  
  63.        77  DFT-SESS                 PIC X VALUE SPACE.
  64.  
  65.        77  HOST-TEXT                PIC X(9) VALUE
  66.            "EHLLAPI-1".
  67.  
  68.        77  INVIS-HOST-TEXT          PIC X(9) VALUE
  69.            "EHLLAPI-2".
  70.  
  71.        77  DISP-TEXT                PIC X(9) .
  72.  
  73.        77  COMMAND-TEXT             PIC X(29) VALUE
  74.            "IND$FILE PUT SF-TEST EXEC A@E".
  75.  
  76.        77  HOME-KEY                 PIC X(4) VALUE
  77.            "@L@0".
  78.  
  79.        77  SETPARM-TEXT             PIC X(17) VALUE
  80.            "NOATTRB EAB XLATE".
  81.  
  82.        77  DISP-NUM                 PIC ZZZZ9.
  83.  
  84.        77  LOOP-COUNT               PIC 99 COMP-0.
  85.  
  86.        77  NUM-SESS                 PIC 99 COMP-0.
  87.  
  88.        77  BIN-NUM                  PIC 99 COMP-0.
  89.  
  90.        77  BIN-NUM2                 PIC 99 COMP-0.
  91.  
  92.        77  BUFF-LENGTH              PIC X(2).
  93.  
  94.        01  HEX-TABLE.
  95.            05 FILLER PIC X(16) VALUE "0123456789ABCDEF".
  96.  
  97.        01  HEX-DIGITS REDEFINES HEX-TABLE.
  98.            05  HEX-DIG PIC X OCCURS 16 TIMES INDEXED BY INDX.
  99.  
  100.        77  HEX-OUTPUT               PIC X(2).
  101.  
  102.        01  HEX-OUTR REDEFINES HEX-OUTPUT.
  103.            05  HEX-OUT PIC X OCCURS 2 TIMES INDEXED BY IND.
  104.  
  105.        77  BLANK-LINE               PIC X VALUE SPACE.
  106.  
  107.        01  BINARY-NUM.
  108.            05 B-NUM PIC 9 COMP OCCURS 4 TIMES.
  109.  
  110.        01  H-PRINT.
  111.            05 H-OUT PIC X OCCURS 8 TIMES.
  112.  
  113.        01  BINARY-NUM-X.
  114.            05 B-NUM-X PIC 9 OCCURS 2 TIMES.
  115.  
  116.        01  H-PRINT-X.
  117.            05 H-OUT-X PIC X OCCURS 4 TIMES.
  118.  
  119.        01 WINDOW-DATA.
  120.             10  WN-DATA1           PIC 9(1) USAGE COMP.
  121.             10  WN-DATA2           PIC 9(1) USAGE COMP.
  122.  
  123.  
  124.      ****** EHLLAPI variables for use with LIM ********
  125.  
  126.        77  HFUNC-NUM               PIC 99 COMP-0.
  127.       *                                      EHLLAPI function number.
  128.        01  HDATA-STRING.
  129.            05  HDATA-STR           PIC X(1) OCCURS 3840 TIMES.
  130.       *                                      EHLLAPI data string
  131.        77  HDS-LEN                 PIC 99 COMP-0.
  132.       *                                      EHLLAPI data string length
  133.        77  HRC                     PIC 99 COMP-0 VALUE ZERO.
  134.       *                                      EHLLAPI return code
  135.  
  136.  
  137.  
  138.  
  139.       ****************************************************************
  140.       ***************** BEGIN INCLUDE FILES **************************
  141.       ****************************************************************
  142.  
  143.        COPY "HAPI_CBL.INC".
  144.  
  145.        SCREEN SECTION.
  146.        01  BLANK-SCR.
  147.           05  BLANK SCREEN.
  148.  
  149.        PROCEDURE DIVISION.
  150.  
  151.  
  152.  
  153.  
  154.       *********************************************************************
  155.       * MAIN - Main code calls routines to do real work.                  *
  156.       *                                                                   *
  157.       *                                                                   *
  158.       *                                                                   *
  159.       *                                                                   *
  160.       *********************************************************************
  161.  
  162.  
  163.        MAIN.
  164.  
  165.          DISPLAY BLANK-SCR.
  166.  
  167.          PERFORM  DISP-EHLLAPI-INFO.
  168.  
  169.          IF HRC = ZERO THEN
  170.  
  171.            DISPLAY PRESS-ENT-MSG WITH NO ADVANCING
  172.            ACCEPT DUMMY
  173.            PERFORM  DISP-SESSION-INFO.
  174.  
  175.          IF HRC = ZERO THEN
  176.            PERFORM M-NEXT.
  177.  
  178.          STOP RUN.
  179.  
  180.        M-NEXT.
  181.  
  182.          IF DFT-SESS NOT = SPACE THEN
  183.  
  184.            DISPLAY BLANK-LINE
  185.            MOVE HOST-TEXT TO DISP-TEXT
  186.            DISPLAY 'Press ENTER to send string "' DISP-TEXT
  187.                WITH NO ADVANCING
  188.            DISPLAY '" to session short name ' DFT-SESS
  189.                WITH NO ADVANCING
  190.            DISPLAY '...'
  191.                WITH NO ADVANCING
  192.            ACCEPT DUMMY
  193.            PERFORM WRITE-STR-2-HOST
  194.  
  195.          ELSE
  196.  
  197.            DISPLAY 'NO DFT SESSION SESSION STARTED.'
  198.            MOVE 1 TO HRC.
  199.  
  200.          IF HRC = ZERO THEN
  201.  
  202.            DISPLAY BLANK-LINE
  203.            DISPLAY 'Press ENTER to search for string "' DISP-TEXT
  204.                  WITH NO ADVANCING
  205.            DISPLAY '" on Host Presentation Space...'
  206.                  WITH NO ADVANCING
  207.            ACCEPT DUMMY
  208.            PERFORM SEARCH-STR-ON-HOST.
  209.  
  210.          IF HRC = ZERO THEN
  211.  
  212.            DISPLAY 'Press ENTER to display first 1920 '
  213.                  WITH NO ADVANCING
  214.            DISPLAY 'bytes of Host presentation space...'
  215.                  WITH NO ADVANCING
  216.            ACCEPT DUMMY
  217.            PERFORM DISP-HOST-SCR.
  218.  
  219.          IF HRC = ZERO THEN
  220.  
  221.            DISPLAY 'Press ENTER to change window title name'
  222.                  WITH NO ADVANCING
  223.            DISPLAY ' of session short name ' DFT-SESS
  224.                  WITH NO ADVANCING
  225.  
  226.            ACCEPT DUMMY
  227.            PERFORM CHANGE-PS-WINDOW-NAME.
  228.  
  229.          IF HRC = ZERO THEN
  230.  
  231.            DISPLAY BLANK-LINE
  232.            DISPLAY 'Press ENTER to change the switch list LT name'
  233.                  WITH NO ADVANCING
  234.            DISPLAY ' for session short name ' DFT-SESS
  235.            ACCEPT DUMMY
  236.            PERFORM CHANGE-SWITCH-LIST-LT-NAME.
  237.  
  238.          IF HRC = ZERO THEN
  239.  
  240.            DISPLAY BLANK-LINE
  241.            DISPLAY BLANK-LINE
  242.            DISPLAY BLANK-LINE
  243.            DISPLAY 'Press ENTER to query the PM status'
  244.                  WITH NO ADVANCING
  245.            DISPLAY ' of session short name ' DFT-SESS
  246.            ACCEPT DUMMY
  247.            PERFORM QUERY-PM-STATUS.
  248.  
  249.          IF HRC = ZERO THEN
  250.  
  251.            DISPLAY BLANK-LINE
  252.            DISPLAY 'Press ENTER to make the PM window invisible'
  253.                  WITH NO ADVANCING
  254.            DISPLAY ' for session short name ' DFT-SESS
  255.            ACCEPT DUMMY
  256.            PERFORM MAKE-PM-WINDOW-INVISIBLE
  257.  
  258.            DISPLAY BLANK-LINE
  259.            MOVE INVIS-HOST-TEXT TO DISP-TEXT
  260.            DISPLAY 'Press ENTER to send string "' DISP-TEXT
  261.                WITH NO ADVANCING
  262.            DISPLAY '" to session short name ' DFT-SESS
  263.                WITH NO ADVANCING
  264.            DISPLAY '...'
  265.                WITH NO ADVANCING
  266.            ACCEPT DUMMY
  267.            PERFORM WRITE-STR-2-HOST.
  268.  
  269.          IF HRC = ZERO THEN
  270.  
  271.            DISPLAY BLANK-LINE
  272.            DISPLAY 'Press ENTER to display first 1920 '
  273.                  WITH NO ADVANCING
  274.            DISPLAY 'bytes of invisible Host presentation space...'
  275.                  WITH NO ADVANCING
  276.            ACCEPT DUMMY
  277.            PERFORM DISP-HOST-SCR.
  278.  
  279.          IF HRC = ZERO THEN
  280.  
  281.            DISPLAY 'Press ENTER to maximize the PM window'
  282.                  WITH NO ADVANCING
  283.            DISPLAY ' and make visible...'
  284.                  WITH NO ADVANCING
  285.            ACCEPT DUMMY
  286.            PERFORM MAKE-PM-WINDOW-VISIBLE.
  287.  
  288.          IF HRC = ZERO THEN
  289.  
  290.            DISPLAY BLANK-LINE
  291.            DISPLAY 'Press ENTER to disconnect from'
  292.                  WITH NO ADVANCING
  293.            DISPLAY ' from session short name ' DFT-SESS
  294.                  WITH NO ADVANCING
  295.            DISPLAY '...'
  296.            ACCEPT DUMMY
  297.            PERFORM DISCONNECT-PM-WINDOW.
  298.  
  299.          IF HRC = ZERO THEN
  300.  
  301.            DISPLAY BLANK-LINE
  302.            DISPLAY 'Press ENTER to restore switch name and window'
  303.                  WITH NO ADVANCING
  304.            DISPLAY ' name and size...'
  305.            ACCEPT DUMMY
  306.            PERFORM RESET-WINDOW.
  307.  
  308.  
  309.          IF HRC = ZERO THEN
  310.            DISPLAY BLANK-LINE
  311.            DISPLAY 'SAMPLE PROGRAM DONE.  To Exit Program '
  312.                  WITH NO ADVANCING
  313.            DISPLAY 'Press ENTER...'
  314.                  WITH NO ADVANCING
  315.            ACCEPT DUMMY.
  316.  
  317.       *********************************************************************
  318.       * DISP-EHLLAPI-INFO - CALLs EHLLAPI QUERY-SYSTEM and then displays  *
  319.       *                     the requested info.                           *
  320.       *                                                                   *
  321.       *                                                                   *
  322.       *                                                                   *
  323.       *********************************************************************
  324.        DISP-EHLLAPI-INFO.
  325.  
  326.          MOVE HA-QUERY-SYSTEM TO HFUNC-NUM.
  327.  
  328.          CALL 'COBLIM' USING HFUNC-NUM, QSYS-STRUCT, HDS-LEN, HRC.
  329.  
  330.          IF HRC = HARC-SUCCESS
  331.            PERFORM DEI-DISP
  332.          ELSE
  333.            PERFORM ERROR-HAND.
  334.  
  335.        DEI-DISP.
  336.          DISPLAY '                       EHLLAPI INFORMATION'.
  337.  
  338.          DISPLAY BLANK-LINE.
  339.  
  340.          DISPLAY '  EHLLAPI version              : '
  341.              QSYS-HLLAPI-VER.
  342.  
  343.          DISPLAY '  EHLLAPI level                : '
  344.              QSYS-HLLAPI-LVL.
  345.  
  346.          DISPLAY '  EHLLAPI release date         : '
  347.              QSYS-HLLAPI-DATE.
  348.  
  349.          DISPLAY '  EHLLAPI LIM version          : '
  350.              QSYS-LIM-VER.
  351.  
  352.          DISPLAY '  EHLLAPI LIM level            : '
  353.              QSYS-LIM-LVL.
  354.  
  355.          DISPLAY '  EHLLAPI hardware base        : '
  356.              QSYS-HARDWARE-BASE ' = '
  357.              WITH NO ADVANCING.
  358.          IF QSYS-HARDWARE-BASE = 'Z'
  359.            DISPLAY '(See System model/submodel below)'
  360.                WITH NO ADVANCING.
  361.          DISPLAY BLANK-LINE.
  362.  
  363.          DISPLAY '  EHLLAPI CTRL program type    : '
  364.              QSYS-CTRL-PROG-TYPE ' = '
  365.              WITH NO ADVANCING.
  366.          IF QSYS-CTRL-PROG-TYPE = 'X'
  367.            DISPLAY 'OS/2' WITH NO ADVANCING.
  368.          DISPLAY BLANK-LINE.
  369.  
  370.          DISPLAY '  EHLLAPI sequence number      : '
  371.              QSYS-SEQ-NUM.
  372.  
  373.          DISPLAY '  EHLLAPI CTRL program version : '
  374.              QSYS-CTRL-PROG-VER.
  375.  
  376.          DISPLAY '  EHLLAPI PC session name      : '
  377.              QSYS-PC-SNAME.
  378.  
  379.          DISPLAY '  EHLLAPI extended error 1     : '
  380.              QSYS-ERR1.
  381.  
  382.          DISPLAY '  EHLLAPI extended error 2     : '
  383.              QSYS-ERR2.
  384.  
  385.          DISPLAY '  EHLLAPI system model/submodel: '
  386.              WITH NO ADVANCING.
  387.          MOVE QSYS-SYS-MODEL TO BIN-NUM.
  388.          PERFORM ITOH.
  389.          DISPLAY HEX-OUT(1) WITH NO ADVANCING.
  390.          DISPLAY HEX-OUT(2) WITH NO ADVANCING.
  391.          MOVE QSYS-SYS-SUBMODEL TO BIN-NUM.
  392.          PERFORM ITOH.
  393.          DISPLAY HEX-OUT(1) WITH NO ADVANCING.
  394.          DISPLAY HEX-OUT(2) WITH NO ADVANCING.
  395.          DISPLAY ' HEX  ' WITH NO ADVANCING.
  396.          IF QSYS-SYS-MODEL = H'FC' AND QSYS-SYS-SUBMODEL = H'00'
  397.            DISPLAY '= Model PC AT' WITH NO ADVANCING.
  398.          IF QSYS-SYS-MODEL = H'FC' AND QSYS-SYS-SUBMODEL = H'01'
  399.            DISPLAY '= Model PC AT ENHANCED' WITH NO ADVANCING.
  400.          IF QSYS-SYS-MODEL = H'FC' AND QSYS-SYS-SUBMODEL = H'02'
  401.            DISPLAY '= Model PC XT Model 286' WITH NO ADVANCING.
  402.          IF QSYS-SYS-MODEL = H'FC' AND QSYS-SYS-SUBMODEL = H'04'
  403.            DISPLAY '= Model 50' WITH NO ADVANCING.
  404.          IF QSYS-SYS-MODEL = H'FC' AND QSYS-SYS-SUBMODEL = H'05'
  405.            DISPLAY '= Model 60' WITH NO ADVANCING.
  406.          IF QSYS-SYS-MODEL = H'F8' AND QSYS-SYS-SUBMODEL = H'00'
  407.            DISPLAY '= Model 80' WITH NO ADVANCING.
  408.          IF QSYS-SYS-MODEL = H'F8' AND QSYS-SYS-SUBMODEL = H'09'
  409.            DISPLAY '= Model 70' WITH NO ADVANCING.
  410.          DISPLAY BLANK-LINE.
  411.  
  412.  
  413.          MOVE QSYS-PC-NLS TO DISP-NUM.
  414.          DISPLAY '  EHLLAPI National Language    : '
  415.              DISP-NUM.
  416.  
  417.  
  418.          DISPLAY '  EHLLAPI monitor type         : '
  419.              QSYS-MONITOR-TYPE ' = '
  420.              WITH NO ADVANCING.
  421.          IF QSYS-MONITOR-TYPE = 'M'
  422.            DISPLAY 'PC MONOCHROME' WITH NO ADVANCING.
  423.          IF QSYS-MONITOR-TYPE = 'C'
  424.            DISPLAY 'PC CGA' WITH NO ADVANCING.
  425.          IF QSYS-MONITOR-TYPE = 'E'
  426.            DISPLAY 'PC EGA' WITH NO ADVANCING.
  427.          IF QSYS-MONITOR-TYPE = 'A'
  428.            DISPLAY 'PS MONOCHROME' WITH NO ADVANCING.
  429.          IF QSYS-MONITOR-TYPE = 'V'
  430.            DISPLAY 'PS 8512' WITH NO ADVANCING.
  431.          IF QSYS-MONITOR-TYPE = 'H'
  432.            DISPLAY 'PS 8514' WITH NO ADVANCING.
  433.          IF QSYS-MONITOR-TYPE = 'U'
  434.            DISPLAY 'UNKNOWN monitor type' WITH NO ADVANCING.
  435.          DISPLAY BLANK-LINE.
  436.  
  437.  
  438.  
  439.  
  440.  
  441.       *********************************************************************
  442.       * DISP-SESSION-INFO - CALLs EHLLAPI QUERY funtions and then displays*
  443.       *                     the requested session info.                   *
  444.       *                                                                   *
  445.       *                                                                   *
  446.       *                                                                   *
  447.       *********************************************************************
  448.        DISP-SESSION-INFO.
  449.  
  450.  
  451.          DISPLAY BLANK-LINE.
  452.          DISPLAY BLANK-LINE.
  453.          DISPLAY BLANK-LINE.
  454.          DISPLAY BLANK-LINE.
  455.          DISPLAY BLANK-LINE.
  456.          DISPLAY BLANK-LINE.
  457.          DISPLAY BLANK-LINE.
  458.          DISPLAY BLANK-LINE.
  459.          DISPLAY BLANK-LINE.
  460.          DISPLAY BLANK-LINE.
  461.          DISPLAY BLANK-LINE.
  462.          DISPLAY BLANK-LINE.
  463.          DISPLAY '                           SESSION INFO'.
  464.          DISPLAY BLANK-LINE.
  465.  
  466.          MOVE HA-QUERY-SESSIONS TO HFUNC-NUM.
  467.  
  468.          COMPUTE HDS-LEN = 12 * HAMMAX-SESSIONS.
  469.  
  470.          CALL 'COBLIM' USING HFUNC-NUM, QSES-STRUCT(1), HDS-LEN,HRC.
  471.  
  472.          IF HRC = HARC-SUCCESS
  473.            PERFORM DSI-SUCCESS
  474.          ELSE
  475.            PERFORM ERROR-HAND.
  476.  
  477.        DSI-SUCCESS.
  478.  
  479.          MOVE HDS-LEN TO NUM-SESS.
  480.  
  481.          MOVE NUM-SESS TO DISP-NUM.
  482.          DISPLAY 'Number of started sessions = ' DISP-NUM.
  483.          DISPLAY BLANK-LINE.
  484.          DISPLAY BLANK-LINE.
  485.  
  486.          SET HAIX TO 1.
  487.          MOVE 1 TO LOOP-COUNT.
  488.  
  489.          PERFORM DSI-LOOP UNTIL HRC NOT = 0 OR HAIX > NUM-SESS.
  490.  
  491.        DSI-LOOP.
  492.  
  493.  
  494.          MOVE LOOP-COUNT TO DISP-NUM.
  495.          DISPLAY 'Session number     : ' DISP-NUM.
  496.  
  497.          DISPLAY 'Session Long name  : ' QSES-LONGNAME(HAIX).
  498.  
  499.          DISPLAY 'Session Short name : '
  500.             QSES-SHORTNAME(HAIX).
  501.  
  502.          DISPLAY 'Session Type       : '
  503.             QSES-SESTYPE(HAIX) ' = ' WITH NO ADVANCING.
  504.          IF QSES-SESTYPE(HAIX) = 'H'
  505.            PERFORM DSI-SET-HOST
  506.            DISPLAY 'Host' WITH NO ADVANCING.
  507.          IF QSES-SESTYPE(HAIX) = 'P'
  508.            DISPLAY 'PC' WITH NO ADVANCING.
  509.          DISPLAY BLANK-LINE.
  510.  
  511.          MOVE QSES-PSSIZE(HAIX) TO DISP-NUM.
  512.          DISPLAY 'Session PS size    : ' DISP-NUM.
  513.  
  514.  
  515.          MOVE HA-QUERY-SESSION-STATUS TO HFUNC-NUM.
  516.  
  517.          MOVE 18 TO HDS-LEN.
  518.  
  519.          MOVE QSES-SHORTNAME(HAIX) TO QSST-SHORTNAME.
  520.  
  521.          CALL 'COBLIM' USING HFUNC-NUM, QSST-STRUCT, HDS-LEN, HRC.
  522.  
  523.          IF HRC = HARC-SUCCESS
  524.            PERFORM DSI-SUCCESS2
  525.          ELSE
  526.            PERFORM ERROR-HAND.
  527.  
  528.        DSI-SUCCESS2.
  529.  
  530.          MOVE QSST-PS-ROWS TO DISP-NUM.
  531.          DISPLAY 'Session PS rows    : ' DISP-NUM.
  532.  
  533.          MOVE QSST-PS-COLS TO DISP-NUM.
  534.          DISPLAY 'Session PS columns : ' DISP-NUM.
  535.  
  536.          DISPLAY 'Session type 2     : ' QSST-SESTYPE ' = '
  537.              WITH NO ADVANCING.
  538.          IF QSST-SESTYPE = 'F'
  539.            DISPLAY '5250' WITH NO ADVANCING.
  540.          IF QSST-SESTYPE = 'G'
  541.            DISPLAY '5250 Printer Session' WITH NO ADVANCING.
  542.          IF QSST-SESTYPE = 'D'
  543.            DISPLAY 'DFT Host' WITH NO ADVANCING.
  544.          IF QSST-SESTYPE = 'P'
  545.            DISPLAY 'PC' WITH NO ADVANCING.
  546.          DISPLAY BLANK-LINE.
  547.  
  548.          DISPLAY 'Session supports Extended attributes (EABs)? : '
  549.              WITH NO ADVANCING.
  550.  
  551.          IF QSST-CHAR >= X'80'
  552.            DISPLAY 'YES' WITH NO ADVANCING
  553.          ELSE
  554.            DISPLAY 'NO' WITH NO ADVANCING.
  555.          DISPLAY BLANK-LINE.
  556.  
  557.          DISPLAY 'Session supports Program Symbols (PSS)?      : '
  558.              WITH NO ADVANCING.
  559.          IF QSST-CHAR >= X'C0'
  560.             OR (QSST-CHAR < X'80' AND  QSST-CHAR >= X'40')
  561.            DISPLAY 'YES' WITH NO ADVANCING
  562.          ELSE
  563.            DISPLAY 'NO' WITH NO ADVANCING.
  564.          DISPLAY BLANK-LINE.
  565.  
  566.          DISPLAY PRESS-ENT-MSG WITH NO ADVANCING.
  567.          ACCEPT DUMMY.
  568.  
  569.  
  570.  
  571.          SET HAIX UP BY 1.
  572.          ADD 1 TO LOOP-COUNT.
  573.  
  574.  
  575.        DSI-SET-HOST.
  576.  
  577.          IF DFT-SESS = SPACE
  578.            MOVE QSES-SHORTNAME(HAIX) TO DFT-SESS.
  579.  
  580.  
  581.  
  582.       *********************************************************************
  583.       * WRITE-STR-2-HOST  - Connects to first session and writes home-key *
  584.       *                     and string to host.                           *
  585.       *                                                                   *
  586.       *                                                                   *
  587.       *                                                                   *
  588.       *********************************************************************
  589.        WRITE-STR-2-HOST.
  590.  
  591.  
  592.          MOVE HA-CONNECT-PS TO HFUNC-NUM.
  593.  
  594.          MOVE DFT-SESS TO HDATA-STR(1).
  595.  
  596.          CALL 'COBLIM' USING HFUNC-NUM, HDATA-STRING, HDS-LEN, HRC.
  597.  
  598.          IF HRC = HARC-SUCCESS
  599.            PERFORM WS2H-SUCCESS
  600.          ELSE
  601.            PERFORM ERROR-HAND.
  602.  
  603.        WS2H-SUCCESS.
  604.  
  605.          MOVE HA-SENDKEY TO HFUNC-NUM.
  606.  
  607.          MOVE 4 TO HDS-LEN.
  608.  
  609.          CALL 'COBLIM' USING HFUNC-NUM, HOME-KEY, HDS-LEN, HRC.
  610.  
  611.          IF HRC = HARC-SUCCESS
  612.            PERFORM WS2H-SUCCESS2
  613.          ELSE
  614.            PERFORM ERROR-HAND.
  615.  
  616.        WS2H-SUCCESS2.
  617.  
  618.  
  619.          MOVE 9 TO HDS-LEN.
  620.  
  621.          CALL 'COBLIM' USING HFUNC-NUM, DISP-TEXT, HDS-LEN, HRC.
  622.  
  623.          IF HRC = HARC-SUCCESS
  624.            DISPLAY 'Sent String to Host.'
  625.  
  626.          ELSE
  627.            PERFORM ERROR-HAND.
  628.  
  629.  
  630.  
  631.       *********************************************************************
  632.       * SEARCH-STR-ON-HOST- Searches for string on host.                  *
  633.       *                                                                   *
  634.       *                                                                   *
  635.       *                                                                   *
  636.       *********************************************************************
  637.        SEARCH-STR-ON-HOST.
  638.  
  639.          MOVE HA-SEARCH-PS TO HFUNC-NUM.
  640.  
  641.          MOVE 7 TO HDS-LEN.
  642.  
  643.          CALL 'COBLIM' USING HFUNC-NUM, DISP-TEXT, HDS-LEN, HRC.
  644.  
  645.          IF HRC = HARC-SUCCESS
  646.            DISPLAY 'Found string "' DISP-TEXT
  647.                WITH NO ADVANCING
  648.            MOVE HDS-LEN TO DISP-NUM
  649.            DISPLAY '" at PS position ' DISP-NUM '.'
  650.            DISPLAY BLANK-LINE
  651.            DISPLAY BLANK-LINE
  652.  
  653.          ELSE
  654.            PERFORM ERROR-HAND.
  655.  
  656.  
  657.       *********************************************************************
  658.       * DISP-HOST-SCR - Displays first 1920 bytes of host screen.         *
  659.       *                                                                   *
  660.       *                                                                   *
  661.       *                                                                   *
  662.       *********************************************************************
  663.        DISP-HOST-SCR.
  664.  
  665.          MOVE HA-SET-SESSION-PARMS TO HFUNC-NUM.
  666.  
  667.          MOVE 17 TO HDS-LEN.
  668.  
  669.          CALL 'COBLIM' USING HFUNC-NUM, SETPARM-TEXT, HDS-LEN, HRC.
  670.  
  671.          IF HRC = HARC-SUCCESS
  672.            PERFORM DHS-SUCCESS
  673.          ELSE
  674.            PERFORM ERROR-HAND.
  675.  
  676.        DHS-SUCCESS.
  677.  
  678.          MOVE HA-COPY-PS-TO-STR TO HFUNC-NUM.
  679.  
  680.          MOVE MAX-DATA-SIZE TO HDS-LEN.
  681.  
  682.          MOVE 1 TO HRC.
  683.  
  684.          CALL 'COBLIM' USING HFUNC-NUM, HDATA-STRING, HDS-LEN, HRC.
  685.  
  686.          IF HRC = HARC-SUCCESS
  687.  
  688.            CALL '__VIOWRTCELLSTR' USING BY VALUE ZRO
  689.                                         BY VALUE ZRO
  690.                                         BY VALUE ZRO
  691.                                         BY VALUE MDS
  692.                                BY REFERENCE HDATA-STRING
  693.  
  694.          ELSE
  695.  
  696.            PERFORM ERROR-HAND.
  697.  
  698.  
  699.       *********************************************************************
  700.       * CHANGE PS WINDOW NAME - Change the title of the PM window session *
  701.       *                                                                   *
  702.       *                                                                   *
  703.       *                                                                   *
  704.       *********************************************************************
  705.        CHANGE-PS-WINDOW-NAME.
  706.  
  707.          MOVE HA-CONNECT-PM-SRVCS TO HFUNC-NUM.
  708.  
  709.          MOVE DFT-SESS TO STPM-SHORTNAME.
  710.  
  711.          CALL 'HLLCOB' USING HFUNC-NUM, STPM-STRUCT, HDS-LEN, HRC.
  712.  
  713.          IF HRC = HARC-SUCCESS
  714.            PERFORM CHANGE-PS
  715.          ELSE
  716.            PERFORM ERROR-HAND.
  717.  
  718.        CHANGE-PS.
  719.  
  720.          MOVE HA-CHANGE-WINDOW-NAME TO HFUNC-NUM.
  721.  
  722.          MOVE DFT-SESS TO CHLT-SHORTNAME.
  723.  
  724.          MOVE 1 TO CHLT-OPTION.
  725.  
  726.          MOVE "Sample Window Name Test" TO CHLT-LTNAME.
  727.          MOVE 26 TO HDS-LEN.
  728.  
  729.          CALL 'HLLCOB' USING HFUNC-NUM,CHLT-STRUCT,HDS-LEN,HRC.
  730.  
  731.          IF HRC = HARC-SUCCESS
  732.  
  733.            DISPLAY 'Window Title Changed.'
  734.            DISPLAY  PRESS-CTRL-ESC
  735.  
  736.          ELSE
  737.  
  738.            PERFORM ERROR-HAND.
  739.  
  740.  
  741.  
  742.       *********************************************************************
  743.       * CHANGE SWITCH LIST LT NAME - Change the session's name on         *
  744.       *                                     the switch list               *
  745.       *                                                                   *
  746.       *                                                                   *
  747.       *********************************************************************
  748.        CHANGE-SWITCH-LIST-LT-NAME.
  749.  
  750.            MOVE HA-CONNECT-PM-SRVCS TO HFUNC-NUM.
  751.  
  752.            MOVE DFT-SESS TO  STPM-SHORTNAME.
  753.  
  754.            CALL 'HLLCOB' USING HFUNC-NUM, STPM-STRUCT, HDS-LEN, HRC.
  755.  
  756.            IF HRC = HARC-SUCCESS
  757.              PERFORM CHANGE-SWITCH
  758.            ELSE
  759.              PERFORM ERROR-HAND.
  760.  
  761.        CHANGE-SWITCH.
  762.  
  763.            MOVE HA-CHANGE-SWITCH-NAME TO  HFUNC-NUM.
  764.  
  765.            MOVE DFT-SESS TO CHSW-SHORTNAME.
  766.            MOVE 1 TO CHSW-OPTION.
  767.  
  768.            MOVE "Sample Switch List Name" TO CHSW-SWNAME.
  769.            MOVE 26 TO HDS-LEN.
  770.  
  771.            CALL 'HLLCOB' USING HFUNC-NUM,CHSW-STRUCT,HDS-LEN,HRC.
  772.  
  773.  
  774.            IF HRC = HARC-SUCCESS
  775.  
  776.              DISPLAY 'Switch List LT Name Changed.'
  777.          DISPLAY PRESS-CTRL-ESC
  778.  
  779.            ELSE
  780.  
  781.              PERFORM ERROR-HAND.
  782.  
  783.  
  784.  
  785.       *********************************************************************
  786.       * QUERY-PM-STATUS -  Query the PM window status.                    *
  787.       *                                                                   *
  788.       *                                                                   *
  789.       *                                                                   *
  790.       *********************************************************************
  791.        QUERY-PM-STATUS.
  792.  
  793.          MOVE HA-CONNECT-PM-SRVCS TO HFUNC-NUM.
  794.  
  795.          MOVE DFT-SESS TO STPM-SHORTNAME.
  796.  
  797.          CALL 'COBLIM' USING HFUNC-NUM, STPM-STRUCT, HDS-LEN, HRC.
  798.  
  799.          IF HRC = HARC-SUCCESS
  800.            PERFORM QUERY-SESSION
  801.          ELSE
  802.            PERFORM ERROR-HAND.
  803.  
  804.        QUERY-SESSION.
  805.  
  806.          MOVE HA-PM-WINDOW-STATUS TO HFUNC-NUM.
  807.  
  808.          MOVE DFT-SESS TO CWIN-SHORTNAME.
  809.  
  810.          MOVE 2 TO CWIN-OPTION.
  811.  
  812.          MOVE 4 TO HDS-LEN.
  813.  
  814.          CALL 'HLLCOB' USING HFUNC-NUM,CWIN-STRUCT,HDS-LEN,HRC.
  815.  
  816.          IF HRC >  HARC-SUCCESS
  817.              PERFORM ERROR-HAND.
  818.  
  819.              DISPLAY '                      PM WINDOW STATUS.'.
  820.  
  821.          DISPLAY BLANK-LINE.
  822.  
  823.          MOVE CWIN-FLAGS TO WINDOW-DATA.
  824.  
  825.          IF (WN-DATA1 = 1) OR (WN-DATA1 = 5) OR (WN-DATA1 = 9)
  826.             DISPLAY 'The Window Is Deactivated.'.
  827.          IF (WN-DATA1 = 4) OR (WN-DATA1 = 5)
  828.             DISPLAY 'The Window Is Minimized.'.
  829.          IF (WN-DATA1 = 8) OR (WN-DATA1 = 9)
  830.             DISPLAY 'The Window Is Maximized.'.
  831.          IF (WN-DATA2 = 8) OR (WN-DATA2 = 136)
  832.             DISPLAY 'The Window Is Visible.'.
  833.          IF (WN-DATA2 = 16) OR (WN-DATA2 = 144)
  834.             DISPLAY 'The Window Is Invisible.'.
  835.          IF (WN-DATA2 = 128)
  836.             DISPLAY 'The Window Is Activated.'.
  837.  
  838.          MOVE HA-QUERY-WINDOW-COORDS TO HFUNC-NUM.
  839.  
  840.          MOVE DFT-SESS TO GCOR-SHORTNAME.
  841.  
  842.          MOVE 17 TO HDS-LEN.
  843.  
  844.          CALL 'HLLCOB' USING HFUNC-NUM,GCOR-STRUCT,HDS-LEN,HRC.
  845.  
  846.          IF HRC = HARC-SUCCESS
  847.            DISPLAY BLANK-LINE
  848.            DISPLAY '                      PM WINDOW COORDINATES.'
  849.            DISPLAY BLANK-LINE
  850.  
  851.            DISPLAY   'XLEFT       '  WITH NO ADVANCING
  852.            MOVE GCOR-XLEFT TO BINARY-NUM
  853.            PERFORM BIN2HEX
  854.            DISPLAY H-PRINT
  855.  
  856.            DISPLAY   'YBOTTOM     ' WITH NO ADVANCING
  857.            MOVE GCOR-YBOTTOM TO BINARY-NUM
  858.            PERFORM BIN2HEX
  859.            DISPLAY H-PRINT
  860.  
  861.            DISPLAY   'XRIGHT      ' WITH NO ADVANCING
  862.            MOVE GCOR-XRIGHT TO BINARY-NUM
  863.            PERFORM BIN2HEX
  864.            DISPLAY H-PRINT
  865.  
  866.            DISPLAY   'YTOP        '  WITH NO ADVANCING
  867.            MOVE GCOR-YTOP TO BINARY-NUM
  868.            PERFORM BIN2HEX
  869.            DISPLAY H-PRINT
  870.  
  871.          ELSE
  872.  
  873.            PERFORM ERROR-HAND.
  874.  
  875.  
  876.       *********************************************************************
  877.       * MAKE-PM-WINDOW-INVISIBLE -  Make the PM window invisible.         *
  878.       *                                                                   *
  879.       *                                                                   *
  880.       *                                                                   *
  881.       *********************************************************************
  882.        MAKE-PM-WINDOW-INVISIBLE.
  883.  
  884.          MOVE HA-CONNECT-PM-SRVCS TO HFUNC-NUM.
  885.  
  886.          MOVE DFT-SESS TO HDATA-STR(1).
  887.  
  888.          CALL 'COBLIM' USING HFUNC-NUM, HDATA-STRING, HDS-LEN, HRC.
  889.  
  890.          IF HRC = HARC-SUCCESS
  891.            PERFORM MAKE-INVIS
  892.          ELSE
  893.            PERFORM ERROR-HAND.
  894.  
  895.        MAKE-INVIS.
  896.  
  897.          MOVE HA-PM-WINDOW-STATUS TO HFUNC-NUM.
  898.  
  899.          MOVE DFT-SESS TO CWIN-SHORTNAME.
  900.          MOVE 1  TO CWIN-OPTION.
  901.          MOVE 16 TO CWIN-FLAGS.
  902.          MOVE 0  TO CWIN-XPOS.
  903.          MOVE 0  TO CWIN-YPOS.
  904.          MOVE 0  TO CWIN-XSIZE.
  905.          MOVE 0  TO CWIN-YSIZE.
  906.          MOVE 0  TO CWIN-BEHIND.
  907.  
  908.          CALL 'HLLCOB' USING HFUNC-NUM,CWIN-STRUCT,HDS-LEN,HRC.
  909.  
  910.          IF HRC = HARC-SUCCESS
  911.  
  912.            DISPLAY 'The PM Window Is Now Invisible.'
  913.            DISPLAY PRESS-CTRL-ESC
  914.  
  915.          ELSE
  916.  
  917.            PERFORM ERROR-HAND.
  918.  
  919.  
  920.       *********************************************************************
  921.       * MAKE-PM-WINDOW-VISIBLE -Make the PM window visible and maximized. *
  922.       *                                                                   *
  923.       *                                                                   *
  924.       *                                                                   *
  925.       *********************************************************************
  926.        MAKE-PM-WINDOW-VISIBLE.
  927.  
  928.          MOVE HA-CONNECT-PM-SRVCS TO HFUNC-NUM.
  929.  
  930.          MOVE DFT-SESS TO  STPM-SHORTNAME.
  931.  
  932.          CALL 'COBLIM' USING HFUNC-NUM, STPM-STRUCT, HDS-LEN, HRC.
  933.  
  934.          IF HRC = HARC-SUCCESS
  935.            PERFORM MAKE-VIS
  936.          ELSE
  937.            PERFORM ERROR-HAND.
  938.  
  939.        MAKE-VIS.
  940.  
  941.          MOVE HA-PM-WINDOW-STATUS TO HFUNC-NUM.
  942.  
  943.          MOVE DFT-SESS TO CWIN-SHORTNAME.
  944.          MOVE 1  TO CWIN-OPTION.
  945.          MOVE 2056 TO CWIN-FLAGS.
  946.          MOVE 0  TO CWIN-XPOS.
  947.          MOVE 0  TO CWIN-YPOS.
  948.          MOVE 0  TO CWIN-XSIZE.
  949.          MOVE 0  TO CWIN-YSIZE.
  950.          MOVE 0  TO CWIN-BEHIND.
  951.  
  952.          CALL 'HLLCOB' USING HFUNC-NUM,CWIN-STRUCT,HDS-LEN,HRC.
  953.  
  954.          IF HRC = HARC-SUCCESS
  955.  
  956.            DISPLAY 'The PM Window Is Now Visible And Maximized.'
  957.            DISPLAY PRESS-CTRL-ESC
  958.  
  959.          ELSE
  960.  
  961.            PERFORM ERROR-HAND.
  962.  
  963.  
  964.  
  965.  
  966.       *********************************************************************
  967.       * DISCONNECT-PM-WINDOW - Disconnect from PM window                  *
  968.       *                                                                   *
  969.       *                                                                   *
  970.       *                                                                   *
  971.       *********************************************************************
  972.        DISCONNECT-PM-WINDOW.
  973.  
  974.  
  975.          MOVE HA-CONNECT-PS TO HFUNC-NUM.
  976.  
  977.          MOVE DFT-SESS TO STPM-SHORTNAME.
  978.  
  979.          CALL 'COBLIM' USING HFUNC-NUM, STPM-STRUCT, HDS-LEN, HRC.
  980.  
  981.          IF HRC = HARC-SUCCESS
  982.            PERFORM DISCONNECT
  983.          ELSE
  984.            PERFORM ERROR-HAND.
  985.  
  986.        DISCONNECT.
  987.  
  988.          MOVE HA-DISCONNECT-PM-SRVCS TO HFUNC-NUM.
  989.  
  990.          MOVE DFT-SESS TO SPPM-SHORTNAME.
  991.  
  992.          CALL 'COBLIM' USING HFUNC-NUM, SPPM-STRUCT, HDS-LEN, HRC.
  993.  
  994.          IF HRC = HARC-SUCCESS
  995.            DISPLAY "PM Window Disconnected."
  996.          ELSE
  997.            PERFORM ERROR-HAND.
  998.  
  999.  
  1000.  
  1001.  
  1002.       *********************************************************************
  1003.       * RESET WINDOW- Reset switch name, window name and window size.     *
  1004.       *                                                                   *
  1005.       *                                                                   *
  1006.       *                                                                   *
  1007.       *********************************************************************
  1008.        RESET-WINDOW.
  1009.  
  1010.  
  1011.          MOVE HA-CONNECT-PM-SRVCS TO HFUNC-NUM.
  1012.  
  1013.          MOVE DFT-SESS TO STPM-SHORTNAME.
  1014.  
  1015.          CALL 'COBLIM' USING HFUNC-NUM, STPM-STRUCT, HDS-LEN, HRC.
  1016.  
  1017.          IF HRC > HARC-SUCCESS
  1018.             PERFORM ERROR-HAND.
  1019.  
  1020.          MOVE HA-CHANGE-SWITCH-NAME TO  HFUNC-NUM.
  1021.  
  1022.          MOVE DFT-SESS TO CHSW-SHORTNAME.
  1023.          MOVE 2 TO CHSW-OPTION.
  1024.          MOVE 4 TO HDS-LEN.
  1025.  
  1026.          CALL 'HLLCOB' USING HFUNC-NUM,CHSW-STRUCT,HDS-LEN,HRC.
  1027.  
  1028.          IF HRC > HARC-SUCCESS
  1029.            PERFORM ERROR-HAND.
  1030.  
  1031.          DISPLAY 'Switch List LT Name Reset.'
  1032.  
  1033.          MOVE HA-CHANGE-WINDOW-NAME TO HFUNC-NUM.
  1034.  
  1035.          MOVE DFT-SESS TO CHLT-SHORTNAME.
  1036.          MOVE 2 TO CHLT-OPTION.
  1037.          MOVE 4 TO HDS-LEN.
  1038.  
  1039.          CALL 'HLLCOB' USING HFUNC-NUM,CHLT-STRUCT,HDS-LEN,HRC.
  1040.  
  1041.          IF HRC > HARC-SUCCESS
  1042.            PERFORM ERROR-HAND.
  1043.  
  1044.          DISPLAY 'PM Window Name Reset.'
  1045.  
  1046.          MOVE HA-PM-WINDOW-STATUS TO HFUNC-NUM.
  1047.  
  1048.          MOVE DFT-SESS TO CWIN-SHORTNAME.
  1049.          MOVE 1  TO CWIN-OPTION.
  1050.          MOVE 4096 TO CWIN-FLAGS.
  1051.          MOVE 0  TO CWIN-XPOS.
  1052.          MOVE 0  TO CWIN-YPOS.
  1053.          MOVE 0  TO CWIN-XSIZE.
  1054.          MOVE 0  TO CWIN-YSIZE.
  1055.          MOVE 0  TO CWIN-BEHIND.
  1056.  
  1057.          CALL 'HLLCOB' USING HFUNC-NUM,CWIN-STRUCT,HDS-LEN,HRC.
  1058.  
  1059.          IF HRC = HARC-SUCCESS
  1060.  
  1061.            DISPLAY 'The PM Window Size Is Now Restored.'
  1062.            DISPLAY PRESS-CTRL-ESC
  1063.            DISPLAY BLANK-LINE
  1064.  
  1065.          ELSE
  1066.  
  1067.            PERFORM ERROR-HAND.
  1068.  
  1069.  
  1070.  
  1071.  
  1072.       *********************************************************************
  1073.       * RESET EHLLAPI - Return EHLLAPI to its original conditions         *
  1074.       *                                                                   *
  1075.       *                                                                   *
  1076.       *********************************************************************
  1077.        RESET-EHLLAPI.
  1078.  
  1079.          MOVE HA-RESET-SYSTEM TO HFUNC-NUM.
  1080.  
  1081.          MOVE DFT-SESS TO HDATA-STR(1).
  1082.  
  1083.          CALL 'COBLIM' USING HFUNC-NUM,HDATA-STRING,HDS-LEN,HRC.
  1084.  
  1085.          IF HRC > HARC-SUCCESS
  1086.               PERFORM ERROR-HAND.
  1087.  
  1088.          DISPLAY 'EHLLAPI Reset To Original Conditions.'.
  1089.  
  1090.  
  1091.  
  1092.  
  1093.  
  1094.       *********************************************************************
  1095.       * ERROR_HAND - Error handler.                                       *
  1096.       *                                                                   *
  1097.       * INPUT                                                             *
  1098.       *                                                                   *
  1099.       * OUTPUT                                                            *
  1100.       *********************************************************************
  1101.        ERROR-HAND.
  1102.  
  1103.            DISPLAY BLANK-LINE.
  1104.            MOVE HRC TO DISP-NUM.
  1105.            DISPLAY 'UNEXPECTED RETURN CODE ' DISP-NUM ' from '
  1106.                WITH NO ADVANCING.
  1107.            MOVE HFUNC-NUM TO DISP-NUM.
  1108.            DISPLAY 'FUNCTION #' DISP-NUM '.'
  1109.                WITH NO ADVANCING.
  1110.  
  1111.  
  1112.       ******************************************************************
  1113.       * ITOH - Convert binary to hex digits.                           *
  1114.       *                                                                *
  1115.       * INPUT                                                          *
  1116.       *                                                                *
  1117.       * OUTPUT                                                         *
  1118.       *                                                                *
  1119.       *                                                                *
  1120.       ******************************************************************
  1121.        ITOH.
  1122.  
  1123.  
  1124.            IF BIN-NUM < 0
  1125.              COMPUTE BIN-NUM = 256 + BIN-NUM.
  1126.  
  1127.            COMPUTE BIN-NUM2 = BIN-NUM / 16.
  1128.  
  1129.            ADD 1 TO BIN-NUM2.
  1130.  
  1131.            SET INDX TO BIN-NUM2.
  1132.  
  1133.            MOVE HEX-DIG(INDX) TO HEX-OUT(1).
  1134.  
  1135.            COMPUTE BIN-NUM2 = BIN-NUM - ((BIN-NUM2 - 1) * 16).
  1136.  
  1137.            ADD 1 TO BIN-NUM2.
  1138.  
  1139.            SET INDX TO BIN-NUM2.
  1140.  
  1141.            MOVE HEX-DIG(INDX) TO HEX-OUT(2).
  1142.  
  1143.  
  1144.  
  1145.       ******************************************************************
  1146.       * BIN2HEX - Copy a variable stored in binary as a PIC(4) to a    *
  1147.       *           variable which can be viewed as a hex number in ascii*
  1148.       *                                                                *
  1149.       * INPUT   - BINARY-NUM CONTAINS A PIC 9(4)                       *
  1150.       *         - B-NUM (4) IS A PIC 9 COMP OCCURS 4 TIMES             *
  1151.       *                                                                *
  1152.       * OUTPUT  - H-PRINT  (H-OUT X OCCURS 8 TIMES)                    *
  1153.       *                                                                *
  1154.       *                                                                *
  1155.       ******************************************************************
  1156.        BIN2HEX.
  1157.  
  1158.  
  1159.         COMPUTE BIN-NUM  = B-NUM(3) /16.
  1160.         COMPUTE BIN-NUM2 = B-NUM(3) - (BIN-NUM * 16).
  1161.         ADD 1 TO BIN-NUM.
  1162.         SET INDX TO BIN-NUM.
  1163.         MOVE HEX-DIG(INDX) TO H-OUT(1).
  1164.         ADD 1 TO BIN-NUM2.
  1165.         SET INDX TO BIN-NUM2.
  1166.         MOVE HEX-DIG(INDX) TO H-OUT(2).
  1167.  
  1168.         COMPUTE BIN-NUM = B-NUM(4) /16.
  1169.         COMPUTE BIN-NUM2 = B-NUM(4) - (BIN-NUM * 16).
  1170.         ADD 1 TO BIN-NUM.
  1171.         SET INDX TO BIN-NUM.
  1172.         MOVE HEX-DIG(INDX) TO H-OUT(3).
  1173.         ADD 1 TO BIN-NUM2.
  1174.         SET INDX TO BIN-NUM2.
  1175.         MOVE HEX-DIG(INDX) TO H-OUT(4).
  1176.  
  1177.  
  1178.         COMPUTE BIN-NUM = B-NUM(1) /16.
  1179.         COMPUTE BIN-NUM2 = B-NUM(1) - (BIN-NUM * 16).
  1180.         ADD 1 TO BIN-NUM.
  1181.         SET INDX TO BIN-NUM.
  1182.         MOVE HEX-DIG(INDX) TO H-OUT(5).
  1183.         ADD 1 TO BIN-NUM2.
  1184.         SET INDX TO BIN-NUM2.
  1185.         MOVE HEX-DIG(INDX) TO H-OUT(6).
  1186.  
  1187.  
  1188.         COMPUTE BIN-NUM = B-NUM(2) /16.
  1189.         COMPUTE BIN-NUM2 = B-NUM(2) - (BIN-NUM * 16).
  1190.         ADD 1 TO BIN-NUM.
  1191.         SET INDX TO BIN-NUM.
  1192.         MOVE HEX-DIG(INDX) TO H-OUT(7).
  1193.         ADD 1 TO BIN-NUM2.
  1194.         SET INDX TO BIN-NUM2.
  1195.         MOVE HEX-DIG(INDX) TO H-OUT(8).
  1196.  
  1197.       ******************************************************************
  1198.       * X2HEX - Copy a variable stored in binary as a PIC X(2) to a    *
  1199.       *           variable which can be viewed as a hex number in ascii*
  1200.       *                                                                *
  1201.       * INPUT   - BINARY-NUM-X CONTAINS A PIC X(2)                     *
  1202.       *         - B-NUM-X (2) IS A PIC 9 COMP OCCURS 4 TIMES           *
  1203.       *                                                                *
  1204.       * OUTPUT  - H-PRINT-X  (H-OUT-X X OCCURS 4 TIMES)                *
  1205.       *                                                                *
  1206.       *                                                                *
  1207.       ******************************************************************
  1208.        X2HEX.
  1209.  
  1210.  
  1211.         COMPUTE BIN-NUM = B-NUM(1) /16.
  1212.         COMPUTE BIN-NUM2 = B-NUM(1) - (BIN-NUM * 16).
  1213.         ADD 1 TO BIN-NUM.
  1214.         SET INDX TO BIN-NUM.
  1215.         MOVE HEX-DIG(INDX) TO H-OUT-X(3).
  1216.         ADD 1 TO BIN-NUM2.
  1217.         SET INDX TO BIN-NUM2.
  1218.         MOVE HEX-DIG(INDX) TO H-OUT-X(4).
  1219.  
  1220.  
  1221.         COMPUTE BIN-NUM = B-NUM(2) /16.
  1222.         COMPUTE BIN-NUM2 = B-NUM(2) - (BIN-NUM * 16).
  1223.         ADD 1 TO BIN-NUM.
  1224.         SET INDX TO BIN-NUM.
  1225.         MOVE HEX-DIG(INDX) TO H-OUT-X(1).
  1226.         ADD 1 TO BIN-NUM2.
  1227.         SET INDX TO BIN-NUM2.
  1228.         MOVE HEX-DIG(INDX) TO H-OUT-X(2).
  1229.  
  1230.  
  1231.