FTN4
      PROGRAM TGPI2(5), 92080-1X377 REV.2026  800416        
C 
C     SOURCE 92080-18377
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 INTERFACE  *
C*   TGP WITH IMAGE . ACCORDING TO INDIC VALUE DIFFERENT TASKS ARE   *
C*   EXECUTED :                                                      *
C*                                                                   *
C*   IF :  INDIC = 0 : COMPILATION OF IMAGE INFORMATION AT THE       *
C*                     QUESTION LEVEL . THE RESULTS OF THIS COMPIL-  *
C*                     ATION ARE STORED IN THE IMAI BUFFER .         *
C*                     REQUEST FROM TGP9 FOR ADD,FIND,UPDATE AND     *
C*                     CHECK EXISTENCE OPERATIONS .                  *
C*                     REQUEST FROM TGP6 FOR DELETE AND DISPLAY      *
C*                     OPERATIONS .                                  *
C*        INDIC = -8 : PROCESS SYSTEM ADDED INFORMATION . REQUEST    *
C*                     FROM TGP6 .                                   *
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)
C 
C  LOCAL VARIABLES *************
C 
      DIMENSION ITGP9(3),IBUF(128),ID(3),IER(3),ITGP6(3),KBUF(16) 
      DIMENSION IADBF(10),ISTAT(10),NAMSET(6),IBUF1(128),IBUF2(128) 
C 
      LOGICAL ISBIT,ISSPA 
C 
      DATA ITGP9/2HTG,2HP9,2H  /
      DATA ITGP6/2HTG,2HP6,2H  /
      DATA JBYTES/170/
      DATA JWORDS/85/ 
C 
C***********************************************************************
C 
C   GO TO THE REQUIRED PORTION OF TGP12 
C 
C********************************************************************** 
C 
C 
      IF(INDIC.EQ.-1)  PAUSE 1203 
      IF(INDIC.EQ.-6)  PAUSE 1204 
      IF(INDIC.EQ.0) GO TO 95 
C 
C*********************************************************************
C 
C   INDIC = -8    SYSTEM ADDED INFORMATION PROCESSING 
C 
C*********************************************************************
C 
C  IX IS ITEM COUNT 1/5 
C 
      IX=1
      INDIC=2 
80    IF(IGET1(MFORM,IX).NE.1HX) GO TO 3030 
      IF(.NOT.(ISSPA(MFORM,6*IX-1,6))) GO TO 3030 
      N=40+IX 
C     "MOVE DATA ITEM NAME TO ID" 
      CALL MOVCA(MFORM,6*IX-1,ID,1,6) 
C     "MOVE DATA SET NAME TO NAMSET"
      CALL MOVCA(MFORM,33+6*(IX-1),NAMSET,1,6)
      IMAI(N,2)=1 
      IF(IGET1(MFORM,28+IX).EQ.1HA) IMAI(N,2)=2 
      GO TO 110 
C 
C************************************************************************ 
C 
C   INDIC = 0  IMAGE COMPILATION AT THE QUESTION LEVEL
C 
C************************************************************************ 
C 
C 
C 
C  N IS A POINTER TO THE CURRENT LINE IN IMAI 
C 
C  ID CONTAINS THE ITEM NAME
C  NAMSET CONTAINS THE DATA SET NAME
C 
C 
C************************************************************************ 
C 
C   GET ITEM AND DATA SET CHARACTERISTICS AND STORE IN IMAI BUFFER
C 
C************************************************************************ 
C 
C 
95    IF(ISCRN.EQ.16) GO TO 100 
      N=2*IQST-1
      CALL MOVCA(JFORM,(27+(IQST-1)*JBYTES),ID,1,6) 
C     "MOVE DATA SET NAME TO NAMSET"
      CALL MOVCA(JFORM,147+(IQST-1)*JBYTES,NAMSET,1,6)
      IF(ISCRN.EQ.15) GO TO 120 
      GO TO 110 
100   CALL MOVCA(JFORM,(134+(IQST-1)*JBYTES),ID,1,6)
      N=2*IQST
C     "MOVE DATA SET NAME TO NAMSET"
      CALL MOVCA(JFORM,140+(IQST-1)*JBYTES,NAMSET,1,6)
C 
C  NOW FILL IN THE IMAI LINE
C 
C 
C  GET DATA ITEM NUMBER 
C 
110   CALL DBINF(IBASE,ID,101,ISTAT,IBUF) 
D     NERROR=1
D     CALL EDUMP(NERROR,N,IMAI(N,1),ID,ISTAT,IBUF)
      IF(ISTAT.NE.0) GO TO 3000 
      IMAI(N,1)=IBUF(1) 
      IF(IMAI(N,1).LT.0) IMAI(N,1)=-1*IMAI(N,1) 
C 
C  CHECK TO MAKE SURE THAT THE ITEM BEING DEALT WITH IS NOT A 
C  SORT ITEM TRYING TO BE UPDATED.
C 
C 
      IF(IAND(IMAI(N,2),7B).NE.1) GO TO 11816 
      CALL DBINF(IBASE,NAMSET,301,ISTAT,IBUF) 
      IF(ISTAT.NE.0) GO TO 3000 
      DO 11805 IZ=1,IBUF(1) 
      IF(IBUF(3*IZ+1).EQ.0) GO TO 11805 
      IF(IBUF(3*IZ+1).NE.IAND(IMAI(N,1),377B)) GO TO 11805
      IMES=41 
      GO TO 3010
11805 CONTINUE
C 
C  GET DATA ITEM CHARACTERISTICS
C 
11816 CALL DBINF(IBASE,IMAI(N,1),102,ISTAT,IBUF)
D     NERROR=2
      IF(ISTAT.NE.0) GO TO 3000 
C     "CALCULATE ITEM'S LENGTH" 
      ITMLTH=IBUF(10)*IBUF(11)
C     "PUT DATA TYPE INTO LOWER BYTE" 
      IBUF(9)=IALF2(IBUF(9))
D     CALL EDUMP(NERROR,ITMLTH,IMAI(N,1),ID,ISTAT,IBUF) 
C 
C  CHECK THAT ITEM TO STORE TRANSACTION HEADER INFO (DATE,TIME..) 
C  HAS A GOOD FORMAT. ITEM MUST BE ASCII & AS FOLLOWS:
C      IX                LENGTH MUST BE(BYTES)
C     ----               -------------- 
C       1  TRANS ID            4
C       2  TERM #              2
C       3  DATE                6
C       4  TIME                4
C 
      IF(ISCRN.NE.17) GO TO 118 
      IF(IGET1(IBUF,18).NE.2HX ) GO TO 115
      IF((IX.EQ.1).AND.(ITMLTH.NE.4)) GO TO 115 
      IF((IX.EQ.2).AND.(ITMLTH.NE.2)) GO TO 115 
      IF((IX.EQ.3).AND.(ITMLTH.NE.6)) GO TO 115 
      IF((IX.EQ.4).AND.(ITMLTH.NE.4)) GO TO 115 
      GO TO 118 
C 
115   IMES=24 
C     "ITEM DOES NOT HAVE THE REQD TYPE OR LENGTH TO STORE THIS INFORMATION"
      GO TO 3010
C 
C 
C  DATA SET TO WHICH ITEM BELONG
C 
118   CALL DBINF(IBASE,NAMSET,201,ISTAT,IBUF) 
      IF(ISTAT.NE.0) GO TO 3000 
      IF(IBUF(1).LT.0) IBUF(1)=-1*IBUF(1) 
      IMAI(N,3)=IBUF(1) 
      NDS=IBUF(1) 
C 
C  SEARCH TYPE (KEY OR NON-KEY ITEM)
C 
C     -USE ITEQU TO DETERMINE IF THIS ITEM IS A KEY OR NON-KEY
      ITMX=IAND(IMAI(N,1),377B) 
      IDSX=IAND(IMAI(N,3),377B) 
      CALL ITEQU(ITMX,IDSX,KBUF,IBASE)
      IF(KBUF(1).EQ.-1) GO TO 1181
C     -THE ITEM IS A KEY, SET BIT 3 OF IMAI(N,2)
      CALL SETBT(IMAI(N,2),3,1) 
C 
C 
C ITEM TYPE 
C 
1181  IBUF(9)=IAND(IBUF(9),377B)
C     -INTEGER?           YES.
      IF(IBUF(9).EQ.111B) IMAI(N,2)=IOR(IMAI(N,2),10000B) 
C     -REAL?              YES.
      IF(IBUF(9).EQ.122B) IMAI(N,2)=IOR(IMAI(N,2),20000B) 
C 
C  ITEM LENGTH
C 
      IMAI(N,4)=IBUF(10)*IBUF(11) 
C 
C-----DETERMINE ITEM'S OFFSET IN ITS DS RECORD. 
C 
      CALL DBINF(IBASE,NDS,104,ISTAT,IBUF1) 
      IF(ISTAT.NE.0) GO TO 3000 
D     NERROR=31 
D     CALL EDUMP(NERROR,NDS,N,IBUF,ISTAT,IBUF1) 
      IOFT=1
C     -ONLY 1 ITEM IN THE RECORD? 
      IF(IBUF1(1).EQ.1) GO TO 1185
C     -NO.
C 
      DO 1183 I=1,IBUF1(1)
         IF(IBUF1(I+1).LT.0) IBUF1(I+1)=-1*IBUF1(I+1) 
C        -FIND THE CORRECT DATA ITEM YET? 
         IF(IBUF1(I+1).EQ.IMAI(N,1)) GO TO 1185 
C        -NO. 
         CALL DBINF(IBASE,IBUF1(I+1),102,ISTAT,IBUF2) 
         IF(ISTAT.NE.0) GO TO 3000
D     NERROR=41 
D     CALL EDUMP(NERROR,IBUF1(I+1),IMAI(N,1),IBUF1,ISTAT,IBUF2) 
C        -CALCULATE ITEM'S LENGTH.
         ITMLTH=IBUF2(10)*IBUF2(11) 
C        -IF ITEM IS STRING, CONVERT ITS LENGTH TO WORDS. 
         IF(IGET1(IBUF2,17).EQ.1HX)  ITMLTH=(ITMLTH+1)/2
         IOFT=IOFT+ITMLTH 
1183  CONTINUE
C 
C     -ERROR. ITEM NOT FOUND. 
D     NERROR=1183 
D     CALL EDUMP(NERROR,ITMLTH,IOFT,IBUF2,ISTAT,IBUF2)
      IMES=40 
      GO TO 3010
C 
C     -STORE THE ITEM'S OFFSET IN THE DS RECORD.
1185  IMAI(N,4)=IOR(IMAI(N,4),IOFT*256) 
C 
C  GET DATA SET CHARACTERISTICS 
C 
      CALL DBINF(IBASE,NDS,202,ISTAT,IBUF)
D     NERROR=4
D     CALL EDUMP(NERROR,NDS,IMAI(N,4),IBUF2,ISTAT,IBUF) 
      IF(ISTAT.NE.0) GO TO 3000 
C     -ERR IF DS ACCESSED > 512 WORDS/RECORD (TMS LIMITATION).
      IF(IBUF(10).LE.512) GO TO 1187
      IMES=39 
      GO TO 3010
C 
C  DATA SET TYPE
C 
C     "PUT DS TYPE INTO LOWER BYTE" 
1187  IBUF(9)=IALF2(IBUF(9))
      IBUF(9)=IAND(IBUF(9),377B)
C     -CK FOR MANUAL MASTER.
      IF(IBUF(9).EQ.115B) IMAI(N,2)=IOR(IMAI(N,2),100000B)
C     -CK FOR AUTOMATIC MASTER. 
      IF(IBUF(9).EQ.101B) IMAI(N,2)=IOR(IMAI(N,2),140000B)
C 
C-----ERROR IF ADD TO A DETAIL DS WHICH DOESN'T HAVE ANY KEYS.
C 
C    -DETAIL? 
      IF(IBUF(9).NE.104B) GO TO 119 
C    -YES. ADD OPERATION? 
      IF(IAND(IMAI(N,2),7).NE.2) GO TO 119
C    -YES. GET DATA SET INFO & TEST FOR NO KEYS.
      CALL DBINF(IBASE,NDS,301,ISTAT,IADBF) 
D     NERROR=5
      IF(ISTAT.NE.0) GO TO 3000 
      IF(IADBF(1).NE.0) GO TO 119 
C    -ERR "THIS ITEM'S DS HAS NO KEYS--ADD CANNOT BE DONE"
      IMES=38 
      GO TO 3010
C 
C-----SCR 16? 
119   IF(ISCRN.NE.17) GO TO 120 
C-----YES.  ADD?
      IF(IAND(IMAI(N,2),7).NE.2) GO TO 120
C-----YES.  ADD TO MSTR?
      IF(.NOT.ISBIT(IMAI(N,2),15)) GO TO 120
C-----YES.  IS THE ITEM A KEY IN THE MSTR?
      IF(.NOT.ISBIT(IMAI(N,2),4)) GO TO 120 
C     -YES.  PRINT ERR MSG, "ITEM CANNOT BE KEY IN A MASTER". 
      IMES=33 
      GO TO 3010
C 
C 
C  IMAGE FUNCTION ? 
C 
C 
120   I=IAND(IMAI(N,2),7B)
C 
C*********************************************************************
C 
C     IMAGE OPERATION IS ADD   FIRST CHECKS ONLY
C 
C********************************************************************** 
C 
C  CHECK IF OPERATION IS ADD THAT NO EQUIVALENT KEY ITEM HAS BEEN 
C  DEFINED FOR AN OTHER ADD 
C 
      IF(I.NE.2) GO TO 180
      IF(.NOT.(ISBIT(IMAI(N,2),3))) GO TO 160 
      ITMX=IAND(IMAI(N,1),377B) 
      IDSX=IAND(IMAI(N,3),377B) 
      CALL ITEQU(ITMX,IDSX,KBUF,IBASE)
      IF(KBUF.NE.-1) GO TO 130
      CALL DBCLS(IBASE,ID,1,ISTAT)
      IF(ISTAT.NE.0) STOP 431 
      STOP 432
130   DO 140 J=1,16 
         IF(KBUF(J).EQ.0) GO TO 140 
C        -THE FOLLOWING ROUTINE SEARCHES THRU IMAI TO LOOK FOR AN ADD ON
C        -THE ITEM IN KBUF(J).  IF A MATCH IS ALSO FOUND ON DS#--ERROR. 
         DO 135 L=1,45,2
C           -DON'T CK THE ARG ITEM THAT IS BEING PROCESSED. 
            IF(N.EQ.L) GO TO 135
C           -ADD? 
            IF(IAND(IMAI(L,2),7).NE.2) GO TO 135
C           -YES.  SAME DATA ITEM?
            IF(IMAI(L,1).NE.IAND(KBUF(J),377B)) GO TO 135 
C           -YES.  SAME DATA SET? 
            K=IALF2(KBUF(J))
            K=IAND(K,377B)
C           GO TO ERROR IF SAME DATA SET. 
            IF(K.EQ.IAND(IMAI(L,3),377B)) GO TO 150 
C 
C--- THE FOLLOWING WAS ADDED TO ALLOW ADDS TO VARIOUS 
C    SETS OF ITEMS THAT ARE COMMON. NORMAL OPERATIONS 
C    DO NOT ALLOW EXPLICIT ADDS OF EQUIVALENT ITEMS-
C    THEY ARE IMPLICITLY ADDED IF OTHER ITEMS OF A SET
C    ARE ADDED. 
C 
C           IF(K.NE.IAND(IMAI(L,3),377B)) GO TO 135 
C           CALL DBINF(IBASE,K,104,ISTAT,IBUF)
C           IF(ISTAT.NE.0) GO TO 3000 
C           IHOLD=IBUF(1) 
C           CALL DBINF(IBASE,K,301,ISTAT,IBUF)
C           IF(ISTAT.NE.0) GO TO 3000 
C           IF(IHOLD.EQ.IBUF(1)) GO TO 135
C           GO TO 150 
C 
135      CONTINUE 
140   CONTINUE
      GO TO 160 
150   K=IAND(KBUF(J),377B)
      CALL DBINF(IBASE,K,102,ISTAT,IBUF)
D     NERROR=6
      IF(ISTAT.NE.0) GO TO 3000 
      CALL MOVEW(IBUF,IER,3)
      IMES=22 
      GO TO 3010
C 
C 
C     BUILD BUFFER TO CONTAIN DATA SET # TO ADD 
C     KFORM(1060) IS # OF DATA SETS 
C     .........1......1ST DATA SET #
C             .      .
C     KFORM(1076) IS 16TH DATA SET #
C 
C     CHECK THAT NO MORE THAN 5 IMAGE OPERATIONS ARE DEFINED
C 
160   K=IAND(IMAI(N,3),377B)
      IF(KFORM(1060).NE.0) GO TO 165
      KFORM(1060)=1 
      KFORM(1061)=K 
      GO TO 180 
165   DO 170 J=1,KFORM(1060)
      IF(KFORM(1060+J).EQ.K) GO TO 180
170   CONTINUE
      J=0 
      IF(IAND(IMFLG,14B).NE.0) J=1
      IF(J+KFORM(1060).LT.16) GO TO 175 
      IMES=21 
      GO TO 3010
175   KFORM(1060)=KFORM(1060)+1 
      KFORM(1060+KFORM(1060))=K 
C 
C 
C*******************************************************************
C 
C  DISPATCH IMAGE OPERATIONS
C 
C******************************************************************** 
C 
180   IF(I.EQ.3) GO TO 200
      IF(I.EQ.0) GO TO 300
      IF(I.EQ.2) GO TO 450
      GO TO 500 
C 
C******************************************************************** 
C 
C--IMAGE FUNCTION IS CHECK AGAINST DATA BASE (IE, CHECK EXISTENCE)
C 
C******************************************************************** 
C 
C-----1ST TEST, CE ONLY ALLOWED IN MASTER (NOT IN DETAIL) 
200   IF(ISBIT(IMAI(N,2),15)) GO TO 201 
C-----"CHECK EXISTENCE ONLY ALLOWED IN MASTER DS" 
      IMES=30 
      GO TO 3010
C 
C  PREREQUISITE KEY ITEM, NO FIND OR STORAGE ON SAME DATA-SET 
C 
C-----CHECK EXISTENCE IS INCOMPATIBLE WITH FIND IN SAME DATA SET
C 
C-----IS THERE A FIND PREVIOUSLY DEFINED? 
201   IF(.NOT.ISBIT(IMFLG,1)) GO TO 204 
      K=-1
C-----DONE SEARCHING IMAI FOR A FIND? 
202   K=K+2 
      IF(K.GT.N) GO TO 204
C-----FIND? 
      IF(IMAI(K,1).EQ.0) GOTO 202 
      IF(IAND(IMAI(K,2),7B).NE.0) GO TO 202 
C-----FOUND ONE, NOW SEE IF IT IS IN SAME DATA SET. 
      IF(NDS.NE.IAND(IMAI(K,3),377B)) GO TO 202 
C-----"CHECK EXISTENCE INCOMPATIBLE WITH FIND IN SAME DATA SET" 
      IMES=28 
      GO TO 3010
C 
C-----CHECK EXISTENCE IS INCOMPATIBLE WITH ADD IN SAME DS.
C 
204   IF(.NOT.ISBIT(IMFLG,0)) GO TO 210 
      K=-1
206   K=K+2 
C-----DONE SEARCHING IMAI FOR ADD?
      IF(K.GT.N) GO TO 210
C-----ADD?
      IF(IAND(IMAI(K,2),7B).NE.2) GO TO 206 
C-----YES, NOW SEE IF CE & ADD ARE IN SAME DS.
      IF(NDS.NE.IAND(IMAI(K,3),377B)) GO TO 206 
C-----"CHECK EXISTENCE INCOMPATIBLE WITH ADD IN SAME DS"
      IMES=1
      GO TO 3010
C 
210   IF(ISBIT(IMAI(N,2),3)) GO TO 215
      IMES=2
      GO TO 3010
C 
C  CREATE IMAGE EDITS FOR CHECK AGAINST DATA BASE 
C 
C  ITEM BELONGS TO A MASTER . EDIT CODE 1 
C 
215   IF(.NOT.(ISBIT(IMAI(N,2),15))) GO TO 220
      IMAI(N,2)=IOR(IMAI(N,2),100B) 
      GO TO 230 
C 
C  ITEM BELONGS TO A DETAIL DATA SET . CODE EDIT 4
C 
220   IMAI(N,2)=IOR(IMAI(N,2),400B) 
      IMAI(N,1)=IOR(IMAI(N,1),IMAI(N,1)*256)
230   IMAI(N,3)=IOR(IMAI(N,3),IMAI(N,3)*256)
      INDIC=3 
C 
C  SET CHECK FLAG 
C 
      IMFLG=IOR(IMFLG,20B)
      GO TO 3030
C 
C***********************************************************************
C 
C  IMAGE FUNCTION IS FIND 
C 
C********************************************************************** 
C 
C  FIND MUST BE U  QUESTION 
C 
300   IF(IQST.LE.IUMAX) GO TO 302 
      IMES=5
      GO TO 3010
C-----IS THERE A CHECK EXISTENCE PREVIOUSLY DEFINED?
302   IF(.NOT.ISBIT(IMFLG,4)) GO TO 305 
C-----SEARCH IMAI FOR CHECK EXISTENCE.
      K=-1
C-----DONE SEARCHING IMAI FOR CHECK EXISTENCE?
303   K=K+2 
      IF(K.GT.N) GO TO 305
C-----CHECK EXISTENCE?
      IF(IAND(IMAI(K,2),7B).NE.3) GO TO 303 
C-----FOUND ONE, NOW SEE IF IT IS IN SAME DATA SET AS THE FIND. 
      IF(NDS.NE.IAND(IMAI(K,3),377B)) GO TO 303 
C-----"FIND INCOMPATIBLE WITH CHECK EXISTENCE IN SAME DATA SET" 
      IMES=29 
      GO TO 3010
C 
C  NO DELETE,UPDATE BEFORE FIND 
C 
305   N1=IAND(IMFLG,14B)
      IF(N1.EQ.0) GO TO 310 
      IMES=14 
      GO TO 3010
C 
C  THE FOLLOWING SECTION APPLIES IF THE ITEM BELONGS TO A DETAIL D.S. 
C 
310   IF(ISBIT(IMAI(N,2),15)) GO TO 360 
C 
C  FIRST QUESTION ASSOCIATED WITH FIND MUST BE KEY ITEM 
C 
      IF((IMAS.NE.0).OR.(IMDT.NE.0)) GO TO 315
      IF(ISBIT(IMAI(N,2),3)) GO TO 315
      IMES=7
      GO TO 3010
C 
C  IS THERE ALREADY A FIND IN A MASTER D.S. IF YES CHECK MASTER 
C  AND DETAIL ARE LINKED
C 
C  GET KEY ITEM# OF MASTER
C 
315   IF(IMAS.EQ.0) GO TO 330 
C=====DO NOT ALLOW FIND IN A MASTER/DETAIL COMBINATION !!!
      GOTO 335
CXX    "THE FOLLOWING LINES ARE DEAD CODE"
CX     CALL DBINF(2HI ,3,IMAS,IBUF) 
CX     IF(IBUF.NE.0) GO TO 3000 
CX
CX  GET LINKED DATA SET # TO MASTER 
CX
CX     CALL DBINF(2HS ,4,IBUF(3),IBUF)
CX     IF(IBUF.NE.0) GO TO 3000 
CX
CX     DO 320 I=1,IBUF(2) 
CX     IF(IBUF(2*I+1).EQ.NDS) GO TO 330 
CX320  CONTINUE 
CX     GOTO 335 
C 
C  ALREADY FIND IN DETAIL ? 
C  IF YES CHECK ITEM BELONGS TO THAT DATA SET 
C 
330   IF(IMDT.EQ.0) GO TO 340 
      IF(IMDT.EQ.NDS) GO TO 340 
335   IMES=6
      GO TO 3010
C 
340   IMDT=NDS
C 
C   SET IMKY (KEY ITEM TO DRIVE THE FIND IN THE DETAIL D.S.)
C 
      IF(.NOT.(ISBIT(IMAI(N,2),3))) GO TO 350 
      IF(IMKY.EQ.0) IMKY=IAND(IMAI(N,1),377B) 
350   GO TO 410 
C 
C 
C  THIS SECTION APPLIES TO FIND IF THE ITEM BELONGS TO A MASTER 
C  DATA SET 
C 
C 
C  CHECK THAT THERE IS NO FIND OPERATIONS IN OTHER MASTER DATA SETS 
C  AND THAT ITEM IS KEY ITEM
C 
C 
360   IF(ISBIT(IMAI(N,2),3)) GO TO 370
      IMES=9
      GO TO 3010
370   IF(IMAS.EQ.0) GO TO 380 
      IMES=6
      GO TO 3010
C 
C  CHECK THAT NO FIND IN DETAIL D.S IS DEFINED
C 
380   IF(IMDT.EQ.0) GO TO 400 
      IMES=6
      GO TO 3010
C 
400   IMAS=NDS
C 
C  END OF FIND PROCESSING SET FIND FLAG 
C 
410   IMFLG=IOR(IMFLG,2)
      INDIC=3 
      GO TO 3030
C 
C 
C***********************************************************************
C 
C   IMAGE OPERATION IS ADD
C 
C********************************************************************** 
C 
C 
C   CHECK THAT :  - NO ADD IN AUTOMATIC MASTER DATA SET 
C                 - ITEM TO ADD IN A MASTER MUST BE U QUESTION
C                 - CHECK AGAINST DATA BASE IS NOT ON SAME DATA-SET 
C                 - NO DELETE IS DEFINED
C 
C-----ADD INCOMPATIBLE WITH CHECK EXISTENCE IN THE SAME DATA SET
C 
450   K=-1
452   K=K+2 
C-----DONE SEARCHING IMAI?
      IF(K.GT.N) GO TO 458
C-----CHECK EXISTENCE?
      IF(IAND(IMAI(K,2),7).NE.3) GO TO 452
C-----YES, NOW SEE IF IT IS IN SAME DATA SET. 
      IF(IAND(IMAI(N,3),377B).NE.IAND(IMAI(K,3),377B)) GO TO 452
C-----ERR "CHECK EXISTENCE INCOMPATIBLE WITH ADD/UPDATE/DELETE IN SAME DS"
      IMES=1
      GO TO 3010
458   IF(.NOT.(ISBIT(IMFLG,2))) GO TO 460 
      IMES=23 
      GO TO 3010
460   IF(.NOT.(ISBIT(IMAI(N,2),15))) GO TO 480
      IF(.NOT.(ISBIT(IMAI(N,2),14))) GO TO 470
      IMES=11 
      GO TO 3010
470   IF((IQST.LE.IUMAX).OR.(ISCRN.EQ.17)) GO TO 480
      IMES=12 
      GO TO 3010
C 
C 
C 
C    IF ITEM TO ADD BELONG TO "TRANSACTION HEADER" (ISCRN=17) CHECK : 
C          - ITEM IS NOT KEY IN MASTER D.S. 
C          - IF ITEM IS KEY IN DETAIL D.S. MASTER MUST BE AUTOMATIC 
C 
480   IF(ISCRN.NE.17) GO TO 487 
      IF(.NOT.(ISBIT(IMAI(N,2),3))) GO TO 487 
      IF(.NOT.(ISBIT(IMAI(N,2),15))) GO TO 483
      IMES=19 
      GO TO 3010
C 
483   K=IAND(IMAI(N,1),377B)
      CALL DBINF(IBASE,K,204,ISTAT,IBUF)
D     NERROR=7
      IF(ISTAT.NE.0) GO TO 3000 
      IF(IBUF(2).LT.0) IBUF(2)=-1*IBUF(2) 
      CALL DBINF(IBASE,IBUF(2),202,ISTAT,IBUF)
D     NERROR=8
      IF(ISTAT.NE.0) GO TO 3000 
C     -ERR IF DS ACCESSED > 512 WORDS/RECORD (TMS LIMITATION).
      IF(IBUF(10).LE.512) GO TO 485 
      IMES=39 
      GO TO 3000
C 
485   IF(IGET1(IBUF,17).EQ.1HA) GO TO 487 
      IMES=20 
      GO TO 3010
C 
C   END OF ADD PROCESSING SET ADD AND IMAGE STORAGE FLAG
C 
487   IMFLG=IOR(IMFLG,100001B)
      INDIC=3 
      GO TO 3030
C 
C***********************************************************************
C 
C   IMAGE OPERATION IS DISPLAY,UPDATE OR DELETE  (5,1,4)
C 
C************************************************************************ 
C 
C 
C   VERIFY FIND OR CHECK AGAINST DATA BASE IS ALREADY DEFINED 
C 
500   IF(ISBIT(IMFLG,1)) GO TO 510
C-----DISPLAY?
      IF(I.EQ.5) GO TO 502
C-----"A FIND MUST HAVE BEEN PREVIOUSLY DEFINED"
      IMES=13 
      GO TO 3010
C-----FUNCTION IS DISPLAY, VERIFY THAT A CHECK EXISTENCE HAS BEEN DEFINED.
502   IF(ISBIT(IMFLG,4)) GO TO 510
C-----"A FIND OR CHECK EXISTENCE MUST HAVE PREVIOUSLY BEEN DEFINED" 
      IMES=26 
      GO TO 3010
C-----IF NOT DISPLAY, GO TO DELETE/UPDATE ROUTINE.
510   IF(I.NE.5) GO TO 513
C 
C 
C 
C************************************************************************ 
C 
C  IMAGE OPERATION IS DISPLAY 
C 
C************************************************************************ 
C 
C-----"DISPLAY FROM DETAIL DATA-SET MUST BE DURING M-QUESTION"
      IMES=32 
      IF(.NOT.ISBIT(IMAI(N,2),15) .AND. IQST.LE.IUMAX)  GOTO 3010 
C 
C-----DETERMINE IF A FIND OR CHECK EXISTENCE HAS ALREADY BEEN DEFINED 
C     FOR THIS DATA SET, AND WHICH ONE IT IS. 
C     IF ANOTHER DISPLAY HAS BEEN PREVIOUSLY DEFINED, THIS DISPLAY MUST 
C     BE FROM THE SAME DATA SET. IF NOT, IT CANNOT BE DONE. 
C 
      K=N 
      KL=0
551   K=K-2 
C-----DONE SEARCHING BACKWARDS FOR DISPLAY, FIND, OR CHECK EXISTENCE IN 
C     IMAI? IF NO FIND OR CHECK EXISTENCE IS FOUND, PRINT ERROR MESSAGE.
C-----"A FIND OR CHECK EXISTENCE MUST BE PREVIOUSLY DEFINED FOR THIS ITEM"
      IMES=26 
      IF(K.LT.1) GO TO 3010 
C-----FAF?
      IF(K.NE.2*IUMAX) GO TO 555
C-----SEARCH FORWARD FOR A FIND IN A DETAIL DURING U-QUESTION 
C     BIT 9 IN IMAI(N,2) MAY NOT BE SET YET.
      DO 5531 KK=1,K,2
      IF(IMAI(KK,1).EQ.0) GO TO 5531
      IF(IAND(IMAI(KK,2),140007B).EQ.0) GO TO 5532
5531  CONTINUE
      GO TO 555 
5532  KL=1
      IF(NDS.EQ.IAND(IMAI(KK,3),377B)) GO TO 556
C-----CHECK EXISTENCE OR FIND IN A MASTER?
555   IF(IMAI(K-1,1).EQ.0) GO TO 5555 
      KK=IAND(IMAI(K-1,2),7)
      IF(KK.EQ.3) GO TO 5553
      IF(KK.NE.0) GO TO 5555
      IF(.NOT.ISBIT(IMAI(K-1,2),15)) GO TO 5555 
5553  KL=1
      IF(NDS.EQ.IAND(IMAI(K-1,3),377B)) GO TO 556 
C-----DISPLAY?
5555  IF(IMAI(K,1).EQ.0) GO TO 551
      IF(IAND(IMAI(K,2),7).NE.5) GO TO 551
      IF(IAND(IMAI(K,3),377B).EQ.NDS) GO TO 556 
C-----NO, "DISPLAY FROM ANOTHER DATA SET ALREADY DEFINED" 
      IMES=31 
C-----IF CHECK/FIND FOUND BEFORE THE DISPLAY, PRINT 
C     "A FIND OR CHECK EXISTENCE MUST BE PREVIOUSLY DEFINED FOR THIS ITEM"
      IF(KL.EQ.1) IMES=26 
      GO TO 3010
C 
C 
C-----THE FOLLOWING RESTRICTIONS FOR TOTAL ITEMS MUST BE CHECKED FOR: 
C     1. TOTAL ITEM CANNOT BE FROM A MASTER DS
C     2. DELETE CANNOT BE DEFINED ON THE SAME DATA SET
C     3. UPDATE CANNOT BE DEFINED ON THE SAME DATA SET
C     4. MUST BE INTEGER OR REAL
C-----MAKE SURE BIT 15 OF IMAI(N,5) IS CLEAR
556   CALL SETBT(IMAI(N,5),15,0)
C-----IS THIS A TOTAL DISPLAY?
      IF(IGET1(JFORM,146+(IQST-1)*JBYTES).NE.1HX) GO TO 557 
C-----THIS IS A TOTAL ITEM. IS IT FROM A MASTER DS? 
      IF(ISBIT(IMAI(N,2),15)) GO TO 5562
C-----NO. DELETE PREVIOUSLY DEFINED?
      IF(ISBIT(IMFLG,2)) GO TO 5563 
C-----NO. UPDATE PREVIOUSLY DEFINED?
      IF(ISBIT(IMFLG,3)) GO TO 5564 
C-----MUST BE INTEGER OR REAL 
      IF(IAND(IMAI(N,2),30000B).EQ.0) GO TO 5565
C-----YES. EVERYTHING OK, SET TOTAL BITS. 
      CALL SETBT(IMFLG,6,1) 
      CALL SETBT(IMAI(N,5),15,1)
      GO TO 557 
C-----ERRORS IN PROCESSING TOTAL DISPLAY. 
C 
C     "CANNOT TOTAL IN A MASTER DATA SET" 
5562  IMES=34 
      GO TO 3010
C     "TOTAL DISPLAY INCOMPATIBLE WITH DELETE"
5563  IMES=35 
      GO TO 3010
C     "TOTAL DISPLAY INCOMPATIBLE WITH UPDATE"
5564  IMES=36 
      GO TO 3010
C     "TOTALED ITEM MUST BE INTEGER OR REAL"
5565  IMES=37 
      GO TO 3010
C 
C-----EVERYTHING OK, NOW SET THE DISPLAY BIT. 
557   CALL SETBT(IMFLG,5,1) 
      INDIC=5 
      GO TO 3030
C 
C***********************************************************************
C 
C  IMAGE OPERATION IS DELETE OR UPDATE
C 
C********************************************************************** 
C 
C-----UPDATE INCOMPATIBLE WITH CHECK EXISTENCE IN THE SAME DS.
C 
513   IF(I.EQ.4) GO TO 600
      IF((NDS.EQ.IMAS).OR.(NDS.EQ.IMDT)) GO TO 520
C-----"ITEM DOES NOT BELONG TO THE ENTRY ISOLATED BY A FIND"
      IMES=15 
      GO TO 3010
C 
C  IF FIND IN MASTER AND DETAIL LINKED ITEM MUST BELONG 
C  TO DETAIL DATA SET 
C 
520   IF(.NOT.((NDS.EQ.IMAS).AND.(IMDT.NE.0))) GO TO 530
      IMES=15 
      GO TO 3010
C 
C  FOR UPDATE IF :
C   ITEM BELONGS TO A MASTER DATA SET IT MUST BE U QUESTION (UPDATE ONLY) 
C   ..................DETAIL.....................M......... 
C 
530   IF(NDS.NE.IMAS) GO TO 540 
      IF((IQST.LE.IUMAX).OR.(ISCRN.EQ.17)) GO TO 600
      IMES=17 
      GO TO 3010
540   IF((IQST.GT.IUMAX).OR.(ISCRN.EQ.17)) GO TO 600
      IMES=18 
      GO TO 3010
600   K=1 
C-----DONE SEARCHING FOR UPATE? 
6010  IF(K.GT.N) GO TO 6020 
C-----CHECK EXISTENCE?
      IF(IAND(IMAI(K,2),7B).EQ.3) GO TO 6012
      GO TO 6013
C-----YES, NOW SEE IF IT IS IN SAME DATA SET. 
6012  IF(NDS.EQ.IAND(IMAI(K,3),377B)) GO TO 6014
6013  K=K+2 
      GO TO 6010
C-----ERR "CHECK EXISTENCE INCOMPATIBLE WITH UPDATE IN SAME DATA SET" 
6014  IMES=1
      GO TO 3010
C 
C-----DELETE INCOMPATIBLE WITH CHECK EXISTENCE IN SAME DATA SET.
C 
C-----DELETE?