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$