FTN4
      SUBROUTINE IOM75, 92080-16570 REV.2026  800602
C 
C 
C  SOURCE FILE:  &IOM75   P/N 92080-18570 
C  RELOC. FILE:  %IOM75   P/N 92080-16570 
C 
C 
C  PMGR:  STEVE WITTEN, 
C         DATA SYSTEMS DIVISION,
C         CUPERTINO, CALIFORNIA 
C 
C 
C  ************************************************************** 
C  *                                                            * 
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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, %IOM75 IS A T.U.S. OF THE TMP (TERMINAL MONITOR PROGRAM). 
C     IT IS THE INTERFACE BETWEEN TMP AND THE MULTIPOINT DRIVER (DVR07).
C 
C 
C*********************************************STEVE WITTEN (DSD)********
C 
C  TRUE COMMON
C 
      COMMON ICOM00(5)
C 
C  THIS COMMON BLOCK IS FOR TMS USE ONLY.  N.B. FOR DEBUGGING, ICOM00(1)
C      CONTAINS THE LU# OF THE TERMINAL THAT SCHEDULED TMP. 
C 
C 
C*********************
C                    *
C  COMMON BLOCK # 1  *
C                    *
C*********************
C 
      COMMON LLU(26),ERRFL,IFILL0,IFC,IORTAD,ITRST,ITSNUM(2),ITIM(6)
     *      ,LITE1,LITE2,LITE3
     *      ,OUTDEV,INPDEV,ITSNAM(5),OTBFLN,OTBUFR(40)
     *      ,HP3077,WAITC,TRMHR,TRMMN,KPLHLD,MBLN,MSGBFR(50)
C 
C  LLU --> ARRAY 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 --> TEMPORARY STORAGE FOR RETURN ADDRESSES WITHIN I/O MODULE
C                  SO THAT CODE SECTIONS CAN BE REUSED. 
C 
C  ITRST --> THE "USEFUL" SUBSET OF THE 6-BYTE TERMINAL HARDWARE STATUS 
C 
C  ITSNUM -->  WORD#1 IS THE TRANS.SPEC. NUMBER-- 
C              WORD#2 IS THE TRANSACTION STEP.
C 
C  ITIM --> A SIX-WORD BUFFER HOLDING THE SYSTEM TIME IN A FORMAT DE- 
C              SCRIBED IN THE 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.  (UPPER BYTE -- QUESTION LIGHT)
C                               (LOWER BYTE -- DISPLAY LIGHT )
C 
C  LITE2 --> THE HI AND LO BYTES CONTAIN THE LOGICAL NUMBERS OF PROMPTING 
C            LIGHTS TO BE LIT.  (UPPER BYTE -- ERROR LIGHT   )
C                               (LOWER BYTE -- TR.COMP.LIGHT )
C 
C  LITE3 --> THE LIGHT # OF THE LITE TO STAY ON ALL THE TIME
C                               (LOWER BYTE ONLY, UPPER BYTE RESERVED 
C                                FOR FUTURE USE.) 
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  TRMHR --> THE HOUR OF THE DAY (24-HR CLOCK) RETRIEVED FROM AN HP3077 
C              TERMINAL.  PASSED BACK TO TMP FOR LOGGING IN OUTPUT FILE.
C 
C  TRMMN --> THE MINUTE (SAME AS FOR 'TRMHR') 
C 
C  KPLHLD --> A DUMMY VARIABLE FOR PLACE HOLDING ONLY.  'KPLHD' MUST NOT
C            BE USED IN THIS ROUTINE -- LEST YOU DESTROY VALUABLE INFO
C            FOR 'ZTMP'.
C 
C  MBLN --> BYTE POINTER TO THE LAST BYTE OF AN HP 307X TERMINAL MESSAGE. 
C 
C  MSGBFR --> BUFFER HOLDING THE CURRENT TERMINAL MESSAGE.
C 
C  WAITC --> A FLAG FROM TMP INDICATING IF TRANS.COMPL. IS THE ONLY ALLOWED 
C              ANSWER TO A QUESTION 
C 
C  HP3077 --> LOGICAL FLAG FOR DETERMINING IF TERM IS AN HP3077 (TRUE = 
C               TERM IS AN HP3077)
C 
C 
C 
C******************** 
C                   * 
C  COMMON BLOCK #3  * 
C                   * 
C******************** 
C 
C 
      COMMON IFILL1(95),INBFLN,INBUFR(100)
     *      ,IDMBF(91),ITT0,ITT,KEYN
C 
C 
C 
C 
C 
C  IFILL1--> FILLER 
C 
C  INBFLN --> MAX.LENGTH IN BYTES OF INFORMATION TO BE READ FROM TERMINAL 
C             AND PASSED TO TMP.  TMP GETS THIS NUMBER FROM THE 
C             TYPE OF INPUT DEVICE SPECIFIED IN THE TS. 
C 
C  INBUFR --> BUFFER OF INFORMATION RECEIVED FROM THE 307X TERMINAL.
C 
C  IDMBF --> A DUMMY BUFFER FOR PLACE-HOLDING ONLY. (MUST NOT BE USED 
C            IN IOM75)
C 
C  ITT0  -->  SIMILAR TO ITT, BUT IT IS WORD 9 OF TS HEADER.
C 
C  ITT --> CHARACTERISTICS OF THE TRANSACTION -- IT IS WORD 10 OF THE 
C             TS HEADER -- SEE TGP IMS FOR ITS FORMAT.  USED IN TERMINAL
C             FEATURE CHECK AND CLOCK SETTING ON HP3077 
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)),
     *            (ITSNA5,ITSNAM(5)), 
     *            (LUOXX,ICOM00(1)) 
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.), AND
C  LU# OF THE TERMINAL THAT SCHEDULED TMP (USED FOR DEBUGGING). 
C 
C 
C  LOCAL STORAGE
C 
C 
C  DECLARE INTGER AND LOGICAL VARIABLES 
C 
      INTEGER OUTDEV,OTBFLN,OTBUFR,TRMHR,TRMMN,ERRFL
     *       ,STATPT
C 
      LOGICAL ISBIT,ISBTW,INUM,KEY75
C 
C  LOGICAL FUNCTIONS ABOVE
C 
      LOGICAL HP3077,WAITC
C 
C  LOGICAL VARIABLES ABOVE
C 
      DIMENSION ITEMP(20),ISASFK(3),IGRNLT(6),KBDLK(3),IMN1(2)
      DIMENSION KBDON(4),KARD3X(4),KARD5X(4),KBARX(4) 
C 
C  'ITEMP' IS A TEMPORARY BUFFER USED THROUGHOUT IOM75
C  'ISASFK' IS AN ESCAPE SEQUENCE THAT WILL ENABLE ALL SFK'S AS 
C           INPUT TERMINATORS.
C  'IGRNLT' IS AN ESCAPE SEQUENCE THAT WILL TURN OFF THE RED LIGHT
C           AND TURN ON THE GREEN LIGHT ON AN HP3077. 
C  'KBDLK' IS AN ESCAPE SEQUENCE THAT WILL LOCK THE KEYBOARD
C           BETWEEN THE TIME A SUCCESSFUL SELECTION OF A TS OCCURS
C           AND THE TIME THE TERMINAL IS READY TO ACCEPT AN ANSWER
C           TO THE FIRST QUESTION OF THE TRANSACTION. 
C  'IMN1' IS USED AS DUMMY INPUT TO 'KEY75' DURING TRANSACTION SELECTION
C           TO TELL 'KEY75' THAT ALL SFK'S ARE ENABLED IN THE TRANS.
C           SELECTION PROCESS (SO USER CAN SELECT A TS WITH AN SFK).
C 
      DATA ISTRQ/015536B/,IST75/015534B/,IMN1/-1,-1/
C 
C  'ISTRQ' ARE THE HP307X STATUS REQUEST CHARACTERS (ESC ^) 
C 
C  'IST75' ARE THE FIRST TWO CHARACTERS OF THE STATUS BYTES RE- 
C          TURNED BY THE HP307X TERMINAL (ESC \)
C 
C  'IMN1' USED TO TELL 'KEY75' THAT ALL SFK'S ARE ENABLED AS
C          INPUT TERMINATORS. 
C 
      DATA ISASFK/015455B,2Hk0,2H[ /
C 
C  'ISASFK' -- ESC.SEQ. FOR ENABLING ALL SFK'S AS INPUT TERM. 
C                   (ESC-k0[) 
C 
      DATA KBDLK/015455B,2Hc0,2HK / 
C 
C  'KBDLK' -- DISABLE KEYBOARD (ESC-c0K)
C 
      DATA IRST/015505B/,IESCJ/015512B/ 
C 
C  'IRST' -- HARD RESET OF TERMINAL (ESC E) 
C 
C  'IESCJ -- CLEAR DISPLAY TERMINAL DISPLAY (ESC J) 
C 
      DATA IGRNLT/015455B,2Hc1,042033B,2H-d,2H1g,2H0R/
C 
C  'IGRNLT' -- LIGHT GREEN LIGHT AND TURN OFF RED LIGHT ON HP3077 
C                    (ESC-c1D ESC-d1g0R)
C 
      DATA KBDON /15455B,61461B,62061B,65400B/
      DATA KARD3X/15455B,71060B,64460B,47000B/
      DATA KARD5X/15455B,71060B,65060B,46000B/
      DATA KBARX /15455B,73462B,61061B,41440B/
C 
C 
C  BEGIN OF PROGRAM 
C 
C  DEFINE THE COMMON BLOCK STRUCTURE TO TMS 
C 
      CALL TMDFN(LLU,LLU,IFILL1,IFILL1,ICOMEN)
C 
C  DISPATCH ON FUNCTION CODE
C 
C     WRITE(6,11199) IFC
C11199 FORMAT(" IOM75 : IFC="I3)  
      GO TO (111,222,333,444,555,666),IFC 
C 
C  SET OUTPUT DEVICE AS DISPLAY 
C 
111   OUTDEV=IAND(OUTDEV,74004B)
      OUTDEV=IOR(OUTDEV,1)
C 
C  CLEAR DESTINATION BUFFER 
C 
      DO 199 LL=1,5 
199   ITSNAM(LL)=0
C 
C   RESET THE TERMINAL AND THE DRIVER 
C 
      CALL TMBCT(23B,170000B) 
      ITRST=0 
C 
C  GET THE TERMINAL STATUS
C 
63    CALL TMBWR(ISTRQ,-2)
      ASSIGN 63 TO ITSNA5 
64    CALL TMRD(ITEMP,-9) 
      LABEL=64
C     WRITE(1,10719) LABEL,IST,ITL,(ITEMP(IX),IX=1,(ITL+1)/2) 
C 
C --- IF LAST CHARACTER OF INPUT STRING IS CR, DECREMENT ITL. 
C 
      IF(IGETB(ITEMP,ITL).EQ.15B) ITL=ITL-1 
      IF(ITL.LT.0) ITL=0
C 
C  WAS THE READ COMPLETED BY AN EQT TIME-OUT?? IF SO, RE-ISSUE THE READ 
C 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 64
C 
C  CHECK THE VALIDITY OF THE STATUS BYTES RECEIVED
C 
C     WRITE(1,64997) ITL,(ITEMP(IX),IX=1,(ITL+1)/2) 
C64997 FORMAT("++++IOM75 : ITL="@6", ITEMP="20A2) 
      IF(ITEMP.NE.IST75 .AND. ITEMP.NE.15501B .AND. 
     +   ITEMP.NE.15502B  .AND. ITEMP.NE.15504B) GO TO 1050 
C 
C  STRIP OUT THE TIME OF DAY THAT THE HP3077 PUTS IN THE STATUS 
C 
      CALL STS77(ITEMP,ITL) 
      IF(ITL.NE.5 .AND. ITL.NE.6) GO TO 1050
C 
C  CHECK TO SEE IF THE PRINTER IS BUSY
C 
      IF(.NOT.ISBIT(ITEMP(2),13))GO TO 65 
C 
C  YES-- WAIT FOR A BIT 
C 
      CALL TMPZ(60) 
      ITRST=ITRST+1 
      IF(ITRST.GT.60)GO TO 65 
      GO TO 63
C 
C  DO THE WAIT LOOP 60 TIMES BEFORE DOING A HARD RESET
C 
65    CALL TMBWR(IRST,-2) 
C 
C   ENABLE ALL SPECIAL FUNCTION KEY 
C 
75    CALL MOVEW(ISASFK,MSGBFR,3) 
      MBLN=5
C 
C   SET RETURN ADDR FROM GET STATUS FOR  IFC=1
C 
      ASSIGN 1060 TO IORTAD 
      ASSIGN 1051 TO ITSNA5 
C 
C   ENTRY TO GET TERMINAL STATUS, CHECK IT AND SAVE IT
C 
100   CONTINUE
C 
C  MOVE STATUS REQUEST BYTES TO END OF COMMAND STRING 
C 
      CALL MOVCA(ISTRQ,1,MSGBFR,MBLN+1,2) 
      MBLN=MBLN+2 
C 
C?????????????????????????????????????????????????????????????????????
D     WRITE(ICOM00,6561)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2)
D6561 FORMAT("  1-IOM75 LU"I3,"   TMWR: LEN="I5,", MSGBFR="50A2)
C?????????????????????????????????????????????????????????????????????
C 
C 
C  WRITE THE COMMAND STRING 
C 
1051  CALL TMBWR(MSGBFR,-MBLN)
      ASSIGN 1051 TO ITSNA5 
C 
C  READ THE STATUS BYTES
C 
1052  CALL TMRD(ITEMP,-9) 
      LABEL=1052
C     WRITE(1,10719) LABEL,IST,ITL,(ITEMP(IX),IX=1,(ITL+1)/2) 
C 
C --- IF LAST CHARACTER OF INPUT STRING IS CR, DECREMENT ITL. 
C 
      IF(IGETB(ITEMP,ITL).EQ.15B) ITL=ITL-1 
      IF(ITL.LT.0) ITL=0
C 
C  WAS THE READ COMPLETED BY EQT TIME-OUT?? IF SO, RE-ISSUE READ. 
C 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 1052
C 
C?????????????????????????????????????????????????????????????????????
D     WRITE(ICOM00,6571)LLU(1),ITL,(ITEMP(I),I=1,(ITL+1)/2) 
D657  FORMAT(" /IOM75 LU"I3", ITL="@6", TERM. STATUS: "3@8) 
D6571 FORMAT(" 2-/IOM75 LU"I3", TERM. STATUS: "3@8) 
C?????????????????????????????????????????????????????????????????????
C 
C 
C  CHECK THE VALIDITY OF THE STATUS BYTES 
C 
C     WRITE(1,64997) ITL,(ITEMP(I),I=1,(ITL+1)/2) 
      IF(ITEMP.NE.IST75 .AND. ITEMP.NE.15501B .AND. 
     +   ITEMP.NE.15502B  .AND. ITEMP.NE.15504B) GO TO 1050 
C 
C  STRIP OUT THE TIME OF DAY THE HP3077 PUTS THERE
C 
      CALL STS77(ITEMP,ITL) 
C     WRITE(1,64997) ITL,ISTRQ
      IF(ITL.NE.5 .AND. ITL.NE.6) GO TO 1050
C 
C  ISOLATE THE BYTES 4 AND 5 OF THE STATUS FOR REFORMATTING 
C 
      IBYT1=IGETB(ITEMP,4)
      IBYT2=IGETB(ITEMP,5)
C 
C --- ISOLATE LEFT & RIGHT-HAND MODULES OF STATUS BYTE 4. 
C 
      MODLH=IAND(IBYT1,70B)/8 
      MODRH=IAND(IBYT1,7B)
C 
C  BEGIN REFORMATTING STATUS BYTES
C 
      ITRST=(IBYT1*256)+IBYT2 
C 
C  REFORMAT ITRST (VALUABLE INFO IN HARDWARE STATUS BYTES) TO 
C     FOLLOWING FORMAT: 
C 
C  UPPER BYTE CONTAINS FOLLOWING: 
C 
C    BITS 0-2 --> PRODUCT # (0=3075,1=3076,2=3077)
C    BIT   3  --> 1 IF CRT PRESENT
C                 0 NO CRT PRESENT
C    BIT   4  --> 1 IF BARCODE READER PRESENT 
C                 0 NO BARCODE READER PRESENT 
C    BIT   5  --> 1 IF MAGSTRIPE READER PRESENT 
C                 0 NO MAGSTRIPE READER PRESENT 
C    BITS 6-7 --> UNUSED
C 
C  LOWER BYTE CONTAINS FOLLOWING: 
C 
C    BIT 0 --> ALWAYS A ZERO
C 
C    BIT 1 --> 1 IF DISPLAY IS PRESENT (QUALIFIED BY BIT 7) 
C              0 IF NO DISPLAY IS PRESENT 
C 
C    BIT 2 --> 1 IF KEYBOARD IS PRESENT (QUALIFIED BY BIT 6)
C              0 IF NO KEYBOARD IS PRESENT
C 
C    BIT 3 --> 1 IF PRINTER PRESENT 
C              0 IF NO PRINTER PRESENT
C 
C    BIT 4 --> 1 IF TYPE III READER PRESENT 
C              0 IF NO TYPE III PRESENT 
C 
C    BIT 5 --> 1 IF TYPE V READER PRESENT 
C              0 IF NO TYPE V PRESENT 
C 
C    BIT 6 --> 1 KEYBOARD IS ALPHANUMERIC 
C              0 KEYBOARD IS NUMERIC ONLY 
C 
C    BIT 7 --> 1 DISPLAY IS ALPHANUMERIC
C              0 DISPLAY IS NUMERIC ONLY
C 
C 
C  ISOLATE PRODUCT #
C 
      IPROD=IAND(IGETB(ITRST,2),7B) 
C 
C  DEFAULT IS 3075/3076 
C 
      ITMP=6B 
C 
C  CHECK IF IT IS A 3077
C 
      IF(IPROD.LT.2)GO TO 101 
      ITMP=0B 
      HP3077=.TRUE. 
C 
C --- CHECK FOR PRINTER.
C 
101   IF(MODRH.EQ.1) CALL SETBT(ITMP,3,1) 
C 
C --- CHECK FOR MULTIFUNCTION READER/TYPE 3 BADGE 
C 
      IF(MODLH.EQ.2) CALL SETBT(ITMP,4,1) 
C 
C --- CHECK FOR TYPE 5 BADGE READER.
C 
      IF(MODLH.EQ.4 .OR. MODRH.EQ.4) CALL SETBT(ITMP,5,1) 
C 
C --- CHECK FOR CRT.
C 
      IF(ISBIT(ITRST,3)) CALL SETBT(IPROD,3,1)
C 
C  CHECK FOR ALPHA DISPLAY
C 
      IF(ISBIT(ITRST,4))CALL SETBT(ITMP,7,1)
C 
C  SET BIT 1 IF PRODUCT IS A 3077 
C 
      IF(IPROD.GE.2)CALL SETBT(ITMP,1,1)
C 
C  CHECK FOR ALPHA KEYBOARD 
C 
      IF(ISBIT(ITRST,5))CALL SETBT(ITMP,6,1)
C 
C --- CHECK FOR MAGSTRIPE READER. 
C 
      IF(MODLH.EQ.5 .OR. MODRH.EQ.5) CALL SETBT(IPROD,5,1)
C 
C --- CHECK FOR BAR CODE READER.
C 
      IF(MODLH.EQ.6 .OR. MODRH.EQ.6) CALL SETBT(IPROD,4,1)
C 
C  PUT ITRST IN ABOVE FORMAT
C 
      ITRST=(IPROD*256)+ITMP
C 
C  GO TO RIGHT PLACE
C 
C     WRITE(1,10509) ITRST
C10509 FORMAT("IOM75 : LABEL=10509, ITRST="@7)
      GOTO IORTAD 
C 
C  THE TERMINAL IS NOT A 3075/76/77 ??? THE TERMINAL IS DOWN??? 
C 
1050  ASSIGN 615 TO I 
      CALL TMPER(I,31,ITSNUM,LLU,LLU,0) 
615   CALL TMPZ(1000) 
      GO TO ITSNA5
C 
C   RETURN FOR IFC=1, AFTER THE GET TERMINAL STATUS 
C  DECONFIGURE ALL DEVICES BUT KEYBOARD & DISPLAY 
C 
1060  ASSIGN 1070 TO IORTAD 
1065  MBLN=0
C 
C --- CONFIGURE DISPLAY & KEYBOARD
C 
      CALL MOVCA(KBDON,1,MSGBFR,1,7)
      MBLN=7
C 
C --- CONFIGURE CARD READER.
C 
      IF(.NOT.ISBIT(ITRST,4)) GO TO 1066
         KARD3=30562B 
         CALL MOVCA(KARD3,1,MSGBFR,MBLN+1,2)
         MBLN=MBLN+2
         KARD3=1
C 
C --- CONFIGURE BADGE V.
C 
1066  IF(.NOT.ISBIT(ITRST,5)) GO TO 1067
         KARD5=30542B 
         CALL MOVCA(KARD5,1,MSGBFR,MBLN+1,2)
         MBLN=MBLN+2
         KARD5=1
C 
C --- CONFIGURE BAR CODE READER.
C 
1067  IF(.NOT.ISBIT(ITRST,12)) GO TO 1068 
         KBAR=30567B
         CALL MOVCA(KBAR,1,MSGBFR,MBLN+1,2) 
         MBLN=MBLN+2
         KBAR=1 
C 
C --- CONFIGURE MAGSTRIPE.
C 
1068  IF(.NOT.ISBIT(ITRST,13)) GO TO 10690
         KMAG=30555B
         CALL MOVCA(KMAG,1,MSGBFR,MBLN+1,2) 
         MBLN=MBLN+2
C 
C --- IF TERMINAL HAS PRINTER, DISABLE IT.
C 
10690 IF(.NOT.ISBIT(ITRST,3)) GO TO 1069
         KPRT=30160B
         CALL MOVCA(KPRT,1,MSGBFR,MBLN+1,2) 
         MBLN=MBLN+2
C 
C --- MAKE LAST CHARACTER, UPPERCASE. 
C 
1069  CALL PUTCA(MSGBFR,IGET1(MSGBFR,MBLN)-20000B,MBLN) 
C 
C --- IF CARD READER WAS CONFIGURED, SET IT TO A.H.NC 
C 
      IF(KARD3.NE.1) GO TO 10691
         CALL MOVCA(KARD3X,1,MSGBFR,MBLN+1,7) 
         MBLN=MBLN+7
C 
C --- IF BADGE 5 WAS CONFIGURED, SET IT TO NUMERIC. 
C 
10691 IF(KARD5.NE.1) GO TO 10692
         CALL MOVCA(KARD5X,1,MSGBFR,MBLN+1,7) 
         MBLN=MBLN+7
C 
C --- IF BAR CODE WAS CONFIGURED, SET IT TO CODE 39, CK DIGIT ON. 
C 
10692 IF(KBAR.NE.1) GO TO 10693 
         CALL MOVCA(KBARX,1,MSGBFR,MBLN+1,7)
         MBLN=MBLN+7
C     WRITE(ICOM00,64999) IDEV,ITRST,MBLN,MSGBFR
C64999 FORMAT(" 2.1-IOM75, IDEV="@7", ITRST="@7", MBLN="@7", MSGBFR=" 
C    .                                                      50A2) 
C64998 FORMAT(" 2.2-IOM75, IDEV="@7", ITRST="@7", MBLN="@7", MSGBFR=" 
C    .                                                      50A2) 
C     WRITE(ICOM00,64998) IDEV,ITRST,MBLN,MSGBFR
C 
C  LIGHT TS# [-SC] LIGHT
C 
10693 LITE2=15
      GOTO 1121 
C 
C  GO TO PRINT THE MESSAGE IF ANY, LIGHT THE LIGHT AND RETURN 
C  AT THE FOLLOWING LINE
C 
C  THE MESSAGE FOR THE DISPLAY, FROM ZTMP IS TO OUTPUT ONLY ONCE. 
C 
1070  OTBFLN=0
      LITE1=0 
C 
C  DO THE WRITE 
C 
C 
C?????????????????????????????????????????????????????????????????????
D     WRITE(ICOM00,6562)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2)
D6562 FORMAT("  3-IOM75 LU"I3,"   TMWR: LEN="I5", MSGBFR="50A2) 
C?????????????????????????????????????????????????????????????????????
C 
      CALL TMWR(MSGBFR,-MBLN) 
C 
C  READ THE TS-SC 
C 
1071  CALL TMRD(ITEMP,-20,4B) 
C 
C --- LEFT JUSTIFY INPUT STRING.
C 
      CALL JUSTF(ITEMP,1,20,1)
      LABEL=1071
C     WRITE(1,10719) LABEL,IST,ITL,(ITEMP(IX),IX=1,(ITL+1)/2) 
C 
C --- IF LAST CHARACTER OF INPUT STRING IS CR, DECREMENT ITL. 
C 
      IF(IGETB(ITEMP,ITL).EQ.15B) ITL=ITL-1 
      IF(ITL.LT.0) ITL=0
C10719 FORMAT("TMRD: LABEL="I5", IST="@6", ITL="@6", ITEMP="10@7) 
C 
C --- IF LAST CHAR IS CR, DECREMENT ITL.
C 
      IF(IGETB(ITEMP,ITL).EQ.15B) ITL=ITL-1 
C 
C  WAS THE READ COMPLETED BY EQT TIME-OUT?? IF SO, RE-ISSUE READ. 
C 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 1071
C 
C --- DISABLE ALL DEVICES TO PREVENT FURTHER INPUT. 
C 
      MBLN=0
      IDEV=0
      CALL DEV75(ITRST,IDEV,MSGBFR,MBLN,OUTDEV,ERRFL,KEYN)
      CALL TMBWR(MSGBFR,-MBLN)
C 
C 
C 
C  INIT SC
C 
      ITSNA5=0
C 
C  GET TS# FROM LAST CHAR IN INPUT BUFFER -- USER PUSHES SFK
C 
      IF(KEY75(ITSSPC,IMN1,ITEMP,ITL))
     *      CALL TMPER(0,99,ITSNUM,LLU,322,ITSSPC)
C 
C  IF USER PUSH ATT -- RESET & TRY AGAIN
C 
      IF(ITSSPC.GE.128)GO TO 111
C 
C  USER INPUTS GARBAGE -- GENERATE ERR
C 
      IF(ITSSPC.GT.0.AND.ITL.NE.0)GO TO 200 
C 
C  A GOOD TS# HAS BEEN OBTAINED 
C 
      IF(ITSSPC.GT.0)GO TO 300
C 
C  USER PUSHES ONLY ENTER KEY 
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,ITSSPC))GO TO 200 
C 
C  IS TS# BETWEEN 0 AND 9999?  IF NOT GENERATE ERR
C 
      IF(ISBTW(ITSSPC,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.) GOTO 200
      ITSNA5=I
C 
C  A GOOD SET OF NUMBERS -- PUT IN A FROM COMPATIBLE WITH TMP 
C 
300   ITSNAM=100000B
      ITSNAM(4)=ITSSPC
      RETURN
C 
C  OBVIOUS ERROR DETECTED BY THE I/O MODULE.
C 
200   LITE1=128 
      GOTO 1060 
C 
C   ENTRY POINT FOR GENERATING STRING FOR THE DISPLAY/LIGHT/... 
C 
C 
C  CHECK FOR DISPLAY -- IF REQUIRED MOVE "ESC J" TO FRONT OF BUFFER 
C 
1121  IF(.NOT.ISBIT(OUTDEV,0))GO TO 1127
C     CALL MOVCA(IESCJ,1,MSGBFR,MBLN+1,2) 
C     MBLN=MBLN+2 
C 
C  MOVE OUTPUT STRING (IF EXISTS) PROVIDED BY ZTMP INTO TERMINAL MESSAGE BFR. 
C 
C1127  WRITE(1,11279) OTBFLN,OTBFLN 
C11279 FORMAT("IOM75 AFTER 1127 : OTBFLN="I6", OTBFLN="@6)
1127  IF(OTBFLN.EQ.0) GO TO 1128
      CALL MOVCA(OTBUFR,1,MSGBFR,MBLN+1,OTBFLN) 
      MBLN=MBLN+OTBFLN+1
      CALL PUTCA(MSGBFR,6400B,MBLN) 
C 
C  GENERATE LIGHT STRING ONLY IF OUTPUT TO NUMERIC DISPLAY IS SPECIFIED.
C 
1128  IF(IAND(OUTDEV,11B).EQ.1) CALL LIT75(ITRST,LITE1,LITE2,LITE3
     .                          ,MSGBFR,MBLN,OUTDEV)
      GOTO IORTAD 
C 
C*********************************************************************
C 
C 
C  FUNCTION CODE #2 -- READ SECURITY CODE WITHOUT ECHO
C 
C 
C  GO UPDATE DISPLAY
C 
222   ASSIGN 2225 TO IORTAD 
      GOTO 1065 
C 
C  RETURN FROM THE LIGHT/MESSAGE GENERATOR
C 
C  DISABLE THE DISPLAY
C 
2225  CALL DEV75(ITRST,4B,MSGBFR,MBLN,OUTDEV,ERRFL,KEYN)
C 
C  WRITE STRING 
C 
C 
C?????????????????????????????????????????????????????????????????????
D     WRITE(ICOM00,656)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2) 
C?????????????????????????????????????????????????????????????????????
C 
      CALL TMBWR(MSGBFR,-MBLN)
C 
C  READ THE SECURITY CODE 
C 
2226  CALL TMRD(ITEMP,-20)
      LABEL=2226
C     WRITE(1,10719) LABEL,IST,ITL,(ITEMP(IX),IX=1,(ITL+1)/2) 
C 
C --- IF LAST CHARACTER OF INPUT STRING IS CR, DECREMENT ITL. 
C 
      IF(IGETB(ITEMP,ITL).EQ.15B) ITL=ITL-1 
      IF(ITL.LT.0) ITL=0
C 
C  WAS READ COMPLETED BY EQT TIME-OUT?? IF SO, RE-ISSUE READ. 
C 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 2226
C 
C  DISABLE THE KEYBOARD TO PREVENT FURTHER INPUT
C 
      CALL TMBWR(KBDLK,-5)
C 
C  CHECK FOR ATT -- IF ATT, THEN DO ENTIRE FUNCTION AGAIN 
C 
      IKTMP=ITL 
      IF(KEY75(KEYNO,ISFK1,ITEMP,IKTMP))
     *       CALL TMPER(0,99,ITSNUM,LLU,322,KEYNO)
      IF(KEYNO.EQ.0 .AND. ITL.NE.0)GO TO 2241 
C 
C  THE USER USE A SFK OR ATT, RESTART  IFC=1
C 
      OTBFLN=0
      LITE1=0 
      GO TO 111 
C 
C  CONVERT SECURITY CODE TO DECIMAL -- IF CONVERSION ERR, DO AGAIN
C 
2241  IF(INUM(ITEMP,1,ITL,I))GO TO 1065 
      IF(FLOAT(I).LT.-32767. .OR. FLOAT(I).GT.32767.)GO TO 1065 
      ITSNA5=I
      RETURN
C 
C*********************************************************************
C 
C 
C  FUNCTION CODE # 3 -- TERMINAL FEATURE CHECK
C 
C 
C  CHECK FEATURES REQUIRED WITH FEATURES OF TERMINAL
C 
333   ISTATS=0
C 
C  ISOLATE PRODUCT NUMBER FROM TERM. STATUS 
C 
      IPROD=IAND(IGETB(ITRST,1),7B) 
C     WRITE(6,33399) IPROD,ISTATS 
C33399 FORMAT(" IOM75 : IPROD="@7", ISTATS="@7) 
C 
C  IF TIME REPORTING REQUESTED BUT TERM NOT A 3077 --> ERROR
C 
      IF(IPROD.LT.2.AND.ISBIT(ITT,10))ISTATS=1
C     WRITE(6,33398) ISTATS 
C33398 FORMAT(" IOM75 : ISTATS="@7) 
C 
C  IF TERM IS 3077 BUT TIME REPORTING NOT REQUESTED --> ERROR 
C 
      IF(IPROD.EQ.2.AND.(.NOT.ISBIT(ITT,10)))ISTATS=1 
C     WRITE(6,33398) ISTATS 
C 
C  CHECK REST OF FEATURES (SEE TGP IMS FOR WORD FORMAT) 
C     (PRT,BG3,BG5,AKB,ADS) 
      DO 335 I=3,7
335   IF(ISBIT(ITT,I).AND.(.NOT.ISBIT(ITRST,I)))ISTATS=1
C     WRITE(6,33398) ISTATS 
C 
C --- (CRT,MSR,WND) 
C 
      DO 336 I=1,3
         IF(ISBIT(ITT0,I-1).AND.(.NOT.ISBIT(ITRST,I+10))) ISTATS=1
336   CONTINUE
C     WRITE(6,33398) ISTATS 
C 
C CHECK FOR MORE PROMPTING LIGHTS USED THAN THE TERMINAL HAS!!!!!!!!
C 
      IF(IGETB(INBUFR,2).GT.14)ISTATS=1 
C     WRITE(6,33699) IPROD,ITT,ITT0,ITRST,INBUFR,ISTATS 
C33699 FORMAT(" IOM75 : "6@7) 
      RETURN
C 
C 
C********************************************************************** 
C 
C 
C  FUNCTION CODE #4 -- RESET THE TERMINAL AND THEN
C                      ENABLE/DISABLE SFK'S AS REQUIRED BY TGP WORDS
C 
C 
444   IF(HP3077)RETURN
      CALL TMBWR(IRST,1)
C 
C  SET RETURN ADDRESS IN CASE TERM. IS DOWN 
C 
      ASSIGN 444 TO ITSNA5
C 
C  GENERATE SFK STRING
C 
      ASSIGN 4446 TO IORTAD 
      CALL SFK75(ITRST,ISFK1,ISFK2,MSGBFR,MBLN) 
C 
C  WRITE STRING TO TERMINAL AND GET THE TERMINAL STATUS 
C 
      GOTO 100
C 
C  RETURN FROM THE RESET/GET TERMINAL STATUS SECTION
C 
4446  CONTINUE
      IF(ISBIT(IST,4))GO TO 444 
      RETURN
C 
C*********************************************************************
C 
C  FUNCTION CODE #5 -- WRITE, READ, AND WRITE/READ
C 
C  CHECK POWERFAIL BIT
C 
555   CONTINUE
      IF(.NOT.ISBIT(OUTDEV,15))GO TO 5555 
C 
C  SET RETURN ADDRESS IN CASE TERMINAL IS DOWN
C 
      ASSIGN 555 TO ITSNA5
C 
C  RESET THE TERMINAL IF NECESSARY
C 
      CALL SETBT(OUTDEV,15,0) 
5552  CALL TMBWR(IRST,1)
5553  ASSIGN 5555 TO IORTAD 
      CALL SFK75(ITRST,ISFK1,ISFK2,MSGBFR,MBLN) 
      GO TO 100 
C 
C  CHECK TO SEE THAT AT LEAST ONE BUFFER LENGTH IS POSITIVE 
C      IF NOT, THEN ERROR!!!
C 
5555  CONTINUE
C 
C?????????????????????????????????????????????????????????????????????
D     WRITE(ICOM00,6566)IFC,INPDEV,INBFLN,OUTDEV,OTBFLN 
D6566 FORMAT(1X,"/IOM75: IFC=",I2," INPDEV=",@8," INBFLN=",I3,
D    *" OUTDEV=",@8," OTBFLN=",I3)
C     WRITE(1,65669) OUTDEV,INPDEV,ITSNAM,OTBFLN,OTBUFR 
C65669 FORMAT("***** IOM75 AFTER 5555="4@7,30A2)
C?????????????????????????????????????????????????????????????????????
C 
      IF(OTBFLN.GT.0.OR.LITE1.NE.0.OR.LITE2.NE.0.OR.LITE3.NE.0)GO TO 590
      IF((LITE1+LITE2+LITE3) .EQ. 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 
5556  CALL TMPER(0,99,ITSNUM,LLU,320,OTBFLN)
C 
C  PERFORM THE OUTPUT SECTION OF IFC=5
C 
590   MBLN=0
C 
C  CHECK FOR HP 3077 AND WAITING FOR TC, IF TRUE THEN GEN. TC 
C 
      IF(HP3077.AND.WAITC) GO TO 580
C 
C  ENABLE APPROPRIATE OUTPUT DEVICE 
C 
      IF(OUTDEV.EQ.0)CALL TMPER(0,99,ITSNUM,LLU,321,OUTDEV) 
C 
C  CONSTRUCT APPROPRIATE COMMAND WORD FOR 'DEV75'