         SYSTEM   SIG7
         SYSTEM   BPM
         SYSTEM   DCPROCS
         SYSTEM   ADMDSECT
         REF      M:SI,M:UC,M:LO
         REF      J:ACCN
         REF      BINCONV,BLDTXTC,DECBIN,MVTXTC,PRINT
         DEF      ENTRY
         DEF      GTOTAL
         CSECT    1
ENTRY    EQU      %
         STW,R0   STKPTR
         PRINT    SP                BLANK LINE
         PRINT    SP                BLANK LINE
         CLEARLST FILCNT,GTOTAL
         M:TIME   TBUF+1
         MVBYTES  TBUF+1,0,TBUF,1,16
         LI,X1    16
         STB,X1   TBUF
         LW,C1    M:SI+22           FILE NAME CONTROL WORD
         AND,C1   =X'FF'            LENGTH OF ENTRY
         AI,C1    M:SI+23           POINT TO ACCOUNT CONTROL WORD
         LW,I1    *C1               GET CONTROL WORD
         AI,C1    1                 POINT TO ACCOUNT
         CI,I1    X'FF00'
         BANZ     %+2               BR IF ACCOUNT SIGNIFICANT
         LI,C1    J:ACCN            NO, USE USER'S ACCOUNT
         LCI      2
         LM,X1    *C1               PICK UP THE ACCOUNT
         LI,C1    7
         LI,I1    X'40'
ACCNLOOP CB,I1    X1,C1
         BNE      %+2
         BDR,C1   ACCNLOOP          DELETE TRAILING BLANKS
         AI,C1    1
         STB,X2   TBUF+8
         SLD,X1   -8
         STB,C1   X1                TEXTC COUNT
         LCI      2
         STM,X1   TBUF+6
         BLDTXTC  OUTBUF,TBUF+6,TITLE,TBUF
         PRINT    OUTBUF
         BLDTXTC  OUTBUF,HDDR1,HDDR2
         PRINT    OUTBUF
         LW,X1    =X'01010101'      SET LAST INDICATOR
         LW,X2    =X'01000000'      FILE NAME = X'00'
         LCI      2
         STM,X1   OPNFPT+6
NXTFIL   MVWDS    INITBUF,TBUF,32  INITIALISE TBUF
,OPNFPT  M:OPEN   M:SI,IN,NXTF,(ABN,OPNABN),(ERR,OPNABN),;
                    (FPARAM,FPARAM),(FILE,'A')
         LI,X1    0
         LI,X2    X'F'              RESET FLAGS TO INDICATE
         STS,X1   OPNFPT+1            NO VLPS PRESENT
         MTW,1    FILCNT
         GO       GETVLP
OPNABN   EQU      %
         LI,X1    0
         LI,X2    1                 RESET FLAG TO INDICATE
         STS,X1   OPNFPT+1            NO VLPS PRESENT
         LB,X1    SR3
         CI,X1    X'02'             SEE IF END OF ACCOUNT
         BE       LISTEND
         MTW,1    FILCNT            COUNT FILES THAT CAN'T BE OPENED
         CI,X1    X'14'
         BNE      PRNTER            BR IF UNKNOWN ERROR
         MVTXTC   SP2,TBUF+13
         CW,SR3   =X'FE0000'
         BAZ      OPNABN5           BR IF 14-00
         MVTXTC   BUSYMES,TBUF      ASSUME 14-01 (FILE BUSY)
         B        PRNTER5
OPNABN5  MVTXTC   RESTMES,TBUF      14-00 (ACCESS PROTECTION)
         B        PRNTER5
*
PRNTER   EQU      %
         STW,SR3  TLOC
         LB,C1    TLOC              MAJOR ERROR CODE
         SLS,C1   8
         LH,X1    TLOC
         SLS,X1   -1
         AND,X1   =X'7F'            EXTRACT SUB CODE
         OR,X1    C1                COMBINE MAJOR AND SUB CODES
         STW,X1   TLOC              RIGHT JUSTIFIED IN TLOC
         BINHEX   TLOC,TLOC+1,4
         BLDTXTC  TBUF,ERROR,TLOC+1  CONCATENATE MESSAGE & ERROR CODE
         MVTXTC   SP13,TBUF+13
PRNTER5  MVTXTC   SP27,TBUF+6
         MVTXTC   M:SI+23,TBUF+17   MOVE FILE NAME FROM DCB
         BLDTXTC  OUTBUF,TBUF,TBUF+6,TBUF+13,TBUF+17
         PRINT    OUTBUF
         M:SETDCB M:SI,(ABN,NXTFIL),(ERR,NXTFIL)
         M:CLOSE  M:SI
         GO       NXTFIL
GETVLP   EQU      %
         PAGE
         LI,I4    FPARAM
         LI,I1    1
         LI,I2    2
         LI,I3    3
VLPLP    LB,X1    *I4               GET CODE
         CI,X1    X'10'
         BG       VLPLP1            DON'T WANT IT
         MTB,0    *I4,I2
         BEZ      VLPLP1            PARAMETER NOT PRESENT
         LW,C1    X1
         EXU      VLPTAB-1,C1       GET PARAMETER OR NOP
VLPLP1   MTB,0    *I4,I1            SEE IF LAST ENTRY
         BNEZ     GRECNT         YES, GO TO CALCULATE NO OF RECORDS
         LB,X1    *I4,I3            GET LENGTH
         AW,I4    X1
         AI,I4    1
         GO       VLPLP             NEXT PARAMETER
         PAGE
FNAME    PUSH   16,R0
         AI,I4    1
         STW,I4   TLOC
         MVTXTC   *TLOC,TBUF+17
         PULL    16,R0
         B        *R15
GCOUNT   PUSH   16,R0
         LW,X1    *I4,I1
         AWM,X1   GTOTAL
         STW,X1   TLOC+1
         BINDEC   TLOC+1,TBUF+1,6
         PULL    16,R0
         B        *R15
ORG      PUSH   16,R0
         AI,I4    1
         LB,C1    *I4
         STW,C1   ORGTYP            SAVE FOR GRECNT ROUTINE
         LB,X2    L('CCKR'),C1
         AI,X2    X'100'
         STH,X2   TBUF
         PULL    16,R0
         B        *R15
         PAGE
MDATE    LI,X1    TBUF+8
         B        GDATE
EDATE    LI,X1    TBUF+14
         B        GDATE
CDATE    LI,X1    TBUF+5
         B        GDATE
SDATE    LI,X1    TBUF+11
         B        GDATE
GDATE    PUSH   16,R0
         STW,X1   TLOC
         LW,X1    *I4,I1
         BEZ      NODATE
         AND,X1   L(X'FFFF')
         AW,X1    L(X'07400000')
         STW,X1   TLOC+1
         AI,I4    1
         LH,X1    *I4
         AND,X1   L(X'FFFF')
         CI,X1    'NE'
         BNE      GDATE2
         MVTXTC   NEVER,TLOC+1
         B        MVDATE
GDATE2   AW,X1    L(X'03F00000')
         STW,X1   TLOC+2
         DECBIN   TLOC+2,TLOC+2,NODATE
         LW,C1    TLOC+2
         LW,X1    MONTAB-1,C1
         STW,X1   TLOC+2
MVDATE   MVTXTC   TLOC+1,*TLOC
         GO       DATRET
NODATE   MVTXTC   SP,*TLOC
DATRET   PULL    16,R0
         B        *R15
GRECNT   EQU      %
         LI,X1    3
         CW,X1    ORGTYP            SEE IF RANDOM FILE
         BE       VLPEND            YES NO RECORD COUNT
         M:PFIL   M:SI,BOF
         M:PRECORD M:SI,FWD,(N,X'7FFF'),(ABN,PRECABN)
         MVTXTC   G32K,TBUF+3
         GO       VLPEND
PRECABN  EQU      %
         LB,X1    SR3               GET ABNORMAL CODE
         CI,X1    X'06'             SEE IF EOF
         BE       GTCNT2
         MVTXTC   ERROR,TBUF+3      FLAG STRANGE ABNORMAL
         GO       VLPEND
GTCNT2   EQU      %
         LW,X1    M:SI+4            GET ARS WD
         SLS,X1   -17               FORM REMAINDER COUNT
         LI,X2    X'7FFF'
         SW,X2    X1                FORM RECORD COUNT
         STW,X2   TLOC+1
         BINDEC   TLOC+1,TBUF+3,6
         GO       VLPEND
         PAGE
VLPEND   EQU      %
         BLDTXTC  OUTBUF,TBUF,SP,TBUF+1,SP,TBUF+3,SP,TBUF+5,SP,;
                  SP,TBUF+8,SP,TBUF+11,SP,TBUF+14,SP,SP,TBUF+17
         PRINT    OUTBUF
         M:CLOSE  M:SI
         GO       NXTFIL
LISTEND  EQU      %
         BINDEC   GTOTAL,TBUF,5
         BINDEC   FILCNT,TBUF+2,3
         BLDTXTC  OUTBUF,TBUF+2,SP,FILES,SP,TBUF,SP,GRANULES
         PRINT    OUTBUF
         M:EXIT
         PAGE
VLPTAB   EQU      %
         BAL,R15  FNAME
         NOP
         NOP
         BAL,R15  EDATE
         NOP                        READ ACCT
         NOP                        WRITE ACCT
         NOP                        INSN
         NOP                        OUTSN
         BAL,R15  ORG
         NOP                        MODIFICATION (UPDATE) DATE
         NOP                        SYNON
         NOP                        ?
         BAL,R15  GCOUNT
         BAL,R15  CDATE
         BAL,R15  MDATE             ACCESS DATE
         BAL,R15  SDATE
         PAGE
MONTAB   EQU      %
         DATA     ' JAN',' FEB',' MAR',' APR',' MAY',' JUN'
         DATA     ' JUL',' AUG',' SEP',' OCT',' NOV',' DEC'
INITBUF  EQU      %
         TXTC     ' '               ORG (TBUF)
         TXTC     '      '          GRANULES (TBUF+1)
         TXTC     '      '          REC (TBUF+3)
         TXTC     '       '         CREATED (TBUF+5)
         DATA     '    '            FILL WORD
         TXTC     '       '         MODIFIED (TBUF+8)
         DATA     '    '
         TXTC     '       '         SAVED (TBUF+11)
         DATA     '    '
         TXTC     '       '         EXPIRES (TBUF+14)
         DATA     '    '
         TXTC     '                               ' NAME (TBUF+17)
TITLE    TXTC     ' ACCOUNT LISTING AT '
NEVER   TXTC     '*NEVER*'
FILES    TXTC     'FILES'
GRANULES TXTC     'GRANULES'
ERROR    TXTC     'ERROR '
BUSYMES  TXTC     '      **BUSY**       '
RESTMES  TXTC     '**RESTRICTED ACCESS**'
HDDR1    TEXTC    'ORG GRAN    REC  CREATED ACCESSED SAVED '
HDDR2    TXTC     '  EXPIRES NAME'
SP      TXTC     ' '
SP2      TXTC     '  '
SP13     TXTC     '             '
SP27     TXTC     '                           '
G32K     TXTC     '*>32K*'
        CSECT    0
GTOTAL  DATA     0
FILCNT   RES      1
ORGTYP   RES      1
         BOUND    8
TBUF     EQU      INBUF
FPARAM   EQU      FILEBUF
         END      ENTRY
