FTN4
      SUBROUTINE IOM70, 92903-16560 REV.1913  790201
C 
C 
C  SOURCE FILE:  &IOM70   P/N 92903-18560 
C  RELOC. FILE:  %IOM70   P/N 92903-16560 
C 
C 
C  PMGR:  STEVE WITTEN, 
C         DATA SYSTEMS DIVISION,
C         CUPERTINO, CALIFORNIA 
C 
C 
C  ************************************************************** 
C  *                                                            * 
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    * 
C  * RESERVED.  NO PART OF THIS PROGRAM MY BE PHOTOCOPIED, RE-  * 
C  * PRODUCED, OR TRANSLATED INTO ANOTHER PROGRAM LANGUAGE WITH-* 
C  * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY   * 
C  *                                                            * 
C  ************************************************************** 
C 
C  THIS PROGRAM IS PART OF THE: 
C 
C                  DATA CAPTURE SOFTWARE
C                    ( D A T A C A P) 
C 
C  IT USES FEATURES OF THE TERMINAL MONITOR SOFTWARE (TMS). 
C 
C  THIS MODULE, %IOM70 IS A T.U.S. OF THE TMP (TERMINAL MONITOR PROGRAM). 
C     IT IS THE INTERFACE BETWEEN TMP AND THE SERIAL LINK DRIVER (DVA47). 
C 
C 
C*********************************************STEVE WITTEN (DSD)********
C 
C 
C  TRUE COMMON
C 
      COMMON ICOM00(5)
C 
C  THIS COMMON BLOCK IS USED BY TMS ONLY.  IT IS NOT USED IN
C    THIS MODULE -- N.B. FOR FUTURE DEBUGGING -- ICOM00(1) CON
C    TAINS THE LU# OF THE TERMINAL THAT SCHEDULED TMP.
C 
C 
C 
C*********************
C                    *
C  COMMON BLOCK # 1  *
C                    *
C*********************
C 
      COMMON LLU(24),IFC,IORTAD,ITRST,ITSNUM(2),ITIM(6),LITE1,LITE2 
     *        ,OUTDEV,INPDEV,ITSNAM(5),OTBFLN,OTBUFR(40)
C 
C  LLU --> ARRAY OF 24 WORDS NEEDED BY TMP.  THIS ROUTINE ONLY NEEDS
C          WORDS 1, 4, AND 5 WHICH ARE "EQUIVALENCED" LATER.
C 
C  IFC --> THE FUNCTION CODE FOR DISPATCHING TO THE APPROPRIATE SECTION 
C          OF THIS CODE.
C 
C  IORTAD --> STORAGE FOR RETURN ADDRESSES WITHIN THE I/O MODULE SO 
C                  CODE SECTIONS CAN BE REUSED. 
C 
C  ITRST --> VALUABLE INFORMATION TO BE SAVED FROM TERMINAL HARDWARE
C                  STATUS.
C 
C  ITSNUM --> WORD#1 IS TRANS.SPEC. NUMBER--
C             WORD#2 IS TRANSACTION STEP. 
C 
C  ITIM --> SIX-WORD BUFFER TO HOLD SYSTEM TIME IN FORMAT DESCRIBED 
C                   IN RTE-IV PROGRAMMER'S REFERENCE MANUAL.
C 
C  LITE1 --> THE HI AND LO BYTES CONTAIN THE LOGICAL NUMBERS OF PROMPTING 
C            LIGHTS TO BE LIT.
C 
C  LITE2 --> THE HI AND LO BYTES CONTAIN THE LOGICAL NUMBERS OF PROMPTING 
C            LIGHTS TO BE LIT.
C 
C  OUTDEV --> OUTPUT DEVICE WORD.  DESCRIBES THE DEVICE TO WHICH OUTPUT 
C             FROM TMP WILL BE ROUTED. BITS 15, 1, AND 0 ARE THE POWER
C             FAIL, PRINTER, AND DISPLAY BITS, RESPECTIVELY.
C 
C  INPDEV --> INPUT DEVICE WORD.  DESCRIBES THE DEVICE FROM WHICH THIS
C             ROUTINE WILL GET INPUT TO PASS TO TMP.  LO BYTE CONTAINS
C             DEVICE DESCRIPTION.  HI BYTE CONTAINS INPUT DESCRIPTION.
C 
C  ITSNAM --> ARRAY OF 5 WORDS TO HOLD THE TRANS.SPEC.# AND SEC.CODE WHEN 
C             THE USER FIRST ADDRESSES A 307X TERMINAL UNDER DATACAP/1000 
C             CONTROL. ITSNAM(4) WILL HOLD TS# AND ITSNAM(5) HOLDS SC.
C             ITSNAM(1,2,3,4) HAVE DIFFERENT MEANINGS IN OTHER PARTS OF THE 
C             CODE AND WILL BE "EQUIVALENCED" LATER.
C 
C  OTBFLN --> LENGTH IN BYTES OF THE BUFFER OF INFORMATION TO BE WRITTEN
C             FROM TMP TO THE 307X TERMINAL.
C 
C  OTBUFR --> BUFFER OF INFORMATION TO BE WRITTEN FROM TMP TO 307X TERMINAL.
C 
C 
C******************** 
C                   * 
C  COMMON BLOCK # 3 * 
C                   * 
C******************** 
C 
C 
      COMMON IFIL1(85 ),INBFLN,INBUFR(100)
C 
C 
C  IFIL1 --> ARRAY OF 85 WORDS NEEDED BY TMP.  THIS ROUTINE NEEDS NONE OF 
C            THESE WORDS. 
C 
C  INBFLN --> MAX.LENGTH IN BYTES OF INFORMATION TO BE READ FROM TERMINAL 
C             AND PASSED TO TMP.  TMP GETS THIS FROM TRANS.SPEC.
C 
C  INBUFR --> BUFFER OF INFORMATION GOTTEN FROM THE 307X TERMINAL.
C 
C******************** 
C                   * 
C  LAST COMMON WORD * 
C                   * 
C******************** 
C 
C 
      COMMON ICOMEN 
C 
C 
C  THIS WORD NOT NEEDED IN THIS ROUTINE BUT IS NEEDED TO PRESERVE 
C  THE TMS ENVIRONMENT. 
C 
C 
      EQUIVALENCE (LLU(1),LU),(LLU(4),IST),(LLU(5),ITL) 
C 
C  TERMINAL LOGICAL UNIT #, 
C  I/O COMPLETION STATUS, AND 
C  I/O TRANSMISSION LOG, RESPECTIVELY.
C 
C 
      EQUIVALENCE (ISTATS,ITSNAM(1)),(ITRNLG,ITSNAM(2)),
     *            (ISFK2,ITSNAM(4)),(ISFK1,ITSNAM(3)),
     *            (LUOXX,ICOM00(1)),(SQUAL,IFIL1(2))
C 
C 
C  I/O MODULE STATUS (MAINTAINED BY THIS ROUTINE),
C  I/O TRANSMISSION LOG (MAINTAINED BY THIS ROUTINE), 
C  SFK-AS-INPUT-TERMINATOR WORDS (USED BY PARTS OF THIS ROUTINE 
C       TO ENABLE/DISABLE SFK'S AS INPUT TERMINATORS -- BIT POSITION
C       AND CONDITION <<SET OR CLEAR>> INDICATE ENABLE/DISABLE KEY
C       AS INPUT TERMINATOR.), (FOR DEBUGGING)--THE LU OF THE TERMINAL
C       WHERE THE TMP WAS GENERATED WITH TMPGN, AND THE STATE QUALIFIER 
C       FROM TMP SO I/O MODULE CAN DETERMINE WHICH STATE (FOR OFF-LINE
C       PRINT-OUT, MAINLY). 
C 
C 
C  DECLARE INTEGER VARIABLES
C 
      INTEGER OUTDEV,OTBFLN,OTBUFR,ERRFL,EDITPT,SQUAL 
C 
C  DECLARE LOGICAL FUNCTIONS
C 
      LOGICAL ISBIT,INUM,ISBTW
C 
C  LOCAL STORAGE
C 
      DIMENSION ITEMP(10),ITMP2(10),MSGBFR(50)
C 
C  GET TERMINAL STATUS BYTES -- SAVE FOR LATER USE
C 
C 
C  DEFINE LOCAL FUNCTIONS 
C 
C  DEFINE LOCAL DATA
C 
      DATA LITSSC/13/ 
C 
C 
C  BEGIN OF PROGRAM 
C 
C 
C  DISPATCH ON FUNCTION CODE
C 
C 
C  DEFINE COMMON BLOCKS 
C 
      CALL TMDFN(LLU,LLU,IFIL1,IFIL1,ICOMEN)
      GO TO (111,222,333,444,555),IFC 
C 
C  SET TERM IN TRANSPARENT MODE 
C 
111   CALL TMBCT(13B) 
C 
C  SET OUTPUT DEVICE TO DISPLAY 
C 
      OUTDEV=1
C 
C  CLEAR TERMINAL 
C 
      ASSIGN 1060 TO IORTAD 
100   CALL TMBCT(0B)
C 
C  CLEAR DESTINATION BUFFER 
C 
      DO 199 LL=1,5 
199   ITSNAM(LL)=0
C 
C  RESET SRQ STATUS 
C 
      CALL TMCTL(11B) 
      ITRST=IST 
C 
C  REFORMAT ITRST INTO A 3075/6/7-LIKE STATUS WORD. 
C 
C    ITRST HAS THE FOLLOWING FORMAT:
C 
C       UPPER BYTE: 
C 
C         BITS 0-2 -->PRODUCT NUMBER (0=3070A,1=3070B)
C         BITS 3-7 -->  *UNUSED AT THIS TIME* 
C 
C       LOWER BYTE: 
C 
C         BIT 0 -->  *UNUSED AT THIS TIME*
C 
C         BIT 1 --> 1 IF DISPLAY IS PRESENT 
C                   0 IF DISPLAY IS NOT PRESENT 
C          (THIS BIT IS ALWAYS SET) 
C 
C         BIT 2 --> 1 IF KEYBOARD IS PRESENT
C                   0 NO KEYBOARD IS PRESENT
C          (THIS BIT IS ALWAYS SET) 
C 
C         BIT 3 --> 1 IF STRIP PRINTER IS PRESENT 
C                   0 IF NO STRIP PRINTER 
C 
C         BIT 4 --> 1 IF TYPE III/MULTI. READER PRESENT 
C                   0 IF NO TYPE III PRESENT
C 
C         BITS 5,6,7 --> USED BUT MUST ALWAYS BE CLEAR
C 
C 
C 
      ITMP=0B 
      IF(ISBIT(ITRST,0))ITMP=400B 
      CALL SETBT(ITMP,1,1)
      CALL SETBT(ITMP,2,1)
      IF(ISBIT(ITRST,1))CALL SETBT(ITMP,4,1)
      IF(ISBIT(ITRST,2))CALL SETBT(ITMP,3,1)
      ITRST=ITMP
C 
C  ENABLE ALL SFK'S AS INPUT TERMINATORS
C 
      DO 110 I=1,11 
110   CALL TMBCT(12B,I) 
C 
C  SET TERMINAL TO NO TIME-OUT
C 
      CALL TMBCT(22B,0) 
      GO TO IORTAD
1060  ASSIGN 1070 TO IORTAD 
1065  MBLN=0
      LITE2=LITSSC
      GO TO 1120
1070  OTBFLN=0
      CALL TMBWR(2H_=,1,21B)
      CALL TMWR(MSGBFR,-MBLN,0B)
      CALL TMBWR(2H>],1,21B)
C 
C  READ TS# [-SC] FROM TERMINAL 
C 
150   CALL TMRD(ITEMP,-20,0B) 
C 
C  GET TS# FROM READ STATUS -- USER PUSHES SFK FOR TS#
C 
      LIGNUM=IAND(IST,17B)-1
C 
C  CHECK FOR SRQ
C 
      IF(ISBIT(IST,7))GO TO 100 
C 
C  USER INPUTS GARBAGE -- GENERATE ERR
C 
      IF(LIGNUM.GT.0.AND.ITL.NE.0)GO TO 200 
C 
C  A GOOD TS# HAS BEEN OBTAINED 
C 
      IF(LIGNUM.GT.0)GO TO 300
C 
C  USER PUSHES ENTER KEY ONLY 
C 
      IF(ITL.EQ.0)GO TO 200 
C 
C  SCAN FOR A -      IF PRESENT THEN USER INPUTS TS#-SC 
C 
      DO 170 ITT=1,ITL
      IF(IGET1(ITEMP,ITT).EQ.1H-)GO TO 175
170   CONTINUE
175   CONTINUE
C 
C  CONVERT TS# TO NUMERIC 
C 
      IF(INUM(ITEMP,1,ITT-1,LIGNUM   ))GO TO 200
C 
C  IS TS# BETWEEN 0 AND 9999?? IF NOT GENERATE ERROR. 
C 
      IF(ISBTW(LIGNUM,0,9999))GO TO 200 
C 
C  CHECK TO SEE IF HAVE TO CONVERT SC TO NUMERIC ALSO 
C 
      IF(ITT-1.GE.ITL)GO TO 300 
C 
C  CONVERT SC TO NUMERIC
C 
190   IF(INUM(ITEMP,ITT+1,ITL-ITT,I))GO TO 200
      IF(FLOAT(I).LT.-32767..OR.FLOAT(I).GT.32767.)GO TO 200
      ITSNAM(5)=I 
C 
C  DONE 
C 
300   ITSNAM(1)=100000B 
      ITSNAM(4)=LIGNUM
      RETURN
C 
C  ERROR SECTION
C 
200   LITE1=128 
      GO TO 1060
1120  CONTINUE
      IF(.NOT.ISBIT(OUTDEV,0))GO TO 1127
      CALL PUTCA(MSGBFR,177B*256,MBLN+1)
      MBLN=MBLN+1 
1127  CALL MOVCA(OTBUFR,1,MSGBFR,MBLN+1,OTBFLN) 
      MBLN=MBLN+OTBFLN
C 
C  GET TERMINAL TYPE
C 
      ITYP=3070 
      IF(ISBIT(ITRST,8))ITYP=3071 
C 
C  GENERATE LITE STRING 
C 
      IF(ISBIT(OUTDEV,0))CALL LIT70(LITE1,LITE2,ITYP,MSGBFR,MBLN) 
      GO TO IORTAD
C*********************************************************************
C 
C 
C  FUNCTION CODE #2 -- READ SECURITY CODE WITHOUT DISPLAY ECHO
C 
C  GO UPDATE OR REFRESH DISPLAY IF NEEDED 
C 
222   ASSIGN 2225 TO IORTAD 
      LITE2=LITSSC
      GO TO 1120
C 
C  RETURN FROM DISPLAY ROUTINE IS HERE
C 
2225  CALL TMBWR(2H_=,1,21B)
      CALL TMWR(MSGBFR,-MBLN) 
C 
C  SET TERMINAL TO NO TIME OUT
C 
      CALL TMBCT(22B,0) 
C 
C  RESET SRQ STATUS 
C 
      CALL TMBCT(11B) 
C 
C  ENABLE SRQ IS INPUT TERMINATOR 
C 
      CALL TMBCT(12B,1) 
C 
C  LISTEN MOD-COM, UNLISTEN DISPLAY 
C 
      CALL TMBWR(4H_>] ,-3,21B) 
C 
C  GET THE SECURITY CODE
C 
      CALL TMRD(ITEMP,-20,0B) 
C 
C  CHECK FOR SRQ--IF SRQ, THEN DO FC#1 AGAIN
C 
      IF(ISBIT(IST,7))GO TO 2240
      GO TO 2241
2240  IFC=1 
      OTBFLN=0
      LITE1=0 
      GO TO 111 
2241  CONTINUE
C 
C  CONVERT SECURITY CODE TO DECIMAL -- IF CONVERSION ERR, DO FUNCTION AGAIN 
C 
      IF(INUM(ITEMP,1,ITL,I))GO TO 1065 
      IF(FLOAT(I).LT.-32767..OR.FLOAT(I).GT.32767.)GO TO 1065 
      ITSNAM(5)=I 
C 
C  ANOTHER EASY ONE!!!
C 
      RETURN
C*********************************************************************
C 
C  FUNCTION CODE #3 -- TERMINAL FEATURE CHECK 
C 
C 
333   ICHEK=INBUFR(1) 
      ISTATS=0
      DO 335 I=3,7
335   IF(ISBIT(ICHEK,I).AND.(.NOT.ISBIT(ITRST,I)))ISTATS=1
      RETURN
C 
C***********************************************************************
C 
C  FUNCTION CODE 4 -- ENABLE/DISABLE SFK'S AS REQUIRED BY TGP DESCIPTION
C 
C 
444   ASSIGN 446 TO IORTAD
C 
C  RESET TERMINAL 
C 
4450  CALL TMBCT(0B)
C 
C  SET TO NO TIME-OUT 
C 
      CALL TMBCT(22B,0) 
C 
C  RESET SRQ STATUS 
C 
      CALL TMCTL(11B) 
C 
C  RE-ENABLE SRQ
C 
      CALL TMBCT(12B,1) 
C 
C  ENABLE OR DISABLE SFK'S AS INPUT TERMINATOR AS 
C     DESCRIBED BY THE BIT PATTERN IN ISFK1 
C 
      DO 445 I=2,11 
      IF(.NOT.(ISBIT(ISFK1,I-2)))GO TO 445
      CALL TMBCT(12B,I) 
445   CONTINUE
      GO TO IORTAD
446   RETURN
C********************************************************************** 
C 
C  FUNCTION CODE # 5 -- WRITE, READ, AND WRITE/READ 
C 
555   ASSIGN 5551 TO IORTAD 
C 
C  CHECK POWERFAIL BIT
C 
      IF(ISBIT(OUTDEV,15))GO TO 4450
5551  CALL SETBT(OUTDEV,15,0) 
      CALL TMBCT(12B,1) 
C 
C  CHECK TO SEE THAT AT LEAST ONE BUFFER LENGTH IS POSITIVE 
C     IF NOT, THEN ERROR!!! 
C 
      IF(OTBFLN.GT.0.OR.LITE1.NE.0.OR.LITE2.NE.0)GO TO 590
      IF(INBFLN.GT.0)GO TO 580
C 
C  GASP!!!  BOTH BUFFER LENGTHS ARE ZERO AND POWERFAIL BIT IS CLEAR!! 
C 
C                  &dCWHAT DO I DO???&d@
C 
599   ASSIGN 600 TO I 
      CALL TMPER(I,99,ITSNUM,LLU,220,OUTDEV)
600   RETURN
C 
C  WRITE ONLY SUBFUNCTION 
C 
C 
C  CHECK FOR WRITE TO PRINTER, DISPLAY OR BOTH
C 
590   CONTINUE
C 
C  UNTALK ALL -- UNLISTEN ALL 
C 
      CALL TMBWR(2H?_,-2,21B) 
C#############################################################
C#############################################################
      IF(ISBIT(OUTDEV,0).AND.ISBIT(OUTDEV,1))GO TO 591
      IF(ISBIT(OUTDEV,0))GO TO 592
      IF(ISBIT(OUTDEV,1))GO TO 593
C 
C  NO OUTPUT DESTINATION BITS SET 
C 
      ASSIGN 601 TO I 
      CALL TMPER(I,99,ITSNUM,LLU,221,OUTDEV)
601   RETURN
C 
C  LISTEN MODCOM -- LISTEN DISPLAY -- LISTEN PRINTER
C 
591   CALL TMBWR(4H>=; ,-3,21B) 
      GO TO 594 
C 
C  LISTEN MODCOM -- LISTEN DISPLAY
C 
592   CALL TMBWR(2H>= ,-2,21B)
      GO TO 594 
C 
C  LISTEN MODCOM -- LISTEN PRINTER
C 
593   CALL TMBWR(2H>; ,-2,21B)
C 
C  SET DESTINATION ADDRESS & GENERATE OUTPUT BUFFER 
C 
594   MBLN=0
      ASSIGN 596 TO IORTAD
      GO TO 1120
596   CONTINUE
C 
C  WRITE OUTPUT HERE
C 
C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C 
C  STRIP OUT CR IF ITS POSITION IN THE LINE IS A MULTIPLE OF 21 
C 
      J=1 
      DO 5912 I=1,MBLN
5910  IF(IGET1(MSGBFR,I).EQ.6440B.AND.J.EQ.21)GO TO 5914
      IF(IGET1(MSGBFR,I).EQ.6440B.OR.J.EQ.21)GO TO 5913 
      J=J+1 
      GO TO 5912
5914  CALL MOVCA(MSGBFR,I+1,MSGBFR,I,MBLN-I)
      MBLN=MBLN-1 
      J=1 
      GO TO 5910
5913  J=1 
5912  CONTINUE
      IF(J.LT.21)GO TO 5915 
      CALL PUTCA(MSGBFR,1H_,MBLN+1) 
      MBLN=MBLN+1 
C 
5915  DO 5911 I=1,MBLN
5911  IF(IGET1(MSGBFR,I).EQ.6440B)CALL PUTCA(MSGBFR,5000B,I)
      IF(SQUAL.EQ.4)GO TO 5920
      J=MBLN/21 
      IF((MBLN-(J*21)).NE.0)GO TO 5921
      CALL PUTCA(MSGBFR,1H_,MBLN) 
      GO TO 5921
5920  CONTINUE
      LL=IGET1(MSGBFR,MBLN) 
D     CALL REIO(2,LUOXX,LL,1) 
      IF(LL.EQ.5040B.OR.LL.EQ.020040B.OR.LL.EQ.57440B)GO TO 5922
      CALL PUTCA(MSGBFR,1H_,MBLN+1) 
      MBLN=MBLN+1 
      GO TO 5921
5922  MBLN=MBLN-1 
5921  CALL TMWR(MSGBFR,-MBLN) 
C 
C  SET STATUS WORD AND TRANSMISSION LOG 
C 
      ISTATS=0
C 
C  CHECK TO SEE IF AN INPUT IS NEEDED 
C 
580   IF(INBFLN.LE.0)RETURN 
      CALL TMBWR(2H_?,-2,21B) 
C 
C  ISOLATE BYTES OF INPUT DEVICE WORD 
C 
      INUP=IGETB(INPDEV,1)
      INLOW=IGETB(INPDEV,2) 
C 
C  BUMP INLOW SO IT CAN BE USED IN A "COMPUTED GO-TO" TO DISPATCH 
C     TO APPROPRIATE SECTION FOR INPUT DEVICE 
C 
      INLOW=INLOW+1 
C 
C  INLOW=1 --> INPUT FROM KEYBOARD
C  INLOW=2 --> INPUT FROM TYPE III/MULTIFUNCTION READER 
C  INLOW>2 --> ERROR FOR 3070A/B
C 
      GO TO (5080,5090,581),INLOW 
C 
C  ERROR -- A NON-EXISTENT DEVICE HAS BEEN REQUESTED
C 
581   ASSIGN 602 TO I 
      CALL TMPER(I,99,ITSNUM,LLU,223,OUTDEV)
602   RETURN
C 
C  INPUT IS FROM KEYBOARD 
C 
5080  INBFLN=20 
C 
C  UNTALK ALL -- LISTEN DISPLAY -- LISTEN MOD-COM -- TALKER KEYBOARD
C 
      CALL TMBWR(4H_>=],-4,21B) 
C 
C  READ KEYBOARD WITH ECHO ON DISPLAY 
C 
      I=2 
      IF(IAND(IALF2(LITE2),377B).EQ.128)I=I+20
      CALL LOGEV(ICOM00(2),LLU,I,MBLN,ITSNUM,ITIM)
      CALL TMRD(INBUFR,-INBFLN,0B)
      CALL LOGEV(ICOM00(2),LLU,3,ITL,ITSNUM,ITIM) 
      ITRNLG=ITL
C 
C  RETRIEVE NUMBER OF KEY THAT COMPLETED READ 
C 
C     N.B.  -1 --> "ENTER" KEY
C            0 --> "SRQ" KEY
C       1...10 --> "SFK#1" ... "SFK#10" 
C 
      ISTATS=IAND(IST,17B)-1
C 
C  CHECK FOR SRQ
C 
      IF(ISBIT(IST,7))GO TO 5081
C 
C  ELIMINATE ENTER AND SRQ POSSIBILITIES FOR ISTATS 
C 
      IF(ISTATS.LE.0)ISTATS=0 
C 
C  SCAN FOR NON-TERMINATING SFK'S IN INPUT BUFFER 
C 
      CALL SCN70(INBUFR,ITRNLG) 
C 
C  SHOULD BE ALL DONE 
C 
      INBFLN=0
      RETURN
C 
C  WHAT TO DO IF USER PUSHES SRQ ---
C 
C 
C  CLEAR SRQ
C 
5081  CALL TMBCT(11B) 
      CALL TMBCT(12B,1) 
C 
C  SET STATUS WORD TO 128 TO INDICATE SRQ TERMINATED READ 
C 
5082  ISTATS=128
      ITRNLG=0
      INBFLN=0
      RETURN
5090  INBFLN=82 
      CALL TMBCT(14B) 
C 
C  INPUT IS FROM CARD READER
C 
C  UNTALK ALL -- UNLISTEN ALL -- LISTEN MOD-COM -- TALKER READER
C 
      CALL TMBWR(2H_?,-2,21B) 
      CALL TMBWR(2H>\,-2,21B) 
C 
C  BEGIN PARSING CARD BY BRUTE FORCE METHOD 
C 
C  DEFAULT CARD TYPE IS:     ASCII
C                            80-COL 
C                            NO CLOCK 
C                            HOLES ONLY 
C 
C  CHECK ASCII/IMAGE BIT FOR DETERMINATION OF LOCAL REJECT CODE 
C 
      KRDTYP=20B
      IF(ISBIT(INPDEV,15))KRDTYP=30B
C 
C  HERE GOES NOTHING
C 
C  MARKS ONLY, 40-COL, NO CLOCK 
C 
      IF(ISBIT(INPDEV,14).AND..NOT.(ISBIT(INPDEV,13)).AND..NOT. 
     *(ISBIT(INPDEV,12)))KRDTYP=KRDTYP+4B 
C 
C  HOLES ONLY, 40-COL, NO CLOCK 
C 
      IF(.NOT.(ISBIT(INPDEV,14)).AND..NOT.(ISBIT(INPDEV,13)).AND. 
     *.NOT.(ISBIT(INPDEV,12)))KRDTYP=KRDTYP+0B
C 
C  HOLES ONLY, 80-COL, NO CLOCK 
C 
      IF(.NOT.(ISBIT(INPDEV,14)).AND.ISBIT(INPDEV,13).AND.
     *.NOT.(ISBIT(INPDEV,12)))KRDTYP=KRDTYP+2B
C 
C  MARKS & HOLES, CAD 
C 
      IF(ISBIT(INPDEV,14).AND.ISBIT(INPDEV,13).AND. 
     *ISBIT(INPDEV,12))KRDTYP=KRDTYP+7B 
C 
C  HOLES ONLY, CAD
C 
      IF(.NOT.(ISBIT(INPDEV,14)).AND.ISBIT(INPDEV,13).AND.
     *ISBIT(INPDEV,12))KRDTYP=KRDTYP+3B 
C 
C  MARKS & HOLES, COD 
C 
      IF(ISBIT(INPDEV,14).AND..NOT.(ISBIT(INPDEV,13)).AND.
     *ISBIT(INPDEV,12))KRDTYP=KRDTYP+5B 
C 
C  IF, AFTER ALL THAT, YOU DIDN'T GET ONE OF THE 8 (COUNT 'EM)
C     COMBINATIONS, SET KRDTYP TO THE DEFAULT (32B) 
C 
      IF(KRDTYP.EQ.20B.OR.KRDTYP.EQ.30B)KRDTYP=32B
C 
C  CONFIGURE THE READER ACCORDING TO KRDTYP 
C 
      CALL TMBCT(6B,KRDTYP) 
C 
C  READ SOME DATA 
C 
      I=2 
      IF(IAND(IALF2(LITE2),377B).EQ.128)I=I+20
      CALL LOGEV(ICOM00(2),LLU,I,MBLN,ITSNUM,ITIM)
      CALL TMRD(INBUFR,-INBFLN,10B) 
      CALL LOGEV(ICOM00(2),LLU,3,ITL,ITSNUM,ITIM) 
      CALL TMBCT(13B) 
C 
C  CHECK FOR SRQ
C 
      IF(ISBIT(IST,7))GO TO 5081
C 
C  NO SRQ -- SET ISTATS, ITRNLG -- AND SHOVE 'ER INTO THE GOIN' HOME HOLE 
C 
      ISTATS=0
      ITRNLG=ITL
      INBFLN=0
      RETURN
      END 
      SUBROUTINE LIT70(LITE1,LITE2,ITTYP,IWORD,IWRDLN), 92903-16560 REV.
     *1913  790226
      LOGICAL ISBIT 
      DIMENSION IBYT(4),IWORD(1),IAERS(8) 
      DATA IAERS/060142B,062146B,064152B,066156B,070162B,072166B, 
     *074172B,076000B/
C 
C  CHECK THE TERMINAL TYPE
C 
      K=1 
      IF(ITTYP.EQ.3071)K=2
      GO TO (10,20),K 
C 
C  CLEAR PROMPTING LIGHTS -- METHOD DETERMINED BY TERMINAL TYPE 
C 
C 
C  TERMINAL IS A 3070A
C 
10    CALL MOVCA(IAERS,1,IWORD,IWRDLN+1,15) 
      IWRDLN=IWRDLN+15
      GO TO 25
C 
C  TERMINAL IS A 3070B
C 
20    CALL PUTCA(IWORD,126*256,IWRDLN+1)
      IWRDLN=IWRDLN+1 
25    IF(LITE1.EQ.0.AND.LITE2.EQ.0)GO TO 35 
C 
C  ISOLATE LIGHT #'S
C 
      IBYT(1)=IGETB(LITE1,1)
      IBYT(2)=IGETB(LITE1,2)
      IBYT(3)=IGETB(LITE2,1)
      IBYT(4)=IGETB(LITE2,2)
C 
C  DECODE LIGHT #'S AND TURN THEM INTO APPROPRIATE TERMINAL COMMANDS
C 
      DO 30 I=1,4 
      IF(IBYT(I).LE.0)GO TO 30
      IF(IBYT(I).EQ.128)GO TO 110 
      IF(IBYT(I).EQ.129)GO TO 111 
      IF(IBYT(I).GE.5.AND.IBYT(I).LE.8)GO TO 1121 
      IF(IBYT(I).GT.8.AND.IBYT(I).LE.13)IBYT(I)=IBYT(I)+2 
      GO TO 112 
1121  IBYT(I)=IBYT(I)+1 
      GO TO 112 
110   IBYT(I)=5 
      GO TO 112 
111   IBYT(I)=10
112   IBYT(I)=(IBYT(I)*2+1+136B)*256
      CALL PUTCA(IWORD,IBYT(I),IWRDLN+1)
      IWRDLN=IWRDLN+1 
30    CONTINUE
35    RETURN
      END 
      SUBROUTINE SCN70(INBFR,INLEN), 92903-16560 REV.1913  780109 
      DIMENSION INBFR(1)
      DO 20 I=1,INLEN 
20    IF(IGET1(INBFR,I).GE.010040B.AND.IGET1(INBFR,I).LE.014440B) 
     *          CALL PUTCA(INBFR,IGET1(INBFR,I)+050340B,I)
      RETURN
      END 
END$