FTN4
      PROGRAM TGPI4(5), 92903-16391 REV.1913  790118 1400 
C 
C     SOURCE 92903-18391
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      PRGMR : JEAN CHARLES MIARD (HPG) 
C 
C 
C*********************************************************************
C*                                                                   *
C*              THIS IS A SEGMENT OF THE TGP PROGRAM USED TO         *
C*   PRINT THE TRANSACTION SPECIFICATIONS ON THE LIST DEVICE .       *
C*   THE 3070 LABEL ATTACHED TO THE TRANSACTION DEFINED IS ALSO      *
C*   PRINTED .                                                       *
C*                                                                   *
C*       IF INDIC = -1 : RETURN FROM TGP11 THE IMAGE OPERATIONS      *
C*                       HAVE BEEN LISTED .                          *
C*       IF INDIC = 4278 : REQUEST TO LIST A TRANSACTION SPEC COMING *
C*                         FROM TGP1                                 *
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 IBUF(30),IDATE(15),JNY(2,2),IRED3(13),IRED5(10) 
      DIMENSION IK1(6),ITERM(4),IALPHA(26)
      DIMENSION IRSET(3),IKBD(4),ISTRG(4),IINT(4),IREAL(4)
      DIMENSION IFUN(4),INAM(3),JFUN(11),JAR(10),JCO(4),JDE(3)
      DIMENSION JNE(5),JDV(8),JDI(8),JEX(8),JNX(10),JCE(11),JCN(11) 
      DIMENSION JID(9),JTE(6),JDA(3),JTI(7),JNAM(3),IPRES(27) 
      DIMENSION ICRBF(3),ITIME(5),ISUM(6),KTERM(4,3)
      DIMENSION JOFF(4,4),JNCH(4),IONL(8) 
C 
      LOGICAL ISSPA,ISBIT,JULIB 
C 
C 
C 
C 
C  DATA VALUES *************
C 
      DATA IK1/2HRE,2HSE,2HT/,2HST,2HAR,2HT / 
      DATA IRSET/2HRE,2HSE,2HT /
      DATA IKBD/2HKE,2HYB,2HOA,2HRD/
      DATA ISTRG/2HST,2HRI,2HNG,2H  / 
      DATA IINT/2HIN,2HTE,2HGE,2HR /
      DATA IREAL/2HRE,2HAL,2H  ,2H  / 
      DATA IFUN/2HFU,2HNC,2HTI,2HON/
      DATA INAM/2HTG,2HP1,2H  / 
      DATA JFUN/2H F,2HUN,2HCT,2HIO,2HNS,2H A,2HCC,2HEP,2HTE,2HD ,2H: / 
      DATA JAR/2HAR,2HIT,2HHM,2HET,2HIC,2H O,2HPE,2HRA,2HTO,2HRS/ 
      DATA JCO/2HCO,2HNT,2HIN,2HUE/ 
      DATA JDE/2HDE,2HLE,2HTE/
      DATA JNE/2HNE,2HXT,2H E,2HNT,2HRY/
      DATA JDV/2HDE,2HFA,2HUL,2HT ,2HVA,2HLU,2HE ,2H: / 
      DATA JDI/2HDI,2HSP,2HLA,2HYE,2HD ,2HVA,2HLU,2HE / 
      DATA JEX/2HCH,2HEC,2HK ,2HEX,2HIS,2HTE,2HNC,2HE / 
      DATA JNX/2HCH,2HEC,2HK ,2HNO,2HN ,2HEX,2HIS,2HTE,2HNC,2HE / 
      DATA JCE/2HCH,2HEC,2HK ,2HAL,2HL ,2HCH,2HAI,2HNS,2H E,2HMP,2HTY/
      DATA JCN/2HCH,2HEC,2HK ,2HCH,2HAI,2HN ,2HNO,2HN ,2HEM,2HPT,2HY /
      DATA JID/2HTR,2HAN,2HSA,2HCT,2HIO,2HN ,2HID,2H. ,2H: /
      DATA JTE/2HTE,2HRM,2HIN,2HAL,2H #,2H :/ 
      DATA JDA/2HDA,2HTE,2H :/
      DATA JTI/2HTI,2HME,2H O,2HF ,2HDA,2HY ,2H: /
      DATA JNAM/2HTG,2HPI,2H1 / 
      DATA IPRES/15530B,15555B,15446B,65460B, 
     C41040B,    15542B,6412B,6412B,15446B,62112B,2HPr,2Hes,2Hs ,15446B,
     C62113B,2HNE,2HXT,2H S,2HCR,2HEE,2HN ,15446B,62112B,2Hke,74433B, 
     C23144B,40040B/
      DATA ICRBF/2H  ,2H  ,2H  /
      DATA ISUM/2H(T,2HOT,2HAL,2H I,2HTE,2HM)/
      DATA JNY/2HNO,2H  ,2HYE,2HS / 
      DATA JOFF/98,67,91,98, 92,68,92,50, 93,69,93,98, 72,61,77,0/
      DATA JNCH/20,6,14,0/
      DATA IRED3/2HTY,2HPE,2H I,2HII,2H C,2HAR,2HD/,2HBA,2HDG,2HE , 
     *           2HRE,2HAD,2HER/
      DATA IRED5/2HTY,2HPE,2H V,2H B,2HAD,2HGE,2H R,2HEA,2HDE,2HR / 
      DATA IONL/2HON,2H-L,2HIN,2HE,,2H S,2HUM,2HMA,2HRY/
C 
C***********************************************************************
C 
C   GET LIST LU AND IF INDIC = -1 GO TO FINISH LISTING
C 
C************************************************************************ 
C 
      LU=ISKIP
49    IF(INDIC.EQ.-1) GO TO 470 
C 
C*********************************************************************
C 
C   WRITE QUESTION SPECIFICATIONS 
C 
C*********************************************************************
C 
      NLINE=32000 
      IPAGE=IMODB 
      CALL FTIME(IDATE) 
300   DO 400 I=1,IUMAX+IMMAX
      MC=(I-1)*140
      MW=(I-1)*70 
C 
C  CALCULATE NO. OF LINES REQUIRED BY THIS QUES 
C 
      JF=JFORM(50+MW) 
      KLINE=14
C 
C-----DISPLAY VALUE ? 
      IF(IGET1(JFORM,103+MC).EQ.1HX)KLINE=KLINE+8 
C 
C-----CARD/TYPE III BADGE READER ?
      IF(IGET2(JFORM,39+MC).NE.2H  )KLINE=KLINE+3 
C 
C-----TYPE V BADGE READER ? 
      IF(IGET2(JFORM,44+MC).NE.2H  )KLINE=KLINE+3 
C 
C-----IMAGE ITEM NAME ? 
      IF(ISSPA(JFORM,28+MC,6))KLINE=KLINE+1 
C 
C-----IMAGE EDITS ? 
      IF(IAND(IMAI(2*I-1,2)/64,700B).NE.0)KLINE=KLINE+1 
C 
C-----ARITHMETIC OPERATORS
      IF(IGET1(JFORM,JOFF(JF+1,1)+MC).EQ.1HX)KLINE=KLINE+1
C 
C-----NEXT ENTRY
      IF(IGET1(JFORM,JOFF(JF+1,2)+MC).EQ.1HX)KLINE=KLINE+1
C 
C-----CONTINUE
      IF(IGET1(JFORM,49+MC).EQ.1HX .AND. J.EQ.3)KLINE=KLINE+1 
C 
C-----DELETE
      IF(IGET1(JFORM,51+MC).EQ.1HX .AND. J.EQ.3)KLINE=KLINE+1 
C 
C-----USER EDIT MODULE
      IF(ISSPA(JFORM,JOFF(JF+1,3)+MC,5) .AND. J.NE.3)KLINE=KLINE+1
C 
C-----LENGTH OF STORAGE 
      IF(I.EQ.IUMAX .OR. I.EQ.IUMAX+IMMAX)NLINE=NLINE+2 
C 
C  HEADER FOR U QUESTIONS 
C 
      NLINE=NLINE+KLINE 
      IF(NLINE.LT.50)GO TO 308
      CALL PHEAD(LU,IPAGE,IDATE)
      NLINE=KLINE 
C 
308   CONTINUE
      IF((I.NE.1).OR.(IUMAX.EQ.0)) GO TO 310
      J=2HU 
      WRITE(LU,2008) IUMAX,J
      WRITE(LU,2009)
      NLINE=NLINE+2 
C 
C  HEADER FOR M QUESTIONS 
C 
310   IF(I.NE.IUMAX+1) GO TO 320
      J=2HM 
      WRITE(LU,2008) IMMAX,J
      WRITE(LU,2009)
      NLINE=NLINE+2 
320   CONTINUE
C 
C  PRINT QUESTION LABEL 
C 
      WRITE(LU,2011) (IFORM(637+(I-1)*6+K),K=1,6) 
      WRITE(LU,2033)
C 
C  DISPLAYED INFORMATION
C 
      IF(IGET1(JFORM,2+MC).NE.1HX) GO TO 324
C 
C  DISPLAY LABEL
C 
      CALL MOVCA(JFORM,106+MC,IBUF,1,20)
      WRITE(LU,2034)(IBUF(K),K=1,10)
C 
C  INDICATOR LIGHT #
C 
      J1=JFORM(51+MW) 
      J2=2H 
      J3=2HNO 
      J4=2HNE 
      IF(J1.NE.2H00) WRITE(LU,2035) J1,J2 
      IF(J1.EQ.2H00) WRITE(LU,2035) J3,J4 
C 
C  ITEM TYPE
C 
      K=IGET1(JFORM,133+MC) 
      IF(K.EQ.1HS) J=0
      IF(K.EQ.1HI) J=1
      IF(K.EQ.1HR) J=2
      IF(K.NE.1H ) GO TO 321
      J=IAND(IMAI(2*I,2),30000B)/4096 
321   IF(J.EQ.0) CALL MOVEW(ISTRG,IBUF,4) 
      IF(J.EQ.1) CALL MOVEW(IINT,IBUF,4)
      IF(J.EQ.2) CALL MOVEW(IREAL,IBUF,4) 
      IF(J.EQ.0) WRITE(LU,2040) (IBUF(K),K=1,4),JFORM(66+MW)
      IF(J.NE.0) WRITE(LU,2039) (IBUF(K),K=1,4) 
C 
C  DISPLAY MODULE 
C 
      IBUF(3)=2H
      CALL MOVCA(JFORM,126+MC,IBUF,1,5) 
      IF(ISSPA(JFORM,126+MC,5)) WRITE(LU,2036) (IBUF(K),K=1,3)
C 
C  IMAGE NAME (ADD "TOTALED ITEM" IF NECESSARY) 
C 
      CALL MOVCA(JFORM,134+MC,IBUF,1,6) 
      IF(.NOT.ISSPA(JFORM,134+MC,6)) GO TO 3212 
      IF(IGET1(JFORM,140+MC).EQ.1HX) GO TO 3211 
      WRITE(LU,2037) (IBUF(K),K=1,3)
      GO TO 3212
3211  WRITE(LU,2037) (IBUF(K),K=1,3),(ISUM(IX),IX=1,6)
C 
C PRINT DISPLAY 
C 
3212  CONTINUE
      J=1 
      CALL BLANC(IBUF,30) 
      JF=IGET2(JFORM,104+MC)
      IF(JF.EQ.2H  ) GO TO 3213 
         J=2
         IBUF(2)=2H , 
         IF(JF.EQ.2HO  .OR. JF.EQ.2H O)CALL MOVCA(IONL,1,IBUF,6,7)
         IF(JF.EQ.2H S .OR. JF.EQ.2HS )CALL MOVCA(IONL,10,IBUF,6,7) 
         IF(JF.EQ.2HOS .OR. JF.EQ.2HSO)CALL MOVCA(IONL,1,IBUF,6,16) 
3213  CONTINUE
      CALL MOVCA(JNY(1,J),1,IBUF,1,3) 
      WRITE(LU,2038) (IBUF(K),K=1,12) 
C 
C  DISPLAYED DATA OFFSET IN OUTPUT BUFFER 
C 
322   WRITE(LU,2045) IMAI(2*I,5)
C 
C  ANSWER SPECIFICATIONS
C 
C 
C  IF TYPE III CARD/BADGE READER ?
C 
324   CONTINUE
      CALL MOVCA(JFORM,8+MC,IBUF,1,20)
      WRITE(LU,2041)(IBUF(K),K=1,10)
      IF(IGET2(JFORM,39+MC).EQ.2H   .AND. IGET2(JFORM,44+MC).EQ.2H  ) 
     *   GO TO 325
      IF(IGET2(JFORM,39+MC).EQ.2H  ) GO TO 328
      WRITE(LU,2012) IRED3
C-----NEW CARD? 
      IF(.NOT.ISSPA(JFORM,35+MC,4)) GO TO 326 
C-----YES.  DISPLAY NEW CARD SPECS. 
      ICRBF(1)=2H . 
      ICRBF(2)=2H . 
      CALL MOVCA(JFORM,35+MC,ICRBF,1,1) 
      CALL MOVCA(JFORM,36+MC,ICRBF,3,1) 
      CALL MOVCA(JFORM,37+MC,ICRBF,5,2) 
      WRITE(LU,2013) (ICRBF(ICR),ICR=1,3) 
326   WRITE(LU,2014)JFORM(20+MW),JFORM(21+MW) 
C 
C  IF TYPE V BADGE READER ? 
C 
328   IF(IGET2(JFORM,44+MC).EQ.2H  )GO TO 330 
      WRITE(LU,2012)IRED5 
      ICRBF(1)=2H . 
      CALL MOVCA(JFORM,43+MC,ICRBF,1,1) 
      IF(ICRBF(1).NE.2H .)WRITE(LU,2013) ICRBF(1) 
      CALL MOVCA(JFORM,44+MC,ICRBF,1,2) 
      CALL MOVCA(JFORM,46+MC,ICRBF,3,2) 
      WRITE(LU,2014)ICRBF(1),ICRBF(2) 
      GO TO 330 
C 
C KEYBOARD INPUT
C 
325   WRITE(LU,2012) IKBD 
C 
C  LIGHT #
C 
330   J1=JFORM(2+MW)
      J2=2H 
      J3=2HNO 
      J4=2HNE 
      IF(J1.NE.2H00) WRITE(LU,2035) J1,J2 
      IF(J1.EQ.2H00) WRITE(LU,2035) J3,J4 
C 
C  PRINT ITEM TYPE
C 
      J=JFORM(50+MW)
      IF(J.EQ.0) CALL MOVEW(ISTRG,IBUF,4) 
      IF(J.EQ.1) CALL MOVEW(IINT,IBUF,4)
      IF(J.EQ.2) CALL MOVEW(IREAL,IBUF,4) 
      IF(J.EQ.3) CALL MOVEW(IFUN,IBUF,4)
      IF(J.EQ.0) WRITE(LU,2040) (IBUF(K),K=1,4),JFORM(25+MW)
      IF(J.NE.0) WRITE(LU,2039) (IBUF(K),K=1,4) 
C 
C  IMAGE ITEM NAME , FUNCTION 
C 
      IF(.NOT.ISSPA(JFORM,28+MC,6)) GO TO 332 
      CALL MOVCA(JFORM,28+MC,IBUF,1,6)
      L=IALF2(JFORM(17+MW)) 
      WRITE(LU,2043) (IBUF(K),K=1,3),L
C 
C  IMAGE EDITS
C 
332   L=IAND(IMAI(2*I-1,2),700B)/64 
      IF(L.EQ.0) GO TO 335
      DO 333 K=1,11 
333   IBUF(K)=2H
      IF(L.EQ.1) CALL MOVEW(JEX,IBUF,8) 
      IF(L.EQ.2) CALL MOVEW(JNX,IBUF,10)
      IF(L.EQ.3) CALL MOVEW(JCE,IBUF,11)
      IF(L.EQ.4) CALL MOVEW(JCN,IBUF,11)
      WRITE(LU,2047) (IBUF(K),K=1,11) 
C 
C  STANDARD EDITS 
C 
335   IF(J.EQ.3) GO TO 350
C 
C STRINGS 
C 
      IF(J.NE.0) GO TO 340
      IBUF(1)=IAND(JFORM(26+MW),177400B)
      IBUF(1)=IOR(IBUF(1),40B)
      WRITE(LU,2019) IBUF(1)
      CALL MOVCA(JFORM,52+MC,IBUF,1,16) 
      IF(ISSPA(IBUF,1,16)) WRITE(LU,2020) (IBUF(K),K=1,8) 
      GO TO 350 
C 
C  INTEGERS 
C 
340   IF(J.NE.1) GO TO 342
      IF(ISSPA(JFORM,49+MC,6)) WRITE(LU,2021) (JFORM(24+MW+K),K=1,3)
      IF(ISSPA(JFORM,55+MC,6)) WRITE(LU,2022) (JFORM(27+MW+K),K=1,3)
      GO TO 350 
C 
C  REALS
C 
342   IF(ISSPA(JFORM,49+MC,14)) WRITE(LU,2021) (JFORM(24+MW+K),K=1,7) 
      IF(ISSPA(JFORM,63+MC,14)) WRITE(LU,2022) (JFORM(31+MW+K),K=1,7) 
C 
C  FUNCTIONS ACCEPTED 
C 
350   DO 351 K=1,29 
351   IBUF(K)=2H
      CALL MOVEW(JFUN,IBUF(9),11) 
C 
C  ARITH OPERATORS
C 
      IF((J.NE.1).AND.(J.NE.2)) GO TO 360 
      K=JOFF(J+1,1) 
      IF(IGET1(JFORM,K+MC).NE.1HX) GO TO 360
      CALL MOVEW(JAR,IBUF(20),10) 
      WRITE(LU,2027) (IBUF(K),K=1,29) 
      DO 352 K=1,29 
352   IBUF(K)=2H
C 
C  NEXT ENTRY 
C 
360   CONTINUE
      K=JOFF(J+1,2) 
      IF(IGET1(JFORM,K+MC).NE.1HX) GO TO  365 
      CALL MOVEW(JNE,IBUF(20),5)
      WRITE(LU,2027) (IBUF(K),K=1,29) 
      DO 361 K=1,29 
361   IBUF(K)=2H
C 
C  CONTINUE 
C 
365   IF(J.NE.3) GO TO 370
      IF(IGET1(JFORM,49+MC).NE.1HX) GO TO 367 
      CALL MOVEW(JCO,IBUF(20),4)
      WRITE(LU,2027) (IBUF(K),K=1,29) 
      DO 366 K=1,29 
366   IBUF(K)=2H
C 
C  DELETE 
C 
367   IF(IGET1(JFORM,51+MC).NE.1HX) GO TO 370 
      CALL MOVEW(JDE,IBUF(20),3)
      WRITE(LU,2027) (IBUF(K),K=1,29) 
      DO 368 K=1,29 
368   IBUF(K)=2H
C 
C   USER EDIT MODULE
C 
370   IF(J.EQ.3) GO TO 385
      IBUF(3)=2H
      K=JOFF(J+1,3) 
      CALL MOVCA(JFORM,K+MC,IBUF,1,5) 
      IF(ISSPA(IBUF,1,5)) WRITE(LU,2044) (IBUF(K),K=1,3)
C 
C  DEFAULT VALUE
C 
      DO 371 K=1,29 
371   IBUF(K)=2H
      CALL MOVEW(JDV,IBUF(12),8)
      IF(IGET1(JFORM,103+MC).EQ.1HX) GO TO 375
      K=JOFF(J+1,4) 
      KCH=JNCH(J+1) 
      IF(ISSPA(JFORM,K+MC,KCH)) GO TO 372 
      IF(J.NE.0) IBUF(21)=2H0 
      GO TO 376 
372   CALL MOVCA(JFORM,K+MC,IBUF,39,KCH)
      GO TO 376 
375   CALL MOVEW(JDI,IBUF(20),8)
376   WRITE(LU,2027) (IBUF(K),K=1,29) 
C 
C PRINT ANSWER ?
C 
      J=1 
      JF=IGET2(JFORM,6+MC)
      CALL BLANC(IBUF,30) 
      IF(JF.EQ.2H  ) GO TO 378
         J=2
         IBUF(2)=2H , 
         IF(JF.EQ.2HO  .OR. JF.EQ.2H O)CALL MOVCA(IONL,1,IBUF,6,7)
         IF(JF.EQ.2H S .OR. JF.EQ.2HS )CALL MOVCA(IONL,10,IBUF,6,7) 
         IF(JF.EQ.2HOS .OR. JF.EQ.2HSO)CALL MOVCA(IONL,1,IBUF,6,16) 
378   CONTINUE
      CALL MOVCA(JNY(1,J),1,IBUF,1,3) 
      WRITE(LU,2061) (IBUF(K),K=1,12) 
C 
C   DATA OFFSET IN OUTPUT BUFFER
C 
380   CONTINUE
      WRITE(LU,2045) IMAI(2*I-1,5)
C 
C  LENGTH OF STORAGE FOR A U OR M QUESTIONS SEQUENCE
C 
385   IF((I.NE.IUMAX).OR.(IUMAX.EQ.0)) GO TO 390
      J=2HU 
      WRITE(LU,2046) J,KFORM(8) 
      NLINE=1000
      GO TO 400 
390   IF((I.NE.IUMAX+IMMAX).OR.(IMMAX.EQ.0)) GO TO 400
      J=2HM 
      WRITE(LU,2046) J,KFORM(9) 
      NLINE=1000
C 
400   CONTINUE
C 
C************************************************************************ 
C 
C  DATA ADDED BY THE SYSTEM : 
C 
C************************************************************************ 
C 
C 
      IF(.NOT.ISSPA(MFORM,1,4)) GO TO 450 
      CALL PHEAD(LU,IPAGE,IDATE)
      WRITE(LU,2050)
      WRITE(LU,2051)
      DO 440 I=1,4
      IF(IGET1(MFORM,I).NE.1HX) GO TO 440 
      DO 405 K=1,9
405   IBUF(K)=2H
      IF(I.EQ.1) CALL MOVEW(JID,IBUF,9) 
      IF(I.EQ.2) CALL MOVEW(JTE,IBUF,6) 
      IF(I.EQ.3) CALL MOVEW(JDA,IBUF,3) 
      IF(I.EQ.4) CALL MOVEW(JTI,IBUF,7) 
      WRITE(LU,2052) (IBUF(K),K=1,9)
      WRITE(LU,2045) IMAI(40+I,5) 
      IF(.NOT.ISSPA(MFORM,5+(I-1)*6,6)) GO TO 440 
      L=MFORM(16) 
      IF(I.LE.2) L=MFORM(15)
      IF((I.EQ.2).OR.(I.EQ.4)) L=IALF2(L) 
      WRITE(LU,2043) (MFORM(K),K=3+(I-1)*3,5+(I-1)*3),L 
440   CONTINUE
C 
C********************************************************************** 
C 
C   DATA STORAGE DEFINITION 
C 
C*********************************************************************
C 
450   CONTINUE
      CALL PHEAD(LU,IPAGE,IDATE)
      IF(.NOT.ISSPA(LFORM,1,29))GO TO 465 
      WRITE(LU,2053)
      WRITE(LU,2054)
C 
C  FILE NAME # 1
C 
      IF(ISSPA(LFORM,1,6)) WRITE(LU,2055) (LFORM(K),K=1,3)
C 
C  FILE NAME # 2
C 
      IF(.NOT.ISSPA(LFORM,7,6)) GO TO 460 
      WRITE(LU,2055) (LFORM(K),K=4,6) 
      IF(ISSPA(LFORM,13,6)) WRITE(LU,2056) (LFORM(K),K=7,9) 
      IF(ISSPA(LFORM,19,6)) WRITE(LU,2057) (LFORM(K),K=10,12) 
C 
C  USER STORAGE MODULE
C 
460   IF(ISSPA(LFORM,25,5)) WRITE(LU,2058) (LFORM(K),K=13,15) 
C 
C  IF IMAGE OPERATIONS GO TO TGP11 TO PRINT THEM
C 
465   IF(IAND(IMFLG,100000B).EQ.0) GO TO 470
      INDIC=-2
      CALL EXEC(8,JNAM) 
C 
C   RETURN FROM TGP11 
C 
470   WRITE(LU,2059) KFORM(1) 
C 
C***********************************************************************
C 
C    IF LIST LU = TERMINAL LU ASK USER TO CONTINUE AND TERMINATE TGP
C 
C***********************************************************************
C 
C 
      IF(LU.NE.ILU) GO TO 480 
      CALL EXEC(2,ILU,IPRES,27) 
      CALL REIO(1,ILU,IANS,-1)
      GO TO 485 
480   CALL EXEC(3,1100B+LU,-1)
485   INDIC=99
      CALL EXEC(8,INAM) 
C 
C 
C 
C*********************************************************************
C 
C  FORMATS
C 
C*********************************************************************
C 
2008  FORMAT(4X,I2,2X,A2,"QUESTIONS :  ") 
2009  FORMAT(4X,17("*"))
2011  FORMAT(//,6X,"QUESTION LABEL :  ",6A2)
2012  FORMAT(30X,"INPUT : ",13A2) 
2013  FORMAT(27X,"NEW CARD : ",3A2) 
2014  FORMAT(22X,"DATA IN COLS. : ",A2," - ",A2)
2019  FORMAT(24X,"POSITIONING : ",A2) 
2020  FORMAT(31X,"MASK : ",8A2) 
2021  FORMAT(24X,"UPPER LIMIT : ",7A2)
2022  FORMAT(24X,"LOWER LIMIT : ",7A2)
2033  FORMAT(6X,30"-")
2034  FORMAT(/,10X,"- DISPLAYED INFORMATION : ",10A2) 
2035  FORMAT(28X,"LIGHT # : ",2A2)
2036  FORMAT(21X,"DISPLAY MODULE : ",3A2) 
2037  FORMAT(20X,"IMAGE ITEM NAME : ",3A2,3X,6A2) 
2038  FORMAT(24X,"PRINT VALUE : ",24A2) 
2039  FORMAT(31X,"TYPE : ",4A2) 
2040  FORMAT(31X,"TYPE : ",4A2,"(LENGTH = ",I3,")") 
2041  FORMAT(/,10X,"- ANSWER DEFINITION : ",10A2) 
2027  FORMAT(29A2)
2042  FORMAT(38X,"IMAGE DATA BASE : ",3A2,/)
2043  FORMAT(20X,"IMAGE ITEM NAME : ",3A2,2X,"(FUNCTION : ",A1,")") 
2044  FORMAT(24X,"EDIT MODULE : ",3A2)
2045  FORMAT(14X,"DATA OFFSET IN BUFFER : ",I4) 
2046  FORMAT(/,6X,"* LENGTH OF STORAGE FOR ",A2,"QUESTIONS ", 
     C"SEQUENCE : ",I4,/) 
2047  FORMAT(15X,"IMAGE EDIT GENERATED : ",11A2)
2050  FORMAT(/,4X,"INFORMATION ADDED BY THE SYSTEM :")
2051  FORMAT(4X,33"*")
2052  FORMAT(/,10X,"- ",9A2)
2053  FORMAT(/,4X,"DATA COLLECTED STORAGE :") 
2054  FORMAT(4X,24"*")
2055  FORMAT(/,10X,"FILE NAME : ",3A2)
2056  FORMAT(10X,"CR # : ",3A2) 
2057  FORMAT(10X,"SEC. CODE : ",3A2)
2058  FORMAT(/,10X,"STORAGE MODULE : ",3A2) 
2059  FORMAT(//,6X,"* TRANSACTION SPECIFICATION LENGTH : ",I4," WORDS") 
2061  FORMAT(23X,"PRINT ANSWER : ",24A2)
C 
C 
      CALL TGP
      END 
C 
C 
C************************************************************************ 
C************************************************************************ 
C 
      SUBROUTINE PHEAD(LU,IPAGE,IDATE), 92903-16391 REV.1913  790203
C 
C 
C 
C************************************************************************ 
C*                                                                      * 
C*          THIS SUBROUTINE OUTPUTS PAGE HEADERS FOR THE TRANSACTION    * 
C*     GENERATION LISTINGS:                                             * 
C*                                                                      * 
C*          LU    - LOGICAL UNIT NO. OF THE OUTPUT DEVICE               * 
C*          IPAGE - CURRENT PAGE NO., THIS PARAMETER IS AUTOMATICALLY   * 
C*                  INCREMENTED TO THE NEXT PAGE UPON RETURN TO THE     * 
C*                  CALLING PROGRAM                                     * 
C*          IDATE - CURRENT DATE                                        * 
C*                                                                      * 
C************************************************************************ 
C 
C 
C 
      DIMENSION IHEAD(24),IDATE(15) 
      DATA IHEAD/2H P,2HAG,2HE ,2H00,2H01,2H  ,2H D,2HAT,2HAC 
     *          ,2HAP,2H/1,2H00,2H0 ,2H- ,2HHP,2H92,2H90,2H3A 
     *          ,2H R,2HEV,2H 1,2H91,2H3 ,2H  / 
C 
         WRITE(LU,1004) 
         CALL JASC(IPAGE,IHEAD,-7,4)
         WRITE(LU,1007)IHEAD,IDATE
         WRITE(LU,2000) 
         WRITE(LU,2024) 
         IPAGE=IPAGE+1
1004  FORMAT("1") 
1007  FORMAT(X,24A2,15A2) 
2000  FORMAT(/,20X,"TRANSACTION SPECIFICATION GENERATOR LIST")
2024  FORMAT(19X,42"*",//)
      RETURN
      END 
      END$