IDENTIFICATION DIVISION.
PROGRAM-ID. ECRBUF.
*	GENERATEUR DE DESCRIPTION COBOL D'APRES LES .FRM
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
 SOURCE-COMPUTER. VAX-11.
 OBJECT-COMPUTER. VAX-11.
SPECIAL-NAMES.
	SYMBOLIC CHARACTERS ESCX TABX LFX FFX SONN CRX
	 ARE 28 10 11 13 08 14
	DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT ENTREE ASSIGN TO ".FRM"
		STATUS IS ST-IN.
	SELECT SORTIE ASSIGN TO ".LIB".
DATA DIVISION.
FILE SECTION.
FD ENTREE
	LABEL RECORDS ARE STANDARD
	VALUE OF ID IS ENTREE-ID.
01	DUBIDON 		PIC X(132).
01	ENTREE-RECORD.
	05	ENT-ELT		PIC X OCCURS 80 TIMES.
FD SORTIE
	VALUE OF ID IS SORTIE-ID
	LABEL RECORD IS STANDARD
	RECORD VARYING FROM 1 TO 80
	DEPENDING ON OUT-L.
01	SORTIE-RECORD		PIC X(80).
01	SSSSS.
	05	CIN		PIC X OCCURS 80.
*
WORKING-STORAGE SECTION.
01	Z-TRAV		PIC X(80).
01	OUT-L	PIC 999	COMP.
01	ST-IN 	PIC XX.
01	HT-COMP PIC 999 COMP VALUE 9.
01	TAB REDEFINES HT-COMP PIC X.
01	STAT			PIC S9(4).
01	ENTREE-ID			PIC X(30).
01	SORTIE-ID		PIC	X(30).
01	DEB			PIC S999 COMP.
01	LONG			PIC S999 COMP.
01	I1			PIC S999 COMP.
01	I-D			PIC S999 COMP.
01	Z-NOM.
	03	FILLER		PIC X	VALUE "E".
	03	Z-NUM		PIC 999.
	03	FILLER		PIC X	VALUE "-".
	03	Z-NCHA		PIC X(15).	
01	B-DET.	
	03	FILLER	PIC X		VALUE TABX.
	03	B-LEVEL	PIC 99.
	03	FILLER	PIC X		VALUE TABX.
	03	B-NOM	PIC X(20).
	03	FILLER	PIC X		VALUE TABX.
	03	FILLER	PIC X		VALUE TABX.
	03	FILLER	PIC XXX		VALUE "PIC".
	03	FILLER	PIC XXX		VALUE SPACES.
	03	B-DES	PIC X(20).
01 INDICE.
	05	I-REC			PIC	9(10).
	05	I			PIC	9(10).
	05	I-TOT			PIC	9(10).
	05	I-BUF			PIC	9(10).
01 Z-REC.
   03 	Z-1.
	05	W-CLAUSE-TXT		PIC X(5).
		88	DEBUT		VALUE "DEBUT".
		88	CHAMP		VALUE "CHAMP".
	05	FILLER			PIC X(5).
   03 	Z-2.
	05	I-LIG			PIC	9(5).
   03 	Z-3.
	05	I-COL			PIC	9(5).
   03 	Z-4.
	05	Z-TYPE			PIC	X(10).
   03 	Z-5.
	05	Z-ATSAI			PIC	X(10).
   03 	Z-6.
	05	Z-ATVIS			PIC	X(10).
01	POUBELLE			PIC 	X(20).
01	NBR-CHA				PIC 9999.
01	LC1.
	05	FILLER			PIC X VALUE "*".
	05	FILLER			PIC X VALUE TABX.
	05	FILLER			PIC X VALUE TABX.
	05	FILLER			PIC X VALUE TABX.
	05	FILLER			PIC X(10) VALUE 
		"Champ No :".
	05	FILLER			PIC X VALUE TABX.
	05	E-CHA			PIC ZZZ9.
01	LC2.
	05	FILLER			PIC X VALUE "*".
	05	FILLER			PIC X VALUE TABX.
	05	FILLER			PIC X VALUE TABX.
	05	FILLER			PIC X VALUE TABX.
	05	E-REC			PIC X(60).	
*
01	T-REC.
   03   T-1.
	05	T-CLAUSE-TXT		PIC X(6).
	05	NO-CHA			PIC 9(4).
    03  T-4.
	05	TY-1				PIC 	X.
	88	TYPS9				VALUE " ".
	88	TYP9				VALUE "+".
	05	D-1				PIC	X.
		88 ALPHA			VALUE "A".
		88 NUM				VALUE "D".
	05	TY-2				PIC	X(4) SYNC RIGHT.
	05	D-2				PIC	X.
		88 PTS				VALUE ".".
	05	TY-3				PIC	X(4) SYNC RIGHT.
01	I-DEC 				PIC	9(4).
01	I-ENT 				PIC	9(4).
01	DELIT-ENT		PIC X.
01	NO-ECR		PIC 999.
01	W-LIBEL-TXT.
	05	W-LIBEL-ELT	PIC X OCCURS 80 TIMES.
01	SW-TXT			PIC 9.
	88	TXT-COM			VALUE 1.
	88	TXT-CLS			VALUE 2.
01	TYPE-PIC	PIC 9.
*
/
PROCEDURE DIVISION.
DECLARATIVES.
ERREUR SECTION.
    USE AFTER STANDARD ERROR PROCEDURE ON ENTREE.
END DECLARATIVES.
PGM SECTION.
BEG.
	MOVE	SPACES	TO	ENTREE-ID, SORTIE-ID.
DEMNOM.
	MOVE SPACES TO ENTREE-ID.
	DISPLAY "nom du fichier (.FRM) en entree - Return=fin ? : "
		WITH NO ADVANCING.
	ACCEPT ENTREE-ID	AT END STOP RUN.
	IF ENTREE-ID = SPACES STOP RUN.
	MOVE ENTREE-ID TO SORTIE-ID.
	OPEN	INPUT	ENTREE OUTPUT SORTIE.
	IF ST-IN NOT = "00"
		DISPLAY	"ECRBUF -- ERR. OUV. FICHIER ENTREE " ST-IN
		GO TO DEMNOM.
LECT.
	MOVE	SPACES	TO	ENTREE-RECORD.
	READ	ENTREE	AT END
		GO TO	FIN.
	INSPECT ENTREE-RECORD REPLACING ALL TABX BY SPACES.
	MOVE ENTREE-RECORD  TO E-REC.
	MOVE LC2	TO SORTIE-RECORD.
*	PERFORM COMPTAGE.
	MOVE 0 TO I-D.
LL.
	ADD 1 TO I-D.
	IF I-D > 80 GO TO LECT.
	IF ENT-ELT (I-D) = SPACES GO TO LL.
	MOVE ENTREE-RECORD(I-D:80) 	TO Z-TRAV.
	DISPLAY Z-TRAV.
TST-CHAMP.
	MOVE SPACES TO Z-REC.
	UNSTRING	Z-TRAV DELIMITED BY
		ALL SPACE OR "," OR "." 
		INTO Z-1 Z-2 Z-3 Z-4 Z-5 Z-6	POUBELLE.
	IF DEBUT	GO TO C-DEBUT.
	IF CHAMP	GO TO C-CHAMP.
	GO TO	LECT.
FIN.
	CLOSE	ENTREE	SORTIE.
	GO TO DEMNOM.
C-DEBUT.
	UNSTRING Z-TRAV DELIMITED BY ALL SPACE
		INTO POUBELLE NO-ECR.
	MOVE	NO-ECR TO Z-NUM.
	GO TO LECT.
C-CHAMP.
	MOVE Z-TRAV	TO E-REC.
	MOVE SPACES TO T-REC.
	DISPLAY "NOM DU CHAMP (En-?) :" WITH NO ADVANCING.
	ACCEPT 	Z-NCHA AT END GO TO FIN.
	MOVE	0 TO I-LIG, I-COL, I-ENT, I-DEC.
	UNSTRING	Z-TRAV DELIMITED BY
		"," 
		INTO Z-1 Z-2 Z-3 Z-4 Z-5 Z-6 POUBELLE.
	UNSTRING W-CLAUSE-TXT DELIMITED BY SPACES OR TABX 
		INTO T-CLAUSE-TXT 	NO-CHA.
	IF NO-CHA NOT NUMERIC	MOVE 0 TO NO-CHA 
				ADD 1 TO NBR-CHA.
	MOVE NO-CHA TO E-CHA.
	IF NO-CHA = 0 MOVE NBR-CHA	TO E-CHA.
	IF Z-NCHA = SPACES MOVE NBR-CHA TO Z-NCHA.
*
	UNSTRING Z-TYPE DELIMITED BY "A" OR "D" OR "."
	INTO TY-1 DELIMITER IN D-1 TY-2 DELIMITER IN D-2 TY-3.
A-TY2.
	MOVE 0 TO I-ENT.
	IF TY-2 = SPACES	GO TO A-TY3.
	MOVE 5 TO DEB.
	MOVE 1 TO LONG.	
L-TY2.
	SUBTRACT 1 FROM DEB.
	IF DEB < 1 GO TO A-TY3.
	IF TY-2 (DEB:LONG) = SPACES GO TO L-TY2.
	MOVE TY-2(1:DEB) TO I-ENT.
A-TY3.
	MOVE 0 TO I-DEC.
	IF TY-2 = SPACES	GO TO EP-0.
	MOVE 5 TO DEB.
	MOVE 1 TO LONG.	
L-TY3.
	SUBTRACT 1 FROM DEB.
	IF DEB < 1 GO TO EP-0.
	IF TY-3 (DEB:LONG) = SPACES GO TO L-TY3.
	MOVE TY-3(1:DEB) TO I-DEC.
EP-0.
	MOVE SPACES TO 	B-NOM	B-DES.
	MOVE 5	TO B-LEVEL.
	MOVE 0 TO I-D DEB.
	ADD 1 TO DEB.
	MOVE 1 TO LONG.
	MOVE	"E" TO B-NOM(DEB:LONG).
	ADD LONG TO DEB.
	MOVE 3 TO LONG.
	IF Z-NUM > 100	MOVE 2 TO LONG.
	IF Z-NUM > 10	MOVE 1 TO LONG.
	MOVE	Z-NUM TO B-NOM(DEB:LONG).
	ADD LONG TO DEB.
	MOVE 1 TO LONG.
	MOVE	"-" TO B-NOM(DEB:LONG).
	ADD LONG TO DEB.
	MOVE 15 TO LONG.
	MOVE	Z-NCHA TO B-NOM(DEB:LONG).
EP-1.
	MOVE 0 TO DEB.
	ADD 1 TO DEB.
	MOVE 1 TO LONG.
	IF (NOT ALPHA) AND TYPS9
			MOVE "S" TO B-DES(DEB:LONG)
			ADD LONG TO DEB.
	IF NUM		MOVE "9" TO B-DES(DEB:LONG)
	ELSE		MOVE "X" TO B-DES(DEB:LONG).
	ADD LONG TO DEB.
	IF I-ENT = 1 GO TO EP-31.
EP-2.
	MOVE "(" TO B-DES(DEB:LONG).
	ADD LONG TO DEB.
	MOVE 1 TO LONG.
	MOVE 0 TO I-D.
L-EP-2.
	ADD 1 TO I-D.
	IF I-D > 4	GO TO EP-3.
	IF TY-2(I-D:1) = SPACE GO TO EP-3.
	MOVE TY-2(I-D:1) TO B-DES(DEB:LONG).
	ADD LONG TO DEB.
	GO TO L-EP-2.
EP-3.
	MOVE ")" TO B-DES(DEB:LONG).
EP-31.
	ADD LONG TO DEB.
	IF ALPHA GO TO EP-5.
	MOVE 1 TO LONG.
	IF NOT PTS GO TO EP-5.
	MOVE "V" TO B-DES(DEB:LONG).
	ADD LONG TO DEB.
	MOVE I-DEC	TO I-D.
EP-4.
	IF I-D < 1	GO TO EP-5.
	MOVE "9" TO B-DES(DEB:LONG)
	ADD LONG TO DEB.
	SUBTRACT 1 FROM I-D.
	GO TO EP-4.
EP-5.
	MOVE "." TO B-DES(DEB:LONG).
	ADD LONG TO DEB.
	DISPLAY "".
	DISPLAY B-DET.
	MOVE B-DET	TO SORTIE-RECORD.
	PERFORM COMPTAGE.
	DISPLAY	LC1.
	MOVE LC1	TO SORTIE-RECORD.
	PERFORM COMPTAGE.
	DISPLAY "".
	GO TO LECT.
COMPTAGE	SECTION.
C1.
	MOVE 80		TO I1.
COMPTCAR.
	IF I1 = 0  GO TO AP-COMPTCAR.
	IF CIN (I1) NOT = SPACE GO TO AP-COMPTCAR.
	SUBTRACT 1 FROM I1.
	GO TO COMPTCAR.
AP-COMPTCAR.
	MOVE I1	TO OUT-L.
	WRITE SORTIE-RECORD.
