FTN4
      PROGRAM TGP9(5), 92903-16370 REV.1913  790119 0915
C 
C     SOURCE 92903-18370
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 SCREEN # 10 & 91.
C*            THE ANSWERS AFTER A CHECK ARE STORED IN JFORM.         *
C*                                                                   *
C*    IF :  INDIC = 0  : ANALYSE SCREEN # 10 . NORMAL PATH .         *
C*                       OR AN ERROR HAS BEEN DETECTED IN TGP12      *
C*                       (IMAGE PROCESSING)                          *
C*                  1  : ANALYZE SCREEN # 91                         *
C*                  3  : RETURN FROM TGP12 IMAGE OPERATION (ADD,     *
C*                       UPDATE, CHECK EXISTENCE,FIND HAS BEEN       *
C*                       SUCCESSFULLY PROCESSED .                    *
C*                -77  : A HELP MESSAGE MUST BE PRINTED              *
C*                                                                   *
C*   WARNING !! * PRINTED SCREEN 10 CORRESPONDS TO ISCRN = 11        *
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 ITGP3(3)
      DIMENSION JOUT(10),ITGP4(3),ITGP12(3),ITGP1(3)
      DIMENSION IHP0(3),IHP1(5),IHP2(7),IHPB0(5),IHPB1(7),IHPB2(9)
      LOGICAL JPAR,RNUM,ISBIT,GETBK,OKABT 
C 
      EQUIVALENCE(JVAL1,KFORM(1000)),(JVAL3,KFORM(1001))
      EQUIVALENCE(JVAL4,KFORM(1002))
      EQUIVALENCE(IFLG2,KFORM(1003)),(ISTAT,KFORM(1004))
      EQUIVALENCE(JOUT1,KFORM(1005)),(NOF,KFORM(1006))
C 
C  DATA VALUES :
C 
      DATA JBYTES/140/
      DATA JWORDS/70/ 
      DATA ITGP3/2HTG,2HP3,2H  /
      DATA ITGP4/2HTG,2HP4,2H  /
      DATA ITGP12/2HTG,2HPI,2H2 / 
      DATA ITGP1/2HTG,2HP1,2H  /
      DATA IHP0/1,4,6/
      DATA IHP1/1,2,3,4,6/
      DATA IHP2/1,2,3,4,5,0,6/
      DATA IHPB0/1,0,0,4,6/ 
      DATA IHPB1/1,0,0,2,3,4,6/ 
      DATA IHPB2/1,0,0,2,3,4,5,0,6/ 
C 
C*********************************************************************
C 
C  IF INDIC = 3 IMAGE PROCESSING SUCCESSFULL
C 
C*********************************************************************
C 
      IF(INDIC.EQ.3) GO TO 1132 
      IF(INDIC.EQ.-77) GO TO 3011 
      IF(INDIC.EQ.1)   GO TO 1500 
C 
C***********************************************************************
C 
C    GET USER'S ANSWERS !!! 
C 
C***********************************************************************
C 
      ISTAT=0 
15    IF(ISCRN.EQ.91) GO TO 1500
      ITLOG=4 
      IF(IAND(ITT,3B) .NE. 0)ITLOG=ITLOG+2
      IF(ISBIT(ITT,1)) ITLOG=ITLOG+9
      IF(IGET1(IFORM,1515).EQ.1HX)  ITLOG=ITLOG+24
      IF(IGET2(IFORM,1518).NE.2H  ) ITLOG=ITLOG+2 
      IF(.NOT.(GETBK(ILU,KFORM,ITLOG))) GO TO 1100
C 
C  ERROR IN GETTING ANSWERS REPRINT SCREEN
C 
17    CALL EXEC(8,ITGP3)
C 
C********************************************************************** 
C 
C   SCREEN # 10  (QUESTION SPECIFICATIONS)
C 
C********************************************************************** 
C 
C 
C   RESET  THE BUFFER FOR DATA SET # TO ADD (KFORM(1060) TO KFORM(1065) 
C   RESET IMAI BUFFER 
C   RESET ILITE BUFFER
C 
1100  N=2*IQST-1
      CALL ERFLG(N,IMAI,IMKY,IMFLG,IMAS,IMDT) 
      CALL ERLIT(ILITE,IQST)
      IF(KFORM(1060).EQ.0) GO TO 410
      DO 200 I=1,KFORM(1060)
      DO 100 J=1,N
      IOP=IAND(IMAI(J,2),7) 
      NDS=IAND(IMAI(J,3),377B)
      IF((IOP.EQ.2).AND.(NDS.EQ.KFORM(1060+I))) GO TO 200 
100   CONTINUE
      KFORM(1060+I)=0 
200   CONTINUE
C 
      I=1 
320   IF(KFORM(1060+I).NE.0) GO TO 400
      IF(I.EQ.KFORM(1060)) GO TO 350
      CALL MOVEW(KFORM(1061+I),KFORM(1060+I),KFORM(1060)-I) 
350   KFORM(1060)=KFORM(1060)-1 
400   I=I+1 
      IF(I.LE.KFORM(1060)) GO TO 320
C 
C   ANSWER TYPE 
C 
410   NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      JVAL1=-1
      IF(JOUT.EQ.2HS ) JVAL1=0
      IF(JOUT.EQ.2HI ) JVAL1=1
      IF(JOUT.EQ.2HR ) JVAL1=2
      IF(JOUT.EQ.2HF ) JVAL1=3
      IF(JOUT.EQ.2HD ) JVAL1=4
      IF(JVAL1.EQ.-1) GO TO 1185
      IF((JVAL1.EQ.3).AND.(IAND(ITT,3B).LT.1)) GO TO 1192 
      IF((JVAL1.EQ.4).AND.(.NOT.ISBIT(ITT,1))) GO TO 1193 
      IF(ISBIT(IMFLG,2).AND.(JVAL1.NE.3)) GO TO 1175
      CALL MOVCA(JOUT,1,JFORM,(1+(IQST-1)*JBYTES),1)
      JSAVE=JVAL1 
C 
C-----GET PROMPTING LIGHT#
C 
11191 NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL3)) GO TO 3000
      CALL MOVCA(JOUT,1,JFORM,(3+(IQST-1)*JBYTES),2)
      JOUT1=JOUT(1) 
      IF(IFLG.GT.1) GO TO 1180
      IF(IFLG.EQ.0) GO TO 11192 
C-----LIGHT 0?
      IF(JVAL3.EQ.0) GO TO 11192
      IF((JVAL3.LT.1).OR.(JVAL3.GT.15)) GO TO 1182
      IF(ILITE(JVAL3).EQ.-99) GO TO 1183
11192 IF(ITLOG.EQ.4) GO TO 1102 
C 
C-----VALUE DISPLAY (TRANSACTION TYPE 1, 2, 3)
C 
1117   IF(IAND(ITT,3B).NE.0) GO TO 1113 
       CALL PUTCA(JFORM,1H ,2+(IQST-1)*JBYTES)
       GO TO 1119 
1113  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(IFLG.NE.0) GO TO 1116
      DO 1115 I=51+(IQST-1)*JWORDS,70+(IQST-1)*JWORDS 
1115  JFORM(I)=2H 
      JFORM(66+(IQST-1)*JWORDS)=0 
1116  IF(IFLG.EQ.0) GO TO 1118
      IF(IAND(ITT,3B).NE.2) GO TO 1118
C-----FIND PREVIOUSLY DEFINED?
      IF(ISBIT(IMFLG,1)) GO TO 1118 
C-----OR CHECK EXISTENCE PREVIOUSLY DEFINED?
      IF(.NOT.ISBIT(IMFLG,4)) GO TO 1197
1118  CALL MOVCA(JOUT,1,JFORM,(2+(IQST-1)*JBYTES),1)
C 
C-----NON-KEYBOARD INPUT
C 
1119  IF(IGET1(IFORM,1518) .EQ. 1HX .OR.
     *   IGET1(IFORM,1519) .EQ. 1HX)GO TO 11193 
      CALL BLAN(JFORM,(5+(IQST-1)*JBYTES),1)
      GO TO 11194 
11193 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 
C--IF FUNCTION, NON-KEYBD CANNOT BE SELECTED AS INPUT DEVICE. 
      IF((JVAL1.EQ.3).AND.(JOUT.EQ.2HX )) GO TO 1205
      CALL MOVCA(JOUT,1,JFORM,(5+(IQST-1)*JBYTES),1)
C 
C-----ON-LINE AND/OR SUMMARY
C 
11194 IF(IGET1(IFORM,1515).EQ.1HX) GO TO 1120 
      CALL BLAN(JFORM,(6+(IQST-1)*JBYTES),22) 
      GO TO 1123
1120  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
         IEDIT=-1 
         IF(JOUT.EQ.2H  )IEDIT=0
         IF((JOUT.EQ.2HO ).OR.(JOUT.EQ.2H O))IEDIT=1
         IF((JOUT.EQ.2HS ).OR.(JOUT.EQ.2H S))IEDIT=2
         IF((JOUT.EQ.2HOS).OR.(JOUT.EQ.2HSO))IEDIT=3
         IF(IEDIT.EQ.-1)GO TO 1207
      CALL MOVCA(JOUT,1,JFORM,(6+(IQST-1)*JBYTES),2)
C 
C-----LABEL FOR ANSWER
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,20,IFLG1,JVAL)) GO TO 3000 
      IF((IFLG.EQ.0).AND.(IFLG1.NE.0))GO TO 1201
      CALL MOVCA(JOUT,1,JFORM,(8+(IQST-1)*JBYTES),20) 
C 
C  ITEM NAME ASSOCIATED WITH ANSWER (TR.TYPE > 1 ONLY)
C 
1123  IF(ISBIT(ITT,1)) GO TO 1124 
      CALL BLAN(JFORM,28+(IQST-1)*JBYTES,7) 
      GO TO 1101
1124  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 
      IFLG3=IFLG
      IF((JVAL1.NE.4).AND.(IFLG.NE.0)) GO TO 1195 
      CALL MOVCA(JOUT,1,JFORM,(28+(IQST-1)*JBYTES),6) 
C 
C  IMAGE OPERATION (TR TYPE 2 OR 3 ONLY)
C 
      N=2*IQST-1
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((IFLG3.NE.0).AND.(IFLG.EQ.0)) GO TO 1198 
      IF((IFLG3.EQ.0).AND.(IFLG.NE.0)) GO TO 1196 
      IF(IFLG.EQ.0) GO TO 1130
      JVAL=-1 
      IF(JOUT.EQ.2HF ) JVAL=0 
      IF(JOUT.EQ.2HU ) JVAL=1 
      IF(JOUT.EQ.2HA ) JVAL=2 
      IF(JOUT.EQ.2HC ) JVAL=3 
      IF(JVAL.EQ.-1) GO TO 1188 
1130   CALL MOVCA(JOUT,1,JFORM,(34+(IQST-1)*JBYTES),1)
C 
C  IMAGE OPERATION CALL TGP12 SEGMENT 
C 
1127  IF(JSAVE.NE.4) GO TO 1101 
      IMAI(N,2)=JVAL
      INDIC=0 
      CALL EXEC(8,ITGP12) 
C 
C************************************************************************ 
C 
C  RETURN FROM TGP12  IMAGE OPERATION SUCCESFULL
C 
C************************************************************************ 
C 
1132  N=2*IQST-1
      INDIC=0 
      JVAL1=IAND(IMAI(N,2),30000B)/4096 
      IF(JVAL1.EQ.0) JFORM(25+(IQST-1)*JWORDS)=IAND(IMAI(N,4),377B) 
C 
C  PROMPTING LIGHT : STORE NOW
C 
1101  IF(ISTAT.EQ.0) GO TO 1102 
      IF(JVAL3.NE.JVAL4) ISTAT=0
1102  IQ=IQST 
C-----LIGHT 0?
      IF((JOUT1.EQ.2H0 ).OR.(JOUT1.EQ.2H 0).OR.(JOUT1.EQ.2H00)) 
     *    GO TO 1106
      CALL LIGHT(IQ,JVAL3,JOUT1,ISTAT,JFORM,ILITE)
      IF(ISTAT.EQ.0) GO TO 1170 
      IF(ISTAT.EQ.-1) GO TO 1181
1104  CALL WARN(ILITE(JVAL3),2) 
      ISTAT=1 
      JVAL4=JVAL3 
      GO TO 15
C-----LIGHT # IS 0. 
1106  JFORM(2+(IQST-1)*JWORDS)=2H00 
C 
C NOW CALL EDIT SCREEN
C 
1170  CONTINUE
      N1=50+(IQST-1)*JWORDS 
      IF((JFORM(N1).EQ.2H  ).OR.(JFORM(N1).EQ.JVAL1)) GO TO 1168
      DO 1166 I=25+(IQST-1)*JWORDS,N1 
1166  JFORM(I)=2H 
1168  JFORM(N1)=JVAL1 
      IF((JVAL1.EQ.0).AND.(IMAI(N,4).NE.0)) JFORM(25+(IQST-1)*JWORDS)=
     CIAND(IMAI(N,4),377B)
      IF(JVAL1.EQ.1) ISCRN=12 
      IF(JVAL1.EQ.2) ISCRN=13 
      IF(JVAL1.EQ.0) ISCRN=14 
      IF(JVAL1.EQ.3) ISCRN=15 
      N=25+(IQST-1)*JWORDS
      IF((ISCRN.EQ.14).AND.(JFORM(N).EQ.2H  )) JFORM(N)=0 
C 
C     CALL SCR 91 IF NECESSARY, OTHERWISE CALL  EDIT SCREENS. 
C 
      IF(IGET1(JFORM,5+(IQST-1)*JBYTES).EQ.2H  ) GO TO 11681
      ISCRN=91
      CALL EXEC(8,ITGP4)
11681 IF(ISCRN.GT.13) CALL EXEC(8,ITGP4)
      CALL EXEC(8,ITGP3)
C 
C  ERROR PROCESSING SCREEN 10 
C 
C-----"FIELD MUST BE BLANK OR INTEGER"
1180  CALL MES09(1,NOF) 
      GO TO 15
C-----"NO MORE LIGHTS AVAILABLE"
1181  CALL MES09(2,NOF) 
      GO TO 15
C-----"ILLEGAL LIGHT NUMBER"
1182  CALL MES09(3,NOF) 
      GO TO 15
C-----"LIGHT RESERVED FOR SYSTEM" 
1183  CALL MES09(4,NOF) 
      GO TO 15
C-----"FIELD MUST BE BLANK OR X"
1184  CALL MES09(5,NOF) 
      GO TO 15
C-----"ILLEGAL ANSWER TYPE" 
1185  CALL MES09(6,NOF) 
      GO TO 15
C-----"ONLY ONE KIND OF DEFAULT VALUE MAY BE SELECTED"
1186  NOF=NOF-1 
      CALL MES09(7,NOF) 
      GO TO 15
C-----"NO DISPLAY HAS BEEN DEFINED FOR THIS QUESTION" 
1187  CALL MES09(8,NOF) 
      GO TO 15
C-----"ILLEGAL IMAGE OPERATION" 
1188  CALL MES09(9,NOF) 
      GO TO 15
C-----"CARD READER NOT SELECTED AS INPUT DEVICE"
1189  CALL MES09(11,NOF)
      GO TO 15
C-----"DEFAULT VALUE MUST BE INTEGER" 
1190  NOF=2 
      IF(IAND(ITT,3B).GT.0) NOF=4 
      CALL MES09(12,NOF+2*IMODB)
      GO TO 15
C-----"NO DEFAULT VALUE ALLOWED FOR A "FUNCTION ONLY" ANSWER TYPE"
1199  GO TO 1169
1191  NOF=2 
      IF(IAND(ITT,3B).GT.0) NOF=4 
      NOF=NOF+2*IMODB 
1169  CALL MES09(13,NOF)
      GO TO 15
C-----""FUNCTION ONLY" ANSWER TYPE ILLEGAL WITH THIS TRANSACTION TYPE"
1192  CALL MES09(14,NOF)
      GO TO 15
C-----"ILLEGAL ANSWER TYPE SINCE NO DATA BASE HAS BEEN SELECTED"
1193  CALL MES09(15,NOF)
      GO TO 15
C-----"DEFAULT ANSWER TYPE MUST BE REAL"
1194  NOF=2 
      IF(IAND(ITT,3B).GT.0) NOF=4 
      CALL MES09(16,NOF+2*IMODB)
      GO TO 15
C-----"ANSWER TYPE MUST BE D" 
1195  CALL MES09(17,1)
      GO TO 15
C-----"MISSING ITEM NAME" 
1196  CALL MES09(18,NOF-1)
      GO TO 15
C-----"A FIND OR CHECK EXISTENCE MUST BE PREVIOUSLY DEFINED FOR DISPLAY"
1197  CALL MES09(19,NOF)
      GO TO 15
C-----"MISSING IMAGE OPERATION" 
1198  CALL MES09(20,NOF)
      GO TO 15
C-----"ANSWER TYPE MUST BE F SINCE DELETE OPERATION WAS PREVIOUSLY DEFINED" 
1175  CALL MES09(21,1)
      GO TO 15
C-----"A DISPLAY MUST BE DEFINED WHEN ANSWER TYPE IS F" 
1176  CALL MES09(22,1)
      GO TO 15
C-----"FIELD MUST BE 'A' OR 'I'"
1177  CALL MES09(23,NOF)
      GO TO 15
C-----"FIELD MUST BE 'H' OR 'M'"
1178  CALL MES09(24,NOF)
      GO TO 15
C-----"ILLEGAL COMBINATION, PLEASE RE-SPECIFY"
1179  CALL MES09(25,NOF)
      GO TO 15
C-----"FIELD MUST BE '80' OR '40' OR 'CO' OR 'CA'"
1200  CALL MES09(26,NOF)
      GO TO 15
C-----"FIELD MUST BE BLANK" 
1201  CALL MES09(27,NOF)
      GO TO 15
C-----"USER WRITTEN MODULE REQUIRED FOR IMAGE CARD INPUT" 
1202  NOF=NOF-2 
      CALL MES09(29,NOF)
      GO TO 15
C-----"CARD SPECS HAVE NOT YET BEEN DEFINED"
1203  CALL MES09(28,NOF)
      GO TO 15
C-----"IF IMAGE CARD INPUT--'F' & 'C' NOT ALLOWED"
1204  CALL MES09(30,NOF)
      GO TO 15
C-----"CARD READER CANNOT BE SELECTED"
1205  CALL MES09(31,NOF)
      GO TO 15
C-----"FIELD MUST BE 'O', 'S', 'OS', OR 'SO'" 
1207  CALL MES09(33,NOF)
      GO TO 15
C 
C*********************************************************************
C 
C SCREEN #91 : NON-KEYBOARD INPUT SPECIFICATIONS
C 
C*********************************************************************
C 
1500  ITLOG=0 
      IF(IGET1(IFORM,1518).EQ.1HX)ITLOG=12
      IF(IGET1(IFORM,1519).EQ.1HX)ITLOG=ITLOG+7 
      IF(ITLOG.EQ.19)ITLOG=20 
      IF(.NOT.(GETBK(ILU,KFORM,ITLOG))) GO TO 1510
C 
C-----ERROR IN GETTING ANSWERS FROM SCR 91, REPRINT SCREEN
C 
      CALL EXEC(8,ITGP4)
C 
C     INPUT=1 MULTIFUNCTION CARD/TYPE III BADGE READER
C          =2 TYPE V BADGE READER 
C          =3 BOTH
1510  NOF=0 
      IARG=0
      ISTART=0
      IEND=0
      ITYP3=0 
      ITYP5=0 
      INEW=0
      IF(ITLOG.EQ.12) INPUT=1 
      IF(ITLOG.EQ. 7) INPUT=2 
      IF(ITLOG.EQ.20) INPUT=3 
C    -INIT A/I BIT 0
      JFORM(24+(IQST-1)*JWORDS)=IAND(JFORM(24+(IQST-1)*JWORDS),177400B) 
      IF(.NOT.ISBIT(ITT,4)) GO TO 1550
C 
C     ++++++++++++++++++++++++++++++++++++++++++++++
C-----MULTIFUNCTION CARD/TYPE III BADGE READER EDITS
C     ++++++++++++++++++++++++++++++++++++++++++++++
C 
C 
C-----ASCII/IMAGE 
C 
      ILENTH=80 
      NOF=1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF(IFLG.EQ.0) GO TO 1512
      IF((JOUT.NE.2HA ).AND.(JOUT.NE.2HI )) GO TO 1177
      IF(JOUT.EQ.2HA ) IARG=IOR(IARG,100B)
      IF(JOUT.EQ.2HI ) IARG=IOR(IARG,200B)
      IF(JOUT.EQ.2HA ) CALL SETBT(JFORM(24+(IQST-1)*JWORDS),0,1)
      IF(JOUT.EQ.2HI ) ILENTH=40
      INEW=1
1512  CALL MOVCA(JOUT,1,JFORM,35+(IQST-1)*JBYTES,1) 
      IF(IFLG.NE.0) ITYP3=1 
C 
C-----HOLES/MARKS 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((INEW.EQ.0).AND.(JOUT.EQ.2H  )) GO TO 1514 
      IF((INEW.EQ.0).AND.(JOUT.NE.2H  )) GO TO 1201 
      IF((JOUT.NE.2HH ).AND.(JOUT.NE.2HM )) GO TO 1178
      IF(JOUT.EQ.2HH ) IARG=IOR(IARG,20B) 
      IF(JOUT.EQ.2HM ) IARG=IOR(IARG,40B) 
1514  CALL MOVCA(JOUT,1,JFORM,(36+(IQST-1)*JBYTES),1) 
      IF(IFLG.NE.0) ITYP3=1 
C 
C-----NC OR CO OR CA (NO CLOCK OR CLOCK ON OR CLOCK AFTER)
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      IF((INEW.EQ.0).AND.(JOUT.EQ.2H  )) GO TO 1516 
      IF((INEW.EQ.0).AND.(JOUT.NE.2H  )) GO TO 1201 
      J=JOUT
      IF((J.NE.2HNC).AND.(J.NE.2HCO).AND.(J.NE.2HCA)) GO TO 1200
      IF(JOUT.EQ.2HNC) IARG=IOR(IARG,2B)
      IF(JOUT.EQ.2HCO) IARG=IOR(IARG,4B)
      IF(JOUT.EQ.2HCA) IARG=IOR(IARG,10B) 
      IF(ISBIT(IARG,4)) ILENTH=80 
      IF(ISBIT(IARG,5)) ILENTH=40 
1516  CALL MOVCA(JOUT,1,JFORM,(37+(IQST-1)*JBYTES),2) 
      IF(IFLG.NE.0) ITYP3=1 
C 
C--CHECK FOR ILLEGAL COMBINATIONS(A.M.NC,I.M.NC,A.H.CO,I.H.CO)
C 
      J=IARG
      IF((J.EQ.142B).OR.(J.EQ.242B).OR.(J.EQ.124B)
     *              .OR.(J.EQ.224B)) GO TO 1179 
C 
C-----STARTING COLUMN 
C 
1520  NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      IF((INEW.EQ.1).AND.(IFLG.EQ.0)) GO TO 15000 
      IF((IFLG.NE.0).AND.(IFLG.NE.1)) GO TO 1180
      IF((INPUT.EQ.1).AND.(IFLG.EQ.0)) GO TO 15000
      IF(IFLG.EQ.0) GO TO 1527
C 
C-----IF LAST FIELDS WERE BLANK, CONDUCT BACKWARDS SEARCH FOR A 
C     PREVIOUSLY DEFINED CARD READER OR TYPE III BADGE. 
C 
      IF(INEW.EQ.1) GO TO 1526
C    -NO. SEARCH BACKWARDS FOR PREVIOUSLY DEFINED SPECS.
      MQSTCT=IQST-1 
      DO 1522 J=IQST-1,1,-1 
      IF(IGET1(JFORM, 5+(J-1)*JBYTES).EQ.1H )  GO TO 1522 
      IF(IGET2(JFORM,44+(J-1)*JBYTES).NE.2H  ) GO TO 15013
      IF(IGET1(JFORM,35+(J-1)*JBYTES).NE.1H )  GO TO 1524 
1522  CONTINUE
C    -ERROR "CARD SPECS NOT PREVIOUSLY DEFINED" 
      NOF=1 
      GO TO 1203
C    -ERR IS M-QUES HAS ITS SPECS ON A U-QUES.
1524  IF(IQST.LE.IUMAX) GO TO 1525
      IF(J.LE.IUMAX) GO TO 15014
C    -FOUND SPECS, SET A/I BIT & ILENTH IF ASCII. 
1525  ILENTH=40 
      IF(IGET1(JFORM,35+(J-1)*JBYTES).EQ.1HI) GO TO 1526
      ILENTH=80 
      CALL SETBT(JFORM(24+(IQST-1)*JWORDS),0,1) 
1526  IF((JVAL.LT.1).OR.(JVAL.GT.ILENTH)) GO TO 15002 
      IF(IFLG.EQ.1) ISTART=JVAL 
1527  CALL MOVCA(JOUT,1,JFORM,(39+(IQST-1)*JBYTES),2) 
      IF(IFLG.NE.0) ITYP3=1 
C 
C-----ENDING COLUMN 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      IF((ISTART.NE.0).AND.(IFLG.NE.1)) GO TO 15000 
      IF((IFLG.NE.0).AND.(IFLG.NE.1)) GO TO 1180
      IF(ISTART.EQ.0 .AND. IFLG.EQ.1) GO TO 15016 
      IF(IFLG.EQ.0) GO TO 1528
      IF((JVAL.LT.1).OR.(JVAL.GT.ILENTH)) GO TO 15002 
      IEND=JVAL 
      ITYP3=1 
      IF(ISTART.GT.IEND) GO TO 15004
      IF(IEND.GT.ILENTH) GO TO 15005
1528  CALL MOVCA(JOUT,1,JFORM,(41+(IQST-1)*JBYTES),2) 
      IF(IFLG.NE.0) ITYP3=1 
C 
C     ++++++++++++++++++++++++++
C-----TYPE V BADGE READER EDITS.
C     ++++++++++++++++++++++++++
C 
1550  IF(.NOT.ISBIT(ITT,5)) GO TO 1599
      ISTART=0
      IEND=0
      ILENTH=10 
C 
C-----NUMERIC/IMAGE 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 
      IF((INPUT.EQ.3).AND.(ITYP3.EQ.1).AND.(IFLG.NE.0)) GO TO 15008 
      IF((JOUT.NE.2HN ).AND.(JOUT.NE.2HI ).AND.(JOUT.NE.2H  ))
     *  GO TO 15009 
      IF(JOUT.EQ.2HN ) CALL SETBT(JFORM(24+(IQST-1)*JWORDS),0,1)
      IF((IFLG.EQ.0).AND.(INPUT.EQ.2)) GO TO 1552 
      IF((IFLG.NE.0).AND.(INPUT.EQ.3).AND.(ITYP3.EQ.1)) GO TO 15008 
1552  CALL MOVCA(JOUT,1,JFORM,(43+(IQST-1)*JBYTES),1) 
      IF(IFLG.NE.0) ITYP5=1 
C 
C-----STARTING COLUMN 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      IF((INPUT.EQ.3).AND.(ITYP3.EQ.1).AND.(IFLG.NE.0)) GO TO 15008 
      IF((IFLG.NE.0).AND.(IFLG.NE.1)) GO TO 1180
      IF((IFLG.EQ.0).AND.(INPUT.EQ.2)) GO TO 15000
      IF((IFLG.EQ.0).AND.(ITYP5.EQ.1)) GO TO 15000
      IF(IFLG.EQ.0) GO TO 1565
C 
C-----IF LAST FIELD WAS BLANK, CONDUCT BACKWARDS SEARCH FOR A 
C     PREVIOUSLY DEFINED TYPE V BADGE.
C 
      IF(ITYP5.EQ.1) GO TO 1564 
      MQSTCT=IQST-1 
      DO 1560 J=IQST-1,1,-1 
      IF(IGET1(JFORM, 5+(J-1)*JBYTES).EQ.1H )  GO TO 1560 
      IF(IGET2(JFORM,39+(J-1)*JBYTES).NE.2H  ) GO TO 15013
      IF(IGET1(JFORM,43+(J-1)*JBYTES).NE.1H )  GO TO 1562 
1560  CONTINUE
C    -ERROR "TYPE V BADGE NOT PREVIOUSLY SPECIFIED" 
      IF(INPUT.EQ.2) NOF=1
      IF(INPUT.EQ.3) NOF=6
      GO TO 15012 
C    -ERROR IF AN M-QUES HAS ITS SPECS DEFINED ON A U-QUES. 
1562  IF(IQST.LE.IUMAX) GO TO 1563
      IF(J.LE.IUMAX) GO TO 15015
C    -FOUND SPECS, SET A/I BIT IF NUMERIC.
1563  IF(IGET1(JFORM,43+(J-1)*JBYTES).EQ.1HI) GO TO 1564
      CALL SETBT(JFORM(24+(IQST-1)*JWORDS),0,1) 
1564  IF((JVAL.LT.1).OR.(JVAL.GT.ILENTH)) GO TO 15010 
      ISTART=JVAL 
1565  CALL MOVCA(JOUT,1,JFORM,(44+(IQST-1)*JBYTES),2) 
      IF(IFLG.NE.0) ITYP5=1 
C 
C-----ENDING COLUMN 
C 
      NOF=NOF+1 
      IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 
      IF((INPUT.EQ.3).AND.(ITYP3.EQ.1).AND.(IFLG.NE.0)) GO TO 15008 
      IF((IFLG.NE.0).AND.(IFLG.NE.1)) GO TO 1180
      IF(ISTART.EQ.0 .AND. IFLG.EQ.1) GO TO 15016 
      IF((IFLG.EQ.0).AND.(INPUT.EQ.2)) GO TO 15000
      IF((IFLG.EQ.1).AND.(INPUT.EQ.3).AND.(ITYP3.EQ.1)) GO TO 15008 
      IF((IFLG.EQ.0).AND.(ITYP5.EQ.1)) GO TO 15000
      IF(IFLG.EQ.0) GO TO 1570
      ITYP5=1 
      IEND=JVAL 
      IF((IEND.LT.1).OR.(IEND.GT.ILENTH)) GO TO 15010 
      IF(ISTART.GT.IEND) GO TO 15004
1570  CALL MOVCA(JOUT,1,JFORM,(46+(IQST-1)*JBYTES),2) 
C 
C-----GO TO NEXT SCREEN (ONE OF THE EDIT SCREENS) 
C 
1599  IF((INPUT.EQ.1).AND.(ITYP3.EQ.0)) GO TO 15007 
      IF((INPUT.EQ.2).AND.(ITYP5.EQ.0)) GO TO 15007 
      IF((INPUT.EQ.3).AND.(ITYP3.EQ.0).AND.(ITYP5.EQ.0)) GO TO 15007
      JVAL1=JFORM(50+(IQST-1)*JWORDS) 
      IF(JVAL1.EQ.1) ISCRN=12 
      IF(JVAL1.EQ.2) ISCRN=13 
      IF(JVAL1.EQ.0) ISCRN=14 
      IF(JVAL1.EQ.3) ISCRN=15 
      IF(ISCRN.GT.13) CALL EXEC(8,ITGP4)
      CALL EXEC(8,ITGP3)
C 
C ERROR PROCESSING FOR SCREEN 91
C 
C-----"FIELD MUST BE INTEGER" 
15000 CALL MES09(34,NOF)
      GO TO 15
C-----"FIELD CANNOT BE BLANK" 
15001 CALL MES09(35,NOF)
      GO TO 15
15002 IF(ILENTH.EQ.80) GO TO 15003
C-----"MUST BE 1 THRU 40" 
      CALL MES09(36,NOF)
      GO TO 15
C-----"MUST BE 1 THRU 80" 
15003 CALL MES09(37,NOF)
      GO TO 15
C-----"ENDING COLUMN CANNOT BE < STARTING COLUMN" 
15004 CALL MES09(38,NOF)
      GO TO 15
C-----"ENDING COLUMN EXCEEDS CARD LENGTH" 
15005 CALL MES09(39,NOF)
      GO TO 15
C-----"ANSWER REQUIRED ON THIS SCREEN"
15007 NOF=1 
      CALL MES09(40,NOF)
      GO TO 15
C-----"CANNOT DEFINE BOTH TYPES OF READERS" 
15008 CALL MES09(41,NOF)
      GO TO 15
C-----"FIELD MUST BE 'N' OR 'I' OR BLANK" 
15009 CALL MES09(42,NOF)
      GO TO 15
C-----"MUST BE 1 THRU 10" 
15010 CALL MES09(43,NOF)
      GO TO 15
C-----"TYPE V BADGE NOT PREVIOUSLY SPECIFIED" 
15012 CALL MES09(45,NOF)
      GO TO 15
C-----"PREVIOUS SPECS ARE ON OTHER TYPE OF READER"
15013 CALL MES09(46,NOF)
      GO TO 15
C-----"AN M-QUES CANNOT HAVE ITS CARD SPECS DEFINED FROM A U-QUES"
15014 CALL MES09(32,1)
      GO TO 15
C-----"AN M-QUES CANNOT HAVE ITS CARD SPECS DEFINED FROM A U-QUES"
15015 IF(INPUT.EQ.2) NOF=1
      IF(INPUT.EQ.3) NOF=6
      CALL MES09(32,NOF)
      GO TO 15
C-----"FIELD MUST BE INTEGER" 
15016 NOF=NOF-1 
      GO TO 15000 
C 
C 
C*********************************************************************
C 
C 2645 SOFT KEYS 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 3005
      CALL MES09(10,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
3011  INDIC=0 
      IF(IMODB.EQ.1) GO TO 3008 
      IF(IAND(ITT,3B).EQ.0) IMES=IHP0(NOF)
      IF(IAND(ITT,3B).EQ.1) IMES=IHP1(NOF)
      IF(IAND(ITT,3B).GT.1) IMES=IHP2(NOF)
      GO TO 3009
3008  IF(IAND(ITT,3B).EQ.0) IMES=IHPB0(NOF) 
      IF(IAND(ITT,3B).EQ.1) IMES=IHPB1(NOF) 
      IF(IAND(ITT,3B).GT.1) IMES=IHPB2(NOF) 
3009  CALL HLP09(IMES,NOF)
      GO TO 15
C 
C  IFLG=8 MEANS LAST SCREEN 
C 
3010  IF(IFLG.NE.8) GO TO 3040
      IF(ISCRN.NE.11) GO TO 3020
      IF(IQST.NE.1) GO TO 3012
      ISCRN=10
      CALL EXEC(8,ITGP3)
3012  IQST=IQST-1 
      I=IGET1(JFORM,(2+(IQST-1)*JBYTES),1)
      IF(I.NE.2HX ) GO TO 3014
      ISCRN=16
      CALL EXEC(8,ITGP4)
3014  I=JFORM(50+(IQST-1)*(JBYTES/2)) 
      IF(I.EQ.3) ISCRN=15 
      IF(I.EQ.0) ISCRN=14 
      IF(I.EQ.2) ISCRN=13 
      IF(I.EQ.1) ISCRN=12 
3016  IF(ISCRN.GT.13) CALL EXEC(8,ITGP4)
      CALL EXEC(8,ITGP3)
C 
3020  ISCRN=11
      CALL EXEC(8,ITGP3)
C 
C  CALL NEXT SCREEN 
C 
C 
C  ABORT PROGRAM
C 
3040  IF(.NOT.(OKABT(ILU))) GO TO 17
      INDIC=99
      CALL EXEC(8,ITGP1)
C 
C  END OF SEGMENT 
C 
      CALL TGP
C 
C 
      END 
      END$
                                        