IDENTIFICATION  DIVISION.
PROGRAM-ID. LSLPCREF.
AUTHOR. KG.
*
*    **********************************************************
*    **                                                      **
*    **           EDITION REFERENCES CROISEES                **
*    **               COPY-LIB / PROGRAMMES                  **
*    **                                                      **
*    **********************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
*
      SELECT  ENTRE   ASSIGN TO "LPCREF.DAT".
      SELECT  IMP     ASSIGN TO "LPCREF.OUT".
*
*
*
DATA DIVISION.
*
FILE SECTION.
*
*
FD	ENTRE
	LABEL RECORD STANDARD.
	COPY LPCREF.
*
FD	IMP
	LABEL RECORD STANDARD RECORD VARYING.
01	LG		PIC X(80).
01	LG3.
	02 L3LIB	PIC X(12).
	02 L3PRO	OCCURS 4.
	  03 L3NP	PIC X(10).
	  03 L3DIV	PIC X.
	  03 L3SL	PIC X.
	  03 L3MOD	PIC X.
	  03 L3SEP	PIC X(5).
*
*
WORKING-STORAGE SECTION.
*
77	IX              PIC S999 COMP.
77	K               PIC S999 COMP.
77	REF             PIC X(9).
77	NLG             PIC S99 COMP.
77	LGMAX           PIC S99 COMP VALUE 58.
77	IMAX               PIC S999 COMP.
77	LR                 PIC X.
*
01	DATEI		PIC 9(6).
01	DATEI2 REDEFINES DATEI.
	02 AAI 		PIC 99.
	02 MMI		PIC 99.
	02 JOI		PIC 99.
*
01	DATED.
	02 JOE		PIC 99.
	02 FILLER     	PIC X VALUE "/".
	02 MME 		PIC 99.
	02 FILLER   	PIC X VALUE "/".
	02 AAE		PIC 99.
*
*
01	TABW.
	02 TLG		OCCURS 300.
	  03 NP		PIC X(9).
	  03 DIV	PIC X.
	  03 MOD	PIC X.
*
01	SAUT            PIC 9.
*
01	LG1.
	02 FILLER	PIC X(8) VALUE "PROCAL  ".
	02 L1D		PIC X(8).
	02 FILLER	PIC X(52) VALUE
	"    REFERENCES CROISEES  COPY LIB / PROGRAMMES".
	02 FILLER	PIC X(8) VALUE "  PAGE: ".
	02 L1F		PIC 99.
/
PROCEDURE DIVISION.
BEG-PGM SECTION.
BEG.
	OPEN INPUT ENTRE.
	OPEN OUTPUT IMP.
	ACCEPT DATEI FROM DATE.
	MOVE AAI TO AAE MOVE MMI TO MME MOVE JOI TO JOE.
	MOVE DATED TO L1D.
	MOVE ZERO TO L1F.
	MOVE SPACE TO LG LR.
	PERFORM LECT.
*		MISE EN PLACE .LIB DE REFERENCE
MEP.
	IF LR NOT = SPACE GO TO FIN.
	MOVE SPACE TO TABW.
	MOVE ZERO TO IMAX.
	MOVE AU-LIB TO REF L3LIB.
	IF L1F = 000 PERFORM WT.
	GO TO TESD.
*		LECTURE D'UN ENREGISTREMENT
LECT.
	MOVE SPACE TO AUS.
	READ ENTRE AT END MOVE "F" TO LR.
TESD.
*		TEST RUPTURE
	IF LR NOT = SPACE OR REF NOT = AU-LIB
		GO TO RUPT.
	IF IMAX > 299 DISPLAY "TROP DE PROG POUR LIBR. "
		REF "   (" AU-PROG ")"
		GO TO LECT.
	ADD 1 TO IMAX.
	MOVE AU-PROG TO NP (IMAX).
	MOVE AU-DIV TO DIV (IMAX).
	MOVE AU-MODIF TO MOD (IMAX).
	GO TO LECT.
*
*****		RUPTURE .LIB
*
RUPT.
	MOVE "  *  " TO L3SEP (1) L3SEP (2) L3SEP (3).
	MOVE 1 TO IX.
	MOVE 1 TO K.
	MOVE 3 TO SAUT.
*		MISE EN FORME IMPRESSION
LOOP.
	MOVE NP (IX) TO L3NP (K).
	MOVE DIV (IX) TO L3DIV (K).
	MOVE MOD (IX) TO L3MOD (K).
	ADD 1 TO K.
	ADD 1 TO IX.
	IF K > 4 PERFORM WL.
	IF IX NOT > IMAX GO TO LOOP.
	IF K > 1 PERFORM WL.
	GO TO MEP.
*
**********************************************************
*		IMPRESSION ENTETE
**********************************************************
*
WT SECTION.
WT_00.
	ADD 1 TO L1F.
	WRITE LG FROM LG1 AFTER PAGE.
	MOVE SPACE TO LG.
	WRITE LG AFTER 2.
	MOVE 4 TO NLG.
	MOVE REF TO L3LIB.
OWT.
	EXIT.
*
**********************************************************
*		IMPRESSION D'UNE LIGNE
**********************************************************
*
WL SECTION.
WL_00.
	WRITE LG AFTER SAUT.
	MOVE SPACE TO LG.
	MOVE 1 TO K.
	ADD SAUT TO NLG.
	MOVE 1 TO SAUT.
	IF NLG > LGMAX PERFORM WT.
	MOVE "  *  " TO L3SEP (1) L3SEP (2) L3SEP (3).
OWL.
	EXIT.
*
**************************************************************
*	FIN DU PROGRAMME
**************************************************************
*
FIN_PGM SECTION.
FIN.
	CLOSE ENTRE IMP.
	STOP RUN.