FTN4 PROGRAM TGP9(5), 92080-1X370 REV.2026 800505 C C SOURCE 92080-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(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 ITGP3(3) DIMENSION JOUT(10),ITGP4(3),ITGP12(3),ITGP1(3) DIMENSION IHLP1(12),IHLP2(7),IHLP3(7),IHLP4(6),IHLP5(8),IHLP6(7) DIMENSION IHP91(9),IHP92(9),IHP93(10),IHP94(6),IHP95(7),IHP96(8) DIMENSION IHP97(4),IHP98(8),IHP99(4),IHP910(5),IHP911(1) LOGICAL JPAR,RNUM,ISBIT,GETBK,OKABT,NAMCK 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/170/ DATA JWORDS/85/ DATA ITGP3/2HTG,2HP3,2H / DATA ITGP4/2HTG,2HP4,2H / DATA ITGP12/2HTG,2HPI,2H2 / DATA ITGP1/2HTG,2HP1,2H / DATA IHLP1/8,6,2,9,10,11,12,13,14,5,15,16/ DATA IHLP2/8,2,9,10,5,15,16/ DATA IHLP3/8,6,10,11,12,13,14/ DATA IHLP4/8,2,9,5,15,16/ DATA IHLP6/8,6,2,9,5,15,16/ DATA IHLP5/8,6,2,9,10,5,15,16/ DATA IHP91/17,18,19,20,21,22,20,21,23/ DATA IHP92/17,18,19,20,21,26,25,25,23/ DATA IHP93/17,18,19,20,21,24,0,25,25,23/ DATA IHP94/17,18,19,20,21,23/ DATA IHP95/22,20,21,26,25,25,23/ DATA IHP96/22,20,21,24,0,25,25,23/ DATA IHP97/22,20,21,23/ DATA IHP98/26,25,25,24,0,25,25,23/ DATA IHP99/26,25,25,23/ DATA IHP910/24,0,25,25,23/ DATA IHP911/23/ 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 16 IF(INDIC.EQ.1) GO TO 1500 C C*********************************************************************** C C GET USER'S ANSWERS !!! C C*********************************************************************** C ISTAT=0 ISTAT1=0 ISTAT2=0 ISTAT3=0 15 IF(ISCRN.EQ.91) GO TO 1500 16 ITLOG=1 C --- 3077? IF(IAND(ITT,2000B).EQ.0) ITLOG=ITLOG+3 C --- DB OR UP OR NON-KEYBOARD INPUT? IF(IAND(ITT,3B).NE.0 .OR. IAND(ITT,11061B).NE.0) ITLOG=ITLOG+4 C --- CRT/ALPHANUMERIC DISPLAY/PRINTER? IF(IAND(ITT,20210B) .NE. 0) ITLOG=ITLOG+17 C --- CRT/PRINTER? IF(IAND(ITT,20010B).NE.0) ITLOG=ITLOG+8 C --- IMAGE? IF(ISBIT(ITT,1)) ITLOG=ITLOG+16 IF(INDIC.EQ.-77) GO TO 3003 IF(.NOT.(GETBK(ILU,KFORM,ITLOG,IMODE))) GO TO 1100 C C ERROR IN GETTING ANSWERS REPRINT SCREEN C 17 IF(ISCRN.EQ.91) CALL EXEC(8,ITGP4) 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(1076) 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. ISBIT(ITT,10)) GO TO 1209 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 IF(IAND(ITT,2000B).EQ.0) GO TO 1112 CALL BLAN(JFORM,3+(IQST-1)*JBYTES,2) GO TO 11192 1112 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) IF(ISBIT(ITT,10) .AND. IFLG.NE.0) GO TO 1209 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.14)) GO TO 1182 IF(ILITE(JVAL3).EQ.-99) GO TO 1183 C C-----VALUE DISPLAY (APPLIES ONLY TO UP OR DB) C 11192 IF(IAND(ITT,3B).NE.0) GO TO 1113 CALL PUTCA(JFORM,1H ,2+(IQST-1)*JBYTES) IF(IAND(ITT,11061B).EQ.0) GO TO 1119 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 C --- CHECK FOR BLANK IF(IFLG.NE.0) GO TO 1201 GO TO 1119 C 1113 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 C -BLANK OR "X"? IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184 C -YES. BLANK? IF(IFLG.NE.0) GO TO 1116 C -YES. FUNCTION? IF(JVAL1.EQ.3) GO TO 1176 C -NO. BLANK & ZERO JFORM FIELDS. DO 1115 I=51+(IQST-1)*JWORDS,73+(IQST-1)*JWORDS 1115 JFORM(I)=2H JFORM(66+(IQST-1)*JWORDS)=0 GO TO 1118 C C ERROR IF TIME-REPORTING TERMINAL & ALPHA DISPLAY BOTH SPECIFIED. 1116 IF(ISBIT(ITT,10) .AND. .NOT.ISBIT(ITT,7)) GO TO 1187 C -DATA ITEM SPECIFIED? C C-----COMMENT OUT NEXT LINE AS OF 2026 PCO C C IF(JVAL1.EQ.4) GO TO 1117 C -NO. USER WRITTEN MODULE SPECIFIED? IF(ISBIT(ITT,0)) GO TO 1118 C -NO. FUNCTION? C C----FOR ALL BUT FUNCTION GO TO 1117 AT 2026 PCO C IF(JVAL1.NE.3) GO TO 1117 C -YES. DB SPECIFIED? IF(.NOT.ISBIT(ITT,1)) GO TO 1211 C -YES. EVERYTHING'S OK. GO TO 1118 C C -FIND PREVIOUSLY DEFINED? 1117 IF(ISBIT(IMFLG,1)) GO TO 1118 C -NO. CHECK EXISTENCE PREVIOUSLY DEFINED? IF(ISBIT(IMFLG,4)) GO TO 1118 C -NO. UP DEFINED? IF(.NOT.ISBIT(ITT,0)) GO TO 1211 1118 CALL MOVCA(JOUT,1,JFORM,(2+(IQST-1)*JBYTES),1) C C-----NON-KEYBOARD INPUT C 1119 IF(IAND(ITT,11061B).NE.0) GO TO 11193 CALL BLAN(JFORM,(5+(IQST-1)*JBYTES),1) IF(IAND(ITT,3B).EQ.0) GO TO 1121 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 C --- CHECK FOR BLANK IF(IFLG.NE.0) GO TO 1201 GO TO 1121 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 IF(ISBIT(ITT,10) .AND. IFLG.EQ.0) GO TO 1210 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-----LABEL FOR ASKING QUESTION FROM DISPLAY OR PRINTER C 1121 IF(IAND(ITT,20210B).NE.0) GO TO 11213 CALL BLAN(JFORM,11+(IQST-1)*JBYTES,16) GO TO 11194 11213 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,16,IFLG,JVAL)) GO TO 3000 CALL MOVCA(JOUT,1,JFORM,(11+(IQST-1)*JBYTES),16) C C --- CRT/ALPHANUMERIC STRIP PRINTER SECTION C 11194 IF(IAND(ITT,20010B).NE.0) GO TO 11214 CALL BLAN(JFORM,6+(IQST-1)*JBYTES,5) GO TO 1123 C C --- SCROLL/CLEAR DISPLAY C 11214 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF(IGET1(IFORM,1550).EQ.1H .AND.IFLG.NE.0) GO TO 1201 IF(JOUT.NE.1HS.AND.JOUT.NE.1HC.AND.IGET1(IFORM,1550).EQ.1HX) . GO TO 1213 CALL MOVCA(JOUT,1,JFORM,7+(IQST-1)*JBYTES,1) C C --- LARGE/SMALL CHARACTERS C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF(IGET1(IFORM,1550).EQ.1H .AND.IFLG.NE.0) GO TO 1201 IF(JOUT.NE.1HL.AND.JOUT.NE.1HS.AND.IGET1(IFORM,1550).EQ.1HX) . GO TO 1214 CALL MOVCA(JOUT,1,JFORM,6+(IQST-1)*JBYTES,1) C C --- ON-LINE PRINTOUT C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF(IGET1(IFORM,1515).EQ.1H .AND.IFLG.NE.0) GO TO 1201 IF(JOUT.NE.1HX.AND.JOUT.NE.1H ) GO TO 1184 CALL MOVCA(JOUT,1,JFORM,9+(IQST-1)*JBYTES,1) C C --- SUMMARY PRINTOUT C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF(IGET1(IFORM,1515).EQ.1H .AND.IFLG.NE.0) GO TO 1201 IF(JOUT.NE.1HX.AND.JOUT.NE.1H ) GO TO 1184 CALL MOVCA(JOUT,1,JFORM,10+(IQST-1)*JBYTES,1) C C ITEM NAME ASSOCIATED WITH ANSWER (TR.TYPE > 1 ONLY) C 1123 IF(ISBIT(ITT,1)) GO TO 1124 CALL BLAN(JFORM,27+(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 1201 CALL MOVCA(JOUT,1,JFORM,(27+(IQST-1)*JBYTES),6) C C-----DATA SET NAME (6 ASCII CHAR, REQD FOR IMAGE ITEM) C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IF(JVAL1.NE.4 .AND. IFLG.NE.0) GO TO 1201 IF(IFLG3.EQ.3 .AND. IFLG.NE.3) GO TO 1208 IF(IFLG3.NE.3 .AND. FILG.EQ.3) GO TO 1201 CALL MOVCA(JOUT,1,JFORM,147+(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(JVAL1.NE.4 .AND. IFLG.NE.0) GO TO 1201 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,(33+(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 C -THE FOLLOWING ROUTINE SEARCHES BACKWARDS THRU THE PREVIOUS C -QUESTIONS TO MAKE SURE THAT THE SAME OPERATION HAS NOT ALREADY C -BEEN DEFINED ON THE SAME ITEM IN THE SAME DATA SET. C C -1ST QUESTION? IF(IQST.EQ.1) GO TO 1139 C -NO. GET OPERATION, ITEM#, & DATA SET#. IOP=IAND(IMAI(N,2),7) ITN=IAND(IMAI(N,1),377B) IDS=IAND(IMAI(N,3),377B) C -DISPLAY? IF(IOP.EQ.5) GO TO 1139 C -NO. NX=N-2 C DO 1134 I=NX,1,-2 IOPX=IAND(IMAI(I,2),7) ITNX=IAND(IMAI(I,1),377B) IDSX=IAND(IMAI(I,3),377B) IF(IOP.NE.IOPX) GO TO 1134 IF(ITN.NE.ITNX) GO TO 1134 IF(IDS.EQ.IDSX) GO TO 1212 1134 CONTINUE 1139 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 C -SKIP IF TIME REPORTING TRANSACTION. IF(ISBIT(ITT,10)) GO TO 1170 CALL LIGHT(IQ,JVAL3,JOUT1,ISTAT,JFORM,ILITE) IF(ISTAT.EQ.0) GO TO 1170 IF(ISTAT.EQ.-1) GO TO 1181 1104 CALL HLP09(7,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) C -BLANK OUT NON-KEYBOARD INPUT FIELDS. 11681 CALL BLAN(JFORM,35+(IQST-1)*JBYTES,13) CALL BLAN(JFORM,153+(IQST-1)*JBYTES,17) 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,2) 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-2) 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,3) 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-----"DATA SET REQUIRED" 1208 CALL MES09(47,NOF) GO TO 15 C-----"ILLEGAL FOR TIME REPORTING TERMINAL" 1209 CALL MES09(48,NOF) GO TO 15 C-----"REQD FOR TIME REPORTING TERMINAL" 1210 CALL MES09(49,NOF) GO TO 15 C "USER WRITTEN MODULE REQUIRED" 1211 CALL MES09(50,NOF) GO TO 15 C C -ADD/FIND/CE/UPDATE ALREADY DEFINED ON THIS DATA ITEM. C -POSITION CURSOR TO IMAGE OPERATION FIELD. C C-----GOING TO CHANGE INDIC TO "0" AS IF AN IMAGE ERROR HAD C BEEN RETURNED FROM TGP12. IF THIS IS NOT DONE INDIC WILL C EQUAL 3 AND THE NEXT DETAIL SCREEN THAT APPEARS WILL IN- C TERPRET THIS AS A FLAG THAT IMAGE VALIDATION HAS TAKEN PLACE C FOR THIS SCREEN. THEREFORE, A LOT OF FIELD VALIDATION IS BY- C PASSED INCORRECTLY. BUG FIX FOR 2026 PCO. C 1212 INDIC=0 C NOF=6 IF(.NOT.ISBIT(ITT,10)) NOF=NOF+1 IF(IAND(ITT,20210B).NE.0) NOF=NOF+1 IF(IAND(ITT,20010B).NE.0) NOF=NOF+4 IF(IOP.EQ.0) IMES=52 IF(IOP.EQ.1) IMES=54 IF(IOP.EQ.2) IMES=51 IF(IOP.EQ.3) IMES=53 CALL MES09(IMES,NOF) GO TO 15 C --- "MUST SPECIFY 'S' OR 'C' FOR SCROLL OF CLEAR" 1213 CALL MES09(56,NOF) GO TO 15 C --- "MUST SPECIFY 'L' OR 'S' FOR LARGE OR SMALL" 1214 CALL MES09(57,NOF) GO TO 15 C C********************************************************************* C C SCREEN #91 : NON-KEYBOARD INPUT SPECIFICATIONS C C********************************************************************* C 1500 ITLOG=0 ICNT=0 IF(IAND(ITT,20B).EQ.0) GO TO 1501 ITLOG=12 ICNT=1 1501 IF(IAND(ITT,40B).EQ.0) GO TO 1502 ITLOG=ITLOG+7 ICNT=ICNT+1 1502 IF(IAND(ITT,10000B).EQ.0) GO TO 1503 ITLOG=ITLOG+9 ICNT=ICNT+1 1503 IF(IAND(ITT,1000B).EQ.0) GO TO 1504 ITLOG=ITLOG+9 ICNT=ICNT+1 1504 IF(IAND(ITT,1B).EQ.0) GO TO 1505 ITLOG=ITLOG+5 ICNT=ICNT+1 1505 ITLOG=ITLOG+ICNT-1 IF(.NOT.(GETBK(ILU,KFORM,ITLOG,IMODE))) GO TO 1510 C C-----ERROR IN GETTING ANSWERS FROM SCR 91, REPRINT SCREEN C CALL EXEC(8,ITGP4) C C ITYPX=0 NO ALTERNATE INPUT DEVICE SELECTED C =1 TYPE III C =2 TYPE V C =3 MAG STRIPE C =4 BAR CODE C =5 USER DATE MODULE 1510 NOF=0 IARG=0 ISTART=0 IEND=0 ITYPX=0 INEW=0 C -INIT A/I BIT 0 JFORM(24+(IQST-1)*JWORDS)=IAND(JFORM(24+(IQST-1)*JWORDS),177400B) IF(ISBIT(ITT,4)) GO TO 1511 CALL BLAN(JFORM,35+(IQST-1)*JBYTES,8) GO TO 1550 C C ++++++++++++++++++++++++++++++++++++++++++++++ C-----MULTIFUNCTION CARD/TYPE III BADGE READER EDITS C ++++++++++++++++++++++++++++++++++++++++++++++ C C C-----ASCII/IMAGE C 1511 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) INEW=1 1512 CALL MOVCA(JOUT,1,JFORM,35+(IQST-1)*JBYTES,1) IF(IFLG.NE.0) ITYPX=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) ITYPX=1 C C-----NC OR CO OR CA (NO CLOCK OR CLOCK ON OR CLOCK AFTER) C CO IS STILL ACCEPTED AS OF 2026 BUT A WARNING C AS TO ITS USE IS DISPLAYED. SUPPORT OF CO IS C SOMEWHAT QUESTIONABLE. 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(JOUT.NE.2HCO) GO TO 15161 IF(ISTAT1.EQ.1) GO TO 15161 ISTAT1=1 CALL HLP09(27,NOF) GO TO 15 15161 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) 1516 CALL MOVCA(JOUT,1,JFORM,(37+(IQST-1)*JBYTES),2) IF(IFLG.NE.0) ITYPX=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(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(IGET2(JFORM,164+(J-1)*JBYTES).NE.2H .OR. . (IGET1(JFORM,166+(J-1)*JBYTES).NE.1H )) GO TO 15013 IF(IGET2(JFORM,159+(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.GT.IUMAX) GO TO 1525 NOF=1 GO TO 15015 C -FOUND SPECS, SET A/I BIT & ILENTH IF ASCII. 1525 IF(IGET1(JFORM,35+(J-1)*JBYTES).EQ.1HI) GO TO 1526 CALL SETBT(JFORM(24+(IQST-1)*JWORDS),0,1) 1526 IF((JVAL.LT.1).OR.(JVAL.GT.ILENTH)) GO TO 15003 IF(IFLG.EQ.1) ISTART=JVAL C -THE FOLLOWING ROUTINE CKS THAT ONLY STRING INPUT FOR IMAGE CARDS IF(INEW.EQ.1) J=IQST C -IMAGE CARD INPUT? IF(IGET1(JFORM,35+(J-1)*JBYTES).NE.1HI) GO TO 1527 C -YES. STRING? IF(JFORM(50+(IQST-1)*JWORDS).NE.0) GO TO 15017 1527 CALL MOVCA(JOUT,1,JFORM,(39+(IQST-1)*JBYTES),2) IF(IFLG.NE.0) ITYPX=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 15003 IEND=JVAL ITYPX=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) ITYPX=1 C C ++++++++++++++++++++++++++ C-----TYPE V BADGE READER EDITS. C ++++++++++++++++++++++++++ C 1550 IF(ISBIT(ITT,5)) GO TO 15501 CALL BLAN(JFORM,43+(IQST-1)*JBYTES,5) GO TO 1575 15501 ISTART=0 IEND=0 ILENTH=10