FTN4 PROGRAM TGP6(5), 92080-1X363 REV.2026 800428 C C SOURCE 92080-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(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),ILNGT(4,4) DIMENSION JOUT(10),ITGP4(3),ITGP7(3),ITGP12(3),ITGP1(3) DIMENSION IHP5(3),IHP60(11),IHP61(6),IHP62(3),IHP63(7),IHP7(4) DIMENSION IHP8(6),IBUF(52),IBUF1(52),ISTAT(10),KBUF(16) DIMENSION IBUF2(52),IHP64(4),IHP65(8),IHP66(5),IHP67(9) DIMENSION IHP68(8),IHP69(6) C LOGICAL JPAR,ISBIT,NAMCK,GETBK,OKABT,ISBTW C EQUIVALENCE(JOUT,KFORM(1000)) EQUIVALENCE(NOF,KFORM(1900)),(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/170/ DATA JWORDS/85/ 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,16,17,18,19,5,20,6,7,21,22/ DATA IHP61/3,16,17,7,21,22/ DATA IHP62/7,21,22/ DATA IHP63/17,5,20,6,7,21,22/ DATA IHP64/17,7,21,22/ DATA IHP65/3,16,5,20,6,7,21,22/ DATA IHP66/3,16,7,21,22/ DATA IHP67/3,16,17,5,20,6,7,21,22/ DATA IHP68/3,16,17,18,19,7,21,22/ DATA IHP69/3,16,17,7,21,22/ DATA IHP7/0,8,0,0/ DATA IHP8/10,12,11,15,24,13/ DATA ILNGT/0,1,5,5,25,37,41,53,7,7,7,7,29,35,29,35/ 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 15 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 ITLOG=0 IF(IAND(ITT,2000B).EQ.0) ITLOG=ITLOG+5 IF(IAND(ITT,20210B).NE.0) ITLOG=ITLOG+17 IF(IAND(ITT,22210B).EQ.0) ITLOG=ITLOG+17 IF(IAND(ITT,10B).NE.0) ITLOG=ITLOG+4 IF(IAND(ITT,1B).NE.0) ITLOG=ITLOG+11 IF(IAND(ITT,2B).NE.0) ITLOG=ITLOG+15 IF(IAND(ITT,3B).EQ.3) ITLOG=ITLOG+1 16 IF((ISCRN.NE.17).OR.(.NOT.ISBIT(ITT,1))) GO TO 12 IF(IAND(IMFLG,100000B).EQ.100000B) ITLOG=71 12 IF(INDIC.EQ.-77) GO TO 3011 IF(.NOT.(GETBK(ILU,KFORM,ITLOG,IMODE))) 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 D NERR=1501 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 D NERR=1505 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 D NERR=1510 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 C -DISPLAY? 1518 IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1519 C -YES. GO TO SCREEN 15. ISCRN=16 GO TO 1002 C C -BLANK OUT SCR 15 FIELDS IN JFORM. 1519 CALL BLAN(JFORM,101+(IQST-1)*JBYTES,46) GO TO 1610 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 -"DELETE ALREADY DEFINED ON THIS ITEM" 1488 CALL MES06(43,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=0 IF(IAND(ITT,2000B).EQ.0) GO TO 1601 CALL BLAN(JFORM,101+(IQST-1)*JBYTES,3) JOUT1=0 GO TO 1603 1601 NOF=NOF+1 CALL ERLIT(ILITE,-IQST) IF(JPAR(KFORM,ITLOG,NOF,JOUT,2,IFLG,JVAL)) GO TO 3000 C -"ILLEGAL FOR TM" IF(ISBIT(ITT,10) .AND. IFLG.NE.0) GO TO 1692 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 1602 C-----LIGHT 0? IF(JVAL3.EQ.0) GO TO 1602 IF((JVAL.LT.1).OR.(JVAL.GT.14)) GO TO 1182 IF(ILITE(JVAL).EQ.-99) GO TO 1183 C C-----WILL DISPLAYED VALUE BE USED AS DEFAULT? C 1602 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 1603 IF(IAND(ITT,20210B).NE.0.OR.IAND(ITT,22210B).EQ.0) .GO TO 1604 CALL BLAN(JFORM,107+(IQST-1)*JBYTES,16) GO TO 1605 1604 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,16,IFLG,JVAL))GO TO 3000 CCC "ILLEGAL FOR TM" CCC IF(ISBIT(ITT,10) .AND. IFLG.NE.0) GO TO 1692 CALL MOVCA(JOUT,1,JFORM,107+(IQST-1)*JBYTES,16) C C PRINTER QUESTIONS (MUST BE SPECIFIED IN SCREEN 41) C C-----ON-LINE AND/OR SUMMARY C C -PRINTER? 1605 CALL BLAN(JFORM,104+(IQST-1)*JBYTES,1) IF(IAND(ITT,10B).NE.0) GO TO 1606 C -NO. BLANK OUT FIELD IN JFORM. CALL BLAN(JFORM,105+(IQST-1)*JBYTES,2) GO TO 1610 C 1606 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL))GO TO 3000 IF(IFLG.EQ.0) GO TO 1607 IF(JOUT.NE.1H .AND.JOUT.NE.1HX) GO TO 1184 1607 CALL MOVCA(JOUT,1,JFORM,105+(IQST-1)*JBYTES,1) NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF(IFLG.EQ.0) GO TO 1608 IF(JOUT.NE.1H .AND.JOUT.NE.1HX) GO TO 1184 1608 CALL MOVCA(JOUT,1,JFORM,106+(IQST-1)*JBYTES,1) 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 1693 1617 CALL MOVCA(JOUT,1,JFORM,(134+(IQST-1)*JBYTES),6) IFLG0=IFLG C C-----DATA SET NAME (6 ASCII CHAR, REQD FOR IMAGE ITEM NAME) C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IF(IFLG0.EQ.3 .AND. IFLG.NE.3) GO TO 1691 IF(IFLG0.NE.3 .AND. IFLG.EQ.3) GO TO 1681 CALL MOVCA(JOUT,1,JFORM,140+(IQST-1)*JBYTES,6) C C-----WILL TOTAL 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 CALL MOVCA(JOUT,1,JFORM,146+(IQST-1)*JBYTES,1) C-----NOW CHECK THAT THERE WON'T BE MORE THAN 4 TOTAL ITEMS. ISUM=0 DO 1618 IXST=1,IQST IF(IGET1(JFORM,146+(IXST-1)*JBYTES).NE.2HX ) GO TO 1618 ISUM=ISUM+1 IF(ISUM.GT.4) GO TO 1185 1618 CONTINUE 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 IF(IX.NE.IY) GO TO 1688 IF(IX.NE.0) GO TO 1650 IF(IAND(IMAI(2*IQST,4),377B).NE.JFORM(25+(IQST-1)*JWORDS)) C GO TO 1689 C-----IS THIS A DISPLAY ITEM? 1642 IF(IGET1(JFORM,2+(IQST-1)*JBYTES).EQ.1H ) GO TO 1650 C-----YES, STORE THE IMAGE ITEM LENGTH. JFORM(66+(IQST-1)*JWORDS)=IAND(IMAI(2*IQST,4),377B) C C ASSIGN LIGHT # NOW FOR THIS DISPLAY IF LIGHT ALREADY USED C ISSUE A WARNING . C 1650 CONTINUE 1654 IQ=-IQST C-----LIGHT 0? IF((JOUT1.EQ.2H0 ).OR.(JOUT1.EQ.2H 0).OR.(JOUT1.EQ.2H00)) * GO TO 16321 IF(ISTAT.EQ.0) GO TO 1632 IF(JVAL3.NE.JVAL4) ISTAT=0 1632 CALL LIGHT(IQ,JVAL3,JOUT1,ISTAT,JFORM,ILITE) IF(ISTAT.EQ.0) GO TO 1630 IF(ISTAT.EQ.-1) GO TO 1181 CALL HLP06(23,1) ISTAT=1 JVAL4=JVAL3 GO TO 15 C-----LIGHT # IS 0. 16321 JFORM(51+(IQST-1)*JWORDS)=2H00 C C*********************************************************************** C C GO TO PROCESS NEXT QUESTION C C*********************************************************************** C 1630 IQST=IQST+1 IF(IQST.GT.(IUMAX+IMMAX)) GO TO 1634 ISCRN=11 GO TO 1000 1634 ISCRN=17 GO TO 1002 C C ERROR PROCESSING SCREEN 15 C C C ILLEGAL DISPLAY VALUE TYPE C 1680 CALL MES06(10,NOF) GO TO 15 C C FIELD MUST BE BLANK C 1681 CALL MES06(11,NOF) GO TO 15 C C MISSING DISPLAY ITEM NAME C 1683 CALL MES06(27,NOF) GO TO 15 C C MISSING DISPLAY ITEM TYPE C 1684 CALL MES06(28,NOF) GO TO 15 C C MISSING DISPLAY PROGRAM NAME C 1685 CALL MES06(29,NOF) GO TO 15 C C CANNOT SPECIFY BOTH USER WRITTEN MODULE & DATA ITEM C 1686 CALL MES06(33,NOF) GO TO 15 C C MISSING DISPLAY VALUE DEFINITION C 1687 CALL MES06(34,NOF) GO TO 15 C C THE DISPLAYED VALUE (DEFAULT VALUE) AND THE ANSWER MUST BE OF THE C SAME TYPE C 1688 CALL MES06(14,NOF) GO TO 15 C C DISPLAYED VALUE AND ANSWER MAX STRING LENGTH MUST BE EQUAL C 1689 CALL MES06(16,NOF) GO TO 15 C-----"FIELD MUST BE O, S, OS, OR SO" 1690 CALL MES06(37,NOF) GO TO 15 C-----"DATA SET REQUIRED" 1691 CALL MES06(38,NOF) GO TO 15 C "ILLEGAL FOR TIME REPORTING TERMINAL" 1692 CALL MES06(40,NOF) GO TO 15 C "USER WRITTEN MODULE OR DATA ITEM REQUIRED" 1693 CALL MES06(42,NOF-3) GO TO 15 C C*********************************************************************** C C SCREEN 16 ( SYSTEM ADDED INFORMATION ) C C********************************************************************** C 1900 NOF=1 DO 1920 I=1,4 C C X IF NEEDED C IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF((JOUT.NE.2H ).AND.(JOUT.NE.2HX )) GO TO 1184 IF(I.NE.4) GO TO 1902 IF(.NOT.ISBIT(ITT,10)) GO TO 1902 IF(IFLG.EQ.0) GO TO 1981 1902 IFLG1=IFLG NOF=NOF+1 CALL MOVCA(JOUT,1,MFORM,I,1) C C IMAGE ITEM NAME (ONLY IF IMAGE STORAGE) C IF(ISBIT(IMFLG,15)) GO TO 1908 CALL BLAN(MFORM,6*I-1,6) CALL BLAN(MFORM,28+I,1) CALL BLAN(MFORM,33+6*(I-1),6) GO TO 1920 1908 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IF((IFLG.NE.0).AND.(IFLG1.EQ.0)) GO TO 1681 IFLG2=IFLG CALL MOVCA(JOUT,1,MFORM,(6*I-1),6) C C-----GET DATA SET NAME(REQD FOR IMAGE ITEM) C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IF(IFLG.NE.0 .AND. IFLG2.EQ.0) GO TO 1681 IF(IFLG.EQ.0 .AND. IFLG2.NE.0) GO TO 1691 CALL MOVCA(JOUT,1,MFORM,33+6*(I-1),6) C C IMAGE OPERATION CODE U OR A C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF((IFLG.NE.0).AND.(IFLG2.EQ.0)) GO TO 1681 IF((IFLG.EQ.0).AND.(IFLG2.NE.0)) GO TO 1980 IF(IFLG.EQ.0) GO TO 1910 IF((JOUT(1).NE.2HA ).AND.(JOUT(1).NE.2HU )) GO TO 1980 1910 NOF=NOF+1 CALL MOVCA(JOUT,1,MFORM,(28+I),1) 1920 CONTINUE C C IF STORAGE IMAGE CALL TGP12 FOR IMAGE PROCESSING C IF(.NOT.(ISBIT(IMFLG,15))) GO TO 1930 INDIC=-8 CALL EXEC(8,ITGP12) C C RETURN FROM TGP12 (INFORMATION SUCCESSFULLY PROCESSED) C 1925 INDIC=0 C C CALL SCREEN 17 C 1930 ISCRN=18 GO TO 1002 C C ERROR SECTION SCREEN 16 C 1980 CALL MES06(30,NOF) GO TO 15 C -"REQD FOR TIME REPORTING TRANS" 1981 CALL MES06(39,NOF) GO TO 15 C C************************************************************************ C C SCREEN 17 (DATA STORAGE DEFINITION) C C************************************************************************ C C FILE NAME # 2 C 1700 NOF=1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IFLG2=IFLG IF(IFLG.EQ.0) GO TO 1704 IF(NAMCK(JOUT)) GO TO 1788 IFLG2=1 1704 CALL MOVEW(JOUT,LFORM(4),3) C C FILE SECURITY CODE C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IF((IFLG.NE.0).AND.(IFLG2.EQ.0)) GO TO 1782 IF(IFLG.GT.1) GO TO 1787 IF(JVAL.EQ.-32768) GO TO 1783 CALL MOVEW(JOUT,LFORM(10),3) C C C CR # ? C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 C -IS CR# GIVEN BUT FILE NAME BLANK? IF(IFLG.NE.0 .AND. IFLG2.EQ.0) GO TO 1781 C -NO. ARE BOTH CR# & FILE NAME BLANK? IF(IFLG.EQ.0 .AND. IFLG2.EQ.0) GO TO 1706 C -NO. CR# FIELD BLANK? IF(IFLG.EQ.0) GO TO 1706 C NO. INTEGER? IF(IFLG.NE.1) GO TO 1705 C YES. IF(JVAL.LT.1) GO TO 1783 GO TO 1706 C ASCII? 1705 IF(IFLG.NE.3) GO TO 1783 C YES. LEFT JUSTIFY IT & MAKE SURE IT IS A VALID 2 CHAR CR#. CALL JUSTF(JOUT,1,6,1) IF(LNCAR(JOUT,1,6).GT.2) GO TO 1783 IF(ISBTW(IGET1(JOUT,1),1HA,1HZ)) GO TO 1783 I=IGET1(JOUT,2) IF(ISBTW(I,1HA,1HZ) .AND. ISBTW(I,1H0,1H9) .AND. ISBTW(I,1H ,1H )) .GO TO 1783 1706 CALL MOVEW(JOUT,LFORM(7),3) C C SHARED ACCESS TO DISC FILE? C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,1,IFLG,JVAL)) GO TO 3000 IF(JOUT.NE.1H .AND.JOUT.NE.1HX) GO TO 1184 IF(IFLG.NE.0.AND.IFLG2.EQ.0) GO TO 1781 CALL MOVCA(JOUT,1,LFORM,30,1) C C FILE NAME # 1 C NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,6,IFLG,JVAL)) GO TO 3000 IFLG1=IFLG IF(IFLG.EQ.0) GO TO 1702 IF(NAMCK(JOUT)) GO TO 1788 IFLG1=1 1702 CALL MOVEW(JOUT,LFORM,3) C C STORAGE PROGRAM ? C IF(.NOT.ISBIT(ITT,0)) GO TO 1710 NOF=NOF+1 IF(JPAR(KFORM,ITLOG,NOF,JOUT,5,IFLG,JVAL)) GO TO 3000 IF(IFLG.EQ.0) GO TO 1712 IF(NAMCK(JOUT)) GO TO 1485 IFLG=1 1712 CALL MOVCA(JOUT,1,LFORM,25,5) 1710 IF((IFLG+IFLG1+IFLG2.EQ.0).AND.(.NOT.ISBIT(ITT,1))) GO TO 1786 IF(.NOT.ISBIT(ITT,0)) CALL BLAN(LFORM,25,5) C C IF TR TYPE >1 INSERT IMAGE EDITS C 1715 IF(.NOT.ISBIT(ITT,1)) GO TO 1720 C C********************************************************************** C C B U I L D I M A G E E D I T S . C C********************************************************************** C C GENERATES IMAGE EDIT FOR ADD OPERATION ONLY FOR KEY ITEMS C C C IMAGE ADD EDITS C C NO EDITS ON NON KEY ITEMS C C K IS IMAGE OPERATION # C C -ADD? 1100 IF(.NOT.(ISBIT(IMFLG,0))) GO TO 1300 C -YES, GENERATE IMAGE ADD EDITS. C DO 1299 I=1,39,2 K=IAND(IMAI(I,2),7) C -ADD? IF(K.NE.2) GO TO 1299 C -YES. KEY ITEM? IF(.NOT.(ISBIT(IMAI(I,2),3))) GO TO 1299 C -YES. IS IT A KEY IN A MASTER OR DETAIL DATA SET? IF(.NOT.(ISBIT(IMAI(I,2),15))) GO TO 1200 C C MASTER DATA SET ADD. C C KEY ITEM : CODE EDIT 2 + LOCK C IMAI(I,2)=IOR(IMAI(I,2),2200B) IMAI(I,3)=IOR(IMAI(I,3),IALF2(IMAI(I,3))) GO TO 1299 C C DETAIL DATA SET ADD. C C GIVEN: KEY ITEM IN A DTL C FIND : WHETHER THE LINKED MASTERS ARE M OR A. IF M & NO ADD C IS ALREADY DEFINED IN IT, SET EDIT CODE 1 & LOCK BIT. C IF A, DON'T HAVE TO GENERATE IMAGE EDIT. C 1200 ITN=IAND(IMAI(I,1),377B) IDS=IAND(IMAI(I,3),377B) C -SET ADD IN DTL FLAG SO THAT LOCK BIT FOR ALL CK EXIST. WILL BE SET. IADDS=1 C C -FIND ITEMS EQUIVALENT TO THIS ITEM. CALL ITEQU(ITN,IDS,KBUF,IBASE) C -LOOP 1290 GOES THRU THE LIST OF EQUIVALENT ITEMS & IF IT IS C -IN A MANUAL MASTER THAT DOESN'T ALREADY HAVE AN ADD DEFINED C -IN INTO IT, IMAGE EDIT CODE 1 + LOCK BIT IS SET & THE DATA SET C -UPON WHICH THE IMAGE EDIT (MORE THAN LIKELY A CHECK EXISTENCE) C -IS PICKED UP. DO 1290 L=1,16 D WRITE(6,1222) L,KBUF(L) D1222 FORMAT(" TGP6 : KBUF(",I2,") =",@7) IF(KBUF(L).EQ.0) GO TO 1290 ITNX=IAND(KBUF(L),377B)