C..   INMAIL.FTN   BOHDEN K. CMAYLO   NOV 81
C..
C..   MAIN MAILER ROUTINE
C..
	SUBROUTINE INMAIL
	INTEGER OUTBXS
	COMMON /INPUTX/ INPUT(512)
	DOUBLE PRECISION TNAME,DBLANK,DXLPT,FTEMP1(2),FTEMP2(2)
	BYTE IZERO,ASTER,IBLANK,INPUT,F1TEMP(16),F2TEMP(16)
	DOUBLE PRECISION ALL,TEMP,NAMES(50),INBOX(8,100),OUTBOX(2,100)
	EQUIVALENCE (F1TEMP,FTEMP1),(F2TEMP,FTEMP2)
	DATA FTEMP1,FTEMP2/'MAIL.DAT',' ','DOC1.DAT',' '/
	DATA ALL,IZERO,ASTER,IBLANK/'ALL     ','0','*',' '/
	DATA DBLANK,MAXGRP,DXLPT /'        ',8,'LP,LP   '/
C.. 
C..      SET NO SUCH FILE COUNT (ERR=#29) TO OK)
C..
       CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,10000)
C..  SET NUMBER OF PRINTED DOCS TO 0
	LP=0
C..
C..  INITIALIZE
C..
	IN=1
	IN2=2
	IN3=3
	NUMPIP=0
	CALL DATE(INPUT(1))
	CALL TIME(INPUT(10))
	TYPE 1,(INPUT(I),I=1,17)
1	FORMAT(10(/)'0*** MAILER ***   DATE:',9A1,'  TIME:',8A1,' ***'/)
C..	DELETE MAIL.DAT AND DOC1.DAT 
C..
	CALL XSPAWN('PIP MAIL.DAT;*/DE/NM,DOC1.DAT;*,FCCC.TMP;*!')
C..ASSIGN FILE TO UNIT 1
	IENC=23
	ENCODE(IENC,11,INPUT)
11	FORMAT('SY:[201,201]DOC005.W11 ')
	TYPE 101
101	FORMAT('0* IN BOX DEFINITIONS ENTERED *'/)
C..DO OVER INBOX AND OUTBOX
	DO 4 J=1,2
	CALL INDOC(IN,INPUT,F1TEMP)
5	KIN=0
6	READ(IN,3,END=7) IQ,(INPUT(I),I=1,IQ)
3	FORMAT(Q,80A1)
	KIN=KIN+1
C.. SET UP INBOX OR OUTBOX UIC
	LST=-1
	CALL INPUTC(INPUT,IQ,IST,LST)
	IF(LST.LT.0) GO TO 91
	CALL INPUTC(INPUT,IQ,IST,LST)
	IF(LST.LT.0) GO TO 91
	TEMP=DBLANK
	ENCODE(LST,9,TEMP)(INPUT(I),I=1,LST)
	IF(J.EQ.1) INBOX(1,KIN)=TEMP
	IF(J.EQ.2) OUTBOX(1,KIN)=TEMP
C.. SET UP INBOX OR OUTBOX FIRST REQUIRED NAME FOR IDENTIFICATION
	CALL INPUTC(INPUT,IQ,IST,LST)
	IF(LST.LT.0) GO TO 90
	TEMP=DBLANK
	IENC=LST-IST+1
	ENCODE(IENC,9,TEMP)(INPUT(I),I=IST,LST)
	IF(J.EQ.1) INBOX(2,KIN)=TEMP
	IF(J.EQ.2) OUTBOX(2,KIN)=TEMP
C.. SET UP INBOX GROUP NAMES
	IF(J.EQ.2) GO TO 6
	IGRP=2
60	IGRP=IGRP+1
	IF(IGRP.GT.MAXGRP) GO TO 6
	CALL INPUTC(INPUT,IQ,IST,LST)
	INBOX(IGRP,KIN)=DBLANK
	IF(LST.LE.0) GO TO 6
	TEMP=DBLANK
	IENC=LST-IST+1
	ENCODE(IENC,9,TEMP) (INPUT(I),I=IST,LST)
	INBOX(IGRP,KIN)=TEMP
9	FORMAT(132A1)
	GO TO 60
90	CALL ERROR(INPUT,IQ,'BAD INBOX/OUTBOX NAME ENTERED.')
	GO TO 6
91	CALL ERROR(INPUT,IQ,'BAD INBOX/OUTBOX UIC ENTERED.')
	GO TO 6
C.. END OF FILE
7	IF(J.EQ.1) INBXS=KIN
	IF(J.EQ.2) OUTBXS=KIN
	CALL CLOSE(IN)
	IF(J.EQ.2) GO TO 4
	IENC=23
	ENCODE(IENC,10,INPUT)
10	FORMAT('SY:[201,201]DOC006.W11 ')
	TYPE 102
102	FORMAT('0* OUT BOX DEFINITIONS ENTERED *'/)
4	CONTINUE
C**	TYPE 63,(JJ,(INBOX(II,JJ),II=1,MAXGRP),JJ=1,INBXS)
63	FORMAT(1X,'INBOX(',I3,')=',8A8)
C**	TYPE 64,(JJ,(OUTBOX(II,JJ),II=1,2),JJ=1,OUTBXS)
64	FORMAT(1X,'OUTBOX(',I3,')=',2A8)
C..
C..	BITMAP READS FOR GETTING NUMBER OF DOCS
C..
	DO 20 JOUT=1,OUTBXS
C**TYPE 105,(OUTBOX(I,JOUT),I=1,2)
105	FORMAT(' * CHECKING OUTBOX ',A7,1X,A8,' FOR MAIL *')
	CALL BITRED(IN,OUTBOX(1,JOUT),NUMDOC,INDOC1)
C.. LESS THAN ONE DOCUMENT, GO TO NEXT OUTBOX
	IF(NUMDOC.LE.2) GO TO 20
	IENC=23
	ENCODE(IENC,62,INPUT)OUTBOX(1,JOUT)
62	FORMAT('WP:[',A7,']DOC001.W11 ')
	CALL RIDBLK(INPUT,IENC)
C..COPY DOC001 TO TEMP FILE F1TEMP AND READ FROM IT
	CALL INDOC(IN2,INPUT,F1TEMP)
	TYPE 103,(OUTBOX(I,JOUT),I=1,2)
103	FORMAT('0* TRANSFER FROM OUTBOX ',A7,1X,A8,' STARTED *')
C.. SET ERROR TO NONE SO FAR
26	READ(IN2,22,END=27)IQ,(INPUT(I),I=1,IQ)
22	FORMAT(Q,132A1)
	TYPE 107,(INPUT(I),I=1,IQ),IBLANK,ASTER
107	FORMAT('0*',80A1)
C.. GET NAMES OF ALL FILES TO BE TRANSFERED
	CALL DOCNAM(OUTBOX(1,JOUT),INPUT,IQ,NUMDOC,NUMNAM,NAMES)
	IF(NUMDOC.LE.1.OR.NUMNAM.LE.0) GO TO 26
C.. INCLUDE SENDING UNIT FOR RECIEPT AT END OF XFER
	NUMNAM=NUMNAM+1
	NAMES(NUMNAM)=OUTBOX(2,JOUT)
C.. DO FOR EACH NAME FOUND (INFRST=0=ISM COPY FIRST)
	INFRST=1
	DO 40 I1=1,NUMNAM
C..	SEE IF CAPS
	CALL CAPS(NAMES(I1),8)
C..	GET RID OF NONALPHA
	CALL RIDCHA(NAMES(I1),-8,'A','Z')
C.. LOCATE INBOX FOR OUTBOX
	JIN=0
	ISTOP=0
48	JJIN=JIN+1
	IF(JJIN.GT.INBXS) GO TO 40
	DO 41 JIN=JJIN,INBXS
C.. SEE IF ALL
C**	IF(NAMES(I1).EQ.ALL) GO TO 42
C.. SEE IF NAME EXISTS
	DO 65 IGRP=2,MAXGRP
	IF(INBOX(IGRP,JIN).EQ.DBLANK) GO TO 41
	IF(INBOX(IGRP,JIN).EQ.NAMES(I1)) GO TO 42
65	CONTINUE
41	CONTINUE
	IF(JJIN.GT.1) GO TO 40
C..	NOT FOUND, SET STOP FLAG, SPOOL TO LP
	ISTOP=1
	TNAME=NAMES(I1)
	INFRST=-1
142	IENC=53
	LP=LP+1
C..	SET TO PRINTER IF FIRST COPY
	ENCODE(IENC,43,INPUT)OUTBOX(1,JOUT),TNAME,LP
     1 ,OUTBOX(1,JOUT),NUMDOC
43	FORMAT('DXL WP:[',A7,']',A8,'.L11;',O4,'=WP:[',A7,']DOC',I3,'!')
	IF(INPUT(50).EQ.IBLANK) INPUT(50)=IZERO
	IF(INPUT(51).EQ.IBLANK) INPUT(51)=IZERO
	CALL XSPAWN(INPUT)
	IF(ISTOP.GT.0) GO TO 40 
C..	GO TO NEXT INBOX IF NOT FIRST COPY
	IF(INFRST.NE.0) GO TO 48
	INFRST=1
C.. CHECK IF NUMBER OF DOCUMENTS ALREADY READ IN FROM BITMAP
C.. READ IN NUMBER OF DOCS IN BITMAP
42	CONTINUE
C..
C..	SEE IF INBOX DEFINED AS LP
C..
	TNAME=INBOX(2,JIN)
	IF(INBOX(1,JIN).EQ.DXLPT.OR.INFRST.EQ.0) GO TO 142
	CALL BITRED(IN,INBOX(1,JIN),NUMIN,INDOC1)
C..  SKIP OVER BITMAP IF EXISTS
	IF(INDOC1.GE.0) GO TO 771
	IENC=17
	ENCODE(IENC,61,INPUT)INBOX(1,JIN)
	CALL XSPAWN(INPUT)
C..	CHECK BITMAP AGAIN
	CALL BITRED(IN,INBOX(1,JIN),NUMIN,INDOC1)
C.. SKIP OVER DOC001.W11, IF EXISTS
771	IF(NUMIN.LE.1) NUMIN=2
C.. GENERATE PIP STATEMENT FOR TRANSFERING DOCS
	IENC=53
	ENCODE(IENC,46,INPUT)INBOX(1,JIN),NUMIN,OUTBOX(1,JOUT),NUMDOC
46	FORMAT('PIP WP:[',A7,']DOC',I3,'.W11/FO=WP:[',A7,']DOC'
     1 ,I3,'.W11!')
C.. ENTER ZEROS FOR DOC NAMES
	IF(INPUT(20).EQ.IBLANK) INPUT(20)=IZERO
	IF(INPUT(21).EQ.IBLANK) INPUT(21)=IZERO
	IF(INPUT(46).EQ.IBLANK) INPUT(46)=IZERO
	IF(INPUT(47).EQ.IBLANK) INPUT(47)=IZERO
	CALL XSPAWN(INPUT)
	NUMPIP=NUMPIP+1
C.. SEE IF DOC001.W11 EXISTS
	IF(INDOC1.GT.0) GO TO 81
C.. DOC001.W11 DOES NOT EXIST, CREATE IT
889	IENC=47
	ENCODE(IENC,88,INPUT)(F2TEMP(I),I=1,16)
88	FORMAT('PIP ',16A1,'/FO=SY:[201,201]DOC001.BKC!')
	CALL XSPAWN(INPUT)
C.. ASSIGN FILE
	CALL ASSIGN(IN3,F2TEMP)
	GO TO 82
C.. DOC001.W11 EXISTS, OPEN IT AND DXF AND APPEND MODE
81	IENC=23
	ENCODE(IENC,62,INPUT)INBOX(1,JIN)
	CALL RIDBLK(INPUT,IENC)
	CALL INDOC(IN3,INPUT,F2TEMP)
82	CALL FDBSET(IN3,'APPEND')
C..  WRITE OUT INFO ON TEMP FILE F2TEMP FOR DOC001
	IF(I1.EQ.NUMNAM) GO TO 221
	IENC=36
	ENCODE(IENC,83,INPUT)OUTBOX(2,JOUT),INBOX(2,JIN),NUMIN
83	FORMAT('<n>FROM ',A8,'-TO-',A8,'<#>',I3,'<>')
	GO TO 222
C..	RECEIPT SECTION (LAST DO LOOP RUN)
221	IENC=31
	ENCODE(IENC,220,INPUT)NAMES(1),NUMIN
220	FORMAT('<n>RECEIPT FOR ',A8,'<#>',I3,'<>')
222	CALL RIDBLK(INPUT(9),IENC-8)
	WRITE(IN3,9,ERR=888)(INPUT(I),I=1,IENC)
	ENDFILE IN3
	CALL CLOSE(IN3)
C.. DXFLEX TEMP FILE F2TEMP OVER TO DOC001.W11
	IENC=61
	ENCODE(IENC,84,INPUT)INBOX(1,JIN),(F2TEMP(I),I=1,16)
84	FORMAT('DXF WP:[',A7,']DOC001.W11/TYPE:DOC=',16A1,'/TYPE:PM!')
	CALL XSPAWN(INPUT)
C.. CHANGE ATTRIBUTES OF DOC001.W11 TO OWNER
	IENC=38
	ENCODE(IENC,53,INPUT)INBOX(1,JIN)
53	FORMAT('PIP WP:[',A7,']DOC001.W11/PR/GR:R/FO!')
	CALL XSPAWN(INPUT)
C.. FIX UP BITMAP FOR ACCOUNT
	IENC=17
	ENCODE(IENC,61,INPUT)INBOX(1,JIN)
61	FORMAT('BMP WP:[',A7,']!')
	CALL XSPAWN(INPUT)
C.. CHECK FOR OTHER MEMBERS
	GO TO 48
C.. NO DOC001 FILE OPENED
888	CALL CLOSE(IN3)
	INDOC1=0
	GO TO 889
40	CONTINUE
	GO TO 26
C.. END OF AN OUTBOX TRANSFER, DELETE ALL W11 FILES IN OUTBOX
27	CALL CLOSE(IN2)
	IENC=28
	ENCODE(IENC,47,INPUT)OUTBOX(1,JOUT)
47	FORMAT('PIP WP:[',A7,']*.W11;*/DE! ')
	CALL XSPAWN(INPUT)
20	CONTINUE
C..
C..	FINISHED, TYPE MESSAGES AND QUIT
C..
	TYPE 70,NUMPIP,LP
70	FORMAT('0*** NUMBER OF DOCUMENTS TRANSFERED=',I6,' ***'//
     1 ' *** NUMBER OF DOCUMENTS PRINTED   =',I6,' ***'//)
	RETURN
	END