* 02/24/76 -- 10:00
* MODULE NAME: PSCTRL
* NUMBER: 4
* PURPOSE: MAINTAIN ALL PERMANENT FILES
*
* ENTRY POINTS:
*
         DEF      C04GET            "GET" COMMAND
         DEF      C04STORE          "STORE" COMMAND
         DEF      C04D              "DELETE" COMMAND
         DEF      C04FILE           FILE OUTPUT COMMAND
         DEF      S04XFILE          EXIT FILE OUTPUT MODE
         DEF      S04FCHK           CHECK FOR FILE OUTPUT MODE
         DEF      FILEFLG           FILE FLAG
*
         REF      S27OCPY,S27CCPY   OPEN,CLOSE COPY FILE
         REF      S27RCPY,S27WCPY   READ,WRITE COPY FILE
         REF      S27RTXT,S27RHDR   READ TEXT,HEADER FILES
         REF      S29STD            PRINT ERROR MESSAGES
         REF      S01SCAN,S01TXTLN  SCAN,WRITE TEXT LINES
         REF      S35CNVRT,S35LINE  CONVERT TO EBCDIC
         REF      S03QM,S03LFMT     PRINT DOCUMENT STATUS
         REF      S03WMREC          WRITE MASTER RECORD
         REF      S05NLMSG,S05RDYCR NEEXT-LINE MESSAGE, Y-CR RESPONSE
         REF      S05TABBR,S05BLQM  TEST FOR TABS, ADD QM ON MSGS
         REF      S27PFILE,S27TXTFL  POSITION FILE
         REF      F:CPY             COPY FILE DCB
         REF      S36M:TIME         GET TIME FOR STORE
         REF      S27PRINT          PRINT LINE
         REF      S28CMPR,S28DCMPR  COMPRESS/DECOMPRESS TEXT
         REF      ZRORTNST          INITIALIZE RETURN STACK
         REF      S05RANGE          GET RANGE OF LINES
         REF      S27OPEN           OPEN A FILE
         REF      S27CLOSE          CLOSE A FILE
         REF      S02BCHK           BATCH MODE CHECK
         REF      S27UCTAB          SET M:UC TABS
         REF      M:LO              M:LO DCB
         REF      BATCHFLG          BATCH MODE FLG
         REF      FILEKEY           FILE OUTPUT KEY
         REF      INCTBL,SZINCTBL   INCREMENT TABLE FOR RENUMBER
*
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
           INVCMDSTA
           INVWSSTA
           INVDCBTBL
*
         PAGE
*
*
*
         DEF      4P,4D
*
4P       EQU      %                 START OF PROCEDURE
         DATA     X'04'             MODULE NUMBER
         DATA     X'022476'         DATE
         DATA     X'1000'           TIME
*
*
         TITLE    '** PSCTRL(4) **'
*
* 'GET' COMMAND
* ENTRY PARAMS:
*        #FLG1 SET FOR 'X' OPTION
*        #DOCNM,#ACCT,#GETPW SET IN CMDSTA IF PRESENT IN COMMAND
*
C04GET   EQU      %
         SAVRTN
*
         BAL,SRTN S04FCHK           CHECK FOR FILE MODE
*
         GET,D1   #LKEYVAL          GET BIAS FOR NEW DOCUMENT KEYS
         LW,AC2   D1                GET IN ODD REGISTER
         DW,AC2   L(#KEYINCR)       DIVIDE BY KEY INCREMENT
         MI,AC2   #KEYINCR          MULTIPLY BY INCR
         STW,AC2  KEYBIAS
         GET,D1   #FLAGS,:K(1)      GET 'X' OPTION FLAG
         STW,D1   XFLG              SAVE
*
         BAL,SRTN S04CHKFL          CHECK GET FILE
         CI,SR3   0                 TEST FOR ERROR
         BNE      GDERR                YES, PRINT ERROR MESSAGE
         GET,D1   *DCB:ORG          GET ORG OF GET FILE
         CI,D1    #KEYED            IS FILE KEYED
         BE       GETMAX            YES, OK
         LI,AC1   78                SET UP 'GET MUST BE KEYED' MSG
         B        GDERR             GO PRINT ERROR MESSAGE
GETMAX   RES      0
*
         LI,AC1   #EOFPFILE         GET EOF WORD FOR PFILE
         LI,AC3   F:CPY             POSITON COPY FIILE
         BAL,SRTN S27PFILE          POSITION COPY FILE TO EOF
         LI,AC1   0                 SET READ SIZE ZERO
         LI,AC2   -1                SET KEY FOR READ PREVIOUS
         BAL,SRTN S27RCPY           GET LAST KEY IN FILE
*
*
         PAGE
*
*
         AW,AC2   KEYBIAS           ADD KEY BIAS
         CW,AC2   L(#MAXKEY)        TEST FOR MAX KEY
         BG       KEYERR               GREATER, KEY ERROR
         LI,AC1   #BOFPFILE         POSITION AT START
         LI,AC3   F:CPY
         BAL,SRTN S27PFILE
         B        RLNSMSG           NOW PRINT NUMBER OF LINES MESSAGE
*
KEYERR   EQU      %
         LI,AC1   25                'DOCUMENT TOO LARGE' MESSAGE
         B        GDERR             GO PRINT MESSAGE
*
*
         PAGE
*
*
RLNSMSG  EQU      %
         GET,AC1  #NCDOCNM          GET SIZE OF DOCUMENT NAME
         GET,D1   #DOCNM            GET ADDR OF NAME
         MOVE,X1  *D1,INSNAME,*AC1  MOVE DOC NAME TO MESSAGE
*
         LI,AC2   #CR               GET RETURN CHAR
         STB,AC2  0,X2              STORE AT END OF LINE
         LW,AC1   X2                GET ADDR OF LAST CHAR
         AI,AC1   -BA(GETMSG)       CALC. SIZE
         STB,AC1  GETMSG            STORE SIZE IN BYTE 0
*
*
         PAGE
*
*
RDCPYFLE EQU      %
         LI,AC1   0
         STW,AC1  NLINES            INITIALIZE TEXT LINE COUNT
         PUT,AC1  #PRNTFLG          SET PRINT FLAG TO SUPPRESS OUTPUT
         LW,AC2   L(#ZROKEY)        POSITION FILE AFTER KEY 0.0
         BAL,SRTN S27RCPY
         BRKCTRL  0                 INITIALIZE BREAK FLAG
*
RDNXTREC EQU      %
         LI,BUF2  BA(STDINBUF)      GET INPUT BUFFER ADDR
         LI,AC1   #STDBUFSZ         GET BUFFER SIZE
         LI,AC2   0                 SET FOR READ NEXT
         AW,BUF2  XFLG              SAVE ROOM FOR ATTN IF 'X'
         SW,AC1   XFLG
*
RCPYREC  EQU      %
         BAL,SRTN S27RCPY           GO READ INPUT RECORD
         CI,AC1   0                 TEST FOR ZERO SIZE
         BG       LNSZOK               NO, SIZE OK
         CI,SR3   3                 TEST FOR EOF RETURN
         BE       CPYEOF               YES, EOF FOUND
         CI,SR3   0                 TEST FOR ERROR RETURN
         BNE      RDNXTREC             YES, READ NEXT RECORD
*
LNSZOK   EQU      %
         AW,AC2   KEYBIAS
         PUT,AC2  #NXTKEY           SET NEW EDIT KEY
*
         LI,AC2   1                 INITIALIZE ATTN COUNT
         MTW,0    XFLG              TEST 'X' FLAG
         BNEZ     TSTCRSZ              SET, TEST CR SIZE
         AI,BUF2  1                    RESET, INCR POINTER
         AI,AC1   -1                DECR SIZE
         BAL,SRTN S28DCMPR          DE-COMPRESS LINE
         LB,AC2   STDINBUF          GET ATTN COUNT
*
*
         PAGE
*
*
TSTCRSZ  EQU      %                 TEST FOR CR AND MAX SIZE
         CI,AC1   #MXLNSZ           TEST MAX SIZE
         BLE      STCR                 OK, STORE CR
         LI,AC1   #MXLNSZ              TOO LARGE, SET MAX SIZE
*
STCR     EQU      %
         CI,AC1   0                 TEST FOR NULL RECORD
         BG       TSTLCHAR             NO, GO TEST LAST CHAR
         LI,AC1   1                    YES, SET SIZE TO ONE
         LW,X1    BUF2              GET POINTER FOR CR STORE
         B        ADDCR             GO ADD CR TO LINE
*
TSTLCHAR EQU      %
         LW,X1    BUF2              GET ADDR OF LINE
         AW,X1    AC1               RDD SIZE FOR ADDR OF END
         AI,X1    -1                SET TO LAST CHAR
         LB,AC3   0,X1              GET LAST CHAR IN LINE
         CI,AC3   #CR               TEST FOR CR
         BE       SCANLN               YES, SCAN LINE
         CI,AC3   #LF               TEST FOR LF
         BE       ADDCR                YES, CHANGE TO CR
         AI,X1    1                 NOT CR OR LF, INCR POINTER
         AI,AC1   1                 INCR LINE SIZE
*
ADDCR    EQU      %
         LI,AC3   #CR               GET CR CHAR
         STB,AC3  0,X1              STORE AT END OF LINE
*
*
         PAGE
*
SCANLN   EQU      %
         BAL,SRTN S01SCAN           GO SCAN LINE
         CI,AC1   0                 TEST FOR ZERO SIZE
         BLEZ     RDNXTREC              YES, GO READ NEXT INPUT RECORD
*
         LW,BUF3  BUF2              GET ADDR OF LINE
         AI,BUF3  -1                INCLUDE ATTN COUNT
         STB,AC2  0,BUF3            STORE ATTN COUNT
         AI,AC1   1                 INCREMENT SIZE
         GET,D1   #NXTKEY           GET VALUE OF NEXT STORE KEY
         PUT,D1   #LKEY             SAVE IN LAST KEY
         PUT,D1   #CLP              SET CLP
         LW,AC2   D1
         BAL,SRTN S01TXTLN          NOW GO WRITE TEXT FILE LINE
         MTW,1    NLINES            INCREMENT NUMBER OF TEXT LINES
*
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BEZ      RDNXTREC             ZERO, READ NEXT RECORD
         LI,D1    1                    SET, TURN-ON PRINT FLAG
         PUT,D1   #PRNTFLG
         LI,AC1   39                'GET INTERRUPTED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         BRKCTRL  0                 RESET BREAK CONTROL
*
*
         PAGE
*
*
CPYEOF   EQU      %                 EOF ON INPUT FILE
         DO       #SYS=TEXT
         LI,D1    1
         PUT,D1   #PRNTFLG          SET PRINT FLAG TO ALLOW PRINTOUT
         ELSE
         DEPZ,D1  #PRNTFLG          RESET PRINT FLAG
         FIN
         LI,BUF1  BA(GETMSG)+1      GET ADDR OF NAME MESSAGE
         LB,AC1   GETMSG            SIZE
         BAL,SRTN S27PRINT          PRINT MESSAGE
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     CLSGTFLE             SET, CLOSE FILE
*
         LW,AC1   NLINES            GET LINE COUNT
         BAL,SRTN S35CNVRT          CONVERT TO EBCDIC
         STW,AC2  NLINES            SAVE EBCDIC LINE COUNT
         MOVE,X1  BA(NLINES),INSLNS,4  MOVE TO MSG
*
         LI,AC1   INSLNS+4          GET ADDR OF MSG END
         LW,AC2   KEYBIAS           GET KEY BIAS
         BEZ      CALCLNSZ             ZERO, GET MSG SIZE
         BAL,SRTN S35LINE           CONVERT TO EBCDIC
         LCI      2                 SAVE LINE NUMBER
         STM,AC1  KEYBIAS
         MOVE,X1  BA(KEYBIAS),INSAFTER,8  MOVE TO MSG
         LI,AC1   INSAFTER+8        GET ADDR OF MSG END
*
*
         PAGE
*
*
CALCLNSZ EQU      %
         AI,AC1   -BA(LINESMSG)     CLAC MSG SIZE
         LI,BUF1  BA(LINESMSG)+1    ADDR OF MSG
         BAL,SRTN S27PRINT          PRINT MESSAGE
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BNEZ     CLSGTFLE             SET, CLOSE FILE
*
         MTW,0    XFLG              TEST 'X' FLAG
         BNEZ     CLSGTFLE             SET, CLOSE FILE
         JNEZ,D1  WS:MGET,CLSGTFLE  IF MEMO-GET, DON'T PRINT STATUS
         LI,BUF2  BA(STDX2BUF)      RE-READ HEADER RECORD
         LI,AC1   SZWSSTA*4
         LW,AC2   L(#ZROKEY)
         BAL,SRTN S27RCPY
         BAL,SRTN S04XCWS           SAVE WS STATUS
         BAL,SRTN S03QM             PRINT DOCUMENT STATUS
         BAL,SRTN S04XCWS           RESTORE WS STATUS
*
CLSGTFLE EQU      %                 CLOSE FILE WITH SAVE
         LI,AC1   #SAVE
         BAL,SRTN S27CCPY
*
PNXTNUM  EQU      %
         BAL,SRTN S03LFMT           PRINT LAST EFFECTIVE FORMAT
         BAL,SRTN S05NLMSG          PRINT NEXT LINE NUMBER
*
         MTW,0    XFLG              EDIT COMPATIBLE DOCUMENT
         BNEZ     GETRTN            YES
         MTW,0    BATCHFLG          BATCH MODE
         BGZ      RESTATUS          YES
         LWC,D1   #WIDTH            GET WS WIDTH WORD
         CW,D1    STDX2BUF+:EO(#WIDTH)  COMPARE TO DOC WIDTH
         BNE      RESQU             NOT EQUAL
         LI,X1    BA(STDX2BUF+:EO(WS:NTABS))  GET BA OF DOC TABS
         LI,X2    BA(:ADEO(WS:NTABS))  GET BA OF WS TABS
         GET,D1   WS:NTABS          GET NUMBER OF TABS IN WS
         AI,D1    1                 ADD 1 FOR COUNT BYTE
         STB,D1   X2                SET UP COUNT FOR COMPARE
         CBS,X1   0                 COMPARE WS TABS TO DOC TABS
         BE       GETRTN            SAME, DO NOT RESTORE DOC FORMAT
RESQU    RES      0
         LI,AC1   74                SET UP 'RESTORE WIDTH...' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         BAL,SRTN S05RDYCR          READ Y-CR RESPONSE
         CI,SR3   0                 CHECK RESPONSE
         BNE      RESTATUS          RESPONSE = YES
         LI,AC1   77                SET UP 'WS FORMAT RETAINED' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         B        GETRTN
RESTATUS RES      0
         LW,D1    STDX2BUF+:EO(#WIDTH)  GET DOCUMENT WIDTH
         STWC,D1  #WIDTH            PUT IN WS
         LI,X1    BA(STDX2BUF+:EO(WS:NTABS))  GET DOC TABS BA
         LI,X2    BA(:ADEO(WS:NTABS))  GET BA OF WS TABS
         LI,D1    WS:SZTABS*4       GET SIZE IN BYTES OF TABS
         STB,D1   X2
         MBS,X1   0                 MOVE DOC TABS TO WS
         MTW,0 BATCHFLG             BATCH MODE
         BGZ      GETRTN            YES
         BAL,SRTN S27UCTAB          SET DCB TABS
         BAL,SRTN S03WMREC          WRITE MASTER RECORD
         LI,AC1   75                SET UP 'FORMAT RESTORED' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
*
GETRTN   EQU      %                 RETURN
         JEZ,D1   WS:MEMO,ZRORTNST  IF NOT MEMO-MODE ZERO RETURN STACK
         RETURN                     OTHERWISE RETURN TO CALLING PROGRAM
         B        ZRORTNST          RE-INITIALIZE RETURN STACK
*
*
         PAGE
*
*
S04XCWS  EQU      %
         SAVRTN
*
         LI,AC1   WA(WSSTA)-1       WS STATUS
         LI,AC2   WA(STDX2BUF)-1    SAVE BUFFER
         LI,X1    :EO(#WLPBASE)+1   SIZE FOR SAVE
XCWSLP   EQU      %
         LW,AC3   *AC1,X1           GET XC WORD
         XW,AC3   *AC2,X1           XC WITH BUFFER
         STW,AC3  *AC1,X1           STORE XC WORD
         BDR,X1   XCWSLP            XC ALL
*
         RETURN
*
*
         PAGE
*
* C04D -- DELETE COMMAND
*
*
C04D     EQU      %
         SAVRTN
         BAL,SRTN S02BCHK           IF BATCH MODE EXIT
         BAL,SRTN S04FCHK           CHECK FOR FILE OUTPUT MODE
*
         LI,AC1   0                 SET 'X' FLAG OFF
         STW,AC1  XFLG
         BAL,SRTN S04CHKFL          CHECK DELETE FILE
         CI,SR3   0                 TEST FOR FILE OK
         BNE      GDERR                NO, ERROR
*
         LB,AC1   STDX2BUF+:EO(WS:IDSZ)  GET ID SIZE
         BEZ      PRNTNM            ZERO, PRINT NAME
         LI,D1    BA(STDX2BUF)+:EO(WS:DOCID)*4+1  ADDR OF ID
         B        PRNTDMSG          PRINT MESSAGE
*
PRNTNM   EQU      %
         GET,AC1  #NCDOCNM          GET NAME SIZE
         GET,D1   #DOCNM            GET ADDR OF NAME
*
*
         PAGE
*
PRNTDMSG EQU      %
         MOVE,X1  *D1,BA(STDPRBUF)+SZDELMSG,*AC1  SET NAME
         MOVE,D1  BA(DELMSG),BA(STDPRBUF),SZDELMSG MSG
         AI,AC1   SZDELMSG          CALC. MESSAGE SIZE
         LI,BUF3  BA(STDPRBUF)      ADDR OF MSG
         BAL,SRTN S05TABBR          TEST FOR TABS
         BAL,SRTN S05BLQM           ADD BLANKS AND QM
         LI,BUF1  BA(STDPRBUF)      GET ADDR
         BAL,SRTN S27PRINT          PRINT DOC ID OR NAME
*
         BAL,SRTN S05RDYCR          READ Y-CR RESPONSE
         CI,SR3   0                 TEST FOR YES
         BE       ACTNCNCL             NO, ACTION CANCELLED
         LI,AC1   #REL              SET UP TO RELEASE FILE
         BAL,SRTN S27CCPY           CLOSE WITH RELEASE
         LI,AC1   27                'DOCUMENT DELETED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         B        RESWS             NOW GO RESET WS STATUS
*
DELMSG   TEXT     'DELETE: '
SZDELMSG EQU      8
         PAGE
*
*
GDERR    EQU      %
         BAL,SRTN S29STD            PRINT ERROR MESSAGE
*
ACTNCNCL EQU      %
         LI,AC1   6                 'ACTION CANCELLED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
*
SAVCCLS  EQU      %
         LI,AC1   #SAVE             CLOSE FILE WITH SAVE
         BAL,SRTN S27CCPY
*
RESWS    EQU      %
         B        ZRORTNST          RE-INITIALIZE RETURN STACK
*
*
         PAGE
*
*
* S04CHKFL -- CHECK FOR LEGAL FILE
*
S04CHKFL EQU      %
         SAVRTN
*
         LI,AC1   #IN               OPEN FILE IN INPUT MODE
         BAL,SRTN S27OCPY
         CI,SR3   0                 TEST FOR ERROR
         BNE      ACCERR               YES, ERROR MESSAGE
*
         MTW,0    XFLG              TEST 'X' FLAG
         BNEZ     RTNCHKFL             SET, RETURN
         BAL,SRTN S04DOC            CHECK FOR TEXT PERM DOCUMENT
         CI,SR3   0                 WAS IT A PERM DOCUMENT
         BNE      ADERR             NO, ACCESS-DENIED ERROR
*
*
         GET,D1   *#ARS             GET ACTUAL SIZE OF MASTER RECORD
         CI,D1    SZWSSTA*4         IS IT EQUAL TO CURRENT SIZE
         BNE      CHK10             NO, SKIP MEMO CHECK
         GET,D1   WS:MGET           GET MEMO-GET  FLAG
         LI,X1    3
         CB,D1    STDX2BUF+:EO(WS:MGET),X1  DOES FLAG MATCH MEMO-MODE FLAG
         BNE      ADERR             NO, ACCESS DENIED
CHK10    RES      0
         LI,SR3   0                    YES, FILE OK
         B        RTNCHKFL          RETURN
*
ACCERR   EQU      %
         CI,SR3   3                 TEST FOR NON-EXISTENCE
         BNE      ADERR                NO, MUST BE ACCESS-DENIED
         LI,AC1   19                'DOES NOT EXIST' MESSAGE
         B        RTNCHKFL          RETURN
*
ADERR    EQU      %
         LI,AC1   20                'ACCESS DENIED' MESSAGE
*
RTNCHKFL EQU      %
         RETURN
*
*
         PAGE
*
*
* S04DOC -- CHECK FOR VALID TEXT PERMANENT DOCUMENT
*
* EXIT PARAMETERS:
*         SR3 = 0 IF VALID DOCUMENT
*         SR3 = 1 IF NOT A VALID DOCUMENT
*
S04DOC   RES      0
         SAVRTN
         LI,SR3   0                 INITIALIZE CODE WORD
         STW,SR3  STDX2BUF+:EO(WS:TXTCODE)
         LI,BUF2  BA(STDX2BUF)      GET ADDR OF BUFFER
         LI,AC1   SZWSSTA*4         GET SIZE OF MASTER RECORD
         LW,AC2   L(#ZROKEY)        READ KEY 0.0 (MASTER REC)
         BAL,SRTN S27RCPY           READ MASTER RECORD INTO WS STATUS
         CI,AC1   0                 TEST NO MASTER RECORD
         BE       DOC500            NO RECORD, ERROR
         LW,D1    STDX2BUF+:EO(WS:TXTCODE)  GET TEXT CODE WORD
         CW,D1    L(#CODEWRD)       TEST FOR VALID CODE
         BE       DOC900            CODE OK
DOC500   RES      0
         LI,SR3   1                 SET ERROR FLAG
DOC900   RES      0
         RETURN
         PAGE
*
* C04STORE -- HANDLE 'STORE' COMMAND
*
* ENTRY PARAMETERS:
*        #FLG1 SET FOR RENUMBER COPY
*        #FLG2 SET FOR 'X'
*        #DOCNM,#DOCID,#GETPW            SET IN CMDSTA TABLE
*
C04STORE EQU      %
         SAVRTN
         BAL,SRTN S02BCHK           IF BATCH MODE EXIT
         BAL,SRTN S04FCHK           CHECK FOR FILE OUTPUT MODE
*
         LI,AC1   0
         STW,AC1  OLDIDFLG          INIT OLD DOC ID FLAG TO NONE
*
         GET,D1   #FKEY             GET FIRST KEY
         GET,D2   #LKEY             GET LAST KEY
         JEZ,AC1  #RN1,TSTRANGE     GET 1ST KEY IN RANGE
         LW,D1    AC1               REPLACE WS 1ST KEY
         JEZ,AC1  #RN2,TSTRANGE     GET LAST KEY IN RANGE
         LW,D2    AC1               REPLACE WS LAST KEY
TSTRANGE RES      0
         BAL,SRTN S05RANGE          GET RANGE OF LINES
         CI,AC1   0                 CHECK FOR NULL RANGE
         BNE      STRANGE           GO STORE RANGE
         LI,AC1   22                'NOTHING TO STORE' MESSAGE
         BAL,SRTN S29STD            GO PRINT MESSAGE
         B        STERR5
*
STRANGE  RES      0
         STW,AC1  RN1               SAVE FIRST KEY IN RANGE
         STW,AC2  RN2               SAVE LAST KEY IN RANGE
*
GETFLGS  EQU      %
         GET,D1   #FLAGS,:K(2)      GET 'X' OPTION FLAG
         STW,D1   XFLG              SAVE
*
         JEZ,D1   (#FLAGS,:K(1)),STRNFLG     TEST RENUMBER FLAG
         LW,AC2   L(#MAXKEY-#ZROKEY) MAX INC = MAX KEY IN ODD REGISTER
         GET,D1   #NLINES
         DW,AC2   D1                   DIVIDED BY NUM LINES IN WRK STOR
         LI,X1    SZINCTBL          NOW SEARCH INCREMENT TABLE
INCRLP   EQU      %
         CH,AC2   INCTBL,X1         TEST FOR INC TOO LARGE
         BGE      INCRFND              NO, USE THIS INC
         BDR,X1   INCRLP               YES, TEST NEXT INC
INCRFND  EQU      %
         LH,D1    INCTBL,X1         GET RENUMBER INCREMENT
STRNFLG  EQU      %
         STW,D1   RENFLG            STORE RENUMBER FLAG
*
*
         PAGE
*
*
         JNEZ,D1  WS:MEMO,NAMEOK    IF MEMO-MODE, DON'T CHECK EXISTENCE
         LI,AC1   #IN               OPEN STORE FILE IN INPUT MODE
         BAL,SRTN S27OCPY               TO CHECK FOR EXISTENCE
         CI,SR3   3                 TEST ERROR FLAG FOR NO FILE
         BE       NAMEOK                SET, FILE NAME OK
         CI,SR3   0                 ANY OTHER ERRORS
         BE       STDUP             NO
         LI,AC1   20                YES, SET FOR 'ACCESS DENIED' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         B        STERR5
STDUP    RES      0
         LI,AC1   66                'DUPLICATE NAME' MESSAGE
*
STERRMSG EQU      %
         BAL,SRTN S29STD            GO PRINT MESSAGE
         BAL,SRTN S05RDYCR          GET RESPONSE
         CI,SR3   0                 CHECK RESPONSE
         BNE      STROVER           RESPONSE = 'YES'
STERR5   RES      0
         LI,AC1   6                 'ACTION CANCELLED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         B        CLSSTFLE          NOW CLOSE FILE AND RETURN
*
STROVER  RES      0
         BAL,SRTN S04DOC            CHECK FOR VALID TEXT DOC
         CI,SR3   0                 IS IT VALID
         BNE      STROVER5          NO
         PUT,SR3  WS:IDSZ           INIT DOC ID SIZE TO 0
         LB,D1    STDX2BUF+:EO(WS:IDSZ)  GET OLD DOC ID SIZE
         BEZ      STROVER5          BRANCH IF NO OLD ID
         LI,X1    BA(STDX2BUF+:EO(WS:IDSZ))  GET BA OF DOC ID
         LI,X2    BA(:ADEO(WS:DOCID))  GET BA OF WS DOC ID
         AI,D1    1                 INCR SIZE FOR ID SIZE
         STB,D1   X2                STORE COUNT FOR MBS
         MBS,X1   0                 MOVE DOC ID TO WS STATUS
         MTW,1    OLDIDFLG          SET OLD DOC ID FLAG
STROVER5 RES      0
         LI,AC1   #SAVE             SET FOR CLOSE WITH SAVE
         BAL,SRTN S27CCPY           CLOSE FILE
NAMEOK   EQU      %                 DOCUMENT DOES NOT EXIST -- NAME OK
         LI,AC1   #OUT              OPEN FILE IN OUTPUT MODE
         BAL,SRTN S27OCPY
         MTW,0    XFLG              TEST 'X' FLAG
         BNEZ     SETSTBR           SET, GO COPY FILE
         BAL,SRTN S03WMREC          SAVE MASTER RECORD
         LW,D1    L(#CODEWRD)       GET TEXT CODE WORD
         PUT,D1   WS:TXTCODE        STORE IN WS STATUS
*
*
         PAGE
*
*
         JEZ,D1   #NCDOCID,OLDIDQ   TEST FOR DOC ID IN COMMAND
         GET,X1   #DOCID                YES, GET ADDR
         LI,X2    :ADEO(WS:DOCID)   GET WORD ADDR OF WS DOC ID
         SLS,X2   2                 CONVERT TO BYTE ADDR
         AI,X2    1                 DISP IN WORD
         STB,D1   X2                STORE COUNT FOR MBS
         MBS,X1   0                 MOVE DOC ID TO WS STATUS
         PUT,D1   WS:IDSZ           STORE DOC ID SIZE
         B        WRMREC            GO WRITE MASTER RECORD
*
OLDIDQ   RES      0
         MTW,0    OLDIDFLG          WAS THERE AN OLD DOC ID
         BEZ      WRMREC            NO
         LI,AC1   68                'RETAIN OLD ID' MSG
         BAL,SRTN S29STD            GO WRITE MESSAGE
         BAL,SRTN S05RDYCR          GET RESPONSE
         CI,SR3   0                 CHECK RESPONSE
         BNE      WRMREC            RESPONSE = 'YES'
         LI,D1    0
         PUT,D1   WS:IDSZ           SET DOC ID SIZE TO 0
*
WRMREC   RES      0
         LI,AC3   :ADEO(WS:TIME)    GET ADDR FOR DATE, TIME
         BAL,SRTN S36M:TIME         GET DATE AND TIME
         LI,BUF3  BA(WSSTA)         ADDR OF WS STATUS
         LI,AC1   SZWSSTA*4         SIZE OF WS STATUS
         LW,AC2   L(#ZROKEY)        KEY FOR MASTER RECORD
         BAL,SRTN S27WCPY           WRITE MASTER RECORD
*
*
         PAGE
*
*
SETSTBR  RES      0
         BRKCTRL  0                 INITIALIZE BREAK FLAG
RDSTFLE  EQU      %                 READ TEXT FILE
         LI,AC1   0
         STW,AC1  NLINES            INITIALIZE NUMBER OF LINES
         LW,AC1   L(#ZROKEY)
         STW,AC1  LSTKEY            INITIALIZE LAST WRITE KEY
         LW,AC2   RN1               GET FIRST KEY IN RANGE
*
RDNXTTXT EQU      %
         LI,BUF2  BA(STDINBUF)      GET ADDR OF INPUT BUFFER
         LI,AC1   #STDBUFSZ         GET SIZE
         BAL,SRTN S27RTXT           READ TEXT LINE
         CI,AC1   0                 TEST FOR EOF
         BLE      TXTEOF                YES
         CW,AC2   RN2               CHECK FOR LAST KEY IN RANGE
         BG       TXTEOF            YES, END OF RANGE
*
         AI,BUF2  1                 INCR PAST ATTN COUNT
         LW,BUF3  BUF2              SET WRITE BUFFER
         AI,AC1   -1                DECR SIZE FOR ATTN
         STW,AC2  TXTKEY            SAVE TEXT LINE KEY
         MTW,0    XFLG              TEST 'X' FLAG
         BNEZ     TSTRFLG              SET, GO TEST 'R' FLAG
*
         BAL,SRTN S28CMPR           COMPRESS TEXT LINE
         AI,BUF3  -1                INCLUDE ATTN COUNT IN BUFFER
         AI,AC1   1
         LB,AC2   STDINBUF          GET ATTN COUNT FROM OLD BUFFER
         STB,AC2  0,BUF3
*
*
         PAGE
*
*
TSTRFLG  EQU      %                 TEST RENUMBER FLAG
         LW,D1    RENFLG            TEST FLAG
         BEZ      WRCPYLN               RESET, GO WRITE LINE
         AW,D1    LSTKEY                SET, ADD BIAS TO LAST KEY
         STW,D1   TXTKEY            SAVE IN TEXT KEY
*
WRCPYLN  EQU      %                 WRITE LINE
         LW,AC2   TXTKEY            GET KEY FOR WRITE
         BAL,SRTN S27WCPY           WRITE OUTPUT LINE
         MTW,1    NLINES            INCREMENT LINE COUNT
         STW,AC2  LSTKEY            SAVE LAST WRITE KEY
         LI,AC2   0                 SET KEY FOR READ NEXT
         MTW,0    BRKFLAG           TEST BREAK FLAG
         BEZ      RDNXTTXT          NOT SET, READ NEXT RECORD
         B        STOREBRK          SET, HANDLE BREAK CONDITION
*
TXTEOF   EQU      %                 EOF FOUND IN TEXT FILE
         MTW,0    XFLG              TEST 'X' OPTION FLAG
         BNEZ     DOCSTMSG              SET, GO CLOSE FILE
         LI,AC3   :ADEO(WS:TIME)    GET ADDR TO STORE TIME
         BAL,SRTN S36M:TIME         GET TIME/DATE IN WS STRTXS
         LW,D1    NLINES            STORE LINE COUNT
         PUT,D1   #NLINES
*
         LI,BUF3  BA(WSSTA)         GET ADDR OF WS TABLE
         LI,AC1   SZWSSTA*4         GET SIZE
         LW,AC2   L(#ZROKEY)        KEY = 0.0 (MASTER RECORD)
         BAL,SRTN S27WCPY           WRITE MASTER RECORD
*
*
         PAGE
*
*
DOCSTMSG EQU      %
         BRKCTRL  0                 RESET BREAK CONTROL
         LI,AC1   7                 'DOCUMENT STORED' MESSAGE
         BAL,SRTN S29STD            GO PRINT MESSAGE
*
CLSSTFLE EQU      %
         LI,AC1   #SAVE             CLOSE FILE WITH SAVE
         BAL,SRTN S27CCPY
         RETURN                     RETURN
*
STOREBRK EQU      %                 BREAK RECEIVED DURING STORE
         BRKCTRL  0                 RESET BREAK ADDR
         LI,AC1   40                'STORE INTERRUPTED' MESSAGE
         BAL,SRTN S29STD            PRINT MESSAGE
         LW,AC1   NLINES            GET NUMBR OF LINES STORED
         BAL,SRTN S35CNVRT          CONVERT TO EBCDIC
         STW,AC2  NSTRMSG+6         STORE IN MESSAGE
         LI,BUF1  BA(NSTRMSG)+1     GET BA OF STORE MESSAGE
         LB,AC1   NSTRMSG           GET SIZE OF MESSAGE
         BAL,SRTN S27PRINT          GO PRINT MESSAGE
         BAL,SRTN S05RDYCR          GET RESPONSE
         CI,SR3   0                 CHECK RESPONSE
         BE       TXTEOF            RESPONSE = NO, STOP STORE
         LI,AC2   0                 SET TO READ NEXT RECORD
         B        RDNXTTXT          CONTINUE STORE OPERATION
         PAGE
*
*
* C04FILE -- FILE OUTPUT COMMAND
*
C04FILE  RES      0
         SAVRTN
         BAL,SRTN S02BCHK           IF BATCH OUTPUT MODE EXIT
         BAL,SRTN S04FCHK           CHECK FOR FILE MODE
*
         JNEZ,D1  #NCGETPW,FILE30   BRANCH IF PASSWORD SPECIFIED
         JEZ,D1   #NCDOCID,FILE30   BRANCH IF NO DOC ID
*
* MAKE ID INTO PASSWORD
         CI,D1    8                 IS SIZE GREATER THAN 8
         BG       FILE450           YES, ERROR
         PUT,D1   #NCGETPW          SET UP SIZE OF PASSWORD
         GET,D1   #DOCID            GET ADDR OF ID
         PUT,D1   #GETPW            SET UP ADDR OF PASSWORD
FILE30   RES      0
         LI,AC1   #IN               CHECK FOR EXISTENCE
         LI,AC3   M:LO              SET DCB = M:LO
         BAL,SRTN S27OPEN           OPEN DCB
         CI,SR3   3                 TEST FOR NO FILE
         BE       FILE50            NO FILE, OK
         LI,AC1   #SAVE             SET TO CLOSE WITH SAVE
         LI,AC3   M:LO              SET DCB = M:LO
         BAL,SRTN S27CLOSE          CLOSE M:LO
         LI,AC1   66                SET FOR 'DUPLICATE NAME' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         BAL,SRTN S05RDYCR          READ 'Y-CR' RESPONSE
         CI,SR3   0                 CHECK RESPONSE
         BE       FILE500           CANCEL COMMAND
FILE50   RES      0
         LI,AC1   #OUT              SET TO OPEN 'OUT'
         LI,AC3   M:LO              SET DCB = M:LO
         BAL,SRTN S27OPEN           OPEN M:LO 'OUT'
         LW,AC1   L(#ZROKEY)        GET KEY 0.0
         STW,AC1  FILEKEY           SAVE IN FILE OUTPUT KEY
         MTW,1    FILEFLG           SET FILE FLAG
         B        FILE900
FILE450  RES      0
         LI,AC1   32                SET UP 'OPTION ERROR' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         B        FILE900
FILE500  RES      0
         LI,AC1   6                 SET FOR 'ACTION CANCELLED' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
FILE900  RES      0
         RETURN
         PAGE
*
*
* S04XFILE -- EXIT FILE OUTPUT MODE
*
S04XFILE RES      0
         LI,AC1   #SAVE             SET FOR CLOSE WITH SAVE
S04XFIL1 RES      0
         SAVRTN
         MTW,0    FILEFLG           FILE OUTPUT MODE
         BEZ      XFILE900          NO
         LI,AC3   M:LO              DCB = M:LO
         BAL,SRTN S27CLOSE          CLOSE OUTPUT FILE
         LI,AC1   0
         STW,AC1  FILEFLG           RESET FILE OUTPUT FLAG
XFILE900 RES      0
         RETURN
*
*
* S04FCHK -- CHECK FOR FILE MODE
*
S04FCHK  RES      0
         SAVRTN
         MTW,0    FILEFLG           CHECK FOR FILE MODE
         BEZ      FCHK900           NO, EXIT
         LCI      2                 SAVE REG AC1,AC2
         STM,AC1  RN1
         LI,AC1   #REL              SET TO RELEASE FILE
         BAL,SRTN S04XFIL1          EXIT FILE MODE
         LI,AC1   72                SET FOR 'FILE COMMAND CANCELLED' MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
         LCI      2
         LM,AC1   RN1               RESTORE REGS AC1,AC2
FCHK900  RES      0
         RETURN
         PAGE
*
*
* LOCAL VARIABLES FOR PSCTRL
*
4D       CSECT    0                 START OF LOCALS
*
TXTBUF   RES      1                 TEXT RECORD BUFFER
TXTSZ    RES      1                     RECORD SIZE
TXTKEY   RES      1                     KEY
*
RENFLG   RES      1                 RENUMBER FLAG
XFLG     RES      1                 HEADER FILE FLAG ('X' OPTION)
*
KEYBIAS  RES      1                 BIAS FOR KEYS IN 'GET' COMMAND
NLINES   RES      1                 NUMBER OF LINES FOR 'GET'
FSTKEY   RES      1                 FIRST KEY IN DOCUMENT
LSTKEY   RES      1                 LAST KEY OF DOCUMENT
SAVFKEY  RES      1                 SAVE FIRST KEY
SAVLKEY  RES      1                 SAVE LAST KEY
*
FILEFLG  DATA     0                 FILE FLAG (OFF)
OLDIDFLG RES      1                 OLD DOC ID FLAG
RN1      RES      1                 FIRST KEY IN RANGE
RN2      RES      1                 LAST KEY IN RANGE
*
*
GETMSG   MESSAGE  #CR,'DOCUMENT: ',(INSNAME,31)
LINESMSG MESSAGE      'LINES:',(INSLNS,4),#CR,;
                      'ADDED AFTER LINE:',(INSAFTER,8)
NSTRMSG  MESSAGE,NOCR  'NUMBER OF LINES STORED:    ',#CR,;
                       'CONTINUE STORE? '
*
         USECT    #PLOC
         END
