FTN4 PROGRAM TGP(3), 92080-16350 REV.2026 800509 C C SOURCE 92080-18350 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* THIS IS THE MAIN MODULE OF THE TGP PROGRAM . * C* TGP IS USED TO BUILD A TRANSACTION SPECIFICATION THRU AN INTER- * C* ACTIVE DIALOG WITH THE USER . * C* THIS DIALOG APPEARS AS A SUCCESSION OF SCREEN MASKS * C* DISPLAYED ON THE TERMINAL ON WHICH THE USER MUST FILL IN THE * C* ANSWERS TO THE QUESTIONS. * C* THE TRANSACTION SPECIFICATION CREATED OR MODIFIED WILL * C* BE USED BY THE TMP PROGRAM TO DRIVE THE TRANSACTION ON THE 3070 * C* TERMINALS . * C* TGP CONSISTS OF ONE SHORT MAIN AND 14 SEGMENTS TGP0 * C* TO TGP13 . A COMMON ZONE IS USED TO PASS THE INFORMATION BETWEEN * C* SEGMENTS . * C* FOLLOWING IS THE MEANING OF THE COMMON VARIABLES : * C* * C* ILU : TERMINAL INTERACTIVE LU. * C* ISCRN : ACTUAL SCREEN #. * C* IQST : ACTUAL QUESTION # . * C* ISKIP : GENERAL PURPOSE VARIABLE . * C* INDIC : GENERAL PURPOSE VARIABLE USED TO TELL A SEGMENT * C* WHEN SCHEDULED WHAT TASK IT MUST PERFORM . * C* IFORM : BUFFER TO STORE IN ASCII FORMAT THE ANSWERS TO * C* SCREENS 3,4,6,7,8 AND 9 . * C* JFORM : BUFFER TO STORE IN ASCII FORMAT THE ANSWERS TO * C* SCREENS 10,11,12,13,14,15 . * C* MFORM : BUFFER TO STORE IN ASCII FORMAT THE ANSWERS TO * C* SCREEN 16 . * C* LFORM : BUFFER TO STORE IN ASCII FORMAT THE ANSWERS TO * C* SCREENS 17 AND 18 . * C* ITT : TRANSACTION TYPE, IF BIT SET, MEANS THE FOLLOWING -- * C* BIT# 0 USER PROCESSING * C* 1 DATA BASE * C* 2 LOGGING * C* 3 PRINTER * C* 4 CARD READER/BADGE 3 * C* 5 BADGE 5 * C* 6 ALPHA KEYBOARD * C* 7 ALPHA DISPLAY * C* 8 LIGHT TO STAY LIT * C* 9 BAR CODE READER * C* 10 3077-TIME AND ATTENDENCE * C* 11 CLOCK: 0=12 HR, 1=24 HR * C* 12 MAG STRIPE READER * C* 13 CRT DISPLAY * C* IKEY : BUFFER TO STORE IN BINARY THE MEANING OF THE SFK'S * C* FOR MORE DETAILS SEE TGP2 . * C* IUMAX : # OF U QUESTIONS IN THIS TRANSACTION * C* IMMAX : # OF M QUESTIONS IN THIS TRANSACTION * C* IMODB : = 0 MEANS 3070A VERSION OF TGP . * C* = 1 MEANS 3070B VERSION OF TGP . * C* ILITE : BUFFER TO ALLOCATE THE PROMPTING LIGHTS # . FOR MORE * C* DETAILS SEE LIGHT SUBROUTINE . * C* IMAI : BUFFER TO STORE THE IMAGE INFORMATION . FOR MORE * C* DETAILS SEE TGP12 . * C* IMFLG : IMAGE FLAG SEE TGP12 * C* IMAS : MASTER DATA SET # ON WHICH A FIND HAS BEEN REQUESTED * C* IMDT : DETAIL DATA SET # ON WHICH A FIND HAS BEEN REQUESTED * C* IMKY : MASTER KEY ITEM # FOR A FIND . * C* KFORM : BUFFER TO STORE THE TRANSACTION SPECIFICATION IN * C* BINARY . (USED BY TMP) * C* ****************************************** * C* * KFORM SERVES AS A BUFFER TO PASS PARAM * * C* * ETERS UNTIL IT IS USED FOR ITS OWN PUR * * C* * POSES. OFFSETS BEING USED ARE: 1000- * * C* * 1006,1016-1023 (CONTINUE ON THIS OFF * * C* * SET),1059,1900,1901,2185-. * * C* ****************************************** * C* ILIBR : BUFFER TO STORE IN ASCII FORMAT THE ANSWERS TO * C* SCREENS 19 AND 20 . * C* NIMAG : = 0 IMAGE VERSION OF TGP * C* = 1 NON IMAGE VERSION OF TGP * C* IBASE : CONTAINS THE DATA BASE NAME IN THE FORMAT REQD BY IMAGE. C* IMODE : = 0 NORMAL MODE (TGP MANUAL OPERATION) * C* = 1 AUTOMATIC MODE * C* = 2 SET TO 2 BY A 'MES' SEGMENT TO TEMPORARILY RETURN* C* TO MANUAL OPERATION DURING AUTOMATIC MODE. * C* ISWICH: = 5 WORD ARRAY THAT CONTAINS TERMINAL STATUS INFO. * C* * C* * C* SCREENS 0,1,2 AND 5 ARE EXPLANATION SCREENS . * C* * C* WARNING !! : THE ORIGINAL SCREEN # 8 DO NOT EXIST ANY MORE SO * C* IN THE CODE WE ALWAYS SKIP FROM SCREEN 7 TO 9 BUT * C* ON THE SCREENS PRINTED FOR THE USER SCREEN # 8 * C* EXIST . SO PRINTED SCREEN # 8 IS IN REALITY SCREEN * C* # 9 IN THE CODE , SCREEN # 9 IS IN THE CODE SCREEN * C* # 10 AND SO ON . * C* * C* * C* THE ONLY TASK PERFORMED BY THE MAIN IS TO GET THE * C* TERMINAL INTERACTIVE LU , INITIALISE SOME VARIABLES AND CALL * C* SEGMENT TGP0 TO PRINT SCREEN # 0 . * C* * C* TO SCHEDULE THE 3070A VERSION OF TGP EXECUTE : * C* * C* * ON,TGP * C* * 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,ISWICH(5) C C LOCAL VRIABLES ********** C DIMENSION INAME(3),INBUF(40),ITS(15),ISC(15),ISRCE(15) DIMENSION IDEST(15),IHDR(15),IPBUF(10),IERR(10) C DATA INAME/2HTG,2HP0,2H / DATA IERR/2H I,2HLL,2HEG,2HAL,2H P,2HAR,2HM ,2HST,2HRI,2HNG/ C C GET INTERACTIVE LU C ILU=LOGLU(IX) IF(ILU.EQ.0) ILU=1 C C --- GET TERMINAL STATUS C CALL STRAP(ILU,ISWICH,0) C C-----LOCK ILU WITH WAIT. C CALL LURQ(1,ILU,1) C C INITIALISE IFORM TO BLANK C IMODB=1 NIMAG=0 ISKIP=2H DO 4 I=1,25 IFORM(I)=2H 4 CONTINUE C C INITIALISE LFORM(40-42) TO BLANK C LFORM(40)=2H LFORM(41)=2H LFORM(42)=2H C C-----AUTOMATIC MODE? C CALL BLANC(INBUF,40) CALL GETST(INBUF,80,ILOG) IMODE=0 IF(IGET1(INBUF,1).EQ.1HA) GO TO 5 C C-----RUN PARMS FOR BATCH AUTOMATIC MODE. C :RU,TGP,A,TS NAME OR #,TS SEC CODE,FROM LIB NAMR,TO LIB NAMR, C LIB HEADER(REQD IF NEW LIB TO BE CREATED),LIST FILE NAME C (EG, LP, ETC. IF HARD COPY DESIRED) C C-----NOT AUTO, BUT MAKE SURE NO OTHER PARMS ENTERED. C IF(ILOG.NE.0) GO TO 500 GO TO 99 C C-----AUTO MODE, 1ST CHECK THAT THERE ARE 4 OR 5 OR 6 PARMS, ELSE ERR. C 5 IMODE=1 IY=0 DO 10 I=1,80 IX=IGET1(INBUF,I) IF(IX.EQ.1H,) IY=IY+1 10 CONTINUE IF(IY.NE.4 .AND. IY.NE.5 .AND. IY.NE.6) GO TO 500 IFORM(7)=2HA C C-----BLANK OUT BUFFERS C CALL BLANC(ITS,15) CALL BLANC(ISC,15) CALL BLANC(ISRCE,15) CALL BLANC(IDEST,15) CALL BLANC(IHDR,15) CALL BLANC(ILIBR,67) C C-----GET TS NAME C IA=0 IB=1 DO 20 I=3,80 IX=IGET1(INBUF,I) IF(IX.EQ.1H,) GO TO 21 CALL PUTCA(ITS,IX,IB) IB=IB+1 IA=1 20 CONTINUE 21 IF(IA.EQ.0) GO TO 500 CALL MOVCA(ITS,1,IFORM,15,6) C C-----GET SECURITY CODE C I=I+1 ISAVE=I IB=1 DO 30 I=I,80 IX=IGET1(INBUF,I) IF(IX.EQ.1H,) GO TO 31 CALL PUTCA(ISC,IX,IB) IB=IB+1 30 CONTINUE 31 CALL MOVCA(ISC,1,IFORM,21,6) C C-----GET SOURCE LIBRARY NAMR C 40 I=I+1 IA=0 IB=1 DO 45 I=I,80 IX=IGET1(INBUF,I) IF(IX.EQ.1H,) GO TO 46 CALL PUTCA(ISRCE,IX,IB) IA=1 IB=IB+1 45 CONTINUE 46 IF(IA.EQ.0) GO TO 500 C C-----PARSE THE SOURCE LIB. NAMR C ICHAR1=1 IB=IB-1 IFLG1=NAMR(IPBUF,ISRCE,IB,ICHAR1) IF(IFLG1.LT.0) GO TO 500 C -FILENAME CALL MOVCA(IPBUF,1,IFORM,27,6) C -CRN. CALL JASC(IPBUF(6),IFORM,33,6) C C-----GET DESTINATION LIBRARY NAMR C I=I+1 IA=0 IB=1 DO 50 I=I,80 IX=IGET1(INBUF,I) IF(IX.EQ.1H, .OR. IX.EQ.1H .OR. IX.EQ.0) GO TO 51 CALL PUTCA(IDEST,IX,IB) IA=1 IB=IB+1 50 CONTINUE 51 IF(IA.EQ.0) GO TO 500 C C-----PARSE THE DESTINATION LIB. NAMR C ICHAR1=1 IB=IB-1 IFLG1=NAMR(IPBUF,IDEST,IB,ICHAR1) IF(IFLG1.LT.0) GO TO 500 C -FILENAME. TEMP STORE IN ILIBR, 1-6. CALL MOVCA(IPBUF,1,ILIBR,1,6) C -CRN. TEMP STORE IN ILIBR, 7-12. CALL JASC(IPBUF(6),ILIBR,7,6) C C-----PROCESS HEADER IF THERE IS ONE. TEMP STORE IN ILIBR, 15-44. C (NOTE: ILIBR 13 & 14,IE. WORD 7, CONTAINS CHAR COUNT OF HEADER). C ILIBR(7)=0 IF(I.EQ.80) GO TO 99 J=I+30 I=I+1 IB=0 IH=15 DO 60 I=I,J IX=IGET1(INBUF,I) IF(IX.EQ.1H,) GO TO 61 IF(IH.GT.44) GO TO 60 IF(IX.EQ.40B) IX=2H CALL PUTCA(ILIBR,IX,IH) IB=IB+1 IH=IH+1 60 CONTINUE C -STORE CHAR COUNT. 61 ILIBR(7)=IB C C-----GET LIST FILE NAME IF PRESENT. TEMP STORE IN ILIBR, 45-50. C IF(IX.NE.1H,) GO TO 99 J=I+6 I=I+1 IH=45 DO 70 I=I,J IX=IGET1(INBUF,I) IF(IX.EQ.1H ) GO TO 99 IF(IX.EQ.1H:) GO TO 500 CALL PUTCA(ILIBR,IX,IH) IH=IH+1 70 CONTINUE GO TO 99 C C-----ILLEGAL PARM STRING C 500 CALL EXEC(2,ILU,IERR,10) GO TO 9999 C C CALL SCREEN # 0 C 99 ISCRN=0 IQST=1 INDIC=0 CALL EXEC(8,INAME) C C FOR IMAGE VERSION OF TGP LOAD RUN TABLE . C CALL AIRUN C 9999 END END$