FTN4,L
      PROGRAM TXTD0(3,89),91711-16023  REV 1926  790428 
C 
C 
C*******************************************
C* TXTD0                                   *
C* PRIMARY SYSTEM DATA ENTRY TERMINAL TEST *
C* RELOC.: 91711-16023                     *
C* SOURCE: 91711-18023                     *
C*******************************************
C 
C 
C *** QUICK VERIFICATION FOR THE 3070A/3070B DATA ENTRY TERMINAL ***
C 
C 
C 
C 
C 
C        DESCRIPTION: 
C        ------------ 
C 
C     THE PROGRAM  "TXTD0"  WILL INTERACT WITH THE OPERATOR AND 
C     TEST THE NUMERIC DISPLAY, ALL PROMPTING LED'S, THE KEYBOARD,
C     ALL SPECIAL FUNCTION KEYS, THE MULTIFUNCTION READER AND THE 
C     ALPHANUMERIC STRIP PRINTER. 
C 
C 
C 
C 
C        OPERATING PROCEDURE: 
C        -------------------- 
C 
C     SCHEDULE THE PROGRAM "TXTD0" USING THE RUN COMMAND: 
C 
C             *RU,TXTD0,LGLU,LU 
C 
C             WHERE LGLU = INTERACTIVE CONSOLE L.U. 
C                           <DEFAULT =1>
C 
C                     LU = 3070A/3070B TERMINAL L.U.
C 
C 
C 
C 
C        TEST STEPS:
C        -----------
C 
C            01 - NUMERIC KEYPAD TEST 
C            02 - SPECIAL FUNCTION KEY TEST 
C            03 - READER TEST 
C            04 - PRINTER TEST
C 
C 
C 
C 
C        ERROR CODES: 
C        ------------ 
C 
C            E1 - OPERATOR ERROR (WRONG KEY)
C            E2 - TRANSMISSION LOG ERROR (TOO MANY KEYS)
C            E3 - STATUS ERROR
C            E4 - CARD READER ERROR DIAGNOSTIC CARD #1
C            E5 - CARD READER ERROR DIAGNOSTIC CARD #2
C            E6 - PRINTER ERROR (PRINTER OFF OR END OF PAPER) 
C 
C 
C 
C 
C 
C 
      DIMENSION IBUFR(100),KARD1(80),KARD2(80),KEY(12)
      DIMENSION MSG(8),IPARM(5),IFAIL(6),ITEST(4) 
C 
C 
C     *** DIAGNOSTIC CARD #1 ***
C 
C 
      DATA KARD1/7777B,0000B,4000B,2000B,1000B,0400B,0200B,0100B, 
     1           0040B,0020B,0010B,0004B,0002B,0001B,3777B,5777B, 
     2           6777B,7377B,7577B,7677B,7737B,7757B,7767B,7773B, 
     3           7775B,7776B,5252B,2525B,5252B,2525B,5252B,2525B, 
     4           5252B,2525B,5252B,2525B,5252B,2525B,5252B,2525B, 
     5           0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 
     6           0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 
     7           0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 
     8           0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 
     9           0000B,0000B,0000B,0000B,0000B,0000B,2100B,0010B/ 
C 
C 
C     *** DIAGNOSTIC CARD #2 ***
C 
C 
      DATA KARD2/5403B,4401B,4201B,4101B,0005B,1023B,1013B,1007B, 
     1           2011B,4021B,1021B,4103B,4043B,4023B,4013B,4007B, 
     2           6403B,2401B,2201B,2101B,0043B,0023B,0201B,1011B, 
     3           2003B,2403B,0007B,1005B,2043B,2023B,2013B,2007B, 
     4           0000B,4006B,0006B,0102B,2102B,1042B,4000B,0022B, 
     5           4022B,2022B,2042B,4012B,1102B,2000B,4102B,1400B, 
     6           1000B,0400B,0200B,0100B,0040B,0020B,0010B,0004B, 
     7           0002B,0001B,0202B,2012B,4042B,0012B,1012B,1006B, 
     8           0042B,4400B,0000B,0000B,0000B,0000B,0000B,0000B, 
     9           0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B/ 
C 
C     *** DATA STATEMENTS *** 
C 
      DATA KEY/2H7 ,2H8 ,2H9 ,2H4 ,2H5 ,2H6 , 
     1         2H1 ,2H2 ,2H3 ,2H- ,2H0 ,2H. / 
      DATA IFAIL/2HE1,2HE2,2HE3,2HE4,2HE5,2HE6/ 
      DATA ITEST/2H01,2H02,2H03,2H04/ 
      DATA KLEAR/2H  /,ICODE/100000B/ 
C 
C     *** GET LGLU AND TEST DEVICE LU *** 
C 
      CALL RMPAR(IPARM) 
      LGLU=IPARM(1) 
      IF (IPARM(1).LE.0) LGLU=LOGLU(IPARM(1)) 
      LU=IPARM(2) 
      IF (IPARM(2).LE.0) GOTO 200 
C 
C     *** GET STATUS OF TEST DEVICE LU ***
C 
      CALL EXEC(13,LU,ISTA1,ISTA2,ISTA3)
C 
C     *** CHECK IF LU IS ENABLED ***
C 
      IF (IAND(ISTA2,77B).NE.0) GOTO 110
      WRITE(LGLU,100)LU 
100   FORMAT(/"  TXTD0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 9999 
C 
C     *** CHECK IF DEVICE TYPE IS 47 ***
C 
110   IF (IAND(ISTA1,37400B).EQ.23400B) GOTO 150
      WRITE(LGLU,120)LU 
120   FORMAT(/"  TXTD0 - LU#",I3," IS NOT ASSIGNED TO 3070 TERMINAL."/
     1"          RERUN TEST SPECIFYING CORRECT LU#.") 
      GOTO 220
C 
C     *** CHECK IF LU IS DOWN *** 
C 
150   IF (IAND(ISTA3,ICODE).EQ.0) GOTO 300
      WRITE(LGLU,160)LU 
160   FORMAT(/"  TXTD0 - LU#",I3,": EQT OR LU FOR TEST TERMINAL"
     1" IS DOWN."/"          UP EQT AND RERUN TEST.") 
      GOTO 220
C 
C     *** ILLEGAL TEST LU *** 
C 
200   WRITE(LGLU,210) LU
210   FORMAT(/"  TXTD0 - LU#",I3," SPECIFIED FOR TEST TERMINAL IS"
     1" ILLEGAL."/"          RERUN TEST SPECIFYING AN INTEGER >0" 
     2" AND <64 FOR LU#.")
220   WRITE(LGLU,230) LU
230   FORMAT(/"  TXTD0 - LU#",I3,":  DATA"
     1" ENTRY TERMINAL TEST ABORTED!"/) 
      GOTO 9999 
C 
C     *** CLEAR TERMINAL ***
C 
300   WRITE(LGLU,310)LU 
310   FORMAT(/"  TXTD0 - LU#",I3,":  DATA"
     1" ENTRY TERMINAL TEST RUNNING") 
      IERR=0
      DO 320 I=1,8
      MSG(I)=20040B 
320   CONTINUE
      CALL EXEC(3+ICODE,LU+1400B) 
      GOTO 1000 
330   CALL EXEC(3+ICODE,LU) 
      GOTO 1000 
340   CALL EXEC(3+ICODE,LU+1100B) 
      GOTO 1000 
350   CALL ABREG(IA,IB) 
      ITYPE=IAND(IA,1B) 
      IFLAG=IA
C 
C 
C ********************* START TESTING ********************* 
C 
C 
C     *** DISPLAY ALL SEGMENTS AND ALL PROMTING LED'S *** 
C 
C     ***  WAIT FOR DEL AND ENT KEYS ***
C 
C 
400   DO 410 I=1,16 
      IBUFR(I)=2H8. 
      CALL EXEC(2+ICODE,LU+100B,IBUFR,1)
      GOTO 1000 
410   CONTINUE
      DO 420 LIGHT=97,125,2 
      WRITE(LU)LIGHT
420   CONTINUE
      CALL REIO(1+ICODE,LU+100B,IBUFR(1),-1)
      GOTO 1000 
430   CALL REIO(1+ICODE,LU+100B,IBUFR(2),-1)
      GOTO 1000 
440   IF ((IBUFR(1).NE.77440B).OR.(IBUFR(2).NE.5040B)) IERR=IERR+1
      IF (ITYPE.EQ.0) GOTO 470
C 
C *** BUZZER TEST *** 
C 
      DO 460 I=1,3
      CALL EXEC(2+ICODE,LU,3400B,-1)
      GOTO 1000 
450   CALL EXEC(12,0,1,0,-10) 
460   CONTINUE
470   CALL EXEC(3+ICODE,LU) 
      GOTO 1000 
C 
C 
C ************* TEST 01 - NUMERIC KEYPAD TEST ************* 
C 
C 
C     *** READ FROM KEYBOARD ***
C 
C 
500   MSG(2)=ITEST(1) 
      DO 570 I=1,12 
      MSG(4)=KEY(I)/256+8192
      MSG(7)=KLEAR
510   CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
520   CALL REIO(1+ICODE,LU+500B,IBUFR,-1) 
      GOTO 1000 
530   CALL ABREG(IA,IB) 
      CALL EXEC(3+ICODE,LU) 
      GOTO 1000 
540   IF (IB.EQ.1) GOTO 550 
      IF (MSG(7).NE.KLEAR) GOTO 560 
      MSG(7)=IFAIL(2) 
      GOTO 510
550   IF (IBUFR(1).EQ.KEY(I)) GOTO 570
      IF (MSG(7).NE.KLEAR) GOTO 560 
      MSG(7)=IFAIL(1) 
      GOTO 510
560   IERR=IERR+1 
      GOTO 580
570   CONTINUE
580   CALL EXEC(3+ICODE,LU+1100B) 
      GOTO 1000 
C 
C 
C ********** TEST 02 - SPECIAL FUNCTION KEY TEST ********** 
C 
C 
C     *** WAIT FOR SRQ AND POLL KEYBOARD STATION ***
C 
C 
600   MSG(2)=ITEST(2) 
      MSG(4)=20061B 
      MSG(7)=KLEAR
610   CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
620   CALL EXEC(3+ICODE,LU+1000B) 
      GOTO 1000 
630   CALL EXEC(2+ICODE,LU+2000B,35B,1) 
      GOTO 1000 
640   CALL EXEC(13,LU,IEQT5)
      IF (IEQT5.EQ.23435B) GOTO 700 
      IF (MSG(7).NE.KLEAR) GOTO 650 
      MSG(7)=IFAIL(3) 
      GOTO 610
650   IERR=IERR+1 
C 
C     *** READ SPECIAL FUNCTION KEYS ***
C 
700   DO 710 I=2,10+ITYPE 
      CALL EXEC(3+ICODE,LU+1200B,I) 
      GOTO 1000 
710   CONTINUE
      DO 770 I=2,10+ITYPE 
      MSG(4)=KCVT(I)
      MSG(7)=KLEAR
720   IBUFR(1)=0
      CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
730   CALL REIO(1+ICODE,LU+400B,IBUFR,10) 
      GOTO 1000 
740   CALL ABREG(IA,IB) 
      IF (IB.EQ.0) GOTO 750 
      IF (MSG(7).NE.KLEAR) GOTO 760 
      MSG(7)=IFAIL(2) 
      GOTO 720
750   IF (IAND(IA,17B).EQ.I) GOTO 770 
      IF (MSG(7).NE.KLEAR) GOTO 760 
      MSG(7)=IFAIL(1) 
      GOTO 720
760   IERR=IERR+1 
      GOTO 780
770   CONTINUE
780   CALL EXEC(3+ICODE,LU) 
      GOTO 1000 
790   CALL EXEC(3+ICODE,LU+1100B) 
      GOTO 1000 
C 
C 
C ********** TEST 03 - MULTIFUNCTION READER TEST ********** 
C 
C 
C     *** READ PUNCHED CARD *** 
C 
C 
800   IF (IAND(IFLAG,3B).NE.3B) GOTO 900
      MSG(2)=ITEST(3) 
      MSG(4)=20061B 
      MSG(7)=KLEAR
      CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
805   CALL EXEC(2+ICODE,LU+2100B,37400B,-1) 
      GOTO 1000 
810   CALL EXEC(3+ICODE,LU+1200B,1) 
      GOTO 1000 
C 
C 
C ** READER CONFIGURATION: IMAGE MODE, MARKS+HOLES
C                          CLOCK AFTER DATA, LOCAL REJECT 
C 
815   CALL EXEC(3+ICODE,LU+600B,27B)
      GOTO 1000 
820   CALL REIO(1+ICODE,LU+1000B,IBUFR,80)
      GOTO 1000 
825   CALL ABREG(IA,IB) 
      IF (IAND(IA,17B).EQ.1) GOTO 880 
      IF (IB.NE.80) MSG(7)=IFAIL(4) 
      DO 830 I=1,80 
      IF (IBUFR(I).EQ.KARD1(I)) GOTO 830
      MSG(7)=IFAIL(4) 
830   CONTINUE
      MSG(4)=20062B 
      CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
835   CALL EXEC(2+ICODE,LU+2100B,37400B,-1) 
      GOTO 1000 
C 
C 
C ** READER CONFIGURATION: IMAGE MODE, HOLES ONLY 
C                          NO CLOCK MARKS, LOCAL REJECT 
C 
840   CALL EXEC(3+ICODE,LU+600B,22B)
      GOTO 1000 
845   CALL REIO(1+ICODE,LU+1000B,IBUFR,80)
      GOTO 1000 
850   CALL ABREG(IA,IB) 
      IF (IAND(IA,17B).EQ.1) GOTO 880 
      IF (IB.NE.66) MSG(7)=IFAIL(5) 
      DO 860 I=1,66 
      IF (IBUFR(I).EQ.KARD2(I)) GOTO 860
      MSG(7)=IFAIL(5) 
860   CONTINUE
      IF (MSG(7).EQ.KLEAR) GOTO 890 
      CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
870   CALL EXEC(12,0,2,0,-3)
880   IERR=IERR+1 
890   CALL EXEC(3+ICODE,LU) 
      GOTO 1000 
C 
C 
C ************** TEST 04 - STRIP PRINTER TEST **************
C 
C 
C     *** PRINT ASCII CHARACTER SET *** 
C 
C 
900   CALL EXEC(3+ICODE,LU+1100B) 
      GOTO 1000 
905   CALL ABREG(IA,IB) 
      IF (IAND(IA,5B).NE.5) GOTO 990
      MSG(2)=ITEST(4) 
      MSG(4)=KLEAR
      MSG(7)=KLEAR
      IF (IAND(IA,40B).EQ.0) GOTO 910 
      MSG(7)=IFAIL(6) 
      GOTO 970
910   CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
915   CALL EXEC(2+ICODE,LU+2100B,37400B,-1) 
      GOTO 1000 
920   IBUFR(1)=20041B 
      DO 925 I=1,31 
      IBUFR(I+1)=IBUFR(I)+514 
925   CONTINUE
      CALL EXEC(2+ICODE,LU+1100B,IBUFR,32)
      GOTO 1000 
930   IBUFR(1)=5012B
      IBUFR(2)=5012B
      IBUFR(3)=5012B
      CALL EXEC(2+ICODE,LU+1100B,IBUFR,3) 
      GOTO 1000 
940   DO 960 I=1,100
      CALL EXEC(3+ICODE,LU+1100B) 
      GOTO 1000 
950   CALL ABREG(IA,IB) 
      IF (IAND(IA,10B).EQ.0) GOTO 990 
960   CONTINUE
      MSG(7)=IFAIL(3) 
970   IERR=IERR+1 
      CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
980   CALL EXEC(12,0,2,0,-3)
990   GOTO 1020 
C 
C     *** TESTING COMPLETED *** 
C 
1000  CALL ABREG(IA,IB) 
      IERR=IERR+1 
      WRITE(LGLU,1010)LU,IA,IB
1010  FORMAT(/"  TXTD0 - LU#",I3,": DATA TRANSMISSION ERROR."/
     1"          ERROR REPORTED A=",@6," B=",@6)
      GOTO 220
1020  CALL EXEC(3+ICODE,LU) 
      GOTO 1000 
1030  IF (IERR.EQ.0) GOTO 1060
      CALL CODE 
      WRITE(MSG,1040) 
1040  FORMAT("      E ",4(2H  ))
      MSG(3)=KCVT(IERR) 
1050  CALL EXEC(2+ICODE,LU,MSG,8) 
      GOTO 1000 
1060  WRITE(LGLU,1070)LU,IERR 
1070  FORMAT(/"  TXTD0 - LU#",I3,":  DATA ENTRY"
     1" TERMINAL TEST FINISHED   ",I3," ERRORS"/) 
9999  END 
      END$