From: OPRIMS@SAUPM00.BITNET (Ilyas M. Shaikh)
Newsgroups: bit.listserv.cics-l
Subject: CICS-WHO transaction
Date: 29 Sep 92 09:46:15 GMT
Organization: King Fahd University of Petroleum and Minerals, S.A.
Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU
X-Acknowledge-To: <OPRIMS@SAUPM00.BITNET>

Ref: Janet McCarthy <CN.JMM@STANDFORD.BITNET

Here is the command level program, you are lookig for.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    SOP0SP02.
       AUTHOR.        I M SHAIKH.
       REMARKS.       INQUIRE USERID FROM CICS

       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  MSG-BUFFER.
           05 MSG            PIC X(80).
       01  MSG0.
           05 USER           PIC X(08).
           05 FILLER         PIC X(03) VALUE ' - '.
           05 TRMID          PIC X(08).
       01  MSG1.
           05 FILLER         PIC X(80) VALUE
           'There are no users signed-on at this time...'.
       01  MSG2.
           05 USR-COUNT      PIC Z9.
           05 FILLER         PIC X     VALUE ' '.
           05 FILLER         PIC X(77) VALUE
           'User(s) signed-on at this time under.'.
       01  MSG3.
           05 APPLID         PIC X(8) VALUE SPACE.
           05 FILLER         PIC X     VALUE ':'.
           05 FILLER         PIC X(77) VALUE
           ' List of users signed-on at this time.'.
       01  WS.
           05 I              PIC 99    VALUE 0.
           05 J              PIC 99    VALUE 0.
           05 K              PIC S9(4) COMP.
           05 ACCM           PIC S9(8) COMP.
           05 TERM-TYPE      PIC X.
              88 CONS        VALUE IS '1'.
           05 MSG-LEN        PIC S9(4) COMP VALUE +1896.
           05 MSG-PAGE-SIZE  PIC S9(4) COMP VALUE +23.
           05 MSG-PAGE-LAST  PIC S9(4) COMP VALUE +24.
           05 MSG-PAGE       PIC X(1896) VALUE SPACES.
           05 MSG-LINE       REDEFINES MSG-PAGE PIC X(79) OCCURS 24.

       PROCEDURE DIVISION.

           EXEC CICS HANDLE CONDITION
                    ERROR(999-ERROR) END(999-END)
           END-EXEC.
      ******************************************************************
      * INITIALIZE                                                     *
      ******************************************************************
           EXEC CICS
               ASSIGN APPLID(APPLID)
           END-EXEC.
           EXEC CICS
               INQUIRE ACCESSMETHOD(ACCM) TERMINAL(EIBTRMID)
           END-EXEC.
           MOVE '0' TO TERM-TYPE.
           IF ACCM = DFHVALUE(CONSOLE)
              MOVE '1' TO TERM-TYPE.
           MOVE MSG3 TO MSG-BUFFER.
           PERFORM 999-SEND-MSG.
      ******************************************************************
      * MAIN LOOP STARTS...                                            *
      ******************************************************************
           EXEC CICS
               INQUIRE TERMINAL START
           END-EXEC.
       100-NEXT.
           EXEC CICS
               INQUIRE TERMINAL(TRMID) NEXT
           END-EXEC.

           EXEC CICS
               INQUIRE TERMINAL(TRMID) USERID(USER)
           END-EXEC.
           IF USER = SPACE
              GO TO 100-NEXT.
           ADD 1 TO I.
           MOVE MSG0 TO MSG-BUFFER.
           PERFORM 999-SEND-MSG.
           GO TO 100-NEXT.
      ******************************************************************
      * HANDEL ROUTINES                                                *
      ******************************************************************
       999-CHAT-USER.
           IF J = MSG-PAGE-SIZE
              MOVE '***' TO MSG-LINE (MSG-PAGE-LAST)
              PERFORM 999-SEND-PAGE
              EXEC CICS
                  RECEIVE INTO(MSG) LENGTH(K)
              END-EXEC
              MOVE SPACES TO MSG-PAGE
              MOVE 0 TO J.
       999-ERROR.
           MOVE 'General error cond. raised ...' TO  MSG-BUFFER.
           GO TO 999-SEND-MSG.
       999-END.
           EXEC CICS INQUIRE TERMINAL END END-EXEC.
           IF I = 0
              MOVE MSG1 TO MSG-BUFFER
              GO TO 999-SEND-MSG.
           MOVE I TO USR-COUNT.
           MOVE MSG2 TO MSG-BUFFER.
       999-SEND-MSG.
           IF CONS
              EXEC CICS SEND FROM(MSG-BUFFER) LENGTH(80) END-EXEC.
           IF NOT CONS
              PERFORM 999-CHAT-USER
              ADD 1 TO J
              MOVE MSG-BUFFER TO MSG-LINE (J).
       999-SEND-PAGE.
           IF NOT CONS
              IF J > 0
                 EXEC CICS SEND TEXT FROM(MSG-PAGE)
                 LENGTH(MSG-LEN) ERASE END-EXEC.
       999-EXIT.
           EXEC CICS RETURN END-EXEC.
           GOBACK.
========================================================================
6
LINE 1 %DATE
LINE 4 %SUBJ
LINE 5 %IDEND   %IDSTART
LINE 6 %END
LINE 7 %DIV
LINE 137 V900101  %RESUME
CICS-WHO trans.
CICS-L
UGA


0
8
14 7
1
1 0 1 0 1
1 0 0 0
137
Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU