%const %string (13) vsn="26 JUL 83   1"

%external %integer %fn %spec dprocedure(%integer act, adr)

!     %include "ercc04.pd21s_c03formats"
%constinteger MAXTCPNAME = 15    {TCP-name length}
      %recordformat %C
PROCDATF(%string(6)USER, %string(MAXTCPNAME)TCPNAME, %byteinteger LOGKEY,
      %byteinteger INVOC, PROTOCOL, NODENO, FSYS,
      %integer LOGSNO,
      %byteinteger SITE, REASON, CONSOLE1, CONSOLE2,
      %integer ID, PROCESS, PREV WARN, SESSEND,
      %byteinteger GETMODE, PREEMPT, BLNK, LINK)
!
      %recordformat %c
TMODEF(%halfinteger FLAGS1, FLAGS2,
{.04}  %byteinteger PROMPTCHAR, ENDCHAR,
{.06}  %bytearray BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))} ,
{.0A}  %byteinteger PADS, RPTBUF, LINELIMIT, PAGELENG,
{.0E}  %byteintegerARRAY TABVEC(0:7),
{.16}  %byteinteger CR,ESC,DEL,CAN, SP1,SP2,SP3,SP4,SP5,SP6)
      {length of this format is X20 bytes}

      %recordformat %c
UINFF (%string(6)USER, %string(31)JOBDOCFILE,
{.28}  %integer MARK, FSYS,
{.30}  PROCNO, ISUFF, REASON, BATCHID, 
{.40}  SESSICLIM, SCIDENSAD, SCIDENS, STARTCNSL,
{.50}  AIOSTAT, SCT DATE, SYNC1 DEST, SYNC2 DEST, 
{.60}  ASYNC DEST, AACCT REC, AIC REVS,
{.6C}  %string(15)JOBNAME,
{.7C}  %string(31)BASEFILE,
{.9C}  %integer PREVIC,
{.A0}  ITADDR0, ITADDR1, ITADDR2, ITADDR3,
{.B0}  ITADDR4, STREAM ID, DIDENT, SCARCITY, 
{.C0}  PREEMPTAT, %string(11)SPOOLRFILE,
{.D0}  %integer FUNDS, SESSLEN, PRIORITY, DECKS,
{.E0}  DRIVES, PART CLOSE,
{.E8}  %record(TMODEF)TMODES,
{108}  %integer PSLOT,
{10C}  %string(63)ITADDR,
{14C}  %integerarray FCLOSING(0:3), %integer CLO FES,
{160}  %integer OUTPUT LIMIT, DAPSECS, %longinteger DAPINSTRS,
{170}  %integer OUT, %string(15)OUTNAME,
{184}  %integer HISEG,
{188}  %string(31)FORK,
{1A8}  %integer INSTREAM, OUTSTREAM,
{1B0}  %integer DIRVSN,
       %integer UEND)

%const %record (uinff) %name uinf=9<<18
%const %integer yes=1, no=0
%const %integer print=no


%external %integer %fn fecount(%integer %name num on fe, num on tcp)

%integer j, cur, ct, my fe, nentries, fnum, tnum
%string (maxtcpname) my tcp
%record (procdatf) %name c
%record %format proc rec f(%integer n, array adr)
%record (proc recf) proc rec
%record (procdatf) %array p(1:256)

   num on fe=0
   num on tcp=0
   proc rec_array adr=addr(p(1))

   j=dprocedure(1, addr(proc rec))
   %if j#0 %then %result=j

   nentries=proc rec_n
   my fe=-1
   my  tcp=""

   fnum=0
   tnum=0

   %until fnum>0 %cycle
      cur=0
      ct=0
      %while cur<nentries %cycle
         cur=cur+1
         ct=ct+1
         c==p(cur)

         %if my fe>=0 %start
            ! Second pass: count users on my fe and tcp
            %if (p(cur)_id>>16)&255=my fe %then fnum=fnum+1
            %if p(cur)_tcpname=my tcp#"null" %then tnum=tnum+1
         %finish

         %if p(cur)_user=uinf_user %and p(cur)_invoc=uinf_isuff %and my fe<0 %then %c
            my fe=(p(cur)_id>>16)&255 %and my tcp=p(cur)_tcpname %and %exit

      %repeat
   %repeat

   %if print=yes %start
      printstring("Num on my  fe:"); write(fnum, 1); newline
      printstring("Num on my tcp:"); write(tnum, 1); newline
   %finish
   num on fe=fnum
   num on tcp=tnum
   %result=0

%end; ! fecount

%external %routine test fecount(%string (255) s)
%integer a, b, j
   j=fecount(a, b)
   printstring("Flag / fecount / tcp count")
   newline
   write(j, 1); write(a, 1); write(b, 1)
   newline
%end

%end %of %file