FTN4
      PROGRAM TGP8(5), 92903-16367 REV.1913  790126 1330
C 
C     SOURCE 92903-18367
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 
C     PRGMR : JEAN CHARLES MIARD (HPG)
C 
C*********************************************************************
C*                                                                   *
C*                       THIS IS A SEGMENT OF THE TGP PROGRAM        *
C*   USED TO ANALYSE THE ANSWERS THE USER HAS GIVEN TO SCREENS 18,   *
C*   19 AND 20 .                                                     *
C*                                                                   *
C*       THE ANSWERS AFTER CHECKS ARE STORED IN LFORM AND ILIBR .    *
C*                                                                   *
C*   IF :   INDIC = 0 : NORMAL PATH ANALYSE SCREEN # ISCRN .         *
C*          INDIC = 2 : RETURN FROM TGP10 AN ERROR HAS OCCURED ON    *
C*                      READING OR WRITING THE SPECS                 *
C*         INDIC =-77 : A HELP MESSAGE MUST BE PRINTED               *
C*                                                                   *
C*   WARNING !! : CARE MUST BE TAKEN * :                             *
C*                                                                   *
C*     PRINTED SCREEN # 18 CORRESPONDS TO ISCRN = 19                 *
C*      ..............  19   .................    20                 *
C*      ..............  20   .................    21                 *
C*                                                                   *
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(60),JOUT(15),ITGP4(3),ITGP1(3) 
      DIMENSION IDCB(144),ITGP10(3),NFORM(3),ITGP3(3) 
      DIMENSION ITGP0(3),IHP19(4),IHP20(4),IHP21(13)
C 
      EQUIVALENCE (NOF,KFORM(1059)) 
C 
      LOGICAL JPAR,NAMCK,CMPW,GETBK,OKABT 
C 
C 
      DATA ITGP4/2HTG,2HP4,2H  /
      DATA ITGP10/2HTG,2HPI,2H0 / 
      DATA ITGP1/2HTG,2HP1,2H  /
      DATA ITGP3/2HTG,2HP3,2H  /
      DATA ITGP0/2HTG,2HP0,2H  /
      DATA IHP19/2,3,1,5/ 
      DATA IHP20/0,2,3,5/ 
      DATA IHP21/4,4,4,4,4,4,4,4,4,4,2,3,1/ 
C 
C 
C*********************************************************************
C 
C  IF INDIC=2 PRINT ERROR MESSAGE ON SCREEN  (ISKIP=FMGR ISTAT) 
C 
C*********************************************************************
C 
      IF(INDIC.EQ.2) GO TO 400
      IF(INDIC.EQ.-77) GO TO 3011 
C 
C*********************************************************************
C 
C       INDIC=0 GET USER'S ANSWERS IN THE SCREEN
C 
C********************************************************************** 
C 
15    IF(ISCRN.EQ.19) ITLOG=51
      IF(ISCRN.EQ.20) ITLOG=22
      IF(ISCRN.EQ.21) ITLOG=114 
      IF(.NOT.(GETBK(ILU,IBUF,ITLOG))) GO TO 10 
C 
C  ERROR IN GETTING ANSWERS REPRINT SCREEN
C 
17    IF(ISCRN.NE.19) CALL EXEC(8,ITGP3)
      CALL EXEC(8,ITGP4)
C 
C********************************************************************** 
C 
C   GO TO ANALYSE ISCRN SCREEN
C 
C********************************************************************** 
C 
10    IF(ISCRN.EQ.20) GO TO 2000
      IF(ISCRN.EQ.21) GO TO 2100
C 
C*********************************************************************
C 
C  SCREEN # 18  (TRANSACTION SPECS. STORAGE)
C 
C*********************************************************************
C 
C 
C  FILE NAME
C 
      NOF=1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.EQ.0) GO TO 1983
      IF(NAMCK(JOUT)) GO TO 1982
      CALL MOVEW(JOUT,LFORM(16),3)
C 
C  CR #   ? 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.GT.1) GO TO 1984
      IF(JVAL.EQ.-32768) GO TO 1984 
      CALL MOVEW(JOUT,LFORM(19),3)
C 
C   HEADER OF LIBRARY 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,30,IFLG,JVAL)) GO TO 3000 
      IFLG1=IFLG
      CALL MOVEW(JOUT,LFORM(22),15) 
C 
C 
C 
C   LIST FILE NAME
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
1800  IF(IFLG.NE.0) GO TO 1805
      LILU=ILU
      GO TO 1810
1805  IF(OPEN(IDCB,ISTAT,JOUT).LT.0) GO TO 1807 
      IF(ISTAT.NE.0)  GO TO 1808
      LILU=IDCB(4)
      CALL CLOSE(IDCB)
      GO TO 1810
1808  IMES=14 
      CALL CLOSE(IDCB)
      GO TO 410 
1807  IMES=0
      IF(ISTAT.EQ.-6) IMES=9
      IF(IMES.EQ.0) CALL JASC(ISTAT,NFORM,1,6)
      GO TO 410 
1810  IF(ISCRN.EQ.20) GO TO 2015
      CALL MOVEW(JOUT,LFORM(37),3)
C 
C  SET ISKIP TO LIST LU GO TO STORE AND LIST TRANSACTION SPEC . 
C 
      INDIC=1 
      ISKIP=LILU
      CALL EXEC(8,ITGP10) 
C 
C 
C  ERROR SECTION SCREEN 18
C 
1980  CALL MES08(1,NOF) 
      GO TO 15
1981  CALL MES08(2,NOF) 
      GO TO 15
1982  CALL MES08(3,NOF) 
      GO TO 15
1983  CALL MES08(4,NOF) 
      GO TO 15
1984  CALL MES08(5,NOF) 
      GO TO 15
C 
C***********************************************************************
C 
C  ERRORS COMING FROM TGP10  (FMGR ERRORS)
C 
C********************************************************************** 
C 
400   IMES=0
      IF(ISCRN.EQ.19) NOF=1 
      IF(ISCRN.EQ.20) NOF=2 
      IF(ISCRN.EQ.21) NOF=11
      IF(ISKIP.EQ.10) IMES=16 
      IF(ISKIP.EQ.-6) IMES=9
      IF(ISKIP.EQ.-2) IMES=10 
      IF(ISKIP.EQ.1)  IMES=6
      IF(ISKIP.EQ.5)  IMES=17 
      IF(ISKIP.EQ.6)  IMES=18 
      IF(ISKIP.EQ.8)  IMES=12 
      IF(ISKIP.EQ.24) IMES=9
      IF(ISKIP.EQ.26) IMES=9
      IF(ISKIP.EQ.66) IMES=21 
      IF(ISKIP.EQ.77) IMES=22 
      IF(ISKIP.EQ.99) IMES=19 
      IF(IMES.NE.0) GO TO 410 
      CALL JASC(ISKIP,NFORM,1,6)
      IMES=11 
410   ISKIP=0 
412   CALL MES08(IMES,NOF,NFORM)
      INDIC=0 
      GO TO 15
C-----IF ERR IS -6, "LIBRARY COULD NOT BE FOUND"
414   IF(ISKIP.EQ.-6) ISKIP=66
      GO TO 400 
C 
C********************************************************************** 
C 
C   SCREEN # 19  BUILD LIBRARY 1 OF 2 
C 
C*********************************************************************
C 
2000  NOF=1 
C 
C  MODE OF OPERATION
C 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000
      IF(JOUT.EQ.1HT) GO TO 3045
      IF((JOUT.NE.1HC).AND.(JOUT.NE.1HE).AND.(JOUT.NE.1HL)) GO TO 2080
      ILIBR=IALF2(JOUT) 
C 
C  SOURCE LIBRARY 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.EQ.0) GO TO 1983
      IF(NAMCK(JOUT)) GO TO 1982
      CALL MOVEW(JOUT,ILIBR(2),3) 
C 
C  CR # 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.GT.1) GO TO 1984
      IF(JVAL.EQ.-32768) GO TO 1984 
      IF(OPEN(IDCB,ISKIP,ILIBR(2),1,0,JVAL).LT.0) GO TO 414 
C-----IF CR WAS NOT SPECIFIED, GET IT NOW FROM IDCB 
      IF(JVAL.NE.0) GO TO 2005
      ICR=ICRLU(-IAND(IDCB,77B))
      CALL JASC(ICR,ILIBR,9,6)
2005  IF((ISKIP.EQ.0).OR.(ISKIP.EQ.35)) GO TO 2010
      NOF=NOF-1 
      IMES=14 
      GO TO 410 
2010  CALL MOVEW(JOUT,ILIBR(5),3) 
      CALL CLOSE(IDCB)
C 
C  LIST FILE NAME 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(ILIBR.EQ.2H L) GO TO 1800
      IF(IFLG.NE.0) GO TO 2081
2015  CALL MOVEW(JOUT,ILIBR(8),3) 
C 
C  IF REQUEST IS TO PRINT DIRECTORY SET ISKIP TO LIST LU
C  AND GO TO TGP10, OTHERWISE PRINT SCREEN 20 
C 
      IF(ILIBR.EQ.2H L) GO TO 2020
      ISCRN=21
      CALL EXEC(8,ITGP3)
2020  INDIC=2 
      ISKIP=LILU
      CALL EXEC(8,ITGP10) 
C 
C***********************************************************************
C 
C  SCREEN # 20  BUILD LIBRARIES 2 OF 2
C 
C********************************************************************** 
C 
2100  NOF=0 
C 
C  ID. OF SPECS TO BE COPIED OR EXCLUDED
C 
      DO 2110 I=1,10
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
C-----IF NUMBER, CHECK RANGE 1-9999.
      IF(IFLG.EQ.0) GO TO 2105
      IF(IFLG.NE.1) GO TO 2105
      IF((JVAL.LT.1).OR.(JVAL.GT.9999)) GO TO 2083
2105  CALL MOVEW(JOUT,ILIBR(11+(I-1)*3),3)
2110  CONTINUE
C 
C  DESTINATION LIBRARY
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.EQ.0) GO TO 1983
      IF(NAMCK(JOUT)) GO TO 1982
      IF(CMPW(ILIBR(2),JOUT,3)) GO TO 2082
      CALL MOVEW(JOUT,ILIBR(41),3)
C 
C  CR # 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.GT.1) GO TO 1984
      IF(JVAL.EQ.-32768) GO TO 1984 
      CALL MOVEW(JOUT,ILIBR(44),3)
C 
C  HEADER 
C 
      NOF=NOF+1 
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,30,IFLG,JVAL1)) GO TO 3000
      IF(OPEN(IDCB,ISKIP,ILIBR(41),1,0,JVAL).LT.0) GO TO 2118 
      IF(IFLG.EQ.0) GO TO 2115
      IF(ISKIP.EQ.0) GO TO 2120 
      ISKIP=-2
      GO TO 400 
2115  IF((ISKIP.EQ.0).OR.(ISKIP.EQ.35)) GO TO 2120
      NOF=NOF-2 
      IMES=14 
      GO TO 410 
2118  IF((ISKIP.EQ.-6).AND.(IFLG.NE.0)) GO TO 2120
      GO TO 414 
2120  CALL MOVEW(JOUT,ILIBR(47),15) 
      LILU=ILU
      GO TO 2020
C 
C ERROR MESSAGES SCREEN 19 AND 20 
C 
2080  CALL MES08(7,NOF) 
      GO TO 15
2081  CALL MES08(8,NOF) 
      GO TO 15
2082  CALL MES08(15,NOF)
      GO TO 15
C-----"ILLEGAL TRANSACTION SPECIFICATION #" 
2083  CALL MES08(20,NOF)
      GO TO 15
C 
C 
C***********************************************************************
C 
C 2645 SOFT KEYS PROCESSING 
C 
C***********************************************************************
C 
C  IFLG=5 MEANS NON PRINTABLE ASCII 
C 
3000  IF(IFLG.EQ.4) IFLG=5
      IF(IFLG.NE.5) GO TO 3005
      CALL MES08(13,NOF)
      GO TO 15
C 
C  IFLG=6 MEANS ILLEGAL PARSE 
C 
3005  IF(IFLG.NE.6) GO TO 3007
      STOP 500
C 
C  IFLG=7 MEANS HELP
C 
3007  IF(IFLG.NE.7) GO TO 3010
      INDIC=-77 
      GO TO 17
3011  INDIC=0 
      IF(ISCRN.EQ.19) IMES=IHP19(NOF) 
      IF(ISCRN.EQ.20) IMES=IHP20(NOF) 
      IF(ISCRN.EQ.21) IMES=IHP21(NOF) 
      CALL HLP08(IMES,NOF)
      GO TO 15
C 
C  IFLG=8 MEANS LAST SCREEN 
C 
3010  IF(IFLG.NE.8) GO TO 3040
      IF(ISCRN.NE.19) GO TO 3066
      ISCRN=18
      CALL EXEC(8,ITGP4)
3066  IF(ISCRN.NE.20) GO TO 3012
      DO 3014 I=1,100 
3014  IFORM(I)=2H 
      ISCRN=3 
      CALL EXEC(8,ITGP0)
3012  ISCRN=20
      CALL EXEC(8,ITGP3)
C 
C  ABORT PROGRAM
C 
3040  IF(.NOT.OKABT(ILU)) GO TO 17
      INDIC=99
      CALL EXEC(8,ITGP1)
3045  INDIC=99
      CALL EXEC(8,ITGP1)
C 
C  END OF SEGMENT 
C 
      CALL TGP
C 
C 
      END 
      END$
                                                                                                                                                                                                                                    