C..  INVENTORY.FTN   BOHDEN K. CMAYLO   MARCH 1982
C.. THIS PROGRAM IS THE MAIN ROUTINE FOR A DATA BASE OF PROGRAM WRITEUPS
C..
C..      PROGRAM INVENTORY
C..
C..
C..      ENTER = 0 ... ENTER WRITEUP
C..      ENTER = 1 ... PRINT WRITEUP
C..      ENTER = 2 ... UPDATE WRITEUP
C..
      COMMON /XDBX/ IN,IOUT,INBOD,IOFILE
      COMMON /CATALL/ MAXCAT,CATIN(6),CAT(6,250),ABSTR(20,100)
     1 ,INPUT(132),BODYUP(20),HOLD(33)
	DATA IN,IOUT,INBOD,IOUTPR/1,2,3,4/
      DATA MAXCAT/250/
C..
C..      INITIAL MSG FOR PROGRAM
C..
	CALL PRSKIP(0,2,'PROGRAM INVENTORY',17)
      IF(XQTOPT('B').GT.0)
     1 CALL PRSKIP(0,2,'@XQT,B = BACKUP THE INFORMATION ON TAPE',38)
      IF(XQTOPT('E').GT.0)
     1 CALL PRSKIP(0,2,'@XQT,E = ENTER USER WRITEUP',27)
      IF(XQTOPT('U').GT.0)
     1 CALL PRSKIP(0,2,'@XQT,U = UPDATE USER WRITEUP',28)
      IOFILE=0
      IF(XQTOPT('P').LE.0) GO TO 77
      IOFILE=IOUTPR
      CALL PRSKIP(0,2,'@XQT,P = ENTER USER PRINT FILE NAME',35)
	I=IREADP('* PRINT FILE NAME=',INPUT)
	IF(I.LE.0) GO TO 99
	INPUT(I+1)=0
	OPEN(UNIT=IOFILE,NAME=INPUT,TYPE='NEW',CARRIAGECONTROL='LIST')
      I=IREADP('* MSG FOR DELIVERY =',INPUT)
      IF(I.LT.0) GO TO 99
      CALL PRSKIP(IOFILE,1,INPUT,I)
77    CONTINUE
C..
C..       SEE IF BACKUP OPTION IS ON
C..
      IF(XQTOPT('B').LE.0) GO TO 44
      CALL XSPAWN('@SX:[5,10]INVENTORY.BUP!')
      GO TO 99
C..
C..      CHECK IF ENTERING WRITEUP OR ASKING FOR ONE
C..
44	IERR=0
	IENTER=0
      IF(XQTOPT('E').GT.0) CALL ENTWU(IERR,IENTER)
	IF(IERR.GT.0) GO TO 99
	IERR=0
	IENTER=2
      IF(XQTOPT('U').GT.0) CALL ENTWU(IERR,IENTER)
	IF(IERR.GT.0) GO TO 99
	IERR=0
	IENTER=1
      CALL ENTWU(IERR,IENTER)
	IF(IERR.GT.0) GO TO 99
C..
C..      ERROR MSGS
C..
102   CALL PRSKIP(0,2,'*** ERROR *** END OF FILE NOT EXPECTED',38)
C..
C..      FINISHED
C..
99    IF(IOFILE.GT.0) CLOSE(UNIT=IOFILE)
      CALL EXIT
      END
C..  ENTWU.FTN   BOHDEN K. CMAYLO    MARCH 1982
C..  SUBROUTINE OF INVENTORY.FTN
      SUBROUTINE ENTWU(IERR,IENTER)
C..
C..      IENTER = 0 ... IENTER WRITEUP
C..      IENTER = 1 ... PRINT WRITEUP
C..      IENTER = 2 ... UPDATE WRITEUP
C..      IENTER = 3 ... DELETE WRITEUP
C..
C..      THIS ROUTINE IENTERS THE WRITEUP FOR THE SYSTEM
C..
C..IERR=+ = ERROR OR NO WANT WRITEUP RETURN
C..
      COMMON /XDBX/ IN,IOUT,INBOD,IOFILE
      COMMON /CATALL/ MAXCAT,CATIN(6),CAT(6,250),ABSTR(20,100)
     1 ,INPUT(132),BODYUP(20),HOLD(33)
	BYTE ICATIN(24),INPUT,IRB,IRA,IRZ,IR0,IR9
	DIMENSION DOCOK(6),PNM(20),XINPUT(33)
	INTEGER ALL
	EQUIVALENCE (ICATIN,CATIN),(XINPUT,INPUT)
	DATA DELE,DOCOK/'DELE','DOCU','MENT','ATIO','N AV','AILI','ABLE'/
	DATA ALLA,OLDA,ANEW,YESA,ANO/'ALL ','OLD ','NEW ','YES ','NO  '/
      DATA BLANK,IRB,IRA,IRZ,IR0,IR9/'    ',' ','A','Z','0','9'/
C..
C..      INPUT ALL CATAGORIES
C..
77        CONTINUE
      CALL DOREAL(HOLD,HOLD(33),BLANK)
	OPEN(UNIT=IN,NAME='WP:[101,20]CATALOG.ALL',TYPE='OLD',READONLY)
C..
C..      FORMAT OF CATALOG.ALL IS:
C..
C..1 = NEXT WRITEUP NUMBER
C..2-END = 28 CHARS OF INFO FOR CATALOG (12 MAIN, 12 SUB 4 INDEX)
      READ(IN,555,END=3)XINPUT(1)
555	FORMAT(33A4)
      INPCAT=0
2     INPCAT=INPCAT+1
      READ(IN,555,END=4)(CAT(I,INPCAT),I=1,7)
      IF(INPCAT.LE.MAXCAT) GO TO 2
C..
C..      ERROR...MORE THAN MAXCAT ENTRIES
C..
      CALL PRSKIP(0,2,'*** ERROR *** MAXIMUM NUMBER OF ENTRIES IN CATALO
     1G REACHED ... CALL PROGRAMMER',77)
      IERR=1
	RETURN
C..
C..      ERROR... NO DATA IN CATALOG ALL
C..
3     CALL PRSKIP(0,2,'*** ERROR *** BAD CATALOG ALL ... CALL PROGRAMMER
     1',49)
	CLOSE(UNIT=IN)
      IERR=1
	RETURN
C..
C..      READ IN ALL OF CATALOG, ASK WHAT CATAGORY WANTED
C..
4     INPCAT=INPCAT-1
	CLOSE(UNIT=IN)
44    CALL PRSKIP(0,4,'CATAGORY    SUBCATAGORY ',24)
      CALL PRSKIP(0,1,'........................',24)
      DO 4444 I=1,INPCAT
      CALL PRSKIP(0,1,CAT(1,I),24)
4444  CONTINUE
444   I=IREADP('2* WHAT CATAGORY WANTED (ALL IF ALL) ?',INPUT)
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF(I.EQ.0) GO TO 444
      CATIN(1)=XINPUT(1)
      IF(XINPUT(1).EQ.ALLA ) XINPUT(1)=BLANK
      CATIN(2)=XINPUT(2)
      CATIN(3)=XINPUT(3)
      IF(CATIN(1).NE.ALLA)
     1 I=IREADP('2* WHAT SUBCATAGORY WANTED (BLANK IF NONE) ?',INPUT)
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
C..
C..      CHECK FOR ALL OPTION
C..     ALL = 0 = NO ALL OPTION ... SET TO CATAGORY LATER
C..     ALL = -10000 = ALL OPTION, SET TO -MAX LATER
C..
      ALL=0
      IF(CATIN(1).EQ.ALLA) ALL=-INPCAT
      IF(I.EQ.0) ALL=-10000
      CATIN(4)=XINPUT(1)
      CATIN(5)=XINPUT(2)
      CATIN(6)=XINPUT(3)
C..
C..      FIND CATAGORY
C..
      CATYPE=OLDA
      IF(CATIN(1).EQ.ALLA) GO TO 6
      DO 5 I=1,INPCAT
      IF(CATIN(1).NE.CAT(1,I)) GO TO 5
      IF(CATIN(2).NE.CAT(2,I)) GO TO 5
      IF(CATIN(3).NE.CAT(3,I)) GO TO 5
      IF(ALL.LT.0) ALL=-I
      IF(CATIN(4).NE.CAT(4,I)) GO TO 5
      IF(CATIN(5).NE.CAT(5,I)) GO TO 5
      IF(CATIN(6).NE.CAT(6,I)) GO TO 5
C..
C..      CATAGORY FOUND, BUILD ELEMENT AND ADD IN CATAGORY CONTENTS LATER
C..
      IF(ALL.EQ.0) ALL=I
      IF(ALL.GT.0.OR.IENTER.EQ.0.OR.IENTER.EQ.2) GO TO 6
5     CONTINUE
C..
C..      CHECK IF ENTRY MODE ONLY
C..
      IF(IENTER.EQ.0) GO TO 7
C..
C..      SEE IF ALL OPTION IS ON AND MODE IS PRINT WRITEUP
C..
      IF(ALL.LE.-1.AND.ALL.NE.-10000.AND.IENTER.EQ.1) GO TO 6
      CALL PRSKIP(0,2,'* ERROR * CATAGORY NOT FOUND * RETRY *',38)
      GO TO 44
C..
C..      ELEMENT NOT FOUND, ASK IF WANT A NEW CATAGORY/SUBCATAGORY
C..
C..
C..      CHECK IF NAME IS OK.
C..
7	CALL BYTEDO(INPUT,INPUT(24),CATIN)
      DO 778 I=1,24
      IF(INPUT(I).EQ.IRB) GO TO 778
      IF(INPUT(I).GE.IRA.AND.INPUT(I).LE.IRZ) GO TO 778
      IF(INPUT(I).GE.IR0.AND.INPUT(I).LE.IR9) GO TO 778
      GO TO 299
778   CONTINUE
      CALL PRSKIP(0,2,'* CATAGORY (OR SUB) NOT FOUND, IS THIS A NEW CATA
     1GORY (OR SUB)',62)
      I=IREADP('1* (YES NO) ?',INPUT)
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF(I.EQ.0.OR.(INPUT(1).NE.'Y'.AND.INPUT(1).NE.'N')) GO TO 7
      CATYPE=ANEW
      IF(INPUT(1).EQ.'Y') GO TO 11
      INPCAT=INPCAT+1
      GO TO 4
C..
C..      CHECK IF ENTER OR UPDATE WANTED
C..
6     NUMBWU=0
	JERR=0
      IF(IENTER.EQ.2) CALL ENTUP(JERR,NUMBWU,PNM)
	IF(IENTER.EQ.2.AND.JERR.GT.0) GO TO 99
      IF(IENTER.EQ.1) CALL PRTWU(JERR,KERR,ALL)
	IF(IENTER.EQ.1.AND.JERR.GT.0) GO TO 99
	IF(IENTER.EQ.1.AND.KERR.GT.0) GO TO 44
	IF(IENTER.EQ.2.AND.PNM(19).EQ.DELE.AND.PNM(20).EQ.DELE) IENTER=3
	IF(IENTER.EQ.3) CALL REALDO(ABSTR(1,1),ABSTR(10,1),PNM)
C..
C..      ENTER MODE ... ENTER STUFF FOR WRITEUP
C..
11    I=4
	IF(IENTER.NE.2) GO TO 71
C..
C..	GET FILE NAME FOR REENTER AND REENTER STUFF
C..
	I=IREADP('2* ENTER FILE NAME FOR REENTER=',INPUT)
	CALL REALDO(HOLD,HOLD(20),XINPUT)
	IF(I.LE.0) GO TO 73
	INPUT(I+1)=0
	OPEN(UNIT=IN,NAME=INPUT,TYPE='OLD',READONLY,ERR=100)
	KABSTR=0
72	KABSTR=KABSTR+1
	READ(IN,555,END=73)(ABSTR(J,KABSTR),J=1,20)
	IF(ABSTR(1,KABSTR).NE.'@EOF') GO TO 72
	CALL DOREAL(ABSTR(11,1),ABSTR(20,1),BLANK)
      CALL DATE(ABSTR(12,1))
	KABSTR=KABSTR-1
	INBODY=IN
	GO TO 88
73	IERR=1
	TYPE 74
74	FORMAT('0*** ERROR IN REENTER *** TRY AGAIN ***')
	RETURN
71	IF(IENTER.EQ.3) GO TO 65
      IF(IENTER.EQ.0) I=IREADP('2* ENTER PROGRAM NAME = ',ABSTR(1,1))
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF(I.EQ.0) GO TO 11
C..ENTER DATE, PASSWORD ... ACCOUNT NUMBER OF IENTERER
	CALL DOREAL(ABSTR(11,1),ABSTR(20,1),BLANK)
      CALL DATE(ABSTR(12,1))
12    CALL PRSKIP(0,2,' * ENTER ONE LINER DESCRIBING PROGRAM (TO 80 CHAR
     1S)',51)
      I=IREADP(' * /',ABSTR(1,2))
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF(I.EQ.0) GO TO 12
 111  I=IREADP('2* ENTER SYSTEM NAME = ',ABSTR(1,3))
      IF (I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF (I.EQ.0) GO TO 111
 200  I=IREADP('2* ENTER ENVIRONMENT = ',ABSTR(1,4))
      IF (I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF (I.EQ.0) GO TO 200
 300  I=IREADP('2* ENTER PROGRAMMER NAME = ',ABSTR(1,5))
      IF (I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF (I.EQ.0) GO TO 300
13    I=IREADP('2* ENTER CONTACT NAME = ',ABSTR(1,6))
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF(I.EQ.0) GO TO 13
14    I=IREADP('2* ENTER CONTACT TELEPHONE NUMBER = ',ABSTR(1,7))
      IF(I.LT.0) IERR=1
	IF(I.LT.0) RETURN
      IF(I.EQ.0) GO TO 14
      KABSTR=7
      CALL PRSKIP(0,2,' * ENTER A SHORT ABSTRACT FOR THE PROGRAM.',42)
      CALL PRSKIP(0,1,' * WHEN FINISHED, ENTER A BLANK LINE. ',36)
15    KABSTR=KABSTR+1
      I=IREADP(' * /',ABSTR(1,KABSTR))
      IF(I.LE.0) GO TO 8
      GO TO 15
C..
C..      END OF ABSTRACT ... ENTER BODY IF WANTED
C..
8     KABSTR=KABSTR-1
      CALL PRSKIP(0,1,' * PROGRAM DOCUMENTATION, DO ONE OF:',36)
      CALL PRSKIP(0,1,' * 1) ENTER ''NO'' IF NO DOCUMENTATION,',37)
      CALL PRSKIP(0,1,' * 2) ENTER ''YES'' IF DOCUMENTATION IS TO BE ENT
     1ERED DIRECTLY,',63)
      CALL PRSKIP(0,1,' * 3) ENTER THE FILE OR ELEMENT NAME WHERE DOCUME
     1NTATION IS STORED.',66)
      I=IREADP('** ENTER ?',BODYUP)
      IF(I.LT.0) BODYUP(1)=ANO
	I4=(I+3)/4
      IF(BODYUP(1).EQ.4H'NO') BODYUP(1)=ANO
      IF(BODYUP(1).EQ.4H'YES) BODYUP(1)=YESA
      XBODY=BODYUP(1)
      INBODY=0
      IF(XBODY.EQ.ANO.OR.XBODY.EQ.YESA) GO TO 20
C..
C..      ENTER DATA FROM USER DEVICE
C..
	INBODY=INBOD
C..	END OF STRING FOR FILE NAME
	BODYUP(I4+1)=0
	OPEN(UNIT=INBODY,NAME=BODYUP,TYPE='OLD',READONLY,ERR=101)
C..
C..      ENTER EXCLUSIVE ASSIGN AND TRANSFER DATA OVER TO  DATA BASE
C..
20	CONTINUE
C..
C..     JUMP OVER CATALOG SECTION IF UPDATE
C..
      IF(IENTER.EQ.2) GO TO 65
C..
C..      READ IN CATALOG ALL FOR CURRENT WRITEUP NUMBER
C..
	OPEN(UNIT=IN,NAME='WP:[101,20]CATALOG.ALL',TYPE='OLD',READONLY)
      READ(IN,24)NUMBWU
24    FORMAT(7X,I6)
      NUMBWU=NUMBWU+1
C..
C..     CREATE ELEMENT FOR NEW DATA IN CATALOG ALL
C..
	OPEN(UNIT=IOUT,NAME='WP:[101,20]CATALOG.ALL',TYPE='NEW'
     1,CARRIAGECONTROL='LIST')
      WRITE(IOUT,24)NUMBWU
C..      READ AND WRITE OUT REST OF STUFF, PLACING IN NEW CATAGORY IF NEEDED
C..
	IWRITE=0
28	READ(IN,420,END=29)ISIZE,(INPUT(I),I=1,24)
C..
C..	CHECK IF LESS THAN,EQUAL, OR GREATER NAME
C.
	IF(ICATIN(1).GT.INPUT(1)) GO TO 229
	DO 445 I=1,24
	IF(ICATIN(I)-INPUT(I)) 228,445,229
445	CONTINUE
C..
C..	NAME FOUND, DO NOT WRITE OUT
C..
	IWRITE=IWRITE+1
229	WRITE(IOUT,420)ISIZE,(INPUT(I),I=1,ISIZE)
      GO TO 28
228	CONTINUE
	IF(IWRITE.GE.1) GO TO 229
C..
C..      ENTER NEW CAT TITLE
C..
	WRITE(IOUT,555)(CATIN(I),I=1,6)
	IWRITE=IWRITE+1
	GO TO 229
C..
C..      END OF CATALOG ALL
C..
29	IF(IWRITE.LE.0) WRITE(IOUT,555)(CATIN(I),I=1,6)
      CLOSE(UNIT=IN)
	CLOSE(UNIT=IOUT)
C..
C..      ENTER ABSTRACT AND/OR BODY
C..
88	IENC=21
	ENCODE(IENC,888,INPUT)NUMBWU,'ABS'
888	FORMAT('WP:[101,20]',I6,'.',A3)
	DO 666 I=11,16
	IF(INPUT(I).EQ.' ') INPUT(I)=IR0
666	CONTINUE
	INPUT(IENC+1)=0
	OPEN(UNIT=IOUT,NAME=INPUT,TYPE='NEW',CARRIAGECONTROL='LIST')
      DO 51 I=1,KABSTR
	DO 667 JJ=1,20
	IF(ABSTR(21-JJ,I).EQ.BLANK) GO TO 667
	KK=21-JJ
	WRITE(IOUT,555)(ABSTR(J,I),J=1,KK)
	GO TO 51
667	CONTINUE
51    CONTINUE
      IF(XBODY.NE.ANO)
     1 WRITE(IOUT,555)DOCOK
	CLOSE(UNIT=IOUT)
C..
C..      ENTER BODY IF WANTED
C..
	IENC=21
	ENCODE(IENC,888,INPUT)NUMBWU,'DOC'
      IF(XBODY.EQ.ANO) GO TO 62
	IF(INPUT(11).EQ.' ') INPUT(11)=IR0
	IF(INPUT(12).EQ.' ') INPUT(12)=IR0
	IF(INPUT(13).EQ.' ') INPUT(13)=IR0
	IF(INPUT(14).EQ.' ') INPUT(14)=IR0
	IF(INPUT(15).EQ.' ') INPUT(15)=IR0
	IF(INPUT(16).EQ.' ') INPUT(16)=IR0
	INPUT(IENC+1)=0
	OPEN(UNIT=IOUT,NAME=INPUT,CARRIAGECONTROL='LIST',TYPE='NEW')
C..
C..      READ IN ELEMENT OR FILE
C..
      IF(XBODY.NE.YESA.AND.INBODY.EQ.0.AND.IENTER.NE.2) 
     1 OPEN(UNIT=INBODY,NAME=BODYUP,TYPE='OLD',READONLY,ERR=100)
61    IF(INBODY.GT.0) READ(INBODY,420,END=62)ISIZE,(INPUT(I),I=1,ISIZE)
	IF(XINPUT(1).EQ.'@EOF') GO TO 62
      IF(INBODY.EQ.0) ISIZE=IREADP('DOCUMENTATION=',INPUT)
      IF(INBODY.EQ.0.AND.ISIZE.LT.0) GO TO 62
	WRITE(IOUT,420)ISIZE,(INPUT(I),I=1,ISIZE)
      GO TO 61
C..
C..      END OF BODY INPUT, FINISH UP
C..
62	WRITE(IOUT,620)
620	FORMAT(/'*** END OF DOCUMENTATION ***')
	CLOSE(UNIT=IOUT)
	IF(INBODY.GT.0) CLOSE(UNIT=INBODY)
C..
C..      TRANSFER CONTENTS OF CATAGORY, IF EXISTS
C..
65	IENC=24
	ENCODE(IENC,225,INPUT)CATIN(1),CATIN(2),CATIN(3),CATIN(4)
225	FORMAT('WP:[101,20]',2A4,A1,'.',A3)
	INPUT(IENC+1)=0
	CALL RIDBLK(INPUT,IENC)
	IF(CATYPE.EQ.OLDA)
     1 OPEN(UNIT=IN,NAME=INPUT,TYPE='OLD',READONLY,ERR=100) 
	OPEN(UNIT=IOUT,NAME=INPUT,TYPE='NEW',CARRIAGECONTROL='LIST'
     1,ERR=100)
      IF(CATYPE.NE.OLDA) GO TO 43
C..
C..      TRANSFER
C..
      ENCODE(4,81,VAL)NUMBWU
81    FORMAT(I4)
42    READ(IN,420,END=43)ISIZE,(INPUT(I),I=1,ISIZE)
420	FORMAT(Q,132A1)
      IF(IENTER.NE.2.AND.IENTER.NE.3)GO TO 80
      IF(VAL.NE.XINPUT(9))GO TO 80
	READ(IN,420,END=43)ISIZE,INPUT(1)
      GO TO 42
80	WRITE(IOUT,420)ISIZE,(INPUT(I),I=1,ISIZE)
      GO TO 42
C..
C..      WRITE OUT PROGRAM NAME AND ONE LINER
C..
43	ENCODE(4,81,ABSTR(9,1))NUMBWU
	IF(IENTER.NE.3) WRITE(IOUT,555)(ABSTR(I,1),I=1,16)
	IF(IENTER.NE.3) WRITE(IOUT,555)(ABSTR(I,2),I=1,20)
	IF(CATYPE.EQ.OLDA) CLOSE(UNIT=IN)
	CLOSE(UNIT=IOUT)
C..
C..	SEE IF "E" OR "U" OPTION
C..
60    IF(IENTER.EQ.0)CALL PRSKIP(0,2,'* PROGRAM ENTERED.............NUMB
     1ER..............DATE',54)
      IF(IENTER.EQ.2)CALL PRSKIP(0,2,'* PROGRAM UPDATED.............NUMB
     1ER..............DATE',54)
      IF(IENTER.EQ.3)CALL PRSKIP(0,2,'* PROGRAM DELETED.............NUMB
     1ER..............DATE',54)
      CALL PRSKIP(0,2,ABSTR(1,1),54)
      I=IREADP('2* DO YOU WISH TO CHECK YOUR ENTRIES FOR THIS PROGRAM
     1(YES NO) ?',INPUT)
      IF(I.LE.0.OR.INPUT(1).EQ.'N'.OR.INPUT(1).EQ.'n') IERR=1
	IF(IERR.EQ.1) RETURN
          IENTER=1
      IF(INPUT(1).EQ.'Y'.OR.INPUT(1).EQ.'n') RETURN
      GO TO 60
C..
C..     ERROR MESSAGES
100	TYPE 101,(HOLD(I),I=1,20)
101	FORMAT(//'0*** ERROR ***',
     1 ' * COULD BE CAUSED BY THE FOLLOWING STATEMENT:'/
     2 3X,20A4)
99	IERR=1
	RETURN
199	TYPE 198
198   FORMAT('0*** ERROR *** DATA BASE ERROR, CONTACT PROGRAMMER '/
     1 ' *** DATA IS AS FOLLOWS :'/1X,20A4)
      GO TO 99
299   TYPE 298,CATIN
298   FORMAT('0 *** ERROR *** CONTENT NAMES MUST BE 1-12 ALPHA NUMERIC V
     1ALID CHARACTERS.'/'  INVALID NAMES ARE  ''',3A4,'''',
     2 5X,'''',3A4,''''//'  TRY AGAIN')
      INPCAT=INPCAT+1
      GO TO 4
      END
C..  ENTUP.FTN   BOHDEN K. CMAYLO  MARCH 1982
C..  SUBROUTINE OF INVENTORY
      SUBROUTINE ENTUP(IERR,NUMBWU,PNAME)
C..
C..      THIS ROUTINE EITHER GIVES DOCUMENTS OR CHECKS SECURITY ON UPDATING
C..
	BYTE INPUT
	COMMON /XDBX/ IN,IOUT,INBOD,IOFILE
      COMMON /CATALL/ MAXCAT,CATIN(6),CAT(6,250),ABSTR(20,100)
     1 ,INPUT(132),BODYUP(20),HOLD(33)
      DIMENSION PNAME(20),XINPUT(33)
	EQUIVALENCE(INPUT,XINPUT)
	DATA REEN,OBTA,DELE,DOCU/'REEN','OBTA','DELE','DOCU'/
C..
C..      GET PROGRAM NUMBER
C..
20    I=IREADP('* ENTER PROGRAM NUMBER =',INPUT)
	IERR=1
      IF(I.LT.0) RETURN 
      IF(I.EQ.0) GO TO 20
      DECODE(I,21,INPUT,ERR=20) NUMBWU
21    FORMAT(I6)
1     I=IREADP('* REENTER OR OBTAIN OR DELETE DOCUMENTATION ?',INPUT)
      IF(I.LT.0) RETURN
	IPASS=0
	IDELET=0
	IF(XINPUT(1).EQ.DELE) IDELET=1
      IF(XINPUT(1).EQ.REEN.OR.XINPUT(1).EQ.DELE) GO TO 243
	IPASS=1
      IF(XINPUT(1).NE.OBTA) GO TO 1
C..
C..      OBTAIN DOC
C..
	I=IREADP('* FILE NAME TO HOLD DOCUMENTATION=',INPUT)
	IF(I.LE.0) GO TO 100
	INPUT(I+1)=0
	OPEN(UNIT=IOUT,NAME=INPUT,TYPE='NEW',CARRIAGECONTROL='LIST'
     1 ,ERR=100)
C..
C..      GET DOCUMENTATION AND TRANSFER
C..
	GO TO 243
240	IPASS=IPASS+1
	WRITE(IOUT,244)
244	FORMAT('@EOF')
	CLOSE(UNIT=IN)
C..  NO DOCUMENTATION CHECK
	IF(IPASS.GT.2) GO TO 25
	IF(XINPUT(1).NE.DOCU) GO TO 25
243	IENC=21
	ENCODE(IENC,241,INPUT)NUMBWU,'ABS'
	IF(IPASS.EQ.2) ENCODE(IENC,241,INPUT)NUMBWU,'DOC'
241	FORMAT('WP:[101,20]',I6,'.',A3)
	DO 242 I=11,16
	IF(INPUT(I).EQ.' ') INPUT(I)='0'
242	CONTINUE
	INPUT(IENC+1)=0
	OPEN(UNIT=IN,NAME=INPUT,TYPE='OLD',READONLY,ERR=100)
	IF(IPASS.EQ.0) GO TO 10
24	READ(IN,555,END=240)I,(INPUT(J),J=1,I)
	WRITE(IOUT,555)I,(INPUT(J),J=1,I)
555	FORMAT(Q,132A1)
      GO TO 24
C..
C..      EOF
C..
25	CLOSE(UNIT=IOUT)
      CALL PRSKIP(0,5,'TRANSFER COMPLETE ... EDIT DATA AND REENTER',43)
      RETURN
C..
C..      CHECK SECURITY CODE FOR REENTER
C..
10	READ(IN,555)IQ,(INPUT(I),I=1,IQ)
	CALL REALDO(HOLD,HOLD(20),XINPUT)
C..
C..	CLOSE FILE
C..
	CLOSE(UNIT=IN)
C..
C..      CHECK PROGRAM NAME C.. AND ACCOUNT NUMBER
C..
15	IF(IDELET.EQ.0)
     1I=IREADP('2* ENTER PROGRAM NAME TO BE REENTERED=',PNAME)
	IF(IDELET.EQ.1)
     1I=IREADP('2* ENTER PROGRAM NAME TO BE DELETED=',PNAME)
      IF(I.LE.0) RETURN
      IF(PNAME(1).NE.HOLD(1).OR.PNAME(2).NE.HOLD(2)) GO TO 200
C..
C..      OK, CONTINUE
C..
      CALL PRSKIP(0,2,'*** OK TO CHANGE DOCUMENTATION ***',34)
	IERR=0
	IF(IDELET.EQ.1) PNAME(19)=DELE
	IF(IDELET.EQ.1) PNAME(20)=DELE
      RETURN
C..
C..      ERRORS
C..
100   CALL PRSKIP(0,2,'** ERROR ** DOCUMENT NOT FOUND ** ABORT **',42)
      RETURN
200   CALL PRSKIP(0,2,'** ERROR ** INVALID UPDATE USER ** ABORT **',43)
      RETURN
      END
C..  PRTWU.FTN   BOHDEN K. CMAYLO    MARCH 1982
C..  SUBROUTINE OF INVENTORY
      SUBROUTINE PRTWU(JERR,KERR,IALL)
C..
C..      JERR=1 = FINAL RETURN
C..      KERR=1 = ANOTHER CATAGORY
C..
C..      ROUTINE PRINTS WRITEUPS
C..
	BYTE INPUT
      COMMON /CATALL/ MAXCAT,CATIN(6),CAT(6,250),ABSTR(20,100)
     1 ,INPUT(132),BODYUP(20),HOLD(20)
          COMMON /XDBX/ IN,IOUT,INBOD,IOFILE
	DIMENSION XINPUT(33)
	EQUIVALENCE(INPUT,XINPUT)
	DATA ALLA,STOPA,DOCU/'ALL ','STOP','DOCU'/
C..
C..      READ IN TABLE OF CONTENTS
C..
      IF(IALL.GT.0) LOOP1=IALL
      IF(IALL.GT.0) LOOP2=IALL
      IF(IALL.LT.0) LOOP1=1
      IF(IALL.LT.0) LOOP2=-IALL
C..
C..      OBTAIN CATAGORY
C..
      DO 50 LOOPER=LOOP1,LOOP2
      IF(LOOP1.EQ.LOOP2) GO TO 51
      IF(CATIN(1).EQ.ALLA) GO TO 51
      IF(CATIN(1).EQ.CAT(1,LOOPER).AND.CATIN(2).EQ.CAT(2,LOOPER)
     1.AND.CATIN(3).EQ.CAT(3,LOOPER)) GO TO 51
      GO TO 50
51	IENC=24
	ENCODE(IENC,40,INPUT)(CAT(I,LOOPER),I=1,4)
40	FORMAT('WP:[101,20]',2A4,A1,'.',A3)
	INPUT(IENC+1)=0
	CALL RIDBLK(INPUT,IENC)
	OPEN(UNIT=IN,NAME=INPUT,TYPE='OLD',READONLY)
C..
C..      LIST STUFF
C..
44    CALL PRSKIP(0,4,'CATAGORY    SUBCATAGORY ',24)
      CALL PRSKIP(0,1,'........................',24)
      CALL PRSKIP(0,1,CAT(1,LOOPER),24)
      CALL PRSKIP(0,1,'PROGRAM                       NUMBER                
     1 DATE',54)
      CALL PRSKIP(0,1,'.................................................
     1.....',54)
2	READ(IN,333,END=55)ISIZE,(INPUT(I),I=1,ISIZE)
      CALL PRSKIP(0,2,INPUT,54)
      CALL REALDO(XINPUT,XINPUT(3),'ONE LINER:')
	READ(IN,333,END=55)ISIZE,(INPUT(I+12),I=1,ISIZE)
      CALL PRSKIP(0,1,INPUT,ISIZE+12)
      GO TO 2
55	CLOSE(UNIT=IN)
50    CONTINUE
C..
C..      ASK WHAT NUMBER OF WRITEUP
C..
1     I=IREADP('3* WHAT PROGRAM DO YOU WANT, ENTER NUMBER (STOP OR @EOF)
     1= ',HOLD)
      IF(I.LE.0.OR.HOLD(1).EQ.'@EOF') GO TO 77
      IF(HOLD(1).EQ.STOPA) GO TO 78
      DECODE(I,3,HOLD,ERR=1) NUMBWU
3     FORMAT(I6)
	IENC=21
	ENCODE(IENC,4,INPUT)NUMBWU,'ABS'
4	FORMAT('WP:[101,20]',I6,'.',A3)
	DO 666 I=11,16
	IF(INPUT(I).EQ.' ') INPUT(I)='0'
666	CONTINUE
	INPUT(IENC+1)=0
	OPEN(UNIT=IN,NAME=INPUT,TYPE='OLD',READONLY)
C..
C..      WRITE WRITEUP
C..
      CALL BYTEDO(INPUT,INPUT(16),'* PROGRAM NAME: ')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
333	FORMAT(Q,132A1)
      CALL PRSKIP(IOFILE,15,INPUT,42)
      CALL BYTEDO(INPUT,INPUT(16),'* ONE LINER:    ')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE+16)
      CALL BYTEDO(INPUT,INPUT(16),'* SYSTEM NAME:  ')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
	CALL PRSKIP(IOFILE,1,INPUT,ISIZE+16)
      CALL BYTEDO(INPUT,INPUT(16),'* ENVIRONMENT:  ')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE+16)
      CALL BYTEDO(INPUT,INPUT(16),'* PROGRAMMER:   ')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE+16)
      CALL BYTEDO(INPUT,INPUT(16),'* CONTACT NAME: ')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE+16)
      CALL BYTEDO(INPUT,INPUT(16),'* CONTACT PHONE:')
	READ(IN,333,END=77)ISIZE,(INPUT(I+16),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE+16)
      ISKIP=2
      CALL BYTEDO(INPUT,INPUT(12),'* ABSTRACT: ')
10	READ(IN,333,END=15)ISIZE,(INPUT(I+12),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE+12)
      CALL DOBYTE(INPUT,INPUT(12),' ')
      ISKIP=1
      DOCUME=XINPUT(4)
      GO TO 10
C..
C..      CHECK FOR FURTHER DOC
C..
15	CLOSE(UNIT=IN)
      IF(DOCUME.NE.DOCU) GO TO 1
      I=IREADP('* DO YOU WANT PROGRAM DOCUMENTATION (YES NO) ?',INPUT)
      IF(I.LT.0) GO TO 99
      IF(I.EQ.0.OR.INPUT(1).EQ.'N') GO TO 1
      IF(INPUT(1).NE.'Y') GO TO 1
C..
C..	OPEN DOC FILE
C..
	IENC=21
	ENCODE(IENC,4,INPUT)NUMBWU,'DOC'
	IF(INPUT(11).EQ.' ') INPUT(11)='0'
	IF(INPUT(12).EQ.' ') INPUT(12)='0'
	IF(INPUT(13).EQ.' ') INPUT(13)='0'
	IF(INPUT(14).EQ.' ') INPUT(14)='0'
	IF(INPUT(15).EQ.' ') INPUT(15)='0'
	IF(INPUT(16).EQ.' ') INPUT(16)='0'
	INPUT(IENC+1)=0
	OPEN(UNIT=IN,NAME=INPUT,TYPE='OLD',READONLY)
      CALL PRSKIP(IOFILE,3,' ',1)
20	READ(IN,333,END=16)ISIZE,(INPUT(I),I=1,ISIZE)
      CALL PRSKIP(IOFILE,1,INPUT,ISIZE)
      GO TO 20
16	CLOSE(UNIT=IN)
	GO TO 1
C..
C..     ERROR MESSAGES
C..
100	TYPE 101,HOLD
101	FORMAT(//'0*** ERROR ***',
     1 ' * COULD BE CAUSED BY THE FOLLOWING STATEMENT:'/
     2 20A4)
99    GO TO 77
200   PRINT 201,NUMBWU
201   FORMAT('0*** ERROR *** PROGRAM #',I6,' NOT FOUND, TRY AGAIN ***')
      GO TO 1
C..
C..	ERROR RETURNS
C..
77	JERR=1
	RETURN
78	KERR=1
	RETURN
      END