FTN4
      PROGRAM TGPI4(5), 92080-16391 REV.2026 800430                     
C 
C     SOURCE 92080-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(780) 
      COMMON JFORM(1700)
      COMMON MFORM(28)
      COMMON LFORM(42)
      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(2844)
      COMMON ILIBR(67)
      COMMON NIMAG
      COMMON IBASE(10),IMODE
C 
C   LOCAL VARIABLES ****************
C 
      DIMENSION IBUF(52),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(4),ITIME(5),ISUM(6),KTERM(4,3)
      DIMENSION JOFF(4,4),JNCH(4),IONL(8),JTI12(6)
      DIMENSION MGSRED(11),IYES(3),BCRED(8),IDSUB(12) 
      DIMENSION ILARGE(3),ISMALL(3),ISCROL(8),ICLEAR(11)
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  ,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/
      DATA JTI12/2H24,2H H,2HR ,2HCL,2HOC,2HK / 
      DATA JBYTES/170/
      DATA MGSRED/2HMA,2HGS,2HTR,2HIP,2HE ,2HCA,2HRD,2H R,2HEA, 
     .2HDE,2HR /
      DATA IYES/2HYE,2HS ,2H  / 
      DATA BCRED/2HBA,2HR ,2HCO,2HDE,2H R,2HEA,2HDE,2HR / 
      DATA IDSUB/2HUS,2HER,2H W,2HRI,2HTT,2HEN,2H D,2HAT,2HA ,
     .2HMO,2HDU,2HLE/ 
      DATA ILARGE/2HLA,2HRG,2HE / 
      DATA ISMALL/2HSM,2HAL,2HL / 
      DATA ISCROL/2H W,2HIT,2HH ,2HSC,2HRO,2HLL,2HIN,2HG /
      DATA ICLEAR/2H, ,2HCL,2HEA,2HR ,2HDI,2HSP,2HLA,2HY ,2HFI,2HRS,
     *2HT / 
      DATA JWORDS/85/ 
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)*JBYTES 
      MW=(I-1)*JWORDS 
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-----MAGSTRIPE READER ?
      IF(IGET1(JFORM,164+MC).NE.1H .OR. 
     .   JFORM(83+MW).NE.2H  ) KLINE=KLINE+3
C 
C-----BAR CODE READER ? 
      IF(IGET2(JFORM,179+MC).NE.2H  )  KLINE=KLINE+3
C 
C-----USER WRITTEN DATA MODULE ?
      IF(JFORM(77+MW).NE.2H  )  KLINE=KLINE+2 
C 
C-----CRT USAGE ? 
      IF(IGET1(IFORM,1550+MC).NE.1H )  KLINE=KLINE+2
C 
C-----IMAGE ITEM NAME ? 
      IF(ISSPA(JFORM,27+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,107+MC,IBUF,1,16)
      WRITE(LU,2034)(IBUF(K),K=1,8) 
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,146+MC).EQ.1HX) GO TO 3211 
      WRITE(LU,2037) (IBUF(K),K=1,3)
      GO TO 32111 
3211  WRITE(LU,2037) (IBUF(K),K=1,3),(ISUM(IX),IX=1,6)
32111 CALL MOVCA(JFORM,140+MC,IBUF,1,6) 
      WRITE(LU,20371) (IBUF(K),K=1,3) 
C 
C PRINT DISPLAY 
C 
3212  CONTINUE
      J=1 
      CALL BLANC(IBUF,30) 
      JF=IGET2(JFORM,105+MC)
      IF(JF.EQ.2H  ) GO TO 3213 
         J=2
         IBUF(2)=2H , 
         IF(JF.EQ.2HX )CALL MOVCA(IONL,1,IBUF,6,7)
         IF(JF.EQ.2H X)CALL MOVCA(IONL,10,IBUF,6,7) 
         IF(JF.EQ.2HXX)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,11+MC,IBUF,1,16) 
      WRITE(LU,2041)(IBUF(K),K=1,8) 
      IF(IGET2(JFORM,39+MC).EQ.2H   .AND. IGET2(JFORM,44+MC).EQ.2H
     *.AND. IGET1(JFORM,164+MC).EQ.1H 
     *.AND. IGET2(JFORM,165+MC).EQ.2H 
     *.AND. IGET2(JFORM,159+MC).EQ.2H 
     *.AND. IGET2(JFORM,154+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 3281
      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  IF MAGSTRIPE READER ?
C 
3281  IF(IGET1(JFORM,164+MC).EQ.1H .AND.
     .         JFORM(83+MW).EQ.2H  ) GO TO 3285 
      WRITE(LU,2012)MGSRED
C --- NEW CARD? 
      IF(.NOT.ISSPA(JFORM,163+MC,1)) GO TO 3282 
      WRITE(LU,2013) IYES 
3282  CALL BLAN(ICRBF,1,8)
      CALL MOVCA(JFORM,164+MC,ICRBF,1,3)
      CALL MOVCA(JFORM,167+MC,ICRBF,5,3)
      WRITE(LU,2062) (ICRBF(ICR),ICR=1,4) 
C 
C  IF BAR CODE READER ? 
C 
3285  IF(IGET2(JFORM,159+MC).EQ.2H  ) GO TO 329 
      WRITE(LU,2012) BCRED
C --- NEW CARD ?
      IF(.NOT.ISSPA(JFORM,158+MC,1)) GO TO 3286 
      ICRBF=2H
      CALL MOVCA(JFORM,158+MC,ICRBF,1,1)
      IF(.NOT.(ISSPA(JFORM,170+MC,1)))WRITE(LU,2067) ICRBF(1) 
      IF(ISSPA(JFORM,170+MC,1)) WRITE(LU,2066) ICRBF(1) 
3286  WRITE(LU,2014) JFORM(80+MW),JFORM(81+MW)
C 
C  IF USER WRITTEN DATA MODULE ?
C 
329   IF(IGET2(JFORM,154+MC).EQ.2H  ) GO TO 330 
      WRITE(LU,2012) IDSUB
      WRITE(LU,2063) (JFORM(ICR),ICR=77+MW,79+MW) 
      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,27+MC,6)) GO TO 332 
      CALL MOVCA(JFORM,27+MC,IBUF,1,6)
      L=JFORM(17+MW)
      WRITE(LU,2043) (IBUF(K),K=1,3),L
      CALL MOVCA(JFORM,147+MC,IBUF,1,6) 
      WRITE(LU,20371) (IBUF(K),K=1,3) 
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   CRT USAGE ? 
C 
335   IF(IGET1(IFORM,1550).EQ.1H ) GO TO 379
      IF(IGET1(JFORM,6+MC).EQ.1HS) GO TO 377
      IF(IGET1(JFORM,7+MC).EQ.1HC) GO TO 3764 
      WRITE(LU,2064) ILARGE,ISCROL
      GO TO 379 
3764  WRITE(LU,2064) ILARGE,ICLEAR
      GO TO 379 
377   IF(IGET1(JFORM,7+MC).EQ.1HC) GO TO 3766 
      WRITE(LU,2064) ISMALL,ISCROL
      GO TO 379 
3766  WRITE(LU,2064) ISMALL,ICLEAR
C 
C PRINT ANSWER ?
C 
379   JJ=1
      JF=IGET2(JFORM,9+MC)
      CALL BLANC(IBUF,30) 
      IF(JF.EQ.2H  ) GO TO 378
         JJ=2 
         IBUF(2)=2H , 
         IF(JF.EQ.2HX )CALL MOVCA(IONL,1,IBUF,6,7)
         IF(JF.EQ.2H X)CALL MOVCA(IONL,10,IBUF,6,7) 
         IF(JF.EQ.2HXX)CALL MOVCA(IONL,1,IBUF,6,16) 
378   CONTINUE
      CALL MOVCA(JNY(1,JJ),1,IBUF,1,3)
      WRITE(LU,2061) (IBUF(K),K=1,12) 
C 
C  STANDARD EDITS 
C 
      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,20) 
      IF(ISSPA(IBUF,1,20)) WRITE(LU,2020) (IBUF(K),K=1,10)
      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 
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,13 
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.NE.4) GO TO 410
        CALL MOVEW(JTI,IBUF,7)
        IF(.NOT.ISBIT(ITT,10)) GO TO 410
          CALL MOVCA(JTI12,1,IBUF,15,12)
410   WRITE(LU,2052) (IBUF(K),K=1,13) 
      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,20431) (MFORM(K),K=3+(I-1)*3,5+(I-1)*3), 
     *               (MFORM(N),N=17+(I-1)*3,19+(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) 
      IF(ISSPA(LFORM,30,1)) WRITE(LU,2065)
C 
C  USER STORAGE MODULE
C 
460   IHOLD=LFORM(15) 
      LFORM(15)=IOR(IAND(LFORM(15),177400B),40B)
      IF(ISSPA(LFORM,25,5)) WRITE(LU,2058) (LFORM(K),K=13,15) 
      LFORM(15)=IHOLD 
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 .OR. IMODE.EQ.1) 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 : ",10A2)
2021  FORMAT(/,24X,"UPPER LIMIT : ",7A2)
2022  FORMAT(24X,"LOWER LIMIT : ",7A2)
2033  FORMAT(6X,30"-")
2034  FORMAT(/,10X,"- DISPLAYED INFORMATION : ",8A2)
2035  FORMAT(/,28X,"LIGHT # : ",2A2)
2036  FORMAT(21X,"DISPLAY MODULE : ",3A2) 
2037  FORMAT(20X,"IMAGE ITEM NAME : ",3A2,3X,6A2) 
20371 FORMAT(20X,"       DATA SET : ",3A2)
2038  FORMAT(24X,"PRINT VALUE : ",24A2) 
2039  FORMAT(31X,"TYPE : ",4A2) 
2040  FORMAT(31X,"TYPE : ",4A2,"(LENGTH = ",I3,")") 
2041  FORMAT(/,10X,"- ANSWER DEFINITION : ",8A2)
2027  FORMAT(29A2)
2042  FORMAT(38X,"IMAGE DATA BASE : ",3A2,/)
2043  FORMAT(20X,"IMAGE ITEM NAME : ",3A2,2X,"(FUNCTION : ",A1,")") 
20431 FORMAT(20X,"IMAGE ITEM NAME : ",3A2," IN ",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,"- ",13A2) 
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)
2062  FORMAT(22X,"DATA IN COLS. : ",2A2,"- ",2A2) 
2063  FORMAT(19X,"DATA MODULE NAME : ",3A2) 
2064  FORMAT(26X,"CRT USAGE : ",3A2,"CHARACTER SET",11A2) 
2065  FORMAT(10X,"SHARED READ ACCESS ALLOWED")
2066  FORMAT(27X,"NEW PASS : YES, TYPE ",1A2,", CHECK DIGIT ENABLED") 
2067  FORMAT(27X,"NEW PASS : YES, TYPE ",1A2,", NO CHECK DIGIT")
C 
C 
      CALL TGP
      END 
      END$