FTN4
      PROGRAM TGPI3(5), 92080-1X379 REV.2026 800220 
C 
C     SOURCE 92080-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(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)
C 
C   LOCAL VARIABLES ****************
C 
      DIMENSION IBUF(52),IBUF2(52),JLIT(6,3),NLAB(3,4),NCOL(4)
      DIMENSION IK1(6),ITERM(4),IALPHA(26),IDATE(15)
      DIMENSION INAM(3),KTERM(14,5),ITIME(5),IPRES(27)
      DIMENSION LABL(3),LABH(3),LABO(3) 
      DIMENSION IAS66(34),IAS79(40),J1224(6),LITBL(5) 
C 
      LOGICAL ISSPA,ISBIT,INUM
C 
      LOGICAL LPRINT,LALPHK,LALPHD,LTYPE3,LTYPE5,LMAGST,LCRT,LBARCD 
      LOGICAL L3075A,L3075N,L3070B,L3070A,L3077A
      LOGICAL LTERM(5),LTIMET 
      EQUIVALENCE (LTERM(1),L3075A) 
      EQUIVALENCE (LTERM(2),L3075N) 
      EQUIVALENCE (LTERM(3),L3070B) 
      EQUIVALENCE (LTERM(4),L3070A) 
      EQUIVALENCE (LTERM(5),L3077A) 
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  , 
     *           2HHP,2H30,2H77,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/ 
      DATA J1224/2H12,2H H,2HR ,2HCL,2HOC,2HK / 
      DATA JBYTES/170/
      DATA JWORDS/85/ 
      DATA LITBL/3,16,29,42,55/ 
      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.
      LCRT=.FALSE.
      LTYPE3=.FALSE.
      LTYPE5=.FALSE.
      LMAGST=.FALSE.
      LBARCD=.FALSE.
      LTIMET=.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((ISBIT(ITT,6)).OR.(MAXKEY.GT.10))LALPHK=.TRUE. 
C 
C-----ALPHA DISPLAY (QUES 3, SCR 41)
      IF(ISBIT(ITT,7))LALPHD=.TRUE. 
C 
C........ALPHA PRINTER (CHECK ANSWERS IN SCREEN 41) 
         IF(ISBIT(ITT,3))LPRINT=.TRUE.
C 
C........CARD/TYPE III BADGE READER (CHECK ANSWERS IN SCREEN 41)
         IF(ISBIT(ITT,4))LTYPE3=.TRUE.
C 
C........TYPE V BADGE READER (CHECK ANSWERS IN SCREEN 41) 
         IF(ISBIT(ITT,5))LTYPE5=.TRUE.
C 
C........CRT DISPLAY (CHECK ANSWERS IN SCREEN 41) 
         IF(ISBIT(ITT,13))LCRT=.TRUE. 
C 
C........MAGSTRIPE READER (CHECK ANSWERS IN SCREEN 41)
         IF(ISBIT(ITT,12))LMAGST=.TRUE. 
C 
C........BAR CODE READER (CHECK ANSWER IN SCREEN 41)
         IF(ISBIT(ITT,9))LBARCD=.TRUE.
C 
C    -TIME REPORTING TERMINAL 
C 
      IF(ISBIT(ITT,10)) LTIMET=.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 
C-----A 3070B CAN ALSO NOT HAVE BAR CODE OR MAGSTRIPE READER OR CRT 
      L3070B=((.NOT.(LALPHK.OR.LALPHD.OR.LTYPE5.OR.LCRT.OR.LMAGST.OR. 
     *    LBARCD)).AND.(MAXLIT.LE.12).AND.(MAXKEY.LE.10)) 
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 
     *         .OR.LCRT.OR.LMAGST.OR.LBARCD)) 
     *         .AND.(MAXKEY.LE.9).AND.(MAXLIT.LE.12)) 
C 
C    -3077A TIME REPORTING TERMINAL 
C 
      L3077A=.FALSE.
      IF(LTIMET) L3077A=.TRUE.
      IF(.NOT.L3077A) GO TO 20
      DO 19 I=1,4 
      LTERM(I)=.FALSE.
19    CONTINUE
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 
20    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,5
         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)
      IF(L3077A.AND.LTERM(I)) GO TO 50
            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) 
      IF(L3077A.AND.LTERM(I)) GO TO 50
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 # , LITBL(N) IS POSITION (CHAR) OF LABEL IN IBUF
C 
D     WRITE(6,1039) I,II,NLAB(I,II),NCOL(II)
D1039 FORMAT("0TGP13 START LOOP 105",4I7) 
            DO 105 K=1,IUMAX+IMMAX
               MIN=(I-1)*NCOL(II)+1 
               MAX=(I-1)*NCOL(II)+NLAB(I,II)
C              -IS THERE A LIGHT# FOR THIS ANSWER?
               IF(.NOT.ISSPA(JFORM,3+(K-1)*JBYTES,2)) GO TO 104 
C              -YES. CONVERT IT TO BINARY.
               IF(INUM(JFORM,3+(K-1)*JBYTES,2,ILT)) PAUSE 104 
C              -ZERO? 
               IF(ILT.EQ.0) GO TO 104 
C              -NO. IS THE LIGHT# IN THIS ROW?
               IF(ILT.LT.MIN .OR. ILT.GT.MAX) GO TO 104 
C              -YES. MODULO THE LIGHT# TO THE NUMBER OF LIGHTS IN THIS
C              ROW (5 OR 4).
               IQ=ILT/NCOL(II)
               N=ILT-IQ*NCOL(II)
               IF(N.EQ.0) N=NCOL(II)
C     WRITE(6,1040) IQ,N,MIN,MAX
D1040 FORMAT(4I7) 
C              -MOVE QUESTION LABEL TO CORRESPONDING LIGHT. 
               CALL MOVCA(IFORM,1275+(K-1)*12,IBUF,LITBL(N),12) 
C 
C              -IS THERE A LIGHT# FOR THIS DISPLAY? 
104            IF(.NOT.ISSPA(JFORM,101+(K-1)*JBYTES,2)) GO TO 105 
C              -YES. CONVERT IT TO BINARY.
               IF(INUM(JFORM,101+(K-1)*JBYTES,2,ILT)) PAUSE 105 
C              -ZERO? 
               IF(ILT.EQ.0) GO TO 105 
C              -NO. IS THE LIGHT# IN THIS ROW?
               IF(ILT.LT.MIN .OR. ILT.GT.MAX) GO TO 105 
C              -YES. MODULO THE LIGHT# TO THE NUMBER OF LIGHTS IN THIS
C              ROW (5 OR 4).
               IQ=ILT/NCOL(II)
               N=ILT-IQ*NCOL(II)
               IF(N.EQ.0) N=NCOL(II)
C              N=3+NLAB(I,II)*13 /2 
D     WRITE(6,1040) IQ,N,MIN,MAX
C              -MOVE DISPLAY LABEL TO CORRESPONDING LIGHT.
               CALL MOVCA(JFORM,107+(K-1)*JBYTES,IBUF2,LITBL(N),12) 
105         CONTINUE
C 
            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 BLANC(IBUF,40) 
            CALL BLANC(IBUF2,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) 
               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)
           GO TO 100
118        CONTINUE 
           CALL EXEC(2,ICNWD,IBUF,40) 
100      CONTINUE 
C 
C  WRITE SFK LABELS AND USER TEXT 
C 
         CALL EXEC(2,ICNWD,IAS66,34)
         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
               IF(I.EQ.1)WRITE(LU,1510)(IALPHA(KK),KK=17,21)
               IF(I.EQ.2)WRITE(LU,1510)(IALPHA(KK),KK=22,26)
            GO TO 120 
142         CONTINUE
            CALL FSTAR(IBUF,0)
            CALL EXEC(2,ICNWD,IBUF,34)
120      CONTINUE 
C 
C  END OF LABEL PRINTOUT
C 
         CALL EXEC(2,ICNWD,IAS66,34)
50    CONTINUE
      IF(.NOT.L3077A) GO TO 150 
      WRITE(LU,2043)
      WRITE(LU,2044)
      WRITE(LU,2045)
      WRITE(LU,2047)
      WRITE(LU,2045)
      WRITE(LU,2046)
      WRITE(LU,2045)
      WRITE(LU,2044)
C-----PRINT MESSAGE THAT SAYS 3070B IS MANDATORY & 3070A CANNOT BE USED.
C 
150   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(LCRT)WRITE(LU,1019) 
         IF(LTYPE3)WRITE(LU,1009) 
         IF(LTYPE5)WRITE(LU,1014) 
         IF(LMAGST)WRITE(LU,1020) 
         IF(LBARCD)WRITE(LU,1021) 
      IF(.NOT.LTIMET) GO TO 64
        IF(ISBIT(ITT,11)) J1224(1)=2H24 
        WRITE(LU,10151) (J1224(I),I=1,6)
64       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,5
            IF(LTERM(I))WRITE(LU,1018)(KTERM(J,I),J=1,14) 
65       CONTINUE 
         WRITE(LU,1012) 
         DO 68 I=1,5
            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":35:"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") 
10151 FORMAT(10X,"TIME REPORTING TERMINAL: ",6A2) 
1016  FORMAT(10X,I2," PROMPTING LIGHTS")
1017  FORMAT(//,4X,"WHICH ARE AVAILABLE ONLY ON :") 
1018  FORMAT(10X,14A2)
1019  FORMAT(10X,"CRT DISPLAY") 
1020  FORMAT(10X,"MAGNETIC STRIPE READER")
1021  FORMAT(10X,"BAR CODE READER") 
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)
C     "DATA BASE?"
      IF(ISBIT(ITT,1)) WRITE(LU,2042) (IFORM(I),I=38,40)
C-----AUTO COMPLETE?
      IF(IGET1(IFORM,1545).EQ.1HX) WRITE(LU,2050) 
C-----IDENTIFICATION LIGHT NUMBER?
      IF(IGET2(IFORM,1546).EQ.2H  )GO TO 209
      IHOLD=IGET2(IFORM,1546) 
      WRITE(LU,2051) IHOLD
C 
C***********************************************************************
C 
C  WRITE SFK ASSIGNEMENTS 
C 
C********************************************************************** 
C 
209   WRITE(LU,2005)
      WRITE(LU,2006)
      IF(.NOT.L3077A) GO TO 211 
      WRITE(LU,2043)
      WRITE(LU,2044)
      WRITE(LU,2045)
      WRITE(LU,2046)
      WRITE(LU,2045)
      WRITE(LU,2044)
      GO TO 470 
211   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",8X,":  ",3A2":35:"3A2) 
2001  FORMAT(4X,"NAME",15X," :  ",3A2)
2002  FORMAT(4X,"NUMBER",13X," :  ",2A2)
2003  FORMAT(4X,"SECURITY CODE",7X,":  ",3A2) 
2004  FORMAT(4X,"LOGGING REQD",8X,": 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) 
2043  FORMAT(/////) 
2044  FORMAT(20X,33("+")) 
2045  FORMAT(20X,"+",31X,"+") 
2046  FORMAT(20X,"+ NA TO TIME REPORTING TERMINAL +") 
2047  FORMAT(20X,"+",8X,"LABEL PRINTOUT",9X,"+")
2050  FORMAT(4X,"AUTO COMPLETION     : YES")
2051  FORMAT(4X,"IDENTIFICATION LIGHT: #"A2)
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     SUBROUTINE PHEAD NOW IN TGPLB (2026 PCO)
C 
C 
      END$
                                                                                                                                                                        