FTN4
      PROGRAM TGP1(5), 92903-16352 REV.1913  790126 1030
C 
C     SOURCE 92903-18352
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     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 0,1,2     *
C*   3,4, 41, AND 5 .                                                     * 
C*            THE ANSWERS AFTER A CHECK ARE STORED IN IFORM.         *
C*                                                                   *
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 TGP11 AN ERROR HAS OCCURED IN    *
C*                   OPENING THE DATA BASE REGET SCREEN #3           *
C*             = 1 : WHEN COMING FROM TGP10 . A TRANSACTION SPEC     *
C*                   HAS BEEN READ (MODE L OR M) BUT AN ERROR        *
C*                   OCURED DURING READ . ISKIP CONTAINS ERROR CODE  *
C*                   SET INDIC TO 4 AND REPRINT SCREEN # 3 .         *
C*             = 2 : WHEN COMING FROM TGP11 . A DATA BASE HAS BEEN   *
C*                   SUCCESSFULLY OPENED GO TO PRINT SCREEN # 5 .    *
C*             = 3 : WHEN COMING FROM TGP10 . A TRANSACTION SPEC     *
C*                   HAS BEEN SUCCESFULLY READ .                     *
C*             = 4 : SEE INDIC=1 AFTER PRINTING SCREEN 3 THE ISKIP   *
C*                   ERROR MESSAGE IS PRINTED .                      *
C*             =-77  A HELP MESSAGE MUST BE PRINTED                  *
C*             = 99  ABORT TGP                                       *
C*                                                                   *
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 ITGP0(3),ITGP10(3),ITGP11(3),ITGP13(3),ITGP3(3) 
      DIMENSION JOUT(10),IFN(9),MNAM(3) 
      DIMENSION IHP3(6),IHP4(6),IHP41(7),IRSET(8) 
      DIMENSION NOMON(10),IERROR(6) 
C 
      EQUIVALENCE(NOF,KFORM(531)) 
C 
      LOGICAL JPAR,ISBTW,GETBK,OKABT,ISBIT
C 
C  DATA VALUES :
C 
      DATA JBYTES/140/
      DATA JWORDS/70/ 
      DATA ITGP0/2HTG,2HP0,2H  /
      DATA ITGP10/2HTG,2HPI,2H0 / 
      DATA ITGP11/2HTG,2HPI,2H1 / 
      DATA ITGP13/2HTG,2HPI,2H3 / 
      DATA ITGP3/2HTG,2HP3,2H  /
      DATA MNAM/2HDC,2HMO,2HN / 
      DATA IFN/5,6,7,8,9,4,2,3,1/ 
      DATA IHP3/0,2,7,3,4,5/
      DATA IHP4/1,6,7,8,9,10/ 
      DATA IHP41/1,6,7,0,8,9,10/
      DATA IRSET/15530B,15555B,15446B,2Hk0,2HB ,15542B,15510B,15512B/ 
      DATA NOMON/2H'D,2HCM,2HON,2H' ,2HNO,2HT ,2HPR,2HES,2HEN,2HT / 
      DATA IERROR/2HER,2HRO,2HR ,2H  ,2H  ,2H  /
C 
C*********************************************************************
C 
C  ACCORDING TO INDIC VALUE GO TO THE REQUIRED PORTION OF TGP1
C 
C*********************************************************************
      IF(INDIC.NE.1) GO TO 20 
      INDIC=0 
      GO TO 227 
20    IF(INDIC.NE.2) GO TO 25 
      INDIC=0 
      GO TO 526 
25    IF(INDIC.NE.3) GO TO 30 
      INDIC=0 
      GO TO 222 
30    IF(INDIC.NE.4) GO TO 35 
      INDIC=0 
      GO TO 230 
35    IF(INDIC.NE.-77) GO TO 40 
      INDIC=0 
      GO TO 3062
40    IF(INDIC.EQ.99) GO TO 990 
C 
C 
C*********************************************************************
C 
C  INDIC = 0   GET THE ANSWERS IN THE SCREEN
C 
C*********************************************************************
C 
15    IF(ISBTW(ISCRN,3,4)) ITLOG=2
      IF(ISCRN.EQ.3) ITLOG=36 
      IF(ISCRN.EQ.4) ITLOG=34 
      IF(ISCRN.EQ.41) ITLOG=22
      IF(.NOT.(GETBK(ILU,KFORM,ITLOG))) GO TO 10
C 
C  ERROR IN GETTING ANSWERS REPRINT SCREEN
C 
17    CALL EXEC(8,ITGP0)
C 
C*********************************************************************
C 
C GO TO ANALYSE USER ANSWERS TO SCREEN # ISCRN
C 
C*********************************************************************
C 
10    IF(ISCRN.EQ.41) GO TO 4100
      GO TO (100,400,200,500,600) ISCRN 
C 
C*********************************************************************
C 
C  SCREEN # 0 ANSWERS  (EXPLANATORY SCREEN) 
C 
C*********************************************************************
C 
100   IF(ISCRN.EQ.1) GO TO 300
      NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      ISCRN=3 
      CALL EXEC(8,ITGP0)
C 
C*********************************************************************
C 
C  SCREEN # 3 ANSWERS (MODE OF OPERATION) 
C 
C*********************************************************************
C 
C  MODE OF OPERATION
C 
200   NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      JVAL1=-1
      IF(JOUT.EQ.2HC ) JVAL1=1
      IF(JOUT.EQ.2HM ) JVAL1=2
      IF(JOUT.EQ.2HL ) JVAL1=3
      IF(JOUT.EQ.2HB ) JVAL1=4
      IF(JOUT.NE.2HE ) GO TO 203
        ISCRN=1 
        CALL EXEC(8,ITGP0)
203   IF(JVAL1.EQ.-1) GO TO 250 
      CALL MOVCA(JOUT,1,IFORM,13,1) 
      IF(JVAL1.EQ.1) IUMAX=0
      IF(JVAL1.EQ.1) IMMAX=0
      IF(JVAL1.EQ.2) CALL BLANC(LFORM(22),15) 
C 
C   TRANSACTION SPEC NAME OR #
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((ISBTW(JVAL1,2,3)).AND.(IFLG.NE.0)) GO TO 260
      IF(.NOT.(ISBTW(JVAL1,2,3)).AND.(IFLG.EQ.0)) GO TO 580 
      IF(IFLG.EQ.0) GO TO 207 
      IF(IFLG.NE.1) GO TO 205 
      IF((JVAL.LT.1).OR.(JVAL.GT.9999)) GO TO 550 
      GO TO 207 
205   IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 265
207   CALL MOVEW(JOUT,IFORM(8),3) 
C 
C   TRANSACTION SPEC SECURITY CODE
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((ISBTW(JVAL1,2,3)).AND.(IFLG.NE.0)) GO TO 260
      IF(.NOT.(ISBTW(JVAL1,2,3)).AND.(IFLG.GT.1)) GO TO 555 
      IF(JVAL.EQ.-32768) GO TO 555
      CALL MOVEW(JOUT,IFORM(11),3)
C 
C  FILE NAME
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((ISBTW(JVAL1,2,3)).AND.(IFLG.NE.0)) GO TO 260
      IF(.NOT.(ISBTW(JVAL1,2,3)).AND.(IFLG.EQ.0)) GO TO 262 
      CALL MOVEW(JOUT,IFORM(14),3)
C 
C  CARTRIDGE #
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF(ISBTW(JVAL1,2,3).AND.(IFLG.NE.0)) GO TO 260
      IF(IFLG.GT.1) GO TO 264 
      IF(JVAL.EQ.-32768) GO TO 264
      CALL MOVEW(JOUT,IFORM(17),3)
C 
C  LIST FILE NAME 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF((JVAL1.NE.3).AND.(IFLG.NE.0)) GO TO 260
      IF(JVAL1.NE.3) GO TO 209
C 
C  DEFAULT LIST FILE IS INTERACTIVE LU
C 
      IF(IFLG.NE.0) GO TO 210 
      ISKIP=ILU 
      GO TO 209 
C 
C  A LIST FILE NAME HAS BEEN GIVEN CHECK FILE EXIST ,IS TYPE 0
C  GET THE LU # IN THE IDCB . 
C 
210   IF(OPEN(KFORM,ISTAT,JOUT).LT.0) GO TO 212 
      IF(ISTAT.NE.0) GO TO 211
      ISKIP=KFORM(4)
      CALL CLOSE(KFORM) 
      GO TO 209 
C 
C FILE TYPE IS NOT 0
C 
211   IMES=4
      CALL CLOSE(KFORM) 
      GO TO 232 
C 
C  ERROR IN OPENING THE FILE
C 
212   IMES=0
      IF(ISTAT.EQ.-6) IMES=20 
      IF(IMES.EQ.0) CALL JASC(ISTAT,JOUT,1,6) 
      GO TO 232 
C 
209   CALL MOVEW(JOUT,IFORM(20),3)
C 
C  IF MODE OF OPERATION IS "B" PRINT SCREEN 19
C 
      IF(JVAL1.NE.4) GO TO 199
      CALL BLANC(ILIBR,61)
      ISCRN=20
      INDIC=0 
      CALL EXEC(8,ITGP3)
C 
C  IF MODE OF OPERATION IS "L" OR "M" GO TO READ FORM 
C 
199   IF(JVAL1.GT.1) GO TO 225
C 
C  HERE POINT OF RETURN FORM TGP10 IF MODE OF OP. WAS L OR M
C  TRANS. SPEC HAS BEEN READ
C 
222   JVAL=IGET1(IFORM,13)
D     GO TO 224 
C-----IF "M", BLANK THE LIBRARY HEADER
      IF(JVAL.EQ.2HM ) CALL BLAN(LFORM,43,30) 
C 
C   IF MODE OF OPERATION IS "L" GO TO PRINT SPECS 
C 
      IF((JVAL.EQ.2HM ).OR.(JVAL.EQ.2HC )) GO TO 223
      INDIC=4278
      CALL EXEC(8,ITGP13) 
C 
C  IF MODE OF OPERATION IS "C" OR "M" INITIALISE BUFFERS
C 
223   CALL NUL(ILITE,14)
      CALL NUL(IMAI,225)
      IMFLG=0 
      IMAS=0
      IMDT=0
      IMKY=0
      CALL NUL(IKEY,78) 
      KFORM(1060)=0 
C 
C  INITIALISE SOURCE BUFFERS ONLY FOR CREATE
C 
      CALL BLANC(ILIBR,61)
      IF(JVAL.NE.2HC ) GO TO 224
      INDIC=0 
      DO 706 I=21,766 
706   IFORM(I)=2H 
      CALL BLANC(JFORM,1400)
      CALL BLANC(LFORM,39)
      CALL BLANC(MFORM,16)
      DO 714 I=1,20 
714   JFORM(66+(I-1)*JWORDS)=0
C 
C  INITIALISE SFK'S TO THE DEFAULT SET
C 
C  KEY #
C 
      IFORM(44)=2H1 
      IFORM(60)=2H 2
      IFORM(77)=2H3 
      IFORM(93)=2H 4
      IFORM(110)=2H5
      IFORM(126)=2H 6 
      IFORM(143)=2H7
      IFORM(159)=2H 8 
      IFORM(176)=2H9
C 
C  FUNCTION # AND TERMINATOR
C 
      IFORM(53)=2HAD
      IFORM(54)=2HX 
      IFORM(69)=2H S
      IFORM(70)=2HUX
      IFORM(86)=2HMP
      IFORM(87)=2HX 
      IFORM(102)=2H D 
      IFORM(103)=2HVX 
      IFORM(119)=2HEQ 
      IFORM(120)=2HX
      IFORM(135)=2H A 
      IFORM(136)=2HBX 
      IFORM(152)=2HRC 
      IFORM(153)=2HX
      IFORM(168)=2H S 
      IFORM(169)=2HVX 
      IFORM(185)=2HTC 
      IFORM(186)=2HX
C 
C  SFK'S LABELS 
C 
      DO 720 I=1,9
      CALL FILAB(I,0,IFN(I),IFORM)
720   CONTINUE
C 
C  CALL NEXT SCREEN 
C 
224   ISCRN=4 
      CALL EXEC(8,ITGP0)
C 
C  GO TO READ FORM
C 
225   CALL EXEC(8,ITGP10) 
C 
C  RETURN FROM TGP10  AN ERROR HAS OCCURED IN READING SPEC REPRINT
C  SCREEN 3 SET INDIC TO 4 TO PRINT LATER THE ERROR . 
C 
227   ISCRN=3 
      INDIC=4 
      CALL EXEC(8,ITGP0)
C 
C   ERRORS ON READING FORM
C 
230   IMES=0
      IF(ISKIP.EQ.1) IMES=15
      IF(ISKIP.EQ.2) IMES=16
      IF(ISKIP.EQ.5) IMES=17
      IF(ISKIP.EQ.6) IMES=18
      IF(ISKIP.EQ.-6) IMES=20 
      IF(ISKIP.EQ.7) IMES=21
      IF(ISKIP.EQ.8) IMES=24
      NOF=2 
      IF((IMES.NE.15).AND.(IMES.NE.17)) GO TO 231 
      NOF=4 
231   IF(IMES.EQ.20) NOF=4
      IF(IMES.EQ.21) NOF=3
      IF(IMES.NE.0) GO TO 232 
      IMES=19 
      CALL JASC(ISKIP,JOUT,1,6) 
232   CALL MES01(IMES,NOF,JOUT) 
      GO TO 15
C 
C  ERROR PROCESSING SCREEN # 3
C 
250   CALL MES01(1,NOF) 
      GO TO 15
260   CALL MES01(10,NOF)
      GO TO 15
261   CALL MES01(11,NOF)
      GO TO 15
262   CALL MES01(12,NOF)
      GO TO 15
263   CALL MES01(13,NOF-1)
      GO TO 15
264   CALL MES01(14,NOF)
      GO TO 15
265   CALL MES01(22,NOF)
      GO TO 15
C 
C*********************************************************************
C 
C  SCREEN # 1 ANSWERS (EXPLANATORY SCREEN)
C 
C*********************************************************************
C 
300   NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      ISCRN=2 
      CALL EXEC(8,ITGP0)
C 
C*********************************************************************
C 
C  SCREEN # 2 ANSWERS  (EXPLANATORY SCREEN) 
C 
C********************************************************************** 
C 
400   NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      ISCRN=5 
      CALL EXEC(8,ITGP0)
C 
C*********************************************************************
C 
C  SCREEN # 4 ANSWERS (TRANS. IDENTIFICATION AND TYPE)
C 
C********************************************************************** 
C 
C 
C  SPECS NAME 
C 
500   NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.EQ.0) GO TO 580 
      IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 265
      CALL MOVEW(JOUT,IFORM(29),3)
C 
C  SPECS NUMBER 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,4,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.EQ.0) GO TO 550 
      IF(IFLG.NE.1) GO TO 550 
      IF((JVAL.LT.1).OR.(JVAL.GT.9999)) GO TO 550 
502   CALL MOVEW(JOUT,IFORM(32),2)
C 
C SPECS SECURITY CODE 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.GT.1) GO TO 555 
      IF(JVAL.EQ.-32768) GO TO 555
      CALL MOVEW(JOUT,IFORM(34),3)
      ITT=0 
C 
C-----LOGGING?
C 
510   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 585 
      CALL MOVCA(JOUT,1,IFORM,74,1) 
      IF(JOUT.EQ.2HX ) CALL SETBT(ITT,2,1)
C 
C  USER WRITTEN MODULES ? 
C 
520   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 585 
      IF(JOUT(1).EQ.2HX ) CALL SETBT(ITT,0,1) 
      CALL MOVCA(JOUT,1,IFORM,73,1) 
C 
C  DATA BASE NAME 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,5,IFLG,JVAL)) GO TO 3000 
      IF((IFLG.NE.0).AND.(NIMAG.EQ.1)) GO TO 586
      IF(IFLG.NE.0) CALL SETBT(ITT,1,1) 
      CALL MOVCA(JOUT,1,IFORM,75,5) 
      IFORM(40)=IAND(IFORM(40),177400B) 
      IFORM(40)=IFORM(40)+40B 
C 
C  DATA BASE SECURITY CODE
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,5,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.EQ.0) GO TO 525 
      IF(IFLG.NE.1) GO TO 570 
      IF(JVAL.LT.1) GO TO 570 
525   IF(ISBIT(ITT,1)) GO TO 5250 
           IF(IFLG.NE.0) GO TO 260
           GO TO 5255 
5250  IF(IFLG.NE.1) GO TO 570 
5255  CALL MOVCA(JOUT,1,IFORM,81,5) 
C 
C  IF DATA BASE ACESSED GO TO TGP11 TO OPEN IT ISKIP=D.B. SEC. CODE 
C 
      IF(.NOT.ISBIT(ITT,1)) GO TO 526 
      ISKIP=JVAL
      INDIC=0 
      CALL EXEC(8,ITGP11) 
C 
C  RETURN FROM TGP11 : DATA BASE SUCCESFULY OPENED
C 
C 
C   PRINT SCREEN # 41 
C 
526   ISCRN=41
      CALL EXEC(8,ITGP3)
C 
C  SCREEN # 4 ERROR PROCESSING
C 
550   CALL MES01(2,NOF) 
      GO TO 15
555   CALL MES01(3,NOF) 
      GO TO 15
570   CALL MES01(6,NOF) 
      GO TO 15
580   CALL MES01(7,NOF) 
      GO TO 15
585   CALL MES01(9,NOF) 
      GO TO 15
586   CALL MES01(5,NOF) 
      GO TO 15
C 
C*********************************************************************
C 
C     SCREEN # 41 : DATA CAPTURE TERMINAL FEATURE SPECIFICATIONS
C 
C*********************************************************************
C 
C-----STRIP PRINTER 
C 
4100  NOF=1 
C     FIRST CLEAR BITS 3,4,5,6,7 IN ITT 
      ITT=IAND(ITT,177407B) 
      NOPTN=0 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(JOUT(1) .NE. 1H  .AND. JOUT(1) .NE. 1HX)GO TO 4110 
      IF(JOUT(1) .EQ. 1HX)NOPTN=NOPTN+1 
      IF(JOUT.EQ.1HX) CALL SETBT(ITT,3,1) 
      CALL MOVCA(JOUT,1,IFORM,1515,1) 
C 
C-----ERROR LABEL 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,12,IFL1,JVAL)) GO TO 3000
      IF(IFLG .EQ. 0 .AND. IFL1 .NE. 0)GO TO 4111 
      CALL MOVCA(JOUT,1,IFORM,1520,12)
      IF((IFL1.EQ.0) .AND. (IFLG.NE.0)) 
     *   CALL MOVCA(IERROR,1,IFORM,1520,12) 
C 
C-----ALPHA KEYBOARD
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(JOUT(1) .NE. 1H  .AND. JOUT(1) .NE. 1HX)GO TO 4110 
      CALL MOVCA(JOUT,1,IFORM,1516,1) 
      IF(JOUT.EQ.1HX) CALL SETBT(ITT,6,1) 
C 
C-----ALPHA DISPLAY 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(JOUT(1) .NE. 1H  .AND. JOUT(1) .NE. 1HX)GO TO 4110 
      CALL MOVCA(JOUT,1,IFORM,1517,1) 
      IF(JOUT.EQ.1HX) CALL SETBT(ITT,7,1) 
C 
C-----CARD READER/TYPE III BADGE
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(JOUT(1) .NE. 1H  .AND. JOUT(1) .NE. 1HX)GO TO 4110 
      IF(JOUT(1) .EQ. 1HX)NOPTN=NOPTN+1 
      CALL MOVCA(JOUT,1,IFORM,1518,1) 
      IF(JOUT.EQ.1HX) CALL SETBT(ITT,4,1) 
C 
C-----TYPE V BADGE
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(JOUT(1) .NE. 1H  .AND. JOUT(1) .NE. 1HX)GO TO 4110 
      IF(JOUT(1) .EQ. 1HX .AND. NOPTN .EQ. 2)GO TO 4112 
      CALL MOVCA(JOUT,1,IFORM,1519,1) 
      IF(JOUT.EQ.1HX) CALL SETBT(ITT,5,1) 
C 
C-----PRINT SCREEN # 5
C 
      ISCRN=6 
      CALL EXEC(8,ITGP0)
C 
C  SCREEN #41 ERROR PROCESSING
C 
C 
C     "FIELD MUST BE BLANK OR X"
C 
4110  CALL MES01(9,NOF) 
      GO TO 15
C 
C     "FIELD MUST BE BLANK" 
C 
4111  CALL MES01(10,NOF)
      GO TO 15
C 
C     "ONLY 2 OF THE "#" ITEMS MAY BE SPECIFIED"
C 
4112  CALL MES01(23,1)
      GO TO 15
C 
C 
C*********************************************************************
C 
C  SCREEN # 5 ANSWERS  (EXPLANATORY SCREEN) 
C 
C*********************************************************************
C 
600   NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      ISCRN=3 
      CALL EXEC(8,ITGP0)
C 
C***********************************************************************
C 
C  CALL NEXT SCREEN 
C 
1000  CALL EXEC(8,ITGP0)
C 
C*********************************************************************
C 
C 
C*********************************************************************
C 
C  2645 SOFT FUNCTION KEY PROCESSING
C 
C*********************************************************************
C 
C  IFLG=5 MEANS NON PRINTABLE ASCII 
C 
3000  IF(IFLG.EQ.4) IFLG=5
      IF(IFLG.NE.5) GO TO 3007
      CALL MES01(8,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
      IF((ISCRN.GT.2).AND.(ISCRN.NE.5)) GO TO 3061
3006  JOUT=20040B 
      JOUT(2)=15542B
      CALL EXEC(2,ILU,JOUT,2) 
      GO TO 15
3061  INDIC=-77 
      GO TO 17
3062  IF(ISCRN.EQ.4) GO TO 3050 
      IMES=IHP3(NOF)
      GO TO 3060
3050  IMES=IHP4(NOF)
      IF(IMODB.EQ.1) IMES=IHP41(NOF)
3060  CALL HLP01(IMES,NOF)
      GO TO 15
C 
C  IFLG=8 MEANS LAST SCREEN 
C 
3010  IF(IFLG.NE.8)                  GO TO 3017 
      IF(ISCRN.EQ.0)                 GO TO 3015 
      IF(ISCRN.EQ.1 .OR. ISCRN.EQ.4) GO TO 3011 
      IF(ISCRN.EQ.2)                 GO TO 3012 
      IF(ISCRN.EQ.3)                 GO TO 30121
      IF(ISCRN.EQ.41)                GO TO 3013 
      IF(ISCRN.EQ.5)                 GO TO 3014 
      GO TO 3015
3011  ISCRN=3 
      GO TO 3015
3012  ISCRN=ISCRN-1 
      GO TO 3015
30121 ISCRN=0 
      GO TO 3015
3013  ISCRN=4 
      IF(ISBIT(ITT,1)) CALL DBCLS(0,ISTAT)
      GO TO 3015
3014  ISCRN=2 
      GO TO 3015
3015  CALL EXEC(8,ITGP0)
C 
C-----ABORT KEY PRESSED?
C 
3017  IF(OKABT(ILU)) GO TO 990
C-----NO, RESCHEDULE TGP0.
      CALL EXEC(8,ITGP0)
C-----YES, ABORT PROGRAM
C-----WAS A DATA BASE USED? 
990   IF(.NOT.ISBIT(ITT,1)) GO TO 992 
C-----YES, (IE, TRANS. TYPE 2 OR 3) CLOSE DATA BASE 
      CALL DBCLS(0,ISTAT) 
C-----RESET TERMINAL. 
992   CALL EXEC(2,ILU,IRSET,8)
C-----RE-SCHEDULE 'DCMON' 
      CALL EXEC(100000B+24,MNAM,ILU)
      GO TO 995 
993   GO TO 999 
C-----"DCMON NOT PRESENT" 
995   CALL EXEC(2,ILU,NOMON,10) 
      GO TO 999 
C-----END OF SEGMENT
996   CALL TGP
999   END 
      END$