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$