FTN4
      PROGRAM TGP2(5), 92903-16355 REV.1913  790125 1030
C 
C     SOURCE 92903-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(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 INAM(3),JNAM(3),KNAM(3) 
      DIMENSION JOUT(10),JK(14),KCHECK(26)
C 
      EQUIVALENCE (NOF,KFORM(531))
C 
      LOGICAL JPAR,GETBK,OKABT,ISBIT
C 
C 
C  DATA VALUES :
C 
      DATA JBYTES/140/
      DATA JWORDS/70/ 
      DATA INAM/2HTG,2HP0,2H  / 
      DATA JNAM/2HTG,2HP3,2H  / 
      DATA KNAM/2HTG,2HP1 ,2H  /
      DATA JK/2HTC,2HRC,2HSV,2HAB,2HAD,2HSU,2HMP,2HDV,2HEQ,2HPR,2HCN, 
     C2HNX,2HDE,2HCA/ 
      DATA KCHECK/26*0/ 
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))) GO TO 10
C 
C  ERROR IN GETTING ANSWERS REPRINT SCREEN
C 
17    IF((ISCRN.LT.8) .OR. (ISCRN.GE.61)) CALL EXEC(8,INAM) 
      CALL EXEC(8,JNAM) 
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
      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
      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       *CA*       COMPLETE/ABORT
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.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   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 FILAB(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
      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,JNAM) 
C 
772   IF(ISCRN .EQ. 61)ISCRN=62 
      IF(ISCRN .EQ. 6)ISCRN=61
      CALL EXEC(8,INAM) 
C 
773   ISCRN=7 
1000  CALL EXEC(8,INAM) 
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*********************************************************************
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   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,1400 
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,JNAM) 
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 
      IF(IFLG.EQ.4) 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 
      CALL HLP02(0,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,INAM) 
3011  IF(ISCRN .EQ. 8)ISCRN=6 
      IF(ISCRN .EQ. 5)ISCRN=41
      IF(ISCRN .LE. 7)CALL EXEC(8,INAM) 
      CALL EXEC(8,JNAM) 
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$