* 02/09/76 -- 14:00
* MODULE NAME: EXTERN
* NUMBER: 13
* PURPOSE: PRINT STORAGE REPORTS AND HANDLE 'XT' COMMAND
*
* ENTRY POINTS:
*
         DEF      C13REPOR          STORAGE REPORT AT TERM.
         DEF      C13XR             STORAGE REPORT AT LP
         DEF      C13XT             MAG TAPE
         DEF      C13XO             MSG TO OPERATOR
         DEF      C13DSMNT          DISMOUNT MAG TAPE
*
*
         REF      S03WMREC          WRITE MASTER RECORD
         REF      S27CTXT,S27CHDR   CLOSE TEXT,HEADER FILES
         REF      S27OCPY,S27CCPY   OPEN,CLOSE COPY FILE
         REF      S36M:TIME         GET DATE/TIME
         REF      S36NXTF           OPEN NEXT FILE IN ACCT
         REF      S27RCPY,S27WCPY READ, WRITE COPY FILE
         REF      S35CNVRT          CONVERT TO EBCDIC
         REF      S03RESWS          RESET WS FILES
         REF      S37OUTLN          PRINT OUTPUT LINE
         REF      S27SETLP          LP PRINTOUT
         REF      S29STD            PRINT MESSAGES
         REF      J:ACCN            USER ACCT NUMBER
         REF      ZRORTNST          RE-INITIALIZE RETURN STACK
         REF      S27MTOPN,S27MTLST MAG TAPE OPENS
         REF      S27RDMT,S27WRMT   READ,WRITE MAG TAPE
         REF      S36MTCLS          CLOSE MAG TAPE FILES
         REF      S36M:MSG          MESSAGE TO OPERATOR
         REF      FILEFLG           FILE OUTPUT FLAG
         REF      BATCHFLG          BATCH MODE FLAG
         REF      S04XFILE          EXIT FILE OUTPUT MODE
         REF      S27PRINT          PRINT OUTPUT LINE
         REF      S37LP             LINE PRINTER TO QUEUE
*
*
         PAGE
*
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
            INVWSSTA
            INVCMDSTA
            INVDCBTBL
            INVPRSTA
*
*
*
         DEF      13P,13D
*
13P      EQU      %
         DATA     X'13'             MODULE NUMBER
         DATA     X'020976'         DATE
         DATA     X'1400'           TIME
*
*
         TITLE    '** EXTERN(13) **'
*
*
* C13REPOR,C13XR  -- PRINT STORAGE REPORT
*
C13REPOR EQU      %
         SAVRTN
*
         LI,D1    0                 SET LP FLAG FOR TERMINAL
         PUT,D1   PR:LPFLG
         STB,D1   BATCHFLG          IF BATCH SET TO GO THRU M:LO
         LW,AC1   FILEFLG           IF FILE OUTPUT
         STB,AC1  FILEFLG             SET TO OUTPUT THRU M:LO
         B        INITREP           GO INITIALIZE REPORT
*
*
C13XR    EQU      %
         SAVRTN
         LI,D1    0
         PUT,D1   PR:VFLG           RESET XGP OUTPUT FLAG
*
         LI,D1    1                 SET LINE PRINTER FLAG ON
         PUT,D1   PR:LPFLG
         BAL,SRTN S27SETLP          GO SET-UP LINE PRINTER
         CI,SR3   0                 TEST FOR AUTHORIZATION
         BE       INITREP              OK, INITIALIZE REPORT
*
         LI,AC1   30                'NOT AUTHORIZED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         LI,AC1   6                 'ACTION CANCELLED'
         BAL,SRTN S29STD            PRINT MESSAGE
         RETURN
*
*
         PAGE
*
*
INITREP  EQU      %
         BRKCTRL  0                 INITIALIZE BREAK CONTROL
         BAL,SRTN S03WMREC          SAVE MASTER RECORD
         LI,AC1   #SAVE             CLOSE WS FILES WITH SAVE
         BAL,SRTN S27CTXT
         BAL,SRTN S27CHDR
*
         LI,AC1   0                 INITIALIZE NUMBER OF DOCS.
         STW,AC1  NUMDOCS
         STW,AC1  STDINBUF          SET FILE NAME TO ZERO
         PUT,AC1  #NCACCT           SET ACCT AND PASSWORD TO 0
         LI,AC1   4                 SET DOC NAME TO 4CHARS
         PUT,AC1  #NCDOCNM
         LI,AC1   BA(STDINBUF)      GET ADDR OF NAME
         PUT,AC1  #DOCNM            SET DOC. NAME
         JEZ,D1   (#FLAGS,:K(1)),NOACCT  TEST FOR ACCT SPECIFIED
         GET,D1   #NCCS,:K(2)       GET NUMBER OF CHARS IN ACCT
         CI,D1    8                 IS NUMBER OF CHARS GT 8
         BG       ACCTERR           YES, ERROR
         PUT,D1   #NCACCT           SAVE FOR OPEN
         GET,D2   #CS,:K(2)
         PUT,D2   #ACCT             SET UP ADDR OF ACCT
NOACCT   RES      0
         LI,AC1   #INOUT            SET MODE = INOUT
         BAL,SRTN S27OCPY           POSITION AT FIRST FILE
         LI,AC1   #REL              RELEASE INITIAL FILE
         BAL,SRTN S27CCPY
*
*
         PAGE
*
*
         MOVE,X1  BA(J:ACCN),INSACCT,8  MOVE ACCT NUMBER TO TITLE
         JEZ,D1   (#FLAGS,:K(1)),WRTITLE  IF NO ACCT, WRITE TITLE
         MOVE,X1  BA(BLANKS),INSACCT,8  MOVE BLANKS TO ACCT
*
* MOVE ACCT TO MESSAGE
         GET,X1   #CS,:K(2)
         LI,X2    BA(INSACCT)
         GET,D1   #NCCS,:K(2)
         STB,D1   X2
         MBS,X1   0                 MOVE ACCT TO MESSAGE
WRTITLE  RES      0
         LB,AC1   RTITLE            GET TITLE SIZE
         STW,AC1  SVMSGSZ           SAVE MESSAGE SIZE
         LI,AC2   X'0100'           SET ONE SKIP FOR LINE
         STH,AC2  RTITLE            STORE IN MSG
         LI,BUF2  BA(RTITLE)        GET ADDR OF MSG
         AI,AC1   1                 ADD ONE FOR CONTROL BYTES
         BAL,SRTN S37OUTLN          PRINT LINE
         LW,AC1   SVMSGSZ           RESTORE MSG SIZE
         STB,AC1  RTITLE
*
         LI,AC3   WA(STDINBUF)      GET ADDR FOR DATE
         BAL,SRTN S36M:TIME         GET DATE AND TIME
         MOVE,X1  BA(STDINBUF),BA(STDPRBUF)+2,16  MOVE TO MSG
         LI,AC2   X'0200'           SET CONTROL BYTES
         STH,AC2  STDPRBUF
         LI,AC2   #CR               GET CR CHAR
         STB,AC2  0,X2              STORE IN MSG
         LI,BUF2  BA(STDPRBUF)      GET ADDR OF OUTPUT LINE
         LI,AC1   19                SIZE OF MESSAGE
         BAL,SRTN S37OUTLN          PRINT LINE
*
*
         PAGE
*
*
NEXTFILE EQU      %
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     ENDREP               SET, END OF REPORT
         INSCHAR  #BLANK,BA(STDPRBUF),66   BLANK-OUT BUFFER
         LI,AC1   X'0100'           SET CONTROL BYTES FOR ENTRY
         STH,AC1  STDPRBUF
         LI,AC1   X'0100'           SET CONTROL BYTES FOR DOC. ID
         STH,AC1  STDINBUF
         LI,AC1   1                 INITIALIZE DOC. ID FOR SKIP ONLY
         STW,AC1  DOCIDSZ
*
         BAL,SRTN S36NXTF           OPEN NEXT FILE IN ACCT
         CI,SR3   2                 TEST FOR LAST FILE
         BE       ENDREP               YES, END-OF-REPORT
         CI,SR3   0                 TEST FOR NOT OPEN
         BE       TSTRECZ              OPEN TEST RECORD ZERO
         CI,SR3   10                TEST FOR LAST FILE CLOSED
         BNE      NEXTCLS              NOT OPEN, GET NEXT
*
TSTRECZ  EQU      %
         DEPZ,D1  WS:TXTCODE        INITIALIZE CODE WORD
         LI,BUF2  BA(WSSTA)         GET ADDR TO READ KEY 0.0
         LI,AC1   SZWSSTA*4         SIZE OF MASTER REC
         LW,AC2   L(#ZROKEY)        SET KEY = 0.0
         BAL,SRTN S27RCPY           READ MASTER REC
         CI,AC2   0                 TEST FOR FOUND
         BE       NEXTCLS              NO, GET NEXT FILE
*
*
         PAGE
*
*
         GET,D1   WS:TXTCODE        GET TEXT CODE WORD
         CW,D1    L(#CODEWRD)       TEST FOR VALID CODE
         BNE      NEXTCLS              NO, GET NEXT FILE
         GET,AC1  *DCB:NCNM            YES, GET SIZE OF NAME
         LW,X1    DCBADDR           GET ADDR OF DCB
         AI,X1    :EO(DCB:NCNM)     ADD OFFSET FOR FILE NAME
         SLS,X1   2                 CONVERT TO BYTE ADDR
         LI,X2    BA(STDPRBUF)+2    GET ADDR OF REPORT BUFFER
         STB,AC1  X2                STORE COUNT FOR MBS
         MBS,X1   1                 MOVE NAME TO BUFFER
*
*
         PAGE
*
*
         LI,X1    :ADEO(WS:OPID)    GET ADDR OF OPERATOR ID
         SLS,X1   2                 CONVERT TO BYTE ADDR
         LI,AC1   12                SIZE OF OP ID
         LI,X2    BA(STDPRBUF)+#OPDISP  GET ADDR FOR OP ID
         STB,AC1  X2                STORE COUNT FOR MBS
         MBS,X1   0                 MOVE OP ID TO BUFFER
*
         LI,X1    :ADEO(WS:TIME)    GET ADDR OF STORE TIME
         SLS,X1   2                 CONVERT TO BYTE ADDR
         AI,X1    6                 GET DATE ONLY
         LI,AC1   10                SIZE OF DATE
         LI,X2    BA(STDPRBUF)+#DATDISP  GET ADDR FOR DATE
         STB,AC1  X2                STORE COUNT FOR MBS
         MBS,X1   0                 MOVE DATE TO BUFFER
*
         GET,AC1  #NLINES           GET LINE COUNT
         BAL,SRTN S35CNVRT          CONVERT TO EBCDIC
         STW,AC2  NLINES            STORE LINE COUNT
         LI,X1    BA(NLINES)        GET ADDR OF LINE COUNT
         LI,AC1   4                 SIZE OF LINE COUNT
         LI,X2    BA(STDPRBUF)+#LDISP  ADDR FOR LINE COUNT
         STB,AC1  X2                STORE COUNT FOR MBS
         MBS,X1   0                 MOVE LINE COUNT TO BUFFER
         LI,AC1   #CR               GET CR CHAR
         STB,AC1  0,X2              STORE IN BUFFER
*
*
         PAGE
*
*
         JEZ,AC1  WS:IDSZ,SETENTSZ  TEST FOR DOC ID
         LI,X1    :ADEO(WS:DOCID)   GET ADDR OF DOC ID
         SLS,X1   2                 CONVERT TO BYTE ADDR
         LI,X2    BA(STDINBUF)+2    ADDR FOR DOCUMENT ID
         STB,AC1  X2                STORE COUNT FOR MBS
         MBS,X1   1                 MOVE ID TO BUFFER
         LI,AC2   #CR               GET CR CHAR
         STB,AC2  0,X2              STORE IN BUFFER
         AI,AC1   3                 SET NEW DOC ID SIZE
         STW,AC1  DOCIDSZ
         MTB,1    STDINBUF          INCR SKIP COUNT
*
SETENTSZ EQU      %
         MTW,0    NUMDOCS           TEST FOR FIRST ENTRY
         BGZ      PRNTENTR             NO, PRINT ENTRY
         LB,AC1   REPHDG            GET SIZE OF HEADING LINE
         STW,AC1  SVMSGSZ           SAVE HEADING SIZE
         LI,AC2   X'0100'           SET CONTROL BYTES
         STH,AC2  REPHDG
         LI,BUF2  BA(REPHDG)        GET ADDR OF HEADING
         AI,AC1   1                 CALC SIZE
         BAL,SRTN S37OUTLN          PRINT HEADING LINE
         LW,AC1   SVMSGSZ           RESTORE MESSAGE SIZE
         STB,AC1  REPHDG
*
*
         PAGE
*
*
         LB,AC1   DOCIDHDG          GET SIZE OF 2ND HEADING
         STW,AC1  SVMSGSZ           SAVE SIZE
         LI,AC2   X'0200'           SET CONTROL BYTES
         STH,AC2  DOCIDHDG
         LI,BUF2  BA(DOCIDHDG)      GET ADDR OF 2ND HEADING
         AI,AC1   1                 ADD CONTROL BYTES TO SIZE
         BAL,SRTN S37OUTLN          PRINT LINE
         LW,AC1   SVMSGSZ           RESTORE MSG SIZE
         STB,AC1  DOCIDHDG
*
PRNTENTR EQU      %
         MTW,1    NUMDOCS           INCR DOCUMENT COUNT
         LI,BUF2  BA(STDPRBUF)      GET ADDR OF BUFFER
         LI,AC1   #LDISP+5          GET SIZE
         BAL,SRTN S37OUTLN          PRINT ENTRY
*
         LI,BUF2  BA(STDINBUF)      GET DOC ID BUFFER
         LW,AC1   DOCIDSZ           GET DOC ID BUFFER SIZE
         BAL,SRTN S37OUTLN          PRINT DOC ID LINE
*
*
         PAGE
*
*
NEXTCLS  EQU      %
         LI,AC1   #SAVE             CLOSE FILE WITH SAVE
         BAL,SRTN S27CCPY
         B        NEXTFILE          GET NEXT FILE IN ACCT
*
ENDREP   EQU      %
         LW,AC1   NUMDOCS           GET NUMBER OF DOCUMENTS
         BAL,SRTN S35CNVRT          CONVERT TO EBCDIC
         CW,AC2   L(#BLANKS)        TEST FOR ALL BLANKS
         BNE      STDOCS               NO, STORE COUNT
         LW,AC2   L('   0')            YES, SET ZERO
*
STDOCS   EQU      %                 STORE NUMBER OF DOCUMENTS
         STW,AC2  NUMDOCS           SAVE COUNT
         MOVE,X1  BA(NUMDOCS),INSNDOCS,4   MOVE TO MSG
         LB,AC1   SUMMSG            GET MESSAGE SIZE
         STW,AC1  SVMSGSZ           SAVE MESSAGE SIZE
         LI,AC2   X'0200'           SET CONTROL BYTES
         STH,AC2  SUMMSG
         LI,BUF2  BA(SUMMSG)        GET ADDR OF MSG
         AI,AC1   1                 ADD TWO FOR CONTROL BYTES
         BAL,SRTN S37OUTLN          PRINT SUMMARY MESSAGE
         LW,AC1   SVMSGSZ           RESTORE MESSAGE SIZE
         STB,AC1  SUMMSG
         JNEZ,D1  PR:LPFLG,RESWS    IF XREPORT, PRINT ON TERMINAL TOO
         MTW,0    FILEFLG           FILE OUTPUT MODE
         BEZ      RESWS3            NO
RESWS    RES      0
         BAL,SRTN S04XFILE          EXIT FILE OUTPUT MODE
         LB,AC1   SUMMSG            GET SIZE OF SUMMARY MSG
         LI,BUF1  BA(SUMMSG)+2      GET ADDR OF SUMMARY MESSAGE
         BAL,SRTN S27PRINT          PRINT SUMMARY MESSAGE ON TERMINAL
RESWS3   RES      0
*
         BAL,SRTN S37LP             TRY TO FORCE LP OUTPUT
         BAL,SRTN S03RESWS          RESTORE WS FILES
         B        ZRORTNST          RESET RETURN STACK
*
ACCTERR  RES      0
         LI,AC1   32                SET UP 'ILLEGAL OPTION ERROR' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         LI,AC1   6                 SET UP 'ACTION CANCELLED' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         B        RESWS3
*
*
#OPDISP  EQU      35                DISP. FOR OP ID
#DATDISP EQU      49                DISP. FOR DATE
#LDISP   EQU      61                DISP FOR LINE COUNT
*
*
         PAGE
*
* S13XO -- MESSAGE TO OPERATOR
*
*
C13XO    EQU      %
         SAVRTN
*
         GET,AC1  #NCCS,:K(2)       GET SIZE OF MESSAGE
         GET,X1   #CS,:K(2)         GET ADDR OF MSG
         LI,X2    BA(STDPRBUF)+1    DEST ADDR
         CI,AC1   136               TEST FOR MAX SIZE
         BLE      MVOPMSG              <MAX, MOVE MSG
         LI,AC1   136                  >MAX, SET MAX
*
MVOPMSG  EQU      %
         STB,AC1  X2                COUNT FOR MBS
         MBS,X1   0                 MOVE MESSAGE
         STB,AC1  STDPRBUF          STORE MESSAGE SIZE
         LI,BUF1  WA(STDPRBUF)      GET ADDR OF BUFFER
         BAL,SRTN S36M:MSG          GO SEND MESSAGE
         RETURN
*
*
         PAGE
*
* C13XT -- COPY TO/FROM MAG TAPE
*
*
C13XT    EQU      %
         SAVRTN
*
         BRKCTRL  MTRDFIN           SET BREAK CONTROL
         JNEZ,D1  (#FLAGS,:K(3)),WRMT  TEST 'S' FLAG
         LI,AC1   #IN               'G' TYPE, TEST FOR FILE
         BAL,SRTN S27OCPY           OPEN FILE
         CI,SR3   3                 3= DOES NOT EXIST
         BE       OUTFLEOK             FILE OK
         LI,AC1   8                 'DUPLICATE NAME' MSG
         B        MTRDERR           GO PRINT ERROR MSG
*
OUTFLEOK EQU      %
         LI,AC1   #OUT              NOW OPEN FILE IN OUT MODE
         BAL,SRTN S27OCPY
         LI,AC1   #IN               OPEN TAPE IN INPUT MODE
         BAL,SRTN S27MTOPN
         CI,SR3   0                 TEST FOR ERROR
         BG       MTWRERR           ILLEGAL MAG TAPE ACTION
         BL       MTRDERR           ILLEGAL OPTION (SN)
*
*
         PAGE
*
*
*
INTAPELP EQU      %
         LI,BUF2  BA(STDINBUF)      GET ADDR OF BUFFER
         LI,AC1   #STDBUFSZ         MAX SIZE
         BAL,SRTN S27RDMT           READ MAG TAPE RECORD
         CI,SR3   0                 TEST FOR EOF
         BNE      MTRDFIN              YES, COPY DONE
         LI,BUF3  BA(STDINBUF)      GET ADDR OF WRITE BUFFER
         BAL,SRTN S27WCPY           WRITE TO FILE
         B        INTAPELP          GET NEXT RECORD
*
*
         PAGE
*
*
MTRDFIN  EQU      %
         BRKCTRL  0                 RESET BREAK CONTROL
         LI,AC1   #SAVE             CLOSE FILE WITH SAVE
         BAL,SRTN S27CCPY
         BAL,SRTN S36MTCLS
*
RTNXT    EQU      %
         RETURN
*
MTRDERR  EQU      %
         BAL,SRTN S29STD            PRINT ERROR MESSAGE
         LI,AC1   6                 'ACTION CANCELLED' MSG
         BAL,SRTN S29STD            PRINT MESSAGE
         B        MTRDFIN
*
*
         PAGE
*
*
WRMT     EQU      %
         LI,AC1   #IN               OPEN COPY FILE
         BAL,SRTN S27OCPY
         CI,SR3   0                 TEST FOR ERROR
         BE       INFLEOK              FILE OK
         LI,AC1   19                'DOES NOT EXIST '
         CI,SR3   3                 TEST ERROR CODE
         BE       PRNTERR              DOES NOT EXIST, PRINT
         LI,AC1   20                'ACCESS DENIED' ERROR
*
PRNTERR  EQU      %
         BAL,SRTN S29STD            PRINT MESSAGE
         LI,AC1   6                 'ACTION CANCELLED
         BAL,SRTN S29STD            PRINT MESSAGE
         B        RTNXT             RETURN
*
INFLEOK  EQU      %
         JEZ,D1   (#FLAGS,:K(1)),WRMTFLE  TEST 'A' FLAG
         BAL,SRTN S27MTLST          POSITION TAPE AFTER LAST FILE
         CI,SR3   0                 TEST FOR SN ERROR
         BL       MTRDERR              YES, PRINT MESSAGE
         CI,SR3   2                 TEST FOR LAST
         BNE      MTWRERR              NO,ERROR
*
*
         PAGE
*
*
WRMTFLE  EQU      %
         LI,AC1   #OUT              OPEN MT FILE OUT
         BAL,SRTN S27MTOPN
         CI,SR3   0                 TEST FOR ERROR
         BNE      MTWRERR              YES, ERROR MSG
*
WRMTLP   EQU      %
         LI,BUF2  BA(STDINBUF)      GET ADDR OF BUFFER
         LI,AC1   #STDBUFSZ         MAX SIZE
         LI,AC2   0                 SET KEY FOR READ NEXT
         BAL,SRTN S27RCPY           READ FILE
         CI,AC2   0                 TEST FOR EOF
         BE       MTRDFIN              YES, DONE
         LI,BUF3  BA(STDINBUF)      GET WRITE BUFFER
         BAL,SRTN S27WRMT           WRITE TO TAPE
         B        WRMTLP            GET NEXT RECORD
*
MTWRERR  EQU      %
         LI,AC1   38                'ILLEGAL MT MSG'
         B        MTRDERR           PRINT ERROR AND RETURN
*
*
         PAGE
*
*
* C13DSMNT -- DISMOUNT MAG TAPE
*
C13DSMNT RES      0
         SAVRTN
         RETURN
*
*
         PAGE
*
* LOCALS FOR REPORT ROUTINE
*
*
13D      CSECT    0
*
SVMSGSZ  RES      1                 SAVE MESSAGE SIZE
NLINES   RES      1                 NUMBER OF LINES IN DOCUMENT
NUMDOCS  RES      1                 NUMBER OF DOCUMENTS
SAVSIZE  RES      1                 SIZE OF ENTRY
DOCIDSZ  RES      1                 DOCUMENT ID SIZE
*
*
BLANKS   TEXT     '        '
*
*
RTITLE   MESSAGE  ' STORAGE REPORT FOR ACCOUNT: ',(INSACCT,8)
REPHDG   MESSAGE  ' DOCUMENT NAME                    ',;
                  'OPERATOR ID   ',;
                  'DATE        ','LINES'
DOCIDHDG MESSAGE  ' DOCUMENT ID'
SUMMSG   MESSAGE  ' NUMBER OF DOCUMENTS:',(INSNDOCS,4)
*
*
         USECT    #PLOC
         END
