1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
| SUBROUTINE LISTE_SOUS_ENSEMBLE_NIV(XNPL,CONTROLE,SOUS,NIV)
EXEC SQL INCLUDE SQLCA
C[------------- DECLARATION RECORD --------------------------]
EXEC SQL INCLUDE 'EM8:[UTIL.INC]FCONTROLE.INC'
RECORD /FCONTROLE/CONTROLE
CHARACTER N_NOMEN*9,XNPL*9,SOUS_PLAN*9,SOUS(400)*9
DIMENSION NIV(400),IC(400,10)
CHARACTER TOTO(400)*31
EXEC SQL DECLARE EXTERNAL B2 ALIAS FILENAME RDB$DB_FT
c EXEC SQL DECLARE TRANSACTION READ ONLY
N_NOMEN=XNPL
DO M=1,400
SOUS(M)=' '
NIV(M)=0
TOTO(M)(1:)=' '
DO LL=1,10
IC(M,LL)=0
ENDDO
ENDDO
L=1
IP=1
SOUS(1)=XNPL
NIV(1)=0
NIV_REF=0
C[------------- INITIALISATION VARIABLE CONTROLE --------------]
CALL STR$UPCASE(CONTROLE.TRANSACTION,CONTROLE.TRANSACTION)
CONTROLE.EXISTE='N' !INITIALISE à 'existe pas'
CONTROLE.NB_RECORD_RDB=1 !NOM de record =0
CONTROLE.STATUS_RDB=0
CONTROLE.TYPE_ERREUR=' '
C[------------- OUVERTURE TRANSACTION SI DEMANDEE -------------]
10 IF(CONTROLE.TRANSACTION.EQ.'O')THEN
EXEC SQL SET TRANSACTION READ ONLY
IF(SQLCOD.NE.0)CALL SYST_ERREUR_SQL(SQLCOD,controle,*10,*10,*999,
, 'LISTE_SOUS_ENSEMBLE/SET TRANS')
ENDIF
C[------------- RECHERCHE ENREGISTREMENT ------- -------------]
11 EXEC SQL DECLARE CUR_SOUS_PLAN CURSOR FOR
, SELECT SOUS_PLAN
, FROM B2.SOUS_PLAN_NOMEN
, WHERE N_NOMEN=:N_NOMEN AND REPERE>0
EXEC SQL OPEN CUR_SOUS_PLAN
20 EXEC SQL FETCH CUR_SOUS_PLAN INTO :SOUS_PLAN
IF(SQLCOD.EQ.0)THEN
CONTROLE.NB_RECORD_RDB=CONTROLE.NB_RECORD_RDB+1
CONTROLE.EXISTE='O' ! ENREGIST EXISTANT
IP=IP+1
SOUS(IP)=SOUS_PLAN
NIV(IP)=NIV_REF+1
ICO=ICO+1
DO IY=1,10
IF(IC(L,IY).NE.0)IC(IP,IY)=IC(L,IY)
IF(IC(L,IY).EQ.0)THEN
IC(IP,IY)=ICO
GO TO 20
ENDIF
ENDDO
GO TO 20
ELSE
EXEC SQL CLOSE CUR_SOUS_PLAN
L=L+1
IF(L.GT.IP)GO TO 40
N_NOMEN=SOUS(L)
NIV_REF=NIV(L)
ICO=0
GO TO 11
ENDIF
C[------------- FIN DE TRANSACTION SI DEMANDEE -------------]
40 CONTINUE
DO I=1,IP
WRITE(TOTO(I),'(10I2,A9,I2)')(IC(I,J),J=1,10),SOUS(I),NIV(I)
ENDDO
CALL TRIFC(TOTO,IP)
DO I=1,IP
READ(TOTO(I),'(20X,A9,I2)')SOUS(I),NIV(I)
ENDDO
EXEC SQL CLOSE CUR_SOUS_PLAN
IF(CONTROLE.TRANSACTION.EQ.'O')THEN
EXEC SQL COMMIT
IF(SQLCOD.NE.0)CALL SYST_ERREUR_SQL(SQLCOD,controle,*10,*40,*999,
, 'LISTE_SOUS_ENSEMBLE/COMMIT')
ENDIF
999 RETURN
END |