FTN4
      PROGRAM TGP6(5), 92903-16363 REV.1913  790131 1300
C 
C     SOURCE 92903-18363
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 
C      PRGMR : JEAN CHARLES MIARD (HPG) 
C 
C*********************************************************************
C*                                                                   *
C*            THIS IS A SEGMENT OF THE TGP PROGRAM USED TO           *
C*   ANALYZE THE ANSWERS THE USER HAS GIVEN IN THE SCREENS 14,15     *
C*   16 AND 17 .                                                     *
C*            THE ANSWERS AFTER A CHECK ARE STORED IN JFORM ,        *
C*   MFORM AND LFORM .                                               *
C*                                                                   *
C*            FOLLOWING ARE THE DIFFERENT WAYS TO EXECUTE THIS       *
C*   SEGMENT ACCORDING TO INDIC VALUE :                              *
C*                                                                   *
C*       INDIC = 0 : NORMAL PATH . ANALYSE ISCRN SCREEN ANSWERS .    *
C*                   OR COMING FROM TGP12 AN ERROR HAS OCCURED IN    *
C*                   IMAGE PROCESSING ( DISPLAY, DELETE,SYSTEM       *
C*                   ADDED INFO,IMAGE EDITS) .                       *
C*             = 2 : RETURN FROM TGP12 . SYSTEM ADDED INFO TO        *
C*                   BE INCLUDED IN IMAGE DATA BASE HAS BEEN         *
C*                   SUCCESSFULY PROCESSED .                         *
C*             = 4 : RETURN FROM TGP12 . IMAGE DELETE OPERATION      *
C*                   SUCCESSFULLY PROCESSED .                        *
C*             = 5 : RETURN FROM TGP12 . IMAGE DISPLAY SUCCESS-      *
C*                   FULLY PROCESSED .                               *
C*             = 8 : ERR RETURN FROM TGP7 WHILE COMPILING INTO KFORM *
C             =-77 : A HELP MESSAGE MUST BE PRINTED                  *
C*                                                                   *
C*   WARNING !! : CARE MUST BE TAKEN * :                             *
C*                                                                   *
C*       PRINTED SCREEN # 14 CORRESPONDS TO ISCRN = 15               *
C*        ............... 15  ....................  16               *
C*        ............... 16  ....................  17               *
C*        ............... 17  ..................... 18               *
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 ITGP3(3),ILNGT(4,4) 
      DIMENSION JOUT(10),ITGP4(3),ITGP7(3),ITGP12(3),ITGP1(3) 
      DIMENSION IHP5(3),IHP60(3),IHP61(6),IHB60(4),IHB61(7),IHP7(3) 
      DIMENSION IHP8(5),IBUF(12)
C 
      LOGICAL JPAR,ISBIT,NAMCK,GETBK,OKABT
C 
      EQUIVALENCE(JOUT,KFORM(1000)) 
      EQUIVALENCE(NOF,KFORM(1015)),(IFLG,KFORM(1016)) 
      EQUIVALENCE(IFLG1,KFORM(1017)),(IFLG2,KFORM(1018))
      EQUIVALENCE(JVAL3,KFORM(1019)),(JVAL4,KFORM(1020))
      EQUIVALENCE(ISTAT,KFORM(1021)),(JOUT1,KFORM(1022))
C 
C  DATA VALUES :
C 
      DATA JBYTES/140/
      DATA JWORDS/70/ 
      DATA ITGP3/2HTG,2HP3,2H  /
      DATA ITGP4/2HTG,2HP4,2H  /
      DATA ITGP7/2HTG,2HP7,2H  /
      DATA ITGP12/2HTG,2HPI,2H2 / 
      DATA ITGP1/2HTG,2HP1 ,2H  / 
      DATA IHP5/1,14,2/ 
      DATA IHP60/3,4,7/ 
      DATA IHP61/3,4,5,0,6,7/ 
      DATA IHB60/3,4,0,7/ 
      DATA IHB61/3,4,0,5,0,6,7/ 
      DATA IHP7/0,8,0/
      DATA IHP8/10,10,11,12,13/ 
      DATA ILNGT/0,1,5,5,25,37,34,46,7,7,7,7,27,33,27,33/ 
C 
C*********************************************************************
C 
C  ACCORDING TO INDIC VALUE GO TO THE REQUIRED PORTION OF TGP6
C 
C*********************************************************************
C 
      IF(INDIC.EQ.4) GO TO 1512 
      IF(INDIC.EQ.5) GO TO 1640 
      IF(INDIC.EQ.2) GO TO 1925 
      IF(INDIC.EQ.7) PAUSE 0606 
C-----ERR RETURN FROM TGP7
      IF(INDIC.EQ.8) GO TO 1775 
      IF(INDIC.EQ.-77) GO TO 3011 
C 
C*********************************************************************
C 
C  INDIC = 0 GET THE ANSWERS IN THE SCREEN
C 
C*********************************************************************
C 
      ISTAT=0 
15    I=IAND(ITT,3B)+1
      J=ISCRN-14
      ITLOG=ILNGT(I,J)
      IF(ISCRN.NE.16) GO TO 16
      IF(IGET1(IFORM,1515).EQ.1HX) ITLOG=ITLOG+3
16    IF((ISCRN.NE.17).OR.(.NOT.ISBIT(ITT,1))) GO TO 12 
      IF(IAND(IMFLG,100000B).EQ.100000B) ITLOG=43 
12    IF(.NOT.(GETBK(ILU,KFORM,ITLOG))) GO TO 10
C 
C  ERROR IN GETTING ANSWERS REPRINT SCREEN
C 
17    CALL EXEC(8,ITGP4)
C 
C*********************************************************************
C 
C     GO TO ANALYSE USER ANSWERS TO SCREEN # ISCRN
C 
C*********************************************************************
C 
10    I=ISCRN-14
      GO TO(1500,1600,1900,1700) I
C 
C***********************************************************************
C 
C  SCREEN 14 "FUNCTON ONLY EDITS" 
C 
C********************************************************************** 
C 
C 
C 
C  RESET IMAGE FLAGS AND BUFFERS
C 
1500  NOF=1 
      N=2*IQST-1
      CALL ERFLG(N,IMAI,IMKY,IMFLG,IMAS,IMDT) 
C 
C   CONTINUE TO THE NEXT QUESTION  * CHECK ANSWER IS BLANK OR X , IF
C   X CHECK CONTINUE IS DEFINED 
C 
1501  IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184
      IFLG1=IFLG
      IF(IFLG.EQ.0) GO TO 1504
      IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1586
      DO 1502 I=1,26
      DO 1502 J=1,3,2 
      IF(IKEY(I,J).EQ.11) GO TO 1504
1502  CONTINUE
      GO TO 1584
1504  CALL MOVCA(JOUT,1,JFORM,(49+(IQST-1)*JBYTES),1) 
C 
C  NEXT ENTRY IN AN IMAGE CHAIN (TR.TYPE 2 AND 3) * CHECK ANSWER IS 
C  BLANK OR X , IF X NEXT ENTRY MUST BE DEFINED AND A FIND IN A DETAIL
C  DATA SET MUST BE DEFINED . 
C 
      IF(ISBIT(ITT,1)) GO TO 1505 
      CALL BLAN(JFORM,50+(IQST-1)*JBYTES,2) 
      GO TO 1515
1505  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IFLG2=IFLG
      IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184
      IF(IFLG.EQ.0) GO TO 1508
      DO 1506 I=1,26
      DO 1506 J=1,3,2 
      IF(IKEY(I,J).EQ.12) GO TO 1507
1506  CONTINUE
      GO TO 1483
1507  IF(IMDT.EQ.0) GO TO 1484
      IF(IQST.LE.IUMAX) GO TO 1487
1508  CALL MOVCA(JOUT,1,JFORM,(50+(IQST-1)*JBYTES),1) 
C 
C  DELETE ENTRY IN DATA BASE (TR,TYPE 2 OR 3 ONLY)
C  CHECK ANSWER IS BLANK OR X , IF X CHECK DELETE IS DEFINED
C  AND GO TO TGP12 TO PROCESS THE IMAGE DELETE
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184
      IF(IFLG.EQ.0) GO TO 1512
      DO 1510 I=1,26
      DO 1510 J=1,3,2 
      IF(IKEY(I,J).EQ.13) GO TO 1511
1510  CONTINUE
      GO TO 1585
C 
C   GO TO TGP12 TO PROCESS IMAGE DELETE 
C 
1511  IMAI(N,2)=4 
      INDIC=0 
      CALL EXEC(8,ITGP12) 
C 
C    HERE RETURN FROM TGP12 (DELETE PROCEESED SUCCESFULLY)
C 
1512  INDIC=0 
      CALL MOVCA(JOUT,1,JFORM,(51+(IQST-1)*JBYTES),1) 
C 
C*********************************************************************
C 
C  CALL DISPLAY INFORMATION SCREEN ?  (SCREENS 11 OR 12 OR 13 OR 14)
C  OR PROCESS NEXT QUESTION 
C 
C*********************************************************************
C 
C 
1515  IF(IFLG1.NE.0) GO TO 1518 
      IF(.NOT.ISBIT(ITT,1)) GO TO 1486
      IF((IFLG.EQ.0).AND.(IFLG2.EQ.0)) GO TO 1486 
1518  IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1630
      ISCRN=16
      GO TO 1002
C 
C  ERROR PROCESSING SCREEN 14 
C 
1584  CALL MES06(8,NOF) 
      GO TO 15
1585  CALL MES06(9,NOF) 
      GO TO 15
1586  CALL MES06(13,NOF)
      GO TO 15
1180  CALL MES06(1,NOF) 
      GO TO 15
1181  CALL MES06(2,NOF) 
      GO TO 15
1182  CALL MES06(3,NOF) 
      GO TO 15
1183  CALL MES06(4,NOF) 
      GO TO 15
1184  CALL MES06(5,NOF) 
      GO TO 15
C-----"NO MORE THAN 4 SUMMARY ITEMS MAY BE DEFINED" 
1185  CALL MES06(36,NOF)
      GO TO 15
1480  CALL MES06(6,NOF) 
      GO TO 15
1483  CALL MES06(7,NOF) 
      GO TO 15
1484  CALL MES06(24,NOF)
      GO TO 15
1485  CALL MES06(25,NOF)
      GO TO 15
1486  CALL MES06(26,NOF)
      GO TO 15
1487  CALL MES06(19,NOF)
      GO TO 15
C 
C*********************************************************************
C 
C  SCREEN 15 DISPLAYED INFORMATION
C 
C*********************************************************************
C 
C   INDICATOR LIGHT #  (CHECK LIGTH # IS LEGAL AND NOT ASSIGNED TO SYSTEM 
C   SAVE LIGHT # IN COMMON (EQUIVALENCE)
C 
C   FIRST RESET ILITE BUFFER
C 
1600  NOF=1 
      CALL ERLIT(ILITE,-IQST) 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      CALL MOVCA(JOUT,1,JFORM,101+(IQST-1)*JBYTES,2)
      JVAL3=JVAL
      JOUT1=JOUT(1) 
      IF(IFLG.GT.1) GO TO 1180
      IF(IFLG.EQ.0) GO TO 1605
C-----LIGHT 0?
      IF(JVAL3.EQ.0) GO TO 1605 
      IF((JVAL.LT.1).OR.(JVAL.GT.15)) GO TO 1182
      IF(ILITE(JVAL).EQ.-99) GO TO 1183 
C 
C-----WILL DISPLAYED VALUE BE USED AS DEFAULT?
C 
1605  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(JOUT.NE.2HX )) GO TO 1184 
      CALL MOVCA(JOUT,1,JFORM,103+(IQST-1)*JBYTES,1)
C 
C-----DISPLAY LABEL 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,20,IFLG,JVAL))GO TO 3000 
      CALL MOVCA(JOUT,1,JFORM,106+(IQST-1)*JBYTES,20) 
C 
C  PRINTER QUESTIONS (MUST BE SPECIFIED IN SCREEN 41) 
C 
C-----ON-LINE AND/OR SUMMARY
C 
      IF(IGET1(IFORM,1515).NE.2HX )GO TO 1610 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL))GO TO 3000
      IF(IFLG.EQ.0) GO TO 1608
      IF((JOUT.NE.2HO ).AND.
     *   (JOUT.NE.2H O).AND.
     *   (JOUT.NE.2HS ).AND.
     *   (JOUT.NE.2H S).AND.
     *   (JOUT.NE.2HOS).AND.
     *   (JOUT.NE.2HSO))     GO TO 1690 
1608  CALL MOVCA(JOUT,1,JFORM,104+(IQST-1)*JBYTES,2)
C 
C  USER WRITTEN DISPLAY MODULES (TR.TYPE 1 OR 3 ONLY) 
C 
C  NAME OF DISPLAY PROGRAM
C 
1610  CONTINUE
      IF(ISBIT(ITT,0)) GO TO 1611 
      CALL BLAN(JFORM,126+(IQST-1)*JBYTES,5)
      CALL BLAN(JFORM,133+(IQST-1)*JBYTES,1)
      JFORM(66+(IQST-1)*JWORDS)=0 
      GO TO 1620
1611  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,5,IFLG,JVAL)) GO TO 3000 
      IF((IAND(ITT,3B).EQ.1).AND.(IFLG.EQ.0)) GO TO 1685
      IF(IFLG.EQ.0) GO TO 16111 
      IF(NAMCK(JOUT)) GO TO 1788
16111 IFLG1=IFLG
      CALL MOVCA(JOUT,1,JFORM,(126+(IQST-1)*JBYTES),5)
C 
C  DISPLAYED ITEM TYPE (TR.TYPE 1 OR 3  ONLY) 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG1.NE.0).AND.(IFLG.EQ.0)) GO TO 1684 
      IF((IFLG1.EQ.0).AND.(IFLG.NE.0)) GO TO 1681 
      JVAL=-1 
      IF(IFLG.EQ.0) GO TO 1612
      IF(JOUT.EQ.2HS ) JVAL=0 
      IF(JOUT.EQ.2HI ) JVAL=1 
      IF(JOUT.EQ.2HR ) JVAL=2 
      IF(JVAL.EQ.-1) GO TO 1680 
C 
C  CHECK DEFAULT =DISPLAY VALUES ARE OF SAME TYPE 
C 
      IFL1=0
      IF(IGET1(JFORM,103+(IQST-1)*JBYTES).NE.2HX ) GO TO 1612 
      JVAL1=JFORM(50+(IQST-1)*JWORDS) 
      IF(JVAL1.EQ.3) GO TO 1612 
      IF(JVAL.NE.JVAL1) GO TO 1688
      IF(JVAL.EQ.0) IFL1=1
1612  JVAL1=JVAL
      CALL MOVCA(JOUT,1,JFORM,(133+(IQST-1)*JBYTES),1)
C 
C  STRING LENGTH (TR TYPE 1 OR 3 ONLY ) 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,3,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.GT.1) GO TO 1480
      IF((JVAL1.NE.0).AND.(IFLG.NE.0)) GO TO 1681 
      IF((JVAL1.EQ.0).AND.(IFLG.EQ.0)) GO TO 1480 
      IF(IFLG.EQ.0) JVAL=0
      IF(IFLG.EQ.0) GO TO 1616
      IF(IFL1.EQ.0) GO TO 1615
      IF(JFORM(25+(IQST-1)*JWORDS).NE.JVAL) GO TO 1689
1615  IF((JVAL.LT.1).OR.(JVAL.GT.126)) GO TO 1480 
1616  JFORM(66+(IQST-1)*JWORDS)=JVAL
C 
C   IMAGE ITEM NAME  ( TR. TYPE 2 OR 3 ONLY)
C 
1620  IF(ISBIT(ITT,1)) GO TO 1621 
      CALL BLAN(JFORM,134+(IQST-1)*JBYTES,6)
      GO TO 1631
1621  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((IAND(ITT,3B).EQ.2).AND.(IFLG.EQ.0)) GO TO 1683
      IF(IAND(ITT,3B).NE.3) GO TO 1617
      IF((IFLG.NE.0).AND.(IFLG1.NE.0)) GO TO 1686 
      IF((IFLG.EQ.0).AND.(IFLG1.EQ.0)) GO TO 1687 
1617  CALL MOVCA(JOUT,1,JFORM,(134+(IQST-1)*JBYTES),6)
      IFLG0=IFLG
C 
C-----WILL SUMMARY ALSO BE DISPLAYED FOR THIS ITEM? 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184
      IF(IFLG0.EQ.0 .AND. JOUT.EQ.2HX ) GO TO 1681
C-----NOW CHECK THAT THERE WON'T BE MORE THAN 4 SUMMARY ITEMS.
      ISUM=0
      DO 1618 IXST=1,IQST 
      IF(IGET1(JFORM,140+(IXST-1)*JBYTES).NE.2HX ) GO TO 1618 
      ISUM=ISUM+1 
      IF(ISUM.GT.3) GO TO 1185
1618  CONTINUE
      CALL MOVCA(JOUT,1,JFORM,(140+(IQST-1)*JBYTES),1)
C 
C 
C   CALL TGP12 TO PROCESS IMAGE DISPLAY 
C 
1631  IF((IFLG1.NE.0).AND.(IAND(ITT,3B).NE.2)) GO TO 1650 
      IMAI(2*IQST,2)=5
      INDIC=0 
      CALL EXEC(8,ITGP12) 
C 
C  RETURN FROM TGP12  . IMAGE DISPLAY SUCCESSFULLY PROCESSED
C 
C  CHECK IF DISPLAYED VALUE=DEFAULT VALUE : 
C     -ITEMS ARE OF SAME TYPE 
C     -STRINGS OF SAME LENGTH 
C 
1640  INDIC=0 
      IF(IGET1(JFORM,103+(IQST-1)*JBYTES).EQ.1H ) GO TO 1642
      IX=JFORM(50+(IQST-1)*JWORDS)
      IF(IX.EQ.3) GO TO 1650
      IY=IAND(IMAI(2*IQST,2),30000B)/4096 
                                                                                                                                                                        