Google
 

Trailing-Edge - PDP-10 Archives - BB-D875A-SM - dx/sources/wp8pip.for
There is 1 other file named wp8pip.for in the archive. Click here to see a list.
C	       PACKAGE	       :       DX/TOPS20
C	       VERSION         :       V1.0
C	       OP. SYSTEM      :       TOPS20 V3.0
C
C              PROGRAM         :       WPIP
C	       MODULE          :       WP8PIP.FOR
C	       MODULE #        :       1 OF 13
C	       EDIT            :       043
C	       EDIT DATE       :       10-AUG-78
C
C
C
C**********************************************************************
C
C	       C O P Y R I G H T
C
C
C	COPYRIGHT (C) 1978
C       DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
C
C
C       THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY  ON  A
C       SINGLE  COMPUTER  SYSTEM  AND  MAY  BE  COPIED  ONLY  WITH THE
C       INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE,  OR
C       ANY  OTHER  COPIES  THEREOF,  MAY NOT BE PROVIDED OR OTHERWISE
C       MADE AVAILABLE TO ANY OTHER PERSON  EXCEPT  FOR  USE  ON  SUCH
C       SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS.  TITLE TO
C       AND OWNERSHIP OF THE SOFTWARE SHALL AT  ALL  TIMES  REMAIN  IN
C       DIGITAL.
C  
C       THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT
C       NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C       EQUIPMENT CORPORATION.
C  
C       DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY
C       OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
C  
C**********************************************************************
C
C
C	E D I T  H I S T O R Y
C
C
C  EDIT #000	1/3/78		KENT BLACKETT
C
C  EDIT #001	2/1/78		J.COHEN
C	ALLOW MESSAGE DURING TRANSMISSION
C
C  EDIT #002	2/1/78		J.COHEN
C	ELIMINATE EXTRA SPACES IN FILE-NAME
C
C  EDIT #003	2/1/78		J.COHEN
C	IMPLEMENT BYE PACKET
C
C  EDIT #004	2/2/78		J.COHEN
C	ALLOW FOR DEFAULT EXTENSION = "WP8"
C
C  EDIT #005	2/4/78		J. COHEN
C	INITIAL IMPLEMENTATION OF PROMPT PACKETS.
C
C  EDIT #006	2/4/78		G. A. REID
C	CHANGE SO THAT ALL USER DIALOGUE IS TO THE WPS
C	STATION AND NOT TO A SECOND TERMINAL.
C	INCLUDED THE ABILITY TO USE A SECOND TERMINAL, LATER
C	THIS CODE WILL BE ALTERED SO THAT IT IS ONLY COMPILED
C	WHEN USING THE 'DEBUG' COMPILER SWITCH.
C
C  EDIT #007	2/14/78		J. COHEN
C	IMPLEMENTATION OF ERROR MESSAGES 103 AND 104.
C
C  EDIT #008	2/14/78		J. COHEN
C	ALLOW FOR OPTIONS TO OVERWRITE, ADD TO TOP AND
C	ADD TO BOTTOM OF A FILE.
C
C  EDIT #009	2/14/78		G. A. REID
C	ADD FILENAME VERIFICATION AND DEFAULT EXTENSION 'WP8'.
C
C  EDIT #010	2/15/78		J. COHEN
C	CHANGED CONTENTS OF ERROR MESSAGES TO NOT INCLUDE
C	'Message - ' AND RELATED CODE CHANGES.
C	FIXED A PROBLEM WHICH CAUSED US TO ALWAYS GO TO THE
C	RECEIVE CODE (FSN 100).
C	WE NOW CLEAR THE MESSAGE BUFFER TO ELIMINATE PREVIOUS
C	CONTENTS, IF ANY.
C
C  EDIT #011	2/15/78		G. A. REID
C	CORRECTIONS TO ENABLE HOST TO ADD TO 'B'OTTOM OR TO
C	79VERWRITE AN EXISTING FILE.  ANOTHER PLACE WAS
C	FOUND WHERE 'BUF' HAD TO BE PADDED WITH SPACES TO
C	CLEAR OUT ANY POSSIBLE PREVIOUS CONTENTS.
C
C  EDIT #012	2/15/78		J. COHEN
C	ALLOW ANSWER TO 'ARE YOU A WPS STATION?' TO BY A 89 OR
C	OR A 121.
C	CHANGE CODE TO PROMPT AGAIN FOR THE FILENAME IF AN
C	83 OR AN 82 RESPONSE IS RECEIVED WHICH IS FOLLOWED
C	BY JUST A SPACE WITH NO FILENAME.
C	CORRECTION TO CODE WHICH HANDLES THE ADD TO TOP OPTION.
C
C  EDIT #013	2/16/78		J. COHEN
C	ADD CODE TO TELL WPS TO SET UP FOR RECEIVING A
C	TOPS20 FILE.
C	ALTER FILENAME CHECK FOR LEGAL CHARACTERS.
C	ANOTHER CORRECTION TO EDIT #010.
C
C  EDIT #014	2/16/78		G. A. REID
C	CHANGES MADE NECESSARY BECAUSE WE MOVED THE CONVERSION
C	FROM LOWERCASE TO UPPERCASE AND CHECKING FOR RESPONSE
C	TO PROMPT PACKETS TO THE 'PROMPT' SUBROUTINE.
C
C  EDIT #015	2/16/78		J. COHEN
C	CHANGES MADE NECESSARY BY EDIT #014.
C	CODING CHANGES TO MAKE THE NECESSARY ORDER OF CALLS
C	FOR SENDING A TOPS20 FILE TO WPS.
C
C  EDIT #016	2/16/78		G. A. REID
C	CHANGE SO THAT NULL RESPONSES TO PROMPTS CAUSE THE FLOW
C	OF CONTROL TO BUBBLE UP TO THE NEXT HIGHER COMMAND LEVEL.
C	ALSO, MODIFY TO PROPERLY ACT ON RESPONSES OTHER THAN 89
C	(I.E. ALTERED FLOW OF CONTROL).
C	IMPLEMENT MESSAGE 105 INDICATING AN ILLEGAL FILENAME:
C		Message - 105.  [Filename] is an illegal name.
C
C  EDIT #017	2/17/78		J. COHEN
C	ALTER FLOW OF LOGICAL IN THE CASE OF AN 'R'ECEIVE TRANSFER
C	TO:  1) PROMPT FOR A 89ES REPLY ON CORRECT ACTION,
C	     2) SEND MESSAGE TO WPS TO SET UP FOR RECEIVE STATE
C	     3) WAIT FOR REPLY = 'M OK' AND CONTINUE OR
C				 A NULLSTRING TO START OVER
C
C  EDIT #018	2/28/78		J. COHEN
C	ADD CODE TO CONVERT 'START-OF-DOCUMENT' PACKETS TO 
C	HEADER BLOCKS FOR THE TOPS20 FILES AS WELL AS CONVERTING
C	HEADER BLOCKS TO 'START-OF-DOCUMENT' PACKETS WHEN
C	SENDING A TOPS20 FILE TO THE WPS SYSTEM.
C	ALTER CODE TO ELIMINATE EXTRANEOUS 'END-OF-DOCUMENT'
C	PACKETS IN CASE ADDING TO THE TOP OR BOTTOM
C	OF AN EXISTING FILE.
C
C  EDIT #019	3/2/78		J. COHEN
C	CLOSE ALL FILES AFTER DXINIT TO AVOID POSSIBLE
C	ERROR CONDITION ON AN 'OPEN' STATEMENT. ALSO
C	CHECK FOR AN 'OK-TO-SEND' PACKET FROM WPS AFTER
C	TOPS20 HAS SENT THE 'START-OF-DOCUMENT' AND BEFORE
C	TOPS20 SENDS THE FIRST 'TEXT-OF-DOCUMENT'.
C
C  EDIT #020	3/2/78		G. A. REID
C	INITIALIZE 'FNAME' BEFORE USING IT.  THIS IS NECESSARY
C	TO CLEAR OUT A FILENAME THAT MAY HAVE PREVIOUSLY BEEN
C	PROCESSED AND WHO'S LENGTH IS GREATER THAN THE NEXT ONE
C	TO BE HANDLED.  AVOIDS FILENAME SPECIFICATION ERRORS.
C	ALSO, FIX SO THAT THE ADD-TO-BOTTOM CASE (WHERE THE
C	HOST IS RECEIVING) WRITES THE END-OF-DOCUMENT RECORD.
C
C  EDIT #021	3/2/78		J. COHEN
C	CALL 'RECV' AFTER END-OF-FILE ENCOUNTERED ON TOPS20
C	FILE. THIS IS DONE TO ENSURE THAT THE LAST PACKET
C	WE SENT WAS RECEIVED AND ACK'ED.
C
C  EDIT #022	3/3/78		G. A. REID
C	PUT IN COPYRIGHT STATEMENT AND RENAMED FROM DX.FTN
C	TO WP8PIP.FTN.
C
C  EDIT #023	3/3/78		J. COHEN
C	INCLUDE A CALL TO 'ERRSET' WHICH WILL INHIBIT AN
C	ERROR LISTING OF CERTAIN POTENTIAL BUT NON-CRITICAL
C	ERRORS (ERROR #'S ARE THE ONES LISTED IN THE 'DATA'
C	STATEMENT FOR 'IERRST').
C	IMPLEMENT USE OF 'MESSAGE 106' WHICH INDICATES THAT
C	A FILE IS CORRUPTED.
C	ALSO IMPLEMENT USE OF 'BYE 202' WHICH INDICATES THAT
C	AN EXPECTED RESPONSE FROM THE LOGICAL FLOW OF
C	'WP8PIP' WAS NOT ENCOUNTERED.
C	REMOVED 'CLOSE' FILE STATEMENTS AFTER 'DXINIT' BECAUSE
C	THEY WERE UNNECESSARY. (REFERENCE EDIT #019).
C	SET CURRENT 'DEBUG' CODE ON.
C
C  EDIT #024	3/3/78		J. COHEN
C	ALTER CHECK FOR 'START-OF-DOCUMENT' CHECK WHEN RECEIVING
C	FROM WPS.
C
C  EDIT #025	3/6/78		J. COHEN
C	FOR WPS RECEIVING ALLOW FOR CHECKING OF CORRECT FILE
C	FORMAT BEFORE SENDING THE FILE AND BEFORE PROMPTING
C	WPS TO SET UP FOR THE TRANSFER.
C	INSERT A TWO SECOND DELAY BEFORE SENDING MESSAGES
C	TO WPS.
C	TYPE OUT THE 'WP8PIP' PROGRAM IDENTIFICATION:
C		'WP8PIP V1.0'.
C
C  EDIT #026	3/6/78		J. COHEN
C	ALLOW 'WP8PIP' TO RESTART AFTER USER TYPES
C	'<GOLD><HALT>' AND LATER TYPES 'DX <RETURN>'.
C
C  EDIT #027	3/6/78		J. COHEN
C	CHECK FOR RESTART POSSIBILITY AFTER ALL CALLS TO
C	'PROMPT' AND 'SEND'.
C
C  EDIT #028	3/7/78		J. COHEN
C	PERFORM HOUSEKEEPING ON ANY OPEN FILES IF FOR ANY
C	REASON TRANSMISSION MUST BE STOPPED PREMATURELY.
C	ALSO ALLOW WPS TO FINISH ITS PROCESSING IN AN
C	ORDERLY MANNER IF THIS CONDITION IS ENCOUNTERED.
C
C  EDIT #029	3/7/78		J. COHEN
C	IF WPS TRANSMITS AN INCORRECT PACKET, END PROCESSING
C	IN AN ORDERLY MANNER AND END FURTHER TRANSMISSION
C	BY SENDING A 'BYE' PACKET.
C
C  EDIT #030	3/7/78		J. COHEN
C	CHANGE THE 2 SECOND DELAY BEFORE A MESSAGE IS
C	SENT TO BE 1 SECOND.
C
C  EDIT #031	3/8/78		J. COHEN
C	ADD 'DEBUG' CODE WHICH CAN BE USED TO CALCULATE
C	STATISTICS FOR DETERMINING BAUD RATES.
C
C  EDIT #032	3/8/78		J. COHEN
C	INFORM USER OF AN EMPTY FILE CONDITION.
C	INFORM USER OF A CORRUPTED FILE CONDITION WHICH
C	OCCURED IN THE MIDDLE OF THE FILE TRANSFER AND 
C	FORCED AN EARLY 'END-OF-DOCUMENT' TO BE SENT.
C	ALSO ALLOW FOR A POSSIBLE TIMEOUT OF 1 MINUTE
C	IN THE CASE WHERE THE WPS USER FIRST TYPED
C	83 FILE THEN TYPED 82 DOCUMENT. SHOULD THIS
C	SITUATION ARISE RESTART.
C	ALLOW TOPS20 TO RECOGNIZE A "164 CODE WHICH SAYS THAT
C	WPS DOES NOT HAVE ENOUGH ROOM ON ITS DISKETTE TO
C	RECEIVE THE FILE WE ARE ABOUT TO SEND DOWN
C
C  EDIT #033	3/9/78		J. COHEN
C	CHANGE THE WAIT TIME FOR ERROR MESSAGES SO THAT
C	THE TOTAL ELAPSED TIME IS 10 SECONDS.
C	ADD COMMENTS WHICH WILL LABEL EACH SECTION OF
C	THE PROGRAM.
C
C  EDIT #034	3/13/78		J. COHEN
C	INFORM USER THAT THEIR FILE IS EMPTY OR CORRUPTED
C	IN THE CASE OF ADDING TO TOP/BOTTOM. ALSO ALLOW FOR
C	A 1 MINUTE TIME OUT IF WE ARE EXPECTING AN 'M OK'
C	MESSAGE AND DON'T RECEIVE IT.
C	CHANGE ALL CARRIAGE CONTROL OPTIONS ON THE 'OPEN'
C	STATEMENTS TO BE 'LIST' NOT 'NONE'.
C
C  EDIT #035	3/13/78		J. COHEN
C	IF USER TYPES OTHER THAN 'M OK' WHEN WPS IS IN
C	THE RECEIVE STATE SEND AN ERROR MESSAGE INFORMING
C	THE USER OF THIS.  INSERT A WAIT AFTER A 'BYE'
C	PACKET HAS BEEN SENT.
C
C**********************************************************************
C**********************************************************************
C
C  EDIT #036	3/15/78		J. COHEN
C	EDITS FROM THIS POINT ON ARE FOR TOPS20 COMPATIBILITY.
C	MAKE CHANGES TO 'LOGICAL*1' DECLARATIVES AND ALL 'OPEN'
C	STATEMENTS.
C
C  EDIT #037	3/17/78		J. COHEN
C	ADD CALLS TO 'DTECVT' AND 'TIMER' WHICH WILL CONVERT
C	THE SYSTEM DATE AND TIME RESPECTIVELY, FORM ASCII TO
C	INTEGER FORMAT FOR USE IN THE HEADER BLOCK IN THE
C	FORMER AND THE STATISTICS ROUTINE IN THE LATER.
C	ALSO ADD CODE WHICH WILL FORM A 'DOUBLE PRECISION'
C	VARIABLE FOR THE FILE NAME TO BE USED IN ALL THE
C	'OPEN' STATEMENTS.
C
C  EDIT #038	3/20/78		J. COHEN
C	CHANGE THE CALL TO 'WAIT' TO A CALL OF A MACRO ROUTINE
C	WHICH DOES THE ACTUAL WAIT.
C
C  EDIT #039	3/28/78		J. COHEN
C	CHANGE ALL CALLS TO WAIT TO NOW SET A VALUE IN 'MCOM'
C	= TO THE # OF 1/2 SECONDS REQUIRED FOR THE WAIT CONDI-
C	TION. WHEN THE WAIT IS PERFORMED WE WILL CONTINUE TO
C	LOOP ON THE CONDITION WHERE 'ITIME' IS NOT = 0, WHEN
C	IT DOES = 0 THIS IMPLIES THAT THE TOTAL WAIT TIME HAS
C	BEEN MET.
C
C  EDIT #040	3/29/78		J. COHEN
C	CHANGE ALL READS, WRITES AND THE APPROPRIATE FORMAT
C	TO INCLUDE A 2 DIGIT NUMBER AS THE FIRST ELEMENT
C	TO BE READ OR WRITTEN WHICH WILL BE THE SIZE OF
C	THE DATA RECORD. ALSO DECREASE THE SIZE OF THE HEADER
C	BLOCK FROM 512 CHARACTERS TO 80 (ONLY 78 OF WHICH WILL
C	REALLY BE USED) IN ORDER TO MAKE ALL THE RECORDS CON-
C	SISTENT.
C
C  EDIT #041	5/19/78		J. COHEN
C	ALLOW FOR 4 DIGIT DOCUMENT # TO BE PASSED TO LOOKUP.
C	IF USER ATTEMPTS TO REFERENCE DOCUMENT #1, SEND AN ERROR
C	MESSAGE AND REINITIALIZE.
C
C  EDIT #042	6/19/78		J. COHEN
C	ALLOW FOR REINITIALIZATION IF PREVIOUS PACKET RECEIVED
C	WAS A <GOLD><MENU> ("171).
C
C  EDIT #043	8/10/78		J. COHEN
C	CHANGE ALL SEQUENTIAL I/O TO RANDOM I/O AND CALL TYPE 2
C	RECV BEFORE FINISHING I/O FOR ADD TO TOP CASE.
C
C**********************************************************************
C
C
C
C	A R R A Y   &   C O M M O N   D E C L A R A T I O N S
C
	IMPLICIT INTEGER (A-Z)
D	REAL DELTA,BAUD,ABAUD
	DOUBLE PRECISION FILNAM,FNAME,FBLANK
	DIMENSION BUF(80),FTEMP(64),DXOPT(2),DC1MSG(44)
	1 ,M104(6),M104A(15),M103(6),M103A(9),CLRSCN(65)
	2 ,EODBYE(17),RECOPT(2),M108(64),M106(6),M106A(13)
	3 ,HEADER(130),HDRTMP(130),CORRUP(64),M107(64)
	4 ,BUFBCK(80)
	DIMENSION DOCNAM(64),CREDAT(2),MODDAT(2)
	COMMON ITMP(6),IERRC,IERRCT,MSGFLG,IBYE
	1 ,IFLAG
	COMMON /WCOM/ MEF,ITIME,IDU
	EQUIVALENCE (FILNAM,FNAME)
C
C	I N I T I A L I Z A T I O N   A N D   C O N S T A N T S
C
	DATA LUN/27/
	DATA LENHDR/65/
	DATA MSGFLG,IBYE,IFLAG/3*0/
	DATA EOD/"146/
	DATA FBLANK/'          '/
C
C  EODBYE WILL BE SENT WHEN THE WPS USER HAS TYPED A 'BYE'
C  MESSAGE DURING A FILE TRANSFER, IT WILL READ:
C	Message - Transfer aborted
C
	DATA EODBYE/"142,84,114,97,110,115,102,101,114,32,
	1 97,98,111,114,116,101,100/
	DATA CLRSCN/"142,64*32/
	DATA DXOPT/"153,"044/
	DATA RECOPT/"141,"047/
	DATA OKSND/"151/
C
C	MESSAGE 103 TO INDICATE AN EMPTY FILE:
C		Message - 103.  [Document] is empty
C
C	MESSAGE 104 TO INDICATE A NONEXISTENT FILE:
C		Message - 104.  [Document] does not exist
C
C	MESSAGE 106 TO INDICATE A CORRUPTED FILE:
C		Message - 106.  [Document] is corrupted
C
C	MESSAGE 107 TO INDICATE DOCUMENT NAME IS NOT UNIQUE:
C		Message - 107.  Non-unique document name - [Document]
C
C	MESSAGE 108 TO INDICATE NO T20 FILE EXISTS FOR THIS DOC. NAME
C		Message - 108.  T20 file does not exist for this
C			        document name
C
C
	DATA M103,M103A,M104,M104A/
	1 49,48,51,46,3*32,105,115,32,101,109,112,116,
	2 121,49,48,52,46,3*32,100,111,101,115,32,
	3 110,111,116,32,101,120,105,115,116/
	DATA M106,M106A/
	1 49,48,54,46,3*32,105,115,32,99,111,114,
	2 114,117,112,116,101,100/
	DATA M107/"142,49,48,55,46,32,32,78,111,110,45,117,110,
	1 105,113,117,101,32,100,111,99,117,109,101,110,116,
	1 32,110,97,109,101,32,45,31*32/
C
	DATA M108/"142,49,48,56,46,32,32,84,79,80,83,50,48,32,102,
	1 105,108,101,32,100,111,101,115,32,110,111,116,32,101,
	2 120,105,115,116,32,102,111,114,32,100,111,99,117,
	3 109,101,110,116,18*32/
C
C
C
C  MESSAGE TO BE SENT IN THE EVENT A CORRUPTED FILE IS
C  DETECTED IN THE MIDDLE OF TRANSMISSION.
C
	DATA CORRUP/"142,
	1 78,111,110,45,115,116,97,110,100,97,114,100,32,
	2 87,80,83,32,102,111,114,109,97,116,32,105,110,32,
	3 100,111,99,117,109,101,110,116,28*32/
C
C  DC1MSG: *** USER MAY NOT REFERENCE DOCUMENT #1 ***
C
	DATA DC1MSG/"142,32,3*42,32,85,83,69,82,32,77,65,89,32,
	1	78,79,84,32,82,69,70,69,82,69,78,67,69,32,
	1	68,79,67,85,77,69,78,84,32,35,49,32,3*42/
C
C  INITIALIZE FIRST TEN WORD OF HEADER BLOCK INFORMATION
C	HEADER(1-2)	=	-255
C	HEADER(3-4)	=	   8
C	HEADER(5-6)	=	   0
C	HEADER(7-8)	=	   0
C	HEADER(9-10)	=	  40
C
C
	DATA HEADER(1),HEADER(2)/"133,"40/
	DATA HEADER(3),HEADER(4)/"137,"47/
	DATA HEADER(5),HEADER(6)/"137,"137/
	DATA HEADER(7),HEADER(8)/"137,"137/
	DATA HEADER(9),HEADER(10)/"137,"107/
C
C
C	P R O G R A M   S T A R T
C
C
C  OBTAIN TODAY'S DATE TO BE USED IN THE HEADER BLOCK AND
C  INITIALIZE THE REMAINDER OF THE HEADER BLOCK TO "137
C  WHICH IS THE COS-310 EQUIVALENT OF ZERO. ALSO INITIALIZE
C  THE TEMPORARY HEADER BLOCK AREA.
C  THE DATE FIELDS APPEAR IN THE HEADER BLOCK AS:
C	HEADER(13)	=	DAY
C	HEADER(14)	=	MONTH
C	HEADER(15-16)	=	YEAR (MINUS 1900)
C
C
	CALL DTECVT(IDAY,IMON,IYR)
	IDYMN = ((IDAY .AND. "77) * "100) + (IMON .AND. "77)
	DAY = IDYMN
	YEAR = IYR
	DO 910 I=11,130
	HEADER(I) = "137
	HDRTMP(I) = "137
910	CONTINUE
	DO 911 I=1,10
	HDRTMP(I) = "137
911	CONTINUE
C
C  CALL 'ERRSET' TO INHIBIT AN ERROR LOG OF THE ERRORS
C  LISTED FOR NUMBERS IN 'DATA STATEMENT' FOR 'IERRST'.
C
	CALL ERRSET(0)
D2	TYPE 8700
D8700	FORMAT(' ARE YOU ON A WPS STATION? (Y/N) ',$)
D	READ(5,8750,END=99999)IANS
8750	FORMAT(A1)
D	IF(IANS .NE. 'Y' .AND. IANS .NE. 'N' .AND.
D	1  IANS .NE. 'y' .AND. IANS .NE. 'n') GO TO 2
D	IF(IANS .NE. 'N' .AND. IANS .NE. 'n') GO TO 3
D	TYPE 8905
D8905	FORMAT(' PLEASE ENTER LINE NUMBER OF WPS STATION : ',$)
D	READ(5,8906,END=99999)IUNIT
D8906	FORMAT(O3)
D	TYPE 8901
D	GO TO 1
3	IUNIT = -1
	TYPE 8901
8901	FORMAT(//,' WPIP  V1.0')
	TYPE 8900
8900	FORMAT(/,' PLEASE TYPE "\R <GOLD><MENU>DX<RETURN>"')
	GO TO 1
99999	CALL EXIT
C
C
C	E S T A B L I S H   C O M M U N I C A T I O N S
C
C
1	IBYE = 0
	CALL DXINIT(IUNIT)
7	CALL SEND(DXOPT,2)
4	IF(IBYE .EQ. 0) GO TO 14
	ITIME = 10000
	CALL WAIT
	ITIME = 0
	MEF = 0
	IBYE = 0
	CALL SEND(CLRSCN,65)
14	IF(IFLAG .EQ. 0) GO TO 15
	IFLAG = 0
	GO TO 1
15	I1112 = 0
	IRECS = 0
	ICNTR = 0
	BCK = 0
	LTOT = 0
	ISIZE = 0
D	IACKC = 0
D	IERRC = 0
D	IERRCT = 0
D	DELTA = 0.
D	BAUD = 0.
D	ABAUD = 0.
	DO 375 I=1,80
	BUF(I) = 32
375	CONTINUE
	IF(IBYE .EQ. 1) GO TO 1
C
C  IF USER RE-ENTERS 'WP8PIP' ALLOW HIM TO RESTART
C
	CALL RECV(1,BUF,LEN)
C
C
C	B E G I N   P R O M P T I N G   W P S - 8
C
C
	IF(IBYE .EQ. 1) GO TO 1
C
C  EDIT #009
C  A RESPONSE HAS THE FORMAT "X FILENAME"
C  WHERE "X" IS A ONE LETTER CODE FOR THE DESIRED FUNCTION:
C  "S" FOR WPS WANTS TO SEND US A DOCUMENT,
C  "R" FOR WPS WANTS TO RECEIVE A DOCUMENT FROM US,
C  "FILENAME" IS THE FILENAME.
C  NOTE: THE FILENAME IS OPTIONAL HERE. IF NOT SPECIFIED, IT
C        WILL BE PROMPTED FOR.
C
C
C
C  EDIT #009
C	IS THE SPECIFIED FUNCTION EITHER 'S' OR 'R'?
C	IF NOT, PROMPT AGAIN FOR THE DESIRED FUNCTION.
C
	IF (BUF(1) .NE. "151 .AND. BUF(1) .NE. "152) GO TO 4
C
C  OK, WE HAVE HAVE LEGAL FUNCTION.  REMEMBER IT IN 'IFCN'.
C
5998	IFCN = BUF(1)
C
C
C  FIRST DETERMINE IF WE HAVE A DOCUMENT NAME OR A DOCUMENT NUMBER.
C  IF IT'S A DOCUMENT NAME SET 'IDOCNO' = 0 AND PASS THE DOCUMENT
C  NAME AND LENGTH RO 'LOOKUP', ELSE SET 'IDOCNO' = DOC. # PASSED IN
C  'BUF(2)' AND 'BUF(3)' AND PASS IT TO 'LOOKUP' WITHOUT THE DOCUMENT
C  NAME.
C
	DO 5999 M=1,64
	DOCNAM(M) = 32
	FTEMP(M) = 32
5999	CONTINUE
	IDOCNO = 0
	IDNLEN = 0
	IFL = 0
	FNAME = FBLANK
	IEXIST = 0
	ISIZE = 0
	IVERSN = 0
C
C  IF LENGTH-1 = 1 OR 2  AND 'BUF(2)' AND 'BUF(3)' EQUALS A
C  NUMBER THEN WE HAVE A DOCUMENT NUMBER ELSE WE HAVE A
C  DOCUMENT NAME.
C
	IDNLEN = LEN - 1
	IF(IDNLEN .GT. 4) GO TO 6
	IDOCNO = 0
	DO 2131 M=LEN,2,-1
	IF(BUF(M) .GE. 48 .AND. BUF(M) .LE. 57) GO TO 2130
	GO TO 6
2130	IDOCNO = IDOCNO + (BUF(M) -48) * (10 ** (LEN - M))
2131	CONTINUE
	IF(IDOCNO .NE. 1) GO TO 8
	CALL SEND(DC1MSG,44)
	GO TO 19
C
C  WE ARE SENDING A DOCUMENT NAME
C
6	DO 12 M=2,LEN
	DOCNAM(M-1) = BUF(M)
12	CONTINUE
	IDOCNO = 0
C
C  SAVE ORIGINAL NAME SENT FROM WPS STATION
C
8	DO 112 M=2,LEN
	FTEMP(M-1) = BUF(M)
112	CONTINUE
C
D	WRITE(23,1000)BUF(1),DOCNAM,IDNLEN,IDOCNO
D1000	FORMAT(' FUNCTION = ',O3,/,' DOC = ',64R1,/,
D	1 ' LENGTH = ',I5,/,'DOC # ',I5)
C
C  CALL 'LOOKUP' WITH EITHER 'IDOCNO' OR 'DOCNAM' AND 'IDNLEN',
C  THE CORRESPONDING FILE NAME WILL BE RETURNED IN 'FNAME' WITH
C  THE LENGTH IN 'IFL'.
C
	CALL LOOKUP(LUN,IDOCNO,DOCNAM,IDNLEN,IEXIST,CREDAT,MODDAT,
	1	    MODTIM,ISIZE,IVERSN,FNAME,IFL)
C
C  VERSION NUMBER FOR THE HEADER WILL BE 'IVERSN' + 1
C
	IVERNO = IVERSN + 1
C
D	WRITE(23,1005)IEXIST,FNAME,IFL
D1005	FORMAT(' ON RETURN FROM LOOKUP ==> ',I5,/,' FNAME = ',
D	1 A10,'   LENGTH = ',I5)
C
C  ON RETURN FROM 'LOOKUP' IEXIST WILL INDICATE THE RESULTS:
C	1 = FILE EXISTS
C	2 = FILE DOES NOT EXIST
C	3 = FILE EXISTS ON INDEX BUT NOT ON DISK (ERROR CONDITION)
C	4 = FILE NAME WAS NOT UNIQUE (POSSIBLE ERROR CONDITION)
C	5 = FILE EXISTS AND WAS CONVERTED BY WFLX
C
	IF(IEXIST .LE. 0 .OR. IEXIST .GT. 5) GO TO 4
	GO TO (11,11,9,10,11),IEXIST
C
C  ALL'S WELL FROM 'LOOKUP' (I.E. 'IEXIST' = 1, 2 OR 5).
C  NOW DISPATCH ON IFCN, "151 = 'S' AND "152 = 'R'.
C
11	IF (IFCN .EQ. "151) GO TO 200
	GO TO 100
C
C  COME HERE TO HANDLE WPS RECEIVING, US SENDING.
C  (THE USER AT THE WPS STATION TYPED 'R'.)
C
C
C
C	H E R E   F O R   W P S - 8   T O   R E C E I V E
C
C
C
C  IF 'IEXIST' = 1 OR 5 WE ARE WORKING WITH AN 'OLD' FILE, ELSE
C  CONTINUE AT FSN #151 TO INFORM THE USER THAT THE DOCUMENT
C  IS EMPTY.
C
100	IF(IEXIST .NE. 1.AND. IEXIST .NE. 5) GO TO 190
	OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='SEQIN',
	1 MODE='ASCII',DISPOSE='SAVE',ERR=190)
C
	CLOSE (UNIT=22)
	OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
	1    MODE='ASCII',RECORD SIZE=67, ASSOCIATE VARIABLE=RECORD,
	2    ERR=194)
	READ(22'1,9002,END=151,ERR=194)LENIN,(HDRTMP(II),II=1,65)
	READ(22'2,9002,END=151,ERR=194)LENIN2,(HDRTMP(II),II=66,130)
C
C  IF THE HEADER BLOCK IS THE FIRST RECORD OF OUR FILE,
C  CONTINUE BY SENDING MESSAGE REQUESTING WPS TO SET UP
C  THE TRANSFER. 
C
C  IF THE FIRST RECORD OF THE FILE IS NOT A 'HEADER BLOCK', THEN
C  THE FILE IS NOT IN THE CORRECT FORMAT. INFORM WPS OF THE
C  PROBLEM AND THEN PROMPT FOR THE FILENAME AGAIN.
C
	IF(HDRTMP(1) .NE. "133 .OR. HDRTMP(2) .NE. "40) GO TO 194
C
C
C  MUST NOW SET UP A 'START-OF-DOCUMENT' PACKET TO SEND WPS BY
C  EXTRACTING THE BLOCK SIZE INFORMATION FROM WORDS 11 AND 12
C  AND THE PRINTER INFORMATION FROM WORDS 39 THRU 78.
C
931	BUF(1) = "144
	BUF(2) = HDRTMP(11)
	BUF(3) = HDRTMP(12)
	DO 930 I=4,45
	BUF(I) = HDRTMP(I+35)
930	CONTINUE
	LEN = 45
C
C  EDIT #001
C	MSGFLG = 1 IMPLIES FILE TRANSMISSION IN PROGRESS
C
	MSGFLG = 1
	CALL SEND(BUF,LEN)
	IF(IBYE .EQ. 1) GO TO 150
	CALL RECV(1,BUF,LEN)
	IF(IBYE .EQ. 1) GO TO 150
	IF(BUF(1) .EQ. "140) GO TO 140
C
C  IF WPS INFORMS US THAT THERE IS NOT ENOUGH ROOM ON ITS
C  DISKETTE TO RECEIVE THE TOPS20 FILE (CODE = "164) THEN
C  CLOSE OPEN FILES AND REINITIALIZE.
C
	IF(BUF(1) .EQ. "164) GO TO 150
C
C  IF THE RESPONSE WE GOT WAS NOT AN 'OK-TO-SEND' PACKET
C  THEN SEND A 'BYE' PACKET WITH THE MESSAGE:
C	Bye - 202.  DX message type error
C  THEN CLOSE FILES AND REINITIALIZE.
C
1202	CALL BYE(2)
1150	CONTINUE
	CLOSE(UNIT=22)
D	CLOSE(UNIT=23)
	IBYE = 1
	GO TO 7
C
C
C	W P S - 8   R E C E I V I N G   T E X T
C
C
C
C  OPEN WAS SUCESSFUL, BEGIN SENDING FILE DOWN
C
140	CONTINUE
D	CALL TIMER(ISEC1)
	RECORD = 3
110	READ(22'RECORD,9002,END=150)LEN,(BUF(II),II=1,65)
9002	FORMAT(I2,65R1)
C
C  IF RECORD IS NOT 'TEXT-OF-DOCUMENT' AND NOT
C  'END-OF-DOCUMENT' THEN WILL SEND 'END-OF-DOCUMENT'
C  PACKET, CLOSE APPROPRIATE FILES AND CONTINUE.
C
	IF(BUF(1) .NE. "145 .AND. BUF(1) .NE. "146) GO TO 154
	CALL SEND(BUF,LEN)
C
C  IF 'BYE' PACKET RECEIVED STOP THIS TRANSMISSION, CLOSE
C  FILES AND REINITIALIZE.
C
	ICNTR = ICNTR + 1
	LTOT = LTOT + LEN  + 4
	IF(IBYE .EQ. 0) GO TO 110
	IF(IFLAG .EQ. 1) GO TO 150
	IBYE = 0
	CALL SEND(EODBYE,17)
	IBYE = 1
	GO TO 150
154	CONTINUE
C
C  INFORM USER THAT FILE 'FNAME' IS CORRPUPTED. THE RESULTING
C  FILE IS, HOWEVER, IN THE CORRECT FORMAT.
C
	IFLLEN = 27
	IF(IDNLEN .LT. 27) IFLLEN = IDNLEN
	DO 155 M=1,IFLLEN
	CORRUP(M+38) = FTEMP(M)
155	CONTINUE
	CALL SEND(CORRUP,IFLLEN+38)
1155	CALL SEND(EOD,1)
	IBYE = 1
C
C  ADD TO STATISTICS COUNTERS FOR THE CASE OF A
C  PREMATURE END TO TRANSMISSION.
C
	ICNTR = ICNTR + 1
C
C  TOTAL CHARACTERS = TOTAL CHARACTERS + EOD(1) + 4
C
	LTOT = LTOT + 5
C
C  END OF FILE ENCOUNTERED, END OF DOCUMENT LAST MESSAGE SENT.
C
150	CLOSE( UNIT=22 )
C
C
C	S T A T I S T I C S   F O R   W P S - 8   R E C E I V I N G
C
C
C
C  CALCULATE STATISTICS AND PREPARE TO OUTPUT THEM
C
D	CALL TIMER(ISEC2)
D	DELTA = ISEC2 - ISEC1
D	IACKC = ICNTR * 5
D	BAUD = ((LTOT + IACKC) / DELTA) * 10.
D	ABAUD = ((LTOT + IERRC + IACKC) / DELTA) * 10.
D	WRITE(23,901) ICNTR,LTOT,IACKC,IERRC,IERRCT,DELTA,BAUD,ABAUD
D901	FORMAT(' TOTAL PACKETS SENT:  ',I5,';',/
D	1      ' TOTAL CHARACTERS SENT:  ',I6,';',/
D	1      ' TOTAL ACK CHARACTERS RECEIVED:  ',I6,';',/
D	1      ' TOTAL ERROR CHAR (MESS. + NAKS):  ',I6,';',/
D	1      ' NUMBER OF ERROR RETRIES:  ',I4,';',/
D	2      ' ELAPSED TIME (SECONDS):  ',F8.0,';',/
D	3      ' EFFECTIVE BAUD RATE (TOTAL CHARS. + ACK CHAR.):  ',
D	3 F8.0,';',/
D	4      ' ACTUAL BAUD (COUNTING ERROR CHARS):  ',F8.0)
D	CLOSE (UNIT=23)
C
	MSGFLG = 0
	GO TO 4
C
C
C	E R R O R   S E C T I O N
C
C
C
C  ERROR -- FILE DOES NOT EXIST ON OUR SYSTEM.
C
C
C  PLACE ERROR MESSAGE 104 INTO BUFFER AREA INCLUDING THE
C  INCORRECT FILENAME.
C
190	IFLLEN = 42
	IF(IDNLEN .LT. 42)IFLLEN = IDNLEN
	DO 191 M=1,15
	BUF(M+IFLLEN+7) = M104A(M)
	IF(M .LE. 6) BUF(M+1) = M104(M)
191	CONTINUE
C
C  SET LEN = PACKET # + MSG LEN + FILENAME LEN
C  LEN = 1 + 21 + IFL = 22 + IFL
C  SET PACKET #
C
	LEN = 22 + IFLLEN
152	BUF(1) = "142
	DO 192 M=1,IFLLEN
	BUF(M+7) = FTEMP(M)
192	CONTINUE
C
C  CLEAR THE REST OF THE BUFFER AREA THEN
C  SEND ERROR MESSAGE, SUSPEND FOR 10 SECONDS, THEN SEND
C  PROMPT FOR HOST FILENAME AGAIN. (PROMPT #2)
C
	DO 193 M=LEN+1,80
	BUF(M) = 32
193	CONTINUE
	CALL SEND(BUF,LEN)
	IF(IBYE .EQ. 1) GO TO 4
C
19	CALL SEND(DXOPT,2)
	IBYE = 1
	GO TO 4
C
C  HERE IF TOPS20 FILE IS EMPTY. CLOSE AND TRY AGAIN.
C
151	IF(RECORD .NE. 1) GO TO 194
	IFLLEN = 48
	IF(IDNLEN .LT. 48)IFLLEN = IDNLEN
	DO 1616 M=1,9
	BUF(M+IFLLEN+7) = M103A(M)
	IF(M .LE. 6) BUF(M+1) = M103(M)
1616	CONTINUE
	LEN = 16 + IFLLEN
	CLOSE(UNIT=22)
	GO TO 152
C
C  SET UP MESSAGE 106, PAUSE FOR 10 SECONDS AND PROMPT FOR
C  THE FILENAME AGAIN.
C
194	IFLLEN = 51
	IF(IDNLEN .LT. 51)IFLLEN = IDNLEN
	DO 1617 M=1,13
	BUF(M+IFLLEN+7) = M106A(M)
	IF(M .LE. 6) BUF(M+1) = M106(M)
1617	CONTINUE
	LEN = 20 + IFLLEN
	CLOSE(UNIT=22)
	GO TO 152
C
C  TOPS20 FILE DOES NOT EXIST FOR WPS DOCUMENT NAME/NUMBER SENT
C
9	IFLLEN = 17
	IF(IDNLEN .LT. 17)IFLLEN = IDNLEN
	DO 1620 M=1,IFLLEN
	M108(M+47) = FTEMP(M)
1620	CONTINUE
	LEN = 47 + IFLLEN
	DO 1618 M=LEN+1,64
	M108(M) = 32
1618	CONTINUE
	CALL SEND(M108,LEN)
	GO TO 19
C
C  DOCUMENT NAME IS NOT UNIQUE
C
10	IFLLEN = 30
	IF(IDNLEN .LT. 30) IFLLEN = IDNLEN
	DO 1621 M=1,IFLLEN
	M107(M+34) = FTEMP(M)
1621	CONTINUE
	LEN = 34 + IFLLEN
	DO 1619 M=LEN+1,64
	M107(M) = 32
1619	CONTINUE
	CALL SEND(M107,LEN)
	GO TO 19
C
C
C	H E R E   F O R   W P S - 8   T O   S E N D
C
C
C
200	GO TO (201,290,9,10,201),IEXIST
201	OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='SEQIN',
	1 MODE='ASCII',DISPOSE='SAVE',ERR=290)
C
C  IF OPEN IS SUCCESSFUL CLOSE AND OPEN AGAIN AS A RANDOM
C  ACCESS FILE.
C
	CLOSE(UNIT=22)
	OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
	1    MODE='ASCII',RECORD SIZE=67,ASSOCIATE VARIABLE=RECORD,
	2    ERR=194)
C
C  SEND THE USER A FILE OPTIONS PACKET TO DETERMINE HOW THE DOCUMENT
C  SHOULD BE MODIFIED.
C
350	CALL SEND(RECOPT,2)
	IF(IBYE .EQ. 1) GO TO 9910
	CALL RECV(1,BUF,LEN)
	IF(IBYE .EQ. 1) GO TO 7
C
C  RESPONSE MUST BE AN ANSWER TO PROMPT ("172) PACKET, IF IT
C  ISN'T SEND THE OPTIONS AGAIN. THE POSSIBLE RESPONSES WITHIN
C  THIS PACKET ARE:
C		"040 - GOLD MENU
C		"041 - 'O'VERWRITE (USER TYPED 'O')
C		"042 - ADD TO 'T'OP (USER TYPED 'T')
C		"043 - ADD TO 'B'OTTOM (USER TYPED 'A')
C  IF IT IS NONE OF THE ABOVE THEN PROMPT AGAIN.
C
	IF(BUF(1) .NE. "172) GO TO 350
	IF(BUF(2) .NE. "040) GO TO 279
	CLOSE(UNIT=22)
	GO TO 7
C
C  CHECK FOR AN O, A T OR AN A.  IF IT IS NONE OF THESE, SEND
C  THE FILE OPTIONS PACKET AGAIN.
C
279	IF(LEN .EQ. 0) GO TO 350
C
C  OVERWRITE?
C
	IF(BUF(2) .NE. "041) GO TO 280
	IT = 1
	GO TO 291
C
C  ADD TO TOP?
C
280	IF(BUF(2) .NE. "042) GO TO 281
	IT = 2
	GO TO 291
C
C  ADD TO BOTTOM?
C
281	IF(BUF(2) .NE. "043) GO TO 350
	IT = 3
	GO TO 291
C
C
C	W P S - 8   S E N D I N G   N E W   F I L E
C
C
290	OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
	1 MODE='ASCII',RECORD SIZE=67,ERR=290,ASSOCIATE VARIABLE=RECORD)
	IT = 4
C
C  IF NEW FILE CONTINUE.
C  IF OVERWRITING, OPEN A NEW VERSION AND CONTINUE.
C  IF ADDING TO TOP OPEN A TEMPORARY FILE.
C  IF ADDING TO BOTTOM, OPEN FILE AS NEW.
C  IN THE CASE OF ADDING TO TOP/BOTTOM CHECK THE HEADER
C  BLOCK FOR CORRECT WPS FORMAT.
C
291	GO TO (3091,3092,3093,2090),IT
C
C  CLOSE FILE AND REOPEN AS 'NEW' TO PRODUCE A NEW VERSION
C  FOR THE OVERWRITE OPTION.
C
C
C
C	W P S - 8   S E N D I N G   O L D   F I L E
C
C
C
C  --- OVERWRITE ---
C
3091	CLOSE(UNIT=22)
	OPEN(UNIT=22,DEVICE='DSK:',ASSOCIATE VARIABLE=RECORD,
	1 ACCESS='RANDOM',MODE='ASCII',RECORD SIZE=67)
	GO TO 2090
C
C  --- ADDING TO TOP ---
C
3092	READ(22'1,9002,END=1151,ERR=1194)LENIN,(HDRTMP(II),II=1,65)
	READ(22'2,9002,END=1151,ERR=1194)LENIN2,(HDRTMP(II),II=66,130)
	CALL DEC(HDRTMP,NUMREC)
D	WRITE(23,9005)NUMREC
D9005	FORMAT(' NUMBER OF INPUT RECORDS FOR TOP = ',I8)
C
C  CHECK FOR VALIDITY OF 'HEADER', IF NOT OK TELL USER
C  THAT FILE IS CORRUPTED.
C
	IF(HDRTMP(1) .NE. "133 .OR. HDRTMP(2) .NE. "40)GO TO 1194
	OPEN(UNIT=24,DEVICE='DSK:',ASSOCIATE VARIABLE=OUTPUT,
	1 ACCESS='RANDOM',RECORD SIZE=67,MODE='ASCII')
	GO TO 2090
C
C  MAKE SURE TOPS20 FILE IS NOT EMPTY OR CORRUPTED, IF IT IS
C  INFORM THE WPS USER OF THE SITUATION.
C
C
C  --- ADDING TO BOTTOM ---
C
3093	READ(22'1,9002,END=151,ERR=194)LENIN,(HDRTMP(II),II=1,65)
	READ(22'2,9002,END=151,ERR=194)LENIN2,(HDRTMP(II),II=66,130)
	IF(HDRTMP(1) .NE. "133 .OR. HDRTMP(2) .NE. "40) GO TO 194
	CALL DEC(HDRTMP,NUMREC)
D	WRITE(23,9007)NUMREC
D9007	FORMAT(' NUMBER OF INPUT RECORDS FOR BOTTOM = ',I8)
	CLOSE(UNIT=22)
	OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
	9 MODE='ASCII',ASSOCIATE VARIABLE=RECORD,RECORD SIZE=67)
C
C  SEND MESSAGE TO WPS TO START SENDING ITS DOCUMENT, THEN
C  CHECK TO SEE IF WE RECEIVED A 'START-OF-DOCUMENT', IF SO
C  SEND THE "OK-TO-SEND" PACKET TO WPS.
C
2090	CALL SEND(OKSND,1)
	IF(IBYE .EQ. 1) GO TO 9912
	CALL RECV(1,BUF,LEN)
	MSGFLG = 0
	IF( IBYE .EQ. 1 ) GO TO 9912
	IF( BUF(1) .EQ. "144) GO TO 949
C
C  DID NOT GET EXPECTED PACKET FROM WPS, SEND
C 'BYE - 202' AND REINITIALIZE.
C
	CALL BYE(2)
	CLOSE(UNIT=22)
	IF(IT .EQ. 2) CLOSE(UNIT=24,DISPOSE='DELETE')
D	CLOSE(UNIT=23)
	GO TO 7
C
C
C	B U I L D   5 1 2   B Y T E   H E A D E R   B L O C K
C
C
C
C  SET UP HEADER BLOCK INFORMATION FOR THE TOPS20 FILE
C  EXTRACT FILE SIZE FROM THE 'START-OF-DOCUMENT'
C  PACKET. ALSO CONVERT TODAY'S DATE AND PLACE IT IN
C  THE HEADER BLOCK. EXTRACT PRINTER SETTINGS FROM
C  PACKET WORDS 4 THRU LEN AND PLACE THEM IN THE HEADER
C  BLOCK WORDS 39 THRU 39+LEN.
C
949	HEADER(11) = BUF(2)
	HEADER(12) = BUF(3)
	NUL1 = "137
	NUL2 = "137
	IRECS = INTSIX(NUL1,BUF(2)) * 64 + INTSIX(NUL2,BUF(3))
C
C  INSERT TODAY'S DATE AS THE LAST DATE EDITED INTO
C  HEADER(17-20)
C
	CALL HDRCVT(IDYMN,HEADER(17),HEADER(18))
	CALL HDRCVT(IYR,HEADER(19),HEADER(20))
C
C  INSERT THE VERSION NUMBER - HEADER(21-22)
C
	CALL HDRCVT(IVERNO,HEADER(21),HEADER(22))
C
C  INSERT CURRENT TIME AS THE TIME LAST EDITED - HEADER(25-26)
C
	CALL TIME(ITIME)
	DECODE(5,13,ITIME)IHR,IMIN
13	FORMAT(I2,1X,I2)
	IHRMN = ((IHR .AND. "77) * "100) + (IMIN .AND. "77)
	CALL HDRCVT(IHRMN,HEADER(25),HEADER(26))
C
C  IF THIS IS A NEW FILE THEN FILL IN TODAY'S DATE WITH THE
C  CURRENT DATE - HEADER(13-16)
C
	IF(IT .NE. 1) GO TO 948
	CALL HDRCVT(DAY,HEADER(13),HEADER(14))
	CALL HDRCVT(YEAR,HEADER(15),HEADER(16))
C
C  WE ARE ONLY CONCERNED WITH THE FIRST 78 CHARACTERS OF THE
C  HEADER BLOCK
C
948	DO 950 I=4,43
	HEADER(I+35) = BUF(I)
950	CONTINUE
C
C  HEADER(79-80)WILL BE USED TO INDICATE WHETHER OR NOT THIS FILE
C  WAS AT ANY POINT CONVERTED BY 'WP8FLX'.
C
	HEADER(79) = HDRTMP(79)
	HEADER(80) = HDRTMP(80)
C
C  IF ADDING TO TOP OF FILE (IT = 2), CONTINUE AT 960
C
	IF(IT .EQ. 2) GO TO 960
C
C  IF ADDING TO BOTTOM OF FILE, NEEDED INFORMATION REMAINS
C  IN 'HEADER' AND PROCESSING CONTINUES.
C
	IF(IT .EQ. 3) GO TO 940
C
C  IF OVERWRITING AN EXISTING FILE OR CREATING A NEW FILE
C  SIMPLY WRITE THE HEADER BLOCK WHICH WAS JUST CREATED AND
C  CONTINUE.
C
	WRITE(22'1,9002)LENHDR,(HEADER(II),II=1,65)
	WRITE(22'2,9002)LENHDR,(HEADER(II),II=66,130)
	GO TO 940
C
C  IF ADDING TO THE TOP OF AN EXISTING FILE, READ THE HEADER
C  BLOCK, ADD THE BLOCK SIZES INTO THE NEW HEADER AREA ('HEADER')
C  AND WRITE 'HEADER' TO THE OUTPUT FILE. IF THE FILE IS
C  EMPTY OR CORRUPTED INFORM THE WPS USER.
C
960	I1112 = INTSIX(HDRTMP(11),HDRTMP(12))
	IJ = I1112 + INTSIX(HEADER(11),HEADER(12))
	CALL HDRCVT(IJ,HEADER(11),HEADER(12))
	WRITE(24'1,9002)LENHDR,(HEADER(II),II=1,65)
	WRITE(24'2,9002)LENHDR,(HEADER(II),II=66,130)
	GO TO 940
C
C  FILE IS EMPTY
C
1151	CLOSE(UNIT=24,DISPOSE='DELETE')
	GO TO 151
C
C  FILE IS CORRUPTED
C
1194	CLOSE(UNIT=24,DISPOSE='DELETE')
	GO TO 194
C
C  EDIT #001
C
940	MSGFLG = 1
C
C  WE ARE NOW READY TO RECEIVE THE 'TEXT-OF-DOCUMENT' PACKETS,
C  THEREFORE WE MUST SEND AN 'OK-TO-SEND' PACKET.
C
	BUF(1) = "140
	CALL SEND(BUF, 1)
	IF(IBYE .EQ. 1) GO TO 7001
C
C  OK, NOW RECEIVE THE FILE.
C
C
C
C	W P S - 8   S T A R T S   S E N D I N G
C
C
D	CALL TIMER(ISEC1)
	RECORD = 3
	OUTPUT = 3
	IF(IT .EQ. 3)RECORD = NUMREC + 1
210	CALL RECV(1,BUF,LEN)
C
C  IF BYE PACKET RECEIVED, CLOSE ALL OPEN FILES,
C  AFTER WRITING AN 'END-OF-DOCUMENT' AND GO
C  BACK TO REINITIALIZE.
C
	IF(IBYE .EQ. 0) GO TO 9988
7001	LEN = 1
	IBYE = 0
	CALL SEND(EODBYE,17)
	IBYE = 1
	BUF(1) = "146
C
C  CONTINUE NORMALLY SO AS TO CLEAN UP ANY END OF DOCUMENT
C  CONDITIONS.
C
9988	CONTINUE
C
C  IF PACKET RECEIVED FROM WPS IS NOT ONE THAT WE EXPECT
C  AT THIS POINT, THEN WRITE OUT AN 'END-OF-DOCUMENT'
C  RECORD, SEND A 'BYE' PACKET AND CLOSE OUT FILES, THEN
C  REINITIALIZE.
C
991	IF(BUF(1) .EQ. "145 .OR. BUF(1) .EQ. "146) GO TO 993
	LEN = 1
	BUF(1) = "146
	IF(IT .NE. 2) WRITE(22'RECORD,9002)LEN,(BUF(II),II=1,65)
	IF(IT .EQ. 2) WRITE(24'OUTPUT,9002)LEN,(BUF(II),II=1,65)
	DO 992 M=2,17
	BUF(M) = E