EXTERNALROUTINE  DESCRIBE(STRING (255)USER)
!
ROUTINE  ERROR(INTEGER  N)
EXTERNALSTRINGFNSPEC  DERRS(INTEGER  N)
      PRINTSTRING("Flag = ")
      PRINTSTRING(DERRS(N))
END 
!
!
!
ROUTINE  PRINTCHS(STRING (255)S)
SYSTEMINTEGERFNSPEC  IOCP(INTEGER  EP, PARM)
INTEGER  LEN, ADR, RES; ! KEEP IN THIS ORDER !!!!
      RETURN  IF  LENGTH(S) = 0
      LEN = LENGTH(S)
      ADR = ADDR(S) + 1
      RES = IOCP(19, ADDR(LEN))
END 
!
!
!
ROUTINE  MOVE(INTEGER  L, FROM, TO)
      *LDTB_X'18000000'
      *LDB_L
      *LDA_FROM
      *CYD_0
      *LDA_TO
      *MV_L =DR 
END ; ! MOVE
!
!
!
INTEGERFN  GET FSYS(STRING (6)USER, INTEGERNAME  FS)
EXTERNALINTEGERFNSPEC  DFSYS(STRING (6)USER, INTEGERNAME  FSYS)
EXTERNALROUTINESPEC  GETAVFSYS(INTEGERNAME  N, INTEGERARRAYNAME  A)
EXTERNALSTRINGFNSPEC  VDUS(INTEGER  N)
INTEGER  N, F, C
INTEGERARRAY  FSYS(0:99)
      GET AV FSYS(N, FSYS)
      C = 0
      CYCLE  F = 0, 1, N-1
         J = DFSYS(USER, FSYS(F))
         RESULT  = J IF  0 # J # 37
!
         IF  J = 0 START 
            IF  C = 0 START 
               PRINTCHS(VDUS(1))
               PRINTSTRING("User: ")
               PRINTSTRING(USER)
               PRINTSTRING("    Fsys: ")
               FS = FSYS(F)
            FINISH 
            C = C + 1
            WRITE(FSYS(F), 2)
         FINISH 
      REPEAT 
!
      RESULT  = 37 IF  C = 0
      RESULT  = 0
END 
!
!
!
EXTERNALINTEGERFNSPEC  DSFI(STRING (6)USER, INTEGER  FSYS, TYPE,
      SET, ADR)
SYSTEMSTRING (8)FNSPEC  UNPACKDATE(INTEGER  I)
SYSTEMSTRING (8)FNSPEC  UNPACKTIME(INTEGER  I)
INTEGER  J, T, FSYS, AI0, K
INTEGERARRAY  INT(0:15)
STRING (15)W
REAL  R
STRINGNAME  S
CONSTINTEGER  TYPES = 15
CONSTBYTEINTEGERARRAY  TYP(1:TYPES) = C 
      18, 1, 0, 4, 30, 11, 12, 7, 13, 14, 33, 37, 40, 6, 9
CONSTSTRING (31)ARRAY  TAG(1:TYPES) = C 
"Surname:  ", "
Delivery: ", "
Basefile: ", "
Index use: ", "
Files: ", "
Limits: MaxKb",
"  Maxfilesize", "
ACR: ", "
Current procs: ", "   max procs: ", "
Funds: ", " Gpholder: ", "
Dates passwords changed: ", "
Last log on: ", "
#ARCH use: index size"
SWITCH  SW(1:TYPES)
!
      J = GET FSYS(USER, FSYS)
      ERROR(J) AND  RETURN  UNLESS  J = 0
      NEWLINE
!
      AI0 = ADDR(INT(0))
      S == STRING(AI0)
      CYCLE  T = 1, 1, TYPES
         J = DSFI(USER, FSYS, TYP(T), 0, AI0)
         PRINTSTRING(TAG(T))
         -> SW(T) IF  J = 0
         ERROR(J)
         -> NEXT
SW(1):
SW(2):
SW(3):
SW(12):
      PRINTSTRING(S)
      -> NEXT
SW(4):
      WRITE(INT(0), 1)
      PRINTSTRING(" files, index size")
      WRITE(INT(3)+1, 1)
      PRINTSTRING("Kb")
      NEWLINE
!
      WRITE(INT(1), 3); PRINTSTRING(" FDs used")
      WRITE(INT(4)-INT(5), 3); PRINTSTRING(" SDs used")
      WRITE(INT(6)-INT(7), 3); PRINTSTRING(" PDs used")
      NEWLINE
!
      WRITE(INT(2), 3); PRINTSTRING(" FDs free")
      WRITE(INT(5), 3); PRINTSTRING(" SDs free")
      WRITE(INT(7), 3); PRINTSTRING(" PDs free")
      -> NEXT
SW(5):
      WRITE(INT(0), 1)
      PRINTSTRING(" disc files,")
      WRITE(INT(1), 1)
      PRINTSTRING(" Kb,")
      WRITE(INT(4), 1)
      PRINTSTRING(" Temp files,")
      WRITE(INT(5), 1)
      PRINTSTRING(" Temp Kb")
      -> NEXT
SW(6):
SW(7):
SW(8):
      WRITE(INT(0), 1)
      -> NEXT
SW(9):
      WRITE(INT(0), 3)
      WRITE(INT(1), 3)
      -> NEXT
SW(10):
      WRITE(INT(0), 3)
      WRITE(INT(1), 3)
      WRITE(INT(2), 3)
      -> NEXT
SW(11):
      R = INT(0) / 10000
      PRINT(R, 1, 2)
      -> NEXT
SW(14):
SW(13):
      CYCLE  J = 0, 1, 1
         K = INT(J)
         IF  K = 0 C 
         THEN  PRINTSTRING("????") C 
         ELSE  PRINTSTRING(UNPACKDATE(K)."   ".UNPACKTIME(K))
         PRINTSTRING("  /  ") IF  J = 0
      REPEAT 
      -> NEXT
SW(15):
      WRITE(INT(4), 1)
      NEWLINE
      WRITE(INT(0), 6); PRINTSTRING(" A files ")
      WRITE(INT(2), 6); PRINTSTRING(" B files ")
      WRITE(INT(5)-INT(6), 4); PRINTSTRING(" FDs used")
      WRITE(INT(7)-INT(8), 4); PRINTSTRING(" PDs used")
      NEWLINE
      WRITE(INT(1), 6); PRINTSTRING(" A Kbytes")
      WRITE(INT(3), 6); PRINTSTRING(" B Kbytes")
      WRITE(INT(6), 4); PRINTSTRING(" FDs free")
      WRITE(INT(8), 4); PRINTSTRING(" PDs free")
NEXT:
      REPEAT 
      NEWLINE
END 
!
ENDOFFILE