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