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$