*ASM XOPTS(SP)                                                          00010000
*        Copyright Russell Evans 2002                                   00020000
**********************************************************************  00030000
*      REEWHO   - inquire on my terminal                             *  00040000
**********************************************************************  00050000
*                                                                    *  00060000
* Module Name : REEWHO                                               *  00070000
**********************************************************************  00080000
REEWHO   TITLE   'inquire on my terminal'                               00090000
*                                                                       00100000
         DFHREGS ,                                                      00110000
BASEREG  EQU   10                                                       00120000
DATAREG  EQU   4                                                        00130000
INPUTREG EQU   5                                                        00140000
EIBBAR   EQU   6                                                        00150000
*                                                                       00160000
         COPY  DFHAID              Attention Id's                       00170000
         COPY  DFHBMSCA            BMS Attribute bytes                  00180000
*                                                                       00190000
**********************************************                          00200000
*  STORAGE                                                              00210000
**********************************************                          00220000
*                                                                       00230000
DFHEISTG DSECT                                                          00240000
WS_WORK  DS    2D                work area for unpack                   00241000
WS_CVD   DS    D                 work area for convert                  00242000
WS_RESP  DS    F                 General purpose resp field             00243000
TERMSEC  DS    F                 yes/no                                 00243100
UCTRAN   DS    F                 yes/no/tran only                       00243200
MOD      DS    H                 model type                             00243300
TCTUAL   DS    H                 TCTUA length                           00243400
LUNAME   DS    CL8               Netname                                00244000
USERID   DS    CL8               Userid                                 00244100
OPID     DS    CL3               Operator ID                            00245000
PRINTTO  DS    CL4               Printer ID (if any)                    00246000
                                                                        00247000
         PRINT GEN                                                      00270000
REEWHO   DFHEIENT CODEREG=(BASEREG),EIBREG=(EIBBAR),DATAREG=(DATAREG)   00280000
REEWHO   AMODE 31                                                       00290000
REEWHO   RMODE ANY                                                      00300000
*                                                                       00310000
A100     DS    0H                 Overall processing control            00320000
*                                                                       00330000
         EXEC  CICS INQUIRE TERMINAL(EIBTRMID)                         *00340000
               NETNAME(LUNAME)                                         X00350000
               OPERID(OPID)                                            X00360000
               PRINTER(PRINTTO)                                        X00370000
               SECURITY(TERMSEC)                                       X00380000
               TERMMODEL(MOD)                                          X00390000
               UCTRANST(UCTRAN)                                        X00400000
               USERAREALEN(TCTUAL)                                     X00410000
               USERID(USERID)                                          X00420000
               RESP(WS_RESP)                                            00428000
         CLC   WS_RESP,DFHRESP(NORMAL)      did inquire work?           00429000
         BNE   INQ_FAILED                   no, skip the rest           00430000
*                                                                       00440000
SENDIT   DS    0H                                                       00450000
         LH    R1,MOD                      get model number             00460000
         BAS   R7,CONVERT                  go convert it                00470000
         MVC   OUTMOD,WS_WORK+11           and move to output           00480000
*                                                                       00490000
         LH    R1,TCTUAL                   get amount                   00500000
         BAS   R7,CONVERT                  go convert it                00510000
         MVC   OUTUAL,WS_WORK+11           and move to output           00520000
*                                                                       00642100
         MVC   OUTTERM,EIBTRMID            save termid                  00642200
         MVC   OUTLU,LUNAME                save netname                 00642300
         MVC   OUTOPID,OPID                save opid                    00642400
         MVC   OUTPRINT,PRINTTO            save printer name            00642500
         MVC   OUTUSER,USERID              save netname                 00642600
         MVC   OUTLU,LUNAME                save netname                 00642700
         MVC   OUTSEC,ACTIVE               preset to active             00642800
         CLC   TERMSEC,DFHVALUE(PRESETSEC) is it?                       00642900
         BE    TERMYES                     yes, continue                00643000
         MVC   OUTSEC,INACTIVE             No, set to inact             00643100
TERMYES  DS    0H                                                       00643200
         MVC   OUTUCT,=CL11'ACTIVE'        preset to active             00643300
         CLC   UCTRAN,DFHVALUE(UCTRAN)    is it?                        00643400
         BE    UCTYES                      yes, continue                00643500
         MVC   OUTUCT,=CL11'TRANID ONLY'   preset to tranid             00643600
         CLC   UCTRAN,DFHVALUE(TRANIDONLY) is it?                       00643700
         BE    UCTYES                      yes, continue                00643800
         MVC   OUTUCT,=CL11'INACTIVE   '   preset to tranid             00643900
UCTYES   DS    0H                                                       00644000
         EXEC CICS SEND TEXT FROM(OUTTXT) LENGTH(TXTLEN)               X00645400
             ERASE FREEKB NOHANDLE                                      00645500
         EXEC CICS RETURN                                               00645600
INQ_FAILED    DS 0H                                                     00645700
         EXEC CICS SEND TEXT FROM(FAILMSG) ERASE FREEKB NOHANDLE        00645800
         EXEC CICS RETURN                                               00646000
CONVERT  DS    0H                                                       00647000
         CVD   R1,WS_CVD                    convert bin to packed       00648000
         UNPK  WS_WORK(16),WS_CVD           unpack                      00649000
         OI    WS_WORK+15,X'F0'             remove sign                 00650000
         BR    R7                           and return                  00660000
*                                                                       00670000
*OVEIT   MVC   MSGPROG(0),5(INPUTREG)       set program name            00680000
ACTIVE   DC    CL8'ACTIVE'                                              00690000
INACTIVE DC    CL8'INACTIVE'                                            00691000
FAILMSG  DC CL75'Error issuing the inquire command.'                    00692000
OUTTXT   DS   0C                                                        00693000
         DC   C'               CICS Terminal Status Inquiry'            00694000
         DC   X'1515'                                                   00695000
         DC   C'CICS Term ID               '                            00696000
OUTTERM  DS   CL4                                                       00697000
         DC   X'15'                                                     00698000
         DC   C'User currently signed on   '                            00699000
OUTUSER  DS   CL9                                                       00700000
         DC   X'15'                                                     00710000
         DC   C'CICS OPID                  '                            00720000
OUTOPID  DS   CL3                                                       00730000
         DC   X'15'                                                     00731000
         DC   C'VTAM LU name               '                            00732000
OUTLU    DS   CL8                                                       00733000
         DC   X'15'                                                     00734000
         DC   C'Associated printer         '                            00735000
OUTPRINT DS   CL4                                                       00735100
         DC   X'15'                                                     00735200
         DC   C'Terminal security is       '                            00735300
OUTSEC   DS   CL8                                                       00735400
         DC   X'15'                                                     00735500
         DC   C'Terminal model number      '                            00735600
OUTMOD   DS   CL5                                                       00735700
         DC   X'15'                                                     00735800
         DC   C'Uppercase translation is   '                            00735900
OUTUCT   DS   CL9                                                       00736000
         DC   X'15'                                                     00736100
         DC   C'TCT user area length       '                            00736200
OUTUAL   DS   CL5                                                       00736300
ENDTXT   DS   0C                                                        00738500
TXTLEN   DC   AL2(ENDTXT-OUTTXT)                                        00738600
*                                                                       00738700
         END                                                            00738800
