FTN4
      PROGRAM TGP6(5), 92080-1X363 REV.2026 800428                
C 
C     SOURCE 92080-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(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 ITGP3(3),ILNGT(4,4) 
      DIMENSION JOUT(10),ITGP4(3),ITGP7(3),ITGP12(3),ITGP1(3) 
      DIMENSION IHP5(3),IHP60(11),IHP61(6),IHP62(3),IHP63(7),IHP7(4)
      DIMENSION IHP8(6),IBUF(52),IBUF1(52),ISTAT(10),KBUF(16) 
      DIMENSION IBUF2(52),IHP64(4),IHP65(8),IHP66(5),IHP67(9) 
      DIMENSION IHP68(8),IHP69(6) 
C 
      LOGICAL JPAR,ISBIT,NAMCK,GETBK,OKABT,ISBTW
C 
      EQUIVALENCE(JOUT,KFORM(1000)) 
      EQUIVALENCE(NOF,KFORM(1900)),(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/170/
      DATA JWORDS/85/ 
      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,16,17,18,19,5,20,6,7,21,22/
      DATA IHP61/3,16,17,7,21,22/ 
      DATA IHP62/7,21,22/ 
      DATA IHP63/17,5,20,6,7,21,22/ 
      DATA IHP64/17,7,21,22/
      DATA IHP65/3,16,5,20,6,7,21,22/ 
      DATA IHP66/3,16,7,21,22/
      DATA IHP67/3,16,17,5,20,6,7,21,22/
      DATA IHP68/3,16,17,18,19,7,21,22/ 
      DATA IHP69/3,16,17,7,21,22/ 
      DATA IHP7/0,8,0,0/
      DATA IHP8/10,12,11,15,24,13/
      DATA ILNGT/0,1,5,5,25,37,41,53,7,7,7,7,29,35,29,35/ 
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 15 
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
      ITLOG=0 
      IF(IAND(ITT,2000B).EQ.0) ITLOG=ITLOG+5
      IF(IAND(ITT,20210B).NE.0) ITLOG=ITLOG+17
      IF(IAND(ITT,22210B).EQ.0) ITLOG=ITLOG+17
      IF(IAND(ITT,10B).NE.0) ITLOG=ITLOG+4
      IF(IAND(ITT,1B).NE.0) ITLOG=ITLOG+11
      IF(IAND(ITT,2B).NE.0) ITLOG=ITLOG+15
      IF(IAND(ITT,3B).EQ.3) ITLOG=ITLOG+1 
16    IF((ISCRN.NE.17).OR.(.NOT.ISBIT(ITT,1))) GO TO 12 
      IF(IAND(IMFLG,100000B).EQ.100000B) ITLOG=71 
12    IF(INDIC.EQ.-77) GO TO 3011 
      IF(.NOT.(GETBK(ILU,KFORM,ITLOG,IMODE))) 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 
D     NERR=1501 
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 
D     NERR=1505 
      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 
D     NERR=1510 
      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 
C     -DISPLAY? 
1518  IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1519
C     -YES.  GO TO SCREEN 15. 
      ISCRN=16
      GO TO 1002
C 
C     -BLANK OUT SCR 15 FIELDS IN JFORM.
1519  CALL BLAN(JFORM,101+(IQST-1)*JBYTES,46) 
      GO TO 1610
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     -"DELETE ALREADY DEFINED ON THIS ITEM"
1488  CALL MES06(43,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=0 
      IF(IAND(ITT,2000B).EQ.0) GO TO 1601 
      CALL BLAN(JFORM,101+(IQST-1)*JBYTES,3)
      JOUT1=0 
      GO TO 1603
1601  NOF=NOF+1 
      CALL ERLIT(ILITE,-IQST) 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
C    -"ILLEGAL FOR TM"
      IF(ISBIT(ITT,10) .AND. IFLG.NE.0) GO TO 1692
      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 1602
C-----LIGHT 0?
      IF(JVAL3.EQ.0) GO TO 1602 
      IF((JVAL.LT.1).OR.(JVAL.GT.14)) GO TO 1182
      IF(ILITE(JVAL).EQ.-99) GO TO 1183 
C 
C-----WILL DISPLAYED VALUE BE USED AS DEFAULT?
C 
1602  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 
1603  IF(IAND(ITT,20210B).NE.0.OR.IAND(ITT,22210B).EQ.0)
     .GO TO 1604
      CALL BLAN(JFORM,107+(IQST-1)*JBYTES,16) 
      GO TO 1605
1604  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,16,IFLG,JVAL))GO TO 3000 
CCC  "ILLEGAL FOR TM" 
CCC   IF(ISBIT(ITT,10) .AND. IFLG.NE.0) GO TO 1692
      CALL MOVCA(JOUT,1,JFORM,107+(IQST-1)*JBYTES,16) 
C 
C  PRINTER QUESTIONS (MUST BE SPECIFIED IN SCREEN 41) 
C 
C-----ON-LINE AND/OR SUMMARY
C 
C     -PRINTER? 
1605  CALL BLAN(JFORM,104+(IQST-1)*JBYTES,1)
      IF(IAND(ITT,10B).NE.0) GO TO 1606 
C     -NO.  BLANK OUT FIELD IN JFORM. 
      CALL BLAN(JFORM,105+(IQST-1)*JBYTES,2)
      GO TO 1610
C 
1606  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL))GO TO 3000
      IF(IFLG.EQ.0) GO TO 1607
      IF(JOUT.NE.1H .AND.JOUT.NE.1HX) GO TO 1184
1607  CALL MOVCA(JOUT,1,JFORM,105+(IQST-1)*JBYTES,1)
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.EQ.0) GO TO 1608
      IF(JOUT.NE.1H .AND.JOUT.NE.1HX) GO TO 1184
1608  CALL MOVCA(JOUT,1,JFORM,106+(IQST-1)*JBYTES,1)
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 1693 
1617  CALL MOVCA(JOUT,1,JFORM,(134+(IQST-1)*JBYTES),6)
      IFLG0=IFLG
C 
C-----DATA SET NAME (6 ASCII CHAR, REQD FOR IMAGE ITEM NAME)
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF(IFLG0.EQ.3 .AND. IFLG.NE.3) GO TO 1691 
      IF(IFLG0.NE.3 .AND. IFLG.EQ.3) GO TO 1681 
      CALL MOVCA(JOUT,1,JFORM,140+(IQST-1)*JBYTES,6)
C 
C-----WILL TOTAL 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
      CALL MOVCA(JOUT,1,JFORM,146+(IQST-1)*JBYTES,1)
C-----NOW CHECK THAT THERE WON'T BE MORE THAN 4 TOTAL ITEMS.
      ISUM=0
      DO 1618 IXST=1,IQST 
      IF(IGET1(JFORM,146+(IXST-1)*JBYTES).NE.2HX ) GO TO 1618 
      ISUM=ISUM+1 
      IF(ISUM.GT.4) GO TO 1185
1618  CONTINUE
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 
      IF(IX.NE.IY) GO TO 1688 
      IF(IX.NE.0) GO TO 1650
      IF(IAND(IMAI(2*IQST,4),377B).NE.JFORM(25+(IQST-1)*JWORDS))
     C  GO TO 1689
C-----IS THIS A DISPLAY ITEM? 
1642  IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1650
C-----YES, STORE THE IMAGE ITEM LENGTH. 
      JFORM(66+(IQST-1)*JWORDS)=IAND(IMAI(2*IQST,4),377B) 
C 
C   ASSIGN LIGHT # NOW FOR THIS DISPLAY IF LIGHT ALREADY USED 
C   ISSUE A WARNING . 
C 
1650  CONTINUE
1654  IQ=-IQST
C-----LIGHT 0?
      IF((JOUT1.EQ.2H0 ).OR.(JOUT1.EQ.2H 0).OR.(JOUT1.EQ.2H00)) 
     *    GO TO 16321 
      IF(ISTAT.EQ.0) GO TO 1632 
      IF(JVAL3.NE.JVAL4) ISTAT=0
1632  CALL LIGHT(IQ,JVAL3,JOUT1,ISTAT,JFORM,ILITE)
      IF(ISTAT.EQ.0) GO TO 1630 
      IF(ISTAT.EQ.-1) GO TO 1181
      CALL HLP06(23,1)
      ISTAT=1 
      JVAL4=JVAL3 
      GO TO 15
C-----LIGHT # IS 0. 
16321 JFORM(51+(IQST-1)*JWORDS)=2H00
C 
C***********************************************************************
C 
C GO TO PROCESS  NEXT QUESTION
C 
C***********************************************************************
C 
1630  IQST=IQST+1 
      IF(IQST.GT.(IUMAX+IMMAX)) GO TO 1634
      ISCRN=11
      GO TO 1000
1634  ISCRN=17
      GO TO 1002
C 
C  ERROR PROCESSING SCREEN 15 
C 
C 
C ILLEGAL DISPLAY VALUE TYPE
C 
1680  CALL MES06(10,NOF)
      GO TO 15
C 
C FIELD MUST BE BLANK 
C 
1681  CALL MES06(11,NOF)
      GO TO 15
C 
C MISSING DISPLAY ITEM NAME 
C 
1683  CALL MES06(27,NOF)
      GO TO 15
C 
C MISSING DISPLAY ITEM TYPE 
C 
1684  CALL MES06(28,NOF)
      GO TO 15
C 
C MISSING DISPLAY PROGRAM NAME
C 
1685  CALL MES06(29,NOF)
      GO TO 15
C 
C CANNOT SPECIFY BOTH USER WRITTEN MODULE & DATA ITEM 
C 
1686  CALL MES06(33,NOF)
      GO TO 15
C 
C MISSING DISPLAY VALUE DEFINITION
C 
1687  CALL MES06(34,NOF)
      GO TO 15
C 
C THE DISPLAYED VALUE (DEFAULT VALUE) AND THE ANSWER MUST BE OF THE 
C SAME TYPE 
C 
1688  CALL MES06(14,NOF)
      GO TO 15
C 
C DISPLAYED VALUE AND ANSWER MAX STRING LENGTH MUST BE EQUAL
C 
1689  CALL MES06(16,NOF)
      GO TO 15
C-----"FIELD MUST BE O, S, OS, OR SO" 
1690  CALL MES06(37,NOF)
      GO TO 15
C-----"DATA SET REQUIRED" 
1691  CALL MES06(38,NOF)
      GO TO 15
C    "ILLEGAL FOR TIME REPORTING TERMINAL"
1692  CALL MES06(40,NOF)
      GO TO 15
C     "USER WRITTEN MODULE OR DATA ITEM REQUIRED" 
1693  CALL MES06(42,NOF-3)
      GO TO 15
C 
C***********************************************************************
C 
C   SCREEN 16 ( SYSTEM ADDED INFORMATION )
C 
C********************************************************************** 
C 
1900  NOF=1 
      DO 1920 I=1,4 
C 
C   X IF NEEDED 
C 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((JOUT.NE.2H  ).AND.(JOUT.NE.2HX )) GO TO 1184
      IF(I.NE.4) GO TO 1902 
        IF(.NOT.ISBIT(ITT,10)) GO TO 1902 
          IF(IFLG.EQ.0) GO TO 1981
1902  IFLG1=IFLG
      NOF=NOF+1 
      CALL MOVCA(JOUT,1,MFORM,I,1)
C 
C   IMAGE ITEM NAME (ONLY IF IMAGE STORAGE) 
C 
      IF(ISBIT(IMFLG,15)) GO TO 1908
      CALL BLAN(MFORM,6*I-1,6)
      CALL BLAN(MFORM,28+I,1) 
      CALL BLAN(MFORM,33+6*(I-1),6) 
      GO TO 1920
1908  IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(IFLG1.EQ.0)) GO TO 1681 
      IFLG2=IFLG
      CALL MOVCA(JOUT,1,MFORM,(6*I-1),6)
C 
C-----GET DATA SET NAME(REQD FOR IMAGE ITEM)
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.NE.0 .AND. IFLG2.EQ.0) GO TO 1681 
      IF(IFLG.EQ.0 .AND. IFLG2.NE.0) GO TO 1691 
      CALL MOVCA(JOUT,1,MFORM,33+6*(I-1),6) 
C 
C   IMAGE OPERATION CODE U OR A 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(IFLG2.EQ.0)) GO TO 1681 
      IF((IFLG.EQ.0).AND.(IFLG2.NE.0)) GO TO 1980 
      IF(IFLG.EQ.0) GO TO 1910
      IF((JOUT(1).NE.2HA ).AND.(JOUT(1).NE.2HU )) GO TO 1980
1910  NOF=NOF+1 
      CALL MOVCA(JOUT,1,MFORM,(28+I),1) 
1920  CONTINUE
C 
C  IF STORAGE IMAGE CALL TGP12 FOR IMAGE PROCESSING 
C 
      IF(.NOT.(ISBIT(IMFLG,15))) GO TO 1930 
      INDIC=-8
      CALL EXEC(8,ITGP12) 
C 
C  RETURN FROM TGP12 (INFORMATION SUCCESSFULLY PROCESSED) 
C 
1925  INDIC=0 
C 
C  CALL SCREEN 17 
C 
1930  ISCRN=18
      GO TO 1002
C 
C  ERROR SECTION SCREEN 16
C 
1980  CALL MES06(30,NOF)
      GO TO 15
C    -"REQD FOR TIME REPORTING TRANS" 
1981  CALL MES06(39,NOF)
      GO TO 15
C 
C************************************************************************ 
C 
C   SCREEN 17  (DATA STORAGE DEFINITION)
C 
C************************************************************************ 
C 
C   FILE NAME # 2 
C 
1700  NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IFLG2=IFLG
      IF(IFLG.EQ.0) GO TO 1704
      IF(NAMCK(JOUT)) GO TO 1788
      IFLG2=1 
1704  CALL MOVEW(JOUT,LFORM(4),3) 
C 
C  FILE SECURITY CODE 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(IFLG2.EQ.0)) GO TO 1782 
      IF(IFLG.GT.1) GO TO 1787
      IF(JVAL.EQ.-32768) GO TO 1783 
      CALL MOVEW(JOUT,LFORM(10),3)
C 
C 
C  CR #  ?
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
C     -IS CR# GIVEN BUT FILE NAME BLANK?
      IF(IFLG.NE.0 .AND. IFLG2.EQ.0) GO TO 1781 
C     -NO.  ARE BOTH CR# & FILE NAME BLANK? 
      IF(IFLG.EQ.0 .AND. IFLG2.EQ.0) GO TO 1706 
C     -NO.  CR# FIELD BLANK?
      IF(IFLG.EQ.0) GO TO 1706
C     NO.  INTEGER? 
      IF(IFLG.NE.1) GO TO 1705
C     YES.
      IF(JVAL.LT.1) GO TO 1783
      GO TO 1706
C     ASCII?
1705  IF(IFLG.NE.3) GO TO 1783
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 1783 
      IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 1783 
      I=IGET1(JOUT,2) 
      IF(ISBTW(I,1HA,1HZ) .AND. ISBTW(I,1H0,1H9) .AND. ISBTW(I,1H ,1H ))
     .GO TO 1783
1706  CALL MOVEW(JOUT,LFORM(7),3) 
C 
C  SHARED ACCESS TO DISC FILE?
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(JOUT.NE.1H .AND.JOUT.NE.1HX) GO TO 1184
      IF(IFLG.NE.0.AND.IFLG2.EQ.0) GO TO 1781 
      CALL MOVCA(JOUT,1,LFORM,30,1) 
C 
C   FILE NAME # 1 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IFLG1=IFLG
      IF(IFLG.EQ.0) GO TO 1702
      IF(NAMCK(JOUT)) GO TO 1788
      IFLG1=1 
1702  CALL MOVEW(JOUT,LFORM,3)
C 
C  STORAGE PROGRAM ?
C 
      IF(.NOT.ISBIT(ITT,0)) GO TO 1710
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,5,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.EQ.0) GO TO 1712
      IF(NAMCK(JOUT)) GO TO 1485
      IFLG=1
1712  CALL MOVCA(JOUT,1,LFORM,25,5) 
1710  IF((IFLG+IFLG1+IFLG2.EQ.0).AND.(.NOT.ISBIT(ITT,1))) GO TO 1786
      IF(.NOT.ISBIT(ITT,0)) CALL BLAN(LFORM,25,5) 
C 
C  IF TR TYPE >1 INSERT IMAGE EDITS 
C 
1715  IF(.NOT.ISBIT(ITT,1)) GO TO 1720
C 
C********************************************************************** 
C 
C           B U I L D   I M A G E   E D I T S  .
C 
C********************************************************************** 
C 
C     GENERATES IMAGE EDIT FOR  ADD  OPERATION ONLY FOR KEY ITEMS 
C 
C 
C  IMAGE ADD EDITS
C 
C  NO EDITS ON NON KEY ITEMS
C 
C  K IS IMAGE OPERATION # 
C 
C     -ADD? 
1100  IF(.NOT.(ISBIT(IMFLG,0))) GO TO 1300
C     -YES, GENERATE IMAGE ADD EDITS. 
C 
      DO 1299 I=1,39,2
         K=IAND(IMAI(I,2),7)
C        -ADD?
         IF(K.NE.2) GO TO 1299
C        -YES. KEY ITEM?
         IF(.NOT.(ISBIT(IMAI(I,2),3))) GO TO 1299 
C        -YES. IS IT A KEY IN A MASTER OR DETAIL DATA SET?
         IF(.NOT.(ISBIT(IMAI(I,2),15))) GO TO 1200
C 
C  MASTER DATA SET ADD. 
C 
C         KEY ITEM : CODE EDIT 2 + LOCK 
C 
         IMAI(I,2)=IOR(IMAI(I,2),2200B) 
         IMAI(I,3)=IOR(IMAI(I,3),IALF2(IMAI(I,3)))
         GO TO 1299 
C 
C  DETAIL DATA SET ADD. 
C 
C        GIVEN: KEY ITEM IN A DTL 
C        FIND : WHETHER THE LINKED MASTERS ARE M OR A. IF M & NO ADD
C               IS ALREADY DEFINED IN IT, SET EDIT CODE 1 & LOCK BIT. 
C               IF A, DON'T HAVE TO GENERATE IMAGE EDIT.
C 
1200     ITN=IAND(IMAI(I,1),377B) 
         IDS=IAND(IMAI(I,3),377B) 
C        -SET ADD IN DTL FLAG SO THAT LOCK BIT FOR ALL CK EXIST. WILL BE SET. 
         IADDS=1
C 
C        -FIND ITEMS EQUIVALENT TO THIS ITEM. 
         CALL ITEQU(ITN,IDS,KBUF,IBASE) 
C        -LOOP 1290 GOES THRU THE LIST OF EQUIVALENT ITEMS & IF IT IS 
C        -IN A MANUAL MASTER THAT DOESN'T ALREADY HAVE AN ADD DEFINED 
C        -IN INTO IT, IMAGE EDIT CODE 1 + LOCK BIT IS SET & THE DATA SET
C        -UPON WHICH THE IMAGE EDIT (MORE THAN LIKELY A CHECK EXISTENCE)
C        -IS PICKED UP. 
         DO 1290 L=1,16 
D      WRITE(6,1222) L,KBUF(L)
D1222  FORMAT(" TGP6 : KBUF(",I2,") =",@7)
            IF(KBUF(L).EQ.0) GO TO 1290 
            ITNX=IAND(KBUF(L),377B) 
                                                          