FTN4 PROGRAM TGP6(5), 92903-16363 REV.1913 790131 1300 C C SOURCE 92903-18363 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 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 14,15 * C* 16 AND 17 . * C* THE ANSWERS AFTER A CHECK ARE STORED IN JFORM , * C* MFORM AND LFORM . * 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 TGP12 AN ERROR HAS OCCURED IN * C* IMAGE PROCESSING ( DISPLAY, DELETE,SYSTEM * C* ADDED INFO,IMAGE EDITS) . * C* = 2 : RETURN FROM TGP12 . SYSTEM ADDED INFO TO * C* BE INCLUDED IN IMAGE DATA BASE HAS BEEN * C* SUCCESSFULY PROCESSED . * C* = 4 : RETURN FROM TGP12 . IMAGE DELETE OPERATION * C* SUCCESSFULLY PROCESSED . * C* = 5 : RETURN FROM TGP12 . IMAGE DISPLAY SUCCESS- * C* FULLY PROCESSED . * C* = 8 : ERR RETURN FROM TGP7 WHILE COMPILING INTO KFORM * C =-77 : A HELP MESSAGE MUST BE PRINTED * C* * C* WARNING !! : CARE MUST BE TAKEN * : * C* * C* PRINTED SCREEN # 14 CORRESPONDS TO ISCRN = 15 * C* ............... 15 .................... 16 * C* ............... 16 .................... 17 * C* ............... 17 ..................... 18 * 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),ILNGT(4,4) DIMENSION JOUT(10),ITGP4(3),ITGP7(3),ITGP12(3),ITGP1(3) DIMENSION IHP5(3),IHP60(3),IHP61(6),IHB60(4),IHB61(7),IHP7(3) DIMENSION IHP8(5),IBUF(12) C LOGICAL JPAR,ISBIT,NAMCK,GETBK,OKABT C EQUIVALENCE(JOUT,KFORM(1000)) EQUIVALENCE(NOF,KFORM(1015)),(IFLG,KFORM(1016)) EQUIVALENCE(IFLG1,KFORM(1017)),(IFLG2,KFORM(1018)) EQUIVALENCE(JVAL3,KFORM(1019)),(JVAL4,KFORM(1020)) EQUIVALENCE(ISTAT,KFORM(1021)),(JOUT1,KFORM(1022)) C C DATA VALUES : C DATA JBYTES/140/ DATA JWORDS/70/ DATA ITGP3/2HTG,2HP3,2H / DATA ITGP4/2HTG,2HP4,2H / DATA ITGP7/2HTG,2HP7,2H / DATA ITGP12/2HTG,2HPI,2H2 / DATA ITGP1/2HTG,2HP1 ,2H / DATA IHP5/1,14,2/ DATA IHP60/3,4,7/ DATA IHP61/3,4,5,0,6,7/ DATA IHB60/3,4,0,7/ DATA IHB61/3,4,0,5,0,6,7/ DATA IHP7/0,8,0/ DATA IHP8/10,10,11,12,13/ DATA ILNGT/0,1,5,5,25,37,34,46,7,7,7,7,27,33,27,33/ C C********************************************************************* C C ACCORDING TO INDIC VALUE GO TO THE REQUIRED PORTION OF TGP6 C C********************************************************************* C IF(INDIC.EQ.4) GO TO 1512 IF(INDIC.EQ.5) GO TO 1640 IF(INDIC.EQ.2) GO TO 1925 IF(INDIC.EQ.7) PAUSE 0606 C-----ERR RETURN FROM TGP7 IF(INDIC.EQ.8) GO TO 1775 IF(INDIC.EQ.-77) GO TO 3011 C C********************************************************************* C C INDIC = 0 GET THE ANSWERS IN THE SCREEN C C********************************************************************* C ISTAT=0 15 I=IAND(ITT,3B)+1 J=ISCRN-14 ITLOG=ILNGT(I,J) IF(ISCRN.NE.16) GO TO 16 IF(IGET1(IFORM,1515).EQ.1HX) ITLOG=ITLOG+3 16 IF((ISCRN.NE.17).OR.(.NOT.ISBIT(ITT,1))) GO TO 12 IF(IAND(IMFLG,100000B).EQ.100000B) ITLOG=43 12 IF(.NOT.(GETBK(ILU,KFORM,ITLOG))) GO TO 10 C C ERROR IN GETTING ANSWERS REPRINT SCREEN C 17 CALL EXEC(8,ITGP4) C C********************************************************************* C C GO TO ANALYSE USER ANSWERS TO SCREEN # ISCRN C C********************************************************************* C 10 I=ISCRN-14 GO TO(1500,1600,1900,1700) I C C*********************************************************************** C C SCREEN 14 "FUNCTON ONLY EDITS" C C********************************************************************** C C C C RESET IMAGE FLAGS AND BUFFERS C 1500 NOF=1 N=2*IQST-1 CALL ERFLG(N,IMAI,IMKY,IMFLG,IMAS,IMDT) C C CONTINUE TO THE NEXT QUESTION * CHECK ANSWER IS BLANK OR X , IF C X CHECK CONTINUE IS DEFINED C 1501 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184 IFLG1=IFLG IF(IFLG.EQ.0) GO TO 1504 IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1586 DO 1502 I=1,26 DO 1502 J=1,3,2 IF(IKEY(I,J).EQ.11) GO TO 1504 1502 CONTINUE GO TO 1584 1504 CALL MOVCA(JOUT,1,JFORM,(49+(IQST-1)*JBYTES),1) C C NEXT ENTRY IN AN IMAGE CHAIN (TR.TYPE 2 AND 3) * CHECK ANSWER IS C BLANK OR X , IF X NEXT ENTRY MUST BE DEFINED AND A FIND IN A DETAIL C DATA SET MUST BE DEFINED . C IF(ISBIT(ITT,1)) GO TO 1505 CALL BLAN(JFORM,50+(IQST-1)*JBYTES,2) GO TO 1515 1505 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IFLG2=IFLG IF((IFLG.NE.0).AND.(JOUT(1).NE.2HX )) GO TO 1184 IF(IFLG.EQ.0) GO TO 1508 DO 1506 I=1,26 DO 1506 J=1,3,2 IF(IKEY(I,J).EQ.12) GO TO 1507 1506 CONTINUE GO TO 1483 1507 IF(IMDT.EQ.0) GO TO 1484 IF(IQST.LE.IUMAX) GO TO 1487 1508 CALL MOVCA(JOUT,1,JFORM,(50+(IQST-1)*JBYTES),1) C C DELETE ENTRY IN DATA BASE (TR,TYPE 2 OR 3 ONLY) C CHECK ANSWER IS BLANK OR X , IF X CHECK DELETE IS DEFINED C AND GO TO TGP12 TO PROCESS THE IMAGE DELETE C 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.EQ.0) GO TO 1512 DO 1510 I=1,26 DO 1510 J=1,3,2 IF(IKEY(I,J).EQ.13) GO TO 1511 1510 CONTINUE GO TO 1585 C C GO TO TGP12 TO PROCESS IMAGE DELETE C 1511 IMAI(N,2)=4 INDIC=0 CALL EXEC(8,ITGP12) C C HERE RETURN FROM TGP12 (DELETE PROCEESED SUCCESFULLY) C 1512 INDIC=0 CALL MOVCA(JOUT,1,JFORM,(51+(IQST-1)*JBYTES),1) C C********************************************************************* C C CALL DISPLAY INFORMATION SCREEN ? (SCREENS 11 OR 12 OR 13 OR 14) C OR PROCESS NEXT QUESTION C C********************************************************************* C C 1515 IF(IFLG1.NE.0) GO TO 1518 IF(.NOT.ISBIT(ITT,1)) GO TO 1486 IF((IFLG.EQ.0).AND.(IFLG2.EQ.0)) GO TO 1486 1518 IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1630 ISCRN=16 GO TO 1002 C C ERROR PROCESSING SCREEN 14 C 1584 CALL MES06(8,NOF) GO TO 15 1585 CALL MES06(9,NOF) GO TO 15 1586 CALL MES06(13,NOF) GO TO 15 1180 CALL MES06(1,NOF) GO TO 15 1181 CALL MES06(2,NOF) GO TO 15 1182 CALL MES06(3,NOF) GO TO 15 1183 CALL MES06(4,NOF) GO TO 15 1184 CALL MES06(5,NOF) GO TO 15 C-----"NO MORE THAN 4 SUMMARY ITEMS MAY BE DEFINED" 1185 CALL MES06(36,NOF) GO TO 15 1480 CALL MES06(6,NOF) GO TO 15 1483 CALL MES06(7,NOF) GO TO 15 1484 CALL MES06(24,NOF) GO TO 15 1485 CALL MES06(25,NOF) GO TO 15 1486 CALL MES06(26,NOF) GO TO 15 1487 CALL MES06(19,NOF) GO TO 15 C C********************************************************************* C C SCREEN 15 DISPLAYED INFORMATION C C********************************************************************* C C INDICATOR LIGHT # (CHECK LIGTH # IS LEGAL AND NOT ASSIGNED TO SYSTEM C SAVE LIGHT # IN COMMON (EQUIVALENCE) C C FIRST RESET ILITE BUFFER C 1600 NOF=1 CALL ERLIT(ILITE,-IQST) IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 CALL MOVCA(JOUT,1,JFORM,101+(IQST-1)*JBYTES,2) JVAL3=JVAL JOUT1=JOUT(1) IF(IFLG.GT.1) GO TO 1180 IF(IFLG.EQ.0) GO TO 1605 C-----LIGHT 0? IF(JVAL3.EQ.0) GO TO 1605 IF((JVAL.LT.1).OR.(JVAL.GT.15)) GO TO 1182 IF(ILITE(JVAL).EQ.-99) GO TO 1183 C C-----WILL DISPLAYED VALUE BE USED AS DEFAULT? C 1605 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF((IFLG.NE.0).AND.(JOUT.NE.2HX )) GO TO 1184 CALL MOVCA(JOUT,1,JFORM,103+(IQST-1)*JBYTES,1) C C-----DISPLAY LABEL C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,20,IFLG,JVAL))GO TO 3000 CALL MOVCA(JOUT,1,JFORM,106+(IQST-1)*JBYTES,20) C C PRINTER QUESTIONS (MUST BE SPECIFIED IN SCREEN 41) C C-----ON-LINE AND/OR SUMMARY C IF(IGET1(IFORM,1515).NE.2HX )GO TO 1610 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL))GO TO 3000 IF(IFLG.EQ.0) GO TO 1608 IF((JOUT.NE.2HO ).AND. * (JOUT.NE.2H O).AND. * (JOUT.NE.2HS ).AND. * (JOUT.NE.2H S).AND. * (JOUT.NE.2HOS).AND. * (JOUT.NE.2HSO)) GO TO 1690 1608 CALL MOVCA(JOUT,1,JFORM,104+(IQST-1)*JBYTES,2) C C USER WRITTEN DISPLAY MODULES (TR.TYPE 1 OR 3 ONLY) C C NAME OF DISPLAY PROGRAM C 1610 CONTINUE IF(ISBIT(ITT,0)) GO TO 1611 CALL BLAN(JFORM,126+(IQST-1)*JBYTES,5) CALL BLAN(JFORM,133+(IQST-1)*JBYTES,1) JFORM(66+(IQST-1)*JWORDS)=0 GO TO 1620 1611 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,5,IFLG,JVAL)) GO TO 3000 IF((IAND(ITT,3B).EQ.1).AND.(IFLG.EQ.0)) GO TO 1685 IF(IFLG.EQ.0) GO TO 16111 IF(NAMCK(JOUT)) GO TO 1788 16111 IFLG1=IFLG CALL MOVCA(JOUT,1,JFORM,(126+(IQST-1)*JBYTES),5) C C DISPLAYED ITEM TYPE (TR.TYPE 1 OR 3 ONLY) C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF((IFLG1.NE.0).AND.(IFLG.EQ.0)) GO TO 1684 IF((IFLG1.EQ.0).AND.(IFLG.NE.0)) GO TO 1681 JVAL=-1 IF(IFLG.EQ.0) GO TO 1612 IF(JOUT.EQ.2HS ) JVAL=0 IF(JOUT.EQ.2HI ) JVAL=1 IF(JOUT.EQ.2HR ) JVAL=2 IF(JVAL.EQ.-1) GO TO 1680 C C CHECK DEFAULT =DISPLAY VALUES ARE OF SAME TYPE C IFL1=0 IF(IGET1(JFORM,103+(IQST-1)*JBYTES).NE.2HX ) GO TO 1612 JVAL1=JFORM(50+(IQST-1)*JWORDS) IF(JVAL1.EQ.3) GO TO 1612 IF(JVAL.NE.JVAL1) GO TO 1688 IF(JVAL.EQ.0) IFL1=1 1612 JVAL1=JVAL CALL MOVCA(JOUT,1,JFORM,(133+(IQST-1)*JBYTES),1) C C STRING LENGTH (TR TYPE 1 OR 3 ONLY ) C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,3,IFLG,JVAL)) GO TO 3000 IF(IFLG.GT.1) GO TO 1480 IF((JVAL1.NE.0).AND.(IFLG.NE.0)) GO TO 1681 IF((JVAL1.EQ.0).AND.(IFLG.EQ.0)) GO TO 1480 IF(IFLG.EQ.0) JVAL=0 IF(IFLG.EQ.0) GO TO 1616 IF(IFL1.EQ.0) GO TO 1615 IF(JFORM(25+(IQST-1)*JWORDS).NE.JVAL) GO TO 1689 1615 IF((JVAL.LT.1).OR.(JVAL.GT.126)) GO TO 1480 1616 JFORM(66+(IQST-1)*JWORDS)=JVAL C C IMAGE ITEM NAME ( TR. TYPE 2 OR 3 ONLY) C 1620 IF(ISBIT(ITT,1)) GO TO 1621 CALL BLAN(JFORM,134+(IQST-1)*JBYTES,6) GO TO 1631 1621 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IF((IAND(ITT,3B).EQ.2).AND.(IFLG.EQ.0)) GO TO 1683 IF(IAND(ITT,3B).NE.3) GO TO 1617 IF((IFLG.NE.0).AND.(IFLG1.NE.0)) GO TO 1686 IF((IFLG.EQ.0).AND.(IFLG1.EQ.0)) GO TO 1687 1617 CALL MOVCA(JOUT,1,JFORM,(134+(IQST-1)*JBYTES),6) IFLG0=IFLG C C-----WILL SUMMARY ALSO BE DISPLAYED FOR THIS ITEM? C 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(IFLG0.EQ.0 .AND. JOUT.EQ.2HX ) GO TO 1681 C-----NOW CHECK THAT THERE WON'T BE MORE THAN 4 SUMMARY ITEMS. ISUM=0 DO 1618 IXST=1,IQST IF(IGET1(JFORM,140+(IXST-1)*JBYTES).NE.2HX ) GO TO 1618 ISUM=ISUM+1 IF(ISUM.GT.3) GO TO 1185 1618 CONTINUE CALL MOVCA(JOUT,1,JFORM,(140+(IQST-1)*JBYTES),1) C C C CALL TGP12 TO PROCESS IMAGE DISPLAY C 1631 IF((IFLG1.NE.0).AND.(IAND(ITT,3B).NE.2)) GO TO 1650 IMAI(2*IQST,2)=5 INDIC=0 CALL EXEC(8,ITGP12) C C RETURN FROM TGP12 . IMAGE DISPLAY SUCCESSFULLY PROCESSED C C CHECK IF DISPLAYED VALUE=DEFAULT VALUE : C -ITEMS ARE OF SAME TYPE C -STRINGS OF SAME LENGTH C 1640 INDIC=0 IF(IGET1(JFORM,103+(IQST-1)*JBYTES).EQ.1H ) GO TO 1642 IX=JFORM(50+(IQST-1)*JWORDS) IF(IX.EQ.3) GO TO 1650 IY=IAND(IMAI(2*IQST,2),30000B)/4096