FTN4
      FUNCTION STRAP(LU,ITEMP,LOCKW), 92080-1X597 REV.2026  800510
C 
C 
C     SOURCE: &STRAP    92080-18597 
C 
C     PMGR:   TOM HIRATA
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     THIS PROGRAM IS A PART OF THE:
C 
C                      DATA CAPTURE SOFTWARE
C                        ( D A T A C A P )
C 
C 
C     THIS FUNCTION WILL GET THE STATUS BYTES OF A 2645/8 THAT PERTAIN TO 
C     THE LATCHING KEYS, MEMORY LOCK, AND KEYBOARD INTERFACE SWITCHES A-Z 
C     AS PER THE 2645/8 REFERENCE MANUAL.  THE STATUS BYTES ARE NOT ALTERED 
C     BUT STORED AWAY WITHOUT MODIFICATION & RETURNED TO THE USER.
C 
C     CALL:         DIMENSION ITEMP(5)
C                   LOGICAL STRAP 
C                       . 
C                       . 
C                       . 
C                   IF(STRAP(LU,ITEMP)) GO TO ERROR 
C                   (NORMAL RETURN) 
C                   WHERE LU=LU OF TERMINAL TO GET STRAP SETTINGS FROM
C                         ITEMP=5 WORD BUFFER WHERE THE STRAP SETTINGS
C                               ARE RETURNED TO THE CALLER. 
C     RETURN:       ITEMP BYTE# 1  A-D
C                               2  E-H
C                               3  J-M
C                               4  N-R
C                               5  S-V
C                               6  W-Z
C                               7  MEMORY LOCK
C                               8  LATCHING KEYS
C 
C     ERROR RETURN: ITEMP(1)=1  UNABLE TO GET STATUS OF LU
C                           =3  UNABLE TO CLEAR G AND H STRAPS
C 
C 
      DIMENSION ITEMP(1), 
     .          IBUF1(5), 
     .          IBUF2(5), 
     .         IGANDH(4)
      LOGICAL STRAP 
      DATA IGANDH/2H&,2Hs0,2Hg0,44000B/
      STRAP=.TRUE.
      ISTAT1=15536B 
      ISTAT2=15576B 
C 
C --- CLEAR STRAPS G AND H BEFORE STARTING, THEY WILL NOT GET 
C     TURNED BACK ON IF THEY WERE SET TO 1. 
C 
      CALL EXEC(100000B+2,2400B+LU,IGANDH,4,0,0,0,0,LOCKW)
      GO TO 75
C 
C --- GET PRIMARY STATUS
C 
      CALL EXEC(100000B+2,2400B+LU,ISTAT1,1,0,0,0,0,LOCKW)
C     PAUSE 1 
      GO TO 80
5     CALL EXEC(100000B+1,LU,IBUF1,5,0,0,0,0,LOCKW) 
C     PAUSE 2 
      GO TO 80
C 
C --- ERROR IF NOT 2645/8 
C 
C10    WRITE(1,10999) IBUF1,IBUF1 
C10999 FORMAT("IBUF1="5A2", IBUF1="5@7) 
10    IF(IBUF1.NE.15534B) GO TO 85
C 
C --- GET SECONDARY STATUS
C 
      CALL EXEC(100000B+2,2400B+LU,ISTAT2,1,0,0,0,0,LOCKW)
C     PAUSE 3 
      GO TO 80
15    CALL EXEC(100000B+1,LU,IBUF2,5,0,0,0,0,LOCKW) 
C     PAUSE 4 
      GO TO 80
C 
C --- ERROR IF NOT 2645/8 
C 
C20    WRITE(1,20999) IBUF2,IBUF2 
C20999 FORMAT("IBUF2="5A2", IBUF2="5@7) 
20    IF(IBUF2.NE.15574B) GO TO 85
C 
C --- PUT STATUS BYTES INTO ITEMP 
C 
C 
C --- GET PRIMARY BYTES 
C 
      DO 25, I=4,5
         CALL PUTCA(ITEMP,IGET1(IBUF1,I),I-3) 
25    CONTINUE
         CALL PUTCA(ITEMP,IGET1(IBUF1,6),8) 
C 
C --- GET SECONDARY BYTES.
C 
      DO 30, I=5,9
         CALL PUTCA(ITEMP,IGET1(IBUF2,I),I-2) 
30    CONTINUE
C 
C --- ALL DONE
C 
      STRAP=.FALSE. 
      GO TO 99
C 
C --- ERROR SECTION.
C 
C --- UNABLE TO CLEAR G AND H STRAPS AT START 
C 
75    ITEMP=3 
      GO TO 99
C 
C --- UNABLE TO GET STATUS OF LU. 
C 
80    ITEMP=1 
      GO TO 99
C 
C --- LU IS NOT 2645/8
C 
85    ITEMP=2 
      GO TO 99
C 
C --- RETURN
C 
99    RETURN
      END 
      END$
                  