FTN4
      PROGRAM TGP7(5), 92903-16366 REV.1913  790201 1100
C 
C     SOURCE 92903-18366
C 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 
C@ TGP - SEG#7 . COMPILE FORM . 10/AUG/77 . *JCM* 
C 
C      PRGMR : JEAN CHARLES MIARD (HPG) 
C 
C 
C*********************************************************************
C*                                                                   *
C*                 THIS IS A SEGMENT OF THE TGP PROGRAM WHICH        *
C*  COMPILES THE SOURCE USER'S ANSWERS STORED IN IFORM,JFORM,MFORM   *
C*  LFORM BUFFERS INTO A BINARY CODE DIRECTLY USABLE BY THE TMP      *
C*  PROGRAM TO DRIVE THE TRANSACTIONS. THIS BINARY CODE IS STORED    *
C*  IN KFORM .                                                       *
C*                                                                   *
C*        ACCORDING TO INDIC VALUE DIFFERENT TASKS ARE PERFORMED :   *
C*                                                                   *
C*          INDIC =  0 : NORMAL PATH . START COMPILATION .           *
C*                   2 : RETURN FROM TGP11 , IMAGE ADD STORAGE       *
C*                       SUCCESSFULLY PROCESSED                      *
C*                                                                   *
C*                                                                   *
C*********************************************************************
C 
C 
C DECLARATIONS COMMON VARIABLES ***************** 
C 
      COMMON ILU,ISCRN,IQST,ISKIP,INDIC 
      COMMON IFORM(766) 
      COMMON JFORM(1400)
      COMMON MFORM(16)
      COMMON LFORM(39)
      COMMON ITT
      COMMON IKEY(26,3) 
      COMMON IUMAX,IMMAX
      COMMON IMODB
      COMMON ILITE(15)
      COMMON IMAI(45,5) 
      COMMON IMFLG,IMAS,IMDT,IMKY 
      COMMON KFORM(2704)
      COMMON ILIBR(61)
      COMMON NIMAG
C 
C   LOCAL VARIABLES **********
C 
      DIMENSION JNAM(3),KNAM(3),ITGP6(3),ISUM(4,2),JSUM(4,2)
      DIMENSION IDUMP(17),IREAL(2),LISTOF(520)
C 
      LOGICAL INUM,ISSPA,ISBIT,RNUM,CMPB
C 
      EQUIVALENCE(LISTOF(1),KFORM(2185))
      EQUIVALENCE(LCTR,ISCRN) 
      EQUIVALENCE(LW,IMODB) 
      EQUIVALENCE(N2,KFORM(1059)) 
      EQUIVALENCE(IREAL,XREAL)
C 
      DATA JNAM/2HTG,2HP4,2H  / 
      DATA KNAM/2HTG,2HPI,2H1 / 
      DATA ITGP6/2HTG,2HP6,2H  /
      DATA JWORDS/70/ 
      DATA JBYTES/140/
C 
C********************************************************************** 
C 
C   ACCORDING INDIC VALUE GO TO THE REQUIRED PORTION OF TGP7
C 
C********************************************************************** 
C 
      IF(INDIC.EQ.2) GO TO 740
C 
C********************************************************************** 
C 
C   INDIC=0 COMPILE !!!!
C 
C********************************************************************** 
C 
C  INITIALISE KFORM 
C 
      DO 100 I=1,1058 
100   KFORM(I)=0
C-----ISUMN & JSUMN ARE GLOBAL VARIABLES(DON'T USE LOCALLY) 
      ISUMN=0 
      JSUMN=0 
C 
C  IF TRANSACTION ACCESS AN IMAGE DATA BASE, GET DATA-BASE-CRC
C  AND STORE IT INTO THE FIRST WORD OF THE SOURCE SPEC. 
C 
      IF(.NOT.ISBIT(ITT,1)) GO TO 105 
      CALL DBCRC(IFORM(38),I,J,K,ISTAT) 
      IF(ISTAT .NE. 0)  PAUSE  0705 
      CALL MOVEW(IFORM(38),IFORM,3) 
      IFORM(4)=I
C 
C***********************************************************************
C 
C  BUILD FORM HEADER (37 WORDS) 
C 
C***********************************************************************
C 
105   CALL MOVEW(IFORM(29),KFORM(2),3)
      IF(INUM(IFORM,63,4,KFORM(5))) GO TO 5000
      IF(INUM(IFORM,67,6,KFORM(6))) GO TO 5000
      KFORM(7)=IOR(IALF2(IUMAX),IMMAX)
C    -SET REV CODE IN BITS 8-11 OF WORD 10 (CURRENT CODE=2) 
109   KFORM(10)=IOR(KFORM(10),1001B)
C    -GET THE FOLLOWING BITS FOR WORD 11 : UP,DB,ADS,AKB,BG5,BG3, 
C                                          PRT,LOG. 
      KFORM(11)=ITT 
C 
C    -DETERMINE MAX LIGHT NUMBER. 
      DO 112 I=17,1,-1
      IF(ILITE(I).NE.0) GO TO 114 
112   CONTINUE
114   KFORM(12)=I 
C    -MOVE DATA BASE NAME TO HEADER 
      CALL MOVEW(IFORM(38),KFORM(21),3) 
C    -MOVE DB SECURITY CODE TO HEADER.
      IF(INUM(IFORM,81,5,KFORM(24))) PAUSE 7107 
C    -MOVE CR# TO HEADER. 
      IF(INUM(IFORM,33,5,KFORM(25))) PAUSE 7110 
C    -MOVE CRC TO HEADER. 
      KFORM(27)=IFORM(4)
C***********************************************************************
C 
C  BUILD DUMMY STATE SQ=0 SFK DEFINITION
C 
C***********************************************************************
C 
C     N2 = KFORM ADDRESS OF 1ST WORD OF THIS STATE
C     N3 = CURRENT KFORM ADDRESS (INCREMENTED AS STATE IS BUILT)
C 
C    -SET ADDRESS POINTERS. 
      N2=38 
      N3=N2+3 
C    -MOVE ERROR LABEL TO KFORM.
      CALL MOVCA(IFORM,1520,KFORM,N3*2-1,12)
      N3=N3+6 
C    -GET PREFIX KEY #
      JPREFX=0
      DO 118 I=1,26 
      IF(IKEY(I,1).EQ.10) GO TO 120 
118   CONTINUE
      GO TO 130 
120   JPREFX=I*2048 
130   KFORM(N3)=JPREFX
C    -GET MAX KEY#
      DO 134 MAXKEY=26,1,-1 
      IF(IKEY(MAXKEY,1).NE.0) GO TO 136 
2     IF(IKEY(MAXKEY,3).NE.0) GO TO 136 
134   CONTINUE
136   KFORM(N3)=IOR(KFORM(N3),MAXKEY) 
      MAX12=MAXKEY*256
      KFORM(12)=IOR(KFORM(12),MAX12)
C 
C 
C  SET SFK TERMINATOR BITS FOR KEYS 1-16
C 
      N3=N3+1 
      DO 160 I=1,16 
      IF(IKEY(I,2).EQ.1) CALL SETBT(KFORM(N3),(I-1),1)
160   CONTINUE
C    -SET SFK TERMINATOR BITS FOR KEYS 17-26
      N3=N3+1 
      DO 165 I=17,26
      IF(IKEY(I,2).EQ.1) CALL SETBT(KFORM(N3),(I-17),1) 
165   CONTINUE
      N3=N3+1 
C 
C  IPNTR IS CURRENT POINTER TO STRING VALUE * IPNTR=1 IS WORD 39 OF KFORM 
C  I  = CURRENT SFK NUMBER  (2 21)
C  J  = 1 IS NORMAL SFK * J=3 IS PREFIXED SFK (SEE IKEY DEFINITION :ANSWR)
C  IX =  CURRENT POINTER (BYTE) 
C  K  = REAL SFK NUMBER (2/11)
C  L  = CURRENT POINTER IN IFORM (1 THRU MAX OF 36) 
C 
C  POINTER DEFINITION : (BYTE)
C                      -SFK=0 : SFK NOT DEFINED 
C                      -SFK=IPNTR : SFK IS A STRING 
C                      -SFK FOR A FUNCTION :
C                           -BIT 7=1
C                           -BIT 6=1 IF A VALIDITY CHECK IS TO BE PERFORMED 
C                                    ON THE FUNCTION
C                           -BITS 0/5 :FUNCTION # 
C 
C-----CALCULATE WHERE THE "VALUE STRING OR FUNCTION LABEL" STORAGE WILL 
C     BEGIN & STORE IT INTO IPNTR.
      IPNTR=12+(MAXKEY+1)/2 
C    -ADD 5 MORE WORDS (FOR 10 KEYS) IF PREFIX KEY IS DEFINED.
      IF(JPREFX.NE.0) IPNTR=IPNTR+5 
C    -INCREMENT LOOP COUNT BY 10 IF PREFIX KEY IS DEFINED.
      LOOPCT=MAXKEY 
      IF(JPREFX.NE.0) LOOPCT=MAXKEY+10
C-----LOOP 230 GOES THRU THE TABLE OF KEYS(IKEY) & DOES THE FOLLOWING:
C     1. SETS UP THE TABLE OF POINTERS WHICH COMES AFTER THE TERMINATOR 
C        BIT WORDS. CURRENTLY THIS TABLE STARTS AT KFORM(50). 
C     2. STORES THE APPROPRIATE STRING (VALUE STRING OR FUNCTION LABEL) 
C        USING THE FORMAT SPECIFIED IN THE IMS WHERE THE POINTER IN (1) SAYS
C        IT IS. 
C     3. THIS IS DONE MAXKEY TIMES. REMEMBER MAXKEY MAY HAVE BEEN INCREMENTED 
C        BY 10 IF A PREFIX KEY IS DEFINED.
C 
      ISFKNO=87 
      ITEXT=89
      ILABEL=108
      DO 230 K=1,LOOPCT 
      I=K 
      J=1 
C    -180 WHILE NON-PREFIXED KEYS.
      IF(K.LE.MAXKEY) GO TO 180 
C    -SWITCH TO PREFIXED KEYS.
      I=K-MAXKEY
      J=3 
      ISFKNO=945
      ITEXT=947 
      ILABEL=966
C    -GET READY TO STORE THE POINTER. 
180   IX=IPNTR
C    -ZERO THE POINTER IF SFK IS NOT DEFINED. 
      IF(IKEY(I,J).EQ.0) IX=0 
C    -STORE THE POINTER IN LEFT OR RIGHT BYTE DEPENDING ON WHETHER KEY #
C     IS ODD OR EVEN. 
      IF(IAND(K,1).EQ.0) GO TO 182
C    -LEFT BYTE.
      N3=50+(K-1)/2 
      KFORM(N3)=IALF2(IX) 
      GO TO 184 
C    -RIGHT BYTE. 
182   KFORM(N3)=IOR(KFORM(N3),IX) 
C    -SKIP REST OF LOOP IS SFK IS NOT DEFINED.
184   IF(IX.EQ.0) GO TO 230 
C    -SET UP FOR SEARCH OF IFORM FOR KEY #
      N1=1
      N6=MAXKEY 
C    -190 WHILE DOING NON-PREFIXED KEYS.
      IF(J.EQ.1) GO TO 190
      N1=MAXKEY+1 
      N6=MAXKEY+10
C    -LOOP 199 SEARCHES IFORM UNTIL FINDING THE CORRECT KEY#, THEN
C     1. IF IT'S A FUNCTION KEY, GET IT'S LABEL & STORE IT IN KFORM 
C     2. IF IT'S A VALUE KEY, GET THE STRING VALUE & STORE IN KFORM.
190   DO 199 L=N1,N6
C    -GET KEY # & CONVERT IT TO INTEGER.
      IF(INUM(IFORM,(ISFKNO+(L-N1)*33),2,IZ)) PAUSE 260 
C    -CORRECT KEY # ? 
      IF(IZ.NE.I) GO TO 199 
C    -IS THIS A VALUE KEY OR FUNCTION KEY?
      IF(IKEY(I,J).NE.-1) GO TO 195 
C    -VALUE KEY. CALCULATE THE STRING LENGTH DROPPING TRAILING BLANKS.
      IL=LNCAR(IFORM,(ITEXT+(L-N1)*33),16)
C    -STORE THE LENGTH IN LEFT BYTE.
      KFORM(N2+IPNTR)=IL*256
C    -STORE THE STRING STARTING IN THE RIGHT BYTE.
      CALL MOVCA(IFORM,(ITEXT+(L-N1)*33),KFORM,((N2+IPNTR)*2),IL) 
C    -UPDATE IPNTR TO NEXT STRING ADDRESS.
      IPNTR=IPNTR+1+(IL/2)
      GO TO 199 
C    -FUNCTION KEY. CALCULATE STRING LENGTH OF LABEL(OMIT TRAILING BLANKS). 
195   IL=LNCAR(IFORM,(ILABEL+(L-N1)*33),12) 
C    -SET FS BIT & MERGE IT WITH THE FUNCTION NUMBER. 
      IX=200B+IKEY(I,J) 
C    -SET EC BIT IF VALIDITY CHECK REQUIRED.
      IF((IKEY(I,J).GT.4).AND.(IKEY(I,J).NE.10)) IX=IX+100B 
      IF(IKEY(I,J).EQ.14) CALL SETBT(IX,6,0)
C    -STORE THE FS/EC/FUNCTION NUMBER IN LEFT BYTE & LENGTH IN RIGHT BYTE.
      KFORM(N2+IPNTR)=IL+IALF2(IX)
C    -STORE THE LABEL STARTING IN NEXT WORD.
      IF(IAND(IL,1).EQ.1) IL=IL+1 
      CALL MOVCA(IFORM,(ILABEL+(L-N1)*33),KFORM,
     *     ((N2+IPNTR+1)*2-1),IL) 
C    -UPDATE IPNTR TO NEXT STRING ADDRESS.
      IPNTR=IPNTR+1+(IL/2)
220   GO TO 230 
199   CONTINUE
230   CONTINUE
C    -ERROR IF TOTAL LENGTH OF STATE MINUS 3 WORDS IS .GT. 256
      IF(IPNTR.GT.259) GO TO 5000 
C    -CALCULATE TRUE LENGTH MINUS 3.
      IX=IPNTR-3
      N1=N2 
C    -SPLIT THE STATE IF NECESSARY. 
      CALL SPLT(N1,IPNTR,KFORM,0) 
C    -STORE TOTAL LENGTH OF STATE MINUS 3.
      KFORM(N2+2)=IX
C    -STORE SAME LENGTH INTO TS HEADER
      KFORM(13)=IX
C    -NOW UPDATE TS TOTAL LENGTH IN TS HEADER.
      KFORM(1)=N1 
C 
C 
C 
C********************************************************************** 
C 
C   CONSTRUCTION OF AN U OR M STATE 
C 
C***********************************************************************
C 
C  HERE BEGINS THE CONSTRUCTION OF AN U OR M STATE .
C      GENERAL PARAMETERS : 
C                 N  : CURRENT POINTER IN IMAI ARRAY
C                 N1 : CURRENT STATE # FIRST IS 1 
C                 N2 : WORD ADDRESS OF FIRST WORD OF CURRENT STATE
C                 N3 : CURRENT ADDRESS IN KFORM 
C                 N4 : CURRENT RELATIVE ADDRESS IN DATA OUTPUT BUFFER 
C                 N5 : CURRENT OFFSET (WORDS) OF THE BEGINING OF STATE
C                      IN JFORM 
C                 N6 : LOCAL PARAMETER
C                 N7 : INPUT STRING LENGTH
C                 N8 : CURRENT OFFSET (CHARACTERS) OF THE BEGINING OF 
C                      STATE IN JFORM 
C                IAT : CURRENT ANSWER TYPE
C                 IX : LOCAL PARAMETER
C                 IY : LOCAL PARAMETER
C              JBYTE : # BYTES PER RECORD IN JFORM (CURRENTLY 140)
C              JWORD : # WORDS PER RECORD IN JFORM (CURRENTLY  70)
C                 LW : WORD POINTER IN LISTOF WHICH HOLDS THE DATA
C                      FOR THE OFF-LINE PRINT-OFF.
C               LCTR : COUNTER FOR THE TOTAL # OF OFF-LINE PRINT-OFF'S
C 
C 
C  INITIALISE PARAMETERS
C 
260   N1=1
      N2=KFORM(1) 
      IFAF=0
      ISUMN=0 
      JBYTE=140 
      JWORD=70
      LW=1
      LCTR=0
C 
C  RESERVE PLACE FOR SYSTEM ADDED INFORMATION 
C 
      N4=1
      IF(IGET1(MFORM,1).NE.1HX) GO TO 261 
      IMAI(41,5)=N4 
      N4=N4+2 
261   IF(IGET1(MFORM,2).NE.1HX) GO TO 262 
      IMAI(42,5)=N4 
      N4=N4+1 
262   IF(IGET1(MFORM,3).NE.1HX) GO TO 263 
      IMAI(43,5)=N4 
      N4=N4+3 
263   IF(IGET1(MFORM,4).NE.1HX) GO TO 265 
      IMAI(44,5)=N4 
      N4=N4+2 
C 
C 
C=========================================================================
C 
C HERE BEGINS THE LOOP
C EACH LOOP BUIDS A STATE CORRESPONDING TO A QUESTION 
C 
C 
265   IF(N1.GT.(IUMAX+IMMAX)) GO TO 625 
      N=2*N1-1
C    -GO BUILD FAF RECORD IF NECESSARY. 
      IF(.NOT.(ISBIT(IMAI(N,2),9))) GO TO 271 
      IF(IFAF.EQ.0) GO TO 654 
C 
C*************************************************************************
C 
C  BUILD STATE GENERAL INFORMATION
C 
C************************************************************************ 
C 
271   N5=(N1-1)*JWORD 
      N8=(N1-1)*JBYTE 
      IAT=JFORM(50+N5)
C 
C  INCLUDE FLAGS FOR DISPLAY,DEFAULT VALUE,INPUT FROM CARD READER ... 
C  IMAGE DELETE FLAG,LAST QUESTION STATE FLAG 
C  INCLUDES ALSO STATE QUALIFIER ,STATE INDEX...
C 
C    -DF. 
      IF(IGET1(JFORM,2+N8).EQ.1HX) KFORM(N2+1)=100000B
C    -DVF.
      IF(IGET1(JFORM,103+N8).EQ.1HX) KFORM(N2+1)=IOR(KFORM(N2+1),20000B)
C    -DEL.
      IF(ISBIT(IMFLG,2)) KFORM(N2+1)=IOR(KFORM(N2+1),400B)
C    -LST.
      IF(N1.EQ.IUMAX+IMMAX) KFORM(N2+1)=IOR(KFORM(N2+1),1000B)
C 
C  STATE INDEX AND STATE QUALIFIER
C 
      IF(N1.LE.IUMAX) KFORM(N2+1)=KFORM(N2+1)+40B+N1
      IF(N1.GT.IUMAX) KFORM(N2+1)=KFORM(N2+1)+100B+(N1-IUMAX)+IFAF
C 
C  ITEM TYPE AND STRING LENGTH (IN CHARS. 2 FOR INTEGERS,4 REALS) 
C 
      KFORM(N2+2)=IAT 
      IF(IAT.NE.0) GO TO 270
      N7=JFORM(25+N5) 
      KFORM(N2+2)=IOR(KFORM(N2+2),16*N7)
270   IF(IAT.EQ.1) KFORM(N2+2)=IOR(KFORM(N2+2),40B) 
      IF(IAT.EQ.2) KFORM(N2+2)=IOR(KFORM(N2+2),100B)
C    -WILL ANSWER (OR QUES) BE PRINTED ON PRINTER?
      IF(.NOT.ISSPA(JFORM,N8+6,2)) GO TO 280
C    -YES. ON-LINE? 
      IF(IGET1(JFORM,N8+6).EQ.1HO) GO TO 272
      IF(IGET1(JFORM,N8+7).NE.1HO) GO TO 274
C    -YES. SET ONP IN HEADER & ANS BITS.
272   KFORM(11)=IOR(KFORM(11),400B) 
      KFORM(N2+2)=IOR(KFORM(N2+2),40000B) 
C    -WILL A LABEL FOR THE ANS (OR QUES) BE PRINTED?
      IF(.NOT.ISSPA(JFORM,N8+8,20)) GO TO 280 
C    -YES. SET TTL & MOVE TITLE TO KFORM. 
      KFORM(N2+2)=IOR(KFORM(N2+2),100000B)
      LNGT=LNCAR(JFORM,N8+8,20) 
      IF(ISBIT(LNGT,0)) LNGT=LNGT+1 
      CALL MOVCA(JFORM,N8+8,KFORM,(N2+8)*2-1,LNGT)
      KFORM(N2+7)=(LNGT/2)+1
C-----IF SUMMARY (IE, OFF-LINE PRINT-OUT AT END OF TRANSACTION) GET TITLE?
274   IF(IGET1(JFORM,N8+6).EQ.1HS) GO TO 276
      IF(IGET1(JFORM,N8+7).NE.1HS) GO TO 280
C     SET TTL & STORE NO. OF BYTES IN LISTOF
276   LISTOF(LW)=LNGT*16
      LISTOF(LW)=IOR(LISTOF(LW),100000B)
      LW=LW+1 
C     MOVE TITLE TO LISTOF. 
      CALL MOVEW(KFORM(N2+8),LISTOF(LW),LNGT/2) 
      LW=LW+LNGT/2
      LCTR=LCTR+1 
C 
C  U QUESTION SEQUENCE STORAGE LENGTH ,QUESTION LIGHT,ITEM ADDRESS
C  IX IS QUESTION LIGHT 
C 
280   IF(N1.EQ.(IUMAX+1)) KFORM(8)=N4-1 
      IF(INUM(JFORM,N8+3,2,IX)) GO TO 5000
C    -QUESTION LIGHT #. 
      KFORM(N2+3)=IX*4096 
      IOFT=N4 
      IF(IAT.EQ.0) N4=N4+(N7+1)/2 
      IF(IAT.EQ.1) N4=N4+1
      IF(IAT.EQ.2) N4=N4+2
C 
C-----THIS SECTION DOES THE CARD READER SPECS.
C 
C    -CARD READER/TYPE III BADGE? 
      IF(IGET1(IFORM,1518).NE.1HX) GO TO 286
C    -YES. INIT THE CARD SPEC BITS. 
      KFORM(N2+4)=IAND(KFORM(N2+4),7777B) 
C    -NEW CARD? 
      IF(.NOT.ISSPA(JFORM,N8+35,4)) GO TO 284 
C    -YES. SET NEW CARD FLAG (CRD) & GET REST OF NEW SPECS. 
      CALL SETBT(KFORM(N2+4),11,1)
C    -GO SET CAO IF NC (NO CLOCK MARKS).
      IF(IGET2(JFORM,N8+37).EQ.2HNC) GO TO 282
C    -SET CNC.
      CALL SETBT(KFORM(N2+4),12,1)
C    -SET CAO IF CA (CLOCK AFTER DATA). 
      IF(IGET2(JFORM,N8+37).EQ.2HCA) CALL SETBT(KFORM(N2+4),13,1) 
      GO TO 283 
C    -SET CAO.
282   CALL SETBT(KFORM(N2+4),13,1)
C    -IF MARKS, SET MH. 
283   IF(IGET1(JFORM,N8+36).EQ.1HM) CALL SETBT(KFORM(N2+4),14,1)
C    -IF ASCII, SET AI (EVEN IF NOT A NEW CARD).
284   IF(ISBIT(JFORM(N5+24),0)) CALL SETBT(KFORM(N2+4),15,1)
C 
C-----THIS SECTION DOES THE INPUT DEVICE. 
C 
C    -NON-KEYBOARD INPUT? 
286   IF(IGET1(JFORM,N8+5).EQ.1HX) GO TO 287
C    -NO. KEYBOARD INPUT. SET INPUT DEVICE=0. 
      KFORM(N2+4)=IAND(KFORM(N2+4),177740B) 
      GO TO 290 
C    -NON-KEYBOARD INPUT. TYPE V BADGE? 
287   IF(IGET2(JFORM,N8+39).EQ.2H  ) GO TO 288
C    -NO. MULTIFUNCTION READER/TYPE III BADGE. SET INPUT DEVICE = 1.
      KFORM(N2+4)=IOR(KFORM(N2+4),1)
      ISTART=39 
      IEND=41 
      GO TO 289 
C    -TYPE V BADGE, SET INPUT DEVICE = 2. 
288   KFORM(N2+4)=IOR(KFORM(N2+4),2)
      ISTART=44 
      IEND=46 
      IF(ISSPA(JFORM,N8+43,1))      CALL SETBT(KFORM(N2+4),11,1)
      IF(IGET1(JFORM,N8+43).EQ.1HN) CALL SETBT(KFORM(N2+4),15,1)
C    -STARTING COLUMN.
289   IF(INUM(JFORM,N8+ISTART,2,IS)) PAUSE 276
C    -ENDING COLUMNH. 
      IF(INUM(JFORM,N8+IEND,2,IE)) PAUSE 277
      IF(ISBIT(KFORM(N2+4),15)) GO TO 2891
C    -IMAGE CARD INPUT : TRANSLATE CARD COLUMNS TO BYTES. 
      IS=IS+IS-1
      IE=IE+IE
2891  ILENTH=IE-IS+1
      KFORM(N2+5)=IS
      KFORM(N2+5)=KFORM(N2+5)+ILENTH*256
C 
C************************************************************************ 
C 
C THIS SECTION BUILDS THE DISPLAY INFORMATION PART OF 
C THE STATE.
C 
C************************************************************************ 
C 
C PRINT ?,STRING LENGTH,DISPLAYED ITEM TYPE 
C IX IS ITEM TYPE 
C IY IS DISPLAYED STRING LENGTH 
C IZ IS A VARIABLE LOCAL TO THE DISPLAY INFORMATION ROUTINE.
C IZ=0 NO TOTAL DISPLAY ON THIS ITEM. 
C IZ=1 SUM ITEM, BUT QUES.NE.DISPLAY
C IZ=2 SUM ITEM, AND QUES.EQ.DISPLAY
C 
C-----1ST, SET CURRENT ADDRESS IN KFORM INTO N3.
C 
290   N3=N2+7 
      IF(ISBIT(KFORM(N2+2),15)) N3=N3+KFORM(N2+7) 
C IF NO DISPLAY STORE ITEM OFFSET IN OUTPUT BUFFER
      IZ=0
C    -DISPLAY?
      IF(IAND(KFORM(N2+1),100000B).NE.0) GO TO 291
C    -NO. NOW STORE ITEM RELATIVE ADDRESSES IN DATA OUTPUT BUFFER.
      IF(IAT.NE.3) KFORM(N2+3)=KFORM(N2+3)+IOFT 
      IF(IAT.NE.3) IMAI(N,5)=IOFT 
C    -IF OFF-LINE PRINT-OUT (IE, SUMMARY) WILL BE DONE AT THE END OF
C     THIS TRANSACTION, MOVE THE LENGTH, TYPE, & OUTPUT BUFFER
C     ADDRESS TO THE LIST-OFF SAVE BUFFER.
      IF(IGET1(JFORM,N8+6).EQ.1HS) GO TO 2901 
      IF(IGET1(JFORM,N8+7).NE.1HS) GO TO 320
2901  LISTOF(LW)=IAND(KFORM(N2+2),7777B)
      LW=LW+1 
      LISTOF(LW)=IAND(KFORM(N2+3),7777B)
      LW=LW+1 
      LCTR=LCTR+1 
      GO TO 320 
C 
C    IMAGE DISPLAY  GET ITEM LENGTH AND TYPE
C 
291   IF(IMAI(N+1,1).EQ.0) GO TO 292
      IX=IAND(IMAI(N+1,2),30000B)/4096
      IY=IAND(IMAI(N+1,4),377B) 
C    -WILL A TOTAL BE DONE ON THIS DISPLAY ITEM?
      IF(IGET1(JFORM,N8+140).EQ.1HX) GO TO 2911 
C    -NO. SET IDF BIT.
      CALL SETBT(KFORM(N3),13,1)
      GO TO 293 
C    -YES. QUES ITEM = DISPLAY ITEM?
2911  IZ=1
      IF(CMPB(JFORM,N8+28,JFORM,N8+134,6)) IZ=2 
                                                                                                        