FTN4
      PROGRAM TGP2(5), 92080-1X355 REV.2026  800502           
C 
C     SOURCE 92080-18355
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 USED TO           *
C*   ANALYZE THE ANSWERS THE USER HAS GIVEN IN THE SCREENS 6,61,62,  *
C*   7,8, AND 9.                                                     *
C*            THE ANSWERS AFTER A CHECK ARE STORED IN IFORM.         *
C*                                                                   *
C*            THIS SEGMENT IS LOADED ONLY TO ANALYSE SCREEN ANSWERS  *
C*  INDIC IS NOT USED .                                              *
C*                                                                   *
C*      IF INDIC=-77 A HELP MESSAGE MUST BE PRINTED                  *
C*                                                                   *
C*                                                                   *
C*  WARNING !! : CARE MUST BE TAKEN * :                              *
C*                                                                   *
C*      PRINTED SCREEN # 8 CORRESPONDS IN THE CODE TO ISCRN=9        *
C*       ............... 9................................. 10       *
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 ITGP0(3),ITGP3(3),KNAM(3),IHP6(5) 
      DIMENSION JOUT(10),JK(14),KCHECK(26)
C 
      EQUIVALENCE (NOF,KFORM(1900)),(NOFX,KFORM(1901))
C 
      LOGICAL JPAR,GETBK,OKABT,ISBIT
C 
C 
C  DATA VALUES :
C 
      DATA JBYTES/170/
      DATA JWORDS/85/ 
      DATA ITGP0/2HTG,2HP0,2H  /
      DATA ITGP3/2HTG,2HP3,2H  /
      DATA KNAM/2HTG,2HP1 ,2H  /
      DATA JK/2HTC,2HRC,2HSV,2HAB,2HAD,2HSU,2HMP,2HDV,2HEQ,2HPR,2HCN, 
     C2HNX,2HDE,2HCS/ 
      DATA KCHECK/26*0/ 
      DATA IHP6/1,2,3,4,5/
C 
C*********************************************************************
C 
C  GET USERS ANSWERS IN THE SCREEN
C 
C*********************************************************************
C 
      IF(INDIC.EQ.-77) GO TO 3009 
15    IF(ISCRN.GT.8) ITLOG=259
      IF((ISCRN.LT.8).OR.(ISCRN.GE.61)) ITLOG=379 
      IF(ISCRN.EQ.62)ITLOG=227
      IF(.NOT.(GETBK(ILU,KFORM,ITLOG,IMODE))) GO TO 10
C 
C  ERROR IN GETTING ANSWERS REPRINT SCREEN
C 
17    IF((ISCRN.LT.8) .OR. (ISCRN.GE.61)) CALL EXEC(8,ITGP0)
      CALL EXEC(8,ITGP3)
C 
C*********************************************************************
C 
C GO TO ANALYSE USER ANSWERS TO SCREEN # ISCRN
C 
C*********************************************************************
C 
10    CONTINUE
      IF(ISCRN .EQ. 61)GO TO 661
      IF(ISCRN .EQ. 62)GO TO 662
      I=ISCRN-6 
      GO TO (700,800,900,900) I 
C 
C*********************************************************************
C 
C  SCREEN # 6 AND 7 ANSWERS  (SFK'S ASSIGNEMENT)
C 
C*********************************************************************
C 
C 
C    ************************************************************ 
C    *                                                          * 
C    *    IKEY IS A MATRIX DEFINING THE SFK'S  IKEY(26,3)       * 
C    *                                                          * 
C    *       IKEY(I,1) IS FUNCTION # (-1 IF USER TEXT)          * 
C    *       IKEY(I,2) IS KEY TERMINATOR OR NOT (1/0)           * 
C    *       IKEY(I,3) IS PREFIXED FUNCTION # (-1 IF TEXT)      * 
C    *       I IS KEY #                                         * 
C    *                                                          * 
C    ************************************************************ 
C 
C ENTRY POINT FOR SCREENS 6,7 
C 
C  FIRST INITIALIZE IKEY
C 
700   DO 702 I=1,26 
      KCHECK(I)=0 
702   IKEY(I,3)=0 
      IF(ISCRN.EQ.7) GO TO 705
      DO 704 I=1,26 
      DO 704 J=1,2
704   IKEY(I,J)=0 
705   CONTINUE
      IKL=1 
      IKU=10
      GO TO 706 
C 
C ENTRY POINT FOR SCREEN 61 
C 
661   IKL=11
      IKU=20
      GO TO 663 
C 
C ENTRY POINT FOR SCREEN 62 
C 
662   IKL=21
      IKU=26
663   DO 665 II=1,26
         IF(ISCRN.NE.KCHECK(II))GO TO 665 
           IKEY(II,1)=0 
           IKEY(II,2)=0 
           IKEY(II,3)=0 
665   CONTINUE
C 
C  NOW PROCESS USER'S ANSWERS : I IS THE LINE# IN THE TABLE SCREEN
C  IKMAX IS MAX # OF KEYS 
C 
706   NOF=0 
      IBLANK=0
      IKMAX=26
C  SET IKMAX TO 10 IF NO ALPHANUMERIC KEYBOARD WAS SPECIFIED
      IF(IGET1(IFORM,1516).NE.1HX) IKMAX=10 
C 
      I=IKL 
C     +++++++++++++++++++ 
C-----+ BEGIN MAIN LOOP + 
C     +++++++++++++++++++ 
      DO 756 II=IKL,IKU 
C 
C  KEY NUMBER ! 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
C 
C  KEY# IS BLANC : OTHER FIELDS IN THE LINE MUST BE BLANK 
C 
      IF(IFLG.NE.0) GO TO 708 
      IBL=1 
      IF(ISCRN.EQ.7) GO TO 713
      GO TO 711 
C 
C  KEY# IS NOT BLANK CHECK : IF 1<=KEY#<=26 
C                            IF THIS KEY# IS NOT ALREADY USED 
C                            IF PREFIX KEY IS NOT ASSIGNED TWICE
C 
708   IBL=0 
710   IF(IFLG.NE.1) GO TO 781 
      IF((JVAL.LT.1).OR.(JVAL.GT.(IKMAX  ))) GO TO 781
C 
      JVAL2=JVAL
C 
      IF(ISCRN.EQ.7) GO TO 712
      IF(IKEY(JVAL,1).NE.0)GO TO 782
      KCHECK(JVAL)=ISCRN
711   CALL MOVCA(JOUT,1,IFORM,(87+(I-1)*33),2)
      GO TO 715 
712   IF(JVAL.GT.IKU)GO TO 799
      IF(IKEY(JVAL,3).NE.0) GO TO 782 
      IF(IKEY(JVAL,1).EQ.10) GO TO 783
713   CALL MOVCA(JOUT,1,IFORM,(945+(I-1)*33),2) 
C 
C  GET USER TEXT
C 
715   NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,16,IFLG,JVAL1)) GO TO 3000 
      IFLG1=IFLG
      IF((IBL.EQ.1).AND.(IFLG1.NE.0)) GO TO 778 
      IF(ISCRN.NE.7) CALL MOVCA(JOUT,1,IFORM,(89+(I-1)*33),16)
      IF(ISCRN.EQ.7) CALL MOVCA(JOUT,1,IFORM,(947+(I-1)*33),16) 
C 
C  GET OPERATION #  CHECK TEXT OR OPER. # ARE EXCLUSIVE BUT ONE OF
C                   THE TWO MUST BE PRESENT 
C                   SET IKEY VALUE
C 
720   NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL1)) GO TO 3000
      IFLG2=IFLG
      IF(IBL.NE.1) GO TO 725
      IF(IFLG2.NE.0) GO TO 779
      GO TO 740 
725   IF((IFLG1.NE.0).AND.(IFLG2.NE.0)) GO TO 784 
      IF((IFLG1.EQ.0).AND.(IFLG2.EQ.0)) GO TO 785 
      IF(IFLG2.NE.0) GO TO 727
      IF(ISCRN.NE.7) IKEY(JVAL,1)=-1
      IF(ISCRN.EQ.7) IKEY(JVAL,3)=-1
      GO TO 740 
C 
C  CHECK OPERATION VALID ?
C      - OPERATION IS ONE OF VALID MNEMONICS
C      - NEXT ENTRY AND IMAGE VALID ONLY WITH IMAGE 
C      - CONTINUE VALID ONLY IF USER MODULE OR IMAGE
C      - ONE OPERATION CANNOT BE ASSIGNED TWICE 
C 
C  OPERATION NUMBERS DEFINED :
C 
C   OPER. #      MNEMONIC           MEANING 
C 
C        1       *TC*       TRANSACTION COMPLETE
C        2       *RC*       RECALL
C        3       *SV*       SAME VALUE
C        4       *AB*       ABORT/SELECT
C        5       *AD*       ARITH ADD 
C        6       *SU*       ARITH SUBSTRACT 
C        7       *MP*       ARITH MULTIPLY
C        8       *DV*       ARITH DIVIDE
C        9       *EQ*       ARITH EQUAL 
C       10       *PR*       PREFIX
C       11       *CN*       CONTINUE (IMAGE OR USER MODULES ONLY) 
C       12       *NX*       NEXT ENTRY (IMAGE ONLY) 
C       13       *DE*       DELETE ENTRY (IMAGE ONLY) 
C       14       *CS*       COMPLETE/SELECT 
C 
C 
727   JVAL1=-1
      DO 726 K=1,14 
      IF(JOUT.EQ.JK(K)) JVAL1=K 
726   CONTINUE
      IF(JVAL1.EQ.-1) GO TO 786 
      IF((JVAL1.EQ.10) .AND. (JVAL.GT.10)) GO TO 7993 
      IF((JVAL1.EQ.12).AND.(.NOT.ISBIT(ITT,1))) GO TO 787 
      IF((JVAL1.EQ.13).AND.(.NOT.ISBIT(ITT,1))) GO TO 787 
      IF((JVAL1.EQ.11).AND.(.NOT.ISBIT(ITT,0)).AND.(.NOT.ISBIT(ITT,1))) 
     *     GO TO 787
      DO 735 J=1,IKMAX
      DO 735 K=1,3,2
      IF(IKEY(J,K).EQ.JVAL1) GO TO 788
735   CONTINUE
      IF(ISCRN.NE.7) IKEY(JVAL,1)=JVAL1 
      IF(ISCRN.EQ.7) IKEY(JVAL,3)=JVAL1 
C 
C  STORE OPERATION #
C 
740   NOF=NOF-2 
      IF((JOUT.EQ.2HTC.OR.JOUT.EQ.2HCS).AND.JVAL2.GT.10 
     ..AND.IGET1(IFORM,1545).EQ.1HX) GO TO 7992 
      NOF=NOF+2 
C 
      IF(ISCRN.NE.7) CALL MOVCA(JOUT,1,IFORM,(105+(I-1)*33),2)
      IF(ISCRN.EQ.7) CALL MOVCA(JOUT,1,IFORM,(963+(I-1)*33),2)
C 
C  GET TERMINATOR 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL2)) GO TO 3000
      IFLG3=IFLG
      IF((IFLG3.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 791
      IF((IBL.EQ.1).AND.(IFLG3.NE.0)) GO TO 796 
      IF(IBL.EQ.1) GO TO 750
C 
C  CHECKS ON TERMINATOR : FUNCTION (EXCEPT PREFIX) MUST BE TERMINATOR 
C                         A PREFIXED KEY MUST HAVE THE SAME TERMINATOR
C                             AS THE NON PREFIXED 
C 
745   IF((IFLG2.EQ.0).OR.(JVAL1.EQ.10)) GO TO 747 
C    -FCN SPECIFIED, THEREFORE IT MUST BE A TERMINATOR. 
      IF(IFLG3.EQ.0) GO TO 793
      JOUT(1)=2HX 
747   IF((JOUT(1).EQ.2HX ).AND.(JVAL1.EQ.10)) GO TO 790 
      IF(ISCRN.NE.7) GO TO 750
      IF(IKEY(JVAL,1).EQ.0) GO TO 750 
      IF((JOUT(1).EQ.2HX ).AND.(IKEY(JVAL,2).EQ.0)) GO TO 792 
      IF((JOUT(1).EQ.2H  ).AND.(IKEY(JVAL,2).EQ.1)) GO TO 793 
750   IF(ISCRN.NE.7) CALL MOVCA(JOUT,1,IFORM,(107+(I-1)*33),1)
      IF(ISCRN.EQ.7) CALL MOVCA(JOUT,1,IFORM,(965+(I-1)*33),1)
      IF(IBL.EQ.1)  GO TO 753 
      IF((ISCRN.NE.7).AND.(IFLG3.NE.0)) IKEY(JVAL,2)=1
      IF((ISCRN.EQ.7).AND.(IKEY(JVAL,1).NE.0)) GO TO 753
      IF(IFLG3.NE.0) IKEY(JVAL,2)=1 
C 
C  SFK LABEL
C 
753   NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,12,IFLG,JVAL3)) GO TO 3000 
      IF((IBL.EQ.1).AND.(IFLG.NE.0)) GO TO 796
      IF((IFLG2.EQ.0).OR.(IFLG.NE.0)) GO TO 754 
      IP=0
      IF(ISCRN.EQ.7) IP=1 
C 
C  IF NO LABEL FOR A FUNCTION INSERT IT 
C 
      CALL FILAC(I,IP,JVAL1,IFORM)
      GO TO 755 
754   IF(ISCRN.NE.7) CALL MOVCA(JOUT,1,IFORM,(108+(I-1)*33),12) 
      IF(ISCRN.EQ.7) CALL MOVCA(JOUT,1,IFORM,(966+(I-1)*33),12) 
755   I=I+1 
C-----SET IBLANK IF LINE WAS BLANK
      IF(IBL .EQ. 1) IBLANK=1 
756   CONTINUE
C     +++++++++++++++++ 
C-----+ END MAIN LOOP + 
C     +++++++++++++++++ 
C 
C  END OF LINE PER LINE EXAMINATION NOW GENERAL CHECKS :
C      -TRANSACTION COMPLETE MUST BE DEFINED
C      -ABORT/SELECT MUST BE DEFINED
C      -IF ANY ARITHMETIC OPERATOR EQUAL MUST BE DEFINED
C      -IF EQUAL IS SELECTED AT LEAST ONE ARITH. OPERATOR MUST BE SELECTED
C 
      IF(ISCRN.EQ.7)  GO TO 758 
      IF(ISCRN .EQ. 62)GO TO 7569 
C-----DON'T PRINT 61 & 62 IF NO ALPHA KEYBD.
      IF(IGET1(IFORM,1516).EQ.1H ) GO TO 7569 
C-----SEARCH FWD THRU IFORM FOR OTHER DEFINED KEYS. 
      DO 7562 J=I,26
      IF(IGET2(IFORM,87+(I-1)*33).NE.2H  ) GO TO 772
7562  CONTINUE
      IF((IBLANK.EQ.0).AND.(ISCRN.NE.62)) GO TO 772 
C-----SEARCH FOR PREFIX KEY.
7569  DO 757 J=1,IKMAX
      IF(IKEY(J,1).EQ.10) GO TO 773 
757   CONTINUE
758   IFLG=0
      IFLG1=0 
      IFLG2=0 
      DO 760 I=1,IKMAX
      DO 760 J=1,3,2
      IF(IKEY(I,J).EQ.1) IFLG=1 
      IF(IKEY(I,J).EQ.14) IFLG=1
      IF(IKEY(I,J).EQ.4) IFLG2=1
      IF((IKEY(I,J).GT.4).AND.(IKEY(I,J).LT.9)) IFLG1=1 
760   CONTINUE
      IF(IFLG.EQ.0) GO TO 794 
      IF(IFLG2.EQ.0) GO TO 797
      IF(IGET1(IFORM,1545).NE.1HX) GO TO 762
      IFLAG4=0
      DO 761 I=1,IKMAX
      IF(IKEY(I,3).EQ.1.OR.IKEY(I,3).EQ.14) GO TO 7992
      IF(IKEY(I,1).NE.1.AND.IKEY(I,1).NE.14) GO TO 761
      IF(I.GT.10) GO TO 7992
      IFLAG4=IFLAG4+1 
761   CONTINUE
      IF(IFLAG4.EQ.0) GO TO 7992
      IF(IFLAG4.GE.2) GO TO 7991
762   CONTINUE
      DO 763 I=1,IKMAX
      DO 763 J=1,3,2
      IF(IKEY(I,J).EQ.9) GO TO 766
763   CONTINUE
      IF(IFLG1.EQ.0) GO TO 771
      GO TO 795 
766   IF(IFLG1.EQ.0) GO TO 798
C 
C  CALL NEXT SCREEN 
C 
771   ISCRN=9 
      CALL EXEC(8,ITGP3)
C 
772   IF(ISCRN .EQ. 61)ISCRN=62 
      IF(ISCRN .EQ. 6)ISCRN=61
      CALL EXEC(8,ITGP0)
C 
773   ISCRN=7 
1000  CALL EXEC(8,ITGP0)
C 
C  SCREENS 6 & 7 ERROR PROCESSING 
C 
778   NOF=NOF-1 
      GO TO 780 
779   NOF=NOF-2 
C 
C KEY # NOT GIVEN 
C 
780   CALL MES02(2,NOF) 
      GO TO 15
C 
C ILLEGAL KEY NUMBER
C 
781   CALL MES02(3,NOF) 
      GO TO 15
C 
C KEY ALREADY ASSIGNED
C 
782   CALL MES02(4,NOF) 
      GO TO 15
C 
C PREFIX KEY CANNOT BE ASSIGNED TWICE 
C 
783   CALL MES02(5,NOF) 
      GO TO 15
C 
C A KEY CANNOT BE ASSIGNED A VALUE AND A FUNCTION SIMULTANEOUSLY
C 
784   NOF=NOF-1 
      CALL MES02(6,NOF) 
      GO TO 15
C 
C NO VALUE OR FUNCTION ASSIGNED TO THIS KEY 
C 
785   NOF=NOF-1 
      CALL MES02(7,NOF) 
      GO TO 15
C 
C UNKNOWN FUNCTION
C 
786   CALL MES02(8,NOF) 
      GO TO 15
C 
C ILLEGAL FUNCTION FOR THIS TYPE OF TRANSACTION 
C 
787   CALL MES02(9,NOF) 
      GO TO 15
C 
C FUNCTION ALREADY SELECTED 
C 
788   CALL MES02(10,NOF)
      GO TO 15
C 
C THIS KEY CANNOT BE TERMINATOR 
C 
790   CALL MES02(11,NOF)
      GO TO 15
C 
C FIELD MUST BE BLANK OR X
C 
791   CALL MES02(12,NOF)
      GO TO 15
C 
C THIS KEY CANNOT BE TERMINATOR ANY MORE
C 
792   CALL MES02(13,NOF)
      GO TO 15
C 
C THIS KEY MUST BE TERMINATOR 
C 
793   CALL MES02(14,NOF)
      GO TO 15
C 
C     "TC OR CA MUST BE DEFINED"
C 
794   CALL MES02(15,1)
      GO TO 15
C 
C EQUAL FUNCTION NOT DEFINED
C 
795   CALL MES02(16,1)
      GO TO 15
C 
C FIELD MUST BE BLANK 
C 
796   CALL MES02(20,NOF)
      GO TO 15
C 
C TRANSACTION COMPLETE FUNCTION NOT DEFINED 
C 
797   CALL MES02(21,1)
      GO TO 15
C 
C NO ARITHMETIC FUNCTION DEFINED WITH EQUAL 
C 
798   CALL MES02(22,1)
      GO TO 15
C 
C ONLY KEYS 1 - 10 MAY BE PREFIXED
C 
799   CALL MES02(23,NOF)
      GO TO 15
C 
C AUTO COMP ALLOWS ONLY ONE OF TC AND CA
C 
7991  CALL MES02(24,NOF)
      GO TO 15
C 
C ONE OF KEYS 1-10 MUST BE TC/CA FOR AUTO COMPLETE
C 
7992  CALL MES02(25,NOF)
      GO TO 15
C 
C PREFIX KEY MUST BE 1-10 
C 
7993  CALL MES02(26,NOF)
      GO TO 15
C 
C*********************************************************************
C 
C  SCREEN OLD # 8 (DOES NOT EXIST)
C 
C*********************************************************************
C 
800   STOP 700
C 
C********************************************************************** 
C 
C  SCREEN # 8 AND 9   (QUESTION LABELS) 
C 
C*********************************************************************
C 
900   I=0 
      IUMA1=IUMAX 
      IMMA1=IMMAX 
      IF(ISCRN.EQ.10) GO TO 902 
      N=1 
      IMX=IUMAX+1 
      GO TO 904 
902   N=IUMAX+1 
      IMX=IUMAX+IMMAX+1 
C 
904   NOFX=0
      DO 920 NOF=1,20 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,12,IFLG,JVAL)) GO TO 3000
C 
C  QUESTION LABEL IN I:O BUFFER 
C 
      IF(IFLG.EQ.0) GO TO 910 
      IF(N.LT.IMX) GO TO 906
      IF(IUMAX+IMMAX.GE.20) GO TO 925 
      CALL MOVEW(IFORM(638+(N-1)*6),IFORM(638+N*6),(N-20)*6)
      CALL MOVEW(JFORM(1+(N-1)*JWORDS),JFORM(1+N*JWORDS),(N-20)*JWORDS) 
      CALL BLAN(JFORM,1+(N-1)*JBYTES,JBYTES)
      JFORM(66+(N-1)*JWORDS)=0
      IMX=IMX+1 
      IF(ISCRN.EQ.9) IUMAX=IUMAX+1
      IF(ISCRN.EQ.10) IMMAX=IMMAX+1 
906   CALL MOVEW(JOUT,IFORM(638+(N-1)*6),6) 
      GO TO 919 
C 
C  INSERT A NEW QUESTION BEFORE PENDING 
C 
901   IF(IUMAX+IMMAX.GE.20) GO TO 925 
      CALL MOVEW(IFORM(638+(N-1)*6),IFORM(638+N*6),(N-20)*6)
      CALL MOVEW(JFORM(1+(N-1)*JWORDS),JFORM(1+N*JWORDS),(N-20)*JWORDS) 
      CALL BLAN(IFORM,1275+(N-1)*12,12) 
      CALL BLAN(JFORM,1+(N-1)*JBYTES,JBYTES)
      JFORM(66+(N-1)*JWORDS)=0
      IMX=IMX+1 
      IF(ISCRN.EQ.9) IUMAX=IUMAX+1
      IF(ISCRN.EQ.10) IMMAX=IMMAX+1 
      I=1 
      IF((ISCRN.EQ.9).AND.(NOF.GT.IUMA1)) GO TO 919 
      IF((ISCRN.EQ.10).AND.(NOF.GT.IMMA1)) GO TO 919
      N=N+1 
      GO TO 919 
C 
C  BLANC IN I:O BUFFER
C 
910   IF((ISCRN.EQ.9).AND.(NOF.GT.IUMA1)) GO TO 920 
      IF((ISCRN.EQ.10).AND.(NOF.GT.IMMA1)) GO TO 920
      CALL MOVEW(IFORM(638+N*6),IFORM(638+(N-1)*6),(20-N)*6)
      CALL MOVEW(JFORM(1+N*JWORDS),JFORM(1+(N-1)*JWORDS),(20-N)*JWORDS) 
      IMX=IMX-1 
      IF(ISCRN.EQ.9) IUMAX=IUMAX-1
      IF(ISCRN.EQ.10) IMMAX=IMMAX-1 
      GO TO 920 
C 
919   N=N+1 
920   CONTINUE
C 
C 
      IF(ISCRN.EQ.9) GO TO 8007 
      IF(IUMAX+IMMAX.EQ.0) GO TO 935
      IF(IUMAX+IMMAX.GE.20) GO TO 8007
      DO 8000 J=638+(IUMAX+IMMAX)*6,757 
8000  IFORM(J)=2H 
      DO 8002 J=1+(IUMAX+IMMAX)*JWORDS,1700 
8002  JFORM(J)=2H 
      DO 8004 J=IUMAX+IMMAX,19
8004  JFORM(66+J*JWORDS)=0
C 
8007  IF(ISCRN.EQ.10) GO TO 8008
      ISCRN=10
      IF(I.NE.0) ISCRN=9
      GO TO 1002
8008  ISCRN=11
      IF(I.NE.0) ISCRN=10 
C 
C 
C  CALL NEXT SCREEN 
C 
1002  CONTINUE
      CALL EXEC(8,ITGP3)
C 
C   ERROR SECTION SCREENS 9 AND 10
C 
925   CALL MES02(17,NOF)
      GO TO 15
935   CALL MES02(19,1)
      GO TO 15
C 
C*********************************************************************
C 
C  2645 SOFTWARE FUNCTION KEY PROCESSING
C 
C*********************************************************************
C 
C 
C  IFLG=5 MEANS NON PRINTABLE ASCII 
C 
3000  IF((ISCRN.NE.9).AND.(ISCRN.NE.10)) GO TO 3001 
C     -INSERT A QUESTION? 
      IF(IFLG.NE.4) GO TO 3001
C     -YES.  SAVE FIELD #.
      NOFX=NOF
      GO TO 901 
3001  IF(IFLG.EQ.4) IFLG=5
      IF(IFLG.NE.5) GO TO 3005
      CALL MES02(1,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
3009  INDIC=0 
      IF(ISCRN.NE.6 .AND. ISCRN.NE.61 .AND. ISCRN.NE.62 
     .  .AND. ISCRN.NE.7) GO TO 30091 
      CALL HLP02(MOD(NOF-1,5)+1,NOF)
      GO TO 15
30091 CALL HLP02(6,NOF) 
      GO TO 15
C 
C  IFLG=8 MEANS LAST SCREEN 
C 
3010  IF(IFLG.NE.8) GO TO 3020
        ISCRN=ISCRN-1 
        IF(ISCRN .LT. 60)GO TO 3011 
          IF(ISCRN .GE. 60)ISCRN=6
          CALL EXEC(8,ITGP0)
C 
C    -GO BACK TO SCR 41 IF ISCRN=8 & TIME REPORTING TRANSACTION 
C 
 3011 IF(ISCRN.NE.8) GO TO 3015 
      IF(.NOT.ISBIT(ITT,10)) GO TO 3015 
      ISCRN=41
3015  IF(ISCRN .EQ. 8)ISCRN=6 
      IF(ISCRN .EQ. 5)ISCRN=41
      IF(ISCRN .LE. 7)CALL EXEC(8,ITGP0)
      CALL EXEC(8,ITGP3)
C 
C  ABORT PROGRAM
C 
3020  IF(.NOT.OKABT(ILU)) GO TO 17
      INDIC=99
      CALL EXEC(8,KNAM) 
C 
C 
C  END OF SEGMENT 
C 
      CALL TGP
C 
C 
      END 
      END$
                                    