FTN4
      PROGRAM TGPI3(5), 92903-16379 REV.1913  790117 0950 
C 
C     SOURCE 92903-18379
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(40),IBUF2(40),JLIT(6,3),NLAB(3,4),NCOL(4)
      DIMENSION IK1(6),ITERM(4),IALPHA(26),IDATE(15)
      DIMENSION INAM(3),KTERM(14,4),ITIME(5),IPRES(27)
      DIMENSION LABL(3),LABH(3),LABO(3) 
      DIMENSION IAS66(34),IAS79(40) 
C 
      LOGICAL ISSPA,ISBIT 
C 
      LOGICAL LPRINT,LALPHK,LALPHD,LTYPE3,LTYPE5
      LOGICAL L3075A,L3075N,L3070B,L3070A 
      LOGICAL LTERM(4)
      EQUIVALENCE (LTERM(1),L3075A) 
      EQUIVALENCE (LTERM(2),L3075N) 
      EQUIVALENCE (LTERM(3),L3070B) 
      EQUIVALENCE (LTERM(4),L3070A) 
C 
C 
C 
C  DATA VALUES *************
C 
      DATA JLIT /2HER,2HRO,2HR ,2HLI,2HGH,2HT , 
     *           2HCO,2HMP,2HL.,2HTR,2HAN,2HS., 
     *           2HSE,2HLE,2HCT,2H T,2H.S,2H. / 
      DATA IK1/2H  ,2H R,2HES,2HET,2H  ,2H  / 
      DATA INAM/2HTG,2HPI,2H4 / 
      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 KTERM/2HHP,2H30,2H75,2H/6,2H (,2HAL,2HPH,2HA ,2HKE,2HYB, 
     *           2HOA,2HRD,2H) ,2H  , 
     *           2HHP,2H30,2H75,2H/6,2H (,2HNU,2HME,2HRI,2HC ,2HKE, 
     *           2HYB,2HOA,2HRD,2H) , 
     *           2HHP,2H30,2H70,2HB ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  , 
     *           2H  ,2H  ,2H  ,2H  , 
     *           2HHP,2H30,2H70,2HA ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  , 
     *           2H  ,2H  ,2H  ,2H  / 
      DATA ITERM/0,0,0,-1/
      DATA IALPHA/2HA>,2HB>,2HC>,2HD>,2HE>,2HF>,2HG>,2HH>,2HI>, 
     *            2HJ>,2HK>,2HL>,2HM>,2HN>,2HO>,2HP>,2HQ>,2HR>, 
     *            2HS>,2HT>,2HU>,2HV>,2HW>,2HX>,2HY>,2HZ>/
      DATA NLAB/5,5,4,5,5,4,4,4,4,4,4,4/
      DATA NCOL/5,5,4,4/
      DATA LABL/11,16,22/ 
      DATA LABH/15,21,26/ 
      DATA LABO/13,0,0/ 
      DATA IAS66/34*25052B/ 
      DATA IAS79/40*25052B/ 
      IAS66(1)=2H * 
      IAS66(34)=2H* 
      IAS79(1)=2H * 
C 
C***********************************************************************
C 
C   GET LIST LU AND IF INDIC = -1 GO TO FINISH LISTING
C 
C************************************************************************ 
C 
      LU=ISKIP
C-----IF LIST LU IS NOT DEFAULT TERMINAL, LOCK IT.
      IF(LU.EQ.ILU) GO TO 49
C-----1ST UNLOCK ALL LOCKED LU'S
      CALL LURQ(100000B,LU,1) 
C-----NOW LOCK THE LIST LU
      CALL LURQ(1,LU,1) 
49    CONTINUE
      ICNWD=LU
C 
C*********************************************************************
C 
C  DETERMINE WHICH SPECIAL FEATURES ARE ENABLED FOR THE TERMINALS 
C 
C*********************************************************************
C 
C INITIALISE ALL FEATURES TO "NOT USED" 
C 
      LPRINT=.FALSE.
      LALPHK=.FALSE.
      LALPHD=.FALSE.
      LTYPE3=.FALSE.
      LTYPE5=.FALSE.
      MAXKEY=0
      MAXLIT=0
C 
C CHECK EACH FEATURE
C 
C-----HIGHEST KEY NO. USED BY TRANSACTION 
      DO 10 I=26,1,-1 
         IF((IKEY(I,1).NE.0).OR.(IKEY(I,3).NE.0))GO TO 11 
10    CONTINUE
11    MAXKEY=I
C 
C-----HIGHEST LIGHT NO. USED BY TRANSACTION 
      DO 15 I=14,1,-1 
         IF(ILITE(I).NE.0)GO TO 16
15    CONTINUE
16    MAXLIT=I
C 
C-----ALPHA KEYBOARD (QUES 2, SCR 41) 
      IF((IGET1(IFORM,1516).EQ.1HX).OR.(MAXKEY.GT.10))LALPHK=.TRUE. 
C 
C-----ALPHA DISPLAY (QUES 3, SCR 41)
      IF(IGET1(IFORM,1517).EQ.1HX)LALPHD=.TRUE. 
C 
C........ALPHA PRINTER (CHECK ANSWERS IN SCREEN 41) 
         IF(IGET1(IFORM,1515).EQ.1HX)LPRINT=.TRUE.
C 
C........CARD/TYPE III BADGE READER (CHECK ANSWERS IN SCREEN 41)
         IF(IGET1(IFORM,1518).EQ.1HX)LTYPE3=.TRUE.
C 
C........TYPE V BADGE READER (CHECK ANSWERS IN SCREEN 41) 
         IF(IGET1(IFORM,1519).EQ.1HX)LTYPE5=.TRUE.
C 
C***********************************************************************
C 
C  DETERMINE WHICH TERMINALS CAN BE USED BY THIS TRANSACTION
C 
C***********************************************************************
C 
C-----3075 WITH ALPHA KEYBOARD CAN ALWAYS BE USED 
      L3075A=.TRUE. 
C 
C-----3075 WITH NUMERIC KEYBOARD IS USED ONLY WHEN THE ALPHA KEYBOARD 
C-----IS NOT SPECIFIED, AND WHEN THE HIGHEST KEY DEFINED IS .LE. 10 
      L3075N=((.NOT.LALPHK).AND.(MAXKEY.LE.10)) 
C 
C-----3070B IS USED ONLY WHEN THE ALPHA KEYBOARD, ALPHA DISPLAY, AND
C-----TYPE V BADGE READER ARE NOT SPECIFIED, WHEN THE HIGHEST KEY 
C-----DEFINED IS .LE. 10, AND WHEN THE HIGHEST LIGHT DEFINED IS .LE. 12 
      L3070B=((.NOT.(LALPHK.OR.LALPHD.OR.LTYPE5)).AND.(MAXKEY.LE.10)
     *         .AND.(MAXLIT.LE.12)) 
C 
C-----3070A IS USED ONLY WHEN THE NONE OF THE SPECIAL FEATURES ARE
C-----SPECIFIED, WHEN THE HIGHEST KEY DEFINED IS .LE. 9, AND WHEN 
C-----THE HIGHEST LIGHT DEFINED IS .LE. 12
      L3070A=((.NOT.(LPRINT.OR.LALPHK.OR.LALPHD.OR.LTYPE3.OR.LTYPE5)) 
     *         .AND.(MAXKEY.LE.9).AND.(MAXLIT.LE.12)) 
C 
C*********************************************************************
C 
C  WRITE LABEL PLATES FOR ALL TERMINALS THAT CAN BE USED BY THIS
C  TRANSACTION
C 
C********************************************************************** 
C 
C  LABEL HEADER 
C 
      CALL EXEC(3,1100B+LU,-1)
C-----GO TO 55 IF THE LIST REQUEST IS FROM TGP1.
      IPAGE=1 
      CALL FTIME(IDATE) 
      DO 50 II=1,4
         IF(.NOT.LTERM(II))GO TO 50 
         CALL PHEAD(LU,IPAGE,IDATE) 
         IF(INDIC.EQ.4278) GO TO 55 
            WRITE(LU,1005)
     *      (IFORM(K),K=29,31),(IFORM(K),K=32,33),
     *      (LFORM(K),K=16,21)
            WRITE(LU,1006) (KTERM(K,II),K=1,14) 
         GO TO 60 
C-----------GET FILE NAME & CR# FROM IFORM(14) INSTEAD OF LFORM(16).
55          WRITE(LU,1005)
     *      (IFORM(K),K=29,31),(IFORM(K),K=32,33),
     *      (IFORM(K),K=14,19)
            WRITE(LU,1006) (KTERM(K,II),K=1,14) 
C 
C  WRITE LIGHT LABEL
C 
60       CONTINUE 
         DO 100 I=1,3 
            IF(II.GT.2)GO TO 102
            IF(II.EQ.2)GO TO 101
C           3075/6 ALPHA KEYBOARD 
               CALL EXEC(2,ICNWD,IAS79,40)
               IX=1 
               IF(I.EQ.3)IX=0 
               CALL FSTAR(IBUF,IX)
               CALL FSTAR(IBUF2,IX) 
            GO TO 103 
101         CONTINUE
C           3075/6 NUMERIC KEYBOARD 
               CALL EXEC(2,ICNWD,IAS79,40)
               IF(I.EQ.3)GO TO 97 
                  IX=1
                  WRITE(LU,1502)
               GO TO 98 
97             CONTINUE 
                  IX=0
                  WRITE(LU,1002)
98             CONTINUE 
               CALL FSTAR(IBUF,IX)
               CALL FSTAR(IBUF2,IX) 
               CALL EXEC(2,ICNWD,IBUF,40) 
            GO TO 103 
102         CONTINUE
C           3070B, 3070A
               CALL EXEC(2,ICNWD,IAS66,34)
               IX=0 
               CALL FSTAR(IBUF,0) 
               CALL FSTAR(IBUF2,0)
               CALL EXEC(2,ICNWD,IBUF,34) 
               WRITE(LU,1002) 
103         CONTINUE
C 
C  INSERT LIGHT LABELS
C  K IS LIGHT # , N IS POSITION (CHAR) OF LABEL IN IBUF 
C 
            DO 105 J=1,NLAB(I,II) 
               K=(I-1)*(NCOL(II))+J 
               N=3+(J-1)*13 
               IF(ILITE(K).EQ.0)GO TO 105 
                  ILT=IABS(ILITE(K))-1
C                 MOVE QUESTION 
                  CALL MOVCA(IFORM,1275+ILT*12,IBUF,N,12) 
C                 MOVE DISPLAY VALUE
                  CALL MOVCA(JFORM,106+ILT*140,IBUF2,N,12)
105         CONTINUE
            N=3+NLAB(I,II)*13 
            CALL MOVCA(JLIT(1,I),1,IBUF,N,12) 
            CALL EXEC(2,ICNWD,IBUF2,40) 
            CALL EXEC(2,ICNWD,IBUF,40)
            CALL FSTAR(IBUF,IX) 
            CALL FSTAR(IBUF2,IX)
C 
C           IF 3075, THEN INSERT SFK LABELS AND VALUES
C 
           IF(II.NE.1)GO TO 118 
            DO 115 K=LABL(I),LABH(I)
               N=3+(K-LABL(I))*13+LABO(I) 
               IF(IKEY(K,1).EQ.0)GO TO 115
C              INSERT LABELS OR VALUES
                  CALL FILK(K,N,1,0,IBUF,IFORM,12)
115            CONTINUE 
               CALL EXEC(2,ICNWD,IBUF2,40)
               CALL EXEC(2,ICNWD,IBUF,40) 
D              PAUSE 100
               IF(I.EQ.1)WRITE(LU,1512)(IALPHA(KK),KK=1,5)
               IF(I.EQ.2)WRITE(LU,1511)(IALPHA(KK),KK=6,11) 
               IF(I.EQ.3)WRITE(LU,1510)(IALPHA(KK),KK=12,16)
D              PAUSE 200
           GO TO 100
118        CONTINUE 
           CALL EXEC(2,ICNWD,IBUF,40) 
100      CONTINUE 
C 
C  WRITE SFK LABELS AND USER TEXT 
C 
D        PAUSE 300
         CALL EXEC(2,ICNWD,IAS66,34)
D        PAUSE 400
         DO 120 I=1,2 
            CALL EXEC(2,ICNWD,IAS66,34) 
            CALL FSTAR(IBUF,0)
            CALL EXEC(2,ICNWD,IBUF,34)
C 
C           INSERT PREFIXED LABELS AND VALUES 
C 
            DO 130 J=1,5
               K=(I-1)*5+J+ITERM(II)
               IF(II.EQ.4 .AND. K.EQ.0)GO TO 130
                  N=3+(J-1)*13
                  IF(IKEY(K,3).EQ.0) GO TO 130
C                 INSERT LABEL
                     CALL FILK(K,N,1,1,IBUF,IFORM,12) 
130         CONTINUE
            CALL EXEC(2,ICNWD,IBUF,40)
            CALL FSTAR(IBUF,0)
            CALL EXEC(2,ICNWD,IBUF,34)
C 
C  INSERT NORMAL KEYS LABELS
C 
            DO 140 J=1,5
               K=(I-1)*5+J+ITERM(II)
               N=3+(J-1)*13 
               IF(II.NE.4 .OR. K.NE.0)GO TO 133 
                  CALL MOVCA(IK1,1,IBUF,N,12) 
               GO TO 140
133            CONTINUE 
                  IF(IKEY(K,1).EQ.0)GO TO 140 
C                 INSERT LABELS OR VALUES 
                     CALL FILK(K,N,1,0,IBUF,IFORM,12) 
140         CONTINUE
            CALL EXEC(2,ICNWD,IBUF,40)
C           CALL EXEC(2,ICNWD,IBUF2,40) 
            IF(II.NE.1)GO TO 142
D           PAUSE 500 
               IF(I.EQ.1)WRITE(LU,1510)(IALPHA(KK),KK=17,21)
               IF(I.EQ.2)WRITE(LU,1510)(IALPHA(KK),KK=22,26)
D           PAUSE 600 
            GO TO 120 
142         CONTINUE
            CALL FSTAR(IBUF,0)
            CALL EXEC(2,ICNWD,IBUF,34)
120      CONTINUE 
D        PAUSE 700
C 
C  END OF LABEL PRINTOUT
C 
         CALL EXEC(2,ICNWD,IAS66,34)
50    CONTINUE
C-----PRINT MESSAGE THAT SAYS 3070B IS MANDATORY & 3070A CANNOT BE USED.
C 
150   CONTINUE
      IF(L3075A.AND.L3075N.AND.L3070B.AND.L3070A)GO TO 200
         CALL PHEAD(LU,IPAGE,IDATE) 
         WRITE(LU,1008) 
         IF(LPRINT)WRITE(LU,1010) 
         IF(LALPHK)WRITE(LU,1013) 
         IF(LALPHD)WRITE(LU,1015) 
         IF(LTYPE3)WRITE(LU,1009) 
         IF(LTYPE5)WRITE(LU,1014) 
         IF((MAXKEY.EQ.10).AND.(.NOT.LALPHK))WRITE(LU,1011) 
         IF(MAXLIT.GT.12)WRITE(LU,1016)MAXLIT 
         WRITE(LU,1017) 
         DO 65 I=1,4
            IF(LTERM(I))WRITE(LU,1018)(KTERM(J,I),J=1,14) 
65       CONTINUE 
         WRITE(LU,1012) 
         DO 68 I=1,4
            IF(.NOT.LTERM(I))WRITE(LU,1018)(KTERM(J,I),J=1,14)
68       CONTINUE 
C  FORMATS
C 
1002  FORMAT(" ",5("*",5X,"[]",5X),"*") 
1004  FORMAT("1") 
1005  FORMAT(21X,"TRANSACTION", 
     C" SPECIFICATION : ",3A2," / ",2A2,//
     C9X"FROM TRANSACTION SPECIFICATION LIBRARY : " 
     C,3A2" (CR =",3A2")"//)
1006  FORMAT(" ",14A2/) 
1008  FORMAT(4X,"THIS TRANSACTION REQUIRES :")
1009  FORMAT(10X,"MULTIFUNCTION CARD/TYPE III BADGE READER")
1010  FORMAT(10X,"ALPHA-NUMERIC PRINTER") 
1011  FORMAT(10X,"10 SPECIAL FUNCTION KEYS")
1012  FORMAT(//,4X,"THEREFORE NO LABELS ARE PROVIDED FOR :")
1013  FORMAT(10X,"ALPHA KEYBOARD")
1014  FORMAT(10X,"TYPE V BADGE READER") 
1015  FORMAT(10X,"ALPHA-NUMERIC DISPLAY") 
1016  FORMAT(10X,I2,"PROMPTING LIGHTS") 
1017  FORMAT(//,4X,"WHICH ARE AVAILABLE ONLY ON :") 
1018  FORMAT(10X,14A2)
1502  FORMAT(" ",6("*",5X,"[]",5X),"*") 
1510  FORMAT(" ",5("*",4X,"<",A2,5X),"*") 
1511  FORMAT(" ",6("*",4X,"<",A2,5X),"*") 
1512  FORMAT(" ","*   SHIFT    ",5("*",4X,"<",A2,5X),"*") 
C 
C*********************************************************************
C 
C   NOW WRITE SPECIFICATIONS
C 
C*********************************************************************
C 
C   NAME ,#, SC,DATA BASE NAME
C 
200   CONTINUE
      CALL PHEAD(LU,IPAGE,IDATE)
C-----GET SYSTEM DATE & PRINT IT. 
C     CALL EXEC(11,ITIME,IYEAR) 
C     IF(JULIB(ITIME(5),IYEAR,IDAY,IMNTH)) GO TO 202
C     WRITE(LU,20241) IMNTH,IDAY,IYEAR
C 
C-----GO TO 203 IF THE LIST REQUEST IS FROM TGP1. 
202   IF(INDIC.EQ.4278) GO TO 203 
      WRITE(LU,2010)(LFORM(I),I=16,21)
      GO TO 204 
C-----GET FILE NAME & CR# FROM IFORM(14) INSTEAD OF LFORM(16) 
203   WRITE(LU,2010) (IFORM(I),I=14,19) 
204   WRITE(LU,2001) (IFORM(I),I=29,31) 
      WRITE(LU,2002) (IFORM(I),I=32,33) 
      WRITE(LU,2003) (IFORM(I),I=34,36) 
C-----LOGGING?
      IF (IGET1(IFORM,74).EQ.1HX) WRITE(LU,2004)
      IF(IAND(ITT,3B).GT.1) WRITE(LU,2042) (IFORM(I),I=38,40) 
C 
C***********************************************************************
C 
C  WRITE SFK ASSIGNEMENTS 
C 
C********************************************************************** 
C 
      WRITE(LU,2005)
      WRITE(LU,2006)
      WRITE(LU,2007)
      DO 210 I=1,MAXKEY 
      DO 215 J=1,38 
215   IBUF(J)=2H
C 
C  KEY #
C 
      CALL MOVCA(IASC(I),1,IBUF,6,2)
C 
C  NORMAL KEYS ASSIGNEMENT  : IF FUNCTION PRINT LABEL 
C                             IF STRING PRINT VALUE 
C 
220   IF(IKEY(I,1).EQ.0) GO TO 230
      IF(IKEY(I,1).LT.0) GO TO 225
      CALL FILK(I,17,1,0,IBUF,IFORM,12) 
      GO TO 230 
225   CALL PUTCA(IBUF,1H",14) 
      CALL PUTCA(IBUF,1H",31) 
      CALL FILK(I,-15,1,0,IBUF,IFORM,16)
C 
C  PREFIXED KEYS ASSIGNEMENT
C 
230   IF(IKEY(I,3).EQ.0) GO TO 238
      IF(IKEY(I,3).LT.0) GO TO 235
      CALL FILK(I,44,1,1,IBUF,IFORM,12) 
      GO TO 238 
235   CALL PUTCA(IBUF,1H",41) 
      CALL PUTCA(IBUF,1H",58) 
      CALL FILK(I,-42,1,1,IBUF,IFORM,16)
C 
C  TERMINATOR ? 
C 
238   IF(IKEY(I,2).EQ.0) GO TO 239
         IBUF(35)=2H Y
         IBUF(36)=2HES
      GO TO 240 
239   CONTINUE
         IBUF(35)=2H N
         IBUF(36)=2HO 
C 
240   CALL EXEC(2,ICNWD,IBUF,40)
C 
210   CONTINUE
C 
C  FORMATS
C 
20241 FORMAT(4X,"SYSTEM DATE   : ",I2,"-",I2,"-",I4)
2010  FORMAT(4X,"FROM LIBRARY   :  ",3A2" (CR ="3A2")") 
2001  FORMAT(4X,"NAME",10X," :  ",3A2)
2002  FORMAT(4X,"NUMBER",8X," :  ",2A2) 
2003  FORMAT(4X,"SECURITY CODE  :  ",3A2) 
2004  FORMAT(4X,"LOGGING REQD   : YES") 
2005  FORMAT(//,4X,"SPECIAL FUNCTION KEYS ASSIGNMENT :")
2006  FORMAT(4X,34("*"),/)
2007  FORMAT(4X,"KEY#",4X,"NORMAL VALUE/FUNCTION",5X, 
     C"PREFIXED VALUE/FUNCTION",4X,"TERMINATOR ?",/)
2042  FORMAT(4X,"IMAGE DATA BASE : ",3A2) 
C 
C*********************************************************************
C 
C   IF LIST LU =TERMINAL LU ASK USER TO CONTINUE AND TERMINATE TGP
C 
C*********************************************************************
C 
470   CONTINUE
C     IF(LU.NE.ILU)GO TO 480
C        CALL EXEC(2,ILU,IPRES,27)
C        CALL REIO(1,ILU,IANS,-1) 
C     GO TO 485 
480   CONTINUE
C        CALL EXEC(3,1100B+LU,-1) 
485   CONTINUE
      IMODB=IPAGE 
C     INDIC=99
      CALL EXEC(8,INAM) 
C 
C 
C 
      CALL TGP
      END 
C 
C 
C************************************************************************ 
C************************************************************************ 
C 
      SUBROUTINE PHEAD(LU,IPAGE,IDATE), 92903-16379 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(" ",24A2,15A2) 
2000  FORMAT(/,20X,"TRANSACTION SPECIFICATION GENERATOR LIST")
2024  FORMAT(19X,42"*",//)
      RETURN
      END 
      END$
                                                                                                                                                                                                                                                