IDENTIFICATION DIVISION.
PROGRAM-ID. ECR.
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.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT ENTREE ASSIGN TO ".FRM"
		STATUS IS ST-IN.
	SELECT SORTIE ASSIGN TO ".ECR".
DATA DIVISION.
FILE SECTION.
FD ENTREE
	LABEL RECORDS ARE STANDARD
	VALUE OF ID IS ENTREE-ID
	DATA RECORD IS ENTREE-RECORD.
01	DUBIDON 		PIC X(132).
01	ENTREE-RECORD.
	05	ENT-ELT		PIC X OCCURS 80 TIMES.
FD SORTIE
	RECORD CONTAINS 132 CHARACTERS
	LABEL RECORDS ARE STANDARD
	VALUE OF ID IS SORTIE-ID
	DATA RECORD IS SORTIE-RECORD.
01	SORTIE-RECORD		PIC X(132).
WORKING-STORAGE SECTION.
01	ST-IN 	PIC XX.
01	HT-COMP PIC 999 COMP VALUE 9.
01	TAB REDEFINES HT-COMP PIC X.
01	DELIT-ENT		PIC X.
01	STAT			PIC S9(4).
01	ENTREE-ID			PIC X(30).
01	SORTIE-ID		PIC	X(30).
01	INDICE.
	05	I-ENT			PIC	S9(10).
	05	I-DEC			PIC	S9(10).
	05	I-REC			PIC	S9(10).
	05	I			PIC	S9(10).
	05	I-COL			PIC	S9(10).
	05	I-LIG			PIC	S9(10).
	05	I-TOT			PIC	S9(10).
	05	I-BUF			PIC	S9(10).
01	IMPRESSION.
	05	I-TITRE.
		10	FILLER	PIC X(22) VALUE SPACE.
		10	FILLER	PIC X(17) VALUE "NOM DE L'ECRAN : ".
		10	I-NOM-ECR	PIC X(30).
		10	FILLER	PIC X(9) VALUE "NUMERO : ".
		10	I-NUM-ECR PIC ZZZ.
	05	I-CAD-1.
		10	FILLER	PIC X(12) VALUE SPACE.
		10	FILLER	PIC X VALUE "1".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "2".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "3".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "4".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "5".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "6".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "7".
		10	FILLER	PIC X(9) VALUE SPACE.
		10	FILLER	PIC X VALUE "8".
	05	I-CAD-2.
	10  FILLER PIC X(23) VALUE "   12345678901234567890".
		10  FILLER PIC X(20) VALUE "12345678901234567890".
		10  FILLER PIC X(20) VALUE "12345678901234567890".
		10  FILLER PIC X(20) VALUE "12345678901234567890".
	05	I-BLANC	PIC X(84) VALUE SPACE.
01	MATRICE.
	05	M-LIG-PNT	PIC 99.
	05	M-COL-PNT	PIC 99.
	05	M-LIG OCCURS 24 TIMES.
		10	M-NO-LIG-1	PIC ZZ.
		10	M-SLASH-1	PIC X.
		10	M-COL		PIC X OCCURS 80 TIMES.
		10	M-SLASH-2	PIC X.
		10	M-NO-LIG-2	PIC ZZ.
01	W-CLAUSE.
	05	W-CLAUSE-TXT	PIC X(6).
	05	W-CLAUSE-NO	PIC 99.
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	TABLE-CLAUSE.
	05	T-CLAUSE-TOT-ELT	PIC S9(10) COMP VALUE 15.
	05	T-CLAUSE-I		PIC S9(10).
	05	T-CLAUSE-DONNEES.
		10	FILLER		PIC X(8) VALUE "01DEBUT ".
		10	FILLER		PIC X(8) VALUE "02VIDEO ".
		10	FILLER		PIC X(8) VALUE "03VALID ".
		10	FILLER		PIC X(8) VALUE "04ALPHA ".
		10	FILLER		PIC X(8) VALUE "05DIGIT ".
		10	FILLER		PIC X(8) VALUE "06DEFSAI".
		10	FILLER		PIC X(8) VALUE "07DEFVIS".
		10	FILLER		PIC X(8) VALUE "08FORMAT".
		10	FILLER		PIC X(8) VALUE "09CHAMP ".
		10	FILLER		PIC X(8) VALUE "10LIBEL ".
		10	FILLER		PIC X(8) VALUE "11DATE  ".
		10	FILLER		PIC X(8) VALUE "12HEURE ".
		10	FILLER		PIC X(8) VALUE "13ERREUR".
		10	FILLER		PIC X(8) VALUE "14QSTION".
		10	FILLER		PIC X(8) VALUE "15FIN   ".
	05	T-CLAUSE-TAB REDEFINES T-CLAUSE-DONNEES.
		10	T-CLAUSE-ELT OCCURS 15 TIMES.
			15	T-CLAUSE-NO	PIC 99.
			15	T-CLAUSE-TXT	PIC X(6).
01	XXD.
	05	XXD-NO-ECR		PIC 999.
	05	XXD-VALID		PIC 9.
		88	XXD-VALID-OFF		VALUE 0.
		88	XXD-VALID-ON		VALUE 1.
	05	XXD-ALPHA		PIC X.
	05	XXD-DIGIT		PIC X.
	05	XXD-VIDEO		PIC 9.
		88	XXD-VIDEO-OFF		VALUE 0.
		88	XXD-VIDEO-ON		VALUE 1.
	05	XXD-ATTSAI.
		10	XXD-ATTSAI-ELT	PIC 9	OCCURS 16 TIMES.
			88	XXD-ATTSAI-OFF	VALUE 0.
			88	XXD-ATTSAI-ON	VALUE 1.
	05	XXD-ATTVIS.
		10	XXD-ATTVIS-ELT	PIC 9 	OCCURS 16 TIMES.
			88	XXD-ATTVIS-OFF	VALUE 0.
			88	XXD-ATTVIS-ON	VALUE 1.
	05	XXD-FORM		PIC XXX.
01	XXC.
	05	XXC-PNT			PIC S9(10).
	05	XXC-PNT-LIM		PIC S9(10).
	05	XXC-ELT OCCURS 200 TIMES.
		10	XXC-NO-CHA	PIC 999.
		10	XXC-NO-LIG	PIC 999.
		10	XXC-NO-COL	PIC 999.
		10	XXC-SIGNE	PIC 9.
		10	XXC-TYPE	PIC X.
		10	XXC-ENT		PIC 999.
		10	XXC-DEC		PIC 999.
		10	XXC-PNT-BUF	PIC 999.
		10	XXC-ATTSAI.
			15	XXC-ATTSAI-ELT PIC 9 OCCURS 16 TIMES.
		10	XXC-ATTVIS.
			15	XXC-ATTVIS-ELT PIC 9 OCCURS 16 TIMES.
01	XXL.
	05	XXL-PNT			PIC S9(10).
	05	XXL-PNT-LIM		PIC S9(10).
	05	XXL-ELT	OCCURS 200 TIMES.
		10	XXL-NO-LIB	PIC 999.
		10	XXL-NO-LIG	PIC 999.
		10	XXL-NO-COL	PIC 999.
		10	XXL-NB-CAR	PIC 999.
		10	XXL-PNT-BUF	PIC 999.
		10	XXL-ATTVIS.
			15	XXL-ATTVIS-ELT PIC 9 OCCURS 16 TIMES.
01	XXT.
	05	XXT-PNT			PIC S9(10).
	05	XXT-ELT			PIC X OCCURS 2000 TIMES.
/
PROCEDURE DIVISION.
DECLARATIVES.
ERREUR SECTION.
    USE AFTER STANDARD ERROR PROCEDURE ON ENTREE.
END DECLARATIVES.
PGM SECTION.
BEG.
	MOVE	SPACES	TO	ENTREE-ID, SORTIE-ID.
*	CALL	"GETCMD"	USING	ENTREE-ID, SORTIE-ID, STAT.
*	IF	STAT = -1
*		STOP RUN.
*	IF	STAT = -2
*		DISPLAY	"ECR -- ERREUR DE SYNTAXE"
*		STOP RUN.
DEMNOM.
	MOVE SPACES TO ENTREE-ID.
	DISPLAY "nom du fichier (.FRM) en entree - Return=fin ? : "
		WITH NO ADVANCING.
	ACCEPT ENTREE-ID.
	IF ENTREE-ID = SPACES STOP RUN.
	MOVE ENTREE-ID TO SORTIE-ID.
	OPEN	INPUT	ENTREE.
	IF ST-IN NOT = "00"
		DISPLAY	"ECR -- ERR. OUV. FICHIER ENTREE " ST-IN
		GO TO DEMNOM.
	MOVE	SPACES TO XXD, XXT.
	MOVE ALL "0"	TO XXC, XXL,  
	MOVE	"-" TO XXD-ALPHA.
	MOVE	"#" TO XXD-DIGIT.
	MOVE	0 TO XXC-PNT-LIM, XXL-PNT-LIM, XXT-PNT.
LEC.
	MOVE	SPACES	TO	ENTREE-RECORD.
	READ	ENTREE	AT END
		GO TO	FIN.
	INSPECT ENTREE-RECORD REPLACING ALL TABX BY SPACES.
	PERFORM	ANACLS-010	THRU	ANACLS-990.
	GO TO	LEC.
FIN.
	CLOSE	ENTREE.
	MOVE	SPACES TO MATRICE.
	MOVE	ENTREE-ID TO I-NOM-ECR.
	MOVE	XXD-NO-ECR TO I-NUM-ECR.
	PERFORM CRE-CAD-010 THRU CRE-CAD-990
		VARYING I FROM 1 BY 1 UNTIL I > 24.
	PERFORM CRE-LIB-010 THRU CRE-LIB-990
	VARYING XXL-PNT FROM 1 BY 1 UNTIL XXL-PNT > XXL-PNT-LIM.
	PERFORM CRE-CHA-010 THRU CRE-CHA-990
	VARYING XXC-PNT FROM 1 BY 1 UNTIL XXC-PNT > XXC-PNT-LIM.
	PERFORM	CRE-OUT-010	THRU	CRE-OUT-990.
	GO TO DEMNOM.
*	STOP	RUN.
ANACLS-010.
	MOVE	0	TO	SW-TXT.
	PERFORM	POSPNT-010	THRU	POSPNT-990	VARYING
		I-REC FROM 1 BY 1 UNTIL SW-TXT > 0.
	IF TXT-COM
		GO TO	ANACLS-990.
	MOVE	SPACES TO W-CLAUSE-TXT.
	UNSTRING	ENTREE-RECORD DELIMITED BY
		SPACE OR
		TAB
		INTO	W-CLAUSE-TXT WITH POINTER I-REC.
	MOVE 	0	TO	W-CLAUSE-NO.
	PERFORM	GETCLS-010	THRU	GETCLS-990	VARYING
	T-CLAUSE-I FROM 1 BY 1 UNTIL T-CLAUSE-I > T-CLAUSE-TOT-ELT.
	IF	W-CLAUSE-NO	=	0
		MOVE	1 	TO	SW-TXT
		GO TO	ANACLS-990.
	IF	W-CLAUSE-NO	NOT =	2
	AND	W-CLAUSE-NO	NOT =	3
	AND	W-CLAUSE-NO	NOT =	15
		MOVE	0	TO	SW-TXT
		PERFORM	POSPNT-010 THRU POSPNT-990 VARYING
			I-REC FROM I-REC BY 1 UNTIL SW-TXT > 0
		IF	TXT-COM
			GO TO	ANACLS-990.
	GO TO	T-DEBUT
		T-VIDEO
		T-VALID
		T-ALPHA
		T-DIGIT
		T-DEFSAI
		T-DEFVIS
		T-FORMAT
		T-CHAMP
		T-LIBEL
		T-DATE
		T-HEURE
		T-ERREUR
		T-QSTION
		T-FIN	DEPENDING ON W-CLAUSE-NO.
T-DEBUT.
	UNSTRING ENTREE-RECORD DELIMITED BY ALL SPACE
		INTO XXD-NO-ECR WITH POINTER I-REC.
	GO TO	ANACLS-990.
T-VIDEO.
	MOVE	1	TO	XXD-VIDEO.
	GO TO	ANACLS-990.
T-VALID.
	MOVE	1	TO	XXD-VALID.
	GO TO	ANACLS-990.
T-ALPHA.
	IF	ENT-ELT(I-REC) = "<"
		ADD 1 TO I-REC.
	MOVE	ENT-ELT(I-REC) TO XXD-ALPHA.
	GO TO	ANACLS-990.
T-DIGIT.
	IF	ENT-ELT(I-REC) = "<"
		ADD 1 TO I-REC.
	MOVE	ENT-ELT(I-REC) TO XXD-DIGIT.
	GO TO	ANACLS-990.
T-DEFSAI.
	GO TO	ANACLS-990.
T-DEFVIS.
	GO TO	ANACLS-990.
T-FORMAT.
	UNSTRING ENTREE-RECORD DELIMITED BY ALL SPACE
		INTO XXD-FORM WITH POINTER I-REC.
	GO TO	ANACLS-990.
T-CHAMP.
	ADD	1 TO XXC-PNT-LIM.
	MOVE	0 TO I-LIG, I-COL, I-ENT, I-DEC.
	UNSTRING ENTREE-RECORD DELIMITED BY ","
		INTO	XXC-NO-CHA(XXC-PNT-LIM)
			I-LIG I-COL WITH POINTER I-REC.
	IF	I-LIG < 1
	OR	I-LIG > 24
		MOVE 1 TO I-LIG.
	MOVE	I-LIG TO XXC-NO-LIG(XXC-PNT-LIM).
	IF	I-COL < 1
	OR	I-COL > 80
		MOVE 1 TO I-COL.
	MOVE	I-COL TO XXC-NO-COL(XXC-PNT-LIM).
	IF	ENT-ELT(I-REC) = ","
		ADD 1 TO I-REC.
	IF	ENT-ELT(I-REC) = "+"
		MOVE 1 TO XXC-SIGNE(XXC-PNT-LIM)
		ADD 1 TO I-REC.
	IF	ENT-ELT(I-REC) = "D"
	OR	ENT-ELT(I-REC) = "A"
		MOVE ENT-ELT(I-REC) TO XXC-TYPE(XXC-PNT-LIM)
		ADD 1 TO I-REC
		UNSTRING ENTREE-RECORD DELIMITED BY "," OR "."
			OR SPACE
		INTO I-ENT DELIMITER IN DELIT-ENT
		WITH POINTER I-REC.
	MOVE	I-ENT TO XXC-ENT(XXC-PNT-LIM).
	IF	DELIT-ENT = "."
		UNSTRING ENTREE-RECORD DELIMITED BY SPACE OR ","
		INTO I-DEC  WITH POINTER I-REC.
	MOVE	I-DEC TO XXC-DEC(XXC-PNT-LIM).
	GO TO	ANACLS-990.
T-LIBEL.
	ADD	1 TO XXL-PNT-LIM.
	MOVE	0 TO I-LIG, I-COL.
	UNSTRING ENTREE-RECORD DELIMITED BY ","
		INTO XXL-NO-LIB(XXL-PNT-LIM)
		I-LIG I-COL WITH POINTER I-REC.
	IF	I-LIG < 1
	OR	I-LIG > 24
		MOVE	1 TO I-LIG.
	MOVE	I-LIG TO XXL-NO-LIG(XXL-PNT-LIM).
	IF	I-COL < 1
	OR	I-COL > 80
		MOVE 1 TO I-COL.
	MOVE	I-COL TO XXL-NO-COL(XXL-PNT-LIM).
	IF	ENT-ELT(I-REC) = ","
		ADD 1 TO I-REC.
	IF	ENT-ELT(I-REC) = "<"
		ADD 1 TO I-REC.
	UNSTRING ENTREE-RECORD DELIMITED BY ">"
		INTO W-LIBEL-TXT COUNT IN XXL-NB-CAR(XXL-PNT-LIM)
		WITH POINTER  I-REC.
	ADD	1 XXT-PNT TO XXL-PNT-BUF(XXL-PNT-LIM).
	PERFORM	PUTLIB-010 THRU PUTLIB-990 VARYING I FROM 1 BY 1
		UNTIL I > XXL-NB-CAR(XXL-PNT-LIM).
	GO TO	ANACLS-990.
T-DATE.
	ADD	1 TO XXL-PNT-LIM.
	UNSTRING ENTREE-RECORD DELIMITED BY SPACE OR ","
	INTO XXL-NO-LIB(XXL-PNT-LIM)
	     XXL-NO-LIG(XXL-PNT-LIM)
	     XXL-NO-COL(XXL-PNT-LIM) WITH POINTER I-REC.
	MOVE	9 TO XXL-NB-CAR(XXL-PNT-LIM).
	MOVE	"JJ-MMM-AA" TO W-LIBEL-TXT.
	ADD	1 XXT-PNT TO XXL-PNT-BUF(XXL-PNT-LIM).
	PERFORM	PUTLIB-010 THRU PUTLIB-990 VARYING I FROM 1 BY 1
		UNTIL I > 9.
	GO TO	ANACLS-990.
T-HEURE.
	ADD	1 TO XXL-PNT-LIM.
	UNSTRING ENTREE-RECORD DELIMITED BY SPACE OR ","
	INTO XXL-NO-LIB(XXL-PNT-LIM)
	     XXL-NO-LIG(XXL-PNT-LIM)
	     XXL-NO-COL(XXL-PNT-LIM) WITH POINTER I-REC.
	MOVE	5 TO XXL-NB-CAR(XXL-PNT-LIM).
	MOVE	"HH:MM" TO W-LIBEL-TXT.
	ADD	1 XXT-PNT TO XXL-PNT-BUF(XXL-PNT-LIM).
	PERFORM	PUTLIB-010 THRU PUTLIB-990 VARYING I FROM 1 BY 1
		UNTIL I > 9.
	GO TO	ANACLS-990.
T-ERREUR.
	GO TO	ANACLS-990.
T-QSTION.
	GO TO	ANACLS-990.
T-FIN.
	GO TO	ANACLS-990.
ANACLS-990.
	EXIT.
POSPNT-010.
	IF	I-REC	>	80
		MOVE	1 TO SW-TXT
	ELSE
		IF ENT-ELT(I-REC) = SPACE
		OR ENT-ELT(I-REC) = TAB
			NEXT SENTENCE
		ELSE
			IF	ENT-ELT(I-REC) = ";"
				MOVE 1 TO SW-TXT
			ELSE
				MOVE 2 TO SW-TXT
				SUBTRACT 1 FROM I-REC.
POSPNT-990.
	EXIT.
GETCLS-010.
	IF	W-CLAUSE-TXT = T-CLAUSE-TXT(T-CLAUSE-I)
		MOVE T-CLAUSE-NO(T-CLAUSE-I) TO W-CLAUSE-NO.
GETCLS-990.
	EXIT.
PUTLIB-010.
	ADD	1 TO XXT-PNT.
	MOVE	W-LIBEL-ELT(I) TO XXT-ELT(XXT-PNT).
PUTLIB-990.
	EXIT.
CRE-CAD-010.
	MOVE	"\" TO M-SLASH-1(I), M-SLASH-2(I).
	MOVE	I TO M-NO-LIG-1(I), M-NO-LIG-2(I).
CRE-CAD-990.
	EXIT.
CRE-LIB-010.
	MOVE	XXL-NO-LIG(XXL-PNT) TO I-LIG.
	MOVE	XXL-NO-COL(XXL-PNT) TO I-COL.
	MOVE	XXL-PNT-BUF(XXL-PNT) TO I-BUF.
	PERFORM	MOV-LIB-010 THRU MOV-LIB-990 XXL-NB-CAR(XXL-PNT) TIMES.
CRE-LIB-990.
	EXIT.
MOV-LIB-010.
	IF	I-LIG < 1
	OR	I-LIG > 24
	OR	I-COL < 1
	OR	I-COL > 80
		GO TO MOV-LIB-990.
	MOVE	XXT-ELT(I-BUF) TO M-COL(I-LIG, I-COL).
	ADD	1 TO I-BUF, I-COL.
MOV-LIB-990.
	EXIT.
CRE-CHA-010.
	MOVE	XXC-NO-LIG(XXC-PNT) TO I-LIG.
	MOVE	XXC-NO-COL(XXC-PNT) TO I-COL.
	PERFORM	MOV-MAT-010 THRU MOV-MAT-990 XXC-ENT(XXC-PNT) TIMES.
	IF	XXC-TYPE(XXC-PNT) = "D"
	AND	XXC-DEC(XXC-PNT) > 0
		MOVE "," TO M-COL(I-LIG, I-COL)
		ADD 1 TO I-COL
		PERFORM MOV-MAT-010 THRU MOV-MAT-990
		XXC-DEC(XXC-PNT) TIMES.
CRE-CHA-990.
	EXIT.
MOV-MAT-010.
	IF	I-LIG < 1
	OR	I-LIG > 24
	OR	I-COL < 1
	OR	I-COL > 80
		GO TO MOV-MAT-990.
	IF	XXC-TYPE(XXC-PNT) = "D"
		MOVE XXD-DIGIT TO M-COL(I-LIG, I-COL)
	ELSE
		MOVE XXD-ALPHA TO M-COL(I-LIG, I-COL).
	ADD	1 TO I-COL.
MOV-MAT-990.
	EXIT.
CRE-OUT-010.
	OPEN	OUTPUT SORTIE.
	WRITE	SORTIE-RECORD FROM I-BLANC.
	WRITE	SORTIE-RECORD FROM I-TITRE.
	WRITE	SORTIE-RECORD FROM I-BLANC.
	WRITE	SORTIE-RECORD FROM I-CAD-1.
	WRITE	SORTIE-RECORD FROM I-CAD-2.
	PERFORM	WRITE-010 THRU WRITE-990
	VARYING I FROM 1 BY 1 UNTIL I > 24.
	WRITE	SORTIE-RECORD FROM I-CAD-2.
	WRITE	SORTIE-RECORD FROM I-CAD-1.
	CLOSE	SORTIE.
CRE-OUT-990.
	EXIT.
WRITE-010.
	WRITE	SORTIE-RECORD FROM M-LIG(I).
WRITE-990.
	EXIT.
