FTN4
      PROGRAM TGPI2(5), 92903-16377 REV.1913  790131 0930 
C 
C     SOURCE 92903-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(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 ITGP9(3),IBUF(12),ID(3),IER(3),ITGP6(3),KBUF(5) 
      DIMENSION IADBF(10) 
C 
      LOGICAL ISBIT,ISSPA 
C 
      DATA ITGP9/2HTG,2HP9,2H  /
      DATA ITGP6/2HTG,2HP6,2H  /
      DATA JBYTES/140/
      DATA JWORDS/70/ 
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 
      CALL MOVCA(MFORM,6*IX-1,ID,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 
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,(28+(IQST-1)*JBYTES),ID,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 
C  NOW FILL IN THE IMAI LINE
C 
C 
C  GET DATA ITEM NUMBER 
C 
110   IMODE=5 
      ITYPE=2HI 
      CALL DBINF(ITYPE,IMODE,ID,IBUF) 
      IF(IBUF.NE.0) GO TO 3000
      IMAI(N,1)=IBUF(2) 
C 
C  GET DATA ITEM CHARACTERISTICS
C 
      IMODE=2 
      CALL DBINF(ITYPE,IMODE,IMAI(N,1),IBUF)
      IF(IBUF.NE.0) GO TO 3000
C 
C  CHECK THAT ITEM TO STORE TRANSACTION HEADER INFO (DATE,TIME..) 
C  HAS A GOOD FORMAT
C 
      IF(ISCRN.NE.17) GO TO 118 
      IF(IGET1(IBUF,10).NE.2HU ) GO TO 115
      IF((IX.EQ.2).AND.(IBUF(7).NE.1)) GO TO 115
      IF((IX.EQ.3).AND.(IBUF(7).NE.3)) GO TO 115
      IF((IX.NE.1).AND.(IX.NE.4)) GO TO 118 
      IF(IBUF(7).EQ.2) GO TO 118
115   IMES=24 
      GO TO 3010
C 
C  SEARCH TYPE
C 
118   I=IBUF(5) 
      I=IALF2(IAND(I,177400B))
      IF(I.EQ.1) IMAI(N,2)=IOR(IMAI(N,2),10B) 
C 
C ITEM TYPE 
C 
      IBUF(5)=IAND(IBUF(5),377B)
      IF(IBUF(5).EQ.111B) IMAI(N,2)=IOR(IMAI(N,2),10000B) 
      IF(IBUF(5).EQ.122B) IMAI(N,2)=IOR(IMAI(N,2),20000B) 
C 
C  ITEM LENGTH ,ITEM OFFSET 
C 
      IMAI(N,4)=IBUF(7)*2 
      IMAI(N,4)=IOR(IMAI(N,4),IBUF(8)*256)
C 
C  DATA SET TO WHICH ITEM BELONG
C 
      IMAI(N,3)=IBUF(9) 
      NDS=IBUF(9) 
C 
C  GET DATA SET CHARACTERISTICS 
C 
      ITYPE=2HS 
      CALL DBINF(ITYPE,IMODE,IMAI(N,3),IBUF)
      IF(IBUF.NE.0) GO TO 3000
C 
C  DATA SET TYPE
C 
      IBUF(5)=IAND(IBUF(5),377B)
      IF(IBUF(5).EQ.115B) IMAI(N,2)=IOR(IMAI(N,2),100000B)
      IF(IBUF(5).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(5).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(2HI ,3,IMAI(N,3),IADBF)
      IF(IADBF.NE.0) GO TO 3000 
      IF(IADBF(2).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-----IF SCR 16, ADD TO MSTR IS ILLEGAL 
119   IF(ISCRN.NE.17) GO TO 120 
C-----ADD?
      IF(IAND(IMAI(N,2),7).NE.2) GO TO 120
C-----ERROR IF ADD TO MSTR
      IF(.NOT.ISBIT(IMAI(N,2),15)) GO TO 120
C-----"ADD TO MSTR NOT ALLOWED" 
      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 
      CALL ITEQU(IMAI(N,1),KBUF)
      IF(KBUF.NE.-1) GO TO 130
      STOP 432
130   DO 140 J=1,5
      IF(KBUF(J).EQ.0) GO TO 140
      K=ILIN(IMAI,KBUF(J),2)
      IF(K.NE.-1) GO TO 150 
140   CONTINUE
      GO TO 160 
150   CALL DBINF(2HI ,2,KBUF(J),IBUF) 
      IF(IBUF.NE.0) GO TO 3000
      CALL MOVEW(IBUF(2),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(1065) IS  5TH 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.5) 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
C     CALL DBINF(2HI ,3,IMAS,IBUF)
C     IF(IBUF.NE.0) GO TO 3000
C 
C  GET LINKED DATA SET # TO MASTER
C 
C     CALL DBINF(2HS ,4,IBUF(3),IBUF) 
C     IF(IBUF.NE.0) GO TO 3000
C 
C     DO 320 I=1,IBUF(2)
C     IF(IBUF(2*I+1).EQ.NDS) GO TO 330
C320  CONTINUE
C     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 
                                                                        