FTN4
      PROGRAM TGP8(5), 92080-1X367 REV.2026  800502             
C 
C     SOURCE 92080-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(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
C 
C   LOCAL VARIABLES **************
C 
      DIMENSION IBUF(61),JOUT(15),ITGP4(3),ITGP1(3) 
      DIMENSION IDCB(144),ITGP10(3),NFORM(3),ITGP3(3) 
      DIMENSION ITGP0(3),IHP19(4),IHP20(4),IHP21(13),ICR(3) 
C 
      EQUIVALENCE (NOF,KFORM(1059)) 
C 
      LOGICAL JPAR,NAMCK,CMPW,GETBK,OKABT,ISBTW,INUM
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/ 
      DATA ICR/2H  ,2H  ,2H  /
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,IMODE))) 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  LIBRARY FILE NAME
C 
1800  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.EQ.0) GO TO 1802
C     NO.  INTEGER? 
      IF(IFLG.NE.1) GO TO 1801
C     YES.
      IF(JVAL.LT.1) GO TO 1984
      GO TO 1802
C     ASCII?
1801  IF(IFLG.NE.3) GO TO 1984
C     YES.  LEFT JUSTIFY IT & MAKE SURE IT IS A VALID 2 CHAR CR#. 
      CALL JUSTF(JOUT,1,6,1)
      IF(LNCAR(JOUT,1,6).GT.2) GO TO 1984 
      IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 1984 
      I=IGET1(JOUT,2) 
      IF(ISBTW(I,1HA,1HZ) .AND. ISBTW(I,1H0,1H9) .AND. ISBTW(I,1H ,1H ))
     .GO TO 1984
1802  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
1804  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.88) IMES=23 
      IF(ISKIP.EQ.99) IMES=19 
      IF(ISKIP.EQ.-32) IMES=24
      IF(ISKIP.EQ.-32) NOF=NOF+1
      IF(ISKIP.EQ.-33) IMES=9 
D     WRITE(6,4109) ISKIP,IMES
D4109 FORMAT(" TGP8 : ISKIP=",I6," , IMES=",I6) 
      IF(IMES.NE.0) GO TO 410 
      CALL JASC(ISKIP,NFORM,1,6)
      IMES=11 
410   ISKIP=0 
      IF(IMES.EQ.5 .AND. ISCRN.EQ.19) NOF=2 
      IF(IMES.EQ.5 .AND. ISCRN.EQ.20) NOF=3 
      IF(IMES.EQ.5 .AND. ISCRN.EQ.21) NOF=12
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 
      JVAL=0
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.EQ.0) GO TO 2003
C     NO.  INTEGER? 
      IF(IFLG.NE.1) GO TO 2002
C     YES.
      IF(JVAL.LT.1) GO TO 1984
      GO TO 2003
C     ASCII?
2002  IF(IFLG.NE.3) GO TO 1984
C     YES.  LEFT JUSTIFY IT & MAKE SURE IT IS A VALID 2 CHAR CR#. 
      CALL JUSTF(JOUT,1,6,1)
      IF(LNCAR(JOUT,1,6).GT.2) GO TO 1984 
      IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 1984 
      I=IGET1(JOUT,2) 
      IF(ISBTW(I,1HA,1HZ) .AND. ISBTW(I,1H0,1H9) .AND. ISBTW(I,1H ,1H ))
     .GO TO 1984
      JVAL=JOUT 
2003  IF(INUM(ILIBR,123,6,ISECOD)) PAUSE 2003 
      IF(OPEN(IDCB,ISKIP,ILIBR(2),1,ISECOD,JVAL).LT.0) GO TO 414
C    -IF CR WAS NOT SPECIFIED, GET IT NOW FROM IDCB 
      IF(IFLG.NE.0) GO TO 2005
      ICR=ICRLU(-IAND(IDCB,77B))
C     -DON'T DO IT IF TYPE 0 FILE.
      IF(ISKIP.EQ.0) GO TO 2005 
      CALL JASC(ICR,ILIBR,9,6)
C     -DO THIS IF CRN IS ASCII. 
      IF(.NOT.NAMCK(ICR)) CALL MOVEW(ICR,ILIBR(5),3)
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 1804
      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
C 
C-----FOLLOWING CHECK MOVED INTO CR # SECTION COMING NEXT 
C 
C     IF(CMPW(ILIBR(2),JOUT,3)) GO TO 2082
      CALL MOVEW(JOUT,ILIBR(41),3)
C 
C  CR # 
C 
      NOF=NOF+1 
      JVAL=0
      IF(JPAR(IBUF,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000
      IF(IFLG.EQ.0) GO TO 2113
C     NO.  INTEGER? 
      IF(IFLG.NE.1) GO TO 2112
C     YES.
      IF(JVAL.LT.1) GO TO 1984
      GO TO 2113
C     ASCII?
2112   IF(IFLG.NE.3) GO TO 1984 
C     YES.  LEFT JUSTIFY IT & MAKE SURE IT IS A VALID 2 CHAR CR#. 
      CALL JUSTF(JOUT,1,6,1)
      IF(LNCAR(JOUT,1,6).GT.2) GO TO 1984 
      IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 1984 
      I=IGET1(JOUT,2) 
      IF(ISBTW(I,1HA,1HZ) .AND. ISBTW(I,1H0,1H9) .AND. ISBTW(I,1H ,1H ))
     .GO TO 1984
      JVAL=JOUT 
C 
C-----CHECK FOR DUPLICATE LIBRARY NAME. ONLY PASS IF NAME/CR# IS
C     DIFFERENT. IF NAME THE SAME AND DEST. CR# NOT GIVEN DO NOT
C     LET PASS EITHER 
C 
2113  NOF=NOF-1 
      IF((CMPW(ILIBR(2),ILIBR(41),3)).AND.
     .   (CMPW(ILIBR(5),JOUT,3).OR.IFLG.EQ.0)) GO TO 2082 
      NOF=NOF+1 
      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$