FTN4,L
      PROGRAM TXWL0(3,89), 91711-16119 REV.2040 800728
C 
C 
C     NAME:   TXWL0 
C     SOURCE: 91711-18119 
C     RELOC:  91711-16119 
C     PGMR:   R.W. (BOISE)
C 
C****************************************************************** 
C  (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS        * 
C  RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,         * 
C  REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT   * 
C  THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.          * 
C****************************************************************** 
C 
C 
C 
C THIS TEST IS FOR CHECKOUT OF LINE PRINTERS USING DRIVER DVA12 OR DVB12
C 
C VARIABLE NAMES USED IN THIS PROGRAM ARE AS FOLLOWS: 
C     IBUF0-10..BUFFERS CONTAINING DATA TO BE PRINTED 
C     IPRAM(1)..LOG DEVICE LU 
C     IPRAM(2)..PROGRAM MODE(1 FOR VERIFICATION,2 FOR DIAGNOSTICS)
C     IPRAM(3)..TEST DEVICE LU
C     IPRAM(4)..LINE PRINTER CODE(1 FOR A 2608,2 FOR A 2619,3 FOR 
C               A STANDARD PRINTER UNDER DVA12) 
C     ILUL......PROGRAM NAME FOR LOG LU 
C     ILUT......PROGRAM NAME FOR TEST LU
C     MLU.......MASK OF ISTAT2 FOR CHECK IF LU IS ASSIGNED
C     MTYP......MASK OF ISTAT1 FOR DEVICE TYPE CHECK
C     MAV.......MASK OF ISTAT1 FOR DEVICE AVAILABILITY CHECK
C               AND STATUS
C     ISTAT1....EQT WORD 5
C     ISTAT2....EQT WORD 4
C     ISTAT3....WORD WHICH GIVES LU STATUS & SUBCHANNEL 
C     ISTR......BUFFER LOCATION FOR PROGRAMMABLE STATUS READ
C     IDOT......BUFFER LOCATION FOR DOT MATRIX & PING-PONG READ 
C     ITYPE.....INPUT FROM CRT SPECIFYING THE TYPE OF THE PRINTER 
C               BEING TESTED
C     IPRGM.....PROGRAM NAME FOR THE PROGRAM MODE 
C     IPRNT.....VARIABLE USED TO DESCRIBE THE TYPE OF PRINTER 
C               BEING TESTED(1-2608,2-2619,3-STANDARD)
C     ITSTN.....NUMBER OF DIAGNOSTIC TESTS CURRENTLY AVAILABLE
C               TO THE OPERATOR - 7 FOR THE 2608,5 FOR THE
C               2619,2 FOR A STANDARD PRINTER UNDER DVA12 
C     ICNWD.....CONTROL WORD USED IN CALLS TO THE EXECUTIVE 
C     IRPT......NUMBER OF TIMES A PARTICULAR DIAGNOSTIC TEST
C               WILL BE REPEATED
C     ITEST.....VARIABLE WHICH CONTAINS THE TEST NO.
C     NUM.......3 ELEMENT ARRAY WHICH CONTAINS INPUT FROM CRT 
C 
C 
      DIMENSION IBUF0(40),IBUF1(40),IBUF2(41),IBUF3(40),IBUF4(40) 
     1,IBUF5(22),IPRAM(5),ISTR(258),IDOT(1154),IBUF6(66),IBUF7(66)
     1,IBUF8(66),IBUF9(66),IBUF10(256),ITYPE(2),NULL(27)
      DATA IBUF0/2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP,2HQR,2HST, 
     12HUV,2HWX,2HYZ,2H01,2H23,2H45,2H67,2H89,2H!",2H #/
      DATA IBUF1/2H$%,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43,2H21,
     12H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,2HPQ/ 
      DATA IBUF2/2H0$,2H%&,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43,
     12H21,2H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,1HP/ 
      DATA IBUF3/2H*A,2H C,2H E,2H G,2H I,2H K,2H M,2H O,2H Q,2H S, 
     12H U,2H W,2H Y,2H 0,2H 2,2H 4,2H 6,2H 8,2H !,2H "/
      DATA IBUF4/2H B,2H D,2H F,2H H,2H J,2H L,2H N,2H P,2H R,2H T, 
     12H V,2H X,2H Z,2H 1,2H 3,2H 5,2H 7,2H 9,2H #,2H $/
      DATA IBUF5/2H1 ,2H  ,2H  ,2H  ,2H  ,2HTO,2HP ,2HOF,2H F,2HOR,2HM!/
      DATA IBUF6/5*2HUU,2H*U,4*2HUU,2HU*,5*2HUU,2H*U,4*2HUU,
     12HU*,5*2HUU,2H*U,4*2HUU,2HU*,5*2HUU,2H*U,4*2HUU,2HU*, 
     15*2HUU,2H*U,4*2HUU,2HU*,5*2HUU,2H*U,4*2HUU,2HU*/
      DATA IBUF7/5*2H**,2HU*,4*2H**,2H*U,5*2H**,2HU*,4*2H**,
     12H*U,5*2H**,2HU*,4*2H**,2H*U,5*2H**,2HU*,4*2H**,2H*U, 
     15*2H**,2HU*,4*2H**,2H*U,5*2H**,2HU*,4*2H**,2H*U/
      DATA IBUF8/4*2H00,4*2H11,4*2H22,4*2H33,4*2H44,4*2H55, 
     14*2H66,4*2H77,4*2H88,4*2H99,4*2H00,4*2H11,4*2H22,4*2H33,
     14*2H44,4*2H55,2*2H66/ 
      DATA IBUF9/66*2HUU/ 
      DATA NULL/27*2H  /
      CALL EXEC(22,1) 
      CALL RMPAR(IPRAM) 
C 
C ASSIGN LOG DEVICE LU
C 
      ILUL=IPRAM(1) 
      IF(IPRAM(1).LE.0) ILUL=LOGLU(IPRAM(1))
C 
C ASSIGN TEST DEVICE LU 
C 
      IF(IPRAM(3).LE.0) GOTO 8020 
   40 ILUT=IPRAM(3) 
C 
C*********************************************************************
C*                  SECTION 100 - GET LU AND VERIFY                  *
C*********************************************************************
C 
      CALL EXEC(13,ILUT,ISTAT1,ISTAT2,ISTAT3) 
C 
C CHECK TO SEE IF LU WAS ASSIGNED 
C 
      MLU=IAND(ISTAT2,77B)
      IF(MLU) 8000,8000,100 
C 
C CHECK FOR PROPER DEVICE TYPE
C 
  100 MTYP=IAND(ISTAT1,37400B)
      IF(MTYP-5000B) 8100,110,8100
C 
C CHECK FOR TEST DEVICE AVAILABILITY
C 
  110 MAV=IAND(ISTAT1,140000B)
      IF(MAV) 8200,120,8200 
C 
C CHECK TO SEE IF LU IS UP
C 
  120 MAV=IAND(ISTAT3,100000B)
      IF(MAV) 8200,200,8200 
C 
C*********************************************************************
C*         SECTION 200 - TEST PRINTER SELECTION                      *
C*********************************************************************
C 
C THIS SECTION GETS THE CODE NO. FOR THE PRINTER TO BE TESTED 
C AND THEN JUMPS TO THE APPROPRIATE SET OF TESTS
C 
C DEFAULT IS IPRAM(4)=0,IF SO,GO LIST PRINTER CODES 
C 
  200 CALL LURQ(1,ILUT,1) 
      IPRGM=IPRAM(2)
      ICNWD=ILUT+1100B
      IF(IPRAM(4).EQ.0)GOTO 270 
      IF(IPRAM(4).EQ.1)GOTO 400 
      IF(IPRAM(4).EQ.2)GOTO 2500
      IF(IPRAM(4).EQ.3)GOTO 5800
C 
C ILLEGAL PRINTER CODE SPECIFIED AT RUN TIME,SO ABORT TESTS 
C 
      WRITE(ILUL,280) ILUT
  280 FORMAT(/"  TXWL0 - LU#",I3,": ILLEGAL LINE PRINTER CODE"
     1" SPECIFIED AT RUN TIME.")
      GOTO 9020 
C 
C LIST ALL PRINTERS AND THEIR RESPECTIVE CODE NO. 
C 
  270 IF((IPRGM.LT.0).OR.(IPRGM.GT.2))GOTO 480
      WRITE(ILUL,210) 
  210 FORMAT(/,20X,"LINE PRINTER CODES")
      WRITE(ILUL,220) 
  220 FORMAT(/,21X,"PRINTER",5X,"CODE") 
      WRITE(ILUL,230) 
  230 FORMAT(22X,"2608",9X,"1"/,22X,"2619",9X,"2"/, 
     122X,"STANDARD",5X,"3"/,22X,"EXIT",9X,"/E,EN,EX")
  260 WRITE(ILUL,240) 
  240 FORMAT(//"PLEASE ENTER PRINTER CODE? _")
C 
C GET THE PRINTER CODE AND CHECK FOR LEGALITY 
C 
      CALL EXEC(1,ILUL+400B,ITYPE,-4) 
      CALL ABREG(IA,IB) 
      IF(IB.GT.2) GOTO 290
      IF(ITYPE.EQ.2H/E)GOTO 9030
      IF(ITYPE.EQ.2HEN)GOTO 9030
      IF(ITYPE.EQ.2HEX)GOTO 9030
      IF(IB.GT.1)GOTO 290 
      IF(ITYPE.EQ.2H1 )GOTO 400 
      IF(ITYPE.EQ.2H2 )GOTO 2500
      IF(ITYPE.EQ.2H3 )GOTO 5800
C 
C ILLEGAL PRINTER CODE,SO PRINT AN ERROR MESSAGE AND GO GET CORRECT CODE
C 
  290 WRITE(ILUL,250) ILUT
  250 FORMAT(/"  TXWL0 - LU#",I3,": ILLEGAL LINE PRINTER CODE.")
      GOTO 260
C 
C 
C*********************************************************************
C*             SECTION 400 - 2608 PRINTER TESTS                      *
C*********************************************************************
C 
  400 IPRNT=1 
      ITSTN=7 
C 
C CHECK FOR ILLEGAL PROGRAM MODE
C IF AN ILLEGAL PROGRAM MODE WAS SPECIFIED AT RUN TIME,THEN ABORT TESTS 
C 
      IF((IPRGM.GE.0).AND.(IPRGM.LE.2))GOTO 470 
  480 WRITE(ILUL,5880) ILUT 
      GOTO 9020 
C 
C DEFAULT IS ZERO,IF SO,CALL SUBROUTINE MODE AND GET PROPER PROGRAM MODE
C 
  470 IF(IPRGM.EQ.0)CALL MODE(ILUL,ILUT,IPRGM)
C 
C CLEAR DEVICE AND AUTOMATIC PAGE EJECT MODE
C 
      CALL EXEC(3,ILUT) 
      CALL EXEC(3,ICNWD,65) 
      GOTO (420,430),IPRGM
C 
C IF IPRGM=1,THEN RUN THE VERIFICATION PACKAGE(RUN ALL AVAILABLE
C TESTS FOR THE 2608 PRINTER ONCE)
C 
  420 IRPT=1
      GOTO 500
C 
C IF IPRGM=2,THEN RUN THE DIAGNOSTIC PACKAGE FOR THE 2608 PRINTER 
C 
  430 WRITE(ILUL,440) 
  440 FORMAT(///,20X,"2608 PRINTER TESTS")
      WRITE(ILUL,450) 
  450 FORMAT(/,20X,"NO.",11X,"TEST")
C 
C LIST ALL AVAILABLE TESTS FOR THE 2608 AND THEIR RESPECTIVE TEST NOS.
C 
      WRITE(ILUL,460) 
  460 FORMAT(21X,"1",13X,"DOT MATRIX TEST"/,
     121X,"2",13X,"PING/PONG READ/WRITE TEST"/, 
     121X,"3",13X,"PRINT VERSION OF SELF-TEST"/,
     121X,"4",13X,"DOUBLE SIZE PRINT TEST"/,
     121X,"5",13X,"STATUS READBACK AND OUTPUT"/,
     121X,"6",13X,"12 CHANNEL VFC TEST"/, 
     121X,"7",13X,"CHARACTER AND LINE SPACE TEST"/, 
     121X,"/E,EN,EX",6X,"EXIT") 
C 
C JUMP TO SUBROUTINE SELCT TO GET PROPER TEST NO. AND REPEAT VALUE, 
C THEN JUMP TO SELECTED TEST FOR EXECUTION
C 
  490 CALL SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN)
      GOTO (500,600,1000,1100,2000,5500,6000,9030),ITEST
C 
C*********************************************************************
C*         SECTION 500 - 2608 DOT MATRIX TESTS                       *
C*********************************************************************
C 
  500 DO 530 K=1,IRPT 
      WRITE(ILUL,506) ILUT,K
  506 FORMAT(/"  TXWL0 - LU#",I3,": DOT MATRIX TEST RUNNING, PASS ",
     1I2) 
C 
C  HEADER 
C 
      WRITE(ILUT,510) 
  510 FORMAT(54X,"DOT MATRIX TEST"//) 
C 
C DOT MATRIX READ/WRITE TEST
C 
      CALL EXEC(1,ILUT,IDOT,-1153,0)
      CALL EXEC(3,ILUT+3000B,2) 
      DO 520 I=1,577
         NULL(27)=IDOT(I) 
         CALL EXEC(2,ILUT+200B,NULL,-54)
  520 CONTINUE
      CALL EXEC(3,ILUT+3000B,0) 
      IF(IFBRK(IDMY))9020,530 
  530 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 490
C 
C*********************************************************************
C*          SECTION 600 - 2608 PING-PONG READ/WRITE TEST             *
C*********************************************************************
C 
  600 DO 630 K=1,IRPT 
      WRITE(ILUT,610) 
  610 FORMAT(46X,"PING-PONG READ/WRITE TEST TO FOLLOW"//) 
      WRITE(ILUL,612) ILUT,K
  612 FORMAT(/"  TXWL0 - LU#",I3,": PING-PONG TEST RUNNING, PASS ", 
     1I2) 
      CALL EXEC(1,ILUT+100B,IDOT,257) 
      DO 620 I=1,257
      WRITE(ILUT,615) I,IDOT(I),IDOT(I) 
  615 FORMAT(47X," BUFFER LOC.(",I3,") = ",@6," = ",A2) 
  620 CONTINUE
      IF(IFBRK(IDMY))9020,630 
  630 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 490
C 
C*********************************************************************
C*         SECTION 1000 - 2608 PRINT VERSION OF SELF-TEST            *
C*********************************************************************
C 
 1000 DO 1030 K=1,IRPT
      WRITE(ILUT,1010)
 1010 FORMAT(46X,"PRINT VERSION OF SELF-TEST TO FOLLOW"//)
C SELF TEST--PRINT VERSION
C 
      WRITE(ILUL,1020) ILUT,K 
 1020 FORMAT(/"  TXWL0 - LU#",I3,": SELF TEST--PRINT VERSION" 
     1" RUNNING, PASS ",I2) 
      CALL EXEC(3,ILUT+2000B,0) 
      IF(IFBRK(IDMY))9020,1030
 1030 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 490
C 
C*********************************************************************
C*           SECTION 1100 - 2608 DOUBLE SIZE PRINT TEST              *
C*********************************************************************
C 
 1100 DO 1120 K=1,IRPT
      WRITE(ILUT,1110)
 1110 FORMAT(55X,"DOUBLE SIZE PRINT TEST")
      WRITE(ILUL,1115) ILUT,K 
 1115 FORMAT(/"  TXWL0 - LU#",I3,": DOUBLE SIZE PRINT TEST RUNNING,"
     1" PASS ",I2)
      CALL EXEC(3,ILUT+3000B,1) 
      WRITE(ILUT,1116)
 1116 FORMAT(/"           DOUBLE SIZE PRINT"/)
      CALL EXEC(3,ILUT+3000B,0) 
      IF(IFBRK(IDMY))9020,1120
 1120 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 490
C 
C*********************************************************************
C*        SECTION 2000 - 2608 STATUS READBACK AND OUTPUT             *
C*********************************************************************
C 
C CONTROL REQUEST FOR STATUS READ & OUTPUT OF STATUS
C 
 2000 DO 2050 K=1,IRPT
      WRITE(ILUL,2010) ILUT,K 
 2010 FORMAT(/"  TXWL0 - LU#",I3,": STATUS READBACK TEST RUNNING" 
     1", PASS ",I2) 
      WRITE(ILUT,2020)
 2020 FORMAT(40X,"CONTROL REQUEST STATUS READ - UNIQUE TO 2608" 
     1" PRINTER"//) 
      CALL EXEC(1,ILUT+200B,ISTR,16)
      DO 2030 I=1,16
      WRITE(ILUT,2040) ILUT,I,ISTR(I) 
 2040 FORMAT(42X," TXWL0 - LU#",I3,": STATUS BUFFER WORD #",I3," - ",@6)
 2030 CONTINUE
      IF(IFBRK(IDMY))9020,2050
 2050 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 490
      GOTO 5500 
C 
C*********************************************************************
C*             SECTION 2500 - 2619 PRINTER TESTS                     *
C*********************************************************************
C 
 2500 IPRNT=2 
      ITSTN=5 
C 
C CHECK FOR ILLEGAL PROGRAM MODE
C IF AN ILLEGAL PROGRAM MODE WAS SPECIFIED AT RUN TIME,THEN ABORT TESTS 
C 
      IF((IPRGM.GE.0).AND.(IPRGM.LE.2))GOTO 2570
      WRITE(ILUL,5880) ILUT 
      GOTO 9020 
C 
C DEFAULT IS ZERO,IF SO,CALL SUBROUTINE MODE AND GET PROPER PROGRAM MODE
C 
 2570 IF(IPRGM.EQ.0)CALL MODE(ILUL,ILUT,IPRGM)
C 
C CLEAR DEVICE AND AUTOMATIC PAGE EJECT MODE,GO TO TOP OF FORM
C 
      CALL EXEC(3,ILUT) 
      CALL EXEC(3,ICNWD,65) 
      CALL EXEC(3,ICNWD,-1) 
      GOTO (2520,2530),IPRGM
C 
C IF IPRGM=1,THEN RUN THE VERIFICATION PACKAGE(RUN ALL AVAILABLE
C TESTS FOR THE 2619 PRINTER ONCE)
C 
 2520 IRPT=1
      GOTO 3000 
C 
C IF IPRGM=2,THEN RUN THE DIAGNOSTIC PACKAGE FOR THE 2619 PRINTER 
C 
 2530 WRITE(ILUL,2540)
 2540 FORMAT(///,20X,"2619 PRINTER TESTS")
      WRITE(ILUL,2550)
 2550 FORMAT(/,20X,"NO.",11X,"TEST")
C 
C LIST ALL AVAILABLE TESTS FOR THE 2619 AND THEIR RESPECTIVE TEST NOS.
C 
      WRITE(ILUL,2560)
 2560 FORMAT(21X,"1",13X,"RIPPLE PRINT TEST"/,
     121X,"2",13X,"DATA LINES (SENSITIVE BIT) TEST"/, 
     121X,"3",13X,"HAMMER ALIGNMENT TEST"/, 
     121X,"4",13X,"8/12 CHANNEL VFC TEST"/, 
     121X,"5",13X,"CHARACTER AND LINE SPACE TEST"/, 
     121X,"/E,EN,EX",6X,"EXIT") 
C 
C JUMP TO SUBROUTINE SELCT TO GET PROPER TEST NO. AND REPEAT VALUE, 
C THEN JUMP TO PROPER TEST ADDRESS
C 
 2590 CALL SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN)
      GOTO (3000,4000,5000,5500,6000,9030),ITEST
C*********************************************************************
C*          SECTION 3000 - 2619 RIPPLE PRINT TEST                    *
C*********************************************************************
C 
C THIS TEST VERIFIES THAT EVERY PRINTABLE CHARACTER CAN BE PRINTED
C IN EVERYONE OF THE 132 COLUMNS
C 
 3000 J=127 
      DO 3030 I=1,256 
         IBUF10(I)=J
         J=J+1
         IF(J.EQ.128) J=0 
 3030 CONTINUE
      DO 3020 K=1,IRPT
      WRITE(ILUL,3010) ILUT,K 
 3010 FORMAT(/"  TXWL0 - LU#",I3,": RIPPLE PRINT TEST RUNNING"
     1", PASS ",I2) 
      WRITE(ILUT,3060)
 3060 FORMAT(57X,"RIPPLE PRINT TEST"//) 
      DO 3040 J=1,60
         WRITE(ILUT,3050)(IBUF10(I),I=J,J+131)
 3050    FORMAT(1H ,132R1)
 3040 CONTINUE
      IF(IFBRK(IDMY))9020,3020
 3020 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 2590 
C 
C*********************************************************************
C*        SECTION 4000 - 2619 DATA LINES (SENSITIVE BIT) TEST        *
C*********************************************************************
C 
C THIS 2619 TEST IS USED TO VERIFY THAT THE CAPACITANCE WHICH 
C APPEARS BETWEEN THE DATA LINES IN THE COMMUNICATIONS CABLE ARE
C NOT AFFECTING DATA TRANSMISSION SIGNALS 
C 
 4000 DO 4030 K=1,IRPT
      WRITE(ILUL,4020) ILUT,K 
 4020 FORMAT(/"  TXWL0 - LU#",I3,": SENSITIVE BIT TEST RUNNING" 
     1", PASS ",I2) 
      WRITE(ILUT,4040)
 4040 FORMAT(57X,"SENSITIVE BIT TEST"//)
      DO 4010 I=1,30
         CALL EXEC(2,ILUT+200B,IBUF6,-132)
         CALL EXEC(2,ILUT+200B,IBUF7,-132)
 4010 CONTINUE
      IF(IFBRK(IDMY))9020,4030
 4030 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 2590 
C 
C*********************************************************************
C*         SECTION 5000 - 2619 HAMMER MODULE ALIGNMENT TEST          *
C*********************************************************************
C 
C THIS 2619 TEST IS USED TO CHECK FOR PROPER ALIGNMENT OF THE HAMMER
C MODULES(A GROUP OF 8 HAMMERS) 
C 
 5000 DO 5040 K=1,IRPT
      WRITE(ILUL,5030) ILUT,K 
 5030 FORMAT(/"  TXWL0 - LU#",I3,": HAMMER ALIGNMENT TEST RUNNING"
     1", PASS ",I2) 
      WRITE(ILUT,5050)
 5050 FORMAT(55X,"HAMMER ALIGNMENT TEST"//) 
      DO 5010 I=1,4 
         CALL EXEC(2,ILUT+200B,IBUF8,-132)
            DO 5020 J=1,14
               CALL EXEC(2,ILUT+200B,IBUF9,-132)
 5020       CONTINUE
 5010 CONTINUE
      IF(IFBRK(IDMY))9020,5040
 5040 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 2590 
C 
C*********************************************************************
C*  SECTION 5500 - 2608 AND 2619 VERTICAL CONTROL FUNCTION TESTS     *
C*********************************************************************
C 
C THIS IS A 2608/2619 TEST USED TO CHECK THE VFC OF THE PRINTER 
C UNDER TEST. AFTER EACH VFC COMMAND, A CALL TO SUBROUTINE CHAN IS
C MADE.CHAN CHECKS TO SEE IF THE LAST VFC COMMAND WAS A TOF OR BOF
C VFC COMMAND.
C 
 5500 DO 5630 K=1,IRPT
      WRITE(ILUL,5640) ILUT,K 
 5640 FORMAT(/"  TXWL0 - LU#",I3,": 2608/2619 VFC TEST" 
     1" RUNNING, PASS ",I2) 
      WRITE(ILUT,5650)
 5650 FORMAT(52X,"2608/2619 VFC TEST")
C 
C DO A CHANNEL 1 (PAGE EJECT) 
      CALL EXEC(3,ICNWD,-1) 
      WRITE(ILUT,5510)
 5510 FORMAT("*CHANNEL  1") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 3 (SKIP TO NEXT SINGLE SPACE)
      CALL EXEC(3,ICNWD,56) 
      WRITE(ILUT,5520)
 5520 FORMAT("*CHANNEL  3") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 4 (SKIP TO NEXT DOUBLE LINE) 
      CALL EXEC(3,ICNWD,57) 
      WRITE(ILUT,5530)
 5530 FORMAT("*CHANNEL  4") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 5 (SKIP TO NEXT TRIPLE LINE) 
      CALL EXEC(3,ICNWD,58) 
      WRITE(ILUT,5540)
 5540 FORMAT("*CHANNEL  5") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 7 (SKIP TO NEXT QUARTER PAGE)
      CALL EXEC(3,ICNWD,60) 
      WRITE(ILUT,5550)
 5550 FORMAT("*CHANNEL  7") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 6 (SKIP TO NEXT HALF PAGE) 
      CALL EXEC(3,ICNWD,59) 
      WRITE(ILUT,5560)
 5560 FORMAT("*CHANNEL  6") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 8 (SKIP TO NEXT TENTH LINE)
      CALL EXEC(3,ICNWD,61) 
      WRITE(ILUT,5570)
 5570 FORMAT("*CHANNEL  8") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 2 (SKIP TO BOTTOM OF FORM) 
      CALL EXEC(3,ICNWD,62) 
      WRITE(ILUT,5580)
 5580 FORMAT("*CHANNEL  2") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 11 (SKIP TO LINE BEFORE TOP OF FORM) 
      IF((IPRAM(5).EQ.1).AND.(IPRNT.EQ.2))GOTO 5660 
      CALL EXEC(3,ICNWD,68) 
      WRITE(ILUT,5590)
 5590 FORMAT("*CHANNEL 11") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 12 (SKIP TO TOP OF FORM WITH STATUS) 
      CALL EXEC(3,ICNWD,69) 
      WRITE(ILUT,5600)
 5600 FORMAT("*CHANNEL 12") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 10 (SKIP TO LINE BEFORE BOTTOM OF FORM)
      CALL EXEC(3,ICNWD,67) 
      WRITE(ILUT,5610)
 5610 FORMAT("*CHANNEL 10") 
      CALL CHAN(ILUT) 
C 
C DO A CHANNEL 9 (SKIP TO BOTTOM OF FORM WITH STATUS) 
      CALL EXEC(3,ICNWD,66) 
      WRITE(ILUT,5620)
 5620 FORMAT("*CHANNEL  9") 
      CALL CHAN(ILUT) 
 5660 IF(IFBRK(IDMY))9020,5630
 5630 CALL EXEC(3,ICNWD,1)
      IF(IPRGM.EQ.1)GOTO 6000 
      GOTO (490,2590),IPRNT 
  
  
C 
C*********************************************************************
C*             SECTION 5800 - STANDARD PRINTER TESTS                 *
C*********************************************************************
C 
 5800 IPRNT=3 
      ITSTN=2 
C 
C CHECK FOR ILLEGAL PROGRAM MODE
C IF AN ILLEGAL PROGRAM MODE WAS SPECIFIED AT RUN TIME,THEN ABORT TESTS 
C 
      IF((IPRGM.GE.0).AND.(IPRGM.LE.2))GOTO 5870
      WRITE(ILUL,5880) ILUT 
 5880 FORMAT(/"  TXWL0 - LU#",I3,": ILLEGAL PROGRAM MODE" 
     1" SPECIFIED AT RUN TIME.")
      GOTO 9020 
C 
C DEFAULT IS ZERO,IF SO,CALL SUBROUTINE MODE AND GET PROPER PROGRAM MODE
C 
 5870 IF(IPRGM.EQ.0)CALL MODE(ILUL,ILUT,IPRGM)
C 
C CLEAR DEVICE AND AUTOMATIC PAGE EJECT MODE,GO TO TOP OF FORM
C 
      CALL EXEC(3,ILUT) 
      CALL EXEC(3,ICNWD,65) 
      CALL EXEC(3,ICNWD,-1) 
      GOTO (5820,5830),IPRGM
C 
C IF IPRGM=1,THEN RUN VERIFICATION PACKAGE(RUN ALL AVAILABLE TESTS FOR
C A STANDARD PRINTER UNDER DVA12 ONCE)
C 
 5820 IRPT=1
      GOTO 6000 
C 
C IF IPRGM=2,THEN RUN THE DIAGNOSIC PACKAGE FOR A STANDARD PRINTER
C UNDER DVA12 
C 
 5830 WRITE(ILUL,5840)
 5840 FORMAT(///,20X,"STANDARD PRINTER TESTS")
      WRITE(ILUL,5850)
 5850 FORMAT(/,20X,"NO.",15X,"TEST")
C 
C LIST ALL AVAILABLE TESTS FOR A STANDARD PRINTER UNDER DVA12 
C AND THEIR RESPECTIVE TEST NOS.
C 
      WRITE(ILUL,5860)
 5860 FORMAT(21X,"1",17X,"CHARACTER AND LINE SPACE TEST"/,
     121X,"2",17X,"8 CHANNEL VFC TEST"/,
     121X,"/E,EN,EX",10X,"EXIT")
C 
C JUMP TO SUBROUTINE SELCT TO GET PROPER TEST NO. AND REPEAT VALUE, 
C THEN JUMP TO PROPER TEST ADDRESS
C 
 5890 CALL SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN)
      GOTO (6000,7000,9030),ITEST 
C*********************************************************************
C*      SECTION 6000 - STANDARD CHARACTER AND LINE SPACE TEST        *
C*********************************************************************
C 
 6000 DO 6050 K=1,IRPT
      WRITE(ILUT,6010)
 6010 FORMAT(51X,"CHARACTER AND LINE SPACE TEST"//) 
      WRITE(ILUL,6020) ILUT,K 
 6020 FORMAT(/"  TXWL0 - LU#",I3,": CHARACTER & LINE SPACE TEST"
     1" RUNNING, PASS ",I2) 
C 
C OUTPUT DATA FROM BUFFERS TO PRINTER 
C 
C OUTPUT FIVE LINE SPACINGS 
C 
      CALL EXEC(3,ICNWD,5)
C 
C OUTPUT BUFFER, PRINT COLUMN 1 
C 
      CALL EXEC(2,ILUT+200B,IBUF0,-40)
C 
C OUTPUT BUFFER, PRINT COLUMN 1 
C 
      CALL EXEC(2,ILUT+200B,IBUF1,-40)
C 
C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. 
C DO A DOUBLE SPACE, THEN OUTPUT BUFFER.
C 
      CALL EXEC(2,ILUT,IBUF2,-41) 
C 
C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. 
C SUPPRESS SPACE (OVERPRINT), THEN OUTPUT BUFFER PRINTING COLUMN 1. 
C 
      CALL EXEC(2,ILUT,IBUF3,-40) 
C 
C OUTPUT BUFFER, PRINT COLUMN 1.
C 
      CALL EXEC(2,ILUT+200B,IBUF4,-40)
C 
C SPACE ONE LINE
C 
      CALL EXEC(3,ICNWD,1)
C 
C OUTPUT BUFFER TO CHECK CHARACTERS 
C 
      WRITE(ILUT,6030)
 6030 FORMAT(" ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!'#$%&()-=@+<>?:876" 
     1"543210ZYXWVUTSRQPONMLKJ")
C 
C FIRST CHARACTER INTERPRETED AS A CONTROL CHARACTER
C TOP OF FORM, THEN OUTPUT BUFFER.
C 
      CALL EXEC(2,ILUT,IBUF5,-22) 
C 
      IF(IFBRK(IDMY))9020,6050
 6050 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 6060 
      GOTO (7150,7150,7000),IPRNT 
 6060 GOTO (490,2590,5890),IPRNT
C 
C*********************************************************************
C*     SECTION 7000 - STANDARD VERTICAL CONTROL FUNCTION TESTS       *
C*********************************************************************
C 
C THIS IS A STANDARD VFC TEST FOR EITHER 6 OR 8 LPI PRINTERS
C 
 7000 DO 7010 K=1,IRPT
      WRITE(ILUL,7070) ILUT,K 
 7070 FORMAT(/"  TXWL0 - LU#",I3,": CONTROL FUNCTION TEST RUNNING"
     1", PASS ",I2) 
      WRITE(ILUT,7160)
 7160 FORMAT(55X,"CONTROL FUNCTION TEST"//) 
C 
C DO A PAGE EJECT AND WRITE TOP OF FORM MESSAGE 
C 
      CALL EXEC(3,ICNWD,-1) 
      WRITE(ILUT,7080)
 7080 FORMAT("          TOP OF FORM!")
C 
C SKIP TO NEXT 1/6 PAGE BOUNDARY AND PRINT MESSAGE
C 
      CALL EXEC(3,ICNWD,61) 
      WRITE(ILUT,7090)
 7090 FORMAT("          1/6 PAGE BOUNDRY!") 
C 
C SKIP TO NEXT 1/4 PAGE BOUNDARY AND PRINT MESSAGE
C 
      CALL EXEC(3,ICNWD,60) 
      WRITE(ILUT,7100)
 7100 FORMAT("          1/4 PAGE BOUNDRY!") 
C 
C SKIP TO NEXT 1/2 PAGE BOUNDARY AND PRINT MESSAGE
C 
      CALL EXEC(3,ICNWD,59) 
      WRITE(ILUT,7110)
 7110 FORMAT("          1/2 PAGE BOUNDRY!") 
C 
C SKIP TO BOTTOM OF THE PAGE AND PRINT MESSAGE
C 
      CALL EXEC(3,ICNWD,62) 
      WRITE(ILUT,7120)
 7120 FORMAT("          BOTTOM OF PAGE!") 
C 
C SKIP TO APPROXIMATELY 3/4 PAGE BOUNDARY AND PRINT MESSAGE 
C 
      CALL EXEC(3,ICNWD,45) 
      WRITE(ILUT,7130)
 7130 FORMAT("          APPROXIMATELY 3/4 DOWN PAGE!")
      IF(IFBRK(IDMY))9020,7010
 7010 CALL EXEC(3,ICNWD,5)
      IF(IPRGM.EQ.2)GOTO 5890 
 7150 WRITE(ILUL,7140) ILUT 
 7140 FORMAT(/"  TXWL0 - LU#",I3,": LINE PRINTER TESTS FINISHED"/)
      GOTO 9900 
C 
C*********************************************************************
C*                  SECTION 8000 - ERROR MESSAGES                    *
C*********************************************************************
C 
 8000 WRITE(ILUL,8010) ILUT 
 8010 FORMAT(/"  TXWL0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 9000 
 8020 WRITE(ILUL,8025)
 8025 FORMAT(/"  TXWL0 - LU# SPECIFIED FOR LINE PRINTER"
     1" IS ILLEGAL."/"          RERUN TEST SPECIFYING AN INTEGER >0"
     2" AND <64 FOR LU#.")
      GOTO 9000 
 8100 WRITE(ILUL,8110) ILUT 
 8110 FORMAT(/"  TXWL0 - LU#",I3," IS NOT ASSIGNED TO A LINE PRINTER."/ 
     1"          RERUN TEST SPECIFYING CORRECT LU#.") 
      GOTO 9000 
 8200 WRITE(ILUL,8210) ILUT 
 8210 FORMAT(/"  TXWL0 - LU#",I3,": EQT OR LU FOR TEST PRINTER" 
     1" IS DOWN."/"          UP EQT AND RERUN TEST.") 
      GOTO 9000 
C 
C*********************************************************************
C*         SECTION 9000 - EXIT/ABORT MESSAGES AND TERMINATE          *
C*********************************************************************
C 
 9020 WRITE(ILUL,9010) ILUT 
 9010 FORMAT(/"  TXWL0 - LU#",I3,": LINE PRINTER TESTS ABORTED!") 
      GOTO 9900 
 9030 WRITE(ILUL,9040) ILUT 
 9040 FORMAT(/"  TXWL0 - LU#",I3,": LINE PRINTER TESTS EXITED!"/) 
 9900 CALL LURQ(0,ILUT,1) 
      CALL EXEC(3,ICNWD,64) 
      CALL EXEC(3,ICNWD,-1) 
 9000 CALL EXEC(22,0) 
      END 
C 
C 
C 
C*********************************************************************
C*                    SUBROUTINE CHAN                                *
C*********************************************************************
C 
C THIS SUBROUTINE CHECKS TO SEE IF THE LAST VFC COMMAND ISSUED TO 
C 2608A/2619A PRINTER WAS A CHANNEL 9 OR 12. IF SO,THEN OUTPUT AN 
C APPROPRIATE MESSAGE.
C 
      SUBROUTINE CHAN(ILUT) 
      CALL EXEC(3,ILUT+600B)
C 
C GET THE CURRENT STATUS FOR THE PRINTER UNDER TEST(EQT#5)
C 
      CALL EXEC(13,ILUT,ISTAT1) 
      ICHN=IAND(ISTAT1,3) 
C 
C IF BIT 0 OF EQT#5 IS 1,THEN A VFC CHANNEL 12 WAS DETECTED 
C IF BIT 1 OF EQT#5 IS 1,THEN A VFC CHANNEL 9 WAS DETECTED
C 
      IF(ICHN.EQ.1)GOTO 10
      IF(ICHN.EQ.2)GOTO 20
      RETURN
   10 WRITE(ILUT,30)
   30 FORMAT("*           ; MATCHES CH 12") 
      RETURN
   20 WRITE(ILUT,40)
   40 FORMAT("            ; MATCHES CH  9") 
      RETURN
      END 
C 
C 
C 
C*********************************************************************
C*                    SUBROUTINE MODE                                *
C*********************************************************************
C 
C THIS SUBROUTINE TALKS INTERACTIVELY WITH THE LOG DEVICE IN ORDER TO 
C GET THE PROGRAM MODE
C 
      SUBROUTINE MODE(ILUL,ILUT,IPRGM)
C 
C LIST THE CURRENT PROGRAM MODES
C 
   30 WRITE(ILUL,10)
   10 FORMAT(//,"PLEASE ENTER:"/,8X,
     1"1 FOR THE VERIFICATION PACKAGE"/,8X, 
     1"2 FOR THE DIAGNOSTIC PACKAGE?    _") 
C 
C READ THE PROGRAM MODE VALUE AND CHECK FOR LEGALITY
C 
      CALL EXEC(1,ILUL+400B,IPRGM,-2) 
      CALL ABREG(IA,IB) 
      IF(IB.GT.1)GOTO 60
      IF(IPRGM.EQ.2H1 )GOTO 20
      IF(IPRGM.EQ.2H2 )GOTO 50
C 
C IF ILLEGAL,GO AND GET PROPER PROGRAM MODE VALUE 
C 
   60 WRITE(ILUL,40) ILUT 
   40 FORMAT(/"  TXWL0 - LU#",I3,": ILLEGAL PROGRAM MODE.") 
      GOTO 30 
   20 IPRGM=1 
      RETURN
   50 IPRGM=2 
      RETURN
      END 
C 
C 
C 
C*********************************************************************
C*                  SUBROUTINE SELCT                                 *
C*********************************************************************
C 
C THIS SUBROUTINE GETS THE PROPER TEST NO. AND REPEAT VALUE 
C 
      SUBROUTINE SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN)
      DIMENSION NUM(2)
C 
C GET THE PROPER TEST NO. 
C 
   10 WRITE(ILUL,20)
   20 FORMAT(//"PLEASE ENTER TEST NO.? _")
      CALL EXEC(1,ILUL+400B,NUM,-4) 
      CALL ABREG(IA,IB) 
      IF((IB.EQ.0).OR.(IB.GT.2))GOTO 110
      IF(NUM.EQ.2H/E)GOTO 120 
      IF(NUM.EQ.2HEN)GOTO 120 
      IF(NUM.EQ.2HEX)GOTO 120 
      IF(IB.GT.1)GOTO 110 
      ITEST=IAND(NUM,77400B)
      ITEST=ITEST/256 
      ITEST=ITEST-60B 
      IF((ITEST.GE.1).AND.(ITEST.LE.ITSTN))GOTO 40
  110 WRITE(ILUL,50) ILUT 
   50 FORMAT(/"  TXWL0 - LU#",I3,": ILLEGAL TEST NO.")
      GOTO 10 
  120 ITEST=ITSTN+1 
      RETURN
C 
C GET THE PROPER REPEAT VALUE 
C 
   40 WRITE(ILUL,70) ITEST
   70 FORMAT(/"HOW MANY TIMES WOULD YOU LIKE TEST ",
     1I2," REPEATED(1-99)? _")
      CALL EXEC(1,ILUL+400B,NUM,-4) 
      CALL ABREG(IA,IB) 
      IF((IB.EQ.0).OR.(IB.GT.2))GOTO 130
      IF(IB.EQ.2)GOTO 30
      IRPT=IAND(NUM,77400B) 
      IRPT=IRPT/256 
      IRPT=IRPT-60B 
      IF((IRPT.GE.1).AND.(IRPT.LE.9))RETURN 
      GOTO 130
   30 IVAR=IAND(NUM,77400B) 
      IVAR=IVAR/256 
      IF((IVAR.LT.60B).OR.(IVAR.GT.71B))GOTO 130
      IRPT=(IVAR-60B)*10
      IVAR=IAND(NUM,177B) 
      IF((IVAR.LT.60B).OR.(IVAR.GT.71B))GOTO 130
      IRPT=IRPT+(IVAR-60B)
      RETURN
  130 WRITE(ILUL,100) ILUT
  100 FORMAT(/"TXWL0 - LU#",I3,": ILLEGAL REPEAT VALUE.") 
      GOTO 40 
      END 
      END$
                                                                                                                                                                                                                