PROGRAM ICL
C         THIS PROGRAM IS DESIGNED TO ACCEPT INPUT FROM AN ICL 1501
C         INTELLIGENT DATA ENTRY TERMINAL, AND WRITE IT OUT TO A FILE.
C
C         THIS PROGRAM USES THE EXECUTIVE QIO DIRECTIVE "CALL WTQIO"
C         TO ALLOW IT TO 1)TRANSMIT AN XON (CTRL/Q) AS A PROMPT IMMEDIATELY
C         BEFORE DATA IS TO BE ACCEPTED;  2)TRANSMIT AN XOF (CTRL/S)
C         IMMEDIATELY AFTER A LINE OF DATA HAS BEEN RECIEVED;  3)ACCEPT
C         THE DATA WITHOUT ECHOING IT BACK TO THE ICL 1501.  THE PURPOSE OF 
C         THE XOF IS TO TELL THE ICL 1501 TO STALL UNTIL THIS PROGRAM IS
C         READY TO ACCEPT THE NEXT LINE OF INPUT.  THE XON IS THE SIGNAL
C         FOR READY TO RECIEVE.
C         FOR MORE INFORMATION ON QIO'S SEE
C                           RSX11M EXECUTIVE REFERENCE MANUAL
C                           RSX11M I.O. DRIVERS REFERENCE MANUAL
C
C
C         OTHER EXECUTIVE DIRECTIVES USED:
C                      CALL GETADR
C                      CALL DISCKP
C                      CALL GETMCR
C                           FOR INFORMATION ON THESE SEE
C                           RSX11M EXECUTIVE REFERENCE MANUAL
C
C          FORTRAN LIBRARY SUBROUTINES USED:
C                      CALL ASSIGN
C                      CALL FDBSET
C                           FOR INFORMATION ON THESE SEE
C                           IAS/RSX FORTRAN IV USERS GUIDE
C
C
C         NOTE:  WHEN THIS JOB IS TASKBUILT, USE THE FOLLOWING TASKBUILD
C         OPTIONS:
C                 ACTFIL=2
C                 UNITS=3
C                 PRI=150
C                 TASK=...ICL
C
C
C         WRITTEN BY JIM ROGERS      TAHOE N.F.      NOV 79
C
C
      LOGICAL*1 XON                     !PROMPT CHARACTOR
      LOGICAL*1 IOST(4)                 !IO STATUS BLOCK
      LOGICAL*1 BUF(90)                 !IO BUFFER
      DIMENSION IPRM(6)                 !PARAMETER LIST
      DATA IORPR/"4520/                 !IO FUNCTION CODE--IO.RPR!TF.XOF!TF.RNE
      DATA XON/"21/                     !PROMPT CHARACTOR (21OCTAL=XON=CTRL/Q)
      DATA IPRM(2)/90/                  !LENGTH OF IO BUFFER
      DATA IPRM(5)/1/                   !LENGTH OF PROMPT
      DATA IPRM(6)/"44/                 !VERTICAL FORMAT CONTROL CHARACTOR
C     GET STARTING ADDRESS OF IO BUFFER, PROMPT STRING
      CALL GETADR (IPRM,BUF(1),,,XON)
      CALL DISCKP                       !DISABLE CHECKPOINTING
      CALL ASSIGN (2,'TT12:',5)          !ASSIGN TT2 AS INPUT DEVICE--UNIT 2
      CALL ASSIGN (3,'TI:',3)           !ASSIGN REQUESTING TERMINAL IO CHANNEL 3
      IRC = 0                           !ZERO RECORD COUNT
C
C         DECODE COMMAND STRING; OPEN OUTPUT FILE
C
      CALL GETMCR (BUF)                 !GET MCR COMMAND LINE THAT STARTED TASK
      IF (BUF(4).NE.' ') GO TO 500      !IF THE FOURTH CHARACTER ISN'T A SPACE
      I1 = 5                            !INITIALIZE POSITION COUNTER
C
   10 IF (BUF(I1).EQ.13) GO TO 20       !IF CURRENT CHARACTOR = CARRAGE RETURN
      IF(BUF(I1).EQ.'/') GO TO 30       !IF CURRENT CHARACTOR = "/"
      BUF(I1-4) = BUF(I1)               !MOVE CHARACTOR TO LEFT IN BUFFER
      I1 = I1 + 1                       !INCREMENT POSITION COUNTER
      GO TO 10
C
   20 BUF(I1-4) = 0                     !PLACE MARKER IN BUFFER
      CALL FDBSET (1,'NEW')             !SPECIFY NEW FILE TO BE OPENED CH. 1
      CALL ASSIGN (1,BUF)               !OPEN FILE CHANNEL 1 (NAME IS IN BUF)
      GO TO 100
C
   30 IF (BUF(I1+1).NE.'A') GO TO 500   !IF 1ST CHARACTOR AFTER "/" IS NOT "A"
      IF (BUF(I1+2).NE.'P') GO TO 500   !IF 2ND CHARACTOR AFTER "/" IS NOT "P"
      IF (BUF(I1+3).NE.13) GO TO 500    !IF 3RD CHARACTOR AFTER "/" IS NOT C.R.
      BUF(I1-4)=0                       !PLACE MARKER IN BUFFER
      CALL FDBSET (1,'APPEND')          !SPECIFY APPEND TO OLD FILE CHANNEL 1
      CALL ASSIGN (1,BUF)               !OPEN FILE CHANNEL 1 (NAME IS IN BUF)
C
C         INPUT/OUTPUT SECTION
C
  100 CALL WTQIO (IORPR,2,5,,IOST,IPRM,IDS)
      IRC = IRC + 1                     !INCREMENT RECORD COUNT
      IF (IOST(1).EQ."177766) GO TO 250 !IF END OF FILE ON INPUT DEVICE (CH. 2)
      IF (IOST(1).LT.0) GO TO 200       !IF ERROR ON READ ATTEMPT
      WRITE (1) (BUF(I),I=1,80)         !WRITE BUFFER TO OUTPUT FILE (CH. 1)
	WRITE (3,13) (BUF(INI),INI=1,78)
13	FORMAT(' ',78A1)
      GO TO 100
C
C           WRITE IO ERROR MESSAGE ON REQUESTING TERMINAL
C
  200 WRITE (3,201) IOST(1),IOST(2),IRC
  201 FORMAT (' ERROR IN QIO--IO STATUS = ',O6,O3,'  RECORD #',I4)
      GO TO 100
C
C           CLOSE OUTPUT FILE AND EXIT
C
  250 CALL CLOSE (1)
      GO TO 1000
C
C           WRITE ERROR MESSAGE AND EXIT
C
  500 WRITE (3,501)
  501 FORMAT (' WHAT?')
C
C           EXIT
C
 1000 CALL EXIT
	END