FTN4,L
      PROGRAM TXTR0(3,89),91711-16022  REV 1926  791112 
C 
C     CHANGED 791112. IF ILUT=0, DO NOT ATTEMPT TO WRITE
C     ERROR MESSAGES TO ILUT.         
C 
C 
C************************************** 
C* TXTR0                              * 
C* PRIMARY SYSTEM RS232 TERMINAL TEST * 
C* RELOC.: 91711-16022                * 
C* SOURCE: 91711-18022                * 
C************************************** 
C 
C 
C THIS PROGRAM IS FOR TESTING KEYBOARD & DISPLAY OPERATION OF 
C DVR00 TYPE DEVICES. VARIABLES USED IN THIS PROGRAM ARE AS FOLLOWS:
C 
C IBUFD......DATA STORED IN PROGRAM TO BE OUTPUT TO DISPLAY 
C IBUFT......DATA STORED ON KEYBOARD INPUT TO BE CHECKED AGAINST
C            THAT IN IBUFD
C IREG.......A & B REGISTERS FOR EXEC CALL PARAMATER RETURN 
C IA.........A REGISTER (NOT USED IN THIS PROGRAM)
C IB.........B REGISTER, USED FOR CHARACTER TRANSFER COUNT
C IQUE.......PROMPT CODE FROM KEYBOARD FOR ABORT OR CONTINUE
C IPRAM(1)...VARIABLE TO PASS PARAMATER OF LOG DEVICE LU
C IPRAM(2)...VARIABLE TO PASS PARAMATER OF TEST DEVICE LU 
C LGLU.......LOG DEVICE LU
C ILUT.......TEST DEVICE LU 
C ISTAT1.....EQT WORD 5 
C ISTAT2.....EQT WORD 4 
C ISTAT3.....BIT 15 OF THIS VARIABLE GIVES STATUS OF LU 
C MLU........MASK OF ISTAT2 FOR CHECK OF PROPER LU ASSIGNMENT 
C MTYP.......MASK OF ISTAT1 FOR CHECK OF PROPER DEVICE TYPE 
C MAV........MASK OF ISTAT1 & ISTAT3 FOR EQT & LU AVAILABILITY
C 
      DIMENSION IBUFD(40), IREG(2), IQUE(1), IPRAM(5), IBUFT(40)
      EQUIVALENCE (REG,IREG,IA), (IREG(2),IB) 
      DATA IBUFD/2HU*,2H3L,2HG8,2H =/ 
      CALL RMPAR(IPRAM) 
C 
C INITIALIZE ERROR COUNTER TO 0 
C 
      IERR=0
C 
C ASSIGN LOG DEVICE LU
C 
      LGLU=IPRAM(1) 
      IF(IPRAM(1).LE.0) LGLU=LOGLU(IPRAM(1))
C 
C ASSIGN TEST DEVICE LU 
C 
      IF(IPRAM(2).LE.0) GOTO 8120 
   30 ILUT=IPRAM(2) 
C 
C*********************************************************************
C*                  SECTION 100 - GET LU & VERIFY 
C*********************************************************************
C 
      CALL EXEC(13,ILUT,ISTAT1,ISTAT2,ISTAT3) 
C 
C CHECK GENERATED LU ASSIGNMENT OF TEST DEVICE
C 
      MLU=IAND(ISTAT2,77B)
      IF(MLU) 8000,8000,100 
C 
C CHECK FOR PROPER TEST DEVICE TYPE 
C 
  100 MTYP=IAND(ISTAT1,37400B)
      IF(MTYP) 8100,110,8100
C 
C CHECK FOR TEST DEVICE EQT AVAILABILITY
C 
  110 MAV=IAND(ISTAT1,140000B)
      IF(MAV) 8200,120,8200 
C 
C CHECK FOR TEST DEVICE LU AVAILABILITY 
C 
  120 MAV=IAND(ISTAT3,100000B)
      IF(MAV) 8200,1000,8200
C 
C*********************************************************************
C*                  SECTION 1000 - KEYBOARD/DISPLAY TESTS 
C*********************************************************************
C 
 1000 IF(ILUT-LGLU) 1005,1007,1005
 1005 WRITE(LGLU,1010) ILUT 
 1007 WRITE(ILUT,1010) ILUT 
 1010 FORMAT(/"  TXTR0 - LU#",I3,":  RS232 TERMINAL TEST RUNNING")
C 
C DATA TRANSFER TEST FOR KEYBOARD/DISPLAY WITH ECHO 
C 
      IF(ILUT-LGLU) 1012,1015,1012
 1012 WRITE(LGLU,1020) ILUT 
 1015 WRITE(ILUT,1020) ILUT 
 1020 FORMAT(/"  TXTR0 - LU#",I3,":"/ 
     1"          TYPE THE FOLLOWING CHARACTERS, THEN PRESS THE RETURN"/ 
     2"          KEY. THE CHARACTERS SHOULD ECHO ON THE TEST DISPLAY"/
     3"          AS THEY ARE TYPED."/"          U*3LG8 ="/"          _")
      REG=EXEC(1,ILUT+400B,IBUFT,4) 
C 
C VERIFY TRANSFERRED DATA 
C 
      DO 1030 I=1,IB
      IF(IBUFD(I).EQ.IBUFT(I)) GOTO 1030
      GOTO 8300 
 1030 CONTINUE
C 
C TEST FOR LINE SPACING ON DISPLAY
C 
 1055 IF(ILUT-LGLU) 1056,1057,1056
 1056 WRITE(LGLU,1060) ILUT 
 1057 WRITE(ILUT,1060) ILUT 
 1060 FORMAT(/"  TXTR0 - LU#",I3,":"/
     1"          THERE SHOULD BE 5 LINES OF SPACE BETWEEN THIS" 
     2" LINE...") 
      CALL EXEC(3,ILUT+1100B,5) 
      IF(ILUT-LGLU)1065,1067,1065 
 1065 WRITE(LGLU,1070)
 1067 WRITE(ILUT,1070)
 1070 FORMAT("          ...AND THIS LINE.") 
      IF(ILUT-LGLU) 1075,1077,1075
 1075 WRITE(LGLU,1080) ILUT,IERR
 1077 WRITE(ILUT,1080) ILUT,IERR
 1080 FORMAT(/"  TXTR0 - LU#",I3,":  RS232 TERMINAL TEST FINISHED   " 
     1,I2," ERRORS"/) 
      GOTO 9900 
C 
C*********************************************************************
C*                  SECTION 8000 - ERROR MESSAGES 
C*********************************************************************
C 
 8000 WRITE(LGLU,8010) ILUT 
 8010 FORMAT(/"  TXTR0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 9900 
 8100 WRITE(LGLU,8110) ILUT 
 8110 FORMAT(/"  TXTR0 - LU#",I3," IS NOT ASSIGNED TO RS232 TERMINAL."/ 
     1"          RERUN TEST SPECIFYING CORRECT LU#.") 
      GOTO 9000 
 8120 WRITE(LGLU,8125)
 8125 FORMAT(/"  TXTR0 - LU# SPECIFIED FOR RS232 TERMINAL IS ILLEGAL."/ 
     1"          RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") 
      GOTO 9000 
 8200 WRITE(LGLU,8210) ILUT 
 8210 FORMAT(/"  TXTR0 - LU#",I3,": EQT OR LU FOR TEST TERMINAL IS" 
     1" DOWN."/"          UP EQT AND RERUN TEST.")
      GOTO 9000 
C 
C REQUEST TO ABORT OR CONTINUE
C 
 8300 WRITE(ILUT,8310) ILUT 
 8310 FORMAT(/"  TXTR0 - LU#",I3,": DATA ENTRY OR TRANSMISSION ERROR."/ 
     1"          TYPE  /C  TO CONTINUE NEXT TEST OR TYPE  /A  TO ABORT"/
     2"          THIS TEST: _") 
      IERR=IERR+1 
      CALL EXEC(1,ILUT+400B,IQUE,1) 
      IF(IQUE.EQ.2H/C) GOTO 1055
      IF(IQUE.EQ.2H/A) GOTO 9000
      GOTO 8300 
C 
C*********************************************************************
C*                  SECTION 9000 - ABORT MESSAGE AND TERMINATE
C*********************************************************************
C 
 9000 IF(ILUT-LGLU) 9005,9010,9005
 9005 WRITE(LGLU,9015) ILUT 
C 
C     FOLLOWING LINE ADDED 791112 
      IF(ILUT.LE.0) GO TO 9900
C 
 9010 WRITE(ILUT,9015) ILUT 
 9015 FORMAT(/"  TXTR0 - LU#",I3,":  RS232 TERMINAL TEST ABORTED!"/)
 9900 END 
      END$
                                                                                                                                                                                                                                