//* YOUR JOB CARD HERE !!! /*JOBPARM LINES=1000 //*--------------------------------------------------------------------- //PRESORT1 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,50,,CONTIG) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,50,,CONTIG) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,50,,CONTIG) //SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,50,,CONTIG) //SORTIN DD DSN=XXX,DISP=SHR //SORTOUT DD DSN=&&INFILE,DISP=(NEW,PASS), // VOL=SER=3390,UNIT=SYSDA, // DCB=(RECFM=VB,LRECL=4092,BLKSIZE=4096), // SPACE=(CYL,(100,50)) SORT FIELDS=(21,4,BI,A) SUM FIELDS=NONE //*--------------------------------------------------------------------- //COBOL EXEC IGYWCLG ,NAME=DLUMARC //COBOL.SYSIN DD * PROCESS TRUNC(BIN) IDENTIFICATION DIVISION. *========================= *---------------------------------------------------------------* * * * PROGRAMME : DL2UMARC * * AUTEUR : SUNURAXI * * SUNURAXI@USERS.SOURCEFORGE.NET * * * * LICENSE : GPL * * * * DEBUGGING : CONVERTING DMARC RECORDS TO UNIMARC IS NOT VERY * * EASY. IF YOU WANT TO DEBUG THE PROGRAM, ENABLE * * THE TRACE OPTION BY UNCOMMENTING THE 3 STARS * * BELOW THE ??? * * * * COMMENTS : IN FRENCH ! SORRY. TRANSLATION WILL BE MADE UPON * * REQUEST. * * * *---------------------------------------------------------------* PROGRAM-ID. DL2UMARC AUTHOR. SUNURAXI DATE-COMPILED. 08/01/04 ENVIRONMENT DIVISION. *===================== CONFIGURATION SECTION. *---------------------- SPECIAL-NAMES. *-------------- CLASS CARACTERE IS "A" THRU "Z" "a" THRU "z" "0" THRU "9" "," ":" "=" "+" "/" "." "?" ";" "%" "£" "$" "*" "<" ">" " " "&" """" "'" "(" "§" "!" ")" "-" "_" "#" "@" "[" "]" "{" "}" "á" "à" "â" "ä" "ã" "é" "è" "ê" "ë" "í" "ì" "î" "ï" "ò" "ó" "ô" "ö" "õ" "ú" "ù" "û" "ü" "ç" "ñ" "Á" "À" "Â" "Ä" "Ã" "É" "È" "Ê" "Ë" "Í" "Ì" "Â" "Ï" "Ó" "Ò" "Ô" "Ö" "Õ" "Ú" "Ù" "Û" "Ü" "Ç" "Ñ" . INPUT-OUTPUT SECTION. *--------------------- FILE-CONTROL. *------------- SELECT INFILE ASSIGN TO INFILE ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL FILE STATUS IS FILE-STATUS. SELECT OUTFILE ASSIGN TO OUTFILE ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL FILE STATUS IS FILE-STATUS. DATA DIVISION. *============== FILE SECTION. *------------- FD INFILE RECORDING MODE IS V. *----------------------------------------------------------------* * FICHIER DOBIS/LIBIS EN ENTRÉE *----------------------------------------------------------------* 01 INFILE-REC. 03 INFILE-HEADER. 05 INFILE-PRINT-QUEUE-NBR PIC 9(8) COMP. 05 INFILE-DATE PIC 9(8) COMP-3. 05 INFILE-TIME PIC 9(8) COMP-3. 05 FILLER PIC X. 05 FILLER PIC XXX. 05 INFILE-DOCUMENT-NBR PIC 9(8) COMP. 05 FILLER PIC XX. 05 FILLER PIC X(4). 05 INFILE-BITMAP PIC XX. 05 INFILE-OFFSET-AUTEUR PIC 9(4) COMP. 05 INFILE-OFFSET-TITRE PIC 9(4) COMP. 05 INFILE-OFFSET-SUJET PIC 9(4) COMP. 05 INFILE-OFFSET-EDITEUR PIC 9(4) COMP. 05 INFILE-OFFSET-CLASSIF PIC 9(4) COMP. 05 INFILE-OFFSET-ISBN PIC 9(4) COMP. 05 INFILE-OFFSET-RELIE PIC 9(4) COMP. 05 INFILE-OFFSET-NATIONAL PIC 9(4) COMP. 05 INFILE-OFFSET-AUTRE PIC 9(4) COMP. 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 INFILE-OFFSET-NOTE PIC 9(4) COMP. 05 FILLER PIC X(6). 05 FILLER PIC X(2). 05 FILLER PIC X(8). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 FILLER PIC X(2). 05 INFILE-OFFSET-COPIES-NOTE PIC 9(4) COMP. 05 INFILE-OFFSET-COPIES PIC 9(4) COMP. 05 FILLER PIC X(04). 05 DATE-NOTICE-BIN PIC X(02). 05 FILLER PIC X(26). 05 FILLER PIC X(21). 03 INFILE-DATA. 05 FILLER PIC X(3943). FD OUTFILE BLOCK CONTAINS 4096 CHARACTERS RECORD IS VARYING FROM 4 TO 4088 CHARACTERS RECORDING MODE IS V. *----------------------------------------------------------------* * FICHIER UNIMARC *----------------------------------------------------------------* 01 OUTFILE-REC. 03 OUTFILE-RECORD PIC X OCCURS 4 TO 4088 TIMES DEPENDING ON OUTFILE-RECORD-LENGTH. WORKING-STORAGE SECTION. *------------------------ *----------------------------------------------------------------* * VARIABLES DE TRAVAIL *----------------------------------------------------------------* 01 WORK-VAR. 03 TEXTE PIC X(500). 03 CDUS PIC X(500). 03 ISBNS PIC X(500). 03 TITRES. 05 TITRE-1 PIC X(255). 05 TITRE-2 PIC X(255). 05 TITRE-3 PIC X(255). 05 TITRE-4 PIC X(255). 03 EDITEUR-NOM PIC X(500). 03 EDITEUR-VILLE PIC X(500). 03 SIGNATURES PIC X(500). 03 MENTION-EDITION PIC X(500). 03 NOTE-PAR PIC X(500). 03 NOTE-PAGE PIC X(500). 03 NOTE-ILLUS PIC X(500). 03 NOTE-FORMAT PIC X(500). 03 NOTE-ANNEXE-1 PIC X(500). 03 NOTE-ANNEXE-2 PIC X(500). 03 STRIP PIC X(500). 03 STRIP-TEMP PIC X(500). 03 CATEGORIES. 05 CATEGORIE PIC X(250) OCCURS 10. 03 COTE PIC X(50). 03 SOUS-COTE PIC X(50). 03 TABLE-COPIES. 05 FILLER OCCURS 50. 08 COPIES-EXEMPLAIRE PIC 9(8). 08 COPIES-COTE PIC X(50). 08 COPIES-SOUS-COTE PIC X(50). 08 COPIES-DATE-EDITION PIC X(8). 03 CHAMP PIC X(500). 03 ETIQUETTE PIC 9(3). 03 TEMP PIC X(500). 03 CHAR-4 PIC X(4). 03 BIN-4 REDEFINES CHAR-4 PIC 9(8) COMP. 03 CHAR-2 PIC X(2). 03 BIN-2 REDEFINES CHAR-2 PIC 9(4) COMP. 03 NUM-8 PIC 9(8). 03 DATE-EDITION PIC X(8). 03 DATE-NOTICE PIC 9(4). 03 CREATION-DATE PIC X(10). 03 CREATION-TIME PIC X(10). 03 EXEMPLAIRE PIC 9(8). 03 DOCUMENT PIC 9(8). 03 NUMERO-COLLECTION PIC X(18). 03 COMPTEUR-RECORD PIC 9(8) COMP. 03 COMPTEUR-TRACE PIC 9(8) COMP. 03 COMPTEUR-ECRITURE PIC 9(8) COMP. 03 COMPTEUR-ERREUR PIC 9(8) COMP. 03 I PIC 9(4) COMP. 03 J PIC 9(4) COMP. 03 K PIC 9(4) COMP. 03 L PIC 9(4) COMP. 03 M PIC 9(4) COMP. 03 N PIC 9(4) COMP. 03 X PIC 9(4) COMP. 03 NBR-AUTEUR PIC 9(4) COMP. 03 NBR-TITRE PIC 9(4) COMP. 03 NBR-SUJET PIC 9(4) COMP. 03 NBR-EDITEUR PIC 9(4) COMP. 03 NBR-CLASSIF PIC 9(4) COMP. 03 NBR-ISBN PIC 9(4) COMP. 03 NBR-RELIE PIC 9(4) COMP. 03 NBR-NATIONAL PIC 9(4) COMP. 03 NBR-AUTRE PIC 9(4) COMP. 03 NBR-COLL-AUTEUR PIC 9(4) COMP. 03 NBR-COLL-TITRE PIC 9(4) COMP. 03 NBR-NOTE PIC 9(4) COMP. 03 NBR-COPIES PIC 9(4) COMP. 03 NBR-COPIES-SUMMARY PIC 9(4) COMP. 03 NBR-UNIMARC-LABEL PIC 9(4) COMP. 03 OFFSET PIC 9(4) COMP. 03 LONGUEUR-TEXTE PIC 9(4) COMP. 03 LONGUEUR-CHAMP PIC 9(4) COMP. 03 OUTFILE-RECORD-LENGTH PIC 9(5). 03 SKIP-RECORD PIC 9(8) COMP. 03 OFFSET-UNIMARC-DATA PIC 9(4) COMP. 03 FILE-STATUS PIC XX. 88 OK VALUE "00" THRU "09" "97". 88 NOK VALUE "10" THRU "96" "98" "99". 88 EOF VALUE "10" "46". 88 DUP VALUE "22". 88 NRF VALUE "23". 03 TRT-FLAG PIC 9 COMP. 88 START-TRT VALUE 0. 88 END-TRT VALUE 1. 03 ERROR-FLAG PIC 9 COMP. 88 NO-ERROR VALUE 0. 88 DECRYPT-ERROR VALUE 1. 03 DISPLAY-FORM-FLAG PIC 9 COMP. 88 NO-DISPLAY-FORM VALUE 0. 88 DISPLAY-FORM VALUE 1. 03 TRACE-FLAG PIC 9 COMP. 88 TRACE-OK VALUE 1. 03 BITMAP-FLAGS. 05 BITMAP-FLAG-1 PIC 9. 88 AUTEUR VALUE 1. 05 BITMAP-FLAG-2 PIC 9. 88 TITRE VALUE 1. 05 BITMAP-FLAG-3 PIC 9. 88 SUJET VALUE 1. 05 BITMAP-FLAG-4 PIC 9. 88 EDITEUR VALUE 1. 05 BITMAP-FLAG-5 PIC 9. 88 CLASSIF VALUE 1. 05 BITMAP-FLAG-6 PIC 9. 88 ISBN VALUE 1. 05 BITMAP-FLAG-7 PIC 9. 88 NATIONAL VALUE 1. 05 BITMAP-FLAG-8 PIC 9. 88 AUTRE VALUE 1. 05 BITMAP-FLAG-9 PIC 9. 88 NOTE VALUE 1. 05 BITMAP-FLAG-10 PIC 9. 88 COLL-AUTEUR VALUE 1. 05 BITMAP-FLAG-11 PIC 9. 88 COLL-TITRE VALUE 1. 05 BITMAP-FLAG-12 PIC 9. 88 COPIES-SUMMARY VALUE 1. 05 BITMAP-FLAG-13 PIC 9. 88 COPIES VALUE 1. 01 UNIMARC-END-FIELD PIC X VALUE X"35". 01 UNIMARC-START-SUBFIELD PIC X VALUE X"1F". 01 UNIMARC-END-NOTICE PIC X VALUE X"1D". *----------------------------------------------------------------* * STRUCTURE DU FICHIER UNIMARC. *----------------------------------------------------------------* 01 UNIMARC-REC. *----------------------------------------------------------------* * ENTETE DU FICHIER UNIMARC. *----------------------------------------------------------------* 03 UNIMARC-HEADER. 05 UNIMARC-NOTICE-LENGTH PIC 9(5). 05 UNIMARC-NOTICE-STATUS PIC X VALUE "c". 05 UNIMARC-DOCUMENT-TYPE PIC X VALUE "a". 05 UNIMARC-BIBLIOGRAPHIC-LEVEL PIC X VALUE "m". 05 UNIMARC-HIERARCHIC-LEVEL PIC X VALUE "0". 05 FILLER PIC X VALUE SPACES. 05 UNIMARC-INDICATOR-LENGTH PIC X VALUE "2". 05 UNIMARC-SUBFIELD-LENGTH PIC X VALUE "2". 05 UNIMARC-BASE-ADDRESS PIC 9(5). 05 UNIMARC-ENCODING-LEVEL PIC X VALUE " ". 05 UNIMARC-CATALOGUING-FORM PIC X VALUE " ". 05 FILLER PIC X VALUE SPACES. 05 UNIMARC-DIRECTORY-MAP PIC X(4) VALUE "450 ". *----------------------------------------------------------------* * REPERTOIRE DES ETIQUETTES UNIMARC *----------------------------------------------------------------* 03 UNIMARC-DIRECTORY. 05 UNIMARC-ENTRY OCCURS 100. 08 UNIMARC-LABEL PIC 9(3). 08 UNIMARC-LENGTH PIC 9(4). 08 UNIMARC-ADDRESS PIC 9(5). *----------------------------------------------------------------* * DONNEES UNIMARC *----------------------------------------------------------------* 03 UNIMARC-DATA. 05 FILLER PIC X(3500). PROCEDURE DIVISION. *------------------- PERFORM INIT. PERFORM TRT UNTIL END-TRT. PERFORM FIN-TRT. GOBACK. INIT. *---- *----------------------------------------------------------------- * CE PARAGRAPHE EFFECTUE L'INITIALISATION DES VARIABLES ET * L'OUVERTURE DES FICHIERS. *----------------------------------------------------------------- INITIALIZE WORK-VAR. MOVE 0 TO OFFSET. *----------------------------------------------------------------- * SI UNE TRACE EST NÉCESSAIRE, ALORS CHANGEZ ICI EN ENLEVANT LES * 3 ETOILES CI DESSOUS. * ??? *----------------------------------------------------------------- * SET TRACE-OK TO TRUE. * MOVE 0050 TO COMPTEUR-TRACE. * MOVE 0001 TO SKIP-RECORD. *----------------------------------------------------------------* * OUVERTURE DES FICHIERS ET INITILISATION DES VARIABLES * *----------------------------------------------------------------* OPEN INPUT INFILE. IF NOK THEN SET END-TRT TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR D'OUVERTURE DU FICHIER INFILE. RC : " FILE-STATUS " *" DISPLAY "*------------------------------------------------*" END-IF. OPEN OUTPUT OUTFILE IF NOK THEN SET END-TRT TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR D'OUVERTURE DU FICHIER OUTFILE. RC : " FILE-STATUS " *" DISPLAY "*------------------------------------------------*" END-IF. DISPLAY "+------------------------------------------------+". DISPLAY "| |". DISPLAY "| CONVERSION DES FICHIERS DMARCOUT DE |". DISPLAY "| DOBIS/LIBIS EN FORMAT UNIMARC |". DISPLAY "| =================================== |". DISPLAY "| |". DISPLAY "+------------------------------------------------+". DISPLAY " ". TRT. *---- *----------------------------------------------------------------* * CE PROCESS LIT UN RECORD EN ENTREE, LE CONTROLE ET ENTAME * * LE PROCESSUS DE DECODAGE DU DMARC * *----------------------------------------------------------------* INITIALIZE INFILE-REC TEXTE. *----------------------------------------------------------------* * LECTURE D'UN ENREGISTREMENT UTILISATEUR DU FICHIER INFILE * *----------------------------------------------------------------* READ INFILE NEXT. IF NOK THEN SET END-TRT TO TRUE IF NOT EOF THEN DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE LECTURE INFILE : " FILE-STATUS " *" DISPLAY "*------------------------------------------------*" END-IF ELSE ADD 1 TO COMPTEUR-RECORD IF COMPTEUR-RECORD >= SKIP-RECORD THEN *----------------------------------------------------------------* * ON LIT LE RECORD DE DESCRIPTION POUR TROUVER LES INFOS * SUR LE DMARCOUT *----------------------------------------------------------------* IF INFILE-REC(1:1) = X"02" THEN MOVE ZEROES TO NUM-8 MOVE INFILE-DATE TO NUM-8 MOVE SPACES TO TEXTE MOVE "19" TO TEXTE IF NUM-8(1:2) < 50 THEN MOVE "20" TO TEXTE END-IF *----------------------------------------------------------------* * INFILE-DATE A LE FORMAT AAMMJJ *----------------------------------------------------------------* STRING TEXTE(1:2) DELIMITED BY SIZE NUM-8(1:2) DELIMITED BY SIZE "/" DELIMITED BY SIZE NUM-8(3:2) DELIMITED BY SIZE "/" DELIMITED BY SIZE NUM-8(5:2) DELIMITED BY SIZE INTO CREATION-DATE END-STRING IF TRACE-OK THEN DISPLAY "TRAITEMENT DU FICHIER CREE LE : " CREATION-DATE END-IF ELSE IF INFILE-REC(1:1) = X"01" THEN IF TRACE-OK DISPLAY "*======================================" "======================================*" DISPLAY "RECORD : " COMPTEUR-RECORD END-IF *----------------------------------------------------------------* * TRAITEMENT DES ENREGISTREMENTS *----------------------------------------------------------------* PERFORM TRT-REC ELSE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD DISPLAY "LE PREMIER CARACTERE DU RECORD CONTIENT " INFILE-REC(1:1) " AU LIEU DE X""01"" OU X""02""." DISPLAY "*------------------------------------------------*" END-IF END-IF END-IF END-IF. IF TRACE-OK AND COMPTEUR-RECORD >= COMPTEUR-TRACE THEN SET END-TRT TO TRUE END-IF. TRT-REC. *-------- *----------------------------------------------------------------* * CE PROCESS VA EXTRAIRE LES INFORMATIONS DES RECORDS LOGIQUES * DE D/L. POUR CE FAIRE, ON VA DÉCOMPOSER D'ABORD LA BITMAP. *----------------------------------------------------------------* PERFORM TRT-BITMAP. *----------------------------------------------------------------* * INTIALISATION DU RECORD EN SORTIE *----------------------------------------------------------------* SET NO-ERROR TO TRUE. INITIALIZE NBR-UNIMARC-LABEL NBR-COPIES EXEMPLAIRE DOCUMENT COTE SOUS-COTE TABLE-COPIES. *----------------------------------------------------------------* * RECHERCHE DU NUMERO DE DOCUMENT ET DE LA DATE DE LA NOTICE *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4 MOVE INFILE-REC(17:4) TO CHAR-4 MOVE BIN-4 TO DOCUMENT MOVE LOW-VALUES TO CHAR-2 MOVE ZEROES TO DATE-NOTICE MOVE DATE-NOTICE-BIN TO CHAR-2 MOVE BIN-2 TO DATE-NOTICE IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " DOCUMENT :" DOCUMENT " DATE NOTICE :" DATE-NOTICE END-IF. *----------------------------------------------------------------* * ON RECHERCHE LES EXEMPLAIRES *----------------------------------------------------------------* IF COPIES THEN PERFORM TRT-COPIES ELSE *----------------------------------------------------------------* * PAS DE NUMERO D'EXEMPLAIRE, ALORS ERREUR DE DECRYPTAGE. *----------------------------------------------------------------* DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD DISPLAY "AUCUN NUMERO D'EXEMPLAIRE. " "IMPOSSIBLE DE CREER LE RECORD UNIMARC." DISPLAY "*------------------------------------------------*" SET DECRYPT-ERROR TO TRUE END-IF. *----------------------------------------------------------------* * POUR CHAQUE DOCUMENT, ON DECODE ET ON CREE UN RECORD UNIMARC *----------------------------------------------------------------* MOVE SPACES TO CDUS ISBNS TITRES SIGNATURES MENTION-EDITION *----------------------------------------------------------------* * PAS D'EXEMPLAIRE, ALORS ERREUR DE DECRYPTAGE *----------------------------------------------------------------* IF NBR-COPIES > ZEROES THEN DISPLAY "==> TRAITEMENT DU DOCUMENT : " DOCUMENT " , " NBR-COPIES " EXEMPLAIRE(S)." ELSE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD DISPLAY "PAS D'EXEMPLAIRE POUR LE DOCUMENT " DOCUMENT ". IMPOSSIBLE DE CREER LE RECORD UNIMARC." DISPLAY "*------------------------------------------------*" SET DECRYPT-ERROR TO TRUE END-IF *----------------------------------------------------------------* * AJOUT DU CHAMP OBLIGATOIRE 100 : GENERAL PROCESSING DATA *----------------------------------------------------------------* MOVE 100 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE *----------------------------------------------------------------* * DATE DE LA NOTICE *----------------------------------------------------------------* DATE-EDITION DELIMITED BY SIZE *----------------------------------------------------------------* * TYPE DE NOTICE : MONOGRAPHIE *----------------------------------------------------------------* "d" DELIMITED BY SIZE *----------------------------------------------------------------* * ANNÉE DE DÉBUT DE PUBLICATION *----------------------------------------------------------------* " " DELIMITED BY SIZE *----------------------------------------------------------------* * ANNÉE DE FIN DE PUBLICATION *----------------------------------------------------------------* " " DELIMITED BY SIZE *----------------------------------------------------------------* * TYPE DE PUBLIC *----------------------------------------------------------------* "u " DELIMITED BY SIZE *----------------------------------------------------------------* * GOVERNMENT PUBLICATION CODE *----------------------------------------------------------------* "y" DELIMITED BY SIZE *----------------------------------------------------------------* * MODIFIED RECORD CODE *----------------------------------------------------------------* "0" DELIMITED BY SIZE *----------------------------------------------------------------* * LANGUAGE OF CATALOGUING *----------------------------------------------------------------* "fre" DELIMITED BY SIZE *----------------------------------------------------------------* * TRANSLITERATION CODE *----------------------------------------------------------------* "y" DELIMITED BY SIZE *----------------------------------------------------------------* * CHARACTER SETS *----------------------------------------------------------------* "0103" DELIMITED BY SIZE *----------------------------------------------------------------* * ADDITIONAL CHARACTER SETS *----------------------------------------------------------------* " " DELIMITED BY SIZE *----------------------------------------------------------------* * SCRIPT OF TITLE *----------------------------------------------------------------* "ba" DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * AJOUT DU CHAMP 101 : LANGUAGE OF THE ITEM *----------------------------------------------------------------* MOVE 101 TO ETIQUETTE MOVE SPACES TO CHAMP STRING "0 " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE *----------------------------------------------------------------* * LANGUE FRANCAISE *----------------------------------------------------------------* "fre" DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "c" DELIMITED BY SIZE *----------------------------------------------------------------* * LANGUE FRANCAISE *----------------------------------------------------------------* "fre" DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * AJOUT DU CHAMP 300 : NUMERO DE DOCUMENT *----------------------------------------------------------------* * MOVE 300 TO ETIQUETTE * MOVE SPACES TO CHAMP * STRING * " " DELIMITED BY SIZE * UNIMARC-START-SUBFIELD DELIMITED BY SIZE * "a" DELIMITED BY SIZE * "Numéro de document : " DELIMITED BY SIZE * DOCUMENT DELIMITED BY SIZE * INTO CHAMP * END-STRING * MOVE ZEROES TO LONGUEUR-CHAMP * INSPECT CHAMP * TALLYING LONGUEUR-CHAMP FOR CHARACTERS * BEFORE " " * PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * AJOUT DU CHAMP 010 : NUMERO DE DOCUMENT *----------------------------------------------------------------* MOVE 010 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE DOCUMENT DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * ON RECHERCHE L'ISBN *----------------------------------------------------------------* IF ISBN THEN PERFORM TRT-ISBN END-IF *----------------------------------------------------------------* * ON RECHERCHE LE TITRE *----------------------------------------------------------------* IF TITRE THEN PERFORM TRT-TITRE ELSE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "PAS DE TITRE PRESENT " "IMPOSSIBLE DE CREER LE RECORD UNIMARC." DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "PAS DE TITRE PRESENT. " UPON SYSPUNCH SET DECRYPT-ERROR TO TRUE END-IF *----------------------------------------------------------------* * ON RECHERCHE L'AUTEUR *----------------------------------------------------------------* IF AUTEUR THEN PERFORM TRT-AUTEUR END-IF *----------------------------------------------------------------* * ON RECHERCHE LE SUJET *----------------------------------------------------------------* IF SUJET THEN PERFORM TRT-SUJET END-IF *----------------------------------------------------------------* * ON RECHERCHE LE EDITEUR *----------------------------------------------------------------* IF EDITEUR THEN PERFORM TRT-EDITEUR END-IF *----------------------------------------------------------------* * ON RECHERCHE LA CLASSIF *----------------------------------------------------------------* IF CLASSIF THEN PERFORM TRT-CLASSIF END-IF *----------------------------------------------------------------* * ON RECHERCHE LE NATIONAL *----------------------------------------------------------------* IF NATIONAL THEN PERFORM TRT-NATIONAL END-IF *----------------------------------------------------------------* * ON RECHERCHE L'AUTRE *----------------------------------------------------------------* IF AUTRE THEN PERFORM TRT-AUTRE END-IF *----------------------------------------------------------------* * ON RECHERCHE COLL-AUTEUR *----------------------------------------------------------------* IF COLL-AUTEUR THEN PERFORM TRT-COLL-AUTEUR END-IF *----------------------------------------------------------------* * ON RECHERCHE COLL-TITRE *----------------------------------------------------------------* IF COLL-TITRE THEN PERFORM TRT-COLL-TITRE END-IF *----------------------------------------------------------------* * ON RECHERCHE LA NOTE *----------------------------------------------------------------* IF NOTE THEN PERFORM TRT-NOTE END-IF *----------------------------------------------------------------* * AJOUT DU CHAMP 949 : AUTRES, CDUS, ISBNS, MENTION EDITION & * DOCUMENT *----------------------------------------------------------------* MOVE 949 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE CDUS DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "b" DELIMITED BY SIZE ISBNS DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "c" DELIMITED BY SIZE DOCUMENT DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "d" DELIMITED BY SIZE SIGNATURES DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "e" DELIMITED BY SIZE MENTION-EDITION DELIMITED BY " " INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * AJOUT DU CHAMP OBLIGATOIRE 801 : GENERAL PROCESSING DATA *----------------------------------------------------------------* MOVE 801 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " 0" DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE *----------------------------------------------------------------* * PAYS D'ORIGINE *----------------------------------------------------------------* "be" DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "b" DELIMITED BY SIZE *----------------------------------------------------------------* * NOM DE LA BIBLIOTHEQUE *----------------------------------------------------------------* "MCF - BIBLIOTHEQUE 27 SEPTEMBRE" DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "c" DELIMITED BY SIZE *----------------------------------------------------------------* * DATE DE LA NOTICE *----------------------------------------------------------------* DATE-NOTICE DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * ECRITURE DU RECORD *----------------------------------------------------------------* IF NO-ERROR THEN PERFORM ECRITURE-OUTFILE ELSE ADD 1 TO COMPTEUR-ERREUR END-IF. TRT-AUTEUR. *----------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES AUTEURS * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(29:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "AUTEUR OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE D'AUTEURS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-AUTEUR. IF TRACE-OK THEN DISPLAY "AUTEUR NOMBRE :" NBR-AUTEUR END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LE NOM DES AUTEURS *----------------------------------------------------------------* IF NBR-AUTEUR >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-AUTEUR SET NO-DISPLAY-FORM TO TRUE ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 3 TO OFFSET *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DE L'AUTEUR *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON SAUTE LES SIGNES DIACRITIQUES *----------------------------------------------------------------* * IF DISPLAY-FORM THEN * MOVE LOW-VALUES TO CHAR-2 * MOVE INFILE-REC(OFFSET:1) TO CHAR-2(2:1) * ADD BIN-2 TO OFFSET * IF TRACE-OK THEN * DISPLAY "SIGNES DIACRITIQUES SAUTES." * DISPLAY "OFFSET ACTUEL :" OFFSET * END-IF * END-IF *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " AUTEUR Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF INSPECT TEXTE REPLACING ALL X"03" BY SPACES *----------------------------------------------------------------* * ON LE VERIFIE ET ON AJOUTE LE CHAMP UNIMARC *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE *----------------------------------------------------------------* * AUTEUR PRINCIPAL *----------------------------------------------------------------* IF M = 1 THEN MOVE 700 TO ETIQUETTE ELSE *----------------------------------------------------------------* * AUTRES AUTEURS *----------------------------------------------------------------* MOVE 702 TO ETIQUETTE END-IF MOVE SPACES TO CHAMP STRING " 0" DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE *----------------------------------------------------------------* * NOM DE L'AUTEUR *----------------------------------------------------------------* TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "L'AUTEUR CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "L'AUTEUR CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION AUTEUR(S) TROUVÉE" " MAIS AUCUN AUTEUR(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION AUTEUR(S) TROUVÉE" " MAIS AUCUN AUTEUR(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-TITRE. *---------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES TITRES * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(31:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "TITRE OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE TITRES *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-TITRE. IF TRACE-OK THEN DISPLAY "TITRE NOMBRE :" NBR-TITRE END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES TITRES *----------------------------------------------------------------* IF NBR-TITRE >= 1 MOVE SPACES TO TITRES PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-TITRE SET NO-DISPLAY-FORM TO TRUE ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 3 TO OFFSET ADD 2 TO OFFSET *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU TITRE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON SAUTE LES SIGNES DIACRITIQUES *----------------------------------------------------------------* * IF DISPLAY-FORM THEN * MOVE LOW-VALUES TO CHAR-2 * MOVE INFILE-REC(OFFSET:1) TO CHAR-2(2:1) * ADD BIN-2 TO OFFSET * IF TRACE-OK THEN * DISPLAY "SIGNES DIACRITIQUES SAUTES." * DISPLAY "OFFSET ACTUEL :" OFFSET * END-IF * END-IF *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " TITRE Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE IF M <= 1 THEN MOVE TEXTE TO TITRES ELSE IF TEXTE NOT = SPACES THEN STRING TITRES DELIMITED BY " " " ; " DELIMITED BY SIZE TEXTE DELIMITED BY " " INTO TITRES END-STRING END-IF MOVE ZEROES TO N INSPECT TITRES TALLYING N FOR CHARACTERS BEFORE " " EVALUATE N WHEN 225 THROUGH 255 STRING TITRES DELIMITED BY " " "˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜" DELIMITED BY SIZE INTO TITRES(1:255) END-STRING WHEN 480 THROUGH 510 STRING TITRES DELIMITED BY " " "˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜" DELIMITED BY SIZE INTO TITRES(1:510) END-STRING WHEN 735 THROUGH 765 STRING TITRE-3 DELIMITED BY " " "˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜˜" DELIMITED BY SIZE INTO TITRES(1:765) END-STRING WHEN OTHER CONTINUE END-EVALUATE END-IF ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "LE TITRE CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "LE TITRE CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM INSPECT TITRES REPLACING ALL "˜" BY SPACES *----------------------------------------------------------------* * LES TITRES VONT DANS LES SOUS-CHAMPS a, c, d, e DE * L'ETIQUETTE 200 *----------------------------------------------------------------* MOVE 200 TO ETIQUETTE MOVE SPACES TO CHAMP STRING "1 " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE TITRE-1 DELIMITED BY " " INTO CHAMP END-STRING IF TITRE-2 NOT = SPACES THEN STRING CHAMP DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "c" DELIMITED BY SIZE TITRE-2 DELIMITED BY " " INTO CHAMP END-STRING END-IF IF TITRE-3 NOT = SPACES THEN STRING CHAMP DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "d" DELIMITED BY SIZE TITRE-3 DELIMITED BY " " INTO CHAMP END-STRING END-IF IF TITRE-4 NOT = SPACES THEN STRING CHAMP DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "e" DELIMITED BY SIZE TITRE-4 DELIMITED BY " " INTO CHAMP END-STRING END-IF MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION TITRE(S) TROUVÉE" " MAIS AUCUN TITRE(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION TITRE(S) TROUVÉE" " MAIS AUCUN TITRE(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-SUJET. *---------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES SUJETS * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(33:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "SUJET OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE SUJETS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-SUJET. IF TRACE-OK THEN DISPLAY "SUJET NOMBRE :" NBR-SUJET END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES SUJETS *----------------------------------------------------------------* IF NBR-SUJET >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-SUJET ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 3 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU SUJET *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES INSPECT TEXTE REPLACING ALL X"1B" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " SUJET Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN *----------------------------------------------------------------* * ON ECLATE LES CATEGORIES DU SUJET *----------------------------------------------------------------* MOVE SPACES TO CATEGORIES UNSTRING TEXTE DELIMITED BY " - " INTO CATEGORIE(1) CATEGORIE(2) CATEGORIE(3) CATEGORIE(4) CATEGORIE(5) CATEGORIE(6) CATEGORIE(7) CATEGORIE(8) CATEGORIE(9) CATEGORIE(10) END-UNSTRING IF CATEGORIE(1)(1:2) = "= " THEN MOVE SPACES TO CATEGORIE(1)(1:2) END-IF PERFORM VARYING J FROM 1 BY 1 UNTIL J > 10 MOVE SPACES TO STRIP MOVE CATEGORIE(J) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO CATEGORIE(J) * INSPECT CATEGORIE(J)(2:) CONVERTING * "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO * "abcdefghijklmnopqrstuvwxyz" END-PERFORM *----------------------------------------------------------------* * AJOUT DU CHAMP 606 : SUJET *----------------------------------------------------------------* MOVE 606 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE CATEGORIE(1) DELIMITED BY " " INTO CHAMP END-STRING PERFORM VARYING J FROM 2 BY 1 UNTIL CATEGORIE(J) = SPACES STRING CHAMP DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "x" DELIMITED BY SIZE CATEGORIE(J) DELIMITED BY " " INTO CHAMP END-STRING END-PERFORM MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "LE SUJET CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "LE SUJET CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION SUJET(S) TROUVÉE" " MAIS AUCUN SUJET(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION SUJET(S) TROUVÉE" " MAIS AUCUN SUJET(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-EDITEUR. *------------ *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES EDITEURS * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(35:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "EDITEUR OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE D'EDITEURS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-EDITEUR. IF TRACE-OK THEN DISPLAY "EDITEUR NOMBRE :" NBR-EDITEUR END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES EDITEURS *----------------------------------------------------------------* IF NBR-EDITEUR >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-EDITEUR ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 2 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DE L'EDITEUR *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES MOVE SPACES TO EDITEUR-NOM EDITEUR-VILLE UNSTRING TEXTE DELIMITED BY X"02" OR X"03" OR X"04" OR X"06" OR X"0B" OR X"17" INTO EDITEUR-NOM EDITEUR-VILLE END-UNSTRING INSPECT TEXTE REPLACING ALL X"02" BY SPACES INSPECT TEXTE REPLACING ALL X"03" BY SPACES INSPECT TEXTE REPLACING ALL X"04" BY SPACES INSPECT TEXTE REPLACING ALL X"06" BY SPACES INSPECT TEXTE REPLACING ALL X"0B" BY SPACES INSPECT TEXTE REPLACING ALL X"17" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " EDITEUR Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE *----------------------------------------------------------------* * AJOUT DU CHAMP 210 : EDITEUR *----------------------------------------------------------------* MOVE 210 TO ETIQUETTE MOVE SPACES TO CHAMP IF EDITEUR-VILLE = SPACES THEN STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "c" DELIMITED BY SIZE TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE INTO CHAMP END-STRING ELSE STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE EDITEUR-VILLE DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "c" DELIMITED BY SIZE EDITEUR-NOM DELIMITED BY " " INTO CHAMP END-STRING END-IF IF DATE-NOTICE > ZEROES THEN STRING CHAMP DELIMITED BY " " UNIMARC-START-SUBFIELD DELIMITED BY SIZE "d" DELIMITED BY SIZE DATE-NOTICE DELIMITED BY SIZE INTO CHAMP END-IF MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "L'EDITEUR CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "L'EDITEUR CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION EDITEUR(S) TROUVÉE" " MAIS AUCUN EDITEUR(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION EDITEUR(S) TROUVÉE" " MAIS AUCUN EDITEUR(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-CLASSIF. *----------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES CLASSIF. * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(37:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "CLASSIF OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE CLASSIFS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-CLASSIF. IF TRACE-OK THEN DISPLAY "CLASSIF NOMBRE :" NBR-CLASSIF END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES CLASSIFS *----------------------------------------------------------------* IF NBR-CLASSIF >= 1 MOVE SPACES TO CDUS PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-CLASSIF ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 2 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU CLASSIF *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " CLASSIF Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE *----------------------------------------------------------------* * AJOUT DU CHAMP 676 : CDU *----------------------------------------------------------------* MOVE 676 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD IF M <= 1 THEN MOVE TEXTE TO CDUS ELSE STRING CDUS DELIMITED BY " " " ; " DELIMITED BY SIZE TEXTE DELIMITED BY " " INTO CDUS END-STRING END-IF ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "LE CLASSIF CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "LA CLASSIF CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION CLASSIF(S) TROUVÉE" " MAIS AUCUN CLASSIF(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION CLASSIF(S) TROUVÉE" " MAIS AUCUN CLASSIF(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-ISBN. *---------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES ISBN * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(39:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "ISBN OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE ISBNS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-ISBN. IF TRACE-OK THEN DISPLAY "ISBN NOMBRE :" NBR-ISBN END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES ISBNS *----------------------------------------------------------------* IF NBR-ISBN >= 1 MOVE SPACES TO ISBNS PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-ISBN ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 1 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU ISBN *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " ISBN Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE INSPECT TEXTE CONVERTING "'" TO SPACES IF M <= 1 THEN CONTINUE ELSE IF M <= 2 THEN MOVE TEXTE TO ISBNS ELSE STRING ISBNS DELIMITED BY " " " ; " DELIMITED BY SIZE TEXTE DELIMITED BY " " INTO ISBNS END-STRING END-IF END-IF *----------------------------------------------------------------* * AJOUT DU CHAMP 010 : ISBN *----------------------------------------------------------------* MOVE 010 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "L'ISBN CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "L'ISBN CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION ISBN(S) TROUVÉE" " MAIS AUCUN ISBN(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION ISBN(S) TROUVÉE" " MAIS AUCUN ISBN(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-NATIONAL. *---------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES NATIONALS * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(43:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "NATIONAL OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE NATIONALS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-NATIONAL. IF TRACE-OK THEN DISPLAY "NATIONAL NOMBRE :" NBR-NATIONAL END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES NATIONALS *----------------------------------------------------------------* IF NBR-NATIONAL >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-NATIONAL ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 1 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU NATIONAL *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " NATIONAL Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN CONTINUE ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "LE NATIONAL CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "LE NATIONAL CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION NATIONAL(S) TROUVÉE" " MAIS AUCUN NATIONAL(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION NATIONAL(S) TROUVÉE" " MAIS AUCUN NATIONAL(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-AUTRE. *---------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES AUTRES * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(45:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "AUTRE OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE AUTRES *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-AUTRE. IF TRACE-OK THEN DISPLAY "AUTRE NOMBRE :" NBR-AUTRE END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES AUTRES *----------------------------------------------------------------* IF NBR-AUTRE >= 1 MOVE SPACES TO SIGNATURES PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-AUTRE ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 2 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU AUTRE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " AUTRE Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE IF M <= 1 THEN MOVE TEXTE TO SIGNATURES ELSE STRING SIGNATURES DELIMITED BY " " " ; " DELIMITED BY SIZE TEXTE DELIMITED BY " " INTO SIGNATURES END-STRING END-IF *----------------------------------------------------------------* * AJOUT DU CHAMP 327 : NOTE SUR LA PROVENANCE *----------------------------------------------------------------* * MOVE 327 TO ETIQUETTE * MOVE SPACES TO CHAMP * STRING * " " DELIMITED BY SIZE * UNIMARC-START-SUBFIELD DELIMITED BY SIZE * "a" DELIMITED BY SIZE * TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE * INTO CHAMP * END-STRING * MOVE ZEROES TO LONGUEUR-CHAMP * INSPECT CHAMP * TALLYING LONGUEUR-CHAMP FOR CHARACTERS * BEFORE " " * PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "L'AUTRE CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "L'AUTRE CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION AUTRE(S) TROUVÉE" " MAIS AUCUN AUTRE(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION AUTRE(S) TROUVÉE" " MAIS AUCUN AUTRE(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-COLL-AUTEUR. *---------------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES COLL-AUT. * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(47:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "COLL-AUTEUR OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE COLL-AUTEURS *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-COLL-AUTEUR. IF TRACE-OK THEN DISPLAY "COLL-AUTEUR NOMBRE :" NBR-COLL-AUTEUR END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES COLL-AUTEURS *----------------------------------------------------------------* IF NBR-COLL-AUTEUR >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-COLL-AUTEUR ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 5 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU COLL-AUTEUR *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON RECHERCHE LA ZONE DE LONGUEUR DU NUMERO DE COLLECTION * QUI EST TOUJOURS EGALE A X"0012" *----------------------------------------------------------------* PERFORM VARYING OFFSET FROM OFFSET BY 1 UNTIL INFILE-REC(OFFSET:2) = X"0012" OR OFFSET > LENGTH OF INFILE-REC CONTINUE END-PERFORM *----------------------------------------------------------------* * ON RECHERCHE LE NUMERO DE COLLECTION *----------------------------------------------------------------* MOVE ZEROES TO LONGUEUR-TEXTE MOVE LOW-VALUES TO CHAR-2 MOVE INFILE-REC(OFFSET:2) TO CHAR-2(1:2) MOVE BIN-2 TO LONGUEUR-TEXTE ADD 2 TO OFFSET MOVE SPACES TO NUMERO-COLLECTION MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO NUMERO-COLLECTION ADD LONGUEUR-TEXTE TO OFFSET INSPECT NUMERO-COLLECTION REPLACING ALL X"00" BY SPACES *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* MOVE ZEROES TO LONGUEUR-TEXTE INSPECT TEXTE TALLYING LONGUEUR-TEXTE FOR CHARACTERS BEFORE " " IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " COLL-AUTEUR Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE *----------------------------------------------------------------* * ON SUPPRIME COLL. AU DÉBUT DU TEXTE *----------------------------------------------------------------* IF TEXTE(1:6) = "COLL. " OR TEXTE(1:6) = "Coll. " OR TEXTE(1:6) = "coll. " MOVE SPACES TO TEMP MOVE TEXTE(7:) TO TEMP MOVE SPACES TO TEXTE MOVE TEMP TO TEXTE SUBTRACT 6 FROM LONGUEUR-TEXTE END-IF *----------------------------------------------------------------* * AJOUT DU CHAMP 225 : COLLECTION *----------------------------------------------------------------* MOVE 225 TO ETIQUETTE MOVE SPACES TO CHAMP STRING "1 " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "v" DELIMITED BY SIZE NUMERO-COLLECTION DELIMITED BY " " INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "LA COLL-AUTEUR CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "LA COLL-AUTEUR CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION COLL-AUTEUR(S) TROUVÉE" " MAIS AUCUN COLL-AUTEUR(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION COLL-AUTEUR(S) TROUVÉE" " MAIS AUCUN COLL-AUTEUR(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-COLL-TITRE. *-------------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES COLL-TITRE * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(49:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "COLL-TITRE OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE COLL-TITRES *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-COLL-TITRE. IF TRACE-OK THEN DISPLAY "COLL-TITRE NOMBRE :" NBR-COLL-TITRE END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES COLL-TITRES *----------------------------------------------------------------* IF NBR-COLL-TITRE >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-COLL-TITRE ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 5 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU COLL-TITRE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:1) TO CHAR-4(4:1) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 1 TO OFFSET *----------------------------------------------------------------* * ON L'EXTRAIT, ON LE MET A L'ENDROIT ET ON LE PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE PERFORM RETOURNE-TEXTE VARYING I FROM 2 BY 1 UNTIL I >= LONGUEUR-TEXTE INSPECT TEXTE REPLACING ALL X"00" BY SPACES ADD LONGUEUR-TEXTE TO OFFSET *----------------------------------------------------------------* * ON RECHERCHE LA ZONE DE LONGUEUR DU NUMERO DE COLLECTION * QUI EST TOUJOURS EGALE A X"0012" *----------------------------------------------------------------* PERFORM VARYING OFFSET FROM OFFSET BY 1 UNTIL INFILE-REC(OFFSET:2) = X"0012" OR OFFSET > LENGTH OF INFILE-REC CONTINUE END-PERFORM *----------------------------------------------------------------* * ON RECHERCHE LE NUMERO DE COLLECTION *----------------------------------------------------------------* MOVE ZEROES TO LONGUEUR-TEXTE MOVE LOW-VALUES TO CHAR-2 MOVE INFILE-REC(OFFSET:2) TO CHAR-2(1:2) MOVE BIN-2 TO LONGUEUR-TEXTE ADD 2 TO OFFSET MOVE SPACES TO NUMERO-COLLECTION MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO NUMERO-COLLECTION ADD LONGUEUR-TEXTE TO OFFSET INSPECT NUMERO-COLLECTION REPLACING ALL X"00" BY SPACES *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* MOVE ZEROES TO LONGUEUR-TEXTE INSPECT TEXTE TALLYING LONGUEUR-TEXTE FOR CHARACTERS BEFORE " " IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " COLL-TITRE Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE *----------------------------------------------------------------* * ON SUPPRIME COLL. AU DÉBUT DU TEXTE *----------------------------------------------------------------* IF TEXTE(1:6) = "COLL. " OR TEXTE(1:6) = "Coll. " OR TEXTE(1:6) = "coll. " MOVE SPACES TO TEMP MOVE TEXTE(7:) TO TEMP MOVE SPACES TO TEXTE MOVE TEMP TO TEXTE SUBTRACT 6 FROM LONGUEUR-TEXTE END-IF *----------------------------------------------------------------* * AJOUT DU CHAMP 225 : COLLECTION *----------------------------------------------------------------* MOVE 225 TO ETIQUETTE MOVE SPACES TO CHAMP STRING "1 " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "v" DELIMITED BY SIZE NUMERO-COLLECTION DELIMITED BY " " INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DECODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "LA COLL-TITRE CONTIENT DES " "CARACTERES BYZARRES." DISPLAY TEXTE(1:LONGUEUR-TEXTE) DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "LA COLL-TITRE CONTIENT DES " "CARACTERES BYZARRES." UPON SYSPUNCH END-IF END-PERFORM ELSE SET DECRYPT-ERROR TO TRUE DISPLAY "*------------------------------------------------*" DISPLAY "*ERREUR DE DÉCODAGE DU RECORD " COMPTEUR-RECORD " EXEMPLAIRE " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " DISPLAY "SECTION COLL-TITRE(S) TROUVÉE" " MAIS AUCUN COLL-TITRE(S) DANS LA SECTION" DISPLAY "*------------------------------------------------*" DISPLAY " EXEMPLAIRE : " EXEMPLAIRE " DOCUMENT :" DOCUMENT " " " COTE : " COTE(1:15) "/" SOUS-COTE(1:10) "SECTION COLL-TITRE(S) TROUVÉE" " MAIS AUCUN COLL-TITRE(S) DANS LA SECTION" UPON SYSPUNCH END-IF. TRT-NOTE. *---------- *----------------------------------------------------------------* * CE PARAGRAPHE EXTRAIT LES INFORMATIONS CONCERNANT LES NOTES * ET CREE LES ETIQUETTES UNIMARC CORRESPONDANTES *----------------------------------------------------------------* *----------------------------------------------------------------* * L'OFFSET COMMENCE A 1 *----------------------------------------------------------------* MOVE 1 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE SON OFFSET *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(51:2) TO CHAR-4(3:2) ADD BIN-4 TO OFFSET. IF TRACE-OK THEN DISPLAY "NOTE OFFSET :" OFFSET END-IF. MOVE LOW-VALUES TO CHAR-4. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON RECHERCHE LE NOMBRE DE NOTES *----------------------------------------------------------------* MOVE LOW-VALUES TO CHAR-4. MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2). MOVE BIN-4 TO NBR-NOTE. IF TRACE-OK THEN DISPLAY "NOTE NOMBRE :" NBR-NOTE END-IF. ADD 2 TO OFFSET. *----------------------------------------------------------------* * ON EXTRAIT LES NOTES *----------------------------------------------------------------* IF NBR-NOTE >= 1 PERFORM VARYING M FROM 1 BY 1 UNTIL M > NBR-NOTE ADD 2 TO OFFSET ADD 2 TO OFFSET ADD 1 TO OFFSET MOVE ZEROES TO BIN-4 MOVE SPACES TO TEXTE *----------------------------------------------------------------* * ON RECHERCHE LA LONGUEUR DU NOTE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:2) TO CHAR-4(3:2) MOVE BIN-4 TO LONGUEUR-TEXTE ADD 2 TO OFFSET *----------------------------------------------------------------* * ON EXTRAIT LA NOTE, ON L'ECLATE ET ON LA PURIFIE *----------------------------------------------------------------* MOVE INFILE-REC(OFFSET:LONGUEUR-TEXTE) TO TEXTE ADD LONGUEUR-TEXTE TO OFFSET MOVE SPACES TO NOTE-PAR NOTE-PAGE NOTE-ILLUS NOTE-FORMAT NOTE-ANNEXE-1 NOTE-ANNEXE-2 MENTION-EDITION TEMP IF TRACE-OK THEN DISPLAY "LONGUEUR NOTE :" LONGUEUR-TEXTE END-IF *----------------------------------------------------------------* * ECLATEMENT DES SOUS-CHAMPS DE LA NOTE *----------------------------------------------------------------* MOVE ZEROES TO I J K L PERFORM VARYING I FROM 1 BY 1 UNTIL I > LONGUEUR-TEXTE IF TEXTE(I:1) < X"10" OR TEXTE(I:1) = X"28" THEN ADD 1 TO I GIVING J *----------------------------------------------------------------* * CALCUL DE LA LONGUEUR DU SOUS-CHAMP *----------------------------------------------------------------* PERFORM VARYING K FROM J BY 1 UNTIL TEXTE(K:1) < X"10" OR TEXTE(K:1) = X"28" OR K > LONGUEUR-TEXTE CONTINUE END-PERFORM SUBTRACT J FROM K GIVING L *----------------------------------------------------------------* * ECLATEMENT D'UN SOUS-CHAMP *----------------------------------------------------------------* EVALUATE TEXTE(I:1) WHEN X"04" IF I <= 1 THEN MOVE TEXTE(J:L) TO NOTE-PAR ELSE MOVE TEXTE(J:L) TO NOTE-FORMAT END-IF WHEN X"05" MOVE TEXTE(J:L) TO MENTION-EDITION WHEN X"06" MOVE TEXTE(J:L) TO NOTE-PAGE WHEN X"03" MOVE TEXTE(J:L) TO NOTE-ILLUS WHEN X"08" MOVE TEXTE(J:L) TO NOTE-ANNEXE-1 WHEN X"0C" MOVE TEXTE(J:L) TO NOTE-ANNEXE-2 WHEN X"28" MOVE SPACE TO TEXTE(J:L) WHEN OTHER MOVE SPACES TO TEXTE(I:1) END-EVALUATE ADD L TO I END-IF END-PERFORM *----------------------------------------------------------------* * EPURATION SUPPLEMENTAIRE ON NE SAIT JAMAIS ] *----------------------------------------------------------------* INSPECT TEXTE REPLACING ALL X"00" BY SPACES INSPECT TEXTE REPLACING ALL X"01" BY SPACES INSPECT TEXTE REPLACING ALL X"02" BY SPACES INSPECT TEXTE REPLACING ALL X"03" BY SPACES INSPECT TEXTE REPLACING ALL X"04" BY SPACES INSPECT TEXTE REPLACING ALL X"05" BY SPACES INSPECT TEXTE REPLACING ALL X"06" BY SPACES INSPECT TEXTE REPLACING ALL X"07" BY SPACES INSPECT TEXTE REPLACING ALL X"08" BY SPACES INSPECT TEXTE REPLACING ALL X"09" BY SPACES INSPECT TEXTE REPLACING ALL X"0A" BY SPACES INSPECT TEXTE REPLACING ALL X"0B" BY SPACES INSPECT TEXTE REPLACING ALL X"0C" BY SPACES INSPECT TEXTE REPLACING ALL X"0D" BY SPACES INSPECT TEXTE REPLACING ALL X"0E" BY SPACES INSPECT TEXTE REPLACING ALL X"0F" BY SPACES INSPECT TEXTE REPLACING ALL X"28" BY SPACES INSPECT TEXTE REPLACING ALL X"32" BY SPACES INSPECT TEXTE REPLACING ALL X"11" BY SPACES INSPECT TEXTE REPLACING ALL X"12" BY SPACES INSPECT TEXTE REPLACING ALL X"14" BY SPACES INSPECT TEXTE REPLACING ALL X"15" BY SPACES INSPECT TEXTE REPLACING ALL X"16" BY SPACES INSPECT TEXTE REPLACING ALL X"17" BY SPACES INSPECT TEXTE REPLACING ALL X"19" BY SPACES INSPECT TEXTE REPLACING ALL X"23" BY SPACES INSPECT TEXTE REPLACING ALL X"3A" BY SPACES INSPECT TEXTE REPLACING ALL X"30" BY SPACES INSPECT TEXTE REPLACING ALL X"31" BY SPACES INSPECT TEXTE REPLACING ALL X"33" BY SPACES INSPECT TEXTE REPLACING ALL X"34" BY SPACES *----------------------------------------------------------------* * ON L'AFFICHE SI NECESSAIRE *----------------------------------------------------------------* IF TRACE-OK THEN DISPLAY "RECORD :" COMPTEUR-RECORD " NOTE Nº:" M " " " LONGUEUR : " LONGUEUR-TEXTE " " TEXTE(1:LONGUEUR-TEXTE) DISPLAY "MENTION-EDIT. :" MENTION-EDITION(1:80) DISPLAY "PAR :" NOTE-PAR(1:80) DISPLAY "PAGE :" NOTE-PAGE(1:80) DISPLAY "ILLUS :" NOTE-ILLUS(1:80) DISPLAY "FORMAT :" NOTE-FORMAT(1:80) DISPLAY "ANNEXE-1 :" NOTE-ANNEXE-1(1:80) DISPLAY "ANNEXE-2 :" NOTE-ANNEXE-2(1:80) DISPLAY "OFFSET ACTUEL :" OFFSET END-IF *----------------------------------------------------------------* * ON LE VERIFIE *----------------------------------------------------------------* IF TEXTE IS CARACTERE THEN MOVE SPACES TO STRIP MOVE TEXTE(1:LONGUEUR-TEXTE) TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO TEXTE MOVE SPACES TO STRIP MOVE NOTE-PAR TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO NOTE-PAR MOVE SPACES TO STRIP MOVE NOTE-PAGE TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO NOTE-PAGE MOVE SPACES TO STRIP MOVE NOTE-ILLUS TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO NOTE-ILLUS MOVE SPACES TO STRIP MOVE NOTE-FORMAT TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO NOTE-FORMAT MOVE SPACES TO STRIP MOVE NOTE-ANNEXE-1 TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO NOTE-ANNEXE-1 MOVE SPACES TO STRIP MOVE NOTE-ANNEXE-2 TO STRIP PERFORM STRIP-TEXT MOVE STRIP TO NOTE-ANNEXE-2 *----------------------------------------------------------------* * AJOUT DU CHAMP 327 : NOTE *----------------------------------------------------------------* MOVE 327 TO ETIQUETTE MOVE SPACES TO CHAMP STRING " " DELIMITED BY SIZE UNIMARC-START-SUBFIELD DELIMITED BY SIZE "a" DELIMITED BY SIZE TEXTE(1:LONGUEUR-TEXTE) DELIMITED BY SIZE INTO CHAMP END-STRING MOVE ZEROES TO LONGUEUR-CHAMP INSPECT CHAMP TALLYING LONGUEUR-CHAMP FOR CHARACTERS BEFORE " " PERFORM ADD-UNIMARC-FIELD *----------------------------------------------------------------* * AJOUT DU CHAM