IDENTIFICATION  DIVISION.
PROGRAM-ID. CALLCREF.
AUTHOR. KG.
*
*    **********************************************************
*    **                                                      **
*    **  REFERENCES CROISEES CALL-SOUS-PROGRAMME/PROGRAMMES  **
*    **                                                      **
*    **********************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. VAX-11.
OBJECT-COMPUTER. VAX-11.
SPECIAL-NAMES.
	SYMBOLIC CHARACTERS TABULA ARE 10
	DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
*
      SELECT  PARAM   ASSIGN TO "DIR.LST".
      SELECT  ENTRE   ASSIGN TO ""
			STATUS IS ST-INP.
      SELECT  SORTIE     ASSIGN TO "SPCREF.DAT".
      SELECT  IMP     ASSIGN TO "".
      SELECT  FTRI    ASSIGN TO "STRFIL".
*
*
*****************************************************************
*                        DATA DIVISION
*****************************************************************
*
DATA DIVISION.
*
FILE SECTION.
*
SD  FTRI.
 01	ENR-TRI.
	02 TRI-PROG	PIC X(9).
	02 TRI-LIBE	PIC X(15).
*
FD  PARAM
      BLOCK CONTAINS 10240 CHARACTERS
      LABEL RECORD STANDARD.
*
01	DIRENR.
	02 DI-C	PIC X OCCURS 80.
*
FD  ENTRE
      VALUE OF ID IS FICHENTR
      LABEL RECORD STANDARD RECORD VARYING
	FROM 1 TO 255 DEPENDING ON ILE.
01	ENRENTR.
	02 CE   PIC X OCCURS 255.
01	ER0.
	02 FILLER		PIC X.
	02 ER1.
	  03 FILLER		PIC X.
	  03 ER2.
	    04 FILLER		PIC X.
	    04 ER3.
	      05 FILLER		PIC X.
	      05 ER4.
	        06 FILLER	PIC X.
	        06 ER5		PIC X(75).
01	ENRENTV.
	02 ZE1.
	  03 ZE3.
	    04 ZE2		PIC X(5).
	    04 FILLER		PIC X(5).
	  03 FILLER		PIC XX.
*
*		DESCRIPTION FICHIER SPCREF
*		REFERENCES CROISEES CALL/PROGRAMME
 FD  SORTIE
     LABEL RECORD IS STANDARD.
*
01	AUS.
	02 AU-PROG	PIC X(9).
*				NOM DU PROGRAMME
	02 AU-LIBE	PIC X(15).
*				NOM SOUS-ROUTINE
*
*
FD  IMP
	BLOCK CONTAINS 1024 CHARACTERS
	VALUE OF ID IS NFIMP
	LABEL RECORD STANDARD RECORD VARYING.
01	LG		PIC X(80).
01	LG3.
	02 L3LIB	PIC X(17).
	02 L3PRO	OCCURS 5.
	  03 L3NP	PIC X(9).
	  03 L3SEP	PIC X(4).
01	LG4.
	02 L4PROG	PIC X(11).
	02 L4PRO	OCCURS 4.
	  03 L4NSP	PIC X(15).
	  03 L4SEP	PIC X(3).
*
*
WORKING-STORAGE SECTION.
*
77	ST-INP	PIC XX.
77	LLE	PIC S9999 COMP.
77	ILE	PIC 9999 COMP.
77	IX	PIC S999 COMP.
77	K	PIC S999 COMP.
77	REF	PIC X(15).
77	NLG	PIC S99 COMP.
77	LGMAX	PIC S99 COMP VALUE 58.
77	NUMD	PIC S99 COMP.
77	TALL	PIC S999 COMP.
77	LRF	PIC X.
77	C	PIC X.
77	CP	PIC X.
77	AIGD	PIC 9.
77	TAB	PIC X.
77	L1	PIC S999 COMP.
77	L2	PIC S999 COMP.
77	IMAX	PIC S999 COMP.
77	LR	PIC X.
*
77	POS	PIC 9(9) COMP.
77	APPEL	PIC X(4) VALUE "CALL".
77	ST-POS	PIC S9(9) COMP.
*
77	IXC	PIC S999 COMP.
77	IKC	PIC S999 COMP.
77	IXC-MAX	PIC S999 COMP.
77	IXC-I	PIC S999 COMP.
77	SP-INF	PIC X(15).
*
01	IK			PIC 9(9) COMP.
01	XCALL			PIC X(4) VALUE "CALL".
*
01	TABCALL.
	02 SP	PIC X(15) OCCURS 999.
*
*
01	NFIMP	PIC X(32).
*
01	FICHENTR.
	02 CNF	PIC X(40).
01	NOM.
	02 CNN	PIC X OCCURS 9.
*
01	AIG1	PIC X.
*
01	TABW.
	02 TCW.
*		routines a referencer globalement
	  03 TCWR		PIC X(6).
	  88 CW-FORM VALUE
	    "AFFMSL" "INIECR" "SAIECR" "AFFMSL" "SAICHA"
	    "AFFCHA" "CHGSAI" "CHGVIS" "AFFMSG" "SONNE"
	    "SAITXT" "POSCUR" "AFFTXT" "AFFECR" "AFFLIB"
	    "VALERR" "INIFRM" "EFFECR".
	  03 TCWRB REDEFINES TCWR.
	    05 TCWR4	PIC X(4).
	    88 CW-FMS VALUE "FDV$".
	    05 FILLER	PIC XX.
	  03 FILLER	PIC X(26).
	02 TCW2 REDEFINES TCW.
	  03 CW		PIC X OCCURS 32.
*
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	TABE.
	02 TLG		OCCURS 500.
	  03 NP		PIC X(15).
*
01	SAUT            PIC 9.
*
****		LIGNE TITRE 1
*
01	LG1.
	02 FILLER	PIC X(8) VALUE "PROCAL  ".
	02 L1D		PIC X(8).
	02 FILLER	PIC X(24) VALUE
	"    REFERENCES CROISEES ".
	02 L1T		PIC X(28).
	02 FILLER	PIC X(8) VALUE "  PAGE: ".
	02 L1F		PIC 99.
/
PROCEDURE DIVISION.
DECLARATIVES.
ERREUR SECTION.
    USE AFTER STANDARD ERROR PROCEDURE ON ENTRE.
END DECLARATIVES.
BEG-PGM SECTION.
BEG.
     MOVE TABULA TO TAB.
     OPEN INPUT PARAM.
     OPEN OUTPUT SORTIE.
LP.
     MOVE SPACE TO DIRENR.
     READ PARAM AT END GO TO FIN.
*			SUPPRESSION NUMERO DE VERSION
	MOVE 1 TO L1.
	MOVE ZERO TO L2.
LNVE.
	IF L2 NOT = ZERO MOVE SPACE TO DI-C (L1)
	   ELSE IF DI-C (L1) = ";" MOVE 1 TO L2.
	IF L1 < 40 ADD 1 TO L1 GO TO LNVE.
*
	MOVE DIRENR TO FICHENTR.
*			RECHERCHE NOM DU PROGRAMME
	MOVE SPACE TO NOM.
	MOVE 1 TO L1.
	MOVE ZERO TO L2.
LNNA.
	IF DI-C (L1) = "]" GO TO AP-LNNA.
	IF L1 < 80 ADD 1 TO L1 GO TO LNNA.
	DISPLAY "DESCRIPTION NON CONFORME " DIRENR.
	GO TO LP.
AP-LNNA.
	ADD 1 TO L1.
	ADD 1 TO L2.
	IF L1 > 80 GO TO AP-NN.
	IF L2 > 9 GO TO AP-NN.
	IF DI-C (L1) = "." GO TO AP-NN.
	MOVE DI-C (L1) TO CNN (L2).
	GO TO AP-LNNA.
AP-NN.
*			TRAITEMENT PROGRAMME
	OPEN INPUT ENTRE.
	IF ST-INP NOT = "00"
		DISPLAY "INCID OUVERTURE " FICHENTR
		"  " ST-INP
		GO TO LP.
	MOVE ZERO TO AIGD.
	MOVE SPACE TO AUS.
	MOVE NOM TO AU-PROG.
	MOVE ZERO TO IXC-MAX.
LECT.
	MOVE SPACE TO ENRENTR.
	READ ENTRE AT END GO TO FERM.
	MOVE ILE TO LLE.
	IF CE (1) = "*" OR "/" GO TO LECT.
	IF ENRENTR = SPACE GO TO LECT.
	MOVE ZERO TO TALL.
	INSPECT ENRENTR TALLYING TALL FOR LEADING SPACE
				TALL FOR LEADING TAB.
	IF TALL = ZERO GO TO AP-CADRAGE.
	IF TALL = 1 MOVE ER1 TO ER0 GO TO AP-CADRAGE.
	IF TALL = 2 MOVE ER2 TO ER0 GO TO AP-CADRAGE.
	IF TALL = 3 MOVE ER3 TO ER0 GO TO AP-CADRAGE.
	IF TALL = 4 MOVE ER4 TO ER0 GO TO AP-CADRAGE.
	IF TALL = 5 MOVE ER5 TO ER0 GO TO AP-CADRAGE.
	MOVE 1 TO IX.
	ADD 1 TALL GIVING K.
CADRAGE.
	MOVE CE (K) TO CE (IX).
	MOVE SPACE TO CE (K).
	IF K < LLE ADD 1 TO K ADD 1 TO IX GO TO CADRAGE.
AP-CADRAGE.
	MOVE ZERO TO IX.
	IF AIGD NOT = ZERO GO TO AP-PROCED.
	IF ZE3 NOT = "PROCEDURE " GO TO LECT.
	MOVE 1 TO AIGD.
	GO TO LECT.
*			RECHERCHE DES CALL
AP-PROCED.
	CALL "LIB$INDEX" USING	BY DESCRIPTOR ENRENTR
				BY DESCRIPTOR XCALL
		GIVING IK.
	IF IK = ZERO GO TO LECT.
	IF IK = 1 SUBTRACT 1 FROM IK GIVING IX
		MOVE SPACE TO CP.
	IF IK > 1 SUBTRACT 2 FROM IK GIVING IX
		MOVE "@" TO CP.
LOOP.
	ADD 1 TO IX.
	IF IX > LLE GO TO LECT.
	MOVE CE (IX) TO C.
	IF C = "C" AND CP = SPACE GO TO COPRO.
	MOVE C TO CP.
	GO TO LOOP.
COPRO.
	PERFORM DEMOT.
*			TEST SI TABW = CALL
AP-DEMOT.
	IF TABW NOT = "CALL" MOVE SPACE TO CP
		GO TO LOOP.
*		RECHERCHE PROCHAIN MOT
ENTMOT.
	ADD 1 TO IX.
	IF IX > LLE GO TO AP-ENTMOT.
	MOVE CE (IX) TO C.
	IF C = SPACE OR TAB OR """" GO TO ENTMOT.
AP-ENTMOT.
	IF IX > LLE MOVE "??" TO TABW
		ELSE PERFORM DEMOT.
	IF CW-FORM MOVE "FORMVAX" TO TABW.
	IF CW-FMS  MOVE "FDV$..." TO TABW.
	IF IXC-MAX > 998
		DISPLAY "PLUS QUE 999 'CALL' DANS " NOM
	   ELSE	ADD 1 TO IXC-MAX
		MOVE TABW TO SP (IXC-MAX).
	GO TO LECT.
*
*****		FIN D'UN PROGRAMME COBOL
*
FERM.
	CLOSE ENTRE.
*
****		TRI TABLE DES SOUS-PROGRAMMES
*
	IF IXC-MAX < 2 GO TO AP-TRI.
	MOVE 1 TO IXC.
TRIA.
	MOVE IXC TO IKC.
	MOVE IKC TO IXC-I.
	MOVE SP (IXC-I) TO SP-INF.
TRIB.
	ADD 1 TO IKC.
	IF SP (IKC) < SP-INF MOVE SP (IKC) TO SP-INF
		MOVE IKC TO IXC-I.
	IF IKC < IXC-MAX GO TO TRIB.
	MOVE SP (IXC) TO SP (IXC-I).
	MOVE SP-INF TO SP (IXC).
	ADD 1 TO IXC.
	IF IXC < IXC-MAX GO TO TRIA.
AP-TRI.
*		RECHERCHE SP EN DOUBLE
	MOVE ZERO TO IXC.
	MOVE 1 TO IKC.
RDD.
	ADD 1 TO IXC.
	ADD 1 TO IKC.
	IF IXC NOT < IXC-MAX GO TO AP-RDD.
	IF SP (IXC) = SP (IKC) GO TO DDD.
	GO TO RDD.
DDD.
	MOVE SPACE TO SP (IXC).
	GO TO RDD.
AP-RDD.
*		ECRITURE SORTIE
	MOVE ZERO TO IXC.
WR.
	ADD 1 TO IXC.
	IF IXC > IXC-MAX GO TO AP-WR.
	MOVE NOM TO AU-PROG.
	MOVE SP (IXC) TO AU-LIBE.
	IF AU-LIBE = SPACE GO TO WR.
	WRITE AUS.
	GO TO WR.
AP-WR.
	GO TO LP.
*
*************************************************************
*		FIN DU FICHIER PARAMETRE
*************************************************************
*
FIN.
	CLOSE PARAM SORTIE.
	PERFORM EDIT2.
	SORT FTRI ON ASCENDING KEY
		TRI-LIBE
		TRI-PROG
		USING SORTIE
		OUTPUT PROCEDURE IS EDIT1.
*
*
	STOP RUN.
*
/
*
**********************************************************
*	TRANSFERT UN MOT COBOL DANS TABW
**********************************************************
*
DEMOT SECTION.
DEMOT_00.
	MOVE SPACE TO TABW.
	MOVE 1 TO K.
DEMOT_10.
	MOVE CE (IX) TO CW (K).
	ADD 1 TO K.
	ADD 1 TO IX.
	IF K > 32 OR IX > LLE GO TO ODEMOT.
	MOVE CE (IX) TO C.
	IF C = SPACE OR "." OR """" GO TO ODEMOT.
	GO TO DEMOT_10.
ODEMOT.
	EXIT.
*
*******************************************************
*		PROCEDURE DE SORTIE DE TRI
*		IMPRESSION CREF S/P PROGRAMMES
*******************************************************
*
EDIT1 SECTION.
ED1.
	MOVE "CALLCREFS.OUT" TO NFIMP.
	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.
	MOVE "SOUS-PROGRAMME / PROGRAMMES" TO L1T.
	PERFORM ED1-LECT.
ED1-MEP.
	IF LR NOT = SPACE GO TO ED1-FIN.
	MOVE SPACE TO TABE.
	MOVE ZERO TO IMAX.
	MOVE AU-LIBE TO REF L3LIB.
	IF L1F = 000 PERFORM ED1-WT.
	GO TO ED1-TESD.
ED1-WT.
	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.
ED1-LECT.
	MOVE SPACE TO ENR-TRI.
	RETURN FTRI INTO AUS AT END MOVE "F" TO LR.
ED1-TESD.
	IF LR NOT = SPACE OR REF NOT = AU-LIBE
		GO TO ED1-RUPT.
	IF IMAX > 499 DISPLAY "TROP DE PROG POUR LIBR. "
		REF "   (" AU-PROG ")"
		GO TO ED1-LECT.
	ADD 1 TO IMAX.
	MOVE AU-PROG TO NP (IMAX).
	GO TO ED1-LECT.
*
ED1-RUPT.
	MOVE " ** " TO L3SEP (1) L3SEP (2) L3SEP (3) L3SEP (4).
	MOVE 1 TO IX.
	MOVE 1 TO K.
	MOVE 3 TO SAUT.
ED1-LOOP.
	MOVE NP (IX) TO L3NP (K).

	ADD 1 TO K.
	ADD 1 TO IX.
	IF K > 5 PERFORM ED1-WL.
	IF IX NOT > IMAX GO TO ED1-LOOP.
	IF K > 1 PERFORM ED1-WL.
	GO TO ED1-MEP.
*
ED1-WL.
	WRITE LG AFTER SAUT.
	MOVE SPACE TO LG.
	MOVE 1 TO K.
	ADD SAUT TO NLG.
	MOVE 1 TO SAUT.
	IF NLG > LGMAX PERFORM ED1-WT.
	MOVE " ** " TO L3SEP (1) L3SEP (2) L3SEP (3) L3SEP (4).
*
ED1-FIN.
	CLOSE IMP.
OEDIT1.
	EXIT.
*
*****************************************************************
*		EDITION CREF PROGRAMMES S/P
*****************************************************************
*
EDIT2 SECTION.
ED2.
	MOVE "CALLCREFP.OUT" TO NFIMP.
	OPEN OUTPUT IMP.
	OPEN INPUT SORTIE.
	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.
	MOVE "PROGRAMME / SOUS-PROGRAMMES" TO L1T.
	PERFORM ED2-LECT.
ED2-MEP.
	IF LR NOT = SPACE GO TO ED2-FIN.
	MOVE SPACE TO TABE.
	MOVE ZERO TO IMAX.
	MOVE AU-PROG TO REF L4PROG.
	IF L1F = 000 PERFORM ED2-WT.
	GO TO ED2-TESD.
ED2-WT.
	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 L4PROG.
ED2-LECT.
	MOVE SPACE TO AUS.
	READ SORTIE AT END MOVE "F" TO LR.
ED2-TESD.
	IF LR NOT = SPACE OR REF NOT = AU-PROG
		GO TO ED2-RUPT.
	IF IMAX > 499 DISPLAY "TROP DE PROG POUR LIBR. "
		REF "   (" AU-PROG ")"
		GO TO ED2-LECT.
	ADD 1 TO IMAX.
	MOVE AU-LIBE TO NP (IMAX).
	GO TO ED2-LECT.
*
ED2-RUPT.
	MOVE " * " TO L4SEP (1) L4SEP (2) L4SEP (3) L4SEP (4).
	MOVE 1 TO IX.
	MOVE 1 TO K.
	MOVE 3 TO SAUT.
ED2-LOOP.
	MOVE NP (IX) TO L4NSP (K).
	ADD 1 TO K.
	ADD 1 TO IX.
	IF K > 5 PERFORM ED2-WL.
	IF IX NOT > IMAX GO TO ED2-LOOP.
	IF K > 1 PERFORM ED2-WL.
	GO TO ED2-MEP.
*
ED2-WL.
	WRITE LG AFTER SAUT.
	MOVE SPACE TO LG.
	MOVE 1 TO K.
	ADD SAUT TO NLG.
	MOVE 1 TO SAUT.
	IF NLG > LGMAX PERFORM ED2-WT.
	MOVE " * " TO L4SEP (1) L4SEP (2) L4SEP (3) L4SEP (4).
*
ED2-FIN.
	CLOSE IMP SORTIE.
OEDIT2.
	EXIT.
