diff options
| author | David Gageot <david@gageot.net> | 2015-07-22 09:43:54 +0200 |
|---|---|---|
| committer | David Gageot <david@gageot.net> | 2015-07-22 13:55:37 +0200 |
| commit | 4b23bd740da7cc0b7ccfd815c310ada6e86cb8b0 (patch) | |
| tree | 9187838e517a9430bae712671a4ff326e22bee4a /it/it-projects | |
| parent | 95439601477588ba93f5772e16c6fe63b593ccc3 (diff) | |
| download | sonarqube-4b23bd740da7cc0b7ccfd815c310ada6e86cb8b0.tar.gz sonarqube-4b23bd740da7cc0b7ccfd815c310ada6e86cb8b0.zip | |
Configure plugin ITs (aka it-platform)
Diffstat (limited to 'it/it-projects')
77 files changed, 22935 insertions, 0 deletions
diff --git a/it/it-projects/plugins/project/.gitignore b/it/it-projects/plugins/project/.gitignore new file mode 100644 index 00000000000..0d70cc697f5 --- /dev/null +++ b/it/it-projects/plugins/project/.gitignore @@ -0,0 +1 @@ +!target diff --git a/it/it-projects/plugins/project/build.sh b/it/it-projects/plugins/project/build.sh new file mode 100644 index 00000000000..4d8d7b14856 --- /dev/null +++ b/it/it-projects/plugins/project/build.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +mvn package diff --git a/it/it-projects/plugins/project/ext/cobol/copybooks/Attr.cpy b/it/it-projects/plugins/project/ext/cobol/copybooks/Attr.cpy new file mode 100755 index 00000000000..bc84af0bc87 --- /dev/null +++ b/it/it-projects/plugins/project/ext/cobol/copybooks/Attr.cpy @@ -0,0 +1,40 @@ + 01 ATTRIBUTE-DEFINITIONS. + * + 05 ATTR-UNPROT PIC X VALUE ' '. + 05 ATTR-UNPROT-MDT PIC X VALUE X'C1'. + 05 ATTR-UNPROT-BRT PIC X VALUE X'C8'. + 05 ATTR-UNPROT-BRT-MDT PIC X VALUE X'C9'. + 05 ATTR-UNPROT-DARK PIC X VALUE X'4C'. + 05 ATTR-UNPROT-DARK-MDT PIC X VALUE X'4D'. + 05 ATTR-UNPROT-NUM PIC X VALUE X'50'. + 05 ATTR-UNPROT-NUM-MDT PIC X VALUE X'D1'. + 05 ATTR-UNPROT-NUM-BRT PIC X VALUE X'D8'. + 05 ATTR-UNPROT-NUM-BRT-MDT PIC X VALUE X'D9'. + 05 ATTR-UNPROT-NUM-DARK PIC X VALUE X'5C'. + 05 ATTR-UNPROT-NUM-DARK-MDT PIC X VALUE X'5D'. + 05 ATTR-PROT PIC X VALUE X'60'. + 05 ATTR-PROT-MDT PIC X VALUE X'61'. + 05 ATTR-PROT-BRT PIC X VALUE X'E8'. + 05 ATTR-PROT-BRT-MDT PIC X VALUE X'E9'. + 05 ATTR-PROT-DARK PIC X VALUE '%'. + 05 ATTR-PROT-DARK-MDT PIC X VALUE X'6D'. + 05 ATTR-PROT-SKIP PIC X VALUE X'F0'. + 05 ATTR-PROT-SKIP-MDT PIC X VALUE X'F1'. + 05 ATTR-PROT-SKIP-BRT PIC X VALUE X'F8'. + 05 ATTR-PROT-SKIP-BRT-MDT PIC X VALUE X'F9'. + 05 ATTR-PROT-SKIP-DARK PIC X VALUE X'7C'. + 05 ATTR-PROT-SKIP-DARK-MDT PIC X VALUE X'7D'. + * + 05 ATTR-NO-HIGHLIGHT PIC X VALUE X'00'. + 05 ATTR-BLINK PIC X VALUE '1'. + 05 ATTR-REVERSE PIC X VALUE '2'. + 05 ATTR-UNDERSCORE PIC X VALUE '4'. + * + 05 ATTR-DEFAULT-COLOR PIC X VALUE X'00'. + 05 ATTR-BLUE PIC X VALUE '1'. + 05 ATTR-RED PIC X VALUE '2'. + 05 ATTR-PINK PIC X VALUE '3'. + 05 ATTR-GREEN PIC X VALUE '4'. + 05 ATTR-TURQUOISE PIC X VALUE '5'. + 05 ATTR-YELLOW PIC X VALUE '6'. + 05 ATTR-NEUTRAL PIC X VALUE '7'. diff --git a/it/it-projects/plugins/project/ext/cobol/copybooks/Custmas.cpy b/it/it-projects/plugins/project/ext/cobol/copybooks/Custmas.cpy new file mode 100755 index 00000000000..e0b41ae39d5 --- /dev/null +++ b/it/it-projects/plugins/project/ext/cobol/copybooks/Custmas.cpy @@ -0,0 +1,9 @@ + 01 CUSTOMER-MASTER-RECORD. + * + 05 CM-CUSTOMER-NUMBER PIC X(6). + 05 CM-FIRST-NAME PIC X(20). + 05 CM-LAST-NAME PIC X(30). + 05 CM-ADDRESS PIC X(30). + 05 CM-CITY PIC X(20). + 05 CM-STATE PIC X(2). + 05 CM-ZIP-CODE PIC X(10). diff --git a/it/it-projects/plugins/project/ext/cobol/copybooks/Errparm.cpy b/it/it-projects/plugins/project/ext/cobol/copybooks/Errparm.cpy new file mode 100755 index 00000000000..3324a1b78a6 --- /dev/null +++ b/it/it-projects/plugins/project/ext/cobol/copybooks/Errparm.cpy @@ -0,0 +1,6 @@ + 01 ERROR-PARAMETERS. + * + 05 ERR-RESP PIC S9(8) COMP. + 05 ERR-RESP2 PIC S9(8) COMP. + 05 ERR-TRNID PIC X(4) VALUE IS 99. + 05 ERR-RSRCE PIC X(8). diff --git a/it/it-projects/plugins/project/ext/cobol/copybooks/MNTSET2.CPY b/it/it-projects/plugins/project/ext/cobol/copybooks/MNTSET2.CPY new file mode 100755 index 00000000000..b9e18823838 --- /dev/null +++ b/it/it-projects/plugins/project/ext/cobol/copybooks/MNTSET2.CPY @@ -0,0 +1,181 @@ + * Micro Focus BMS Screen Painter (ver MFBM 2.0.11) + * MapSet Name MNTSET2 + * Date Created 04/16/2001 + * Time Created 14:38:47 + + * Input Data For Map MNTMAP1 + 01 MNTMAP1I. + 03 FILLER PIC X(12). + 03 TRANID1L PIC S9(4) COMP. + 03 TRANID1F PIC X. + 03 FILLER REDEFINES TRANID1F. + 05 TRANID1A PIC X. + 03 FILLER PIC X(2). + 03 TRANID1I PIC X(4). + 03 CUSTNO1L PIC S9(4) COMP. + 03 CUSTNO1F PIC X. + 03 FILLER REDEFINES CUSTNO1F. + 05 CUSTNO1A PIC X. + 03 FILLER PIC X(2). + 03 CUSTNO1I PIC X(6). + 03 ACTIONL PIC S9(4) COMP. + 03 ACTIONF PIC X. + 03 FILLER REDEFINES ACTIONF. + 05 ACTIONA PIC X. + 03 FILLER PIC X(2). + 03 ACTIONI PIC X(1). + 03 MSG1L PIC S9(4) COMP. + 03 MSG1F PIC X. + 03 FILLER REDEFINES MSG1F. + 05 MSG1A PIC X. + 03 FILLER PIC X(2). + 03 MSG1I PIC X(79). + 03 DUMMY1L PIC S9(4) COMP. + 03 DUMMY1F PIC X. + 03 FILLER REDEFINES DUMMY1F. + 05 DUMMY1A PIC X. + 03 FILLER PIC X(2). + 03 DUMMY1I PIC X(1). + + * Output Data For Map MNTMAP1 + 01 MNTMAP1O REDEFINES MNTMAP1I. + 03 FILLER PIC X(12). + 03 FILLER PIC X(3). + 03 TRANID1C PIC X. + 03 TRANID1H PIC X. + 03 TRANID1O PIC X(4). + 03 FILLER PIC X(3). + 03 CUSTNO1C PIC X. + 03 CUSTNO1H PIC X. + 03 CUSTNO1O PIC X(6). + 03 FILLER PIC X(3). + 03 ACTIONC PIC X. + 03 ACTIONH PIC X. + 03 ACTIONO PIC X(1). + 03 FILLER PIC X(3). + 03 MSG1C PIC X. + 03 MSG1H PIC X. + 03 MSG1O PIC X(79). + 03 FILLER PIC X(3). + 03 DUMMY1C PIC X. + 03 DUMMY1H PIC X. + 03 DUMMY1O PIC X(1). + + * Input Data For Map MNTMAP2 + 01 MNTMAP2I. + 03 FILLER PIC X(12). + 03 TRANID2L PIC S9(4) COMP. + 03 TRANID2F PIC X. + 03 FILLER REDEFINES TRANID2F. + 05 TRANID2A PIC X. + 03 FILLER PIC X(2). + 03 TRANID2I PIC X(4). + 03 INSTR2L PIC S9(4) COMP. + 03 INSTR2F PIC X. + 03 FILLER REDEFINES INSTR2F. + 05 INSTR2A PIC X. + 03 FILLER PIC X(2). + 03 INSTR2I PIC X(79). + 03 CUSTNO2L PIC S9(4) COMP. + 03 CUSTNO2F PIC X. + 03 FILLER REDEFINES CUSTNO2F. + 05 CUSTNO2A PIC X. + 03 FILLER PIC X(2). + 03 CUSTNO2I PIC X(6). + 03 LNAMEL PIC S9(4) COMP. + 03 LNAMEF PIC X. + 03 FILLER REDEFINES LNAMEF. + 05 LNAMEA PIC X. + 03 FILLER PIC X(2). + 03 LNAMEI PIC X(30). + 03 FNAMEL PIC S9(4) COMP. + 03 FNAMEF PIC X. + 03 FILLER REDEFINES FNAMEF. + 05 FNAMEA PIC X. + 03 FILLER PIC X(2). + 03 FNAMEI PIC X(20). + 03 ADDRL PIC S9(4) COMP. + 03 ADDRF PIC X. + 03 FILLER REDEFINES ADDRF. + 05 ADDRA PIC X. + 03 FILLER PIC X(2). + 03 ADDRI PIC X(30). + 03 CITYL PIC S9(4) COMP. + 03 CITYF PIC X. + 03 FILLER REDEFINES CITYF. + 05 CITYA PIC X. + 03 FILLER PIC X(2). + 03 CITYI PIC X(20). + 03 STATEL PIC S9(4) COMP. + 03 STATEF PIC X. + 03 FILLER REDEFINES STATEF. + 05 STATEA PIC X. + 03 FILLER PIC X(2). + 03 STATEI PIC X(2). + 03 ZIPCODEL PIC S9(4) COMP. + 03 ZIPCODEF PIC X. + 03 FILLER REDEFINES ZIPCODEF. + 05 ZIPCODEA PIC X. + 03 FILLER PIC X(2). + 03 ZIPCODEI PIC X(10). + 03 MSG2L PIC S9(4) COMP. + 03 MSG2F PIC X. + 03 FILLER REDEFINES MSG2F. + 05 MSG2A PIC X. + 03 FILLER PIC X(2). + 03 MSG2I PIC X(79). + 03 DUMMY2L PIC S9(4) COMP. + 03 DUMMY2F PIC X. + 03 FILLER REDEFINES DUMMY2F. + 05 DUMMY2A PIC X. + 03 FILLER PIC X(2). + 03 DUMMY2I PIC X(1). + + * Output Data For Map MNTMAP2 + 01 MNTMAP2O REDEFINES MNTMAP2I. + 03 FILLER PIC X(12). + 03 FILLER PIC X(3). + 03 TRANID2C PIC X. + 03 TRANID2H PIC X. + 03 TRANID2O PIC X(4). + 03 FILLER PIC X(3). + 03 INSTR2C PIC X. + 03 INSTR2H PIC X. + 03 INSTR2O PIC X(79). + 03 FILLER PIC X(3). + 03 CUSTNO2C PIC X. + 03 CUSTNO2H PIC X. + 03 CUSTNO2O PIC X(6). + 03 FILLER PIC X(3). + 03 LNAMEC PIC X. + 03 LNAMEH PIC X. + 03 LNAMEO PIC X(30). + 03 FILLER PIC X(3). + 03 FNAMEC PIC X. + 03 FNAMEH PIC X. + 03 FNAMEO PIC X(20). + 03 FILLER PIC X(3). + 03 ADDRC PIC X. + 03 ADDRH PIC X. + 03 ADDRO PIC X(30). + 03 FILLER PIC X(3). + 03 CITYC PIC X. + 03 CITYH PIC X. + 03 CITYO PIC X(20). + 03 FILLER PIC X(3). + 03 STATEC PIC X. + 03 STATEH PIC X. + 03 STATEO PIC X(2). + 03 FILLER PIC X(3). + 03 ZIPCODEC PIC X. + 03 ZIPCODEH PIC X. + 03 ZIPCODEO PIC X(10). + 03 FILLER PIC X(3). + 03 MSG2C PIC X. + 03 MSG2H PIC X. + 03 MSG2O PIC X(79). + 03 FILLER PIC X(3). + 03 DUMMY2C PIC X. + 03 DUMMY2H PIC X. + 03 DUMMY2O PIC X(1). + diff --git a/it/it-projects/plugins/project/lib/c/mylib.h b/it/it-projects/plugins/project/lib/c/mylib.h new file mode 100644 index 00000000000..63e375d712b --- /dev/null +++ b/it/it-projects/plugins/project/lib/c/mylib.h @@ -0,0 +1,2 @@ +#define ADD(X, Y) X + Y + diff --git a/it/it-projects/plugins/project/pom.xml b/it/it-projects/plugins/project/pom.xml new file mode 100644 index 00000000000..41a46c9508a --- /dev/null +++ b/it/it-projects/plugins/project/pom.xml @@ -0,0 +1,30 @@ +<!-- + + Maven is used only to build project when Java files are changed. The generated + classes are stored in Git. + Sources are analyzed with sonar-runner. + +--> + +<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" + xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <groupId>com.sonarsource.it-all-lang</groupId> + <artifactId>it-all-lang</artifactId> + <version>1.0-SNAPSHOT</version> + <name>All Languages</name> + + <dependencies> + <dependency> + <groupId>junit</groupId> + <artifactId>junit</artifactId> + <version>4.10</version> + <scope>test</scope> + </dependency> + </dependencies> + + <build> + <sourceDirectory>src/java</sourceDirectory> + <testSourceDirectory>test/java</testSourceDirectory> + </build> +</project> diff --git a/it/it-projects/plugins/project/sonar-project.properties b/it/it-projects/plugins/project/sonar-project.properties new file mode 100644 index 00000000000..c0d80855a0a --- /dev/null +++ b/it/it-projects/plugins/project/sonar-project.properties @@ -0,0 +1,40 @@ +sonar.projectKey=all-langs +sonar.projectName=All Languages +sonar.projectVersion=1.0-SNAPSHOT + +sonar.encoding=UTF-8 +sonar.sources=. +sonar.inclusions=src/**,ext/** +# PLI temporarily disabled as it does not support multi-language configuration. It still requires +# the property sonar.language to be set to 'pli'. +sonar.exclusions=src/pli/** +sonar.test.inclusions=test/** + +# C +sonar.cfamily.library.directories=lib/c + +# Cobol +sonar.cobol.copy.directories=ext/cobol/copybooks +sonar.cobol.file.suffixes=cbl,cpy +sonar.cobol.copy.suffixes=cpy + +# Java +sonar.junit.reportsPath=reports/java/surefire-reports +sonar.jacoco.reportPath=reports/java/jacoco.exec +sonar.java.binaries=target/classes +sonar.java.test.binaries=target/test-classes + +# JavaScript +sonar.javascript.lcov.reportPath=target/js/lcov.dat + +# Flex +sonar.flex.cobertura.reportPath=reports/flex/coverage.xml + +#PHP +# Reusing PHPUnit reports +sonar.php.coverage.reportPath=target/php/phpunit.coverage.xml +sonar.php.tests.reportPath=target/php/phpunit.xml + +#PLI - temporarily disabled (see exclusions) +sonar.pli.marginLeft=2 +sonar.pli.marginRight=0 diff --git a/it/it-projects/plugins/project/src/abap/ZBCMKZ17.abap b/it/it-projects/plugins/project/src/abap/ZBCMKZ17.abap new file mode 100644 index 00000000000..936119df612 --- /dev/null +++ b/it/it-projects/plugins/project/src/abap/ZBCMKZ17.abap @@ -0,0 +1,147 @@ +REPORT ZBCMKZ17. +*----------------------------------------------------------------------* +* Description: Report and Transaction Starter * +* It shows an individual list of reports/Trans. to start* +* * +* Authorization: S_PROGRAM, Reports starten * +* * +* Class: Utility * +* * +* Customizing: Needs Customer Table: ZBCMKZ1 * +* Field: Key Type Length Descr. * +* ZBCMKZ1-BNAME X CHAR C 12 User name * +* ZBCMKZ1-NAME X CHAR C 8 Report/Trans. code * +* ZBCMKZ1-NUMMER INT1 X 1 Priority level * +* * +* R/3 Release: 3.0d * +* * +* Programmer: Bence Toth * +* Date: 1997 April * +* * +*----------------------------------------------------------------------* +INCLUDE: <ICON>. +TABLES: ZBCMKZ1, TRDIR, TSTCT, TSTC. +DATA: BEGIN OF BTAB OCCURS 50, "Hilfstabelle fuer Textpool + CODE(82), + END OF BTAB. +DATA: BEGIN OF T OCCURS 100, + NUMMER LIKE ZBCMKZ1-NUMMER, + NAME LIKE TRDIR-NAME, + CODE(82), +END OF T. +DATA: FI(20). +DATA BEGIN OF BDCDATA OCCURS 100. + INCLUDE STRUCTURE BDCDATA. +DATA END OF BDCDATA. + +DATA BEGIN OF MESSTAB OCCURS 10. + INCLUDE STRUCTURE BDCMSGCOLL. +DATA END OF MESSTAB. + +DATA REPORT. +AUTHORITY-CHECK OBJECT 'S_PROGRAM' + ID 'P_GROUP' FIELD '*' + ID 'P_ACTION' FIELD '*'. +IF SY-SUBRC NE 0. EXIT. ENDIF. +WRITE: /2 'Er. Modus', 12 'Name', 22 'Text'. + + +DETAIL. +SKIP. +SELECT * FROM ZBCMKZ1 WHERE BNAME EQ SY-UNAME. + CHECK ZBCMKZ1-NAME+5(1) EQ ' '. + SELECT SINGLE * FROM TSTC WHERE TCODE EQ ZBCMKZ1-NAME. + CHECK SY-SUBRC EQ 0. + CLEAR TSTCT. + SELECT SINGLE * FROM TSTCT WHERE SPRSL EQ SY-LANGU AND + TCODE EQ ZBCMKZ1-NAME. + T-CODE = TSTCT-TTEXT. + MOVE-CORRESPONDING ZBCMKZ1 TO T. + APPEND T. + CLEAR T. +ENDSELECT. +SORT T BY NUMMER CODE. +REPORT = ' '. +PERFORM LIST USING REPORT. +SELECT * FROM ZBCMKZ1 WHERE BNAME EQ SY-UNAME. + CHECK ZBCMKZ1-NAME+5(1) NE ' '. + READ TEXTPOOL ZBCMKZ1-NAME INTO BTAB LANGUAGE SY-LANGU. + CHECK SY-SUBRC EQ 0. + LOOP AT BTAB. + IF BTAB-CODE(1) EQ 'R'. + EXIT. + ENDIF. + ENDLOOP. + MOVE BTAB-CODE+9(70) TO T-CODE. + MOVE-CORRESPONDING ZBCMKZ1 TO T. + APPEND T. + CLEAR T. +ENDSELECT. +SORT T BY NUMMER CODE. +REPORT = 'X'. +PERFORM LIST USING REPORT. + +AT LINE-SELECTION. + CHECK NOT ( T-NAME IS INITIAL ). + GET CURSOR FIELD FI. + IF T-NAME+5(1) EQ ' '. + REPORT = ' '. + ELSE. + REPORT = 'X'. + ENDIF. + IF FI = 'ICON_EXECUTE_OBJECT'. + PERFORM PERO USING T-NAME REPORT. + ELSEIF REPORT EQ ' '. +* SELECT SINGLE * FROM TSTC WHERE TCODE EQ ZBCMKZ1-NAME. +* IF T+5(1) EQ ' '. + CALL TRANSACTION T-NAME. + ELSE. + SUBMIT (T-NAME) VIA SELECTION-SCREEN AND RETURN. + ENDIF. + CLEAR T-NAME. +*---------------------------------------------------------------------* +* FORM LIST * +*---------------------------------------------------------------------* +* ........ * +*---------------------------------------------------------------------* +FORM LIST USING REPORT. + LOOP AT T. + IF REPORT = ' '. + WRITE: /5 ICON_EXECUTE_OBJECT AS ICON, T-NAME UNDER 'Name', + T-CODE UNDER 'Text'. + ELSE. + WRITE: / T-NAME UNDER 'Name', T-CODE UNDER 'Text'. + ENDIF. + HIDE T. + AT END OF NUMMER. + SKIP. + ENDAT. + ENDLOOP. + SKIP. + CLEAR T. + REFRESH T. +ENDFORM. +*---------------------------------------------------------------------* +* FORM PERO * +*---------------------------------------------------------------------* +* ........ * +*---------------------------------------------------------------------* +* --> T-NAME * +*---------------------------------------------------------------------* +FORM PERO USING T-NAME REPORT. + CHECK REPORT EQ ' '. + MOVE T-NAME TO T-NAME+2(4). + MOVE '/o' TO T-NAME+0(2). + BDCDATA-PROGRAM = 'SAPMS01J'. + BDCDATA-DYNPRO = '0310'. + BDCDATA-DYNBEGIN = 'X'. + APPEND BDCDATA. + CLEAR BDCDATA. + BDCDATA-FNAM = 'BDC_OKCODE'. + BDCDATA-FVAL = T-NAME. + APPEND BDCDATA. + CALL TRANSACTION 'SU50' USING BDCDATA MODE 'N' + MESSAGES INTO MESSTAB. + CLEAR BDCDATA. + REFRESH BDCDATA. +ENDFORM. diff --git a/it/it-projects/plugins/project/src/abap/ZZBGS106.abap b/it/it-projects/plugins/project/src/abap/ZZBGS106.abap new file mode 100644 index 00000000000..f0e75a11934 --- /dev/null +++ b/it/it-projects/plugins/project/src/abap/ZZBGS106.abap @@ -0,0 +1,194 @@ +REPORT ZZBGS106 MESSAGE-ID Z1. +*----------------------------------------------------------------------* +* Description: Utillity used for downloading abap/4 source code and * +* text elements to the desktop using ws_download. * +* Is useful as backup or for transporting to another site.* +* You must run this program in foreground/online due to * +* the use of ws_download throug the SAPGUI. * +* * +* Implementing The program is client independent. * +* * +* Authoriza. No Authorization check. * +* * +* Submitting: Run by SA38, SE38. * +* * +* Parametre: You can use generic values when filling the parameters * +* except for the Path. * +* * +* Customizing: No need for customization. * +* * +* Change of You only need to do the syntax check at releasechanges. * +* release: * +* * +* R/3 Release: Developed and tested in R/3 Release: * +* 2.2F * +* 3.0D * +* * +* Programmer: Benny G. S�rensen, BGS-Consulting * +* Date: Nov 1996. * +* * +* Version 1 +*-------------------------------Corrections----------------------------* +* Date Userid Correction Text * +* 11.11.1996 BGS :::::::::::::: Start of development * +*----------------------------------------------------------------------* +*----------------------------------------------------------------------* +* Tables * +*----------------------------------------------------------------------* +TABLES: TRDIR "Application Masterdata + . +*----------------------------------------------------------------------* +* Parameters * +*----------------------------------------------------------------------* +SELECT-OPTIONS: REPO FOR TRDIR-NAME. +PARAMETERS: PATH(60) TYPE C DEFAULT 'C:\SAP\'. + +*----------------------------------------------------------------------* +* Work Variables and internal tables * +*----------------------------------------------------------------------* +DATA: BEGIN OF TABSOURCE OCCURS 10 + ,SOURCE(72) TYPE C + ,END OF TABSOURCE. + +DATA: BEGIN OF TABTEXT OCCURS 50 + ,TAB LIKE TEXTPOOL + ,END OF TABTEXT. + +DATA: BEGIN OF TABRDIR OCCURS 100 + ,RDIR LIKE TRDIR + ,END OF TABRDIR. + +DATA: FILENAME LIKE RLGRAP-FILENAME + ,MODE TYPE C VALUE ' ' + ,RDIRROWS TYPE I + ,SOURCEROWS TYPE I + ,RC TYPE I + ,LENGTH TYPE I + . +FIELD-SYMBOLS: <P> . + +*----------------------------------------------------------------------* +* Constants * +*----------------------------------------------------------------------* +DATA: OK TYPE I VALUE 0 + ,FAIL TYPE I VALUE 1. + +*----------------------------------------------------------------------* +* EVENT: validate users entries on the selection screen * +*----------------------------------------------------------------------* +AT SELECTION-SCREEN. +DATA: I TYPE I. + DESCRIBE TABLE REPO LINES I. + IF I <= 0. + SET CURSOR FIELD REPO. + MESSAGE E065 WITH TEXT-101. + ENDIF. + +*----------------------------------------------------------------------* +* EVENT: Start-Of-Selection * +*----------------------------------------------------------------------* +START-OF-SELECTION. +* Set slash at the end of path if not speciefied by user + CONDENSE PATH NO-GAPS. + LENGTH = STRLEN( PATH ) . + SUBTRACT 1 FROM LENGTH. + ASSIGN PATH+LENGTH(1) TO <P>. + IF <P> <> '\'. + ADD 1 TO LENGTH. + ASSIGN PATH+LENGTH TO <P>. + <P> = '\'. + ENDIF. + + SELECT * FROM TRDIR INTO TABLE TABRDIR WHERE NAME IN REPO. + DESCRIBE TABLE TABRDIR LINES RDIRROWS. + CHECK RDIRROWS > 0. + +* For every selected program: + LOOP AT TABRDIR. + MOVE TABRDIR TO TRDIR. + PERFORM DOWNLOAD_SOURCE USING RC. + CHECK RC = OK. + PERFORM DOWNLOAD_TEXTPOOL USING RC. + ENDLOOP. + +*----------------------------------------------------------------------* +* FORM: Download_Sourcecode * +*----------------------------------------------------------------------* +FORM DOWNLOAD_SOURCE USING RC. + RC = FAIL. + CLEAR: TABSOURCE, FILENAME. + REFRESH: TABSOURCE. + READ REPORT TRDIR-NAME INTO TABSOURCE. + DESCRIBE TABLE TABSOURCE LINES SOURCEROWS. + CHECK SOURCEROWS > 0. + + CALL FUNCTION 'STRING_CONCATENATE_3' "R. 2.2F + EXPORTING "R. 2.2F + STRING1 = PATH "R. 2.2F + STRING2 = TRDIR-NAME "R. 2.2F + STRING3 = '.aba' "R. 2.2F + IMPORTING "R. 2.2F + STRING = FILENAME "R. 2.2F + EXCEPTIONS "R. 2.2F + TOO_SMALL = 01. "R. 2.2F + +* CONCATENATE PATH TRDIR-NAME '.ABA' INTO FILENAME. "R. 3.0D + CONDENSE FILENAME NO-GAPS. + PERFORM DOWNLOAD TABLES TABSOURCE USING FILENAME RC. + +ENDFORM. + +*----------------------------------------------------------------------* +* FORM: Download_Textpool * +*----------------------------------------------------------------------* +FORM DOWNLOAD_TEXTPOOL USING RC. + RC = FAIL. + CLEAR: TABTEXT, FILENAME. + REFRESH: TABTEXT. + READ TEXTPOOL TRDIR-NAME INTO TABTEXT LANGUAGE SY-LANGU. + DESCRIBE TABLE TABTEXT LINES SOURCEROWS. + CHECK SOURCEROWS > 0. + + CALL FUNCTION 'STRING_CONCATENATE_3' "R. 2.2F + EXPORTING "R. 2.2F + STRING1 = PATH "R. 2.2F + STRING2 = TRDIR-NAME "R. 2.2F + STRING3 = '.TXT' "R. 2.2F + IMPORTING "R. 2.2F + STRING = FILENAME "R. 2.2F + EXCEPTIONS "R. 2.2F + TOO_SMALL = 01. "R. 2.2F + +* CONCATENATE PATH TRDIR-NAME '.TXT' INTO FILENAME. "R. 3.0x + CONDENSE FILENAME NO-GAPS. + PERFORM DOWNLOAD TABLES TABTEXT USING FILENAME RC. + +ENDFORM. + +*----------------------------------------------------------------------* +* FORM: Download * +*----------------------------------------------------------------------* +FORM DOWNLOAD TABLES TABDATA USING FILENAME RC. + + RC = FAIL. + CALL FUNCTION 'WS_DOWNLOAD' + EXPORTING + FILENAME = FILENAME + FILETYPE = 'ASC' + MODE = MODE + TABLES + DATA_TAB = TABDATA + EXCEPTIONS + FILE_OPEN_ERROR = 1 + FILE_WRITE_ERROR = 2 + INVALID_FILESIZE = 3 + INVALID_TABLE_WIDTH = 4 + INVALID_TYPE = 5 + NO_BATCH = 6 + UNKNOWN_ERROR = 7. + IF SY-SUBRC <> OK. + WRITE:/ SY-SUBRC, TEXT-100. + ENDIF. + RC = SY-SUBRC. + +ENDFORM. diff --git a/it/it-projects/plugins/project/src/c/main.c b/it/it-projects/plugins/project/src/c/main.c new file mode 100644 index 00000000000..2c3bf69a583 --- /dev/null +++ b/it/it-projects/plugins/project/src/c/main.c @@ -0,0 +1,19 @@ +#include <stdio.h> /* NOK, according to the MISRA C 2004 20.9 rule, stdio.h must not be used in embedded system's production code */ + +#include <mylib.h> + +/* + * Compile & run from current folder: + * gcc -Wall -pedantic -std=c99 -I../lib -o main main.c && ./main + */ + +int main(void) { + int x = ADD(40, 2); + + if (x != 42) + { /* NOK, empty code blocks generate violations */ + } + + // print something + printf("40 + 2 = %d\n", x); +} diff --git a/it/it-projects/plugins/project/src/cobol/Custmnt2.cbl b/it/it-projects/plugins/project/src/cobol/Custmnt2.cbl new file mode 100755 index 00000000000..662b5ca706f --- /dev/null +++ b/it/it-projects/plugins/project/src/cobol/Custmnt2.cbl @@ -0,0 +1,581 @@ + IDENTIFICATION DIVISION. + * + PROGRAM-ID. CUSTMNT2. + * + ENVIRONMENT DIVISION. + * + DATA DIVISION. + * + WORKING-STORAGE SECTION. + * + 01 SWITCHES. + * + 05 VALID-DATA-SW PIC X(01) VALUE 'Y'. + 88 VALID-DATA VALUE 'Y'. + * + 01 FLAGS. + * + 05 SEND-FLAG PIC X(01). + 88 SEND-ERASE VALUE '1'. + 88 SEND-ERASE-ALARM VALUE '2'. + 88 SEND-DATAONLY VALUE '3'. + 88 SEND-DATAONLY-ALARM VALUE '4'. + * + 01 WORK-FIELDS. + * + 05 RESPONSE-CODE PIC S9(08) COMP. + * + 01 USER-INSTRUCTIONS. + * + 05 ADD-INSTRUCTION PIC X(79) VALUE + 'Type information for new customer. Then Press Enter.'. + 05 CHANGE-INSTRUCTION PIC X(79) VALUE + 'Type changes. Then press Enter.'. + 05 DELETE-INSTRUCTION PIC X(79) VALUE + 'Press Enter to delete this customer or press F12 to canc + - 'el.'. + * + 01 COMMUNICATION-AREA. + * + 05 CA-CONTEXT-FLAG PIC X(01). + 88 PROCESS-KEY-MAP VALUE '1'. + 88 PROCESS-ADD-CUSTOMER VALUE '2'. + 88 PROCESS-CHANGE-CUSTOMER VALUE '3'. + 88 PROCESS-DELETE-CUSTOMER VALUE '4'. + 05 CA-CUSTOMER-RECORD. + 10 CA-CUSTOMER-NUMBER PIC X(06). + 10 FILLER PIC X(112). + * + COPY CUSTMAS. + * + COPY MNTSET2. + * + COPY DFHAID. + * + COPY ATTR. + * + COPY ERRPARM. + * + LINKAGE SECTION. + * + 01 DFHCOMMAREA PIC X(119). + * + PROCEDURE DIVISION. + * + 0000-PROCESS-CUSTOMER-MAINT. + * + IF EIBCALEN > ZERO + MOVE DFHCOMMAREA TO COMMUNICATION-AREA + END-IF. + * + EVALUATE TRUE + * + WHEN EIBCALEN = ZERO + MOVE LOW-VALUE TO MNTMAP1O + MOVE -1 TO CUSTNO1L + SET SEND-ERASE TO TRUE + PERFORM 1500-SEND-KEY-MAP + SET PROCESS-KEY-MAP TO TRUE + * + WHEN EIBAID = DFHPF3 + EXEC CICS + XCTL PROGRAM('INVMENU') + END-EXEC + * + WHEN EIBAID = DFHPF12 + IF PROCESS-KEY-MAP + EXEC CICS + XCTL PROGRAM('INVMENU') + END-EXEC + ELSE + MOVE LOW-VALUE TO MNTMAP1O + MOVE -1 TO CUSTNO1L + SET SEND-ERASE TO TRUE + PERFORM 1500-SEND-KEY-MAP + SET PROCESS-KEY-MAP TO TRUE + END-IF + * + WHEN EIBAID = DFHCLEAR + IF PROCESS-KEY-MAP + MOVE LOW-VALUE TO MNTMAP1O + MOVE -1 TO CUSTNO1L + SET SEND-ERASE TO TRUE + PERFORM 1500-SEND-KEY-MAP + ELSE + MOVE LOW-VALUE TO MNTMAP2O + MOVE CA-CUSTOMER-NUMBER TO CUSTNO2O + EVALUATE TRUE + WHEN PROCESS-ADD-CUSTOMER + MOVE ADD-INSTRUCTION TO INSTR2O + WHEN PROCESS-CHANGE-CUSTOMER + MOVE CHANGE-INSTRUCTION TO INSTR2O + WHEN PROCESS-DELETE-CUSTOMER + MOVE DELETE-INSTRUCTION TO INSTR2O + END-EVALUATE + MOVE -1 TO LNAMEL + SET SEND-ERASE TO TRUE + PERFORM 1400-SEND-DATA-MAP + END-IF + * + WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3 + CONTINUE + * + WHEN EIBAID = DFHENTER + EVALUATE TRUE + WHEN PROCESS-KEY-MAP + PERFORM 1000-PROCESS-KEY-MAP + WHEN PROCESS-ADD-CUSTOMER + PERFORM 2000-PROCESS-ADD-CUSTOMER + WHEN PROCESS-CHANGE-CUSTOMER + PERFORM 3000-PROCESS-CHANGE-CUSTOMER + WHEN PROCESS-DELETE-CUSTOMER + PERFORM 4000-PROCESS-DELETE-CUSTOMER + END-EVALUATE + * + WHEN OTHER + IF PROCESS-KEY-MAP + MOVE LOW-VALUE TO MNTMAP1O + MOVE 'That key is unassigned.' TO MSG1O + MOVE -1 TO CUSTNO1L + SET SEND-DATAONLY-ALARM TO TRUE + PERFORM 1500-SEND-KEY-MAP + ELSE + MOVE LOW-VALUE TO MNTMAP2O + MOVE 'That key is unassigned.' TO MSG2O + MOVE -1 TO LNAMEL + SET SEND-DATAONLY-ALARM TO TRUE + PERFORM 1400-SEND-DATA-MAP + END-IF + * + END-EVALUATE. + + EXEC CICS + RETURN TRANSID('MNT2') + COMMAREA(COMMUNICATION-AREA) + END-EXEC. + * + 1000-PROCESS-KEY-MAP. + * + PERFORM 1100-RECEIVE-KEY-MAP. + PERFORM 1200-EDIT-KEY-DATA. + IF VALID-DATA + IF NOT PROCESS-DELETE-CUSTOMER + INSPECT CUSTOMER-MASTER-RECORD + REPLACING ALL SPACE BY '_' + END-IF + MOVE CUSTNO1I TO CUSTNO2O + MOVE CM-LAST-NAME TO LNAMEO + MOVE CM-FIRST-NAME TO FNAMEO + MOVE CM-ADDRESS TO ADDRO + MOVE CM-CITY TO CITYO + MOVE CM-STATE TO STATEO + MOVE CM-ZIP-CODE TO ZIPCODEO + MOVE -1 TO LNAMEL + SET SEND-ERASE TO TRUE + PERFORM 1400-SEND-DATA-MAP + ELSE + MOVE LOW-VALUE TO CUSTNO1O + ACTIONO + SET SEND-DATAONLY-ALARM TO TRUE + PERFORM 1500-SEND-KEY-MAP + END-IF. + * + 1100-RECEIVE-KEY-MAP. + * + EXEC CICS + RECEIVE MAP('MNTMAP1') + MAPSET('MNTSET2') + INTO(MNTMAP1I) + END-EXEC. + * + INSPECT MNTMAP1I + REPLACING ALL '_' BY SPACE. + * + 1200-EDIT-KEY-DATA. + * + MOVE ATTR-NO-HIGHLIGHT TO ACTIONH + CUSTNO1H. + * + IF ACTIONI NOT = '1' AND '2' AND '3' AND '4' AND '5' + MOVE ATTR-REVERSE TO ACTIONH + MOVE -1 TO ACTIONL + MOVE 'Action must be 1, 2, or 3.' TO MSG1O + MOVE 'N' TO VALID-DATA-SW + END-IF. + * + IF CUSTNO1L = ZERO + OR CUSTNO1I = SPACE + MOVE ATTR-REVERSE TO CUSTNO1H + MOVE -1 TO CUSTNO1L + MOVE 'You must enter a customer number.' TO MSG1O + MOVE 'N' TO VALID-DATA-SW + END-IF. + * + IF VALID-DATA + MOVE LOW-VALUE TO MNTMAP2O + EVALUATE ACTIONI + WHEN '1' + PERFORM 1300-READ-CUSTOMER-RECORD + IF RESPONSE-CODE = DFHRESP(NOTFND) + MOVE ADD-INSTRUCTION TO INSTR2O + SET PROCESS-ADD-CUSTOMER TO TRUE + MOVE SPACE TO CUSTOMER-MASTER-RECORD + ELSE + IF RESPONSE-CODE = DFHRESP(NORMAL) + MOVE 'That customer already exists.' + TO MSG1O + MOVE 'N' TO VALID-DATA-SW + END-IF + END-IF + WHEN '2' + PERFORM 1300-READ-CUSTOMER-RECORD + IF RESPONSE-CODE = DFHRESP(NORMAL) + MOVE CUSTOMER-MASTER-RECORD TO + CA-CUSTOMER-RECORD + MOVE CHANGE-INSTRUCTION TO INSTR2O + SET PROCESS-CHANGE-CUSTOMER TO TRUE + ELSE + IF RESPONSE-CODE = DFHRESP(NOTFND) + MOVE 'That customer does not exist.' TO + MSG1O + MOVE 'N' TO VALID-DATA-SW + END-IF + END-IF + WHEN '3' + PERFORM 1300-READ-CUSTOMER-RECORD + IF RESPONSE-CODE = DFHRESP(NORMAL) + MOVE CUSTOMER-MASTER-RECORD TO + CA-CUSTOMER-RECORD + MOVE DELETE-INSTRUCTION TO INSTR2O + SET PROCESS-DELETE-CUSTOMER TO TRUE + MOVE ATTR-PROT TO LNAMEA + FNAMEA + ADDRA + CITYA + STATEA + ZIPCODEA + ELSE + IF RESPONSE-CODE = DFHRESP(NOTFND) + MOVE 'That customer does not exist.' TO + MSG1O + MOVE 'N' TO VALID-DATA-SW + END-IF + END-IF + END-EVALUATE. + * + 1300-READ-CUSTOMER-RECORD. + * + EXEC CICS + READ FILE('CUSTMAS') + INTO(CUSTOMER-MASTER-RECORD) + RIDFLD(CUSTNO1I) + RESP(RESPONSE-CODE) + END-EXEC. + * + IF RESPONSE-CODE NOT = DFHRESP(NORMAL) + AND RESPONSE-CODE NOT = DFHRESP(NOTFND) + PERFORM 9999-TERMINATE-PROGRAM + END-IF. + * + 1400-SEND-DATA-MAP. + * + MOVE 'MNT2' TO TRANID2O. + * + EVALUATE TRUE + WHEN SEND-ERASE + EXEC CICS + SEND MAP('MNTMAP2') + MAPSET('MNTSET2') + FROM(MNTMAP2O) + ERASE + CURSOR + END-EXEC + WHEN SEND-DATAONLY-ALARM + EXEC CICS + SEND MAP('MNTMAP2') + MAPSET('MNTSET2') + FROM(MNTMAP2O) + DATAONLY + ALARM + CURSOR + END-EXEC + END-EVALUATE. + * + 1500-SEND-KEY-MAP. + * + MOVE 'MNT2' TO TRANID1O. + * + EVALUATE TRUE + WHEN SEND-ERASE + EXEC CICS + SEND MAP('MNTMAP1') + MAPSET('MNTSET2') + FROM(MNTMAP1O) + ERASE + CURSOR + END-EXEC + WHEN SEND-ERASE-ALARM + EXEC CICS + SEND MAP('MNTMAP1') + MAPSET('MNTSET2') + FROM(MNTMAP1O) + ERASE + ALARM + CURSOR + END-EXEC + WHEN SEND-DATAONLY-ALARM + EXEC CICS + SEND MAP('MNTMAP1') + MAPSET('MNTSET2') + FROM(MNTMAP1O) + DATAONLY + ALARM + CURSOR + END-EXEC + END-EVALUATE. + * + 2000-PROCESS-ADD-CUSTOMER. + * + PERFORM 2100-RECEIVE-DATA-MAP. + PERFORM 2200-EDIT-CUSTOMER-DATA. + IF VALID-DATA + PERFORM 2300-WRITE-CUSTOMER-RECORD + IF RESPONSE-CODE = DFHRESP(NORMAL) + MOVE 'Customer record added.' TO MSG1O + SET SEND-ERASE TO TRUE + ELSE + IF RESPONSE-CODE = DFHRESP(DUPREC) + MOVE 'Another user has added a record with that c + - 'ustomer number.' TO MSG1O + SET SEND-ERASE-ALARM TO TRUE + END-IF + END-IF + MOVE -1 TO CUSTNO1L + PERFORM 1500-SEND-KEY-MAP + SET PROCESS-KEY-MAP TO TRUE + ELSE + MOVE LOW-VALUE TO LNAMEO + FNAMEO + ADDRO + CITYO + STATEO + ZIPCODEO + SET SEND-DATAONLY-ALARM TO TRUE + PERFORM 1400-SEND-DATA-MAP + END-IF. + * + 2100-RECEIVE-DATA-MAP. + * + EXEC CICS + RECEIVE MAP('MNTMAP2') + MAPSET('MNTSET2') + INTO(MNTMAP2I) + END-EXEC. + * + INSPECT MNTMAP2I + REPLACING ALL '_' BY SPACE. + * + 2200-EDIT-CUSTOMER-DATA. + * + MOVE ATTR-NO-HIGHLIGHT TO ZIPCODEH + STATEH + CITYH + ADDRH + FNAMEH + LNAMEH. + + IF ZIPCODEI = SPACE + OR ZIPCODEL = ZERO + MOVE ATTR-REVERSE TO ZIPCODEH + MOVE -1 TO ZIPCODEL + MOVE 'You must enter a zip code.' TO MSG2O + MOVE 'N' TO VALID-DATA-SW + END-IF. + + IF STATEI = SPACE + OR STATEL = ZERO + MOVE ATTR-REVERSE TO STATEH + MOVE -1 TO STATEL + MOVE 'You must enter a state.' TO MSG2O + MOVE 'N' TO VALID-DATA-SW + END-IF. + + IF CITYI = SPACE + OR CITYL = ZERO + MOVE ATTR-REVERSE TO CITYH + MOVE -1 TO CITYL + MOVE 'You must enter a city.' TO MSG2O + MOVE 'N' TO VALID-DATA-SW + END-IF. + + IF ADDRI = SPACE + OR ADDRL = ZERO + MOVE ATTR-REVERSE TO ADDRH + MOVE -1 TO ADDRL + MOVE 'You must enter an address.' TO MSG2O + MOVE 'N' TO VALID-DATA-SW + END-IF. + + IF FNAMEI = SPACE + OR FNAMEL = ZERO + MOVE ATTR-REVERSE TO FNAMEH + MOVE -1 TO FNAMEL + MOVE 'You must enter a first name.' TO MSG2O + MOVE 'N' TO VALID-DATA-SW + END-IF. + + IF LNAMEI = SPACE + OR LNAMEL = ZERO + MOVE ATTR-REVERSE TO LNAMEH + MOVE -1 TO LNAMEL + MOVE 'You must enter a last name.' TO MSG2O + MOVE 'N' TO VALID-DATA-SW + END-IF. + * + 2300-WRITE-CUSTOMER-RECORD. + * + MOVE CUSTNO2I TO CM-CUSTOMER-NUMBER. + MOVE LNAMEI TO CM-LAST-NAME. + MOVE FNAMEI TO CM-FIRST-NAME. + MOVE ADDRI TO CM-ADDRESS. + MOVE CITYI TO CM-CITY. + MOVE STATEI TO CM-STATE. + MOVE ZIPCODEI TO CM-ZIP-CODE. + * + EXEC CICS + WRITE FILE('CUSTMAS') + FROM(CUSTOMER-MASTER-RECORD) + RIDFLD(CM-CUSTOMER-NUMBER) + RESP(RESPONSE-CODE) + END-EXEC. + * + IF RESPONSE-CODE NOT = DFHRESP(NORMAL) + AND RESPONSE-CODE NOT = DFHRESP(DUPREC) + PERFORM 9999-TERMINATE-PROGRAM + END-IF. + * + 3000-PROCESS-CHANGE-CUSTOMER. + * + PERFORM 2100-RECEIVE-DATA-MAP. + PERFORM 2200-EDIT-CUSTOMER-DATA. + IF VALID-DATA + MOVE CUSTNO2I TO CM-CUSTOMER-NUMBER + PERFORM 3100-READ-CUSTOMER-FOR-UPDATE + IF RESPONSE-CODE = DFHRESP(NORMAL) + IF CUSTOMER-MASTER-RECORD = CA-CUSTOMER-RECORD + * Introduce extra nested if as an example of rule violation + IF VALID-DATA + IF RESPONSE-CODE = DFHRESP(NORMAL) + PERFORM 3200-REWRITE-CUSTOMER-RECORD + MOVE 'Customer record updated.' TO MSG1O + SET SEND-ERASE TO TRUE + END-IF + END-IF + ELSE + MOVE 'Another user has updated the record. Try a + - 'gain.' TO MSG1O + SET SEND-ERASE-ALARM TO TRUE + END-IF + ELSE + IF RESPONSE-CODE = DFHRESP(NOTFND) + MOVE 'Another user has deleted the record.' TO + MSG1O + SET SEND-ERASE-ALARM TO TRUE + END-IF + END-IF + MOVE -1 TO CUSTNO1L + PERFORM 1500-SEND-KEY-MAP + SET PROCESS-KEY-MAP TO TRUE + ELSE + MOVE LOW-VALUE TO LNAMEO + FNAMEO + ADDRO + CITYO + STATEO + ZIPCODEO + SET SEND-DATAONLY-ALARM TO TRUE + PERFORM 1400-SEND-DATA-MAP + END-IF. + * + 3100-READ-CUSTOMER-FOR-UPDATE. + * + EXEC CICS + READ FILE('CUSTMAS') + INTO(CUSTOMER-MASTER-RECORD) + RIDFLD(CM-CUSTOMER-NUMBER) + UPDATE + RESP(RESPONSE-CODE) + END-EXEC. + * + IF RESPONSE-CODE NOT = DFHRESP(NORMAL) + AND RESPONSE-CODE NOT = DFHRESP(NOTFND) + PERFORM 9999-TERMINATE-PROGRAM + END-IF. + * + 3200-REWRITE-CUSTOMER-RECORD. + * + MOVE LNAMEI TO CM-LAST-NAME. + MOVE FNAMEI TO CM-FIRST-NAME. + MOVE ADDRI TO CM-ADDRESS. + MOVE CITYI TO CM-CITY. + MOVE STATEI TO CM-STATE. + MOVE ZIPCODEI TO CM-ZIP-CODE. + * + EXEC CICS + REWRITE FILE('CUSTMAS') + FROM(CUSTOMER-MASTER-RECORD) + RESP(RESPONSE-CODE) + END-EXEC. + * + IF RESPONSE-CODE NOT = DFHRESP(NORMAL) + PERFORM 9999-TERMINATE-PROGRAM + END-IF. + * + 4000-PROCESS-DELETE-CUSTOMER. + * + MOVE CA-CUSTOMER-NUMBER TO CM-CUSTOMER-NUMBER. + PERFORM 3100-READ-CUSTOMER-FOR-UPDATE. + IF RESPONSE-CODE = DFHRESP(NORMAL) + ALTER X TO PROCEED TO Y + IF CUSTOMER-MASTER-RECORD = CA-CUSTOMER-RECORD + PERFORM 4100-DELETE-CUSTOMER-RECORD + MOVE 'Customer deleted.' TO MSG1O + SET SEND-ERASE TO TRUE + ELSE + MOVE 'Another user has updated the record. Try again + - '.' TO MSG1O + SET SEND-ERASE-ALARM TO TRUE + END-IF + ELSE + IF RESPONSE-CODE = DFHRESP(NOTFND) + MOVE 'Another user has deleted the record.' TO + MSG1O + SET SEND-ERASE-ALARM TO TRUE + END-IF + END-IF. + MOVE -1 TO CUSTNO1L. + PERFORM 1500-SEND-KEY-MAP. + SET PROCESS-KEY-MAP TO TRUE. + * + 4100-DELETE-CUSTOMER-RECORD. + * TODO Some comment + EXEC CICS + DELETE FILE('CUSTMAS') + RESP(RESPONSE-CODE) + END-EXEC. + * + IF RESPONSE-CODE NOT = DFHRESP(NORMAL) + PERFORM 9999-TERMINATE-PROGRAM + END-IF. + * + 9999-TERMINATE-PROGRAM. + * + MOVE EIBRESP TO ERR-RESP. + MOVE EIBRESP2 TO ERR-RESP2. + MOVE EIBTRNID TO ERR-TRNID. + MOVE EIBRSRCE TO ERR-RSRCE. + * + EXEC CICS + XCTL PROGRAM('SYSERR') + COMMAREA(ERROR-PARAMETERS) + END-EXEC. diff --git a/it/it-projects/plugins/project/src/cobol/TC4E3H0.CBL b/it/it-projects/plugins/project/src/cobol/TC4E3H0.CBL new file mode 100644 index 00000000000..da86bbe241d --- /dev/null +++ b/it/it-projects/plugins/project/src/cobol/TC4E3H0.CBL @@ -0,0 +1,17508 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TC4E3H0 . + DATE-COMPILED. 02/17/10 + *REMARKS. + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY REMARKS ! + *------------------------------------------------------------------- + * AUTEUR : SOLERI ! + ****************************************************************** ! + * AUTEUR : SOLERI * ! + * LANGAGE : COBOL * ! + * MONITEUR : CICS * ! + * DATE CREATION : 1999/01/15 * ! + * * ! + * * ! + * DESCRIPTIF : ECRAN DE CORRECTION DES MOUVEMENTS EN ANOMALIES * ! + * ------------ CET ECRAN EST PARAMETRE SELON LE CODE APPLICATION* ! + * DU MOUVEMENT A CORRIGER * ! + * * ! + ****************************************************************** ! + * LISTE DES MESSAGES ERREUR UTILISES * ! + ****************************************************************** ! + *000001 TOUCHE DE FONCTION INTERDITE ! + *000010 F5 : VALIDATION ! + *000029 DATE INCORRECTE ! + *000141 CODE INEXISTANT ! + *000148 ZONE OBLIGATOIRE ! + *000193 MODIFICATION EFFECTUEE ! + *000270 CETTE DONNEE DOIT ETRE NUMERIQUE ! + *4E0041 LE CODE BANQUE DOIT ETRE NUMERIQUE ! + *4E0053 CODE PRODUIT INEXISTANT ! + *4E0058 CODE PARTENAIRE INCORRECT ! + *4E0059 CODE RPODUIT INCORRECT ! + *4E0060 NUMERO DE SOUSCRIPTION INCORRECT ! + *4E0061 NUMERO DE CONTRAT INCORRECT ! + *4E0062 NUMERO ADHESION INCORRECT ! + *4E0063 NUMERO DOSSSIER SINITRE INCORRECT ! + *4E0064 PERIODE DGI INCORRECTE ! + *4E0065 CODE TYPE CRO OBLIGATOIRE ! + *4E0066 CODE TYPE CRO INEXISTANT ! + ****************************************************************** ! + * MAINTENANCE * ! + ****************************************************************** ! + * AUTEUR * DATE * DESCRIPTIF * ! + ****************************************************************** ! + * * * * ! + * * * * ! + * * * * ! + ****************************************************************** ! + * SODIFRANCE *25.04.2006* REMPLACER ACCES YSP4EPTN PAR * ! + * * * ACCES MODULE TN4D101 (DB2) * ! + ****************************************************************** ! + *----------------------------------------------! END REMARKS ---- + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SPECIAL-NAMES. + DECIMAL-POINT IS COMMA. + DATA DIVISION. + SKIP2 + WORKING-STORAGE SECTION. + * + * THIS PROGRAM HAS BEEN DEVELOPED WITH THE TELON APPLICATION + * DEVELOPMENT SYSTEM, LICENSED BY: + * + * COMPUTER ASSOCIATES INTERNATIONAL, INC. + * ONE COMPUTER ASSOCIATES PLAZA + * ISLANDIA, NY 11788-7000 + * + * + * ----- LINE EFFICENCY OVERVIEW ----- + * + * THIS PROGRAM INCORPORATES LOGIC WHICH SIGNIFICANTLY + * REDUCES THE AMOUNT OF DATA WHICH IS TRANSMITTED TO AND + * FROM THE TERMINAL. TO PERFORM THIS FUNCTION, A ROUTINE + * NAMED TLRAMRG IS CALLED. IN GENERAL, ONLY MODIFIED + * FIELDS ARE TRANSMITTED TO AND FROM THE TERMINAL. + * SEE SECTIONS C-100 AND C-200 FOR A DESCRIPTION OF THIS + * ROUTINE. THERE ARE TWO DATA AREAS WHICH ARE USED BY + * THIS ROUTINE, THE OUTPUT SCREEN TABLE AND THE SCREEN IMAGE AREA. + * + * THE STEPS TO MODIFY A MESSAGE FORMAT WITHOUT THE USE OF TELON ARE: + * 1. ADD THE FIELD TO THE BMS MAP. + * 2. ADD THE FIELD TO THE TP BUFFER DEFINITION. + * 3. ADD THE FIELD TO THE OUTPUT SCREEN TABLE. + * 4. SET THE SIZE OF THE SCREEN IMAGE AREA. + * + * OUTPUT SCREEN TABLE + * + * THE OUTPUT SCREEN TABLE CONTAINS A DEFINITION OF THE + * SCREEN. IT CONSISTS OF AN 18 BYTE HEADER AREA AND FOUR + * ENTRY TYPES AS DESCRIBED BELOW. + * + * VARIABLE FIELD ENTRY + * ONE ENTRY FOR EVERY VARIABLE FIELD ON THE SCREEN IN + * ORDER OF THE TP-BUFFER FIELDS. + * 1. FILLER PIC X. + * 2. SCT-FIELD-TYPE PIC X VALUE (I/O). + * I - FIELD IS INPUT FROM THE TERMINAL. + * O - FIELD IS OUTPUT ONLY TO THE TERMINAL. + * 3. TPO-FIELDNAME-LTH PIC 9(4) COMP. + * LENGTH OF THE FIELD ON THE SCREEN. + * + * TABLE END ENTRY + * THIS ENTRY IS REQUIRED TO MARK THE END OF THE TABLE. + * 1. SCT-END-ENTRY PIC 9(4) COMP VALUE ZERO. + EJECT + * SEGLOOP ENTRY + * THE SEGLOOP ENTRY IS USED TO MARK THE START OF A LINE + * WHICH IS TO BE REPEATED. IT IS USED IN CONJUNCTION + * WITH THE SEGEND ENTRY TO DELIMIT THE REPETITIVE LINE. + * 1. FILLER PIC X. + * 2. SCT-SEGLOOP-TYPE PIC X VALUE 'S'. + * 3. SCT-ENTRY-LENGTH PIC 9(4) COMP VALUE NNN. + * LENGTH OF SEGLOOP ENTRY. + * 3. SCT-REPEAT-LINES PIC 9(2) COMP-3 VALUE NN. + * NUMBER OF TIMES TO REPEAT LINE ON THE SCREEN. + * THIS VALUE IS 1 LESS THAN THE NUMBER OF LINES TO + * BE DISPLAYED ON THE SCREEN. + * 5. INCREMENTAL VALUE PIC 9(2) COMP-3 VALUE NN. + * SPECIFIES THE NUMBER OF LINES TO SKIP BETWEEN EACH + * LINE WHERE A VALUE OF 1 INDICATES THE NEXT LINE. + * THE NUMBER OF INCREMENTS IS EQUAL TO THE VALUE OF + * SCT-REPEAT-LINES. + * + * SEGEND ENTRY + * THE SEGEND ENTRY IS USED TO MARK THE END OF A LINE + * WHICH IS TO BE REPEATED. IT IS PLACED AFTER THE LAST + * FIELD WHICH IS TO BE REPEATED. + * 1. FILLER PIC X. + * 2. SCT-SEGEND-TYPE PIC X VALUE 'T'. + * 3. SCT-ENTRY-LENGTH PIC 9(4) COMP VALUE 4. + * + * + * SCREEN IMAGE AREA + * + * THE SCREEN IMAGE IS AN AREA APPENDED TO THE SPA AREA + * WHICH CONTAINS A COPY OF THE SCREEN. IT CONSISTS OF A + * 12 BYTE HEADER AND A DATA AREA LARGE ENOUGH TO HOLD THE + * TP-BUFFER. + * 1. SCREEN IMAGE PIC X(NNNN). + * THE SIZE IS DEPENDENT ON THE OUTPUT SCREEN TABLE + * FIELD SCT-REFRESH-OUTPUTS. (Y/N) + * Y - NNNN IS EQUAL TO THE TP-BUFFER LENGTH. + * N - NNNN IS EQUAL TO THE LENGTH OF THE FIELDS AND + * ATTRIBUTES WHICH ARE INPUT FROM THE TERMINAL. + * + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEWSSD ! + *------------------------------------------------------------------- + **************************************************************** ! + * TABLE DES CHAMPS POUR HELP CURSEUR * ! + **************************************************************** ! + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY HELPGEN 2! + *------------------------------------------------------------------- + 01 TAB-POS. 2! + 02 FILLER PIC X(14) VALUE '00000000000000'. 2! + 02 FILLER PIC X(14) VALUE '001002008000OU'. 2! + 02 FILLER PIC X(14) VALUE '001070010000OU'. 2! + 02 FILLER PIC X(14) VALUE '002003004000OU'. 2! + 02 FILLER PIC X(14) VALUE '002073005000OU'. 2! + 02 FILLER PIC X(14) VALUE '004014002000OU'. 2! + 02 FILLER PIC X(14) VALUE '004017027000OU'. 2! + 02 FILLER PIC X(14) VALUE '004071002000OI'. 2! + 02 FILLER PIC X(14) VALUE '004074002000OI'. 2! + 02 FILLER PIC X(14) VALUE '004077004000OI'. 2! + 02 FILLER PIC X(14) VALUE '007020002000OI'. 2! + 02 FILLER PIC X(14) VALUE '007023002000OI'. 2! + 02 FILLER PIC X(14) VALUE '007026004000OI'. 2! + 02 FILLER PIC X(14) VALUE '007057020000OU'. 2! + 02 FILLER PIC X(14) VALUE '007078003000OU'. 2! + 02 FILLER PIC X(14) VALUE '008020005000OU'. 2! + 02 FILLER PIC X(14) VALUE '008026005000OU'. 2! + 02 FILLER PIC X(14) VALUE '008033011000OU'. 2! + 02 FILLER PIC X(14) VALUE '008046002000OU'. 2! + 02 FILLER PIC X(14) VALUE '009020005000OI'. 2! + 02 FILLER PIC X(14) VALUE '009026005000OI'. 2! + 02 FILLER PIC X(14) VALUE '009033011000OI'. 2! + 02 FILLER PIC X(14) VALUE '009046002000OU'. 2! + 02 FILLER PIC X(14) VALUE '009072009000OU'. 2! + 02 FILLER PIC X(14) VALUE '010020001000OU'. 2! + 02 FILLER PIC X(14) VALUE '010022032000OU'. 2! + 02 FILLER PIC X(14) VALUE '010078003000OU'. 2! + 02 FILLER PIC X(14) VALUE '011020007000OI'. 2! + 02 FILLER PIC X(14) VALUE '014002017000OU'. 2! + 02 FILLER PIC X(14) VALUE '014020005000OI'. 2! + 02 FILLER PIC X(14) VALUE '014026020000OU'. 2! + 02 FILLER PIC X(14) VALUE '014047002000OU'. 2! + 02 FILLER PIC X(14) VALUE '014058019000OU'. 2! + 02 FILLER PIC X(14) VALUE '014078003000OU'. 2! + 02 FILLER PIC X(14) VALUE '015002017000OU'. 2! + 02 FILLER PIC X(14) VALUE '015020013000OI'. 2! + 02 FILLER PIC X(14) VALUE '015034007000OU'. 2! + 02 FILLER PIC X(14) VALUE '015042004000OI'. 2! + 02 FILLER PIC X(14) VALUE '015047032000OU'. 2! + 02 FILLER PIC X(14) VALUE '016002017000OU'. 2! + 02 FILLER PIC X(14) VALUE '016020004000OU'. 2! + 02 FILLER PIC X(14) VALUE '016025001000OU'. 2! + 02 FILLER PIC X(14) VALUE '016027006000OI'. 2! + 02 FILLER PIC X(14) VALUE '016034007000OU'. 2! + 02 FILLER PIC X(14) VALUE '016042002000OI'. 2! + 02 FILLER PIC X(14) VALUE '016047032000OU'. 2! + 02 FILLER PIC X(14) VALUE '017002017000OU'. 2! + 02 FILLER PIC X(14) VALUE '017020032000OI'. 2! + 02 FILLER PIC X(14) VALUE '018002017000OU'. 2! + 02 FILLER PIC X(14) VALUE '018020002000OI'. 2! + 02 FILLER PIC X(14) VALUE '018023002000OI'. 2! + 02 FILLER PIC X(14) VALUE '018026004000OI'. 2! + 02 FILLER PIC X(14) VALUE '018058012000OU'. 2! + 02 FILLER PIC X(14) VALUE '018071002000OI'. 2! + 02 FILLER PIC X(14) VALUE '018074002000OI'. 2! + 02 FILLER PIC X(14) VALUE '018077004000OI'. 2! + 02 FILLER PIC X(14) VALUE '019002017000OU'. 2! + 02 FILLER PIC X(14) VALUE '019020002000OI'. 2! + 02 FILLER PIC X(14) VALUE '019023002000OI'. 2! + 02 FILLER PIC X(14) VALUE '019026004000OI'. 2! + 02 FILLER PIC X(14) VALUE '019031003000OI'. 2! + 02 FILLER PIC X(14) VALUE '019035001000OI'. 2! + 02 FILLER PIC X(14) VALUE '019037023000OU'. 2! + 02 FILLER PIC X(14) VALUE '019067012000OU'. 2! + 02 FILLER PIC X(14) VALUE '019080001000OI'. 2! + 02 FILLER PIC X(14) VALUE '021020002000OU'. 2! + 02 FILLER PIC X(14) VALUE '021024032000OU'. 2! + 02 FILLER PIC X(14) VALUE '021063010000OU'. 2! + 02 FILLER PIC X(14) VALUE '022002079000OI'. 2! + 02 FILLER PIC X(14) VALUE '023002079000OU'. 2! + 02 FILLER PIC X(14) VALUE '024002079000OU'. 2! + 01 TAB-POS-NB PIC 999 VALUE 071. 2! + 01 WS-TLN-SPA-LENGTH PIC 9(4) COMP VALUE 8192. 2! + *----------------------------------------------! END HELPGEN ---- + + **************************************************************** ! + * VARIABLES NORMALISEES * ! + **************************************************************** ! + 01 WS-TLNGIE. ! + * TOP PERMETTANT DE DETECTER LA PRESENCE DE LA SECTION M-100 ! + 02 WS-TLN-M100 PIC X VALUE 'N'. ! + * DATE ET HEURE FORMATTEES EN FIN DE SECTION Q-100 ! + 02 WS-TLN-DATE. ! + 05 WS-TLN-JJ PIC X(2). ! + 05 FILLER PIC X VALUE '/'. ! + 05 WS-TLN-MM PIC X(2). ! + 05 FILLER PIC X VALUE '/'. ! + 05 WS-TLN-AA PIC X(2). ! + 02 WS-TLN-DATE-LTH PIC 9(4) COMP VALUE 8. ! + 02 WS-TLN-TIME PIC X(8). ! + 02 WS-TLN-TIME-D REDEFINES WS-TLN-TIME. ! + 05 FILLER PIC X. ! + 05 WS-TLN-HH PIC X(2). ! + 05 WS-TLN-MN PIC X(2). ! + 05 WS-TLN-SS PIC X(2). ! + 05 FILLER PIC X. ! + 02 WS-TLN-DATE-AFF. ! + 05 WS-TLN-JJ-AFF PIC X(2). ! + 05 FILLER PIC X VALUE '/'. ! + 05 WS-TLN-MM-AFF PIC X(2). ! + 05 FILLER PIC X VALUE '/'. ! + 05 WS-TLN-SA-AFF. ! + 07 WS-TLN-SI-AFF PIC X(2). ! + 07 WS-TLN-AA-AFF PIC X(2). ! + 02 WS-TLN-TIME-AFF. ! + 05 WS-TLN-HH-AFF PIC X(2). ! + 05 FILLER PIC X VALUE 'H'. ! + 05 WS-TLN-MN-AFF PIC X(2). ! + * INDICE DE PARCOURS UTILISE DANS GIEPF03I, ET GIEPF03. ! + 02 WS-TLN-IND PIC 9(2) VALUE ZERO. ! + * VARIABLE PERMETTANT L'IDENTIFICATION DU TRAITEMENT ! + * TELON OU PAS . ! + 02 WS-TLN-TYP-PROG PIC X VALUE SPACES. ! + 88 WS-TLN-PROG-TELON VALUE 'T'. ! + * TOP A RENSEIGENER A 'C' POUR UN DEBRANCHEMENT VERS UN ! + * PRGROMME NON TELON. INTERPRETER EN SECTION C-300. ! + 02 WS-TLN-TYP-XCTL PIC X VALUE SPACES. ! + 88 WS-TLN-XCTL-NON-TELON VALUE 'C'. ! + * VARIABLE CONTENANT LA VALEUR EMISE PAR LA SELECTION ! + * D'UN DETAIL (FONCTION ZOOM) ! + 02 WS-TLN-VAL-SELECT PIC X VALUE 'D'. ! + * ZONES D'APPEL AU MODULE ODATAMJ ET IDATAMJ ! + 02 WS-TLN-TYPDATE PIC X(3) VALUE 'D03'. ! + 02 WS-TLN-NB-DEC PIC 9 VALUE ZERO. ! + 02 WS-TLN-SIGNE PIC X VALUE 'N'. ! + * ZONES D'APPEL AU MODULE OSPITAB, ISPITAB, OSPIGRP,ISPIGRP ! + 02 WS-TLN-LTH-KEY PIC 9(4) COMP VALUE ZERO. ! + 02 WS-TLN-LTH-DEBKEY PIC 9(4) COMP VALUE ZERO. ! + 02 WS-TLN-EL-DEMANDES PIC X(6) VALUE SPACES. ! + 02 WS-TLN-CODTAB PIC X(8) VALUE SPACES. ! + * ZONES D'APPEL AU MODULE ILUHNKY ! + 02 WS-TLN-LTH-RAC PIC 9(2) VALUE ZERO. ! + 02 WS-TLN-RAC-LUHN PIC X(20) VALUE SPACES. ! + * ZONES PERMETTANT LA SAUVEGARDE DU CODE HEADER DE ! + * L'APPLICATION EXECUTEE LORS D'UN APPEL DE VALEUR ! + 02 WS-TLN-DEB-SPA PIC X(2). ! + 02 WS-TLN-BIN-SPA REDEFINES WS-TLN-DEB-SPA PIC 9(4) COMP. ! + 02 WS-TLN-BIN-MAX PIC 9(5) COMP VALUE 16447. ! + 02 WS-TLN-BIN-MIN PIC 9(5) COMP VALUE ZERO. ! + * VARIABLE PERMETTANT D'INDIQUER SI UNE CONVERSION DES ! + * LETTRES MINUSCULES ACCENTUEES EN LETTRE MAJUSCULE EST ! + * A EFFECTUER DANS LES FLDTYPES 'ALPHAB' ET 'ALPHABG' ! + 02 WS-TLN-IDC-CONVERSION PIC X VALUE 'O'. ! + * ZONES PERMETTANT LA GESTION DU MESSAGE D'ERREUR POUR ! + * CONTROLE DE PREMIER NIVEAU. ! + 02 WS-TLN-MSG. ! + 05 WS-TLN-DBT-MSG PIC X(2) VALUE SPACES. ! + 05 WS-TLN-NUM-MSG PIC X(4) VALUE SPACES. ! + * ZONE PERMETTANT LA GESTION DES ABENDS ! + 02 WS-TLN-EIB. ! + 05 WS-TLN-EIBFN PIC X(2) VALUE SPACES. ! + 05 WS-TLN-EIBRCODE PIC X(6) VALUE SPACES. ! + 02 WS-TLN-ABT-PGM. ! + 05 WS-TLN-ABT-PGM-HD PIC X(2) VALUE 'TX'. ! + 05 WS-TLN-ABT-PGM-ID PIC X(6) VALUE '00ABD '. ! + * VARIABLE PERMETTANT LE PASSAGE D'INFORMATIONS DU PROGRAMME ! + * APPLICATIF AU PROGRAMME APPEL DE VALEUR. ! + * RECUPERATION DE CETTE VARIABLE DANS LA ZONE DE COMMAREA ! + * HELP-MSG-NAME-KEY(1). ! + 02 WS-TLN-HELP-NAME-KEY. ! + 05 WS-TLN-HELP-DEB-KEY PIC X(10) VALUE SPACES. ! + 05 WS-TLN-HELP-FIN-KEY PIC X(10) VALUE SPACES. ! + 05 FILLER PIC X VALUE SPACE. ! + * ZONE CONTENANT LE LIBELLE COMPLEMENTAIRE A UN MESSAGE ! + * D'ERREUR ! + 02 WS-TLN-LIB-CPL-MES PIC X(32) VALUE SPACES. ! + 02 WS-TLN-ADR-PGM PIC X(6) VALUE SPACES. ! + * TYPE PROVENANCE APPEL (MODE NATIF OU PAS) ! + 02 WS-TLN-TYP-PROV PIC X. ! + 88 APPEL-NATIF VALUE 'N'. ! + 88 APPEL-ALICE VALUE 'A'. ! + * MESSAGE ENVOYE SI APPEL EN MODE NATIF ! + 02 WS-TLN-MES-ERR-PROV PIC X(22) ! + VALUE 'APPEL DIRECT INTERDIT'. ! + 02 WS-TLN-LG-MES PIC 9(4) COMP VALUE 22. ! + 02 WS-TLN-PFKEY-INDICATOR PIC 9(2). ! + 88 ENTREE VALUE 0. ! + 88 AIDE VALUE 1. 88 DOCU VALUE 2. ! + 88 MENUPRE VALUE 3. 88 APPVAL VALUE 4. ! + 88 REFRESH VALUE 5. 88 LIBRE1 VALUE 6. ! + 88 PAGEPRE VALUE 7. 88 PAGESUI VALUE 8. ! + 88 ZOOM VALUE 10. 88 ECRPRE VALUE 12. ! + 88 MESS VALUE 14. 88 MENUGEN VALUE 15. ! + 88 CONVERT VALUE 17. ! + 88 LIBRE2 VALUE 18. 88 DROITE VALUE 19. ! + 88 GAUCHE VALUE 20. 88 TOPPERS VALUE 22. ! + 88 PROFCPT VALUE 23. 88 IMPRDIAM VALUE 24. ! + 88 EFFECR VALUE 25. ! + 02 WS-TLN-FCT-VALIDATION PIC X. ! + 88 VALIDATION VALUE 'O'. ! + * INDICATEUR DEDIE A CHACUNE DES FOCNTIONS PROPOS�ES. ! + * VALEUR POSSIBLE : N --> FONCTION NON UTILIS�E ! + * : O --> FONCTION UTILISEE ! + * : I --> FONCTION NON UTILISEE, MAIS RESERVATION ! + * : EMPLACEMENT TOUCHE DE FONCTION ! + 02 WS-TLN-TABLE-FONCTION. ! + 05 WS-TLN-AIDE-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-DOCU-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-ECRPRE-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-MENUGEN-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-MENUPRE-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-APPVAL-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-PAGEPRE-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-PAGESUI-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-GAUCHE-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-DROITE-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-ZOOM-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-REFRESH-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-MESS-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-TOPPERS-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-CONVERT-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-PROFCPT-UTI PIC X VALUE 'N'. ! + 05 WS-TLN-VALIDATION-UTI REDEFINES ! + WS-TLN-PROFCPT-UTI PIC X. ! + * VARIABLES A RENSEIGNER DANS LE CAS D'UTILISATION ! + * DE FONCTION DIFFERENTES DE CELLES DEJA PROPOSEES. ! + * LES TOUCHES DE FONCTIONS ASSOCIEES DOIVENT ETRE ! + * 'F6' ET 'F18'. ! + 02 WS-TLN-TCH-LIBRE1 PIC X(16) VALUE SPACES. ! + 02 WS-TLN-TCH-LIBRE2 PIC X(16) VALUE SPACES. ! + * VARIABLE PERMETTANT DE PARAMETRER LE MODULE APPELER ! + * POUR UTILISATION DES TOUCHES DE FONCTIONS. ! + 02 WS-TLN-MODULE PIC X(8) VALUE SPACES. ! + * NOM DE LA TS PERMETTANT LA SAUVEGARDE DE LA COMMAREA ! + * APRES LE 'RETURN TRANSID' ! + 02 WS-TLN-HOLD-AREA-KEY. ! + 05 WS-TLN-HOLD-AREA-LTERM PIC X(4). ! + 05 WS-TLN-HOLD-AREA-NAME PIC X(4). ! + 02 WS-TLN-HOLD-AREA-NAME-DFLT PIC X(4) VALUE 'SCOM'. ! + * ZONE DE TRAVAIL PERMETTANT DE RESTAURER L'INDICATEUR ! + * INDIQUANT SI UNE VALEUR A �T� S�LECTIONN�E LORS DE ! + * L'APPEL DE VALEUR. ! + 02 WS-TLN-MODIFY-INDICATOR PIC X. ! + * ZONE DE TRAVAIL PERMETTANT D'INDIQUER SI UN POINT ! + * DE SYNCRONISATION EST NECESSAIRE LORS D'UN CHAINAGE ! + * PAR XCTL. LA VALEUR PAR DEFAUT EST (O)UI ET PEUT ETRE ! + * RENSEIGNE A (N)ON SI ON NE DESIRE PAS EXECUTE L'ORDRE ! + * 'EXEC CICS SYNCPOINT'. ! + 02 WS-TLN-IDC-SYNCPOINT PIC X VALUE 'O'. ! + 88 TRAITER-SYNCPOINT VALUE 'O'. ! + * CARACT�RE UTILIS� POUR MARQUER UN CHAMP PAR LE PROGRAMME ! + * P00740 ! + 02 WS-TLN-CAR-SEL PIC X VALUE 'X'. ! + * ZONES D'APPEL AUX MODULES CONTROLE NO TELEPHONE ! + 02 WS-TLN-APP-TEL. ! + 05 WS-TLN-CD-POST PIC X(5) VALUE SPACES. ! + 05 WS-TLN-TYP-ERR PIC X(1) VALUE SPACES. ! + 05 WS-TLN-IDC-CTRL PIC X(1) VALUE SPACES. ! + ! + * ZONES DE TRAVAIL SUR DATE ET HEURE ! + 02 WS-TLN-ASKTIME PIC X(15). ! + * ZONES PERMETTANT DE RECUPERER ANNEE SUR 4 CAR. ! + 02 WS-TLN-YEAR PIC S9(08) COMP VALUE +0. ! + 02 WS-TLN-YEAR-NUM PIC 9(04) VALUE 0. ! + ! + * VARIABLE PERMETTANT D'INDIQUER SI LES BLANCS SONT AUTORISES ! + * DANS LA DONNEE EN ENTREE ! + 02 WS-TLN-IDC-BLANC PIC X VALUE 'O'. ! + * ZONES UTILISEES DANS LA CONVERSION DEVISES CVMTT ! + 02 WS-TLN-NB-DEC-ORI PIC 9(01). ! + 02 WS-TLN-DEV-ORI PIC X(03). ! + 02 WS-TLN-BOOL-SIGNE PIC X(01). ! + 02 WS-TLN-NB-DEC-CBL PIC 9(01). ! + 02 WS-TLN-DEV-CBL PIC X(03). ! + 02 WS-TLN-NB-DEC-ECT PIC 9(01). ! + 02 WS-TLN-DEV-ECT PIC X(03). ! + 02 WS-TLN-BOOL-ECT PIC X(01). ! + 02 WS-TLN-MT-ECT PIC S9(15)V9(3). ! + * ZONES UTILISEES DANS LA CONVERSION DEVISES CNVMT ! + 02 WS-TLN-ORI-NB-DEC PIC 9(01). ! + 02 WS-TLN-ORI-DVS PIC X(03). ! + 02 WS-TLN-CBL-IDC-SGN PIC X(01) VALUE 'O'. ! + 02 WS-TLN-CBL-NB-DEC PIC 9(01). ! + 02 WS-TLN-CBL-NB-ENT PIC 9(02). ! + 02 WS-TLN-CBL-DVS PIC X(03). ! + 02 WS-TLN-CBL-AFF PIC X(01) VALUE 'O'. ! + 02 WS-TLN-CBL-IDC-SEP PIC X(01) VALUE 'O'. ! + *----------------------------------------------! END GIEWSSD ---- + + ******************************************************** + * T E L O N R E L E A S E D A T A * + ******************************************************** + SKIP1 + 01 TELON-RELEASE-DATA. + 05 TELON-RELEASE-EYECATCH PIC X(10) VALUE 'TELON ID'. + 05 TELON-REL-MOD-ID PIC X(6) VALUE '4.1 '. + 05 TELON-REL-DATE PIC X(6) VALUE '031130'. + 05 TELON-MOD-NO PIC X(4) VALUE '0311'. + 05 TELON-MOD-DATE PIC X(6) VALUE '031130'. + 05 TELON-PGM-ID PIC X(6) VALUE 'CIC'. + 05 TELON-EXECUTION-OPTIONS. + 10 TELON-TRACE-OPTION PIC X VALUE 'N'. + 10 FILLER PIC X(7) VALUE SPACES. + 05 TELON-GEN-DATE PIC X(8) VALUE '02/17/10'. + 05 TELON-GEN-TIME PIC X(5) VALUE '16.56'. + 05 TELON-PROGRAM-FEATURES. + 10 TELON-PGMSTRUCT-FEATURE PIC X VALUE '3'. + 10 TELON-LINEOPT-FEATURE PIC X VALUE '1'. + 10 TELON-ABNORMALT-FEATURE PIC X VALUE '3'. + 10 TELON-COBOL-VERSION PIC X VALUE '3'. + 10 TELON-EATTR-FEATURE PIC X VALUE 'N'. + 10 FILLER PIC X(5) VALUE SPACES. + SKIP1 + EJECT + ******************************************************** + * A B N O R M A L T E R M I N A T I O N A R E A * + ******************************************************** + SKIP1 + 01 ABNORMAL-TERMINATION-AREA. + 05 FILLER PIC X(8) VALUE 'ABT AREA'. + 05 ABT-TEST-FACILITY-AREA. + 10 ABT-TEST-FACILITY-IND PIC X VALUE 'N'. + 88 ABT-TEST-FACILITY-ACTIVE VALUE 'Y'. + 88 ABT-TEST-FACILITY-NOT-ACTIVE VALUE 'N'. + 10 ABT-TEST-MODE-IND PIC X VALUE 'P'. + 88 ABT-TEST-MODE-ABT VALUE 'A'. + 88 ABT-TEST-MODE-PGM VALUE 'P'. + * IF THE TELON TEST FACILITY IS ACTIVE + * AND THE ABT-TEST-MODE IS "P" + * THEN THE ABT-CONTROL-INDICATOR WILL BE FORCED TO SPACE. + 10 FILLER PIC X(2) VALUE LOW-VALUES. + 10 ABT-TEST-FACILITY-RESERVE PIC X(4) VALUE LOW-VALUES. + 05 ABT-CONTROL-INFO. + 10 ABT-CONTROL-INDICATOR PIC X VALUE 'R'. + 88 ABT-DO-ABEND VALUE 'A'. + 88 ABT-DO-WRITE VALUE 'E'. + 88 ABT-DO-TRANSFER VALUE 'R'. + 88 ABT-CONTINUE-PROCESS VALUE ' '. + 10 ABT-IN-PROGRESS PIC X VALUE 'N'. + 10 ABT-DYNAMIC-CONTROL-PGM PIC X(8) VALUE 'ADCCABT'. + 10 ABT-DYNAMIC-CONTROL-RC PIC S9(4) COMP VALUE +0. + 10 ABT-NUMBER-OF-STD-PARMS PIC 9(2) COMP VALUE 9. + 10 ABT-NUMBER-OF-USER-PARMS PIC 9(2) COMP VALUE 1. + 10 ABT-NUMBER-OF-DA-PARMS PIC 9(2) COMP VALUE 0. + 10 ABT-PGM-GEN-TYPE PIC X(4) VALUE 'CICS'. + 88 ABT-PGM-IS-TSOPGM VALUE 'TSO '. + 88 ABT-PGM-IS-IMSDYN VALUE 'IDYN'. + 88 ABT-PGM-IS-IMSSTAT VALUE 'ISTA'. + 88 ABT-PGM-IS-IMSDRVR VALUE 'IDRV'. + 88 ABT-PGM-IS-CICSPGM VALUE 'CICS'. + 88 ABT-PGM-IS-BATCHPGM VALUE 'BATC'. + 88 ABT-PGM-IS-AS400PGM VALUE 'AS4 '. + 88 ABT-PGM-IS-AS400DRV VALUE 'AS4D'. + 88 ABT-PGM-IS-WINCHPGM VALUE 'WINC'. + 88 ABT-PGM-IS-WINCHDRV VALUE 'WIND'. + 88 ABT-PGM-IS-UNIXPGM VALUE 'UNIX'. + 88 ABT-PGM-IS-UNIXDRV VALUE 'UNXD'. + 88 ABT-PGM-IS-STORED VALUE 'STPR'. + 10 ABT-PGM-GEN-REL-LEVEL PIC X(4) VALUE '4.1 '. + 10 ABT-PGM-NAME PIC X(8) VALUE 'TC4E3H0 '. + 10 ABT-PGM-TRAN-CODE PIC X(8) VALUE '4E3H'. + 10 ABT-PGM-MAP-NAME PIC X(8) VALUE 'MC4E3H0'. + 10 ABT-NEXT-PROGRAM-NAME. + 15 ABT-NEXT-PROGRAM-NAME-HDR PIC X(2) VALUE 'TC'. + 15 ABT-NEXT-PROGRAM-NAME-ID PIC X(5) VALUE '00ABD'. + 15 ABT-NEXT-PROGRAM-NAME-TRL PIC X(1) VALUE ' '. + 10 ABT-TPO-ERRMSG1-LTH PIC 9(4) COMP VALUE 79. + 10 ABT-ERROR-MESSAGE PIC X(80) VALUE SPACES. + 10 ABT-SPA-TS-QUEUE-ID PIC X(8) VALUE LOW-VALUES. + SKIP1 + 05 ABT-PGM-ERROR-DATA. + 10 ABT-ERROR-SECTION. + 15 ABT-ERROR-SECTION-NAME PIC X(5) VALUE SPACES. + 15 ABT-ERROR-SECTION-SUB PIC X(3) VALUE SPACES. + 10 ABT-PROGRAM-FUNCTION REDEFINES + ABT-ERROR-SECTION PIC X(8). + * ABT PROGRAM FUNCTION VALUES ARE DOCUMENTED IN THE + * DYNAMICALLY INVOKED ABT ROUTINE. + 10 ABT-ERROR-ACTIVITY PIC X(4). + 88 ABT-ERROR-IS-TP-IMS VALUE 'IMS '. + 88 ABT-ERROR-IS-TP-CICS VALUE 'CICS'. + 88 ABT-ERROR-IS-TP-TSO VALUE 'TSO '. + 88 ABT-ERROR-IS-SEQ VALUE 'SEQ '. + 88 ABT-ERROR-IS-VSAM VALUE 'VSAM'. + 88 ABT-ERROR-IS-DLI VALUE 'DLI '. + 88 ABT-ERROR-IS-EXECDLI VALUE 'XDLI'. + 88 ABT-ERROR-IS-DB2 VALUE 'DB2 '. + 88 ABT-ERROR-IS-CQUEUE VALUE 'CQUE'. + 88 ABT-ERROR-IS-CJOURNAL VALUE 'CJRL'. + 10 ABT-ERROR-ABEND-CODE PIC S9(4) COMP. + 10 FILLER PIC X(16) VALUE LOW-VALUES. + SKIP1 + 05 ABT-DATA-ACCESS-INFO. + 10 ABT-DA-FUNCTION PIC X(8) VALUE SPACES. + 10 ABT-DA-FUNCTION-DLI REDEFINES ABT-DA-FUNCTION. + 15 ABT-DA-FUNC-DLI PIC X(4). + 15 ABT-DA-FUNC-PCB-TYPE PIC X(4). + 10 ABT-U100-SUB PIC X(3) VALUE SPACES. + 10 FILLER PIC X(1) VALUE LOW-VALUE. + 10 ABT-DA-ACCESS-NAME PIC X(8). + 10 ABT-DA-GENERIC-STATUS PIC X(3) VALUE SPACES. + 88 ABT-DA-OK VALUE 'OK '. + 88 ABT-DA-DUPLICATE VALUE 'DUP'. + 88 ABT-DA-NOTAVAIL VALUE 'NAV'. + 88 ABT-DA-NOTFOUND VALUE 'NFD'. + 88 ABT-DA-ENDFILE VALUE 'EOF' 'NFD'. + 88 ABT-DA-LOGICERR VALUE 'LOG'. + 88 ABT-DA-SECURITY VALUE 'SEC'. + 88 ABT-DA-DBMERROR VALUE 'DBM'. + 88 ABT-DA-ANYERROR VALUE 'DUP' 'NAV' + 'NFD' 'EOF' + 'LOG' 'SEC' + 'DBM'. + 10 FILLER PIC X(1) VALUE LOW-VALUE. + 10 ABT-DA-SPECIFIC-STATUS PIC X(6) VALUE LOW-VALUES. + 10 FILLER REDEFINES ABT-DA-SPECIFIC-STATUS. + 15 ABT-DLI-STATUS PIC X(2). + 15 FILLER PIC X(4). + 10 FILLER REDEFINES ABT-DA-SPECIFIC-STATUS. + 15 ABT-DB2-STATUS PIC S9(9) COMP-4. + 15 FILLER PIC X(2). + 10 FILLER REDEFINES ABT-DA-SPECIFIC-STATUS. + 15 ABT-VSAM-CICS-STATUS PIC X(1). + 15 FILLER PIC X(5). + 10 FILLER REDEFINES ABT-DA-SPECIFIC-STATUS. + 15 ABT-BATCH-STATUS PIC X(2). + 15 FILLER PIC X(4). + 10 FILLER REDEFINES ABT-DA-SPECIFIC-STATUS. + 15 ABT-CQUEUE-CICS-STATUS PIC X(1). + 15 FILLER PIC X(5). + 10 FILLER REDEFINES ABT-DA-SPECIFIC-STATUS. + 15 ABT-CJOURNAL-CICS-STATUS PIC X(1). + 15 FILLER PIC X(5). + 10 FILLER PIC X(16) VALUE LOW-VALUES. + EJECT + ******************************************************** + * T P I N P U T S C R E E N T A B L E * + ******************************************************** + 01 TP-INPUT-TABLE. + 05 FILLER PIC X(4) VALUE SPACES. + 05 TPI-DAPECJ-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-DAPECM-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-DAPECA-LTH PIC 9(4) COMP VALUE 4. + 05 TPI-DAECNJ-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-DAECNM-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-DAECNA-LTH PIC 9(4) COMP VALUE 4. + 05 TPI-CDBQE1-LTH PIC 9(4) COMP VALUE 5. + 05 TPI-CDGUI1-LTH PIC 9(4) COMP VALUE 5. + 05 TPI-NOCPT1-LTH PIC 9(4) COMP VALUE 11. + 05 TPI-NOCHQ-LTH PIC 9(4) COMP VALUE 7. + 05 TPI-CDPTN-LTH PIC 9(4) COMP VALUE 5. + 05 TPI-REF1L15-LTH PIC 9(4) COMP VALUE 13. + 05 TPI-REF2L15-LTH PIC 9(4) COMP VALUE 4. + 05 TPI-REF4L16-LTH PIC 9(4) COMP VALUE 6. + 05 TPI-REF1L16-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-REF1L17-LTH PIC 9(4) COMP VALUE 32. + 05 TPI-RF1L18J-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-RF1L18M-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-RF1L18A-LTH PIC 9(4) COMP VALUE 4. + 05 TPI-RF2L18J-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-RF2L18M-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-RF2L18A-LTH PIC 9(4) COMP VALUE 4. + 05 TPI-RF1L19J-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-RF1L19M-LTH PIC 9(4) COMP VALUE 2. + 05 TPI-RF1L19A-LTH PIC 9(4) COMP VALUE 4. + 05 TPI-REF2L19-LTH PIC 9(4) COMP VALUE 3. + 05 TPI-REF3L19-LTH PIC 9(4) COMP VALUE 1. + 05 TPI-REF5L19-LTH PIC 9(4) COMP VALUE 1. + 05 TPI-ERRMSG1-LTH PIC 9(4) COMP VALUE 79. + EJECT + ******************************************************** + * T P O U T P U T S C R E E N T A B L E * + ******************************************************** + 01 TP-OUTPUT-TABLE. + 05 SCT-TABLE-HEADER. + 10 FILLER PIC XX VALUE LOW-VALUES. + * OUTPUT ONLY FIELDS SAVED IN THE SCREEN IMAGE (Y/N). + 10 SCT-REFRESH-OUTPUTS PIC X VALUE 'Y'. + * SOUND THE ALARM ON ERROR ATTRIBUTES (Y/N). + 10 SCT-ALARM-INDICATOR PIC X VALUE 'N'. + * FILL CHARACTER FOR INPUT FIELDS ON OUTPUT. + * (SPACE/LOW-VALUES/'_') + 10 SCT-INPUT-FILL-CHAR PIC X VALUE SPACES. + * BMS BUFFER ALIGNMENT (Y/N). + 10 SCT-BMS-ALIGNMENT PIC X VALUE 'N'. + * LOWER CASE INPUT SUPPORT (Y/N) + 10 SCT-LOWERCASE-INPUT PIC X VALUE 'N'. + 10 SCT-HELP-CHAR PIC X VALUE LOW-VALUES. + 10 FILLER PIC X(6) VALUE LOW-VALUES. + * VARIABLE FIELD ENTRY LENGTH. + 10 SCT-ENTRY-LENGTH PIC 9(4) COMP VALUE 4. + * NUMBER OF ATTRIBUTES FOR EACH FIELD. + 10 SCT-ATTR-COUNT PIC 9(4) COMP VALUE 1. + 05 SCT-NOMMAP. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-NOMMAP-LTH PIC 9(4) COMP VALUE 8. + 05 SCT-DATE. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-DATE-LTH PIC 9(4) COMP VALUE 10. + 05 SCT-NUMECR. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-NUMECR-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-HEURE. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-HEURE-LTH PIC 9(4) COMP VALUE 5. + 05 SCT-CDAPL. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CDAPL-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-LIBAPL. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIBAPL-LTH PIC 9(4) COMP VALUE 27. + 05 SCT-DAPECJ. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-DAPECJ-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-DAPECM. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-DAPECM-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-DAPECA. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-DAPECA-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-DAECNJ. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-DAECNJ-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-DAECNM. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-DAECNM-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-DAECNA. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-DAECNA-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-MTOPE. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-MTOPE-LTH PIC 9(4) COMP VALUE 20. + 05 SCT-CDDVS. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CDDVS-LTH PIC 9(4) COMP VALUE 3. + 05 SCT-CDBQE. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CDBQE-LTH PIC 9(4) COMP VALUE 5. + 05 SCT-CDGUI. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CDGUI-LTH PIC 9(4) COMP VALUE 5. + 05 SCT-NOCPT. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-NOCPT-LTH PIC 9(4) COMP VALUE 11. + 05 SCT-CLERIB. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CLERIB-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-CDBQE1. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-CDBQE1-LTH PIC 9(4) COMP VALUE 5. + 05 SCT-CDGUI1. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-CDGUI1-LTH PIC 9(4) COMP VALUE 5. + 05 SCT-NOCPT1. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-NOCPT1-LTH PIC 9(4) COMP VALUE 11. + 05 SCT-CLERIB1. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CLERIB1-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-NBELT. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-NBELT-LTH PIC 9(4) COMP VALUE 9. + 05 SCT-MODRGL. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-MODRGL-LTH PIC 9(4) COMP VALUE 1. + 05 SCT-LIBRGL. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIBRGL-LTH PIC 9(4) COMP VALUE 32. + 05 SCT-NBPREST. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-NBPREST-LTH PIC 9(4) COMP VALUE 3. + 05 SCT-NOCHQ. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-NOCHQ-LTH PIC 9(4) COMP VALUE 7. + 05 SCT-LIB1. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB1-LTH PIC 9(4) COMP VALUE 17. + 05 SCT-CDPTN. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-CDPTN-LTH PIC 9(4) COMP VALUE 5. + 05 SCT-LIBPTN. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIBPTN-LTH PIC 9(4) COMP VALUE 20. + 05 SCT-IDCPTN. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-IDCPTN-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-LIB1B. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB1B-LTH PIC 9(4) COMP VALUE 19. + 05 SCT-ECGFIN. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-ECGFIN-LTH PIC 9(4) COMP VALUE 3. + 05 SCT-LIB2. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB2-LTH PIC 9(4) COMP VALUE 17. + 05 SCT-REF1L15. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF1L15-LTH PIC 9(4) COMP VALUE 13. + 05 SCT-LIB3. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB3-LTH PIC 9(4) COMP VALUE 7. + 05 SCT-REF2L15. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF2L15-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-REF3L15. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-REF3L15-LTH PIC 9(4) COMP VALUE 32. + 05 SCT-LIB4A. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB4A-LTH PIC 9(4) COMP VALUE 17. + 05 SCT-REF3L16. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-REF3L16-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-TIRET. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-TIRET-LTH PIC 9(4) COMP VALUE 1. + 05 SCT-REF4L16. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF4L16-LTH PIC 9(4) COMP VALUE 6. + 05 SCT-LIB4. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB4-LTH PIC 9(4) COMP VALUE 7. + 05 SCT-REF1L16. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF1L16-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-REF2L16. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-REF2L16-LTH PIC 9(4) COMP VALUE 32. + 05 SCT-LIB5. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB5-LTH PIC 9(4) COMP VALUE 17. + 05 SCT-REF1L17. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF1L17-LTH PIC 9(4) COMP VALUE 32. + 05 SCT-LIB6. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB6-LTH PIC 9(4) COMP VALUE 17. + 05 SCT-RF1L18J. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF1L18J-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-RF1L18M. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF1L18M-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-RF1L18A. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF1L18A-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-LIB6B. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB6B-LTH PIC 9(4) COMP VALUE 12. + 05 SCT-RF2L18J. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF2L18J-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-RF2L18M. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF2L18M-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-RF2L18A. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF2L18A-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-LIB7. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB7-LTH PIC 9(4) COMP VALUE 17. + 05 SCT-RF1L19J. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF1L19J-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-RF1L19M. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF1L19M-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-RF1L19A. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-RF1L19A-LTH PIC 9(4) COMP VALUE 4. + 05 SCT-REF2L19. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF2L19-LTH PIC 9(4) COMP VALUE 3. + 05 SCT-REF3L19. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF3L19-LTH PIC 9(4) COMP VALUE 1. + 05 SCT-REF4L19. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-REF4L19-LTH PIC 9(4) COMP VALUE 23. + 05 SCT-LIB8. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIB8-LTH PIC 9(4) COMP VALUE 12. + 05 SCT-REF5L19. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-REF5L19-LTH PIC 9(4) COMP VALUE 1. + 05 SCT-CDREJ. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-CDREJ-LTH PIC 9(4) COMP VALUE 2. + 05 SCT-LIBREJ. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIBREJ-LTH PIC 9(4) COMP VALUE 32. + 05 SCT-DAREJ. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-DAREJ-LTH PIC 9(4) COMP VALUE 10. + 05 SCT-ERRMSG1. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'I'. + 10 TPO-ERRMSG1-LTH PIC 9(4) COMP VALUE 79. + 05 SCT-LIG23. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIG23-LTH PIC 9(4) COMP VALUE 79. + 05 SCT-LIG24. + 10 FILLER PIC X VALUE LOW-VALUES. + 10 SCT-FIELD-TYPE PIC X VALUE 'O'. + 10 TPO-LIG24-LTH PIC 9(4) COMP VALUE 79. + 05 SCT-END-ENTRY PIC 9(4) COMP VALUE 0. + EJECT + ******************************************************** + * T P B U F F E R * + ******************************************************** + 01 TP-BUFFER. + 02 FILLER PIC X(12). + 02 TP-OUTPUT-BUFFER-FIELDS. + 05 TPO-NOMMAP-ATTR PIC XXX. + 05 TPO-NOMMAP PIC X(8). + 05 TPO-DATE-ATTR PIC XXX. + 05 TPO-DATE PIC X(10). + 05 TPO-NUMECR-ATTR PIC XXX. + 05 TPO-NUMECR PIC X(4). + 05 TPO-HEURE-ATTR PIC XXX. + 05 TPO-HEURE PIC X(5). + 05 TPO-CDAPL-ATTR PIC XXX. + 05 TPO-CDAPL PIC X(2). + 05 TPO-LIBAPL-ATTR PIC XXX. + 05 TPO-LIBAPL PIC X(27). + 05 TPO-DAPECJ-ATTR PIC XXX. + 05 TPO-DAPECJ PIC X(2). + 05 TPO-DAPECM-ATTR PIC XXX. + 05 TPO-DAPECM PIC X(2). + 05 TPO-DAPECA-ATTR PIC XXX. + 05 TPO-DAPECA PIC X(4). + 05 TPO-DAECNJ-ATTR PIC XXX. + 05 TPO-DAECNJ PIC X(2). + 05 TPO-DAECNM-ATTR PIC XXX. + 05 TPO-DAECNM PIC X(2). + 05 TPO-DAECNA-ATTR PIC XXX. + 05 TPO-DAECNA PIC X(4). + 05 TPO-MTOPE-ATTR PIC XXX. + 05 TPO-MTOPE-CHAR PIC X(20). + 05 TPO-MTOPE REDEFINES TPO-MTOPE-CHAR + PIC -B---B---B---B--9V.99. + 05 TPO-CDDVS-ATTR PIC XXX. + 05 TPO-CDDVS PIC X(3). + 05 TPO-CDBQE-ATTR PIC XXX. + 05 TPO-CDBQE PIC X(5). + 05 TPO-CDGUI-ATTR PIC XXX. + 05 TPO-CDGUI PIC X(5). + 05 TPO-NOCPT-ATTR PIC XXX. + 05 TPO-NOCPT PIC X(11). + 05 TPO-CLERIB-ATTR PIC XXX. + 05 TPO-CLERIB PIC X(2). + 05 TPO-CDBQE1-ATTR PIC XXX. + 05 TPO-CDBQE1 PIC X(5). + 05 TPO-CDGUI1-ATTR PIC XXX. + 05 TPO-CDGUI1 PIC X(5). + 05 TPO-NOCPT1-ATTR PIC XXX. + 05 TPO-NOCPT1 PIC X(11). + 05 TPO-CLERIB1-ATTR PIC XXX. + 05 TPO-CLERIB1 PIC X(2). + 05 TPO-NBELT-ATTR PIC XXX. + 05 TPO-NBELT-CHAR PIC X(9). + 05 TPO-NBELT REDEFINES TPO-NBELT-CHAR + PIC ZZZZZZZZ9. + 05 TPO-MODRGL-ATTR PIC XXX. + 05 TPO-MODRGL PIC X. + 05 TPO-LIBRGL-ATTR PIC XXX. + 05 TPO-LIBRGL PIC X(32). + 05 TPO-NBPREST-ATTR PIC XXX. + 05 TPO-NBPREST-CHAR PIC X(3). + 05 TPO-NBPREST REDEFINES TPO-NBPREST-CHAR + PIC ZZ9. + 05 TPO-NOCHQ-ATTR PIC XXX. + 05 TPO-NOCHQ PIC X(7). + 05 TPO-LIB1-ATTR PIC XXX. + 05 TPO-LIB1 PIC X(17). + 05 TPO-CDPTN-ATTR PIC XXX. + 05 TPO-CDPTN PIC X(5). + 05 TPO-LIBPTN-ATTR PIC XXX. + 05 TPO-LIBPTN PIC X(20). + 05 TPO-IDCPTN-ATTR PIC XXX. + 05 TPO-IDCPTN PIC X(2). + 05 TPO-LIB1B-ATTR PIC XXX. + 05 TPO-LIB1B PIC X(19). + 05 TPO-ECGFIN-ATTR PIC XXX. + 05 TPO-ECGFIN PIC X(3). + 05 TPO-LIB2-ATTR PIC XXX. + 05 TPO-LIB2 PIC X(17). + 05 TPO-REF1L15-ATTR PIC XXX. + 05 TPO-REF1L15 PIC X(13). + 05 TPO-LIB3-ATTR PIC XXX. + 05 TPO-LIB3 PIC X(7). + 05 TPO-REF2L15-ATTR PIC XXX. + 05 TPO-REF2L15 PIC X(4). + 05 TPO-REF3L15-ATTR PIC XXX. + 05 TPO-REF3L15 PIC X(32). + 05 TPO-LIB4A-ATTR PIC XXX. + 05 TPO-LIB4A PIC X(17). + 05 TPO-REF3L16-ATTR PIC XXX. + 05 TPO-REF3L16 PIC X(4). + 05 TPO-TIRET-ATTR PIC XXX. + 05 TPO-TIRET PIC X. + 05 TPO-REF4L16-ATTR PIC XXX. + 05 TPO-REF4L16 PIC X(6). + 05 TPO-LIB4-ATTR PIC XXX. + 05 TPO-LIB4 PIC X(7). + 05 TPO-REF1L16-ATTR PIC XXX. + 05 TPO-REF1L16 PIC X(2). + 05 TPO-REF2L16-ATTR PIC XXX. + 05 TPO-REF2L16 PIC X(32). + 05 TPO-LIB5-ATTR PIC XXX. + 05 TPO-LIB5 PIC X(17). + 05 TPO-REF1L17-ATTR PIC XXX. + 05 TPO-REF1L17 PIC X(32). + 05 TPO-LIB6-ATTR PIC XXX. + 05 TPO-LIB6 PIC X(17). + 05 TPO-RF1L18J-ATTR PIC XXX. + 05 TPO-RF1L18J PIC X(2). + 05 TPO-RF1L18M-ATTR PIC XXX. + 05 TPO-RF1L18M PIC X(2). + 05 TPO-RF1L18A-ATTR PIC XXX. + 05 TPO-RF1L18A PIC X(4). + 05 TPO-LIB6B-ATTR PIC XXX. + 05 TPO-LIB6B PIC X(12). + 05 TPO-RF2L18J-ATTR PIC XXX. + 05 TPO-RF2L18J PIC X(2). + 05 TPO-RF2L18M-ATTR PIC XXX. + 05 TPO-RF2L18M PIC X(2). + 05 TPO-RF2L18A-ATTR PIC XXX. + 05 TPO-RF2L18A PIC X(4). + 05 TPO-LIB7-ATTR PIC XXX. + 05 TPO-LIB7 PIC X(17). + 05 TPO-RF1L19J-ATTR PIC XXX. + 05 TPO-RF1L19J PIC X(2). + 05 TPO-RF1L19M-ATTR PIC XXX. + 05 TPO-RF1L19M PIC X(2). + 05 TPO-RF1L19A-ATTR PIC XXX. + 05 TPO-RF1L19A PIC X(4). + 05 TPO-REF2L19-ATTR PIC XXX. + 05 TPO-REF2L19 PIC X(3). + 05 TPO-REF3L19-ATTR PIC XXX. + 05 TPO-REF3L19 PIC X. + 05 TPO-REF4L19-ATTR PIC XXX. + 05 TPO-REF4L19 PIC X(23). + 05 TPO-LIB8-ATTR PIC XXX. + 05 TPO-LIB8 PIC X(12). + 05 TPO-REF5L19-ATTR PIC XXX. + 05 TPO-REF5L19 PIC X. + 05 TPO-CDREJ-ATTR PIC XXX. + 05 TPO-CDREJ PIC X(2). + 05 TPO-LIBREJ-ATTR PIC XXX. + 05 TPO-LIBREJ PIC X(32). + 05 TPO-DAREJ-ATTR PIC XXX. + 05 TPO-DAREJ PIC X(10). + 05 TPO-ERRMSG1-ATTR PIC XXX. + 05 TPO-ERRMSG1 PIC X(79). + 05 TPO-LIG23-ATTR PIC XXX. + 05 TPO-LIG23 PIC X(79). + 05 TPO-LIG24-ATTR PIC XXX. + 05 TPO-LIG24 PIC X(79). + SKIP2 + ******************************************************** + * T P O I N P U T F I E L D S * + ******************************************************** + 02 TPO-INPUT-FIELDS REDEFINES TP-OUTPUT-BUFFER-FIELDS. + 05 FILLER PIC X(11). + 05 FILLER PIC X(13). + 05 FILLER PIC X(7). + 05 FILLER PIC X(8). + 05 FILLER PIC X(5). + 05 FILLER PIC X(30). + 05 FILLER PIC X(3). + 05 TPI-DAPECJ PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-DAPECM PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-DAPECA PIC X(4). + 05 FILLER PIC X(3). + 05 TPI-DAECNJ PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-DAECNM PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-DAECNA PIC X(4). + 05 FILLER PIC X(23). + 05 FILLER PIC X(6). + 05 FILLER PIC X(8). + 05 FILLER PIC X(8). + 05 FILLER PIC X(14). + 05 FILLER PIC X(5). + 05 FILLER PIC X(3). + 05 TPI-CDBQE1 PIC X(5). + 05 FILLER PIC X(3). + 05 TPI-CDGUI1 PIC X(5). + 05 FILLER PIC X(3). + 05 TPI-NOCPT1 PIC X(11). + 05 FILLER PIC X(5). + 05 FILLER PIC X(12). + 05 FILLER PIC X(4). + 05 FILLER PIC X(35). + 05 FILLER PIC X(6). + 05 FILLER PIC X(3). + 05 TPI-NOCHQ PIC X(7). + 05 FILLER PIC X(20). + 05 FILLER PIC X(3). + 05 TPI-CDPTN PIC X(5). + 05 FILLER PIC X(23). + 05 FILLER PIC X(5). + 05 FILLER PIC X(22). + 05 FILLER PIC X(6). + 05 FILLER PIC X(20). + 05 FILLER PIC X(3). + 05 TPI-REF1L15 PIC X(13). + 05 FILLER PIC X(10). + 05 FILLER PIC X(3). + 05 TPI-REF2L15 PIC X(4). + 05 FILLER PIC X(35). + 05 FILLER PIC X(20). + 05 FILLER PIC X(7). + 05 FILLER PIC X(4). + 05 FILLER PIC X(3). + 05 TPI-REF4L16 PIC X(6). + 05 FILLER PIC X(10). + 05 FILLER PIC X(3). + 05 TPI-REF1L16 PIC X(2). + 05 FILLER PIC X(35). + 05 FILLER PIC X(20). + 05 FILLER PIC X(3). + 05 TPI-REF1L17 PIC X(32). + 05 FILLER PIC X(20). + 05 FILLER PIC X(3). + 05 TPI-RF1L18J PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-RF1L18M PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-RF1L18A PIC X(4). + 05 FILLER PIC X(15). + 05 FILLER PIC X(3). + 05 TPI-RF2L18J PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-RF2L18M PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-RF2L18A PIC X(4). + 05 FILLER PIC X(20). + 05 FILLER PIC X(3). + 05 TPI-RF1L19J PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-RF1L19M PIC X(2). + 05 FILLER PIC X(3). + 05 TPI-RF1L19A PIC X(4). + 05 FILLER PIC X(3). + 05 TPI-REF2L19 PIC X(3). + 05 FILLER PIC X(3). + 05 TPI-REF3L19 PIC X. + 05 FILLER PIC X(26). + 05 FILLER PIC X(15). + 05 FILLER PIC X(3). + 05 TPI-REF5L19 PIC X. + 05 FILLER PIC X(5). + 05 FILLER PIC X(35). + 05 FILLER PIC X(13). + 05 FILLER PIC X(3). + 05 TPI-ERRMSG1 PIC X(79). + 05 FILLER PIC X(82). + 05 FILLER PIC X(82). + 01 TP-OUTPUT-BUFFER REDEFINES TP-BUFFER PIC X(1063). + EJECT + ******************************************************** + * A P P L I C A T I O N W O R K A R E A * + ******************************************************** + 01 APP-WORK-AREA. + 05 FILLER PIC X(12) VALUE 'APP WORK'. + + *TELON-------------------------------------------------------------- + *DS: ECCX.PPO00.SRCTLIB ! COPY TWKAREA ! + *------------------------------------------------------------------- + ************************************************************** ! + * COPY STANDARD GENERE DANS TOUS LES PROGRAMMES * ! + ************************************************************** ! + 01 WORKAREA. ! + * MESSAGES ! + 05 ERROR-MESSAGE-CURSOR PIC X(6) ! + VALUE '000002'. ! + 05 ERROR-MESSAGE-HELPCMB PIC X(6) ! + VALUE '000134'. ! + 05 ERROR-MESSAGE-NOHIT PIC X(6) ! + VALUE '000135'. ! + 05 ERROR-MESSAGE-MULTHIT PIC X(6) ! + VALUE '000136'. ! + 05 ERROR-MESSAGE-HIGHLIGHT PIC X(6) ! + VALUE '000007'. ! + 05 ERROR-MESSAGE-SELECT-LINE-NO PIC X(6) ! + VALUE '000137'. ! + 05 ERROR-MESSAGE-HELP PIC X(79) ! + VALUE SPACES. ! + 05 ERROR-MESSAGE-HOLD PIC X(79) ! + VALUE SPACES. ! + 05 ERROR-MESSAGE-RESUME PIC X(6) ! + VALUE '000138'. ! + 05 ERROR-MESSAGE-HOLD-ISRT PIC X(6) ! + VALUE '000139'. ! + ** VARIABLES ! + 05 MORE-LITERAL PIC X(7) VALUE '.../...'. ! + 05 NO-MORE-LITERAL PIC X(7) VALUE '* FIN *'. ! + 05 ERROR-REQ-CHAR PIC X VALUE '*'. ! + 05 PRINT-ERROR-FLAG PIC X VALUE SPACES. ! + 05 HELP-CHAR PIC X VALUE '?'. ! + 05 HELP-FIELD-PGM-ID PIC X(4) VALUE 'CCVH'. ! + 05 HELP-SCREEN-PGM-ID PIC X(4) VALUE 'CCVH'. ! + 05 HELP-TABLE-LIMIT PIC 9(2) COMP VALUE 1. ! + 05 NO-MAP-FLAG PIC X VALUE 'N'. ! + *----------------------------------------------! END TWKAREA ---- + + SKIP3 + ******************************************************** + * P R O G R A M W O R K A R E A * + ******************************************************** + 01 PROGRAM-WORK-AREA. + 05 FILLER PIC X(12) VALUE 'PGM WORK'. + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY WKAREA ! + *------------------------------------------------------------------- + **************************************************************** ! + * * ! + * ZONE DE TRAVAIL SPECIFIQUE PROGRAMME * ! + * * ! + **************************************************************** ! + ! + 77 WS-CDPTN-N PIC 9(05) VALUE ZERO. ! + ! + *================================================================ ! + * ZONES ECRAN ! + *================================================================ ! + * * ! + 01 TOP-SAISIE PIC X. ! + 88 TOP-SAISIE-OK VALUE 'O'. ! + 88 TOP-SAISIE-KO VALUE 'K'. ! + ! + ! + 01 WS-CHANGEMENT PIC X(01) VALUE 'N'. ! + ! + 01 WS-TIRET PIC X(01). ! + ! + 01 WS-DAFIC. ! + 05 WS-DAFIC-SA. ! + 10 WS-DAFIC-SS PIC X(2). ! + 10 WS-DAFIC-AA PIC X(2). ! + 05 WS-DAFIC-MM PIC X(2). ! + 05 WS-DAFIC-JJ PIC X(2). ! + ! + 01 WS-DA8. ! + 05 WS-DA8-SA. ! + 10 WS-DA8-SS PIC X(2). ! + 10 WS-DA8-AA PIC X(2). ! + 05 WS-DA8-MM PIC X(2). ! + 05 WS-DA8-JJ PIC X(2). ! + ! + 01 WS-DA10. ! + 05 WS-DA10-JJ PIC X(2). ! + 05 FILLER PIC X VALUE ' '. ! + 05 WS-DA10-MM PIC X(2). ! + 05 FILLER PIC X VALUE ' '. ! + 05 WS-DA10-SA. ! + 10 WS-DA10-SS PIC X(2). ! + 10 WS-DA10-AA PIC X(2). ! + ! + * ZONES VARIABLES DE L'ECRAN TC4E3H0 ! + 01 WS-DA-PEC-DEM-SP PIC X(8). ! + 01 WS-DA-ECN-OPE PIC X(8). ! + 01 WS-DA-REJ-OPE PIC X(8). ! + ! + 01 WS-CLE-RIB PIC X(02). ! + 01 WS-CD-BQE-DST1 PIC X(05). ! + 01 WS-CD-GUI-DST1 PIC X(05). ! + 01 WS-NO-CPT-DST1 PIC X(11). ! + 01 WS-CLE-RIB1 PIC X(02). ! + 01 WS-LIB-RGL PIC X(32). ! + 01 WS-NO-CHQ PIC X(07). ! + ! + 01 WS-LIB1 PIC X(18). ! + 01 WS-LIB-PTN PIC X(20). ! + 01 WS-CD-PTN PIC X(05). ! + 01 WS-IDC-PTN PIC X(02). ! + 01 WS-LIB1B PIC X(19). ! + 01 WS-ECG-FIN PIC X(05). ! + ! + 01 WS-LIB2 PIC X(18). ! + 01 WS-REF1L15 PIC X(13). ! + 01 WS-LIB3 PIC X(10). ! + 01 WS-REF2L15 PIC X(04). ! + 01 WS-REF3L15 PIC X(28). ! + ! + 01 WS-LIB4 PIC X(06). ! + 01 WS-REF1L16 PIC X(02). ! + 01 WS-REF2L16 PIC X(32). ! + 01 WS-LIB4A PIC X(18). ! + 01 WS-REF3L16 PIC X(04). ! + 01 WS-REF4L16 PIC X(06). ! + 01 WS-LIB5 PIC X(18). ! + 01 WS-REF1L17 PIC X(32). ! + ! + 01 WS-LIB6 PIC X(18). ! + 01 WS-REF1L18 PIC X(10). ! + 01 WS-LIB6B PIC X(12). ! + 01 WS-REF2L18. ! + 05 WS-REF2L18-JJ PIC X(02). ! + 05 FILLER PIC X(01) VALUE SPACE. ! + 05 WS-REF2L18-MM PIC X(02). ! + 05 FILLER PIC X(01) VALUE SPACE. ! + 05 WS-REF2L18-SA PIC X(04). ! + ! + 01 WS-LIB7 PIC X(18). ! + 01 WS-REF1L19. ! + 05 WS-REF1L19-JJ PIC X(02). ! + 05 FILLER PIC X(01) VALUE SPACE. ! + 05 WS-REF1L19-MM PIC X(02). ! + 05 FILLER PIC X(01) VALUE SPACE. ! + 05 WS-REF1L19-SA PIC X(04). ! + 01 WS-REF2L19 PIC X(03). ! + 01 WS-REF3L19 PIC X(01). ! + 01 WS-REF4L19 PIC X(25). ! + 01 WS-LIB8 PIC X(12). ! + 01 WS-REF5L19 PIC X(01). ! + 01 WS-LIB-REJ-OPE PIC X(32). ! + ! + * CALCUL CLE RIB ! + 01 WS-CPT. ! + 05 WS-CPT-BQE PIC X(05). ! + 05 WS-CPT-GUI PIC X(05). ! + 05 WS-CPT-CPT PIC X(11). ! + 05 WS-CPT-RIB-CLE PIC X(02). ! + ! + ! + *================================================================ ! + * COPY POUR APPEL SPITAB ! + *================================================================ ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YSPIPARA 2! + *------------------------------------------------------------------- + 01 SPI-LONG PIC S9(4) COMP. 2! + 01 SPI-PARMCICS. 2! + 10 SPI-PARAMETRE. 2! + 15 SPI-FONCTION PIC X(2). 2! + 15 SPI-NBPOST PIC S9(8) COMP. 2! + 15 FILLER REDEFINES SPI-NBPOST. 2! + 20 SPI-NBPOST1 PIC X(2). 2! + 20 SPI-NBPOST2 PIC S9(4) COMP. 2! + 15 SPI-RETCOD PIC X(2). 2! + 15 SPI-CODTAB PIC X(8). 2! + 15 SPI-EL-DEMANDES PIC X(60). 2! + 15 SPI-EL-RECHERCHE PIC X(60). 2! + 15 SPI-OPERATEUR PIC X(2). 2! + 15 SPI-REF-POSTE PIC X(50). 2! + 15 SPI-REF-FIN PIC X(50). 2! + 10 SPI-PCB. 2! + 15 SPI-FICHIER PIC X(8). 2! + 15 FILLER PIC X(2). 2! + 15 SPI-STAT PIC X(2). 2! + 15 FILLER PIC X(2). 2! + 15 FILLER PIC X(4). 2! + 10 SPI-IOAREA PIC X(2000). 2! + *----------------------------------------------! END YSPIPARA ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YSP4E013 2! + *------------------------------------------------------------------- +000010* TABLE CROS LIEE PLATEFORME 2! +000020 01 YSP4E013-YSP4E013. 2! +000030* TABLE CROS LIEE PLATEFORME 2! +000040 20 YSP4E013-PAGE-01. 2! +000050* CODE APPL ICATION O PERATIO 2! +000060 25 YSP4E013-CD-APLI-OPE PIC X(02). 2! +000070* CODE TYPE CRO 2! +000080 25 YSP4E013-CD-TY-CRO PIC X(03). 2! +000090* LIBELLE L ONG DU CR O 2! +000100 25 YSP4E013-LIB-TY-VER PIC X(32). 2! +000110* LIBELLE C OURT DU C RO 2! +000120 25 YSP4E013-LIB-INT-CT PIC X(10). 2! +000130* LIBELLE C OMMENTAIR E 2! +000140 25 YSP4E013-LIB-CMT PIC X(32). 2! + * DESCRIPTION STRUCTURE SPITAB -> FORMAT LIGHT *******************2! + *PILOTE MOTPASSE 2! + * CYSP4E013TABLE CROS LIEE PLATEFORME VALR 2! + *ACODE APPLICATION OPERATION CD-APLI-OPE 02X * 2! + *BCODE TYPECRO CD-TY-CRO 03X * 2! + *CLIBELLE LONG DU CRO LIB-TY-VER 32X 2! + *DLIBELLE COURT DU CRO LIB-INT-CT 10X 2! + *ELIBELLE COMMENTAIRE LIB-CMT 32X 2! + *----------------------------------------------! END YSP4E013 ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YSP4E053 2! + *------------------------------------------------------------------- +000010* TABLE MODE REGLEMENT 2! +000020 01 YSP4E053-YSP4E053. 2! +000030* TABLE MODE REGLEMENT 2! +000040 20 YSP4E053-PAGE-01. 2! +000050* CODE MODE REGLEMEN T OPERA 2! +000060 25 YSP4E053-CD-MODE-RGL-OPE PIC X(01). 2! +000070* LIBELLE M ODE REGLE MENT 2! +000080 25 YSP4E053-LIB-MODE-RGL PIC X(32). 2! + * DESCRIPTION STRUCTURE SPITAB -> FORMAT LIGHT *******************2! + *PILOTE MOTPASSE 2! + * CYSP4E053TABLE MODE REGLEMENT R 2! + *ACODE MODE REGLEMENT OPERATICD-MODE-RGL-OPE01X * 2! + *BLIBELLE MODE REGLEMENT LIB-MODE-RGL 32X 2! + *----------------------------------------------! END YSP4E053 ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YSP4E017 2! + *------------------------------------------------------------------- +000010* TABLE CODE REJET 2! +000020 01 YSP4E017-YSP4E017. 2! +000030* TABLE CODE REJET 2! +000040 20 YSP4E017-PAGE-01. 2! +000050* CODE REJE T OPERATI ON 2! +000060 25 YSP4E017-CD-REJ-OPE PIC X(02). 2! +000070* LIBELLE R EJET OPER ATION 2! +000080 25 YSP4E017-LIB-REJ-OPE PIC X(32). 2! + * DESCRIPTION STRUCTURE SPITAB -> FORMAT LIGHT *******************2! + *PILOTE MOTPASSE 2! + * CYSP4E017TABLE CODE REJET R 2! + *ACODE REJET OPERATION CD-REJ-OPE 02X * 2! + *BLIBELLE REJET OPERATION LIB-REJ-OPE 32X 2! + *----------------------------------------------! END YSP4E017 ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YZL00271 2! + *------------------------------------------------------------------- + ******************************************************************2! + * COMPTABILITE GENERALE *2! + * MODULE P00271 - CALCUL DE CLES *2! + * *2! + * COMMAREA 80 CAR. *2! + * *2! + ******************************************************************2! + * 2! + 01 ZL00271-LG-COMM PIC S9(4) COMP VALUE +80. 2! + * 2! + 01 ZL00271-ENR. 2! + *------ NUMERO PROGRAMME 2! + 03 ZL00271-NO-PGM PIC X(08). 2! + *------ CODE CHOIX 2! + * 1= CLE COMPTE 2! + * 2= CLE RIB 2! + 03 ZL00271-CD-CHX PIC X(01). 2! + * 2! + *------ NUMERO RIB 2! + 03 ZL00271-RIB-21-CAR. 2! + 05 ZL00271-RIB-CD-BNQ PIC X(05). 2! + 05 ZL00271-RIB-CD-GUI PIC X(05). 2! + 05 ZL00271-RIB-CPT-11-CAR PIC X(11). 2! + * 2! + *------ RACINE COMPTE 2! + 03 FILLER REDEFINES ZL00271-RIB-21-CAR. 2! + 05 ZL00271-RAC-7-CAR PIC X(07). 2! + 05 FILLER PIC X(14). 2! + * 2! + 03 FILLER PIC X(30). 2! + * 2! + *------ ZONE RETOUR 2! + 03 ZL00271-RETOUR. 2! + 05 FILLER PIC X(16). 2! + * 2! + 05 ZL00271-RIB-CLE. 2! + 07 FILLER PIC X(01). 2! + 07 ZL00271-RAC-CLE PIC X(01). 2! + * 2! + 05 ZL00271-CD-RET PIC X(02). 2! + *----------------------------------------------! END YZL00271 ---- + + *================================================================ ! + * MODULES ! + *================================================================ ! + * * ! + * 01 F PIC X(12) VALUE '**COMMAREA**'. ! + * 01 WS-LNG-COM PIC S9(04) VALUE +8000 COMP. ! + * 01 Y00CIA. ! + * 05 FILLER PIC X(16). ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y00CIA 2! + *------------------------------------------------------------------- +000010*CPG* 00 Y00CIA COMMAREA INTRA APPLICATIONS 2! +000020* LG=04000, STRUCTURE MAJ LE 04/07/94 PAR REPRISE 2! +000030* GENERE LE 28/10/08 A 16H21, PFX : Y00CIA- MEMBRE : Y00CIA 2! +000040 03 Y00CIA-Y00CIA. 2! +000050* COMMAREA INTRA APPLICATIONS 1 31/08/92 2! +000060 05 Y00CIA-ETN-TEC. 2! +000070* ENTETE TECHNIQUE 1 - - 2! +000080 07 Y00CIA-CD-RET-PGM PIC 9(2). 2! +000090* CODE RETOUR PROGRAMME 1 16/02/06 2! +000100 07 Y00CIA-CD-ABEND PIC X(4). 2! +000110* CODE ABEND 3 28/12/94 2! +000120 07 Y00CIA-CD-TY-FIC PIC X(1). 2! +000130* CODE TYPE FICHIER 7 25/08/97 2! +000140 07 Y00CIA-CD-PVN-APP PIC X(1). 2! +010010* CODE PROVENANCE APPEL 8 28/12/94 2! +010020 07 Y00CIA-NO-PGM-CICS-APP PIC X(8). 2! +010030* NUMERO PROGRAMME CICS APPELE 9 - - 2! +010040 07 Y00CIA-NO-PGM-CICS-AT PIC X(8). 2! +010050* NUMERO PROGRAMME CICS APPELANT 17 21/01/04 2! +010060 07 Y00CIA-NO-SAL PIC X(8). 2! +010070* NUMERO SALARIE 25 16/11/04 2! +010080 07 Y00CIA-CD-APLI PIC X(2). 2! +010090* CODE APPLICATION 33 28/12/94 2! +010100 07 Y00CIA-NIV-DLG PIC X(3). 2! +010110* NIVEAU DELEGATION 35 10/11/05 2! +010120 07 Y00CIA-NOM-TS-DBT PIC X(7). 2! +010130* NOM TS ECRAN 38 05/04/01 2! +010140 07 Y00CIA-CD-MES-ERR PIC X(6). 2! +020010* CODE MESSAGE ERREUR 45 28/12/94 2! +020020 07 Y00CIA-LIB-CPL-MES-ERR PIC X(32). 2! +020030* LIBELLE COMPLEMENT MESSAGE ERREUR 51 18/07/03 2! +020040 07 Y00CIA-CD-TY-MES-ERR PIC X(1). 2! +020050* CODE TYPE MESSAGE ERREUR 83 28/12/94 2! +020060 88 Y00CIA-MES-BLOQUANT VALUE 'B'. 2! +020070* DONNEE NIVEAU 88 MESSAGE BLOQUANT 84 - - 2! +020080 88 Y00CIA-MES-INFORMATIF VALUE 'I'. 2! +020090* DONNEE NIVEAU 88 MESSAGE INFORMATIF 84 - - 2! +020100 88 Y00CIA-MES-RETOUR VALUE 'P'. 2! +020110* DONNEE NIVEAU 88 MESSAGE RETOUR 84 - - 2! +020120 07 Y00CIA-CD-SI PIC X(3). 2! +020130* CODE S.I. 84 - - 2! +020140 07 Y00CIA-NO-PGM-CICS-RTG PIC X(8). 2! +030010* NUMERO PROGRAMME CICS ROUTAGE 87 - - 2! +030020 07 Y00CIA-CD-EFS PIC X(2). 2! +030030* CODE ENTITE-FS 95 30/06/00 2! +030040 07 Y00CIA-CD-FCT-DEM-RTG PIC X(3). 2! +030050* CODE FONCTION DEMANDE ROUTAGE 97 05/04/01 2! +030060 06 FILLER PIC X(101). 2! +030070* FIN SS-STR ETN-TEC 100 2! +030080 05 Y00CIA-ETN-APL. 2! +030090* ENTETE COMMAREA APPLICATIVE 201 06/10/92 2! +030100 07 Y00CIA-FCT-DEM PIC X(3). 2! +030110* FONCTION DEMANDE 201 26/09/05 2! +030120 07 Y00CIA-NB-OCC-DEM PIC 9(4) COMP. 2! +030130* NOMBRE OCCURRENCE DEMANDE 204 28/12/94 2! +030140 07 Y00CIA-NB-OCC-RES PIC 9(4) COMP. 2! +040010* NOMBRE OCCURRENCE RESULTAT 206 06/08/96 2! +040020 07 Y00CIA-NB-OCC-TOT PIC 9(7) COMP. 2! +040030* NOMBRE OCCURRENCE TOTALE 208 20/02/06 2! +040040 07 Y00CIA-NO-ITEM-TS PIC 9(4) COMP. 2! +040050* NUMERO ITEM TS 212 13/12/04 2! +040060 07 Y00CIA-NB-PAG-TS PIC 9(3) COMP. 2! +040070* NOMBRE DE PAGES EN TS 214 05/08/04 2! +040080 07 Y00CIA-WK-LG-TS-ECR PIC S9(4) COMP. 2! +040090* LONGUEUR TS ECRAN 216 17/07/03 2! +040100 07 Y00CIA-WK-LG-OCC-APLI PIC 9(4) COMP. 2! +040110* WORKING LONGUEUR OCCURRENCE APPLICATIV 218 - - 2! +040120 07 Y00CIA-WK-LG-ETN-RPN PIC 9(4) COMP. 2! +040130* WORKING LONGUEUR ENTETE REPONSE 220 28/12/94 2! +040140 07 Y00CIA-NB-OCC-PG-ECR PIC 9(4) COMP. 2! +050010* NOMBRE OCCURRENCE PAGE ECRAN 222 16/07/03 2! +050020 07 Y00CIA-IDC-OCC-SPL PIC X(1). 2! +050030* INDICATEUR OCCURRENCE SUPPLEMENTAIRE 224 22/10/07 2! +050040 07 Y00CIA-CD-RET-APLI PIC 9(2). 2! +050050* CODE RETOUR APPLICATIF 225 16/02/06 2! +050060 07 Y00CIA-WK-LG-ZON-ENT PIC S9(4) COMP. 2! +050070* WORKING LONGUEUR ZONE ENTREE 227 28/12/94 2! +050080 07 Y00CIA-WK-LG-ZON-SOR PIC S9(4) COMP. 2! +050090* WORKING LONGUEUR ZONE SORTIE 229 17/07/03 2! +050100 07 Y00CIA-NOM-TS-Q PIC X(16). 2! +050110* NOM TS QUEUE 231 28/10/08 2! +050120 06 FILLER PIC X(54). 2! +050130* FIN SS-STR ETN-APL 247 2! +050140 05 Y00CIA-ZON-APLI. 2! +060010* ZONE APPLICATION 301 06/10/92 2! +060020 07 FILLER PIC X(3700). 2! +060030* 301 2! + *----------------------------------------------! END Y00CIA ---- + + * 05 WS-YN4ESPS-APLI REDEFINES Y00CIA-ZON-APLI. ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YN4ESPS 2! + *------------------------------------------------------------------- +000010*GAR* OS YN4ESPS COPY ACCESSEUR F4EOPSPS 2! +000020* LG=01000, ESD MAJ LE 30/12/98, ELS MAJ LE 27/04/99 PAR CS0135 2! +000030* GENERE LE 27/04/99 A 16H42, PFX : YN4ESP- MEMBRE : YN4ESPS 2! +000040 07 YN4ESP-ZONE-ALLER. 2! +000050* ZONE ALLER ACCESSEUR 1 16/08/96 2! +000060 10 YN4ESP-IDC-PEC-OPE-SP PIC X(1). 2! +000070* INDICATEUR PRISE OPERATION SX:-SP 1 31/08/98 2! +000080 10 YN4ESP-DA-ENT-OPE-SP PIC X(8). 2! +000090* DATE ENTREE OPERATION SX:-SP 2 - - 2! +000100 10 YN4ESP-NO-SEQ-SP PIC X(6). 2! +000110* NUMERO SEQUENCE SX:-SP 10 08/04/98 2! +000120 10 YN4ESP-DA-PEC-DEM-SP PIC X(8). 2! +000130* DATE PRISE DEMANDEE SX:-SP 16 31/08/98 2! +000140 10 YN4ESP-CD-PTN-SP PIC X(5). 2! +010010* CODE PARTENAIRE SX:-SP 24 28/12/94 2! +010020 10 YN4ESP-NO-SAL-SP PIC X(8). 2! +010030* NUMERO SALARIE SX:-SP 29 - - 2! +010040 10 YN4ESP-CD-ORI-REJ-SPS PIC X(3). 2! +010050* CODE ORIGINE REJET SUSPENS 37 07/09/98 2! +010060 10 YN4ESP-CD-REJ-OPE PIC X(2). 2! +010070* CODE REJET OPERATION 40 31/08/98 2! +010080 10 YN4ESP-DA-REJ-OPE PIC X(8). 2! +010090* DATE REJET OPERATION 42 - - 2! +010100 10 YN4ESP-CD-ENT-SRT-OP PIC X(1). 2! +010110* CODE ENTREE SORTIE SX:-OP 50 - - 2! +010120 10 YN4ESP-DA-ECN-OPE PIC X(8). 2! +010130* DATE ECHEANCE OPERATION 51 - - 2! +010140 10 YN4ESP-DA-THR-GEN-OPE PIC X(8). 2! +020010* DATE THEORIQUE GENERATION OPERATION 59 - - 2! +020020 10 YN4ESP-DA-EFF REDEFINES YN4ESP-DA-THR-GEN-OPE. 2! +020030* DATE EFFET 59 28/12/94 2! +020040 12 YN4ESP-DA-EFF-A PIC X(4). 2! +020050* DATE EFFET ANNEE 59 - - 2! +020060 12 YN4ESP-DA-EFF-M PIC X(2). 2! +020070* DATE EFFET MOIS 63 - - 2! +020080 12 YN4ESP-DA-EFF-J PIC X(2). 2! +020090* DATE EFFET JOUR 65 - - 2! +020100 10 YN4ESP-MT-OPE-SIT PIC 9(13)V9(2). 2! +020110* MONTANT OPERATION SIT 67 02/09/98 2! +020120 10 YN4ESP-CD-BQE-DST PIC 9(5). 2! +020130* CODE BANQUE DESTINATAIRE 82 28/12/94 2! +020140 10 YN4ESP-CD-GUI-DST PIC X(5). 2! +030010* CODE GUICHET DESTINATAIRE 87 07/03/96 2! +030020 10 YN4ESP-NO-CPT-DST PIC X(11). 2! +030030* NUMERO COMPTE DESTINATAIRE 92 28/12/94 2! +030040 10 YN4ESP-CD-APLI-OPE PIC X(2). 2! +030050* CODE APPLICATION OPERATION 103 31/08/98 2! +030060 10 YN4ESP-CD-DMN-OPE PIC X(2). 2! +030070* CODE DOMAINE OPERATION 105 - - 2! +030080 10 YN4ESP-CD-DVS-OPE PIC X(3). 2! +030090* CODE DEVISE OPERATION 107 - - 2! +030100 10 YN4ESP-CD-MODE-TT-OPE PIC X(3). 2! +030110* CODE MODE TRAITEMENT OPERATION 110 - - 2! +030120 10 YN4ESP-IDT-CPT-FNC PIC X(4). 2! +030130* IDENTIFIANT COMPTE FINANCIER 113 02/09/98 2! +030140 10 YN4ESP-CD-MODE-RGL-OPE PIC X(1). 2! +040010* CODE MODE REGLEMENT OPERATION 117 31/08/98 2! +040020 10 YN4ESP-CD-SNS-OPE-SIT PIC X(2). 2! +040030* CODE SENS OPERATION SIT 118 02/09/98 2! +040040 10 YN4ESP-DA-CRE-LOT-SIT PIC X(8). 2! +040050* DATE CREATION LOT SIT 120 31/08/98 2! +040060 10 YN4ESP-NO-PTN PIC 9(3) COMP-3. 2! +040070* NUMERO PARTENAIRE 128 28/12/94 2! +040080 10 YN4ESP-NO-PRD-PTN PIC 9(3) COMP-3. 2! +040090* NUMERO PRODUIT PARTENAIRE 130 - - 2! +040100 10 YN4ESP-NO-CLI-PTN PIC 9(7) COMP-3. 2! +040110* NUMERO CLIENT PARTENAIRE 132 - - 2! +040120 10 YN4ESP-NO-ORD-CTR PIC 9(2) COMP-3. 2! +040130* NUMERO ORDRE CONTRAT 136 - - 2! +040140 10 YN4ESP-CD-TY-CRO PIC X(3). 2! +050010* CODE TYPE CRO 138 - - 2! +050020 10 YN4ESP-LIB-NOM PIC X(32). 2! +050030* LIBELLE NOM 141 - - 2! +050040 10 YN4ESP-LIB-PRN PIC X(32). 2! +050050* LIBELLE PRENOM 173 - - 2! +050060 10 YN4ESP-DA-CRE-LOT-COM PIC X(8). 2! +050070* DATE CREATION LOT COMMISSION 205 31/08/98 2! +050080 10 YN4ESP-CD-TY-COM PIC X(1). 2! +050090* CODE TYPE COMMISSION 213 28/12/94 2! +050100 10 YN4ESP-NO-STR-DIS PIC X(6). 2! +050110* NUMERO STRUCTURE DISTRIBUTION 214 26/12/95 2! +050120 10 YN4ESP-CD-TY-DCR-DGI PIC X(4). 2! +050130* CODE TYPE DECLARATION DGI 220 02/09/98 2! +050140 10 YN4ESP-PER-DCR-DGI PIC X(6). 2! +060010* PERIODE DECLARATION DGI 224 - - 2! +060020 10 YN4ESP-IDC-PTN-CM PIC X(1). 2! +060030* INDICATEUR PARTENAIRE CREDIT-MUTUEL 230 28/12/94 2! +060040 10 YN4ESP-CD-TY-ECG-FNC PIC X(5). 2! +060050* CODE TYPE ECHANGE FINANCIER 231 17/04/96 2! +060060 10 YN4ESP-CD-PTN PIC X(5). 2! +060070* CODE PARTENAIRE 236 28/12/94 2! +060080 10 YN4ESP-CD-PRD PIC X(2). 2! +060090* CODE PRODUIT 241 - - 2! +060100 10 YN4ESP-IDC-PRD-UNT-CPT PIC X(1). 2! +060110* INDICATEUR PRODUIT UNITE COMPTE 243 - - 2! +060120 10 YN4ESP-NO-POL-9. 2! +060130* NUM�RO DE POLICE 9 CAR 244 04/11/98 2! +060140 12 YN4ESP-NO-POL PIC X(8). 2! +070010* NUMERO POLICE 244 28/12/94 2! +070020 12 YN4ESP-CLE-POL PIC X(1). 2! +070030* CLE POLICE 252 - - 2! +070040 10 YN4ESP-RAC-CLE. 2! +070050* GROUPE COMPTE 253 - - 2! +070060 12 YN4ESP-RACINE PIC X(7). 2! +070070* RACINE DU CLIENT 253 07/03/96 2! +070080 12 YN4ESP-CLE-RACINE PIC X(1). 2! +070090* Cl� de la racine du client 260 28/12/94 2! +070100 10 YN4ESP-NO-DOS-SIN-DCS PIC 9(13) COMP-3. 2! +070110* NUMERO DOSSIER SINISTRE DECES 261 09/05/96 2! +070120 10 YN4ESP-TXT-MTF-OPE PIC X(32). 2! +070130* TEXTE MOTIF OPERATION 268 02/09/98 2! +070140 10 YN4ESP-DA-SCR-CTR PIC X(8). 2! +080010* DATE SOUSCRIPTION CONTRAT 300 28/12/94 2! +080020 10 YN4ESP-DA-CRE-CRO PIC X(8). 2! +080030* DATE CREATION CRO 308 25/02/98 2! +080040 10 YN4ESP-CD-MTL PIC X(1). 2! +080050* CODE MINITEL 316 31/08/98 2! +080060 10 YN4ESP-NO-CHQ PIC X(7). 2! +080070* NUMERO CHEQUE 317 28/12/94 2! +080080 10 YN4ESP-CD-CLO-ECN PIC X(1). 2! +080090* CODE CLOTURE ECHEANCE 324 19/10/98 2! +080100 10 YN4ESP-LIB-NOM-CRP-COM PIC X(32). 2! +080110* LIBELLE NOM CORRESPONDANT COMMISSION 325 28/12/94 2! +080120 10 YN4ESP-LIB-DET-SIT 2! +080130* LIBELLE DETAIL SIT 357 31/08/98 2! +080140 PIC X(24). 2! +090010 07 YN4ESP-ZONE-RETOUR. 2! +090020* ZONE RETOUR ACCESSEUR 381 16/08/96 2! +090030 10 YN4ESP-DETAIL-SIT. 2! +090040* D�TAIL D'UN MVT � VALIDER 381 16/11/98 2! +090050 15 YN4ESP-CD-STA-OPE PIC X(1). 2! +090060* CODE STATUT OPERATION 381 31/08/98 2! +090070 15 YN4ESP-NO-SEQ-OP PIC X(6). 2! +090080* NUMERO SEQUENCE SX:-OP 382 08/04/98 2! +090090 15 YN4ESP-DA-ENT-OPE PIC X(8). 2! +090100* DATE ENTREE OPERATION 388 31/08/98 2! +090110 15 YN4ESP-DA-THR-GEN-OPE PIC X(8). 2! +090120* DATE THEORIQUE GENERATION OPERATION 396 - - 2! +090130 15 YN4ESP-DA-PEC-DEM-SP PIC X(8). 2! +090140* DATE PRISE DEMANDEE SX:-SP 404 - - 2! +100010 15 YN4ESP-CD-REJ-OPE PIC X(2). 2! +100020* CODE REJET OPERATION 412 - - 2! +100030 15 YN4ESP-MT-OPE-SIT PIC 9(13)V9(2). 2! +100040* MONTANT OPERATION SIT 414 02/09/98 2! +100050 15 YN4ESP-NB-ELT-OPE PIC S9(9) COMP-3. 2! +100060* NOMBRE ELEMENT OPERATION 429 06/11/98 2! +100070 15 YN4ESP-NB-PRT-OPE PIC S9(9) COMP-3. 2! +100080* NOMBRE PRESENTATION OPERATION 434 - - 2! +100090 15 YN4ESP-CD-BQE-DST PIC 9(5). 2! +100100* CODE BANQUE DESTINATAIRE 439 28/12/94 2! +100110 15 YN4ESP-CD-GUI-DST PIC X(5). 2! +100120* CODE GUICHET DESTINATAIRE 444 07/03/96 2! +100130 15 YN4ESP-NO-CPT-DST PIC X(11). 2! +100140* NUMERO COMPTE DESTINATAIRE 449 28/12/94 2! +110010 15 YN4ESP-CD-APLI-OPE PIC X(2). 2! +110020* CODE APPLICATION OPERATION 460 31/08/98 2! +110030 15 YN4ESP-NO-SAL-BP PIC X(8). 2! +110040* NUMERO SALARIE SX:-BP 462 28/12/94 2! +110050 15 YN4ESP-NO-SAL-AP PIC X(8). 2! +110060* NUMERO SALARIE SX:-AP 470 - - 2! +110070 15 YN4ESP-CD-DMN-OPE PIC X(2). 2! +110080* CODE DOMAINE OPERATION 478 31/08/98 2! +110090 15 YN4ESP-CD-DVS-OPE PIC X(3). 2! +110100* CODE DEVISE OPERATION 480 - - 2! +110110 15 YN4ESP-CD-MODE-TT-OPE PIC X(3). 2! +110120* CODE MODE TRAITEMENT OPERATION 483 - - 2! +110130 15 YN4ESP-IDT-CPT-FNC PIC X(4). 2! +110140* IDENTIFIANT COMPTE FINANCIER 486 02/09/98 2! +120010 15 YN4ESP-CD-SNS-OPE-SIT PIC X(2). 2! +120020* CODE SENS OPERATION SIT 490 - - 2! +120030 15 YN4ESP-CD-MODE-RGL-OPE PIC X(1). 2! +120040* CODE MODE REGLEMENT OPERATION 492 31/08/98 2! +120050 15 YN4ESP-DA-CRE-LOT-SIT PIC X(8). 2! +120060* DATE CREATION LOT SIT 493 - - 2! +120070 15 YN4ESP-DA-ECN-OPE PIC X(8). 2! +120080* DATE ECHEANCE OPERATION 501 - - 2! +120090 15 YN4ESP-LIB-LOT-SIT 2! +120100* LIBELLE LOT SIT 509 - - 2! +120110 PIC X(24). 2! +120120 15 YN4ESP-CD-TY-ELT-SIT PIC X(3). 2! +120130* CODE TYPE ELEMENT SIT 533 - - 2! +120140 15 YN4ESP-LIB-DET-SIT 2! +130010* LIBELLE DETAIL SIT 536 - - 2! +130020 PIC X(24). 2! +130030 15 YN4ESP-NO-PTN PIC 9(3) COMP-3. 2! +130040* NUMERO PARTENAIRE 560 28/12/94 2! +130050 15 YN4ESP-NO-PRD-PTN PIC 9(3) COMP-3. 2! +130060* NUMERO PRODUIT PARTENAIRE 562 - - 2! +130070 15 YN4ESP-NO-CLI-PTN PIC 9(7) COMP-3. 2! +130080* NUMERO CLIENT PARTENAIRE 564 - - 2! +130090 15 YN4ESP-NO-ORD-CTR PIC 9(2) COMP-3. 2! +130100* NUMERO ORDRE CONTRAT 568 - - 2! +130110 15 YN4ESP-DA-CRE-CRO PIC X(8). 2! +130120* DATE CREATION CRO 570 25/02/98 2! +130130 15 YN4ESP-CD-TY-CRO PIC X(3). 2! +130140* CODE TYPE CRO 578 28/12/94 2! +140010 15 YN4ESP-CD-MTL PIC X(1). 2! +140020* CODE MINITEL 581 31/08/98 2! +140030 15 YN4ESP-DA-SCR-CTR PIC X(8). 2! +140040* DATE SOUSCRIPTION CONTRAT 582 28/12/94 2! +140050 15 YN4ESP-LIB-NOM PIC X(32). 2! +140060* LIBELLE NOM 590 - - 2! +140070 15 YN4ESP-LIB-PRN PIC X(32). 2! +140080* LIBELLE PRENOM 622 - - 2! +140090 15 YN4ESP-NO-LOT-CHQ PIC 9(3) COMP-3. 2! +140100* NUMERO LOT CHEQUE 654 01/09/98 2! +140110 15 YN4ESP-NO-ORD-LOT-CHQ PIC 9(3) COMP-3. 2! +140120* NUMERO ORDRE LOT CHEQUE 656 - - 2! +140130 15 YN4ESP-DA-CRE-LOT-COM PIC X(8). 2! +140140* DATE CREATION LOT COMMISSION 658 31/08/98 2! +150010 15 YN4ESP-CD-TY-COM PIC X(1). 2! +150020* CODE TYPE COMMISSION 666 28/12/94 2! +150030 15 YN4ESP-NO-STR-DIS PIC X(6). 2! +150040* NUMERO STRUCTURE DISTRIBUTION 667 26/12/95 2! +150050 15 YN4ESP-LIB-NOM-CRP-COM PIC X(32). 2! +150060* LIBELLE NOM CORRESPONDANT COMMISSION 673 28/12/94 2! +150070 15 YN4ESP-CD-TY-DCR-DGI PIC X(4). 2! +150080* CODE TYPE DECLARATION DGI 705 02/09/98 2! +150090 15 YN4ESP-PER-DCR-DGI PIC X(6). 2! +150100* PERIODE DECLARATION DGI 709 - - 2! +150110 15 YN4ESP-CD-DCR-DGI PIC X(1). 2! +150120* CODE DECLARATION DGI 715 - - 2! +150130 15 YN4ESP-IDC-PTN-CM PIC X(1). 2! +150140* INDICATEUR PARTENAIRE CREDIT-MUTUEL 716 28/12/94 2! +160010 15 YN4ESP-CD-TY-ECG-FNC PIC X(5). 2! +160020* CODE TYPE ECHANGE FINANCIER 717 17/04/96 2! +160030 15 YN4ESP-CD-PTN PIC X(5). 2! +160040* CODE PARTENAIRE 722 28/12/94 2! +160050 15 YN4ESP-CD-PRD PIC X(2). 2! +160060* CODE PRODUIT 727 - - 2! +160070 15 YN4ESP-NO-POL-9. 2! +160080* NUM�RO DE POLICE 9 CAR 729 04/11/98 2! +160090 17 YN4ESP-NO-POL PIC X(8). 2! +160100* NUMERO POLICE 729 28/12/94 2! +160110 17 YN4ESP-CLE-POL PIC X(1). 2! +160120* CLE POLICE 737 - - 2! +160130 15 YN4ESP-RAC-CLE. 2! +160140* GROUPE COMPTE 738 - - 2! +170010 17 YN4ESP-RACINE PIC X(7). 2! +170020* RACINE DU CLIENT 738 07/03/96 2! +170030 17 YN4ESP-CLE-RACINE PIC X(1). 2! +170040* Cl� de la racine du client 745 28/12/94 2! +170050 15 YN4ESP-NO-DOS-SIN-DCS PIC 9(13) COMP-3. 2! +170060* NUMERO DOSSIER SINISTRE DECES 746 09/05/96 2! +170070 15 YN4ESP-NO-CHQ PIC X(7). 2! +170080* NUMERO CHEQUE 753 28/12/94 2! +170090 15 YN4ESP-CD-TY-CSN PIC X(1). 2! +170100* CODE TYPE CESSION 760 26/12/95 2! +170110 15 YN4ESP-TXT-MTF-OPE PIC X(32). 2! +170120* TEXTE MOTIF OPERATION 761 02/09/98 2! +170130 15 YN4ESP-CD-CLO-ECN PIC X(1). 2! +170140* CODE CLOTURE ECHEANCE 793 19/10/98 2! +180010 15 YN4ESP-DA-REJ-OPE PIC X(8). 2! +180020* DATE REJET OPERATION 794 31/08/98 2! +180030 15 YN4ESP-DA-EFF. 2! +180040* DATE EFFET 802 28/12/94 2! +180050 17 YN4ESP-DA-EFF-A PIC X(4). 2! +180060* DATE EFFET ANNEE 802 - - 2! +180070 17 YN4ESP-DA-EFF-M PIC X(2). 2! +180080* DATE EFFET MOIS 806 - - 2! +180090 17 YN4ESP-DA-EFF-J PIC X(2). 2! +180100* DATE EFFET JOUR 808 - - 2! +180110 15 YN4ESP-NO-NTL-EM PIC X(6). 2! +180120* NUMERO NATIONAL EMETTEUR 810 - - 2! +180130 07 FILLER PIC X(185). 2! +180140* FIN DE STRUCTURE PRINCIPALE 816 2! + *----------------------------------------------! END YN4ESPS ---- + + * ! + * 01 Y00WIA. ! + * 05 FILLER PIC X(16). ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y00WIA 2! + *------------------------------------------------------------------- +000010*GAR* OS Y00WIA DESC. WORKING COMMAREA GENERALISEE ACC. 2! +000020* LG=04000, ESD MAJ LE 04/07/94, ELS MAJ LE 04/07/94 PAR G6A6 2! +000030* GENERE LE 20/04/01 A 09H43, PFX : Y00WIA- MEMBRE : Y00WIA 2! +000040 03 Y00WIA-Y00CIA. 2! +000050* COMMAREA INTRA APPLICATIONS 1 31/08/92 2! +000060 05 Y00WIA-ETN-TEC. 2! +000070* ENTETE TECHNIQUE 1 - - 2! +000080 07 Y00WIA-CD-RET-PGM PIC 9(2). 2! +000090* CODE RETOUR PROGRAMME 1 28/12/94 2! +000100 07 Y00WIA-CD-ABEND PIC X(4). 2! +000110* CODE ABEND 3 - - 2! +000120 07 Y00WIA-CD-TY-FIC PIC X(1). 2! +000130* CODE TYPE FICHIER 7 25/08/97 2! +000140 07 Y00WIA-CD-PVN-APP PIC X(1). 2! +010010* CODE PROVENANCE APPEL 8 28/12/94 2! +010020 07 Y00WIA-NO-PGM-CICS-APP PIC X(8). 2! +010030* NUMERO PROGRAMME CICS APPELE 9 - - 2! +010040 07 Y00WIA-NO-PGM-CICS-AT PIC X(8). 2! +010050* NUMERO PROGRAMME CICS APPELANT 17 - - 2! +010060 07 Y00WIA-NO-SAL PIC X(8). 2! +010070* NUMERO SALARIE 25 - - 2! +010080 07 Y00WIA-CD-APLI PIC X(2). 2! +010090* CODE APPLICATION 33 - - 2! +010100 07 Y00WIA-NIV-DLG PIC X(3). 2! +010110* NIVEAU DELEGATION 35 16/05/00 2! +010120 07 Y00WIA-NOM-TS-DBT PIC X(7). 2! +010130* NOM TS ECRAN 38 05/04/01 2! +010140 07 Y00WIA-CD-MES-ERR PIC X(6). 2! +020010* CODE MESSAGE ERREUR 45 28/12/94 2! +020020 07 Y00WIA-LIB-CPL-MES-ERR PIC X(32). 2! +020030* LIBELLE COMPLEMENT MESSAGE ERREUR 51 - - 2! +020040 07 Y00WIA-CD-TY-MES-ERR PIC X(1). 2! +020050* CODE TYPE MESSAGE ERREUR 83 - - 2! +020060 88 Y00WIA-MES-BLOQUANT VALUE 'B'. 2! +020070* DONNEE NIVEAU 88 MESSAGE BLOQUANT 84 - - 2! +020080 88 Y00WIA-MES-INFORMATIF VALUE 'I'. 2! +020090* DONNEE NIVEAU 88 MESSAGE INFORMATIF 84 - - 2! +020100 88 Y00WIA-MES-RETOUR VALUE 'P'. 2! +020110* DONNEE NIVEAU 88 MESSAGE RETOUR 84 - - 2! +020120 07 Y00WIA-CD-SI PIC X(3). 2! +020130* CODE S.I. 84 - - 2! +020140 07 Y00WIA-NO-PGM-CICS-RTG PIC X(8). 2! +030010* NUMERO PROGRAMME CICS ROUTAGE 87 - - 2! +030020 07 Y00WIA-CD-EFS PIC X(2). 2! +030030* CODE ENTITE-FS 95 30/06/00 2! +030040 07 Y00WIA-CD-FCT-DEM-RTG PIC X(3). 2! +030050* CODE FONCTION DEMANDE ROUTAGE 97 05/04/01 2! +030060 06 FILLER PIC X(101). 2! +030070* FIN SS-STR ETN-TEC 100 2! +030080 05 Y00WIA-ETN-APL. 2! +030090* ENTETE COMMAREA APPLICATIVE 201 06/10/92 2! +030100 07 Y00WIA-FCT-DEM PIC X(3). 2! +030110* FONCTION DEMANDE 201 05/04/01 2! +030120 07 Y00WIA-NB-OCC-DEM PIC 9(4) COMP. 2! +030130* NOMBRE OCCURRENCE DEMANDE 204 28/12/94 2! +030140 07 Y00WIA-NB-OCC-RES PIC 9(4) COMP. 2! +040010* NOMBRE OCCURRENCE RESULTAT 206 06/08/96 2! +040020 07 Y00WIA-NB-OCC-TOT PIC 9(7) COMP. 2! +040030* NOMBRE OCCURRENCE TOTALE 208 27/02/96 2! +040040 07 Y00WIA-NO-ITEM-TS PIC 9(4) COMP. 2! +040050* NUMERO D'ITEM DE TS 212 28/12/94 2! +040060 07 Y00WIA-NB-PAG-TS PIC 9(3) COMP. 2! +040070* NOMBRE DE PAGES EN TS 214 - - 2! +040080 07 Y00WIA-WK-LG-TS-ECR PIC S9(4) COMP. 2! +040090* LONGUEUR TS ECRAN 216 - - 2! +040100 07 Y00WIA-WK-LG-OCC-APLI PIC 9(4) COMP. 2! +040110* WORKING LONGUEUR OCCURENCE APPLICATIVE 218 - - 2! +040120 07 Y00WIA-WK-LG-ETN-RPN PIC 9(4) COMP. 2! +040130* WORKING LONGUEUR ENTETE REPONSE 220 - - 2! +040140 07 Y00WIA-NB-OCC-PG-ECR PIC 9(4) COMP. 2! +050010* NOMBRE OCCURRENCE PAGE ECRAN 222 - - 2! +050020 07 Y00WIA-IDC-OCC-SPL PIC X(1). 2! +050030* INDICATEUR OCCURENCE SUPPLEMENTAIRE 224 - - 2! +050040 07 Y00WIA-CD-RET-APLI PIC 9(2). 2! +050050* CODE RETOUR APPLICATIF 225 - - 2! +050060 07 Y00WIA-WK-LG-ZON-ENT PIC S9(4) COMP. 2! +050070* WORKING LONGUEUR ZONE ENTREE 227 - - 2! +050080 07 Y00WIA-WK-LG-ZON-SOR PIC S9(4) COMP. 2! +050090* WORKING LONGUEUR ZONE SORTIE 229 - - 2! +050100 06 FILLER PIC X(70). 2! +050110* FIN SS-STR ETN-APL 231 2! +050120 05 Y00WIA-ZON-APLI. 2! +050130* ZONE APPLICATION 301 06/10/92 2! +050140 07 FILLER PIC X(3700). 2! +060010* 301 2! + *----------------------------------------------! END Y00WIA ---- + + * 05 WS-TN4D101-APLI REDEFINES Y00WIA-ZON-APLI. ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y4DN101 2! + *------------------------------------------------------------------- +000010*GAR* OS Y4DN101 TN4D101:ACCESSEUR TABLE V4D01010 2! +000020* LG=00600, ESD MAJ LE 13/02/03, ELS MAJ LE 13/02/03 PAR C13447 2! +000030* GENERE LE 13/02/03 A 16H01, PFX : Y4D101- MEMBRE : Y4DN101 2! +000040 10 Y4D101-Y4DN101. 2! +000050* TN4D101:ACCESSEUR TABLE V4D01010 1 21/09/94 2! +000060 20 Y4D101-TM-STP PIC X(26). 2! +000070* TIME STAMP 1 14/04/00 2! +000080 20 Y4D101-NO-PTN PIC 9(3) COMP-3. 2! +000090* NUMERO PARTENAIRE 27 28/12/94 2! +000100 20 Y4D101-CD-PTN PIC X(5). 2! +000110* CODE PARTENAIRE 29 - - 2! +000120 20 Y4D101-NOM-PTN PIC X(32). 2! +000130* NOM PARTENAIRE 34 11/05/00 2! +000140 20 Y4D101-LA-PTN PIC X(16). 2! +010010* LIBELLE-ABREGE PARTENAIRE 66 28/12/94 2! +010020 20 Y4D101-NO-TEL PIC X(11). 2! +010030* NUMERO TELEPHONE 82 - - 2! +010040 20 Y4D101-NO-NTL-EM PIC X(6). 2! +010050* NUMERO NATIONAL EMETTEUR 93 - - 2! +010060 20 Y4D101-IDC-PTN-CM PIC X(1). 2! +010070* INDICATEUR PARTENAIRE CREDIT-MUTUEL 99 - - 2! +010080 20 Y4D101-IDC-AUT-GTN-CLI PIC X(1). 2! +010090* INDICATEUR AUTORISATION GESTION CLIENT 100 - - 2! +010100 20 Y4D101-NB-QZ-DRG-AV PIC 9(2) COMP-3. 2! +010110* NOMBRE QUINZAINE DEROGATION SX:-AV 101 - - 2! +010120 20 Y4D101-NB-QZ-DRG-AP PIC 9(2) COMP-3. 2! +010130* NOMBRE QUINZAINE DEROGATION SX:-AP 103 - - 2! +010140 20 Y4D101-CD-NAF PIC X(4). 2! +020010* CODE N.A.F. 105 - - 2! +020020 20 Y4D101-NO-IDT-EPS-SIT PIC 9(9). 2! +020030* NUMERO IDENTIFICATION ENTREPRISE SIRET 109 - - 2! +020040 20 Y4D101-NO-IDT-CPL-SIT PIC 9(5). 2! +020050* NUMERO IDENTIFICATION COMPLEMENTAIRE S 118 - - 2! +020060 20 Y4D101-CD-MODE-RGL-COM PIC X(1). 2! +020070* CODE MODE REGLEMENT COMMISSION 123 - - 2! +020080 20 Y4D101-LIB-NOM-CRP-COM PIC X(32). 2! +020090* LIBELLE NOM CORRESPONDANT COMMISSION 124 - - 2! +020100 20 Y4D101-CD-PER-COM-PTN PIC X(1). 2! +020110* CODE PERIODICITE COMMISSION PARTENAIRE 156 - - 2! +020120 20 Y4D101-CD-INT PIC X(2). 2! +020130* CODE INTITULE 157 - - 2! +020140 20 Y4D101-LIB-NOM-CRP-SF PIC X(32). 2! +030010* LIBELLE NOM CORRESPONDANT SX:-SF 159 - - 2! +030020 20 Y4D101-IDC-PTN-ITN PIC X(1). 2! +030030* INDICATEUR PARTENAIRE INTERNET 191 31/08/98 2! +030040 20 Y4D101-LIB-MTN-LGL 2! +030050* LIBELLE MENTION LEGALE 192 02/10/98 2! +030060 PIC X(72). 2! +030070 20 Y4D101-CD-GRP-PTN PIC X(3). 2! +030080* CODE GROUPE PARTENAIRE 264 25/07/95 2! +030090 20 Y4D101-CD-TY-ECG-FNC PIC X(5). 2! +030100* CODE TYPE ECHANGE FINANCIER 267 17/04/96 2! +030110 20 Y4D101-IDC-PEC PIC X(1). 2! +030120* INDICATEUR PRISE-EN-CHARGE 272 28/12/94 2! +030130 20 Y4D101-LIB-VIL PIC X(32). 2! +030140* LIBELLE VILLE 273 - - 2! +040010 20 Y4D101-IDC-AFG-AGT PIC X(1). 2! +040020* INDICATEUR AFFICHAGE AGENT 305 14/09/95 2! +040030 20 Y4D101-NB-EDI-EX PIC S9(4) COMP-3. 2! +040040* NOMBRE EDITION SX:-EX 306 02/03/95 2! +040050 20 Y4D101-CD-TY-ARC PIC X(1). 2! +040060* CODE TYPE ARCHIVAGE 309 10/07/00 2! +040070 20 Y4D101-CD-SI-DI PIC X(3). 2! +040080* CODE S.I. SX:-DI 310 28/12/94 2! +040090 20 Y4D101-DA-DNN-PTN PIC X(8). 2! +040100* DATE DENONCIATION PARTENAIRE 313 01/08/00 2! +040110 20 Y4D101-IDC-VSU-DO PIC X(1). 2! +040120* INDICATEUR VISUALISATION SX:-DO 321 27/02/96 2! +040130 20 Y4D101-IDC-TT-ACT-AG PIC X(1). 2! +040140* INDICATEUR TRAITEMENT ACTION SX:-AG 322 24/07/95 2! +050010 20 Y4D101-IDC-AFG-PT PIC X(1). 2! +050020* INDICATEUR AFFICHAGE SX:-PT 323 30/04/99 2! +050030 10 FILLER PIC X(277). 2! +050040* FIN DE STRUCTURE PRINCIPALE 324 2! + *----------------------------------------------! END Y4DN101 ---- + + ! + * COPY ACCESSEUR LIBELLE STRUCTURE ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y4DSTRG 2! + *------------------------------------------------------------------- + * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2! + * !!!!!!! !!!!!!! 2! + * !!!!!!! NE PAS UTILISER COPYGEN !!!!!!! 2! + * !!!!!!! PROBLEME AVEC LE SUFFIXE : -XX !!!!!!! 2! + * !!!!!!! !!!!!!! 2! + * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2! +000010*GAR* OS Y4DSTRG RECUPERATION INFORMATIONS SUR STRUCTURES 2! +000020* LG=00402, ESD MAJ LE 10/07/01, ELS MAJ LE 10/07/01 PAR CS0586 2! +000030* GENERE LE 10/07/01 A 10H29, PFX : Y4DSTR- MEMBRE : Y4DSTRG 2! +000040 01 Y4DSTR-Y4DSTRG. 2! +000050* RECUPERATION INFORMATIONS SUR STRUCTUR 1 14/06/93 2! +000060 02 Y4DSTR-Y4DSTRG-XX. 2! +000070* RECUPERATION INFORMATIONS SUR S SX:-XX 1 - - 2! +000080 05 FILLER PIC X(400). 2! +000090* 1 2! +000100 02 Y4DSTR-Y4DSTRG-IN REDEFINES Y4DSTR-Y4DSTRG-XX. 2! +000110* RECUPERATION INFORMATIONS SUR S SX:-IN 1 - - 2! +000120 05 Y4DSTR-TY-FCT-IN PIC X(4). 2! +000130* TYPE FONCTION SX:-IN 1 12/09/00 2! +000140 05 Y4DSTR-CD-PTN-IN PIC X(5). 2! +010010* CODE PARTENAIRE SX:-IN 5 28/12/94 2! +010020 05 Y4DSTR-NO-PTN-IN PIC 9(3). 2! +010030* NUMERO PARTENAIRE SX:-IN 10 - - 2! +010040 05 Y4DSTR-NO-STR-DIS-IN PIC X(6). 2! +010050* NUMERO STRUCTURE DISTRIBUTION SX:-IN 13 26/12/95 2! +010060 05 Y4DSTR-CD-AUT-OPT-IN PIC X(1). 2! +010070* CODE AUTORISATION OPTION SX:-IN 19 28/12/94 2! +010080 05 FILLER PIC X(381). 2! +010090* 20 2! +010100 02 Y4DSTR-Y4DSTRG-OU REDEFINES Y4DSTR-Y4DSTRG-IN. 2! +010110* RECUPERATION INFORMATIONS SUR S SX:-OU 1 14/06/93 2! +010120 05 Y4DSTR-CD-RET PIC X(4). 2! +010130* CODE RETOUR 1 04/04/00 2! +010140 05 Y4DSTR-CD-RET-SQL PIC S9(4) COMP. 2! +020010* CODE RETOUR SQL 5 28/12/94 2! +020020 05 Y4DSTR-LIB-MES PIC X(79). 2! +020030* LIBELLE MESSAGE 7 - - 2! +020040 05 Y4DSTR-NO-PTN PIC 9(3). 2! +020050* NUMERO PARTENAIRE 86 - - 2! +020060 05 Y4DSTR-NO-STR-DIS PIC X(6). 2! +020070* NUMERO STRUCTURE DISTRIBUTION 89 26/12/95 2! +020080 05 Y4DSTR-CD-FCT 2! +020090* CODE FONCTIONNALITE 95 07/03/96 2! +020100 PIC X(01). 2! +020110 05 Y4DSTR-LIB-NOM-TY 2! +020120* LIBELLE NOM SX:-TY 96 28/12/94 2! +020130 PIC X(07). 2! +020140 05 Y4DSTR-LIB-STR PIC X(32). 2! +030010* LIBELLE STRUCTURE 103 - - 2! +030020 05 Y4DSTR-LIB-RUE-1 PIC X(32). 2! +030030* LIBELLE RUE SX:-1 135 - - 2! +030040 05 Y4DSTR-LIB-RUE-2 PIC X(32). 2! +030050* LIBELLE RUE SX:-2 167 - - 2! +030060 05 Y4DSTR-LIB-COMMUNE PIC X(32). 2! +030070* LIBELLE DE LA COMMUNE 199 10/07/01 2! +030080 05 Y4DSTR-CD-POST PIC X(5). 2! +030090* CODE POSTAL 231 28/12/94 2! +030100 05 Y4DSTR-LIB-BUR-DIST 2! +030110* Libell� du bureau distributeur 236 - - 2! +030120 PIC X(26). 2! +030130 05 Y4DSTR-NO-TEL PIC X(11). 2! +030140* NUMERO TELEPHONE 262 - - 2! +040010 05 Y4DSTR-CD-BQE PIC X(5). 2! +040020* CODE BANQUE 273 - - 2! +040030 05 Y4DSTR-CD-GUICHET PIC X(5). 2! +040040* Code guichet 278 - - 2! +040050 05 Y4DSTR-NO-IDT-EPS-SIT PIC 9(9). 2! +040060* NUMERO IDENTIFICATION ENTREPRISE SIRET 283 - - 2! +040070 05 Y4DSTR-NO-IDT-CPL-SIT PIC 9(5). 2! +040080* NUMERO IDENTIFICATION COMPLEMENTAIRE S 292 - - 2! +040090 05 Y4DSTR-CD-MODE-RGL-COM PIC X(1). 2! +040100* CODE MODE REGLEMENT COMMISSION 297 - - 2! +040110 05 Y4DSTR-LIB-NOM-CRP-COM PIC X(32). 2! +040120* LIBELLE NOM CORRESPONDANT COMMISSION 298 - - 2! +040130 05 Y4DSTR-GRP-CCM PIC X(3). 2! +040140* GROUPE CAISSE 330 10/07/01 2! +050010 05 Y4DSTR-NO-FAX PIC X(12). 2! +050020* NUMERO FAX 333 27/02/96 2! +050030 05 Y4DSTR-CD-RGT-CC PIC X(1). 2! +050040* CODE REGISTRE COMMERCE 345 28/12/94 2! +050050 05 Y4DSTR-CD-INSEE-DPT PIC X(2). 2! +050060* CODE INSEE DEPARTEMENT 346 - - 2! +050070 05 Y4DSTR-CD-GRF-RGT-CC PIC X(2). 2! +050080* CODE GREFFE REGISTRE COMMERCE 348 - - 2! +050090 05 Y4DSTR-LIB-VIL-GRF-R-C PIC X(32). 2! +050100* LIBELLE VILLE GREFFE REGISTRE COMMERCE 350 - - 2! +050110 05 FILLER PIC X(19). 2! +050120* 382 2! + 02 Y4DSTR-Y4DSTRG-003 REDEFINES Y4DSTR-Y4DSTRG-IN. 2! +000110* RECUPERATION INFORMATIONS SUR S SX:-IN 1 - - 2! + 05 Y4DSTR-CD-RET-003 PIC X(4). 2! + * CODE RETOUR 1 2! + 05 Y4DSTR-CD-RET-SQL-003 PIC S9(4) COMP. 2! + * CODE RETOUR SQL 5 2! + 05 Y4DSTR-LIB-MES-ERR PIC X(79). 2! + * LIBELLE MESSAGE 84 2! + 05 Y4DSTR-MT-CAP-SOC PIC S9(13)V9(2) COMP-3. 2! + * CAPITAL SOCIAL 92 2! + 05 Y4DSTR-LIB-FRM-SOC-1 PIC X(50). 2! + * LIBELLE FORME SOCIALE UN 142 2! + 05 Y4DSTR-LIB-FRM-SOC-2 PIC X(50). 2! + * LIBELLE FORME SOCIALE DEUX 192 2! + * 2! +050130 01 Y4DSTR-LG-COMM PIC S9(4) COMP VALUE +400. 2! +050140* LONGUEUR COMMAREA 1 10/07/01 2! + *----------------------------------------------! END Y4DSTRG ---- + + ! + * COPY ACCESSEUR LIBELLE PRODUIT ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y4DTRAN 2! + *------------------------------------------------------------------- +000010*GAR* OS Y4DTRAN TRANSCO CLE EXT. EN CLE INT. ( TP ) 2! +000020* LG=00300, ESD MAJ LE 15/12/93, ELS MAJ LE 19/12/95 PAR CS0108 2! +000030* GENERE LE 19/12/95 A 08H55, PFX : Y4DTRA- MEMBRE : Y4DTRAN 2! +000040 01 Y4DTRA-LONG-SEG PIC S9(4) COMP VALUE 300. 2! +000050* LONGUEUR DU SEGMENT 1 28/12/94 2! +000060 01 Y4DTRA-Y4DTRAN. 2! +000070* TRANSCO CLE EXTERNE EN CLE INTERNE 1 11/03/93 2! +000080 05 FILLER PIC X(2). 2! +000090* 1 2! +000100 05 Y4DTRA-CD-TY-CTRL-E PIC X(1). 2! +000110* CODE TYPE CONTROLE SX:-E 3 28/12/94 2! +000120 05 Y4DTRA-NO-PTN-E PIC 9(3). 2! +000130* NUMERO PARTENAIRE SX:-E 4 - - 2! +000140 05 Y4DTRA-CD-PTN-E PIC X(5). 2! +010010* CODE PARTENAIRE SX:-E 7 - - 2! +010020 05 Y4DTRA-CD-CLI-PTN-E PIC X(15). 2! +010030* CODE CLIENT PARTENAIRE SX:-E 12 - - 2! +010040 05 Y4DTRA-CD-PRD-E PIC X(2). 2! +010050* CODE PRODUIT SX:-E 27 - - 2! +010060 05 Y4DTRA-NO-CTR-PTN-E PIC X(15). 2! +010070* NUMERO CONTRAT PARTENAIRE SX:-E 29 - - 2! +010080 05 Y4DTRA-NO-CLI-PTN-E PIC 9(7) COMP-3. 2! +010090* NUMERO CLIENT PARTENAIRE SX:-E 44 - - 2! +010100 05 Y4DTRA-NO-PRD-PTN-E PIC 9(3) COMP-3. 2! +010110* NUMERO PRODUIT PARTENAIRE SX:-E 48 - - 2! +010120 05 Y4DTRA-NO-ORD-CTR-E PIC 9(2) COMP-3. 2! +010130* NUMERO ORDRE CONTRAT SX:-E 50 - - 2! +010140 05 Y4DTRA-IDC-PTN-CM-E PIC X(1). 2! +020010* INDICATEUR PARTENAIRE CREDIT-MU SX:-E 52 - - 2! +020020 05 FILLER PIC X(5). 2! +020030* 53 2! +020040 05 Y4DTRA-CD-RET-S PIC X(4). 2! +020050* CODE RETOUR SX:-S 58 - - 2! +020060 05 Y4DTRA-LIB-MES-S PIC X(79). 2! +020070* LIBELLE MESSAGE SX:-S 62 - - 2! +020080 05 Y4DTRA-NOM-FIC-S PIC X(8). 2! +020090* NOM FICHIER SX:-S 141 - - 2! +020100 05 Y4DTRA-NOM-PROC-S PIC X(8). 2! +020110* NOM PROCEDURE SX:-S 149 - - 2! +020120 05 Y4DTRA-LIB-ACT-S PIC X(32). 2! +020130* LIBELLE ACTION SX:-S 157 - - 2! +020140 05 Y4DTRA-CD-RET-PGM-S PIC 9(2). 2! +030010* CODE RETOUR PROGRAMME SX:-S 189 - - 2! +030020 05 Y4DTRA-CD-RET-SQL-S PIC S9(4) COMP. 2! +030030* CODE RETOUR SQL SX:-S 191 - - 2! +030040 05 Y4DTRA-NO-PTN-S PIC 9(3). 2! +030050* NUMERO PARTENAIRE SX:-S 193 - - 2! +030060 05 Y4DTRA-NOM-PTN-S PIC X(32). 2! +030070* NOM PARTENAIRE SX:-S 196 - - 2! +030080 05 Y4DTRA-NO-CLI-PTN-S PIC 9(7). 2! +030090* NUMERO CLIENT PARTENAIRE SX:-S 228 - - 2! +030100 05 Y4DTRA-NO-PRD-PTN-S PIC 9(3). 2! +030110* NUMERO PRODUIT PARTENAIRE SX:-S 235 - - 2! +030120 05 Y4DTRA-LIB-PRD-S PIC X(32). 2! +030130* LIBELLE PRODUIT SX:-S 238 - - 2! +030140 05 Y4DTRA-NO-ORD-CTR-S PIC 9(2). 2! +040010* NUMERO ORDRE CONTRAT SX:-S 270 - - 2! +040020 05 Y4DTRA-LA-PRD-S PIC X(10). 2! +040030* LIBELLE-ABREGE PRODUIT SX:-S 272 - - 2! +040040 05 Y4DTRA-NO-TY-PRD-S PIC 9(2) COMP-3. 2! +040050* NUMERO TYPE PRODUIT SX:-S 282 - - 2! +040060 05 Y4DTRA-NO-POL-PRB-S PIC X(9). 2! +040070* NUMERO POLICE PREVI-B SX:-S 284 - - 2! +040080 05 Y4DTRA-CD-PRD-S PIC X(2). 2! +040090* CODE PRODUIT SX:-S 293 - - 2! +040080 05 Y4DTRA-CD-PRD-OR-S PIC X(2). 2! +040090* CODE PRODUIT AUT. POUR PEP SX:-S 293 - - 2! +040100 05 FILLER PIC X(2). 2! +040110* 295 2! + *----------------------------------------------! END Y4DTRAN ---- + + ! + *----------------------------------------------! END WKAREA ---- + + SKIP1 + EJECT + ******************************************************** + * S Y S T E M W O R K A R E A * + ******************************************************** + SKIP2 + 01 SYS-WORK-AREA. + 05 FILLER PIC X(12) VALUE 'SYS WORK '. + 05 IDENTIFICATION-DATA. + 10 CURRENT-PROGRAM-NAME PIC X(8) VALUE 'TC4E3H0 '. + 10 PROGRAM-NAME PIC X(5) VALUE '4E3H0'. + 10 FILLER PIC X(3) VALUE SPACES. + 10 NEXT-PROGRAM-NAME. + 15 NEXT-PROGRAM-NAME-HDR PIC X(2) VALUE 'TC'. + 15 NEXT-PROGRAM-NAME-ID PIC X(5) VALUE '4E3H0'. + 15 NEXT-PROGRAM-NAME-TRL PIC X(1) VALUE ' '. + 10 PROGRAM-TRANSACTION-CODE PIC X(4) VALUE '4E3H'. + SKIP1 + SKIP1 + * CURSOR-ATTR X'FFFFC0' - CURSOR + * ERROR-ATTR X'FFFFC8' - CURSOR, HIGHLIGHT + * OK-ATTR X'0000C0' - DEFAULT + * PROT-ATTR X'0000F0' - PROT, NUMERIC + * OUTPUT-ATTR X'0000F0' - PROT, NUMERIC + * OUTPUT-BLANK-ATTR X'0000FC' - PROT, NUMERIC, BLANK + * BLANK-ATTR X'0000FC' - PROT, NUMERIC, BLANK + * CURSOR-BLANK-ATTR X'FFFFCC' - CURSOR, BLANK + * INPUT-BLANK-ATTR X'0000CC' - BLANK + * OUTPUT-HIGH-ATTR X'0000F8' - PROT, NUMERIC, HIGLIGHT + * INPUT-HIGH-ATTR X'0000C8' - HIGHLIGHT + SKIP1 + 05 ATTRIBUTE-VARIABLES. + 10 CURSOR-ATTR-B PIC S9(9) COMP VALUE +16777152. + 10 FILLER REDEFINES CURSOR-ATTR-B. + 15 FILLER PIC X. + 15 CURSOR-ATTR PIC X(3). + 10 ERROR-ATTR-B PIC S9(9) COMP VALUE +16777160. + 10 FILLER REDEFINES ERROR-ATTR-B. + 15 FILLER PIC X. + 15 ERROR-ATTR PIC X(3). + 10 OK-ATTR-B PIC S9(9) COMP VALUE +192. + 10 FILLER REDEFINES OK-ATTR-B. + 15 FILLER PIC X. + 15 OK-ATTR PIC X(3). + 10 PROT-OUTPUT-ATTR-B PIC S9(9) COMP VALUE +240. + 10 FILLER REDEFINES PROT-OUTPUT-ATTR-B. + 15 FILLER PIC X. + 15 PROT-ATTR PIC X(3). + 10 FILLER REDEFINES PROT-OUTPUT-ATTR-B. + 15 FILLER PIC X. + 15 OUTPUT-ATTR PIC X(3). + 10 OUTPUT-BLANK-ATTR-B PIC S9(9) COMP VALUE +252. + 10 FILLER REDEFINES OUTPUT-BLANK-ATTR-B. + 15 FILLER PIC X. + 15 OUTPUT-BLANK-ATTR PIC X(3). + 10 FILLER REDEFINES OUTPUT-BLANK-ATTR-B. + 15 FILLER PIC X. + 15 BLANK-ATTR PIC X(3). + 10 CURSOR-BLANK-ATTR-B PIC S9(9) COMP VALUE +16777164. + 10 FILLER REDEFINES CURSOR-BLANK-ATTR-B. + 15 FILLER PIC X. + 15 CURSOR-BLANK-ATTR PIC X(3). + 10 INPUT-BLANK-ATTR-B PIC S9(9) COMP VALUE +204. + 10 FILLER REDEFINES INPUT-BLANK-ATTR-B. + 15 FILLER PIC X. + 15 INPUT-BLANK-ATTR PIC X(3). + 10 OUTPUT-HIGH-ATTR-B PIC S9(9) COMP VALUE +248. + 10 FILLER REDEFINES OUTPUT-HIGH-ATTR-B. + 15 FILLER PIC X. + 15 OUTPUT-HIGH-ATTR PIC X(3). + 10 INPUT-HIGH-ATTR-B PIC S9(9) COMP VALUE +200. + 10 FILLER REDEFINES INPUT-HIGH-ATTR-B. + 15 FILLER PIC X. + 15 INPUT-HIGH-ATTR PIC X(3). + SKIP1 + EJECT + 05 CONTROL-VARIABLES. + * + * THE CONTROL INDICATOR CONTROLS THE PROGRAM FLOW + * + 10 CONTROL-INDICATOR PIC X VALUE LOW-VALUE. + 88 PROCESS-OUTPUT VALUE 'O'. + 88 DO-WRITE VALUE 'E'. + 88 PROCESS-INPUT VALUE 'I'. + 88 DO-TRANSFER VALUE 'R'. + 88 TRANSACTION-COMPLETE VALUE 'C'. + 88 CONTINUE-PROCESS VALUE SPACE. + SKIP1 + * + * CONTROL INDICATOR ON ENTRY TO PROGRAM + * + 10 ENTRY-CONTROL-INDICATOR PIC X VALUE LOW-VALUE. + 88 ENTRY-PROCESS-OUTPUT VALUE 'O'. + 88 ENTRY-PROCESS-INPUT VALUE 'I'. + SKIP1 + * + * LITERALS USED TO SET THE CONTROL INDICATOR + * + 10 CONTROL-INDICATOR-LITERALS. + 15 PROCESS-OUTPUT-LIT PIC X VALUE 'O'. + 15 DO-WRITE-LIT PIC X VALUE 'E'. + 15 PROCESS-INPUT-LIT PIC X VALUE 'I'. + 15 DO-TRANSFER-LIT PIC X VALUE 'R'. + 15 TRANSACTION-COMPLETE-LIT PIC X VALUE 'C'. + 15 CONTINUE-PROCESS-LIT PIC X VALUE SPACE. + SKIP1 + 10 SELECT-DONE PIC X VALUE SPACES. + 10 SELECT-COUNT PIC 999 COMP-3 VALUE ZERO. + 10 HEX-3F-VALUE PIC 9(4) COMP VALUE 63. + 10 HEX-3F-REDEF REDEFINES HEX-3F-VALUE. + 15 FILLER PIC X. + 15 HEX-3F PIC X. + 10 BMSMAP-NAME PIC X(7) VALUE 'MC4E3H0'. + 10 SEGLOOP-CONTROL. + 15 SEGLOOP-COUNT PIC 999 COMP-3 VALUE ZERO. + 15 SEGLOOP-COUNT-MAX PIC 999 COMP-3 VALUE 0. + 15 INPUT-LINE-COUNT PIC 999 COMP-3 VALUE ZERO. + 15 INPUT-LINE-EDIT PIC X VALUE SPACE. + 88 NO-LINE-ERRORS VALUE ' '. + 88 LINE-ERRORS VALUE 'E'. + 88 NO-LINE-EDIT VALUE 'N'. + 15 SEGLOOP-ERROR-SW PIC X. + 88 SEGLOOP-ERROR-FOUND VALUE 'Y'. + 15 FINISH-COUNT PIC 999 COMP-3 VALUE ZERO. + 15 PAGE-REQUEST-INDICATOR PIC X VALUE LOW-VALUE. + 88 PAGE-FORWARD VALUE '1'. + 88 PAGE-BACKWARD VALUE '2'. + SKIP1 + 05 PFKEY-INDICATOR VALUE 00 PIC 99. + 88 ENTER-KEY VALUE 00. 88 CLEAR VALUE 93. + 88 PA1 VALUE 92. 88 PA2 VALUE 94. 88 PA3 VALUE 91. + 88 PFK1 VALUE 1. 88 PFK2 VALUE 2. 88 PFK3 VALUE 3. + 88 PFK4 VALUE 4. 88 PFK5 VALUE 5. 88 PFK6 VALUE 6. + 88 PFK7 VALUE 7. 88 PFK8 VALUE 8. 88 PFK9 VALUE 9. + 88 PFK10 VALUE 10. 88 PFK11 VALUE 11. 88 PFK12 VALUE 12. + 88 PFK13 VALUE 13. 88 PFK14 VALUE 14. 88 PFK15 VALUE 15. + 88 PFK16 VALUE 16. 88 PFK17 VALUE 17. 88 PFK18 VALUE 18. + 88 PFK19 VALUE 19. 88 PFK20 VALUE 20. 88 PFK21 VALUE 21. + 88 PFK22 VALUE 22. 88 PFK23 VALUE 23. 88 PFK24 VALUE 24. + 88 PFK1-13 VALUE 1 13. 88 PFK2-14 VALUE 2 14. + 88 PFK3-15 VALUE 3 15. 88 PFK4-16 VALUE 4 16. + 88 PFK5-17 VALUE 5 17. 88 PFK6-18 VALUE 6 18. + 88 PFK7-19 VALUE 7 19. 88 PFK8-20 VALUE 8 20. + 88 PFK9-21 VALUE 9 21. 88 PFK10-22 VALUE 10 22. + 88 PFK11-23 VALUE 11 23. 88 PFK12-24 VALUE 12 24. + SKIP1 + EJECT + 05 WORKFLD-NUMERIC-INSTALL. + 10 WORKFLD-NUMERIC-1 PIC S9(15)V9(3). + SKIP1 + 05 TRACE-VARIABLES. + 10 SECTION-TABLE. + 15 SECTION-NAME-TABLE PIC X(8) OCCURS 9 TIMES + INDEXED BY SEC-INDEX. + 10 TRACE-SECTION-AREA. + 15 FILLER PIC X(6) VALUE 'TRACE '. + 15 FILLER PIC S9(4) COMP VALUE -1286. + 15 TRACE-SECTION-NAME PIC X(8) VALUE SPACES. + 15 TRACE-SEGMENT-NAME PIC X(8) VALUE SPACES. + 15 TRACE-FIELD-NAME PIC X(8) VALUE SPACES. + SKIP1 + 05 FIELD-EDIT-VARIABLES. + 10 FIELD-EDIT-ERROR PIC X(4) VALUE SPACES. + 88 FIELD-EDIT-GOOD VALUE SPACES. + 10 WORKFLD-INDEX PIC 9(4) COMP VALUE ZERO. + 10 WORKFLD-NUMERIC PIC S9(11)V9(7) VALUE ZERO. + 10 WORKFLD-VCHAR. + 15 WORKFLD-LTH PIC S9(4) COMP VALUE ZERO. + 15 WORKFLD-ALPHA PIC X(256) VALUE SPACES. + 10 WORKFLD-SEGLTH PIC 9(4) COMP VALUE ZERO. + 10 WORKFLD-NUMREC PIC 9(4) COMP VALUE ZERO. + 10 WORKFLD-RBA-RRN PIC 9(8) COMP VALUE ZERO. + 05 OPERATOR-ID PIC X(8) VALUE SPACES. + 05 HOLD-AREA-SIZE PIC 9(4) COMP. + 05 HOLD-AREA-APPLID-DFLT PIC X(3) VALUE 'TC4'. + 05 UPDATE-PTR POINTER. + 05 SPA-TS-ITEM PIC 9(4) COMP VALUE 1. + 05 FALLOUT-ABEND-CODE PIC 9(4) VALUE 4002. + 05 CNTLERR-ABEND-CODE PIC 9(4) VALUE 4001. + * THE FOLLOWING FIELDS ARE DEFINED FOR COMPATIBILITY + * BETWEEN TELON IMS AND TELON CICS PROGRAMS. + 05 PROGRAM-TYPE PIC X VALUE 'C'. + 05 IO-PCB PIC X VALUE SPACE. + 05 XFER-PCB PIC X VALUE SPACE. + 05 SOUND-THE-ALARM PIC X VALUE SPACE. + 05 TPO-SCA-FIELD PIC X VALUE SPACE. + 05 SPA-CMPAT PIC X VALUE SPACE. + SKIP3 + 01 SEGMENT-IO-AREA. + 02 SEGMENT-IO-AREA-HEADER PIC X(12) VALUE 'SEGMENT AREA'. + 02 SEGMENT-IO-AREA-END PIC X. + EJECT + ******************************************************** + * H O L D A R E A B E G I N N I N G * + ******************************************************** + 01 HOLD-AREA. + 05 HOLD-AREA-KEY. + 10 HOLD-AREA-LTERM PIC X(4). + 10 HOLD-AREA-APPLID PIC X(3). + 10 HOLD-AREA-TYPE PIC X. + 05 HOLD-RESUME-PGM-ID PIC X(5). + 05 FILLER PIC X(3). + SKIP2 + ******************************************************** + * S P A A R E A * + ******************************************************** + 01 SPA-AREA PIC X(08192). + 01 FILLER REDEFINES SPA-AREA. + 02 SPA-HEADER. + 05 SPA-LENGTH PIC 9(4) COMP. + 05 SPA-NEXT-PROGRAM-NAME PIC X(8). + 05 SPA-TRANSACTION-CODE PIC X(4). + 05 FILLER PIC XX. + 02 SPA-XFER-WORK-AREA. + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIESPA ! + *------------------------------------------------------------------- + **------------------------------------------------------------** ! + ** ZONES REQUISES POUR L APPEL DE VALEUR : FONCTION HELP ** ! + ** 08/10/1999 PIRIOU ** ! + **------------------------------------------------------------** ! + ** ! + 03 XFER-HELP-CUR. ! + 05 XFER-HELP-AREA-HDR PIC X(4). ! + 05 XFER-HELP-MAP-NAME PIC X(8). ! + 05 XFER-HELP-POS-COD PIC 9(4) COMP. ! + 05 XFER-HELP-LTH-COD PIC 9(4) COMP. ! + 05 XFER-HELP-POS-LIB PIC 9(4) COMP. ! + 05 XFER-HELP-LTH-LIB PIC 9(4) COMP. ! + 05 XFER-HELP-DATA PIC X(80). ! + 05 XFER-HELP-DATA-LIB1 REDEFINES XFER-HELP-DATA. ! + 07 FILLER PIC X(74). ! + 07 XFER-HELP-POS-LIB1 PIC 9(4) COMP. ! + 07 XFER-HELP-LTH-LIB1 PIC 9(4) COMP. ! + 07 XFER-HELP-IDC-LIB1 PIC X(02). ! + 03 XFER-HELP-STD. ! + 05 XFER-HOLD-INDICATOR PIC X. ! + 05 HELP-CURR-MSG-COUNT PIC 99 COMP. ! + 05 HELP-MSG-COUNT PIC 99 COMP. ! + 05 HELP-MSG-NAME OCCURS 1. ! + 07 HELP-MSG-NAME-PROG PIC X(8). ! + 07 FILLER PIC X. ! + 07 HELP-MSG-NAME-KEY PIC X(21). ! + **------------------------------------------------------------** ! + ** ZONES REQUISES POUR LA FONCTION CHAINAGE PF03, PF04 ** ! + **------------------------------------------------------------** ! + 03 XFER-CHAINAGE. ! + 05 XFER-NB PIC 99. ! + 05 XFER-NB-MAX PIC 99. ! + 05 XFER-TABLE-PROG. ! + 07 XFER-TABLE-PROG1 PIC X(8). ! + 07 XFER-TABLE-PROG2 PIC X(72). ! + 05 FILLER REDEFINES XFER-TABLE-PROG. ! + 07 XFER-PROGRAMME OCCURS 10. ! + 09 XFER-PROG PIC X(7). ! + 09 XFER-MENU PIC X. ! + 05 FILLER REDEFINES XFER-TABLE-PROG. ! + 07 XFER-PROG1 PIC X(16). ! + 07 XFER-PROG2 PIC X(64). ! + **------------------------------------------------------------** ! + ** ZONE STOCKAGE LONGEUR COMMAREA DE PROVENANCE POUR ** ! + ** NON TELON (CICS NATIF) ** ! + **------------------------------------------------------------** ! + 03 XFER-LG-SPA-PVN-TLN PIC 9(4) COMP-5. ! + 03 XFER-MODIFY-INDICATOR PIC X(1). ! + **------------------------------------------------------------** ! + ** ZONE STOCKAGE NUMERO DE SI POUR ROUTAGE LORS D'UN ** ! + ** APPEL DE VALEUR ** ! + **------------------------------------------------------------** ! + 03 XFER-CD-SI PIC X(3). ! + 03 FILLER PIC X(177). ! + **------------------------------------------------------------** ! + ** DEBUT ZONE UTILISATEUR ** ! + **------------------------------------------------------------** ! + 02 XFER-DBT-ZON-APL. ! + *----------------------------------------------! END GIESPA ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y00CTLN ! + *------------------------------------------------------------------- +000010*GAR* OS Y00CTLN COMMAREA MENU D'ACCUEIL CAISSE LOCAL ! +000020* LG=00024, ESD MAJ LE 05/10/92, ELS MAJ LE 05/10/92 PAR G6A6 ! +000030* GENERE LE 05/10/92 A 17H52, PFX : Y00TLN- MEMBRE : Y00CTLN ! +000040 03 Y00TLN-Y00CTLN. ! +000050* COMMAREA MENU D'ACCUEIL CAISSE LOCAL 1 05/10/92 ! +000060 05 Y00TLN-CD-TRANS-PROV PIC X(4). ! +000070* CODE TRANSACTION DE PROVENANCE 1 25/01/89 ! +000080 05 Y00TLN-CD-HABILIT PIC X(2). ! +000090* CODE HABILITATION 5 - - ! +000100 05 Y00TLN-NO-CLI-CRC. ! +000110* Num�ro de client Caisse Racine Cl� 7 24/05/89 ! +000120 10 Y00TLN-NO-CCM PIC X(4). ! +000130* NUMERO CAISSE 7 14/08/92 ! +000140 10 Y00TLN-RAC-CLE. ! +010010* GROUPE COMPTE 11 23/05/89 ! +010020 15 Y00TLN-RACINE PIC X(7). ! +010030* Racine du client 11 15/06/89 ! +010040 15 Y00TLN-CLE-RACINE PIC X(1). ! +010050* Cl� de la racine du client 18 02/10/89 ! +010060 05 Y00TLN-NO-DOMAINE PIC 9(2). ! +010070* Num�ro de domaine 19 24/05/89 ! +010080 05 Y00TLN-CD-TRANS-DEST PIC X(4). ! +010090* CODE TRANSACTION DE DESTINATION 21 25/01/89 ! + *----------------------------------------------! END Y00CTLN ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y4DFIXE ! + *------------------------------------------------------------------- +000100****************************************************************** ! +000200* * ! +000300* G E O D E / S U R A V E N I R * ! +000400* * ! +000500****************************************************************** ! +000600 03 WS-4DCO-COMMAREA-FIXE. ! +000700*================================================================= ! +000800*= = ! +000900*= APPLICATION : COMMAREA COMMUNE GENERALE = ! +001000*= = ! +001100*= LONGUEUR : 1270 = ! +001200*= PREFIXE : WS-4DCO- = ! +001300*= = ! +001400*= ATTENTION : Les 56 premiers caract�res de cette = ! +001500*= commarea sont utiles pour le retour = ! +001600*= apr�s ABEND. (+ 24 Y4DCTLN = 80). = ! +001700*= = ! +001800*================================================================= ! +001900 ! +002000 05 WS-4DCO-ACCUEIL. ! +002100* ================ ! +002200*--------------------------------------------------------------- * ! +002300* COMMAREA : PARTIE COMMUNE ==> ACCUEIL GEODES * ! +002400* LONGUEUR : 550 * ! +002500* PREFIXE : WS-4DCO- * ! +002600*--------------------------------------------------------------- * ! +002700* ! +002800* ------------------------------------------------------------ ! +002900* LONGUEUR : 56 ! +003000* INFORMATIONS NECESSAIRES AU RETOUR APRES ABEND ! +003100* ------------------------------------------------------------ ! +003200* ! +003300 10 WS-4DCO-INITIAL. ! +003400 15 WS-4DCO-ACCUEIL-IDENT PIC X(008). ! +003500* IDENTIFIANT EN LIGNE ! +003600* correspond au no salarie r�seau credit mutuel ! +003700* ou au no identificateur ptn ext ! +003800 15 WS-4DCO-CD-PTN-LIGNE PIC X(005). ! +003900* CODE EXTERNE PARTENAIRE EN LIGNE ! +004000 15 WS-4DCO-CD-PTN PIC X(005). ! +004100* CODE EXTERNE PARTENAIRE TRAITE ! +004200 15 WS-4DCO-LIB-PTN PIC X(032). ! +004300* LIBELLE PARTENAIRE ! +004400 15 WS-4DCO-NO-PTN-LIGNE PIC 9(003). ! +004500* NO INTERNE DU PARTENAIRE EN LIGNE ! +004600 15 WS-4DCO-IDC-ITN PIC X(001). ! +004700* INDICATEUR INTERNET DE L'IDENTIFIANT EN LIGNE ! +004800* (POUR CONTROLE D'ENTREE DANS GEODES SEULEMENT) ! +004900 15 WS-4DCO-IDC-CMLACO-EXT PIC X(001). ! +005000* INDICATEUR EXTRANET CMLACO ! +005100 15 WS-4DCO-TYPE-CNX PIC X(001). ! +005200* TYPE DE CONNEXION PHYSIQUE ! +005300 88 CNX-EXTRANET VALUE '1'. ! +005400* Connexion par extranet (terminal EXtranet) ! +005500* ! +005600* ------------------------------------------------------------ ! +005700* LONGUEUR : 1 ! +005800* PROVENANCE DE LA CONNECTION PERMET : ! +005900* * D'IDENTIFIER L'ENVIRONNEMENT D'ORIGINE ! +006000* * D'ASSURER LE RETOUR A CET ENVIRONNEMENT ! +006100* * DE PREVOIR LA SAISIE SELON L'ACTEUR ! +006200* ------------------------------------------------------------ ! +006300* ! +006400 10 WS-4DCO-CD-PROV PIC X(001). ! +006500* CODE PROVENANCE ! +006600* PEUT PRENDRE LES VALEURS : ! +006700 88 PROV-CCM VALUE '1'. ! +006800* Provenance = environnement CCM ! +006900 88 PROV-SURA-CCM VALUE '2'. ! +007000* Provenance = environnement SURA pour CCM ! +007100 88 PROV-SURA-PEXT VALUE '3'. ! +007200* Provenance = environnement SURA pour P. EXT. ! +007300 88 PROV-SURA-CMLACO VALUE '4'. ! +007400* Provenance = environnement SURA pour CMLACO ! +007500 88 PROV-CCM-SIMU VALUE '5'. ! +007600* Provenance = environnement CCM pour simulation ! +007700 88 PROV-SURA-SIMU VALUE '6'. ! +007800* Provenance = environnement SURA pour simulation ! +007810 88 PROV-SURA-EXTPSE VALUE '7'. ! +007820* Provenance = extranet personne ! +007900* ! +008000* ------------------------------------------------------------ ! +008100* LONGUEUR : 30 ! +008200* INFORMATIONS COMPLEMENTAIRES PARTENAIRE EN LIGNE ! +008300* ------------------------------------------------------------ ! +008400* ! +008500 10 WS-4DCO-IDENTIFICATION. ! +008600 15 WS-4DCO-ACCUEIL-NO-STR-DIS PIC X(006). ! +008700* STRUCTURE DE DISTRIBUTION DU PTN EN LIGNE ! +008800* correspond au no caisse r�seau cr�dit mutuel ! +008900* ou au no agence reseau ptn ext ! +009000 15 WS-4DCO-ACCUEIL-NO-AGT-PTN PIC X(008). ! +009100* NO AGENT PARTENAIRE EN LIGNE ! +009200* correspond au no agent chez le partenaire ext. ! +009300* (num�ro propre au partenaire) ! +009400 15 WS-4DCO-CD-PFL PIC X(003). ! +009500* CODE PROFIL IDENTIFICATEUR EN LIGNE ! +009600 15 WS-4DCO-IDC-PEC PIC X(001). ! +009700* PARTENAIRE EN PRISE EN CHARGE AUTOMATIQUE ! +009800* PEUT PRENDRE LES VALEURS : ! +009900 88 IDC-PEC-AUT VALUE 'O'. ! +010000* Prise en charge automatique : pas de ! +010100* pr�-saisie ! +010200 88 IDC-PEC-MAN VALUE 'N'. ! +010300* Partenaire avec pr�-saisie (souscription, ! +010400* versement ...) ! +010500 15 WS-4DCO-IDC-AFG-AGT PIC X(001). ! +010600* Autorisation affichage numero d'agent ! +010700* ! +010800 15 WS-4DCO-VLR-NIV-DRG PIC S9(03) COMP-3. ! +010900* Niveau de d�rogation de l'identifiant ! +011000* ! +011100* ! +011200* TOP DE PROVENANCE TRANSFERT RACHAT ! +011300* ! +011400 15 WS-4DCO-TRANSFERT PIC X(02). ! +011500 88 RAC-TOT-SOUS-POPT VALUE '30'. ! +011600 88 RAC-TOT-VERS-POPT VALUE '35'. ! +011700 88 RAC-PAR-SOUS-POPT VALUE '40'. ! +011800 88 RAC-PAR-VERS-POPT VALUE '45'. ! +011900 88 RAC-TOT-SOUS-PRAC VALUE '50'. ! +012000 88 RAC-TOT-VERS-PRAC VALUE '55'. ! +012100 88 RAC-PAR-SOUS-PRAC VALUE '60'. ! +012200 88 RAC-PAR-VERS-PRAC VALUE '65'. ! +012300* ! +012400 15 WS-4DCO-IDC-VISU-DOC-ARCH PIC X(001). ! +012500* Autorisation consultation documents archiv�s ! +012600* ! +012700 15 FILLER PIC X(001). ! +012800* ZONES DISPONIBLES (Partenaire en ligne) ! +012900* ! +013000* ------------------------------------------------------------ ! +013100* LONGUEUR : 005 ! +013200* informations identifiantes de la personne (nvelle base) ! +013900* ------------------------------------------------------------ ! +014000* ! +014100 10 WS-4DCO-IDENTIFIANT-PERSONNE. ! +014200* infos indentifiantes personnes ! +014300 15 WS-4DCO-NO-PSE PIC 9(8) COMP. ! +014400* n� de la personne ! +014401 15 FILLER PIC X(001). ! +014402* ZONES DISPONIBLES (Personne) ! +014403* ! +014404* ------------------------------------------------------------ ! +014405* LONGUEUR : 430 ! +014406* INFORMATIONS CLIENT PERMET : ! +014407* * DE CONSERVER LES INFORMATIONS GLOBALES D'UN CLIENT ! +014408* SURAVENIR (PERSONNE PHYSIQUE OU MORALE) ! +014409* * DE SAUVEGARDE DES DONNEES VENANT DE L'INTERFACE CCM ! +014410* POUR LA MISE A JOUR DE LA BASE PERSONNE ! +014411* * DE DISTINGUER LES INFORMATIONS PROPRES A UN CLIENT ! +014412* DE TYPE PERSONNE PHYSIQUE OU MORALE ! +014413* ------------------------------------------------------------ ! +014414* ! +014415 10 WS-4DCO-CLIENT-GLOBAL. ! +014416* INFOS GLOBALES CLIENT ! +014417 15 WS-4DCO-CD-CLI-PTN PIC X(015). ! +014418* CODE EXTERNE DU CLIENT ! +014500 15 WS-4DCO-CREAT-CLIENT PIC X(001). ! +014600* TOP POSSIBILITE CREATION CLIENT (O/N) ! +014700 15 WS-4DCO-CNTU PIC X(001). ! +014800* CODE TYPE DE PERSONNE (P:Phys, M:Morale) ! +014900 15 WS-4DCO-CLI-ADR. ! +015000* ADRESSE DU CLIENT ! +015100 20 WS-4DCO-RUE-DEB PIC X(032). ! +015200* RUE (LIGNE 1) ! +015300 20 WS-4DCO-RUE PIC X(032). ! +015400* RUE (LIGNE 2) ! +015500 20 WS-4DCO-COMMU PIC X(032). ! +015600* COMMUNE ! +015700 20 WS-4DCO-CODPOS PIC X(005). ! +015800* CODE POSTAL ! +015900 20 WS-4DCO-LIB-BUR-DIST PIC X(032). ! +016000* BUREAU DISTRIBUTEUR ! +016100 20 WS-4DCO-CD-DPT PIC X(002). ! +016200* CODE DEPARTEMENT ! +016300 20 WS-4DCO-CD-COMM PIC X(003). ! +016400* CODE INSEE COMMUNE ! +016500 20 WS-4DCO-NO-TEL PIC X(011). ! +016600* NUMERO TELEPHONE ! +016700 20 WS-4DCO-DA-DNR-MAJ-ADR PIC X(008). ! +016800* DATE DE DERNIERE MAJ ADRESSE ! +016900 15 WS-4DCO-CLIENT-NO-STR-DIS PIC X(006) ! +017000 OCCURS 10. ! +017100* STRUCTURE PRESENCE DU CLIENT ! +017200 15 WS-4DCO-DOM-NO-STR-DIS PIC X(006). ! +017300* STRUCTURE DU COMPTE DOMICILIATION ! +017400 15 WS-4DCO-CAT-DOM PIC X(002). ! +017500* CATEGORIE DU COMPTE DOMICILIATION ! +017600 15 WS-4DCO-LIB-CD-INT-CT PIC X(010). ! +017700* LIBELLE COURT DU CODE INTITULE ! +017800 15 WS-4DCO-NO-ORD-ADR-POST PIC 9(002). ! +017900* NUMERO D ADRESSE POSTALE ! +017901* ! +017902* ------------------------------------------------------------ ! +017903* LONGUEUR : 006 ! +017904* informations identifiantes de la relation ! +017905* personne/partenaire (nouvelle base) ! +017906* ------------------------------------------------------------ ! +017907* ! +017908 10 WS-4DCO-IDENTIFIANT-PSE-PTN. ! +017909* infos indentifiantes relation personne/partenaire ! +017910 15 WS-4DCO-NO-IDT-PSE-PTN PIC 9(9) COMP-3. ! +017911* n� personne/partenaire ! +017912 15 FILLER PIC X(001). ! +017913* ZONE DISPONIBLE ! +018200* ! +018300 10 WS-4DCO-CLIENT-PPPM PIC X(170). ! +018400* DISTINCTION INFOS PP OU PM ! +018500* ! +018600 10 WS-4DCO-CLIP REDEFINES WS-4DCO-CLIENT-PPPM. ! +018700* INFOS CLIENT TYPE PERSONNE PHYSIQUE ! +018800 15 WS-4DCO-CINT PIC X(002). ! +018900* CODE INTITULE DE LA PERSONNE PHYSIQUE ! +019000 15 WS-4DCO-NOM PIC X(032). ! +019100* NOM DU CLIENT ! +019200 15 WS-4DCO-PRENOM PIC X(032). ! +019300* PRENOM DU CLIENT ! +019400 15 WS-4DCO-AANAI. ! +019500* DATE DE NAISSANCE DU CLIENT ! +019600 20 WS-4DCO-DNAISSA. ! +019700* SIECLE ET ANNEE DATE DE NAISSANCE ! +019800 25 WS-4DCO-DNAISS PIC X(002). ! +019900* SIECLE DATE DE NAISSANCE ! +020000 25 WS-4DCO-DNAISA PIC X(002). ! +020100* ANNEE DATE DE NAISSANCE ! +020200 20 WS-4DCO-DNAISM PIC X(002). ! +020300* MOIS DATE DE NAISSANCE ! +020400 20 WS-4DCO-DNAISJ PIC X(002). ! +020500* JOUR DATE DE NAISSANCE ! +020600 15 WS-4DCO-LIEUNAIS PIC X(032). ! +020700* LIEU DE NAISSANCE ! +020800 15 WS-4DCO-CD-INS-COM-NAI. ! +020900* CODE INSEE COMMUNE NAISSANCE ! +021000 20 WS-4DCO-CD-INS-DPT-NAIS PIC X(002). ! +021100* CODE INSEE DEPARTEMENT NAISSANCE ! +021200 20 WS-4DCO-CD-INS-VIL-NAIS PIC X(003). ! +021300* CODE INSEE VILLE NAISSANCE ! +021400 15 WS-4DCO-NOM-PATRO PIC X(032). ! +021500* NOM PATRONYMIQUE ! +021600 15 WS-4DCO-CD-SIT-FAM PIC X(001). ! +021700* CODE SITUATION FAMILIALE ! +021800 15 FILLER PIC X(002). ! +021900* ! +022000 15 WS-4DCO-CD-SEX PIC X(001). ! +022100* CODE SEXE ! +022200 15 WS-4DCO-CFRS PIC X(006). ! +022300* CENTRE DE FRAIS ! +022400* 15 WS-4DCO-RANG-PEPB PIC X(002). ! +022500* RANG DU DERNIER PEP BANQUE ! + 15 WS-4DCO-CD-CPC-JUR PIC X(002). ! + * code juridique ! +022600* 15 WS-4DCO-FCT-PEPB PIC X(001). ! +022700* FONCTIONNEMENT DU PEP BANQUE ! + 15 WS-4DCO-CD-RGM-MAT PIC X(001). ! + * code regime matrimonial ! +022800 15 WS-4DCO-CD-INSEE-CSP PIC X(004). ! +022900* CODE CATEGORIE SOCIO PROFESS. INSEE ! +023000 15 WS-4DCO-DA-LIQ-RTRT PIC X(008). ! +023100* DATE DEPART EN RETRAITE (GESTION PERP) ! +023101 15 WS-4DCO-CD-RSD-ETG-P PIC X(002). ! +023102* CODE RESIDENT ETRANGER ! +023200* ! +023300 10 WS-4DCO-CLIM REDEFINES WS-4DCO-CLIENT-PPPM. ! +023400* INFOS CLIENT TYPE PERSONNE MORALE ! +023500 15 WS-4DCO-CD-INT PIC X(002). ! +023600* CODE INTITULE DE LA PERSONNE MORALE ! +023700 15 WS-4DCO-RAI-SOC PIC X(032). ! +023800* RAISON SOCIALE ! +023900 15 WS-4DCO-LIB-ENS PIC X(032). ! +024000* ENSEIGNE COMMERCIALE ! +024100 15 WS-4DCO-DA-CRE-EPS. ! +024200* DATE DE CREATION DE L'ENTREPRISE ! +024300 20 WS-4DCO-DA-CRE-EPS-SSAA. ! +024400* SIECLE ET ANNEE DATE DE CREATION ! +024500 25 WS-4DCO-DA-CRE-EPS-SS PIC X(002). ! +024600* SIECLE DATE DE CREATIO ! +024700 25 WS-4DCO-DA-CRE-EPS-AA PIC X(002). ! +024800* ANNEE DATE DE CREATION ! +024900 20 WS-4DCO-DA-CRE-EPS-MM PIC X(002). ! +025000* MOIS DATE DE CREATION ! +025100 20 WS-4DCO-DA-CRE-EPS-JJ PIC X(002). ! +025200* JOUR DATE DE CREATION ! +025300 15 WS-4DCO-LIB-NOM PIC X(032). ! +025400* NOM DU REPRESENTANT LEGAL ! +025500 15 WS-4DCO-CD-TY-PSE-EN PIC X. ! +025600* TYPE D'ENTREPRISE ! +025700 15 WS-4DCO-CD-INT-REP PIC X(002). ! +025800* CODE INTITULE DU REPRESENTANT LEGAL ! +025900 15 FILLER PIC X(002). ! +026000* ZONE LIBRE ! +026100 15 WS-4DCO-NOM-PATRO-EN PIC X(032). ! +026200* RAISON SOCIALE + LIBELLE ENSEIGNE ! +026300 15 WS-4DCO-NO-SIRET. ! +026400* NUMERO DE SIRET ! +026500 20 WS-4DCO-NO-IDT-EPS-SIT PIC X(009). ! +026600* NUMERO DE SIREN ! +026700 20 WS-4DCO-NO-IDT-CPL-SIT PIC X(005). ! +026800* COMPLEMENT AU SIREN ! +026900 15 WS-4DCO-JURID. ! +027000* CLASSIFICATION JURIDIQUE DE L'ENTREPRISE ! +027100 20 WS-4DCO-CD-DIV-FRM-JUR PIC X(002). ! +027200* CODE DIVISION FORME JURIDIQUE ! +027300 20 WS-4DCO-CD-SUB-FRM-JUR PIC X(002). ! +027400* CODE SUBDIVISION FORME JURIDIQUE ! +027500 15 WS-4DCO-NAF. ! +027600* CODE NORME ACTIVITE FRANCAISE ! +027700 20 WS-4DCO-CD-DIV-NAF PIC X(002). ! +027800* CODE DIVISION NAF ! +027900 20 WS-4DCO-CD-CLS-NAF PIC X(002). ! +028000* CODE VLASSIFICATION NAF ! +028010 15 WS-4DCO-CD-RSD-ETG-M PIC X(002). ! +028020* CODE RESIDENT ETRANGER ! +028100 15 FILLER PIC X(003). ! +028200* ZONE DISPONIBLE (P. Morale) ! +028300* ! +028400* ------------------------------------------------------------ ! +028500* LONGUEUR : 33 ! +028600* FIN DE LA PARTIE ACCUEIL (ZONE DISPONIBLE) ! +028700* ------------------------------------------------------------ ! +028800 10 WS-4DCO-TRAN-PROV PIC X(004). ! +028900* TRANSACTION APPELANTE ! +029000 10 WS-4DCO-HABI-CCM-GRP PIC X(003). ! +029100* groupe habilitation ccm ! +029200 10 WS-4DCO-HABI-CCM-NIV-DLG PIC X(003). ! +029300* Niveau delegation habilitation ccm ! +029400* ------------------------------------------------------------ ! +029500* LONGUEUR : 1 ! +029600* MODE DE CONNEXION / ZONE SPECIFIQUE CONNEXION CMLACO ! +029700* ------------------------------------------------------------ ! +029800* ! +029900 10 WS-4DCO-MOD-CNX PIC X(001). ! +030000* MODE CONNEXION ! +030100* PEUT PRENDRE LES VALEURS : ! +030200 88 MOD-CNX-ANC VALUE '0'. ! +030300* ANCIEN MODE DE CONNEXION PARTENAIRE '00028' ! +030400 88 MOD-CNX-NV-SS-INF-CLI VALUE '1'. ! +030500* NOUVEAU MODE DE CONNEXION PARTENAIRE '15749' ! +030600* SANS INFOS CLIENT ! +030700 88 MOD-CNX-NV-AVC-INF-CLI VALUE '2'. ! +030800* NOUVEAU MODE DE CONNEXION PARTENAIRE '15749' ! +030900* AVEC INFOS CLIENT ! +030700 88 MOD-CNX-ORIADYS VALUE '3'. ! +030800* NOUVEAU MODE DE CONNEXION ! +031000* ! +031100 10 WS-4DCO-NO-BUR-STR-OPE-GE PIC X(006). ! +031200* NUMERO DE BUREAU DE GESTION ! +031201* ! +031202 10 WS-4DCO-PARAMETRE-FPOINT PIC X(001). ! +031203* INDICATEUR FOURNI PAR FPOINT ! +031204* ! +031205 10 WS-4DCO-NB-QZ-DRG PIC 9(002). ! +031206* NOMBRE DE QUINZAINES DEROGEABLES ! +031300* ! +031400 10 WS-4DCO-DATE-SELECTION. ! +031401 15 WS-4DCO-DATE-SEL-SSAA PIC 9(004). ! +031402 15 WS-4DCO-DATE-SEL-MM PIC 9(002). ! +031403 15 WS-4DCO-DATE-SEL-JJ PIC 9(002). ! +031404* date pour selection dans liste ! +031405* (voir WS-4DCO-DATE-FIN plus bas) ! +031406 10 WS-4DCO-TOP-MODIF PIC X. ! +031410* ! +031420 10 FILLER PIC X(004). ! +031500* ZONE DISPONIBLE (partie accueil) ! +031600 ! +031700 05 WS-4DCO-TRAITE. ! +031800* =============== ! +031900*--------------------------------------------------------------- * ! +032000* COMMAREA : PARTIE COMMUNE ==> INFOS TRAITEES * ! +032100* LONGUEUR : 350 * ! +032200* PREFIXE : WS-4DCO- * ! +032300*--------------------------------------------------------------- * ! +032400* ! +032500* ------------------------------------------------------------ ! +032600* INFORMATIONS CONTRAT (NUMERO INTERNE) ! +032700* ------------------------------------------------------------ ! +032800 10 WS-4DCO-GEODE. ! +032900* CLE INTERNE GEODE ! +033000* correspond a la r�f�rence interne qui est ! +033100* utilis�e pour la lecture des fichiers ! +033200 15 WS-4DCO-GEO-PTN PIC 9(003). ! +033300* PARTENAIRE INTERNE ! +033400 15 WS-4DCO-GEO-CLI PIC 9(007). ! +033500* CLIENT INTERNE ! +033600 15 WS-4DCO-GEO-PRD PIC 9(003). ! +033700* PRODUIT INTERNE ! +033800 15 WS-4DCO-GEO-RANG PIC X(002). ! +033900* RANG INTERNE ! +034000 15 WS-4DCO-GEO-ENR PIC X(002). ! +034100* NO ENREGISTREMENT (fichier) ! +034200 15 WS-4DCO-GEO-SEQ PIC X(003). ! +034300* NO SEQUENCE (fichier) ! +034400* ! +034500* ------------------------------------------------------------ ! +034600* INFORMATIONS CONTRAT (NUMERO EXTERNE) ! +034700* ------------------------------------------------------------ ! +034800 10 WS-4DCO-EXTERNE PIC X(020). ! +034900* IMAGE COMPLETE DU CONTRAT EXTERNE ! +035000* A utiliser uniquement pour les affichages ! +035100* ! +035200 10 WS-4DCO-CLE-CCM REDEFINES WS-4DCO-EXTERNE. ! +035300 15 WS-4DCO-CCM-PTN PIC X(005). ! +035400* PARTENAIRE CCM ! +035500 15 WS-4DCO-CCM-CPT. ! +035600* CONTRAT EXTERNE CREDIT MUTUEL ! +035700* Correspond � la r�f�rence externe (T4D0108) ! +035800* d'un num�ro de contrat pour le cr�dit mutuel ! +035900 20 WS-4DCO-CCM-CLIENT. ! +036000 25 WS-4DCO-CCM-RAC PIC X(007). ! +036100* RACINE ! +036200 25 WS-4DCO-CCM-CLE PIC X(001). ! +036300* CLE ! +036400 20 WS-4DCO-CCM-CAT PIC X(002). ! +036500* CATEGORIE ! +036600 20 WS-4DCO-CCM-RANG PIC X(002). ! +036700* RANG ! +036800 20 FILLER PIC X(003). ! +036900* ! +037000 10 WS-4DCO-CLE-EXT REDEFINES WS-4DCO-EXTERNE. ! +037100 15 WS-4DCO-EXT-PTN PIC X(005). ! +037200* PARTENAIRE EXTERIEUR ! +037300 15 WS-4DCO-EXT-CPT. ! +037400* CONTRAT EXTERNE PARTENAIRE EXTERIEUR ! +037500* Correspond � la r�f�rence externe (T4D0108) ! +037600* d'un contrat pour les partenaires ext�rieurs ! +037700 20 WS-4DCO-EXT-PRD PIC X(002). ! +037800* PRODUIT ! +037900 20 WS-4DCO-EXT-POL PIC X(009). ! +038000* NO POLICE ! +038100 20 FILLER PIC X(004). ! +038200* ! +038300* ------------------------------------------------------------ ! +038400* INFORMATIONS PROPRES AU CMLACO (Table T4D0109) ! +038500* ------------------------------------------------------------ ! +038600 10 WS-4DCO-CMLACO. ! +038700* NUMERO DE COMPTE DU CMLACO ! +038800 15 WS-4DCO-CMLACO-CAISSE PIC X(003). ! +038900* CAISSE CMLACO ! +039000 15 WS-4DCO-CMLACO-CPT PIC X(008). ! +039100* COMPTE CMLACO ! +039200* ! +039300* ------------------------------------------------------------ ! +039400* LONGUEUR : 30 ! +039500* INFORMATIONS COMPLEMENTAIRES DU PARTENAIRE TRAITE ! +039600* ------------------------------------------------------------ ! +039700 10 WS-4DCO-PARTENAIRE. ! +039800 15 WS-4DCO-IDC-CMB-EXT PIC X(001). ! +039900* INDICATEUR DU TYPE DE PARTENAIRE ! +040000* Pr�cise si le partenaire est de type CMB (O) ! +040100* ou de type partenaire ext�rieur (N) ! +040200 88 IDC-CMB VALUE 'O'. ! +040300* Type CMB ! +040400 88 IDC-EXT VALUE 'N'. ! +040500* Type partenaire ext�rieur ! +040600 15 WS-4DCO-LA-PTN PIC X(016). ! +040700* LIBELLE ABREGE PARTENAIRE ! +040800 15 WS-4DCO-IDC-SOC-FDL-GT PIC X(001). ! +040900* INDICATEUR GESTION OPERATIONS SOC. FIDELES ! +041000 15 WS-4DCO-TX-DRG-FRS-DOS-SF PIC 9(3)V9(4). ! +041100* TAUX DE FRAIS OPERATIONS SOC. FIDELES ! +041200 15 WS-4DCO-IDC-CTR-FDL-GT PIC X(001). ! +041300* INDICATEUR GESTION OPERATIONS SOC. FIDELES ! +041400* POUR LE CONTRAT TRAITE ! +041500 15 WS-4DCO-IDC-PTN-ITN PIC X(001). ! +041600* INDICATEUR INTERNET GENERAL (PTN OU IDENTIFIANT) ! +041700 15 WS-4DCO-TOPDIS PIC X(001). ! +041800* INDICATEUR RECHERCHE CONTRAT (CF. YS) ! +041900 15 WS-4DCO-PARTN-IDC-PTN-ITN PIC X(001). ! +042000* TOP "PARTENAIRE INTERNET" DU PARTENAIRE TRAIT� ! +042010 15 WS-4DCO-IDC-GTN-MG PIC X(001). ! +042200* indicateur gestion sous mandat ! +042300* ! +042400* ------------------------------------------------------------ ! +042500* INFOS STRUCTURE DE DISTRIBUTION GESTIONNAIRE DU CONTRAT ! +042600* ------------------------------------------------------------ ! +042700 10 WS-4DCO-FIX-STRUCTURE-GTN. ! +042800 15 WS-4DCO-FIX-NO-STR-GTN PIC X(006). ! +042900* STRUCTURE DE DISTRIBUTION DU CONTRAT ! +043000* correspond au no caisse r�seau credit mutuel ! +043100* ou au no agence reseau ptn ext ! +043200 15 WS-4DCO-FIX-LIB-STR-GTN PIC X(032). ! +043300* LIBELLE STRUCTURE DU CONTRAT ! +043400 15 WS-4DCO-FIX-NO-AGT-GTN PIC X(008). ! +043500* NUMERO D AGENT DU CONTRAT ! +043600* correspond au no salarie r�seau credit mutuel ! +043700* ou au no identificateur ptn ext ! +043800* ! +043900* ------------------------------------------------------------ ! +044000* INFORMATIONS PRODUIT (+ TYPE, + GAMME) TRAITE ! +044100* ------------------------------------------------------------ ! +044200 10 WS-4DCO-PRODUIT. ! +044300 15 WS-4DCO-CD-PRD PIC X(002). ! +044400* CODE EXTERNE DU PRODUIT ! +044500 15 WS-4DCO-GEN-PRD PIC X(003). ! +044600* NUMERO DE GENERATION DU PRODUIT ! +044700 15 WS-4DCO-LIB-PROD PIC X(032). ! +044800* LIBELLE PRODUIT ! +044900 15 WS-4DCO-LIB-PROD-CENTRE PIC X(032). ! +045000* LIBELLE <CENTRE> DU PRODUIT ! +045100 15 WS-4DCO-TY-PRD PIC 9(002). ! +045200* TYPE DE PRODUIT ! +045300 15 WS-4DCO-LIB-TY-PRD PIC X(032). ! +045400* LIBELLE TYPE DE PRODUIT ! +045500 15 WS-4DCO-GEN-TY PIC X(003). ! +045600* NUMERO DE GENERATION DU TYPE DE PRODUIT ! +045700 15 WS-4DCO-GAM-PRD PIC 9(002). ! +045800* GAMME DE PRODUIT ! +045900 15 WS-4DCO-LIB-GAM-PRD PIC X(032). ! +046000* LIBELLE GAMME DE PRODUIT ! +046100* ! +046200* ------------------------------------------------------------ ! +046300* INFORMATIONS DERNIERE MISE A JOUR ! +046400* ------------------------------------------------------------ ! +046500 10 WS-4DCO-DERN-MAJ. ! +046600* DATE ET HEURE DE DERNIERE MAJ ! +046700* correspond � la date de derniere maj ! +046800* correspond � l'heure de derniere maj ! +046900 15 WS-4DCO-DATE-DERN-MAJ. ! +047000* DATE DE DERNIERE MAJ ! +047100 20 WS-4DCO-DMAJ-SS PIC X(002). ! +047200* SIECLE DATE DE DERNIERE MAJ ! +047300 20 WS-4DCO-DMAJ-AA PIC X(002). ! +047400* ANNEE DATE DE DERNIERE MAJ ! +047500 20 WS-4DCO-DMAJ-MM PIC X(002). ! +047600* MOIS DATE DE DERNIERE MAJ ! +047700 20 WS-4DCO-DMAJ-JJ PIC X(002). ! +047800* JOUR DATE DE DERNIERE MAJ ! +047900 15 WS-4DCO-HEUR-DERN-MAJ. ! +048000* HORAIRE DE DERNIERE MAJ ! +048100 20 WS-4DCO-DMAJ-HEU PIC X(002). ! +048200* HEURE HORAIRE DE DERNIERE MAJ ! +048300 20 WS-4DCO-DMAJ-MIN PIC X(002). ! +048400* MINUTE HORAIRE DE DERNIERE MAJ ! +048500 20 WS-4DCO-DMAJ-SEC PIC X(002). ! +048600* SECONDE HORAIRE DE DERNIERE MAJ ! +048700 10 WS-4DCO-TS-EDIT-CICS. ! +048800* IDENTIFICATION TS IMPRESSION CICS ! +048900 15 WS-4DCO-TRMID-CICS PIC X(004). ! +049000* TERMINAL DE CREATION TS EDITION CICS ! +049100 15 WS-4DCO-TIME-CICS PIC S9(7) COMP-3. ! +049200* HEURE DE CREATION TS EDITION CICS ! +049300* ------------------------------------------------------------ ! +049400* INFORMATIONS SPECIFIQUES A PREVI-OPTIONS ! +049500* ------------------------------------------------------------ ! +049600 10 WS-4DCO-PUC. ! +049700 15 WS-4DCO-IDC-PRD-UNT-CPT PIC X(001). ! +049800* INDICATEUR PRODUIT EN UNITE DE COMPTE ! +049900 10 WS-4DCO-TRAITEMENT-SCP PIC X(001). ! +050000* Etat souscription pour partenaire exterieur ! +050100 88 SOUSCRIPTION-VALIDEE VALUE 'O'. ! +050200 88 SOUSCRIPTION-NON-VALIDEE VALUE 'N'. ! +050300* ! +050400* ------------------------------------------------------------ ! +050500* INFORMATIONS SPECIFIQUES A PROVENANCE GESTION DECES ! +050600* ------------------------------------------------------------ ! +050700 10 WS-4DCO-PROV-GESTION-DECES PIC X(001). ! +050800* Souscription ou Versement ! +050900 88 PROV-DECES VALUE 'S' 'V'. ! +051000 88 SOUS-PROV-DECES VALUE 'S'. ! +051100 88 VERS-PROV-DECES VALUE 'V'. ! +051200* ! +051300* ------------------------------------------------------------ ! +051400* REFERENCES IMPRIMES ! +051500* ------------------------------------------------------------ ! +051600 10 WS-4DCO-REF-IMP. ! +051700 15 WS-4DCO-REF-IMP-CG PIC X(010). ! +051800 15 WS-4DCO-REF-IMP-SU PIC X(010). ! +051900* ! +052000* ------------------------------------------------------------ ! +052100* gestion profil ! +052200* ------------------------------------------------------------ ! +052300 10 WS-4DCO-IDC-PRD-CMP PIC X(001). ! +052400 10 WS-4DCO-CD-PFL-GES PIC X(003). ! +052500* ------------------------------------------------------------ ! +052600 10 WS-4DCO-CD-PER PIC X(001). ! +052700* ---------- indicateur d�qualification dsk ----------------- ! +052800 10 WS-4DCO-OUI-NON PIC X(001). ! +052900* ---------- indicateur produit dsk ----------------- ! +053000 10 WS-4DCO-IDC-PRD-DSK PIC X(001). ! +053100* ---------- indicateur pourcentage FCPR < 10 --------------- ! +053200 10 WS-4DCO-IDC-VAL-FCPR PIC X(001). ! +053300* ------------------------------------------------------------ ! +053400* code devise gestion ! +053500* ------------------------------------------------------------ ! +053600 10 WS-4DCO-CD-DVS-GTN PIC X(03). ! +053700* ------------------------------------------------------------ ! +053800* Indicateurs permettant la gestion des cadres ficaux (PEP, ! +053900* DSK, ...) en tant qu'option fiscale du contrat ! +054100* ------------------------------------------------------------ ! +054200 10 WS-4DCO-INFOS-OPT-FISCALE. ! +054300* ! +054400 15 WS-4DCO-IDC-PRD-FIS-UNQ PIC X(001). ! +054500* Indicateur produit commercial � option fiscale unique O/N ! +054501 88 PDT-AVEC-OPT-FIS-UNIQUE VALUE 'O'. ! +054502* Produit n'est reli� qu'� une seule cat�gorie ! +054503* fiscale ! +054504 88 PDT-AVEC-OPT-FIS-MULTIPLE VALUE 'N'. ! +054505* Produit reli� � plusieures cat�gories fiscales ! +054506 15 WS-4DCO-CD-CAT-FIS-CTR PIC X(002). ! +054507* Cat�gorie fiscale effective sur le contrat ! +054508 15 WS-4DCO-IDC-PRD-NSK PIC X(001). ! +054509 15 FILLER PIC X(003). ! +054510* R�serve pour gestion nouvelles options fiscales ! +054600* ! +055100* ------------------------------------------------------------ ! +055200* gestion offre li�e ! +055300* ------------------------------------------------------------ ! +055400 10 WS-4DCO-CD-OFFRE-LIEE PIC X(02). ! +055500* ------------------------------------------------------------ ! +055600 10 WS-4DCO-CD-MODE-OFFRE-LIEE PIC X(03). ! +055700* ------------------------------------------------------------ ! +055800* gestion demande internet ! +055900* ------------------------------------------------------------ ! +056000 10 WS-4DCO-IDC-TT-DEM-ITN PIC X(01). ! +056100* Indicateur de gestion des demandes internet ! +056200* ------------------------------------------------------------ ! +056300* numero sequentiel de document (reedition) ! +056400* ------------------------------------------------------------ ! +056500 10 WS-4DCO-NO-SEQ-DO PIC 9(3). ! +056600 10 WS-4DCO-IDC-CRE-FLUX PIC X(01). ! +056700* ------------------------------------------------------------ ! +056800* ZONE DISPONIBLE (infos trait�es) ! +056900* ------------------------------------------------------------ ! +057000 10 WS-4DCO-IDC-CDR-DRG PIC X(001). ! +057010 10 WS-4DCO-IDC-TY-PRD-DSK PIC X(001). ! +057100* ------------------------------------------------------------ ! +057200 10 WS-4DCO-DA-PREM-SCR PIC X(008). ! +057300* ------------------------------------------------------------ ! +057400 ! +057500 05 WS-4DCO-RESERVE. ! +057600* ================ ! +057700*--------------------------------------------------------------- * ! +057800* COMMAREA : PARTIE COMMUNE ==> RESERVE * ! +057900* LONGUEUR : 300 * ! +058000* PREFIXE : WS-4DCO- * ! +058100*--------------------------------------------------------------- * ! +058200 ! +058300* ------------------------------------------------------------ ! +058400* INDICATEURS DE MAJ COMMAREA PAR APPEL DU MODULE K4DINITC ! +058500* (MISE A JOUR GENERALISEE DE COMMAREA) ! +058600* ------------------------------------------------------------ ! +058700 10 WS-4DCO-IND-MAJ-COMMAREA. ! +058800 15 WS-4DCO-IND-MAJ-COM. ! +058900 20 WS-4DCO-IND-MAJ-PTN PIC X(001). ! +059000* INDICATEUR DE MAJ INFOS PARTENAIRE ! +059100 20 WS-4DCO-IND-MAJ-PRD PIC X(001). ! +059200* INDICATEUR DE MAJ INFOS PRODUIT ! +059300 20 WS-4DCO-IND-MAJ-CLT PIC X(001). ! +059400* INDICATEUR DE MAJ INFOS CLIENT ! +059500 20 WS-4DCO-IND-MAJ-CLT-CTR PIC X(001). ! +059600* INDICATEUR DE MAJ INFOS CLT AVEC INFOS CTR ! +059700 20 WS-4DCO-IND-MAJ-PRD-SSINIT PIC X(001). ! +059800* INDICATEUR DE MAJ INFOS PRODUIT SANS INIT ! +059900 20 WS-4DCO-IND-MAJ-HBI PIC X(001). ! +060000* INDICATEUR DE MAJ INFOS HABILITATION ! +060100 20 FILLER PIC X(002). ! +060200* ZONE DISPONIBLE ! +060300 15 WS-4DCO-CD-RET-MAJ-COM PIC S9(4) COMP. ! +060400* CODE RETOUR SUR MAJ COMMAREA ! +060500 ! +060600* ------------------------------------------------------------ ! +060700 10 WS-4DCO-CCHX PIC X(002). ! +060800* CODE CHOIX ! +060900 10 WS-4DCO-TS-IDENT PIC X(008). ! +061000* IDENTIFIANT DE LA TS D'EDITION ! +061100 10 WS-4DCO-LMSG PIC X(070). ! +061200* LIBELLE MESSAGE ! +061300 10 WS-4DCO-PGM PIC X(008). ! +061400* NOM DU PROGRAMME ! +061500 10 WS-4DCO-DATEJOUR. ! +061600* DATE DU JOUR ! +061700 15 WS-4DCO-DATESA. ! +061800* ANNEE ET SIECLE DATE DU JOUR ! +061900 20 WS-4DCO-DATESS PIC X(002). ! +062000* SIECLE DATE DU JOUR ! +062100 20 WS-4DCO-DATEAA PIC X(002). ! +062200* ANNEE DATE DU JOUR ! +062300 15 WS-4DCO-DATEMM PIC X(002). ! +062400* MOIS DATE DU JOUR ! +062500 15 WS-4DCO-DATEJJ PIC X(002). ! +062600* JOUR DATE DU JOUR ! +062700 10 WS-4DCO-HEUREJOUR. ! +062800* HORAIRE DE TRAITEMENT ! +062900 15 WS-4DCO-HEUREHH PIC X(002). ! +063000* HEURE HORAIRE DE TRAITEMENT ! +063100 15 WS-4DCO-HEUREMM PIC X(002). ! +063200* MINUTE HORAIRE DE TRAITEMENT ! +063300 10 WS-4DCO-OKVALID PIC X(001). ! +063400* FLAG DE VALIDATION DONNEES ! +063500* Rajout pour test sous telon ! +063600 88 ECRAN-ATTENTE-VALIDATION VALUE '*'. ! +063700 88 ECRAN-ATTENTE-NORMALE VALUE ' '. ! +063800 10 WS-4DCO-OKBEN PIC X(001). ! +063900* FLAG DE VALIDATION DONNEES ECRANS BENEF. ! +064000 10 WS-4DCO-BLOCAGE PIC X(001). ! +064100* FLAG DE BLOCAGE DE LA SAISIE ! +064200 10 WS-4DCO-BANQDOM PIC X(005). ! +064300* CODE BANQUE DU COMPTE DOM ! +064400 10 WS-4DCO-GUICHDOM. ! +064500* CODE GUICHET DU COMPTE DOM ! +064600 15 WS-4DCO-DEPDOM PIC X(002). ! +064700* NO DE DEPARTEMENT ! +064800 15 WS-4DCO-CAIDOM PIC X(003). ! +064900* NO DE CAISSE SUR 3 POS. ! +065000 10 WS-4DCO-NO-PAGE PIC 9(002). ! +065100* NUMERO DE PAGE ! +065200 10 WS-4DCO-NB-PAGES PIC 9(002). ! +065300* NOMBRE DE PAGES ! +065400 10 WS-4DCO-CD-DOC PIC X(007). ! +065500* REFERENCE DE L'EDITION ! +065600 10 WS-4DCO-RETOUR PIC X(001). ! +065700* CODE RETOUR ! +065800 10 WS-4DCO-IND-LETTRE-CHEQUE PIC X(001). ! +065900* FLAG TRAITEMENT LETTRES-CHEQUES ! +066000 10 WS-4DCO-MVT-RETRO PIC X(001). ! +066100* INDICATEUR AUTORISATION MVT RETROACTIF ! +066200 10 WS-4DCO-TS-ITEM PIC 9(002). ! +066300* NUMERO D'ITEM TS D'EDITION ! +066400 10 WS-4DCO-TRF-SORTIE PIC X(001). ! +066500* FLAG TRF EN SORTIE ! +066600 10 WS-4DCO-CD-RET PIC X(002). ! +066700* CODE RETOUR PROGRAMMES DE DEBRANCHEMENT ! +066800 10 WS-4DCO-FCT PIC X(001). ! +066900* CODE FONCTIONNEMENT DU COMPTE ! +067000 10 WS-4DCO-CHG-CPT-DOM PIC X(001). ! +067100* INDICATEUR DE CHANGEMENT DU COMPTE DOM ! +067200 10 WS-4DCO-NO-CTR PIC X(006). ! +067300* NUMERO DE CONTRAT FISCAL ! +067400 10 WS-4DCO-CD-NTS PIC X(001). ! +067500* INDICATEUR DE NANTISSEMENT ! +067600 10 WS-4DCO-DA-SCR. ! +067700* DATE SOUSCRIPTION ! +067800 15 WS-4DCO-DA-SCR-SSAA. ! +067900* SIECLE ANNEE DATE SOUSCR. ! +068000 20 WS-4DCO-DA-SCR-SS PIC X(002). ! +068100* SIECLE DATE SOUSCRIPTION ! +068200 20 WS-4DCO-DA-SCR-AA PIC X(002). ! +068300* ANNEE DATE SOUSCRIPTION ! +068400 15 WS-4DCO-DA-SCR-MM PIC X(002). ! +068500* MOIS DATE SOUSCRIPTION ! +068600 15 WS-4DCO-DA-SCR-JJ PIC X(002). ! +068700* JOUR DATE SOUSCRIPTION ! +068800 10 WS-4DCO-CPT-PAS. ! +068900* COMPTE DE PASSAGE DES CCM ! +069000 15 WS-4DCO-CPT-PAS-RAC PIC X(007). ! +069100* RACINE DE PASSAGE DES CCM ! +069200 15 WS-4DCO-CPT-PAS-CLE PIC X(001). ! +069300* RACINE DE PASSAGE DES CCM ! +069400 10 WS-4DCO-DEMANDE-PR PIC X(003). ! +069500* CODE CONSULTATION PRIME OU DEMANDE PRIME ! +069600 10 WS-4DCO-MTF-CLO PIC X(001). ! +069700* CODE MOTIF CLOTURE DU COMPTE ! +069800 10 WS-4DCO-NB-BNF PIC 9(002). ! +069900* NOMBRE DE BENEFICIAIRES ! +070000 10 WS-4DCO-NB-ESS-CNX PIC 9(001). ! +070100* NOMBRE ESSAIS CONNEXION ! +070200 ! +070300* ------------------------------------------------------------ ! +070400* PARTIE COMMUNE POUR AFFICHAGE MENU ! +070500* ------------------------------------------------------------ ! +070600 10 WS-4DCO-CD-APPLI PIC X(004). ! +070700* CODE APPLICATION DESTINATION ! +070800 10 WS-4DCO-CD-OPT-SAUV. ! +070900* OPTION CHOISIE DU MENU PRECEDENT ! +071000 15 WS-4DCO-CD-OPT-MP PIC X(002). ! +071100* OPTION CHOISIE DU MENU PRINCIPAL ! +071200 15 WS-4DCO-CD-OPT-MS PIC X(002). ! +071300* OPTION CHOISIE DU MENU SECONDAIRE ! +071400 15 WS-4DCO-CD-OPT-MT PIC X(002). ! +071500* OPTION CHOISIE DU MENU TERTIAIRE ! +071600 15 WS-4DCO-CD-OPT-MQ PIC X(002). ! +071700* OPTION CHOISIE DU MENU QUATERNAIRE ! +071800 15 FILLER PIC X(004). ! +071900* ZONES DISPO (pour autre type de menu) ! +072000 ! +072021 10 WS-4DCO-DATE-FIN. ! +072022 15 WS-4DCO-DATE-FIN-SSAA PIC 9(004). ! +072023 15 WS-4DCO-DATE-FIN-MM PIC 9(002). ! +072024 15 WS-4DCO-DATE-FIN-JJ PIC 9(002). ! +072025* date pour selection dans liste ! +072026* (voir date-selection plus haut) ! +072030 ! +072100* ------------------------------------------------------------ ! +072200* PARTIE COMMUNE POUR CONFIDENTIALITE ! +072300* ------------------------------------------------------------ ! +072400 10 WS-4DCO-CONFID PIC X(001). ! +072500* TYPE DE CONFIDENTIALITE ! +072600 88 CONFID-T VALUE 'T'. ! +072700* CONFIDENTIALITE TOUT PARTENAIRE ! +072800 88 CONFID-X VALUE 'X'. ! +072900* CONFIDENTIALITE TOUT PARTENAIRE SAUF ! +073000 88 CONFID-P VALUE 'P'. ! +073100* CONFIDENTIALITE PARTENAIRE (1 A N) ! +073200 88 CONFID-A VALUE 'A'. ! +073300* CONFIDENTIALITE AGENCE (1 A N) ! +073400 88 CONFID-G VALUE 'G'. ! +073500* CONFIDENTIALITE AGENT (1 A N) ! +073600 10 WS-4DCO-NB-OCC-CF PIC 9(003). ! +073700* NOMBRE OCCURENCES TS CONFIDENTIALITE ! +073800 ! +073900* ------------------------------------------------------------ ! +074000* PARTIE COMMUNE POUR DEROGATIONS ! +074100* ------------------------------------------------------------ ! +074200 10 WS-4DCO-DEROG. ! +074300* DEROGATIONS PAR TYPE DE DONNEE ! +074400 15 WS-4DCO-IDC-AUT-DRG-DA PIC X(1). ! +074500* INDICATEUR DEROGATION DATE ! +074600 15 WS-4DCO-IDC-AUT-DRG-AG PIC X(1). ! +074700* INDICATEUR DEROGATION AGE ! +074800 15 WS-4DCO-IDC-AUT-DRG-MT PIC X(1). ! +074900* INDICATEUR DEROGATION MONTANT ! +075000 15 WS-4DCO-IDC-AUT-DRG-NB PIC X(1). ! +075100* INDICATEUR DEROGATION NOMBRE ! +075200 15 WS-4DCO-IDC-AUT-DRG-TX PIC X(1). ! +075300* INDICATEUR DEROGATION TAUX ! +075400 15 WS-4DCO-IDC-AUT-DRG-CP PIC X(1). ! +075500* INDICATEUR DEROGATION COMPTE ! +075600 15 WS-4DCO-IDC-AUT-DRG-TT PIC X(1). ! +075700* INDICATEUR DEROGATION SUR TAUX PAR TRANCHE ! +075800 15 WS-4DCO-IDC-AUT-DRG-TC PIC X(1). ! +075900* INDICATEUR DEROGATION TRAITEMENT DES CHEQUES ! +076000 15 WS-4DCO-IDC-AUT-DRG-SF PIC X(1). ! +076100* INDICATEUR DEROGATION SOCIETAIRE FIDELE ! +076200 15 WS-4DCO-IDC-AUT-DRG-AN PIC X(1). ! +076300* INDICATEUR DEROGATION ANNULATION NON JOUR ! +076400 15 WS-4DCO-IDC-N-IMT PIC X(1). ! +076500* INDICATEUR DEROGATION AVIS DE NON IMPOSITION ! +076600 15 WS-4DCO-IDC-VAL-PCE PIC X(1). ! +076700* INDICATEUR DEROGATION VALIDATION PIECES ! +076800 15 WS-4DCO-IDC-PRS-MVTS-PMR PIC X(1). ! +076900* INDICATEUR DEROGATION CONTRAT AVEC MVTS ! +077000* POST-MORTEM SUR ANNEE N-1 ! +077100 15 WS-4DCO-IDC-AUT-DRG-CLA PIC X(1). ! +077200* INDICATEUR DEROGATION SAISIE CLAUSE ! +077300 15 WS-4DCO-IDC-AUT-DRG-PM PIC X(1). ! +077400* INDICATEUR DEROGATION SAISIE PERSONNE MORALE ! +077500 15 WS-4DCO-IDC-AUT-DQ-DSK PIC X(1). ! +077600* INDICATEUR DEROGATION DEQUALIFICATION DSK ! +077610 15 WS-4DCO-IDC-AUT-DRG-FRS-RPP PIC X(1). ! +077620* INDICATEUR DEROGATION FRAIS RACHAT PARTIEL PROGRAMME ! +077700 15 FILLER PIC X(08). ! +077800* RESERVE (25 DEROGATIONS ETANT PREVUES) ! +077900* ------------------------------------------------------- ! +078000* TOP DE CONTROLE SAISIE ! +078100* ------------------------------------------------------- ! +078200 10 WS-4DCO-IDC-AFF PIC X(001). ! +078300* FLAG DE DONNEES ! +078400* Rajout pour test / gestion des contrats ! +078500 88 AFF-COMPTE VALUE 'C'. ! +078600 88 AFF-POLICE VALUE 'P'. ! +078700 88 AFF-TOUT VALUE ' '. ! +078800* ------------------------------------------------------ ! +078900* MEF IDENTIFIANT CONTRAT EN FONCTION PARTENAIRE ! +079000* PARTENAIRE LIBELLE IDENTIFIANT ! +079100* ---------- -------------- ------------------------- ! +079200* CMB COMPTE A CREER RACINE CLE CATEGORIE RANG ! +079300* CMAB " " ! +079400* CMSO " " ! +079500* EXTERIEUR NO. ADHESION PRODUIT POLICE CLE ! +079600* CMLACO " " ! +079700* ------------------------------------------------------ ! +079800 10 WS-4DCO-FIX-LIB-IDT-CTR PIC X(016). ! +079900* Libelle contrat ! +080000* ------------------------------------------------------ ! +080100 10 WS-4DCO-FIX-NO-IDT-CTR PIC X(015). ! +080200* Identifiant contrat ! +080300* ------------------------------------------------------ ! +080400 10 WS-4DCO-RPP-ENCO PIC X(001). ! +080500* Indicateur rachat partiel programme en cours ! +080600* ! +080700* ------------------------------------------------------- ! +080800* TOP BLOCAGE APPLICATIF GEODES ! +080900* ------------------------------------------------------- ! +081000 10 WS-4DCO-FIX-BLOC-TRAN PIC X(001). ! +081100* Top blocage transaction ! +081200* ------------------------------------------------------- ! +081300* EDITION DE DOCUMENT INFORMATIONS RESERVEES ! +081400* ------------------------------------------------------- ! +081500 10 WS-4DCO-TOP-EDIT-DEM PIC X(003). ! +081600* Top reconnaissance edition demandee ! +081700 10 WS-4DCO-TOP-OPE-ORIG REDEFINES ! +081800 WS-4DCO-TOP-EDIT-DEM PIC X(003). ! +081900* Top reconnaissance origine de l'operation ! +082000 10 WS-4DCO-4DKA-FDP PIC X(010). ! +082100* Code reference document fond de page ! +082200 10 WS-4DCO-4DKA-TOP-PTN PIC X(001). ! +082300* Top edition libelle partenaire ! +082400 10 WS-4DCO-4DKA-TYPE-IMP PIC X(001). ! +082500* Reference de l'imprimante utilis�e ! +082600 10 WS-4DCO-4DKA-NBR-EX PIC 9(001). ! +082700* Reference de l'imprimante utilis�e ! +082800 10 WS-4DCO-4DKA-NO-IMP PIC X(004). ! +082900* Numero de l'imprimante cics utilis�e ! +083000 10 WS-4DCO-CD-MOD-CL PIC X(002). ! +083100* Type de modification ! +083200* ------------------------------------------------------- ! +083300* REEDITION DE DOCUMENT ! +083400* ------------------------------------------------------- ! +083500 10 WS-4DCO-CD-REEDITION PIC X(001). ! +083600* code reedition (o/n) ! +083700 10 WS-4DCO-CD-PRESENCE-ARCH PIC X(001). ! +083800* code presence archive (o/n) ! +083900* ------------------------------------------------------ ! +084000 10 WS-4DCO-CD-EVE-TY PIC X(006). ! +084100* CODE EVENEMENT TRAITE ! +084200 10 WS-4DCO-DT-EVE PIC X(008). ! +084300* DATE EVENEMENT TRAITE ! +084320 10 WS-4DCO-IDC-PRD-PERP PIC X(001). ! +084330* indicateur produit PERP ! +084600* ------------------------------------------------------ ! +084700* ! +084800 05 WS-4DCO-CONTRAT-ENT. ! +084900* =================== ! +085000*--------------------------------------------------------------- * ! +085100* COMMAREA : PARTIE COMMUNE RESERVEE AUX CONTRATS * ! +085200* LONGUEUR : 70 ENTREPRISE * ! +085300* PREFIXE : WS-4DCO- * ! +085400*--------------------------------------------------------------- * ! +085500 ! +085600 10 WS-4DCO-CD-TRANS PIC X(004). ! +085700* CODE TRANSACTION ASSOCIE AU PRODUIT ! +085800 10 WS-4DCO-NO-CLI-PTN-EN PIC S9(7) COMP-3. ! +085900* NUMERO INTERNE CLIENT ENTREPRISE ! +086000 10 WS-4DCO-NO-ORD-CTR-EN PIC S9(2) COMP-3. ! +086100* NUMERO D'ORDRE DU CONTRAT ENTREPRISE ! +086200 10 WS-4DCO-DA-NAI-CJ. ! +086300* DATE DE NAISSANCE DU CONJOINT ! +086400 15 WS-4DCO-DA-NAI-CJ-SSAA. ! +086500* SIECLE ANNEE NAISSANCE CONJOINT ! +086600 20 WS-4DCO-DA-NAI-CJ-SS PIC X(002). ! +086700* SIECLE NAISSANCE CONJOINT ! +086800 20 WS-4DCO-DA-NAI-CJ-AA PIC X(002). ! +086900* ANNEE NAISSANCE CONJOINT ! +087000 15 WS-4DCO-DA-NAI-CJ-MM PIC X(002). ! +087100* MOIS NAISSANCE CONJOINT ! +087200 15 WS-4DCO-DA-NAI-CJ-JJ PIC X(002). ! +087300* JOUR NAISSANCE CONJOINT ! +087400 10 WS-4DCO-MT-SAL-A PIC S9(13)V9(2) COMP-3. ! +087500* MONTANT DU SALAIRE ANNUEL ! +087600 10 WS-4DCO-DA-EMB. ! +087700* DATE D'EMBAUCHE ! +087800 15 WS-4DCO-DA-EMB-SSAA. ! +087900* SIECLE ANNEE EMBAUCHE ! +088000 20 WS-4DCO-DA-EMB-SS PIC X(002). ! +088100* SIECLE EMBAUCHE ! +088200 20 WS-4DCO-DA-EMB-AA PIC X(002). ! +088300* ANNEE EMBAUCHE ! +088400 15 WS-4DCO-DA-EMB-MM PIC X(002). ! +088500* MOIS EMBAUCHE ! +088600 15 WS-4DCO-DA-EMB-JJ PIC X(002). ! +088700* JOUR EMBAUCHE ! +088800 10 WS-4DCO-NO-FAX PIC X(012). ! +088900* MONTANT DU SALAIRE ANNUEL ! +089000* ------------------------------------------------------ ! +089100 10 WS-4DCO-TOP-DECES PIC X. ! +089200 10 WS-4DCO-DA-DECES PIC X(10). ! +089300* DATE DE DECES de l'adh�rent PIC X(10). ! +089400* 10 FILLER PIC X(013). ! +089500 10 WS-4DCO-PGM-SVT PIC X(08). ! +089600 10 FILLER PIC X(005). ! +089700* ZONES DISPONIBLES (CONTRATS ENTREPRISE) ! +089800* ------------------------------------------------------ ! + *----------------------------------------------! END Y4DFIXE ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY Y4DGEODE ! + *------------------------------------------------------------------- +000100****************************************************************** ! +000200* * ! +000300* G E O D E / S U R A V E N I R * ! +000400* * ! +000500****************************************************************** ! +000600*================================================================= ! +000700*= = ! +000800*= APPLICATION : COMMAREA COMMUNE PROGRAMME = ! +000900*= = ! +001000*================================================================= ! +001100 ! +001200 03 WS-4DCO-PROGRAM. ! +001300* ================ ! +001400 05 FILLER PIC X(1800). ! +001500 ! +001600* ------------------------------------------------------ * ! +001700* ! +001800*================================================================ ! +001900* ! +002000*= APPLICATION : GESTION DES CONTRATS = ! +002100* ! +002200*================================================================ ! +002300 ! +002400 03 WS-4DCO-MENU-CTR REDEFINES WS-4DCO-PROGRAM. ! +002500* ================ ! +002600* ------------------------------------------------------ * ! +002700* COMMAREA : MENU GESTION DES CONTRATS * ! +002800* LONGUEUR : 1800 * ! +002900* PREFIXE : WS-4DCO-MNC * ! +003000* ------------------------------------------------------ * ! +003100 ! +003200 05 WS-4DCO-MNC-BLOC-TRAN PIC X(001). ! +003300* TOP BLOCAGE TRANSACTION ! +003400 05 FILLER PIC X(1799). ! +003500* ZONES DISPONIBLES ! +003600* ------------------------------------------------------ * ! +003700 ! +003800 03 WS-4DCO-SOUS REDEFINES WS-4DCO-PROGRAM. ! +003900* ============ ! +004000* ------------------------------------------------------ * ! +004100* COMMAREA : SOUSCRIPTION / TRANSFERT EN ENTREE * ! +004200* LONGUEUR : 1800 * ! +004300* PREFIXE : WS-4DCO- * ! +004400* ------------------------------------------------------ * ! +004500 ! +004600 05 WS-4DCO-INTITULEB PIC X(002). ! +004700* CODE INTITULE BENEFICIAIRE ! +004800 05 WS-4DCO-NOMB PIC X(032). ! +004900* NOM BENEFICIAIRE ! +005000 05 WS-4DCO-RUEB-1 PIC X(032). ! +005100* RUE / ADRESSE BENEFICIAIRE ! +005200 05 WS-4DCO-RUEB-2 PIC X(032). ! +005300* RUE / ADRESSE BENEFICIAIRE ! +005400 05 WS-4DCO-COMMUB PIC X(032). ! +005500* COMMUNE / ADRESSE BENEFICIAIRE ! +005600 05 WS-4DCO-CODPOSB PIC X(005). ! +005700* CODE POSTAL / ADRESSE BENEFICIAIRE ! +005800 05 WS-4DCO-BENEF PIC 9(02). ! +005900* NO BENEFICIAIRE ! +006000 05 FILLER PIC X(001). ! +006100* ZONE DISPONIBLE ! +006200 05 WS-4DCO-EXPED PIC X(001). ! +006300* CODE EXPEDITION ! +006400 05 WS-4DCO-NBEN PIC 9(02). ! +006500* NOMBRE DE BENEFICIAIRES ! +006600 05 WS-4DCO-PERIOD PIC X(001). ! +006700* CODE PERIODICITE V.P. ! +006800 05 WS-4DCO-AJUST PIC X(001). ! +006900* INDICATEUR AJUSTEMENT DE COTISATION ! +007000 05 WS-4DCO-DSOUS. ! +007100* DATE DE SOUSCRIPTION ! +007200 10 WS-4DCO-DSOUSSA. ! +007300* SIECLE ANNEE DATE DE SOUSCRIPTION ! +007400 15 WS-4DCO-DSOUSS PIC X(002). ! +007500* SIECLE DATE DE SOUSCRIPTION ! +007600 15 WS-4DCO-DSOUSA PIC X(002). ! +007700* ANNEE DATE DE SOUSCRIPTION ! +007800 10 WS-4DCO-DSOUSM PIC X(002). ! +007900* MOIS DATE DE SOUSCRIPTION ! +008000 10 WS-4DCO-DSOUSJ PIC X(002). ! +008100* JOUR DATE DE SOUSCRIPTION ! +008200 05 WS-4DCO-DEFFET. ! +008300* DATE D'EFFET CONTRAT ! +008400 10 WS-4DCO-DEFFETSA. ! +008500* SIECLE ANNEE DATE D'EFFET ! +008600 15 WS-4DCO-DEFFETS PIC X(002). ! +008700* SIECLE DATE D'EFFET ! +008800 15 WS-4DCO-DEFFETA PIC X(002). ! +008900* ANNEE DATE D'EFFET ! +009000 10 WS-4DCO-DEFFETM PIC X(002). ! +009100* MOIS DATE D'EFFET ! +009200 10 WS-4DCO-DEFFETJ PIC X(002). ! +009300* JOUR DATE D'EFFET ! +009400 05 WS-4DCO-DURCNT. ! +009500* DUREE DU CONTRAT ! +009600 10 WS-4DCO-AADUR PIC X(002). ! +009700* ANNEE DUREE DU CONTRAT ! +009800 10 WS-4DCO-MMDUR PIC X(002). ! +009900* MOIS DUREE DU CONTRAT ! +010000 05 WS-4DCO-DRTENT PIC S9(07)V9(02). ! +010100* MONTANT DES DROITS D'ENTREE ! +010200 05 WS-4DCO-DRTENT-C REDEFINES WS-4DCO-DRTENT ! +010300 PIC S9(09). ! +010400* MONTANT DES DROITS D'ENTREE ! +010500 05 WS-4DCO-BRUTINI PIC S9(09)V9(02). ! +010600* MONTANT BRUT V.I. ! +010700 05 WS-4DCO-BRUTINI-C REDEFINES WS-4DCO-BRUTINI ! +010800 PIC S9(11). ! +010900* MONTANT BRUT V.I. ! +011000 05 WS-4DCO-BRUTPER PIC S9(09)V9(02). ! +011100* MONTANT BRUT V.P. ! +011200 05 WS-4DCO-BRUTPER-C REDEFINES WS-4DCO-BRUTPER ! +011300 PIC S9(11). ! +011400* MONTANT BRUT V.P. ! +011500 05 WS-4DCO-TXFRINI PIC 9(02)V9(03). ! +011600* TAUX DE FRAIS V.I. ! +011700 05 WS-4DCO-TXFRINI-C REDEFINES WS-4DCO-TXFRINI ! +011800 PIC 9(05). ! +011900* TAUX DE FRAIS V.I. ! +012000 05 WS-4DCO-TXFRPER PIC 9(02)V9(03). ! +012100* TAUX DE FRAIS V.P. ! +012200 05 WS-4DCO-TXFRPER-C REDEFINES WS-4DCO-TXFRPER ! +012300 PIC 9(05). ! +012400* TAUX DE FRAIS V.P. ! +012500 05 WS-4DCO-MTFRINI PIC S9(09)V9(02). ! +012600* MONTANT FRAIS V.I. ! +012700 05 WS-4DCO-MTFRINI-C REDEFINES WS-4DCO-MTFRINI ! +012800 PIC S9(11). ! +012900* MONTANT FRAIS V.I. ! +013000 05 WS-4DCO-MTFRPER PIC S9(09)V9(02). ! +013100* MONTANT FRAIS V.P. ! +013200 05 WS-4DCO-MTFRPER-C REDEFINES WS-4DCO-MTFRPER ! +013300 PIC S9(11). ! +013400* MONTANT FRAIS V.P. ! +013500 05 WS-4DCO-NETINI PIC S9(09)V9(02). ! +013600* MONTANT NET V.I. ! +013700 05 WS-4DCO-NETINI-C REDEFINES WS-4DCO-NETINI ! +013800 PIC S9(11). ! +013900* MONTANT NET V.I. ! +014000 05 WS-4DCO-NETPER PIC S9(09)V9(02). ! +014100* MONTANT NET V.P. ! +014200 05 WS-4DCO-NETPER-C REDEFINES WS-4DCO-NETPER ! +014300 PIC S9(11). ! +014400* MONTANT NET V.P. ! +014500 05 WS-4DCO-DVERSINI. ! +014600* DATE EFFET VERSEMENT INITIAL ! +014700 10 WS-4DCO-DVINISA. ! +014800* SIECLE ANNEE DATE EFFET V.I. ! +014900 15 WS-4DCO-DVINIS PIC X(002). ! +015000* SIECLE DATE EFFET V.I. ! +015100 15 WS-4DCO-DVINIA PIC X(002). ! +015200* ANNEE DATE EFFET V.I. ! +015300 10 WS-4DCO-DVINIM PIC X(002). ! +015400* MOIS DATE EFFET V.I. ! +015500 10 WS-4DCO-DVINIJ PIC X(002). ! +015600* JOUR DATE EFFET V.I. ! +015700 05 WS-4DCO-DVERSPER. ! +015800* DATE EFFET VERSEMENT PERIODIQUE ! +015900 10 WS-4DCO-DVPERSA. ! +016000* SIECLE ANNEE DATE EFFET V.P. ! +016100 15 WS-4DCO-DVPERS PIC X(002). ! +016200* SIECLE DATE EFFET V.P. ! +016300 15 WS-4DCO-DVPERA PIC X(002). ! +016400* ANNEE DATE EFFET V.P. ! +016500 10 WS-4DCO-DVPERM PIC X(002). ! +016600* MOIS DATE EFFET V.P. ! +016700 10 WS-4DCO-DVPERJ PIC X(002). ! +016800* JOUR DATE EFFET V.P. ! +016900 05 WS-4DCO-TXMNGAR PIC 9(02)V9(03). ! +017000* TAUX MINIMUM GARANTI ! +017100 05 WS-4DCO-COM-PTN-SO PIC S9(07)V9(02). ! +017200* MONTANT COMMISSION DU PARTENAIRE ! +017300 05 WS-4DCO-COM-PTN-SO-C REDEFINES WS-4DCO-COM-PTN-SO ! +017400 PIC S9(09). ! +017500* MONTANT COMMISSION PARTENAIRE ! +017600 05 WS-4DCO-COM-GTN-SO PIC S9(07)V9(02). ! +017700* MONTANT COMMISSION SURAVENIR ! +017800 05 WS-4DCO-COM-GTN-SO-C REDEFINES WS-4DCO-COM-GTN-SO ! +017900 PIC S9(09). ! +018000* MONTANT COMMISSION SURAVENIR ! +018100 05 WS-4DCO-QPART PIC 9(03). ! +018200* QUOTE PART ! +018300 05 WS-4DCO-CUMULQPART PIC 9(03). ! +018400* CUMUL QUOTE PART ! +018500 05 WS-4DCO-AANAIB. ! +018600* DATE DE NAISSANCE BENEFICIAIRE ! +018700 10 WS-4DCO-DNAISSAB. ! +018800* SIECLE ANNEE DATE DE NAISSANCE BENEF ! +018900 15 WS-4DCO-DNAISSB PIC X(002). ! +019000* SIECLE DATE DE NAISSANCE BENEF ! +019100 15 WS-4DCO-DNAISAB PIC X(002). ! +019200* ANNEE DATE DE NAISSANCE BENEF ! +019300 10 WS-4DCO-DNAISMB PIC X(002). ! +019400* MOIS DATE DE NAISSANCE BENEF ! +019500 10 WS-4DCO-DNAISJB PIC X(002). ! +019600* JOUR DATE DE NAISSANCE BENEF ! +019700 05 WS-4DCO-RIB-INI. ! +019800* COMPTE INTER-BANCAIRE VERSEMENT INITIAL ! +019900 10 WS-4DCO-BNQRIB-I PIC X(005). ! +020000* BANQUE RIB COMPTE DOM V.I. ! +020100 10 WS-4DCO-GCHRIB-I PIC X(005). ! +020200* GUICHET RIB COMPTE DOM V.I. ! +020300 10 WS-4DCO-RACRIB-I PIC X(011). ! +020400* RACINE RIB COMPTE DOM V.I. ! +020500 10 WS-4DCO-CLERIB-I PIC X(002). ! +020600* CLE RIB COMPTE DOM V.I. ! +020700 05 WS-4DCO-RIB-PER. ! +020800* COMPTE INTER-BANCAIRE VERSEMENT PERIODIQUE ! +020900 10 WS-4DCO-BNQRIB-P PIC X(005). ! +021000* BANQUE RIB COMPTE DOM V.P. ! +021100 10 WS-4DCO-GCHRIB-P PIC X(005). ! +021200* GUICHET RIB COMPTE DOM V.P. ! +021300 10 WS-4DCO-RACRIB-P PIC X(011). ! +021400* RACINE RIB COMPTE DOM V.P. ! +021500 10 WS-4DCO-CLERIB-P PIC X(002). ! +021600* CLE RIB COMPTE DOM V.P. ! +021700 05 WS-4DCO-ETABLB PIC X(005). ! +021800* BANQUE RIB COMPTE DOM BENEF ! +021900 05 WS-4DCO-GUICHB PIC X(005). ! +022000* GUICHET RIB COMPTE DOM BENEF ! +022100 05 WS-4DCO-NOCPTB PIC X(011). ! +022200* RACINE RIB COMPTE DOM BENEF ! +022300 05 WS-4DCO-CLERIBB PIC X(002). ! +022400* CLE RIB COMPTE DOM BENEF ! +022500 05 WS-4DCO-SOLDINI PIC S9(13)V9(02). ! +022600* SOLDE COMPTE VERSEMENT INITIAL ! +022700 05 WS-4DCO-SOLDINI-C REDEFINES WS-4DCO-SOLDINI ! +022800 PIC S9(15). ! +022900* SOLDE COMPTE VERSEMENT INITIAL ! +023000 05 WS-4DCO-SOLDPER PIC S9(13)V9(02). ! +023100* SOLDE COMPTE VERSEMENT PERIODIQUE ! +023200 05 WS-4DCO-SOLDPER-C REDEFINES WS-4DCO-SOLDPER ! +023300 PIC S9(15). ! +023400* SOLDE COMPTE VERSEMENT PERIODIQUE ! +023500 05 WS-4DCO-DGARAN. ! +023600* DATE LIMITE GARANTIE TAUX ! +023700 10 WS-4DCO-DGARANSA. ! +023800* SIECLE ANNEE DATE LIMITE GARANTIE TAUX ! +023900 15 WS-4DCO-DGARANS PIC X(002). ! +024000* SIECLE DATE LIMITE GARANTIE TAUX ! +024100 15 WS-4DCO-DGARANA PIC X(002). ! +024200* ANNEE DATE LIMITE GARANTIE TAUX ! +024300 10 WS-4DCO-DGARANM PIC X(002). ! +024400* MOIS DATE LIMITE GARANTIE TAUX ! +024500 10 WS-4DCO-DGARANJ PIC X(002). ! +024600* JOUR DATE LIMITE GARANTIE TAUX ! +024700 05 WS-4DCO-VERS-PERIOD PIC X(001). ! +024800* INDICATEUR DE VERSEMENT PERIODIQUE ! +024900 05 WS-4DCO-TY-AJU-CTS PIC X(001). ! +025000* INDICATEUR AJUSTEMENT VERSEMENT ! +025100 05 WS-4DCO-DRG-FRS-GTN PIC X(001). ! +025200* INDICATEUR DE DEROGATION TAUX FRAIS ! +025300 05 WS-4DCO-DRG-DRT-ENT PIC X(001). ! +025400* INDICATEUR DE DEROGATION DROIT ENTREE ! +025500 05 WS-4DCO-SOUS-MINI PIC X(001). ! +025600* CODE SOUSCRIPTION MINITEL O/N ! +025700 05 WS-4DCO-REF-EXT-INTV PIC X(015). ! +025800* REFERENCES EXTERNES ! +025900 05 WS-4DCO-FICH-MINI-FERME PIC X(001). ! +026000* CODE FICHIERS MINITEL FERMES ! +026100 05 WS-4DCO-D1IRV. ! +026200* DATE 1ERE INSCRIPTION REGIME VIEILLESSE LOI MADELIN ! +026300 10 WS-4DCO-D1IRVSA. ! +026400* SIECLE ANNEE DATE 1ERE INSCRIPTION RG ! +026500 15 WS-4DCO-D1IRVS PIC X(002). ! +026600* SIECLE DATE 1ERE INSCRIPTION RG ! +026700 15 WS-4DCO-D1IRVA PIC X(002). ! +026800* ANNEE DATE 1ERE INSCRIPTION RG ! +026900 10 WS-4DCO-D1IRVM PIC X(002). ! +027000* MOIS DATE 1ERE INSCRIPTION RG ! +027100 10 WS-4DCO-D1IRVJ PIC X(002). ! +027200* JOUR DATE 1ERE INSCRIPTION RG ! +027300 05 WS-4DCO-MTMANN PIC S9(13)V9(02). ! +027400* MONTANT MINIMUM DE VERSEMENT ANNUEL LOI MADELIN ! +027500 05 WS-4DCO-MTMANN-C REDEFINES WS-4DCO-MTMANN ! +027600 PIC S9(15). ! +027700 05 WS-4DCO-MTMXANN PIC S9(13)V9(02). ! +027800* MONTANT MAXIMUM DE VERSEMENT ANNUEL LOI MADELIN ! +027900 05 WS-4DCO-MTMXANN-C REDEFINES WS-4DCO-MTMXANN ! +028000 PIC S9(15). ! +028100 05 WS-4DCO-DA-ARR-FIS. ! +028200* DATE D'ARRETE FISCAL (PREVI RETRAITE INDEPENDANTS) ! +028300 10 WS-4DCO-DA-ARR-FIS-MM PIC XX. ! +028400 10 WS-4DCO-DA-ARR-FIS-JJ PIC XX. ! +028500* TYPE D'ECHANGE FINANCIER POUR LES ENTREES (EIB,..) ! +028600 05 WS-4DCO-CD-TY-ECG-FNC PIC X(05). ! +028700 05 WS-4DCO-S-TOP-PREM-PREL PIC X(01). ! +028800 05 WS-4DCO-CD-TY-CLA PIC X(04). ! +028900* Code Type Clause ! +029000 05 WS-4DCO-IDC-MSG-BNF PIC X(01). ! +029100* Affichage d'un message warning selon type de clause ! +029200 05 WS-4DCO-LA-TY-CLA PIC X(20). ! +029300* Libell� Type Clause ! +029400 05 WS-4DCO-SOUS-CD-CDR-ADH PIC X(001). ! +029500* CODE CADRE ADHESION ! +029600 05 WS-4DCO-SOUS-IDC-PRD-PD PIC X(001). ! +029700* INDICATEUR TYPE DE PRODUIT ! +029800 05 WS-4DCO-SOUS-LA-CD-CDR-ADH PIC X(20). ! +029900* Libell� Type Clause ! +030000 05 WS-4DCO-SOUS-IDC-AFG-AGT-PA PIC X(001). ! +030100* INDICATEUR AFFICHAGE AGENT ! +030200 05 WS-4DCO-SOUS-IDC-AFG-PA PIC X(001). ! +030300* INDICATEUR AFFICHAGE REFERENCE PARTENAIRE ! +030400* -- VIE196 ADHESION MULTI INTERVENANT 12/05 CAPGEMINI ! +030500 05 WS-4DCO-SOUS-IDC-ADH-MI PIC X(001). ! +030600* INDICATEUR ADHESION MULTI INTERVENANTS ! +030700 05 FILLER PIC X(020). ! +030800* ZONES DISPONIBLES (CORRECTION 17/12/91) ! +030900* ! +031000 05 WS-4DCO-TRANSFERT-ENTREE. ! +031100* ZONES SPECIFIQUES TRANSFERT EN ENTREE ! +031200 10 WS-4DCO-DSOUS-PEP1. ! +031300* DATE SOUSCRIPTION 1ER PEP ! +031400 15 WS-4DCO-DSOUS-PEP1SA. ! +031500* SIECLE ANNEE DATE SOUSCRIPTION 1ER PEP ! +031600 20 WS-4DCO-DSOUS-PEP1S PIC X(002). ! +031700* SIECLE DATE SOUSCRIPTION 1ER PEP ! +031800 20 WS-4DCO-DSOUS-PEP1A PIC X(002). ! +031900* ANNEE DATE SOUSCRIPTION 1ER PEP ! +032000 15 WS-4DCO-DSOUS-PEP1M PIC X(002). ! +032100* MOIS DATE SOUSCRIPTION 1ER PEP ! +032200 15 WS-4DCO-DSOUS-PEP1J PIC X(002). ! +032300* JOUR DATE SOUSCRIPTION 1ER PEP ! +032400 10 WS-4DCO-BRUTGLO PIC S9(07)V9(02). ! +032500* MONTANT BRUT GLOBAL VERSMT DE TRANSFERT ! +032600 10 WS-4DCO-TAB-MTNETVER OCCURS 11. ! +032700* TABLEAU DES VERSEMENTS PAR ANNEE ! +032800 15 WS-4DCO-MTNETVER PIC S9(07)V9(02). ! +032900* MONTANT NET DES VERSEMENTS ! +033000 10 WS-4DCO-MTINCAP PIC S9(07)V9(02). ! +033100* MONTANT DES INTERETS CAPITALISES ! +033200 10 WS-4DCO-MTINCAP-C REDEFINES WS-4DCO-MTINCAP ! +033300 PIC S9(09). ! +033400* MONTANT DES INTERETS CAPITALISES ! +033500 10 WS-4DCO-TOP-TRF-CMB PIC X(01). ! +033600* TOP TRANSFERT PEP EN ENTREE CMB (O/N) ! +033700 10 WS-4DCO-ERREUR-BLOQUANTE PIC X(001). ! +033800* TOP ERREUR BLOQUANTE (O/N) ! +033900 10 WS-4DCO-DA-OPE-TRF PIC X(008). ! +034000* date op�ration transfert ! +034100 05 WS-4DCO-TFE-MT-VER-CTR PIC S9(15) COMP-3. ! +034200* transfert en entr�e - montant versement contrat ! +034300 05 WS-4DCO-SOUS-RETRO PIC X(001). ! +034400* INDICATEUR DE SOUSCRIPTION RETROACTIVE ! +034500 05 WS-4DCO-SCR-NANT PIC X(001). ! +034600* INDICATEUR NANTISSEMENT (AJOUT 17/12/91) ! +034700 05 WS-4DCO-LIB-IDT-CTR PIC X(016). ! +034800* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +034900 05 WS-4DCO-NO-IDT-CTR PIC X(015). ! +035000* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT ! +035100 05 WS-4DCO-AGENT PIC X(008). ! +035200* N� D'AGENT GESTIONNAIRE DU CONTRAT ! +035300 05 WS-4DCO-NO-STR-GTN PIC X(006). ! +035400* N� DE STRUCTURE GESTIONNAIRE DU CONTRAT ! +035500 05 WS-4DCO-NO-STR-OPE PIC X(006). ! +035600* N� DE STRUCTURE QUI A EFFECTUEE L'OPERATION ! +035700 05 WS-4DCO-NO-ADR PIC 9(002). ! +035800* N� D'ADRESSE DU CLIENT ! +035900 05 WS-4DCO-NB-ADR-CLI PIC 9(003). ! +036000* NB D'ADRESSE DU CLIENT ! +036100 05 WS-4DCO-DET-FRS-AP. ! +036200* DETAIL DES FRAIS APPLIQUES ! +036300 10 WS-4DCO-TX-FRS-CUM-AP PIC 9(5) COMP-3. ! +036400* TAUX FRAIS CUMUL ! +036500 10 WS-4DCO-MT-FRS-OPE-AP PIC S9(9) COMP-3. ! +036600* MONTANT FRAIS OPERATION ! +036700 10 WS-4DCO-TX-FRS-GTN-AP PIC 9(5) COMP-3. ! +036800* TAUX FRAIS GESTION ! +036900 10 WS-4DCO-TX-FRS-COM-AP PIC 9(5) COMP-3. ! +037000* TAUX FRAIS COMMISSION ! +037100 10 WS-4DCO-MT-FRS-GTN-OPE-AP PIC S9(9) COMP-3. ! +037200* MONTANT FRAIS GESTION OPERATION ! +037300 10 WS-4DCO-MT-FRS-COM-OPE-AP PIC S9(9) COMP-3. ! +037400* MONTANT FRAIS COMMISSION OPERAT ! +037500 10 WS-4DCO-MT-NET-OPE-AP PIC S9(15) COMP-3. ! +037600* MONTANT NET OPERATION ! +037700 05 WS-4DCO-DET-FRS-ST. ! +037800* DETAIL DES FRAIS STANDARDS ! +037900 10 WS-4DCO-TX-FRS-CUM-ST PIC 9(5) COMP-3. ! +038000* TAUX FRAIS CUMUL ! +038100 10 WS-4DCO-MT-FRS-OPE-ST PIC S9(9) COMP-3. ! +038200* MONTANT FRAIS OPERATION ! +038300 10 WS-4DCO-TX-FRS-GTN-ST PIC 9(5) COMP-3. ! +038400* TAUX FRAIS GESTION ! +038500 10 WS-4DCO-TX-FRS-COM-ST PIC 9(5) COMP-3. ! +038600* TAUX FRAIS COMMISSION ! +038700 10 WS-4DCO-MT-FRS-GTN-OPE-ST PIC S9(9) COMP-3. ! +038800* MONTANT FRAIS GESTION OPERATION ! +038900 10 WS-4DCO-MT-FRS-COM-OPE-ST PIC S9(9) COMP-3. ! +039000* MONTANT FRAIS COMMISSION OPERAT ! +039100 10 WS-4DCO-MT-NET-OPE-ST PIC S9(15) COMP-3. ! +039200* MONTANT NET OPERATION ! +039300 05 WS-4DCO-TX-DERO-VI PIC X(001). ! +039400* INDICATEUR DE TAUX DEROGATOIRE SUR VI ! +039500 05 WS-4DCO-TX-DERO-VP PIC X(001). ! +039600* INDICATEUR DE TAUX DEROGATOIRE SUR VP ! +039700 05 WS-4DCO-NO-GEN-PRD PIC 9(003). ! +039800* NUMERO DE GENERATION DU PRODUIT ! +039900 05 WS-4DCO-NO-GEN-TYP PIC 9(003). ! +040000* NUMERO DE GENERATION DU TYPE DE PRODUIT ! +040100 05 WS-4DCO-BEN-MINI OCCURS 4. ! +040200* BENEFICIAIRES MINITEL 4 MAXI ! +040300 10 WS-4DCO-BEN-MINI-INT PIC X(02). ! +040400* INTITULE BENEFICIAIRE ! +040500 10 WS-4DCO-BEN-MINI-NOM PIC X(32). ! +040600* NOM + PRENOM BENEFICIAIRE ! +040700 10 WS-4DCO-BEN-MINI-DNAI. ! +040800 15 WS-4DCO-BEN-MINI-DNAI-SA. ! +040900 20 WS-4DCO-BEN-MINI-DNAI-SS PIC X(02). ! +041000 20 WS-4DCO-BEN-MINI-DNAI-AA PIC X(02). ! +041100 15 WS-4DCO-BEN-MINI-DNAI-MM PIC X(02). ! +041200 15 WS-4DCO-BEN-MINI-DNAI-JJ PIC X(02). ! +041300* DATE DE NAISSANCE BENEFICIAIRE ! +041400 10 WS-4DCO-BEN-MINI-QUOTPAR PIC 9(03). ! +041500* QUOTE PART ! +041600 05 WS-4DCO-IDC-CLA-PROR PIC X(001). ! +041700* CODE CLAUSE PROROGATION CONTRAT ! +041800 05 WS-4DCO-TXFRINI-X PIC X(006). ! +041900* SAUVEGARGE ZONE ECRAN (TX FRAIS VERS INI) ! +042000 05 WS-4DCO-TXFRPER-X PIC X(006). ! +042100* SAUVEGARGE ZONE ECRAN (TX FRAIS VERS PER) ! +042200 05 WS-4DCO-DRTENT-X PIC X(010). ! +042300* SAUVEGARGE ZONE ECRAN (TX FRAIS VERS PER) ! +042400 05 WS-4DCO-S-IDC-ACCORD-TX PIC X(001). ! +042500* INDICATEUR D'ACCORD TAUX DEROG SURAVENIR ! +042600 05 WS-4DCO-IDC-DRG-TT PIC X(001). ! +042700* INDICATEUR D'ACCORD TAUX / TRANCHE ! +042800 05 WS-4DCO-IDC-AUT-SOC-FDL PIC X(001). ! +042900* INDICATEUR AUTORISATION PARRAINAGE CONTRAT ! +043000 05 WS-4DCO-S-CESSION. ! +043100* INFORMATIONS TRANSFERT APRES SINISTRE ! +043200 10 WS-4DCO-S-CES-TM-STP PIC X(026). ! +043300 10 WS-4DCO-S-CES-NO-DOS-SIN PIC S9(013) COMP-3. ! +043400 10 WS-4DCO-S-CES-NO-BNF-SIN PIC S9(007) COMP-3. ! +043500 10 WS-4DCO-S-CES-DA-OPE PIC X(008). ! +043600 10 WS-4DCO-S-CES-NO-ORD-RGL PIC S9(002) COMP-3. ! +043700 10 WS-4DCO-S-CES-NO-CSN PIC S9(003) COMP-3. ! +043800 10 WS-4DCO-S-CES-MT-CSN PIC S9(013)V9(2) ! +043900 COMP-3. ! +044000 05 WS-4DCO-TOP-OPE-ORIG-SOUS PIC X(03). ! +044100 88 SOUSCRIPTION VALUE 'SOU'. ! +044200 88 PRE-SOUSCRIPTION VALUE 'SPR'. ! +044300 88 VALID-PRE-SOUSC VALUE 'VPR'. ! +044400 88 ANNUL-PRE-SOUSC VALUE 'APR'. ! +044500 88 SOUSC-SUITE-TRF VALUE 'STR'. ! +044600 88 TRF-EN-ENTREE VALUE 'TFE'. ! +044700***SOL ! +044800 05 WS-4DCO-4DJJ-CD-CLI-PTN-EN PIC X(15). ! +044900* CODE EXTERNE CLIENT ENTREPRISE ! +045000 05 WS-4DCO-4DJJ-NOM-CLI-PTN-EN PIC X(32). ! +045100* NOM CLIENT ENTREPRISE ! +045200* ! +045300*** 05 FILLER PIC X(714). ! +045400*** 05 FILLER PIC X(667). ! +045500***SOL ! +045600***DME ! +045700 05 WS-4DCO-DUR-CTR PIC X(04). ! +045800* DUREE CONTRAT ! +045900 05 WS-4DCO-AGE-MIN-SC PIC 9(03). ! +046000* AGE MINIMUN DU SOUSCRIPTEUR ! +046100 05 WS-4DCO-CD-IDT-STK PIC X(03). ! +046200* CODE IDENTIFIANT STOCK ! +046300 05 WS-4DCO-TX-FRS-STD-ENT PIC S9(2)V9(3) COMP-3. ! +046400* CODE IDENTIFIANT STOCK ! +046500***DME ! +046600 05 WS-4DCO-IDC-CLA-DMB PIC X. ! +046700 88 CLA-DMB-OK VALUE '1'. ! +046800* ! +046900 05 WS-4DCO-TRF-ENTREE-SUITE. ! +047000* ZONES SPECIFIQUES TRANSFERT EN ENTREE SUITE ! +047100 10 WS-4DCO-DA-RGU. ! +047200* DATE REGULARISATION ! +047300 15 WS-4DCO-DA-RGU-A PIC X(4). ! +047400* DATE REGULARISATION ANNEE ! +047500 15 WS-4DCO-DA-RGU-M PIC X(2). ! +047600* DATE REGULARISATION MOIS ! +047700 15 WS-4DCO-DA-RGU-J PIC X(2). ! +047800* DATE REGULARISATION JOUR ! +047900 10 WS-4DCO-CD-TY-RGU PIC X(1). ! +048000* CODE TYPE REGULARISATION ! +048100 10 WS-4DCO-LIB-TY-RGU PIC X(32). ! +048200* LIBELLE TYPE REGULARISATION ! +048300 10 WS-4DCO-MT-TRF-RGU PIC S9(13)V99 COMP-3. ! +048400* MONTANT TRANSFERT ! +048500* ! +048600 10 WS-4DCO-MT-TOTTRF-RGU PIC S9(07)V9(02). ! +048700* MONTANT TRANSFERT TOTAL ! +048800* ! +048900 10 WS-4DCO-MT-TOTCUM-VER PIC S9(07)V9(02). ! +049000* MONTANT VERSEMENT CUMULE TOTAL ! +049100* ! +049200 05 WS-4DCO-NUMCE PIC X(15). ! +049300* NUMERO DU CE ! +049400* ! +049500 05 WS-4DCO-LIBCE PIC X(16). ! +049600* LIBELLE DU CE ! +049700* ! +049800 05 WS-4DCO-IDC-PRS-FIS-SPC PIC X(01). ! +049900* indicateur anticipation PERP ! +050000* ! +050100 05 FILLER PIC X(554). ! +050200* ZONES DISPONIBLES ! +050300* ------------------------------------------------------ * ! +050400 ! +050500 03 WS-4DCO-VERS REDEFINES WS-4DCO-PROGRAM. ! +050600* ================ ! +050700* ------------------------------------------------------ * ! +050800* COMMAREA : VERSEMENT * ! +050900* LONGUEUR : 1800 * ! +051000* PREFIXE : WS-4DCO- * ! +051100* ------------------------------------------------------ * ! +051200 ! +051300 05 FILLER PIC X(016). ! +051400* ZONES DISPONIBLES ! +051500 05 WS-4DCO-RIBV. ! +051600* NO COMPTE INTERBANCAIRE V.E. ! +051700 10 WS-4DCO-BNQDOMV PIC X(005). ! +051800* BANQUE RIB COMPTE V.E. ! +051900 10 WS-4DCO-GUIDOMV PIC X(005). ! +052000* GUICHET RIB V.E. ! +052100 10 WS-4DCO-RACDOMV. ! +052200* RACINE RIB V.E. ! +052300 15 WS-4DCO-RACD0V PIC X(001). ! +052400* ! +052500 15 WS-4DCO-RACD1V PIC X(007). ! +052600* ! +052700 15 WS-4DCO-RACD2V PIC X(001). ! +052800* ! +052900 15 WS-4DCO-RACD3V PIC X(002). ! +053000* ! +053100 10 WS-4DCO-CLEDOMV PIC X(002). ! +053200* CLE RIB V.E. ! +053300 05 WS-4DCO-CPTDOMV. ! +053400* NO COMPTE DOMICILIATION ! +053500 10 WS-4DCO-CAICMBV PIC X(004). ! +053600* ! +053700 10 WS-4DCO-RACCMBV PIC X(007). ! +053800* ! +053900 10 WS-4DCO-CLECMBV PIC X(001). ! +054000* ! +054100 10 WS-4DCO-TYPCMBV PIC X(002). ! +054200* ! +054300 05 WS-4DCO-NOMVR PIC X(032). ! +054400* NOM CLIENT ! +054500 05 WS-4DCO-DUREEVR PIC X(004). ! +054600* DUREE DU CONTRAT ! +054700 05 WS-4DCO-CTRATVR PIC X(006). ! +054800* NO CONTRAT ! +054900 05 WS-4DCO-DSOUV. ! +055000* DATE SOUSCRIPTION CONTRAT ! +055100 10 WS-4DCO-DSOUVSA. ! +055200* SIECLE ANNEE DATE SOUSCRIPTION ! +055300 15 WS-4DCO-DSOUVS PIC X(002). ! +055400* SIECLE DATE SOUSCRIPTION ! +055500 15 WS-4DCO-DSOUVA PIC X(002). ! +055600* ANNEE DATE SOUSCRIPTION ! +055700 10 WS-4DCO-DSOUVM PIC X(002). ! +055800* MOIS DATE SOUSCRIPTION ! +055900 10 WS-4DCO-DSOUVJ PIC X(002). ! +056000* JOUR DATE SOUSCRIPTION ! +056100 05 WS-4DCO-DECHE. ! +056200* DATE ECHEANCE CONTRAT ! +056300 10 WS-4DCO-DECHESA. ! +056400* SIECLE ANNEE DATE ECHEANCE ! +056500 15 WS-4DCO-DECHES PIC X(002). ! +056600* SIECLE DATE ECHEANCE ! +056700 15 WS-4DCO-DECHEA PIC X(002). ! +056800* ANNEE DATE ECHEANCE ! +056900 10 WS-4DCO-DECHEM PIC X(002). ! +057000* MOIS DATE ECHEANCE ! +057100 10 WS-4DCO-DECHEJ PIC X(002). ! +057200* JOUR DATE ECHEANCE ! +057300 05 WS-4DCO-DVERS. ! +057400* DATE OPERATION VERSEMENT ! +057500 10 WS-4DCO-DVERSSA. ! +057600* SIECLE ANNEE DATE OPERATION V.E. ! +057700 15 WS-4DCO-DVERSS PIC X(002). ! +057800* SIECLE DATE OPERATION V.E. ! +057900 15 WS-4DCO-DVERSA PIC X(002). ! +058000* ANNEE DATE OPERATION V.E. ! +058100 10 WS-4DCO-DVERSM PIC X(002). ! +058200* MOIS DATE OPERATION V.E. ! +058300 10 WS-4DCO-DVERSJ PIC X(002). ! +058400* JOUR DATE OPERATION V.E. ! +058500 05 WS-4DCO-DEFFETV. ! +058600* DATE EFFET VERSEMENT ! +058700 10 WS-4DCO-DEFVSA. ! +058800* SIECLE ANNEE DATE EFFET V.E. ! +058900 15 WS-4DCO-DEFVS PIC X(002). ! +059000* SIECLE DATE EFFET V.E. ! +059100 15 WS-4DCO-DEFVA PIC X(002). ! +059200* ANNEE DATE EFFET V.E. ! +059300 10 WS-4DCO-DEFVM PIC X(002). ! +059400* MOIS DATE EFFET V.E. ! +059500 10 WS-4DCO-DEFVJ PIC X(002). ! +059600* JOUR DATE EFFET V.E. ! +059700 05 WS-4DCO-DSOUV-EFF. ! +059800* DATE EFFET SOUCRIPTION CONTRAT ! +059900 10 WS-4DCO-DSOUVSA-EFF. ! +060000* SIECLE ANNEE DATE EFFET SOUSCRIPTION ! +060100 15 WS-4DCO-DSOUVS-EFF PIC X(002). ! +060200* SIECLE DATE EFFET SOUSCRIPTION ! +060300 15 WS-4DCO-DSOUVA-EFF PIC X(002). ! +060400* ANNEE DATE EFFET SOUSCRIPTION ! +060500 10 WS-4DCO-DSOUVM-EFF PIC X(002). ! +060600* MOIS DATE EFFET SOUSCRIPTION ! +060700 10 WS-4DCO-DSOUVJ-EFF PIC X(002). ! +060800* JOUR DATE EFFET SOUCRIPTION ! +060900 05 WS-4DCO-DSOUV-OR. ! +061000* DATE SOUSCRIPTION CONTRAT BQE ORIGINE ! +061100 10 WS-4DCO-DSOUVSA-OR. ! +061200* SIECLE ANNEE DATE SOUSCRIPTION ! +061300 15 WS-4DCO-DSOUVS-OR PIC X(002). ! +061400* SIECLE DATE SOUSCRIPTION ! +061500 15 WS-4DCO-DSOUVA-OR PIC X(002). ! +061600* ANNEE DATE SOUSCRIPTION ! +061700 10 WS-4DCO-DSOUVM-OR PIC X(002). ! +061800* MOIS DATE SOUSCRIPTION ! +061900 10 WS-4DCO-DSOUVJ-OR PIC X(002). ! +062000* JOUR DATE SOUSCRIPTION ! +062100 05 FILLER PIC X(008). ! +062200* ZONES DISPONIBLES ! +062300 05 WS-4DCO-FINVAL. ! +062400* DATE LIMITE GARANTIE CONTRAT ! +062500 10 WS-4DCO-JJVAL PIC X(002). ! +062600* JOUR DATE LIMITE GARANTIE CONTRAT ! +062700 10 WS-4DCO-MMVAL PIC X(002). ! +062800* MOIS DATE LIMITE GARANTIE CONTRAT ! +062900 10 WS-4DCO-ANVAL. ! +063000* SIECLE ANNEE DATE LIMITE GRANTIE CONTRAT ! +063100 15 WS-4DCO-SSVAL PIC X(002). ! +063200* SIECLE DATE LIMITE GARANTIE CONTRAT ! +063300 15 WS-4DCO-AAVAL PIC X(002). ! +063400* ANNEE DATE LIMITE GARANTIE CONTRAT ! +063500 05 WS-4DCO-FINVAL2. ! +063600* DATE LIMITE GARANTIE VERSEMENT ! +063700 10 WS-4DCO-JJVAL2 PIC X(002). ! +063800* JOUR DATE LIMITE GARANTIE VERSMT ! +063900 10 WS-4DCO-MMVAL2 PIC X(002). ! +064000* MOIS DATE LIMITE GARANTIE VERSMT ! +064100 10 WS-4DCO-ANVAL2. ! +064200* SIECLE ANNEE DATE LIMITE GARANTIE VERSMT ! +064300 15 WS-4DCO-SSVAL2 PIC X(002). ! +064400* SIECLE DATE LIMITE GARANTIE VERSMT ! +064500 15 WS-4DCO-AAVAL2 PIC X(002). ! +064600* ANNEE DATE LIMITE GARANTIE VERSMT ! +064700 05 WS-4DCO-STR-GERV PIC X(06). ! +064800* STRUCTURE GESTIONNAIRE DU CONTRAT ! +064900 05 WS-4DCO-TXMINGAR PIC S9(02)V9(03). ! +065000* TAUX MINIMUM GARANTI CONTRAT ! +065100 05 WS-4DCO-TXMINGAR2 PIC S9(02)V9(03). ! +065200* TAUX MINIMUM GARANTI VERSEMENT ! +065300 05 WS-4DCO-TXFRAIS PIC S9(02)V9(03). ! +065400* TAUX DE FRAIS DE GESTION ! +065500 05 WS-4DCO-TXFRAIS-C REDEFINES WS-4DCO-TXFRAIS ! +065600 PIC S9(05). ! +065700* TAUX DE FRAIS DE GESTION ! +065800 05 WS-4DCO-CUMVERS PIC S9(09)V9(02). ! +065900* SOLDE ! +066000 05 WS-4DCO-CUMVERS-C REDEFINES WS-4DCO-CUMVERS ! +066100 PIC S9(11). ! +066200* SOLDE ! +066300 05 WS-4DCO-MTBRUT PIC S9(09)V9(02). ! +066400* MONTANT BRUT VERSEMENT ! +066500 05 WS-4DCO-MTBRUT-C REDEFINES WS-4DCO-MTBRUT ! +066600 PIC S9(11). ! +066700* MONTANT BRUT VERSEMENT ! +066800 05 WS-4DCO-MTFRAIS PIC S9(09)V9(02). ! +066900* MONTANT FRAIS VERSEMENT ! +067000 05 WS-4DCO-MTFRAIS-C REDEFINES WS-4DCO-MTFRAIS ! +067100 PIC S9(11). ! +067200* MONTANT FRAIS VERSEMENT ! +067300 05 WS-4DCO-MTNET PIC S9(09)V9(02). ! +067400* MONTANT NET VERSEMENT ! +067500 05 WS-4DCO-MTNET-C REDEFINES WS-4DCO-MTNET ! +067600 PIC S9(11). ! +067700* MONTANT NET VERSEMENT ! +067800 05 WS-4DCO-COM-PTN-VE PIC S9(07)V9(02). ! +067900* MONTANT COMMISSION PARTENAIRE ! +068000 05 WS-4DCO-COM-PTN-VE-C REDEFINES WS-4DCO-COM-PTN-VE ! +068100 PIC S9(09). ! +068200* MONTANT COMMISSION PARTENAIRE ! +068300 05 WS-4DCO-MTPEPOPT PIC S9(07)V9(02). ! +068400* MONTANT PEP OPTIMISE ! +068500 05 WS-4DCO-MTPRIME PIC S9(07)V9(02). ! +068600* MONTANT PRIME ! +068700 05 WS-4DCO-MTDEDUC PIC S9(07)V9(02). ! +068800* MONTANT DEDUCTION FISCALE ! +068900 05 WS-4DCO-NETCTR PIC S9(09)V9(02). ! +069000* MONTANT NET CONTRAT ! +069100 05 WS-4DCO-NETCTR-C REDEFINES WS-4DCO-NETCTR ! +069200 PIC S9(11). ! +069300* MONTANT NET CONTRAT ! +069400 05 WS-4DCO-NETEX PIC S9(09)V9(02). ! +069500* MONTANT NET EXERCICE ! +069600 05 WS-4DCO-NETEX-C REDEFINES WS-4DCO-NETEX ! +069700 PIC S9(11). ! +069800* MONTANT NET EXERCICE ! +069900 05 WS-4DCO-VERS-CD-PROR-CTR PIC X(001). ! +070000* indicateur prorogation ! +070100 05 FILLER PIC X(012). ! +070200* ZONES DISPONIBLES ! +070300 05 WS-4DCO-COM-GTN PIC S9(07)V9(02). ! +070400* MONTANT COMMISSION GESTIONNAIRE ! +070500 05 WS-4DCO-COM-GTN-C REDEFINES WS-4DCO-COM-GTN ! +070600 PIC S9(09). ! +070700* MONTANT COMMISSION GESTIONNAIRE ! +070800 05 WS-4DCO-VE-RETRO PIC X(001). ! +070900* INDICATEUR VERSEMENT RETROACTIF ! +071000 05 WS-4DCO-DMP PIC X(003). ! +071100* DUREE MOYENNE PONDEREE AVANT VE ! +071200 05 WS-4DCO-MTBRUT-CTR PIC S9(15). ! +071300* MONTANT BRUT VERSEMENT CONTRAT ! +071400 05 WS-4DCO-MT-PND PIC S9(15). ! +071500* MONTANT PONDERE ! +071600 05 WS-4DCO-DA-DNR-ACT PIC X(008). ! +071700* DATE DERNIERE ACTUALISATION MT PND ! +071800 05 WS-4DCO-DET-FRS-AP-VE. ! +071900* DETAIL DES FRAIS APPLIQUES ! +072000 10 WS-4DCO-TX-FRS-CUM-AP-VE PIC 9(5) COMP-3. ! +072100* TAUX FRAIS CUMUL ! +072200 10 WS-4DCO-MT-FRS-OPE-AP-VE PIC S9(9) COMP-3. ! +072300* MONTANT FRAIS OPERATION ! +072400 10 WS-4DCO-TX-FRS-GTN-AP-VE PIC 9(5) COMP-3. ! +072500* TAUX FRAIS GESTION ! +072600 10 WS-4DCO-TX-FRS-COM-AP-VE PIC 9(5) COMP-3. ! +072700* TAUX FRAIS COMMISSION ! +072800 10 WS-4DCO-MT-FRS-GTN-OPE-AP-VE PIC S9(9) COMP-3. ! +072900* MONTANT FRAIS GESTION OPERATION ! +073000 10 WS-4DCO-MT-FRS-COM-OPE-AP-VE PIC S9(9) COMP-3. ! +073100* MONTANT FRAIS COMMISSION OPERAT ! +073200 10 WS-4DCO-MT-NET-OPE-AP-VE PIC S9(15) COMP-3. ! +073300* MONTANT NET OPERATION ! +073400 05 WS-4DCO-DET-FRS-ST-VE. ! +073500* DETAIL DES FRAIS STANDARDS ! +073600 10 WS-4DCO-TX-FRS-CUM-ST-VE PIC 9(5) COMP-3. ! +073700* TAUX FRAIS CUMUL ! +073800 10 WS-4DCO-MT-FRS-OPE-ST-VE PIC S9(9) COMP-3. ! +073900* MONTANT FRAIS OPERATION ! +074000 10 WS-4DCO-TX-FRS-GTN-ST-VE PIC 9(5) COMP-3. ! +074100* TAUX FRAIS GESTION ! +074200 10 WS-4DCO-TX-FRS-COM-ST-VE PIC 9(5) COMP-3. ! +074300* TAUX FRAIS COMMISSION ! +074400 10 WS-4DCO-MT-FRS-GTN-OPE-ST-VE PIC S9(9) COMP-3. ! +074500* MONTANT FRAIS GESTION OPERATION ! +074600 10 WS-4DCO-MT-FRS-COM-OPE-ST-VE PIC S9(9) COMP-3. ! +074700* MONTANT FRAIS COMMISSION OPERAT ! +074800 10 WS-4DCO-MT-NET-OPE-ST-VE PIC S9(15) COMP-3. ! +074900* MONTANT NET OPERATION ! +075000 05 WS-4DCO-TX-DERO-VE PIC X(001). ! +075100* INDICATEUR DE TAUX DEROGATOIRE SUR VE ! +075200 05 WS-4DCO-LIB-IDT-CTR-VE PIC X(016). ! +075300* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +075400 05 WS-4DCO-NO-IDT-CTR-VE PIC X(015). ! +075500* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT ! +075600 05 WS-4DCO-AGT-GTNV PIC X(008). ! +075700* NO. D'AGENT GESTIONNAIRE DU CONTRAT ! +075800 05 WS-4DCO-CLECROVR. ! +075900* CLE CRO SELECTIONNE ! +076000 10 FILLER PIC X(029). ! +076100* FILLER ! +076200 10 WS-4DCO-TYPCROVR PIC X(003). ! +076300* TYPE DE CRO SELECTIONNE ! +076400 10 FILLER PIC X(018). ! +076500* FILLER ! +076600 05 WS-4DCO-LIB-AVN-VE PIC X(014). ! +076700* LIBELLE AVANCE ! +076800 05 WS-4DCO-SLD-AVN-VE-X PIC X(014). ! +076900* ! +077000 05 WS-4DCO-SLD-AVN-VE PIC S9(15) COMP-3. ! +077100* ! +077200 05 WS-4DCO-SLD-AVN-VE-R REDEFINES WS-4DCO-SLD-AVN-VE ! +077300 PIC S9(13)V9(02) COMP-3. ! +077400* ! +077500 05 WS-4DCO-NOSAISIE-VE PIC X(001). ! +077600* INDICATEUR DE SAISIE INTERDITE ! +077700* ! +077800 05 WS-4DCO-DVEX-MINI. ! +077900* DATE DEMANDE DE VERSEMENT SUR MINITEL ! +078000 10 WS-4DCO-DVEXSA-MINI. ! +078100* SIECLE ANNEE DATE DEM. VERSEMENT ! +078200 15 WS-4DCO-DVEXS-MINI PIC X(002). ! +078300* SIECLE DATE DEM. VERSEMENT ! +078400 15 WS-4DCO-DVEXA-MINI PIC X(002). ! +078500* ANNEE DATE DEM. VERSEMENT ! +078600 10 WS-4DCO-DVEXM-MINI PIC X(002). ! +078700* MOIS DATE DEM. VERSEMENT ! +078800 10 WS-4DCO-DVEXJ-MINI PIC X(002). ! +078900* JOUR DATE DEM. VERSEMENT ! +079000* ! +079100 05 WS-4DCO-HVEX-MINI. ! +079200* HEURE DEMANDE DE VERSEMENT SUR MINITEL ! +079300 10 WS-4DCO-HVEXH-MINI PIC X(002). ! +079400* HEURES DEM. VERSEMENT ! +079500 10 WS-4DCO-HVEXM-MINI PIC X(002). ! +079600* MINUTES DEM. VERSEMENT ! +079700 10 WS-4DCO-HVEXS-MINI PIC X(002). ! +079800* SECONDES DEM. VERSEMENT ! +079900* ! +080000 05 WS-4DCO-MTBR-MINI PIC S9(15) COMP-3. ! +080100* MONTANT BRUT DU REVERSEMENT MINITEL ! +080200 05 WS-4DCO-MTBR-MINI-R REDEFINES WS-4DCO-MTBR-MINI ! +080300 PIC S9(13)V9(02) COMP-3. ! +080400* ! +080500 05 WS-4DCO-RVCH-MINI PIC X(001). ! +080600* CODE REVERSEMENT MINITEL O/N ! +080700* ! +080800 05 WS-4DCO-V-IDC-ACCORD-TX PIC X(001). ! +080900* INDICATEUR D'ACCORD TAUX DEROG SURAVENIR ! +081000* ! +081100 05 WS-4DCO-IDC-AUT-SOC-FDL-VE PIC X(001). ! +081200* INDICATEUR AUTORISATION PARRAINAGE CONTRAT ! +081300 05 WS-4DCO-VEX-CD-TY-ECG-FNC PIC X(05). ! +081400* TYPE D'ECHANGE FINANCIER POUR LES ENTREES (EIB,..) ! +081500 ! +081600 05 WS-4DCO-V-CESSION. ! +081700* INFORMATIONS TRANSFERT APRES SINISTRE ! +081800 10 WS-4DCO-V-CES-TM-STP PIC X(026). ! +081900 10 WS-4DCO-V-CES-NO-DOS-SIN PIC S9(013) COMP-3. ! +082000 10 WS-4DCO-V-CES-NO-BNF-SIN PIC S9(007) COMP-3. ! +082100 10 WS-4DCO-V-CES-DA-OPE PIC X(008). ! +082200 10 WS-4DCO-V-CES-NO-ORD-RGL PIC S9(002) COMP-3. ! +082300 10 WS-4DCO-V-CES-NO-CSN PIC S9(003) COMP-3. ! +082400 10 WS-4DCO-V-CES-MT-CSN PIC S9(013)V9(2) ! +082500 COMP-3. ! +082600 05 WS-4DCO-4DPZ-PR-NOM PIC X(032). ! +082700 05 WS-4DCO-4DPZ-DUREE PIC X(004). ! +082800 05 WS-4DCO-4DPZ-DA-OUV. ! +082900 10 WS-4DCO-4DPZ-DA-OUV-SA. ! +083000 15 WS-4DCO-4DPZ-DA-OUV-S PIC X(002). ! +083100 15 WS-4DCO-4DPZ-DA-OUV-A PIC X(002). ! +083200 10 WS-4DCO-4DPZ-DA-OUV-M PIC X(002). ! +083300 10 WS-4DCO-4DPZ-DA-OUV-J PIC X(002). ! +083400 05 WS-4DCO-4DPZ-DA-ECH. ! +083500 10 WS-4DCO-4DPZ-DA-ECH-SA. ! +083600 15 WS-4DCO-4DPZ-DA-ECH-S PIC X(002). ! +083700 15 WS-4DCO-4DPZ-DA-ECH-A PIC X(002). ! +083800 10 WS-4DCO-4DPZ-DA-ECH-M PIC X(002). ! +083900 10 WS-4DCO-4DPZ-DA-ECH-J PIC X(002). ! +084000 05 WS-4DCO-4DPZ-LIB-IDT-CTR PIC X(016). ! +084100 05 WS-4DCO-4DPZ-NO-IDT-CTR PIC X(016). ! +084200 05 WS-4DCO-4DPZ-LIB-AV-VE PIC X(014). ! +084300 05 WS-4DCO-4DPZ-SOLDE-AV-VE-X PIC X(014). ! +084400 05 WS-4DCO-4DPZ-SOLDE-AV-VE PIC S9(15) COMP-3. ! +084500 05 WS-4DCO-4DPZ-SOLDE-AV-VE-R ! +084600 REDEFINES WS-4DCO-4DPZ-SOLDE-AV-VE ! +084700 PIC S9(13)V9(02) COMP-3. ! +084800 05 WS-4DCO-DA-ECN-PROR-AN PIC X(008). ! +084900* DERNIERE DATE ECHEANCE PROROGEE ! +085000 05 WS-4DCO-VE-CD-IDT-STK PIC X(003). ! +085100* CODE IDENTIFIANT STOCK ! +085200 05 WS-4DCO-VE-TX-FRS-STD-ENT PIC S9(02)V9(03) COMP-3. ! +085300* TAUX FRAIS STANDARD ! +085400 05 WS-4DCO-DA-BSC-EF PIC X(008). ! +085500* DATE BASCULEMENT ! +085600 05 WS-4DCO-DA-OPE-DNR-RP PIC X(008). ! +085700* DATE DERNIER RACHAT ! +085800 05 WS-4DCO-DA-ECN-PROR-AA PIC X(008). ! +085900* DERNIERE DATE ECHEANCE PROROGEE ANCIENNE ! +086000 05 WS-4DCO-VERS-IDC-RFS-CDN-NV PIC X(1). ! +086100* CODE REFUS NOUVELLES CONDITIONS ! +086200 05 WS-4DCO-TOP-CTRL-VER-MIN PIC X(1). ! +086300* TOP CONTROLE VERSEMENT MINIMUM ! +086400 05 FILLER PIC X(991). ! +086500 ! +086600* ZONES DISPONIBLES ! +086700* ------------------------------------------------------ * ! +086800 ! +086900 03 WS-4DCO-VISUALISATION REDEFINES WS-4DCO-PROGRAM. ! +087000* ===================== ! +087100* ------------------------------------------------------ * ! +087200* COMMAREA : CONSULTATION * ! +087300* LONGUEUR : 1800 * ! +087400* PREFIXE : WS-4DCO- * ! +087500* ------------------------------------------------------ * ! +087600 ! +087700 05 WS-4DCO-NOMV PIC X(032). ! +087800* CLIENT ! +087900 05 WS-4DCO-GENPRDV PIC X(003). ! +088000* NO. DE GENERATION DU PRODUIT ! +088100 05 WS-4DCO-GENTYPV PIC X(003). ! +088200* NO. DE GENERATION DU TYPE DE PRODUIT ! +088300 05 WS-4DCO-NBENV PIC 9(02). ! +088400* NBRE BENEF ! +088500 05 WS-4DCO-NBENEV PIC 9(03). ! +088600* NO BENEF ENCOURS ! +088700 05 WS-4DCO-NENREGV PIC 9(02). ! +088800* NO ENREG BENEF ! +088900 05 WS-4DCO-TSMVTV PIC 9(01). ! +089000* TS ECRITE ! +089100 05 WS-4DCO-NBPAGV PIC 9(02). ! +089200* NBRE PAGE MVTS ! +089300 05 WS-4DCO-PAGENV PIC 9(02). ! +089400* NO PAGE MVTS ENCOURS ! +089500 05 WS-4DCO-CLECROV. ! +089600* CLE CRO SELECTIONNE ! +089700 10 FILLER PIC X(029). ! +089800* FILLER ! +089900 10 WS-4DCO-TYPCROV PIC X(003). ! +090000* TYPE DE CRO SELECTIONNE ! +090100 10 FILLER PIC X(018). ! +090200* FILLER ! +090300 05 WS-4DCO-CURSV PIC X(001). ! +090400* POSITION DU CURSEUR ! +090500 05 WS-4DCO-CUMVTV PIC 9(02). ! +090600* POSITION DU CURSEUR ! +090700 05 WS-4DCO-DEREXE PIC 9(02). ! +090800* EXERCICE DAMIER LU ! +090900 05 WS-4DCO-ART07V PIC X(001). ! +091000* PRESENCE ARTICLE 07 PERMANENT PEP ! +091100 05 WS-4DCO-CPT-DESTV. ! +091200* NUMERO DU COMPTE DESTINATAIRE ! +091300 10 WS-4DCO-BNQDESTV PIC X(005). ! +091400* BANQUE RIB COMPTE DESTINATAIRE ! +091500 10 WS-4DCO-GCHDESTV PIC X(005). ! +091600* GUICHET RIB COMPTE DESTINATAIRE ! +091700 10 WS-4DCO-RACDESTV PIC X(011). ! +091800* RACINE RIB COMPTE DESTINATAIRE ! +091900 10 WS-4DCO-CLEDESTV PIC X(002). ! +092000* CLE RIB COMPTE DESTINATAIRE ! +092100 05 WS-4DCO-NOM-ETAV PIC X(033). ! +092200* NOM DE L'ETABLISSEMENT ! +092300 05 WS-4DCO-NOM-AGCV PIC X(033). ! +092400* NOM DE L'AGENCE ! +092500 05 WS-4DCO-ADR-AGCV. ! +092600* ADRESSE DE L'AGENCE ! +092700 10 WS-4DCO-RUE-AGCV PIC X(033). ! +092800* RUE / ADRESSE DE L'AGENCE ! +092900 10 WS-4DCO-CODPOS-AGCV PIC X(005). ! +093000* CODE POSTAL / ADRESSE DE L'AGENCE ! +093100 10 WS-4DCO-COMMU-AGCV PIC X(027). ! +093200* COMMUNE / ADRESSE DE L'AGENCE ! +093300 05 WS-4DCO-VIS-DA-CLO. ! +093400* DATE DE CLOTURE (16/03/92) ! +093500 10 WS-4DCO-VIS-DA-CLO-SSAA. ! +093600* SIECLE ANNEE DATE DE CLOTURE (16/03/92) ! +093700 15 WS-4DCO-VIS-DA-CLO-SS PIC 9(002). ! +093800* SIECLE DATE DE CLOTURE (16/03/92) ! +093900 15 WS-4DCO-VIS-DA-CLO-AA PIC 9(002). ! +094000* ANNEE DATE DE CLOTURE (16/03/92) ! +094100 10 WS-4DCO-VIS-DA-CLO-MM PIC 9(02). ! +094200* MOIS DATE DE CLOTURE (16/03/92) ! +094300 10 WS-4DCO-VIS-DA-CLO-JJ PIC 9(02). ! +094400* JOUR DATE DE CLOTURE (16/03/92) ! +094500 05 WS-4DCO-VIS-CLE-CTR PIC X(020). ! +094600* CLE ART 10 PEP / ZOOM BENEF (31/07/92) ! +094700 05 FILLER REDEFINES WS-4DCO-VIS-CLE-CTR. ! +094800* CLE ART 10 PEP / ZOOM BENEF (31/07/92) ! +094900 10 FILLER PIC X(017). ! +095000* FILLER (31/07/92) ! +095100 10 WS-4DCO-VIS-NO-ORD-ENREG PIC 9(03). ! +095200* NO ORDRE ENREGISTREMENT (31/07/92) ! +095300 05 WS-4DCO-VIS-IND-TAB-BNF PIC 9(02). ! +095400* INDICE LIGNE ZOOMEE (31/07/92) ! +095500 05 WS-4DCO-VIS-NO-PAGE PIC 9(02). ! +095600* NUMERO DE PAGE ECRAN M4DHZ0 ! +095700 05 WS-4DCO-VIS-NB-PAGES PIC 9(02). ! +095800* NOMBRE DE PAGES ECRAN M4DHZ0 ! +095900 05 WS-4DCO-LIB-IDT-CTR-VI PIC X(016). ! +096000* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +096100 05 WS-4DCO-NO-IDT-CTR-VI PIC X(015). ! +096200* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT ! +096300 05 WS-4DCO-LIB-AVN-VI PIC X(014). ! +096400* LIBELLE AVANCE ! +096500 05 WS-4DCO-SLD-AVN-VI-X PIC X(014). ! +096600* ! +096700 05 WS-4DCO-SLD-AVN-VI PIC S9(15) COMP-3. ! +096800* ! +096900 05 WS-4DCO-SLD-AVN-VI-R REDEFINES WS-4DCO-SLD-AVN-VI ! +097000 PIC S9(13)V9(02) COMP-3. ! +097100 05 FILLER PIC X(50). ! +097200* ZONES DISPONIBLES ! +097300* CE FILLER A ETE RAJOUTE POUR NE PAS ECRASER LES VALEURS DE LA ! +097400* COMMAREA PAR LES NOUVELLES ZONES QUAND ON VIENT DE L ANNULATION ! +097500 05 WS-4DCO-DT-OPE. ! +097600* DATE DE L'OPERATION ! +097700 10 WS-4DCO-DT-OPE-SA PIC X(4). ! +097800* DATE DE L'OPERATION SSAA ! +097900 10 WS-4DCO-DT-OPE-MM PIC X(2). ! +098000* DATE DE L'OPERATION MOIS ! +098100 10 WS-4DCO-DT-OPE-JJ PIC X(2). ! +098200* DATE DE L'OPERATION JOUR ! +098300 05 WS-4DCO-MT-OPE PIC S9(9)V99 COMP-3. ! +098400* MONTANT DE L OPERATION ! +098500 05 WS-4DCO-NOM-INTIT PIC X(036). ! +098600* NOM PATRONIMIQUE ET INTITULE ! +098700* ! +098800 05 WS-4DCO-PER. ! +098900* commarea pour affichage des infos complementaires PER ! +099000* sur l'�cran d�tail : tc4djl0 ! +099100 10 WS-4DCO-PER-NO-STR PIC X(006). ! +099200* n�structure du contrat ! +099300 10 WS-4DCO-PER-NO-CTR PIC X(006). ! +099400* n�de contrat comptable ! +099500 10 WS-4DCO-PER-INFOS. ! +099600* infos r�cup�r�es par l'appel au module TN4DPER ! +099700 15 WS-4DCO-PER-TY-CPT-PER PIC X. ! +099800* type de per (mixte ..) ! +099900 15 WS-4DCO-PER-NOM-PRN-CJ PIC X(032). ! +100000* nom du conjoint ! +100100 15 WS-4DCO-PER-DA-NAIS PIC X(008). ! +100200* date de naissance du conjoint ! +100300 15 WS-4DCO-PER-DA-PRM-RTT PIC X(008). ! +100400* date de 1er retrait apr�s 60 ans ! +100500 15 WS-4DCO-PER-MT OCCURS 10. ! +100600* occurence des soldes comptables � garder ! +100700 20 WS-4DCO-PER-SLD-CPB-R PIC S9(15) COMP-3. ! +100800 20 WS-4DCO-PER-SLD-CPB REDEFINES WS-4DCO-PER-SLD-CPB-R ! +100900 PIC S9(13)V9(02) COMP-3. ! +101000*avt 05 FILLER ( -141 pour le per) PIC X(1339). ! +101100 05 WS-4DCO-4DHU. ! +101200* commarea pour affichage d�tail fiscalit� ! +101300* sur l'�cran : tc4dfo0 ! +101400 10 WS-4DCO-4DHU-CD-ACT PIC X(01). ! +101500* Code action ! +101600* V pour visualisation ! +101700* A pour annulation ! +101800 10 WS-4DCO-4DHU-CURSA PIC 9(02). ! +101900* POSITION DU CURSEUR ! +102000 10 WS-4DCO-4DHU-MT-PV PIC S9(13)V99 COMP-3. ! +102100* montant plus value ! +102200 10 WS-4DCO-4DHU-MT-PV-F8 PIC S9(13)V99 COMP-3. ! +102300* montant plus value loi finance 98 ! +102400 10 WS-4DCO-4DHU-MT-PLV-LBL PIC S9(13)V99 COMP-3. ! +102500* montant pr�l�vement lib�ratoire ! +102600 10 WS-4DCO-4DHU-MT-PLV-SOC PIC S9(13)V99 COMP-3. ! +102700* montant pr�l�vement social ! +102800 10 WS-4DCO-4DHU-MT-PLV-CSG PIC S9(13)V99 COMP-3. ! +102900* montant pr�l�vement CSG ! +103000 10 WS-4DCO-4DHU-MT-CTB-DPT PIC S9(13)V99 COMP-3. ! +103100* montant contribution d�partementale ! +103200 10 WS-4DCO-4DHU-MT-VER-RDS PIC S9(13)V99 COMP-3. ! +103300* montant pr�l�vement CRDS ! +103400 10 WS-4DCO-4DHU-MT-ASST-CRDS PIC S9(13)V99 COMP-3. ! +103500* Assiette CRDS ! +103600 10 WS-4DCO-4DHU-MT-ASST-CSG PIC S9(13)V99 COMP-3. ! +103700* Assiette CSG ! +103800 10 WS-4DCO-4DHU-MT-ASST-SOC PIC S9(13)V99 COMP-3. ! +103900* Assiette SOC ! +104000 10 WS-4DCO-4DHU-TX-PLV-LBL PIC S9(02)V999 COMP-3. ! +104100* Assiette SOC ! +104200 10 WS-4DCO-4DHU-MT-CTS-VLL PIC S9(13)V99 COMP-3. ! +104300* montant cotisation vieillesse ! +104400 10 WS-4DCO-4DHU-DA-OPE-RACH PIC X(008). ! +104500* date op�ration de rachat ! +104600 10 WS-4DCO-4DHU-DA-EFF-RACH PIC X(008). ! +104700* date effet du rachat ! +104800 10 WS-4DCO-4DHU-MT-ASST-CTB PIC S9(13)V99 COMP-3. ! +104900* montant assiette contribution ! +105000 10 WS-4DCO-4DHU-MT-CTB PIC S9(13)V99 COMP-3. ! +105100* montant contribution ! +105200 05 FILLER PIC X(1072). ! +105300* ZONES DISPONIBLES ! +105400* ------------------------------------------------------ * ! +105500 ! +105600 03 WS-4DCO-ANOMALIES REDEFINES WS-4DCO-PROGRAM. ! +105700* ================= ! +105800* ------------------------------------------------------ * ! +105900* COMMAREA : CONSULTATION DES ANOMALIES * ! +106000* LONGUEUR : 1800 * ! +106100* PREFIXE : WS-4DCO-ANO- * ! +106200* ------------------------------------------------------ * ! +106300 ! +106400 05 WS-4DCO-ANO-STRUCT PIC X(006). ! +106500* NUMERO DE STRUCTURE ! +106600 05 WS-4DCO-ANO-DATE-DEB. ! +106700* DATE DE DEBUT ! +106800 10 WS-4DCO-ANO-ANDEB PIC X(004). ! +106900* SIECLE ANNEE DATE DE DEBUT ! +107000 10 WS-4DCO-ANO-MMDEB PIC X(002). ! +107100* MOIS DATE DE DEBUT ! +107200 10 WS-4DCO-ANO-JJDEB PIC X(002). ! +107300* JOUR DATE DE DEBUT ! +107400 05 WS-4DCO-ANO-DATE-FIN. ! +107500* DATE DE FIN ! +107600 10 WS-4DCO-ANO-ANFIN PIC X(004). ! +107700* SIECLE ANNEE DATE DE FIN ! +107800 10 WS-4DCO-ANO-MMFIN PIC X(002). ! +107900* MOIS DATE DE FIN ! +108000 10 WS-4DCO-ANO-JJFIN PIC X(002). ! +108100* JOUR DATE DE FIN ! +108200 05 WS-4DCO-ANO-OKVALID PIC X(001). ! +108300* INDICATEUR DE SAISIE ! +108400 05 WS-4DCO-ANO-PAGENV PIC S9(03). ! +108500* NUMERO DE PAGE ! +108600 05 WS-4DCO-ANO-NBPAGE PIC S9(03). ! +108700* NOMBRE DE PAGES ! +108800 05 WS-4DCO-ANO-CUM PIC S9(04). ! +108900* ! +109000 05 WS-4DCO-ANO-TSMVT PIC S9(04). ! +109100* ! +109200 05 WS-4DCO-ANO-CLE-ABEND PIC X(020). ! +109300* ! +109400 05 FILLER PIC X(1743). ! +109500* ZONES DISPONIBLES ! +109600* ------------------------------------------------------ * ! +109700 ! +109800 03 WS-4DCO-ANNU REDEFINES WS-4DCO-PROGRAM. ! +109900* ============ ! +110000* ------------------------------------------------------ * ! +110100* COMMAREA : ANNULATION * ! +110200* LONGUEUR : 1800 * ! +110300* PREFIXE : WS-4DCO- * ! +110400* ------------------------------------------------------ * ! +110500 ! +110600 05 WS-4DCO-TSMVTA PIC 9(01). ! +110700* TS ECRITE ! +110800 05 WS-4DCO-NBPAGA PIC 9(02). ! +110900* NBRE PAGE MVTS ! +111000 05 WS-4DCO-PAGENA PIC 9(02). ! +111100* NO PAGE MVTS ENCOURS ! +111200 05 WS-4DCO-CLECROA PIC X(040). ! +111300* CLE CRO SELECTIONNE ! +111400 05 WS-4DCO-CTRATA PIC X(006). ! +111500* CONTRAT ! +111600 05 WS-4DCO-NOMA PIC X(032). ! +111700* NOM ! +111800 05 WS-4DCO-CURSA PIC 9(02). ! +111900* POSITION DU CURSEUR ! +112000 05 FILLER PIC X(201). ! +112100* ZONES DISPONIBLES (CORRECTION 17/12/91) ! +112200 05 WS-4DCO-CPT-DOM-AN. ! +112300* COMPTE DOM ANNULATION ! +112400 10 WS-4DCO-BNQ-AN PIC X(005). ! +112500* BANQUE RIB CPTE DOM ANNULATION ! +112600 10 WS-4DCO-GUI-AN PIC X(005). ! +112700* GUICHET RIB COMPTE DOM ANNULATION ! +112800 10 WS-4DCO-CPT-AN PIC X(011). ! +112900* RACINE RIB COMPTE DOM ANNULATION ! +113000 10 WS-4DCO-CLE-AN PIC X(002). ! +113100* CLE RIB COMPTE DOM ANNULATION ! +113200 05 WS-4DCO-CLECROA-ZOOM PIC X(040). ! +113300* CLE CRO SELECTIONNE PAR LE ZOOM ! +113400 05 WS-4DCO-IDENT-CRO-ZOOM. ! +113500* IDENTIFICATION CRO ZOOM ! +113600 10 WS-4DCO-DAT-CRO-ZOOM PIC X(008). ! +113700* DATE CREATION CRO ZOOM ! +113800 10 WS-4DCO-HEU-CRO-ZOOM PIC X(006). ! +113900* HEURE CREATION CRO ZOOM ! +114000 10 WS-4DCO-TYP-CRO-ZOOM PIC X(003). ! +114100* TYPE CRO ZOOM ! +114200 05 WS-4DCO-ANN-DA-PAS-DNR-PAB PIC X(08). ! +114300* DATE DE PASSAGE DERNIER PAB ! +114400 05 WS-4DCO-ANN-TOP-MES-FONDS PIC X(01). ! +114500* TOP MESSAGE 'AVEZ-VOUS RECUPERE LES FONDS?' ! +114600 05 WS-4DCO-ANN-IDC-RAC-PART PIC X(01). ! +114700* INDICATEUR PRESENCE RACHAT PARTIEL ! +114800 05 WS-4DCO-NB-CRO-340 PIC 9(02). ! +114900* NOMBRE DE CRO SINISTRE AFFICHES A L ECRAN ! +115000 05 WS-4DCO-IDC-VAL-RIB PIC X(01). ! +115100* INDICATEUR DE VALIDITE DU COMPTE DOM ! +115200 05 WS-4DCO-NO-PTN-TR PIC 9(3). ! +115300* NUMERO PARTENAIRE EMMETTEUR TRANSFERT ! +115400 05 WS-4DCO-NO-PRD-PTN-TR PIC 9(3). ! +115500* NUMERO PRODUIT EMMETTEUR TRANSFERT ! +115600 05 WS-4DCO-NO-CLI-PTN-TR PIC 9(7). ! +115700* NUMERO CLIENT EMMETTEUR TRANSFERT ! +115800 05 WS-4DCO-NO-ORD-CTR-TR PIC 9(2). ! +115900* NUMERO ORDRE DU CONTRAT EMMETTEUR TRANSFERT ! +116000 05 WS-4DCO-TOP-TRF-PTN PIC X(1). ! +116100* INDICATEUR PRESENCE TRANSFERT PARTENAIRE ! +116200 05 WS-4DCO-DATE-TRF-PTN PIC 9(8). ! +116300 05 WS-4DCO-HEU-TRF-PTN PIC 9(6). ! +116400* HEURE DU TRANSFERT DE PARTENAIRE ! +116500 05 WS-4DCO-ANN-DA-OPE-DNR-RP PIC X(08). ! +116600* DATE OPERATION DERNIER RACHAT PARTIEL ! +116700 05 WS-4DCO-IDC-MVT-PUC-NON-ANNUL PIC X(01). ! +116800* INDICATEUR MVT PUC NON ANNULER ! +116900 05 WS-4DCO-CD-MSG PIC X(75). ! +117000* CODE MESSAGE ! +117100 05 WS-4DCO-IDC-PRES-CRO-JOUR PIC X(01). ! +117200* INDICATEUR PRESENCE CRO JOUR ! +117300 ! +117400 05 FILLER PIC X(1306). ! +117500* ZONES DISPONIBLES ! +117600* ------------------------------------------------------ * ! +117700 ! +117800 03 WS-4DCO-TRANS-CAIS REDEFINES WS-4DCO-PROGRAM. ! +117900* ================== ! +118000* ------------------------------------------------------ * ! +118100* COMMAREA : TRANSFERT DE STRUCTURE A STRUCTURE * ! +118200* LONGUEUR : 1800 * ! +118300* PREFIXE : WS-4DCO- * ! +118400* ------------------------------------------------------ * ! +118500 ! +118600 05 WS-4DCO-NO-STR-TRANS PIC X(006). ! +118700* NO STRUCTURE TRANSFEREE ! +118800 05 WS-4DCO-NO-AGT-TRANS PIC X(008). ! +118900* NO AGENT TRANSFERE ! +119000 05 WS-4DCO-CLIENT-TRANS PIC X(008). ! +119100* NO-CLIENT-TRANSFERE ! +119200 05 WS-4DCO-COMPTE-TRANS REDEFINES WS-4DCO-CLIENT-TRANS. ! +119300* NO COMPTE TRANSFERE ! +119400 10 WS-4DCO-RAC-TRANS PIC X(007). ! +119500* RACINE TRANSFEREE ! +119600 10 WS-4DCO-CLE-TRANS PIC X(001). ! +119700* CLE TRANSFEREE ! +119800 05 WS-4DCO-MT-TRF PIC S9(11) COMP-3. ! +119900* MONTANT DU TRANSFERT ! +120000 05 WS-4DCO-CPT-DOM-AV. ! +120100* RIB CPTE DOM AVANT TRANSFERT ! +120200 10 WS-4DCO-BNQ-DOM-AV PIC X(005). ! +120300* BANQUE RIB CPTE DOM AVANT TRANSFERT ! +120400 10 WS-4DCO-GCH-DOM-AV PIC X(005). ! +120500* GUICHET RIB CPTE DOM AVANT TRANSFERT ! +120600 10 WS-4DCO-RAC-DOM-AV PIC X(011). ! +120700* RACINE RIB CPTE DOM AVANT TRANSFERT ! +120800 10 WS-4DCO-CLE-DOM-AV PIC X(002). ! +120900* CLE RIB COMPTE DOM AVANT TRANSFERT ! +121000 05 WS-4DCO-CPT-DOM-AP. ! +121100* RIB CPTE DOM APRES TRANSFERT ! +121200 10 WS-4DCO-BNQ-DOM-AP PIC X(005). ! +121300* BANQUE RIB COMPTE DOM APRES TRANSFERT ! +121400 10 WS-4DCO-GCH-DOM-AP PIC X(005). ! +121500* GUICHET RIB COMPTE DOM APRES TRANSFERT ! +121600 10 WS-4DCO-RAC-DOM-AP PIC X(011). ! +121700* RACINE RIB COMPTE DOM APRES TRANSFERT ! +121800 10 WS-4DCO-CLE-DOM-AP PIC X(002). ! +121900* CLE RIB COMPTE DOM APRES TRANSFERT ! +122000 05 WS-4DCO-TITRE-ECRAN PIC X(032). ! +122100* LIBELLE TITRE ECRAN M4DHI0 ! +122200 05 WS-4DCO-TRFS-AUT-P PIC X(001). ! +122300* TOP AUTORISATION VERSEMENT PERIODIQUE ! +122400 05 WS-4DCO-4DHI-IDC-BLOC PIC X(001). ! +122500* TOP BLOCAGE TRFT caisse (CONTRAT PROROGEABLE) ! +122600 05 WS-4DCO-4DHI-DA-ECN-PROR PIC X(008). ! +122700* DATE ECHEANCE PROROGEE ! +122800 05 FILLER PIC X(1684). ! +122900* ZONES DISPONIBLES ! +123000* ------------------------------------------------------ * ! +123100 ! +123200 03 WS-4DCO-TRFRAC REDEFINES WS-4DCO-PROGRAM. ! +123300* ================== ! +123400* ------------------------------------------------------ * ! +123500* COMMAREA : TRANSFERT DE RACINE * ! +123600* LONGUEUR : 1800 * ! +123700* PREFIXE : WS-4DCO- * ! +123800* ------------------------------------------------------ * ! +123900 ! +124000 05 WS-4DCO-4DHJ-CLIENT PIC X(015). ! +124100* NOUVEAU N� DE CLIENT (EXTERNE) ! +124200 05 WS-4DCO-4DHJ-NO-CLI-PTN PIC 9(007). ! +124300* NOUVEAU N� DE CLIENT (INTERNE) ! +124400 05 WS-4DCO-4DHJ-NO-ORD-CTR PIC 9(002). ! +124500* NOUVEAU N� D'ORDRE DU CONTRAT ! +124600 05 WS-4DCO-4DHJ-CINT PIC X(002). ! +124700* CODE INTITULE ! +124800 05 WS-4DCO-4DHJ-NOM PIC X(032). ! +124900* NOM ! +125000 05 WS-4DCO-4DHJ-RUE1 PIC X(032). ! +125100* LIGNE ADRESSE 1 ! +125200 05 WS-4DCO-4DHJ-RUE2 PIC X(032). ! +125300* LIGNE ADRESSE 2 ! +125400 05 WS-4DCO-4DHJ-CODPOS PIC X(005). ! +125500* CODE POSTAL ! +125600 05 WS-4DCO-4DHJ-BUR-DIS PIC X(026). ! +125700* BUREAU DISTRIBUTEUR ! +125800 05 WS-4DCO-4DHJ-CPT-DOM-AV. ! +125900* RIB CPTE DOM AVANT TRANSFERT ! +126000 10 WS-4DCO-4DHJ-BNQ-DOM-AV PIC X(005). ! +126100* BANQUE RIB CPTE DOM AVANT TRANSFERT ! +126200 10 WS-4DCO-4DHJ-GCH-DOM-AV PIC X(005). ! +126300* GUICHET RIB CPTE DOM AVANT TRANSFERT ! +126400 10 WS-4DCO-4DHJ-RAC-DOM-AV PIC X(011). ! +126500* RACINE RIB CPTE DOM AVANT TRANSFERT ! +126600 10 WS-4DCO-4DHJ-CLE-DOM-AV PIC X(002). ! +126700* CLE RIB COMPTE DOM AVANT TRANSFERT ! +126800 05 WS-4DCO-4DHJ-CPT-DOM-AP. ! +126900* RIB CPTE DOM APRES TRANSFERT ! +127000 10 WS-4DCO-4DHJ-BNQ-DOM-AP PIC X(005). ! +127100* BANQUE RIB CPTE DOM APRES TRANSFERT ! +127200 10 WS-4DCO-4DHJ-GCH-DOM-AP PIC X(005). ! +127300* GUICHET RIB CPTE DOM APRES TRANSFERT ! +127400 10 WS-4DCO-4DHJ-RAC-DOM-AP PIC X(011). ! +127500* RACINE RIB CPTE DOM APRES TRANSFERT ! +127600 10 WS-4DCO-4DHJ-CLE-DOM-AP PIC X(002). ! +127700* CLE RIB COMPTE DOM APRES TRANSFERT ! +127800 05 WS-4DCO-4DHJ-LIB-TITRE PIC X(032). ! +127900* LIBELLE TITRE ECRAN M4DHI0 ! +128000 05 WS-4DCO-4DHJ-VP-OK PIC X(001). ! +128100* TOP AUTORISATION VERSEMENT PERIODIQUE ! +128200 05 WS-4DCO-4DHJ-AV-OK PIC X(001). ! +128300* TOP AUTORISATION AVANCE ! +128400 05 WS-4DCO-4DHJ-CD-VER-PER PIC X(001). ! +128500* CODE PERIODICITE ! +128600 05 WS-4DCO-4DHJ-LIB-CTR PIC X(013). ! +128700* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +128800 05 WS-4DCO-4DHJ-IDT-CTR PIC X(015). ! +128900* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT ! +129000 05 WS-4DCO-4DHJ-IDT-NV-CTR PIC X(015). ! +129100* MASQUE D'AFFICHAGE DE L'IDENTIFIANT NOUVEAU CONTRAT ! +129200 05 WS-4DCO-4DHJ-DA-NAI. ! +129300* DATE DE NAISSANCE ! +129400 10 WS-4DCO-4DHJ-DA-NAI-SA. ! +129500* SIECLE ANNEE DATE NAISSANCE ! +129600 15 WS-4DCO-4DHJ-DA-NAI-SS PIC X(002). ! +129700* SIECLE DATE NAISSANCE ! +129800 15 WS-4DCO-4DHJ-DA-NAI-AA PIC X(002). ! +129900* ANNEE DATE NAISSANCE ! +130000 10 WS-4DCO-4DHJ-DA-NAI-MM PIC X(002). ! +130100* MOIS DATE NAISSANCE ! +130200 10 WS-4DCO-4DHJ-DA-NAI-JJ PIC X(002). ! +130300* JOUR DATE NAISSANCE ! +130400 05 WS-4DCO-4DHJ-SLD-TP PIC S9(15) COMP-3. ! +130500* SOLDE TP TEMPS REEL ! +130600 05 WS-4DCO-4DHJ-NO-POL PIC X(009). ! +130700* NUMERO DE POLICE (PARTENAIRE EXTERIEUR) ! +130800 05 WS-4DCO-4DHJ-LIB-POL PIC X(011). ! +130900* LIBELLE "NO POLICE -->" ! +131000 05 WS-4DCO-4DHJ-NO-GEN-PRD PIC X(003). ! +131100* N� DE GENERATION DU PRODUIT ! +131200 05 WS-4DCO-4DHJ-NO-GEN-TY-PRD PIC X(003). ! +131300* N� DE GENERATION DU TYPE DE PRODUIT ! +131400 05 WS-4DCO-4DHJ-MOD-POL PIC X(001). ! +131500* SI = 'O' ==> SEUL LE N� DE POLICE A ETE MODIFIE ! +131600 05 WS-4DCO-4DHJ-IDC-BLOC PIC X(001). ! +131700* TOP BLOCAGE TRFT RACINE (CONTRAT PROROGEABLE) ! +131800 05 FILLER PIC X(1479). ! +131900* ZONES DISPONIBLES ! +132000* ------------------------------------------------------ * ! +132100 ! +132200 03 WS-4DCO-RENON REDEFINES WS-4DCO-PROGRAM. ! +132300* ============= ! +132400* ------------------------------------------------------ * ! +132500* COMMAREA : RENONCIATION * ! +132600* LONGUEUR : 1800 * ! +132700* PREFIXE : WS-4DCO- * ! +132800* ------------------------------------------------------ * ! +132900 ! +133000 05 WS-4DCO-RIBR. ! +133100* RIB CPTE DOM RENONCIATION ! +133200 10 WS-4DCO-BANDR PIC X(005). ! +133300* BANQUE RIB CPTE DOM RENONCIATION ! +133400 10 WS-4DCO-GUIDR PIC X(005). ! +133500* GUICHET RIB CPTE DOM RENONCIATION ! +133600 10 WS-4DCO-RACDR. ! +133700* RACINE RIB CPTE DOM RENONCIATION ! +133800 15 WS-4DCO-RACD0R PIC X(001). ! +133900* ! +134000 15 WS-4DCO-RACD1R PIC X(007). ! +134100* ! +134200 15 WS-4DCO-RACD2R PIC X(001). ! +134300* ! +134400 15 WS-4DCO-RACD3R PIC X(002). ! +134500* ! +134600 10 WS-4DCO-CLEDR PIC X(002). ! +134700* CLE RIB CPTE DOM RENONCIATION ! +134800 05 WS-4DCO-CPTDOMR. ! +134900* CPTE DOM RENONCIATION ! +135000 10 WS-4DCO-CAICMBR PIC X(004). ! +135100* CAISSE CPTE DOM RENONCIATION ! +135200 10 WS-4DCO-RACCMBR PIC X(007). ! +135300* RACINE CPTE DOM RENONCIATION ! +135400 10 WS-4DCO-CLECMBR PIC X(001). ! +135500* CLE CPTE DOM RENONCIATION ! +135600 10 WS-4DCO-TYPCMBR PIC X(002). ! +135700* TYPE CPTE DOM RENONCIATION ! +135800 05 WS-4DCO-DSOUSR. ! +135900* DATE SOUSCRIPTION ! +136000 10 WS-4DCO-DSOUSRSA. ! +136100* SIECLE ANNEE DATE SOUSCRIPTION ! +136200 15 WS-4DCO-DSOUSRS PIC X(002). ! +136300* SIECLE DATE SOUSCRIPTION ! +136400 15 WS-4DCO-DSOUSRA PIC X(002). ! +136500* ANNEE DATE SOUSCRIPTION ! +136600 10 WS-4DCO-DSOUSRM PIC X(002). ! +136700* MOIS DATE SOUSCRIPTION ! +136800 10 WS-4DCO-DSOUSRJ PIC X(002). ! +136900* JOUR DATE SOUSCRIPTION ! +137000 05 WS-4DCO-DECHER. ! +137100* DATE ECHEANCE ! +137200 10 WS-4DCO-DECHERSA. ! +137300* SIECLE ANNEE DATE ECHEANCE ! +137400 15 WS-4DCO-DECHERS PIC X(002). ! +137500* SIECLE DATE ECHEANCE ! +137600 15 WS-4DCO-DECHERA PIC X(002). ! +137700* ANNEE DATE ECHEANCE ! +137800 10 WS-4DCO-DECHERM PIC X(002). ! +137900* MOIS DATE ECHEANCE ! +138000 10 WS-4DCO-DECHERJ PIC X(002). ! +138100* JOUR DATE ECHEANCE ! +138200 05 WS-4DCO-DOPE. ! +138300* DATE VERSEMENT ! +138400 10 WS-4DCO-DOPESA. ! +138500* SIECLE ANNEE DATE VERSEMENT ! +138600 15 WS-4DCO-DOPES PIC X(002). ! +138700* SIECLE DATE VERSEMENT ! +138800 15 WS-4DCO-DOPEA PIC X(002). ! +138900* ANNEE DATE VERSEMENT ! +139000 10 WS-4DCO-DOPEM PIC X(002). ! +139100* MOIS DATE VERSEMENT ! +139200 10 WS-4DCO-DOPEJ PIC X(002). ! +139300* JOUR DATE VERSEMENT ! +139400 05 WS-4DCO-DEFCNTR. ! +139500* DATE EFFET CONTRAT ! +139600 10 WS-4DCO-DEFCNTRSA. ! +139700* SIECLE ANNEE DATE EFFET CONTRAT ! +139800 15 WS-4DCO-DEFCNTRS PIC X(002). ! +139900* SIECLE DATE EFFET CONTRAT ! +140000 15 WS-4DCO-DEFCNTRA PIC X(002). ! +140100* ANNEE DATE EFFET CONTRAT ! +140200 10 WS-4DCO-DEFCNTRM PIC X(002). ! +140300* MOIS DATE EFFET CONTRAT ! +140400 10 WS-4DCO-DEFCNTRJ PIC X(002). ! +140500* JOUR DATE EFFET CONTRAT ! +140600 05 WS-4DCO-FINDTGAR. ! +140700* ! +140800 10 WS-4DCO-JJDTGAR PIC X(002). ! +140900* ! +141000 10 WS-4DCO-MMDTGAR PIC X(002). ! +141100* ! +141200 10 WS-4DCO-ANDTGAR. ! +141300* ! +141400 15 WS-4DCO-SSDTGAR PIC X(002). ! +141500* ! +141600 15 WS-4DCO-AADTGAR PIC X(002). ! +141700* ! +141800 05 WS-4DCO-STR-GERR PIC X(006). ! +141900* STRUCTURE GERANTE DU CONTRAT ! +142000 05 WS-4DCO-TXMNGARR PIC S9(02)V9(03). ! +142100* TAUX MINIMUM GARANTI CONTRAT ! +142200 05 WS-4DCO-BRUTINIR PIC S9(09)V9(02). ! +142300* MONTANT BRUT VERSEMENT ! +142400 05 WS-4DCO-BRUTINIR-C REDEFINES WS-4DCO-BRUTINIR ! +142500 PIC S9(11). ! +142600* MONTANT BRUT VERSEMENT ! +142700 05 WS-4DCO-NETINIR PIC S9(09)V9(02). ! +142800* MONTANT NET VERSEMENT ! +142900 05 WS-4DCO-NETINIR-C REDEFINES WS-4DCO-NETINIR ! +143000 PIC S9(11). ! +143100* MONTANT NET VERSEMENT ! +143200 05 WS-4DCO-FRSINIR PIC S9(09)V9(02). ! +143300* MONTANT FRAIS VERSEMENT ! +143400 05 WS-4DCO-FRSINIR-C REDEFINES WS-4DCO-FRSINIR ! +143500 PIC S9(11). ! +143600* MONTANT FRAIS VERSEMENT ! +143700 05 WS-4DCO-NB-VER-EXC PIC 9(03) COMP-3. ! +143800* NOMBRE DE VERSEMENTS ! +143900 05 WS-4DCO-TYP-VERR PIC X(001). ! +144000* PERIODICITE DES VERSEMENTS ! +144100 05 WS-4DCO-REN-RETRO PIC X(001). ! +144200* INDICATEUR DE RETROACTIVITE ! +144300 05 WS-4DCO-REN-NBRE-PASSAGE PIC X(001). ! +144400* INDICATEUR NOMBRE PASSAGES ! +144500 05 WS-4DCO-LIB-IDT-CTR-RE PIC X(016). ! +144600* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +144700 05 WS-4DCO-NO-IDT-CTR-RE PIC X(015). ! +144800* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT ! +144900 05 WS-4DCO-NOMR PIC X(032). ! +145000* NOM PRENOM DU SOUSCRIPTEUR ! +145100 05 WS-4DCO-AGT-GTNR PIC X(008). ! +145200* NO. AGENT GESTIONNAIRE DU CONTRAT ! +145300 05 WS-4DCO-REN-MT-NET-VER-INI PIC S9(11) COMP-3. ! +145400* MONTANT NET DU VERSEMENT INITIAL ! +145500 05 WS-4DCO-REN-SLD-TPS-REAL PIC S9(15) COMP-3. ! +145600* SOLDE TP TEMPS REEL ! +145700 05 WS-4DCO-REN-IDC-EDI-CM PIC X(01). ! +145800* indicateur edition cheque ccm ! +145900 05 FILLER PIC X(1588). ! +146000* ZONES DISPONIBLES ! +146100* ------------------------------------------------------ * ! +146200 ! +146300 03 WS-4DCO-MODIFICATION REDEFINES WS-4DCO-PROGRAM. ! +146400* ==================== ! +146500* ------------------------------------------------------ * ! +146600* COMMAREA : MODIFICATION * ! +146700* LONGUEUR : 1800 * ! +146800* PREFIXE : WS-4DCO- * ! +146900* ------------------------------------------------------ * ! +147000* NOTE : 11/06/92 = CORRECTION COMMAREA MODIFICATION ! +147100 ! +147200 05 WS-4DCO-MOD-BEN-OK PIC X(001). ! +147300* INDICATEUR SAISIE BENEF. OK ! +147400 05 WS-4DCO-MOD-NB-ITEM-TS PIC 9(02). ! +147500* NB ITEM TS DES BENEFICIAIRES ! +147600 05 WS-4DCO-MOD-NB-BEN-PEP PIC 9(02). ! +147700* NB BENEF NON ANNULES PEP ! +147800 05 WS-4DCO-MOD-NB-NOUV-BEN PIC 9(02). ! +147900* NB NOUVEAUX BENEFICIAIRES ! +148000 05 WS-4DCO-MOD-DER-NO-ORD PIC 9(02). ! +148100* DERNIER NO ORDRE ART 10 PEP ! +148200 05 WS-4DCO-MOD-DER-NO-BNF PIC 9(02). ! +148300* DERNIER NO BENEF ART 10 PEP ! +148400 05 WS-4DCO-MOD-LIB-CTR PIC X(16). ! +148500* LIBELLE DU TYPE DE CONTRAT ! +148600 05 WS-4DCO-MOD-IDT-CTR PIC X(15). ! +148700* IDENTIFIANT DU CONTRAT ! +148800 05 WS-4DCO-MOD-STR-GTN PIC X(06). ! +148900* STRUCTURE GESTIONNAIRE DU CONTRAT ! +149000 05 WS-4DCO-MOD-AGT-GTN PIC X(08). ! +149100* AGENT GESTIONNAIRE DU CONTRAT ! +149200 05 WS-4DCO-MOD-NOM-CLI PIC X(32). ! +149300* NOM DU SOUSCRIPTEUR ! +149400 05 WS-4DCO-MOD-TX-DERO-VP PIC X(01). ! +149500* INDICATEUR DE TAUX DEROGATOIRE SUR V.P. ! +149600 05 FILLER PIC X(022). ! +149700* ZONES DISPONIBLES ! +149800 05 WS-4DCO-MOD-MAP-M42620A. ! +149900* ZONES MAP M42620A ! +150000 10 WS-4DCO-MOD-SAISIE-BENEF PIC X(001). ! +150100* INDICATEUR TRT BENEFICIAIRES ! +150200 10 WS-4DCO-MOD-CD-INT PIC X(002). ! +150300* CODE INTITULE DU TITULAIRE ! +150400 10 WS-4DCO-MOD-NOM-PATRO PIC X(032). ! +150500* NOM DU TITULAIRE ! +150600 10 WS-4DCO-MOD-DA-NAI. ! +150700* DATE NAISSANCE TITULAIRE ! +150800 15 WS-4DCO-MOD-DA-NAI-A PIC X(004). ! +150900* ANNEE NAISSANCE TITULAIRE ! +151000 15 WS-4DCO-MOD-DA-NAI-M PIC X(002). ! +151100* MOIS NAISSANCE TITULAIRE ! +151200 15 WS-4DCO-MOD-DA-NAI-J PIC X(002). ! +151300* JOUR NAISSANCE TITULAIRE ! +151400 10 WS-4DCO-MOD-DA-SCR. ! +151500* DATE SOUSCRIPTION ! +151600 15 WS-4DCO-MOD-DA-SCR-SA PIC 9(04). ! +151700* SIECLE ANNEE DATE SOUSCRIPTION ! +151800 15 WS-4DCO-MOD-DA-SCR-M PIC 9(02). ! +151900* MOIS DATE SOUSCRIPTION ! +152000 15 WS-4DCO-MOD-DA-SCR-J PIC 9(02). ! +152100* JOUR DATE SOUSCRIPTION ! +152200 10 WS-4DCO-MOD-DA-ECN-CTR PIC X(008). ! +152300* DATE ECHEANCE CONTRAT ! +152400 10 WS-4DCO-MOD-DUR-CTR-AV PIC X(004). ! +152500* DUREE DU CONTRAT AVANT MODIFICATION ! +152600 10 WS-4DCO-MOD-DUR-CTR. ! +152700* DUREE DU CONTRAT ! +152800 15 WS-4DCO-MOD-AA-DUR-CTR PIC X(002). ! +152900* NB ANNEES DUREE DU CONTRAT ! +153000 15 WS-4DCO-MOD-MM-DUR-CTR PIC X(002). ! +153100* NB MOIS DUREE DU CONTRAT ! +153200 10 FILLER REDEFINES WS-4DCO-MOD-DUR-CTR. ! +153300* DUREE DU CONTRAT (NUMERIQUE) ! +153400 15 WS-4DCO-MOD-AA-DUR-CTR-R PIC 9(02). ! +153500* NB ANNEES DUREE DU CONTRAT (NUMERIQUE) ! +153600 15 WS-4DCO-MOD-MM-DUR-CTR-R PIC 9(02). ! +153700* NB MOIS DUREE DU CONTRAT (NUMERIQUE) ! +153800 10 WS-4DCO-MOD-DA-ECN-AV PIC X(008). ! +153900* DATE ECHEANCE CONTRAT ! +154000 10 WS-4DCO-MOD-DA-ECN. ! +154100* DATE ECHEANCE CONTRAT ! +154200 15 WS-4DCO-MOD-DA-ECN-A PIC X(004). ! +154300* SIECLE ANNEE DATE ECHEANCE CONTRAT ! +154400 15 WS-4DCO-MOD-DA-ECN-M PIC X(002). ! +154500* MOIS DATE ECHEANCE CONTRAT ! +154600 15 WS-4DCO-MOD-DA-ECN-J PIC X(002). ! +154700* JOUR DATE ECHEANCE CONTRAT ! +154800 10 FILLER REDEFINES WS-4DCO-MOD-DA-ECN. ! +154900* DATE ECHEANCE CONTRAT (NUMERIQUE) ! +155000 15 WS-4DCO-MOD-DA-ECN-A-R PIC 9(04). ! +155100* SIECLE ANNEE DATE ECHEANCE CONTRAT ! +155200 15 WS-4DCO-MOD-DA-ECN-M-R PIC 9(02). ! +155300* MOIS DATE ECHEANCE CONTRAT ! +155400 15 WS-4DCO-MOD-DA-ECN-J-R PIC 9(02). ! +155500* JOUR DATE ECHEANCE CONTRAT ! +155600 10 WS-4DCO-MOD-TRT-BEN PIC X(001). ! +155700* INDICATEUR MODIF BENEFICIAIRES ! +155800 10 WS-4DCO-MOD-CD-EXP PIC X(001). ! +155900* CODE EXPEDITION ! +156000 10 WS-4DCO-MOD-CD-NTS-AV PIC X(001). ! +156100* VALEUR NANTISSEMENT AV MODIF ! +156200 10 WS-4DCO-MOD-CD-NTS PIC X(001). ! +156300* NOUVELLE VALEUR NANTISSEMENT ! +156400 10 WS-4DCO-MOD-EXIST-VP PIC X(001). ! +156500* INDICATEUR EXISTENCE V.P. POUR LE COMPTE ! +156600 10 WS-4DCO-MOD-VP-AUTORISE PIC X(001). ! +156700* INDICATEUR DE VERSEMENT PERIODIQUE ! +156800 10 WS-4DCO-MOD-NO-RIB-VP. ! +156900* RIB COMPTE DOM. VERSEMENTS PERIODIQUES ! +157000 15 WS-4DCO-MOD-CD-BNQ-VP PIC X(005). ! +157100* CODE BANQUE COMPTE DOM. V.P. ! +157200 15 WS-4DCO-MOD-CD-GCH-VP PIC X(005). ! +157300* CODE GUICHET COMPTE DOM. V.P. ! +157400 15 WS-4DCO-MOD-NO-CPT-VP PIC X(011). ! +157500* NUMERO DE COMPTE DOM. V.P. ! +157600 15 WS-4DCO-MOD-CLE-RIB-VP PIC X(002). ! +157700* CLE RIB COMPTE DOM. V.P. ! +157800 10 WS-4DCO-MOD-SLD-X PIC X(016). ! +157900* SOLDE COMPTE VERSEMENT PERIODIQUE ! +158000 10 WS-4DCO-MOD-SLD-F PIC S9(13)V9(02). ! +158100* SOLDE COMPTE VERSEMENT PERIODIQUE ! +158200 10 WS-4DCO-MOD-SLD-C REDEFINES WS-4DCO-MOD-SLD-F ! +158300 PIC S9(15). ! +158400* SOLDE COMPTE VERSEMENT PERIODIQUE ! +158500 10 WS-4DCO-MOD-DA-EFF-VP-AV PIC X(008). ! +158600* DATE EFFET V.P. AVANT MODIFICATION ! +158700 10 WS-4DCO-MOD-DA-EFF-VP. ! +158800* DATE EFFET V.P. ! +158900 15 WS-4DCO-MOD-DA-EFF-VP-SA PIC X(004). ! +159000* ANNEE DATE EFFET V.P. ! +159100 15 WS-4DCO-MOD-DA-EFF-VP-M PIC X(002). ! +159200* MOIS DATE EFFET V.P. ! +159300 15 WS-4DCO-MOD-DA-EFF-VP-J PIC X(002). ! +159400* JOUR DATE EFFET V.P. ! +159500 10 WS-4DCO-MOD-MT-BRT-X PIC X(10). ! +159600* MONTANT BRUT V.P. AFFICHE A L'ECRAN ! +159700 10 WS-4DCO-MOD-MT-BRT-F PIC S9(07)V9(02). ! +159800* MONTANT BRUT V.P. ! +159900 10 WS-4DCO-MOD-MT-BRT-C REDEFINES WS-4DCO-MOD-MT-BRT-F ! +160000 PIC S9(09). ! +160100* MONTANT BRUT V.P. ! +160200 10 WS-4DCO-MOD-TX-FRS-X PIC X(006). ! +160300* TAUX DE FRAIS V.P. AFFICHE A L'ECRAN ! +160400 10 WS-4DCO-MOD-TX-FRS-F PIC 9(02)V9(03). ! +160500* TAUX DE FRAIS V.P. ! +160600 10 WS-4DCO-MOD-TX-FRS-C REDEFINES WS-4DCO-MOD-TX-FRS-F ! +160700 PIC 9(05). ! +160800* TAUX DE FRAIS V.P. ! +160900 10 WS-4DCO-MOD-MT-FRS-X PIC X(010). ! +161000* MONTANT FRAIS V.P. AFFICHE A L'ECRAN ! +161100 10 WS-4DCO-MOD-MT-FRS-F PIC S9(07)V9(02). ! +161200* MONTANT FRAIS V.P. ! +161300 10 WS-4DCO-MOD-MT-FRS-C REDEFINES WS-4DCO-MOD-MT-FRS-F ! +161400 PIC S9(09). ! +161500* MONTANT FRAIS V.P. ! +161600 10 WS-4DCO-MOD-MT-NET-X PIC X(010). ! +161700* MONTANT NET V.P. AFFICHE A L'ECRAN ! +161800 10 WS-4DCO-MOD-MT-NET-F PIC S9(07)V9(02). ! +161900* MONTANT NET V.P. ! +162000 10 WS-4DCO-MOD-MT-NET-C REDEFINES WS-4DCO-MOD-MT-NET-F ! +162100 PIC S9(09). ! +162200* MONTANT NET V.P. ! +162300 10 WS-4DCO-MOD-NET-CTR PIC S9(07)V9(02). ! +162400* MONTANT NET DES VERSEMENTS DU CONTRAT ! +162500 10 WS-4DCO-MOD-NET-CTR-R REDEFINES WS-4DCO-MOD-NET-CTR ! +162600 PIC S9(09). ! +162700* MONTANT NET DES VERSEMENTS DU CONTRAT ! +162800 10 WS-4DCO-MOD-CD-PER-VP PIC X(001). ! +162900* CODE PERIODICITE ! +163000 10 WS-4DCO-MOD-AJU-CTS PIC X(001). ! +163100* INDICATEUR AJUSTEMENT VERSEMENTS ! +163200 10 WS-4DCO-MOD-DRG-FRS-GTN PIC X(001). ! +163300* INDICATEUR DE DEROGATION TAUX FRAIS ! +163400 10 WS-4DCO-MOD-MM-DUR-CTR-SAI PIC X(002). ! +163500* DUREE DE CONTRAT SAISIE MOIS ! +163600 10 WS-4DCO-MOD-AA-DUR-CTR-SAI PIC X(002). ! +163700* DUREE DE CONTRAT SAISIE ANNEE ! +163800 10 WS-4DCO-MOD-DA-ECN-M-SAI PIC X(002). ! +163900* DATE D'ECHEANCE SAISIE MOIS ! +164000 10 WS-4DCO-MOD-DA-ECN-A-SAI PIC X(004). ! +164100* DATE D'ECHEANCE SAISIE ANNEE ! +164200 10 WS-4DCO-MOD-DA-EFF-CTR PIC X(008). ! +164300* DATE EFFET CONTRAT ! +164400 10 FILLER PIC X(082). ! +164500* ZONES DISPONIBLES ! +164600 05 WS-4DCO-MOD-MAP-M42630A. ! +164700* ZONES BENEF. MAP M42630A ! +164800 10 WS-4DCO-MOD-NO-PAGE PIC 9(02). ! +164900* NUMERO DE PAGE ECRAN M42630A ! +165000 10 WS-4DCO-MOD-NB-PAGES PIC 9(02). ! +165100* NOMBRE DE PAGES ECRAN M42630A ! +165200 10 WS-4DCO-MOD-TAB-BENEF OCCURS 10. ! +165300* TABLEAU DES BENEF / M42630A ! +165400 15 WS-4DCO-MOD-NOM PIC X(032). ! +165500* NOM DU BENEFICIAIRE ! +165600 15 WS-4DCO-MOD-QP PIC X(003). ! +165700* QUOTE PART DU BENEFICIAIRE ! +165800 15 WS-4DCO-MOD-ETAT PIC X(003). ! +165900* ETAT DU BENEFICIAIRE ! +166000 10 WS-4DCO-MOD-TAB-TRT. ! +166100* TABLEAU TOP DE TRT BENEF. ! +166200 15 WS-4DCO-MOD-TRT PIC X(001) OCCURS 10. ! +166300* TOP DE SAISIE BENEFICIAIRE ! +166400 05 WS-4DCO-MOD-TS-BENEF-OK PIC X(001). ! +166500* INDICATEUR EXISTENCE TS BENEF. ! +166600 05 WS-4DCO-MOD-MAP-M42640A. ! +166700* ZONES BENEFICIAIRE MAP M42640A ! +166800 10 WS-4DCO-MOD-CD-INT-BNF PIC X(002). ! +166900* CODE INTITULE BENEFICIAIRE ! +167000 10 WS-4DCO-MOD-NOM-PATRO-BNF PIC X(032). ! +167100* NOM BENEFICIAIRE ! +167200 10 WS-4DCO-MOD-DA-NAI-BNF. ! +167300* DATE DE NAISSANCE BENEF ! +167400 15 WS-4DCO-MOD-DA-NAI-BNF-SA PIC X(004). ! +167500* SIECLE ANNEE DATE DE NAISSANCE ! +167600 15 WS-4DCO-MOD-DA-NAI-BNF-M PIC X(002). ! +167700* MOIS DATE DE NAISSANCE ! +167800 15 WS-4DCO-MOD-DA-NAI-BNF-J PIC X(002). ! +167900* JOUR DATE DE NAISSANCE ! +168000 10 WS-4DCO-MOD-NO-RIB. ! +168100* NUMERO DE COMPTE BENEFICIAIRE ! +168200 15 WS-4DCO-MOD-CD-BQE PIC X(005). ! +168300* CODE BANQUE RIB BENEFICIAIRE ! +168400 15 WS-4DCO-MOD-CD-GCH PIC X(005). ! +168500* CODE GUICHET RIB BENEFICIAIRE ! +168600 15 WS-4DCO-MOD-NO-CPT PIC X(011). ! +168700* NO COMPTE RIB BENEFICIAIRE ! +168800 15 WS-4DCO-MOD-CLE-RIB PIC X(002). ! +168900* CLE RIB BENEFICIAIRE ! +169000 10 WS-4DCO-MOD-QUOTE-PART PIC X(003). ! +169100* QUOTE PART DU BENEFICIAIRE ! +169200 10 WS-4DCO-MOD-LIB-RUE-1 PIC X(032). ! +169300* RUE ADRESSE BENEFICIAIRE ! +169400 10 WS-4DCO-MOD-CD-POST PIC X(005). ! +169500* CODE POSTAL ADRESSE BENEF. ! +169600 10 WS-4DCO-MOD-LIB-COMMUNE PIC X(032). ! +169700* VILLE ADRESSE BENEFICIAIRE ! +169800 10 WS-4DCO-MOD-LIB-RUE-2 PIC X(032). ! +169900* RUE ADRESSE BENEFICIAIRE ! +170000 05 WS-4DCO-MOD-LIB-AVN PIC X(019). ! +170100* LIBELLE AVANCE ! +170200 05 WS-4DCO-MOD-SLD-AVN-X PIC X(014). ! +170300* ! +170400 05 WS-4DCO-MOD-SLD-AVN PIC S9(15) COMP-3. ! +170500* ! +170600 05 WS-4DCO-MOD-SLD-AVN-R REDEFINES WS-4DCO-MOD-SLD-AVN ! +170700 PIC S9(13)V9(02) COMP-3. ! +170800* ! +170900 05 WS-4DCO-MOD-IDC-NTS PIC X(001). ! +171000* ! +171100 05 WS-4DCO-MOD-REF-EXT-INTV PIC X(015). ! +171200* ! +171300 05 WS-4DCO-MOD-EXPED PIC X(001). ! +171400* TYPE D'EXPEDITION ! +171500* ! +171600* ====> MODIFICATION DU CADRE DU CONTRAT : ! +171700* ---- EPARGNE HANDICAP ! +171800* ---- RENTE SURVIE ! +171900 05 WS-4DCO-MOD-CD-EPH-AV PIC X(001). ! +172000* VALEUR CODE EPARGNE HANDICAP ! +172100 05 WS-4DCO-MOD-CD-EPH PIC X(001). ! +172200* NOUVELLE VALEUR EPARGNE HANDICAP ! +172300 05 WS-4DCO-MOD-CD-RSU-AV PIC X(001). ! +172400* VALEUR CODE RENTE SURVIE ! +172500 05 WS-4DCO-MOD-CD-RSU PIC X(001). ! +172600* NOUVELLE VALEUR RENTE SURVIE ! +172700 05 WS-4DCO-MOD-CREAT-VP PIC X(001). ! +172800* INDICATEUR CREATION V.P. POUR LE COMPTE ! +172900 05 WS-4DCO-MOD-DA-ADH-RGM-VLL PIC X(008). ! +173000* DATE ADHESION REGIME VIEILLESSE (SSAAMMJJ) ! +173100 05 FILLER REDEFINES WS-4DCO-MOD-DA-ADH-RGM-VLL. ! +173200 07 WS-4DCO-MOD-DA-ADH-RGM-VLL-A PIC X(4). ! +173300 07 WS-4DCO-MOD-DA-ADH-RGM-VLL-M PIC X(2). ! +173400 07 WS-4DCO-MOD-DA-ADH-RGM-VLL-J PIC X(2). ! +173500 05 WS-4DCO-MOD-PER-ARR-FIS-CLI PIC X(004). ! +173600* PERIODE ARRETE FISCAL CLIENT (MMJJ) ! +173700 05 FILLER REDEFINES WS-4DCO-MOD-PER-ARR-FIS-CLI . ! +173800 07 WS-4DCO-MOD-PER-ARR-FIS-CLI-M PIC X(2). ! +173900 07 WS-4DCO-MOD-PER-ARR-FIS-CLI-J PIC X(2). ! +174000 05 WS-4DCO-MOD-TOP-PREM-PREL PIC X(01). ! +174100 05 WS-4DCO-MOD-TY-TRF-PP-AV PIC X(02). ! +174200* TYPE DE CLASSIFICATION PU/PP AVANT MOD ! +174300 05 WS-4DCO-MOD-TY-TRF-PP PIC X(02). ! +174400* TYPE DE CLASSIFICATION PU/PP ! +174500 05 WS-4DCO-CD-PER-RPP PIC X(01). ! +174600* CODE PERIODICITE RPP ! +174700 05 WS-4DCO-MOD-NO-GEN-TY-PRD PIC X(03). ! +174800* NO DE GENERATION TYPE DE PRODUIT ! +174900 05 WS-4DCO-MOD-IDC-RFS-CDN-NV-AV PIC X(01). ! +175000* INDICATEUR REFUS CONDITION NOUVELLE AVANT ! +175100 05 WS-4DCO-MOD-IDC-RFS-CDN-NV PIC X(01). ! +175200* INDICATEUR REFUS CONDITION NOUVELLE ! +175300 05 WS-4DCO-MOD-IDC-CTRL PIC X(1). ! +175400* INDICATEUR DE CONTROLE ! +175500 05 WS-4DCO-MOD-ERRMSG PIC X(6). ! +175600* SAUVEGARDE MESSAGE ERREUR ! +175700 05 WS-4DCO-MOD-4DME0. ! +175800 10 WS-4DCO-MOD-CD-BLOC-DOSS PIC X(01). ! +175900 10 WS-4DCO-MOD-CD-BLOC-DOSS-AV PIC X(01). ! +176000* DATE PROCHAIN RACHAT ! +176100 05 WS-4DCO-MOD-DA-NXT-RPP. ! +176200 10 WS-4DCO-MOD-DA-NXT-RPP-A PIC X(04). ! +176300 10 WS-4DCO-MOD-DA-NXT-RPP-M PIC X(02). ! +176400 10 WS-4DCO-MOD-DA-NXT-RPP-J PIC X(02). ! +176500* ! +176600* DATE DERNIER RACHAT ! +176700 05 WS-4DCO-MOD-DA-DNR-RPP. ! +176800 10 WS-4DCO-MOD-DA-DNR-RPP-A PIC X(04). ! +176900 10 WS-4DCO-MOD-DA-DNR-RPP-M PIC X(02). ! +177000 10 WS-4DCO-MOD-DA-DNR-RPP-J PIC X(02). ! +177100* TYPE DE TRAITEMENT ! +177200 05 WS-4DCO-SAV-4DMI0. ! +177300 10 WS-4DCO-SAV-OPERATION PIC X(02). ! +177400 88 WS-CREATION VALUE 'CR'. ! +177500 88 WS-MODIFICATION VALUE 'MO'. ! +177600 88 WS-CONSULTATION VALUE 'CS'. ! +177700 88 WS-SUPPRESSION VALUE 'SP'. ! +177800* ! +177900 05 FILLER PIC X(0673). ! +178000* ZONES DISPONIBLES ! +178100* ------------------------------------------------------ * ! +178200 ! +178300 03 WS-4DCO-RACHAT REDEFINES WS-4DCO-PROGRAM. ! +178400* ============== ! +178500* ------------------------------------------------------ * ! +178600* COMMAREA : RACHAT * ! +178700* LONGUEUR : 1800 * ! +178800* PREFIXE : WS-4DCO- * ! +178900* ------------------------------------------------------ * ! +179000 ! +179100 05 WS-4DCO-RIBRC. ! +179200* RIB CPTE DOM RACHAT ! +179300 10 WS-4DCO-BNQDRC PIC X(005). ! +179400* BANQUE RIB CPTE DOM RACHAT ! +179500 10 WS-4DCO-GUICDRC PIC X(005). ! +179600* GUICHET RIB CPTE DOM RACHAT ! +179700 10 WS-4DCO-RACDRC PIC X(011). ! +179800* RACINE RIB CPTE DOM RACHAT ! +179900 10 WS-4DCO-CLEDRC PIC X(002). ! +180000* CLE RIB CPTE DOM RACHAT ! +180100 05 WS-4DCO-STR-GTN-RC PIC X(006). ! +180200* STRUCTURE GESTIONNAIRE DU CONTRAT ! +180300 05 WS-4DCO-DSOURC. ! +180400* DATE SOUSCRIPTION CONTRAT ! +180500 10 WS-4DCO-AA-SOUSC. ! +180600* SIECLE ANNEE DATE SOUSCRIPTION CONTRAT ! +180700 15 WS-4DCO-AA1-SOUSC PIC X(002). ! +180800* SIECLE DATE SOUSCRIPTION CONTRAT ! +180900 15 WS-4DCO-AA2-SOUSC PIC X(002). ! +181000* ANNEE DATE SOUSCRIPTION CONTRAT ! +181100 10 WS-4DCO-MM-SOUSC PIC X(002). ! +181200* MOIS DATE SOUSCRIPTION CONTRAT ! +181300 10 WS-4DCO-JJ-SOUSC PIC X(002). ! +181400* JOUR DATE SOUSCRIPTION CONTRAT ! +181500 05 WS-4DCO-DSOURC-EFF. ! +181600* DATE EFFET SOUSCRIPTION ! +181700 10 WS-4DCO-AA-EFF-SOUSC. ! +181800* SIECLE ANNEE DATE EFFET SOUSCRIPTION ! +181900 15 WS-4DCO-AA1-EFF-SC PIC X(002). ! +182000* SIECLE DATE EFFET SOUSCRIPTION ! +182100 15 WS-4DCO-AA2-EFF-SC PIC X(002). ! +182200* ANNEE DATE EFFET SOUSCRIPTION ! +182300 10 WS-4DCO-MM-EFF-SOUSC PIC X(002). ! +182400* MOIS DATE EFFET SOUSCRIPTION ! +182500 10 WS-4DCO-JJ-EFF-SOUSC PIC X(002). ! +182600* JOUR DATE EFFET SOUSCRIPTION ! +182700 05 WS-4DCO-DOPE-RC. ! +182800* DATE OPERATION RACHAT ! +182900 10 WS-4DCO-AA-OPE. ! +183000* SIECLE ANNEE DATE OPERATION RACHAT ! +183100 15 WS-4DCO-AA1-OPE PIC X(002). ! +183200* SIECLE DATE OPERATION RACHAT ! +183300 15 WS-4DCO-AA2-OPE PIC X(002). ! +183400* ANNEE DATE OPERATION RACHAT ! +183500 10 WS-4DCO-MM-OPE PIC X(002). ! +183600* MOIS DATE OPERATION RACHAT ! +183700 10 WS-4DCO-JJ-OPE PIC X(002). ! +183800* JOUR DATE OPERATION RACHAT ! +183900 05 WS-4DCO-DEFFET-RC. ! +184000* DATE EFFET RACHAT ! +184100 10 WS-4DCO-AA-EFF. ! +184200* SIECLE ANNEE DATE EFFET RACHAT ! +184300 15 WS-4DCO-AA1-EFF PIC X(002). ! +184400* SIECLE DATE EFFET RACHAT ! +184500 15 WS-4DCO-AA2-EFF PIC X(002). ! +184600* ANNEE DATE EFFET RACHAT ! +184700 10 WS-4DCO-MM-EFF PIC X(002). ! +184800* MOIS DATE EFFET RACHAT ! +184900 10 WS-4DCO-JJ-EFF PIC X(002). ! +185000* JOUR DATE EFFET RACHAT ! +185100 05 WS-4DCO-IDC-DCS PIC X(001). ! +185200* INDICATEUR DE DECES ACCIDENTEL (PREVI-CROISSANCE) ! +185300 05 WS-4DCO-DECLA-INT PIC X(001). ! +185400* ! +185500 05 FILLER PIC X(001). ! +185600* ZONE DISPONIBLE ! +185700 05 WS-4DCO-CERTIF-IMP PIC X(001). ! +185800* ! +185900 05 WS-4DCO-ZOOM PIC X(001). ! +186000* ! +186100 05 WS-4DCO-NOMRC PIC X(032). ! +186200* ! +186300 05 WS-4DCO-LIB-AVN-RC PIC X(014). ! +186400* LIBELLE AVANCE ! +186500 05 WS-4DCO-SLD-AVN-RC-X PIC X(14). ! +186600* ! +186700 05 WS-4DCO-SLD-AVN-RC PIC S9(15) COMP-3. ! +186800* ! +186900 05 WS-4DCO-SLD-AVN-RC-R REDEFINES WS-4DCO-SLD-AVN-RC ! +187000 PIC S9(13)V9(02) COMP-3. ! +187100* ! +187200 05 WS-4DCO-DA-DNR-PAB-RC PIC X(08). ! +187300* DATE DE PASSAGE DE LA DERNIERE PAB ! +187400* ! +187500 05 WS-4DCO-IT-FR-A-RC PIC S9(15) COMP-3. ! +187600* INTERETS ET FRAIS SUR AVANCE ! +187700 05 WS-4DCO-IT-FR-A-RC-R REDEFINES WS-4DCO-IT-FR-A-RC ! +187800 PIC S9(13)V9(02) COMP-3. ! +187900* ! +188000 05 WS-4DCO-FRS-ANN-RC PIC S9(15) COMP-3. ! +188100* FRAIS ANNUELS DE GESTION ! +188200 05 WS-4DCO-FRS-ANN-RC-R REDEFINES WS-4DCO-FRS-ANN-RC ! +188300 PIC S9(13)V9(02) COMP-3. ! +188400* FRAIS ANNUELS DE GESTION -> NOUVEAU PRODUIT ! +188500 05 WS-4DCO-FRS-ANN-GTN PIC S9(15) COMP-3. ! +188600 05 WS-4DCO-FRS-ANN-GTN-R REDEFINES WS-4DCO-FRS-ANN-GTN ! +188700 PIC S9(13)V9(02) COMP-3. ! +188800 05 WS-4DCO-CRDS PIC S9(15) COMP-3. ! +188900 05 WS-4DCO-CRDS-R REDEFINES WS-4DCO-CRDS ! +189000 PIC S9(13)V9(02) COMP-3. ! +189100 05 FILLER PIC X(004). ! +189200* ZONES DISPONIBLES ! +189300 05 WS-4DCO-PREL-LIB-RC PIC S9(15) COMP-3. ! +189400* ! +189500 05 WS-4DCO-PR-LIB-RC-R REDEFINES WS-4DCO-PREL-LIB-RC ! +189600 PIC S9(13)V9(02) COMP-3. ! +189700* ! +189800 05 WS-4DCO-PREL-SOC-RC PIC S9(15) COMP-3. ! +189900* ! +190000 05 WS-4DCO-PR-SOC-RC-R REDEFINES WS-4DCO-PREL-SOC-RC ! +190100 PIC S9(13)V9(02) COMP-3. ! +190200* ! +190300 05 WS-4DCO-PREL-VIE-RC PIC S9(15) COMP-3. ! +190400* ! +190500 05 WS-4DCO-PR-VIE-RC-R REDEFINES WS-4DCO-PREL-VIE-RC ! +190600 PIC S9(13)V9(02) COMP-3. ! +190700* ! +190800 05 WS-4DCO-MT-VER-INI-RC PIC S9(11) COMP-3. ! +190900* ! +191000 05 WS-4DCO-SOLD-TP-RC PIC S9(15) COMP-3. ! +191100* ! +191200 05 WS-4DCO-SLD-TP-RC-R REDEFINES WS-4DCO-SOLD-TP-RC ! +191300 PIC S9(13)V9(02) COMP-3. ! +191400* ! +191500 05 WS-4DCO-SOLD-VERS PIC S9(15) COMP-3. ! +191600* SOMME VERSEE AU SOCIETAIRE ! +191700 05 WS-4DCO-SOLD-VERS-R REDEFINES WS-4DCO-SOLD-VERS ! +191800 PIC S9(13)V9(02) COMP-3. ! +191900* ! +192000 05 WS-4DCO-CD-VER-PER-RC PIC X(001). ! +192100* ! +192200 05 WS-4DCO-DRG-DA-SRC PIC X(001). ! +192300* ! +192400 05 WS-4DCO-DRAP-ZOOM-RC PIC X(001). ! +192500* ! +192600 05 WS-4DCO-NBRE-PASSAGE PIC X(001). ! +192700* ! +192800 05 WS-4DCO-DERN-NO-RACP PIC 9(003). ! +192900* ! +193000 05 WS-4DCO-MT-PART PIC S9(15) COMP-3. ! +193100* MONTANT DU RACHAT PARTIEL ! +193200 05 WS-4DCO-MT-PART-R REDEFINES WS-4DCO-MT-PART ! +193300 PIC S9(13)V9(02) COMP-3. ! +193400* MONTANT DU CREDIT SOCIETAIRE AFFICHE ! +193500 05 WS-4DCO-MT-CRD-SOC-AFF PIC X(011). ! +193600* ! +193700 05 WS-4DCO-SOLD-TP-A-RC PIC S9(15) COMP-3. ! +193800* ! +193900 05 WS-4DCO-SOLD-TP-A-RC-R REDEFINES WS-4DCO-SOLD-TP-A-RC ! +194000 PIC S9(13)V9(02) COMP-3. ! +194100 05 FILLER PIC X(015). ! +194200* ZONES DISPONIBLES ! +194300 05 WS-4DCO-LIB-DECLA-RC PIC X(045). ! +194400* ! +194500 05 WS-4DCO-LIB-IDT-CTR-RC PIC X(016). ! +194600* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +194700 05 WS-4DCO-NO-IDT-CTR-RC PIC X(015). ! +194800* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT ! +194900 05 WS-4DCO-AGT-GTN-RC PIC X(008). ! +195000* NO. D'AGENT GESTIONNAIRE DU CONTRAT ! +195100 05 FILLER PIC X(055). ! +195200* ZONES DISPONIBLES ! +195300 05 WS-4DCO-LIB-EXO-RC PIC X(0045). ! +195400* COMPLEMENT DE ZONES RACHAT ASSURANCE ! +195500 05 WS-4DCO-EXO-RC PIC X(001). ! +195600* ! +195700 05 WS-4DCO-DRAP-RC PIC X(001). ! +195800* ! +195900 05 WS-4DCO-INT-BRT-RC PIC S9(15) COMP-3. ! +196000* ! +196100 05 WS-4DCO-INT-BRT-RC-R REDEFINES WS-4DCO-INT-BRT-RC ! +196200 PIC S9(13)V9(02) COMP-3. ! +196300* ! +196400 05 WS-4DCO-MT-PRIM-RC PIC S9(15) COMP-3. ! +196500* ! +196600 05 WS-4DCO-INT-PRIM-RC PIC S9(15) COMP-3. ! +196700* ! +196800 05 WS-4DCO-PREL-TOT-RC PIC S9(15) COMP-3. ! +196900* TOTAL PRELEVEMENTS : PREL + SOC + VIE ! +197000 05 WS-4DCO-PREL-TOT-RC-R REDEFINES WS-4DCO-PREL-TOT-RC ! +197100 PIC S9(13)V9(02) COMP-3. ! +197200* ! +197300 05 WS-4DCO-TX-PREL PIC S9(02)V9(03). ! +197400* ! +197500 05 WS-4DCO-MT-PV-RC PIC S9(15) COMP-3. ! +197600* ! +197700 05 WS-4DCO-MT-PV-RC-R REDEFINES WS-4DCO-MT-PV-RC ! +197800 PIC S9(13)V9(02) COMP-3. ! +197900* ! +198000 05 WS-4DCO-MT-VA-RC PIC S9(15) COMP-3. ! +198100* ! +198200 05 WS-4DCO-MT-VA-RC-R REDEFINES WS-4DCO-MT-VA-RC ! +198300 PIC S9(13)V9(02) COMP-3. ! +198400* ! +198500 05 WS-4DCO-INDIC-ART10 PIC X(001). ! +198600* ! +198700 05 WS-4DCO-ETAT-BEN PIC X(001). ! +198800* ! +198900 05 WS-4DCO-NO-ITEM-BENEF PIC S9(02). ! +199000* ! +199100 05 FILLER PIC X(002). ! +199200* ! +199300 05 WS-4DCO-CUMUL-QP-B PIC S9(03)V9(02). ! +199400* ! +199500 05 WS-4DCO-INT-A-RC PIC S9(15) COMP-3. ! +199600* ! +199700 05 WS-4DCO-INT-A-1-RC PIC S9(15) COMP-3. ! +199800* ! +199900 05 WS-4DCO-TOT-QP-REMB PIC S9(05). ! +200000* ! +200100 05 WS-4DCO-TOT-QP-REMB-D REDEFINES WS-4DCO-TOT-QP-REMB ! +200200 PIC S9(03)V9(02). ! +200300* ! +200400 05 WS-4DCO-TOT-MT-REMB PIC S9(13) COMP-3. ! +200500* ! +200600 05 WS-4DCO-NBRE-ART10 PIC S9(02). ! +200700* ! +200800 05 WS-4DCO-QP-EPG-CAP PIC S9(03)V9(02). ! +200900* ! +201000 05 WS-4DCO-NBR-MAX-ITEM PIC 9(02). ! +201100* ! +201200 05 WS-4DCO-CD-PREM-BEN PIC X(001). ! +201300* ! +201400 05 WS-4DCO-NBR-ITEM-01 PIC 9(02). ! +201500* ! +201600 05 WS-4DCO-NBR-ECR-VIERGE PIC S9(02). ! +201700* ! +201800 05 WS-4DCO-INDIC-PF5 PIC X(001). ! +201900* ! +202000 05 WS-4DCO-BEN-AFF PIC X(001). ! +202100* ! +202200 05 WS-4DCO-NO-BEN-TS PIC 9(02). ! +202300* ! +202400 05 WS-4DCO-NBR-BEN-TS PIC S9(02). ! +202500* ! +202600 05 WS-4DCO-IND-FISC PIC X(001). ! +202700* ! +202800 05 FILLER PIC X(016). ! +202900* ZONES DISPONIBLES ! +203000 05 WS-4DCO-SAVE-MAX-ITEM PIC 9(02). ! +203100* NOMBRE DE PAGES MAXI ! +203200 05 WS-4DCO-NBR-PAGE-RC PIC 9(02). ! +203300* NO PAGE COURANTE ! +203400 05 WS-4DCO-NO-PAGE-RC PIC 9(02). ! +203500* MONTANT DE LA CSG ! +203600 05 WS-4DCO-PREL-CSG-RC PIC S9(15) COMP-3. ! +203700* ! +203800 05 WS-4DCO-PR-CSG-RC-R REDEFINES WS-4DCO-PREL-CSG-RC ! +203900 PIC S9(13)V9(02) COMP-3. ! +204000* ! +204100* MONTANT Disponible rachat partiel ! +204200 05 WS-4DCO-MAX-DISPO-RC PIC S9(15) COMP-3. ! +204300* ! +204400 05 WS-4DCO-MAX-DISPO-RC-X REDEFINES WS-4DCO-MAX-DISPO-RC ! +204500 PIC S9(13)V9(02) COMP-3. ! +204600* ! +204700 05 FILLER PIC X(038). ! +204800* ZONES DISPONIBLES ! +204900 05 WS-4DCO-PREL-DPT-RC PIC S9(15) COMP-3. ! +205000* MONTANT CONTRIBUTION DEPARTEMENTALE ! +205100 05 WS-4DCO-PR-DPT-RC-R REDEFINES WS-4DCO-PREL-DPT-RC ! +205200 PIC S9(13)V9(02) COMP-3. ! +205300* ! +205400* DATE PROCHAIN RACHAT ! +205500 05 WS-4DCO-DA-NXT-RPP. ! +205600 10 WS-4DCO-DA-NXT-RPP-A PIC X(04). ! +205700 10 WS-4DCO-DA-NXT-RPP-M PIC X(02). ! +205800 10 WS-4DCO-DA-NXT-RPP-J PIC X(02). ! +205900* ! +206000* DATE DERNIER RACHAT ! +206100 05 WS-4DCO-DA-DNR-RPP. ! +206200 10 WS-4DCO-DA-DNR-RPP-A PIC X(04). ! +206300 10 WS-4DCO-DA-DNR-RPP-M PIC X(02). ! +206400 10 WS-4DCO-DA-DNR-RPP-J PIC X(02). ! +206500* ! +206600 05 WS-4DCO-TX-AJU-A-RPP PIC 9(07) COMP-3. ! +206700* ! +206800 05 WS-4DCO-DA-DNR-MAJ-02 PIC X(8). ! +206900 05 WS-4DCO-HEU-MN-SS-MAJ-02 PIC X(6). ! +207000* ! +207100 05 WS-4DCO-IDC-RACHAT-PEP PIC X(1). ! +207200 05 WS-4DCO-MOT-RACHAT-PEP PIC X(1). ! +207300 05 WS-4DCO-RC-IDC-DEBL-ATP PIC X(1). ! +207400* INDICATEUR DEBLOCAGE ANTICIPE ! +207500 05 WS-4DCO-RC-DA-DEBL-ATP. ! +207600* DATE DEBLOCAGE ANTICIPE ! +207700 10 WS-4DCO-RC-DA-DEBL-ATP-A PIC X(4). ! +207800* DATE DEBLOCAGE ANTICIPE ANNEE ! +207900 10 WS-4DCO-RC-DA-DEBL-ATP-M PIC X(2). ! +208000* DATE DEBLOCAGE ANTICIPE MOIS ! +208100 10 WS-4DCO-RC-DA-DEBL-ATP-J PIC X(2). ! +208200* DATE DEBLOCAGE ANTICIPE JOUR ! +208300 05 WS-4DCO-RC-IDC-DEBL-RCH PIC X(1). ! +208400* INDICATEUR DEBLOCAGE RACHAT ! +208500 05 WS-4DCO-RC-DA-DEBL-RCH. ! +208600* DATE DEBLOCAGE RACHAT ! +208700 10 WS-4DCO-RC-DA-DEBL-RCH-A PIC 9(4). ! +208800* DATE DEBLOCAGE RACHAT ANNEE ! +208900 10 WS-4DCO-RC-DA-DEBL-RCH-M PIC 9(2). ! +209000* DATE DEBLOCAGE RACHAT MOIS ! +209100 10 WS-4DCO-RC-DA-DEBL-RCH-J PIC 9(2). ! +209200* DATE DEBLOCAGE RACHAT JOUR ! +209300 05 WS-4DCO-EXO-RC-REF PIC X(1). ! +209400* INDICATEUR DE confirmation du code exo. '9' ! +209500 05 WS-4DCO-TX-PRL-SOC PIC S99V999 COMP-3. ! +209600* taux pr�l�vement social ! +209700 05 WS-4DCO-TX-PRL-VIE PIC S99V999 COMP-3. ! +209800* taux pr�l�vement vieillesse ! +209900 05 WS-4DCO-IDC-EPG-HCP PIC X. ! +210000* Indicateur �pargne handicap ! +210100 05 WS-4DCO-CTR-DMP PIC X(003). ! +210200* duree moyenne ponderee ! +210300* ! +210400* montant credit d impot ! +210500 05 WS-4DCO-MT-CRD-IMP PIC S9(15) COMP-3. ! +210600 05 WS-4DCO-MT-CRD-IMP-R REDEFINES WS-4DCO-MT-CRD-IMP ! +210700 PIC S9(13)V99 COMP-3. ! +210800 05 WS-4DCO-AGE-RC PIC 999. ! +210900 05 WS-4DCO-PRM-RCT-PAR PIC X. ! +211000* ! +211100 05 WS-4DCO-MT-PV-F8 PIC S9(15) COMP-3. ! +211200* ! +211300 05 WS-4DCO-MT-PV-F8-R REDEFINES WS-4DCO-MT-PV-F8 ! +211400 PIC S9(13)V9(02) COMP-3. ! +211500 05 WS-4DCO-PREL-LIB-F8 PIC S9(15) COMP-3. ! +211600* ! +211700 05 WS-4DCO-PR-LIB-F8-R REDEFINES WS-4DCO-PREL-LIB-F8 ! +211800 PIC S9(13)V9(02) COMP-3. ! +211900 05 WS-4DCO-MT-PV-FI01-R PIC S9(15) COMP-3. ! +212000* ! +212100 05 WS-4DCO-MT-PV-FI01 REDEFINES WS-4DCO-MT-PV-FI01-R ! +212200 PIC S9(13)V9(02) COMP-3. ! +212300 05 WS-4DCO-MT-PV-FI02-R PIC S9(15) COMP-3. ! +212400* ! +212500 05 WS-4DCO-MT-PV-FI02 REDEFINES WS-4DCO-MT-PV-FI02-R ! +212600 PIC S9(13)V9(02) COMP-3. ! +212700 05 WS-4DCO-TY-CPT-PER PIC X(1). ! +212800* indicateur pr�cisant le type de contrat PER ! +212900* mixte = type 1,2,3,5 ! +213000* assurance = type 4,6 ! +213100 05 WS-4DCO-RC-DA-BSC-EF PIC X(08). ! +213200* DATE EFFET DERNIER BASCULEMENT ! +213300 05 WS-4DCO-RC-DA-ECN-PROR PIC X(08). ! +213400* DATE ECHEANCE PROROGATION ! +213500 05 WS-4DCO-CREAT-RPP PIC X(1). ! +213600* indicateur pour savoir si on est en cr�ation de RPP ! +213700* prend la valeur 'c' qd on est en mise en place de rpp ! +213800 05 WS-4DCO-SLD-TPS-REAL PIC S9(15) COMP-3. ! +213900* Montant reserv� pour appel y4g140 ! +214000 05 WS-4DCO-DMP-AAMM PIC X(4). ! +214100* dmp sous forme AAMM ! +214200 05 WS-4DCO-RC-TY-RCH PIC X(01). ! +214300* type de rachat (normal,conversion de rente,terme) ! +214400 05 WS-4DCO-RC-lib-TY-RCH PIC X(32). ! +214500* type de rachat (normal,conversion de rente,terme) ! +214600 05 WS-4DCO-PREL-CTB-RC PIC S9(15) COMP-3. ! +214700 05 WS-4DCO-PR-CTB-RC-R REDEFINES WS-4DCO-PREL-CTB-RC ! +214800 PIC S9(13)V9(02) COMP-3. ! +214900 05 WS-4DCO-RC-IDC-EDI-CM PIC X(01). ! +215000* indicateur edition cheque ccm ! +215100 05 WS-4DCO-RC-CD-PER-VER-PER PIC X(01). ! +215200* indicateur code p�riodicit� vp ! +215300* ! +215400 05 WS-4DCO-RC-DA-NXT-VER-PER. ! +215500* DATE PROCHAIN V.P. ! +215600 15 WS-4DCO-RC-DA-NXT-VER-PER-A PIC X(004). ! +215700* SIECLE ANNEE DATE PROCHAIN V.P. ! +215800 15 WS-4DCO-RC-DA-NXT-VER-PER-M PIC X(002). ! +215900* MOIS DATE PROCHAIN V.P. ! +216000 15 WS-4DCO-RC-DA-NXT-VER-PER-J PIC X(002). ! +216100* JOUR DATE PROCHAIN V.P. ! +216200 05 WS-4DCO-RC-CD-TY-TRT PIC X(1). ! +216300* CODE TYPE DE TRAITEMENT (P4DGQ0) ! +216400* 'V' : 'VERSEMENT A ECHEANCE ! +216500* 'D' : 'DEMANDE DE VERSEMENT A ECHEANCE' ! +216600* 'R' : 'RACHAT TOTAL' ! +216700*--AJOUT INFOS FISCALITE ! +216800 05 WS-4DCO-RC-FISC. ! +216900 15 WS-4DCO-RC-IDC-ETG-CNF PIC X. ! +217000 15 WS-4DCO-RC-CD-OSCE-PAYS PIC X(003). ! +217100 15 WS-4DCO-RC-LIB-PAYS PIC X(20). ! +217200 15 WS-4DCO-RC-CD-CNV PIC X. ! +217300 15 WS-4DCO-RC-TX-PLV-FIS PIC S9(4)V9(3). ! +217400*--FIN AJOUT INFOS FISCALITE ! +217500 05 FILLER PIC X(913). ! +217600* ! +217700* ZONES DISPONIBLES ! +217800* ------------------------------------------------------ * ! +217900 ! +218000*================================================================ ! +218100*= APPLICATION : PARAMETRAGE = ! +218200*================================================================ ! +218300* ! +218400 03 WS-4DCO-4DYA-PRM-OPT REDEFINES WS-4DCO-PROGRAM. ! +218500* ============ ! +218600 ! +218700* ============== ! +218800* ------------------------------------------------------ * ! +218900* COMMAREA : PARAMETRAGE : GESTION DES OPTIONS -* ! +219000* LONGUEUR : 1800 * ! +219100* PREFIXE : WS-4DCO-4DYA * ! +219200* ------------------------------------------------------ * ! +219300* ! +219400 05 WS-4DCO-4DYA-CD-TY-OPT PIC X(3). ! +219500 05 WS-4DCO-4DYA-NO-TY-PRD PIC X(2). ! +219600 05 WS-4DCO-4DYA-CD-PRD PIC X(2). ! +219700 05 WS-4DCO-4DYA-NO-GEN PIC X(3). ! +219800 05 WS-4DCO-4DYA-NO-PRD-PTN PIC X(3). ! +219900 05 WS-4DCO-4DYA-LIB-TY-PRD PIC X(32). ! +220000 05 WS-4DCO-4DYA-NO-TRF PIC 9(9). ! +220100* ! +220200 05 WS-4DCO-4DYA-CREAT. ! +220300 10 WS-4DCO-4DYA-NO-OPT PIC S9(9). ! +220400 10 WS-4DCO-4DYA-DA-DEB PIC X(8). ! +220500 10 WS-4DCO-4DYA-DA-FIN PIC X(8). ! +220600 10 WS-4DCO-4DYA-DEROG PIC X(1). ! +220700* sauve parametres de la liste recue ! +220800 05 WS-4DCO-4DYA-NB-PAG-TS PIC 9(02). ! +220900 05 WS-4DCO-4DYA-NB-OCC-TS PIC S9(4) COMP. ! +221000* sauve numeros items pour lesquels une action est demandee ! +221100 05 WS-4DCO-4DYA-SAUV-ACTION. ! +221200 10 WS-4DCO-4DYA-SAUV-ITEM PIC 9(2) OCCURS 12. ! +221300* indicateur mode de traitement : ! +221400* c=creation, d=consultation, a=annulation, m=modification ! +221500 05 WS-4DCO-4DYA-IDC-MOD-TRT PIC X(01). ! +221600 88 WS-4DCO-4DYA-CRE VALUE 'C'. ! +221700 88 WS-4DCO-4DYA-DET VALUE 'D'. ! +221800 88 WS-4DCO-4DYA-ANN VALUE 'A'. ! +221900 88 WS-4DCO-4DYA-MOD VALUE 'M'. ! +222000* code type option de cr�ation ! +222100 05 WS-4DCO-4DYA-CD-TY-OPT-C PIC X(3). ! +222200* code type option de liste ! +222300 05 WS-4DCO-4DYA-CD-TY-OPT-L PIC X(3). ! +222400* numero de partenaire ! +222500 05 WS-4DCO-4DYA-NO-PTN PIC 9(3). ! +222600* gestion du mode : param�trage des options ou des frais ! +222700 05 WS-4DCO-4DYA-FRS-OPT PIC X(01). ! +222800 88 WS-4DCO-4DYA-FRS VALUE 'F'. ! +222900 88 WS-4DCO-4DYA-OPT VALUE 'O'. ! +223000* ! +223100 05 FILLER PIC X(1679). ! +223200* ! +223300* ! +223400 03 WS-4DCO-4DYF-PRM-TRF REDEFINES WS-4DCO-PROGRAM. ! +223500* ============ ! +223600 ! +223700* ============== ! +223800* ------------------------------------------------------ * ! +223900* COMMAREA : PARAMETRAGE : GESTION DES TARIFS -* ! +224000* LONGUEUR : 1800 * ! +224100* PREFIXE : WS-4DCO-4DYF * ! +224200* ------------------------------------------------------ * ! +224300* ! +224400* code type tarif ! +224500 05 WS-4DCO-4DYF-CD-TY-TRF PIC X(2). ! +224600* num�ro de tarif ! +224700 05 WS-4DCO-4DYF-NO-TRF PIC 9(9). ! +224800* indicateur mode de traitement : ! +224900* c=creation, d=consultation, a=annulation, m=modification ! +225000 05 WS-4DCO-4DYF-IDC-MOD-TRT PIC X(01). ! +225100 88 WS-4DCO-4DYF-CRE VALUE 'C'. ! +225200 88 WS-4DCO-4DYF-DET VALUE 'D'. ! +225300 88 WS-4DCO-4DYF-ANN VALUE 'A'. ! +225400 88 WS-4DCO-4DYF-MOD VALUE 'M'. ! +225500* code type tarif de cr�ation ! +225600 05 WS-4DCO-4DYF-CD-TY-TRF-C PIC X(2). ! +225700* code type tarif de liste ! +225800 05 WS-4DCO-4DYF-CD-TY-TRF-L PIC X(2). ! +225900* ! +226000 05 FILLER PIC X(1784). ! +226100* ! +226200* ! +226300 03 WS-4DCO-4DYU-PRM-GAR REDEFINES WS-4DCO-PROGRAM. ! +226400* ============ ! +226500 ! +226600* ============== ! +226700* ------------------------------------------------------ * ! +226800* COMMAREA : PARAMETRAGE : GESTION DES GARANTIES -* ! +226900* LONGUEUR : 1800 * ! +227000* PREFIXE : WS-4DCO-4DYU * ! +227100* ------------------------------------------------------ * ! +227200* ! +227300 05 WS-4DCO-4DYU-CD-TY-GAR PIC X(3). ! +227400 05 WS-4DCO-4DYU-IDT-GAR PIC X(8). ! +227500 05 WS-4DCO-4DYU-NO-TY-PRD PIC X(2). ! +227600 05 WS-4DCO-4DYU-CD-PRD PIC X(2). ! +227700 05 WS-4DCO-4DYU-NO-GEN PIC X(3). ! +227800 05 WS-4DCO-4DYU-NO-PRD-PTN PIC X(3). ! +227900 05 WS-4DCO-4DYU-LIB-TY-PRD PIC X(32). ! +228000 05 WS-4DCO-4DYU-NO-TRF PIC 9(9). ! +228100* ! +228200 05 WS-4DCO-4DYU-CREAT. ! +228300 10 WS-4DCO-4DYU-NO-OPT PIC S9(9). ! +228400 10 WS-4DCO-4DYU-DA-DEB PIC X(8). ! +228500 10 WS-4DCO-4DYU-DA-FIN PIC X(8). ! +228600 10 WS-4DCO-4DYU-DEROG PIC X(1). ! +228700* sauve parametres de la liste recue ! +228800 05 WS-4DCO-4DYU-NB-PAG-TS PIC 9(02). ! +228900 05 WS-4DCO-4DYU-NB-OCC-TS PIC S9(4) COMP. ! +229000* sauve numeros items pour lesquels une action est demandee ! +229100 05 WS-4DCO-4DYU-SAUV-ACTION. ! +229200 10 WS-4DCO-4DYU-SAUV-ITEM PIC 9(2) OCCURS 12. ! +229300* indicateur mode de traitement : ! +229400* c=creation, d=consultation, a=annulation, m=modification ! +229500 05 WS-4DCO-4DYU-IDC-MOD-TRT PIC X(01). ! +229600 88 WS-4DCO-4DYU-CRE VALUE 'C'. ! +229700 88 WS-4DCO-4DYU-DET VALUE 'D'. ! +229800 88 WS-4DCO-4DYU-ANN VALUE 'A'. ! +229900 88 WS-4DCO-4DYU-MOD VALUE 'M'. ! +230000* code type option de cr�ation ! +230100 05 WS-4DCO-4DYU-CD-TY-GAR-C PIC X(3). ! +230200* code type option de liste ! +230300 05 WS-4DCO-4DYU-CD-TY-GAR-L PIC X(3). ! +230400* numero de partenaire ! +230500 05 WS-4DCO-4DYU-NO-PTN PIC 9(3). ! +230600* ! +230700 05 FILLER PIC X(1674). ! +230800* ! +230900* ! +231000*================================================================ ! +231100*= APPLICATION : prime etat (certificat non imposition) = ! +231200*================================================================ ! +231300* ! +231400 03 WS-4DCO-4DPS-PRM-ETAT REDEFINES WS-4DCO-PROGRAM. ! +231500* ============ ! +231600 ! +231700* ============== ! +231800* ------------------------------------------------------ * ! +231900* COMMAREA : PARAMETRAGE : GESTION DE LA PRIME ETAT -* ! +232000* LONGUEUR : 1800 * ! +232100* PREFIXE : WS-4DCO-4DPS * ! +232200* ------------------------------------------------------ * ! +232300* ! +232400* ZONES COMMUNES ! +232500* ! +232600 05 WS-4DCO-4DPS. ! +232700* ! +232800* ZONE DE PAGINATION ! +232900 15 WS-4DCO-4DPS-PAGE. ! +233000 20 WS-4DCO-4DPS-IDC-OCC-SPL PIC X(001). ! +233100 20 WS-4DCO-4DPS-NB-PAG-TS PIC 9(002). ! +233200 20 WS-4DCO-4DPS-SAUV-PAGE-AREA PIC X(198). ! +233300* ! +233400* ACTION SAUVEGARDEE ! +233500 15 WS-4DCO-4DPS-SAUV-ACT PIC X. ! +233600* ! +233700* CODE MESSAGE ERREUR ! +233800 15 WS-4DCO-4DPS-ERRMSG1 PIC X(006). ! +233900* ! +234000* NOMBRE D'OCCURENCES DE LA LISTE ! +234100 15 WS-4DCO-4DPS-NB-TS-ITEM PIC S9(04) COMP. ! +234200* ! +234300* POSITION DU CURSEUR DU 1ER DETAIL DEMANDE ! +234400 15 WS-4DCO-4DPS-POS-CURSOR PIC 9(002). ! +234500* NB DE DETAILS TRAITES ! +234600 15 WS-4DCO-4DPS-SAUV-ACT-TRT PIC S9(4) COMP. ! +234700* NB DE DETAILS DEMANDES ! +234800 15 WS-4DCO-4DPS-SAUV-ACT-NB PIC S9(4) COMP. ! +234900 15 WS-4DCO-4DPS-DA-OUV. ! +235000* DATE OUVERTURE CONTRAT ! +235100 20 WS-4DCO-4DPS-DA-OUV-A PIC 9(4). ! +235200 20 WS-4DCO-4DPS-DA-OUV-M PIC 9(2). ! +235300 20 WS-4DCO-4DPS-DA-OUV-J PIC 9(2). ! +235400 15 WS-4DCO-4DPS-DA-DEM. ! +235500* DATE DU JOUR ! +235600 20 WS-4DCO-4DPS-DA-DEM-A PIC 9(4). ! +235700 20 WS-4DCO-4DPS-DA-DEM-M PIC 9(2). ! +235800 20 WS-4DCO-4DPS-DA-DEM-J PIC 9(2). ! +235900 15 WS-4DCO-4DPS-CD-MTF-DEM PIC X(30). ! +236000 15 WS-4DCO-4DPS-CD-MTF PIC 9(02). ! +236100 15 WS-4DCO-4DPS-TY-TRF PIC X(2). ! +236200 15 WS-4DCO-4DPS-MT-PRIM-PEP PIC S9(13)V99 COMP-3. ! +236300 15 WS-4DCO-4DPS-MT-ITT-PRIM PIC S9(13)V99 COMP-3. ! +236400 15 WS-4DCO-4DPS-MT-PRIM-PLUS PIC S9(13)V99 COMP-3. ! +236500 15 WS-4DCO-4DPS-MT-PRIM-SANS PIC S9(13)V99 COMP-3. ! +236600 15 WS-4DCO-4DPS-MT-CRDS PIC S9(09)V99 COMP-3. ! +236700 15 WS-4DCO-4DPS-NB-EXE-CCN PIC 9(02). ! +236800 15 WS-4DCO-4DPS-AN-MAX PIC 9(02). ! +236900 15 WS-4DCO-4DPS-CD-ANOM PIC X(01). ! +237000 15 WS-4DCO-4DPS-MES-ANOM PIC X(32). ! +237100 15 WS-4DCO-4DPS-TAB. ! +237200 20 WS-4DCO-4DPS-POSTE OCCURS 10. ! +237300 22 WS-4DCO-4DPS-IND-LG PIC X(001). ! +237400* indicateur de ligne siginificative ! +237500 22 WS-4DCO-4DPS-CDIMT PIC X(001). ! +237600* indic. etat demande prime ecran ! +237700 22 WS-4DCO-4DPS-CDIMT-PREC PIC X(001). ! +237800* indic. etat demande prime precedent ! +237900 22 WS-4DCO-4DPS-A-ACQ-PRIM PIC X(004). ! +238000 22 WS-4DCO-4DPS-MT-GLB-PRIM ! +238100 PIC S9(13)V99 COMP-3. ! +238200 22 WS-4DCO-4DPS-MT-GLB-ITT-PRIM ! +238300 PIC S9(13)V99 COMP-3. ! +238400 22 WS-4DCO-4DPS-MT-ASST-CRDS ! +238500 PIC S9(13)V99 COMP-3. ! +238600 22 WS-4DCO-4DPS-MT-ASST-CSG ! +238700 PIC S9(13)V99 COMP-3. ! +238800 22 WS-4DCO-4DPS-MT-ASST-SOC ! +238900 PIC S9(13)V99 COMP-3. ! +239000 22 WS-4DCO-4DPS-DT-DEM. ! +239100* DATE DE DEMANDE ! +239200 25 WS-4DCO-4DPS-DT-DEM-A PIC 9(4). ! +239300 25 WS-4DCO-4DPS-DT-DEM-M PIC 9(2). ! +239400 25 WS-4DCO-4DPS-DT-DEM-J PIC 9(2). ! +239500 15 WS-4DCO-4DPS-TX-CRDS PIC S9(02)V999 COMP-3. ! +239600 15 WS-4DCO-4DPS-TX-CSG PIC S9(02)V999 COMP-3. ! +239700 15 WS-4DCO-4DPS-TX-PLV-SOC PIC S9(02)V999 COMP-3. ! +239800* taux crds et csg et ps ! +239900 15 WS-4DCO-4DPS-TOT-ASST-CRDS PIC S9(13)V99 COMP-3. ! +240000 15 WS-4DCO-4DPS-TOT-ASST-CSG PIC S9(13)V99 COMP-3. ! +240100 15 WS-4DCO-4DPS-TOT-ASST-SOC PIC S9(13)V99 COMP-3. ! +240200* cumul assiettes sur une annee ! +240300 15 WS-4DCO-4DPS-MT-VER-RDS PIC S9(13)V99 COMP-3. ! +240400 15 WS-4DCO-4DPS-MT-CSG PIC S9(13)V99 COMP-3. ! +240500 15 WS-4DCO-4DPS-MT-PLV-SOC PIC S9(13)V99 COMP-3. ! +240600* montants crds et csg et ps ! +240700 15 WS-4DCO-4DPU-LIBOPE PIC X(42). ! +240800 15 WS-4DCO-4DPU-LIBTOT PIC X(20). ! +240900 15 WS-4DCO-4DPU-TOT-GEN PIC S9(13)V99 COMP-3. ! +241000* ! +241100 15 WS-4DCO-4DPS-DA-ORIG. ! +241200* DATE OUVERTURE CONTRAT BQUE ORIGINE ! +241300 20 WS-4DCO-4DPS-DA-ORI-A PIC 9(4). ! +241400 20 WS-4DCO-4DPS-DA-ORI-M PIC 9(2). ! +241500 20 WS-4DCO-4DPS-DA-ORI-J PIC 9(2). ! +241600 05 FILLER PIC X(0774). ! +241700* ! +241800************************************ NOMBRE PRIS 216 ! +241900************************************ NOMBRE DISPONIBLE 1584 ! +242000 ! +242100 03 WS-4DCO-OPTION-VETRF REDEFINES WS-4DCO-PROGRAM. ! +242200* ==================== ! +242300* ------------------------------------------------------ * ! +242400* COMMAREA : TRANSFERT PER => PEP * ! +242500* LONGUEUR : 1800 * ! +242600* PREFIXE : WS-4DCO- * ! +242700* ------------------------------------------------------ * ! +242800 ! +242900 05 WS-4DCO-DSPEPT. ! +243000* DATE SOUSCRIPTION PEP ! +243100 10 WS-4DCO-DSPEPTSA. ! +243200* SIECLE ANNEE DATE SOUSCRIPTION PEP ! +243300 15 WS-4DCO-DSPEPTS PIC X(002). ! +243400* SIECLE DATE SOUSCRIPTION PEP ! +243500 15 WS-4DCO-DSPEPTA PIC X(002). ! +243600* ANNEE DATE SOUSCRIPTION PEP ! +243700 10 WS-4DCO-DSPEPTM PIC X(002). ! +243800* MOIS DATE SOUSCRIPTION PEP ! +243900 10 WS-4DCO-DSPEPTJ PIC X(002). ! +244000* JOUR DATE SOUSCRIPTION PEP ! +244100 05 WS-4DCO-DSPERT. ! +244200* DATE SOUSCRIPTION PER ! +244300 10 WS-4DCO-DSPERTSA. ! +244400* SIECLE ANNEE DATE SOUSCRIPTION PER ! +244500 15 WS-4DCO-DSPERTS PIC X(002). ! +244600* SIECLE DATE SOUSCRIPTION PER ! +244700 15 WS-4DCO-DSPERTA PIC X(002). ! +244800* ANNEE DATE SOUSCRIPTION PER ! +244900 10 WS-4DCO-DSPERTM PIC X(002). ! +245000* MOIS DATE SOUSCRIPTION PER ! +245100 10 WS-4DCO-DSPERTJ PIC X(002). ! +245200* JOUR DATE SOUSCRIPTION PER ! +245300 05 WS-4DCO-NOMT PIC X(032). ! +245400* NOM ! +245500 05 WS-4DCO-CPT-PER. ! +245600* NO CPTE PER ! +245700 10 WS-4DCO-CCMPERT PIC X(004). ! +245800* CAISSE NO CPTE PER ! +245900 10 WS-4DCO-RACPERT PIC X(007). ! +246000* RACINE NO CPTE PER ! +246100 10 WS-4DCO-CLEPERT PIC X(001). ! +246200* CLE NO CPTE PER ! +246300 10 WS-4DCO-CATPERT PIC X(002). ! +246400* CATEGORIE NO CPTE PER ! +246500 10 WS-4DCO-RNGPERT PIC X(002). ! +246600* RANG NO CPTE PER ! +246700 05 WS-4DCO-CPT-PEP. ! +246800* NO CPTE PEP ! +246900 10 WS-4DCO-CCMPEPT PIC X(004). ! +247000* CAISSE NO CPTE PEP ! +247100 10 WS-4DCO-RACPEPT PIC X(007). ! +247200* RACINE NO CPTE PEP ! +247300 10 WS-4DCO-CLEPEPT PIC X(001). ! +247400* CLE NO CPTE PEP ! +247500 10 WS-4DCO-CATPEPT PIC X(002). ! +247600* CATEGORIE NO CPTE PEP ! +247700 10 WS-4DCO-RNGPEPT PIC X(002). ! +247800* RANG NO CPTE PEP ! +247900 05 WS-4DCO-SOLDPEPT PIC S9(13)V9(02). ! +248000* SOLDE TP COMPTE PEP ! +248100 05 WS-4DCO-SOLDPEPT-C REDEFINES WS-4DCO-SOLDPEPT ! +248200 PIC S9(15). ! +248300* SOLDE TP COMPTE PEP ! +248400 05 WS-4DCO-BQEPERT PIC X(005). ! +248500* BANQUE COMPTE PER ! +248600 05 FILLER PIC X(1700). ! +248700* ZONES DISPONIBLES ! +248800* ------------------------------------------------------ * ! +248900 ! +249000 03 WS-4DCO-TRANS-SORTIE REDEFINES WS-4DCO-PROGRAM. ! +249100* ==================== ! +249200* ------------------------------------------------------ * ! +249300* COMMAREA : TRANSFERT EN SORTIE * ! +249400* LONGUEUR : 1800 * ! +249500* PREFIXE : WS-4DCO-TFS * ! +249600* ------------------------------------------------------ * ! +249700 ! +249800 05 WS-4DCO-TFS-INFOS-AUTRE-ETBL. ! +249900* ZONES ECRAN "INFO. AUTRE ETABLISSEMENT" ! +250000 10 WS-4DCO-TFS-CD-DEST-TRF PIC X(001). ! +250100* CODE DESTINATAIRE DU TRANSFERT ! +250200 10 WS-4DCO-TFS-CPT-DEST. ! +250300* RIB CPTE DESTINATAIRE ! +250400 15 WS-4DCO-TFS-BNQ-DEST PIC X(005). ! +250500* BANQUE RIB CPTE DESTINATAIRE ! +250600 15 WS-4DCO-TFS-GCH-DEST PIC X(005). ! +250700* GUICHET RIB CPTE DESTINATAIRE ! +250800 15 WS-4DCO-TFS-RAC-DEST PIC X(011). ! +250900* RACINE RIB CPTE DESTINATAIRE ! +251000 15 WS-4DCO-TFS-CLE-DEST PIC X(002). ! +251100* CLE RIB CPTE DESTINATAIRE ! +251200 10 WS-4DCO-TFS-ETA-DEST PIC X(032). ! +251300* NOM DE L'ETABLISSEMENT DESTINATAIRE ! +251400 10 WS-4DCO-TFS-AGC-DEST PIC X(032). ! +251500* NOM DE L'AGENCE DESTINATAIRE ! +251600 10 WS-4DCO-TFS-ADR-DEST. ! +251700* ADRESSE ETABL. DESTINATAIRE ! +251800 15 WS-4DCO-TFS-RUE-DEST PIC X(032). ! +251900* RUE / ADRESSE ETABL. DESTINATAIRE ! +252000 15 WS-4DCO-TFS-CDP-DEST PIC X(005). ! +252100* CODE POSTAL / ADRESSE ETABL. DESTINATAIRE ! +252200 15 WS-4DCO-TFS-BRD-DEST PIC X(026). ! +252300* COMMUNE / ADRESSE ETABL. DESTINATAIRE ! +252400 10 WS-4DCO-TFS-NB-PASSAGES PIC 9(01). ! +252500* NOMBRE DE PASSAGES ! +252600 10 WS-4DCO-TFS-NO-CTR PIC X(006). ! +252700* NUMERO DE CONTRAT ! +252800 10 WS-4DCO-4DHL-IDC-EPG-HCP PIC X(001). ! +252900* FLAG �pargne handicap ! +253000 10 WS-4DCO-TFS-DECHE. ! +253100* DATE ECHEANCE CONTRAT ! +253200 15 WS-4DCO-TFS-DECHESA. ! +253300* SIECLE ANNEE DATE ECHEANCE ! +253400 20 WS-4DCO-TFS-DECHES PIC X(002). ! +253500* SIECLE DATE ECHEANCE ! +253600 20 WS-4DCO-TFS-DECHEA PIC X(002). ! +253700* ANNEE DATE ECHEANCE ! +253800 15 WS-4DCO-TFS-DECHEM PIC X(002). ! +253900* MOIS DATE ECHEANCE ! +254000 15 WS-4DCO-TFS-DECHEJ PIC X(002). ! +254100* JOUR DATE ECHEANCE ! +254200 10 FILLER PIC X(033). ! +254300* ZONES DISPONIBLES ! +254400 05 WS-4DCO-TFS-SIMULATION. ! +254500* ZONES ECRAN "SIMULATION" ! +254600 10 WS-4DCO-TFS-OPE. ! +254700* DATE OPERATION ! +254800 15 WS-4DCO-TFS-OPESA. ! +254900* SIECLE ANNEE DATE OPERATION ! +255000 20 WS-4DCO-TFS-OPESS PIC X(002). ! +255100* SIECLE DATE OPERATION ! +255200 20 WS-4DCO-TFS-OPEAA PIC X(002). ! +255300* ANNEE DATE OPERATION ! +255400 15 WS-4DCO-TFS-OPEMM PIC X(002). ! +255500* MOIS DATE OPERATION ! +255600 15 WS-4DCO-TFS-OPEJJ PIC X(002). ! +255700* JOUR DATE OPERATION ! +255800 10 WS-4DCO-TFS-EFF. ! +255900* DATE EFFET ! +256000 15 WS-4DCO-TFS-EFFSA. ! +256100* SIECLE ANNEE DATE EFFET ! +256200 20 WS-4DCO-TFS-EFFSS PIC X(002). ! +256300* SIECLE DATE EFFET ! +256400 20 WS-4DCO-TFS-EFFAA PIC X(002). ! +256500* ANNEE DATE EFFET ! +256600 15 WS-4DCO-TFS-EFFMM PIC X(002). ! +256700* MOIS DATE EFFET ! +256800 15 WS-4DCO-TFS-EFFJJ PIC X(002). ! +256900* JOUR DATE EFFET ! +257000 10 WS-4DCO-TFS-MT-IK PIC S9(15) COMP-3. ! +257100* INTERETS CAPITALISES ! +257200 10 WS-4DCO-TFS-MT-IK-R REDEFINES WS-4DCO-TFS-MT-IK ! +257300 PIC S9(13)V9(02) COMP-3. ! +257400* INTERETS CAPITALISES ! +257500 10 WS-4DCO-TFS-PEN-IK PIC S9(15) COMP-3. ! +257600* PENALITES TRANSFERT SUR INT. CAPITALISES ! +257700 10 WS-4DCO-TFS-PEN-IK-R REDEFINES WS-4DCO-TFS-PEN-IK ! +257800 PIC S9(13)V9(02) COMP-3. ! +257900* PENALITES TRANSFERT SUR INT. CAPITALISES ! +258000 10 WS-4DCO-TFS-MT-GLO PIC S9(15) COMP-3. ! +258100* MONTANT GLOBAL DU TRANSFERT EN SORTIE ! +258200 10 WS-4DCO-TFS-MT-GLO-R REDEFINES WS-4DCO-TFS-MT-GLO ! +258300 PIC S9(13)V9(02) COMP-3. ! +258400* MONTANT GLOBAL DU TRANSFERT EN SORTIE ! +258500 10 WS-4DCO-TFS-CPT-CRE. ! +258600* RIB CPTE CREDITE ! +258700 15 WS-4DCO-TFS-BNQ-CRE PIC X(005). ! +258800* BANQUE RIB CPTE CREDITE ! +258900 15 WS-4DCO-TFS-GCH-CRE PIC X(005). ! +259000* GUICHET RIB CPTE CREDITE ! +259100 15 WS-4DCO-TFS-RAC-CRE PIC X(011). ! +259200* RACINE RIB CPTE CREDITE ! +259300 15 WS-4DCO-TFS-CLE-CRE PIC X(002). ! +259400* CLE RIB CPTE CREDITE ! +259500 10 WS-4DCO-TFS-PRIME OCCURS 10. ! +259600* MONTANT NET DES VERSEMENTS PAR ANNEE ! +259700 15 WS-4DCO-TFS-A-ACQ-PRM PIC X(004). ! +259800* ! +259900 15 WS-4DCO-TFS-TOT-VR-EX PIC S9(09) COMP-3. ! +260000* ! +260100 15 WS-4DCO-TFS-TOT-VR-EX-R REDEFINES ! +260200 WS-4DCO-TFS-TOT-VR-EX ! +260300 PIC S9(07)V9(02) COMP-3. ! +260400* ! +260500 10 WS-4DCO-TFS-DA-PAS-PAB. ! +260600* DATE PASSAGE PAB ! +260700 15 WS-4DCO-TFS-DA-PAS-PAB-SA. ! +260800* SIECLE ANNEE DATE PASSAGE PAB ! +260900 20 WS-4DCO-TFS-DA-PAS-PAB-SS PIC X(002). ! +261000* SIECLE DATE PASSAGE PAB ! +261100 20 WS-4DCO-TFS-DA-PAS-PAB-AA PIC X(002). ! +261200* ANNEE DATE PASSAGE PAB ! +261300 15 WS-4DCO-TFS-DA-PAS-PAB-MM PIC X(002). ! +261400* MOIS DATE PASSAGE PAB ! +261500 15 WS-4DCO-TFS-DA-PAS-PAB-JJ PIC X(002). ! +261600* JOUR DATE PASSAGE PAB ! +261700 10 WS-4DCO-TFS-DA-SCR. ! +261800* DATE SOUSCRIPTION ! +261900 15 WS-4DCO-TFS-DA-SCR-SA. ! +262000* SIECLE ANNEE DATE SOUSCRIPTION ! +262100 20 WS-4DCO-TFS-DA-SCR-SS PIC X(002). ! +262200* SIECLE DATE SOUSCRIPTION ! +262300 20 WS-4DCO-TFS-DA-SCR-AA PIC X(002). ! +262400* ANNEE DATE SOUSCRIPTION ! +262500 15 WS-4DCO-TFS-DA-SCR-MM PIC X(002). ! +262600* MOIS DATE SOUSCRIPTION ! +262700 15 WS-4DCO-TFS-DA-SCR-JJ PIC X(002). ! +262800* JOUR DATE SOUSCRIPTION ! +262900 10 WS-4DCO-TFS-DA-EFF-CTR. ! +263000* DATE EFFET CONTRAT ! +263100 15 FILLER PIC X(002). ! +263200* FILLER ! +263300 15 WS-4DCO-TFS-DA-EFF-CTR-A PIC X(002). ! +263400* ANNEE DATE EFFET CONTRAT ! +263500 15 FILLER PIC X(004). ! +263600* FILLER ! +263700 10 WS-4DCO-TFS-CD-PER-VER-PER PIC X(001). ! +263800* CODE PERIODICITE V.P. ! +263900 10 WS-4DCO-TFS-SLD-TPS-REAL PIC S9(15) COMP-3. ! +264000* SOLDE TEMPS REEL ! +264100 10 WS-4DCO-TFS-SLD-TPS-REAL-R ! +264200 REDEFINES ! +264300 WS-4DCO-TFS-SLD-TPS-REAL PIC S9(13)V9(02) COMP-3. ! +264400* ! +264500 10 WS-4DCO-TFS-DA-NXT-VER-PER. ! +264600* DATE PROCHAIN V.P. ! +264700 15 WS-4DCO-TFS-DA-NXT-VER-PER-A PIC X(004). ! +264800* SIECLE ANNEE DATE PROCHAIN V.P. ! +264900 15 WS-4DCO-TFS-DA-NXT-VER-PER-M PIC X(002). ! +265000* MOIS DATE PROCHAIN V.P. ! +265100 15 WS-4DCO-TFS-DA-NXT-VER-PER-J PIC X(002). ! +265200* JOUR DATE PROCHAIN V.P. ! +265300 10 WS-4DCO-TFS-MT-BRT-VER-CTR PIC S9(11) COMP-3. ! +265400* ! +265500 10 WS-4DCO-TFS-DA-ARR-CPB-1 PIC X(008). ! +265600* ! +265700 10 WS-4DCO-TFS-CD-DRG-DA-SCR PIC X(001). ! +265800* ! +265900 10 WS-4DCO-TFS-TX-MIN-GAR-S PIC S9(02)V9(03) COMP-3. ! +266000* ! +266100 10 WS-4DCO-TFS-TX-DNR-PAB-S PIC S9(03)V9(03) COMP-3. ! +266200* ! +266300 10 WS-4DCO-TFS-PRC-PAB-RCH-S PIC S9(03)V9(03) COMP-3. ! +266400* ! +266500 10 WS-4DCO-TFS-TX-MIN-GAR-A PIC S9(02)V9(03) COMP-3. ! +266600* ! +266700 10 WS-4DCO-TFS-TX-DNR-PAB-A PIC S9(03)V9(03) COMP-3. ! +266800* ! +266900 10 WS-4DCO-TFS-PRC-PAB-RCH-A PIC S9(03)V9(03) COMP-3. ! +267000* ! +267100 10 WS-4DCO-TFS-TX-MIN-GAR-A-1 PIC S9(02)V9(03) COMP-3. ! +267200* ! +267300 10 WS-4DCO-TFS-TX-DNR-PAB-A-1 PIC S9(03)V9(03) COMP-3. ! +267400* ! +267500 10 WS-4DCO-TFS-PRC-PAB-RCH-A-1 PIC S9(03)V9(03) COMP-3. ! +267600* ! +267700 10 WS-4DCO-TFS-TX-PNL-ITT-CP-I PIC S9(02)V9(03). ! +267800* ! +267900 10 WS-4DCO-TFS-TX-PNL-ITT-CU-I PIC S9(02)V9(03). ! +268000* ! +268100 10 WS-4DCO-TFS-TX-PNL-ITT-CP-E PIC S9(02)V9(03). ! +268200* ! +268300 10 WS-4DCO-TFS-TX-PNL-ITT-CU-E PIC S9(02)V9(03). ! +268400* ! +268500 10 WS-4DCO-TFS-MT-DASLD OCCURS 26. ! +268600* ZONES DAMIER DES SOLDES EXERCICE ! +268700 15 WS-4DCO-TFS-ENT-QZ PIC S9(15) COMP-3. ! +268800* ! +268900 15 WS-4DCO-TFS-SRT-QZ PIC S9(15) COMP-3. ! +269000* ! +269100 15 WS-4DCO-TFS-SLD-QZ PIC S9(15) COMP-3. ! +269200* ! +269300 10 WS-4DCO-TFS-MT-DASLD-1 OCCURS 26. ! +269400* ZONES DAMIER DES SOLDES EXERCICE -1 ! +269500 15 WS-4DCO-TFS-ENT-QZ-1 PIC S9(15) COMP-3. ! +269600* ! +269700 15 WS-4DCO-TFS-SRT-QZ-1 PIC S9(15) COMP-3. ! +269800* ! +269900 15 WS-4DCO-TFS-SLD-QZ-1 PIC S9(15) COMP-3. ! +270000* ! +270100 10 WS-4DCO-TFS-SLD-RCH PIC S9(15) COMP-3. ! +270200* ! +270300 10 WS-4DCO-TFS-INT-BRT PIC S9(15) COMP-3. ! +270400* ! +270500 10 WS-4DCO-TFS-INT-A-1 PIC S9(15) COMP-3. ! +270600* ! +270700 10 WS-4DCO-TFS-ERR-LEC PIC X(001). ! +270800* FLAG DE RENSEIGNEMENT DE LA COMMAREA ! +270900 10 WS-4DCO-TFS-DRAP-RC PIC X(001). ! +271000* FLAG DE VERSEMENT PERIODIQUE ! +271100* ! +271200 10 WS-4DCO-TFS-TOP-AVN PIC X(001). ! +271300* TOP PRECISANT APPEL P4DAVAN DEJA FAIT ! +271400* ! +271500 10 WS-4DCO-TFS-SLD-AVN PIC S9(15) COMP-3. ! +271600 10 WS-4DCO-TFS-SLD-AVN-R REDEFINES WS-4DCO-TFS-SLD-AVN ! +271700 PIC S9(13)V9(02) COMP-3. ! +271800* ! +271900 10 WS-4DCO-TFS-IF-AVN PIC S9(15) COMP-3. ! +272000 10 WS-4DCO-TFS-IF-AVN-R REDEFINES WS-4DCO-TFS-IF-AVN ! +272100 PIC S9(13)V9(02) COMP-3. ! +272200* ! +272300 10 WS-4DCO-TFS-FA-GES PIC S9(15) COMP-3. ! +272400 10 WS-4DCO-TFS-FA-GES-R REDEFINES WS-4DCO-TFS-FA-GES ! +272500 PIC S9(13)V9(02) COMP-3. ! +272600* ! +272700 10 WS-4DCO-TFS-VRB OCCURS 02. ! +272800 15 WS-4DCO-TFS-TOT-VRB-EX PIC S9(15) COMP-3. ! +272900 15 WS-4DCO-TFS-TOT-VRB-EX-R REDEFINES ! +273000 WS-4DCO-TFS-TOT-VRB-EX PIC S9(13)V9(02) COMP-3. ! +273100* ! +273200 10 WS-4DCO-TFS-MT-FAG PIC S9(15) COMP-3. ! +273300 10 WS-4DCO-TFS-MT-FAG-R REDEFINES WS-4DCO-TFS-MT-FAG ! +273400 PIC S9(13)V9(02) COMP-3. ! +273500* ! +273600* 10 WS-4DCO-TFS-MT-PV PIC S9(15) COMP-3. ! +273700* 10 WS-4DCO-TFS-MT-PV-R REDEFINES WS-4DCO-TFS-MT-PV ! +273800* PIC S9(13)V9(02) COMP-3. ! +273900 10 WS-4DCO-4DHL-MT-PLV-SOC PIC S9(09) COMP-3. ! +274000 10 WS-4DCO-4DHL-MT-PLV-SOC-R REDEFINES ! +274100 WS-4DCO-4DHL-MT-PLV-SOC PIC S9(07)V9(02) COMP-3. ! +274200* mt prel soc ! +274300* ! +274400 10 FILLER PIC X(0010). ! +274500* ZONES DISPONIBLES ! +274600* ------------------------------------------------------ * ! +274700 ! +274800 03 WS-4DCO-DEM-PRIME REDEFINES WS-4DCO-PROGRAM. ! +274900* ================= ! +275000* ------------------------------------------------------ * ! +275100* COMMAREA : DEMANDE DE PRIME DE L'ETAT * ! +275200* LONGUEUR : 1800 * ! +275300* PREFIXE : WS-4DCO-PR- * ! +275400* ------------------------------------------------------ * ! +275500 ! +275600 05 WS-4DCO-PR-IMP-AN-1 PIC X(001). ! +275700* INDIC EXISTENCE DEMANDE SUR ANNEE -1 ! +275800 05 WS-4DCO-PR-IMP-AN PIC X(001). ! +275900* INDIC EXISTENCE DEMANDE ANNEE EN COURS ! +276000 05 WS-4DCO-PR-CPT-DOM. ! +276100* RIB CPTE DOM PRIME D'ETAT ! +276200 10 WS-4DCO-PR-BQE-DOM PIC X(005). ! +276300* BANQUE RIB CPTE DOM PRIME D'ETAT ! +276400 10 WS-4DCO-PR-GUI-DOM PIC X(005). ! +276500* GUICHET RIB CPTE DOM PRIME D'ETAT ! +276600 10 WS-4DCO-PR-RAC-DOM PIC X(011). ! +276700* RACINE RIB CPTE DOM PRIME D'ETAT ! +276800 10 WS-4DCO-PR-CLE-DOM PIC X(002). ! +276900* CLE RIB CPTE DOM PRIME D'ETAT ! +277000 05 WS-4DCO-PR-TAB-TRAV. ! +277100* TABLE DES 10 EXERCICES DU COMPTE ! +277200 10 WS-4DCO-PR-TAB-POSTE OCCURS 10. ! +277300* ! +277400 15 WS-4DCO-PR-ANNEE PIC 9(04). ! +277500* ! +277600 15 WS-4DCO-PR-VER PIC S9(09) COMP-3. ! +277700* ! +277800 15 WS-4DCO-PR-VER-D REDEFINES WS-4DCO-PR-VER ! +277900 PIC S9(07)V9(02) COMP-3. ! +278000* ! +278100 15 WS-4DCO-PR-PRIM PIC S9(09) COMP-3. ! +278200* ! +278300 15 WS-4DCO-PR-PRIM-D REDEFINES WS-4DCO-PR-PRIM ! +278400 PIC S9(07)V9(02) COMP-3. ! +278500* ! +278600 15 WS-4DCO-PR-PRIM-X REDEFINES WS-4DCO-PR-PRIM ! +278700 PIC X(005). ! +278800* ! +278900 15 WS-4DCO-PR-TAUX PIC S9(02)V9(03). ! +279000* ! +279100 15 WS-4DCO-PR-INT PIC S9(09) COMP-3. ! +279200* ! +279300 15 WS-4DCO-PR-INT-D REDEFINES WS-4DCO-PR-INT ! +279400 PIC S9(07)V9(02) COMP-3. ! +279500* ! +279600 15 WS-4DCO-PR-INT-X REDEFINES WS-4DCO-PR-INT ! +279700 PIC X(005). ! +279800* ! +279900 15 WS-4DCO-PR-IMP PIC X(001). ! +280000* ! +280100 15 WS-4DCO-PR-CONF-IMP PIC X(001). ! +280200* ! +280300 15 WS-4DCO-PR-DAT-DEM. ! +280400* ! +280500 20 WS-4DCO-PR-DEM-SA. ! +280600* ! +280700 25 WS-4DCO-PR-DEM-S PIC X(002). ! +280800* ! +280900 25 WS-4DCO-PR-DEM-A PIC X(002). ! +281000* ! +281100 20 WS-4DCO-PR-DEM-M PIC X(002). ! +281200* ! +281300 20 WS-4DCO-PR-DEM-J PIC X(002). ! +281400* ! +281500 15 WS-4DCO-PR-DAT-PAIE. ! +281600* ! +281700 20 WS-4DCO-PR-PAIE-SA. ! +281800* ! +281900 25 WS-4DCO-PR-PAIE-S PIC X(002). ! +282000* ! +282100 25 WS-4DCO-PR-PAIE-A PIC X(002). ! +282200* ! +282300 20 WS-4DCO-PR-PAIE-M PIC X(002). ! +282400* ! +282500 20 WS-4DCO-PR-PAIE-J PIC X(002). ! +282600* ! +282700 05 WS-4DCO-PR-NBRE-EXER PIC 9(02). ! +282800* NBRE EXE CONCERNES PAR DEMANDE DE PRIME ! +282900 05 WS-4DCO-PR-CUM-PRI PIC S9(09) COMP-3. ! +283000* CUMUL DES PRIMES (TOUS EXE CONFONDUS) ! +283100 05 WS-4DCO-PR-CUM-PRI-D REDEFINES WS-4DCO-PR-CUM-PRI ! +283200 PIC S9(07)V9(02) COMP-3. ! +283300* CUMUL DES PRIMES (TOUS EXE CONFONDUS) ! +283400 05 WS-4DCO-PR-CUM-INT PIC S9(09) COMP-3. ! +283500* CUMUL INTERETS PRIMES (TOUS EXE CONFONDUS) ! +283600 05 WS-4DCO-PR-CUM-INT-D REDEFINES WS-4DCO-PR-CUM-INT ! +283700 PIC S9(07)V9(02) COMP-3. ! +283800* CUMUL INTERETS PRIMES (TOUS EXE CONFONDUS) ! +283900 05 WS-4DCO-PR-TOT PIC S9(11) COMP-3. ! +284000* TOTAL GENERAL ! +284100 05 WS-4DCO-PR-TOT-D REDEFINES WS-4DCO-PR-TOT ! +284200 PIC S9(09)V9(02) COMP-3. ! +284300* TOTAL GENERAL ! +284400 05 WS-4DCO-PR-PRI-DEM PIC S9(09) COMP-3. ! +284500* PRIMES DEMANDEES (SUR EXE CONCERNES) ! +284600 05 WS-4DCO-PR-PRI-DEM-D REDEFINES WS-4DCO-PR-PRI-DEM ! +284700 PIC S9(07)V9(02) COMP-3. ! +284800* PRIMES DEMANDEES (SUR EXE CONCERNES) ! +284900 05 WS-4DCO-PR-ITT-DEM PIC S9(09) COMP-3. ! +285000* INTERETS DEMANDES (SUR EXE CONCERNES) ! +285100 05 WS-4DCO-PR-ITT-DEM-D REDEFINES WS-4DCO-PR-ITT-DEM ! +285200 PIC S9(07)V9(02) COMP-3. ! +285300* INTERETS DEMANDES (SUR EXE CONCERNES) ! +285400 05 WS-4DCO-PR-PITT-DEM PIC S9(09) COMP-3. ! +285500* TOTAL PRIME DEMANDEE ! +285600 05 WS-4DCO-PR-PITT-DEM-D REDEFINES WS-4DCO-PR-PITT-DEM ! +285700 PIC S9(07)V9(02) COMP-3. ! +285800* TOTAL PRIME DEMANDEE ! +285900 05 WS-4DCO-PR-IND-AN PIC 9(02). ! +286000* INDICE POSTE ANNEE EN COURS ! +286100 05 WS-4DCO-PR-IND-AN-1 PIC 9(02). ! +286200* INDICE POSTE ANNEE PRECEDENTE ! +286300 05 WS-4DCO-PR-SAISIES PIC X(001). ! +286400* INDIC EXERCICES RESTANT A SAISIR ! +286500 05 WS-4DCO-PR-OK-VALID PIC X(001). ! +286600* INDIC DEMANDE POUR AU MOINS UN EXE ! +286700 05 WS-4DCO-PR-DA-CLO. ! +286800* DATE CLOTURE PEP ! +286900 10 WS-4DCO-PR-DA-CLO-SA. ! +287000* SIECLE ANNEE DATE CLOTURE PEP ! +287100 15 WS-4DCO-PR-DA-CLO-SS PIC 9(02). ! +287200* SIECLE DATE CLOTURE PEP ! +287300 15 WS-4DCO-PR-DA-CLO-AA PIC 9(02). ! +287400* ANNEE DATE CLOTURE PEP ! +287500 10 WS-4DCO-PR-DA-CLO-MM PIC 9(02). ! +287600* MOIS DATE CLOTURE PEP ! +287700 10 WS-4DCO-PR-DA-CLO-JJ PIC 9(02). ! +287800* JOUR DATE CLOTURE PEP ! +287900 05 WS-4DCO-PR-NOM PIC X(32). ! +288000* NOM ET PRENOM DU CONTRAT ! +288100 05 WS-4DCO-PR-IDC-DECES PIC X. ! +288200* INDICATEUR DECES ! +288300 05 WS-4DCO-PR-DA-DECES. ! +288400* DATE DE DECES ! +288500 10 WS-4DCO-PR-DA-DECES-SA. ! +288600* SIECLE ANNEE DATE DECES ! +288700 15 WS-4DCO-PR-DA-DECES-SS PIC 9(02). ! +288800* SIECLE DATE DECES ! +288900 15 WS-4DCO-PR-DA-DECES-AA PIC 9(02). ! +289000* ANNEE DATE DECES ! +289100 10 WS-4DCO-PR-DA-DECES-MM PIC 9(02). ! +289200* MOIS DATE DECES ! +289300 10 WS-4DCO-PR-DA-DECES-JJ PIC 9(02). ! +289400* jour date DECES ! +289500 05 WS-4DCO-PR-TY-PP PIC XX. ! +289600* CODIFICATION PU OU PP ! +289700 05 WS-4DCO-PR-IDC-DEBL-ATP PIC X(1). ! +289800* INDICATEUR DEBLOCAGE ANTICIPE ! +289900 05 WS-4DCO-PR-DA-DEBL-ATP. ! +290000* DATE DEBLOCAGE ANTICIPE ! +290100 10 WS-4DCO-PR-DA-DEBL-ATP-A PIC X(4). ! +290200* DATE DEBLOCAGE ANTICIPE ANNEE ! +290300 10 WS-4DCO-PR-DA-DEBL-ATP-M PIC X(2). ! +290400* DATE DEBLOCAGE ANTICIPE MOIS ! +290500 10 WS-4DCO-PR-DA-DEBL-ATP-J PIC X(2). ! +290600* DATE DEBLOCAGE ANTICIPE JOUR ! +290700 05 WS-4DCO-PR-IDC-DEBL-RCH PIC X(1). ! +290800* INDICATEUR DEBLOCAGE RACHAT ! +290900 05 WS-4DCO-PR-DA-DEBL-RCH. ! +291000* DATE DEBLOCAGE RACHAT ! +291100 10 WS-4DCO-PR-DA-DEBL-RCH-A PIC 9(4). ! +291200* DATE DEBLOCAGE RACHAT ANNEE ! +291300 10 WS-4DCO-PR-DA-DEBL-RCH-M PIC 9(2). ! +291400* DATE DEBLOCAGE RACHAT MOIS ! +291500 10 WS-4DCO-PR-DA-DEBL-RCH-J PIC 9(2). ! +291600* DATE DEBLOCAGE RACHAT JOUR ! +291700*** donnees specifiques au pgm c4dpv0 ! +291800 05 WS-4DCO-4DPV-NO-RIB-DOM. ! +291900* RIB CPTE DOM PRIME D'ETAT ! +292000 10 WS-4DCO-4DPV-CD-BANQUE PIC X(005). ! +292100* BANQUE RIB CPTE DOM PRIME D'ETAT ! +292200 10 WS-4DCO-4DPV-CD-GUICHET PIC X(005). ! +292300* GUICHET RIB CPTE DOM PRIME D'ETAT ! +292400 10 WS-4DCO-4DPV-NO-CPT-RIB PIC X(011). ! +292500* RACINE RIB CPTE DOM PRIME D'ETAT ! +292600 10 WS-4DCO-4DPV-CLE-RIB PIC X(002). ! +292700* CLE RIB CPTE DOM PRIME D'ETAT ! +292800 05 WS-4DCO-4DPV-MODE-RGL PIC X(001). ! +292900* MODE DE REGLEMENT ! +293000 05 WS-4DCO-4DPV-DA-OUV. ! +293100* DATE OUVERTURE CONTRAT ! +293200 10 WS-4DCO-4DPV-DA-OUV-A PIC 9(4). ! +293300 10 WS-4DCO-4DPV-DA-OUV-M PIC 9(2). ! +293400 10 WS-4DCO-4DPV-DA-OUV-J PIC 9(2). ! +293500 05 WS-4DCO-4DPV-DA-PRE. ! +293600* DATE PRESCRIPTION DU CONTRAT ! +293700 10 WS-4DCO-4DPV-DA-PRE-A PIC 9(4). ! +293800 10 WS-4DCO-4DPV-DA-PRE-M PIC 9(2). ! +293900 10 WS-4DCO-4DPV-DA-PRE-J PIC 9(2). ! +294000 05 WS-4DCO-4DPV-CD-FCT PIC X(001). ! +294100 05 WS-4DCO-4DPV-AVNIMP PIC X(001). ! +294200 05 WS-4DCO-4DPT-IDC-DEBL-RCH PIC X(1). ! +294300* INDICATEUR DEBLOCAGE RACHAT ! +294400 05 WS-4DCO-4DPT-DA-DEB. ! +294500* DATE debut deblocage anticipe ! +294600 10 WS-4DCO-4DPV-DA-DEB-A PIC 9(4). ! +294700 10 WS-4DCO-4DPV-DA-DEB-M PIC 9(2). ! +294800 10 WS-4DCO-4DPV-DA-DEB-J PIC 9(2). ! +294900 05 WS-4DCO-4DPT-DA-FIN. ! +295000* DATE fin deblocage anticipe ! +295100 10 WS-4DCO-4DPV-DA-FIN-A PIC 9(4). ! +295200 10 WS-4DCO-4DPV-DA-FIN-M PIC 9(2). ! +295300 10 WS-4DCO-4DPV-DA-FIN-J PIC 9(2). ! +295400 05 WS-4DCO-4DPT-MT-VER-EXE-1 PIC S9(15) COMP-3. ! +295500* Montant de l'exercice N-1 ! +295600 05 FILLER PIC X(1180). ! +295700* ZONES DISPONIBLES ! +295800* ------------------------------------------------------ * ! +295900 ! +296000 03 WS-4DCO-PRIME-4DPR REDEFINES WS-4DCO-PROGRAM. ! +296100* ================== ! +296200* ------------------------------------------------------ * ! +296300* COMMAREA : MODIFICATION CODE MOTIF EXONERATION * ! +296400* LONGUEUR : 1800 * ! +296500* PREFIXE : WS-4DCO-4DPR- * ! +296600* ------------------------------------------------------ * ! +296700 ! +296800 05 WS-4DCO-4DPR-DA-OUV-J PIC XX. ! +296900 05 WS-4DCO-4DPR-DA-OUV-M PIC XX. ! +297000 05 WS-4DCO-4DPR-DA-OUV-A PIC XXXX. ! +297100 05 WS-4DCO-4DPR-TY-PP PIC XX. ! +297200 05 WS-4DCO-4DPR-DA-RACH PIC X(10). ! +297300 05 WS-4DCO-4DPR-CD-DECLA PIC X. ! +297400 05 WS-4DCO-4DPR-CD-EXO PIC X. ! +297500 05 WS-4DCO-4DPR-CD-NEWMTF PIC X. ! +297600 05 WS-4DCO-4DPR-LIB-ITT PIC X(33). ! +297700 05 WS-4DCO-4DPR-LIB-EXO PIC X(33). ! +297800 05 WS-4DCO-4DPR-LIB-NEW PIC X(33). ! +297900 05 FILLER PIC X(1678). ! +298000* ZONES DISPONIBLES ! +298100 ! +298200 03 WS-4DCO-TRF-PEP-PR REDEFINES WS-4DCO-PROGRAM. ! +298300* ================== ! +298400* ------------------------------------------------------ * ! +298500* COMMAREA : TRANSFERT D'UN PEP EN PREVI-RETRAITE * ! +298600* LONGUEUR : 1800 * ! +298700* PREFIXE : WS-4DCO-4DHO- * ! +298800* ------------------------------------------------------ * ! +298900 ! +299000 05 WS-4DCO-4DHO-TRF PIC X(001). ! +299100* INDIC DEMANDE DE TRANSFERT (O/N) ! +299200 05 WS-4DCO-4DHO-SLD PIC S9(15) COMP-3. ! +299300* SOLDE AU TRANSFERT ! +299400 05 WS-4DCO-4DHO-SLD-CPB PIC S9(15) COMP-3. ! +299500* SOLDE COMPTABLE ! +299600 05 WS-4DCO-4DHO-VP-OK PIC X(001). ! +299700* INDIC DELAI VP OK ! +299800 05 WS-4DCO-4DHO-AV-OK PIC X(001). ! +299900* INDIC SOLDE AVANCE OK ! +300000 05 WS-4DCO-4DHO-DA-TRF. ! +300100* DATE D'EFFET DU TRANSFERT ! +300200 10 WS-4DCO-4DHO-DA-TRF-SA PIC 9(004). ! +300300* ANNEE ET SIECLE ! +300400 10 WS-4DCO-4DHO-DA-TRF-MM PIC X(002). ! +300500* MOIS ! +300600 10 WS-4DCO-4DHO-DA-TRF-JJ PIC X(002). ! +300700* JOUR ! +300800 05 WS-4DCO-4DHO-DSOUS. ! +300900* DATE DE SOUSCRIPTION (PEP) ! +301000 10 WS-4DCO-4DHO-ASOUS PIC 9(004). ! +301100* ANNEE ET SIECLE ! +301200 10 WS-4DCO-4DHO-MSOUS PIC X(002). ! +301300* MOIS ! +301400 10 WS-4DCO-4DHO-JSOUS PIC X(002). ! +301500* JOUR ! +301600 05 WS-4DCO-4DHO-MT-TRF PIC S9(15) COMP-3. ! +301700* MONTANT DU TRANSFERT ! +301800 05 WS-4DCO-4DHO-MT-PAB PIC S9(15) COMP-3. ! +301900* MONTANT DES 80 % DE LA PAB ! +302000 05 WS-4DCO-4DHO-CPT-TRF. ! +302100* COMPTE PR ISSU DU TRANSFERT ! +302200 10 WS-4DCO-4DHO-PTN PIC X(003). ! +302300* PARTENAIRE ! +302400 10 WS-4DCO-4DHO-PRD PIC X(003). ! +302500* PRODUIT ! +302600 10 WS-4DCO-4DHO-CLI PIC X(007). ! +302700* CLIENT ! +302800 10 WS-4DCO-4DHO-RNG PIC X(002). ! +302900* RANG ! +303000 05 WS-4DCO-4DHO-NOM PIC X(032). ! +303100* NOM DU CLIENT ! +303200 05 WS-4DCO-4DHO-STR-GTN PIC X(006). ! +303300* N� DE STRUCTURE GESTIONNAIRE DU CONTRAT ! +303400 05 WS-4DCO-4DHO-AGT-GTN PIC X(008). ! +303500* N� DE L'AGENT GESTIONNAIRE DU CONTRAT ! +303600 05 WS-4DCO-4DHO-CD-VER-PER PIC X(001). ! +303700* CODE VERSEMENT PERIODIQUE ! +303800 05 WS-4DCO-4DHO-LIB-IDT-CTR PIC X(016). ! +303900* LIBELLE APPARESSANT DEVANT L'IDENTIFIANT CONTRAT ! +304000 05 WS-4DCO-4DHO-NO-IDT-CTR PIC X(015). ! +304100* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT (68) ! +304200 05 WS-4DCO-4DHO-NO-IDT-CTR-2 PIC X(015). ! +304300* MASQUE D'AFFICHAGE DE L'IDENTIFIANT CONTRAT (76) ! +304400 05 WS-4DCO-4DHO-LIB-PRD-ORI PIC X(032). ! +304500* LIBELLE DU PRODUIT D'ORIGINE ! +304600 05 WS-4DCO-4DHO-NO-POL-PRB PIC X(009). ! +304700* N� DE POLICE PARTENAIRE EXTERIEUR ! +304800 05 WS-4DCO-4DHO-NO-STR-DIS PIC X(006). ! +304900* N� DE STRUCTURE DE DISTRIBUTION ! +305000 05 WS-4DCO-4DHO-NO-ORD-ADR-POST PIC S9(2) COMP-3. ! +305100* N� DE STRUCTURE DE DISTRIBUTION ! +305200 05 WS-4DCO-4DHO-NO-TY-PRD PIC S9(2) COMP-3. ! +305300* N� DU TYPE DE PRODUIT ! +305400 05 WS-4DCO-4DHO-NO-PRD-PTN PIC S9(3) COMP-3. ! +305500* N� DE PRODUIT DU PARTENAIRE ! +305600 05 WS-4DCO-4DHO-NO-ORD-CTR PIC S9(2) COMP-3. ! +305700* N� D'ORDRE DU CONTRAT (RANG) ! +305800 05 WS-4DCO-4DHO-68-GEN-PRD PIC X(003). ! +305900* N� DE GENERATION DE SOUSCRIPTION DU PRODUIT TYPE PEP ! +306000 05 WS-4DCO-4DHO-76-GEN-PRD PIC X(003). ! +306100* N� DE GENERATION EN COURS DU PRODUIT TYPE PREVI-RETRAIT ! +306200 05 WS-4DCO-4DHO-NO-GEN-TY-PRD PIC X(003). ! +306300* N� DE GENERATION DU PRODUIT ! +306400 05 WS-4DCO-4DHO-CD-PRD-ORI PIC X(002). ! +306500* CODE PRODUIT ORIGINE ! +306600 05 FILLER PIC X(1575). ! +306700* ZONES DISPONIBLES ! +306800* GSX ------------------------------------------------------ * ! +306900* ! +307000*================================================================ ! +307100*= APPLICATION : SIMILATION EPARGNE ACQUISE = ! +307200*================================================================ ! +307300* ! +307400 ! +307500 03 WS-4DCO-SIMUL REDEFINES WS-4DCO-PROGRAM. ! +307600* ============= ! +307700* ------------------------------------------------------ * ! +307800* COMMAREA : SIMULATION DE L'EPARGNE ACQUISE * ! +307900* LONGUEUR : 1800 * ! +308000* PREFIXE : WS-4DCO-SIM * ! +308100* ------------------------------------------------------ * ! +308200 ! +308300 05 WS-4DCO-SIM-M4D170A. ! +308400 10 WS-4DCO-SIM-MT-INIB PIC X(16). ! +308500* MONTANT INIT BRUT AFFICHE A L'ECRAN ! +308600 10 WS-4DCO-SIM-MT-INIB-N PIC S9(13)V9(02). ! +308700* MONTANT INITIAL BRUT ! +308800 10 WS-4DCO-SIM-MT-INIB-R REDEFINES ! +308900 WS-4DCO-SIM-MT-INIB-N ! +309000 PIC S9(15). ! +309100* MONTANT INITIAL BRUT ! +309200 10 WS-4DCO-SIM-MT-PERB PIC X(16). ! +309300* MONTANT PERB.BRUT AFFICHE A L'ECRAN ! +309400 10 WS-4DCO-SIM-MT-PERB-N PIC S9(13)V9(02). ! +309500* MONTANT PERIOD. BRUT ! +309600 10 WS-4DCO-SIM-MT-PERB-R REDEFINES ! +309700 WS-4DCO-SIM-MT-PERB-N ! +309800 PIC S9(15). ! +309900* MONTANT PERIODIQUE BRUT ! +310000 10 WS-4DCO-SIM-INDEX PIC X(006). ! +310100* POURCENTAGE INDEX AFFICHE A L'ECRAN ! +310200 10 WS-4DCO-SIM-INDEX-N PIC 9(02)V9(03). ! +310300* POURCENTAGE D'INDEXATION ANNUEL ! +310400 10 WS-4DCO-SIM-INDEX-R REDEFINES WS-4DCO-SIM-INDEX-N ! +310500 PIC 9(05). ! +310600* POURCENTAGE D'INDEXATION ANNUEL ! +310700 10 WS-4DCO-SIM-FREQ PIC X(002). ! +310800* NOMBRE DE VERSEMENT PAR AN ! +310900 10 WS-4DCO-SIM-FREQ-N PIC 9(02). ! +311000* NOMBRE DE VERSEMENT PAR AN ! +311100 10 WS-4DCO-SIM-FRAIS PIC X(006). ! +311200* FRAIS DE SOUSCRIPTION AFFICHE A L'ECRAN ! +311300 10 WS-4DCO-SIM-FRAIS-N PIC 9(02)V9(03). ! +311400* FRAIS DE SOUSCRIPTION ! +311500 10 WS-4DCO-SIM-FRAIS-R REDEFINES WS-4DCO-SIM-FRAIS-N ! +311600 PIC 9(05). ! +311700* FRAIS DE SOUSCRIPTION ! +311800 10 WS-4DCO-SIM-TXGST PIC X(006). ! +311900* TX FRAIS DE GESTION ! +312000 10 WS-4DCO-SIM-TXGST-N PIC 9(02)V9(03). ! +312100* TAUX FRAIS DE GESTION ! +312200 10 WS-4DCO-SIM-TXGST-R REDEFINES WS-4DCO-SIM-TXGST-N ! +312300 PIC 9(05). ! +312400 10 WS-4DCO-SIM-TXVAL PIC X(006). ! +312500* TX ANN DE REVALORISAT AFFICHE A L'ECRAN ! +312600 10 WS-4DCO-SIM-TXVAL-N PIC 9(02)V9(03). ! +312700* TAUX ANNUEL DE REVALORISATION ! +312800 10 WS-4DCO-SIM-TXVAL-R REDEFINES WS-4DCO-SIM-TXVAL-N ! +312900 PIC 9(05). ! +313000* TAUX ANNUEL DE REVALORISATION ! +313100 10 WS-4DCO-SIM-ANVERS PIC X(004). ! +313200* ANNEE DU PREMIER VERSEMENT A L'ECRAN ! +313300 10 WS-4DCO-SIM-ANVERS-N PIC 9(04). ! +313400* ANNEE DU PREMIER VERSEMENT ! +313500 10 WS-4DCO-SIM-DUREE PIC X(003). ! +313600* DUREE DU CONTRAT A L'ECRAN ! +313700 10 WS-4DCO-SIM-DUREE-N PIC 9(03). ! +313800* ANNEE DU CONTRAT ! +313900 10 WS-4DCO-SIM-MT-EPNI PIC X(16). ! +314000* EPARGNE INIT BRUT AFFICHE A L'ECRAN ! +314100 10 WS-4DCO-SIM-MT-EPNI-N PIC S9(13)V9(02). ! +314200* EPARGNE INITIALE BRUTE ! +314300 10 WS-4DCO-SIM-MT-EPNI-R REDEFINES ! +314400 WS-4DCO-SIM-MT-EPNI-N ! +314500 PIC S9(15). ! +314600* PART D'EPARGNE INITIALE BRUTE ! +314700 10 WS-4DCO-SIM-MT-EPNP PIC X(16). ! +314800* EPARGNE INIT BRUT AFFICHE A L'ECRAN ! +314900 10 WS-4DCO-SIM-MT-EPNP-N PIC S9(13)V9(02). ! +315000* EPARGNE PERIODIQUE BRUTE ! +315100 10 WS-4DCO-SIM-MT-EPNP-R REDEFINES ! +315200 WS-4DCO-SIM-MT-EPNP-N ! +315300 PIC S9(15). ! +315400* PART D'EPARGNE PERIODIQUE BRUTE ! +315500 10 WS-4DCO-SIM-TOTVBRUT-N PIC S9(13)V9(02). ! +315600* TOTAL DES VERSEMENTS BRUTS ! +315700 10 WS-4DCO-SIM-TOTEPGN-N PIC S9(13)V9(02). ! +315800* TOTAL DE LA PART D'EPARGNE ! +315900 10 WS-4DCO-SIM-TOTINT-N PIC S9(13)V9(02). ! +316000* TOTAL DES INTERETS ACQUIS ! +316100 10 WS-4DCO-SIM-EPGNFIN-N PIC S9(13)V9(02). ! +316200* EPARGNE ACQUISE AU TERME ! +316300 10 WS-4DCO-SIM-DEST PIC X(32). ! +316400* DESTINATAIRE DE LA SIMULATION ! +316500 10 WS-4DCO-SIM-SOLDE PIC X(16). ! +316600* MONTANT DU SOLDE AFFICHE A L'ECRAN ! +316700 10 WS-4DCO-SIM-SOLDE-N PIC S9(13)V9(02). ! +316800* MONTANT DU SOLDE ! +316900 10 WS-4DCO-SIM-SOLDE-R REDEFINES WS-4DCO-SIM-SOLDE-N ! +317000 PIC S9(15). ! +317100* MONTANT DU SOLDE ! +317200 10 WS-4DCO-SIM-ANFIN PIC X(004). ! +317300* ANNEE DU PREMIER VERSEMENT A L'ECRAN ! +317400 10 WS-4DCO-SIM-ANFIN-N PIC 9(04). ! +317500* ANNEE DU PREMIER VERSEMENT ! +317600 10 WS-4DCO-SIM-NORME-SURAV PIC X. ! +317700* VALEUR DU CODE NORME SURAVENIR ! +317800 05 WS-4DCO-SIM-TABLEAU. ! +317900 10 WS-4DCO-SIM-TANNEE OCCURS 32. ! +318000 15 WS-4DCO-SIM-TANNEE-ELT PIC X(4). ! +318100* ELEMENT ANNEE ! +318200 10 WS-4DCO-SIM-TVBRUT OCCURS 32. ! +318300 15 WS-4DCO-SIM-TVBRUT-ELT PIC S9(13)V99 COMP-3. ! +318400* ELEMENT VERSEMENT BRUT ! +318500 10 WS-4DCO-SIM-TVNET OCCURS 32. ! +318600 15 WS-4DCO-SIM-TVNET-ELT PIC S9(13)V99 COMP-3. ! +318700* ELEMENT VERSEMENT NET ! +318800 10 WS-4DCO-SIM-EPGAC OCCURS 32. ! +318900 15 WS-4DCO-SIM-EPGAC-ELT PIC S9(13)V99 COMP-3. ! +319000* ELEMENT EPARGNE ACQUISE ! +319100 05 WS-4DCO-SIM-M4D170A-SUITE. ! +319200 10 WS-4DCO-SIM-AGEADH PIC X(003). ! +319300* AGE DE L'ADHERENT ! +319400 10 WS-4DCO-SIM-AGEADH-N PIC 9(03). ! +319500* AGE DE L'ADHERENT (NUMERIQUE) ! +319600 10 WS-4DCO-SIM-AGECOR PIC X(003). ! +319700* AGE DE L'ADHERENT ! +319800 10 WS-4DCO-SIM-AGECOR-N PIC 9(03). ! +319900* AGE DE L'ADHERENT (NUMERIQUE) ! +320000 10 WS-4DCO-SIM-RENTNVER-N PIC S9(13)V9(02). ! +320100* TOTAL DE LA RENTE NON REVERSIBLE ! +320200 10 WS-4DCO-SIM-RENTR60-N PIC S9(13)V9(02). ! +320300* TOTAL DE LA RENTE REVERSIBLE A 60% ! +320400 10 WS-4DCO-SIM-RENTR100-N PIC S9(13)V9(02). ! +320500* TOTAL DE LA RENTE REVERSIBLE A 100% ! +320600 10 WS-4DCO-SIM-AGERET PIC X(003). ! +320700* AGE DE LA RETRAITE ! +320800 10 WS-4DCO-SIM-AGERET-N PIC 9(03). ! +320900* AGE DE LA RETRAITE ! +321000 10 WS-4DCO-SIM-MTRENT PIC X(16). ! +321100* MONTANT DE LA RENTE SOUHAITEE ! +321200 10 WS-4DCO-SIM-MTRENT-N PIC S9(13)V9(02). ! +321300* MONTANT DE LA RENTE SOUHAITEE ! +321400 10 WS-4DCO-SIM-MTRENT-R REDEFINES WS-4DCO-SIM-MTRENT-N ! +321500 PIC S9(15). ! +321600* MONTANT DE LA RENTE SOUHAITEE ! +321700 10 WS-4DCO-SIM-TXREV PIC X(003). ! +321800* TX REVERSION RENTE ! +321900 10 WS-4DCO-SIM-TXREV-N PIC 9(03). ! +322000* TAUX REVERSION RENTE ! +322100* ! +322200 05 WS-4DCO-SIM-TABI. ! +322300* OCCURENCE DE TAUX POUR NOUVELLES SIMULATIONS ! +322400 10 WS-4DCO-SIM-VALI PIC 9(3)V9(15) OCCURS 12. ! +322500* TAUX NET PERIODIQUE = (1 + Im) ** (m/12) ! +322600 10 WS-4DCO-SIM-TX-FREQ PIC 9(3)V9(15). ! +322700* TAUX CALCULE SELON LA FREQUENCE DU VP ! +322800 10 WS-4DCO-SIM-VP-NEW PIC S9(09)V9(09). ! +322900* MONTANT DU VP RECALCULE = V' ! +323000 10 WS-4DCO-SIM-EP-NEW PIC S9(09)V9(09). ! +323100* EPARGNE DU VP RECALCULE = E' ! +323200 ! +323300 05 WS-4DCO-SIM-TX-TCH-STD PIC X(06). ! +323400* taux technique ! +323500 05 WS-4DCO-SIM-TX-TCH-STD-N PIC S9(2)V9(3). ! +323600* taux technique ! +323700 05 WS-4DCO-SIM-TX-TCH-STD-R REDEFINES ! +323800 WS-4DCO-SIM-TX-TCH-STD-N PIC 9(05). ! +323900* taux technique ! +324000 05 WS-4DCO-SIM-MT-VP-N PIC S9(13)V9(02). ! +324100* MONTANT DES VERSEMENTS PROGRAMMES ! +324200 05 WS-4DCO-cd-afg-mes PIC x(1). ! +324300* ? ! +324400 05 WS-4DCO-SIM-CD-SEX-RNT PIC X(1). ! +324500* SEXE DU RENTIER ! +324600 05 WS-4DCO-SIM-CD-SEX-COR PIC X(1). ! +324700* SEXE DU CO-RENTIER ! +324800 05 WS-4DCO-SIM-CD-PER PIC X(1). ! +324900* code p�riodicit� ! +325000 05 WS-4DCO-SIM-TX-FRS-GTN PIC X(06). ! +325100* TAUX frais de gestion pour affichage ! +325200 05 WS-4DCO-SIM-TX-FRS-GTN-N PIC 9(3)V9(02). ! +325300* TAUX frais de gestion ! +325400 05 WS-4DCO-SIM-TX-FRS-GTN-R REDEFINES ! +325500 WS-4DCO-SIM-TX-FRS-GTN-N PIC 9(05). ! +325600* TAUX frais de gestion ! +325700* ! +325800 05 FILLER PIC X(0174). ! +325900* ZONES DISPONIBLES ! +326000* ------------------------------------------------------ * ! +326100 ! +326200 03 WS-4DCO-SIMAVC REDEFINES WS-4DCO-PROGRAM. ! +326300* ============== ! +326400* ------------------------------------------------------ * ! +326500* COMMAREA : SIMULATION DE L'EPARGNE ACQUISE (AVANCE) * ! +326600* LONGUEUR : 1800 * ! +326700* PREFIXE : WS-4DCO-SIMAVC * ! +326800* ------------------------------------------------------ * ! +326900 ! +327000 05 WS-4DCO-SIMAVC-M4D171A. ! +327100 10 WS-4DCO-SIMAVC-MT-VIB PIC X(16). ! +327200* MONTANT INIT BRUT AFFICHE A L'ECRAN ! +327300 10 WS-4DCO-SIMAVC-MT-VIBN PIC S9(13)V9(02). ! +327400* MONTANT INITIAL BRUT ! +327500 10 WS-4DCO-SIMAVC-MT-VIBR REDEFINES ! +327600 WS-4DCO-SIMAVC-MT-VIBN ! +327700 PIC S9(15). ! +327800* MONTANT INITIAL BRUT ! +327900 10 WS-4DCO-SIMAVC-FRS PIC X(006). ! +328000* FRAIS DE SOUSCRIPTION AFFICHE A L'ECRAN ! +328100 10 WS-4DCO-SIMAVC-FRS-N PIC 9(02)V9(03). ! +328200* FRAIS DE SOUSCRIPTION ! +328300 10 WS-4DCO-SIMAVC-FRS-R REDEFINES WS-4DCO-SIMAVC-FRS-N ! +328400 PIC 9(05). ! +328500 10 WS-4DCO-SIMAVC-TXGST PIC X(006). ! +328600* TX FRAIS DE GESTION AFFICHE A L'ECRAN ! +328700 10 WS-4DCO-SIMAVC-TXGST-N PIC 9(02)V9(03). ! +328800* TX FRAIS DE GESTION ! +328900 10 WS-4DCO-SIMAVC-TXGST-R REDEFINES ! +329000 WS-4DCO-SIMAVC-TXGST-N PIC 9(05). ! +329100* TX FRAIS DE GESTION ! +329200 10 WS-4DCO-SIMAVC-MTAVC PIC X(16). ! +329300* MONTANT DE L'AVANCE AFFICHE A L'ECRAN ! +329400 10 WS-4DCO-SIMAVC-MTAVCN PIC S9(13)V9(02). ! +329500* MONTANT DE L'AVANCE ! +329600 10 WS-4DCO-SIMAVC-MTAVCR REDEFINES ! +329700 WS-4DCO-SIMAVC-MTAVCN ! +329800 PIC S9(15). ! +329900* MONTANT DE L'AVANCE ! +330000 10 WS-4DCO-SIMAVC-TXAVC PIC X(006). ! +330100* TX DE CROISSANCE DE L'AVANCE AFFICHE ! +330200 10 WS-4DCO-SIMAVC-TXAVCN PIC 9(02)V9(03). ! +330300* TX DE CROISSANCE DE L'AVANCE ! +330400 10 WS-4DCO-SIMAVC-TXAVCR REDEFINES ! +330500 WS-4DCO-SIMAVC-TXAVCN ! +330600 PIC 9(05). ! +330700* TX DE CROISSANCE DE L'AVANCE ! +330800 10 WS-4DCO-SIMAVC-TXRVL PIC X(006). ! +330900* TX ANN DE REVALORISAT AFFICHE A L'ECRAN ! +331000 10 WS-4DCO-SIMAVC-TXRVLN PIC 9(02)V9(03). ! +331100* TAUX ANNUEL DE REVALORISATION ! +331200 10 WS-4DCO-SIMAVC-TXRVLR REDEFINES ! +331300 WS-4DCO-SIMAVC-TXRVLN ! +331400 PIC 9(05). ! +331500* TAUX ANNUEL DE REVALORISATION ! +331600 10 WS-4DCO-SIMAVC-TAUXAV PIC X(006). ! +331700* TAUX DE L'AVANCE AFFICHE A L'ECRAN ! +331800 10 WS-4DCO-SIMAVC-TAUXAVN PIC 9(02)V9(03). ! +331900* TAUX DE L'AVANCE DE L'AVANCE ! +332000 10 WS-4DCO-SIMAVC-TAUXAVR REDEFINES ! +332100 WS-4DCO-SIMAVC-TAUXAVN ! +332200 PIC 9(05). ! +332300* TAUX DE L'AVANCE ! +332400 10 WS-4DCO-SIMAVC-ANVERS PIC X(004). ! +332500* ANNEE DU PREMIER VERSEMENT A L'ECRAN ! +332600 10 WS-4DCO-SIMAVC-ANVERSN PIC 9(04). ! +332700* ANNEE DU PREMIER VERSEMENT ! +332800 10 WS-4DCO-SIMAVC-DUREE PIC X(003). ! +332900* DUREE DU CONTRAT A L'ECRAN ! +333000 10 WS-4DCO-SIMAVC-DUREE-N PIC 9(03). ! +333100* ANNEE DU CONTRAT ! +333200 10 WS-4DCO-SIMAVC-EPN-N PIC S9(13)V9(02). ! +333300* PART D'EPARGNE ! +333400 10 WS-4DCO-SIMAVC-EPND-N PIC S9(13)V9(02). ! +333500* PART D'EPARGNE DISPONIBLE ! +333600 10 WS-4DCO-SIMAVC-ANFIN PIC X(004). ! +333700* ANNEE DE FIN DE CONTRAT AFFICHE ! +333800 10 WS-4DCO-SIMAVC-ANFIN-N PIC 9(04). ! +333900* ANNEE DE FIN DE CONTRAT ! +334000 05 WS-4DCO-SIMAVC-TABLEAU. ! +334100 10 WS-4DCO-SIMAVC-TANNEE OCCURS 21. ! +334200 15 WS-4DCO-SIMAVC-TANNEE-ELT PIC X(4). ! +334300* ELEMENT ANNEE ! +334400 10 WS-4DCO-SIMAVC-EPGERE OCCURS 21. ! +334500 15 WS-4DCO-SIMAVC-EPGERE-ELT PIC S9(13)V99 COMP-3. ! +334600* ELEMENT EPARGNE GERE ! +334700 10 WS-4DCO-SIMAVC-UTAVC OCCURS 21. ! +334800 15 WS-4DCO-SIMAVC-UTAVC-ELT PIC S9(13)V99 COMP-3. ! +334900* ELEMENT UTILISATION AVANCE ! +335000 10 WS-4DCO-SIMAVC-PREV OCCURS 21. ! +335100 15 WS-4DCO-SIMAVC-PREV-ELT PIC S9(13)V99 COMP-3. ! +335200* ELEMENT MONTANT PRELEVEMENT ! +335300 10 WS-4DCO-SIMAVC-BASCA OCCURS 21. ! +335400 15 WS-4DCO-SIMAVC-BASCA-ELT PIC S9(13)V99 COMP-3. ! +335500* ELEMENT BASE DE CALCUL REVALORISATION ! +335600 10 WS-4DCO-SIMAVC-RVLN OCCURS 21. ! +335700 15 WS-4DCO-SIMAVC-RVLN-ELT PIC S9(13)V99 COMP-3. ! +335800* ELEMENT REVALORISATION NETTE ! +335900 10 WS-4DCO-SIMAVC-AVIR OCCURS 21. ! +336000 15 WS-4DCO-SIMAVC-AVIR-ELT PIC S9(13)V99 COMP-3. ! +336100* ELEMENT AVANCE AVEC INT A REMBOURSER ! +336200 10 WS-4DCO-SIMAVC-EPNDIS OCCURS 21. ! +336300 15 WS-4DCO-SIMAVC-EPNDIS-ELT PIC S9(13)V99 COMP-3. ! +336400* ELEMENT EPARGNE DISPONIBLE FIN D'ANNEE ! +336500 10 WS-4DCO-SIMAVC-EPN PIC X(16). ! +336600* PART D'EPARGNE ! +336700 10 WS-4DCO-SIMAVC-EPND PIC X(16). ! +336800* PART D'EPARGNE DISPONIBLE ! +336900 05 WS-4DCO-SIMAVC-NORME-SURAV PIC X. ! +337000* VALEUR DU CODE NORME SURAVENIR ! +337100 05 WS-4DCO-SIMAVC-MTABT PIC X(8). ! +337200 05 WS-4DCO-SIMAVC-MTABTN PIC 9(5)V99. ! +337300 05 FILLER PIC X(0323). ! +337400* ZONES DISPONIBLES ! +337500* ------------------------------------------------------ * ! +337600 ! +337700 03 WS-4DCO-SIMRET REDEFINES WS-4DCO-PROGRAM. ! +337800* ============== ! +337900* ------------------------------------------------------ * ! +338000* COMMAREA : SIMULATION DE L'EPARGNE ACQUISE (RETRAIT) * ! +338100* LONGUEUR : 1800 * ! +338200* PREFIXE : WS-4DCO-SIMRET * ! +338300* ------------------------------------------------------ * ! +338400 ! +338500 05 WS-4DCO-SIMRET-M42172A. ! +338600 10 WS-4DCO-SIMRET-MT-VIB PIC X(16). ! +338700* MONTANT INIT BRUT AFFICHE A L'ECRAN ! +338800 10 WS-4DCO-SIMRET-MT-VIBN PIC S9(13)V9(02). ! +338900* MONTANT INITIAL BRUT ! +339000 10 WS-4DCO-SIMRET-MT-VIBR REDEFINES ! +339100 WS-4DCO-SIMRET-MT-VIBN ! +339200 PIC S9(15). ! +339300* MONTANT INITIAL BRUT ! +339400 10 WS-4DCO-SIMRET-FRS PIC X(006). ! +339500* FRAIS DE SOUSCRIPTION AFFICHE A L'ECRAN ! +339600 10 WS-4DCO-SIMRET-FRS-N PIC 9(02)V9(03). ! +339700* FRAIS DE SOUSCRIPTION ! +339800 10 WS-4DCO-SIMRET-FRS-R REDEFINES ! +339900 WS-4DCO-SIMRET-FRS-N ! +340000 PIC 9(05). ! +340100* FRAIS DE SOUSCRIPTION ! +340200 10 WS-4DCO-SIMRET-MTRET PIC X(16). ! +340300* MONTANT DU RETRAIT AFFICHE A L'ECRAN ! +340400 10 WS-4DCO-SIMRET-MTRETN PIC S9(13)V9(02). ! +340500* MONTANT DU RETRAIT ! +340600 10 WS-4DCO-SIMRET-MTRETR REDEFINES ! +340700 WS-4DCO-SIMRET-MTRETN ! +340800 PIC S9(15). ! +340900* MONTANT DU RETRAIT ! +341000 10 WS-4DCO-SIMRET-TXRET PIC X(006). ! +341100* TX DE CROISSANCE DU RETRAIT AFFICHE ! +341200 10 WS-4DCO-SIMRET-TXRETN PIC 9(02)V9(03). ! +341300* TX DE CROISSANCE DU RETRAIT ! +341400 10 WS-4DCO-SIMRET-TXRETR REDEFINES ! +341500 WS-4DCO-SIMRET-TXRETN ! +341600 PIC 9(05). ! +341700* TX DE CROISSANCE DU RETRAIT ! +341800 10 WS-4DCO-SIMRET-TXRVL PIC X(006). ! +341900* TX ANN DE REVALORISAT AFFICHE A L'ECRAN ! +342000 10 WS-4DCO-SIMRET-TXRVLN PIC 9(02)V9(03). ! +342100* TAUX ANNUEL DE REVALORISATION ! +342200 10 WS-4DCO-SIMRET-TXRVLR REDEFINES ! +342300 WS-4DCO-SIMRET-TXRVLN ! +342400 PIC 9(05). ! +342500 10 WS-4DCO-SIMRET-TXGST PIC X(006). ! +342600* TX ANN DE GESTION AFFICHE A L'ECRAN ! +342700 10 WS-4DCO-SIMRET-TXGSTN PIC 9(02)V9(03). ! +342800* TAUX ANNUEL DE GESTION ! +342900 10 WS-4DCO-SIMRET-TXGSTR REDEFINES ! +343000 WS-4DCO-SIMRET-TXGSTN ! +343100 PIC 9(05). ! +343200* TAUX ANNUEL DE REVALORISATION ! +343300 10 WS-4DCO-SIMRET-ANVERS PIC X(004). ! +343400* ANNEE DU PREMIER VERSEMENT A L'ECRAN ! +343500 10 WS-4DCO-SIMRET-ANVERSN PIC 9(04). ! +343600* ANNEE DU PREMIER VERSEMENT ! +343700 10 WS-4DCO-SIMRET-DUREE PIC X(003). ! +343800* DUREE DU CONTRAT A L'ECRAN ! +343900 10 WS-4DCO-SIMRET-DUREE-N PIC 9(03). ! +344000* ANNEE DU CONTRAT ! +344100 10 WS-4DCO-SIMRET-ANFIN PIC X(004). ! +344200* ANNEE DE FIN DE CONTRAT AFFICHE ! +344300 10 WS-4DCO-SIMRET-ANFIN-N PIC 9(04). ! +344400* ANNEE DE FIN DE CONTRAT ! +344500 10 WS-4DCO-SIMRET-EPNR-N PIC S9(13)V9(02). ! +344600* PART D'EPARGNE RESTANTE ! +344700 05 WS-4DCO-SIMRET-TABLEAU. ! +344800 10 WS-4DCO-SIMRET-TANNEE OCCURS 21. ! +344900 15 WS-4DCO-SIMRET-TANNEE-ELT PIC X(4). ! +345000* ELEMENT ANNEE ! +345100 10 WS-4DCO-SIMRET-EPGAVR OCCURS 21. ! +345200 15 WS-4DCO-SIMRET-EPGAVR-ELT PIC S9(13)V99 COMP-3. ! +345300* ELEMENT EPARGNE AVANT RETRAIT ! +345400 10 WS-4DCO-SIMRET-RPAPI OCCURS 21. ! +345500 15 WS-4DCO-SIMRET-RPAPI-ELT PIC S9(13)V99 COMP-3. ! +345600* ELEMENT RETRAIT PARTIEL APRES IMPOT ! +345700 10 WS-4DCO-SIMRET-REAVI OCCURS 21. ! +345800 15 WS-4DCO-SIMRET-REAVI-ELT PIC S9(13)V99 COMP-3. ! +345900* ELEMENT RETRAIT EFFECTIF AVANT IMPOT ! +346000 10 WS-4DCO-SIMRET-PARIM OCCURS 21. ! +346100 15 WS-4DCO-SIMRET-PARIM-ELT PIC S9(13)V99 COMP-3. ! +346200* ELEMENT PARTIE IMPOSABLE ! +346300 10 WS-4DCO-SIMRET-TXIMP OCCURS 21. ! +346400 15 WS-4DCO-SIMRET-TXIMP-ELT PIC 99V99. ! +346500* ELEMENT TAUX D'IMPOSITION ! +346600 10 WS-4DCO-SIMRET-MTIMP OCCURS 21. ! +346700 15 WS-4DCO-SIMRET-MTIMP-ELT PIC S9(13)V99 COMP-3. ! +346800* ELEMENT MONTANT DE L'IMPOT ! +346900 10 WS-4DCO-SIMRET-EPNRES OCCURS 21. ! +347000 15 WS-4DCO-SIMRET-EPNRES-ELT PIC S9(13)V99 COMP-3. ! +347100* ELEMENT EPARGNE RESTANTE APRES IMPOT ! +347200 10 WS-4DCO-SIMRET-EPNR PIC X(16). ! +347300* PART D'EPARGNE RESTANTE ! +347400 05 WS-4DCO-SIMRET-NORME-SURAV PIC X. ! +347500* VALEUR DU CODE NORME SURAVENIR ! +347600 05 WS-4DCO-SIMRET-MTABT PIC X(8). ! +347700 05 WS-4DCO-SIMRET-MTABTN PIC 9(5)V99. ! +347800 05 FILLER PIC X(0449). ! +347900* ZONES DISPONIBLES ! +348000* ------------------------------------------------------ * ! +348100 ! +348200 03 WS-4DCO-SIMTRI REDEFINES WS-4DCO-PROGRAM. ! +348300* ============== ! +348400* ------------------------------------------------------ * ! +348500* COMMAREA : SIMULATION AVEC RACHATS TRIMESTRIELS * ! +348600* LONGUEUR : 1800 * ! +348700* PREFIXE : WS-4DCO-SIMTRI * ! +348800* ------------------------------------------------------ * ! +348900 ! +349000 05 WS-4DCO-SIMTRI-DONNEES. ! +349100* VERSEMENT INITIAL BRUT ! +349200 10 WS-4DCO-SIMTRI-MT-B-V PIC S9(13)V9(02) COMP-3. ! +349300* VERSEMENT INITIAL NET ! +349400 10 WS-4DCO-SIMTRI-MT-N-V PIC S9(13)V9(02) COMP-3. ! +349500* TAUX FRAIS SOUSCRIPTION ! +349600 10 WS-4DCO-SIMTRI-TX-FRS-INI PIC S9(2)V9(03) COMP-3. ! +349700* TAUX FRAIS GESTION ! +349800 10 WS-4DCO-SIMTRI-TX-FRS-GTN PIC S9(2)V9(03) COMP-3. ! +349900* MONTANT NET DES RACHATS ! +350000 10 WS-4DCO-SIMTRI-MT-RPP PIC S9(13)V9(02) COMP-3. ! +350100* CODE PERIODICITE ! +350200 10 WS-4DCO-SIMTRI-CD-PER PIC X. ! +350300* TAUX INDEXATION DES RACHATS ! +350400 10 WS-4DCO-SIMTRI-TX-IDX-RRT-STD PIC S9(2)V999 COMP-3. ! +350500* CODE FISCALITE ! +350600 10 WS-4DCO-SIMTRI-CD-FIS PIC X. ! +350700* TAUX REVALORISATION ! +350800 10 WS-4DCO-SIMTRI-TX-VLR PIC S9(2)V9(3) COMP-3. ! +350900* MONTANT ABATTEMENT ! +351000 10 WS-4DCO-SIMTRI-MT-ABT PIC S9(13)V99 COMP-3. ! +351100* MONTANT VERSEMENT NET ! +351200 10 WS-4DCO-SIMTRI-MT-VER-NET PIC S9(13)V99 COMP-3. ! +351300* MONTANT EPARGNE RESTANTE ! +351400 10 WS-4DCO-SIMTRI-MT-EPG-RES PIC S9(13)V99 COMP-3. ! +351500* MONTANT INTERET ! +351600 10 WS-4DCO-SIMTRI-MT-INT PIC S9(13)V99 COMP-3. ! +351700* NOMBRE RETRAIT EPARGNE ! +351800 10 WS-4DCO-SIMTRI-NB-RTT-EPG PIC 9(02) OCCURS 41. ! +351900* MONTANT CAPITAL ! +352000 10 WS-4DCO-SIMTRI-MT-CAP ! +352100 PIC S9(9)V99 COMP-3 OCCURS 41. ! +352200* MONTANT RETRAIT APRES ! +352300 10 WS-4DCO-SIMTRI-MT-RTT-AP ! +352400 PIC S9(9)V99 COMP-3 OCCURS 41. ! +352500* MONTANT RETRAIT AVANT ! +352600 10 WS-4DCO-SIMTRI-MT-RTT-AV ! +352700 PIC S9(9)V99 COMP-3 OCCURS 41. ! +352800* MONTANT INTERET ! +352900 10 WS-4DCO-SIMTRI-MT-ITT-I1 ! +353000 PIC S9(9)V99 COMP-3 OCCURS 41. ! +353100* TAUX PRELEVEMENT ! +353200 10 WS-4DCO-SIMTRI-TX-PLV-LBL ! +353300 PIC S9(2)V999 COMP-3 OCCURS 41. ! +353400* MONTANT IMPOT ! +353500 10 WS-4DCO-SIMTRI-MT-IMT ! +353600 PIC S9(9)V99 COMP-3 OCCURS 41. ! +353700* SOLDE CONTRAT ! +353800 10 WS-4DCO-SIMTRI-SLD-CTR ! +353900 PIC S9(9)V99 COMP-3 OCCURS 41. ! +354000 10 WS-4DCO-SIMTRI-NORME PIC X. ! +354100 ! +354200 10 FILLER PIC X(48). ! +354300 ! +354400 03 WS-4DCO-SIMRNT REDEFINES WS-4DCO-PROGRAM. ! +354500* ============== ! +354600* ------------------------------------------------------ * ! +354700* COMMAREA : SIMULATION RENTE VIAGERE IMMEDIATE * ! +354800* LONGUEUR : 1800 * ! +354900* PREFIXE : WS-4DCO-SIMRNT * ! +355000* ------------------------------------------------------ * ! +355100 ! +355200 05 WS-4DCO-SIMRNT-DONNEES. ! +355300* REFERENCE DU CONTRAT ! +355400 10 WS-4DCO-SIMRNT-REF-CTR PIC X(15). ! +355500* VERSEMENT INITIAL BRUT ! +355600 10 WS-4DCO-SIMRNT-MT-B-V PIC S9(13)V9(02) COMP-3. ! +355700* VERSEMENT INITIAL NET ! +355800 10 WS-4DCO-SIMRNT-MT-N-V PIC S9(13)V9(02) COMP-3. ! +355900* TAUX FRAIS SOUSCRIPTION ! +356000 10 WS-4DCO-SIMRNT-TX-FRS PIC S9(2)V9(03) COMP-3. ! +356100* VALEUR DE RACHAT DU CONTRAT ! +356200 10 WS-4DCO-SIMRNT-VLR-RAC PIC S9(13)V9(02) COMP-3. ! +356300* AGE DU RENTIER ! +356400 10 WS-4DCO-SIMRNT-VLR-AGE-RNT PIC 9(3). ! +356500* AGE DU CO-RENTIER ! +356600 10 WS-4DCO-SIMRNT-VLR-AGE-COR PIC 9(3). ! +356700* TAUX DE REVERSION ! +356800 10 WS-4DCO-SIMRNT-TX-REV PIC S9(3) COMP-3. ! +356900* TAUX TECHNIQUE ! +357000 10 WS-4DCO-SIMRNT-TX-TEC PIC S9(3)V9(02) COMP-3. ! +357100* MONTANT ANNUELLE DE LA RENTE ! +357200 10 WS-4DCO-SIMRNT-MT-REN PIC S9(13)V9(02) COMP-3. ! +357300* COEFFICIENT DE CONVERSION ! +357400 10 WS-4DCO-SIMRNT-COEF-CNVS PIC S9(2)V9(3) COMP-3. ! +357500* NORME ! +357600 10 WS-4DCO-SIMRNT-NORME PIC X. ! +357700* SEXE DU RENTIER ! +357800 10 WS-4DCO-SIMRNT-CD-SEX-RNT PIC X(1). ! +357900* SEXE DU CO-RENTIER ! +358000 10 WS-4DCO-SIMRNT-CD-SEX-COR PIC X(1). ! +358100* code p�riodicit� ! +358200 10 WS-4DCO-SIMRNT-CD-PER PIC X(1). ! +358300* TAUX frais de gestion ! +358400 10 WS-4DCO-SIMRNT-TX-FRS-GTN PIC S9(3)V9(02) COMP-3. ! +358500* ! +358600 10 FILLER PIC X(1729). ! +358700* ! +358800 ! +358900 03 WS-4DCO-SIMEVO REDEFINES WS-4DCO-PROGRAM. ! +359000* ============== ! +359100* ------------------------------------------------------ * ! +359200* COMMAREA : SIMULATION DE L'EPARGNE (EVOLUTION/TAUX) * ! +359300* LONGUEUR : 1800 * ! +359400* PREFIXE : WS-4DCO-SIMEVO * ! +359500* ------------------------------------------------------ * ! +359600 ! +359700 05 WS-4DCO-SIMEVO-M42173A. ! +359800 10 WS-4DCO-SIMEVO-MT-VIB PIC X(16). ! +359900* MONTANT INIT BRUT AFFICHE A L'ECRAN ! +360000 10 WS-4DCO-SIMEVO-MT-VIBN PIC S9(13)V9(02). ! +360100* MONTANT INITIAL BRUT ! +360200 10 WS-4DCO-SIMEVO-MT-VIBR REDEFINES ! +360300 WS-4DCO-SIMEVO-MT-VIBN ! +360400 PIC S9(15). ! +360500* MONTANT INITIAL BRUT ! +360600 10 WS-4DCO-SIMEVO-FRS PIC X(006). ! +360700* FRAIS DE SOUSCRIPTION AFFICHE A L'ECRAN ! +360800 10 WS-4DCO-SIMEVO-FRS-N PIC 9(02)V9(03). ! +360900* FRAIS DE SOUSCRIPTION ! +361000 10 WS-4DCO-SIMEVO-FRS-R REDEFINES ! +361100 WS-4DCO-SIMEVO-FRS-N ! +361200 PIC 9(05). ! +361300* FRAIS DE SOUSCRIPTION ! +361400 10 WS-4DCO-SIMEVO-TXGST PIC X(006). ! +361500* TX FRAIS DE GESTION AFFICHE A L'ECRAN ! +361600 10 WS-4DCO-SIMEVO-TXGST-N PIC 9(02)V9(03). ! +361700* TX FRAIS DE GESTION ! +361800 10 WS-4DCO-SIMEVO-TXGST-R REDEFINES ! +361900 WS-4DCO-SIMEVO-TXGST-N ! +362000 PIC 9(05). ! +362100* FRAIS DE GESTION ! +362200 10 WS-4DCO-SIMEVO-MTEPN PIC X(16). ! +362300* MONTANT PART D'EPARGNE AFFICHE A L'ECRAN ! +362400 10 WS-4DCO-SIMEVO-ANVERS PIC X(004). ! +362500* ANNEE DU PREMIER VERSEMENT A L'ECRAN ! +362600 10 WS-4DCO-SIMEVO-ANVERSN PIC 9(04). ! +362700* ANNEE DU PREMIER VERSEMENT ! +362800 10 WS-4DCO-SIMEVO-DUREE PIC X(003). ! +362900* DUREE DU CONTRAT A L'ECRAN ! +363000 10 WS-4DCO-SIMEVO-DUREE-N PIC 9(03). ! +363100* ANNEE DU CONTRAT ! +363200 10 WS-4DCO-SIMEVO-ANFIN PIC X(004). ! +363300* ANNEE DE FIN DE CONTRAT AFFICHE ! +363400 10 WS-4DCO-SIMEVO-ANFIN-N PIC 9(04). ! +363500* ANNEE DE FIN DE CONTRAT ! +363600 05 WS-4DCO-SIMEVO-TABTXRVL. ! +363700 10 WS-4DCO-SIMEVO-TABTX OCCURS 7. ! +363800 15 WS-4DCO-SIMEVO-TXRVL PIC X(006). ! +363900* TX ANN DE REVALORISAT AFFICHE A L'ECRAN ! +364000 15 WS-4DCO-SIMEVO-TXRVLN PIC 9(02)V9(03). ! +364100* TAUX ANNUEL DE REVALORISATION ! +364200 15 WS-4DCO-SIMEVO-TXRVLR REDEFINES ! +364300 WS-4DCO-SIMEVO-TXRVLN ! +364400 PIC 9(05). ! +364500* TAUX ANNUEL DE REVALORISATION ! +364600 05 WS-4DCO-SIMEVO-TABLEAU. ! +364700 10 WS-4DCO-SIMEVO-TANNEE OCCURS 21. ! +364800 15 WS-4DCO-SIMEVO-TANNEE-ELT PIC X(4). ! +364900* ELEMENT ANNEE ! +365000 10 WS-4DCO-SIMEVO-EPGTX1 OCCURS 21. ! +365100 15 WS-4DCO-SIMEVO-EPGTX1-ELT PIC S9(13)V99 COMP-3. ! +365200* ELEMENT EPARGNE ACQUISE AU TAUX NO 1 ! +365300 10 WS-4DCO-SIMEVO-EPGTX2 OCCURS 21. ! +365400 15 WS-4DCO-SIMEVO-EPGTX2-ELT PIC S9(13)V99 COMP-3. ! +365500* ELEMENT EPARGNE ACQUISE AU TAUX NO 2 ! +365600 10 WS-4DCO-SIMEVO-EPGTX3 OCCURS 21. ! +365700 15 WS-4DCO-SIMEVO-EPGTX3-ELT PIC S9(13)V99 COMP-3. ! +365800* ELEMENT EPARGNE ACQUISE AU TAUX NO 3 ! +365900 10 WS-4DCO-SIMEVO-EPGTX4 OCCURS 21. ! +366000 15 WS-4DCO-SIMEVO-EPGTX4-ELT PIC S9(13)V99 COMP-3. ! +366100* ELEMENT EPARGNE ACQUISE AU TAUX NO 4 ! +366200 10 WS-4DCO-SIMEVO-EPGTX5 OCCURS 21. ! +366300 15 WS-4DCO-SIMEVO-EPGTX5-ELT PIC S9(13)V99 COMP-3. ! +366400* ELEMENT EPARGNE ACQUISE AU TAUX NO 5 ! +366500 10 WS-4DCO-SIMEVO-EPGTX6 OCCURS 21. ! +366600 15 WS-4DCO-SIMEVO-EPGTX6-ELT PIC S9(13)V99 COMP-3. ! +366700* ELEMENT EPARGNE ACQUISE AU TAUX NO 6 ! +366800 10 WS-4DCO-SIMEVO-EPGTX7 OCCURS 21. ! +366900 15 WS-4DCO-SIMEVO-EPGTX7-ELT PIC S9(13)V99 COMP-3. ! +367000* ELEMENT EPARGNE ACQUISE AU TAUX NO 7 ! +367100 10 WS-4DCO-SIMEVO-MTEPN-N PIC S9(13)V99. ! +367200* MONTANT PART D'EPARGNE ! +367300 05 WS-4DCO-SIMEVO-NORME-SURAV PIC X. ! +367400* VALEUR DU CODE NORME SURAVENIR ! +367500 05 FILLER PIC X(0356). ! +367600* ZONES DISPONIBLES ! +367700* ! +367800 ! +367900 03 WS-4DCO-ZVER REDEFINES WS-4DCO-PROGRAM. ! +368000* ============== ! +368100* ------------------------------------------------------ * ! +368200* COMMAREA : ZOOM REEDITION VERSEMENT PROGRAMME * ! +368300* LONGUEUR : 1800 * ! +368400* PREFIXE : WS-4DCO-ZVER * ! +368500* ------------------------------------------------------ * ! +368600 ! +368700 05 WS-4DCO-ZVER-PAGE-AREA PIC X(198). ! +368800 05 WS-4DCO-ZVER-NB-PAG-TS PIC 9(3). ! +368900 05 WS-4DCO-ZVER-DONNEES. ! +369000* DATE CREATION CRO ! +369100 10 WS-4DCO-ZVER-DA-CRE-CRO PIC X(8). ! +369200* HEURE CREATION CRO ! +369300 10 WS-4DCO-ZVER-HEU-CRE-CRO PIC X(6). ! +369400* NUMERO STRUCTURE OPERATION ! +369500 10 WS-4DCO-ZVER-NO-STR-OPE PIC X(6). ! +369600* NUMERO AGENT OPERATION ! +369700 10 WS-4DCO-ZVER-NO-AGT-OPE PIC X(8). ! +369800* MONTANT BRUT VERSEMENT PERIODIQUE ! +369900 10 WS-4DCO-ZVER-MT-BRT-VER-PER PIC S9(15). ! +370000 10 WS-4DCO-ZVER-MT-BRT-VER-PER-R ! +370100 REDEFINES WS-4DCO-ZVER-MT-BRT-VER-PER PIC S9(13)V9(2). ! +370200* MONTANT FRAIS ! +370300 10 WS-4DCO-ZVER-FRS-VER-PER PIC S9(15). ! +370400 10 WS-4DCO-ZVER-FRS-VER-PER-R ! +370500 REDEFINES WS-4DCO-ZVER-FRS-VER-PER PIC S9(13)V9(2). ! +370600* MONTANT NET VERSEMENT PERIODIQUE ! +370700 10 WS-4DCO-ZVER-MT-NET-VER-PER PIC S9(15). ! +370800 10 WS-4DCO-ZVER-MT-NET-VER-PER-R ! +370900 REDEFINES WS-4DCO-ZVER-MT-NET-VER-PER PIC S9(13)V9(2). ! +371000* TAUX FRAIS ! +371100 10 WS-4DCO-ZVER-TX-FRS-VER-PER PIC S9(5). ! +371200 10 WS-4DCO-ZVER-TX-FRS-VER-PER-R ! +371300 REDEFINES WS-4DCO-ZVER-TX-FRS-VER-PER PIC S9(2)V9(3). ! +371400* DATE EFFET ! +371500 10 WS-4DCO-ZVER-DA-EFF-VER-PER PIC X(8). ! +371600* CODE PERIODICITE ! +371700 10 WS-4DCO-ZVER-CD-PER-VER-PER PIC X(1). ! +371800* COMPTE DOM VERSEMENT PERIODIQUE ! +371900 10 WS-4DCO-ZVER-RIB-VER-PER PIC X(23). ! +372000* TYPE AJUSTEMENT ! +372100 10 WS-4DCO-ZVER-TY-AJU-CTS PIC X(1). ! +372200 05 FILLER PIC X(1488). ! +372300* ! +372400 ! +372500 03 WS-4DCO-ZEXP REDEFINES WS-4DCO-PROGRAM. ! +372600* ============== ! +372700* ------------------------------------------------------ * ! +372800* COMMAREA : ZOOM REEDITION MODIFICATION CODE EXPED. * ! +372900* LONGUEUR : 1800 * ! +373000* PREFIXE : WS-4DCO-ZEXP * ! +373100* ------------------------------------------------------ * ! +373200 ! +373300 05 WS-4DCO-ZEXP-PAGE-AREA PIC X(198). ! +373400 05 WS-4DCO-ZEXP-NB-PAG-TS PIC 9(3). ! +373500 05 WS-4DCO-ZEXP-DONNEES. ! +373600* DATE CREATION CRO ! +373700 10 WS-4DCO-ZEXP-DA-CRE-CRO PIC X(8). ! +373800* HEURE CREATION CRO ! +373900 10 WS-4DCO-ZEXP-HEU-CRE-CRO PIC X(6). ! +374000* NUMERO STRUCTURE OPERATION ! +374100 10 WS-4DCO-ZEXP-NO-STR-OPE PIC X(6). ! +374200* NUMERO AGENT OPERATION ! +374300 10 WS-4DCO-ZEXP-NO-AGT-OPE PIC X(8). ! +374400* CODE EXPEDITION ! +374500 10 WS-4DCO-ZEXP-CD-EXP PIC X(1). ! +374600 05 FILLER PIC X(1570). ! +374700* ! +374800 ! +374900 03 WS-4DCO-ZRACP REDEFINES WS-4DCO-PROGRAM. ! +375000* ============== ! +375100* ------------------------------------------------------ * ! +375200* COMMAREA : ZOOM REEDITION RACHATS PARTIELS * ! +375300* LONGUEUR : 1800 * ! +375400* PREFIXE : WS-4DCO-ZRACP * ! +375500* ------------------------------------------------------ * ! +375600 ! +375700 05 WS-4DCO-ZRACP-PAGE-AREA PIC X(198). ! +375800 05 WS-4DCO-ZRACP-NB-PAG-TS PIC 9(3). ! +375900 05 WS-4DCO-ZRACP-DONNEES. ! +376000* DATE CREATION CRO ! +376100 10 WS-4DCO-ZRACP-DA-CRE-CRO PIC X(8). ! +376200* HEURE CREATION CRO ! +376300 10 WS-4DCO-ZRACP-HEU-CRE-CRO PIC X(6). ! +376400* NUMERO STRUCTURE OPERATION ! +376500 10 WS-4DCO-ZRACP-CD-TY-CRO PIC X(3). ! +376600* NUMERO STRUCTURE OPERATION ! +376700 10 WS-4DCO-ZRACP-NO-STR-OPE PIC X(6). ! +376800* NUMERO STRUCTURE GESTION ! +376900 10 WS-4DCO-ZRACP-NO-STR-GTN PIC X(6). ! +377000* NUMERO AGENT OPERATION ! +377100 10 WS-4DCO-ZRACP-NO-AGT-OPE PIC X(8). ! +377200* MONTANT CREDIT SOCIETAIRE ! +377300 10 WS-4DCO-ZRACP-MT-CRD-SOC PIC S9(15). ! +377400 10 WS-4DCO-ZRACP-MT-CRD-SOC-R REDEFINES ! +377500 WS-4DCO-ZRACP-MT-CRD-SOC PIC S9(13)V9(2). ! +377600* NUMERO RIB ! +377700 10 WS-4DCO-ZRACP-NO-RIB PIC X(23). ! +377800* TYPE IMPOSITION ! +377900 10 WS-4DCO-ZRACP-TY-IMT-ITT PIC X(1). ! +378000* MONTANT PLUS VALUE ! +378100 10 WS-4DCO-ZRACP-MT-PV PIC S9(15). ! +378200 10 WS-4DCO-ZRACP-MT-PV-R REDEFINES ! +378300 WS-4DCO-ZRACP-MT-PV PIC S9(13)V9(2). ! +378400* MONTANT PLUS VALUE F8 ! +378500 10 WS-4DCO-ZRACP-MT-PV-F8 PIC S9(15). ! +378600 10 WS-4DCO-ZRACP-MT-PV-F8-R REDEFINES ! +378700 WS-4DCO-ZRACP-MT-PV-F8 PIC S9(13)V9(2). ! +378800* DATE D'EFFET ! +378900 10 WS-4DCO-ZRACP-DA-EFF PIC X(8). ! +379000* MODE DE REGLEMENT ! +379100 10 WS-4DCO-ZRACP-MODE-RGL PIC X(1). ! +379200* TYPE DE LETTRE ! +379300 10 WS-4DCO-ZRACP-TY-LET PIC X(3). ! +379400* MONTANT CSG ! +379500 10 WS-4DCO-ZRACP-MT-CSG PIC S9(15). ! +379600 10 WS-4DCO-ZRACP-MT-CSG-R REDEFINES ! +379700 WS-4DCO-ZRACP-MT-CSG PIC S9(13)V9(2). ! +379800* MONTANT PRELEVEMENTS SOCIAUX ! +379900 10 WS-4DCO-ZRACP-MT-PLV-SOC PIC S9(15). ! +380000 10 WS-4DCO-ZRACP-MT-PLV-SOC-R REDEFINES ! +380100 WS-4DCO-ZRACP-MT-PLV-SOC PIC S9(13)V9(2). ! +380200* MONTANT PRELEVEMENT LIBERATOIRE ! +380300 10 WS-4DCO-ZRACP-MT-PLV-LBL PIC S9(15). ! +380400 10 WS-4DCO-ZRACP-MT-PLV-LBL-R REDEFINES ! +380500 WS-4DCO-ZRACP-MT-PLV-LBL PIC S9(13)V9(2). ! +380600* MONTANT PRELEVEMENT LIBERATOIRE F8 ! +380700 10 WS-4DCO-ZRACP-MT-PLV-LBL-F8 PIC S9(15). ! +380800 10 WS-4DCO-ZRACP-MT-PLV-LBL-F8-R REDEFINES ! +380900 WS-4DCO-ZRACP-MT-PLV-LBL-F8 PIC S9(13)V9(2). ! +381000* MONTANT VERSEMENT RDS ! +381100 10 WS-4DCO-ZRACP-MT-VER-RDS PIC S9(15). ! +381200 10 WS-4DCO-ZRACP-MT-VER-RDS-R REDEFINES ! +381300 WS-4DCO-ZRACP-MT-VER-RDS PIC S9(13)V9(2). ! +381400 05 FILLER PIC X(1406). ! +381500* ! +381600 ! +381700 03 WS-4DCO-ZCIVIL REDEFINES WS-4DCO-PROGRAM. ! +381800* ============== ! +381900* ------------------------------------------------------ * ! +382000* COMMAREA : ZOOM REEDITION MODIFICATION ETAT CIVIL * ! +382100* LONGUEUR : 1800 * ! +382200* PREFIXE : WS-4DCO-ZCIVIL * ! +382300* ------------------------------------------------------ * ! +382400 ! +382500 05 WS-4DCO-ZCIVIL-PAGE-AREA PIC X(198). ! +382600 05 WS-4DCO-ZCIVIL-NB-PAG-TS PIC 9(3). ! +382700 05 WS-4DCO-ZCIVIL-DONNEES. ! +382800* DATE CREATION CRO ! +382900 10 WS-4DCO-ZCIVIL-DA-CRE-CRO PIC X(8). ! +383000* HEURE CREATION CRO ! +383100 10 WS-4DCO-ZCIVIL-HEU-CRE-CRO PIC X(6). ! +383200* NUMERO STRUCTURE OPERATION ! +383300 10 WS-4DCO-ZCIVIL-NO-STR-OPE PIC X(6). ! +383400* NUMERO AGENT OPERATION ! +383500 10 WS-4DCO-ZCIVIL-NO-AGT-OPE PIC X(8). ! +383600* NOM MODIFICATION ! +383700 10 WS-4DCO-ZCIVIL-CD-NOM-MOD PIC X(32). ! +383800* INTITULE MODIFICATION ! +383900 10 WS-4DCO-ZCIVIL-CD-INT-MODIF PIC X(2). ! +384000* DATE NAISSANCE MODIFICATION ! +384100 10 WS-4DCO-ZCIVIL-DA-NAI-MODIF PIC X(8). ! +384200 05 FILLER PIC X(1529). ! +384300 ! +384400 ! +384500*================================================================ ! +384600*= APPLICATION : GESTION DES HABILITATIONS = ! +384700*================================================================ ! +384800* ! +384900 03 WS-4DCO-HABILITATION REDEFINES WS-4DCO-PROGRAM. ! +385000* ==================== ! +385100* ------------------------------------------------------ * ! +385200* COMMAREA : GESTION DES HABILITATIONS * ! +385300* LONGUEUR : 1800 * ! +385400* PREFIXE : WS-4DCO-98XX * ! +385500* ------------------------------------------------------ * ! +385600 ! +385700 05 WS-4DCO-HABI-9800. ! +385800* ------------------------------------------------------ * ! +385900* COMMAREA : APPLICATION HABILITATION (PARTIE COMMUNE) * ! +386000* LONGUEUR : 0400 * ! +386100* PREFIXE : WS-4DCO-9800 * ! +386200* ------------------------------------------------------ * ! +386300 ! +386400 10 WS-4DCO-9800-CD-PTN-DLGAIRE PIC X(05). ! +386500* CODE PARTENAIRE DELEGATAIRE ! +386600 10 WS-4DCO-9800-LA-PTN-DLGAIRE PIC X(16). ! +386700* LIBELLE COURT PARTENAIRE DELEGATAIRE ! +386800 10 WS-4DCO-9800-CD-PFL-DLGAIRE PIC X(03). ! +386900* CODE PROFIL DELEGATAIRE ! +387000 10 WS-4DCO-9800-LA-PFL-DLGAIRE PIC X(16). ! +387100* LIBELLE COURT PROFIL DELEGATAIRE ! +387200 10 WS-4DCO-9800-CD-IDT-DLGAIRE PIC X(08). ! +387300* CODE IDENTIFICATEUR DELEGATAIRE ! +387400 10 WS-4DCO-9800-CD-PTN-DLGUE PIC X(05). ! +387500* CODE PARTENAIRE DELEGUE ! +387600 10 WS-4DCO-9800-LA-PTN-DLGUE PIC X(16). ! +387700* LIBELLE COURT PARTENAIRE DELEGUE ! +387800 10 WS-4DCO-9800-CD-PFL-DLGUE PIC X(03). ! +387900* CODE PROFIL DELEGUE ! +388000 10 WS-4DCO-9800-LA-PFL-DLGUE PIC X(16). ! +388100* LIBELLE COURT PROFIL DELEGUE ! +388200 10 WS-4DCO-9800-CD-IDT-DLGUE PIC X(08). ! +388300* CODE IDENTIFICATEUR ! +388400 10 WS-4DCO-9800-IDC-MAJ PIC X(01). ! +388500* INDICATEUR DE MISE A JOUR ! +388600 10 WS-4DCO-9800-LIB-PTN-DLGAIRE PIC X(32). ! +388700* LIBELLE LONG PARTENAIRE EN LIGNE ! +388800 10 WS-4DCO-9800-CD-TY-PFL-DLGUE PIC X(01). ! +388900* CODE TYPE DE PROFIL DELEGUE ! +389000 10 WS-4DCO-9800-NO-PTN-DLGAIRE PIC 9(03). ! +389100* CODE PARTENAIRE DELEGATAIRE ! +389200 10 WS-4DCO-9800-NO-PTN-DLGUE PIC 9(03). ! +389300* CODE PARTENAIRE DELEGUE ! +389400 10 WS-4DCO-9800-IDC-IDT-ITN PIC X(1). ! +389500* INDICATEUR IDENTIFIANT INTERNET ! +389600 10 WS-4DCO-9800-NIV-DRG PIC 9(3). ! +389700* Niveau de d�rogation ! +389800 10 WS-4DCO-9800-NO-TEL-SL PIC X(11). ! +389900* NUMERO DE TELEPHONE ! +390000 10 WS-4DCO-9800-NO-TEL-DM PIC X(11). ! +390100* NUMERO DE TELEPHONE DOMAINE ! +390200 10 WS-4DCO-9800-NO-FAX PIC X(12). ! +390300* NUMERO DE FAX ! +390400 10 WS-4DCO-9800-CD-PROV PIC X(03). ! +390500 88 ADMINISTRATEUR VALUE 'ADM'. ! +390600 88 DELEGUE VALUE 'DLG'. ! +390700 88 IDENTIFICATEUR VALUE 'IDT'. ! +390800 10 WS-4DCO-9800-IDC-TC98060 PIC X(01). ! +390900* INDICATEUR PROVENANCE MENU HABI PARTENAIRE ! +391000* ! +391100 10 FILLER PIC X(222). ! +391200* ! +391300* ! +391400* ! +391500 05 WS-4DCO-HABI-DETAIL. ! +391600* ------------------------------------------------------ * ! +391700* COMMAREA : APPLICATION HABILITATION (DETAIL) * ! +391800* LONGUEUR : 1400 * ! +391900* PREFIXE : WS-4DCO-98NN * ! +392000* ------------------------------------------------------ * ! +392100 10 FILLER PIC X(1400). ! +392200 ! +392300***************************************************************** ! +392400 ! +392500 ! +392600 05 WS-4DCO-98400 REDEFINES WS-4DCO-HABI-DETAIL. ! +392700* ================= ! +392800* ------------------------------------------------------ * ! +392900* COMMAREA : CREATION D'UN IDENTIFICATEUR * ! +393000* LONGUEUR : 1400 * ! +393100* PREFIXE : WS-4DCO-9840 * ! +393200* ------------------------------------------------------ * ! +393300 07 WS-4DCO-98400-IDT. ! +393400 ! +393500 10 WS-4DCO-9840-CD-IDT PIC X(08). ! +393600* CODE IDENTIFICATEUR ! +393700 10 WS-4DCO-9840-CD-PFL PIC X(03). ! +393800* CODE PROFIL AFFECTE ! +393900 10 WS-4DCO-9840-LIBPFL PIC X(32). ! +394000* LIBELLE PROFIL AFFECTE ! +394100 10 WS-4DCO-9840-SELPFL PIC X. ! +394200* ZONE DE SELECT PF10 SUR PROFIL AFFECTE ! +394300 10 WS-4DCO-9840-CD-CFD PIC X(01). ! +394400* CODE PROFIL CONFIDENTIALITE ! +394500 10 WS-4DCO-9840-LIBCFD PIC X(32). ! +394600* LIBELLE PROFIL CONFIDENTIALITE ! +394700 10 WS-4DCO-9840-SELCDF PIC X. ! +394800* ZONE DE SELECT PF10 POUR DETAIL CONFIDENTIALITE ! +394900 10 WS-4DCO-9840-CD-DRG PIC X(01). ! +395000* CODE AUTORISATION DEROGATION ! +395100 10 WS-4DCO-9840-SELDRG PIC X. ! +395200* ZONE DE SELECT PF10 POUR DETAIL DEROGATION ! +395300 10 WS-4DCO-9840-LIBIDT PIC X(32). ! +395400* LIBELLE CODE IDENTIFICATEUR ! +395500 10 WS-4DCO-9840-NOSTR PIC X(06). ! +395600* NUMERO DE STRUCTURE D'APPARTENANCE ! +395700 10 WS-4DCO-9840-NOAGT PIC X(08). ! +395800* NUMERO D'AGENT PARTENAIRE ! +395900 10 WS-4DCO-9840-IDC-INIT-PFL PIC X(01). ! +396000* INDICATEUR PRESENCE F10 SUR PROFIL ! +396100 10 WS-4DCO-9840-IDC-INIT-DRG PIC X(01). ! +396200* INDICATEUR PRESENCE F10 SUR PROFIL ! +396300 10 WS-4DCO-9840-IDC-INIT-CFD PIC X(01). ! +396400* INDICATEUR PRESENCE F10 SUR PROFIL ! +396500 10 WS-4DCO-9840-LIBSTR PIC X(32). ! +396600* LIBELLE PROFIL STRUCTURE ! +396700 10 WS-4DCO-9840-IDC-INIT-IDT PIC X(01). ! +396800* INDICATEUR PRESENCE SAISIE CMPL ! +396900 10 WS-4DCO-9840-MDP PIC X(08). ! +397000* INDICATEUR PRESENCE SAISIE CMPL ! +397100 10 FILLER PIC X(30). ! +397200* ZONES DISPONIBLES ! +397300 ! +397400 07 WS-4DCO-98100-ADM REDEFINES WS-4DCO-98400-IDT. ! +397500 10 FILLER PIC X(200). ! +397600* ZONES DISPONIBLES ! +397700 ! +397800 ! +397900 07 WS-4DCO-98700-DLG REDEFINES WS-4DCO-98400-IDT. ! +398000 10 FILLER PIC X(200). ! +398100* ZONES DISPONIBLES ! +398200 ! +398300 07 WS-4DCO-98900. ! +398400* ============== ! +398500* ------------------------------------------------------ * ! +398600* COMMAREA : MODIFICATION OPTIONS DES APPLICATIONS * ! +398700* LONGUEUR : 1400 * ! +398800* PREFIXE : WS-4DCO-9890 * ! +398900* ------------------------------------------------------ * ! +399000 ! +399100 10 WS-4DCO-9890. ! +399200 ! +399300 15 WS-4DCO-9890-CD-APLI PIC X(04). ! +399400* CODE APPLICATION ! +399500 15 WS-4DCO-9890-LIB-APLI PIC X(50). ! +399600* LIBELLE APPLICATION ! +399700 15 WS-4DCO-9890-SEL. ! +399800 20 WS-4DCO-9890-SELOP PIC X(01) OCCURS 12. ! +399900* STOCKAGE SELECTION ! +400000 15 WS-4DCO-9890-CD-OPT-SAUV. ! +400100* OPTION CHOISIE DU MENU PRECEDENT ! +400200 20 WS-4DCO-9890-CD-OPT-MP PIC X(002). ! +400300* OPTION CHOISIE DU MENU PRINCIPAL ! +400400 20 WS-4DCO-9890-CD-OPT-MS PIC X(002). ! +400500* OPTION CHOISIE DU MENU SECONDAIRE ! +400600 20 WS-4DCO-9890-CD-OPT-MT PIC X(002). ! +400700* OPTION CHOISIE DU MENU TERTIAIRE ! +400800 20 WS-4DCO-9890-CD-OPT-MQ PIC X(002). ! +400900* OPTION CHOISIE DU MENU QUATERNAIRE ! +401000 15 WS-4DCO-9890-PAGE-AREA-MP PIC X(90). ! +401100* PAGE AREA START -ENCHAINEMENT PGMS AVEC SEGLOOP ! +401200 15 WS-4DCO-9890-PAGE-AREA-MS PIC X(90). ! +401300* PAGE AREA START -ENCHAINEMENT PGMS AVEC SEGLOOP ! +401400 15 WS-4DCO-9890-PAGE-AREA-MT PIC X(90). ! +401500* PAGE AREA START -ENCHAINEMENT PGMS AVEC SEGLOOP ! +401600 15 WS-4DCO-9890-PAGE-AREA-MQ PIC X(90). ! +401700* PAGE AREA START -ENCHAINEMENT PGMS AVEC SEGLOOP ! +401800 15 WS-4DCO-9890-LIB-CD-OPT-MS PIC X(50). ! +401900* LIBELLE OPTION CHOISIE DU MENU SECONDAIRE ! +402000 15 WS-4DCO-9890-LIB-CD-OPT-MT PIC X(50). ! +402100* LIBELLE OPTION CHOISIE DU MENU TERTIAIRE ! +402200 15 WS-4DCO-9890-LIB-CD-OPT-MQ PIC X(50). ! +402300* LIBELLE OPTION CHOISIE DU MENU QUATERNAIRE ! +402400 15 WS-4DCO-9890-NO-ITEM-TS-A PIC 9(04) COMP. ! +402500* PREMIER ITEM TS AI03 DU PRG ! +402600 15 WS-4DCO-9890-TOP-MAJ-EFFECTUEE PIC X(01). ! +402700* TOP MODIF PAGE ! +402800 15 WS-4DCO-9890-ITEM-MENUPRE-P PIC 9(04) COMP. ! +402900* ITEM AI03 DU MENU PRECEDENT PRIMAIRE ! +403000 15 WS-4DCO-9890-ITEM-MENUPRE-S PIC 9(04) COMP. ! +403100* ITEM AI03 DU MENU PRECEDENT SECONDAIRE ! +403200 15 WS-4DCO-9890-ITEM-MENUPRE-T PIC 9(04) COMP. ! +403300* ITEM AI03 DU MENU PRECEDENT TERTIAIRE ! +403400 15 WS-4DCO-9890-STOCK-AUTORIS. ! +403500 20 WS-4DCO-9890-ST-AUT PIC X(01) OCCURS 36. ! +403600* STOCKAGE AUTORISATIONS POUR REMONTEE DU NON ! +403700 07 WS-4DCO-98040-DRG. ! +403800* ================== ! +403900* ------------------------------------------------------ * ! +404000* COMMAREA : CREATION ET MODIFS DE DEROGATIONS * ! +404100* PREFIXE : WS-4DCO-9804-DRG * ! +404200* ------------------------------------------------------ * ! +404300 ! +404400 10 WS-4DCO-9804-DRG. ! +404500 ! +404600 15 WS-4DCO-9804-TABDEROG OCCURS 24. ! +404700* TABLE DEROGATIONS ! +404800 20 WS-4DCO-9804-CD-DRG PIC X(2). ! +404900* CODES DEROGATIONS ! +405000 20 WS-4DCO-9804-IDC-AUT-DRG PIC X. ! +405100* INDIC AUTO DEROGATION ! +405200 ! +405300 07 WS-4DCO-98040-TAB-TST. ! +405400* ====================== ! +405500* ------------------------------------------------------ * ! +405600* COMMAREA : CREATION ET MODIFS DE DEROGATIONS * ! +405700* PREFIXE : WS-4DCO-9804-DRG * ! +405800* ------------------------------------------------------ * ! +405900 ! +406000 15 WS-4DCO-9840-TABAPPLI OCCURS 20. ! +406100* TABLE APPLICATION GEODE ! +406200 20 WS-4DCO-9840-CD-TST-AS PIC X(4). ! +406300* APPLICATION GEODE ! +406400 20 WS-4DCO-9840-CD-TST-REEL PIC X(4). ! +406500* APPLICATION GEODE-REELLE ! +406600 ! +406700 07 FILLER PIC X(339). ! +406800* ZONES DISPONIBLES ! +406900 ! +407000 05 WS-4DCO-98590 REDEFINES WS-4DCO-HABI-DETAIL. ! +407100* ============== ! +407200* ------------------------------------------------------ * ! +407300* COMMAREA : LISTE DE IDENTIFICATEURS / PARTENAIRE * ! +407400* LONGUEUR : 1400 * ! +407500* PREFIXE : WS-4DCO-9890 * ! +407600* ------------------------------------------------------ * ! +407700 ! +407800 10 WS-4DCO-9890. ! +407900 ! +408000 15 WS-4DCO-9859-SEL. ! +408100 20 WS-4DCO-9859-SELIDT PIC X(01) OCCURS 12. ! +408200* STOCKAGE SELECTION ! +408300 15 WS-4DCO-9859-IDC-OCC-SPL PIC X(1). ! +408400* INDICATEUR OCCURENCE SUPPLEMENTAIRE ! +408500 15 WS-4DCO-9859-PAGE-AREA PIC X(198). ! +408600* ! +408700 15 FILLER PIC X(1189). ! +408800* ZONES DISPONIBLES ! +408900* ! +409000 05 WS-4DCO-98210 REDEFINES WS-4DCO-HABI-DETAIL. ! +409100* ============== ! +409200* ------------------------------------------------------ * ! +409300* COMMAREA : AFFECTATION DEROGATION * ! +409400* LONGUEUR : 1400 * ! +409500* PREFIXE : WS-4DCO-9890 * ! +409600* ------------------------------------------------------ * ! +409700 ! +409800 10 WS-4DCO-9821. ! +409900 ! +410000 15 WS-4DCO-9821-TABDEROG OCCURS 24. ! +410100* TABLE DEROGATIONS ! +410200 20 WS-4DCO-9821-CD-DRG PIC X(2). ! +410300* CODES DEROGATIONS ! +410400 20 WS-4DCO-9821-IDC-AUT-DRG PIC X. ! +410500* INDIC AUTO DEROGATION ! +410600 15 FILLER PIC X(1328). ! +410700* ZONES DISPONIBLES ! +410800 05 WS-4DCO-98220 REDEFINES WS-4DCO-HABI-DETAIL. ! +410900* ================= ! +411000* ------------------------------------------------------ * ! +411100* COMMAREA : AFFECTATION CONFIDENTIALITE ADM * ! +411200* LONGUEUR : 1400 * ! +411300* PREFIXE : WS-4DCO-9822 * ! +411400* ------------------------------------------------------ * ! +411500 07 WS-4DCO-98220-ADM. ! +411600 ! +411700 10 WS-4DCO-9822-CD-CFD PIC X(01). ! +411800* CODE PROFIL CONFIDENTIALITE ! +411900 10 WS-4DCO-9822-LIBCFD PIC X(32). ! +412000* LIBELLE PROFIL CONFIDENTIALITE ! +412100 10 FILLER PIC X(1367). ! +412200* ZONES DISPONIBLES ! +412300* ------------------------------------------------------ * ! +412400 05 WS-4DCO-98240 REDEFINES WS-4DCO-HABI-DETAIL. ! +412500* ============== ! +412600* ------------------------------------------------------ * ! +412700* COMMAREA : LISTE DES PROFILS / PARTENAIRE * ! +412800* LONGUEUR : 1400 * ! +412900* PREFIXE : WS-4DCO-9824 * ! +413000* ------------------------------------------------------ * ! +413100 ! +413200 10 WS-4DCO-9824-CD-PTN PIC XXXXX. ! +413300 10 WS-4DCO-9824-CD-PFL PIC XXX. ! +413400 10 WS-4DCO-9824. ! +413500 15 WS-4DCO-9824-SEL. ! +413600 20 WS-4DCO-9824-SELIDT PIC X(01) OCCURS 12. ! +413700* STOCKAGE SELECTION ! +413800 10 FILLER PIC X(1380). ! +413900* ZONES DISPONIBLES ! +414000* ------------------------------------------------------ * ! +414100 05 WS-4DCO-98850 REDEFINES WS-4DCO-HABI-DETAIL. ! +414200* ============== ! +414300* ------------------------------------------------------ * ! +414400* COMMAREA : LISTE DES demandes racf * ! +414500* LONGUEUR : 1400 * ! +414600* PREFIXE : ws-4dco-98850 * ! +414700* ------------------------------------------------------ * ! +414800* ! +414900 07 WS-4DCO-H0-COM-COMMAREA-APLI. ! +415000 10 WS-4DCO-H0-NIV-DLG PIC X(003). ! +415100 10 WS-4DCO-H0-NO-SAL PIC X(008). ! +415200 10 WS-4DCO-H0-NIV-DLG-MEN PIC X(003). ! +415300 10 WS-4DCO-H2-ZON-COMMAREA-APLI. ! +415400 15 WS-4DCO-H2-ZONE-SAISIE. ! +415500 20 WS-4DCO-H2-IDT-UTI-DE PIC X(008). ! +415600 20 WS-4DCO-H2-IDT-UTI PIC X(008). ! +415700 20 WS-4DCO-H2-LIB-NOM PIC X(032). ! +415800 20 WS-4DCO-H2-CD-GRP-RACF PIC X(008). ! +415900 20 WS-4DCO-H2-MDP PIC X(008). ! +416000 20 WS-4DCO-H2-CD-ACT-RACF PIC X(001). ! +416100 20 WS-4DCO-H2-IDC-GRP-DFT PIC X(001). ! +416200 10 WS-4DCO-H3-ZON-COMMAREA-APLI. ! +416300 15 WS-4DCO-H3-IDT-UTI-DE PIC X(008). ! +416400 15 WS-4DCO-H3-SAUV-ACT-DETAIL. ! +416500 20 WS-4DCO-H3-TM-STP-DEM-RACF ! +416600 PIC X(26) OCCURS 13. ! +416700 15 WS-4DCO-H3-IND PIC S9(4) COMP. ! +416800 10 WS-4DCO-H4-ZON-COMMAREA-APLI. ! +416900 15 WS-4DCO-H4-IDT-UTI-DE PIC X(8). ! +417000 15 WS-4DCO-H4-TM-STP-DEM-RACF PIC X(26). ! +417100 15 WS-4DCO-H4-TM-STP-RPN-RACF PIC X(26). ! +417200 15 WS-4DCO-H4-IDT-UTI PIC X(8). ! +417300 15 WS-4DCO-H4-CD-ACT-RACF PIC X(1). ! +417400 15 WS-4DCO-H4-CD-RET PIC X(4). ! +417500 15 WS-4DCO-H4-TXT-RAI-ANO PIC X(80). ! +417600 15 WS-4DCO-H4-LIB-NOM PIC X(32). ! +417700 15 WS-4DCO-H4-DA-CRE. ! +417800 20 WS-4DCO-H4-DA-CRE-S PIC X(2). ! +417900 20 WS-4DCO-H4-DT-CRE. ! +418000 25 WS-4DCO-H4-DT-CRE-A2 PIC X(2). ! +418100 25 WS-4DCO-H4-DT-CRE-M PIC X(2). ! +418200 25 WS-4DCO-H4-DT-CRE-J PIC X(2). ! +418300 15 WS-4DCO-H4-CD-GRP-RACF PIC X(8). ! +418400 15 WS-4DCO-H4-DA-DNR-MAJ-MDP PIC X(10). ! +418500 15 WS-4DCO-H4-DUR-ITV-MAJ-MDP PIC 9(9) COMP. ! +418600 15 WS-4DCO-H4-TXT-ATB-UTI PIC X(32). ! +418700 15 WS-4DCO-H4-TM-STP-DNR-UTI PIC X(26). ! +418800 15 FILLER PIC X(200). ! +418900 10 WS-4DCO-H0-TYP-ERR PIC X. ! +419000 88 WS-4DCO-H0-TRAITEMENT-OK VALUE SPACE. ! +419100 88 WS-4DCO-H0-ERREUR-BLOQUANTE VALUE 'B'. ! +419200 10 WS-4DCO-H0-ERRMSG1 PIC X(006). ! +419300 10 WS-4DCO-H0-LIB-CPL-MES PIC X(032). ! +419400 10 WS-4DCO-H0-CD-FCT PIC X(002). ! +419500 88 WS-4DCO-H0-MODE-VISUALISATION VALUE 'VI'. ! +419600 10 FILLER PIC X(456). ! +419700* ZONES DISPONIBLES ! +419800 ! +419900 ! +420000 05 WS-4DCO-98H00 REDEFINES WS-4DCO-HABI-DETAIL. ! +420100* ================= ! +420200* ------------------------------------------------------ * ! +420300* COMMAREA : GESTION HABILITATIONS PARTENAIRE: * ! +420400* CREATION D'UN IDENTIFICATEUR * ! +420500* LONGUEUR : 1400 * ! +420600* PREFIXE : WS-4DCO-98H0 * ! +420700* ------------------------------------------------------ * ! +420800 07 WS-4DCO-98H00-IDT. ! +420900 ! +421000 10 WS-4DCO-98H0-CD-IDT PIC X(08). ! +421100* CODE IDENTIFICATEUR ! +421200 10 WS-4DCO-98H0-CD-PFL PIC X(03). ! +421300* CODE PROFIL AFFECTE ! +421400 10 WS-4DCO-98H0-LIBPFL PIC X(32). ! +421500* LIBELLE PROFIL AFFECTE ! +421600 10 WS-4DCO-98H0-LIBIDT PIC X(32). ! +421700* LIBELLE CODE IDENTIFICATEUR ! +421800 10 WS-4DCO-98H0-NOSTR PIC X(06). ! +421900* NUMERO DE STRUCTURE D'APPARTENANCE ! +422000 10 WS-4DCO-98H0-LIBSTR PIC X(32). ! +422100* LIBELLE PROFIL STRUCTURE ! +422200 10 WS-4DCO-98H0-MDP PIC X(08). ! +422300* MOT DE PASSE ! +422400 10 FILLER PIC X(1271). ! +422500* ZONES DISPONIBLES ! +422600 ! +422700 ! +422800 05 WS-4DCO-98H40 REDEFINES WS-4DCO-HABI-DETAIL. ! +422900* ============== ! +423000* ------------------------------------------------------ * ! +423100* COMMAREA : LISTE DE IDENTIFICATEURS / PARTENAIRE * ! +423200* LONGUEUR : 1400 * ! +423300* PREFIXE : WS-4DCO-98H4 * ! +423400* ------------------------------------------------------ * ! +423500 ! +423600 10 WS-4DCO-98H4. ! +423700 ! +423800 15 WS-4DCO-98H4-SEL. ! +423900 20 WS-4DCO-98H4-SELIDT PIC X(01) OCCURS 12. ! +424000* STOCKAGE SELECTION ! +424100 15 WS-4DCO-98H4-IDC-OCC-SPL PIC X(1). ! +424200* INDICATEUR OCCURENCE SUPPLEMENTAIRE ! +424300 15 WS-4DCO-98H4-PAGE-AREA PIC X(198). ! +424400* ! +424500 15 FILLER PIC X(1189). ! +424600* ZONES DISPONIBLES ! +424700* ! +424800 ! +424900*================================================================ ! +425000*= APPLICATION : GESTION DU PARAMETRAGE = ! +425100*================================================================ ! +425200* ! +425300 03 WS-4DCO-4DAA REDEFINES WS-4DCO-PROGRAM. ! +425400* ============ ! +425500 ! +425600* ============== ! +425700* ------------------------------------------------------ * ! +425800* COMMAREA : PARAMETRAGE : MENU GENERAL * ! +425900* LONGUEUR : 1800 * ! +426000* PREFIXE : WS-4DCO-4DAA * ! +426100* ------------------------------------------------------ * ! +426200 ! +426300 10 WS-4DCO-4DAA. ! +426400 ! +426500 15 WS-4DCO-4DAA-CD-INT PIC X(02). ! +426600* CODE INTITULE ! +426700 15 WS-4DCO-4DAA-TIMESTAMP PIC X(26). ! +426800* TIME STAMP ! +426900 15 WS-4DCO-4DAA-PAGE-AREA PIC X(198). ! +427000* PAGE AREA START ! +427100 15 WS-4DCO-4DAA-CD-GAM PIC S9(02) COMP-3. ! +427200* CODE GAMME ! +427300 15 WS-4DCO-4DAA-CD-STR PIC X(06). ! +427400* NUMERO DE STRUCTURE COMMERCIALE ! +427500 15 WS-4DCO-4DAA-CD-ETB-FNC PIC X(05). ! +427600* CODE ORGANISME FINANCIER ! +427700 15 WS-4DCO-4DAA-CD-VLR PIC X(12). ! +427800* CODE SUPPORT ! +427900 15 WS-4DCO-4DAA-NO-ORG-FNC PIC S9(03) COMP-3. ! +428000* NUMERO INTERNE ORGANISME FINANCIER ! +428100 15 WS-4DCO-4DAA-TIMESTAMP-2 PIC X(26). ! +428200* TIME STAMP 2 ! +428300 15 WS-4DCO-4DAA-NO-SPP-FNC PIC S9(06) COMP-3. ! +428400* NUMERO SUPPORT FINANCIER ! +428500 15 WS-4DCO-4DAA-ECR-ORI PIC X(04). ! +428600* NUMERO SUPPORT FINANCIER ! +428700 15 WS-4DCO-4DAA-LIB-SPP PIC X(32). ! +428800* LIBELLE SUPPORT FINANCIER ! +428900 15 FILLER PIC X(1481). ! +429000* 15 FILLER PIC X(1513). ! +429100* 15 FILLER PIC X(1521). ! +429200* ZONES DISPONIBLES ! +429300* ! +429400 03 WS-4DCO-4DAB REDEFINES WS-4DCO-PROGRAM. ! +429500* ============ ! +429600 ! +429700* ============== ! +429800* ------------------------------------------------------ * ! +429900* COMMAREA : PARAMETRAGE * ! +430000* LONGUEUR : 1800 * ! +430100* PREFIXE : WS-4DCO-4DAB * ! +430200* ------------------------------------------------------ * ! +430300 ! +430400 05 WS-4DCO-4DAB. ! +430500 ! +430600 15 WS-4DCO-4DAB-NO-PTN PIC S9(03) COMP-3. ! +430700* NUMERO INTERNE PARTENAIRE ! +430800 15 WS-4DCO-4DAB-TIMESTAMP1 PIC X(26). ! +430900* TIME STAMP ! +431000 15 WS-4DCO-4DAB-TIMESTAMP2 PIC X(26). ! +431100* TIME STAMP ! +431200 15 WS-4DCO-4DAB-CD-PTN PIC X(05). ! +431300* NUMERO EXTERNE PARTENAIRE ! +431400 15 WS-4DCO-4DAB-PAGE-AREA PIC X(198). ! +431500* PAGE AREA START ! +431600 15 WS-4DCO-4DAB-NO-STR PIC X(06). ! +431700* NUMERO EXTERNE PARTENAIRE ! +431800 15 WS-4DCO-4DAB-MODE-RGL PIC X(01). ! +431900* MODE DE REGLEMENT PARTENAIRE ! +432000 15 WS-4DCO-4DAB-MAJ-PTN PIC X(01). ! +432100* INDICATEUR MISE A JOUR NO PARTENAIRE ! +432200 10 WS-4DCO-4DAB-1. ! +432300 15 WS-4DCO-4DAB-TYPRD PIC S9(02) COMP-3. ! +432400* NUMERO TYPE DE PRODUIT ! +432500 15 WS-4DCO-4DAB-NOGEN PIC X(03). ! +432600* NUMERO DE GENERATION ! +432700 15 WS-4DCO-4DAB-TY-PRD-INI PIC S9(02) COMP-3. ! +432800* NUMERO TYPE DE PRODUIT INITIAL ! +432900 15 WS-4DCO-4DAB-PRD PIC X(02). ! +433000* CODE PRODUIT ! +433100 15 WS-4DCO-4DAB-NO-PRD-INI PIC S9(03) COMP-3. ! +433200* NUMERO DE PRODUIT INITIAL ! +433300 15 WS-4DCO-4DAB-CD-PTN-INI PIC X(05). ! +433400* NUMERO EXTERNE PARTENAIRE INITIAL ! +433500 15 WS-4DCO-4DAB-DA-VAL-DBT PIC X(10). ! +433600* DATE DEBUT ! +433700 15 WS-4DCO-4DAB-DA-FIN-VAL PIC X(10). ! +433800* DATE FIN ! +433900 15 WS-4DCO-4DAB-NOM-PRD PIC X(32). ! +434000* LIBELLE PRODUIT ! +434100 15 WS-4DCO-4DAB-MAJ-PTN-PRD PIC X(01). ! +434200* INDICATEUR MISE A JOUR NO PARTENAIRE PRODUIT ! +434300 15 WS-4DCO-4DAB-NO-PRD PIC S9(03) COMP-3. ! +434400* NUMERO INTERNE PRODUIT ! +434500 15 WS-4DCO-4DAB-V4D01130. ! +434600* CONTENUE TABLE DES PRODUITS ! +434700 20 WS-4DCO-4DAB-LIB-PRD PIC X(32). ! +434800 20 WS-4DCO-4DAB-LA-PRD PIC X(16). ! +434900 20 WS-4DCO-4DAB-MT-MIN-VER-INI ! +435000 PIC S9(07)V99 COMP-3. ! +435100 20 WS-4DCO-4DAB-MT-MIN-VER-EXC ! +435200 PIC S9(07)V99 COMP-3. ! +435300 20 WS-4DCO-4DAB-MT-MX-DRT-ENT ! +435400 PIC S9(07)V99 COMP-3. ! +435500 20 WS-4DCO-4DAB-MT-MIN-RCH-PART ! +435600 PIC S9(07)V99 COMP-3. ! +435700 20 WS-4DCO-4DAB-MT-MIN-EPG-RST ! +435800 PIC S9(07)V99 COMP-3. ! +435900 20 WS-4DCO-4DAB-MT-MIN-AV ! +436000 PIC S9(13)V99 COMP-3. ! +436100 20 WS-4DCO-4DAB-MT-EPG-RST-AV ! +436200 PIC S9(13)V99 COMP-3. ! +436300 20 WS-4DCO-4DAB-TX-MX-EPG-DSP ! +436400 PIC S9(03)V999 COMP-3. ! +436500 20 WS-4DCO-4DAB-NB-MX-AV-A ! +436600 PIC S9(02) COMP-3. ! +436700 20 WS-4DCO-4DAB-IDC-ACC-COM PIC X(01). ! +436800 20 WS-4DCO-4DAB-AGE-MIN ! +436900 PIC S9(02) COMP-3. ! +437000 20 WS-4DCO-4DAB-IDC-VSU-STAT PIC X(01). ! +437100 20 WS-4DCO-4DAB-IDC-EDI-STAT PIC X(01). ! +437200 20 WS-4DCO-4DAB-IDC-EDI-ENC PIC X(01). ! +437300 20 WS-4DCO-4DAB-IDC-EDI-PRD PIC X(01). ! +437400 20 WS-4DCO-4DAB-CD-TRANS PIC X(04). ! +437500 20 WS-4DCO-4DAB-TX-MIN-FRS-GTN ! +437600 PIC S9(02)V999 COMP-3. ! +437700 15 WS-4DCO-4DAB-V4D01200. ! +437800* CONTENUE TABLE DES RIB PRODUITS ! +437900 17 WS-4DCO-4DAB-CPT-FIN. ! +438000 20 WS-4DCO-4DAB-CDBANQF PIC X(05). ! +438100 20 WS-4DCO-4DAB-CDGUICF PIC X(05). ! +438200 20 WS-4DCO-4DAB-CPTRIBF PIC X(11). ! +438300 20 WS-4DCO-4DAB-CLERIBF PIC X(02). ! +438400 17 WS-4DCO-4DAB-CPT-PAS. ! +438500 20 WS-4DCO-4DAB-CDBANQP PIC X(05). ! +438600 20 WS-4DCO-4DAB-CDGUICP PIC X(05). ! +438700 20 WS-4DCO-4DAB-CPTRIBP PIC X(11). ! +438800 20 WS-4DCO-4DAB-CLERIBP PIC X(02). ! +438900 17 WS-4DCO-4DAB-CPT-EIB. ! +439000 20 WS-4DCO-4DAB-CDBANQE PIC X(05). ! +439100 20 WS-4DCO-4DAB-CDGUICE PIC X(05). ! +439200 20 WS-4DCO-4DAB-CPTRIBE PIC X(11). ! +439300 20 WS-4DCO-4DAB-CLERIBE PIC X(02). ! +439400 17 WS-4DCO-4DAB-CPT-SDF. ! +439500 20 WS-4DCO-4DAB-CDBANQS PIC X(05). ! +439600 20 WS-4DCO-4DAB-CDGUICS PIC X(05). ! +439700 20 WS-4DCO-4DAB-CPTRIBS PIC X(11). ! +439800 20 WS-4DCO-4DAB-CLERIBS PIC X(02). ! +439900 15 WS-4DCO-4DAB-NB-SPP-INI PIC S9(03) COMP-3. ! +440000* NOMBRE DE SUPPORTS INITIAUX ! +440100 15 WS-4DCO-4DAB-NB-SPP-A-VAL PIC S9(03) COMP-3. ! +440200* NOMBRE DE SUPPORTS A VALIDER ! +440300 15 FILLER PIC X(02). ! +440400 15 WS-4DCO-4DAB-TIMESTAMPAB PIC X(26). ! +440500* TIMESTAMP DE MAJ TX LINEAIRE ARBITRAGE ! +440600 15 WS-4DCO-4DAB-TAUX-LIN PIC X(01). ! +440700* INDICATEUR CREATION PRODUIT TAUX LINEAIRE ! +440800 15 WS-4DCO-4DAB-VERS-PERIOD PIC X(01). ! +440900* INDICATEUR CREATION PRODUIT VERSEM PERIODIQUE ! +441000 15 WS-4DCO-4DAB-VERSEMENT OCCURS 5. ! +441100* CONTENUE TABLE DES VERSEMENTS PERIODIQUES ! +441200 20 WS-4DCO-4DAB-CD-PER ! +441300 PIC X(01). ! +441400 20 WS-4DCO-4DAB-LIB-TY-VER ! +441500 PIC X(32). ! +441600 20 WS-4DCO-4DAB-MT-MIN-VER ! +441700 PIC S9(07)V99 COMP-3. ! +441800 15 WS-4DCO-4DAB-NO-PTN-INI PIC S9(03) COMP-3. ! +441900* NUMERO DE PRODUIT INITIAL ! +442000 15 WS-4DCO-4DAB-CREATION-PRD PIC X(01). ! +442100* TOP CREATION PRODUIT ! +442200 15 WS-4DCO-4DAB-NO-GAM-PRD PIC S9(02) COMP-3. ! +442300* TOP CREATION PRODUIT ! +442400 15 WS-4DCO-4DAB-TAB-TIMESTAMP OCCURS 5. ! +442500* CONTENUE TABLE DES TIMESTAMPS MAJ TAUX ! +442600 20 WS-4DCO-4DAB-TIMESTAMP ! +442700 PIC X(26). ! +442800 15 WS-4DCO-4DAB-CHG-TYPVERS PIC X(01). ! +442900* TOP MODIFCATION TYPE DE VERSEMENT ! +443000 15 WS-4DCO-4DAB-TAB-TIMESTAMP2 OCCURS 3. ! +443100* CONTENUE TABLE DES TIMESTAMPS MAJ RIB PROD ! +443200 20 WS-4DCO-4DAB-TIMESTAMPT2 ! +443300 PIC X(26). ! +443400 15 WS-4DCO-4DAB-MESSAGE PIC X(01). ! +443500* FLAG MESSAGE CREATION NOUVELLE GENERATION ! +443600 15 WS-4DCO-4DAB-MESSAGE-INF PIC X(06). ! +443700* FLAG MESSAGE INFORMATIF CREATION NOUV GENER ! +443800 15 WS-4DCO-4DAB-REF-IMP-PRO PIC X(10). ! +443900*= reference CG de prorogation ! +444000 15 WS-4DCO-4DAB-IDC-DOC PIC X(1). ! +444100*= indicateur pour coupon ech�ance (O/N) ! +444200 15 WS-4DCO-4DAB-NO-SPP-FNC PIC 9(6). ! +444300*= NO SUPPORT FINANCIER ! +444400 15 WS-4DCO-4DAB-IDC-OCC-SPL PIC X(001). ! +444500* ZONE DEPAGINATION ! +444600* 15 FILLER PIC X(21). ! +444700 15 WS-4DCO-4DAB-MT-MIN-MDT PIC S9(13)V99 COMP-3. ! +444800* montant minimum du mandat de gestion ! +444900* modif projet vie167 capgemini : ! +445000* gestion sous mandat ! +445100 15 WS-4DCO-4DAB-IDC-VER-PER-LIM PIC X(1). ! +445200*da6586 as519 Indicateur versement periodique limite ! +445300 15 WS-4DCO-4DAB-MT-VER-PER-LIM ! +445400 PIC S9(13)V9(2) COMP-3. ! +445500*da6586 as519 Montant versement periodique limite ! +445600*da6586 as519 15 FILLER PIC X(13). ! +445700 15 FILLER PIC X(04). ! +445800 15 WS-4DCO-4DAB-CD-FRS-ARBT PIC X(01). ! +445900* INDICATEUR FRAIS ARBITRAGE ! +446000 15 WS-4DCO-4DAB-MT-FOF-GLB PIC S9(13)V99 COMP-3. ! +446100* MONTANT FORFAIT GLOBAL ! +446200 15 WS-4DCO-4DAB-MT-FOF-GTN PIC S9(13)V99 COMP-3. ! +446300* MONTANT FORFAIT GESTIONNAIRE ! +446400 15 WS-4DCO-4DAB-MT-FOF-PTN PIC S9(13)V99 COMP-3. ! +446500* MONTANT FORFAIT PARTENAIRE ! +446600 15 WS-4DCO-4DAB-NOGEN-INI PIC X(03). ! +446700* NUMERO DE GENERATION POUR INITIALIS ! +446800 15 WS-4DCO-4DAB-TAUX-M OCCURS 5. ! +446900 20 WS-4DCO-4DAB-TY-TAUX-M ! +447000 PIC X(01). ! +447100 20 WS-4DCO-4DAB-TX-ACD-GTN-M ! +447200 PIC S9(02)V999 COMP-3. ! +447300 20 WS-4DCO-4DAB-TX-ACD-PTN-M ! +447400 PIC S9(02)V999 COMP-3. ! +447500 20 WS-4DCO-4DAB-TX-EFF-GLB-M ! +447600 PIC S9(02)V9(05) COMP-3. ! +447700 15 WS-4DCO-4DAB-PROD-MINITEL. ! +447800 20 WS-4DCO-4DAB-MT-MIN-VER-INI-M ! +447900 PIC S9(07)V99 COMP-3. ! +448000 20 WS-4DCO-4DAB-MT-MIN-VER-EXC-M ! +448100 PIC S9(07)V99 COMP-3. ! +448200 20 WS-4DCO-4DAB-MT-MX-DRT-ENT-M ! +448300 PIC S9(07)V99 COMP-3. ! +448400 20 WS-4DCO-4DAB-MT-MIN-VER-PER-M ! +448500 PIC S9(07)V99 COMP-3. ! +448600 20 WS-4DCO-4DAB-MT-MIN-RCH-PART-M ! +448700 PIC S9(07)V99 COMP-3. ! +448800 20 WS-4DCO-4DAB-MT-MIN-EPG-RST-M ! +448900 PIC S9(07)V99 COMP-3. ! +449000 20 WS-4DCO-4DAB-MT-MIN-AV-M ! +449100 PIC S9(11)V99 COMP-3. ! +449200 20 WS-4DCO-4DAB-MT-EPG-RST-AV-M ! +449300 PIC S9(11)V99 COMP-3. ! +449400 20 WS-4DCO-4DAB-TX-MX-EPG-DSP-M ! +449500 PIC S9(03)V999 COMP-3. ! +449600 20 WS-4DCO-4DAB-NB-MX-AV-A-M ! +449700 PIC S9(02) COMP-3. ! +449800 20 WS-4DCO-4DAB-IDC-PRD-MTL-MJ ! +449900 PIC X(01). ! +450000*= APPLICATION : PARAMETRAGE : GESTION PARTENAIRE = ! +450100 10 WS-4DCO-4DAD-4DAB REDEFINES WS-4DCO-4DAB-1. ! +450200 12 WS-4DCO-4DAD-V4D01010. ! +450300 15 WS-4DCO-4DAD-NOM-PTN PIC X(32). ! +450400 15 WS-4DCO-4DAD-NOM-PTN-MI PIC X(32). ! +450500 15 WS-4DCO-4DAD-LA-PTN PIC X(16). ! +450600 15 WS-4DCO-4DAD-LA-PTN-MI PIC X(16). ! +450700 15 WS-4DCO-4DAD-NO-TEL PIC X(11). ! +450800 15 WS-4DCO-4DAD-NO-NTL-EM PIC X(6). ! +450900 15 WS-4DCO-4DAD-IDC-PTN-CM PIC X(1). ! +451000 15 WS-4DCO-4DAD-IDC-AUT-GTN-CLI PIC X(1). ! +451100 15 WS-4DCO-4DAD-LIB-ORD-CHQ PIC X(32). ! +451200 15 WS-4DCO-4DAD-NO-POL-MN PIC X(8). ! +451300 15 WS-4DCO-4DAD-NO-POL-MX PIC X(8). ! +451400 15 WS-4DCO-4DAD-LIB-SVR PIC X(32). ! +451500 15 WS-4DCO-4DAD-NB-QZ-DRG-AV PIC S9(2) COMP-3. ! +451600 15 WS-4DCO-4DAD-NB-QZ-DRG-AP PIC S9(2) COMP-3. ! +451700 15 WS-4DCO-4DAD-LIB-VIL PIC X(32). ! +451800 15 WS-4DCO-4DAD-CD-NAF PIC X(4). ! +451900 15 WS-4DCO-4DAD-NO-IDT-EPS-SIT PIC X(9). ! +452000 15 WS-4DCO-4DAD-NO-IDT-CPL-SIT PIC X(5). ! +452100 15 WS-4DCO-4DAD-CD-MODE-RGL-COM PIC X(1). ! +452200 15 WS-4DCO-4DAD-LIB-NOM-CRP-COM PIC X(32). ! +452300 15 WS-4DCO-4DAD-CD-PER-COM-PTN PIC X(1). ! +452400 15 WS-4DCO-4DAD-IDC-EDI PIC X(1). ! +452500 15 WS-4DCO-4DAD-IDC-PEC PIC X(1). ! +452600 15 WS-4DCO-4DAD-CD-INT PIC X(2). ! +452700 15 WS-4DCO-4DAD-LIB-NOM-CRP-SF PIC X(32). ! +452800 15 WS-4DCO-4DAD-TX-DRG-FRS-DOS-SF ! +452900 PIC S9(3)V9(4) COMP-3. ! +453000 15 WS-4DCO-4DAD-IDC-SOC-FDL-GT PIC X(1). ! +453100 15 WS-4DCO-4DAD-CD-GRP-PTN PIC X(3). ! +453200 15 WS-4DCO-4DAD-IDC-AFG-AGT PIC X(1). ! +453300 15 WS-4DCO-4DAD-CD-TY-ECG-FNC PIC X(5). ! +453400 15 WS-4DCO-4DAD-IDC-PTN-ITN PIC X(1). ! +453500 15 WS-4DCO-4DAD-LIB-MTN-LGL PIC X(72). ! +453600 15 WS-4DCO-4DAD-IDC-VSU-DO PIC X(1). ! +453700 15 WS-4DCO-4DAD-IDC-TT-ACT-AG PIC X(1). ! +453800 15 WS-4DCO-4DAD-IDC-AFG-PT PIC X(1). ! +453900 15 WS-4DCO-4DAD-HEU-LIM-PEC PIC X(05). ! +454000 15 WS-4DCO-4DAD-IDC-ADR-ETG PIC X(1). ! +454100 12 WS-4DCO-4DAD-V4D01180. ! +454200 15 WS-4DCO-4DAD-LIB-RUE-1 PIC X(32). ! +454300 15 WS-4DCO-4DAD-LIB-RUE-2 PIC X(32). ! +454400 15 WS-4DCO-4DAD-LIB-COMMUNE PIC X(32). ! +454500 15 WS-4DCO-4DAD-CD-POST PIC X(5). ! +454600 15 WS-4DCO-4DAD-LIB-BUR-DIST PIC X(26). ! +454700 12 WS-4DCO-4DAD-LIB-INT PIC X(12). ! +454800 12 WS-4DCO-4DAD-RIB. ! +454900 15 WS-4DCO-4DAD-CD-BQE PIC X(05). ! +455000 15 WS-4DCO-4DAD-CD-GUI PIC X(05). ! +455100 15 WS-4DCO-4DAD-CPT-RIB. ! +455200 20 FILLER PIC X(01). ! +455300 20 WS-4DCO-4DAD-RAC PIC 9(07). ! +455400 20 WS-4DCO-4DAD-CLE-RAC PIC X(01). ! +455500 20 WS-4DCO-4DAD-CAT-CPT PIC X(02). ! +455600 15 WS-4DCO-4DAD-CLE-RIB PIC X(02). ! +455700 12 WS-4DCO-4DAD-V4D01010-COMPL. ! +455800 15 WS-4DCO-4DAD-IDC-INF-IMP PIC X(1). ! +455900 15 WS-4DCO-4DAD-IDC-SPS-IMP PIC X(1). ! +456000 15 WS-4DCO-4DAD-NB-IMP-SPS-2ND PIC S9(3) COMP-3. ! +456100 15 WS-4DCO-4DAD-NB-IMP-SPS-PCL PIC S9(3) COMP-3. ! +456200 15 WS-4DCO-4DAD-CD-TY-VTE PIC X(3). ! +456300 15 WS-4DCO-4DAD-CD-FIL PIC X(4). ! +456400 15 WS-4DCO-4DAD-IDC-PRS-FIC PIC X(1). ! +456500*= APPLICATION : PARAMETRAGE : GESTION STRUCTURE = ! +456600 10 WS-4DCO-4DAD-4DAN REDEFINES WS-4DCO-4DAB-1. ! +456700 12 WS-4DCO-4DAN-V4D01101. ! +456800 15 WS-4DCO-4DAN-NO-TEL PIC X(11). ! +456900 15 WS-4DCO-4DAN-NO-FAX PIC X(12). ! +457000*= APPLICATION : PARAMETRAGE : GESTION orga. financier = ! +457100 10 WS-4DCO-4DAD-4DMA REDEFINES WS-4DCO-4DAB-1. ! +457200 12 WS-4DCO-4DMA-V4D01320. ! +457300 15 WS-4DCO-4DMA-NO-TEL PIC X(11). ! +457400 15 WS-4DCO-4DMA-NO-FAX PIC X(12). ! +457500 10 WS-4DCO-4DAB-MIN. ! +457600 15 WS-4DCO-4DAB-CREAT-MINITEL PIC X(01). ! +457700* TOP POUR CREATION PRODUIT MINITEL ! +457800 15 WS-4DCO-4DAB-CHG-MINI PIC X(01). ! +457900* TOP MODIFCATION MINITEL ! +458000 15 WS-4DCO-4DAB-TYAUT PIC X(06). ! +458100* TYPE OPERATION MINITEL ! +458200* NUMERO DE GENERATION POUR INITIALIS ! +458300 15 WS-4DCO-4DAB-LIB-PRD-M PIC X(32). ! +458400* NOM PRODUIT MINITEL ! +458500 15 WS-4DCO-4DAB-LA-PRD-M PIC X(16). ! +458600* NOM ABREGE PRODUIT MINITEL ! +458700 15 WS-4DCO-4DAB-TABLE-SEL. ! +458800 20 WS-4DCO-4DAB-SELECTION OCCURS 15. ! +458900 25 WS-4DCO-4DAB-CODE-SELECTION ! +459000 PIC X(01). ! +459100 15 WS-4DCO-4DAB-CHG-MINI-PRD PIC X(01). ! +459200* TOP MODIFICATION OPERATION MINITEL PRD ! +459300 15 WS-4DCO-4DAB-IDC-CLA-PROR PIC X(01). ! +459400* INDICATEUR CLAUSE DE PROROGATION ! +459500 15 WS-4DCO-4DAB-CD-PRD-OR PIC X(02). ! +459600* CODE EXTERNE DU PRODUIT D ORIGINE ! +459700 15 WS-4DCO-4DAB-NO-CTR-AS PIC X(08). ! +459800* NUMERO DE CONTRAT D ASSURANCE ! +459900 15 WS-4DCO-4DAB-IDC-PRD-UNT-CPT PIC X(01). ! +460000* NUMERO DE CONTRAT D ASSURANCE ! +460100 15 WS-4DCO-4DAB-MT-MIN-ARBT PIC S9(13)V9(2) COMP-3. ! +460200* MONTANT MINIMUM POUR ARBITRAGE ! +460300 15 WS-4DCO-4DAB-LIB-PRD-ED PIC X(32). ! +460400* LIBELLE POUR EDITION ! +460500 15 WS-4DCO-4DAB-CD-TY-VER-AUT PIC X(10). ! +460600* TYPE DE VERSEMENT AUTORISES ! +460700 15 WS-4DCO-4DAB-TAUX OCCURS 7. ! +460800 20 WS-4DCO-4DAB-TY-TAUX ! +460900 PIC X(01). ! +461000 20 WS-4DCO-4DAB-TX-ACD-GTN ! +461100 PIC S9(02)V999 COMP-3. ! +461200 20 WS-4DCO-4DAB-TX-ACD-PTN ! +461300 PIC S9(02)V999 COMP-3. ! +461400 20 WS-4DCO-4DAB-TX-EFF-GLB ! +461500 PIC S9(02)V9(05) COMP-3. ! +461600 15 WS-4DCO-4DAB-INITECR PIC X. ! +461700* INDICATEUR INIT ECRAN ! +461800 15 WS-4DCO-4DAB-NB-OCC PIC S9(3) COMP-3. ! +461900* NB OCCURENCES ! +462000 15 WS-4DCO-4DAB-NO-ORD PIC S9(3) COMP-3. ! +462100* POSTE DU SUPPORT TRAITE ! +462200 15 WS-4DCO-4DAB-TY-VER-AUT-GT PIC X(10). ! +462300* TYPE DE VERSEMENT AUTORISES ! +462400 15 WS-4DCO-4DAB-TX-EFF-GLB-GT ! +462500 PIC S9(02)V9(05) COMP-3. ! +462600* TAUX EFFECTIF GLOBAL ! +462700 15 WS-4DCO-4DAB-TX-ACD-PTN-GT ! +462800 PIC S9(02)V999 COMP-3. ! +462900* TAUX ACCORDE AU PARTENAIRE ! +463000 15 WS-4DCO-4DAB-TX-ACD-GTN-GT ! +463100 PIC S9(02)V999 COMP-3. ! +463200* TAUX ACCORDE AU GESTIONNAIRE ! +463300 15 WS-4DCO-4DAB-CD-ASS-AS PIC X(03). ! +463400 15 WS-4DCO-4DAB-NOM-PATRO-AS PIC X(32). ! +463500* CODE GROUPE PARTENAIRE ! +463600 15 WS-4DCO-4DAB-CD-GRP-PTN PIC X(03). ! +463700* NUMERO DE CONTRAT TYPE COMPTABLE ! +463800 15 WS-4DCO-4DAB-NO-CTR-TY-CPB PIC 9(3). ! +463900 10 WS-4DCO-4DAB-2. ! +464000* ZONE GROUPE POUR LE PROGRAMME TC4DDI0 ! +464100 15 WS-4DCO-4DDI. ! +464200* ZONE DE PAGINATION ! +464300 16 WS-4DCO-4DDI-PAGE. ! +464400 20 WS-4DCO-4DDI-IDC-OCC-SPL PIC X(001). ! +464500 20 WS-4DCO-4DDI-NB-PAG-TS PIC 9(002). ! +464600 20 WS-4DCO-4DDI-SAUV-PAGE-AREA PIC X(198). ! +464700* ! +464800* CODE GROUPE PARTENAIRE ! +464900 16 WS-4DCO-4DDI-CDGRP PIC X(003). ! +465000* CLE DE REPOSITIONNEMENT (CODE PARTENAIRE) ! +465100 16 WS-4DCO-4DDI-CLEPOS PIC X(005). ! +465200* ! +465300* CODE MESSAGE ERREUR ! +465400 16 WS-4DCO-4DDI-ERRMSG1 PIC X(006). ! +465500* ZOOM DEBUT ! +465600* DONNEES POUR LESQUELLES ON A DEMANDE LE DETAIL ! +465700 16 WS-4DCO-4DDI-TABLE. ! +465800 18 WS-4DCO-4DDI-VAL-DTL PIC X(005) ! +465900 OCCURS 12. ! +466000 ! +466100* POSITION DU CURSEUR DU 1ER DETAIL DEMANDE ! +466200 16 WS-4DCO-4DDI-POS-CURSOR PIC 9(002). ! +466300* NB DE DETAILS TRAITES ! +466400 16 WS-4DCO-4DDI-SAUV-ACT-TRT PIC S9(4) COMP. ! +466500* NB DE DETAILS DEMANDES ! +466600 16 WS-4DCO-4DDI-SAUV-ACT-NB PIC S9(4) COMP. ! +466700* ZOOM FIN ! +466800 15 WS-4DCO-4DAB-TIMESTAMPT3 PIC X(26). ! +466900 15 WS-4DCO-4DAB-MODIF-ZONE PIC X(01). ! +467000 15 WS-4DCO-4DAB-IDC-VALID PIC X(01). ! +467100 15 WS-4DCO-4DAB-REF-IMP-CG PIC X(10). ! +467200 15 WS-4DCO-4DAB-REF-IMP-SU PIC X(10). ! +467300 15 WS-4DCO-4DAB-IDC-PRD-CMP PIC X(01). ! +467400 15 WS-4DCO-4DAB-CD-PFL-GT PIC X(03). ! +467500 15 WS-4DCO-4DAD-NB-EDI-EX PIC 9(1). ! +467600 15 WS-4DCO-4DAD-CD-TY-ARC PIC X(1). ! +467700 15 WS-4DCO-4DAD-CD-SI-DI PIC X(3). ! +467800 15 WS-4DCO-4DAB-CD-TY-CTR-ARC PIC X(6). ! +467900***************** ZONES DISPONIBLES ******************* ! +468000 15 WS-4DCO-4DAD-DA-DBT-ARC-ADH PIC X(8). ! +468100 15 WS-4DCO-4DAD-DA-DBT-ARC-AVT PIC X(8). ! +468200 15 WS-4DCO-4DAD-DA-DNN-PTN PIC X(8). ! +468300***************** ZONES DISPONIBLES ******************* ! +468400 ! +468500 10 WS-4DCO-4DAB-3 REDEFINES WS-4DCO-4DAB-2. ! +468600 15 WS-4DCO-4DAB-TX-FRS-COM-SR ! +468700 PIC S9(02)V999 COMP-3. ! +468800* TAUX DE SURCOMMISSIONNEMENT ! +468900 ! +469000 ! +469100*================================================================ ! +469200*= APPLICATION : GESTION DES AVANCES = ! +469300*= REMUNERATION ET FISCALITE = ! +469400*================================================================ ! +469500 03 WS-4DCO-4DAC REDEFINES WS-4DCO-PROGRAM. ! +469600* ============ ! +469700 ! +469800* ============== ! +469900* ------------------------------------------------------ * ! +470000* COMMAREA : GESTION DES AVANCES * ! +470100* LONGUEUR : 1800 * ! +470200* PREFIXE : WS-4DCO-4DAC * ! +470300* ------------------------------------------------------ * ! +470400 ! +470500 10 WS-4DCO-4DAC. ! +470600 ! +470700 15 WS-4DCO-4DAC-ZON-APLI. ! +470800 20 WS-4DCO-4DAC-MT-MIN-AV ! +470900 PIC S9(13)V9(2) COMP-3. ! +471000* MONTANT MINIMUM AVANCE ! +471100 20 WS-4DCO-4DAC-MT-EPG-RST-AV ! +471200 PIC S9(13)V9(2) COMP-3. ! +471300* MONTANT EPARGNE RESTANTE ! +471400 20 WS-4DCO-4DAC-TX-MX-EPG-DSP ! +471500 PIC S9(3)V9(4) COMP-3. ! +471600* TAUX MAXIMUM EPARGNE DISPONIBLE ! +471700 20 WS-4DCO-4DAC-NB-MX-AV-A PIC 9(02). ! +471800* NOMBRE MAXIMUM AVANCES ANNUELLES ! +471900 20 WS-4DCO-4DAC-DUR-DEL-CRNC PIC 9(02). ! +472000* DUREE DELAI DE CARENCE ! +472100 ! +472200 15 WS-4DCO-4DAC-ZON-SAV. ! +472300 20 WS-4DCO-4DAC-SAV-MT-MIN-AV ! +472400 PIC S9(13)V9(2) COMP-3. ! +472500* MONTANT MINIMUM AVANCE ! +472600 20 WS-4DCO-4DAC-SAV-MT-EPG-RST-AV ! +472700 PIC S9(13)V9(2) COMP-3. ! +472800* MONTANT EPARGNE RESTANTE ! +472900 20 WS-4DCO-4DAC-SAV-TX-MX-EPG-DSP ! +473000 PIC S9(3)V9(4) COMP-3. ! +473100* TAUX MAXIMUM EPARGNE DISPONIBLE ! +473200 20 WS-4DCO-4DAC-SAV-NB-MX-AV-A ! +473300 PIC 9(02). ! +473400* NOMBRE MAXIMUM AVANCES ANNUELLES ! +473500 20 WS-4DCO-4DAC-SAV-DUR-DEL-CRNC ! +473600 PIC 9(02). ! +473700* DUREE DELAI DE CARENCE ! +473800 ! +473900 15 WS-4DCO-4DAC-LIB-OPE PIC X(12). ! +474000* LIBELLE OPERATION ! +474100 ! +474200 15 FILLER PIC X(1740). ! +474300* ZONES DISPONIBLES ! +474400* ! +474500*================================================================ ! +474600*= APPLICATION : GESTION DES AVANCES = ! +474700*= TAUX SUR AVANCES = ! +474800*================================================================ ! +474900 03 WS-4DCO-4DTX REDEFINES WS-4DCO-PROGRAM. ! +475000* ============ ! +475100 ! +475200* ============== ! +475300* ------------------------------------------------------ * ! +475400* COMMAREA : TAUX SUR AVANCES * ! +475500* LONGUEUR : 1800 * ! +475600* PREFIXE : WS-4DCO-4DTX * ! +475700* ------------------------------------------------------ * ! +475800 ! +475900 10 WS-4DCO-4DTX. ! +476000 ! +476100 15 WS-4DCO-4DTX-ZON-APLI. ! +476200 20 WS-4DCO-4DTX-SAUV-MODIF OCCURS 13. ! +476300* SAUVEGARDE DES ZONES MODIFIABLES ! +476400 25 WS-4DCO-4DTX-A-REF PIC 9(4). ! +476500* ANNEE DE REFERENCE ! +476600 25 WS-4DCO-4DTX-TX-FRS-AV ! +476700 PIC S9(3)V9(4). ! +476800* TAUX DE FRAIS SUR AVANCE ! +476900 25 WS-4DCO-4DTX-TX-INT-AV ! +477000 PIC S9(3)V9(4). ! +477100* TAUX D'INTERET SUR AVANCE ! +477200 20 WS-4DCO-4DTX-SEGLOOP-COUNT-MOD PIC 9(2). ! +477300* INDICE DE LA LIGNE A MODIFIER ! +477400 20 WS-4DCO-4DTX-SEGLOOP-COUNT-ANN PIC 9(2). ! +477500* INDICE DE LA LIGNE A ANNULER ! +477600 15 FILLER PIC X(1562). ! +477700* ZONES DISPONIBLES ! +477800* ! +477900 ! +478000*================================================================ ! +478100*= APPLICATION : PARAMETRAGE : GESTION PRODUITS COMPTABLES= ! +478200*================================================================ ! +478300* ! +478400* ! +478500 03 WS-4DCO-PRD-CPB REDEFINES WS-4DCO-PROGRAM. ! +478600* ============ ! +478700 ! +478800* ============== ! +478900* ------------------------------------------------------ ! +479000* COMMAREA : PARAMETRAGE : GESTION DES PRODUITS COMPTA- ! +479100* BLES (CONTRAT-TYPE ET PRODUIT COMPTABLE) ! +479200* LONGUEUR : 1800 ! +479300* PREFIXE : WS-4DCO-PRCP ! +479400* ------------------------------------------------------ ! +479500* ! +479600* ZONES COMMUNES ! +479700* ! +479800 10 WS-4DCO-PRCP-COMMUN. ! +479900 15 WS-4DCO-PRCP-ACT PIC X(1). ! +480000* ! +480100* CONTRAT-TYPE ! +480200* ! +480300 10 WS-4DCO-PRCP-CTR-TYPE. ! +480400 15 WS-4DCO-PRCP-NO-CTR-TY-CPB PIC X(3). ! +480500 15 WS-4DCO-PRCP-NO-CTR-TY-CC PIC X(3). ! +480600 15 WS-4DCO-PRCP-CD-CAT-MIT PIC X(3). ! +480700 15 WS-4DCO-PRCP-LIB-CTR-TY-CPB PIC X(32). ! +480800 15 WS-4DCO-PRCP-CD-PRD-GNR-CPB PIC X(2). ! +480900 15 WS-4DCO-PRCP-LIB-GNR-CPB PIC X(32). ! +481000 15 WS-4DCO-PRCP-CD-CDR-PRF-CPB PIC X(2). ! +481100 15 WS-4DCO-PRCP-CD-CAT-CPB PIC X(2). ! +481200 15 WS-4DCO-PRCP-CD-CLS-CTR-TY PIC X(1). ! +481300 15 WS-4DCO-PRCP-CD-CPB-AUX PIC X(4). ! +481400 15 WS-4DCO-PRCP-TBL-ACT-FNC OCCURS 3. ! +481500 20 WS-4DCO-PRCP-CD-UNT-SPP-TBL PIC X(1). ! +481600 20 WS-4DCO-PRCP-CD-ACT-FNC-TBL PIC X(5). ! +481700 15 FILLER PIC X(182). ! +481800* ! +481900* PRODUIT COMPTABLE ! +482000* ! +482100 10 WS-4DCO-PRCP-PRD-CPB. ! +482200 15 WS-4DCO-PRCP-NO-PRD-CPB-SURA PIC X(3). ! +482300 15 WS-4DCO-PRCP-CD-UNT-SPP PIC X(1). ! +482400 15 WS-4DCO-PRCP-NO-GEN-PRD-CPB PIC X(3). ! +482500 15 WS-4DCO-PRCP-DA-DBT-GEN PIC X(8). ! +482600 15 WS-4DCO-PRCP-DA-FIN-GEN PIC X(8). ! +482700 15 WS-4DCO-PRCP-LIB-PRD-CPB PIC X(32). ! +482800 15 WS-4DCO-PRCP-CD-ACT-FNC PIC X(5). ! +482900 15 WS-4DCO-PRCP-CD-RGM-PAB PIC X(2). ! +483000 15 WS-4DCO-PRCP-TX-FRS-GTN-AN PIC 9(2)V9(3) COMP-3. ! +483100 15 WS-4DCO-PRCP-TX-MIN-ITT-GAR PIC S9(2)V9(3) COMP-3. ! +483200* ! +483300************************************ NOMBRE PRIS 353 ! +483400************************************ NOMBRE DISPONIBLE 1447 ! +483500* ZONE GROUPE POUR LE PROGRAMME TC4DDM0 ! +483600* ! +483700 10 WS-4DCO-4DDM. ! +483800* ! +483900* ZONE DE PAGINATION ! +484000 15 WS-4DCO-4DDM-PAGE. ! +484100 20 WS-4DCO-4DDM-IDC-OCC-SPL PIC X(001). ! +484200 20 WS-4DCO-4DDM-NB-PAG-TS PIC 9(002). ! +484300 20 WS-4DCO-4DDM-SAUV-PAGE-AREA PIC X(198). ! +484400* ! +484500* CLE DE REPOSITIONNEMENT (N� PRODUIT COMPTABLE) ! +484600 15 WS-4DCO-4DDM-CLEPOS PIC 9(003). ! +484700* ! +484800* CODE MESSAGE ERREUR ! +484900 15 WS-4DCO-4DDM-ERRMSG1 PIC X(006). ! +485000* ! +485100* ZOOM DEBUT ! +485200* SAUVEGARDE DES DONNEES A TRANSMETTRE QUELLES ! +485300* LA VISUALISATION EST DEMANDEE ! +485400 15 WS-4DCO-4DDM-TABLE. ! +485500 20 WS-4DCO-4DDM-TAB-ACTION-DTL OCCURS 12. ! +485600 25 WS-4DCO-4DDM-VAL-DTL PIC 9(003). ! +485700* ! +485800* POSITION DU CURSEUR DU 1ER DETAIL DEMANDE ! +485900 15 WS-4DCO-4DDM-POS-CURSOR PIC 9(002). ! +486000* NB DE DETAILS TRAITES ! +486100 15 WS-4DCO-4DDM-SAUV-ACT-TRT PIC S9(4) COMP. ! +486200* NB DE DETAILS DEMANDES ! +486300 15 WS-4DCO-4DDM-SAUV-ACT-NB PIC S9(4) COMP. ! +486400* ZOOM FIN ! +486500* ! +486600************************************ NOMBRE PRIS 605 ! +486700************************************ NOMBRE DISPONIBLE 1195 ! +486800 ! +486900* ZONE GROUPE POUR LE PROGRAMME TC4DDN0 ! +487000* ! +487100 10 WS-4DCO-4DDN. ! +487200* ! +487300* ZONE DE PAGINATION ! +487400 15 WS-4DCO-4DDN-PAGE. ! +487500 20 WS-4DCO-4DDN-IDC-OCC-SPL PIC X(001). ! +487600 20 WS-4DCO-4DDN-NB-PAG-TS PIC 9(002). ! +487700 20 WS-4DCO-4DDN-SAUV-PAGE-AREA PIC X(198). ! +487800* ! +487900* CLE DE REPOSITIONNEMENT ! +488000* 1) CODE EXTERNE DU PARTENAIRE ! +488100* 2) CODE EXTERNE DU PRODUIT ! +488200* 3) N� DE GENERATION DU PRODUIT ! +488300* CLE DE REPOSITIONNEMENT (CODE PARTENAIRE) ! +488400 15 WS-4DCO-4DDN-CLEPOS. ! +488500 20 WS-4DCO-4DDN-CD-PTN PIC X(005). ! +488600 20 WS-4DCO-4DDN-CD-PRD PIC X(002). ! +488700 20 WS-4DCO-4DDN-NO-GEN-PRD PIC X(003). ! +488800* ! +488900* CODE MESSAGE ERREUR ! +489000 15 WS-4DCO-4DDN-ERRMSG1 PIC X(006). ! +489100* ! +489200* ZOOM DEBUT 217 ! +489300* DONNEES POUR LESQUELLES LE ZOOM EST DDE ! +489400 15 WS-4DCO-4DDN-TABLE. ! +489500 20 WS-4DCO-4DDN-TAB-ACTION-DTL OCCURS 12. ! +489600 25 WS-4DCO-4DDN-Z-CD-PTN PIC X(005). ! +489700 25 WS-4DCO-4DDN-Z-CD-PRD PIC X(002). ! +489800 25 WS-4DCO-4DDN-Z-NO-GEN-PRD PIC X(003). ! +489900* ! +490000* POSITION DU CURSEUR DU 1ER DETAIL DEMANDE ! +490100 15 WS-4DCO-4DDN-POS-CURSOR PIC 9(002). ! +490200* NB DE DETAILS TRAITES ! +490300 15 WS-4DCO-4DDN-SAUV-ACT-TRT PIC S9(4) COMP. ! +490400* NB DE DETAILS DEMANDES ! +490500 15 WS-4DCO-4DDN-SAUV-ACT-NB PIC S9(4) COMP. ! +490600 15 WS-4DCO-4DDN-NO-CTR-TY-CPB PIC X(3). ! +490700* ZOOM FIN ! +490800************************************ NOMBRE PRIS 951 ! +490900************************************ NOMBRE DISPONIBLE 849 ! +491000 ! +491100 10 FILLER PIC X(849). ! +491200 ! +491300*================================================================ ! +491400*= APPLICATION : PARAMETRAGE : PRIME ETAT = ! +491500*================================================================ ! +491600* ! +491700 03 WS-4DCO-4DZZ REDEFINES WS-4DCO-PROGRAM. ! +491800* ============ ! +491900 ! +492000* ============== ! +492100* ------------------------------------------------------ * ! +492200* COMMAREA : GEODE : MENU PRINCIPAL * ! +492300* LONGUEUR : 1800 * ! +492400* PREFIXE : WS-4DCO-4DZZ * ! +492500* ------------------------------------------------------ * ! +492600 ! +492700 10 WS-4DCO-4DZZ. ! +492800 ! +492900 15 WS-4DCO-4DZZ-TOPMODIF PIC 9. ! +493000* INDIC MAJ COMMAREA PARTENAIRE ! +493100 15 FILLER PIC X(1799). ! +493200* ZONES DISPONIBLES ! +493300 ! +493400*================================================================ ! +493500*= APPLICATION : GESTION DES PERSONNES = ! +493600*================================================================ ! +493700 03 WS-4DCO-PERS REDEFINES WS-4DCO-PROGRAM. ! +493800* ============ ! +493900 ! +494000* ============== ! +494100* ------------------------------------------------------ * ! +494200* COMMAREA : PERS : GESTION DES PERSONNES * ! +494300* LONGUEUR : 1800 * ! +494400* PREFIXE : WS-4DCO-PERS * ! +494500* ------------------------------------------------------ * ! +494600 ! +494700 05 WS-4DCO-PERS-COMMUNE. ! +494800* PARTIE COMMUNE PERSONNE PHYSIQUE ET MORALE ! +494900 07 WS-4DCO-PERS-NO-PTN-MAJ PIC S9(03) COMP-3. ! +495000* NUMERO INTERNE PARTENAIRE AUTEUR DE LA MAJ ! +495100 07 WS-4DCO-PERS-NO-PTN PIC S9(03) COMP-3. ! +495200* NUMERO INTERNE PARTENAIRE ! +495300 07 WS-4DCO-PERS-CD-PTN PIC X(05). ! +495400* NUMERO EXTERNE PARTENAIRE ! +495500 07 WS-4DCO-PERS-NO-CLI-PTN PIC S9(07) COMP-3. ! +495600* NUMERO INTERNE CLIENT ! +495700 07 WS-4DCO-PERS-CD-CLI-PTN. ! +495800* NUMERO EXTERNE CLIENT ! +495900 10 WS-4DCO-PERS-CD-CLI1-PTN PIC X(07). ! +496000* NUMERO EXTERNE CLIENT PARTIE 1 ! +496100 10 WS-4DCO-PERS-CD-CLI2-PTN PIC X(08). ! +496200* NUMERO EXTERNE CLIENT PARTIE 2 ! +496300 07 WS-4DCO-PERS-VLR-IDT-MJ PIC X(08). ! +496400* IDENTIFIANT AYANT FAIT LA MAJ ! +496500 07 WS-4DCO-PERS-NO-AGT-MJ PIC X(08). ! +496600* AGENT AYANT FAIT LA MAJ ! +496700 07 WS-4DCO-PERS-CLIENT. ! +496800* INFOS CLIENT ! +496900 10 WS-4DCO-PERS-CD-INT PIC X(02). ! +497000* CODE INTITULE ! +497100 10 WS-4DCO-PERS-NOM-USU-PSE PIC X(32). ! +497200* NOM + PRENOM OU ENSEIGNE ! +497300 10 WS-4DCO-PERS-CD-TY-PSE PIC X(01). ! +497400* TYPE DE PERSONNE ! +497500 10 WS-4DCO-PERS-IDC-DOS-ATT PIC X(01). ! +497600* INDICATEUR DOSSIER EN ATTENTE ! +497700 10 WS-4DCO-PERS-IDC-ACC-MTL PIC X(01). ! +497800* INDICATEUR ACCES MINITEL ! +497900 10 WS-4DCO-PERS-IDC-INF-CFL PIC X(01). ! +498000* INDICATEUR CONFIDENTIALITE INFOS. ! +498100 10 WS-4DCO-PERS-ADR OCCURS 5. ! +498200* ADRESSES ET NUM TELEPHONE DU CLIENT ! +498300 15 WS-4DCO-PERS-NO-ORD-ADR-POST PIC S9(02) COMP-3. ! +498400* NUMERO ORDRE ADRESSE POSTALE ! +498500 15 WS-4DCO-PERS-LIB-RUE-1 PIC X(32). ! +498600* 1 ERE LIGNE ADRESSE ! +498700 15 WS-4DCO-PERS-LIB-RUE-2 PIC X(32). ! +498800* 2 EME LIGNE ADRESSE ! +498900 15 WS-4DCO-PERS-LIB-COMMUNE PIC X(32). ! +499000* 3 EME LIGNE ADRESSE ! +499100 15 WS-4DCO-PERS-CD-POST PIC X(05). ! +499200* CODE POSTAL ! +499300 15 WS-4DCO-PERS-LIB-BUR-DIST PIC X(26). ! +499400* LIBELLE DU BUREAU DISTRIBUTEUR ! +499500 15 WS-4DCO-PERS-CD-DPT PIC X(02). ! +499600* CODE DEPARTEMENT ! +499700 15 WS-4DCO-PERS-CD-COMM PIC X(03). ! +499800* CODE INSEE COMMUNE ! +499900 15 WS-4DCO-PERS-NO-TEL PIC X(11). ! +500000* NUMERO DE TELEPHONE ! +500100 15 WS-4DCO-DA-MAJ-ADR-POST. ! +500200* DATE DE DERNIERE MAJ ADRESSE POSTALE ! +500300 20 WS-4DCO-MAJ-ADR-SSAA PIC X(04). ! +500400* ANNEE DE DERNIERE MAJ ADRESSE POSTALE ! +500500 20 FILLER PIC X. ! +500600 20 WS-4DCO-MAJ-ADR-MM PIC X(02). ! +500700* MOIS DE DERNIERE MAJ ADRESSE POSTALE ! +500800 20 FILLER PIC X. ! +500900 20 WS-4DCO-MAJ-ADR-JJ PIC X(02). ! +501000* JOUR DE DERNIERE MAJ ADRESSE POSTALE ! +501100 10 WS-4DCO-PERS-CFRS PIC X(6). ! +501200* CENTRE DE FRAIS ! +501300 07 WS-4DCO-PERS-IDC-AUT-GTN-CLI PIC X. ! +501400 88 AUT-GERER VALUE 'O'. ! +501500 88 NON-AUT-GERER VALUE 'N'. ! +501600* INDIC SI PTN AUTO A GERER SES CODES CLIENTS ! +501700 07 FILLER PIC X(2). ! +501800* FILLER ! +501900* ! +502000 05 WS-4DCO-PHYS. ! +502100* COMMAREA PERSONNE PHYSIQUE ! +502200 07 WS-4DCO-PHYS-LIB-NOM PIC X(32). ! +502300* NOM ! +502400 07 WS-4DCO-PHYS-LIB-PRN PIC X(32). ! +502500* PRENOM ! +502600 07 WS-4DCO-PHYS-DA-NAI. ! +502700* DATE DE NAISSANCE ! +502800 10 WS-4DCO-PHYS-DA-NAI-SSAA PIC X(04). ! +502900* SIECLE ANNEE ! +503000 10 CARSLASH1 PIC X. ! +503100 10 WS-4DCO-PHYS-DA-NAI-MM PIC X(02). ! +503200* MOIS DE NAISSANCE ! +503300 10 CARSLASH2 PIC X. ! +503400 10 WS-4DCO-PHYS-DA-NAI-JJ PIC X(02). ! +503500* JOUR DE NAISSANCE ! +503600 07 WS-4DCO-PHYS-LIEU-NAI PIC X(32). ! +503700* LIEU DE NAISSANCE ! +503800 07 WS-4DCO-PHYS-CD-DPT-NAIS PIC X(02). ! +503900* CODE DEPARTEMENT DE NAISSANCE ! +504000 07 WS-4DCO-PHYS-CD-COMM-NAIS PIC X(03). ! +504100* CODE INSEE COMMUNE DE NAISSANCE ! +504200 07 WS-4DCO-PHYS-NOM-PATRO PIC X(32). ! +504300* NOM PATRONIMIQUE ! +504400 07 WS-4DCO-PHYS-CD-SIT-FAM PIC X(01). ! +504500* CODE SITUATION FAMILIALE ! +504600 07 FILLER PIC X(02). ! +504700* ! +504800 07 WS-4DCO-PHYS-CD-SEXE PIC X(01). ! +504900* SEXE ! +505000 07 WS-4DCO-PHYS-CD-CSP PIC X(04). ! +505100* CODE CATEGORIE SOCIO PROFESSIONNELLE ! +505200 07 WS-4DCO-PHYS-DA-DCS PIC X(10). ! +505300* DATE DECES PERSONNE PHYSIQUE ! +505400 07 WS-4DCO-PHYS-CD-OSCE-PAYS-N PIC X(03). ! +505500* CODE OSCEE PAYS ! +505600 07 WS-4DCO-PHYS-CD-OSCE-PAYS-NT PIC X(03). ! +505700* CODE OSCEE PAYS ! +505800 07 WS-4DCO-PHYS-CD-OSCE-PAYS-F PIC X(03). ! +505900* CODE OSCEE PAYS ! +506000 07 WS-4DCO-PHYS-CD-RGM-MTM PIC X(01). ! +506100* CODE REGIME MATRIMONIALE ! +506200 07 WS-4DCO-PHYS-CD-SIT-LOG PIC X(01). ! +506300* CODE SITUATION LOGEMENT ! +506400 07 WS-4DCO-PHYS-CD-CPC-JUR PIC X(02). ! +506500* CODE CAPACITE JURIDIQUE ! +506600 07 WS-4DCO-PHYS-CD-NIV-CFL-PSE PIC X(01). ! +506700* CODE NIVEAU CONFIDENTIALITE PERSONNE ! +506800 07 WS-4DCO-PHYS-CD-ORIG-DC PIC X(01). ! +506900* CODE ORIGINE ! +507000 07 FILLER PIC X(124). ! +507100* FILLER ! +507200* ! +507300 05 WS-4DCO-PERS-MORA REDEFINES WS-4DCO-PHYS. ! +507400* COMMAREA PERSONNE MORALE ! +507500 07 WS-4DCO-MORA-DA-CRE-EPS. ! +507600* DATE DE CREATION ENTREPRISE ! +507700 10 WS-4DCO-MORA-DA-CRE-EPS-SSAA PIC X(04). ! +507800* SIECLE ANNEE ! +507900 10 WS-4DCO-MORA-DA-CRE-EPS-MM PIC X(02). ! +508000* MOIS DE NAISSANCE ! +508100 10 WS-4DCO-MORA-DA-CRE-EPS-JJ PIC X(02). ! +508200* JOUR DE NAISSANCE ! +508300 07 WS-4DCO-MORA-RAI-SOC PIC X(32). ! +508400* RAISON SOCIALE ! +508500 07 WS-4DCO-MORA-LIB-ENS PIC X(32). ! +508600* ENSEIGNE COMMERCIALE ! +508700 07 WS-4DCO-MORA-LIB-NOM PIC X(32). ! +508800* NOM REPRESENTANT LEGAL ! +508900 07 WS-4DCO-MORA-NO-SIRET. ! +509000* NUMERO DE SIRET ! +509100 10 WS-4DCO-MORA-NO-IDT-EPS-SIT PIC X(09). ! +509200* NUMERO DE SIREN ! +509300 10 WS-4DCO-MORA-NO-IDT-CPL-SIT PIC X(05). ! +509400* COMPLEMENT AU SIREN ! +509500 07 WS-4DCO-MORA-JURID. ! +509600* CLASSIFICATION JURIDIQUE DE L'ENTREPRISE ! +509700 10 WS-4DCO-MORA-CD-DIV-FRM-JUR PIC X(02). ! +509800* CODE DIVISION FORME JURIDIQUE ! +509900 10 WS-4DCO-MORA-CD-SUB-FRM-JUR PIC X(02). ! +510000* CODE SUBDIVISION FORME JURIDIQUE ! +510100 07 WS-4DCO-MORA-NAF. ! +510200* CODE NORME ACTIVITE FRANCAISE ! +510300 10 WS-4DCO-MORA-CD-DIV-NAF PIC X(02). ! +510400* CODE DIVISION NAF ! +510500 10 WS-4DCO-MORA-CD-CLS-NAF PIC X(02). ! +510600* CODE CLASSIFICATION NAF ! +510700 07 WS-4DCO-MORA-CD-INT-REP PIC X(02). ! +510800* CODE INTITULE REPRESENTANT LEGAL ! +510900 07 WS-4DCO-MORA-LIB-CD-INT-REP PIC X(12). ! +511000* LIBELLE INTITULE REPRESENTANT LEGAL ! +511100 07 WS-4DCO-MORA-NO-FAX PIC X(12). ! +511200* NUMERO DU FAX ! +511300 07 WS-4DCO-RECH-SEL-MO. ! +511400* SELECTION ! +511500 10 WS-4DCO-RECH-SELOP-MO PIC X OCCURS 15. ! +511600* SELECTION ZOOM ! +511700 07 WS-4DCO-MORA-PAGE. ! +511800 20 WS-4DCO-MORA-IDC-OCC-SPL PIC X(001). ! +511900 20 WS-4DCO-MORA-NB-PAG-TS PIC 9(002). ! +512000 20 WS-4DCO-MORA-SAUV-PAGE-AREA PIC X(090). ! +512100 07 FILLER PIC X(040). ! +512200* ! +512300 05 WS-4DCO-PERS-AUTADR PIC X. ! +512400* INDIC SI AUTRE ADRESSE ! +512500 05 WS-4DCO-PERS-LIB-CD-INT-CT PIC X(10). ! +512600* LIBELLE CODE INTITULE COURT ! +512700 05 WS-4DCO-TOP-HOMONY PIC X. ! +512800* TOP VERIF DES HOMONYMES ! +512900 05 WS-4DCO-NBPAGES PIC 9(002). ! +513000* NOMBRE DE PAGES ! +513100* ! +513200 05 WS-4DCO-RECHERCHE. ! +513300* COMMAREA RECHERCHE PERSONNE ! +513400 07 WS-4DCO-RECH-CD-PTN PIC X(05). ! +513500* NUMERO EXTERNE PARTENAIRE ! +513600 07 WS-4DCO-RECH-NO-STR-DIS PIC X(06). ! +513700* NUMERO STRUCTURE DE DISTRIBUTION ! +513800 07 WS-4DCO-RECH-CD-CLI-PTN. ! +513900* NUMERO EXTERNE CLIENT ! +514000 10 WS-4DCO-RECH-CD-CLI1-PTN PIC X(07). ! +514100* NUMERO EXTERNE CLIENT PARTIE 1 ! +514200 10 WS-4DCO-RECH-CD-CLI2-PTN PIC X(08). ! +514300* NUMERO EXTERNE CLIENT PARTIE 2 ! +514400 07 WS-4DCO-RECH-LIB-NOM PIC X(32). ! +514500* NOM ! +514600 07 WS-4DCO-RECH-LIB-PRN PIC X(32). ! +514700* PRENOM ! +514800 07 WS-4DCO-RECH-LIB-ENS REDEFINES ! +514900 WS-4DCO-RECH-LIB-PRN PIC X(32). ! +515000* ENSEIGNE ! +515100 07 WS-4DCO-RECH-NOM-PATRO PIC X(32). ! +515200* NOM PATRONIMIQUE ! +515300 07 WS-4DCO-RECH-RAI-SOC REDEFINES ! +515400 WS-4DCO-RECH-NOM-PATRO PIC X(32). ! +515500* RAISON SOCIALE ! +515600 07 WS-4DCO-RECH-DA-NAI. ! +515700* DATE DE NAISSANCE ! +515800 10 WS-4DCO-RECH-DA-NAI-SSAA PIC X(04). ! +515900* SIECLE ANNEE ! +516000 10 CARTIRET1 PIC X. ! +516100 10 WS-4DCO-RECH-DA-NAI-MM PIC X(02). ! +516200* MOIS DE NAISSANCE ! +516300 10 CARTIRET2 PIC X. ! +516400 10 WS-4DCO-RECH-DA-NAI-JJ PIC X(02). ! +516500* JOUR DE NAISSANCE ! +516600 05 WS-4DCO-RECH-SEL. ! +516700* SELECTION ! +516800 07 WS-4DCO-RECH-SELOP PIC X OCCURS 14. ! +516900* SELECTION ZOOM ! +517000 05 WS-4DCO-PERS-NO-STR-DIS PIC X(06). ! +517100* NUMERO STRUCTURE DE DISTRIBUTION ! +517200 05 WS-4DCO-RECH-PAGE-AREA PIC X(200). ! +517300* COMMAREA RECHERCHE PERSONNE ! +517400 05 WS-4DCO-MAJ-TM-STP. ! +517500* TIME STAMP ! +517600 07 WS-4DCO-TM-STP PIC X(26) OCCURS 3. ! +517700* TIMESTAMP DES TABLES ! +517800 05 WS-4DCO-CTR-SEL. ! +517900* SELECTION ! +518000 07 WS-4DCO-CTR-SELOP PIC X OCCURS 10. ! +518100* SELECTION ZOOM ! +518200 05 WS-4DCO-PERS-TRANS PIC X(004). ! +518300* CODE APPLICATION ! +518400 05 WS-4DCO-PERS-NBPAGES PIC 9(002). ! +518500* NOMBRE DE PAGES ! +518600 05 WS-4DCO-PERS-MONT PIC S9(15)V99 COMP-3. ! +518700* MONTANT SOLDE COMPTABLE ! +518800 05 WS-4DCO-TM-STP1 PIC X(26). ! +518900* TIMESTAMP SUPPLEMENTAIRE ! +519000 05 WS-4DCO-PERS-NO-ADR PIC 9(002). ! +519100* NOMBRE D'ADRESSES COURRIER ! +519200 05 WS-4DCO-PERS-NO-ADR-MAX PIC 9(002). ! +519300* NO D'ODRE ADR COURRIER LE PLUS GRAND ! +519400 05 WS-4DCO-PERS-NO-SAUV PIC 9(002). ! +519500* SAUVEGARDE DU NO PAGE ! +519600 05 WS-4DCO-PERS-LIB-CD-INT PIC X(12). ! +519700* LIBELLE CODE INTITULE AFFICHE ! +519800 05 WS-4DCO-PERS-CD-PRD PIC X(02). ! +519900* CODE PRODUIT ! +520000 05 WS-4DCO-PERS-NO-POL-PRB PIC X(09). ! +520100* NO DE CONTRAT ! +520200 05 WS-4DCO-PERS-IDC-PRD-UNT-CPT PIC X(01). ! +520300* INDICATEUR PRODUIT EN UNITE DE COMPTE ! +520400 05 WS-4DCO-PERS-DA-DCS. ! +520500* DATE DECES ! +520600 10 WS-4DCO-PERS-DA-DCS-JJ PIC X(02). ! +520700 10 FILLER PIC X. ! +520800 10 WS-4DCO-PERS-DA-DCS-MM PIC X(02). ! +520900 10 FILLER PIC X. ! +521000 10 WS-4DCO-PERS-DA-DCS-SSAA PIC X(04). ! +521100*-- DA3371 ! +521200*-- DATE DE MAJ DE L'ENCOURS GLOBAL ! +521300 05 WS-4DCO-PERS-DATMAJ. ! +521400 10 WS-DA-MAJP-SA PIC X(04). ! +521500 10 WS-DA-MAJP-MM PIC X(02). ! +521600 10 WS-DA-MAJP-JJ PIC X(02). ! +521700 05 FILLER PIC X(91). ! +521800* ! +521900*================================================================ ! +522000*= APPLICATION : GESTION DES AVANCES = ! +522100*================================================================ ! +522200 03 WS-4DCO-AVN REDEFINES WS-4DCO-PROGRAM. ! +522300* ============ ! +522400 ! +522500* ============== ! +522600* ------------------------------------------------------ * ! +522700* COMMAREA : AVN : GESTION DES AVANCES * ! +522800* LONGUEUR : 1800 * ! +522900* PREFIXE : WS-4DCO-AVN * ! +523000* ------------------------------------------------------ * ! +523100 ! +523200 05 WS-4DCO-AVN-NO-STR-GTN PIC X(06). ! +523300* NUMERO STRUCTURE GESTION ! +523400 05 WS-4DCO-AVN-NO-AGT-GTN PIC X(08). ! +523500* NUMERO AGENT GESTION ! +523600 05 WS-4DCO-AVN-DA-PAS-DNR-PAB PIC X(08). ! +523700* DATE DE PASSAGE DERNIER PAB ! +523800 05 WS-4DCO-AVN-SLD-TPS-REAL PIC S9(15) COMP-3. ! +523900* SOLDE TEMPS REEL CONTRAT ! +524000 05 WS-4DCO-AVN-SLD-AV PIC S9(15) COMP-3. ! +524100* SOLDE AVANCES ! +524200 05 WS-4DCO-AVN-NB-AV-ACD PIC 9(02). ! +524300* NOMBRE AVANCES DEJA ACCORDEES ! +524400 05 WS-4DCO-AVN-MT-ITT-EXE PIC S9(15) COMP-3. ! +524500* MT INTERETS AVANCES EXE EN-COURS ! +524600 05 WS-4DCO-AVN-MT-ITT-EXE-1 PIC S9(15) COMP-3. ! +524700* MT INTERETS AVANCES EXE -1 ! +524800 05 WS-4DCO-AVN-MT-FRS-EXE PIC S9(15) COMP-3. ! +524900* MT FRAIS AVANCES EXE EN-COURS ! +525000 05 WS-4DCO-AVN-MT-FRS-EXE-1 PIC S9(15) COMP-3. ! +525100* MT FRAIS AVANCES EXE -1 ! +525200 05 WS-4DCO-AVN-MT-FRS-EXEG PIC S9(15) COMP-3. ! +525300* MT FRAIS GESTION AVANCES EXE EN-COURS ! +525400 05 WS-4DCO-AVN-MT-FRS-EXE-1G PIC S9(15) COMP-3. ! +525500* MT FRAIS GESTION AVANCES EXE -1 ! +525600 05 WS-4DCO-AVN-MT-FRS-EXEC PIC S9(15) COMP-3. ! +525700* MT FRAIS COMMISSION AVANCES EXE EN-COURS ! +525800 05 WS-4DCO-AVN-MT-FRS-EXE-1G PIC S9(15) COMP-3. ! +525900* MT FRAIS COMMISSION AVANCES EXE -1 ! +526000 05 WS-4DCO-AVN-IDT-CLT PIC X(32). ! +526100* IDENTITE CLIENT ! +526200 05 WS-4DCO-AVN-LIB-CTR PIC X(16). ! +526300* LIBELLE CONTRAT ( NO ADHESION / NO COMPTE ) ! +526400 05 WS-4DCO-AVN-NO-CTR PIC X(15). ! +526500* NUMERO DE CONTRAT ! +526600 05 WS-4DCO-AVN-NO-CTR-CCM REDEFINES WS-4DCO-AVN-NO-CTR. ! +526700* NUMERO DE CONTRAT CCM ! +526800 10 WS-4DCO-AVN-RACINE PIC X(07). ! +526900 10 WS-4DCO-AVN-FILLER PIC X(01). ! +527000 10 WS-4DCO-AVN-CLE-RAC PIC X(01). ! +527100 10 WS-4DCO-AVN-FILLER PIC X(01). ! +527200 10 WS-4DCO-AVN-CAT PIC X(02). ! +527300 10 WS-4DCO-AVN-FILLER PIC X(01). ! +527400 10 WS-4DCO-AVN-RANG PIC X(02). ! +527500 05 WS-4DCO-AVN-NO-CTR-EXT REDEFINES WS-4DCO-AVN-NO-CTR. ! +527600* NUMERO DE CONTRAT PARTENAIRES EXTERIEURS ! +527700 10 WS-4DCO-AVN-PRD PIC X(02). ! +527800 10 WS-4DCO-AVN-FILLER PIC X(01). ! +527900 10 WS-4DCO-AVN-NO-POL PIC X(08). ! +528000 10 WS-4DCO-AVN-FILLER PIC X(01). ! +528100 10 WS-4DCO-AVN-CLE-POL PIC X(01). ! +528200 10 WS-4DCO-AVN-FILLER PIC X(02). ! +528300 05 WS-4DCO-AVN-DA-OPE. ! +528400* DATE D OPERATION ! +528500 10 WS-4DCO-AVN-DA-OPE-A PIC X(04). ! +528600 10 WS-4DCO-AVN-DA-OPE-M PIC X(02). ! +528700 10 WS-4DCO-AVN-DA-OPE-J PIC X(02). ! +528800 05 WS-4DCO-AVN-DA-EFF. ! +528900* DATE D EFFET ! +529000 10 WS-4DCO-AVN-DA-EFF-A PIC X(04). ! +529100 10 WS-4DCO-AVN-DA-EFF-M PIC X(02). ! +529200 10 WS-4DCO-AVN-DA-EFF-J PIC X(02). ! +529300 05 WS-4DCO-AVN-NO-RIB. ! +529400* NUMERO RIB ! +529500 10 WS-4DCO-AVN-CD-BANQUE PIC X(05). ! +529600 10 WS-4DCO-AVN-CD-GUICHET PIC X(05). ! +529700 10 WS-4DCO-AVN-NO-CPT-RIB PIC X(11). ! +529800 10 WS-4DCO-AVN-NO-CLE-RIB PIC X(02). ! +529900 05 WS-4DCO-AVN-MT-AV PIC S9(13)V9(2). ! +530000* MONTANT AVANCE ! +530100 05 FILLER PIC X(10). ! +530200* FILLER ! +530300 05 WS-4DCO-AVN-MODE-RGL PIC X(01). ! +530400* MODE REGLEMENT ! +530500 05 WS-4DCO-AVN-NO-CHQ PIC X(07). ! +530600* NUMERO DE CHEQUE ! +530700 05 WS-4DCO-AVN-TAB-MVT OCCURS 20. ! +530800* TABLE DES LIBELLES MOUVEMENTS ! +530900 10 WS-4DCO-AVN-LIB-MVT PIC X(32). ! +531000* LIBELLE MOUVEMENT ! +531100 10 WS-4DCO-AVN-CD-SENS-MVT PIC X(01). ! +531200* CODE SENS MOUVEMENT ! +531300 05 WS-4DCO-AVN-ITEM-ZOOM PIC S9(04) COMP. ! +531400* NO DE L'ITEM A ZOOMER ! +531500 05 WS-4DCO-AVN-PAGE-AREA PIC X(198). ! +531600* PAGE AREA START ! +531700 05 WS-4DCO-AVN-STOCK. ! +531800 10 WS-4DCO-AVN-NO-ENREG OCCURS 12 PIC X(02). ! +531900* STOCK TYPE DE MOUVEMENT DE LA PAGE ! +532000 10 WS-4DCO-AVN-MT-STOCK OCCURS 12 ! +532100 PIC S9(13)V99 COMP-3. ! +532200* STOCK MT DE MOUVEMENT DE LA PAGE ! +532300 05 WS-4DCO-AVN-NOM-PATRO PIC X(32). ! +532400* NOM PATRONYMIQUE ! +532500 05 WS-4DCO-AVN-CD-NTS PIC X(01). ! +532600* CODE NANTISSEMENT ! +532700 05 WS-4DCO-AVN-TYP-ANN PIC X. ! +532800 88 ANNULATION-JOUR VALUE ' '. ! +532900 88 ANNULATION-NON-JOUR VALUE 'N'. ! +533000* TOP ANNULATION AVANCE ! +533100 05 WS-4DCO-AVN-TYP-CONF PIC X(10). ! +533200* TYPE CONFIDENCIALITE ! +533300 05 WS-4DCO-AVN-CHX1 PIC X(02). ! +533400* CHOIX 1 ! +533500 05 WS-4DCO-AVN-CHX2 PIC X(02). ! +533600* CHOIX 2 ! +533700 05 WS-4DCO-AVN-LIB-CONF-1 PIC X(32). ! +533800* LIBELLE CONFIDENCIALITE 1 ! +533900 05 WS-4DCO-AVN-LIB-CONF-2 PIC X(32). ! +534000* LIBELLE CONFIDENCIALITE 2 ! +534100 05 WS-4DCO-AVN-DEBJ PIC X(02). ! +534200* DATE DEBUT JOUR ! +534300 05 WS-4DCO-AVN-DEBM PIC X(02). ! +534400* DATE DEBUT MOIS ! +534500 05 WS-4DCO-AVN-DEBSA PIC X(04). ! +534600* DATE DEBUT SIECLE ANNEE ! +534700 05 WS-4DCO-AVN-FINJ PIC X(02). ! +534800* DATE FIN JOUR ! +534900 05 WS-4DCO-AVN-FINM PIC X(02). ! +535000* DATE FIN MOIS ! +535100 05 WS-4DCO-AVN-FINSA PIC X(04). ! +535200* DATE FIN SIECLE ANNEE ! +535300 05 WS-4DCO-AVN-IMP PIC X(07). ! +535400* IMPRIMANTE ! +535500 05 WS-4DCO-AVN-MT-NET-VER-PER PIC S9(15) COMP-3. ! +535600* MT NET DU VERSEMENT PERIODIQUE ! +535700 05 WS-4DCO-AVN-CD-PROR-CTR PIC X(01). ! +535800* CODE PROROGATION DU CONTRAT ! +535900 05 WS-4DCO-AVN-DA-ECN-CTR PIC X(08). ! +536000* DATE ECHEANCE DU CONTRAT ! +536100 05 WS-4DCO-AVN-DA-ECN-PROR PIC X(08). ! +536200* DATE ECHEANCE PROROGEE DU CONTRAT ! +536300 05 WS-4DCO-AVN-DATRB PIC X(08). ! +536400* DATE DE REMBOURSEMENT TOTAL ! +536500 05 WS-4DCO-AVN-IDC-EDI-CM PIC X(01). ! +536600* indicateur edition cheque ccm ! +536700 05 WS-4DCO-AVN-NO-AV PIC 9(08) COMP. ! +536800* numero d'avance ! +536900 05 WS-4DCO-AVN-DA-DEM. ! +537000* DATE D EFFET ! +537100 10 WS-4DCO-AVN-DA-DEM-A PIC X(04). ! +537200 10 WS-4DCO-AVN-DA-DEM-M PIC X(02). ! +537300 10 WS-4DCO-AVN-DA-DEM-J PIC X(02). ! +537400 05 FILLER PIC X(400). ! +537500***************************************************************** ! +537600*================================================================ ! +537700*= APPLICATION : STATISTIQUES PRODUCTION ET ENCOURS = ! +537800*================================================================ ! +537900 03 WS-4DCO-STAT-PROD-ENC REDEFINES WS-4DCO-PROGRAM. ! +538000* ===================== ! +538100 ! +538200* ============== ! +538300* ------------------------------------------------------ * ! +538400* COMMAREA : STA : STATISTIQUES PRODUCTION ET ENCOURS * ! +538500* LONGUEUR : 1800 * ! +538600* PREFIXE : WS-4DCO-93C0 (PARTIE COMMUNE) 200C * ! +538700* ------------------------------------------------------ * ! +538800 ! +538900 05 WS-4DCO-93C0-GZONCOM. ! +539000* ZONE COMMUNE GESTION DES STATISTIQUES ! +539100* LIBELLE MESSAGE ! +539200 10 WS-4DCO-93C0-LMSG PIC X(050). ! +539300* CODE CHOIX ! +539400 10 WS-4DCO-93C0-CCHX PIC X(001). ! +539500* CODE ACTION ! +539600 10 WS-4DCO-93C0-CACT PIC X(001). ! +539700* CLE POLICE RACINE ! +539800 10 WS-4DCO-93C0-GCLE. ! +539900* CODE PARTENAIRE ! +540000 15 WS-4DCO-93C0-CPRN PIC X(005). ! +540100* NUMERO PRODUIT ! +540200 15 WS-4DCO-93C0-CPRD PIC X(002). ! +540300* NUMERO POLICE ! +540400 15 WS-4DCO-93C0-NPOL. ! +540500 20 WS-4DCO-93C0-NPOLRAC PIC X(008). ! +540600 20 WS-4DCO-93C0-NPOLCLE PIC X(001). ! +540700* NUMERO PROGRAMME ! +540800 10 WS-4DCO-93C0-PGM PIC X(008). ! +540900* ! +541000 10 WS-4DCO-93C0-LCOUPRN PIC X(012). ! +541100* ! +541200 10 WS-4DCO-93C0-LCOUPRD PIC X(012). ! +541300* ! +541400 10 WS-4DCO-93C0-LNOM PIC X(032). ! +541500* ! +541600 10 WS-4DCO-93C0-CTLAGE PIC X(008). ! +541700* ! +541800 10 WS-4DCO-93C0-TRMID PIC X(4). ! +541900* ! +542000 10 WS-4DCO-93C0-TIME PIC S9(7) COMP-3. ! +542100* ! +542200 10 WS-4DCO-93C0-NIVEAU PIC X. ! +542300* ! +542400 10 WS-4DCO-93C0-GESED PIC X. ! +542500* ! +542600 10 WS-4DCO-93C0-IND PIC X(1). ! +542700* CODE CHOIX SUR 2 CAR. ! +542800 10 WS-4DCO-93C0-CHOIX PIC X(002). ! +542900* ! +543000 10 WS-4DCO-93C0-VAL PIC X(001). ! +543100* ! +543200 10 WS-4DCO-93C0-NO-ECRAN PIC S9(04) COMP. ! +543300* ! +543400 10 WS-4DCO-93C0-NUM PIC 9(04). ! +543500* ! +543600 10 FILLER PIC X(040). ! +543700 ! +543800* ============== ! +543900* ------------------------------------------------------ * ! +544000* COMMAREA : STA : STATISTIQUES PRODUCTION ET ENCOURS * ! +544100* LONGUEUR : 1800 * ! +544200* PREFIXE : WS-4DCO-93C5 (PARTIE VARIABLE) 1600C * ! +544300* ------------------------------------------------------ * ! +544400* ! +544500 05 WS-4DCO-93C5-GZONSPC5. ! +544600 ! +544700* AGENCE PREAFFICHEE '0' (NON) ! +544800* '1' (OUI) ! +544900 10 WS-4DCO-93C5-TOPAGE PIC X(001). ! +545000* ZONES ECRAN ! +545100 10 WS-4DCO-93C5-ECRAN. ! +545200* CODE NATURE '1' OU '2' ! +545300 15 WS-4DCO-93C5-CNAT PIC X(001). ! +545400* CODE ACTION '1' '2' '3' ! +545500* '4' OU '5' ! +545600 15 WS-4DCO-93C5-CACT PIC X(001). ! +545700* CODES PRODUITS ! +545800 15 WS-4DCO-93C5-CPRD1 PIC X(002). ! +545900 15 WS-4DCO-93C5-CPRD2 PIC X(002). ! +546000 15 WS-4DCO-93C5-CPRD3 PIC X(002). ! +546100 15 WS-4DCO-93C5-CPRD4 PIC X(002). ! +546200 15 WS-4DCO-93C5-CPRD5 PIC X(002). ! +546300* CODE AGENCE ! +546400 15 WS-4DCO-93C5-AGENCE-S. ! +546500 20 FILLER PIC X(002). ! +546600 20 WS-4DCO-93C5-AGENCE PIC X(006). ! +546700* CODE AGENT ! +546800 15 WS-4DCO-93C5-AGENT PIC X(008). ! +546900* DATE DEBUT ! +547000 15 WS-4DCO-93C5-DDEB. ! +547100 20 WS-4DCO-93C5-DDEBSA PIC X(004). ! +547200 20 WS-4DCO-93C5-DDEBMM PIC X(002). ! +547300 20 WS-4DCO-93C5-DDEBJJ PIC X(002). ! +547400* DATE FIN ! +547500 15 WS-4DCO-93C5-DFIN. ! +547600 20 WS-4DCO-93C5-DFINSA PIC X(004). ! +547700 20 WS-4DCO-93C5-DFINMM PIC X(002). ! +547800 20 WS-4DCO-93C5-DFINJJ PIC X(002). ! +547900* ! +548000 15 WS-4DCO-93C5-CPRD1I PIC 9(003). ! +548100 15 WS-4DCO-93C5-CPRD2I PIC 9(003). ! +548200 15 WS-4DCO-93C5-CPRD3I PIC 9(003). ! +548300 15 WS-4DCO-93C5-CPRD4I PIC 9(003). ! +548400 15 WS-4DCO-93C5-CPRD5I PIC 9(003). ! +548500* ! +548600 10 WS-4DCO-93C5-LCOUPRD1 PIC X(032). ! +548700 10 WS-4DCO-93C5-LCOUPRD2 PIC X(032). ! +548800 10 WS-4DCO-93C5-LCOUPRD3 PIC X(032). ! +548900 10 WS-4DCO-93C5-LCOUPRD4 PIC X(032). ! +549000 10 WS-4DCO-93C5-LCOUPRD5 PIC X(032). ! +549100* POSSIBILITE ZOOM ECRAN M4DLG0 ' ' (NON) ! +549200* '*' (OUI) ! +549300 10 WS-4DCO-93C5-OUV-ZOOM PIC X(001). ! +549400* MONTANT ENCOURS NET POUR PRODUIT 74 ! +549500 10 WS-4DCO-93C5-MT-ENC-74 PIC S9(15) COMP-3. ! +549600* DATE REFERENCE POUR ZOOM 74 ! +549700 10 WS-4DCO-93C5-DAT-REF-74 PIC X(08). ! +549800* CODE PRODUIT POPT ! +549900 10 WS-4DCO-93C5-CPRD-74 PIC X(02). ! +550000* NUMERO INTERNE PRODUIT POPT ! +550100 10 WS-4DCO-93C5-CPRDI-74 PIC 9(03). ! +550200* LIBELLE PRODUIT 74 ! +550300 10 WS-4DCO-93C5-LPRD-74 PIC X(32). ! +550400* MONTANT ENCOURS VALORISE POUR PRODUIT 74 ! +550500 10 WS-4DCO-93C5-MT-VAL-74 PIC S9(15) COMP-3. ! +550600* ---- LIB ABR�G� PRODUITS ! +550700 10 WS-4DCO-93C5-LA-PRD OCCURS 5 PIC X(016). ! +550800* ---- LISTE DES PRODUITS EN ENTETE D'�CRAN ! +550900 10 WS-4DCO-93C5-LISTE-PRD PIC X(065). ! +551000* ---- INDICATEUR DE VISUALISATION DES STATS ! +551100 10 WS-4DCO-93C5-IDC-VSU-STAT OCCURS 5 PIC X(01). ! +551200* ! +551300 10 WS-4DCO-93C5-no-spp-fnc PIC 9(06). ! +551400* ! +551500 10 WS-4DCO-93C5-MODIF-ZONE pic x(01). ! +551600* ! +551700 10 WS-4DCO-93C5-IDC-OCC-SPL PIC X(001). ! +551800* ! +551900 10 WS-4DCO-93C5-IDC-nopage PIC X(001). ! +552000* ! +552100 10 FILLER PIC X(1159). ! +552200 ! +552300* ------------------------------------------------------ * ! +552400* COMMAREA : EDITIONS MINITEL * ! +552500* LONGUEUR : 1800 * ! +552600* PREFIXE : WS-4DCO-93C6 (PARTIE VARIABLE) 1600C * ! +552700* ------------------------------------------------------ * ! +552800* ! +552900 05 WS-4DCO-93C6-GZONSPC6 REDEFINES WS-4DCO-93C5-GZONSPC5. ! +553000 ! +553100* TOP REQUETE ! +553200 10 WS-4DCO-93C6-TOPREQ PIC X(001). ! +553300* ZONES ECRAN ! +553400 10 WS-4DCO-93C6-ECRAN. ! +553500* CHOIX '1' EDITION OU ! +553600* '2' REEDITION ! +553700 15 WS-4DCO-93C6-CHOIX PIC X(001). ! +553800* IMPRIMANTE ! +553900 15 WS-4DCO-93C6-IMPR PIC X(008). ! +554000* CODES PRODUITS ! +554100 15 WS-4DCO-93C6-CPRD1 PIC X(002). ! +554200 15 WS-4DCO-93C6-CPRD2 PIC X(002). ! +554300 15 WS-4DCO-93C6-CPRD3 PIC X(002). ! +554400 15 WS-4DCO-93C6-CPRD4 PIC X(002). ! +554500 15 WS-4DCO-93C6-CPRD5 PIC X(002). ! +554600* DATE DEBUT ! +554700 15 WS-4DCO-93C6-DDEB. ! +554800 20 WS-4DCO-93C6-DDEBSA PIC X(004). ! +554900 20 WS-4DCO-93C6-DDEBMJ. ! +555000 25 WS-4DCO-93C6-DDEBMM PIC X(002). ! +555100 25 WS-4DCO-93C6-DDEBJJ PIC X(002). ! +555200* DATE FIN ! +555300 15 WS-4DCO-93C6-DFIN. ! +555400 20 WS-4DCO-93C6-DFINSA PIC X(004). ! +555500 20 WS-4DCO-93C6-DFINMJ. ! +555600 25 WS-4DCO-93C6-DFINMM PIC X(002). ! +555700 25 WS-4DCO-93C6-DFINJJ PIC X(002). ! +555800* PROCHAINE DATE DEBUT EDITION ! +555900 15 WS-4DCO-93C6-DDED. ! +556000 20 WS-4DCO-93C6-DDEDJM. ! +556100 25 WS-4DCO-93C6-DDEDJJ PIC X(002). ! +556200 25 WS-4DCO-93C6-DDEDMM PIC X(002). ! +556300 20 WS-4DCO-93C6-DDEDSA PIC X(004). ! +556400* ! +556500 10 FILLER PIC X(1556). ! +556600* ! +556700* ============== ! +556800* ------------------------------------------------------ * ! +556900* COMMAREA : REQUETES * ! +557000* LONGUEUR : 1800 * ! +557100* PREFIXE : WS-4DCO-93C7 (PARTIE VARIABLE) 1600C * ! +557200* ------------------------------------------------------ * ! +557300* ! +557400 05 WS-4DCO-93C7-GZONSPC7 REDEFINES WS-4DCO-93C5-GZONSPC5. ! +557500* TOP EOF FICHER REQUETE ! +557600 10 WS-4DCO-93C7-REQ-BOF PIC X(1). ! +557700 10 WS-4DCO-93C7-REQ-EOF PIC X(1). ! +557800* OCCURENCE IMAGE REQUETE ! +557900 10 WS-4DCO-93C7-IMAREQ PIC S9(2). ! +558000* NBR DE REQUETES AFFICHEES ! +558100 10 WS-4DCO-93C7-NBREQ PIC S9(2). ! +558200* ! +558300* CLE REQUETE RETOUR ZOOM ! +558400 10 WS-4DCO-93C7-GCLEREQ. ! +558500* CODE REQUETE ! +558600 15 WS-4DCO-93C7-CODREQ PIC X(02). ! +558700* NO REQUETE ! +558800 15 WS-4DCO-93C7-NOREQ PIC X(04). ! +558900* PARTENAIRE ! +559000 15 WS-4DCO-93C7-CPRN PIC X(05). ! +559100* DATE / HEURE REQUETE ! +559200 15 WS-4DCO-93C7-DHREQ. ! +559300 20 WS-4DCO-93C7-DREQ. ! +559400 25 WS-4DCO-93C7-DREQ-SA. ! +559500 30 WS-4DCO-93C7-DREQ-SS PIC X(02). ! +559600 30 WS-4DCO-93C7-DREQ-AA PIC X(02). ! +559700 25 WS-4DCO-93C7-DREQ-MM PIC X(02). ! +559800 25 WS-4DCO-93C7-DREQ-JJ PIC X(02). ! +559900 20 WS-4DCO-93C7-HREQ. ! +560000 25 WS-4DCO-93C7-HREQ-HH PIC X(02). ! +560100 25 WS-4DCO-93C7-HREQ-MM PIC X(02). ! +560200 25 WS-4DCO-93C7-HREQ-SS PIC X(02). ! +560300* ! +560400* CLE REQUETE ZOOM ! +560500 10 WS-4DCO-93C7-GCLEREQZ. ! +560600* CODE REQUETE ! +560700 15 WS-4DCO-93C7-CODREQZ PIC X(02). ! +560800* NO REQUETE ! +560900 15 WS-4DCO-93C7-NOREQZ PIC X(04). ! +561000* PARTENAIRE ! +561100 15 WS-4DCO-93C7-CPRNZ PIC X(05). ! +561200* DATE / HEURE REQUETE ! +561300 15 WS-4DCO-93C7-DHREQZ. ! +561400 20 WS-4DCO-93C7-DREQZ. ! +561500 25 WS-4DCO-93C7-DREQZ-SA. ! +561600 30 WS-4DCO-93C7-DREQZ-SS PIC X(02). ! +561700 30 WS-4DCO-93C7-DREQZ-AA PIC X(02). ! +561800 25 WS-4DCO-93C7-DREQZ-MM PIC X(02). ! +561900 25 WS-4DCO-93C7-DREQZ-JJ PIC X(02). ! +562000 20 WS-4DCO-93C7-HREQZ. ! +562100 25 WS-4DCO-93C7-HREQZ-HH PIC X(02). ! +562200 25 WS-4DCO-93C7-HREQZ-MM PIC X(02). ! +562300 25 WS-4DCO-93C7-HREQZ-SS PIC X(02). ! +562400* ! +562500* TOP REQUETE ECRAN ! +562600 15 WS-4DCO-93C7-TOPREQ PIC X(01) OCCURS 14. ! +562700* ! +562800 10 FILLER PIC X(1530). ! +562900* ! +563000*================================================================ ! +563100*= APPLICATION : PROROGATION CONTRAT / EDITION AVENANT = ! +563200*================================================================ ! +563300 03 WS-4DCO-AVT REDEFINES WS-4DCO-PROGRAM. ! +563400* ============ ! +563500 ! +563600* ============== ! +563700* ------------------------------------------------------ * ! +563800* COMMAREA : AVT : PROROG. CONTRAT / EDIT. AVENANT * ! +563900* LONGUEUR : 1800 * ! +564000* PREFIXE : WS-4DCO-AVT * ! +564100* ------------------------------------------------------ * ! +564200 ! +564300 05 WS-4DCO-AVT-PRG-AVANT PIC X(01). ! +564400* CODE PROROGATION AVANT ! +564500 05 WS-4DCO-AVT-PRG-APRES PIC X(01). ! +564600* CODE PROROGATION APRES ! +564700 05 WS-4DCO-AVT-PRG-EDIT PIC X(01). ! +564800* CODE EDITION ! +564900 05 WS-4DCO-AVT-NOM-PATRO PIC X(32). ! +565000* NOM PRENOM ! +565100 05 WS-4DCO-AVT-DA-SCR. ! +565200* DATE SOUSCRIPTION ! +565300 10 WS-4DCO-AVT-DA-SCR-SA PIC X(04). ! +565400* DATE SOUSCRIPTION SIECLE ANNEE ! +565500 10 WS-4DCO-AVT-DA-SCR-MM PIC X(02). ! +565600* DATE SOUSCRIPTION MOIS ! +565700 10 WS-4DCO-AVT-DA-SCR-JJ PIC X(02). ! +565800* DATE SOUSCRIPTION JOUR ! +565900 05 WS-4DCO-AVT-DA-ECN. ! +566000* DATE ECHEANCE CONTRAT ! +566100 10 WS-4DCO-AVT-DA-ECN-SA PIC X(04). ! +566200* DATE ECHEANCE SIECLE ANNEE ! +566300 10 WS-4DCO-AVT-DA-ECN-MM PIC X(02). ! +566400* DATE ECHEANCE MOIS ! +566500 10 WS-4DCO-AVT-DA-ECN-JJ PIC X(02). ! +566600* DATE ECHEANCE JOUR ! +566700 05 WS-4DCO-AVT-RUE-1 PIC X(32). ! +566800* LIBELLE RUE 1 ! +566900 05 WS-4DCO-AVT-RUE-2 PIC X(32). ! +567000* LIBELLE RUE 2 ! +567100 05 WS-4DCO-AVT-CD-POST PIC X(05). ! +567200* CODE POSTAL ! +567300 05 WS-4DCO-AVT-COMMUNE PIC X(32). ! +567400* COMMUNE ! +567500 05 WS-4DCO-AVT-BUR-DIST PIC X(26). ! +567600* BUREAU DISTRIBUTEUR ! +567700 05 WS-4DCO-AVT-TX-MIN PIC 99V9(3). ! +567800* TX MINIMUM GARANTI ! +567900 05 WS-4DCO-AVT-DA-FIN-TX. ! +568000* DATE FIN TX MIN GARANTI ! +568100 10 WS-4DCO-AVT-DA-FIN-TX-SA PIC X(04). ! +568200* DATE FIN TX MIN GARANTI SIECLE ANNEE ! +568300 10 WS-4DCO-AVT-DA-FIN-TX-MM PIC X(02). ! +568400* DATE FIN TX MIN GARANTI MOIS ! +568500 10 WS-4DCO-AVT-DA-FIN-TX-JJ PIC X(02). ! +568600* DATE FIN TX MIN GARANTI JOUR ! +568700 05 WS-4DCO-AVT-BQE PIC X(05). ! +568800* BANQUE DOMICILIATAIRE ! +568900 05 WS-4DCO-AVT-GCHT PIC X(05). ! +569000* GUICHET DOMICILIATAIRE ! +569100 05 WS-4DCO-AVT-CPT PIC X(11). ! +569200* COMPTE DOMICILIATAIRE ! +569300 05 WS-4DCO-AVT-CLE PIC X(02). ! +569400* CLE DOMICILIATAIRE ! +569500 05 WS-4DCO-AVT-DA-ECN-PROR. ! +569600* DATE ECHEANCE PROROGATION ! +569700 10 WS-4DCO-AVT-DA-ECN-PRO-SA PIC X(04). ! +569800* DATE ECHEANCE SIECLE ANNEE ! +569900 10 WS-4DCO-AVT-DA-ECN-PRO-MM PIC X(02). ! +570000* DATE ECHEANCE MOIS ! +570100 10 WS-4DCO-AVT-DA-ECN-PRO-JJ PIC X(02). ! +570200* DATE ECHEANCE JOUR ! +570300 05 WS-4DCO-AVT-DA-PROR. ! +570400* DATE PROROGATION ! +570500 10 WS-4DCO-AVT-DA-PRO-SA PIC X(04). ! +570600* DATE ECHEANCE SIECLE ANNEE ! +570700 10 WS-4DCO-AVT-DA-PRO-MM PIC X(02). ! +570800* DATE ECHEANCE MOIS ! +570900 10 WS-4DCO-AVT-DA-PRO-JJ PIC X(02). ! +571000* DATE ECHEANCE JOUR ! +571100 05 WS-4DCO-AVT-DUREE-PRO PIC 9(02). ! +571200* DUREE DE LA PROROGATION ! +571300 05 WS-4DCO-AVT-TY-PROR PIC X(01) . ! +571400 88 WS-4DCO-AVT-TY-ANC VALUE '1' . ! +571500 88 WS-4DCO-AVT-TY-NOUV VALUE '2' . ! +571600 88 WS-4DCO-AVT-TY-TACITE VALUE '3' . ! +571700 05 FILLER PIC X(1567). ! +571800 ! +571900* ==================== ! +572000 03 WS-4DCO-PROROG-LISTE REDEFINES WS-4DCO-PROGRAM. ! +572100* ==================== ! +572200* ------------------------------------------------------ * ! +572300* COMMAREA : PROROGATION / REEDITION D AVENANT * ! +572400* LONGUEUR : 1800 * ! +572500* PREFIXE : WS-4DCO-PRG * ! +572600* ------------------------------------------------------ * ! +572700 10 WS-4DCO-4DIT-RETOUR PIC XXXX. ! +572800 10 WS-4DCO-PRG-TC4DIT0. ! +572900 15 WS-4DCO-PRG-TC4DIT0-SEL OCCURS 15. ! +573000 20 WS-4DCO-4DIT-SELEC PIC X. ! +573100* TOP SELECTION CONTRAT ! +573200 20 WS-4DCO-4DIT-NO-PTN PIC 999. ! +573300* NO PARTENAIRE INTERNE LIGNE CONTRAT ! +573400 20 WS-4DCO-4DIT-NO-PRD-PTN PIC 999. ! +573500* NO PRODUIT INTERNE LIGNE CONTRAT ! +573600 20 WS-4DCO-4DIT-NO-CLI-PTN PIC 9(7). ! +573700* NO CLIENT INTERNE LIGNE CONTRAT ! +573800 20 WS-4DCO-4DIT-NO-ORD-CTR PIC 99. ! +573900* NO ORDRE INTERNE LIGNE CONTRAT ! +574000 20 WS-4DCO-4DIT-IDC-CM PIC X. ! +574100* INDICATEUR CMM LIGNE CONTRAT ! +574200 20 WS-4DCO-4DIT-RAC PIC X(7). ! +574300* RACINE EXTERNE LIGNE CONTRAT ! +574400 20 WS-4DCO-4DIT-CLE-RAC PIC X(1). ! +574500* CLE EXTERNE LIGNE CONTRAT ! +574600 20 WS-4DCO-4DIT-CAT PIC X(2). ! +574700* CATEGORIE EXTERNE LIGNE CONTRAT ! +574800 20 WS-4DCO-4DIT-RANG PIC X(2). ! +574900* NUMERO DE RANG LIGNE CONTRAT ! +575000 20 WS-4DCO-4DIT-NO-POL-PRB PIC X(9). ! +575100* NUMERO DE RANG LIGNE CONTRAT ! +575200 20 WS-4DCO-4DIT-CD-PRD-PO PIC X(2). ! +575300* NUMERO DE PRODUIT EXTERNE CONTRAT ! +575400 20 WS-4DCO-4DIT-DUREE PIC 9(2). ! +575500* DUREE DE LA PROROGATION CONTRAT ! +575600* 20 WS-4DCO-4DIT-IDC-PRD-UNT-CPT PIC X(1). ! +575700* INDICATEUR PRODUIT EN UC ! +575800 10 WS-4DCO-NBR-AVENANT PIC 99. ! +575900* NOMBRE D'AVENANT A EDITER ! +576000 10 WS-4DCO-4DIT-NOSTR-SAI PIC X(6). ! +576100 10 WS-4DCO-4DIT-NOPTN-SAI PIC X(5). ! +576200 10 WS-4DCO-4DIT-CD-PROR PIC X(1) OCCURS 15. ! +576300 10 WS-4DCO-4DIT-DA-ECN PIC X(8) . ! +576400 10 WS-4DCO-4DIT-NO-STR-GTN PIC X(6) . ! +576500 10 WS-4DCO-4DIT-LIB-STR PIC X(32) . ! +576600 10 WS-4DCO-4DIT-IDC-STR PIC X(1) . ! +576700 10 WS-4DCO-4DIT-IDC-PRD-UNT-CPT PIC X(1) OCCURS 15. ! +576800 10 FILLER PIC X(1076). ! +576900* ZONES DISPONIBLES ! +577000***************************************************************** ! +577100* ! +577200*================================================================ ! +577300*= APPLICATION : SAISIE CONTRAT EN ANOMALIE = ! +577400*================================================================ ! +577500 03 WS-4DCO-CTR-ANO REDEFINES WS-4DCO-PROGRAM. ! +577600* ============ ! +577700* ============== ! +577800* ------------------------------------------------------ * ! +577900* COMMAREA : SAISIE CONTRAT EN ANOMALIE * ! +578000* LONGUEUR : 1800 * ! +578100* PREFIXE : WS-4DCO-CTR-ANO * ! +578200* ------------------------------------------------------ * ! +578300 ! +578400 05 WS-4DCO-4DJA-CD-CHX PIC X(02). ! +578500* CHOIX EDITION ! +578600 05 WS-4DCO-4DJA-STOCK. ! +578700* STOCKAGE ! +578800 07 WS-4DCO-4DJA-INTERNE OCCURS 78. ! +578900* ELEMENTS POUR CLE INTERNE ! +579000 09 WS-4DCO-4DJA-CLI PIC 9(07). ! +579100* NO CLIENT ! +579200 09 WS-4DCO-4DJA-RNG PIC 9(02). ! +579300* RANG ! +579400 07 WS-4DCO-4DJA-STOCK-CPT. ! +579500 09 WS-4DCO-4DJA-CPT OCCURS 78. ! +579600* COMPTE ! +579700 11 WS-4DCO-4DJA-RAC PIC X(07). ! +579800* RACINE ! +579900 11 WS-4DCO-4DJA-CLE-RAC PIC X(01). ! +580000* CLE ! +580100 11 WS-4DCO-4DJA-RNG-CPT PIC X(02). ! +580200* RANG ! +580300* ! +580400 07 WS-4DCO-4DJA-STOCK-POL REDEFINES ! +580500 WS-4DCO-4DJA-STOCK-CPT. ! +580600 09 WS-4DCO-4DJA-POL OCCURS 78. ! +580700* POLICE 9 CAR ! +580800 11 WS-4DCO-4DJA-NOPOL PIC X(08). ! +580900* NO POLICE ! +581000 11 WS-4DCO-4DJA-CLEPOL PIC X(01). ! +581100* CLE POLICE ! +581200 09 FILLER PIC X(78). ! +581300* ! +581400 05 FILLER PIC X(0316). ! +581500* FILLER DE WS-4DCO-ANOMALIE ! +581600***************************************************************** ! +581700* ! +581800*================================================================ ! +581900*= APPLICATION : EDITION DE FIN D ANNEE = ! +582000*================================================================ ! +582100 03 WS-4DCO-4E REDEFINES WS-4DCO-PROGRAM. ! +582200* ============ ! +582300* ------------------------------------------------------ * ! +582400* COMMAREA : EDITION DE FIN D ANNEE * ! +582500* LONGUEUR : 1800 * ! +582600* PREFIXE : WS-4DCO-4E * ! +582700* ------------------------------------------------------ * ! +582800 ! +582900 05 WS-4DCO-4E-CD-DOC PIC X(05). ! +583000* CODE DOCUMENT ('CF ','IFU ', OU 'RDC ') ! +583100 05 WS-4DCO-4E-NOM-USU-PSE PIC X(32). ! +583200* NOM USUEL PERSONNE DU CONTRAT ! +583300 05 WS-4DCO-4E-CLE . ! +583400* STOCKAGE CLE FICHIER ANOMALIE ! +583500* STUCTURE = CODE PARTENAIRE, STRUCTURE DISTRIBUTION ! +583600* NUMERO DE COMPTE EDIT RANG ! +583700 10 WS-4DCO-4E-CD-PTN PIC X(05). ! +583800 10 WS-4DCO-4E-NO-STR-DIS PIC X(06). ! +583900 10 WS-4DCO-4E-NUM-CPT PIC X(20). ! +584000 10 WS-4DCO-4E-RANG PIC X(02). ! +584100 10 FILLER PIC X(01). ! +584200* ! +584300 05 WS-4DCO-4E-ENR PIC X(1300). ! +584400* STOCKAGE ENREGISTREMENT ANOMALIE POUR CORRECTION ! +584500 05 WS-4DCO-4E050-LIBELLES REDEFINES WS-4DCO-4E-ENR. ! +584600* LIBELLES A TRANSMETTRE POUR EDITION CERT FISCAUX ! +584700 10 WS-4DCO-4E050-NO-FDS-PG PIC X(4). ! +584800* NUMERO DE FOND DE PAGE ! +584900 10 WS-4DCO-4E050-LIBELLE-PRODUIT PIC X(32). ! +585000* LIBELLE DU PRODUIT ! +585100 10 WS-4DCO-4E050-LIBELLE-NOM-PTN PIC X(50). ! +585200* NOM DU PARTENAIRE ! +585300 10 WS-4DCO-4E050-LIBELLE-SPECIAL PIC X(16). ! +585400* LIBELLE SPECIAL (RENTE SURVIE OU EPARGNE HANDICAP ! +585500 10 WS-4DCO-4E050-LIBELLE-BENEF PIC X(80). ! +585600* LIBELLE BENEF SI RENTE SURVIE ! +585700 10 WS-4DCO-4E050-COMMENT-PRIME-1 PIC X(80). ! +585800* COMMENTAIRE PRIME LIGNE 1 ! +585900 10 WS-4DCO-4E050-COMMENT-PRIME-2 PIC X(80). ! +586000* COMMENTAIRE PRIME LIGNE 2 ! +586100 10 WS-4DCO-4E050-COMMENT-CF-1 PIC X(80). ! +586200* COMMENTAIRE PRIME CERT FISCAUX LIGNE 1 ! +586300 10 WS-4DCO-4E050-COMMENT-CF-2 PIC X(80). ! +586400* COMMENTAIRE PRIME CERT FISCAUX LIGNE 2 ! +586500 10 WS-4DCO-4E050-DAT-EDI PIC X(10). ! +586600* DATE D'EDITION ! +586700 10 FILLER PIC X(788). ! +586800*** ZONE POUR REEDITION DES IMPRIMMES ! +586900 05 WS-4DCO-4E020-LIBELLES REDEFINES WS-4DCO-4E-ENR. ! +587000 10 WS-4DCO-4E020-CD-CHOIX PIC X(1). ! +587100* CHOIX IMPRESSION TOUS LES CONTRATS OU NON ! +587200 10 WS-4DCO-4E020-NB-CPT PIC 99. ! +587300* NOMBRE DE CONTRATS A IMPRIMER ! +587400 10 WS-4DCO-4E020-LISTE-CPT. ! +587500 12 WS-4DCO-4E020-LISTE OCCURS 11. ! +587600* CLES DES CONTRATS A IMPRIMER ! +587700 15 WS-4DCO-4E020-NUM-CPT PIC X(20). ! +587800 15 WS-4DCO-4E020-RANG PIC X(2). ! +587900 10 WS-4DCO-4E020-PAGE-SUIV PIC X. ! +588000 10 FILLER PIC X(1054). ! +588100*** ZONE POUR REEDITION RDC PREVI-OPTIONS ! +588200 05 WS-4DCO-4E090-LIBELLES REDEFINES WS-4DCO-4E-ENR. ! +588300 10 WS-4DCO-4E090-CD-CHOIX PIC X(1). ! +588400* CHOIX IMPRESSION TOUS LES CONTRATS OU NON ! +588500 10 WS-4DCO-4E090-NB-CPT PIC 99. ! +588600* NOMBRE DE CONTRATS A IMPRIMER ! +588700 10 WS-4DCO-4E090-LISTE-CPT. ! +588800 12 WS-4DCO-4E090-LISTE OCCURS 11. ! +588900* CLES DES CONTRATS A IMPRIMER ! +589000 15 WS-4DCO-4E090-CD-PTN PIC X(5). ! +589100 15 WS-4DCO-4E090-CD-PRD PIC X(2). ! +589200 15 WS-4DCO-4E090-DAT-EDI PIC X(8). ! +589300 15 WS-4DCO-4E090-NUM-CPT PIC X(20). ! +589400 15 WS-4DCO-4E090-CD-TY-DOC PIC X(5). ! +589500 10 WS-4DCO-4E090-PAGE-SUIV PIC X. ! +589600 10 FILLER PIC X(856). ! +589700 05 WS-4DCO-4E800-LIBELLES REDEFINES WS-4DCO-4E-ENR. ! +589800 10 WS-4DCO-4E800-CD-CHOIX PIC X(1). ! +589900* CHOIX IMPRESSION TOUS LES CONTRATS OU NON ! +590000 10 WS-4DCO-4E800-NB-CPT PIC 99. ! +590100* NOMBRE DE CONTRATS A IMPRIMER ! +590200 10 WS-4DCO-4E800-PAGE-SUIV PIC X. ! +590300 10 WS-4DCO-4E800-SEL PIC X. ! +590400 10 WS-4DCO-4E800-LISTE-CPT. ! +590500 12 WS-4DCO-4E800-LISTE OCCURS 11. ! +590600* CLES DES CONTRATS A IMPRIMER ! +590700 15 WS-4DCO-4E800-NO-PSE PIC 9(8). ! +590800 15 WS-4DCO-4E800-LIB-NOM-PRN PIC X(32). ! +590900 15 WS-4DCO-4E800-CD-ANO PIC X(2). ! +591000 10 WS-4DCO-4E800-SV-LIGN. ! +591100 12 WS-4DCO-4E800-LIB-ACT PIC X(79). ! +591200 12 WS-4DCO-4E800-TAB OCCURS 10. ! +591300 15 WS-4DCO-4E800-CD-ACTION PIC X(01). ! +591400 12 WS-4DCO-4E800-NB-ACT PIC 9(02). ! +591500 12 WS-4DCO-4E800-CD-AUT PIC X(01). ! +591600 10 FILLER PIC X(741). ! +591700 05 WS-4DCO-4E-SEL. ! +591800 10 WS-4DCO-4E-SELOP PIC X(01) OCCURS 14. ! +591900* STOCKAGE SELECTION ! +592000 05 WS-4DCO-4E-CODE-ADRESSE PIC X. ! +592100 05 WS-4DCO-4E-NOM-BENEF PIC X(32). ! +592200 05 WS-4DCO-4E-PAGE-NUMBER-SAVE PIC 99. ! +592300 05 WS-4DCO-4E-NB-PAGES PIC 99. ! +592400 05 WS-4DCO-4E-PAGE-AREA PIC X(200). ! +592500* COMMAREA SAUVEGARDE LIST ! +592600*** 4E010 : ZONES SAUVEGARDE SAISIE COMPTE OU CLIENT ! +592700*** AU NIVEAU DU MENU ! +592800 05 WS-4DCO-4E010-NUM-CPT PIC X(20). ! +592900 05 WS-4DCO-4E010-NO-PSE PIC X(8). ! +593000*** 4E070 : ZONES SAUVEGARDES - CORRECTION DES RDC ! +593100 05 WS-4DCO-4E070-NB-LIGNE PIC 9(02). ! +593200 05 WS-4DCO-4E070-NAME-TS PIC X(8). ! +593300 05 WS-4DCO-4E070-NB-OCC-RES PIC 9(04). ! +593400*** 4E010 : ZONES SAUVEGARDE CHOIX PUC ! +593500 05 WS-4DCO-4E010-PUC PIC X(1). ! +593600** 4E050 ! +593700 05 WS-4DCO-ANC-SAISIE PIC X(1). ! +593800 05 WS-4DCO-4E-MONTANT-9 PIC 9(15). ! +593900 05 FILLER PIC X(0119). ! +594000* FILLER DE WS-4DCO-4E ! +594100* ! +594200*================================================================ ! +594300*= APPLICATION : EDITION DES DAMIERS CUMULES = ! +594400*================================================================ ! +594500 03 WS-4DCO-DAM REDEFINES WS-4DCO-PROGRAM. ! +594600* ============ ! +594700* ------------------------------------------------------ * ! +594800* COMMAREA : EDITION DES DAMIERS CUMULES * ! +594900* LONGUEUR : 1800 * ! +595000* PREFIXE : WS-4DCO-DAM * ! +595100* ------------------------------------------------------ * ! +595200 ! +595300 05 WS-4DCO-DAM-LI-ECR PIC X(32). ! +595400* LIBELLE ECRAN ! +595500 05 WS-4DCO-DAM-CD-APPL PIC X(02). ! +595600* CODE APPLICATION ! +595700 05 WS-4DCO-DAM-LI-APPL PIC X(32). ! +595800* LIBELLE APPLICATION ! +595900 05 WS-4DCO-DAM-CD-PTN PIC X(05). ! +596000* CODE PARTENAIRE ! +596100 05 WS-4DCO-DAM-NOM-PTN PIC X(32). ! +596200* NOM PARTENAIRE ! +596300 05 WS-4DCO-DAM-CD-PRD PIC X(02). ! +596400* CODE PRODUIT ! +596500 05 WS-4DCO-DAM-LI-PRD PIC X(32). ! +596600* CODE PRODUIT ! +596700 05 WS-4DCO-DAM-NO-GEN PIC X(03). ! +596800* CODE PRODUIT ! +596900 05 WS-4DCO-DAM-CD-RGP PIC X(03). ! +597000* CODE REGROUPEMENT ! +597100 05 WS-4DCO-DAM-LI-RGP PIC X(32). ! +597200* LIBELLE REGROUPEMENT ! +597300 05 WS-4DCO-DAM-NO-TY-PRD PIC 9(02). ! +597400* NUMERO TYPE PRODUIT ! +597500 05 WS-4DCO-DAM-REVAL OCCURS 4. ! +597600* ANNEE ET TAUX DE REVALORISATION ! +597700 10 WS-4DCO-DAM-AN-CLOT PIC X(04). ! +597800 10 WS-4DCO-DAM-TX-REVAL PIC 9(03)V9(03). ! +597900 05 WS-4DCO-DAM-TY-TRT PIC 9. ! +598000* TYPE TRAITEMENT ! +598100 88 DAMIER-APPLICATION VALUE 1. ! +598200 88 DAMIER-PARTICULIER VALUE 2. ! +598300 88 DAMIER-REGROUPE VALUE 3. ! +598400 05 WS-4DCO-DAM-TY-DAM PIC 9. ! +598500* TYPE DAMIER ! +598600 88 DAMIER-PRODUCTION VALUE 1. ! +598700 88 DAMIER-AVANCES VALUE 2. ! +598800 05 FILLER PIC X(1581). ! +598900 ! +599000*================================================================ ! +599100*= APPLICATION : GESTION DES CALENDRIERS PUC = ! +599200*================================================================ ! +599300 03 WS-4DCO-4DNE REDEFINES WS-4DCO-PROGRAM. ! +599400* ============ ! +599500* ------------------------------------------------------ * ! +599600* COMMAREA : GESTION DES CALENDRIERS PREVI-OPTION * ! +599700* LONGUEUR : 1800 * ! +599800* PREFIXE : WS-4DCO-4DNE * ! +599900* ------------------------------------------------------ * ! +600000 ! +600100 05 WS-4DCO-4DNE-COMMA. ! +600200* ZONNE DE COMMAREA POUR LE P4DQB0 ! +600300 07 WS-4DCO-4DNE-ANNEE PIC 9(4). ! +600400* ANNEE SAISIE ! +600500 07 WS-4DCO-4DNE-CHOIX PIC XX. ! +600600* CHOIX CALENDRIER ! +600700 07 WS-4DCO-4DNE-LIBEL PIC X(25). ! +600800* LIBELLE CALENDRIER ! +600900 07 WS-4DCO-4DNE-MESS PIC X(32). ! +601000* MESSAGE ! +601100 07 WS-4DCO-4DNE-MOD PIC X. ! +601200* MODIF ! +601300 07 WS-4DCO-4DNE-SUP PIC X. ! +601400* SUPPRESSION ! +601500 07 WS-4DCO-4DNE-CRE PIC X. ! +601600* CREATION ! +601700 07 WS-4DCO-4DNE-ENT PIC X. ! +601800* ENTETE ! +601900 07 WS-4DCO-4DNE-NUMJJ PIC 99. ! +602000* NUMJJ-RET ! +602100 07 WS-4DCO-4DNE-NBJ PIC 999. ! +602200* NBJ-RET ! +602300 07 FILLER PIC X(27). ! +602400 07 WS-4DCO-4DNE-RETOUR PIC X. ! +602500* RETOUR DU P4DQB0 ! +602600* ! +602700* ! +602800 05 WS-4DCO-4DNE-ZONE-SAISIE. ! +602900 07 WS-4DCO-4DNE-CAL PIC 9(2). ! +603000* NUMERO DU CALENDRIER ! +603100 07 WS-4DCO-4DNE-LIB-CAL PIC X(25). ! +603200* LIBELLE DU CALENDRIER ! +603300 07 WS-4DCO-4DNE-NB-UTI-RUB PIC 9(6). ! +603400* NOMBRE D UTILISATION DE LA RUBRIQUE ! +603500 07 FILLER PIC X(67). ! +603600 ! +603700* SAUVEGARDE DES NUMEROS DE CAL POUR LESQUELLES LA ! +603800* VISU DU DETAIL EST DEMANDEE ! +603900 ! +604000 05 WS-4DCO-4DNE-SAUV-ACT-DETAIL. ! +604100 07 WS-4DCO-4DNE-SAUV-ACT-CAL PIC 9(2) OCCURS 14. ! +604200 07 WS-4DCO-4DNE-SAUV-ACT-LIB PIC X(25) OCCURS 14. ! +604300* ! +604400 05 WS-4DCO-4DNE-SAUV-ACT-NB PIC 9(2). ! +604500* NOMBRE D ACTIONS A TRAITER ! +604600 05 WS-4DCO-4DNE-SAUV-ACT-TRT PIC 9(2). ! +604700* NOMBRE D ACTIONS TRAITEES ! +604800 ! +604900 05 WS-4DCO-4DNE-TYP-ACTION PIC X. ! +605000 88 MODIFICATION VALUE 'M'. ! +605100 88 ANNULATION VALUE 'D'. ! +605200 ! +605300* ZONNE DE PAGINATION ! +605400 05 WS-4DCO-4DNE-NB-PAG-TS PIC 9(02). ! +605500 05 WS-4DCO-4DNE-SAUV-PAGE-AREA PIC X(160). ! +605600 ! +605700* FILLER DE RESERVE ! +605800 05 FILLER PIC X(1055). ! +605900 ! +606000*================================================================ ! +606100*= APPLICATION : CONSOLIDATION SUPPORTS = ! +606200*================================================================ ! +606300 03 WS-4DCO-4DNF REDEFINES WS-4DCO-PROGRAM. ! +606400* ============ ! +606500* ------------------------------------------------------ * ! +606600* COMMAREA : CONSOLIDATION SUPPORTS ! +606700* LONGUEUR : 1800 * ! +606800* PREFIXE : WS-4DCO-4DNF * ! +606900* ------------------------------------------------------ * ! +607000 ! +607100* SAUVEGARDE DES NUMEROS DE SUPPORT DONT LA ! +607200* VISU DU DETAIL EST DEMANDEE ! +607300 ! +607400 05 WS-4DCO-4DNF-ACT-DETAIL. ! +607500 07 WS-4DCO-4DNF-NO-SPP-FNC-DTL ! +607600 PIC 9(6) COMP-3 OCCURS 14. ! +607700 07 WS-4DCO-4DNF-NO-CAL-DTL ! +607800 PIC X(2) OCCURS 14. ! +607900 07 WS-4DCO-4DNF-LIB-SPP-DTL ! +608000 PIC X(32) OCCURS 14. ! +608100 ! +608200* SAUVEGARDE DES NUMEROS DE SUPPORT DONT LA ! +608300* MODIF DU DETAIL EST DEMANDEE ! +608400* ! +608500 05 WS-4DCO-4DNF-ACT-MODIF REDEFINES ! +608600 WS-4DCO-4DNF-ACT-DETAIL. ! +608700 07 WS-4DCO-4DNF-NO-SPP-FNC-MOD ! +608800 PIC 9(6) COMP-3 OCCURS 14. ! +608900 07 WS-4DCO-4DNF-NO-CAL-MOD ! +609000 PIC X(2) OCCURS 14. ! +609100 07 WS-4DCO-4DNF-LIB-SPP-MOD ! +609200 PIC X(32) OCCURS 14. ! +609300 ! +609400* SAUVEGARDE DES NUMEROS DE SUPPORT DONT L'AJOUT ! +609500* DE MVT MANUELS EST DEMANDEE ! +609600* ! +609700 05 WS-4DCO-4DNF-ACT-AJOUT REDEFINES ! +609800 WS-4DCO-4DNF-ACT-DETAIL. ! +609900 07 WS-4DCO-4DNF-NO-SPP-FNC-AJT ! +610000 PIC 9(6) COMP-3 OCCURS 14. ! +610100 07 WS-4DCO-4DNF-NO-CAL-AJT ! +610200 PIC X(2) OCCURS 14. ! +610300 07 WS-4DCO-4DNF-LIB-SPP-AJT ! +610400 PIC X(32) OCCURS 14. ! +610500* ! +610600 05 WS-4DCO-4DNF-DA-CSL-SPP-FNC PIC X(8). ! +610700 05 WS-4DCO-4DNF-NO-SPP-FNC PIC 9(6). ! +610800 05 WS-4DCO-4DNF-NO-CAL PIC X(2). ! +610900 05 WS-4DCO-4DNF-LIB-SPP PIC X(32). ! +611000 ! +611100 05 WS-4DCO-4DNF-ACT-NB PIC 9(2). ! +611200* NOMBRE D ACTIONS A TRAITER ! +611300 05 WS-4DCO-4DNF-ACT-TRT PIC 9(2). ! +611400* NOMBRE D ACTIONS TRAITEES ! +611500 ! +611600 05 WS-4DCO-4DNF-TYP-ACTION PIC X. ! +611700 88 ENAJOUT VALUE 'A'. ! +611800 88 ENMODIF VALUE 'M'. ! +611900 88 ENVISU VALUE 'D'. ! +612000 ! +612100* ZONE DE PAGINATION ! +612200 05 WS-4DCO-4DNF-NB-PAG-TS PIC 9(02). ! +612300 05 WS-4DCO-4DNF-PAGE-AREA PIC X(160). ! +612400 05 wS-4DCO-4DNF-IDC-OCC-SPL pic x(1). ! +612500 ! +612600 05 WS-4DCO-4DNG-ENR. ! +612700 10 WS-4DCO-4DNF-MT-ORD-ACH PIC S9(13)V99 COMP-3. ! +612800 10 WS-4DCO-4DNF-NB-PART-VTE PIC 9(11)V9(4) COMP-3. ! +612900 10 WS-4DCO-4DNF-NB-OPE-ORD-ACH PIC 9(7) COMP-3. ! +613000 10 WS-4DCO-4DNF-NB-OPE-ORD-VTE PIC 9(7) COMP-3. ! +613100 10 WS-4DCO-4DNF-NB-CTR-ORD-ACH PIC 9(7) COMP-3. ! +613200 10 WS-4DCO-4DNF-NB-CTR-ORD-VTE PIC 9(7) COMP-3. ! +613300 05 WS-4DCO-4DNG-ZONE-SAISIE. ! +613400 10 WS-4DCO-4DNF-MT PIC S9(13)V99 COMP-3. ! +613500 10 WS-4DCO-4DNF-NB PIC 9(11)V9(04) COMP-3. ! +613600 05 WS-4DCO-4DNG-INDIC PIC 9. ! +613700* FILLER DE RESERVE ! +613800 05 FILLER PIC X(1003). ! +613900 ! +614000*================================================================ ! +614100*= APPLICATION : ENREGISTREMENT DES VALEURS LIQUIDATIVES = ! +614200*================================================================ ! +614300 03 WS-4DCO-4DNI REDEFINES WS-4DCO-PROGRAM. ! +614400* ============ ! +614500* ------------------------------------------------------ * ! +614600* COMMAREA : ENREGISTREMENT DES VL ! +614700* LONGUEUR : 1800 * ! +614800* PREFIXE : WS-4DCO-4DNI * ! +614900* ------------------------------------------------------ * ! +615000 ! +615100* -- 1ER ECRAN. SAUVEGARDE DES DONNEES A PASSER AU 2EME ECRAN ! +615200 05 WS-4DCO-4DNI-ACT-SAUVE. ! +615300 07 WS-4DCO-4DNI-NO-SPP-FNC ! +615400 PIC 9(6) COMP-3 OCCURS 14. ! +615500 07 WS-4DCO-4DNI-CD-VLR ! +615600 PIC X(12) OCCURS 14. ! +615700 07 WS-4DCO-4DNI-LIB-SPP ! +615800 PIC X(32) OCCURS 14. ! +615900 07 WS-4DCO-4DNI-CD-TY-VLR ! +616000 PIC X(01) OCCURS 14. ! +616100 07 WS-4DCO-4DNI-NO-CAL ! +616200 PIC X(2) OCCURS 14. ! +616300 07 WS-4DCO-4DNI-DEL-ENV-ORD ! +616400 PIC S9(3) COMP-3 OCCURS 14. ! +616500 07 WS-4DCO-4DNI-CD-TY-SPP ! +616600 PIC X(01) OCCURS 14. ! +616700* ! +616800 05 WS-4DCO-4DNI-ACT-NB PIC 9(2). ! +616900* NOMBRE D ACTIONS A TRAITER ! +617000 05 WS-4DCO-4DNI-ACT-TRT PIC 9(2). ! +617100* NOMBRE D ACTIONS TRAITEES ! +617200 ! +617300* ZONE DE PAGINATION ! +617400 05 WS-4DCO-4DNi-IDC-OCC-SPL pic x(1). ! +617500 05 WS-4DCO-4DNI-NB-PAG-TS PIC 9(02). ! +617600 05 WS-4DCO-4DNI-PAGE-AREA PIC X(160). ! +617700* ! +617800 05 WS-4DCO-4DNI-SUITE PIC 9. ! +617900* INDICATEUR MEME PROGRAMME MAIS ENREG SUIVANT ! +618000* ! +618100* CLE DE REPOSITIONNEMENT ! +618200 05 WS-4DCO-4DNI-NO-SUP-FNC PIC X(0006). ! +618300 ! +618400* -- 2ER ECRAN. SAUVEGARDE DES DONNEES A PASSER AU 3EME ECRAN ! +618500 05 WS-4DCO-4DNJ-ACT-SAUVE. ! +618600 07 WS-4DCO-4DNJ-DA-VLR-LIQ ! +618700 PIC X(8) OCCURS 12. ! +618800 07 WS-4DCO-4DNJ-MT-VLR-LIQ-A ! +618900 PIC S9(13)V99 COMP-3 OCCURS 12. ! +619000 07 WS-4DCO-4DNJ-MT-VLR-LIQ-V ! +619100 PIC S9(13)V99 COMP-3 OCCURS 12. ! +619200 07 WS-4DCO-4DNJ-NB-PART-SURA ! +619300 PIC 9(11)V9(4) COMP-3 OCCURS 12. ! +619400 07 WS-4DCO-4DNJ-MT-GLB-ORD-ACH ! +619500 PIC S9(13)V99 COMP-3 OCCURS 12. ! +619600 07 WS-4DCO-4DNJ-NB-PART-VTE ! +619700 PIC 9(11)V9(4) COMP-3 OCCURS 12. ! +619800 07 WS-4DCO-4DNJ-MT-GLB-ORD-VTE ! +619900 PIC S9(13)V99 COMP-3 OCCURS 12. ! +620000* ! +620100 05 WS-4DCO-4DNJ-ACT-NB PIC 9(2). ! +620200* NOMBRE D ACTIONS A TRAITER ! +620300 05 WS-4DCO-4DNJ-ACT-TRT PIC 9(2). ! +620400* NOMBRE D ACTIONS TRAITEES ! +620500 ! +620600* TYPE D'ACTION SUR L'ECRAN MC4DNK0 ! +620700 05 WS-4DCO-4DNK-TYP-ACTION PIC X. ! +620800 88 4DNK-ENAJOUT VALUE 'A'. ! +620900 88 4DNK-ENVISU VALUE 'D'. ! +621000 88 4DNK-ENMODIF VALUE 'M'. ! +621100 88 4DNK-ENCONF VALUE 'C'. ! +621200 88 4DNK-ENTOLER VALUE 'T'. ! +621300 88 4DNK-ENSUPPR VALUE 'S'. ! +621400 ! +621500* SAUVEGARDE DES ZONES SAISIES ! +621600 05 WS-4DCO-4DNK-VLAC PIC S9(13)V99 COMP-3. ! +621700 05 WS-4DCO-4DNK-VLVC PIC S9(13)V99 COMP-3. ! +621800* ! +621900 05 WS-4DCO-4DNK-ACTION PIC X. ! +622000* ZONE DE PAGINATION ! +622100 05 WS-4DCO-4DNM. ! +622200 07 WS-4DCO-4DNM-IDC-OCC-SPL PIC X(001). ! +622300 07 WS-4DCO-4DNM-NB-PAG-TS PIC 9(02). ! +622400 07 WS-4DCO-4DNM-PAGE-AREA PIC X(160). ! +622500* CLE DE REPOSITIONNEMENT ! +622600 07 WS-4DCO-4DNM-DA-VLR-LIQ PIC X(0008). ! +622700* FILLER DE RESERVE ! +622800 05 FILLER PIC X(0004). ! +622900 ! +623000 ! +623100*================================================================ ! +623200*= APPLICATION : GESTION TAUX PAR TRANCHES = ! +623300*================================================================ ! +623400 03 WS-4DCO-4DDA REDEFINES WS-4DCO-PROGRAM. ! +623500* ============ ! +623600* ------------------------------------------------------ * ! +623700* COMMAREA : TAUX PAR TRANCHES ! +623800* LONGUEUR : 1800 * ! +623900* PREFIXE : WS-4DCO-4DDA * ! +624000* ------------------------------------------------------ * ! +624100 ! +624200 05 WS-4DCO-4DDA-TOPMODIF PIC 9. ! +624300* INDIC MAJ COMMAREA PARTENAIRE ! +624400* -- 1ER ECRAN. SAUVEGARDE DES DONNEES A PASSER AU 2EME ECRAN ! +624500 05 WS-4DCO-4DDA-TY-TAUX PIC 9. ! +624600* TYPE DE TAUX CHOISI ! +624700* -- 2EM ECRAN. MAJ DES TAUX PAR TRANCHES ! +624800 05 WS-4DCO-4DDA-NB-OCC PIC 99. ! +624900* NOMBRE DE TAUX PAR TRANCHE TROUVE ! +625000 05 WS-4DCO-4DDA-INITECR PIC X. ! +625100* INITIALISATION DE L'ECRAN ! +625200 05 WS-4DCO-4DDA-ACTION PIC X. ! +625300 88 4DDA-CREAT VALUE ' '. ! +625400 88 4DDA-MODIF VALUE 'M'. ! +625500 88 4DDA-SUPPR VALUE 'A'. ! +625600* ACTION SAISIE (MAJ,SUP,CREATION) ! +625700 05 WS-4DCO-4DDA-TESTMAJ PIC X. ! +625800* TOP INDIC ECRAN MODE MAJ ! +625900 05 WS-4DCO-4DDA-ITEM PIC 99. ! +626000* NO DE L'ITEM SELECTIONNEE ! +626100 05 WS-4DCO-4DDA-TRANCHE. ! +626200* INFOS DE LA TRANCHE EN COURS DE (CREAT, MAJ, SUP) ! +626300 10 WS-4DCO-4DDA-TMSTP PIC X(26). ! +626400* TIMESTAMP DE LA TRANCHE (MAJ ET SUP) ! +626500 10 WS-4DCO-4DDA-TX-POSS PIC 9(3)V9(4) COMP-3. ! +626600* TAUX DE LA TRACHE ! +626700 10 WS-4DCO-4DDA-MT-MIN PIC 9(13)V99 COMP-3. ! +626800* MONTANT MINIMUM ! +626900 10 WS-4DCO-4DDA-MT-MAX PIC 9(13)V99 COMP-3. ! +627000* MONTANT MAXIMUM ! +627100 ! +627200 05 FILLER PIC X(1745). ! +627300 ! +627400*================================================================ ! +627500*= APPLICATION : AUTRES DEROGATIONS TAUX PAR TRANCHE = ! +627600*================================================================ ! +627700 03 WS-4DCO-4DDD REDEFINES WS-4DCO-PROGRAM. ! +627800* ============ ! +627900* ------------------------------------------------------ * ! +628000* COMMAREA : AUTRES DEROGATIONS * ! +628100* LONGUEUR : 1800 * ! +628200* PREFIXE : WS-4DCO-4DDD * ! +628300* ------------------------------------------------------ * ! +628400 ! +628500 05 WS-4DCO-4DDD-TOPMODIF PIC 9. ! +628600* INDIC MAJ COMMAREA PARTENAIRE ! +628700 05 WS-4DCO-4DDD-NB-OCC PIC 99. ! +628800* NBRE OCCURENCES SELECTIONNEES ! +628900 ! +629000* -- 1ER ECRAN. SAUVEGARDE DES DONNEES TAUX HORS TRANCHE ! +629100 05 WS-4DCO-4DDD-ACT-SAUVE. ! +629200 07 WS-4DCO-4DDD-TM-STP PIC X(26). ! +629300 07 WS-4DCO-4DDD-NO-PTN PIC 9(3) COMP-3. ! +629400 07 WS-4DCO-4DDD-NO-CTR-PTN PIC X(15). ! +629500 07 WS-4DCO-4DDD-DA-OPE PIC X(10). ! +629600 07 WS-4DCO-4DDD-NO-OPE-TX PIC 9(3) COMP-3. ! +629700 07 WS-4DCO-4DDD-NO-PRD-PTN PIC 9(3) COMP-3. ! +629800 07 WS-4DCO-4DDD-NO-STR-DIS PIC X(6). ! +629900 07 WS-4DCO-4DDD-MT-BRT-OPE PIC S9(13)V9(2) COMP-3. ! +630000 07 WS-4DCO-4DDD-TY-TX PIC X. ! +630100 07 WS-4DCO-4DDD-TX-TCH-DRG PIC S9(3)V9(4) COMP-3. ! +630200 07 WS-4DCO-4DDD-CD-MAJ PIC X. ! +630300 07 WS-4DCO-4DDD-DA-MAJ PIC X(8). ! +630400 07 WS-4DCO-4DDD-TXT-CMT. ! +630500 09 WS-4DCO-4DDD-LIB-ETA-1 PIC X(70). ! +630600 09 WS-4DCO-4DDD-LIB-ETA-2 PIC X(70). ! +630700 09 WS-4DCO-4DDD-LIB-ETA-3 PIC X(70). ! +630800 09 WS-4DCO-4DDD-LIB-ETA-4 PIC X(70). ! +630900 09 WS-4DCO-4DDD-LIB-ETA-5 PIC X(70). ! +631000* ! +631100* TYPE D'ACTION SUR L'ECRAN MC4DDD0 ! +631200 05 WS-4DCO-4DDD-TYP-ACTION PIC X. ! +631300 88 4DDD-CREAT VALUE 'W'. ! +631400 88 4DDD-MODIF VALUE 'M'. ! +631500 88 4DDD-SUPP VALUE 'A'. ! +631600 88 4DDD-VISU VALUE 'C'. ! +631700* ! +631800 05 WS-4DCO-4DDD-ACTION PIC X. ! +631900 88 4DDD-CONSULTATION VALUE 'C'. ! +632000 88 4DDD-MODIFICATION VALUE 'M'. ! +632100* ! +632200 05 WS-4DCO-4DDD-PARA. ! +632300* REPRISE DES INFOS DE WS-4DCO-4DAB UTILISEES PAR ! +632400* LES TRANSACTIONS TC4DCE0 ET TC4DCF0 ! +632500 07 WS-4DCO-4DDD-TIMESTAMP1 PIC X(26). ! +632600 07 WS-4DCO-4DDD-MT-MIN-VER-INI PIC S9(07)V99 COMP-3. ! +632700 07 WS-4DCO-4DDD-MT-MIN-VER-EXC PIC S9(07)V99 COMP-3. ! +632800 07 WS-4DCO-4DDD-MT-MX-DRT-ENT PIC S9(07)V99 COMP-3. ! +632900 07 WS-4DCO-4DDD-MT-MIN-RCH-PART ! +633000 PIC S9(07)V99 COMP-3. ! +633100 07 WS-4DCO-4DDD-MT-MIN-EPG-RST PIC S9(07)V99 COMP-3. ! +633200 07 WS-4DCO-4DDD-MT-MIN-AV PIC S9(13)V99 COMP-3. ! +633300 07 WS-4DCO-4DDD-MT-EPG-RST-AV PIC S9(13)V99 COMP-3. ! +633400 07 WS-4DCO-4DDD-TX-MX-EPG-DSP PIC S9(03)V999 COMP-3. ! +633500 07 WS-4DCO-4DDD-NB-MX-AV-A PIC S9(02) COMP-3. ! +633600 07 WS-4DCO-4DDD-IDC-PRD-MTL PIC X(01). ! +633700 07 WS-4DCO-4DDD-AGE-MIN PIC S9(02) COMP-3. ! +633800 07 WS-4DCO-4DDD-MT-MIN-VER PIC S9(07)V99 COMP-3. ! +633900 ! +634000 05 WS-4DCO-4DDD-EXT-POL PIC X(09). ! +634100 05 WS-4DCO-4DDD-NO-STR-CLE PIC X(06). ! +634200 05 WS-4DCO-4DDD-POSIT PIC X. ! +634300 05 WS-4DCO-4DDD-PAGE-SUIV PIC X. ! +634400* FILLER DE RESERVE X(1262) ! +634500*= SOUS-APPLICATION : SAISIE DES ASSOCIATIONS : 400 DE LONG = ! +634600 05 WS-4DCO-4DDG-ECRAN. ! +634700 07 WS-4DCO-4DDG-TM-STP PIC X(26). ! +634800 07 WS-4DCO-4DDG-CD-ASS-AS PIC X(03). ! +634900 07 WS-4DCO-4DDG-NOM-PATRO-PR PIC X(32). ! +635000 07 WS-4DCO-4DDG-NOM-PATRO-AS PIC X(32). ! +635100 07 WS-4DCO-4DDG-LIB-ENS-1 PIC X(32). ! +635200 07 WS-4DCO-4DDG-LIB-ENS-2 PIC X(32). ! +635300 07 WS-4DCO-4DDG-LIB-RUE-1 PIC X(32). ! +635400 07 WS-4DCO-4DDG-LIB-RUE-2 PIC X(32). ! +635500 07 WS-4DCO-4DDG-LIB-COMMUNE PIC X(32). ! +635600 07 WS-4DCO-4DDG-CD-POST PIC X(05). ! +635700 07 WS-4DCO-4DDG-LIB-BUR-DIST PIC X(27). ! +635800 07 WS-4DCO-4DDG-NO-TEL PIC X(11). ! +635900* MAX(CD-ASS-AS) POUR INCREMENTATION LORS DE CREATION ! +636000 07 WS-4DCO-4DDG-CD-ASS-MAX PIC 9(03). ! +636100 07 FILLER PIC X(101). ! +636200 05 WS-4DCO-4DDD-AGE-LIM PIC 9(02). ! +636300 05 WS-4DCO-4DDD-MT-MIN-ARBT PIC S9(13)V9(2) COMP-3. ! +636400* FILLER DE RESERVE X(1252) - X(400) ! +636500 05 FILLER PIC X(852). ! +636600*================================================================ ! +636700*= APPLICATION : PREPARATION EDITIONS = ! +636800*================================================================ ! +636900 03 WS-4DCO-SA REDEFINES WS-4DCO-PROGRAM. ! +637000* ============ ! +637100 05 WS-4DCO-SA-ECRAN. ! +637200 10 WS-4DCO-SA-TY-LET PIC X(03). ! +637300 10 WS-4DCO-SA-LIB-DEST PIC X(10). ! +637400 10 WS-4DCO-SA-LIB-PTN PIC X(32). ! +637500 10 WS-4DCO-SA-LIB-CD-INT-D PIC X(32). ! +637600 10 WS-4DCO-SA-NOM-PATRO-D PIC X(32). ! +637700 10 WS-4DCO-SA-NO-ORD-ADR-D PIC 9(02). ! +637800 10 WS-4DCO-SA-LIB-RUE-D1 PIC X(32). ! +637900 10 WS-4DCO-SA-LIB-RUE-D2 PIC X(32). ! +638000 10 WS-4DCO-SA-LIB-COMMUNE-D PIC X(32). ! +638100 10 WS-4DCO-SA-CD-POST-D PIC X(05). ! +638200 10 WS-4DCO-SA-LIB-BUR-DIST-D PIC X(26). ! +638300 10 WS-4DCO-SA-IDC-COP-AVIS-CL PIC X(01). ! +638400 10 WS-4DCO-SA-IDC-COP-AVIS-PT PIC X(01). ! +638500 10 WS-4DCO-SA-IDC-ARC PIC X(01). ! +638600 05 WS-4DCO-SA-CONTROL-TY-LET PIC X(01). ! +638700 88 TYPE-LETTRE-RECHERCHE VALUE 'R'. ! +638800 88 TYPE-LETTRE-TROUVE VALUE 'O'. ! +638900 88 TYPE-LETTRE-NON-TROUVE VALUE 'N'. ! +639000 05 WS-4DCO-SA-TABLE-ADRESSE PIC X(645). ! +639100 05 FILLER REDEFINES ! +639200 WS-4DCO-SA-TABLE-ADRESSE OCCURS 5. ! +639300 10 WS-4DCO-SA-NO-ORD-ADR-POST PIC 9(02). ! +639400 10 WS-4DCO-SA-LIB-RUE-1 PIC X(32). ! +639500 10 WS-4DCO-SA-LIB-RUE-2 PIC X(32). ! +639600 10 WS-4DCO-SA-LIB-COMMUNE PIC X(32). ! +639700 10 WS-4DCO-SA-CD-POST PIC X(05). ! +639800 10 WS-4DCO-SA-LIB-BUR-DIST PIC X(26). ! +639900 05 FILLER REDEFINES ! +640000 WS-4DCO-SA-TABLE-ADRESSE. ! +640100 10 FILLER PIC X(129) OCCURS 4. ! +640200 10 FILLER PIC X(97). ! +640300 10 WS-4DCO-SA-NOM-RETRAITE PIC X(32). ! +640400 05 WS-4DCO-SA-CONTROL-ECRAN PIC X(01). ! +640500 88 OUI-ECRAN-AFFICHE VALUE 'O'. ! +640600 88 NON-ECRAN-AFFICHE VALUE 'N'. ! +640700 05 WS-4DCO-SA-TY-LET-ORIGINE PIC X(03). ! +640800 05 WS-4DCO-SA-TY-LET-EQ-1 PIC X(03). ! +640900 05 WS-4DCO-SA-TY-LET-EQ-2 PIC X(03). ! +641000 05 WS-4DCO-SA-TY-LET-EQ-3 PIC X(03). ! +641100 05 WS-4DCO-SA-TY-LET-EQ-4 PIC X(03). ! +641200 05 WS-4DCO-SA-IDC-PAI-CHQ PIC X(01). ! +641300 05 WS-4DCO-SA-CD-EXP PIC X(01). ! +641400 05 WS-4DCO-SA-CD-TT PIC X(01). ! +641500 05 WS-4DCO-SA-CD-EVE-TY PIC X(06). ! +641600 05 WS-4DCO-SA-LIB-OPE PIC X(32). ! +641700 05 WS-4DCO-SA-IDC-COP-AVIS-S1 PIC X(01). ! +641800 05 WS-4DCO-SA-IDC-COP-AVIS-S2 PIC X(01). ! +641900 05 WS-4DCO-SA-IDC-COP-AVIS-S3 PIC X(01). ! +642000 05 WS-4DCO-SA-LIB-CD-INT PIC X(32). ! +642100 05 WS-4DCO-SA-NOM-PATRO PIC X(32). ! +642200 05 WS-4DCO-SA-TRAN PIC X(04). ! +642300* ZONES POUR LE PROGRAMME TC4DPI0 ! +642400* ! +642500* ZONE DE PAGINATION ! +642600 05 WS-4DCO-SA-4DPI. ! +642700 15 WS-4DCO-4DPI-PAGE. ! +642800 20 WS-4DCO-4DPI-IDC-OCC-SPL PIC X(001). ! +642900 20 WS-4DCO-4DPI-NB-PAG-TS PIC 9(002). ! +643000 20 WS-4DCO-4DPI-SAUV-PAGE-AREA PIC X(198). ! +643100* ACTION SAUVEGARDEE ! +643200 15 WS-4DCO-4DPI-SAUV-ACT PIC X. ! +643300* NOMBRE D'OCCURENCES DE LA LISTE ! +643400 15 WS-4DCO-4DPI-NB-TS-ITEM PIC S9(04) COMP. ! +643500* NUMERO D'ITEM SELECTIONNE ! +643600 15 WS-4DCO-4DPI-NO-ITEM-SEL PIC S9(04) COMP. ! +643700* CLE DE REPOSITIONNEMENT ! +643800 15 WS-4DCO-4DPI-CLE. ! +643900 20 WS-4DCO-4DPI-NO-ETAT-PRIM PIC 9(06). ! +644000 20 WS-4DCO-4DPI-CD-PTN PIC 9(05). ! +644100 20 WS-4DCO-4DPI-CD-MTF-DEM PIC X(02). ! +644200 20 WS-4DCO-4DPI-NO-SEQ-MVT-POS PIC 9(05). ! +644300* CLE DE SAUVEGARDE. ! +644400 15 WS-4DCO-4DPI-SAV-CLE. ! +644500 20 WS-4DCO-4DPI-SAV-PRIM PIC 9(06). ! +644600 20 WS-4DCO-4DPI-SAV-PTN PIC 9(05). ! +644700 20 WS-4DCO-4DPI-SAV-MTF PIC X(02). ! +644800 20 WS-4DCO-4DPI-SAV-NO-POS PIC 9(05). ! +644900* INITIALISATION ECRAN SUIVANT. ! +645000 15 WS-4DCO-4DPI-NOM-PTN PIC X(32). ! +645100 15 WS-4DCO-4DPI-DATE-OPE. ! +645200 20 WS-4DCO-4DPI-AAOPE PIC X(04). ! +645300 20 WS-4DCO-4DPI-MMOPE PIC X(02). ! +645400 20 WS-4DCO-4DPI-JJOPE PIC X(02). ! +645500 15 WS-4DCO-4DPI-MDREGL PIC X(01). ! +645600 15 WS-4DCO-4DPI-NO-RIB-DOM. ! +645700 20 WS-4DCO-4DPI-CD-BQE PIC X(05). ! +645800 20 WS-4DCO-4DPI-CD-GUI PIC X(05). ! +645900 20 WS-4DCO-4DPI-NO-CPT PIC X(11). ! +646000 20 WS-4DCO-4DPI-CLE-RIB PIC X(02). ! +646100 15 WS-4DCO-4DPI-SLD-A-PAYER PIC S9(15)V99 COMP-3. ! +646200*===> variables -4dpj- ! +646300 05 WS-4DCO-SA-4DPJ. ! +646400 15 WS-4DCO-4DPJ-MT-ASST-CRDS PIC S9(13)V99 COMP-3. ! +646500* assiette crds ! +646600 15 WS-4DCO-4DPJ-MT-ASST-CSG PIC S9(13)V99 COMP-3. ! +646700* assiette csg ! +646800 15 WS-4DCO-4DPJ-MT-VER-RDS PIC S9(13)V99 COMP-3. ! +646900* montant crds ! +647000 15 WS-4DCO-4DPJ-MT-CSG PIC S9(13)V99 COMP-3. ! +647100* montant csg ! +647200 15 WS-4DCO-4DPJ-TOT-CRDS-CSG PIC S9(13)V99 COMP-3. ! +647300* cumul montant (crds & csg) ! +647400 15 WS-4DCO-4DPJ-MT-NET PIC S9(13)V99 COMP-3. ! +647500* montant net vers� au client ! +647600 15 WS-4DCO-4DPJ-IDC-DEBL-ATP PIC X. ! +647700* indicateur de d�blocage anticip� ! +647800 15 WS-4DCO-4DPJ-IDC-CRDS PIC X. ! +647900* indicateur de pr�l�vement CRDS & CSG ! +648000 15 WS-4DCO-4DPJ-MDREGL-DA PIC X. ! +648100* mode r�glement compte de passage(dbloc. ant.) ! +648200 15 WS-4DCO-4DPJ-MT-ASST-SOC PIC S9(13)V99 COMP-3. ! +648300* assiette soc ! +648400 15 WS-4DCO-4DPJ-MT-PLV-SOC PIC S9(13)V99 COMP-3. ! +648500* montant prelevement ! +648600* FILLER DE RESERVE ! +648700 05 FILLER PIC X(0401). ! +648800*================================================================ ! +648900*= APPLICATION : SORTIES DE FONDS = ! +649000*================================================================ ! +649100 03 WS-4DCO-ESDF REDEFINES WS-4DCO-PROGRAM. ! +649200* ============ ! +649300* ------------------------------------------------------ * ! +649400* COMMAREA : EDITION SORTIE DE FONDS * ! +649500* LONGUEUR : 1800 * ! +649600* PREFIXE : WS-4DCO-ESDF * ! +649700* ------------------------------------------------------ * ! +649800 05 WS-4DCO-ESDF-NO-ADH PIC X(20). ! +649900* NUMERO D'ADHESION ! +650000 05 WS-4DCO-ESDF-NOM-PATRO PIC X(32). ! +650100* NOM PATRONIMIQUE ! +650200 05 WS-4DCO-ESDF-TY-LET PIC X(03). ! +650300* TYPE DE LETTRE ! +650400 05 WS-4DCO-ESDF-TY-OPE PIC X(06). ! +650500* TYPE D'OPERATION ! +650600 05 WS-4DCO-ESDF-MT-OPE PIC S9(09)V99. ! +650700* TYPE D'OPERATION ! +650800 05 WS-4DCO-ESDF-DA-OPE. ! +650900* DATE DE L'OPERATION ! +651000 07 WS-4DCO-ESDF-DA-OPE-A PIC X(04). ! +651100 07 WS-4DCO-ESDF-DA-OPE-M PIC X(02). ! +651200 07 WS-4DCO-ESDF-DA-OPE-J PIC X(02). ! +651300 05 WS-4DCO-ESDF-NO-CHQ PIC X(07). ! +651400* NUMERO DE CHEQUE ! +651500 05 WS-4DCO-ESDF-AFFICHE PIC X(01). ! +651600* TOP AFFICHAGE ECRAN ! +651700 05 WS-4DCO-F463 PIC X(01). ! +651800* TOP BLOCAGE ECRAN ! +651900 05 WS-4DCO-ESDF-TRAN PIC X(04). ! +652000* TOP BLOCAGE ECRAN ! +652100 05 FILLER PIC X(1707). ! +652200* ! +652300* ! +652400*================================================================ ! +652500*= APPLICATION : TRAITEMENT DES CHEQUES = ! +652600*================================================================ ! +652700 03 WS-4DCO-CHEQ REDEFINES WS-4DCO-PROGRAM. ! +652800* ============ ! +652900* ------------------------------------------------------ * ! +653000* COMMAREA : TRAITEMENT DES CHEQUES * ! +653100* LONGUEUR : 1800 * ! +653200* PREFIXE : WS-4DCO-CHEQ : TOUS PROG GES CHEQUES * ! +653300* WS-4DCO-LOTS : TOUS PROG GES LOTS * ! +653400* WS-4DCO-4DF? : SPECIFIQUES PROGRAM * ! +653500* ------------------------------------------------------ * ! +653600* ==> SAISIE MENUS ! +653700 05 WS-4DCO-CHEQ-NO-LOT PIC 9(3) COMP-3. ! +653800* NUMERO DU LOT ! +653900 05 WS-4DCO-CHEQ-DA-LOT PIC X(10). ! +654000* DATE DU LOT ! +654100* ! +654200* ==> INFORMATIONS D'UN CHEQUE ! +654300 05 WS-4DCO-INFOS-CHEQUE. ! +654400* IMAGE DE V4D01380 ! +654500 10 WS-4DCO-CHEQ-TM-STP PIC X(26). ! +654600* TIME STAMP ! +654700 10 WS-4DCO-CHEQ-DA-CRE-LOT PIC X(10). ! +654800* DATE DE CREATION DU LOT ! +654900 10 WS-4DCO-CHEQ-NO-LOT-CHQ PIC 9(3) COMP-3. ! +655000* NUMERO LOT CHEQUE ! +655100 10 WS-4DCO-CHEQ-NO-ORD-LOT-CHQ PIC 9(3) COMP-3. ! +655200* NUMERO ORDRE LOT CHEQUE ! +655300 10 WS-4DCO-CHEQ-NO-PTN PIC 9(3) COMP-3. ! +655400* NUMERO PARTENAIRE ! +655500 10 WS-4DCO-CHEQ-NO-CTR-PTN PIC X(15). ! +655600* NUMERO CONTRAT PARTENAIRE ! +655700 10 WS-4DCO-CHEQ-CD-VTL PIC X(1). ! +655800* CODE VENTILATION ! +655900 10 WS-4DCO-CHEQ-REM-CHQ PIC S9(13)V9(2) COMP-3. ! +656000* MONTANT REMISE CHEQUE ! +656100 10 WS-4DCO-CHEQ-LIB-ABR-DOM PIC X(6). ! +656200* LIBELLE ABREGE DOMICILIATION ! +656300 10 WS-4DCO-CHEQ-NOM-PATRO PIC X(16). ! +656400* NOM PATRONYMIQUE ! +656500 10 WS-4DCO-CHEQ-DA-OPE-VER PIC X(10). ! +656600* DATE OPERATION VERSEMENT ! +656700 10 WS-4DCO-CHEQ-NO-STR-OPE PIC X(6). ! +656800* NUMERO STRUCTURE OPERATIONNELLE ! +656900 10 WS-4DCO-CHEQ-NO-AGT-OPE PIC X(8). ! +657000* NUMERO AGENT OPERATION ! +657100 10 WS-4DCO-CHEQ-LIB-CPL PIC X(32). ! +657200* LIBELLE COMPLEMENT ! +657300 10 WS-4DCO-CHEQ-CD-MAJ PIC X(1). ! +657400* CODE MAJ ! +657500 10 WS-4DCO-CHEQ-CD-PTN PIC X(5). ! +657600* CODE PERTENAIRE EXTERNE ! +657700 10 WS-4DCO-CHEQ-IDC-PTN-CM PIC X. ! +657800* INDICATEUR PARTENAIRE CREDIT-MUTUEL ! +657900 88 CHEQ-CCM VALUE 'O'. ! +658000 88 CHEQ-EXT VALUE 'N'. ! +658100* ! +658200* ==> INFORMATIONS D'UN LOT ! +658300 05 WS-4DCO-INFOS-LOT. ! +658400* IMAGE DE V4D01390 ! +658500 15 WS-4DCO-LOTS-TM-STP PIC X(26). ! +658600* TIME STAMP ! +658700 15 WS-4DCO-LOTS-DA-CRE-LOT PIC X(10). ! +658800* DATE DE CREATION DU LOT ! +658900 15 WS-4DCO-LOTS-NO-LOT-CHQ PIC 9(3) COMP-3. ! +659000* NUMERO LOT CHEQUE ! +659100 15 WS-4DCO-LOTS-COMPTE. ! +659200* NUMERO DE COMPTE ! +659300 20 WS-4DCO-LOTS-CD-BANQUE PIC X(5). ! +659400* CODE BANQUE ! +659500 20 WS-4DCO-LOTS-CD-GUICHET PIC X(5). ! +659600* CODE GUICHET ! +659700 20 WS-4DCO-LOTS-NO-CPT-RIB PIC X(11). ! +659800* NUMERO COMPTE RIB ! +659900 20 WS-4DCO-LOTS-CLE-RIB PIC X(2). ! +660000* CLE RIB ! +660100 15 WS-4DCO-LOTS-NO-PTN-OP PIC 9(3) COMP-3. ! +660200* NUMERO PARTENAIRE ! +660300 15 WS-4DCO-LOTS-NO-STR-OPE PIC X(6). ! +660400* NUMERO STRUCTURE OPERATIONNELLE ! +660500 15 WS-4DCO-LOTS-NO-AGT-OPE PIC X(8). ! +660600* NUMERO AGENT OPERATION ! +660700 15 WS-4DCO-LOTS-MT-REM-LO PIC S9(13)V9(2) COMP-3. ! +660800* MONTANT REMISE ! +660900 15 WS-4DCO-LOTS-CD-MAJ PIC X(1). ! +661000* CODE MAJ ! +661100 15 WS-4DCO-LOTS-CD-ENV PIC X(1). ! +661200* CODE ENVOI ! +661300 15 WS-4DCO-LOTS-DA-ENV-LOT PIC X(10). ! +661400* DATE ENVOI LOT ! +661500 15 WS-4DCO-LOTS-MT-REM-CHQ PIC S9(13)V9(2) COMP-3. ! +661600* MONTANT REMISES CHEQUES TOTALISES ! +661700 15 WS-4DCO-LOTS-NB-REM-CHQ PIC 9(7) COMP-3. ! +661800* NOMBRE REMISES CHEQUES TOTALISES ! +661900 15 WS-4DCO-LOTS-CD-PTN PIC X(5). ! +662000* CODE PARTENAIRE EXTERNE ! +662100 ! +662200* ==> ZONES DE TRAVAIL POUR SAISIE CRITERES DE SELECTION ! +662300* POUR LISTE DE LOTS ! +662400 ! +662500 05 WS-4DCO-SELECTION-LOT. ! +662600* SELECTION : DATE DEBUT ! +662700 07 WS-4DCO-4DFF-DA-DEB. ! +662800 10 WS-4DCO-4DFF-DA-DEB-SA PIC X(04). ! +662900 10 WS-4DCO-4DFF-DA-DEB-MM PIC X(02). ! +663000 10 WS-4DCO-4DFF-DA-DEB-JJ PIC X(02). ! +663100* SELECTION : DATE FIN ! +663200 07 WS-4DCO-4DFF-DA-FIN. ! +663300 10 WS-4DCO-4DFF-DA-FIN-SA PIC X(04). ! +663400 10 WS-4DCO-4DFF-DA-FIN-MM PIC X(02). ! +663500 10 WS-4DCO-4DFF-DA-FIN-JJ PIC X(02). ! +663600* SELECTION : NUMERO LOT DEBUT ! +663700 07 WS-4DCO-4DFF-NO-LOT-DEB PIC 9(03) COMP-3. ! +663800* SELECTION : NUMERO LOT FIN ! +663900 07 WS-4DCO-4DFF-NO-LOT-FIN PIC 9(03) COMP-3. ! +664000* SELECTION : COMPTE BANCAIRE DESTINATAIRE ! +664100 07 WS-4DCO-4DFF-CD-BANQUE PIC X(05). ! +664200 07 WS-4DCO-4DFF-CD-GUICHET PIC X(05). ! +664300 07 WS-4DCO-4DFF-NO-CPT-RIB PIC X(11). ! +664400 07 WS-4DCO-4DFF-CLE-RIB PIC X(02). ! +664500 ! +664600* ==> ZONES DE TRAVAIL POUR DETAIL SUCCESSIF DE LOTS ! +664700 ! +664800 05 WS-4DCO-SUCCESSION-LOT. ! +664900* ZONE DE PAGINATION ! +665000 07 WS-4DCO-4DFG-NB-PAG-TS PIC 9(02). ! +665100 07 WS-4DCO-4DFG-PAGE-AREA PIC X(198). ! +665200* ! +665300 07 WS-4DCO-4DFG-SAUV-ACTION. ! +665400 10 WS-4DCO-4DFG-SAUV-ITEM PIC 9(3) OCCURS 12. ! +665500* ! +665600 07 WS-4DCO-4DFG-SAUV-ACT-NB PIC 9(2). ! +665700* NOMBRE D ACTIONS A TRAITER ! +665800 07 WS-4DCO-4DFG-SAUV-ACT-TRT PIC 9(2). ! +665900* NOMBRE D ACTIONS TRAITEES ! +666000 ! +666100 07 WS-4DCO-4DFG-TYP-ACTION PIC X. ! +666200 88 CONSULTATION-LOT VALUE '1'. ! +666300 88 MODIFICATION-LOT VALUE '2'. ! +666400 88 SUPPRESSION-LOT VALUE '3'. ! +666500 88 ENVOI-LOT VALUE '4'. ! +666600 88 ANNULATION-ENVOI-LOT VALUE '5'. ! +666700 ! +666800 07 WS-4DCO-4DFC-IDC-OCC-SPL PIC X. ! +666900 07 WS-4DCO-4DFC-SANS-CREAT PIC X. ! +667000 07 WS-4DCO-4DFG-SANS-ENV PIC X. ! +667100 ! +667200* ==> ZONES DE TRAVAIL POUR SAISIE CRITERES DE SELECTION ! +667300* POUR LISTE DE CHEQUES ! +667400 ! +667500 05 WS-4DCO-SELECTION-CHEQUE. ! +667600* SELECTION : DATE DEBUT ! +667700 07 WS-4DCO-4DFI-DA-DEB. ! +667800 10 WS-4DCO-4DFI-DA-DEB-SA PIC X(04). ! +667900 10 WS-4DCO-4DFI-DA-DEB-MM PIC X(02). ! +668000 10 WS-4DCO-4DFI-DA-DEB-JJ PIC X(02). ! +668100* SELECTION : DATE FIN ! +668200 07 WS-4DCO-4DFI-DA-FIN. ! +668300 10 WS-4DCO-4DFI-DA-FIN-SA PIC X(04). ! +668400 10 WS-4DCO-4DFI-DA-FIN-MM PIC X(02). ! +668500 10 WS-4DCO-4DFI-DA-FIN-JJ PIC X(02). ! +668600* SELECTION : NUMERO LOT DEBUT ! +668700 07 WS-4DCO-4DFI-NO-LOT-DEB PIC 9(03) COMP-3. ! +668800* SELECTION : NUMERO LOT FIN ! +668900 07 WS-4DCO-4DFI-NO-LOT-FIN PIC 9(03) COMP-3. ! +669000* SELECTION : COMPTE BANCAIRE DESTINATAIRE ! +669100 07 WS-4DCO-4DFI-CD-BANQUE PIC X(05). ! +669200 07 WS-4DCO-4DFI-CD-GUICHET PIC X(05). ! +669300 07 WS-4DCO-4DFI-NO-CPT-RIB PIC X(11). ! +669400 07 WS-4DCO-4DFI-CLE-RIB PIC X(02). ! +669500* SELECTION : LIBELLE ABREGE DOMICILIATION ! +669600 07 WS-4DCO-4DFI-LIB-ABR-DOM PIC X(06). ! +669700* SELECTION : NOM CLIENT ! +669800 07 WS-4DCO-4DFI-NOM-PATRO PIC X(16). ! +669900* SELECTION : PARTENAIRE DE GESTION ! +670000 07 WS-4DCO-4DFI-CD-PTN PIC X(05). ! +670100* SELECTION : NUMERO CONTRAT ! +670200 07 WS-4DCO-4DFI-NO-CTR-PTN PIC X(09). ! +670300* SELECTION : CODE VENTILATION ! +670400 07 WS-4DCO-4DFI-CD-VTL PIC X. ! +670500* SELECTION : MONTANT MINIMUM ! +670600 07 WS-4DCO-4DFI-MT-MINI PIC S9(13)V9(2) COMP-3. ! +670700* SELECTION : MONTANT MAXIMUM ! +670800 07 WS-4DCO-4DFI-MT-MAXI PIC S9(13)V9(2) COMP-3. ! +670900 07 WS-4DCO-4DFI-NO-PTN PIC 9(3) COMP-3. ! +671000 ! +671100* ==> ZONES DE TRAVAIL POUR DETAIL SUCCESSIF DE CHEQUES ! +671200 ! +671300 05 WS-4DCO-SUCCESSION-CHEQUE. ! +671400* ZONE DE PAGINATION ! +671500 ! +671600 07 WS-4DCO-4DFJ-NB-PAG-TS PIC 9(02). ! +671700 07 WS-4DCO-4DFJ-PAGE-AREA PIC X(198). ! +671800* ! +671900 07 WS-4DCO-4DFJ-SAUV-ACTION. ! +672000 10 WS-4DCO-4DFJ-SAUV-ITEM PIC 9(3) OCCURS 12. ! +672100* ! +672200 07 WS-4DCO-4DFJ-SAUV-ACT-NB PIC 9(2). ! +672300* NOMBRE D ACTIONS A TRAITER ! +672400 07 WS-4DCO-4DFJ-SAUV-ACT-TRT PIC 9(2). ! +672500* NOMBRE D ACTIONS TRAITEES ! +672600 ! +672700 07 WS-4DCO-4DFJ-TYP-ACTION PIC X. ! +672800 88 CONSULTATION-CHEQUE VALUE '1'. ! +672900 88 MODIFICATION-CHEQUE VALUE '2'. ! +673000 88 SUPPRESSION-CHEQUE VALUE '3'. ! +673100 ! +673200 07 WS-4DCO-4DFJ-IDC-CHQ PIC X. ! +673300 07 WS-4DCO-4DFJ-CD-PTN-SAUV PIC X(05). ! +673400* ! +673500 07 WS-4DCO-4DFH-IDC-OCC-SPL PIC X. ! +673600* ! +673700 05 WS-4DCO-SELECTION-PTN. ! +673800* SELECTION : DATE DEBUT ! +673900 07 WS-4DCO-4DFK-DA-DEB. ! +674000 10 WS-4DCO-4DFK-DA-DEB-SA PIC X(04). ! +674100 10 WS-4DCO-4DFK-DA-DEB-MM PIC X(02). ! +674200 10 WS-4DCO-4DFK-DA-DEB-JJ PIC X(02). ! +674300* SELECTION : DATE FIN ! +674400 07 WS-4DCO-4DFK-DA-FIN. ! +674500 10 WS-4DCO-4DFK-DA-FIN-SA PIC X(04). ! +674600 10 WS-4DCO-4DFK-DA-FIN-MM PIC X(02). ! +674700 10 WS-4DCO-4DFK-DA-FIN-JJ PIC X(02). ! +674800* SELECTION : CODE EXTERNE PTN ! +674900 07 WS-4DCO-4DFK-CD-PTN PIC X(05). ! +675000* SELECTION : NUMERO PTN INTERNE ! +675100 07 WS-4DCO-4DFK-NO-PTN PIC 9(03) COMP-3. ! +675200* MONTANT REMISES CHEQUES TOTALISES ! +675300 07 WS-4DCO-4DFK-MT-REM-CHQ PIC S9(13)V9(2) COMP-3. ! +675400* NOMBRE REMISES CHEQUES TOTALISES ! +675500 07 WS-4DCO-4DFK-NB-REM-CHQ PIC 9(7) COMP-3. ! +675600 05 FILLER PIC X(855). ! +675700* ! +675800* ! +675900*================================================================ ! +676000*= APPLICATION : RACHATS PREVI-7 = ! +676100*================================================================ ! +676200 03 WS-4DCO-RCH-P7 REDEFINES WS-4DCO-PROGRAM. ! +676300* ============ ! +676400* ------------------------------------------------------ * ! +676500* COMMAREA : RACHATS PREVI-7 * ! +676600* LONGUEUR : 1800 * ! +676700* PREFIXE : WS-P7CO-RCH * ! +676800* ------------------------------------------------------ * ! +676900* ! +677000 05 WS-P7CO-RCH-INFO-SCP. ! +677100* INFORMATIONS GENERALES SOUSCRIPTION ! +677200 07 WS-P7CO-RCH-CAPO PIC X(005). ! +677300 07 WS-P7CO-RCH-NGEN PIC X(002). ! +677400 07 WS-P7CO-RCH-NSCP PIC X(008). ! +677500 07 WS-P7CO-RCH-DSCP. ! +677600 09 WS-P7CO-RCH-DSCP-SA. ! +677700 11 WS-P7CO-RCH-DSCP-SS PIC 9(002). ! +677800 11 WS-P7CO-RCH-DSCP-AA PIC 9(002). ! +677900 09 WS-P7CO-RCH-DSCP-MM PIC 9(002). ! +678000 09 WS-P7CO-RCH-DSCP-JJ PIC 9(002). ! +678100 07 WS-P7CO-RCH-DEFF. ! +678200 09 WS-P7CO-RCH-DEFF-SA. ! +678300 11 WS-P7CO-RCH-DEFF-SS PIC 9(002). ! +678400 11 WS-P7CO-RCH-DEFF-AA PIC 9(002). ! +678500 09 WS-P7CO-RCH-DEFF-MM PIC 9(002). ! +678600 09 WS-P7CO-RCH-DEFF-JJ PIC 9(002). ! +678700 07 WS-P7CO-RCH-TXGARMIN PIC S9(3)V9(4) COMP-3. ! +678800 07 WS-P7CO-RCH-TXFRSGES PIC S9(3)V9(4) COMP-3. ! +678900 07 WS-P7CO-RCH-TXCOMSCP PIC S9(3)V9(4) COMP-3. ! +679000 07 WS-P7CO-RCH-NOM-PATRO-SC PIC X(032). ! +679100* NOM PATRONYMIQUE DU SOUSCRIPTEUR ! +679200 07 WS-P7CO-RCH-NCERDEP PIC X(008). ! +679300* ! +679400 05 WS-P7CO-RCH-INFO-RCH. ! +679500* INFORMATIONS GENERALES RACHAT ! +679600 07 WS-P7CO-RCH-DRAC. ! +679700 09 WS-P7CO-RCH-DRACSA. ! +679800 11 WS-P7CO-RCH-DRACSS PIC X(002). ! +679900 11 WS-P7CO-RCH-DRACAA PIC X(002). ! +680000 09 WS-P7CO-RCH-DRACMM PIC X(002). ! +680100 09 WS-P7CO-RCH-DRACJJ PIC X(002). ! +680200* ! +680300 07 WS-P7CO-RCH-OPTRAC PIC X(001). ! +680400 07 WS-P7CO-RCH-NO-STR-GTN PIC X(006). ! +680500 07 WS-P7CO-RCH-LIB-STR PIC X(032). ! +680600 07 WS-P7CO-RCH-CPT-DOM. ! +680700* COMPTE BANCAIRE ! +680800 09 WS-P7CO-RCH-CD-BQE-DOM PIC X(005). ! +680900 09 WS-P7CO-RCH-CD-GUI-DOM PIC X(005). ! +681000 09 WS-P7CO-RCH-NO-CPT-DOM PIC X(011). ! +681100 09 WS-P7CO-RCH-CLE-RIB-DOM PIC X(002). ! +681200 07 WS-P7CO-RCH-IDT-FIS. ! +681300* IDENTIFIANT FISCAL ! +681400 09 WS-P7CO-RCH-CD-BQE-FIS PIC X(005). ! +681500 09 WS-P7CO-RCH-CD-GUI-FIS PIC X(005). ! +681600 09 WS-P7CO-RCH-NO-CPT-FIS PIC X(011). ! +681700 09 WS-P7CO-RCH-CLE-RIB-FIS PIC X(002). ! +681800 07 WS-P7CO-RCH-IDC-PAI-CHQ PIC X(001). ! +681900* ! +682000 05 WS-P7CO-RCH-INFO-VAL-RCH. ! +682100* INFORMATIONS MONTANTS RACHAT ! +682200 07 WS-P7CO-RCH-PLUVAL PIC S9(11)V99 COMP-3. ! +682300 07 WS-P7CO-RCH-MNTPL PIC S9(11)V99 COMP-3. ! +682400 07 WS-P7CO-RCH-MNTCS PIC S9(11)V99 COMP-3. ! +682500 07 WS-P7CO-RCH-MNTPS PIC S9(11)V99 COMP-3. ! +682600 07 WS-P7CO-RCH-MNTCSG PIC S9(11)V99 COMP-3. ! +682700 07 WS-P7CO-RCH-MNTIGF PIC S9(11)V99 COMP-3. ! +682800 07 WS-P7CO-RCH-MNTDEP PIC S9(11)V99 COMP-3. ! +682900 07 WS-P7CO-RCH-VRACNET PIC S9(11)V99 COMP-3. ! +683000 07 WS-P7CO-RCH-VRACBRU PIC S9(11)V99 COMP-3. ! +683100 07 WS-P7CO-MT-ASST-CRDS PIC S9(11)V99 COMP-3. ! +683200 07 WS-P7CO-MT-VER-RDS PIC S9(11)V99 COMP-3. ! +683300 07 WS-P7CO-MT-ASST-CSG PIC S9(11)V99 COMP-3. ! +683400 07 FILLER PIC X(1) . ! +683500 07 WS-P7CO-TX-CTB-TP PIC S9(2)V9(3) COMP-3. ! +683600 07 WS-P7CO-TX-CSG-TP PIC S9(2)V9(3) COMP-3. ! +683700 07 WS-P7CO-TX-CRDS-TP PIC S9(2)V9(3) COMP-3. ! +683800* ! +683900 05 WS-P7CO-RCH-INFO-COUR. ! +684000* INFORMATIONS COURRIER ! +684100 07 WS-P7CO-RCH-INFO-COUR-PORT. ! +684200* INFORMATIONS SUR LE PORTEUR DES TITRES ! +684300 09 WS-P7CO-RCH-TY-LET PIC X(003). ! +684400 09 WS-P7CO-RCH-CODINT PIC X(001). ! +684500 09 WS-P7CO-RCH-LI-INT PIC X(016). ! +684600 09 WS-P7CO-RCH-LI-INT-CT PIC X(010). ! +684700 09 WS-P7CO-RCH-NOM PIC X(032). ! +684800 09 WS-P7CO-RCH-PRENOM PIC X(032). ! +684900 09 WS-P7CO-RCH-NOMJF PIC X(032). ! +685000 09 WS-P7CO-RCH-ADR1 PIC X(032). ! +685100 09 WS-P7CO-RCH-ADR2 PIC X(032). ! +685200 09 WS-P7CO-RCH-CODPOS PIC X(005). ! +685300 09 WS-P7CO-RCH-BURDIS PIC X(026). ! +685400 07 WS-P7CO-RCH-INFO-TRT. ! +685500 09 WS-P7CO-RCH-IDC-CPT PIC X(01). ! +685600 09 WS-P7CO-RCH-IDC-CCL PIC X(01). ! +685700 09 WS-P7CO-RCH-IDC-ARC PIC X(01). ! +685800 09 WS-P7CO-RCH-CD-EXP PIC X(01). ! +685900 09 WS-P7CO-RCH-CTRL-TY-LET PIC X(01). ! +686000 88 TY-LET-RECHERCHE VALUE 'R'. ! +686100 88 TY-LET-TROUVE VALUE 'O'. ! +686200 88 TY-LET-NON-TROUVE VALUE 'N'. ! +686300 09 WS-P7CO-RCH-TY-LET-ORI PIC X(03). ! +686400 ! +686500 07 WS-P7CO-RCH-INFO-COUR-DEST. ! +686600* INFORMATIONS SUR LE DESTINATAIRE DU COURRIER ! +686700 09 WS-P7CO-RCH-NOM-DST PIC X(032). ! +686800 09 WS-P7CO-RCH-PRENOM-DST PIC X(032). ! +686900 09 WS-P7CO-RCH-ADR1-DST PIC X(032). ! +687000 09 WS-P7CO-RCH-ADR2-DST PIC X(032). ! +687100 09 WS-P7CO-RCH-CODPOS-DST PIC X(005). ! +687200 09 WS-P7CO-RCH-BURDIS-DST PIC X(026). ! +687300 ! +687400 07 WS-P7CO-RCH-NBR-EX PIC 9(001). ! +687500* NBRE D'EXEMPLAIRES A EDITER ! +687600* ! +687700 07 WS-P7CO-RCH-NO-CHQ PIC X(007). ! +687800* NUMERO DE CHEQUE ! +687900* ! +688000 05 WS-P7CO-RCH-INFO-SPIT. ! +688100* INFORMATIONS ISSUES DU PARAMETRAGE SPITAB ! +688200 07 WS-P7CO-RCH-CD-TY-CRO PIC X(003). ! +688300 07 WS-P7CO-RCH-CD-EVE-TY PIC X(006). ! +688400 07 WS-P7CO-RCH-LIB-OPE PIC X(032). ! +688500 07 WS-P7CO-RCH-LIB-LET PIC X(032). ! +688600* ! +688700 05 WS-P7CO-RCH-INFO-TS. ! +688800* INFORMATIONS CONCERNANT LA TS - LISTE TITRES ! +688900 07 WS-P7CO-RCH-TS-LG PIC S9(04) COMP. ! +689000 07 WS-P7CO-RCH-TS-ITEM OCCURS 15 PIC S9(04) COMP. ! +689100 07 WS-P7CO-RCH-TS-NB-ITEM PIC S9(04) COMP. ! +689200 07 WS-P7CO-RCH-TS-NB-ZOOM PIC S9(04) COMP. ! +689300 07 WS-P7CO-RCH-TS-NOM PIC X(07). ! +689400 07 WS-P7CO-RCH-TS-NB-MODIF PIC 9(2). ! +689500* ! +689600 05 WS-P7CO-RCH-EDIT. ! +689700 07 WS-P7CO-RCH-LIB-LET-0 PIC X(30). ! +689800 07 WS-P7CO-RCH-LIB-LET-1 PIC X(30). ! +689900 07 WS-P7CO-RCH-REF-IMP-EXT PIC X(10). ! +690000* ! +690100*-- DUREE DU CONTRAT EN NOMBRE DE JOURS ! +690200 05 WS-P7CO-RCH-NB-JOURS PIC 9(05). ! +690300*-- INDICE FISCALITE ! +690400 05 WS-P7CO-RCH-IND-FIS PIC X(01). ! +690500 ! +690600*-- INDICATEUR EDITION POUR IMPRESSION RDI ! +690700 05 WS-P7CO-E-IDC-EDIT PIC X(04). ! +690800 88 IMPR-SUIVANTE VALUE 'SU'. ! +690900 88 IMPR-TERMINER VALUE 'FF'. ! +691000*-- NOM PROGRAMME RETOUR APRES IMPRESSION RDI ! +691100 05 WS-P7CO-E-NO-PGM-CICS-RE PIC X(08). ! +691200*-- DATE ET HEURE DE MISE A JOUR DES CROS ! +691300 05 WS-P7CO-RCH-DA-CRE-CRO PIC X(08). ! +691400 05 WS-P7CO-RCH-HEU-CRE-CRO PIC 9(06). ! +691500*-- NOM DE LA TS D'EDITION ! +691600 05 WS-P7CO-RCH-E-TS-NOM PIC X(08). ! +691700*-- COMPTE EXONERE ! +691800 05 WS-P7CO-RCH-EXO PIC X(01). ! +691900 ! +692000* - AGENCE ! +692100 05 WS-P7CO-SCR-NAPO PIC X(8). ! +692200* - NUMERO DE CLIENT INTERNE DU CLIENT SOUSCRIPTEUR ! +692300 05 WS-P7CO-SCR-NO-CLI PIC 9(7). ! +692400* - CODE EXTERNE DU CLIENT SOUSCRIPTEUR ! +692500 05 WS-P7CO-SCR-CD-CLI. ! +692600* - CODE EXTERNE DU CLIENT SOUSCRIPTEUR PARTIE 1 ! +692700 10 WS-P7CO-SCR-CD-CLI-PART1 PIC X(7). ! +692800* - CODE EXTERNE DU CLIENT SOUSCRIPTEUR PARTIE 2 ! +692900 10 WS-P7CO-SCR-CD-CLI-PART2 PIC X(8). ! +693000* - DATE NAISSANCE ! +693100 05 WS-P7CO-SCR-DNAI. ! +693200 10 WS-P7CO-SCR-DNAI-SA. ! +693300 15 WS-P7CO-SCR-DNAI-SS PIC 9(2). ! +693400 15 WS-P7CO-SCR-DNAI-AA PIC 9(2). ! +693500 10 WS-P7CO-SCR-DNAI-MM PIC 9(2). ! +693600 10 WS-P7CO-SCR-DNAI-JJ PIC 9(2). ! +693700* - LIEU NAISSANCE ! +693800 05 WS-P7CO-SCR-LOCNAI PIC X(32). ! +693900* - DEPARTEMENT NAISSANCE ! +694000 05 WS-P7CO-SCR-DEPNAI PIC X(32). ! +694100* - CODE EXPEDITION (TYPE D'ENVOI) 1:EN CCM 2:A DOMICILE ! +694200 05 WS-P7CO-SCR-CEXPEDI PIC X(1). ! +694300* - DATE ACCUSE DE RECEPTION ! +694400 05 WS-P7CO-SCR-DACRECEP. ! +694500 10 WS-P7CO-SCR-DACRECP-SA. ! +694600 15 WS-P7CO-SCR-DACRECP-SS PIC X(2). ! +694700 15 WS-P7CO-SCR-DACRECP-AA PIC X(2). ! +694800 10 WS-P7CO-SCR-DACRECP-MM PIC X(2). ! +694900 10 WS-P7CO-SCR-DACRECP-JJ PIC X(2). ! +695000* - OPTION GARDIENNAGE A LA SOUSCRIPTION ! +695100 05 WS-P7CO-SCR-OPTGARD PIC X(1). ! +695200* ! +695300 05 WS-P7CO-SCR-NANTI PIC X(1). ! +695400* - CODE RENONCIATION 0:NON 1:OUI ! +695500 05 WS-P7CO-SCR-CRENONC PIC X(1). ! +695600* - DATE RENONCIATION ! +695700 05 WS-P7CO-SCR-DREN. ! +695800 10 WS-P7CO-SCR-DREN-SA. ! +695900 15 WS-P7CO-SCR-DREN-SS PIC 9(2). ! +696000 15 WS-P7CO-SCR-DREN-AA PIC 9(2). ! +696100 10 WS-P7CO-SCR-DREN-MM PIC 9(2). ! +696200 10 WS-P7CO-SCR-DREN-JJ PIC 9(2). ! +696300* - MONTANT SOUSCRIT ! +696400 05 WS-P7CO-SCR-MNTSCP PIC S9(13) COMP-3. ! +696500* - FRAIS GESTION ! +696600 05 WS-P7CO-SCR-FRSGES PIC S9(13) COMP-3. ! +696700* - TAUX FRAIS GESTION ! +696800 05 WS-P7CO-SCR-TXFRSGES PIC S9(3)V9(4) COMP-3. ! +696900* - COMMISSION ! +697000 05 WS-P7CO-SCR-COMSCP PIC S9(13) COMP-3. ! +697100* - TAUX COMMISSION ! +697200 05 WS-P7CO-SCR-TXCOMSCP PIC S9(3)V9(4) COMP-3. ! +697300* - NOMBRE ET MONTANT DES TITRES SOUSCRITS ! +697400 05 WS-P7CO-SCR-GTITRE OCCURS 7. ! +697500* - MONTANT DU TITRE ! +697600 10 WS-P7CO-SCR-MNTTIT PIC S9(13) COMP-3. ! +697700* - NB TIT DE CE MONTANT ! +697800 10 WS-P7CO-SCR-NBTIT PIC S9(5) COMP-3. ! +697900* - NOMBRE D'ITEMS DANS LA TS TITS ! +698000 05 WS-P7CO-TIT-NB-ITEM PIC S9(4) COMP. ! +698100* - NUMERO D'ITEM DE LA TS TITS ! +698200 05 WS-P7CO-TIT-NO-ITEM PIC S9(4) COMP. ! +698300* - CODE OPTION FISCALE ! +698400 05 WS-P7CO-CD-OPT-FIS PIC X(01). ! +698500* - CODE NATURE PIECE IDENTITE ! +698600 05 WS-P7CO-CD-NAT-PCE-IDT PIC X(02). ! +698700* - CODE INSEE COMMUNE ! +698800 05 WS-P7CO-RCH-CD-DPT PIC X(02). ! +698900* - NUMERO INSEE COMMUNE ! +699000 05 WS-P7CO-RCH-CD-COMM PIC X(03). ! +699100* - INDICATEUR SOUSCRIPTION ECHUE ( TERME PR�VI-7 ) ! +699200 05 WS-P7CO-SCR-IDC-ECH PIC X(01). ! +699300* - DATE ECHEANCE SOUSCRIPTION ! +699400 05 WS-P7CO-SCR-DAECHSCP. ! +699500 10 WS-P7CO-SCR-DAECHSCPSA. ! +699600 15 WS-P7CO-SCR-DAECHSC-SS PIC 9(2). ! +699700 15 WS-P7CO-SCR-DAECHSC-AA PIC 9(2). ! +699800 10 WS-P7CO-SCR-DAECHSC-MM PIC 9(2). ! +699900 10 WS-P7CO-SCR-DAECHSC-JJ PIC 9(2). ! +700000* - AFFICHAGE TCP7510 ! +700100 05 WS-P7CO-LIB-SEL PIC X(030). ! +700200 05 WS-P7CO-SEL-TS-TIT PIC X(001). ! +700300* - AFFICHAGE TCP7520- APPEL DE VALEUR ! +700400 05 WS-P7CO-RCH-CODINT2 PIC X(002). ! +700500 05 WS-P7CO-RCH-LI-INT2 PIC X(016). ! +700600* - RESERVATION DU NUMERO DE TITRE SAISI ! +700700 05 WS-P7CO-RCH-NSER PIC X(04). ! +700800 05 WS-P7CO-RCH-NCAR PIC X(07). ! +700900 05 WS-P7CO-RCH-NTIT PIC X(07). ! +701000 05 WS-P7CO-RCH-IDC-MESS-FISCALITE PIC X(01). ! +701100* - CONTRIBUTION ADDITIONNELLE ! +701200 05 WS-P7CO-RCH-MT-CTB PIC S9(11)V99 COMP-3. ! +701300* - NOUVEAU FILLER DE FIN ! +701400 05 FILLER PIC X(587). ! +701500 ! +701600* ! +701700*================================================================ ! +701800*= APPLICATION : GESTION SINISTRE DECES = ! +701900*================================================================ ! +702000 03 WS-4DCO-4DDS REDEFINES WS-4DCO-PROGRAM. ! +702100* ============ ! +702200 ! +702300* ============== ! +702400* ------------------------------------------------------ * ! +702500* COMMAREA : PARAMETRAGE : REGLE DE DELEGATION * ! +702600* LONGUEUR : 1800 * ! +702700* PREFIXE : WS-4DCO-4DDS * ! +702800* ------------------------------------------------------ * ! +702900 ! +703000 10 WS-4DCO-4DDS. ! +703100 ! +703200 15 FILLER PIC X(28). ! +703300* AJUSTEMENT ! +703400 15 WS-4DCO-4DDS-PAGE-AREA PIC X(198). ! +703500* PAGE AREA POUR LISTE ! +703600 15 WS-4DCO-4DDS-NO-PTN PIC S9(05) COMP-3. ! +703700* NUMERO INTERNE PARTENAIRE ! +703800 15 WS-4DCO-4DDS-CD-PTN PIC 9(05). ! +703900* NUMERO EXTERNE PARTENAIRE ! +704000 15 WS-4DCO-4DDS-NO-STR PIC X(06). ! +704100* NUMERO EXTERNE PARTENAIRE ! +704200 15 WS-4DCO-4DDS-CD-RGL-DLG PIC X(03). ! +704300* CODE REGLE DELEGATION ! +704400 15 WS-4DCO-4DDS-DA-VAL-DBT PIC X(08). ! +704500* DATE DEBUT-VALIDITE ! +704600 15 WS-4DCO-4DDS-DA-FIN-VAL PIC X(08). ! +704700* DATE FIN VALIDITE ! +704800 15 WS-4DCO-4DDS-MT-MX-PRIM ! +704900 PIC S9(13)V9(02) COMP-3. ! +705000* INDICATEUR FONCTION DEMANDE ! +705100 15 WS-4DCO-4DDS-FCT-DEM PIC X(03). ! +705200* MONTANT MAXIMUM DE PRESTATION ! +705300 15 WS-4DCO-4DDS-CD-RGL-DLG-LST PIC X(03). ! +705400* CODE REGLE DELEGATION ! +705500 15 WS-4DCO-4DDS-DA-VAL-DBT-LST PIC X(08). ! +705600* DATE DEBUT-VALIDITE ! +705700 15 FILLER PIC X(1519). ! +705800* ! +705900*================================================================ ! +706000*= APPLICATION : TRANSFERT PARTENAIRE = ! +706100*================================================================ ! +706200 03 WS-4DCO-TRANSFER-DEST REDEFINES WS-4DCO-PROGRAM. ! +706300* ============ ! +706400* ------------------------------------------------------ * ! +706500* COMMAREA : TRANSFERT PARTENAIRE * ! +706600* LONGUEUR : 1800 * ! +706700* PREFIXE : ! +706800* ------------------------------------------------------ * ! +706900* ! +707000 05 WS-4DCO-TRANSF-DEST. ! +707100* NUMERO DE PARTENAIRE EXTERNE (DESTINATAIRE) ! +707200 10 WS-4DCO-CD-PTN-DEST PIC X(005). ! +707300* LIBELLE PARTENAIRE EXTERNE (DESTINATAIRE) ! +707400 10 WS-4DCO-LIB-PTN-DEST PIC X(032). ! +707500* NUMERO DE PARTENAIRE INTERNE (DESTINATAIRE) ! +707600 10 WS-4DCO-NO-PTN-DEST PIC 9(003). ! +707700* NUMERO AGENCE (DESTINATAIRE) ! +707800 10 WS-4DCO-NO-AGC-DEST PIC X(006). ! +707900* NOM AGENCE (DESTINATAIRE) ! +708000 10 WS-4DCO-NOM-AGC-DEST PIC X(032). ! +708100* ADRESSE AGENCE (DESTINATAIRE) ! +708200 10 WS-4DCO-LIB-RUE-1-STR-DEST PIC X(032). ! +708300 10 WS-4DCO-LIB-RUE-2-STR-DEST PIC X(032). ! +708400 10 WS-4DCO-LIB-COMMUNE-STR-DES PIC X(032). ! +708500 10 WS-4DCO-CD-POST-STR-DEST PIC X(005). ! +708600 10 WS-4DCO-LIB-BUR-DIST-STR-DEST PIC X(026). ! +708700* NUMERO STRUCTURE GESTIONNAIRE (EMMETTEUR ) ! +708800 10 WS-4DCO-NO-STR-GTN-EMET PIC X(006). ! +708900* NUMERO AGENECE GESTIONNAIRE (EMMETTEUR ) ! +709000 10 WS-4DCO-NO-AGT-GTN-EMET PIC X(008). ! +709100 10 WS-4DCO-PRODUIT-DEST. ! +709200* NUMERO DE PRODUIT EXTERNE (DESTINATAIRE) ! +709300 15 WS-4DCO-CD-PRD-DEST PIC X(002). ! +709400* LIBELLE PRODUIT EXTERNE (DESTINATAIRE) ! +709500 15 WS-4DCO-LIB-PROD-DEST PIC X(032). ! +709600* NUMERO DE PRODUIT INTERNE (DESTINATAIRE) ! +709700 15 WS-4DCO-NO-PRD-DEST PIC 9(003). ! +709800* NUMERO GENERATION PRODUIT (DESTINATAIRE) ! +709900 15 WS-4DCO-NO-GEN-PRD-DEST PIC X(003). ! +710000* TYPE GENERATION PRODUIT (DESTINATAIRE) ! +710100 15 WS-4DCO-NO-TYP-PRD-DEST PIC 9(002). ! +710200* NUMERO CLIENT EXTERNE (DESTINATAIRE) ! +710300 10 WS-4DCO-CD-CLI-DEST PIC X(015). ! +710400* NUMERO CLIENT INTERNE (DESTINATAIRE) ! +710500 10 WS-4DCO-NO-CLI-DEST PIC 9(007). ! +710600* NOM PRENOM CLIENT (DESTINATAIRE) ! +710700 10 WS-4DCO-NOM-CLIENT-DEST PIC X(032). ! +710800* NOM CLIENT (DESTINATAIRE) ! +710900 10 WS-4DCO-NOM-DEST PIC X(032). ! +711000* PRENOM CLIENT (DESTINATAIRE) ! +711100 10 WS-4DCO-PRENOM-DEST PIC X(032). ! +711200* CODE INTITULE CLIENT (DESTINATAIRE) ! +711300 10 WS-4DCO-CD-INT-CLI-DEST PIC X(002). ! +711400* ADRESSE CLIENT (DESTINATAIRE) ! +711500 10 WS-4DCO-LIB-RUE-1-CLI-DEST PIC X(032). ! +711600 10 WS-4DCO-LIB-RUE-2-CLI-DEST PIC X(032). ! +711700 10 WS-4DCO-LIB-COMMUNE-CLI-DEST PIC X(032). ! +711800 10 WS-4DCO-CD-POST-CLI-DEST PIC X(005). ! +711900 10 WS-4DCO-LIB-BUR-DIST-CLI-DEST PIC X(026). ! +712000* DATE DE NAISSANCE CLIENT (DESTINATAIRE) ! +712100 10 WS-4DCO-DA-NAIS-DEST. ! +712200 15 WS-4DCO-DA-NAIS-SSAA-DEST PIC X(004). ! +712300 15 FILLER PIC X(001). ! +712400 15 WS-4DCO-DA-NAIS-MM-DEST PIC X(002). ! +712500 15 FILLER PIC X(001). ! +712600 15 WS-4DCO-DA-NAIS-JJ-DEST PIC X(002). ! +712700* NUMERO DU CONTRAT (DESTINATAIRE) ! +712800 10 WS-4DCO-CONTRAT-DEST PIC X(009). ! +712900* NUMERO D ORDRE CONTRAT (DESTINATAIRE) ! +713000 10 WS-4DCO-NO-ORD-CTR-DEST PIC 9(002). ! +713100 10 WS-4DCO-DRAP-RC-DEST PIC X(001). ! +713200* NUMERO RIB DOM (DESTINATAIRE) ! +713300 10 WS-4DCO-RIB-PER-DEST. ! +713400 15 WS-4DCO-BNQ-DOM-DEST PIC X(005). ! +713500 15 WS-4DCO-GCH-DOM-DEST PIC X(005). ! +713600 15 WS-4DCO-RAC-DOM-DEST PIC X(011). ! +713700 15 WS-4DCO-CLE-DOM-DEST PIC X(002). ! +713800* NUMERO RIB DOM (EMMETTEUR ) ! +713900 10 WS-4DCO-RIB-PER-EMET. ! +714000 15 WS-4DCO-BNQ-DOM-EMET PIC X(005). ! +714100 15 WS-4DCO-GCH-DOM-EMET PIC X(005). ! +714200 15 WS-4DCO-RAC-DOM-EMET PIC X(011). ! +714300 15 WS-4DCO-CLE-DOM-EMET PIC X(002). ! +714400* PROVISION MATHEMATIQUE OUVERT (DESTINATAIRE) ! +714500 10 WS-4DCO-PVS-MTH-OUV-EXE PIC S9(15) COMP-3. ! +714600* MONANT NET VERSEMENT ANNEE (DESTINATAIRE) ! +714700 10 WS-4DCO-MT-NET-VER-EXE PIC S9(15) COMP-3. ! +714800* MONANT CREDIT SOCIETAIRE (DESTINATAIRE) ! +714900 10 WS-4DCO-MT-CRD-SOC PIC S9(15) COMP-3. ! +715000* MONANT COTISATION VIEILLESSE (DESTINATAIRE) ! +715100 10 WS-4DCO-MT-CTS-VLL PIC S9(9) COMP-3. ! +715200* MONANT PRELEVEMENT SOCIALE (DESTINATAIRE) ! +715300 10 WS-4DCO-MT-PLV-SOC PIC S9(9) COMP-3. ! +715400* MONANT C.S.G (DESTINATAIRE) ! +715500 10 WS-4DCO-MT-CSG PIC S9(13)V9(2) COMP-3. ! +715600* MONANT CONTRIBUTION DEPERTEMT (DESTINATAIRE) ! +715700 10 WS-4DCO-MT-CTB-DPT PIC S9(15) COMP-3. ! +715800* MONANT PRELEVEMENT LIBERATOIRE(DESTINATAIRE) ! +715900 10 WS-4DCO-MT-PLV-LBL PIC S9(13)V9(2) COMP-3. ! +716000* SOLDE DES AVANCES (DESTINATAIRE) ! +716100 10 WS-4DCO-SLD-AV-DEST PIC 9(15) COMP-3. ! +716200* MONTANT DES FRAIS SUR AVANCES (DESTINATAIRE) ! +716300 10 WS-4DCO-MT-FRS-AV-EXE PIC S9(15) COMP-3. ! +716400* MONTANT DES FRAIS RPP (DESTINATAIRE) ! +716500 10 WS-4DCO-MT-FRS-RPP-A PIC S9(13)V9(2) COMP-3. ! +716600* SOLDE TEMPS REEL (DESTINATAIRE) ! +716700 10 WS-4DCO-SLD-TPS-REAL-DEST PIC S9(15) COMP-3. ! +716800* INDICATEUR CREDIT MUTUEL ! +716900 10 WS-4DCO-IDC-PTN-CM-DEST PIC X(001). ! +717000* INDICATEUR NANTISSEMENT ! +717100 10 WS-4DCO-CD-NTS-DEST PIC X(001). ! +717200* INDICATEUR FONCTIONNALITE ! +717300 10 WS-4DCO-CD-FCT-DEST PIC X(001). ! +717400* INDICATEUR MOUVEMENTS DANS LA JOURNNE ! +717500 10 WS-4DCO-MVT-JOUR-DEST PIC X(001). ! +717600* INDICATEUR P.A.B ! +717700 10 WS-4DCO-DNR-PAB-DEST PIC X(001). ! +717800* DATE P.A.B ! +717900 10 WS-4DCO-DA-PAS-PAB PIC X(008). ! +718000* INDICATEUR VERSEMENT PERIODIQUE ! +718100 10 WS-4DCO-CD-VER-PER-DEST PIC X(001). ! +718200 10 WS-4DCO-NB-PASSAGE-DEST PIC 9(001). ! +718300 10 WS-4DCO-TX-FRS-DEST PIC S9(2)V9(5) COMP-3. ! +718400 10 WS-4DCO-IDC-TRF-DSK PIC X(001). ! +718500 10 WS-4DCO-CD-PTN-DEST-A PIC X(005). ! +718600 10 WS-4DCO-NO-CTR-DEST-A PIC X(009). ! +718700 10 WS-4DCO-MT-CTB-DEST PIC S9(13)V99 COMP-3. ! +718800* MONTANT PRELEVEMENT LIBERATOIRE(DESTINATAIRE) ! +718900 10 WS-4DCO-MT-PLV-LBL-F8 PIC S9(13)V9(2) COMP-3. ! +719000 10 FILLER PIC X(1084). ! +719100 ! +719200*================================================================ ! +719300*= APPLICATION : PARAMETRAGE : GESTION PRIME ETAT = ! +719400*================================================================ ! +719500* ! +719600 03 WS-4DCO-PRM-ETAT REDEFINES WS-4DCO-PROGRAM. ! +719700* ============ ! +719800 ! +719900* ============== ! +720000* ------------------------------------------------------ * ! +720100* COMMAREA : PARAMETRAGE : GESTION DE LA PRIME ETAT -* ! +720200* LONGUEUR : 1800 * ! +720300* PREFIXE : WS-4DCO-PRCP * ! +720400* ------------------------------------------------------ * ! +720500* ! +720600* ZONES COMMUNES ! +720700* ZONE GROUPE POUR LE PROGRAMME TC4DPD0 ! +720800* ! +720900 05 WS-4DCO-4DPD. ! +721000* ! +721100* ZONE DE PAGINATION ! +721200 15 WS-4DCO-4DPD-PAGE. ! +721300 20 WS-4DCO-4DPD-IDC-OCC-SPL PIC X(001). ! +721400 20 WS-4DCO-4DPD-NB-PAG-TS PIC 9(002). ! +721500 20 WS-4DCO-4DPD-SAUV-PAGE-AREA PIC X(198). ! +721600* ! +721700* ACTION SAUVEGARDEE ! +721800 15 WS-4DCO-4DPD-SAUV-ACT PIC X. ! +721900* ! +722000* CODE MESSAGE ERREUR ! +722100 15 WS-4DCO-4DPD-ERRMSG1 PIC X(006). ! +722200* ! +722300* NOMBRE D'OCCURENCES DE LA LISTE ! +722400 15 WS-4DCO-4DPD-NB-TS-ITEM PIC S9(04) COMP. ! +722500* ! +722600* POSITION DU CURSEUR DU 1ER DETAIL DEMANDE ! +722700 15 WS-4DCO-4DPD-POS-CURSOR PIC 9(002). ! +722800* NB DE DETAILS TRAITES ! +722900 15 WS-4DCO-4DPD-SAUV-ACT-TRT PIC S9(4) COMP. ! +723000* NB DE DETAILS DEMANDES ! +723100 15 WS-4DCO-4DPD-SAUV-ACT-NB PIC S9(4) COMP. ! +723200* ! +723300************************************ NOMBRE PRIS 216 ! +723400************************************ NOMBRE DISPONIBLE 1584 ! +723500 ! +723600* ZONE GROUPE POUR LE PROGRAMME TC4DPH0 ! +723700* ! +723800 05 WS-4DCO-4DPH. ! +723900* ! +724000* ZONE DE PAGINATION ! +724100 15 WS-4DCO-4DPH-PAGE. ! +724200 20 WS-4DCO-4DPH-IDC-OCC-SPL PIC X(001). ! +724300 20 WS-4DCO-4DPH-NB-PAG-TS PIC 9(002). ! +724400 20 WS-4DCO-4DPH-SAUV-PAGE-AREA PIC X(198). ! +724500* ! +724600* CLE DE REPOSITIONNEMENT ! +724700 15 WS-4DCO-4DPH-CLE. ! +724800 20 WS-4DCO-4DPH-CD-PTN PIC 9(005). ! +724900 20 WS-4DCO-4DPH-NO-SEQ-MVT-POS PIC 9(005). ! +725000* CLE DE SAUVEGARDE. ! +725100 15 WS-4DCO-4DPH-CLE-REF. ! +725200 20 WS-4DCO-4DPH-CD-PTN-REF PIC 9(05). ! +725300 20 WS-4DCO-4DPH-NO-SEQ-MVT-REF PIC 9(5). ! +725400* ! +725500* ACTION SAUVEGARDEE ! +725600 15 WS-4DCO-4DPH-SAUV-ACT PIC X. ! +725700* ! +725800* CODE MESSAGE ERREUR ! +725900 15 WS-4DCO-4DPH-ERRMSG1 PIC X(006). ! +726000* ! +726100* NOMBRE D'OCCURENCES DE LA LISTE ! +726200 15 WS-4DCO-4DPH-NB-TS-ITEM PIC S9(04) COMP. ! +726300* ! +726400* ZOOM DEBUT 447 ! +726500* POSITION DU CURSEUR DU 1ER DETAIL DEMANDE ! +726600 15 WS-4DCO-4DPH-POS-CURSOR PIC 9(002). ! +726700* NB DE DETAILS TRAITES ! +726800 15 WS-4DCO-4DPH-SAUV-ACT-TRT PIC S9(4) COMP. ! +726900* NB DE DETAILS DEMANDES ! +727000 15 WS-4DCO-4DPH-SAUV-ACT-NB PIC S9(4) COMP. ! +727100* ZOOM FIN ! +727200************************************ NOMBRE PRIS 452 ! +727300************************************ NOMBRE DISPONIBLE 1348 ! +727400* ! +727500* ZONE GROUPE POUR ZOOM (C4DPE0, C4DPF0, C4DPG0, C4DPH0) ! +727600 ! +727700 05 WS-4DCO-4DPD-ZOOM. ! +727800 ! +727900 15 WS-4DCO-4DPD-NO-ETAT-PRIM PIC S9(6) COMP-3. ! +728000 15 WS-4DCO-4DPD-DA-TT-PRIM PIC X(10). ! +728100 15 WS-4DCO-4DPD-DA-PAI-PRIM PIC X(10). ! +728200 15 WS-4DCO-4DPD-NB-CPT-CCN PIC S9(6) COMP-3. ! +728300 15 WS-4DCO-4DPD-MT-GLB-PRIM-DEM PIC S9(13)V99 COMP-3. ! +728400 15 WS-4DCO-4DPD-MT-GLB-PRIM-VER PIC S9(13)V99 COMP-3. ! +728500 15 WS-4DCO-4DPD-CD-VAL-PAI PIC X. ! +728600* RUBRIQUES SPECIFIQUES C4DPF0 ! +728700 15 WS-4DCO-4DPF-MT-GLB-PRIM-RJ PIC S9(13)V99 COMP-3. ! +728800 15 WS-4DCO-4DPF-MT-GLB-PRIM-SAI PIC S9(13)V99 COMP-3. ! +728900* RUBRIQUES SPECIFIQUES C4DPE0 ! +729000 15 WS-4DCO-4DPE-NO-IMPL PIC X(08). ! +729100 15 WS-4DCO-4DPE-NB-EXEMP PIC 99. ! +729200* RUBRIQUES SPECIFIQUES C4DPH0 ! +729300 15 WS-4DCO-4DPH-IDC-PTN-CM PIC X. ! +729400 ! +729500************************************ NOMBRE PRIS 523 ! +729600************************************ NOMBRE DISPONIBLE 1276 ! +729700 ! +729800* 03 WS-4DCO-PAIEMENT-PRIME REDEFINES WS-4DCO-PROGRAM. ! +729900* ====================== ! +730000* !!! CETTE PARTIE EST INTEGREE A LA NOUVELLE APPLICATION !!!!!!! ! +730100* ------------------------------------------------------ * ! +730200* COMMAREA : PAIEMENT DE LA PRIME DE L'ETAT * ! +730300* LONGUEUR : 1800 * ! +730400* PREFIXE : WS-4DCO-PA- / WS-4DCO-MD- * ! +730500* ------------------------------------------------------ * ! +730600* COMMAREA SPECIFIQUE P4DHE0 ! +730700 ! +730800 05 WS-4DCO-PA-NOM-TIT-PEP PIC X(032). ! +730900* NOM ! +731000 05 WS-4DCO-PA-DA-SEL. ! +731100* DATE DE DEMANDE ENR Y4D99P ! +731200 10 WS-4DCO-PA-DA-SA-SEL PIC X(4). ! +731300 10 WS-4DCO-PA-DA-MM-SEL PIC X(2). ! +731400 10 WS-4DCO-PA-DA-JJ-SEL PIC X(2). ! +731500 05 WS-4DCO-PA-POS-CURS PIC S9(04) COMP. ! +731600* POSITION DU CURSEUR ! +731700 05 WS-4DCO-PA-IND-FIC PIC X(001). ! +731800* CODE RETOUR POUR FICHIER (P4299P) VIDE ! +731900 05 WS-4DCO-PA-TAB-TRAV. ! +732000* TABLE DES 12 ENREGISTREMENTS P4299P ! +732100 10 WS-4DCO-PA-TAB-POSTE OCCURS 12. ! +732200* ! +732300 15 WS-4DCO-PA-NO-ORD-ENR-99 PIC 9(03). ! +732400* ! +732500 15 WS-4DCO-PA-DAT-DEM. ! +732600* ! +732700 20 WS-4DCO-PA-DAT-DEM-SA. ! +732800* ! +732900 25 WS-4DCO-PA-DAT-DEM-S PIC X(002). ! +733000* ! +733100 25 WS-4DCO-PA-DAT-DEM-A PIC X(002). ! +733200* ! +733300 20 WS-4DCO-PA-DAT-DEM-MM PIC X(002). ! +733400* ! +733500 20 WS-4DCO-PA-DAT-DEM-JJ PIC X(002). ! +733600* ! +733700 15 WS-4DCO-PA-MT-DEM PIC S9(15) COMP-3. ! +733800* ! +733900 15 WS-4DCO-PA-MT-DEM-D REDEFINES WS-4DCO-PA-MT-DEM ! +734000 PIC S9(13)V9(02) COMP-3. ! +734100* ! +734200 15 WS-4DCO-PA-NBRE-PEP PIC S9(05). ! +734300* ! +734400 15 WS-4DCO-PA-DAT-PAI. ! +734500* ! +734600 20 WS-4DCO-PA-DAT-PAI-SA. ! +734700* ! +734800 25 WS-4DCO-PA-DAT-PAI-S PIC X(002). ! +734900* ! +735000 25 WS-4DCO-PA-DAT-PAI-A PIC X(002). ! +735100* ! +735200 20 WS-4DCO-PA-DAT-PAI-MM PIC X(002). ! +735300* ! +735400 20 WS-4DCO-PA-DAT-PAI-JJ PIC X(002). ! +735500* ! +735600 15 WS-4DCO-PA-CD-PAI PIC X(001). ! +735700* ! +735800 15 WS-4DCO-PA-CD-VAL-PAI PIC 9(01). ! +735900* ! +736000 15 WS-4DCO-PA-MT-PAI PIC S9(15) COMP-3. ! +736100* ! +736200 15 WS-4DCO-PA-MT-PAI-D REDEFINES WS-4DCO-PA-MT-PAI ! +736300 PIC S9(13)V9(02) COMP-3. ! +736400* ! +736500 15 WS-4DCO-PA-MT-PAI-X REDEFINES WS-4DCO-PA-MT-PAI ! +736600 PIC X(008). ! +736700* ! +736800 05 WS-4DCO-PA-ENR-99-AFF PIC S9(02). ! +736900* NB ENREG P4299P LUS ET STOCKES ! +737000 05 WS-4DCO-PA-SAISIES PIC X(001). ! +737100* INDIC EXERCICES RESTANT A SAISIR ! +737200 ! +737300* ------------------------------------------------------ * ! +737400* ZONES SPECIFIQUES PROGRAMME DE MODIFICATION DU MONTANT * ! +737500* PRIME POUR REJET APPELE PAR ZOOM PF10 * ! +737600* ------------------------------------------------------ * ! +737700 ! +737800 05 WS-4DCO-MD-TAB-TRAV. ! +737900* ! +738000 10 WS-4DCO-MD-02-COURANT PIC 9(2). ! +738100* INDICE DE L' ARTICLE 02 QUE L'ON TRAITE ! +738200 10 WS-4DCO-MD-TAB-POSTE OCCURS 10. ! +738300* ! +738400 15 WS-4DCO-MD-ANNEE-VER PIC 9(04). ! +738500* ! +738600 15 WS-4DCO-MD-ANNEE-IMP PIC 9(04). ! +738700* ! +738800 15 WS-4DCO-MD-VER PIC S9(09) COMP-3. ! +738900* ! +739000 15 WS-4DCO-MD-VER-D REDEFINES WS-4DCO-MD-VER ! +739100 PIC S9(07)V9(02) COMP-3. ! +739200* ! +739300 15 WS-4DCO-MD-PRIM PIC S9(09) COMP-3. ! +739400* ! +739500 15 WS-4DCO-MD-PRIM-D REDEFINES WS-4DCO-MD-PRIM ! +739600 PIC S9(07)V9(02) COMP-3. ! +739700* ! +739800 15 WS-4DCO-MD-TAUX PIC S9(02)V9(03). ! +739900* ! +740000 15 WS-4DCO-MD-INT PIC S9(09) COMP-3. ! +740100* ! +740200 15 WS-4DCO-MD-INT-D REDEFINES WS-4DCO-MD-INT ! +740300 PIC S9(07)V9(02) COMP-3. ! +740400* ! +740500 15 WS-4DCO-MD-IMP PIC X(001). ! +740600* ! +740700 15 WS-4DCO-MD-DAT-DEM. ! +740800* ! +740900 20 WS-4DCO-MD-DEM-SA. ! +741000* ! +741100 25 WS-4DCO-MD-DEM-S PIC X(002). ! +741200* ! +741300 25 WS-4DCO-MD-DEM-A PIC X(002). ! +741400* ! +741500 20 WS-4DCO-MD-DEM-M PIC X(002). ! +741600* ! +741700 20 WS-4DCO-MD-DEM-J PIC X(002). ! +741800* ! +741900 15 WS-4DCO-MD-SAISIE-REJET PIC X. ! +742000* CODE REJET PAIEMENT (O OU N) ! +742100 15 WS-4DCO-MD-NO-IND-03 PIC 9(02). ! +742200* INDICE DU TABLEAU WS-4DCO-MD-ART03-POSTE DU PAIEMENT CORR ! +742300 15 WS-4DCO-MD-NO-ETAT-PRIM PIC S9(6) COMP-3. ! +742400* N� ETAT CONTENANT LA DEMANDE DE PRIME POUR L'ANNEE ! +742500* ! +742600 05 WS-4DCO-MD-TAB-ART03. ! +742700* ! +742800 10 WS-4DCO-MD-ART03-POSTE OCCURS 10. ! +742900* ! +743000 15 WS-4DCO-MD-NO-ORD PIC 9(03). ! +743100* NUMERO D' ORDRE LE L'ENREG 03 CORRESPONDANT A CETTE ANNEE ! +743200 15 WS-4DCO-MD-CD-ETAT-PRIME PIC X. ! +743300* CODE ETAT DE LA DEMANDE DE PRIME ! +743400 15 WS-4DCO-MD-MT-GLB-PRIM-DEM PIC S9(13)V9(2) COMP-3. ! +743500* MONTANT DEMANDE DANS CETTE DEMANDE ! +743600 15 WS-4DCO-MD-MT-GLB-PRIM-VER PIC S9(13)V9(2) COMP-3. ! +743700* MONTANT ACCEPTE DANS CETTE DEMANDE ! +743800 05 WS-4DCO-MD-CUM-PRI PIC S9(09) COMP-3. ! +743900* CUMUL PRIMES (POUR EXE CONCERNES) ! +744000 05 WS-4DCO-MD-CUM-PRI-D REDEFINES WS-4DCO-MD-CUM-PRI ! +744100 PIC S9(07)V9(02) COMP-3. ! +744200* CUMUL PRIMES (POUR EXE CONCERNES) ! +744300 05 WS-4DCO-MD-CUM-INT PIC S9(09) COMP-3. ! +744400* CUMUL INTERETS PRIMES (EXE CONCERNES) ! +744500 05 WS-4DCO-MD-CUM-INT-D REDEFINES WS-4DCO-MD-CUM-INT ! +744600 PIC S9(07)V9(02) COMP-3. ! +744700* CUMUL INTERETS PRIMES (EXE CONCERNES) ! +744800 05 WS-4DCO-MD-TOT PIC S9(11) COMP-3. ! +744900* TOTAL GENERAL ! +745000 05 WS-4DCO-MD-TOT-D REDEFINES WS-4DCO-MD-TOT ! +745100 PIC S9(09)V9(02) COMP-3. ! +745200* TOTAL GENERAL ! +745300 05 WS-4DCO-MD-PRIM-ACC PIC S9(09) COMP-3. ! +745400* PRIME ACCEPTEE ! +745500 05 WS-4DCO-MD-PRIM-ACC-D REDEFINES WS-4DCO-MD-PRIM-ACC ! +745600 PIC S9(07)V9(02) COMP-3. ! +745700* PRIME ACCEPTEE ! +745800 05 WS-4DCO-MD-NBRE-EXER PIC S9(02). ! +745900* NB EXERCICES NON IMPOSABLES ! +746000 05 WS-4DCO-MD-NBRE-DEM PIC S9(02). ! +746100* NB ART 03 CONCERNES PAR DEMANDE GLOBALE ! +746200 05 WS-4DCO-MD-CD-REJET PIC X(002). ! +746300* CODE REJET ! +746400 05 WS-4DCO-MD-PRIM-RJ PIC S9(15) COMP-3. ! +746500* CUMUL PRIMES (POUR EXE CONCERNES) ! +746600 05 WS-4DCO-MD-PRIM-RJ-D REDEFINES WS-4DCO-MD-PRIM-RJ ! +746700 PIC S9(13)V9(02) COMP-3. ! +746800 05 FILLER PIC X(0049). ! +746900* ZONES DISPONIBLES ! +747000* ------------------------------------------------------ * ! +747100 ! +747200*================================================================ ! +747300*= APPLICATION : saisie ponctuelle de dde prime ! +747400*================================================================ ! +747500* ! +747600 03 WS-4DCO-PRM-PONCT REDEFINES WS-4DCO-PROGRAM. ! +747700* ============ ! +747800 ! +747900* ============== ! +748000* ------------------------------------------------------ * ! +748100* COMMAREA : PARAMETRAGE : GESTION DEMANDE PONCTUELLE -* ! +748200* LONGUEUR : 1800 PRIME ETAT * ! +748300* PREFIXE : WS-4DCO-4DPW * ! +748400* ------------------------------------------------------ * ! +748500* ! +748600* ZONES COMMUNES ! +748700* ZONE GROUPE POUR LE PROGRAMME TC4DPW0 ! +748800* ! +748900 ! +749000 05 WS-4DCO-4DPW-DET. ! +749100 ! +749200 15 WS-4DCO-4DPW-NO-PTN PIC 9(03). ! +749300 15 WS-4DCO-4DPW-NO-PRD-PTN PIC 9(03). ! +749400 15 WS-4DCO-4DPW-NO-CLI-PTN PIC 9(07). ! +749500 15 WS-4DCO-4DPW-NO-ORD-CTR PIC 9(02). ! +749600 15 WS-4DCO-4DPW-CD-PTN PIC X(05). ! +749700 15 WS-4DCO-4DPW-NUMCPT PIC X(12). ! +749800 15 WS-4DCO-4DPW-LIB-NOM PIC X(32). ! +749900 15 WS-4DCO-4DPW-LIB-PRENOM PIC X(32). ! +750000 15 WS-4DCO-4DPW-NOM-PATRO PIC X(32). ! +750100 15 WS-4DCO-4DPW-LIB-STR PIC X(32). ! +750200 15 WS-4DCO-4DPW-RUE1 PIC X(32). ! +750300 15 WS-4DCO-4DPW-RUE2 PIC X(32). ! +750400 15 WS-4DCO-4DPW-RUE3 PIC X(32). ! +750500 15 WS-4DCO-4DPW-RUE4 PIC X(32). ! +750600 15 WS-4DCO-4DPW-CDPOST PIC 9(05). ! +750700 15 WS-4DCO-4DPW-BURDIST PIC X(28). ! +750800 15 WS-4DCO-4DPW-DA-SCR. ! +750900 20 WS-4DCO-4DPW-SASCR PIC X(04). ! +751000 20 WS-4DCO-4DPW-MMSCR PIC X(02). ! +751100 20 WS-4DCO-4DPW-JJSCR PIC X(02). ! +751200 15 WS-4DCO-4DPW-DA-DDE. ! +751300 20 WS-4DCO-4DPW-SADEM PIC X(04). ! +751400 20 WS-4DCO-4DPW-MMDEM PIC X(02). ! +751500 20 WS-4DCO-4DPW-JJDEM PIC X(02). ! +751600 15 WS-4DCO-4DPW-COMPL PIC X(01). ! +751700 15 WS-4DCO-4DPW-NOSTR PIC X(06). ! +751800 15 WS-4DCO-4DPW-NBEXE PIC 9(02). ! +751900 15 WS-4DCO-4DPW-CDMTF PIC X(02). ! +752000 15 WS-4DCO-4DPW-MTPRIM PIC S9(13)V99 COMP-3. ! +752100 15 WS-4DCO-4DPW-MTITT PIC S9(13)V99 COMP-3. ! +752200 15 WS-4DCO-4DPW-TOP PIC X(01). ! +752300* indicateur de blocage ! +752400 15 WS-4DCO-4DPW-ACTION PIC X(01). ! +752500* ind. action (creation, modif, sup) ! +752600 15 WS-4DCO-4DPW-DDE PIC X(01). ! +752700* ind. prime ponctuelle deja demandee ! +752800 15 WS-4DCO-4DPW-COMPLM PIC X(01). ! +752900* ind. demande normale ou compl�mentaire ! +753000 15 WS-4DCO-4DPW-TOP-ENTREE PIC X(01). ! +753100* ind. pour affichage msg+entr�e avant validation ! +753200 15 WS-4DCO-4DPW-MTPRIM-OLD PIC S9(13)V99 COMP-3. ! +753300 15 FILLER PIC X(1423). ! +753400*================================================================ ! +753500*= APPLICATION : PRELEVEMENTS LIBERATOIRES = ! +753600*================================================================ ! +753700* ! +753800 03 WS-4DCO-PLIB REDEFINES WS-4DCO-PROGRAM. ! +753900* ============ ! +754000 ! +754100* ============== ! +754200* ------------------------------------------------------ * ! +754300* COMMAREA : PARAMETRAGE : PRELEV. LIB. POUR LA DGI * ! +754400* LONGUEUR : 1800 * ! +754500* PREFIXE : WS-4DCO-PLIB * ! +754600* ------------------------------------------------------ * ! +754700* ! +754800* ZONES COMMUNES ! +754900* ZONE GROUPE POUR LE PROGRAMME TC4DPN0 ! +755000* ! +755100 05 WS-4DCO-PLIB-MVT. ! +755200* MOUVEMENT AU FORMAT DGI 250 CARACTERES ! +755300 10 WS-4DCO-PLIB-CD-TY-MVT-DGI PIC X(3). ! +755400* CODE TYPE MOUVEMENT DGI ! +755500 10 WS-4DCO-PLIB-NO-PTN PIC 9(3). ! +755600* NUMERO PARTENAIRE ! +755700 10 WS-4DCO-PLIB-NO-PRD-PTN PIC 9(3). ! +755800* NUMERO PRODUIT PARTENAIRE ! +755900 10 WS-4DCO-PLIB-REF-GEODES. ! +756000* REFERENCE GEODES ! +756100 15 WS-4DCO-PLIB-NO-CLI-PTN PIC 9(7). ! +756200* NUMERO CLIENT PARTENAIRE ! +756300 15 WS-4DCO-PLIB-NO-ORD-CTR PIC 9(2). ! +756400* NUMERO ORDRE CONTRAT ! +756500 15 FILLER PIC X(9). ! +756600* ! +756700 10 WS-4DCO-PLIB-REF-PREVI7. ! +756800* REFERENCE PREVI 7 ! +756900 15 WS-4DCO-PLIB-NO-SER PIC X(4). ! +757000* NUMERO SERIE BON CAPITALISATION ! +757100 15 WS-4DCO-PLIB-NO-CNT PIC 9(7). ! +757200* NUMERO CARNET BON CAPITALISATION ! +757300 15 WS-4DCO-PLIB-NO-TIT PIC 9(7). ! +757400* NUMERO TITRE BON CAPITALISATION ! +757500 10 WS-4DCO-PLIB-DA-CRE-CRO PIC X(8). ! +757600* DATE CREATION CRO ! +757700 10 WS-4DCO-PLIB-HEU-CRE-CRO. ! +757800* HEURE CREATION CRO ! +757900 15 WS-4DCO-PLIB-HEU-CRE-HH PIC 9(2). ! +758000 15 WS-4DCO-PLIB-HEU-CRE-MM PIC 9(2). ! +758100 15 WS-4DCO-PLIB-HEU-CRE-SS PIC 9(2). ! +758200 10 WS-4DCO-PLIB-CD-CRO PIC X(3). ! +758300* CODE TYPE CRO ! +758400 10 WS-4DCO-PLIB-CD-APT-APLI PIC X(2). ! +758500* CODE APPARTENANCE APPLICATION ! +758600 10 WS-4DCO-PLIB-NOM-PATRO PIC X(32). ! +758700* NOM PATRONYMIQUE ! +758800 10 WS-4DCO-PLIB-CD-FIS PIC X(3). ! +758900* CODE FISCALITE PRELEVEMENT ! +759000 10 WS-4DCO-PLIB-CD-PTN PIC X(5). ! +759100* CODE PARTENAIRE ! +759200 10 WS-4DCO-PLIB-CD-PRD PIC X(2). ! +759300* CODE PRODUIT ! +759400 10 WS-4DCO-PLIB-NO-GEN-PRD PIC X(3). ! +759500* NUM�RO DE G�N�RATION DANS LE PRODUIT ! +759600 10 WS-4DCO-PLIB-REF-DOS PIC X(10). ! +759700* VALEUR REFERENCE DOSSIER ! +759800 10 WS-4DCO-PLIB-NO-GAM-PRD PIC 9(2). ! +759900* NUMERO GAMME PRODUIT ! +760000 10 WS-4DCO-PLIB-NO-TY-PRD PIC 9(2). ! +760100* NUMERO TYPE PRODUIT ! +760200 10 WS-4DCO-PLIB-NO-GEN-TY-PRD PIC X(3). ! +760300* NUMERO GENERATION TYPE PRODUIT ! +760400 10 WS-4DCO-PLIB-NO-SCR-BON-CAP PIC X(8). ! +760500* NUMERO SOUSCRIPTION BON CAPITALISATION ! +760600 10 WS-4DCO-PLIB-CD-SI PIC X(3). ! +760700* CODE S.I. ! +760800 10 WS-4DCO-PLIB-CD-ORIG-MVT PIC X(2). ! +760900* CODE ORIGINE MOUVEMENT ! +761000 10 WS-4DCO-PLIB-IDC-PTN-CM PIC X(1). ! +761100* INDICATEUR PARTENAIRE CREDIT-MUTUEL ! +761200 10 WS-4DCO-PLIB-OPT-ANY PIC X(1). ! +761300* INDICATEUR OPTION ANONYMAT ! +761400 10 WS-4DCO-PLIB-DA-SCR PIC X(8). ! +761500* DATE SOUSCRIPTION ! +761600 10 WS-4DCO-PLIB-DA-RAC. ! +761700* DATE OPERATION RACHAT ! +761800 15 WS-4DCO-PLIB-DA-RAC-A PIC X(4). ! +761900* DATE OPERATION ANNEE ! +762000 15 WS-4DCO-PLIB-DA-RAC-M PIC X(2). ! +762100* DATE OPERATION MOIS ! +762200 15 WS-4DCO-PLIB-DA-RAC-J PIC X(2). ! +762300* DATE OPERATION JOUR ! +762400 10 WS-4DCO-PLIB-DA-CRE-TEC PIC X(8). ! +762500* DATE CREATION TECHNIQUE ! +762600 10 WS-4DCO-PLIB-DA-AFF. ! +762700* DATE D'AFFECTATION PRODUIT COMPTABLE ! +762800 15 WS-4DCO-PLIB-DA-AFF-A PIC X(4). ! +762900* DATE AFFECTATION ANNEE ! +763000 15 WS-4DCO-PLIB-DA-AFF-M PIC X(2). ! +763100* DATE AFFECTATION MOIS ! +763200 15 WS-4DCO-PLIB-DA-AFF-J PIC X(2). ! +763300* DATE AFFECTATION JOUR ! +763400 10 WS-4DCO-PLIB-MT-CLO PIC S9(13)V9(2) COMP-3. ! +763500* MONTANT CLOTURE ! +763600 10 WS-4DCO-PLIB-MT-PLV PIC S9(13)V9(2) COMP-3. ! +763700* MONTANT PLUS-VALUE ! +763800 10 WS-4DCO-PLIB-PLV-LBL PIC S9(13)V9(2) COMP-3. ! +763900* MONTANT PRELEVEMENT LIBERATOIRE ! +764000 10 WS-4DCO-PLIB-PLV-SOC PIC S9(13)V9(2) COMP-3. ! +764100* MONTANT PRELEVEMENT SOCIALE ! +764200 10 WS-4DCO-PLIB-CTS-VLL PIC S9(13)V9(2) COMP-3. ! +764300* MONTANT COTISATION VIEILLESSE ! +764400 10 WS-4DCO-PLIB-MT-CSG PIC S9(13)V9(2) COMP-3. ! +764500* MONTANT C.S.G. ! +764600 10 WS-4DCO-PLIB-ASST-CRDS PIC S9(13)V9(2) COMP-3. ! +764700* MONTANT ASSIETTE CRDS ! +764800 10 WS-4DCO-PLIB-MT-ISF PIC S9(13)V9(2) COMP-3. ! +764900* MONTANT ISF ! +765000 10 WS-4DCO-PLIB-MT-RDS PIC S9(13)V9(2) COMP-3. ! +765100* MONTANT VERSEMENT RDS ! +765200 10 WS-4DCO-PLIB-CD-SNS-MVT PIC X. ! +765300* MONTANT VERSEMENT RDS ! +765400 10 WS-4DCO-PLIB-PAY-ISO PIC X(3). ! +765500* NUMERO PAYS ! +765600 10 WS-4DCO-PLIB-ASST-CSG PIC S9(13)V9(2) COMP-3. ! +765700* MONTANT ASSIETTE CSG ! +765800 10 WS-4DCO-PLIB-DATE-SAISIE PIC X(10). ! +765900* DATE saisie acompte ! +766000 10 FILLER PIC X(01). ! +766100* ! +766200 05 WS-4DCO-PLIB-LIB-PTN PIC X(32). ! +766300* LIBELLE DU PARTENAIRE ! +766400 05 WS-4DCO-PLIB-CAPO PIC X(5). ! +766500* CODE APPORTEUR PREVI-7 ! +766600 05 WS-4DCO-PLIB-LIB-PRD PIC X(32). ! +766700* LIBELLE DU PRODUIT ! +766800 05 WS-4DCO-PLIB-IDC-PRD-UNT PIC X. ! +766900* INDIC PRODUIT EN UC ! +767000 05 WS-4DCO-PLIB-TYP-CTR PIC X. ! +767100* TYPE DE CONTRAT ! +767200 88 CONTRAT-CMB VALUE 'C'. ! +767300 88 CONTRAT-EXT VALUE 'E'. ! +767400 88 CONTRAT-PR7 VALUE '7'. ! +767500* ! +767600* ZONES COMMUNES ! +767700* ZONE GROUPE POUR LE PROGRAMME TC4DPO0 ! +767800 ! +767900* SAUVEGARDE CLE DE LA DECLARATION SELECTIONNEE ! +768000 05 WS-4DCO-PLIB-SAUV-DECLA. ! +768100 10 WS-4DCO-PLIB-SAUV-CD-SI PIC X(3). ! +768200 10 WS-4DCO-PLIB-SAUV-TY-FCT PIC X(4). ! +768300 10 WS-4DCO-PLIB-SAUV-AA-DEC PIC X(4). ! +768400 10 WS-4DCO-PLIB-SAUV-MM-DEC PIC X(2). ! +768500 10 WS-4DCO-PLIB-SAUV-CD-DCR PIC 9. ! +768600* NUMERO D'ITEM SELECTIONNE ! +768700 05 WS-4DCO-PLIB-SAUV-ITEM PIC 99. ! +768800* ACTION SELECTIONNEE ! +768900 05 WS-4DCO-PLIB-TYP-ACTION PIC X. ! +769000 88 DETAIL-DECLA VALUE 'D'. ! +769100 88 VALID-DECLA VALUE 'V'. ! +769200 88 ANNUL-DECLA VALUE 'A'. ! +769300 ! +769400* ZONNE DE PAGINATION ! +769500 05 WS-4DCO-PLIB-NB-PAG-TS PIC 9(02). ! +769600 05 WS-4DCO-PLIB-PAGE-AREA PIC X(160). ! +769700 ! +769800* ZONE GROUPE POUR LE PROGRAMME TC4DPP0 ! +769900* ENREGITREMENT DECLARATION 2777 (=Y4DDGIDE) ! +770000 05 WS-4DCO-PLIB-DECLA. ! +770100 07 WS-4DCO-PLIB-DECL-CD-SI PIC X(3). ! +770200 07 WS-4DCO-PLIB-DECL-TY-FCT PIC X(4). ! +770300 07 WS-4DCO-PLIB-DECL-DA-DCR-A PIC X(4). ! +770400 07 WS-4DCO-PLIB-DECL-DA-DCR-M PIC X(2). ! +770500 07 WS-4DCO-PLIB-DECL-CD-DCR PIC 9(1). ! +770600 07 WS-4DCO-PLIB-DECL-NB-MVT-LOT PIC S9(7) COMP-3. ! +770700 07 WS-4DCO-PLIB-DECL-CD-STA PIC X(1). ! +770800 07 WS-4DCO-PLIB-DECL-CD-MODE-RGL PIC X(1). ! +770900 07 WS-4DCO-PLIB-DECL-DA-CRE-TEC PIC X(8). ! +771000 07 WS-4DCO-PLIB-DECL-DA-RGL PIC X(8). ! +771100 07 WS-4DCO-PLIB-DECL-MT-BASE-DE PIC S9(13)V9(2) COMP-3. ! +771200 07 WS-4DCO-PLIB-DECL-MT-DE PIC S9(13)V9(2) COMP-3. ! +771300 07 WS-4DCO-PLIB-DECL-MT-BASE-DF PIC S9(13)V9(2) COMP-3. ! +771400 07 WS-4DCO-PLIB-DECL-MT-DF PIC S9(13)V9(2) COMP-3. ! +771500 07 WS-4DCO-PLIB-DECL-MT-BASE-DG PIC S9(13)V9(2) COMP-3. ! +771600 07 WS-4DCO-PLIB-DECL-MT-DG PIC S9(13)V9(2) COMP-3. ! +771700 07 WS-4DCO-PLIB-DECL-MT-BASE-DH PIC S9(13)V9(2) COMP-3. ! +771800 07 WS-4DCO-PLIB-DECL-MT-DH PIC S9(13)V9(2) COMP-3. ! +771900 07 WS-4DCO-PLIB-DECL-MT-BASE-DI PIC S9(13)V9(2) COMP-3. ! +772000 07 WS-4DCO-PLIB-DECL-MT-DI PIC S9(13)V9(2) COMP-3. ! +772100 07 WS-4DCO-PLIB-DECL-MT-BASE-DJ PIC S9(13)V9(2) COMP-3. ! +772200 07 WS-4DCO-PLIB-DECL-MT-DJ PIC S9(13)V9(2) COMP-3. ! +772300 07 WS-4DCO-PLIB-DECL-MT-BASE-FJ PIC S9(13)V9(2) COMP-3. ! +772400 07 WS-4DCO-PLIB-DECL-MT-FJ PIC S9(13)V9(2) COMP-3. ! +772500 07 WS-4DCO-PLIB-DECL-MT-MM PIC S9(13)V9(2) COMP-3. ! +772600 07 WS-4DCO-PLIB-DECL-MT-OP PIC S9(13)V9(2) COMP-3. ! +772700 07 WS-4DCO-PLIB-DECL-MT-BASE-PO PIC S9(13)V9(2) COMP-3. ! +772800 07 WS-4DCO-PLIB-DECL-MT-PO PIC S9(13)V9(2) COMP-3. ! +772900 07 WS-4DCO-PLIB-DECL-MT-BASE-PP PIC S9(13)V9(2) COMP-3. ! +773000 07 WS-4DCO-PLIB-DECL-MT-PP PIC S9(13)V9(2) COMP-3. ! +773100 07 WS-4DCO-PLIB-DECL-MT-BASE-PR PIC S9(13)V9(2) COMP-3. ! +773200 07 WS-4DCO-PLIB-DECL-MT-PR PIC S9(13)V9(2) COMP-3. ! +773300 07 WS-4DCO-PLIB-DECL-MT-BASE-PS PIC S9(13)V9(2) COMP-3. ! +773400 07 WS-4DCO-PLIB-DECL-MT-PS PIC S9(13)V9(2) COMP-3. ! +773500 07 WS-4DCO-PLIB-DECL-MT-BASE-PT PIC S9(13)V9(2) COMP-3. ! +773600 07 WS-4DCO-PLIB-DECL-MT-PT PIC S9(13)V9(2) COMP-3. ! +773700 07 WS-4DCO-PLIB-DECL-MT-BASE-PU PIC S9(13)V9(2) COMP-3. ! +773800 07 WS-4DCO-PLIB-DECL-MT-PU PIC S9(13)V9(2) COMP-3. ! +773900 07 WS-4DCO-PLIB-DECL-MT-BASE-RS PIC S9(13)V9(2) COMP-3. ! +774000 07 WS-4DCO-PLIB-DECL-MT-RS PIC S9(13)V9(2) COMP-3. ! +774100 07 WS-4DCO-PLIB-DECL-MT-BASE-RT PIC S9(13)V9(2) COMP-3. ! +774200 07 WS-4DCO-PLIB-DECL-MT-RT PIC S9(13)V9(2) COMP-3. ! +774300 07 WS-4DCO-PLIB-DECL-MT-TB PIC S9(13)V9(2) COMP-3. ! +774400 07 WS-4DCO-PLIB-DECL-MT-SB REDEFINES ! +774500 WS-4DCO-PLIB-DECL-MT-TB PIC S9(13)V9(2) COMP-3. ! +774600 07 WS-4DCO-PLIB-DECL-MT-TC PIC S9(13)V9(2) COMP-3. ! +774700 07 WS-4DCO-PLIB-DECL-MT-TD PIC S9(13)V9(2) COMP-3. ! +774800 07 WS-4DCO-PLIB-DECL-MT-SC REDEFINES ! +774900 WS-4DCO-PLIB-DECL-MT-TD PIC S9(13)V9(2) COMP-3. ! +775000 07 WS-4DCO-PLIB-DECL-MT-TG PIC S9(13)V9(2) COMP-3. ! +775100 07 WS-4DCO-PLIB-DECL-MT-SF REDEFINES ! +775200 WS-4DCO-PLIB-DECL-MT-TG PIC S9(13)V9(2) COMP-3. ! +775300 07 WS-4DCO-PLIB-DECL-MT-QR PIC S9(13)V9(2) COMP-3. ! +775400 07 WS-4DCO-PLIB-DECL-MT-BASE-DK PIC S9(13)V9(2) COMP-3. ! +775500 07 WS-4DCO-PLIB-DECL-MT-DK PIC S9(13)V9(2) COMP-3. ! +775600 07 WS-4DCO-PLIB-DECL-MT-BASE-DL PIC S9(13)V9(2) COMP-3. ! +775700 07 WS-4DCO-PLIB-DECL-MT-DL PIC S9(13)V9(2) COMP-3. ! +775800 07 WS-4DCO-PLIB-DECL-MT-BASE-PW PIC S9(13)V9(2) COMP-3. ! +775900 07 WS-4DCO-PLIB-DECL-MT-PW PIC S9(13)V9(2) COMP-3. ! +776000 07 WS-4DCO-PLIB-DECL-MT-BASE-PX PIC S9(13)V9(2) COMP-3. ! +776100 07 WS-4DCO-PLIB-DECL-MT-PX PIC S9(13)V9(2) COMP-3. ! +776200 07 WS-4DCO-PLIB-DECL-MT-BASE-PY PIC S9(13)V9(2) COMP-3. ! +776300 07 WS-4DCO-PLIB-DECL-MT-PY PIC S9(13)V9(2) COMP-3. ! +776400 07 WS-4DCO-PLIB-DECL-MT-BASE-RV PIC S9(13)V9(2) COMP-3. ! +776500 07 WS-4DCO-PLIB-DECL-MT-RV PIC S9(13)V9(2) COMP-3. ! +776600 07 WS-4DCO-PLIB-DECL-MT-BASE-RW PIC S9(13)V9(2) COMP-3. ! +776700 07 WS-4DCO-PLIB-DECL-MT-RW PIC S9(13)V9(2) COMP-3. ! +776800 07 WS-4DCO-PLIB-DECL-MT-RX PIC S9(13)V9(2) COMP-3. ! +776900 07 WS-4DCO-PLIB-DECL-MT-RZ PIC S9(13)V9(2) COMP-3. ! +777000 07 WS-4DCO-PLIB-DECL-MT-BASE-DA PIC S9(13)V9(2) COMP-3. ! +777100 07 WS-4DCO-PLIB-DECL-MT-DA PIC S9(13)V9(2) COMP-3. ! +777200 07 WS-4DCO-PLIB-DECL-MT-BASE-DB PIC S9(13)V9(2) COMP-3. ! +777300 07 WS-4DCO-PLIB-DECL-MT-DB PIC S9(13)V9(2) COMP-3. ! +777400 07 WS-4DCO-PLIB-DECL-MT-BASE-PJ PIC S9(13)V9(2) COMP-3. ! +777500 07 WS-4DCO-PLIB-DECL-MT-PJ PIC S9(13)V9(2) COMP-3. ! +777600 07 WS-4DCO-PLIB-DECL-MT-BASE-PM PIC S9(13)V9(2) COMP-3. ! +777700 07 WS-4DCO-PLIB-DECL-MT-PM PIC S9(13)V9(2) COMP-3. ! +777800 07 WS-4DCO-PLIB-DECL-MT-PZ PIC S9(13)V9(2) COMP-3. ! +777900 07 WS-4DCO-PLIB-DECL-MT-RU PIC S9(13)V9(2) COMP-3. ! +778000 07 WS-4DCO-PLIB-DECL-MT-BASE-RR PIC S9(13)V9(2) COMP-3. ! +778100 07 WS-4DCO-PLIB-DECL-MT-RR PIC S9(13)V9(2) COMP-3. ! +778200 07 WS-4DCO-PLIB-DECL-MT-BASE-RY PIC S9(13)V9(2) COMP-3. ! +778300 07 WS-4DCO-PLIB-DECL-MT-RY PIC S9(13)V9(2) COMP-3. ! +778400 07 WS-4DCO-PLIB-DECL-MT-RA PIC S9(13)V9(2) COMP-3. ! +778500 07 FILLER PIC X(120). ! +778600* MONTANTS CALCULES POUR L'ECRAN C4DPP0 ! +778700 05 WS-4DCO-PLIB-MONT. ! +778800 07 WS-4DCO-PLIB-MONT-IL PIC S9(13)V9(2) COMP-3. ! +778900 07 WS-4DCO-PLIB-MONT-PQ PIC S9(13)V9(2) COMP-3. ! +779000 07 WS-4DCO-PLIB-BASE-PQ PIC S9(13)V9(2) COMP-3. ! +779100 07 WS-4DCO-PLIB-MONT-PV PIC S9(13)V9(2) COMP-3. ! +779200 07 WS-4DCO-PLIB-BASE-PV PIC S9(13)V9(2) COMP-3. ! +779300 07 WS-4DCO-PLIB-MONT-RU PIC S9(13)V9(2) COMP-3. ! +779400 07 WS-4DCO-PLIB-MONT-SA PIC S9(13)V9(2) COMP-3. ! +779500 07 WS-4DCO-PLIB-MONT-TA PIC S9(13)V9(2) COMP-3. ! +779600 07 WS-4DCO-PLIB-MONT-SB PIC S9(13)V9(2) COMP-3. ! +779700 07 WS-4DCO-PLIB-MONT-TB PIC S9(13)V9(2) COMP-3. ! +779800 07 WS-4DCO-PLIB-MONT-SC PIC S9(13)V9(2) COMP-3. ! +779900 07 WS-4DCO-PLIB-MONT-TC PIC S9(13)V9(2) COMP-3. ! +780000 07 WS-4DCO-PLIB-MONT-SD PIC S9(13)V9(2) COMP-3. ! +780100 07 WS-4DCO-PLIB-MONT-TD PIC S9(13)V9(2) COMP-3. ! +780200 07 WS-4DCO-PLIB-MONT-SE PIC S9(13)V9(2) COMP-3. ! +780300 07 WS-4DCO-PLIB-MONT-TE PIC S9(13)V9(2) COMP-3. ! +780400 07 WS-4DCO-PLIB-MONT-SF PIC S9(13)V9(2) COMP-3. ! +780500 07 WS-4DCO-PLIB-MONT-TF PIC S9(13)V9(2) COMP-3. ! +780600 07 WS-4DCO-PLIB-MONT-TG PIC S9(13)V9(2) COMP-3. ! +780700 07 WS-4DCO-PLIB-MONT-PFL PIC S9(13)V9(2) COMP-3. ! +780800* ne pas oublier de diminuer le filler en cas d'ajout ici ! +780900* ! +781000* ZONES COMMUNES ! +781100* ZONE GROUPE POUR LE PROGRAMME TC4DPY0 ! +781200 05 WS-4DCO-PLIB-MT-CSG-J PIC S9(13)V9(2) COMP-3. ! +781300* MONTANT C.S.G. janvier ! +781400 05 WS-4DCO-PLIB-ASST-CSG-J PIC S9(13)V9(2) COMP-3. ! +781500* MONTANT ASSIETTE CSG janvier ! +781600 05 WS-4DCO-PLIB-CD-SNS-MVT-J PIC X. ! +781700* MONTANT VERSEMENT RDS ! +781800 05 WS-4DCO-PLIB-VALIDATION PIC X. ! +781900* passage sur deuxieme ecran ! +782000 05 WS-4DCO-PLIB-MT-SOC PIC S9(13)V9(2) COMP-3. ! +782100* MONTANT pr�l�vement social d�cembre ! +782200 05 WS-4DCO-PLIB-ASST-SOC PIC S9(13)V9(2) COMP-3. ! +782300* MONTANT ASSIETTE prelevement social d�cembre ! +782400 05 WS-4DCO-PLIB-CD-SNS-MVT-SOC PIC X. ! +782500* MONTANT sens mvt prel soc d�cembre ! +782600 05 WS-4DCO-PLIB-MT-SOC-J PIC S9(13)V9(2) COMP-3. ! +782700* MONTANT pr�l�vement social janvier ! +782800 05 WS-4DCO-PLIB-ASST-SOC-J PIC S9(13)V9(2) COMP-3. ! +782900* MONTANT ASSIETTE prelevement social janvier ! +783000 05 WS-4DCO-PLIB-CD-SNS-MVT-SOC-J PIC X. ! +783100* MONTANT sens mvt prel soc janvier ! +783200* ===> ZONE GROUPE POUR LE PROGRAMME TC4DPN0 ! +783300 05 WS-4DCO-PLIB-MT-CSG97 PIC S9(13)V9(2) COMP-3. ! +783400* MONTANT C.S.G. de 1997 (3,4%) ! +783500 05 WS-4DCO-PLIB-ASST-CSG97 PIC S9(13)V9(2) COMP-3. ! +783600* MONTANT ASSIETTE CSG 1997 ! +783700 05 WS-4DCO-PLIB-ASST-PLV-SOC PIC S9(13)V9(2) COMP-3. ! +783800* MONTANT assiette prelev. soc. ! +783900 05 WS-4DCO-PLIB-ASST-PLV-LBL-8A PIC S9(13)V9(2) COMP-3. ! +784000* MONTANT ASSIETTE prelev. liber. � 7,5% ! +784100 05 WS-4DCO-PLIB-MT-CTB PIC S9(13)V9(2) COMP-3. ! +784200* MONTANT Contribution additionnelle ! +784300 05 WS-4DCO-PLIB-ASST-CTB PIC S9(13)V9(2) COMP-3. ! +784400* MONTANT ASSIETTE Contribution additionnelle ! +784500 05 WS-4DCO-PLIB-MT-CTB-J PIC S9(13)V9(2) COMP-3. ! +784600* MONTANT Contribution additionnelle janvier ! +784700 05 WS-4DCO-PLIB-ASST-CTB-J PIC S9(13)V9(2) COMP-3. ! +784800* MONTANT ASSIETTE Contribution additionnelle janvier ! +784900 05 WS-4DCO-PLIB-DATELIB PIC X(15). ! +785000* date acompte ! +785100 05 WS-4DCO-PLIB-CICS PIC X(04). ! +785200* type de cics ! +785300 ! +785400* ZONES DISPONIBLES ! +785500 05 FILLER PIC X(0287). ! +785600*================================================================ ! +785700*= APPLICATION : GESTION DES CONTRATS ENTREPRISE = ! +785800*================================================================ ! +785900* ! +786000 03 WS-4DCO-CTR-ENT REDEFINES WS-4DCO-PROGRAM. ! +786100* ============ ! +786200 ! +786300* ============== ! +786400* ------------------------------------------------------ * ! +786500* COMMAREA : GESTION DES CONTRATS ENTREPRISE * ! +786600* LONGUEUR : 1800 * ! +786700* PREFIXE : WS-4DCO-CTRE * ! +786800* ------------------------------------------------------ * ! +786900* ! +787000 05 WS-4DCO-CTRE-DA-SCR. ! +787100* DATE DE SOUSCRITPION ! +787200 10 WS-4DCO-CTRE-DA-SCR-JJ PIC X(2). ! +787300* DATE DE SOUSCRITPION - JOUR ! +787400 10 FILLER PIC X(1). ! +787500* SEPARATEUR DE DATE ! +787600 10 WS-4DCO-CTRE-DA-SCR-MM PIC X(2). ! +787700* DATE DE SOUSCRIPTION - MOIS ! +787800 10 FILLER PIC X(1). ! +787900* SEPARATEUR DE DATE ! +788000 10 WS-4DCO-CTRE-DA-SCR-SSAA PIC X(4). ! +788100* DATE DE SOUSCRIPTION - ANNEE ! +788200 05 WS-4DCO-CTRE-NO-STR-GTN PIC X(6). ! +788300* NUMERO STRUCTURE GESTIONNAIRE ! +788400 05 WS-4DCO-CTRE-LIB-STR-GTN PIC X(32). ! +788500* LIBELLE STRUCTURE GESTIONNAIRE ! +788600 05 WS-4DCO-CTRE-LIB-EFF-1 PIC X(50). ! +788700* LIEBLLE EFFECTIF 1 ! +788800 05 WS-4DCO-CTRE-LIB-EFF-2 PIC X(50). ! +788900* LIEBLLE EFFECTIF 2 ! +789000 05 WS-4DCO-CTRE-CD-CLC-IFC PIC X(1). ! +789100* MODE DE CALCUL INDEMNIT�S FIN CARRI�RE ! +789200 05 WS-4DCO-CTRE-TX-CTS-SAL-CO PIC S9(3)V99. ! +789300* TX COTISATION SALAIRE CONTRAT COLLECTIF ! +789400 05 WS-4DCO-CTRE-TX-CTS-TCH-A-CO PIC S9(3)V99. ! +789500* TX COTISATION TRANCHE A CONTRAT COLLECTIF ! +789600 05 WS-4DCO-CTRE-TX-CTS-TCH-B-CO PIC S9(3)V99. ! +789700* TX COTISATION TRANCHE B CONTRAT COLLECTIF ! +789800 05 WS-4DCO-CTRE-TX-CTS-TCH-C-CO PIC S9(3)V99. ! +789900* TX COTISATION TRANCHE C CONTRAT COLLECTIF ! +790000 05 WS-4DCO-CTRE-TX-CTS-SAL-IN PIC S9(3)V99. ! +790100* TX COTISATION SALAIRE CONTRAT INDIVIDUEL ! +790200 05 WS-4DCO-CTRE-TX-CTS-TCH-A-IN PIC S9(3)V99. ! +790300* TX COTISATION TRANCHE A CONTRAT INDIVIDUEL ! +790400 05 WS-4DCO-CTRE-TX-CTS-TCH-B-IN PIC S9(3)V99. ! +790500* TX COTISATION TRANCHE B CONTRAT INDIVIDUEL ! +790600 05 WS-4DCO-CTRE-TX-CTS-TCH-C-IN PIC S9(3)V99. ! +790700* TX COTISATION TRANCHE C CONTRAT INDIVIDUEL ! +790800 05 WS-4DCO-CTRE-MT-VER-INI PIC S9(13)V99. ! +790900* MONTANT VERSEMENT INITIAL ! +791000 05 WS-4DCO-CTRE-NB-A-RATR PIC S9(2). ! +791100* MONTANT VERSEMENT INITIAL ! +791200 05 WS-4DCO-CTRE-LIB-TY-CLA-1 PIC X(50). ! +791300* LIBELLE TYPE CLAUSE 1 ! +791400 05 WS-4DCO-CTRE-LIB-TY-CLA-2 PIC X(50). ! +791500* LIBELLE TYPE CLAUSE 2 ! +791600 05 WS-4DCO-CTRE-TM-STP PIC X(26). ! +791700* TIMESTAMP DE LA LECTURE CONTRAT ENTREPRISE ! +791800 05 WS-4DCO-CTRE-PAGE-AREA PIC X(198). ! +791900* SAUVEGARDE PAGE AREA START ! +792000 05 WS-4DCO-CTRE-NOM-USU-PSE PIC X(32). ! +792100* NOM + PRENOM OU ENSEIGNE ! +792200 05 WS-4DCO-CTRE-MONT PIC S9(15)V99 COMP-3. ! +792300* MONTANT SOLDE COMPTABLE ! +792400 05 WS-4DCO-CTRE-NBPAGES PIC 9(002). ! +792500* NOMBRE DE PAGES ! +792600 05 WS-4DCO-CTRE1-NBPAGES PIC 9(002). ! +792700* NOMBRE DE PAGES SUR TC4DRT0 ! +792800*-- DA3371 ! +792900*-- DATE DE MAJ DE L'ENCOURS GLOBAL ! +793000 05 WS-4DCO-CTRE-DATMAJ. ! +793100 10 WS-DA-MAJC-SA PIC X(004). ! +793200 10 WS-DA-MAJC-MM PIC X(002). ! +793300 10 WS-DA-MAJC-JJ PIC X(002). ! +793400*================================================================ ! +793500*= APPLICATION : VERSEMENT SUR CONTRATS LIES AU = ! +793600*= CONTRAT ENTREPRISE (TC4DRV0) = ! +793700*================================================================ ! +793800* ! +793900 03 WS-4DCO-4DRV REDEFINES WS-4DCO-PROGRAM. ! +794000* ============ ! +794100 ! +794200* ============== ! +794300* ------------------------------------------------------ * ! +794400* COMMAREA : VERSEMENT SUR LES CONTRATS LIES AU * ! +794500* CONTRAT ENTREPRISE * ! +794600* LONGUEUR : 1800 * ! +794700* PREFIXE : WS-4DCO-4DRV * ! +794800* ------------------------------------------------------ * ! +794900 05 WS-4DCO-4DRV-CPT-DOM. ! +795000* COMPTE DOM ! +795100 10 WS-4DCO-4DRV-CD-BQE PIC X(005). ! +795200* CODE BANQUE ! +795300 10 WS-4DCO-4DRV-CD-GUI PIC X(005). ! +795400* CODE GUICHET ! +795500 10 WS-4DCO-4DRV-NO-CPT PIC X(011). ! +795600* NUMERO COMPTE ! +795700 10 WS-4DCO-4DRV-CLE-RIB PIC X(002). ! +795800* CLE RIB ! +795900 05 WS-4DCO-4DRV-TX-FRAIS PIC 9(02)V9(03). ! +796000* TAUX DE FRAIS ! +796100 05 WS-4DCO-4DRV-DA-OPE. ! +796200* DATE D'OPERATION ! +796300 10 WS-4DCO-4DRV-DA-OPE-J PIC X(2). ! +796400* DATE D'OPERATION - JOUR ! +796500 10 FILLER PIC X(1). ! +796600* SEPARATEUR DE DATE ! +796700 10 WS-4DCO-4DRV-DA-OPE-M PIC X(2). ! +796800* DATE D'OPERATION - MOIS ! +796900 10 FILLER PIC X(1). ! +797000* SEPARATEUR DE DATE ! +797100 10 WS-4DCO-4DRV-DA-OPE-A PIC X(4). ! +797200* DATE D'OPERATION - ANNEE ! +797300 05 WS-4DCO-4DRV-DA-EFF. ! +797400* DATE D'EFFET ! +797500 10 WS-4DCO-4DRV-DA-EFF-J PIC X(2). ! +797600* DATE D'EFFET - JOUR ! +797700 10 FILLER PIC X(1). ! +797800* SEPARATEUR DE DATE ! +797900 10 WS-4DCO-4DRV-DA-EFF-M PIC X(2). ! +798000* DATE D'EFFET - MOIS ! +798100 10 FILLER PIC X(1). ! +798200* SEPARATEUR DE DATE ! +798300 10 WS-4DCO-4DRV-DA-EFF-A PIC X(4). ! +798400* DATE D'EFFET - ANNEE ! +798500 05 WS-4DCO-4DRV-MT-BRUT PIC S9(09)V9(02). ! +798600* MONTANT BRUT ! +798700 05 WS-4DCO-4DRV-LIB-CPT PIC X(13). ! +798800* LIBELLE COMPTE SUR ECRAN ! +798900 05 WS-4DCO-4DRV-NOM-TS-PARAM PIC X(08). ! +799000* NOM TS PARAMETRE PRODUIT ! +799100 05 WS-4DCO-4DRV-DA-EFF-CTR PIC X(08). ! +799200* DATE D'EFFET DU CONTRAT GEODES ! +799300 05 WS-4DCO-4DRV-DA-EFF-CLC PIC X(08). ! +799400* DATE D'EFFET CALCULEE ! +799500 05 WS-4DCO-4DRV-MTBRUT PIC S9(09)V9(02). ! +799600* MONTANT BRUT VERSEMENT ! +799700 05 WS-4DCO-4DRV-MTBRUT-C REDEFINES ! +799800 WS-4DCO-4DRV-MTBRUT ! +799900 PIC S9(11). ! +800000* MONTANT BRUT VERSEMENT ! +800100 05 WS-4DCO-4DRV-MTNET PIC S9(09)V9(02). ! +800200* MONTANT NET VERSEMENT ! +800300 05 WS-4DCO-4DRV-MTNET-C REDEFINES ! +800400 WS-4DCO-4DRV-MTNET ! +800500 PIC S9(11). ! +800600 05 WS-4DCO-4DRV-NOM-TS-VERS PIC X(08). ! +800700* NOM TS VERSEMENT ! +800800 05 WS-4DCO-4DRV-NB-OCC-RES PIC 9(03). ! +800900* NOMBRE D'ELEMENTS RESTITUES PAR TN00LIS ! +801000 05 WS-4DCO-4DRV-NO-STR-GTN-CTR PIC X(06). ! +801100* NUMERO STRUCTURE GESTIONNAIRE CONTRAT ! +801200 05 WS-4DCO-4DRV-NO-AGT-GTN-CTR PIC X(08). ! +801300* NUMERO AGENT GESTIONNAIRE CONTRAT ! +801400 05 WS-4DCO-4DRV-CD-TY-ECG-FNC PIC X(05). ! +801500* CODE TYPE ECHEANCE ! +801600 05 WS-4DCO-4DRV-ERREUR PIC X(01). ! +801700* INDICATEUR ERREUR BLOQUANTE ! +801800 88 ERREUR-BLOQUANTE VALUE 'O'. ! +801900* CODE MESSAGE ERREUR BLOQUANTE ! +802000 05 WS-4DCO-4DRV-CD-MES-ERR PIC X(06). ! +802100* LIBELLE COMPLEMENTAIRE MESSAGE ERREUR ! +802200 05 WS-4DCO-4DRV-LIB-CPL-MES PIC X(32). ! +802300*--DME DEBUT ! +802400* CODE IDENTIFIANT STOCK ! +802500 05 WS-4DCO-4DRV-CD-IDT-STK PIC X(03). ! +802600* DATE BASCULEMENT EFFECTIVE ! +802700 05 WS-4DCO-4DRV-DA-BSC-EFF PIC X(08). ! +802800* DATE BASCULEMENT EFFECTIVE ! +802900 05 WS-4DCO-4DRV-DA-OPE-DNR-RP PIC X(08). ! +803000*--DME FIN ! +803100*--DA3371 deb ! +803200 05 WS-4DCO-4DRV-NOM-USU-PSE PIC X(32). ! +803300* NOM + PRENOM OU ENSEIGNE ! +803400*--DA3371 fin ! +803500*================================================================ ! +803600*= APPLICATION : DADS2 : declaration des donnees sociales = ! +803700*= a la dgi = ! +803800*================================================================ ! +803900* ! +804000 03 WS-4DCO-DADS REDEFINES WS-4DCO-PROGRAM. ! +804100* ============ ! +804200 ! +804300* ============== ! +804400* ------------------------------------------------------ * ! +804500* COMMAREA : GESTION TC4DZF0 : SAISE MVT DADS2 * ! +804600* LONGUEUR : 1800 * ! +804700* PREFIXE : WS-4DCO-dads * ! +804800* ------------------------------------------------------ * ! +804900 05 WS-4DCO-DADS-MVT. ! +805000* DECLARATION D'UN MOUVEMENT ! +805100 10 WS-4DCO-DADS-CD-TY-FRN PIC X(2). ! +805200 10 WS-4DCO-DADS-NO-FRN PIC 9(8). ! +805300 10 WS-4DCO-DADS-A-DCR PIC 9(4). ! +805400 10 WS-4DCO-DADS-NO-ORD-MT PIC 9(3). ! +805500 10 WS-4DCO-DADS-LIB-NOM-FRN PIC X(30). ! +805600 10 WS-4DCO-DADS-LIB-PRN PIC X(20). ! +805700 10 WS-4DCO-DADS-LIB-RAI-SOC-FRN PIC X(50). ! +805800 10 WS-4DCO-DADS-LIB-RUE PIC X(32). ! +805900 10 WS-4DCO-DADS-LIB-CPL PIC X(32). ! +806000 10 WS-4DCO-DADS-CD-POST PIC X(5). ! +806100 10 WS-4DCO-DADS-LIB-BUR-DIST PIC X(26). ! +806200 10 WS-4DCO-DADS-MT-DGI-HN PIC S9(13)V99 COMP-3. ! +806300 10 WS-4DCO-DADS-MT-DGI-JT PIC S9(13)V99 COMP-3. ! +806400 10 WS-4DCO-DADS-FILLER PIC X(72). ! +806500 05 WS-4DCO-DADS-LIB-MAP PIC X(050). ! +806600* ! +806700 05 WS-4DCO-DADS-LIST. ! +806800* DONNEES UTILIS�ES POUR LA TRANSACTION DE LISTE 4DZG ! +806900 10 WS-4DCO-DADS-TOP-POS PIC X. ! +807000 10 WS-4DCO-DADS-TY-FOUSAIS PIC XX. ! +807100 10 WS-4DCO-DADS-NO-FOUSAIS PIC 9(8). ! +807200 10 WS-4DCO-DADS-AA-FOUSAIS PIC 9(4). ! +807300* ! +807400 05 FILLER PIC X(1435). ! +807500* ! +807600* ! +807700*================================================================ ! +807800*= APPLICATION : PAB : declaration a la DGI des mvts = ! +807900*= PAB (CSG et CRDS) = ! +808000*================================================================ ! +808100* ! +808200 03 WS-4DCO-PAB REDEFINES WS-4DCO-PROGRAM. ! +808300* ============ ! +808400* ! +808500* ============== ! +808600* ------------------------------------------------------ * ! +808700* COMMAREA : GESTION TC4DPZ0 : Saisie mvts PAB * ! +808800* LONGUEUR : 1800 * ! +808900* PREFIXE : WS-4DCO-PAB * ! +809000* ------------------------------------------------------ * ! +809100 05 WS-4DCO-PAB-DONNEES. ! +809200 10 WS-4DCO-PAB-CD-PTN PIC X(5). ! +809300 10 WS-4DCO-PAB-LIB-PTN PIC X(5). ! +809400 10 WS-4DCO-PAB-NO-PTN PIC 9(3). ! +809500 10 WS-4DCO-PAB-CD-APT-APLI PIC X(2). ! +809600 10 WS-4DCO-PAB-MT-CSG PIC S9(13)V99 COMP-3. ! +809700 10 WS-4DCO-PAB-MT-ASST-CSG PIC S9(13)V99 COMP-3. ! +809800 10 WS-4DCO-PAB-MT-VER-RDS PIC S9(13)V99 COMP-3. ! +809900 10 WS-4DCO-PAB-MT-ASST-CRDS PIC S9(13)V99 COMP-3. ! +810000 10 WS-4DCO-PAB-MT-PLV-SOC PIC S9(13)V99 COMP-3. ! +810100 10 WS-4DCO-PAB-MT-ASST-SOC PIC S9(13)V99 COMP-3. ! +810200 10 WS-4DCO-PAB-MT-CTS-VLL PIC S9(7)V99 COMP-3. ! +810300 10 WS-4DCO-PAB-MT-CTB PIC S9(13)V99 COMP-3. ! +810400 10 WS-4DCO-PAB-MT-ASST-CTB PIC S9(13)V99 COMP-3. ! +810500 10 WS-4DCO-PAB-MT-CSG-P7 PIC S9(13)V99 COMP-3. ! +810600 10 WS-4DCO-PAB-MT-ASST-CSG-P7 PIC S9(13)V99 COMP-3. ! +810700 10 WS-4DCO-PAB-MT-VER-RDS-P7 PIC S9(13)V99 COMP-3. ! +810800 10 WS-4DCO-PAB-MT-ASST-CRDS-P7 PIC S9(13)V99 COMP-3. ! +810900 10 WS-4DCO-PAB-MT-PLV-SOC-P7 PIC S9(13)V99 COMP-3. ! +811000 10 WS-4DCO-PAB-MT-ASST-SOC-P7 PIC S9(13)V99 COMP-3. ! +811100 10 WS-4DCO-PAB-MT-CTS-VLL-P7 PIC S9(7)V99 COMP-3. ! +811200 10 WS-4DCO-PAB-MT-CTB-P7 PIC S9(13)V99 COMP-3. ! +811300 10 WS-4DCO-PAB-MT-ASST-CTB-P7 PIC S9(13)V99 COMP-3. ! +811400 10 WS-4DCO-PAB-MODIF-PR PIC X(1). ! +811500 10 WS-4DCO-PAB-MODIF-P7 PIC X(1). ! +811600 05 FILLER PIC X(1644). ! +811700* ------------------------------------------------------ * ! +811800* ! +811900*================================================================ ! +812000*= APPLICATION : DIH : liste des mouvements dgi = ! +812100*================================================================ ! +812200* ! +812300 03 WS-4DCO-DIH REDEFINES WS-4DCO-PROGRAM. ! +812400* ============ ! +812500* ! +812600* ============== ! +812700* ------------------------------------------------------ * ! +812800* COMMAREA : GESTION TC4DQA0 et TC4DQB0 * ! +812900* Liste des mouvements DGI et detail * ! +813000* LONGUEUR : 1800 * ! +813100* PREFIXE : WS-4DCO-DIH * ! +813200* ------------------------------------------------------ * ! +813300 05 WS-4DCO-DIH-DONNEES. ! +813400 10 WS-4DCO-DIH-DA-CRE-CRO PIC X(8). ! +813500 10 WS-4DCO-DIH-CD-TY-MVT-DGI PIC X(3). ! +813600 10 WS-4DCO-DIH-DA-CRE-TEC PIC X(8). ! +813700 10 WS-4DCO-DIH-CD-TY-MVT-DGI-CL PIC X(3). ! +813800 10 WS-4DCO-DIH-NO-SEQ PIC X(6). ! +813900 10 WS-4DCO-DIH-NO-PTN PIC X(3). ! +814000 10 WS-4DCO-DIH-NO-PRD-PTN PIC X(3). ! +814100 10 WS-4DCO-DIH-REF-GEODES PIC X(18). ! +814200 10 WS-4DCO-DIH-DA-CRE-CRO-CL PIC X(8). ! +814300 10 WS-4DCO-DIH-HEU-CRE-CRO PIC X(6). ! +814400 10 WS-4DCO-DIH-CD-TY-CRO PIC X(3). ! +814500 10 WS-4DCO-DIH-TOP-POS PIC X(1). ! +814600 10 WS-4DCO-DIH-CD-ORI-ENR PIC X(1). ! +814700 10 WS-4DCO-DIH-TABLE OCCURS 15. ! +814800 15 WS-4DCO-DIH-NO-SEQ-TB PIC X(06). ! +814900 15 WS-4DCO-DIH-CD-ORI-ENR-TB PIC X(01). ! +815000 05 FILLER PIC X(1624). ! +815100* ------------------------------------------------------ * ! +815200*================================================================ ! +815300*= APPLICATION : parametrage des clauses = ! +815400*================================================================ ! +815500* ! +815600 03 WS-4DCO-CLA REDEFINES WS-4DCO-PROGRAM. ! +815700* ============ ! +815800* ! +815900* ============== ! +816000* ------------------------------------------------------ * ! +816100* COMMAREA : GESTION TC4GQA0, QB0, QC0, QE0, QF0 * ! +816200* LONGUEUR : 1800 * ! +816300* PREFIXE : WS-4DCO-CLA * ! +816400* ------------------------------------------------------ * ! +816500 05 WS-4DCO-CLA-DONNEES. ! +816600 10 WS-4DCO-CLA-TY-CLA-BNF PIC X(04). ! +816700* Type de clause b�n�ficiaire ! +816800 10 WS-4DCO-CLA-NO-GEN PIC 9(03). ! +816900* No de g�n�ration ! +817000 10 WS-4DCO-CLA-LIB-TY-CLA-BNF PIC X(32). ! +817100* Libell� type de clause ! +817200 10 WS-4DCO-CLA-IDC-TXT-STD PIC X(01). ! +817300* Indicateur texte standard ! +817400 10 WS-4DCO-CLA-IDC-CLA-NOMI PIC X(01). ! +817500* Indicateur Clause nominative ! +817600 10 WS-4DCO-CLA-IDC-ACC-BENF PIC X(01). ! +817700* Indicateur Acceptation b�n�fice ! +817800 10 WS-4DCO-CLA-IDC-AUT-DRG PIC X(01). ! +817900* Indicateur Autorisation D�r�gation ! +818000 10 WS-4DCO-CLA-CLE-REPO. ! +818100 15 WS-4DCO-CLA-TY-CLA-BNF-R PIC X(04). ! +818200* Repositionnement Type de clause b�n�ficiaire ! +818300 15 WS-4DCO-CLA-NO-GEN-R PIC 9(03). ! +818400* Repositionnement No de g�n�ration ! +818500 10 WS-4DCO-CLA-CPOSN PIC S9(04) COMP. ! +818600* Curseur positionnement ! +818700 10 WS-4DCO-CLA-PAGE-AREA PIC X(80). ! +818800* SAUVEGARDE PAGE AREA START ! +818900 10 WS-4DCO-CLA-TM-STP PIC X(26). ! +819000* TIME STAMP ! +819100 10 WS-4DCO-CLA-LA-TY-CLA-BNF PIC X(20). ! +819200* Libell� type de clause ! +819300 10 WS-4DCO-CLA-IDC-CLA-NTR PIC X(01). ! +819400* Indicateur Clause notaire ! +819500 10 WS-4DCO-CLA-IDC-CLA-DMB PIC X(01). ! +819600* Indicateur Clause d�membrement ! +819700 10 WS-4DCO-CLA-IDC-CLA-DFT PIC X(01). ! +819800* Indicateur Clause par d�faut ! +819900 10 WS-4DCO-CLA-IDC-CLA-TUT PIC X(01). ! +820000* Indicateur Clause mineur majeur sous tutelle ! +820100* ! +820200 05 FILLER PIC X(618). ! +820300* lien clause / autres applications ! +820400 05 WS-4DCO-LIEN-CLA PIC X(1000). ! +820500* APPLICATION : parametrage Clause / type de produit ! +820600 05 WS-4DCO-4DDY-CLA REDEFINES WS-4DCO-LIEN-CLA. ! +820700* ================= ! +820800 10 WS-4DCO-4DDY-TYPRD PIC S9(02) COMP-3. ! +820900* NUMERO TYPE DE PRODUIT ! +821000 10 WS-4DCO-4DDY-LIB-TY-PRD PIC X(32). ! +821100* LIBELLE TYPE DE PRODUIT ! +821200 10 WS-4DCO-4DDY-NOGEN PIC X(03). ! +821300* NUMERO DE GENERATION ! +821400 10 WS-4DCO-4DDY-DA-VAL-DBT PIC X(10). ! +821500* DATE DEBUT ! +821600 10 WS-4DCO-4DDY-DA-FIN-VAL PIC X(10). ! +821700* DATE FIN ! +821800 10 WS-4DCO-4DDY-NO-GAM-PRD PIC S9(02) COMP-3. ! +821900* NUMERO GAMME DE PRODUIT ! +822000 10 WS-4DCO-4DDY-TX-MIN-ITT-GAR PIC X(06). ! +822100* Taux minimum de garde ! +822200 10 WS-4DCO-4DDY-TX-AJU-CTS PIC X(06). ! +822300* Taux ajustement contrat ! +822400 10 WS-4DCO-4DDY-PRC-PAB-RCH PIC X(07). ! +822500* Pourcent. PAB Rachat ! +822600 10 WS-4DCO-4DDY-PRC-PAB-SIN PIC X(07). ! +822700* Pourcent. PAB Sinistre ! +822800 10 WS-4DCO-4DDY-DEL-SAI-RNO PIC S9(02) COMP-3. ! +822900* Delai de renonciation ! +823000 10 WS-4DCO-4DDY-MT-PLAF-VER-CTR PIC X(10). ! +823100* Mtant max contrat ! +823200 10 WS-4DCO-4DDY-MT-CTRL-OPE-DTX PIC X(16). ! +823300* Mtant controle op�ration insolite ! +823400 10 WS-4DCO-4DDY-MT-MIN-CTRL-CLI PIC X(16). ! +823500* Mtant controle client ! +823600 10 WS-4DCO-4DDY-MT-MIN-VER-A PIC X(10). ! +823700* Mtant minimum annuel ouvrant droit � d�duction fiscale ! +823800 10 WS-4DCO-4DDY-MT-MAX-VER-A PIC X(10). ! +823900* Mtant maximum annuel ouvrant droit � d�duction fiscale ! +824000 10 WS-4DCO-4DDY-TX-SML-PAB PIC X(06). ! +824100* Taux simulation PAB ! +824200 10 WS-4DCO-4DDY-TX-DNR-PAB PIC X(08). ! +824300* Taux derniere PAB ! +824400 10 WS-4DCO-4DDY-TX-DNR-PAB-MI PIC X(08). ! +824500* Taux derniere PAB ! +824600 10 WS-4DCO-4DDY-TX-CRDS PIC X(07). ! +824700* Taux CRDS ! +824800 10 WS-4DCO-4DDY-TX-CSG PIC X(07). ! +824900* Taux CSG ! +825000 10 WS-4DCO-4DDY-TX-CSG-97 PIC X(07). ! +825100* Taux CSG 97 ! +825200 10 WS-4DCO-4DDY-DA-PAB-A-MI PIC X(10). ! +825300* Date PAB minitel ! +825400 10 WS-4DCO-4DDY-CD-TY-TX-RMN PIC X(01). ! +825500* Code Type taux min. ! +825600 10 WS-4DCO-4DDY-CD-TY-RCH-AUT PIC X(10). ! +825700* Code Type rachat automatique ! +825800 10 WS-4DCO-4DDY-CD-TY-VER-AUT PIC X(10). ! +825900* Code Type versement automatique ! +826000 10 WS-4DCO-4DDY-CD-PER-VER-AUT PIC X(10). ! +826100* Code p�riodicit� versement automatique ! +826200 10 WS-4DCO-4DDY-DUR-CTR PIC X(04). ! +826300* Dur�e contrat ! +826400 10 WS-4DCO-4DDY-CD-FIS-AUT PIC X(10). ! +826500* Code fiscal autoris� ! +826600 10 WS-4DCO-4DDY-CD-MTF-RCH-AUT PIC X(10). ! +826700* Code motif rachat autoris� ! +826800 10 WS-4DCO-4DDY-IDC-NTS PIC X(01). ! +826900* Indicateur nantissement ! +827000 10 WS-4DCO-4DDY-CD-TY-PSE PIC X(01). ! +827100* Code type personne ! +827200 10 WS-4DCO-4DDY-IDC-UNI-PRD PIC X(01). ! +827300* Unicit� type produit ! +827400 10 WS-4DCO-4DDY-CD-CAT-FIS PIC X(02). ! +827500* Code cat�gorie fiscale ! +827600 10 WS-4DCO-4DDY-CD-TAB-DU PIC X(02). ! +827700* Code dur�e ! +827800 10 WS-4DCO-4DDY-IDC-PRD-UNT-CPT PIC X(01). ! +827900* indicateur P.U.C ! +828000 10 WS-4DCO-4DDY-IDC-ACTION PIC X(01). ! +828100 88 WS-4DCO-4DDY-CREATION VALUE 'C'. ! +828200* indicateur action ! +828300 10 WS-4DCO-4DDY-IDC-PRD-pd PIC X(01). ! +828400* indicateur type produit eligible previ-duo trans ! +828500 10 FILLER PIC X(733). ! +828600* ! +828700 ! +828800 03 WS-4DCO-PMO-4DFL REDEFINES WS-4DCO-PROGRAM. ! +828900* ================== ! +829000* ------------------------------------------------------ * ! +829100* COMMAREA : MODIFICATION MONTANT PMO/VERST BRUT * ! +829200* LONGUEUR : 1800 * ! +829300* PREFIXE : WS-4DCO-4DFL- * ! +829400* ------------------------------------------------------ * ! +829500 ! +829600 05 WS-4DCO-4DFL-TAB-STO-GEST OCCURS 10. ! +829700 07 WS-4DCO-4DFL-PMO-AV PIC S9(13)V9(2) COMP-3. ! +829800 07 WS-4DCO-4DFL-PMO-AP PIC S9(13)V9(2) COMP-3. ! +829900 07 WS-4DCO-4DFL-FLAG-MODIF-PMO PIC X(01). ! +830000 07 WS-4DCO-4DFL-MT-BRT-VER-AV PIC S9(13)V9(2) COMP-3. ! +830100 07 WS-4DCO-4DFL-MT-BRT-VER-AP PIC S9(13)V9(2) COMP-3. ! +830200 07 WS-4DCO-4DFL-FLAG-MODIF-VER PIC X(01). ! +830300 07 WS-4DCO-4DFL-FLAG-EXIST-STOCK PIC X(01). ! +830400 05 WS-4DCO-4DFL-TAB-STO-FISCA OCCURS 2. ! +830500 07 WS-4DCO-4DFL-MT-RCH-NET-AV PIC S9(13)V9(2) COMP-3. ! +830600 07 WS-4DCO-4DFL-MT-RCH-NET-AP PIC S9(13)V9(2) COMP-3. ! +830700 07 WS-4DCO-4DFL-FLAG-MODIF-RN PIC X(01). ! +830800 07 WS-4DCO-4DFL-MT-PV-AV PIC S9(13)V9(2) COMP-3. ! +830900 07 WS-4DCO-4DFL-MT-PV-AP PIC S9(13)V9(2) COMP-3. ! +831000 07 WS-4DCO-4DFL-FLAG-MODIF-PV PIC X(01). ! +831100 07 WS-4DCO-4DFL-FLAG-EXIST-FISCA PIC X(01). ! +831200 05 WS-4DCO-4DFL-MT-PMO-TOT-AV PIC S9(15) COMP-3. ! +831300 05 WS-4DCO-4DFL-MT-PMO-TOT-R REDEFINES ! +831400 WS-4DCO-4DFL-MT-PMO-TOT-AV PIC S9(13)V9(2) COMP-3. ! +831500 05 WS-4DCO-4DFL-MT-PMO-TOT-AP PIC S9(13)V9(2) COMP-3. ! +831600 05 WS-4DCO-4DFL-TAB-EXIST-STOC OCCURS 6. ! +831700 07 WS-4DCO-4DFL-FLAG-EXIST-STOC PIC X(01). ! +831800 05 FILLER PIC X(1358). ! +831900* ZONES DISPONIBLES ! +832000 ! +832100 03 WS-4DCO-4DDU REDEFINES WS-4DCO-PROGRAM. ! +832200* ============ ! +832300* ! +832400* ============== ! +832500* ------------------------------------------------------ * ! +832600* COMMAREA : GESTION TC4DDU0, DDZ * ! +832700* LONGUEUR : 1800 * ! +832800* PREFIXE : WS-4DCO-4DDU * ! +832900* ------------------------------------------------------ * ! +833000 05 WS-4DCO-4DDU-DONNEES. ! +833100 10 WS-4DCO-4DDU-CD-RGL-SURA PIC X(06). ! +833200* Code r�gle param�trage ! +833300 10 WS-4DCO-4DDU-LIB-RGL-SURA PIC X(32). ! +833400* Code r�gle param�trage ! +833500 10 WS-4DCO-4DDU-CLE-REPO. ! +833600 15 WS-4DCO-4DDU-CD-RGL-SURA-R PIC X(06). ! +833700* Repositionnement Code R�gle param�trage ! +833800 10 WS-4DCO-4DDU-CPOSN PIC S9(04) COMP. ! +833900* Curseur positionnement ! +834000 10 WS-4DCO-4DDU-PAGE-AREA PIC X(80). ! +834100* SAUVEGARDE PAGE AREA START ! +834200* ! +834300 05 FILLER PIC X(1674). ! +834400 03 WS-4DCO-4DDV REDEFINES WS-4DCO-PROGRAM. ! +834500* ============ ! +834600* ! +834700* ============== ! +834800* ------------------------------------------------------ * ! +834900* COMMAREA : GESTION TC4DDV0 * ! +835000* LONGUEUR : 1800 * ! +835100* PREFIXE : WS-4DCO-4DDV * ! +835200* ------------------------------------------------------ * ! +835300 05 WS-4DCO-4DDV-DONNEES. ! +835400 10 WS-4DCO-4DDV-CD-EVE-SURA PIC X(07). ! +835500* Code �v�nement param�trage ! +835600 10 WS-4DCO-4DDV-LIB-EVE-SURA PIC X(32). ! +835700* libell� �v�nement param�trage ! +835800 10 WS-4DCO-4DDV-LA-EVE-SURA PIC X(20). ! +835900* libell� court �v�nement param�trage ! +836000 10 WS-4DCO-4DDV-CLE-REPO. ! +836100 15 WS-4DCO-4DDV-CD-EVE-SURA-R PIC X(07). ! +836200* Repositionnement Code �v�nement param�trage ! +836300 10 WS-4DCO-4DDV-PAGE-AREA PIC X(80). ! +836400* SAUVEGARDE PAGE AREA START ! +836500 10 WS-4DCO-4DDV-CD-EVE-SURA-SE PIC X(07). ! +836600* Code �v�nement param�trage ! +836700* ! +836800 05 FILLER PIC X(1647). ! +836900 03 WS-4DCO-4DDW REDEFINES WS-4DCO-PROGRAM. ! +837000* ============ ! +837100* ! +837200* ============== ! +837300* ------------------------------------------------------ * ! +837400* COMMAREA : GESTION TC4DDW0, DDF * ! +837500* LONGUEUR : 1800 * ! +837600* PREFIXE : WS-4DCO-4DDW * ! +837700* ------------------------------------------------------ * ! +837800 05 WS-4DCO-4DDW-DONNEES. ! +837900 10 WS-4DCO-4DDW-CD-EVE-SURA PIC X(07). ! +838000* Code Ev�nement param�trage ! +838100 10 WS-4DCO-4DDW-LIB-EVE PIC X(32). ! +838200* Libell� �v�nement ! +838300 10 WS-4DCO-4DDW-CD-RGL-SURA PIC X(06). ! +838400* Code r�gle param�trage ! +838500 10 WS-4DCO-4DDW-LIB-RGL PIC X(32). ! +838600* Libell� R�gle ! +838700 10 WS-4DCO-4DDW-NO-ORD-APLI PIC 9(03). ! +838800* Num�ro d'ordre apli ! +838900 10 WS-4DCO-4DDW-CLE-REPO. ! +839000 15 WS-4DCO-4DDW-CD-EVE-SURA-R PIC X(07). ! +839100* Repositionnement Code Ev�nement param�trage ! +839200 10 WS-4DCO-4DDW-CPOSN PIC S9(04) COMP. ! +839300* Curseur positionnement ! +839400 10 WS-4DCO-4DDW-PAGE-AREA PIC X(80). ! +839500* SAUVEGARDE PAGE AREA START ! +839600 10 WS-4DCO-4DDW-CD-RGL-SEL PIC X(06). ! +839700* Code r�gle s�lectionn� ! +839800 10 WS-4DCO-4DDW-SCAT-EVE PIC X(04). ! +839900* sous cat�gorie �v�nement ! +840000 10 WS-4DCO-4DDW-SCAT-RGL PIC X(04). ! +840100* sous cat�gorie r�gle ! +840200 10 WS-4DCO-4DDW-SCAT-DFT PIC X(04). ! +840300* sous cat�gorie par d�faut ! +840400 10 WS-4DCO-4DDW-CD-EVE-SURA-GR PIC X(07). ! +840500* Code Ev�nement groupe ! +840600 10 WS-4DCO-4DDW-IDC-DET PIC X(01). ! +840700* indicateur d�tail ! +840800 10 WS-4DCO-4DDW-CAT-EVE PIC X(04). ! +840900* cat�gorie �v�nement ! +841000* ! +841100 05 FILLER PIC X(1601). ! +841200* ! +841300 03 WS-4DCO-4DD1 REDEFINES WS-4DCO-PROGRAM. ! +841400* ============ ! +841500* ! +841600* ============== ! +841700* ------------------------------------------------------ * ! +841800* COMMAREA : GESTION TC4DD10 * ! +841900* LONGUEUR : 1800 * ! +842000* PREFIXE : WS-4DCO-4DD1 * ! +842100* ------------------------------------------------------ * ! +842200 05 WS-4DCO-4DD1-DONNEES. ! +842300 10 WS-4DCO-4DD1-DA-DEB-PER PIC X(08). ! +842400* Date D�but p�riode ! +842500 10 WS-4DCO-4DD1-DA-FIN-PER PIC X(08). ! +842600* Date Fin p�riode ! +842700 10 WS-4DCO-4DD1-CD-ACT PIC X(01). ! +842800* Code action ! +842900 10 WS-4DCO-4DD1-CD-TY-ENR PIC X(01). ! +843000* Code Type Enregistrement ! +843100 10 WS-4DCO-4DD1-WK-ZON-CLE PIC X(50). ! +843200* Argument cl� ! +843300 10 WS-4DCO-4DD1-TM-STP PIC X(26). ! +843400* Time stamp pass� ! +843500 10 WS-4DCO-4DD1-NO-SAL-MAJ PIC X(08). ! +843600* Num�ro Sal. Maj ! +843700 10 WS-4DCO-4DD1-CPOSN PIC S9(04) COMP. ! +843800* Curseur positionnement ! +843900 10 WS-4DCO-4DD1-PAGE-AREA PIC X(80). ! +844000* SAUVEGARDE PAGE AREA START ! +844100 10 WS-4DCO-4DD1-DA-DEB-PER-SEL PIC X(08). ! +844200* Date D�but p�riode ! +844300 10 WS-4DCO-4DD1-DA-FIN-PER-SEL PIC X(08). ! +844400* Date Fin p�riode ! +844500 10 WS-4DCO-4DD1-CD-ACT-SEL PIC X(01). ! +844600* Code Action ! +844700 10 WS-4DCO-4DD1-CD-TY-ENR-SEL PIC X(01). ! +844800* Code type enregist ! +844900 10 WS-4DCO-4DD1-NO-SAL-MAJ-SEL PIC X(06). ! +845000* Code salarie ! +845100 05 FILLER PIC X(1592). ! +845200* ! +845300 03 WS-4DCO-4DD7 REDEFINES WS-4DCO-PROGRAM. ! +845400* ============ ! +845500* ! +845600* ============== ! +845700* ------------------------------------------------------ * ! +845800* COMMAREA : GESTION TC4DD70 * ! +845900* LONGUEUR : 1800 * ! +846000* PREFIXE : WS-4DCO-4DD7 * ! +846100* ------------------------------------------------------ * ! +846200 05 WS-4DCO-4DD7-DONNEES. ! +846300 10 WS-4DCO-4DD7-CD-IMPR PIC X(08). ! +846400* Code imprimante ! +846500 05 FILLER PIC X(1792). ! +846600* ! +846700 03 WS-4DCO-4DG1 REDEFINES WS-4DCO-PROGRAM. ! +846800* ============ ! +846900* ! +847000* ============== ! +847100* ------------------------------------------------------ * ! +847200* COMMAREA : GESTION TC4DG10 * ! +847300* LONGUEUR : 1800 * ! +847400* PREFIXE : WS-4DCO-4DG1 * ! +847500* ------------------------------------------------------ * ! +847600 05 WS-4DCO-4DG1-ZON-CLE. ! +847700 07 WS-4DCO-4DG1-DONNEES. ! +847800 10 WS-4DCO-4DG1-NO-RGM-GE PIC 9(03). ! +847900 10 WS-4DCO-4DG1-A-REF PIC 9(04). ! +848000* TYPE D'ACTION SUR L'ECRAN MC4DG10 ! +848100 07 WS-4DCO-4DG1-SAV-ACTION PIC X. ! +848200 88 4DG1-CREAT VALUE 'C'. ! +848300 88 4DG1-MODIF VALUE 'M'. ! +848400 88 4DG1-SUPP VALUE 'A'. ! +848500 88 4DG1-VISU VALUE 'D'. ! +848600* ! +848700 05 WS-4DCO-4DG1-NB-OCC-RES PIC 9(04). ! +848800 05 WS-4DCO-4DG1-SAUV-PAGE-AREA PIC X(198). ! +848900 05 WS-4DCO-4DG1-NB-PAGES PIC 9(02). ! +849000 05 WS-4DCO-4DG1-NO-RGM-GE-SEL PIC S9(03) COMP-3. ! +849100 05 WS-4DCO-4DG1-A-REF-SEL PIC X(04). ! +849200 05 FILLER PIC X(1582). ! +849300* ! +849400 03 WS-4DCO-4DG2 REDEFINES WS-4DCO-PROGRAM. ! +849500* ============ ! +849600* ! +849700* ====m========= ! +849800* ------------------------------------------------------ * ! +849900* COMMAREA : GESTION TC4DG20 * ! +850000* LONGUEUR : 1800 * ! +850100* PREFIXE : WS-4DCO-4DG2 * ! +850200* ------------------------------------------------------ * ! +850300 05 WS-4DCO-4DG2-DONNEES. ! +850400 ! +850500 10 WS-4DCO-4DG2-ZON-CLE. ! +850600 15 WS-4DCO-4DG2-NO-RGM-GE PIC 9(03). ! +850700* NUMERO REGIME ! +850800 15 WS-4DCO-4DG2-A-REF PIC 9(04). ! +850900* ANNEE REFERENCE ! +851000 15 WS-4DCO-4DG2-SAV-ACTION PIC X. ! +851100 88 4DG2-CREAT VALUE 'C'. ! +851200 88 4DG2-MODIF VALUE 'M'. ! +851300 88 4DG2-SUPP VALUE 'A'. ! +851400 88 4DG2-VISU VALUE 'D'. ! +851500 ! +851600 10 WS-4DCO-4DG2-ZON-APLI. ! +851700 15 WS-4DCO-4DG2-LIB-RGM-GE PIC X(32). ! +851800* LIBELLE REGIME ! +851900 15 WS-4DCO-4DG2-TX-MIN-ITT-GAR ! +852000 PIC S9(2)V9(3) COMP-3. ! +852100* TAUX MINIMUM INT�R�TS GARANTIS ! +852200 15 WS-4DCO-4DG2-TX-PAB PIC S9(2)V9(3) COMP-3. ! +852300* TAUX PAB ! +852400 15 WS-4DCO-4DG2-TX-FRS-GTN-AN ! +852500 PIC S9(2)V9(3) COMP-3. ! +852600* TAUX FRAIS GESTION ! +852700 15 WS-4DCO-4DG2-TX-FRS-STD-ENT ! +852800 PIC S9(2)V9(3) COMP-3. ! +852900* TAUX FRAIS STANDARD ENTREE ! +853000 15 WS-4DCO-4DG2-TX-RBT-SR ! +853100 PIC S9(3)V9(4) COMP-3. ! +853200* TAUX REMBOURSEMENT ! +853300 15 WS-4DCO-4DG2-TX-FRS-ARBT ! +853400 PIC S9(3)V9(4) COMP-3. ! +853500* TAUX FRAIS ARBITRAGE ! +853600 15 WS-4DCO-4DG2-MT-FOF-GLB ! +853700 PIC S9(13)V9(2) COMP-3. ! +853800* MONTANT FORFAITAIRE FRAIS ARBITRAGE ! +853900 15 WS-4DCO-4DG2-MT-MIN-ARBT ! +854000 PIC S9(13)V9(2) COMP-3. ! +854100* MONTANT MINIMUM PAR ARBITRAGE ! +854200 15 WS-4DCO-4DG2-MT-MX-ARBT ! +854300 PIC S9(13)V9(2) COMP-3. ! +854400* MONTANT MAXIMUM PAR ARBITRAGE ! +854500* ! +854600 10 WS-4DCO-4DG2-ZON-SAV. ! +854700 15 WS-4DCO-4DG2-SV-LIB-RGM-GE PIC X(32). ! +854800* LIBELLE REGIME ! +854900 15 WS-4DCO-4DG2-SV-TX-MIN-ITT-GAR ! +855000 PIC S9(2)V9(3) COMP-3. ! +855100* TAUX MINIMUM INT�R�TS GARANTIS ! +855200 15 WS-4DCO-4DG2-SV-TX-PAB ! +855300 PIC S9(2)V9(3) COMP-3. ! +855400* TAUX PAB ! +855500 15 WS-4DCO-4DG2-SV-TX-FRS-GTN-AN ! +855600 PIC S9(2)V9(3) COMP-3. ! +855700* TAUX FRAIS GESTION ! +855800 15 WS-4DCO-4DG2-SV-TX-FRS-STD-ENT ! +855900 PIC S9(2)V9(3) COMP-3. ! +856000* TAUX FRAIS STANDARD ENTREE ! +856100 15 WS-4DCO-4DG2-SV-TX-RBT-SR ! +856200 PIC S9(3)V9(4) COMP-3. ! +856300* TAUX REMBOURSEMENT ! +856400 15 WS-4DCO-4DG2-SV-TX-FRS-ARBT ! +856500 PIC S9(3)V9(4) COMP-3. ! +856600* TAUX FRAIS ARBITRAGE ! +856700 15 WS-4DCO-4DG2-SV-MT-FOF-GLB ! +856800 PIC S9(13)V9(2) COMP-3. ! +856900* MONTANT FORFAITAIRE FRAIS ARBITRAGE ! +857000 15 WS-4DCO-4DG2-SV-MT-MIN-ARBT ! +857100 PIC S9(13)V9(2) COMP-3. ! +857200* MONTANT MINIMUM PAR ARBITRAGE ! +857300 15 WS-4DCO-4DG2-SV-MT-MX-ARBT ! +857400 PIC S9(13)V9(2) COMP-3. ! +857500* MONTANT MAXIMUM PAR ARBITRAGE ! +857600 ! +857700 10 WS-4DCO-4DG2-LIB-OPE PIC X(30). ! +857800* LIBELLE OPERATION ! +857900 ! +858000 05 FILLER PIC X(1610). ! +858100* ! +858200 03 WS-4DCO-4DTP REDEFINES WS-4DCO-PROGRAM. ! +858300* ============ ! +858400* ! +858500* ============== ! +858600* ------------------------------------------------------ * ! +858700* COMMAREA : GESTION TC4DTP0 * ! +858800* LONGUEUR : 1800 * ! +858900* PREFIXE : WS-4DCO-4DTP * ! +859000* ------------------------------------------------------ * ! +859100 05 WS-4DCO-4DTP-DONNEES. ! +859200 15 WS-4DCO-4DTP-TYPRD PIC S9(02) COMP-3. ! +859300* NUMERO TYPE DE PRODUIT ! +859400 15 WS-4DCO-4DTP-LIB-TYPRD PIC X(32). ! +859500* LIBELLE TYPE DE PRODUIT ! +859600 15 WS-4DCO-4DTP-NOGEN PIC X(03). ! +859700* NUMERO DE GENERATION ! +859800 15 WS-4DCO-4DTP-CDGAR PIC X(02). ! +859900* CODE DE GARANTIE ! +860000* ! +860100 05 WS-4DCO-4DTP-SAUV-PAGE-AREA PIC X(198). ! +860200 05 WS-4DCO-4DTP-SAV-ACTION PIC X. ! +860300 05 FILLER PIC X(1562). ! +860400* ! +860500 03 WS-4DCO-4DM1 REDEFINES WS-4DCO-PROGRAM. ! +860600* ============ ! +860700* ! +860800* ============== ! +860900* ------------------------------------------------------ * ! +861000* COMMAREA : GESTION TC4DM10 * ! +861100* PARAMETRAGE MS:LISTE RESULTATS PAR STOCK * ! +861200* LONGUEUR : 1800 * ! +861300* PREFIXE : WS-4DCO-4DM1 * ! +861400* ------------------------------------------------------ * ! +861500 05 WS-4DCO-4DM1-DONNEES. ! +861600 15 WS-4DCO-4DM1-DA-DBT-PR-1 PIC X(10). ! +861700* DATE DEBUT PROROGATION 1 ! +861800 15 WS-4DCO-4DM1-DA-DBT-PR-2 PIC X(10). ! +861900* DATE DEBUT PROROGATION 2 ! +862000 15 WS-4DCO-4DM1-DA-DBT-PR-3 PIC X(10). ! +862100* DATE DEBUT PROROGATION 3 ! +862200 15 WS-4DCO-4DM1-DA-FIN-PR-1 PIC X(10). ! +862300* DATE DEBUT PROROGATION 1 ! +862400 15 WS-4DCO-4DM1-DA-FIN-PR-2 PIC X(10). ! +862500* DATE DEBUT PROROGATION 2 ! +862600 15 WS-4DCO-4DM1-DA-FIN-PR-3 PIC X(10). ! +862700* DATE DEBUT PROROGATION 3 ! +862800 05 WS-4DCO-4DM1-SAUV-PAGE-AREA PIC X(198). ! +862900 05 WS-4DCO-4DM1-SAV-ACT1 PIC X. ! +863000 05 WS-4DCO-4DM1-SAV-ACT2 PIC X. ! +863100 05 WS-4DCO-4DM1-SAV-ACT3 PIC X. ! +863200 05 WS-4DCO-4DM1-OCCUR PIC X. ! +863300 88 WS-4DCO-4DM1-OCCUR-OK VALUE 'O'. ! +863400 88 WS-4DCO-4DM1-OCCUR-KO VALUE 'N'. ! +863500 05 FILLER PIC X(1538). ! +863600* ! +863700 03 WS-4DCO-4DM2 REDEFINES WS-4DCO-PROGRAM. ! +863800* ============ ! +863900* ! +864000* ============== ! +864100* ------------------------------------------------------ * ! +864200* COMMAREA : GESTION TC4DM20 * ! +864300* PARAMETRAGE MS:resultats regimes gestion * ! +864400* LONGUEUR : 1800 * ! +864500* PREFIXE : WS-4DCO-4DM2 * ! +864600* ------------------------------------------------------ * ! +864700 05 WS-4DCO-4DM2-DONNEES. ! +864800 15 WS-4DCO-4DM2-A-REF PIC X(4). ! +864900* ANNEE DE REFERENCE ! +865000 15 WS-4DCO-4DM2-LIB-RGM-GE PIC X(32). ! +865100* ANNEE DE REFERENCE ! +865200 15 WS-4DCO-4DM2-TX-MIN-ITT-GAR PIC S9(2)V9(3). ! +865300* TAUX MINIMUM INTERETS GARANTIS ! +865400 15 WS-4DCO-4DM2-TX-PAB PIC S9(2)V9(3). ! +865500* TAUX DE PAB ! +865600 15 WS-4DCO-4DM2-TX-FRS-GTN-AN PIC S9(2)V9(3). ! +865700* TAUX DE FRAIS DE GESTION ! +865800 15 WS-4DCO-4DM2-TX-FRS-STD-ENT PIC S9(2)V9(3). ! +865900* TAUX DE FRAIS STANDARD ! +866000 15 WS-4DCO-4DM2-TX-RBT-SR PIC S9(3)V9(4). ! +866100* TAUX DE REMBOURSEMENT ! +866200 15 WS-4DCO-4DM2-TX-FRS-ARBT PIC S9(3)V9(4). ! +866300* TAUX DE FRAIS D'ARBITRAGE ! +866400 15 WS-4DCO-4DM2-MT-FOF-GLB PIC S9(13)V9(2). ! +866500* MONTANT FORFAITAIRE FRAIS D'ARBITRAGE ! +866600 05 WS-4DCO-4DM2-SAUV-PAGE-AREA PIC X(198). ! +866700 05 WS-4DCO-4DM2-SAV-ACTION PIC X. ! +866800 05 FILLER PIC X(1516). ! +866900* ! +867000 03 WS-4DCO-4DM4 REDEFINES WS-4DCO-PROGRAM. ! +867100* ============ ! +867200* ! +867300* ============== ! +867400* ------------------------------------------------------ * ! +867500* COMMAREA : GESTION TC4DM40 * ! +867600* PARAMETRAGE MS: regimes fiscaux * ! +867700* LONGUEUR : 1800 * ! +867800* PREFIXE : WS-4DCO-4DM4 * ! +867900* ------------------------------------------------------ * ! +868000 05 WS-4DCO-4DM4-DONNEES. ! +868100 15 WS-4DCO-4DM4-NO-GEN-RF PIC 9(3). ! +868200* NUMERO DE GENERATION ! +868300 15 WS-4DCO-4DM4-CD-DRG-RF PIC X(2). ! +868400* CODE DEROGATION ! +868500 15 WS-4DCO-4DM4-DA-VAL-DBT-RF PIC X(10). ! +868600* DATE DEBUT REGIME ! +868700 15 WS-4DCO-4DM4-DA-FIN-VAL-RF PIC X(10). ! +868800* DATE FIN REGIME ! +868900 15 WS-4DCO-4DM4-LIB-RGM-FI PIC X(32). ! +869000* LIBELLE REGIME ! +869100 15 WS-4DCO-4DM4-TX-PLV-SOC PIC S9(3)V9(8). ! +869200* TAUX PRELEVEMENT SOCIAL ! +869300 15 WS-4DCO-4DM4-LIB-TY-TX-SO PIC X(32). ! +869400* LIBELLE TYPE DE TAUX ! +869500 15 WS-4DCO-4DM4-TX-CRDS PIC S9(2)V9(3). ! +869600* TAUX CRDS ! +869700 15 WS-4DCO-4DM4-LIB-TY-TX-CR PIC X(32). ! +869800* LIBELLE TYPE DE TAUX ! +869900 15 WS-4DCO-4DM4-TX-CTB PIC S9(2)V9(3). ! +870000* TAUX CTB ! +870100 15 WS-4DCO-4DM4-LIB-TX-CTB PIC X(32). ! +870200* LIBELLE TYPE DE TAUX ! +870300 15 WS-4DCO-4DM4-TX-CSG PIC S9(2)V9(3). ! +870400* TAUX CSG ! +870500 15 WS-4DCO-4DM4-LIB-TY-TX-CS PIC X(32). ! +870600* LIBELLE TYPE DE TAUX ! +870700 15 WS-4DCO-4DM4-TX-CSG-97 PIC S9(2)V9(3). ! +870800* TAUX CSG 97 ! +870900 15 WS-4DCO-4DM4-LIB-TY-TX-97 PIC X(32). ! +871000* LIBELLE TYPE DE TAUX CSG 97 ! +871100 15 WS-4DCO-4DM4-TX-CSG-98 PIC S9(2)V9(3). ! +871200* TAUX CSG 98 ! +871300 15 WS-4DCO-4DM4-LIB-TY-TX-98 PIC X(32). ! +871400* LIBELLE TYPE DE TAUX CSG 98 ! +871500 15 WS-4DCO-4DM4-TX-PLV-LBL-1 PIC S9(2)V9(3). ! +871600* TAUX PRELEVEMENT LIBERATOIRE 1 ! +871700 15 WS-4DCO-4DM4-LIB-TY-TX-1 PIC X(32). ! +871800* LIBELLE TYPE DE TAUX 1 ! +871900 15 WS-4DCO-4DM4-DUR-FIS-1 PIC 9(4). ! +872000* DUREE FISCALE 1 ! +872100 15 WS-4DCO-4DM4-TX-PLV-LBL-2 PIC S9(2)V9(3). ! +872200* TAUX PRELEVEMENT LIBERATOIRE 2 ! +872300 15 WS-4DCO-4DM4-LIB-TY-TX-2 PIC X(32). ! +872400* LIBELLE TYPE DE TAUX 2 ! +872500 15 WS-4DCO-4DM4-DUR-FIS-2 PIC 9(4). ! +872600* DUREE FISCALE 2 ! +872700 15 WS-4DCO-4DM4-TX-PLV-LBL-3 PIC S9(2)V9(3). ! +872800* TAUX PRELEVEMENT LIBERATOIRE 3 ! +872900 15 WS-4DCO-4DM4-LIB-TY-TX-3 PIC X(32). ! +873000* LIBELLE TYPE DE TAUX 3 ! +873100 15 WS-4DCO-4DM4-DUR-FIS-3 PIC 9(4). ! +873200* DUREE FISCALE 3 ! +873300 15 WS-4DCO-4DM4-TX-PLV-LBL-4 PIC S9(2)V9(3). ! +873400* TAUX PRELEVEMENT LIBERATOIRE 4 ! +873500 15 WS-4DCO-4DM4-LIB-TY-TX-4 PIC X(32). ! +873600* LIBELLE TYPE DE TAUX 4 ! +873700 15 WS-4DCO-4DM4-DUR-FIS-4 PIC 9(4). ! +873800* DUREE FISCALE 4 ! +873900 15 WS-4DCO-4DM4-TX-PLV-LBL-5 PIC S9(2)V9(3). ! +874000* TAUX PRELEVEMENT LIBERATOIRE 5 ! +874100 15 WS-4DCO-4DM4-LIB-TY-TX-5 PIC X(32). ! +874200* LIBELLE TYPE DE TAUX 5 ! +874300 15 WS-4DCO-4DM4-DUR-FIS-5 PIC 9(4). ! +874400* DUREE FISCALE 5 ! +874500 05 WS-4DCO-4DM4-SAUV-PAGE-AREA PIC X(198). ! +874600 05 WS-4DCO-4DM4-SAV-ACTION PIC X. ! +874700 05 FILLER PIC X(1109). ! +874800* ! +874900 03 WS-4DCO-4DF1 REDEFINES WS-4DCO-PROGRAM. ! +875000* ============ ! +875100* ! +875200* ============== ! +875300* ------------------------------------------------------ * ! +875400* COMMAREA : GESTION TC4DF10 * ! +875500* LONGUEUR : 1800 * ! +875600* PREFIXE : WS-4DCO-4DF1 * ! +875700* ------------------------------------------------------ * ! +875800 05 WS-4DCO-4DF1-ZON-CLE. ! +875900 07 WS-4DCO-4DF1-DONNEES. ! +876000 10 WS-4DCO-4DF1-NO-RGM-FI PIC 9(03). ! +876100 10 WS-4DCO-4DF1-NO-GEN-RF PIC 9(03). ! +876200 10 WS-4DCO-4DF1-CD-DRG-RF PIC X(02). ! +876300 07 WS-4DCO-4DF1-ACTIONS. ! +876400* TYPE D'ACTION SUR L'ECRAN MC4DF10 ! +876500 10 WS-4DCO-4DF1-SAV-ACTION PIC X. ! +876600 88 4DF1-CREAT VALUE 'C'. ! +876700 88 4DF1-MODIF VALUE 'M'. ! +876800 88 4DF1-SUPP VALUE 'A'. ! +876900 88 4DF1-VISU VALUE 'D'. ! +877000* ! +877100 05 WS-4DCO-4DF1-NB-OCC-RES PIC 9(04). ! +877200 05 WS-4DCO-4DF1-SAUV-PAGE-AREA PIC X(198). ! +877300 05 WS-4DCO-4DF1-NB-PAGES PIC 9(02). ! +877400 05 FILLER PIC X(1587). ! +877500* ! +877600* ! +877700 03 WS-4DCO-4DF2 REDEFINES WS-4DCO-PROGRAM. ! +877800* ============ ! +877900* ! +878000* ============== ! +878100* ------------------------------------------------------ * ! +878200* COMMAREA : GESTION TC4DF20 * ! +878300* LONGUEUR : 1800 * ! +878400* PREFIXE : WS-4DCO-4DF2 * ! +878500* ------------------------------------------------------ * ! +878600 05 WS-4DCO-4DF2-ZON-CLE. ! +878700 07 WS-4DCO-4DF2-SAISIES. ! +878800 10 WS-4DCO-4DF2-NO-RGM-FI PIC 9(03). ! +878900 10 WS-4DCO-4DF2-NO-GEN-RF PIC 9(03). ! +879000 10 WS-4DCO-4DF2-CD-DRG-RF PIC X(02). ! +879100 07 WS-4DCO-4DF2-ACTIONS. ! +879200* TYPE D'ACTION SUR L'ECRAN MC4DF10 ! +879300 10 WS-4DCO-4DF2-SAV-ACTION PIC X. ! +879400 88 4DF2-CREAT VALUE 'C'. ! +879500 88 4DF2-MODIF VALUE 'M'. ! +879600 88 4DF2-SUPP VALUE 'A'. ! +879700 88 4DF2-VISU VALUE 'D'. ! +879800 05 WS-4DCO-4DF2-DONNEES. ! +879900 10 WS-4DCO-4DF2-DA-VAL-DBT-RF PIC X(10). ! +880000 10 WS-4DCO-4DF2-DA-FIN-VAL-RF PIC X(10). ! +880100 10 WS-4DCO-4DF2-LIB-RGM-FI PIC X(32). ! +880200 10 WS-4DCO-4DF2-TX-PLV-SOC PIC S9(3)V9(8) COMP-3. ! +880300 10 WS-4DCO-4DF2-LIB-TY-TX-SO PIC X(32). ! +880400 10 WS-4DCO-4DF2-TX-CRDS PIC S9(3)V9(8) COMP-3. ! +880500 10 WS-4DCO-4DF2-LIB-TY-TX-CR PIC X(32). ! +880600 10 WS-4DCO-4DF2-TX-CSG PIC S9(3)V9(8) COMP-3. ! +880700 10 WS-4DCO-4DF2-LIB-TY-TX-CS PIC X(32). ! +880800 10 WS-4DCO-4DF2-TX-CSG-97 PIC S9(3)V9(8) COMP-3. ! +880900 10 WS-4DCO-4DF2-LIB-TY-TX-97 PIC X(32). ! +881000 10 WS-4DCO-4DF2-TX-CSG-98 PIC S9(3)V9(8) COMP-3. ! +881100 10 WS-4DCO-4DF2-LIB-TY-TX-98 PIC X(32). ! +881200 10 WS-4DCO-4DF2-TX-CTB-AD PIC S9(3)V9(8) COMP-3. ! +881300 10 WS-4DCO-4DF2-LIB-TY-TX-AD PIC X(32). ! +881200 10 WS-4DCO-4DF2-TX-RSA PIC S9(3)V9(8) COMP-3. ! +881300 10 WS-4DCO-4DF2-LIB-TY-TX-RSA PIC X(32). ! +881400 10 WS-4DCO-4DF2-TX-PLV-LBL-1 PIC S9(3)V9(8) COMP-3. ! +881500 10 WS-4DCO-4DF2-LIB-TY-TX-1 PIC X(32). ! +881600 10 WS-4DCO-4DF2-DUR-FIS-1 PIC S9(4). ! +881700 10 WS-4DCO-4DF2-TX-PLV-LBL-2 PIC S9(3)V9(8) COMP-3. ! +881800 10 WS-4DCO-4DF2-LIB-TY-TX-2 PIC X(32). ! +881900 10 WS-4DCO-4DF2-DUR-FIS-2 PIC S9(4). ! +882000 10 WS-4DCO-4DF2-TX-PLV-LBL-3 PIC S9(3)V9(8) COMP-3. ! +882100 10 WS-4DCO-4DF2-LIB-TY-TX-3 PIC X(32). ! +882200 10 WS-4DCO-4DF2-DUR-FIS-3 PIC S9(4). ! +882300 10 WS-4DCO-4DF2-TX-PLV-LBL-4 PIC S9(3)V9(8) COMP-3. ! +882400 10 WS-4DCO-4DF2-LIB-TY-TX-4 PIC X(32). ! +882500 10 WS-4DCO-4DF2-DUR-FIS-4 PIC S9(4). ! +882600 10 WS-4DCO-4DF2-TX-PLV-LBL-5 PIC S9(3)V9(8) COMP-3. ! +882700 10 WS-4DCO-4DF2-LIB-TY-TX-5 PIC X(32). ! +882800 10 WS-4DCO-4DF2-DUR-FIS-5 PIC S9(4). ! +882900 05 WS-4DCO-4DF2-LIB-OPE PIC X(30). ! +883000 05 WS-4DCO-4DF2-SV-DONNEES. ! +883100 10 WS-4DCO-4DF2-SV-NO-RGM-FI PIC 9(03). ! +883200 10 WS-4DCO-4DF2-SV-NO-GEN-RF PIC 9(03). ! +883300 10 WS-4DCO-4DF2-SV-CD-DRG-RF PIC X(02). ! +883400 10 WS-4DCO-4DF2-SV-DA-VAL-DBT-RF PIC X(10). ! +883500 10 WS-4DCO-4DF2-SV-DA-FIN-VAL-RF PIC X(10). ! +883600 10 WS-4DCO-4DF2-SV-LIB-RGM-FI PIC X(32). ! +883700 10 WS-4DCO-4DF2-SV-TX-PLV-SOC PIC S9(3)V9(8) COMP-3. ! +883800 10 WS-4DCO-4DF2-SV-LIB-TY-TX-SO PIC X(32). ! +883900 10 WS-4DCO-4DF2-SV-TX-CRDS PIC S9(3)V9(8) COMP-3. ! +884000 10 WS-4DCO-4DF2-SV-LIB-TY-TX-CR PIC X(32). ! +884100 10 WS-4DCO-4DF2-SV-TX-CSG PIC S9(3)V9(8) COMP-3. ! +884200 10 WS-4DCO-4DF2-SV-LIB-TY-TX-CS PIC X(32). ! +884300 10 WS-4DCO-4DF2-SV-TX-CSG-97 PIC S9(3)V9(8) COMP-3. ! +884400 10 WS-4DCO-4DF2-SV-LIB-TY-TX-97 PIC X(32). ! +884500 10 WS-4DCO-4DF2-SV-TX-CSG-98 PIC S9(3)V9(8) COMP-3. ! +884600 10 WS-4DCO-4DF2-SV-LIB-TY-TX-98 PIC X(32). ! +884700 10 WS-4DCO-4DF2-SV-TX-CTB-AD PIC S9(3)V9(8) COMP-3. ! +884800 10 WS-4DCO-4DF2-SV-LIB-TY-TX-AD PIC X(32). ! +884700 10 WS-4DCO-4DF2-SV-TX-RSA PIC S9(3)V9(8) COMP-3. ! +884800 10 WS-4DCO-4DF2-SV-LIB-TY-TX-RSA PIC X(32). ! +884900 10 WS-4DCO-4DF2-SV-TX-PLV-LBL-1 PIC S9(3)V9(8) COMP-3. ! +885000 10 WS-4DCO-4DF2-SV-LIB-TY-TX-1 PIC X(32). ! +885100 10 WS-4DCO-4DF2-SV-DUR-FIS-1 PIC S9(4). ! +885200 10 WS-4DCO-4DF2-SV-TX-PLV-LBL-2 PIC S9(3)V9(8) COMP-3. ! +885300 10 WS-4DCO-4DF2-SV-LIB-TY-TX-2 PIC X(32). ! +885400 10 WS-4DCO-4DF2-SV-DUR-FIS-2 PIC S9(4). ! +885500 10 WS-4DCO-4DF2-SV-TX-PLV-LBL-3 PIC S9(3)V9(8) COMP-3. ! +885600 10 WS-4DCO-4DF2-SV-LIB-TY-TX-3 PIC X(32). ! +885700 10 WS-4DCO-4DF2-SV-DUR-FIS-3 PIC S9(4). ! +885800 10 WS-4DCO-4DF2-SV-TX-PLV-LBL-4 PIC S9(3)V9(8) COMP-3. ! +885900 10 WS-4DCO-4DF2-SV-LIB-TY-TX-4 PIC X(32). ! +886000 10 WS-4DCO-4DF2-SV-DUR-FIS-4 PIC S9(4). ! +886100 10 WS-4DCO-4DF2-SV-TX-PLV-LBL-5 PIC S9(3)V9(8) COMP-3. ! +886200 10 WS-4DCO-4DF2-SV-LIB-TY-TX-5 PIC X(32). ! +886300 10 WS-4DCO-4DF2-SV-DUR-FIS-5 PIC S9(4). ! +882900 05 FILLER PIC X(697). ! +886400* ! +886500 03 WS-4DCO-BLOCNOTE REDEFINES WS-4DCO-PROGRAM. ! +886600* ============ ! +886700* ! +886800* ============== ! +886900* ------------------------------------------------------ * ! +887000* COMMAREA : GESTION TC4DB60 -TC4DB70 * ! +887100* LONGUEUR : 1800 * ! +887200* PREFIXE : WS-4DCO-4DB6 * ! +887300* ------------------------------------------------------ * ! +887400 05 WS-4DCO-4DB6-CMT-RSC PIC X(79). ! +887500 05 WS-4DCO-4DB6-NAME-TS PIC X(08). ! +887600 05 WS-4DCO-4DB6-NO-ITEM PIC 9(04) COMP. ! +887700 05 WS-4DCO-4DB6-NB-ITEM PIC 9(04) COMP. ! +887800 05 WS-4DCO-4DB6-NB-OCC-RES PIC 9(04). ! +887900 05 WS-4DCO-4DB6-SAUV-PAGE-AREA PIC X(198). ! +888000 05 WS-4DCO-4DB6-NB-PAGES PIC 9(02). ! +888100 05 WS-4DCO-4DB6-IDC-OCC-SPL PIC X(01). ! +888200 05 WS-4DCO-4DB6-NO-SEQ-HIS PIC S9(07) COMP-3. ! +888300* TYPE D'ACTION SUR ECRANS MC4DB60 - MC4DB70 ! +888400 05 WS-4DCO-4DB6-TOP-ACTION PIC X. ! +888500 88 4DB6-CREAT VALUE 'C'. ! +888600 88 4DB6-MODIF VALUE 'M'. ! +888700 88 4DB6-SUPP VALUE 'A'. ! +888800 88 4DB6-VISU VALUE 'D'. ! +888900 05 FILLER PIC X(1306). ! +889000* ! +889100 03 WS-4DCO-4ET1 REDEFINES WS-4DCO-PROGRAM. ! +889200* ============ ! +889300* ! +889400* ============== ! +889500* ------------------------------------------------------ * ! +889600* COMMAREA : GESTION TC4ET10 * ! +889700* LONGUEUR : 1800 * ! +889800* PREFIXE : WS-4DCO-4ET1 * ! +889900* ------------------------------------------------------ * ! +890000 05 WS-4DCO-4ET1-PAGE-AREA-START PIC X(80). ! +890100* SAUVEGARDE DE L'ECRAN DE LISTE ! +890200 05 WS-4DCO-4ET1-LIB-EVE-TY PIC X(32). ! +890300* LIBELLE EVENEMENT ! +890400 05 WS-4DCO-4ET1-NO-SEQ-DO PIC 9(03). ! +890500* NUMERO SEQUENTIELLE DOCUMENT ! +890600 05 WS-4DCO-4ET1-IDC-DUP PIC X(01). ! +890700* INDICATEUR DUPLICATA ! +890800 05 WS-4DCO-4ET1-IDC-NV-CD PIC X(01). ! +890900* INDICATEUR CODE BARRE ! +891000 05 WS-4DCO-4ET1-IDC-REL-TT PIC X(01). ! +891100* INDICATEUR RELANCE ! +891200 05 WS-4DCO-4ET1-DA-CRE PIC X(08). ! +891300* DATE CREATION DOCUMENT ! +891400 05 WS-4DCO-4ET1-HEU-CRE PIC X(06). ! +891500* HEURE CREATION DOCUMENT ! +891600 05 WS-4DCO-4ET1-CD-EVE-TY PIC X(06). ! +891700* CODE EVENEMENT TYPE ! +891800 05 WS-4DCO-4ET1-NB-PG-DOC-REDI PIC 9(04) COMP. ! +891900* NOMBRE DE PAGE EDITION ! +892000 05 WS-4DCO-4ET1-CD-DEL PIC X(02). ! +892100* CODE DELAI ! +892200 05 WS-4DCO-4ET1-CD-EVE-TY-CF PIC X(06). ! +892300* CODE EVENEMENT TYPE CONFIRMATION ! +892400 05 WS-4DCO-4ET1-CONF-FORCEE PIC X(01). ! +892500* CODE EVENEMENT TYPE CONFIRMATION ! +892600 05 FILLER PIC X(1651). ! +892700* ! +892800 03 WS-4DCO-4DA4 REDEFINES WS-4DCO-PROGRAM. ! +892900* ============ ! +893000* ! +893100* ============== ! +893200* ------------------------------------------------------ * ! +893300* COMMAREA : GESTION DEROGATION PAR PROFIL ET TRANCHES * ! +893400* LONGUEUR : 1800 * ! +893500* PREFIXE : WS-4DCO-4DA4- * ! +893600* ------------------------------------------------------ * ! +893700* AFFICHAGE ENTETE (TC4DA40) ! +893800 05 WS-4DCO-4DA4-CD-PTN-TT PIC X(5). ! +893900 05 WS-4DCO-4DA4-NO-PTN-TT PIC 9(3) COMP-3. ! +894000 05 WS-4DCO-4DA4-LIB-PTN PIC X(32). ! +894100 05 WS-4DCO-4DA4-CD-PRF PIC X(3). ! +894200 05 WS-4DCO-4DA4-LIB-PRF PIC X(32). ! +894300 05 WS-4DCO-4DA4-CD-PRD1 PIC X(2). ! +894400 05 WS-4DCO-4DA4-NO-PRD-TT PIC 9(3) COMP-3. ! +894500 05 WS-4DCO-4DA4-CD-PRD-TT PIC X(2). ! +894600 05 WS-4DCO-4DA4-LIB-ACT PIC X(79). ! +894700 05 WS-4DCO-4DA4-TX-STD PIC S9(2)V9(5). ! +894800 05 WS-4DCO-4DA4-TY-TX PIC X(1). ! +894900 05 WS-4DCO-4DA4-LIB-TX PIC X(32). ! +895000 05 WS-4DCO-4DA4-LIB-PRD1 PIC X(32). ! +895100* ZONE DE SAUVEGARDE DU BORDEREAU ENTETE (CAS 2) ! +895200 05 WS-4DCO-4DA4-CD-PTN-TT-S PIC X(5). ! +895300 05 WS-4DCO-4DA4-NO-PTN-TT-S PIC 9(3) COMP-3. ! +895400 05 WS-4DCO-4DA4-LIB-PTN-S PIC X(32). ! +895500 05 WS-4DCO-4DA4-CD-PRF-S PIC X(3). ! +895600 05 WS-4DCO-4DA4-LIB-PRF-S PIC X(32). ! +895700 05 WS-4DCO-4DA4-CD-PRD1-S PIC X(2). ! +895800 05 WS-4DCO-4DA4-NO-PRD-TT-S PIC 9(3) COMP-3. ! +895900 05 WS-4DCO-4DA4-TX-STD-S PIC S9(2)V9(5). ! +896000 05 WS-4DCO-4DA4-TY-TX-S PIC X(1). ! +896100 05 WS-4DCO-4DA4-LIB-TX-S PIC X(32). ! +896200 05 WS-4DCO-4DA4-LIB-PRD1-S PIC X(32). ! +896300 05 WS-4DCO-4DA4-IND-PAGE PIC X(1). ! +896400 05 WS-4DCO-4DA4-IND PIC X(1). ! +896500* ZONE DEDIEE A LA LISTE (TC4DA40) ! +896600 05 WS-4DCO-4DA4-NB-PAGES PIC 9(2). ! +896700 05 WS-4DCO-4DA4-NO-PAGES PIC 9(2). ! +896800 05 WS-4DCO-4DA4-PAGE-AREA PIC X(198). ! +896900 05 WS-4DCO-4DA4-CD-ACTION PIC X(1). ! +897000* ZONE DEDIEE A LA CREATION (TC4DA50) ! +897100 05 WS-4DCO-4DA4-PFL-CRE PIC X(3). ! +897200 05 WS-4DCO-4DA4-PRD-CRE PIC X(2). ! +897300 05 WS-4DCO-4DA4-TX-STD-CRE PIC S9(2)V9(5). ! +897400 05 WS-4DCO-4DA4-TY-CRE PIC X(1). ! +897500* ZONE DEDIEE A LA SAUVEGARDE DE L'ENTETE ! +897600 05 WS-4DCO-4DA4-SVG-PTN PIC X(5). ! +897700 05 WS-4DCO-4DA4-SVG-PFL PIC X(3). ! +897800 05 WS-4DCO-4DA4-SVG-PRD PIC X(2). ! +897900 05 WS-4DCO-4DA4-SVG-STD PIC S9(2)V9(5). ! +898000 05 WS-4DCO-4DA4-SVG-TY PIC X(1). ! +898100* ZONE DEDIEE AUX DIVERS INDICATEURS (TOUS) ! +898200 05 WS-4DCO-4DA4-INDICE PIC 9(1). ! +898300 05 WS-4DCO-4DA4-CD-INDICATEUR PIC 9(1). ! +898400 05 WS-4DCO-4DA4-CD-INDICATEUR2 PIC 9(1). ! +898500 05 WS-4DCO-4DA4-CD-INDICATEUR3 PIC 9(1). ! +898600* ZONE DEDIEE A L'AIDE A LA CREATION (TC4DA60) ! +898700 05 WS-4DCO-4DA4-CD-PTN-AIDE PIC X(5). ! +898800 05 WS-4DCO-4DA4-CD-PFL-AIDE PIC X(3). ! +898900 05 WS-4DCO-4DA4-CD-PRD-AIDE PIC X(2). ! +899000 05 WS-4DCO-4DA4-TY-TX-AIDE PIC X(1). ! +899100 05 WS-4DCO-4DA4-TX-STD-AIDE PIC S9(2)V9(5). ! +899200* AFFICHAGE DU % (TC4DA50) ! +899300 05 WS-4DCO-4DA4-AFFICHAGE OCCURS 12. ! +899400 10 WS-4DCO-4DA4-SIGLE PIC X(1). ! +899500* SAUVEGARDE DES TRANCHES CREEES (TC4DA50) ! +899600 05 WS-4DCO-4DA4-SVG OCCURS 12. ! +899700 10 WS-4DCO-4DA4-SVG-TX-DRD PIC S9(3)V9(4). ! +899800 10 WS-4DCO-4DA4-SVG-MT-MIN PIC S9(13)V99 COMP-3. ! +899900 10 WS-4DCO-4DA4-SVG-MT-MAX PIC S9(13)V99 COMP-3. ! +900000* SAUVEGARDE DES TRANCHES (TC4DA50) ! +900100 05 WS-4DCO-4DA4-TRANCHE OCCURS 12. ! +900200 10 WS-4DCO-4DA4-TX-TCH-DRG PIC S9(3)V9(4) COMP-3. ! +900300 10 WS-4DCO-4DA4-MIN-TCH-DRG PIC S9(13)V99 COMP-3. ! +900400 10 WS-4DCO-4DA4-MAX-TCH-DRG PIC S9(13)V99 COMP-3. ! +900500* SAUVEGARDE DE LA CLE DE REPOSITIONNEMENT (TC4DA40) ! +900600 05 WS-4DCO-4DA4-SV-CLE-PRD1 PIC 9(3) COMP-3. ! +900700 05 WS-4DCO-4DA4-CLE-POS. ! +900800 10 WS-4DCO-4DA4-SV-CLE-PRF PIC X(3). ! +900900 10 WS-4DCO-4DA4-SV-CLE-PRD PIC X(2). ! +901000 10 WS-4DCO-4DA4-SV-CLE-TYTX PIC X(1). ! +901100 10 WS-4DCO-4DA4-SV-CLE-TXSTD PIC 9(2)V9(5). ! +901200* APPLICATION HABILITATION (PARTIE COMMUNE) (TC98720) ! +901300 05 WS-4DCO-HABI-4DA4. ! +901400* LONGUEUR : 0400 ! +901500 10 WS-4DCO-4AD4-CD-PTN-DLGAIRE PIC X(05). ! +901600 10 WS-4DCO-4DA4-LA-PTN-DLGAIRE PIC X(16). ! +901700 10 WS-4DCO-4DA4-CD-PFL-DLGAIRE PIC X(03). ! +901800 10 WS-4DCO-4DA4-LA-PFL-DLGAIRE PIC X(16). ! +901900 10 WS-4DCO-4DA4-CD-IDT-DLGAIRE PIC X(08). ! +902000 10 WS-4DCO-4DA4-CD-PTN-DLGUE PIC X(05). ! +902100 10 WS-4DCO-4DA4-LA-PTN-DLGUE PIC X(16). ! +902200 10 WS-4DCO-4DA4-CD-PFL-DLGUE PIC X(03). ! +902300 10 WS-4DCO-4DA4-LA-PFL-DLGUE PIC X(16). ! +902400 10 WS-4DCO-4DA4-CD-IDT-DLGUE PIC X(08). ! +902500 10 WS-4DCO-4DA4-IDC-MAJ PIC X(01). ! +902600 10 WS-4DCO-4DA4-LIB-PTN-DLGAIRE PIC X(32). ! +902700 10 WS-4DCO-4DA4-CD-TY-PFL-DLGUE PIC X(01). ! +902800 10 WS-4DCO-4DA4-NO-PTN-DLGAIRE PIC 9(03). ! +902900 10 WS-4DCO-4DA4-NO-PTN-DLGUE PIC 9(03). ! +903000 10 WS-4DCO-4DA4-IDC-IDT-ITN PIC X(1). ! +903100 10 WS-4DCO-4DA4-NIV-DRG PIC 9(3). ! +903200 10 WS-4DCO-4DA4-NO-TEL-SL PIC X(11). ! +903300 10 WS-4DCO-4DA4-NO-TEL-DM PIC X(11). ! +903400 10 WS-4DCO-4DA4-NO-FAX PIC X(12). ! +903500 10 WS-4DCO-4DA4-CD-PROV PIC X(03). ! +903600 88 ADMINISTRATEUR VALUE 'ADM'. ! +903700 88 DELEGUE VALUE 'DLG'. ! +903800 88 IDENTIFICATEUR VALUE 'IDT'. ! +903900 10 FILLER PIC X(223). ! +904000* LIBELLE DE L'ACTION EN COURS (C4DA50) ! +904100 05 WS-4DCO-4DA4-LIB-TITRE PIC X(012). ! +904200* TAUX TRANCHE DEROGATOIRE MAXIMUM (C4DA50) ! +904300 05 WS-4DCO-4DA4-TRANCE-MAXI OCCURS 12. ! +904400 10 WS-4DCO-4DA4-TX-TCH-DRG-MX PIC S9(3)V9(4) COMP-3. ! +904500* FILLER ! +904600 05 FILLER PIC X(038). ! +904700* ! +904800 03 WS-4DCO-4ERIA REDEFINES WS-4DCO-PROGRAM. ! +904900* ============ ! +905000* ! +905100* ============== ! +905200* ------------------------------------------------------ * ! +905300* COMMAREA : GESTION DES RELEVES D'INFO ANNUELLE * ! +905400* LONGUEUR : 1800 * ! +905500* PREFIXE : WS-4DCO-4ERIA * ! +905600* ------------------------------------------------------ * ! +905700 05 WS-4DCO-4ERIA-NUM-CPT PIC X(15). ! +905800 05 WS-4DCO-4ERIA-NOM-PATRO PIC X(32). ! +905900 05 WS-4DCO-4ERIA-LIB-PFL PIC X(32). ! +906000 05 WS-4DCO-4ERIA-SAV-ACTION PIC X(01). ! +906100 05 WS-4DCO-4ERIA-CD-ACTION PIC X(01). ! +906200 05 WS-4DCO-4ERIA-A-REF-RLV-CPT PIC 9(04). ! +906300 05 WS-4DCO-4ERIA-CD-PTN PIC X(05). ! +906400 05 WS-4DCO-4ERIA-PERIODE PIC X(01). ! +906500 88 RIA-ANNEE-1 VALUE '1'. ! +906600 88 RIA-ANNEE-2 VALUE '2'. ! +906700 05 FILLER PIC X(44). ! +906800 05 WS-4DCO-4E13. ! +906900 10 WS-4DCO-4E13-LIB-TITRE PIC X(30). ! +907000 10 WS-4DCO-4E13-NB-PAGES PIC 9(02). ! +907100 10 WS-4DCO-4E13-NO-PAGES PIC 9(02). ! +907200 10 WS-4DCO-4E13-PAGE-AREA PIC X(198). ! +907300 10 WS-4DCO-4E13-LIB-ACT PIC X(78). ! +907400 10 WS-4DCO-4E13-UC-CRE PIC X(16). ! +907500 10 WS-4DCO-4E13-DAT-CRE PIC S9(10)V9(04). ! +907600 10 WS-4DCO-4E13-ACH-CRE PIC S9(10)V9(04). ! +907700 10 WS-4DCO-4E13-VEN-CRE PIC S9(10)V9(04). ! +907800 10 WS-4DCO-4E13-FAG-CRE PIC S9(10)V9(04). ! +907900 10 WS-4DCO-4E13-IDC-MODIF PIC 9(1). ! +908000 10 WS-4DCO-4E13-CPN-CRE PIC S9(10)V9(04). ! +908100 10 FILLER PIC X(85). ! +908200 05 WS-4DCO-4E12. ! +908300 10 WS-4DCO-4E12-LIB-TITRE PIC X(37). ! +908400 10 FILLER PIC X(63). ! +908500 05 WS-4DCO-4E16. ! +908600 10 WS-4DCO-4E16-NB-PAGES PIC 9(02). ! +908700 10 WS-4DCO-4E16-NO-PAGES PIC 9(02). ! +908800 10 WS-4DCO-4E16-PAGE-AREA PIC X(198). ! +908900 10 WS-4DCO-4E16-NO-PART PIC X(03). ! +909000 10 WS-4DCO-4E16-NO-CTR PIC X(15). ! +909100 10 FILLER PIC X(30). ! +909200 05 WS-4DCO-4E14. ! +909300 10 WS-4DCO-4E14-NB-PAGES PIC 9(02). ! +909400 10 WS-4DCO-4E14-NO-PAGES PIC 9(02). ! +909500 10 WS-4DCO-4E14-PAGE-AREA PIC X(198). ! +909600 10 FILLER PIC X(48). ! +909700 05 WS-4DCO-4E15. ! +909800 10 WS-4DCO-4E15-IND-MODIF PIC X(01). ! +909900 10 WS-4DCO-4E15-IND-PAGE PIC 9(01). ! +910000 10 WS-4DCO-4E15-LIB-TITRE PIC X(37). ! +910100 10 WS-4DCO-4E15-LIB-ACTION PIC X(40). ! +910200 10 WS-4DCO-4E15-PAGE-AREA PIC X(198). ! +910300 10 WS-4DCO-4E15-NB-PAGES PIC 9(02). ! +910400 10 WS-4DCO-4E15-CD-ACTION PIC X(01). ! +910500 10 WS-4DCO-4E15-SVG-INDICE PIC 9(03). ! +910600 10 WS-4DCO-4E15-LIBOPEC PIC X(32). ! +910700 10 WS-4DCO-4E15-DA-EFF-C PIC X(10). ! +910800 10 WS-4DCO-4E15-DEBITC PIC X(14). ! +910900 10 WS-4DCO-4E15-CREDITC PIC X(14). ! +911000 10 FILLER PIC X(07). ! +911100 05 WS-4DCO-4E18. ! +911200 10 WS-4DCO-4E18-LIB-TITRE PIC X(42). ! +911300 10 FILLER PIC X(08). ! +911400 05 FILLER PIC X(040). ! +911500* ! +911600 03 WS-4DCO-GLG REDEFINES WS-4DCO-PROGRAM. ! +911700* ================ ! +911800* ------------------------------------------------------ * ! +911900* COMMAREA : VERSEMENT SUITE A TRANSFERT C4GLG0 * ! +912000* LONGUEUR : 1800 * ! +912100* PREFIXE : WS-4DCO-MNC * ! +912200* ------------------------------------------------------ * ! +912300 ! +912400 05 WS-4DCO-GLG-CTR-ECHU PIC X(001). ! +912500* TOP INDICATEUR DE CONTRAT ECHU ! +912600 05 FILLER PIC X(1799). ! +912700* ZONES DISPONIBLES ! +912800* ------------------------------------------------------ * ! +912900* ! +913000 03 WS-4DCO-4FMB REDEFINES WS-4DCO-PROGRAM. ! +913100* ================ ! +913200* ------------------------------------------------------ * ! +913300* COMMAREA : RENTES DETAIL TC4FMB0 * ! +913400* LONGUEUR : 1800 * ! +913500* PREFIXE : WS-4DCO-4FMB * ! +913600* ------------------------------------------------------ * ! +913700 ! +913800 05 WS-4DCO-4FMB-CD-PTN PIC X(05). ! +913900* CODE PARTENAIRE ! +914000 05 WS-4DCO-4FMB-IDT-CTR PIC X(15). ! +914100* IDENTIFIANT CONTRAT ! +914200 05 WS-4DCO-4FMB-NOM-PRN PIC X(32). ! +914300* NOM PRENOM ! +914400 05 WS-4DCO-4FMB-DA-NAIS PIC X(08). ! +914500* DATE NAISSANCE ! +914600 05 WS-4DCO-4FMB-DA-DCS PIC X(08). ! +914700* DATE DECES ! +914800 05 WS-4DCO-4FMB-NO-RIB-RT PIC X(23). ! +914900* NUMERO RIB RENTE ! +915000 05 FILLER PIC X(1709). ! +915100* ZONES DISPONIBLES ! +915200* ------------------------------------------------------ * ! +915300* ! +915400 03 WS-4DCO-4DCR REDEFINES WS-4DCO-PROGRAM. ! +915500* ================ ! +915600* ------------------------------------------------------ * ! +915700* COMMAREA : CALCUL CLE RIB TC4DCR0 * ! +915800* LONGUEUR : 1800 * ! +915900* PREFIXE : WS-4DCO-4DCR * ! +916000* ------------------------------------------------------ * ! +916100 ! +916200 05 WS-4DCO-4DCR-CD-BANQUE PIC X(05). ! +916300* CODE BANQUE ! +916400 05 WS-4DCO-4DCR-CD-GUICHET PIC X(05). ! +916500* CODE GUICHET ! +916600 05 WS-4DCO-4DCR-NO-CPT-RIB PIC X(11). ! +916700* NUMERO COMPTE RIB ! +916800 05 WS-4DCO-4DCR-CLE-RIB PIC X(02). ! +916900* CLE RIB ! +917000 05 FILLER PIC X(1777). ! +917100* ZONES DISPONIBLES ! +917200* ------------------------------------------------------ * ! +917300 03 WS-4DCO-4FPT REDEFINES WS-4DCO-PROGRAM. ! +917400* ============ ! +917500* ! +917600* ============== ! +917700* ------------------------------------------------------ * ! +917800* GESTION SOUS MANDAT : LISTE PROFIL MANDAT DE GESTION * ! +917900* COMMAREA : GESTION TC4FPT0 * ! +918000* LONGUEUR : 1800 * ! +918100* PREFIXE : WS-4DCO-4FPT * ! +918200* ------------------------------------------------------ * ! +918300 05 WS-4DCO-4FPT-ZON-CLE. ! +918400 07 WS-4DCO-4FPT-DONNEES. ! +918500 10 WS-4DCO-4FPT-CD-PFL-MDT PIC X(03). ! +918600* TYPE D'ACTION SUR L'ECRAN MC4FPT0 ! +918700 07 WS-4DCO-4FPT-SAV-ACTION PIC X. ! +918800 88 4FPT-CREAT VALUE 'C'. ! +918900 88 4FPT-MODIF VALUE 'M'. ! +919000 88 4FPT-SUPP VALUE 'A'. ! +919100 88 4FPT-VISU VALUE 'D'. ! +919200* ! +919300 05 WS-4DCO-4FPT-DA-OUV-PFL PIC X(08). ! +919400 05 WS-4DCO-4FPT-DA-FIN-PFL PIC X(08). ! +919500 05 WS-4DCO-4FPT-NB-OCC-RES PIC 9(04). ! +919600 05 WS-4DCO-4FPT-SAUV-PAGE-AREA PIC X(198). ! +919700 05 WS-4DCO-4FPT-NB-PAGES PIC 9(02). ! +919800 05 WS-4DCO-4FPT-CD-PFL-MDT-SEL PIC X(03). ! +919900 05 FILLER PIC X(1573). ! +920000* ! +920100 03 WS-4DCO-4FPU REDEFINES WS-4DCO-PROGRAM. ! +920200* ============= ! +920300* ! +920400* ====m========= ! +920500* ------------------------------------------------------ * ! +920600* COMMAREA : GESTION sous mandat zoom, creation, supp * ! +920700* COMMAREA : TC4FPU0 * ! +920800* LONGUEUR : 1800 * ! +920900* PREFIXE : WS-4DCO-4FPT2 * ! +921000* ------------------------------------------------------ * ! +921100 05 WS-4DCO-4FPU-DONNEES. ! +921200 ! +921300 10 WS-4DCO-4FPU-ZON-CLE. ! +921400 15 WS-4DCO-4FPU-CD-PFL-MDT PIC X(03). ! +921500* CODE PROFIL MANDAT GESTION ! +921600 15 WS-4DCO-4FPU-SAV-ACTION PIC X. ! +921700 88 4FPU-CREAT VALUE 'C'. ! +921800 88 4FPU-MODIF VALUE 'M'. ! +921900 88 4FPU-SUPP VALUE 'A'. ! +922000 88 4FPU-VISU VALUE 'D'. ! +922100 ! +922200 10 WS-4DCO-4FPU-ZON-APLI. ! +922300 15 WS-4DCO-4FPU-LIB-PFL-MDT ! +922400 PIC X(32). ! +922500* LIBELL� LONG DU PROFIL ! +922600 15 WS-4DCO-4FPU-LA-PFL-MDT ! +922700 PIC X(20). ! +922800* LIBELL� COURT DU PROFIL ! +922900 15 WS-4DCO-4FPU-DA-OUV-PFL ! +923000 PIC X(10). ! +923100* DATE OUVERTURE ! +923200 15 WS-4DCO-4FPU-DA-FIN-PFL ! +923300 PIC X(10). ! +923400* DATE FERMETURE ! +923500 15 WS-4DCO-4FPU-PCG-MIN-ACT ! +923600 PIC S9(3)V9(4) COMP-3. ! +923700* POURCENTAGE MINIMUM ACTION ! +923800 15 WS-4DCO-4FPU-PCG-MX-ACT ! +923900 PIC S9(3)V9(4) COMP-3. ! +924000* POURCENTAGE MAXIMUM ACTION ! +924100 15 WS-4DCO-4FPU-PCG-MIN-EURO ! +924200 PIC S9(3)V9(4) COMP-3. ! +924300* POURCENTAGE MINIMUM FONDS EN EUROS ! +924400 15 WS-4DCO-4FPU-TX-FRS-PV ! +924500 PIC S9(3)V9(4) COMP-3. ! +924600* TAUX FRAIS SUR PLUS VALUE ! +924700 ! +924800 ! +924900 10 WS-4DCO-4FPU-ZON-SAV. ! +925000 15 WS-4DCO-4FPU-SV-LIB-PFL-MDT ! +925100 PIC X(32). ! +925200* LIBELL� LONG DU PROFIL ! +925300 15 WS-4DCO-4FPU-SV-LA-PFL-MDT ! +925400 PIC X(20). ! +925500* LIBELL� COURT DU PROFIL ! +925600 15 WS-4DCO-4FPU-SV-DA-OUV-PFL ! +925700 PIC X(10). ! +925800* DATE OUVERTURE ! +925900 15 WS-4DCO-4FPU-SV-DA-FIN-PFL ! +926000 PIC X(10). ! +926100* DATE FERMETURE ! +926200 15 WS-4DCO-4FPU-SV-PCG-MIN-ACT ! +926300 PIC S9(3)V9(4) COMP-3. ! +926400* POURCENTAGE MINIMUM ACTION ! +926500 15 WS-4DCO-4FPU-SV-PCG-MX-ACT ! +926600 PIC S9(3)V9(4) COMP-3. ! +926700* POURCENTAGE MAXIMUM ACTION ! +926800 15 WS-4DCO-4FPU-SV-PCG-MIN-EURO ! +926900 PIC S9(3)V9(4) COMP-3. ! +927000* POURCENTAGE MINIMUM FONDS EN EUROS ! +927100 15 WS-4DCO-4FPU-SV-TX-FRS-PV ! +927200 PIC S9(3)V9(4) COMP-3. ! +927300* TAUX FRAIS SUR PLUS VALUE ! +927400 ! +927500 ! +927600 10 WS-4DCO-4FPU-LIB-OPE PIC X(40). ! +927700* LIBELLE OPERATION ! +927800 05 FILLER PIC X(1580). ! +927900* ! +928000 03 WS-4DCO-4ELB REDEFINES WS-4DCO-PROGRAM. ! +928100* ============= ! +928200* ! +928300* ====m========= ! +928400* ------------------------------------------------------ * ! +928500* COMMAREA : EVOLUTION DE L'APPLICATIF LAB SURAVENIR * ! +928600* COMMAREA : TC4ELB0 * ! +928700* LONGUEUR : 1800 * ! +928800* PREFIXE : WS-4DCO-4ELB0 * ! +928900* ------------------------------------------------------ * ! +929000 05 WS-4DCO-4ELB-DONNEES. ! +929100 ! +929200 10 WS-4DCO-4ELB-DA-DBT-OPE. ! +929300 20 WS-4DCO-4ELB-DA-DBT-OPE-A PIC X(04). ! +929400 20 WS-4DCO-4ELB-DA-DBT-OPE-M PIC X(02). ! +929500 20 WS-4DCO-4ELB-DA-DBT-OPE-J PIC X(02). ! +929600* DATE DEBUT OPERATION ! +929700 10 WS-4DCO-4ELB-DA-FIN-OPE. ! +929800 20 WS-4DCO-4ELB-DA-FIN-OPE-A PIC X(04). ! +929900 20 WS-4DCO-4ELB-DA-FIN-OPE-M PIC X(02). ! +930000 20 WS-4DCO-4ELB-DA-FIN-OPE-J PIC X(02). ! +930100* DATE FIN OPERATION ! +930200 10 WS-4DCO-4ELB-CD-MTF PIC X(03). ! +930300* MOTIF ! +930400 10 WS-4DCO-4ELB-CD-PTN PIC X(05). ! +930500* PARTENAIRE ! +930600 10 WS-4DCO-4ELB-CD-CLI-PTN PIC X(15). ! +930700* IDENTIFIANT ! +930800 10 WS-4DCO-4ELB-SAUV-PAGE-AREA PIC X(160). ! +930900* ! +931000 10 WS-4DCO-4ELB-NB-PAG-TS PIC 9(002). ! +931100* ! +931200 05 FILLER PIC X(1599). ! +931300* 05 FILLER PIC X(1761). ! +931400* ! +931500 03 WS-4DCO-4ECOM REDEFINES WS-4DCO-PROGRAM. ! +931600* ============= ! +931700* ! +931800* ============== ! +931900* ------------------------------------------------------ * ! +932000* COMMAREA : GESTION DU R�F�RENTIEL COMMISSIONS * ! +932100* COMMAREA : TC4EM10 * ! +932200* LONGUEUR : 1800 * ! +932300* PREFIXE : WS-4DCO-4ECOM * ! +932400* ------------------------------------------------------ * ! +932500 05 WS-4DCO-4ECOM-DONNEES. ! +932600*--- GESTION DES HABILITATIONS LIGNE ACTIONS SUR �CRAN DE LISTE ! +932700 10 WS-4DCO-4ECOM-SV-LIGN. ! +932800 12 WS-4DCO-4ECOM-LIB-ACT PIC X(79). ! +932900 12 WS-4DCO-4ECOM-TAB OCCURS 10. ! +933000 15 WS-4DCO-4ECOM-CD-ACTION PIC X(01). ! +933100 12 WS-4DCO-4ECOM-NB-ACT PIC 9(02). ! +933200 12 WS-4DCO-4ECOM-CD-AUT-APLI-S PIC X(01). ! +933300*--- INFORMATIONS CODE EFS ! +933400 10 WS-4DCO-4ECOM-CD-EFS PIC X(02). ! +933500*--- INFORMATIONS DISTRIBUTEURS ! +933600 10 WS-4DCO-4ECOM-NO-DIS PIC 9(08). ! +933700 10 WS-4DCO-4ECOM-LIB-DIS PIC X(32). ! +933800 10 WS-4DCO-4ECOM-CD-NIV-HIE PIC X(03). ! +933900 10 WS-4DCO-4ECOM-CD-FCT-COM PIC X(01). ! +934000*--- INFORMATIONS CONVENTION ! +934100 10 WS-4DCO-4ECOM-NO-CNV-COM PIC X(25). ! +934200 10 WS-4DCO-4ECOM-DA-DBT-CNV-COM PIC X(08). ! +934300 10 WS-4DCO-4ECOM-DA-FIN-CNV-COM PIC X(08). ! +934400*--- INFORMATIONS entites rglt ! +934500 10 WS-4DCO-4ECOM-NO-ETT-RGL PIC S9(9) COMP. ! +934600*--- sauvegarde du contexte avant d�branchement ! +934700 10 WS-4DCO-4ECOM-SAUV-PAGE-AREA PIC X(200). ! +934800*--- sauvegarde cle de repositionnement avant d�branchement ! +934900 10 WS-4DCO-4ECOM-SAUV-CLE-POS PIC X(32). ! +935000*--- 10 WS-4DCO-4ECOM-SAUV-CLE-POS PIC Z(7)9. ! +935100*--- code partenaire ! +935200 10 WS-4DCO-4ECOM-CD-PTN PIC X(5). ! +935300*--- INFORMATIONS FAMILLES DE COMMISSION ! +935400 10 WS-4DCO-4ECOM-NO-FML-COM PIC X(3). ! +935500 10 WS-4DCO-4ECOM-CD-GRP-COM PIC X(2). ! +935600 10 WS-4DCO-4ECOM-CD-TY-COM PIC X(2). ! +935700 10 WS-4DCO-4ECOM-CD-CAT-COM PIC X(2). ! +935800 10 WS-4DCO-4ECOM-CD-CRI-COM PIC X(3). ! +935900 10 WS-4DCO-4ECOM-LIB-FML-COM PIC X(32). ! +936000 ! +936100 05 FILLER PIC X(1336). ! +936200*--- 05 FILLER PIC X(1380). ! +936300*--- 05 FILLER PIC X(1409). ! +936400 ! +936500 03 WS-4DCO-SIMPLV REDEFINES WS-4DCO-PROGRAM. ! +936600* ============== ! +936700* ------------------------------------------------------ * ! +936800* COMMAREA : SIMULATION PLAN DE VERSEMENT * ! +936900* LONGUEUR : 1800 * ! +937000* PREFIXE : WS-4DCO-SIMPLV * ! +937100* ------------------------------------------------------ * ! +937200 ! +937300 05 WS-4DCO-SIMPLV-DONNEES. ! +937400 10 WS-4DCO-SIMPLV-MT-CAP PIC S9(13)V99 COMP-3. ! +937500 10 WS-4DCO-SIMPLV-MT-BRT-VER-INI PIC S9(13)V99 COMP-3. ! +937600 10 WS-4DCO-SIMPLV-MT-NET-VER-INI PIC S9(13)V99 COMP-3. ! +937700 10 WS-4DCO-SIMPLV-TX-FRS-SCR PIC 9(02)V9(03). ! +937800 10 WS-4DCO-SIMPLV-TX-FRS PIC 9(02)V9(03). ! +937900 10 WS-4DCO-SIMPLV-TX-RVL-PRIM PIC 9(02)V9(03). ! +938000 10 WS-4DCO-SIMPLV-DUR-A PIC 9(02). ! +938100 10 WS-4DCO-SIMPLV-MT-BRT-VER-PER PIC S9(13)V99 COMP-3. ! +938200 10 WS-4DCO-SIMPLV-MT-NET-VER-PER PIC S9(13)V99 COMP-3. ! +938300 10 WS-4DCO-SIMPLV-NB-VER-AN PIC 9(02). ! +938400 10 WS-4DCO-SIMPLV-AN-1 PIC 9(04). ! +938500 10 WS-4DCO-SIMPLV-AN-FIN PIC 9(04). ! +938600 05 FILLER PIC X(1733). ! +938700*================================================================ ! +938800* ! +938900*= APPLICATION : GESTION SPECIFIQUE SURAVENIR = ! +939000* ! +939100*================================================================ ! +939200 ! +939300 03 WS-4DCO-GSS REDEFINES WS-4DCO-PROGRAM. ! +939400* ================ ! +939500* ------------------------------------------------------ * ! +939600* COMMAREA : * ! +939700* LONGUEUR : 1800 * ! +939800* PREFIXE : WS-4DCO-GSS * ! +939900* ------------------------------------------------------ * ! +940000 ! +940100 05 WS-4DCO-GSS-SAUV-PAGE-AREA PIC X(160). ! +940200* SAUVEGARDE PAGE AREA START ! +940300 05 WS-4DCO-GSS-NB-PAG-TS PIC 9(2). ! +940400* SAUVEGARDE NB PAGE TS ! +940500 05 FILLER PIC X(1638). ! +940600* ZONES DISPONIBLES ! +940700*================================================================ ! +940800* ! +940900*= APPLICATION : GESTION DES ADMINISTRATEURS = ! +941000* ! +941100*================================================================ ! +941200 ! +941300 03 WS-4DCO-ADM REDEFINES WS-4DCO-PROGRAM. ! +941400* ================ ! +941500* ------------------------------------------------------ * ! +941600* COMMAREA : * ! +941700* LONGUEUR : 1800 * ! +941800* PREFIXE : WS-4DCO-ADM * ! +941900* ------------------------------------------------------ * ! +942000 ! +942100 05 WS-4DCO-ADM-NO-GRP-PSE PIC 9(10) COMP. ! +942200* NUMERO GROUPE PERSONNE ! +942300 05 WS-4DCO-ADM-CD-ROL PIC X(06). ! +942400* CODE ROLE ! +942500 05 WS-4DCO-ADM-A-FIS PIC 9(04). ! +942600* ANNEE FISCALE ! +942700 05 FILLER PIC X(1782). ! +942800* ZONES DISPONIBLES ! +942900*================================================================ ! +943000* ! +943100*= APPLICATION : EDITION AVIS D'OPERE = ! +943200* ! +943300*================================================================ ! +943400 03 WS-4DCO-AVOP REDEFINES WS-4DCO-PROGRAM. ! +943500* ============ ! +943600* ------------------------------------------------------ * ! +943700* COMMAREA : * ! +943800* LONGUEUR : 1800 * ! +943900* PREFIXE : WS-4DCO-AVOP * ! +944000* ------------------------------------------------------ * ! +944100 05 FILLER PIC X(1793). ! +944200* ZONES DISPONIBLES ! +944300 05 WS-4DCO-AVOP-TRAN-PROV PIC X(04). ! +944400* TRANSACTION PRECEDENT AVIS OPERE ! +944500 05 WS-4DCO-AVOP-IDC-AVOP PIC X. ! +944600* INDICATEUR EDITION AVIS D'OPERATION ! +944700 05 WS-4DCO-AVOP-CD-AVOP PIC X(02). ! +944800* TYPE D'AVIS D'OPERE A EDITER ! +944900*================================================================ ! +945000* ! +945100*= APPLICATION : gestion du terme mono-supports = ! +945200* ! +945300*================================================================ ! +945400 03 WS-4DCO-4DGA REDEFINES WS-4DCO-PROGRAM. ! +945500* ============ ! +945600* ------------------------------------------------------ * ! +945700* COMMAREA : * ! +945800* LONGUEUR : 1800 * ! +945900* PREFIXE : WS-4DCO-4DGA * ! +946000* ------------------------------------------------------ * ! +946100 05 WS-4DCO-4DGA-IDC-TT-ECN PIC X(01). ! +946200* INDICATEUR TRAITEMENT ECHEANCE ! +946300 05 FILLER PIC X(1799). ! +946400* ZONES DISPONIBLES ! +946500*================================================================ ! +946600* ! +946700*= APPLICATION : rattachement au type de produit = ! +946800* ! +946900*================================================================ ! +947000 03 WS-4DCO-4DYT-PRM-FSC REDEFINES WS-4DCO-PROGRAM. ! +947100* ============ ! +947200* ------------------------------------------------------ * ! +947300* COMMAREA : * ! +947400* LONGUEUR : 1800 * ! +947500* PREFIXE : WS-4DCO-4DYT * ! +947600* ------------------------------------------------------ * ! +947700 05 WS-4DCO-4DYT-NO-GEN PIC X(003). ! +947800 05 WS-4DCO-4DYT-NO-TY-PRD PIC 9(002). ! +947900 05 WS-4DCO-4DYT-NO-GEN-TY-PRD PIC X(003). ! +948000 05 WS-4DCO-4DYT-CD-PTN PIC X(005). ! +948100 05 WS-4DCO-4DYT-CD-PRD PIC X(002). ! +948200 05 FILLER PIC X(1785). ! +948300* ZONES DISPONIBLES ! +948400*================================================================ ! +948500* ! +948600*= APPLICATION : rattachement au produit commercial ! +948700* ! +948800*================================================================ ! +948900 03 WS-4DCO-4DYs-PRM-FSC REDEFINES WS-4DCO-PROGRAM. ! +949000* ============ ! +949100* ------------------------------------------------------ * ! +949200* COMMAREA : * ! +949300* LONGUEUR : 1800 * ! +949400* PREFIXE : WS-4DCO-4DYs * ! +949500* ------------------------------------------------------ * ! +949600 05 WS-4DCO-4DYs-NO-GEN PIC X(003). ! +949700 05 WS-4DCO-4DYs-NO-TY-PRD PIC 9(002). ! +949800 05 WS-4DCO-4DYs-NO-GEN-TY-PRD PIC X(003). ! +949900 05 WS-4DCO-4DYs-CD-PTN PIC X(005). ! +950000 05 WS-4DCO-4DYs-CD-PRD PIC X(002). ! +950100 05 FILLER PIC X(1785). ! +950200* ZONES DISPONIBLES ! +950300 03 WS-4DCO-4DX REDEFINES WS-4DCO-PROGRAM. ! +950400* =========== ! +950500* ! +950600* ============== ! +950700* ------------------------------------------------------ * ! +950800* COMMAREA : GESTION DES CONTRATS ET CAM * ! +950900* LONGUEUR : 1800 * ! +951000* PREFIXE : WS-4DCO-4DX * ! +951100* ------------------------------------------------------ * ! +951200 05 WS-4DCO-4DX-DONNEES. ! +951300 10 WS-4DCO-4DX-CD-CTR PIC X(08). ! +951400* Code contrat assurance ! +951500 10 WS-4DCO-4DX-LIB-CTR-AS PIC X(32). ! +951600* Libell� contrat assurance ! +951700 10 WS-4DCO-4DX-PAGE-AREA PIC X(80). ! +951800* SAUVEGARDE PAGE AREA START ! +951900* Code �v�nement param�trage ! +952000 10 WS-4DCO-4DX-CD-CAT-MIT PIC X(06). ! +952100* CODE CATEGORIE MINISTERIELLE ! +952110* sauve parametres de la liste recue ! +952111 05 WS-4DCO-4DX-LISTE-TS. ! +952120 10 WS-4DCO-4DX-NB-PAG-TS PIC 9(02). ! +952130 10 WS-4DCO-4DX-NB-OCC-TS PIC S9(4) COMP. ! +952200* ! +952300 05 FILLER PIC X(1670). ! + *----------------------------------------------! END Y4DGEODE ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY YC4ESDSF ! + *------------------------------------------------------------------- +000010*CPG* 11 YC4ESDSF COPY COMMAREA PLATEFORME ! +000020* LG=02000, STRUCTURE MAJ LE 14/04/06 PAR AS232 ! +000030* GENERE LE 14/04/06 A 10H55, PFX : YC4ESD- MEMBRE : YC4ESDSF ! +000040 03 YC4ESD-YC4ESDSF. ! +000050* COPY COMMAREA PLATEFORME 1 13/11/98 ! +000060 10 YC4ESD-PGM-CICS-APL PIC X(8). ! +000070* PROGRAMME CICS APPLICATION 1 30/07/03 ! +000080 10 YC4ESD-PGM-CICS-APL-D PIC X(8). ! +000090* PROGRAMME CICS APPLICATION SX:-D 9 - - ! +000100 10 YC4ESD-NB-PAG-TS PIC 9(3) COMP. ! +000110* NOMBRE DE PAGES EN TS 17 - - ! +000120 10 YC4ESD-CD-MES-ERR PIC X(6). ! +000130* CODE MESSAGE ERREUR 19 - - ! +000140 10 YC4ESD-ZONE-RCP. ! +010010* ZONE GROUPE POUR ECRANS RECAP 25 13/11/98 ! +010020 15 YC4ESD-DA-DBT PIC X(8). ! +010030* DATE DEBUT 25 30/07/03 ! +010040 15 YC4ESD-DA-FIN PIC X(8). ! +010050* DATE FIN 33 - - ! +010060 15 YC4ESD-CD-ENT-SRT PIC X(1). ! +010070* CODE ENTREE SORTIE 41 - - ! +010080 15 YC4ESD-CD-DMN-OPE PIC X(2) OCCURS 12. ! +010090* CODE DOMAINE OPERATION 42 - - ! +010100 10 YC4ESD-NB-OCC PIC 9(2). ! +010110* NOMBRE OCCURRENCE 66 - - ! +010120 10 YC4ESD-LIST-DOM-HAB OCCURS 20. ! +010130* LISTE DOMAINES HABILIT�S PAR SALARI� 68 12/11/98 ! +010140 15 YC4ESD-CD-DMN-OPE PIC X(2). ! +020010* CODE DOMAINE OPERATION 68 30/07/03 ! +020020 15 YC4ESD-MT-MIN-M PIC 9(13)V9(2) COMP-3. ! +020030* MONTANT MINIMUM MOIS 70 - - ! +020040 15 YC4ESD-MT-MX-M PIC 9(13)V9(2) COMP-3. ! +020050* MONTANT MAXIMUM MOIS 78 - - ! +020060 15 YC4ESD-IDC-CRI PIC X(1). ! +020070* INDICATEUR CRITERE 86 - - ! +020080 10 YC4ESD-ZONE-VISU. ! +020090* ZONE GROUPE POUR LES ECRANS DE VISU 448 13/11/98 ! +020100 15 YC4ESD-LIB-NOM PIC X(32). ! +020110* LIBELLE NOM 448 30/07/03 ! +020120 15 YC4ESD-LIB-PRN PIC X(32). ! +020130* LIBELLE PRENOM 480 - - ! +020140 15 YC4ESD-CD-PTN PIC X(5). ! +030010* CODE PARTENAIRE 512 - - ! +030020 15 YC4ESD-NO-POL-9. ! +030030* NUMERO POLICE NEUF 517 12/08/05 ! +030040 17 YC4ESD-NO-POL PIC X(8). ! +030050* NUMERO POLICE 517 30/07/03 ! +030060 17 YC4ESD-CLE-POL PIC X(1). ! +030070* CLE POLICE 525 - - ! +030080 15 YC4ESD-NO-DOS-SIN-DCS PIC 9(13) COMP-3. ! +030090* NUMERO DOSSIER SINISTRE DECES 526 - - ! +030100 15 YC4ESD-MT-OPE-SIT PIC 9(13)V9(2). ! +030110* MONTANT OPERATION SIT 533 - - ! +030120 15 YC4ESD-CD-STA-OPE PIC X(1). ! +030130* CODE STATUT OPERATION 548 - - ! +030140 15 YC4ESD-CD-DMN-OPE PIC X(2). ! +040010* CODE DOMAINE OPERATION 549 - - ! +040020 15 YC4ESD-CD-ENT-SRT PIC X(1). ! +040030* CODE ENTREE SORTIE 551 - - ! +040040 15 YC4ESD-RAC-CLE. ! +040050* GROUPE COMPTE 552 25/10/05 ! +040060 17 YC4ESD-RACINE PIC X(7). ! +040070* RACINE DU CLIENT 552 30/07/03 ! +040080 17 YC4ESD-CLE-RACINE PIC X(1). ! +040090* CL� DE LA RACINE DU CLIENT 559 - - ! +040100 15 YC4ESD-CD-PRD PIC X(2). ! +040110* CODE PRODUIT 560 - - ! +040120 10 YC4ESD-ZONE-VISU-DET. ! +040130* ZONE GROUPE POUR ECRANS VISU DETAIL 562 12/01/99 ! +040140 15 YC4ESD-CD-STA-OPE PIC X(1). ! +050010* CODE STATUT OPERATION 562 30/07/03 ! +050020 15 YC4ESD-CD-ENT-SRT PIC X(1). ! +050030* CODE ENTREE SORTIE 563 - - ! +050040 15 YC4ESD-DA-ENT-OPE PIC X(8). ! +050050* DATE ENTREE OPERATION 564 - - ! +050060 15 YC4ESD-NO-SEQ-OP PIC X(6). ! +050070* NUMERO SEQUENCE SX:-OP 572 - - ! +050080 10 YC4ESD-ZONE-VALID. ! +050090* ZONE GROUPE POUR ECRANS DE VALIDATION 578 13/11/98 ! +050100 15 YC4ESD-CD-STA-OPE PIC X(1). ! +050110* CODE STATUT OPERATION 578 30/07/03 ! +050120 15 YC4ESD-CD-ENT-SRT PIC X(1). ! +050130* CODE ENTREE SORTIE 579 - - ! +050140 15 YC4ESD-DA-ENT-OPE PIC X(8). ! +060010* DATE ENTREE OPERATION 580 - - ! +060020 15 YC4ESD-DA-THR-GEN-OPE PIC X(8). ! +060030* DATE THEORIQUE GENERATION OPERATION 588 - - ! +060040 15 YC4ESD-NO-SEQ PIC X(6). ! +060050* NUMERO SEQUENCE 596 - - ! +060060 15 YC4ESD-CD-DMN-OPE PIC X(2). ! +060070* CODE DOMAINE OPERATION 602 - - ! +060080 15 YC4ESD-LIB-DMN-OPE PIC X(32). ! +060090* LIBELLE DOMAINE OPERATION 604 - - ! +060100 15 YC4ESD-CD-PTN PIC X(5). ! +060110* CODE PARTENAIRE 636 - - ! +060120 15 YC4ESD-NO-DOS-SIN-DCS PIC 9(13) COMP-3. ! +060130* NUMERO DOSSIER SINISTRE DECES 641 - - ! +060140 15 YC4ESD-CD-PTN-R PIC X(5). ! +070010* CODE PARTENAIRE SX:-R 648 - - ! +070020 15 YC4ESD-NO-DOS-SIN-DCS-R PIC 9(13) COMP-3. ! +070030* NUMERO DOSSIER SINISTRE DECES SX:-R 653 - - ! +070040 15 YC4ESD-MT-OPE-SIT PIC 9(13)V9(2). ! +070050* MONTANT OPERATION SIT 660 - - ! +070060 10 YC4ESD-NO-OCC-M PIC 9(2). ! +070070* NUMERO OCCURRENCE SX:-M 675 - - ! +070080 10 YC4ESD-ZONE-MANUEL. ! +070090* ZONE GROUPE POUR ECRANS VIR. MANUEL 677 13/11/98 ! +070100 15 YC4ESD-NO-CHX-MNU PIC X(2). ! +070110* NUMERO CHOIX MENU 677 30/07/03 ! +070120 15 YC4ESD-ZONE-OCC-MAN OCCURS 14. ! +070130* ZONE OCC POUR MULTI-DETAIL MVTS MANUEL 679 02/03/99 ! +070140 20 YC4ESD-DA-ENT-OPE PIC X(8). ! +080010* DATE ENTREE OPERATION 679 30/07/03 ! +080020 20 YC4ESD-NO-SEQ PIC X(6). ! +080030* NUMERO SEQUENCE 687 - - ! +080040 20 YC4ESD-IDC-PEC-OPE PIC X(1). ! +080050* INDICATEUR PRISE-EN-COMPTE OPERATION 693 - - ! +080060 15 YC4ESD-IDT-CPT-FNC PIC X(4). ! +080070* IDENTIFIANT COMPTE FINANCIER 889 18/09/03 ! +080080 15 YC4ESD-MT-TOT-CPT-DEB PIC S9(13)V9(2) COMP-3. ! +080090* MONTANT TOTAL COMPTE DEBIT 893 30/07/03 ! +080100 15 YC4ESD-MT-OPE-CU PIC S9(13)V9(2) COMP-3. ! +080110* MONTANT OPERATION SX:-CU 901 - - ! +080120 15 YC4ESD-CD-BQE-EM PIC 9(5). ! +080130* CODE BANQUE EMETTEUR 909 - - ! +080140 15 YC4ESD-CD-GUI-EM PIC X(5). ! +090010* CODE GUICHET EMETTEUR 914 - - ! +090020 15 YC4ESD-NO-CPT-EM PIC X(11). ! +090030* NUMERO COMPTE EMETTEUR 919 - - ! +090040 15 YC4ESD-DA-VAL PIC X(8). ! +090050* DATE VALIDITE 930 - - ! +090060 15 YC4ESD-MT-OPE PIC S9(13)V9(2) COMP-3. ! +090070* MONTANT OPERATION 938 - - ! +090080 15 YC4ESD-CD-DVS-OPE PIC X(3). ! +090090* CODE DEVISE OPERATION 946 - - ! +090100 15 YC4ESD-RAI-SOC PIC X(32). ! +090110* RAISON SOCIALE 949 - - ! +090120 15 YC4ESD-LIB-DEB-VIR PIC X(32). ! +090130* LIBELLE DEBIT VIREMENT 981 - - ! +090140 10 YC4ESD-ZONE-MODIF. ! +100010* ZONE GROUPE POUR ECRANS MODIF ANOMALIE1013 01/12/98 ! +100020 15 YC4ESD-CD-STA-OPE PIC X(1). ! +100030* CODE STATUT OPERATION 1013 30/07/03 ! +100040 15 YC4ESD-CD-ENT-SRT PIC X(1). ! +100050* CODE ENTREE SORTIE 1014 - - ! +100060 15 YC4ESD-DA-THR-GEN-OPE PIC X(8). ! +100070* DATE THEORIQUE GENERATION OPERATION 1015 - - ! +100080 15 YC4ESD-NO-SEQ PIC X(6). ! +100090* NUMERO SEQUENCE 1023 - - ! +100100 15 YC4ESD-CD-APLI-OPE PIC X(2). ! +100110* CODE APPLICATION OPERATION 1029 - - ! +100120 15 YC4ESD-LIB-APLI-OPE PIC X(32). ! +100130* LIBELLE APPLICATION OPERATION 1031 - - ! +100140 15 YC4ESD-CD-PTN PIC X(5). ! +110010* CODE PARTENAIRE 1063 - - ! +110020 15 YC4ESD-NO-DOS-SIN-DCS PIC 9(13) COMP-3. ! +110030* NUMERO DOSSIER SINISTRE DECES 1068 - - ! +110040 15 YC4ESD-MT-OPE-SIT PIC 9(13)V9(2). ! +110050* MONTANT OPERATION SIT 1075 - - ! +110060 10 YC4ESD-ZONE-DETAIL OCCURS 14. ! +110070* ZONE GROUPE POUR ECRANS DETAIL 1090 14/12/98 ! +110080 15 YC4ESD-DA-CRE-LOT PIC X(8). ! +110090* DATE CREATION LOT 1090 30/07/03 ! +110100 15 YC4ESD-NO-LOT-SIT PIC X(3). ! +110110* NUMERO LOT SIT 1098 - - ! +110120 10 YC4ESD-NO-OCC-D PIC 9(2). ! +110130* NUMERO OCCURRENCE SX:-D 1244 - - ! +110140 10 YC4ESD-ZONE-OCC-DET OCCURS 12. ! +120010* ZONE OCC POUR MULTI-DETAIL MVTS SIT 1246 26/02/99 ! +120020 15 YC4ESD-CD-ENT-SRT PIC X(1). ! +120030* CODE ENTREE SORTIE 1246 30/07/03 ! +120040 15 YC4ESD-DA-ENT-OPE PIC X(8). ! +120050* DATE ENTREE OPERATION 1247 - - ! +120060 15 YC4ESD-NO-SEQ PIC X(6). ! +120070* NUMERO SEQUENCE 1255 - - ! +120080 15 YC4ESD-CD-STA-OPE PIC X(1). ! +120090* CODE STATUT OPERATION 1261 - - ! +120100 15 YC4ESD-NB-PRT-OPE PIC S9(9) COMP-3. ! +120110* NOMBRE PRESENTATION OPERATION 1262 - - ! +120120 10 YC4ESD-CD-PVN-DATA OCCURS 12. ! +120130* CODE PROVENANCE DONNEES 1498 22/12/93 ! +120140 14 FILLER PIC X(1). ! +130010* 1498 ! +130020 10 YC4ESD-IDC-CRI-VP PIC X(1). ! +130030* INDICATEUR CRITERE SX:-VP1510 30/07/03 ! +130040 10 YC4ESD-IDC-REDI-CR PIC X(1). ! +130050* INDICATEUR REEDITION COURRIER 1511 - - ! +130060 10 YC4ESD-CD-MODE-RGL PIC X(1). ! +130070* CODE MODE REGLEMENT 1512 - - ! +130080 10 YC4ESD-NO-AGT-OPE PIC X(8). ! +130090* NUMERO AGENT OPERATION 1513 - - ! +130100 10 YC4ESD-MT-MX PIC S9(13)V9(2) COMP-3. ! +130110* MONTANT MAXIMUM 1521 24/11/04 ! +130120 03 FILLER PIC X(472). ! +130130* FIN DE STRUCTURE PRINCIPALE 1529 ! + *----------------------------------------------! END YC4ESDSF ---- + + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY XFER3H0 ! + *------------------------------------------------------------------- + ************************************************************* ! + * WORKING PARTICULIERE * ! + ************************************************************* ! + * ! + * SAUVEGARDE DES VALEURS AFFICHEES A L'ECRAN ! + * ! + 03 XF-ZONE-AFF. ! + 05 XF-AFF-DA-PEC-DEM-SP. ! + 10 XF-AFF-DA-PEC-DEM-JJ PIC X(02). ! + 10 XF-AFF-DA-PEC-DEM-MM PIC X(02). ! + 10 XF-AFF-DA-PEC-DEM-SA PIC X(04). ! + 05 XF-AFF-DA-ECN-OPE. ! + 10 XF-AFF-DA-ECN-OPE-JJ PIC X(02). ! + 10 XF-AFF-DA-ECN-OPE-MM PIC X(02). ! + 10 XF-AFF-DA-ECN-OPE-SA PIC X(04). ! + 05 XF-AFF-CD-BQE-DST1 PIC X(05). ! + 05 XF-AFF-CD-GUI-DST1 PIC X(05). ! + 05 XF-AFF-NO-CPT-DST1 PIC X(11). ! + 05 XF-AFF-CLE-RIB1 PIC X(02). ! + 05 XF-AFF-NO-CHQ PIC X(07). ! + 05 XF-AFF-CD-PTN PIC X(05). ! + 05 XF-AFF-REF1L15 PIC X(13). ! + 05 XF-AFF-REF2L15 PIC X(04). ! + 05 XF-AFF-REF1L16 PIC X(02). ! + 05 XF-AFF-REF4L16 PIC X(06). ! + 05 XF-AFF-REF1L17 PIC X(32). ! + 05 XF-AFF-REF1L18. ! + 10 XF-AFF-RF1L18-J PIC X(02). ! + 10 XF-AFF-RF1L18-M PIC X(02). ! + 10 XF-AFF-RF1L18-S PIC X(04). ! + 05 XF-AFF-REF2L18. ! + 10 XF-AFF-RF2L18-J PIC X(02). ! + 10 XF-AFF-RF2L18-M PIC X(02). ! + 10 XF-AFF-RF2L18-S PIC X(04). ! + 05 XF-AFF-REF1L19. ! + 10 XF-AFF-RF1L19-J PIC X(02). ! + 10 XF-AFF-RF1L19-M PIC X(02). ! + 10 XF-AFF-RF1L19-S PIC X(04). ! + 05 XF-AFF-REF2L19 PIC X(03). ! + 05 XF-AFF-REF3L19 PIC X(01). ! + 05 XF-AFF-REF5L19 PIC X(01). ! + 05 XF-AFF-MEMO-YN4ESPS. ! + 10 XF-AFF-MEMO-ZON1 PIC X(127). ! + 10 XF-AFF-MEMO-ZON2 PIC 9(3) COMP-3. ! + 10 XF-AFF-MEMO-ZON3 PIC 9(3) COMP-3. ! + 10 XF-AFF-MEMO-ZON4 PIC 9(7) COMP-3. ! + 10 XF-AFF-MEMO-ZON5 PIC 9(2) COMP-3. ! + 10 XF-AFF-MEMO-ZON6 PIC X(124). ! + 10 XF-AFF-MEMO-ZON7 PIC 9(13) COMP-3. ! + 10 XF-AFF-MEMO-ZON8 PIC X(113). ! + 05 XF-VALIDATION PIC X. ! + 88 DEMANDE-DE-VALIDATION VALUE 'V'. ! + 88 ENTREE-PGM VALUE 'E'. ! + ! + *----------------------------------------------! END XFER3H0 ---- + + 02 SCREEN-IMAGE-AREA. + 05 SCI-AREA-HEADER. + 10 FILLER PIC X. + 10 SCI-WRITE-INDICATOR PIC X. + 88 SCREEN-HAS-BEEN-WRITTEN VALUE HIGH-VALUES. + 88 SCREEN-FIRST-WRITE VALUE LOW-VALUES. + 10 SCI-MODIFY-INDICATOR PIC X. + 88 FIELD-HAS-BEEN-MODIFIED VALUE HIGH-VALUES. + 88 NO-FIELD-MODIFIED VALUE LOW-VALUES. + 10 SCI-ALARM-INDICATOR PIC X. + 88 SET-ALARM-ON-WRITE VALUE HIGH-VALUES. + 88 NO-ALARM-ON-WRITE VALUE LOW-VALUES. + 10 FILLER PIC X(8). + 05 SCREEN-IMAGE PIC X(1051). + 05 SCREEN-IMAGE-END PIC X. + LINKAGE SECTION. + EJECT + ******************************************************** + * L I N K A G E S E C T I O N * + ******************************************************** + SKIP2 + SKIP2 + 01 DFHCOMMAREA. + 05 COM-SPA-AREA PIC X OCCURS 1 TO 32500 TIMES + DEPENDING ON EIBCALEN. + SKIP2 + EJECT + EJECT + ******************************************************** + * * + * P R O C E D U R E D I V I S I O N * + * * + ******************************************************** + PROCEDURE DIVISION. + SKIP3 + MAIN-LINE SECTION. + ******************************************************** + * M A I N L I N E * + ******************************************************** + SET SEC-INDEX TO 1. + MOVE 'TELON ID' TO TELON-RELEASE-EYECATCH. + SKIP1 + * PROGRAM CUSTOM CONTROL MAINI + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEMAINI ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEMAINI R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * Fonctionnalites : * ! + * GIEMAINI : * ! + * * ! + * traitement normalise effectue au debut de chaque programme * ! + * insere automatiquement au debut de la section MAIN-LINE * ! + * mise au format heure et date de traitement a afficher, puis * ! + * decalage de la commarea si programme de provenance NON TELON.* ! + * conversion des touches de fonction en fonctions. * ! + * * ! + * Dependance avec autres sections : * ! + * GIEC300I * ! + **************************************************************** ! + ! + MOVE EIBTIME TO WS-TLN-TIME. ! + MOVE EIBDATE TO WORKFLD-NUMERIC. ! + CALL 'OJULIAN' USING WS-TLN-DATE ! + WS-TLN-DATE-LTH ! + WORKFLD-NUMERIC. ! + MOVE WS-TLN-JJ TO WS-TLN-MM-AFF. ! + MOVE WS-TLN-MM TO WS-TLN-JJ-AFF. ! + MOVE WS-TLN-AA TO WS-TLN-AA-AFF. ! + ! + MOVE WS-TLN-HH TO WS-TLN-HH-AFF. ! + MOVE WS-TLN-MN TO WS-TLN-MN-AFF. ! + ! + EXEC CICS ASKTIME ABSTIME (WS-TLN-ASKTIME) ! + END-EXEC. ! + ! + EXEC CICS FORMATTIME ABSTIME (WS-TLN-ASKTIME) ! + YEAR (WS-TLN-YEAR) ! + END-EXEC. ! + ! + MOVE WS-TLN-YEAR TO WS-TLN-YEAR-NUM. ! + MOVE WS-TLN-YEAR-NUM TO WS-TLN-SA-AFF. ! + ! + IF EIBCALEN > ZERO ! + MOVE SPACE TO WS-TLN-TYP-PROV ! + MOVE DFHCOMMAREA TO WS-TLN-DEB-SPA ! + IF (WS-TLN-BIN-SPA < WS-TLN-BIN-MIN OR ! + WS-TLN-BIN-SPA > WS-TLN-BIN-MAX) ! + MOVE 'A' TO WS-TLN-TYP-PROV ! + MOVE DFHCOMMAREA TO XFER-DBT-ZON-APL ! + MOVE EIBCALEN TO XFER-LG-SPA-PVN-TLN ! + MOVE ZERO TO EIBCALEN ! + ELSE NEXT SENTENCE ! + ELSE MOVE 'N' TO WS-TLN-TYP-PROV. ! + ! + MOVE 'P00721 ' TO WS-TLN-MODULE. ! + CALL WS-TLN-MODULE USING DFHEIBLK ! + DFHCOMMAREA ! + WS-TLN-PFKEY-INDICATOR ! + WS-TLN-FCT-VALIDATION. ! + ! + *----------------------------------------------! END GIEMAINI ---- + + SKIP1 + IF EIBCALEN = 0 + PERFORM Q-100-CICS-INIT + MOVE LOW-VALUES TO SPA-TRANSACTION-CODE + MOVE NEXT-PROGRAM-NAME TO SPA-NEXT-PROGRAM-NAME + MOVE 08192 TO SPA-LENGTH + MOVE PROCESS-OUTPUT-LIT TO CONTROL-INDICATOR + ELSE + MOVE DFHCOMMAREA TO SPA-AREA + PERFORM Q-100-CICS-INIT + IF SPA-TRANSACTION-CODE = PROGRAM-TRANSACTION-CODE + MOVE PROCESS-INPUT-LIT TO CONTROL-INDICATOR + PERFORM C-100-TERMIO-READ + ELSE + MOVE PROCESS-OUTPUT-LIT TO CONTROL-INDICATOR. + * + * PROCESS THE TRANSACTION + * + MOVE CONTROL-INDICATOR TO ENTRY-CONTROL-INDICATOR. + PERFORM MAIN-PROCESS UNTIL TRANSACTION-COMPLETE. + MAIN-LINE-RETURN. + SKIP1 + * PROGRAM CUSTOM CONTROL MAINT + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEMAINT ! + *------------------------------------------------------------------- + **************************************************************** ! + * CODE PERSONNALISATION : GIEMAINT R1 V1 * ! + * Date de creation : 13/11/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * Permettre un chainage par "RETURN TRANSID" avec une commarea* ! + * constitu�e de : * ! + * - entete telon (16 caracteres). * ! + * - 24 premiers caract�res de la partie applicative. * ! + * Dependance avec autres sections : * ! + **************************************************************** ! + ! + CALL 'ADLAATX' USING DFHEIBLK DFHCOMMAREA. ! + IF SPA-TRANSACTION-CODE = SPACES ! + EXEC CICS RETURN END-EXEC ! + ELSE ! + MOVE PROGRAM-TRANSACTION-CODE TO SPA-TRANSACTION-CODE ! + MOVE WS-TLN-SPA-LENGTH TO SPA-LENGTH ! + MOVE WS-TLN-HOLD-AREA-NAME-DFLT TO WS-TLN-HOLD-AREA-NAME ! + PERFORM K-300-HOLD-SAVE ! + MOVE 40 TO SPA-LENGTH ! + MOVE XFER-DBT-ZON-APL TO SPA-XFER-WORK-AREA ! + EXEC CICS RETURN TRANSID(SPA-TRANSACTION-CODE) ! + COMMAREA(SPA-AREA) ! + LENGTH(SPA-LENGTH) ! + END-EXEC. ! + GOBACK. ! + *----------------------------------------------! END GIEMAINT ---- + + SKIP1 + SKIP3 + ******************************************************** + * R E T U R N T O C I C S * + ******************************************************** + RETURN-TO-CICS. + SKIP1 + CALL 'ADLAATX' USING DFHEIBLK DFHCOMMAREA. + IF SPA-TRANSACTION-CODE = SPACES + EXEC CICS RETURN END-EXEC + ELSE + MOVE PROGRAM-TRANSACTION-CODE TO SPA-TRANSACTION-CODE + MOVE 08192 TO SPA-LENGTH + EXEC CICS RETURN TRANSID(SPA-TRANSACTION-CODE) + COMMAREA(SPA-AREA) + LENGTH(SPA-LENGTH) + END-EXEC. + GOBACK. + EJECT + SKIP3 + MAIN-PROCESS SECTION. + ******************************************************** + * * + * M A I N P R O C E S S * + * * + * PGMSTRUCT 3 * + * * + * THE FLOW OF THE PROGRAM IS CONTROLLED BY THE * + * VARIABLE NAMED CONTROL-INDICATOR. * + * * + * THERE ARE SIX VALUES WHICH INDICATE ACTION. THE * + * INDICATOR IS TESTED WITH THE 88 LEVEL ITEMS LISTED * + * BELOW. THERE ARE ALSO CORRESPONDING DATA ITEMS * + * WITH THE SUFFIX '-LIT' WHICH ARE USED TO SET THE * + * CONTROL-INDICATOR. * + * * + * 88 LEVEL NAME A C T I O N * + * ------------------- ----------------------- * + * PROCESS-OUTPUT - BUILD A SCREEN FOR OUTPUT * + * DO-WRITE - WRITE A SCREEN * + * PROCESS-INPUT - PROCESS AN INPUT MESSAGE * + * DO-TRANSFER - TRANSFER TO NEXT PROGRAM * + * TRANSACTION-COMPLETE - RETURN CONTROL TO CALLER * + * CONTINUE-PROCESS - PERFORM NEXT ROUTINE * + * * + ******************************************************** + SKIP1 + IF PROCESS-OUTPUT + PERFORM MAIN-OUTPUT + ELSE + IF DO-WRITE + PERFORM C-200-TERMIO-WRITE + ELSE + IF PROCESS-INPUT + PERFORM MAIN-INPUT + ELSE + IF DO-TRANSFER + PERFORM C-300-TERMIO-XFER + ELSE + PERFORM Z-990-PROGRAM-ERROR. + SKIP1 + MAIN-PROCESS-RETURN. + EXIT. + EJECT + MAIN-OUTPUT SECTION. + ******************************************************** + * M A I N O U T P U T * + ******************************************************** + SKIP1 + MOVE SPACE TO CONTROL-INDICATOR. + IF XFER-HOLD-INDICATOR = 'P' OR 'D' + MOVE XFER-HOLD-INDICATOR TO HOLD-AREA-TYPE + PERFORM K-100-HOLD-RESTORE + ELSE + PERFORM A-100-OUTPUT-INIT + IF CONTINUE-PROCESS + PERFORM B-100-OUTPUT-EDITS. + * + * SET DEFAULT ACTION TO DO-WRITE + * + IF CONTINUE-PROCESS + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR. + SKIP1 + MAIN-OUTPUT-RETURN. + EXIT. + SKIP3 + MAIN-INPUT SECTION. + ******************************************************** + * M A I N I N P U T * + ******************************************************** + SKIP1 + MOVE SPACE TO CONTROL-INDICATOR. + MOVE PROGRAM-NAME OF SYS-WORK-AREA TO NEXT-PROGRAM-NAME-ID. + PERFORM P-100-PFKEYS. + IF CONTINUE-PROCESS + PERFORM D-100-INPUT-INIT + IF CONTINUE-PROCESS + PERFORM E-100-INPUT-EDITS + IF CONTINUE-PROCESS + PERFORM X-100-CONSIS-EDITS + IF CONTINUE-PROCESS + PERFORM H-100-INPUT-TERM. + * + * SET DEFAULT ACTION TO DO-TRANSFER + * + IF CONTINUE-PROCESS + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR. + * + * IF TRANSFER IS TO THE SAME PROGRAM, PROCESS OUTPUT + * + IF DO-TRANSFER + AND (SPA-TRANSACTION-CODE NOT = SPACES) + IF NEXT-PROGRAM-NAME = CURRENT-PROGRAM-NAME + MOVE PROCESS-OUTPUT-LIT TO CONTROL-INDICATOR + ENTRY-CONTROL-INDICATOR. + SKIP1 + MAIN-INPUT-RETURN. + EXIT. + EJECT + A-100-OUTPUT-INIT SECTION. + ******************************************************** + * A - 1 0 0 - O U T P U T - I N I T * + ******************************************************** + * THIS ROUTINE INITIALIZES ANY FIELDS NECESSARY PRIOR * + * TO OUTPUT PROCESSING AND RETRIEVES OUTPUT/OUTIN * + * DATABASE SEGMENTS. * + * * + * GENERATED - TP-OUTPUT-BUFFER FIELD INITIALIZATION * + * COPY CODE - SCREEN/OINIT1 * + * GENERATED - OUTPUT/OUTIN DATA ACCESS AUTO CALLS * + * COPY CODE - SCREEN/OINIT2 * + ******************************************************** + SKIP1 + MOVE LOW-VALUES TO SCREEN-IMAGE-AREA TP-BUFFER. + SKIP1 + * SCREEN/OINIT1 COPY CODE + SKIP1 + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY OINIT1 ! + *------------------------------------------------------------------- + * INITIALISATION DIVERSES ! + ! + *---------------------------------------------------------------- ! + * GESTION DE LA PROVENANCE * ! + * COPY GIECPROV : CE COPY PERMET DE CONTROLER QUE L'APPEL A * ! + * +++++++ CET ECRAN S'EST FAIT A TRAVERS LES MENUS * ! + *---------------------------------------------------------------- ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIECPROV 2! + *------------------------------------------------------------------- + **************************************************************** 2! + * CODE PERSONNALISATION : CMB GIECPROV R1 V1 * 2! + * Date de creation : 27/01/1992 * 2! + * Date de modification : / / * 2! + * * 2! + * Fonctionnalites : * 2! + * Traitement normalise pour controle la validite de l'appel * 2! + * d'une application (appel � partir des menus alice et * 2! + * demande valider par 'f5'. * 2! + * * 2! + * Dependance avec autres sections : * 2! + **************************************************************** 2! + IF APPEL-NATIF 2! + THEN 2! + EXEC CICS SEND TEXT 2! + FROM (WS-TLN-MES-ERR-PROV) 2! + LENGTH (WS-TLN-LG-MES) 2! + ERASE 2! + END-EXEC 2! + MOVE TRANSACTION-COMPLETE-LIT TO CONTROL-INDICATOR 2! + MOVE SPACES TO SPA-TRANSACTION-CODE. 2! + *----------------------------------------------! END GIECPROV ---- + + IF NOT CONTINUE-PROCESS ! + GO TO A-100-OUTPUT-INIT-RETURN. ! + * ! + **************************************************************** ! + * Codification n�cessaire � la gestion automatis�e des * ! + * fonctions RETOUR MENU GENERAL, RETOUR MENU PRECEDENT, * ! + * RETOUR ECRAN PRECEDENT. * ! + **************************************************************** ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEINITI 2! + *------------------------------------------------------------------- + **************************************************************** 2! + * Code personnalisation : CMB GIEINITI R1 V1 * 2! + * Date de creation : 27/01/1992 * 2! + * Date de modification : / / * 2! + * * 2! + * Fonctionnalites : * 2! + * Traitement normalise effectue au debut de la section a-100 * 2! + * pour gestion des fonctions retour a l'ecran precedent, * 2! + * retour au menu precedent, retour au menu principal. * 2! + * permet de preciser que l'on se trouve sur un menu * 2! + * intermediaire. * 2! + * * 2! + * Dependance avec autres sections : * 2! + **************************************************************** 2! + PERFORM 2! + VARYING WS-TLN-IND FROM 1 BY 1 UNTIL 2! + WS-TLN-IND > XFER-NB 2! + IF XFER-PROG(WS-TLN-IND) = CURRENT-PROGRAM-NAME 2! + THEN MOVE WS-TLN-IND TO XFER-NB 2! + MOVE 98 TO WS-TLN-IND 2! + END-IF 2! + END-PERFORM 2! + IF CURRENT-PROGRAM-NAME = XFER-PROG(XFER-NB) 2! + NEXT SENTENCE 2! + ELSE 2! + IF XFER-NB < XFER-NB-MAX 2! + ADD 1 TO XFER-NB 2! + MOVE CURRENT-PROGRAM-NAME TO XFER-PROG(XFER-NB) 2! + MOVE 'M' TO XFER-MENU(XFER-NB) 2! + ELSE 2! + MOVE XFER-PROG2 TO XFER-TABLE-PROG2 2! + MOVE CURRENT-PROGRAM-NAME TO XFER-PROG(XFER-NB) 2! + MOVE 'M' TO XFER-MENU(XFER-NB) 2! + END-IF 2! + END-IF. 2! + 2! + *----------------------------------------------! END GIEINITI ---- + + ! + MOVE PROGRAM-TRANSACTION-CODE TO Y00TLN-CD-TRANS-PROV. ! + ! + MOVE 'TC4E3H0' TO YC4ESD-PGM-CICS-APL-D. ! + SET ENTREE-PGM TO TRUE. ! + PERFORM ACCES-TN4ESPS-005 THRU ACCES-TN4ESPS-005-FIN. ! + * ! + *----------------------------------------------! END OINIT1 ---- + + SKIP1 + SKIP1 + * SCREEN/OINIT2 COPY CODE + SKIP1 + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY OINIT2 ! + *------------------------------------------------------------------- + **************************************************************** ! + * * ! + * OINIT2 * ! + * * ! + **************************************************************** ! + MOVE 'YSP4E064' TO WS-TLN-CODTAB. ! + MOVE 2 TO WS-TLN-LTH-KEY. ! + MOVE '*AB' TO WS-TLN-EL-DEMANDES. ! + * ! + ****************************************************************** ! + * POUR AFFICHAGE DE L'ECRAN DES DIFFERENTES ZONES ! + * SUIVANT LE CODE APPLICATION ! + ****************************************************************** ! + MOVE 'D03' TO WS-TLN-TYPDATE ! + ! + MOVE YN4ESP-DA-PEC-DEM-SP OF YN4ESP-DETAIL-SIT ! + TO WS-DA-PEC-DEM-SP ! + XF-AFF-DA-PEC-DEM-SP. ! + ! + MOVE YN4ESP-DA-ECN-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-ECN-OPE ! + XF-AFF-DA-ECN-OPE. ! + ! + * CALCUL DE LA CLE RIB ! + ! + MOVE YN4ESP-CD-BQE-DST OF YN4ESP-DETAIL-SIT ! + TO WS-CPT-BQE. ! + MOVE YN4ESP-CD-GUI-DST OF YN4ESP-DETAIL-SIT ! + TO WS-CPT-GUI. ! + MOVE YN4ESP-NO-CPT-DST OF YN4ESP-DETAIL-SIT ! + TO WS-CPT-CPT. ! + MOVE ZERO TO WS-CPT-RIB-CLE. ! + ! + PERFORM ACCES-P00271 THRU ACCES-P00271-FIN. ! + MOVE WS-CPT-RIB-CLE TO WS-CLE-RIB. ! + ! + MOVE YN4ESP-CD-BQE-DST OF YN4ESP-DETAIL-SIT ! + TO WS-CD-BQE-DST1 ! + XF-AFF-CD-BQE-DST1 ! + MOVE YN4ESP-CD-GUI-DST OF YN4ESP-DETAIL-SIT ! + TO WS-CD-GUI-DST1 ! + XF-AFF-CD-GUI-DST1 ! + MOVE YN4ESP-NO-CPT-DST OF YN4ESP-DETAIL-SIT ! + TO WS-NO-CPT-DST1 ! + XF-AFF-NO-CPT-DST1 ! + ! + MOVE WS-CD-BQE-DST1 TO WS-CPT-BQE. ! + MOVE WS-CD-GUI-DST1 TO WS-CPT-GUI. ! + MOVE WS-NO-CPT-DST1 TO WS-CPT-CPT. ! + MOVE ZERO TO WS-CPT-RIB-CLE. ! + ! + PERFORM ACCES-P00271 THRU ACCES-P00271-FIN. ! + MOVE WS-CPT-RIB-CLE TO WS-CLE-RIB1. ! + ! + PERFORM ACCES-SPI053 THRU ACCES-SPI053-FIN. ! + MOVE YSP4E053-LIB-MODE-RGL TO WS-LIB-RGL. ! + ! + IF YN4ESP-CD-MODE-RGL-OPE OF YN4ESP-DETAIL-SIT NOT = 'C' ! + MOVE PROT-ATTR TO TPO-NOCHQ-ATTR ! + END-IF. ! + ! + MOVE YN4ESP-NO-CHQ OF YN4ESP-DETAIL-SIT ! + TO WS-NO-CHQ ! + XF-AFF-NO-CHQ ! + ! + * VALORISATION DES ZONES DE REFERENCE DE GESTION ! + * SELON LA VALEUR DU CODE APPLICATION ! + ! + EVALUATE YN4ESP-CD-APLI-OPE OF YN4ESP-DETAIL-SIT ! + WHEN 'CH' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER 'TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'NUM LOT CHEQUE :' TO WS-LIB2 ! + MOVE PROT-ATTR TO TPO-REF1L15-ATTR ! + MOVE YN4ESP-NO-LOT-CHQ OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + MOVE PROT-ATTR TO TPO-REF2L15-ATTR ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE SPACES TO WS-LIB5 ! + MOVE PROT-ATTR TO TPO-REF1L17-ATTR ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE 'DATE EFFET ' TO WS-LIB6B ! + MOVE YN4ESP-DA-EFF OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L18 ! + XF-AFF-REF2L18 ! + * LIGNE 19 ! + MOVE PROT-ATTR TO TPO-RF1L19J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19A-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF5L19-ATTR ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN 'P7' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER 'TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'SOUSCRIPTION :' TO WS-LIB2 ! + MOVE YN4ESP-NO-POL-9 OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + MOVE 'PRODUIT :' TO WS-LIB3 ! + MOVE YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L15 ! + XF-AFF-REF2L15 ! + IF YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT = SPACES ! + MOVE SPACES TO WS-REF3L15 ! + ELSE ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S NOT = ZERO ! + MOVE SPACES TO XF-AFF-REF2L15 ! + END-IF ! + END-IF ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'NOM-PRENOM :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE 'DATE SOUSCRIP. :' TO WS-LIB6 ! + MOVE YN4ESP-DA-SCR-CTR OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L18 ! + XF-AFF-REF1L18 ! + ! + MOVE 'DATE EFFET ' TO WS-LIB6B ! + MOVE YN4ESP-DA-EFF OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L18 ! + XF-AFF-REF2L18 ! + * LIGNE 19 ! + MOVE 'EVENEMENT :' TO WS-LIB7 ! + MOVE YN4ESP-DA-CRE-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L19 ! + XF-AFF-REF1L19 ! + ! + MOVE YN4ESP-CD-TY-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L19 ! + XF-AFF-REF2L19 ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + MOVE 'CODE MINITEL ' TO WS-LIB8 ! + MOVE YN4ESP-CD-MTL OF YN4ESP-DETAIL-SIT ! + TO WS-REF5L19 ! + XF-AFF-REF5L19 ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN '4D' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'CONTRAT :' TO WS-LIB2 ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE YN4ESP-RAC-CLE OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + ELSE ! + MOVE YN4ESP-NO-POL-9 OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + END-IF ! + MOVE 'PRODUIT :' TO WS-LIB3 ! + MOVE YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L15 ! + XF-AFF-REF2L15 ! + IF YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT = SPACES ! + MOVE SPACES TO WS-REF3L15 ! + ELSE ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S NOT = ZERO ! + MOVE SPACES TO XF-AFF-REF2L15 ! + END-IF ! + END-IF ! + * LIGNE 16 ! + MOVE 'RANG ' TO WS-LIB4 ! + MOVE YN4ESP-NO-ORD-CTR OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L16 ! + XF-AFF-REF1L16 ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'NOM-PRENOM :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE 'DATE SOUSCRIP. :' TO WS-LIB6 ! + MOVE YN4ESP-DA-SCR-CTR OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L18 ! + XF-AFF-REF1L18 ! + ! + MOVE 'DATE EFFET ' TO WS-LIB6B ! + MOVE YN4ESP-DA-EFF OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L18 ! + XF-AFF-REF2L18 ! + * LIGNE 19 ! + MOVE 'EVENEMENT :' TO WS-LIB7 ! + MOVE YN4ESP-DA-CRE-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L19 ! + XF-AFF-REF1L19 ! + ! + MOVE YN4ESP-CD-TY-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L19 ! + XF-AFF-REF2L19 ! + MOVE YN4ESP-CD-CLO-ECN OF YN4ESP-DETAIL-SIT ! + TO WS-REF3L19 ! + XF-AFF-REF3L19 ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + MOVE 'CODE MINITEL ' TO WS-LIB8 ! + MOVE YN4ESP-CD-MTL OF YN4ESP-DETAIL-SIT ! + TO WS-REF5L19 ! + XF-AFF-REF5L19 ! + YN4ESP-CD-MTL OF YN4ESP-ZONE-ALLER ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN '4F' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'CONTRAT :' TO WS-LIB2 ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE YN4ESP-RAC-CLE OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + ELSE ! + MOVE YN4ESP-NO-POL-9 OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + END-IF ! + MOVE 'PRODUIT :' TO WS-LIB3 ! + MOVE YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L15 ! + XF-AFF-REF2L15 ! + IF YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT = SPACES ! + MOVE SPACES TO WS-REF3L15 ! + ELSE ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S NOT = ZERO ! + MOVE SPACES TO XF-AFF-REF2L15 ! + END-IF ! + END-IF ! + * LIGNE 16 ! + MOVE 'RANG ' TO WS-LIB4 ! + MOVE YN4ESP-NO-ORD-CTR OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L16 ! + XF-AFF-REF1L16 ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'NOM-PRENOM :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE 'DATE SOUSCRIP. :' TO WS-LIB6 ! + MOVE YN4ESP-DA-SCR-CTR OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L18 ! + XF-AFF-REF1L18 ! + ! + MOVE 'DATE EFFET ' TO WS-LIB6B ! + MOVE YN4ESP-DA-EFF OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L18 ! + XF-AFF-REF2L18 ! + * LIGNE 19 ! + MOVE 'EVENEMENT :' TO WS-LIB7 ! + MOVE YN4ESP-DA-CRE-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L19 ! + XF-AFF-REF1L19 ! + ! + MOVE YN4ESP-CD-TY-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L19 ! + XF-AFF-REF2L19 ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + MOVE 'CODE MINITEL ' TO WS-LIB8 ! + MOVE YN4ESP-CD-MTL OF YN4ESP-DETAIL-SIT ! + TO WS-REF5L19 ! + XF-AFF-REF5L19 ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN '37' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'NUMERO ADHESION :' TO WS-LIB2 ! + MOVE YN4ESP-NO-CLI-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + MOVE 'PRODUIT :' TO WS-LIB3 ! + MOVE YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L15 ! + XF-AFF-REF2L15 ! + IF YN4ESP-CD-PRD OF YN4ESP-DETAIL-SIT = SPACES ! + MOVE SPACES TO WS-REF3L15 ! + ELSE ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S NOT = ZERO ! + MOVE SPACES TO XF-AFF-REF2L15 ! + END-IF ! + END-IF ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'NOM-PRENOM :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE 'DATE SOUSCRIP. :' TO WS-LIB6 ! + MOVE YN4ESP-DA-SCR-CTR OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L18 ! + XF-AFF-REF1L18 ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE 'EVENEMENT :' TO WS-LIB7 ! + MOVE YN4ESP-DA-CRE-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L19 ! + XF-AFF-REF1L19 ! + ! + MOVE YN4ESP-CD-TY-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L19 ! + XF-AFF-REF2L19 ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + MOVE 'CODE MINITEL ' TO WS-LIB8 ! + MOVE YN4ESP-CD-MTL OF YN4ESP-DETAIL-SIT ! + TO WS-REF5L19 ! + XF-AFF-REF5L19 ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN '4G' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'SINISTRE :' TO WS-LIB2 ! + MOVE YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-ZONE-ALLER ! + MOVE PROT-ATTR TO TPO-REF2L15-ATTR ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'NOM-PRENOM :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE 'EVENEMENT :' TO WS-LIB7 ! + MOVE YN4ESP-DA-CRE-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L19 ! + XF-AFF-REF1L19 ! + ! + MOVE YN4ESP-CD-TY-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L19 ! + XF-AFF-REF2L19 ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + MOVE SPACES TO WS-LIB8 ! + MOVE SPACES TO WS-REF5L19 ! + ! + MOVE PROT-ATTR TO TPO-REF5L19-ATTR ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN 'CO' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'DATE COMMISSION :' TO WS-LIB2 ! + MOVE YN4ESP-DA-CRE-LOT-COM OF YN4ESP-DETAIL-SIT ! + TO WS-DA8 ! + MOVE WS-DA8-JJ TO WS-DA10-JJ ! + MOVE WS-DA8-MM TO WS-DA10-MM ! + MOVE WS-DA8-SS TO WS-DA10-SS ! + MOVE WS-DA8-AA TO WS-DA10-AA ! + MOVE WS-DA10 TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + MOVE PROT-ATTR TO TPO-REF1L15-ATTR ! + ! + MOVE 'TYPE ' TO WS-LIB3 ! + MOVE YN4ESP-CD-TY-COM OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L15 ! + XF-AFF-REF2L15 ! + MOVE PROT-ATTR TO TPO-REF2L15-ATTR ! + IF YN4ESP-CD-TY-COM OF YN4ESP-DETAIL-SIT = 'M' ! + MOVE 'PRODUCTION' TO WS-REF3L15 ! + ELSE ! + IF YN4ESP-CD-TY-COM OF YN4ESP-DETAIL-SIT = 'E' ! + MOVE 'ENCOURS' TO WS-REF3L15 ! + ELSE ! + IF YN4ESP-CD-TY-COM OF YN4ESP-DETAIL-SIT = 'Z' ! + MOVE 'PRODUCTION RETROACTIVE' ! + TO WS-REF3L15 ! + END-IF ! + END-IF ! + END-IF ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'CORRESPONDANT :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM-CRP-COM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE PROT-ATTR TO TPO-RF1L19J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19A-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF5L19-ATTR ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN 'AS' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'NO DOSSIER :' TO WS-LIB2 ! + MOVE YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-ZONE-ALLER ! + MOVE PROT-ATTR TO TPO-REF1L15-ATTR ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE PROT-ATTR TO TPO-RF1L19J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19A-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF5L19-ATTR ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN 'RE' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE 'NO DOSSIER :' TO WS-LIB2 ! + MOVE YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L15 ! + XF-AFF-REF1L15 ! + YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-ZONE-ALLER ! + MOVE PROT-ATTR TO TPO-REF1L15-ATTR ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE 'NOM-PRENOM :' TO WS-LIB5 ! + MOVE YN4ESP-LIB-NOM OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L17 ! + XF-AFF-REF1L17 ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE PROT-ATTR TO TPO-RF1L19J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19A-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF5L19-ATTR ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN 'DG' ! + * LIGNE 14 ! + MOVE PROT-ATTR TO TPO-CDPTN-ATTR ! + MOVE 'ECHANGE FINANCIER ' TO WS-LIB1B ! + MOVE YN4ESP-CD-TY-ECG-FNC OF YN4ESP-DETAIL-SIT ! + TO WS-ECG-FIN ! + * LIGNE 15 ! + MOVE PROT-ATTR TO TPO-REF1L15-ATTR ! + TPO-REF2L15-ATTR ! + TPO-REF3L15-ATTR ! + * LIGNE 16 ! + MOVE '-' TO WS-TIRET ! + MOVE 'DECLARATION :' TO WS-LIB4A ! + MOVE YN4ESP-CD-TY-DCR-DGI OF YN4ESP-DETAIL-SIT ! + TO WS-REF3L16 ! + MOVE YN4ESP-PER-DCR-DGI OF YN4ESP-DETAIL-SIT ! + TO WS-REF4L16 ! + XF-AFF-REF4L16 ! + MOVE 'CODE ' TO WS-LIB4 ! + MOVE YN4ESP-CD-DCR-DGI OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L16 ! + XF-AFF-REF1L16 ! + IF YN4ESP-CD-DCR-DGI OF YN4ESP-DETAIL-SIT = '0' ! + MOVE 'ACOMPTE' TO WS-REF2L16 ! + ELSE ! + IF YN4ESP-CD-DCR-DGI OF YN4ESP-DETAIL-SIT = '1' ! + MOVE 'MENSUEL' TO WS-REF2L16 ! + END-IF ! + END-IF ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE PROT-ATTR TO TPO-REF1L17-ATTR ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE PROT-ATTR TO TPO-RF1L19J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L19A-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + MOVE PROT-ATTR TO TPO-REF5L19-ATTR ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + WHEN 'FI' ! + * LIGNE 14 ! + MOVE 'CODE PARTENAIRE :' TO WS-LIB1 ! + MOVE YN4ESP-CD-PTN OF YN4ESP-DETAIL-SIT ! + TO WS-CD-PTN ! + XF-AFF-CD-PTN ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-DETAIL-SIT = 'O' ! + MOVE 'CM' TO WS-IDC-PTN ! + ELSE ! + MOVE SPACES TO WS-IDC-PTN ! + END-IF ! + * LIGNE 15 ! + MOVE PROT-ATTR TO TPO-REF1L15-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L15-ATTR ! + * LIGNE 16 ! + MOVE PROT-ATTR TO TPO-REF1L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF2L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF3L16-ATTR ! + MOVE PROT-ATTR TO TPO-REF4L16-ATTR ! + * LIGNE 17 ! + MOVE PROT-ATTR TO TPO-REF1L17-ATTR ! + * LIGNE 18 ! + MOVE PROT-ATTR TO TPO-RF1L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF1L18A-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18J-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18M-ATTR ! + MOVE PROT-ATTR TO TPO-RF2L18A-ATTR ! + * LIGNE 19 ! + MOVE 'EVENEMENT :' TO WS-LIB7 ! + MOVE YN4ESP-DA-CRE-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF1L19 ! + XF-AFF-REF1L19 ! + ! + MOVE YN4ESP-CD-TY-CRO OF YN4ESP-DETAIL-SIT ! + TO WS-REF2L19 ! + XF-AFF-REF2L19 ! + MOVE PROT-ATTR TO TPO-REF3L19-ATTR ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + MOVE SPACES TO WS-LIB8 ! + MOVE SPACES TO WS-REF5L19 ! + * LIGNE 21 ! + PERFORM ACCES-SPI017 THRU ACCES-SPI017-FIN ! + MOVE YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO WS-DA-REJ-OPE ! + END-EVALUATE. ! + ! + ! + *----------------------------------------------! END OINIT2 ---- + + SKIP1 + SKIP1 + PERFORM N-100-CURSOR-POSITION. + SKIP1 + A-100-OUTPUT-INIT-RETURN. + EXIT. + EJECT + B-100-OUTPUT-EDITS SECTION. + ******************************************************** + * B - 1 0 0 - O U T P U T - E D I T S * + ******************************************************** + * THIS ROUTINE CONTAINS THE OUTPUT EDIT LOGIC * + * GENERATED FROM THE FIELD STATEMENTS. FIELDS ARE * + * MOVED FROM THE DBNAME FIELD AND EDITED BASED UPON * + * THE FIELD EDIT PARAMETERS SPECIFIED. SPECIAL * + * FLDTYPE EDITS ARE LINKED TO WITH CALL STATEMENTS. * + * * + * GENERATED - FIELD EDIT LOGIC * + * COPY CODE - SCREEN/OUTTERM * + ******************************************************** + SKIP1 + SKIP2 + * NOMMAP FIELD + SKIP1 + MOVE BMSMAP-NAME TO TPO-NOMMAP. + SKIP2 + * NUMECR FIELD + SKIP1 + MOVE EIBTRMID TO TPO-NUMECR. + SKIP2 + * CDAPL FIELD + SKIP1 + MOVE YN4ESP-CD-APLI-OPE OF YN4ESP-DETAIL-SIT TO TPO-CDAPL. + SKIP2 + * LIBAPL FIELD + SKIP1 + CALL 'OSPITAB' USING TPO-LIBAPL + TPO-LIBAPL-LTH + YN4ESP-CD-APLI-OPE OF YN4ESP-DETAIL-SIT + WS-TLN-CODTAB + WS-TLN-LTH-KEY + WS-TLN-EL-DEMANDES. + SKIP2 + * DAPECJ FIELD + SKIP1 + CALL 'ODATEJ' USING TPO-DAPECJ + TPO-DAPECJ-LTH + WS-DA-PEC-DEM-SP + TPO-DAPECM + TPO-DAPECA + WS-TLN-TYPDATE. + SKIP2 + * DAECNJ FIELD + SKIP1 + CALL 'ODATEJ' USING TPO-DAECNJ + TPO-DAECNJ-LTH + WS-DA-ECN-OPE + TPO-DAECNM + TPO-DAECNA + WS-TLN-TYPDATE. + SKIP2 + * MTOPE FIELD + SKIP1 + MOVE YN4ESP-MT-OPE-SIT OF YN4ESP-DETAIL-SIT TO TPO-MTOPE. + SKIP2 + * CDDVS FIELD + SKIP1 + MOVE YN4ESP-CD-DVS-OPE OF YN4ESP-DETAIL-SIT TO TPO-CDDVS. + SKIP2 + * CDBQE FIELD + SKIP1 + MOVE YN4ESP-CD-BQE-DST OF YN4ESP-DETAIL-SIT TO TPO-CDBQE. + SKIP2 + * CDGUI FIELD + SKIP1 + MOVE YN4ESP-CD-GUI-DST OF YN4ESP-DETAIL-SIT TO TPO-CDGUI. + SKIP2 + * NOCPT FIELD + SKIP1 + MOVE YN4ESP-NO-CPT-DST OF YN4ESP-DETAIL-SIT TO TPO-NOCPT. + SKIP2 + * CLERIB FIELD + SKIP1 + MOVE WS-CLE-RIB TO TPO-CLERIB. + SKIP2 + * CDBQE1 FIELD + SKIP1 + MOVE WS-CD-BQE-DST1 TO TPO-CDBQE1. + SKIP2 + * CDGUI1 FIELD + SKIP1 + MOVE WS-CD-GUI-DST1 TO TPO-CDGUI1. + SKIP2 + * NOCPT1 FIELD + SKIP1 + MOVE WS-NO-CPT-DST1 TO TPO-NOCPT1. + SKIP2 + * CLERIB1 FIELD + SKIP1 + MOVE WS-CLE-RIB1 TO TPO-CLERIB1. + SKIP2 + * NBELT FIELD + SKIP1 + MOVE YN4ESP-NB-ELT-OPE OF YN4ESP-DETAIL-SIT TO TPO-NBELT. + SKIP2 + * MODRGL FIELD + SKIP1 + MOVE YN4ESP-CD-MODE-RGL-OPE OF YN4ESP-DETAIL-SIT TO + TPO-MODRGL. + SKIP2 + * LIBRGL FIELD + SKIP1 + MOVE WS-LIB-RGL TO TPO-LIBRGL. + SKIP2 + * NBPREST FIELD + SKIP1 + MOVE YN4ESP-NB-PRT-OPE OF YN4ESP-DETAIL-SIT TO TPO-NBPREST. + SKIP2 + * NOCHQ FIELD + SKIP1 + MOVE WS-NO-CHQ TO TPO-NOCHQ. + SKIP2 + * LIB1 FIELD + SKIP1 + MOVE WS-LIB1 TO TPO-LIB1. + SKIP2 + * CDPTN FIELD + SKIP1 + MOVE WS-CD-PTN TO TPO-CDPTN. + SKIP2 + * LIBPTN FIELD + SKIP1 + MOVE WS-LIB-PTN TO TPO-LIBPTN. + SKIP2 + * IDCPTN FIELD + SKIP1 + MOVE WS-IDC-PTN TO TPO-IDCPTN. + SKIP2 + * LIB1B FIELD + SKIP1 + MOVE WS-LIB1B TO TPO-LIB1B. + SKIP2 + * ECGFIN FIELD + SKIP1 + MOVE WS-ECG-FIN TO TPO-ECGFIN. + SKIP2 + * LIB2 FIELD + SKIP1 + MOVE WS-LIB2 TO TPO-LIB2. + SKIP2 + * REF1L15 FIELD + SKIP1 + MOVE WS-REF1L15 TO TPO-REF1L15. + SKIP2 + * LIB3 FIELD + SKIP1 + MOVE WS-LIB3 TO TPO-LIB3. + SKIP2 + * REF2L15 FIELD + SKIP1 + MOVE WS-REF2L15 TO TPO-REF2L15. + SKIP2 + * REF3L15 FIELD + SKIP1 + MOVE WS-REF3L15 TO TPO-REF3L15. + SKIP2 + * LIB4A FIELD + SKIP1 + MOVE WS-LIB4A TO TPO-LIB4A. + SKIP2 + * REF3L16 FIELD + SKIP1 + MOVE WS-REF3L16 TO TPO-REF3L16. + SKIP2 + * TIRET FIELD + SKIP1 + MOVE WS-TIRET TO TPO-TIRET. + SKIP2 + * REF4L16 FIELD + SKIP1 + MOVE WS-REF4L16 TO TPO-REF4L16. + SKIP2 + * LIB4 FIELD + SKIP1 + MOVE WS-LIB4 TO TPO-LIB4. + SKIP2 + * REF1L16 FIELD + SKIP1 + MOVE WS-REF1L16 TO TPO-REF1L16. + SKIP2 + * REF2L16 FIELD + SKIP1 + MOVE WS-REF2L16 TO TPO-REF2L16. + SKIP2 + * LIB5 FIELD + SKIP1 + MOVE WS-LIB5 TO TPO-LIB5. + SKIP2 + * REF1L17 FIELD + SKIP1 + MOVE WS-REF1L17 TO TPO-REF1L17. + SKIP2 + * LIB6 FIELD + SKIP1 + MOVE WS-LIB6 TO TPO-LIB6. + SKIP2 + * RF1L18J FIELD + SKIP1 + CALL 'ODATEJ' USING TPO-RF1L18J + TPO-RF1L18J-LTH + WS-REF1L18 + TPO-RF1L18M + TPO-RF1L18A + WS-TLN-TYPDATE. + SKIP2 + * LIB6B FIELD + SKIP1 + MOVE WS-LIB6B TO TPO-LIB6B. + SKIP2 + * RF2L18J FIELD + SKIP1 + CALL 'ODATEJ' USING TPO-RF2L18J + TPO-RF2L18J-LTH + WS-REF2L18 + TPO-RF2L18M + TPO-RF2L18A + WS-TLN-TYPDATE. + SKIP2 + * LIB7 FIELD + SKIP1 + MOVE WS-LIB7 TO TPO-LIB7. + SKIP2 + * RF1L19J FIELD + SKIP1 + CALL 'ODATEJ' USING TPO-RF1L19J + TPO-RF1L19J-LTH + WS-REF1L19 + TPO-RF1L19M + TPO-RF1L19A + WS-TLN-TYPDATE. + SKIP2 + * REF2L19 FIELD + SKIP1 + MOVE WS-REF2L19 TO TPO-REF2L19. + SKIP2 + * REF3L19 FIELD + SKIP1 + MOVE WS-REF3L19 TO TPO-REF3L19. + SKIP2 + * REF4L19 FIELD + SKIP1 + MOVE WS-REF4L19 TO TPO-REF4L19. + SKIP2 + * LIB8 FIELD + SKIP1 + MOVE WS-LIB8 TO TPO-LIB8. + SKIP2 + * REF5L19 FIELD + SKIP1 + MOVE WS-REF5L19 TO TPO-REF5L19. + SKIP2 + * CDREJ FIELD + SKIP1 + MOVE YN4ESP-CD-REJ-OPE OF YN4ESP-DETAIL-SIT TO TPO-CDREJ. + SKIP2 + * LIBREJ FIELD + SKIP1 + MOVE WS-LIB-REJ-OPE TO TPO-LIBREJ. + SKIP2 + * DAREJ FIELD + SKIP1 + CALL 'ODATAMJ' USING TPO-DAREJ + TPO-DAREJ-LTH + YN4ESP-DA-REJ-OPE OF YN4ESP-DETAIL-SIT + WS-TLN-TYPDATE. + SKIP1 + SKIP1 + * SCREEN/OUTTERM COPY CODE + SKIP1 + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY OUTTERM ! + *------------------------------------------------------------------- + *---------------------------------------------------------------- ! + * AFFICHAGE DES TOUCHES DE FONCTION PERMANENTE * ! + *---------------------------------------------------------------- ! + MOVE 'O' TO WS-TLN-DOCU-UTI ! + WS-TLN-AIDE-UTI ! + WS-TLN-ECRPRE-UTI ! + WS-TLN-MENUPRE-UTI ! + WS-TLN-MENUGEN-UTI. ! + *----------------------------------------------! END OUTTERM ---- + + SKIP1 + SKIP1 + B-100-OUTPUT-EDITS-RETURN. + SKIP1 + * PROGRAM CUSTOM CONTROL B100T + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEB100T ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEB100T R1 V1 * ! + * Date de creation : 30/11/1992 * ! + * Date de modification : / / * ! + * Fonctionnalites : * ! + * GIECB00T : * ! + * Appel au module p00722 pour formattage du bandeau inf�rieur * ! + * de l'�cran. Remplace le P00720 pour prise en compte F22. * ! + * * ! + * Dependance avec autres sections : * ! + * GIEMAINI * ! + **************************************************************** ! + ! + MOVE 'P00722 ' TO WS-TLN-MODULE. ! + CALL WS-TLN-MODULE USING DFHEIBLK ! + DFHCOMMAREA ! + TPO-LIG23 ! + TPO-LIG24 ! + WS-TLN-TCH-LIBRE1 ! + WS-TLN-TCH-LIBRE2 ! + WS-TLN-TABLE-FONCTION. ! + *----------------------------------------------! END GIEB100T ---- + + SKIP1 + EJECT + C-100-TERMIO-READ SECTION. + ******************************************************** + * C - 1 0 0 - T E R M I O - R E A D * + ******************************************************** + * * + * THIS SECTION READS THE INPUT MESSAGE FROM THE * + * TERMINAL. PROGRAM SECTION C-930 IS CALLED * + * FOLLOWING THE RECIEVE MAP COMMAND TO PERFORM A * + * MERGE OF THE TP BUFFER WITH THE SCREEN IMAGE. ALL * + * FIELDS WHICH ARE ENTERED FROM THE SCREEN HAVE NULLS * + * AND OPTIONALLY UNDERSCORES CONVERTED TO SPACES. * + * NOTE THAT THE FLAG BYTE AND LENGTH FIELD RETURNED * + * FROM BMS ARE RESET AND ARE NOT REFERENCED IN THE * + * TP-BUFFER. ALL FIELDS WHICH ARE NOT RECEIVED FROM * + * THE TERMINAL ARE MOVED INTO THE TP-BUFFER FROM THE * + * SCREEN IMAGE. ALL INPUT FIELDS THAT WERE WRITTEN * + * PREVIOUSLY WITH AN ERROR-ATTR, HAVE THE TP-BUFFER * + * ATTRIBUTE FIELD RESET FOR THE NEXT TRANSMISSION. * + * AT THE END OF INPUT MERGING, THE TP-BUFFER CONTAINS * + * ALL OF THE FIELDS WHICH HAVE BEEN INPUT FROM THE * + * FROM THE SCREEN, AND OPTIONALLY ALL OUTPUT ONLY * + * FIELDS. * + * THE EIBAID BYTE IS CONVERTED TO A NUMERIC VALUE AND * + * RETURNED IN THE FIELD PFKEY-INDICATOR. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * PROGRAM CUSTOM CONTROL C100I + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEC100I ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEC100I R1 V1 * ! + * Date de creation : 09/12/1992 * ! + * Date de modification : / / * ! + * Fonctionnalites : * ! + * GIEC100I : * ! + * restore de la commarea stockee en ts. * ! + * * ! + * Dependance avec autres sections : * ! + * gieMAINt * ! + **************************************************************** ! + MOVE WS-TLN-HOLD-AREA-NAME-DFLT TO WS-TLN-HOLD-AREA-NAME. ! + PERFORM K-300-HOLD-RESTORE. ! + *----------------------------------------------! END GIEC100I ---- + + SKIP1 + SKIP1 + EXEC CICS HANDLE CONDITION ERROR + MAPFAIL(C-100-MERGE-IN) + END-EXEC. + SKIP1 + MOVE LOW-VALUES TO TP-BUFFER. + EXEC CICS RECEIVE MAP(BMSMAP-NAME) + INTO(TP-BUFFER) + END-EXEC. + SKIP1 + C-100-MERGE-IN. + SKIP1 + PERFORM C-930-INPUT-MERGE. + SKIP1 + C-100-TERMIO-READ-RETURN. + EXIT. + EJECT + C-200-TERMIO-WRITE SECTION. + ******************************************************** + * C - 2 0 0 - T E R M I O - W R I T E * + ******************************************************** + * THIS SECTION WRITES THE OUTPUT MESSAGE TO THE * + * TERMINAL. PROGRAM SECTION C-940 IS CALLED TO * + * MERGE THE TP BUFFER WITH THE SCREEN IMAGE. * + * ONLY DATA FROM THE BUFFER WHICH IS NOT IN THE SCREEN* + * IMAGE IS TRANSMITTED. INPUT FIELDS ARE OPTIONALLY * + * FILLED WITH LOW-VALUES OR UNDERSCORES. OUTPUT ONLY * + * FIELDS ARE PADDED ON THE RIGHT WITH LOW-VALUES. * + * AT THE END OF OUTPUT MERGING THE TP BUFFER CONTAINS * + * LOW VALUES FOR ALL FIELDS THAT ARE ALREADY ON THE * + * SCREEN AND THE DATA TO BE SENT WITH THE APPROPRIATE * + * FILL CHARACTERS FOR FIELDS TO BE TRANSMITTED. * + * THE CONTROL INDICATOR IS ALSO SET TO INDICATE * + * TRANSACTION COMPLETE. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * PROGRAM CUSTOM CONTROL C200I + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY GIEC200I ! + *------------------------------------------------------------------- + ******************************************************** ! + * CODE PERSONNALISATION : CMB GIEC200I R1 V1 * ! + * DATE DE CREATION : 27/01/1992 * ! + * DATE DE MODIFICATION : / / * ! + * FONCTIONNALITES : * ! + * GIEC200I : * ! + * ALIMENTATION ZONES BMS DATE ET HEURE A PARTIR DES * ! + * ZONES DEFINIES EN WORKING ET FORMATTEES EN SECTION * ! + * MAINI. * ! + * DEPENDANCE AVEC AUTRES SECTIONS : * ! + * CMBMAINI * ! + ******************************************************** ! + ! + MOVE WS-TLN-DATE-AFF TO TPO-DATE. ! + MOVE WS-TLN-TIME-AFF TO TPO-HEURE. ! + MOVE 'P00710' TO WS-TLN-MODULE. ! + CALL WS-TLN-MODULE USING DFHEIBLK DFHCOMMAREA ! + TPO-ERRMSG1 ! + TPO-ERRMSG1-ATTR ! + WS-TLN-ADR-PGM ! + WS-TLN-LIB-CPL-MES. ! + ! + *----------------------------------------------! END GIEC200I ---- + + SKIP1 + SKIP1 + PERFORM C-940-OUTPUT-MERGE. + SKIP1 + IF SCI-WRITE-INDICATOR = LOW-VALUES + PERFORM C-210-TERMIO-WRITE-INITIAL + MOVE HIGH-VALUES TO SCI-WRITE-INDICATOR + ELSE + PERFORM C-220-TERMIO-WRITE-SUBSEQUENT. + MOVE TRANSACTION-COMPLETE-LIT TO CONTROL-INDICATOR. + SKIP1 + C-200-TERMIO-WRITE-RETURN. + EXIT. + EJECT + C-210-TERMIO-WRITE-INITIAL SECTION. + ******************************************************** + * C - 2 1 0 - T E R M I O - W R I T E - I N I T I A L * + ******************************************************** + * THIS SECTION DOES THE INITIAL OUTPUT TO THE * + * TERMINAL. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + EXEC CICS SEND MAP(BMSMAP-NAME) + FROM(TP-BUFFER) + ERASE + FREEKB + FRSET + CURSOR + END-EXEC. + SKIP1 + SKIP3 + C-220-TERMIO-WRITE-SUBSEQUENT SECTION. + ******************************************************** + * C - 2 2 0 - T E R M I O - W R I T E - S U B Q U E N T* + ******************************************************** + * THIS SECTION WRITES ONLY CHANGED FIELDS TO THE * + * TERMINAL. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + EXEC CICS SEND MAP(BMSMAP-NAME) + FROM(TP-BUFFER) + DATAONLY + FREEKB + FRSET + CURSOR + END-EXEC. + EJECT + C-300-TERMIO-XFER SECTION. + ******************************************************** + * C - 3 0 0 - T E R M I O - X F E R * + ******************************************************** + * THIS SECTION TRANSFERS CONTROL TO THE NEXT PROGRAM * + * TO PROCESS OUTPUT USING THE XCTL COMMAND. IT PASSES * + * THE SPA-AREA IN DFHCOMMAREA. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + IF SPA-TRANSACTION-CODE NOT = SPACES + MOVE LOW-VALUES TO SPA-TRANSACTION-CODE. + SKIP1 + * PROGRAM CUSTOM CONTROL C300I + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEC300I ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEC300I R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * GIEC300I : Module permettant le decalage de la commarea * ! + * de 16 caracteres vers la gauche pour appel * ! + * d'un pgm NON TELON ou chainage vers le programme * ! + * de gestion des anomalies. * ! + * Un point de synchronisation est effectue si * ! + * l'indicateur ws-tln-idc-syncpoint est valorise * ! + * � 'O'.* ! + * * ! + * Dependance avec autres sections : * ! + * GIEMAINI * ! + **************************************************************** ! + ! + MOVE WS-TLN-SPA-LENGTH TO SPA-LENGTH. ! + IF NEXT-PROGRAM-NAME-ID = '00ABD' ! + EXEC CICS SYNCPOINT ROLLBACK ! + END-EXEC ! + MOVE WS-TLN-ABT-PGM TO ABT-NEXT-PROGRAM-NAME ! + NEXT-PROGRAM-NAME ! + MOVE XFER-DBT-ZON-APL TO XFER-HELP-DATA ! + MOVE PROGRAM-TRANSACTION-CODE ! + TO ABT-PGM-TRAN-CODE ! + MOVE ABNORMAL-TERMINATION-AREA ! + TO SPA-AREA(419:240) ! + MOVE SPACE TO WS-TLN-TYP-XCTL. ! + ! + IF TRAITER-SYNCPOINT ! + THEN EXEC CICS SYNCPOINT ! + END-EXEC. ! + ! + IF WS-TLN-XCTL-NON-TELON ! + THEN MOVE NEXT-PROGRAM-NAME TO SPA-NEXT-PROGRAM-NAME ! + EXEC CICS XCTL PROGRAM (SPA-NEXT-PROGRAM-NAME) ! + COMMAREA (XFER-DBT-ZON-APL) ! + LENGTH (XFER-LG-SPA-PVN-TLN) ! + END-EXEC. ! + *----------------------------------------------! END GIEC300I ---- + + SKIP1 + SKIP1 + IF SPA-TRANSACTION-CODE = SPACES + MOVE TRANSACTION-COMPLETE-LIT TO CONTROL-INDICATOR + GO TO C-300-TERMIO-XFER-RETURN. + CALL 'ADLAATX' USING DFHEIBLK DFHCOMMAREA. + SKIP1 + MOVE NEXT-PROGRAM-NAME TO SPA-NEXT-PROGRAM-NAME. + EXEC CICS XCTL PROGRAM(SPA-NEXT-PROGRAM-NAME) + COMMAREA(SPA-AREA) + LENGTH(SPA-LENGTH) + END-EXEC. + SKIP1 + C-300-TERMIO-XFER-RETURN. + EXIT. + EJECT + C-930-INPUT-MERGE SECTION. + ******************************************************** + * C - 9 3 0 - I N P U T - M E R G E * + ******************************************************** + * THIS SECTION MERGES THE OUTPUT BUFFER WITH THE * + * SCREEN IMAGE ON INPUT. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * + * CALL THE TELON MERGE ROUTINE FOR INPUT PROCESSING + * + CALL 'TLRAMRI' USING DFHEIBLK + DFHCOMMAREA + TP-OUTPUT-TABLE + TP-OUTPUT-BUFFER-FIELDS + SCREEN-IMAGE-AREA + PFKEY-INDICATOR + EIBAID. + SKIP1 + C-930-INPUT-MERGE-RETURN. + EXIT. + EJECT + C-940-OUTPUT-MERGE SECTION. + ******************************************************** + * C - 9 4 0 - O U T P U T - M E R G E * + ******************************************************** + * THIS SECTION MERGES THE OUTPUT BUFFER WITH THE * + * SCREEN IMAGE ON OUTPUT. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * + * CALL THE TELON MERGE ROUTINE FOR OUTPUT PROCESSING + * + CALL 'TLRAMRO' USING DFHEIBLK + DFHCOMMAREA + TP-OUTPUT-TABLE + TP-OUTPUT-BUFFER-FIELDS + SCREEN-IMAGE-AREA. + SKIP1 + C-940-OUTPUT-MERGE-RETURN. + EXIT. + EJECT + D-100-INPUT-INIT SECTION. + ******************************************************** + * D - 1 0 0 - I N P U T - I N I T * + ******************************************************** + * THIS ROUTINE INITIALIZES ANY FIELDS NECESSARY * + * PRIOR TO INPUT PROCESSING AND RETRIEVES INPUT/OUTIN * + * UPDATE DATABASE SEGMENTS. * + * * + * COPY CODE - SCREEN/ININIT1 * + * GENERATED - INPUT/OUTPUT/UPDATE DATABASE AUTO CALLS * + * COPY CODE - SCREEN/ININIT2(ININIT) * + ******************************************************** + SKIP1 + SKIP1 + * SCREEN/ININIT1 NOT CODED + SKIP1 + SKIP1 + SKIP1 + * SCREEN/ININIT2 NOT CODED + SKIP1 + SKIP1 + D-100-INPUT-INIT-RETURN. + EXIT. + EJECT + E-100-INPUT-EDITS SECTION. + ******************************************************** + * E - 1 0 0 - I N P U T - E D I T S * + ******************************************************** + * THIS ROUTINE CONTAINS THE INPUT EDIT LOGIC GENERATED* + * FROM THE FIELD STATEMENT PARAMETERS. STANDARD * + * EDITS SUCH AS REQ, CONVERT AND VALUES ARE GENERATED * + * IN THIS SECTION. SPECIAL FLDTYPES ARE LINKED TO * + * WITH CALL STATEMENTS. * + * * + * GENERATED - FIELD EDIT LOGIC * + * COPY CODE - SEGLOOP/ICUST1 (PRE EDIT) * + * COPY CODE - SEGLOOP/ICUST2 * + * COPY CODE - SCREEN/FLDEDIT * + ******************************************************** + SKIP1 + SKIP2 + * DAPECJ FIELD + SKIP1 + CALL 'IDATEJ' USING FIELD-EDIT-ERROR + TPI-DAPECJ-LTH + TPI-DAPECJ + WORKFLD-ALPHA + TPI-DAPECM + TPO-DAPECM-ATTR + TPI-DAPECA + TPO-DAPECA-ATTR + WS-TLN-TYPDATE + CONTROL-INDICATOR + IF FIELD-EDIT-GOOD + MOVE WORKFLD-ALPHA TO WS-DA-PEC-DEM-SP + ELSE + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR + MOVE ERROR-ATTR TO TPO-DAPECJ-ATTR. + SKIP2 + * DAECNJ FIELD + SKIP1 + CALL 'IDATEJ' USING FIELD-EDIT-ERROR + TPI-DAECNJ-LTH + TPI-DAECNJ + WORKFLD-ALPHA + TPI-DAECNM + TPO-DAECNM-ATTR + TPI-DAECNA + TPO-DAECNA-ATTR + WS-TLN-TYPDATE + CONTROL-INDICATOR + IF FIELD-EDIT-GOOD + MOVE WORKFLD-ALPHA TO WS-DA-ECN-OPE + ELSE + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR + MOVE ERROR-ATTR TO TPO-DAECNJ-ATTR. + SKIP2 + * CDBQE1 FIELD + SKIP1 + IF TPI-CDBQE1 NOT = SPACE + MOVE TPI-CDBQE1 TO WS-CD-BQE-DST1 + ELSE + MOVE SPACES TO WS-CD-BQE-DST1. + SKIP2 + * CDGUI1 FIELD + SKIP1 + IF TPI-CDGUI1 NOT = SPACE + MOVE TPI-CDGUI1 TO WS-CD-GUI-DST1 + ELSE + MOVE SPACES TO WS-CD-GUI-DST1. + SKIP2 + * NOCPT1 FIELD + SKIP1 + IF TPI-NOCPT1 NOT = SPACE + MOVE TPI-NOCPT1 TO WS-NO-CPT-DST1 + ELSE + MOVE SPACES TO WS-NO-CPT-DST1. + SKIP2 + * NOCHQ FIELD + SKIP1 + IF TPI-NOCHQ NOT = SPACE + MOVE TPI-NOCHQ TO WS-NO-CHQ + ELSE + MOVE SPACES TO WS-NO-CHQ. + SKIP2 + * CDPTN FIELD + SKIP1 + IF TPI-CDPTN NOT = SPACE + MOVE TPI-CDPTN TO WS-CD-PTN + ELSE + MOVE SPACES TO WS-CD-PTN. + SKIP2 + * REF1L15 FIELD + SKIP1 + IF TPI-REF1L15 NOT = SPACE + MOVE TPI-REF1L15 TO WS-REF1L15 + ELSE + MOVE SPACES TO WS-REF1L15. + SKIP2 + * REF2L15 FIELD + SKIP1 + IF TPI-REF2L15 NOT = SPACE + MOVE TPI-REF2L15 TO WS-REF2L15 + ELSE + MOVE SPACES TO WS-REF2L15. + SKIP2 + * REF4L16 FIELD + SKIP1 + IF TPI-REF4L16 NOT = SPACE + MOVE TPI-REF4L16 TO WS-REF4L16 + ELSE + MOVE SPACES TO WS-REF4L16. + SKIP2 + * REF1L16 FIELD + SKIP1 + IF TPI-REF1L16 NOT = SPACE + MOVE TPI-REF1L16 TO WS-REF1L16 + ELSE + MOVE SPACES TO WS-REF1L16. + SKIP2 + * REF1L17 FIELD + SKIP1 + IF TPI-REF1L17 NOT = SPACE + MOVE TPI-REF1L17 TO WS-REF1L17 + ELSE + MOVE SPACES TO WS-REF1L17. + SKIP2 + * RF1L18J FIELD + SKIP1 + CALL 'IDATEJ' USING FIELD-EDIT-ERROR + TPI-RF1L18J-LTH + TPI-RF1L18J + WORKFLD-ALPHA + TPI-RF1L18M + TPO-RF1L18M-ATTR + TPI-RF1L18A + TPO-RF1L18M-ATTR + WS-TLN-TYPDATE + CONTROL-INDICATOR + IF FIELD-EDIT-GOOD + MOVE WORKFLD-ALPHA TO WS-REF1L18 + ELSE + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR + MOVE ERROR-ATTR TO TPO-RF1L18J-ATTR. + SKIP2 + * RF2L18J FIELD + SKIP1 + CALL 'IDATEJ' USING FIELD-EDIT-ERROR + TPI-RF2L18J-LTH + TPI-RF2L18J + WORKFLD-ALPHA + TPI-RF2L18M + TPO-RF2L18M-ATTR + TPI-RF2L18A + TPO-RF2L18A-ATTR + WS-TLN-TYPDATE + CONTROL-INDICATOR + IF FIELD-EDIT-GOOD + MOVE WORKFLD-ALPHA TO WS-REF2L18 + ELSE + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR + MOVE ERROR-ATTR TO TPO-RF2L18J-ATTR. + SKIP2 + * RF1L19J FIELD + SKIP1 + CALL 'IDATEJ' USING FIELD-EDIT-ERROR + TPI-RF1L19J-LTH + TPI-RF1L19J + WORKFLD-ALPHA + TPI-RF1L19M + TPO-RF1L19M-ATTR + TPI-RF1L19A + TPO-RF1L19A-ATTR + WS-TLN-TYPDATE + CONTROL-INDICATOR + IF FIELD-EDIT-GOOD + MOVE WORKFLD-ALPHA TO WS-REF1L19 + ELSE + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR + MOVE ERROR-ATTR TO TPO-RF1L19J-ATTR. + SKIP2 + * REF2L19 FIELD + SKIP1 + IF TPI-REF2L19 NOT = SPACE + MOVE TPI-REF2L19 TO WS-REF2L19 + ELSE + MOVE SPACES TO WS-REF2L19. + SKIP2 + * REF3L19 FIELD + SKIP1 + IF TPI-REF3L19 NOT = SPACE + MOVE TPI-REF3L19 TO WS-REF3L19 + ELSE + MOVE SPACES TO WS-REF3L19. + SKIP2 + * REF5L19 FIELD + SKIP1 + IF TPI-REF5L19 NOT = SPACE + MOVE TPI-REF5L19 TO WS-REF5L19 + ELSE + MOVE SPACES TO WS-REF5L19. + SKIP1 + * + * IF ERROR INDICATED, SET DEFAULT ERROR MESSAGE + * + SKIP1 + IF NOT CONTINUE-PROCESS + MOVE ERROR-MESSAGE-HIGHLIGHT TO TPO-ERRMSG1. + SKIP1 + * SCREEN/FLDEDIT NOT CODED + SKIP1 + SKIP1 + E-100-INPUT-EDITS-RETURN. + SKIP1 + * PROGRAM CUSTOM CONTROL E100T + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEE100T ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEC300I R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * HELP CURSEUR - custom code E100T * ! + * Help demand� mais aucune cle de help sur le panel * ! + * * ! + * Dependance avec autres sections : * ! + * GIEL100I,GIEK100I,GIEK100T,GIEK200I,GIEM100T,GIEP100I * ! + **************************************************************** ! + ! + IF APPVAL AND WS-TLN-M100 = 'N' ! + CALL 'HELPCURS' USING XFER-HELP-CUR HELP-CHAR ! + EIBCPOSN TAB-POS-NB TAB-POS TPO-INPUT-FIELDS ! + TELON-EATTR-FEATURE ! + MOVE 0 TO XFER-HELP-POS-COD XFER-HELP-POS-LIB ! + MOVE '000160' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR. ! + *----------------------------------------------! END GIEE100T ---- + + SKIP1 + EJECT + H-100-INPUT-TERM SECTION. + ******************************************************** + * H - 1 0 0 - I N P U T - T E R M * + ******************************************************** + * THIS SECTION IS EXECUTED AT THE END OF INPUT * + * PROCESSING. * + * * + * GENERATED - CREATE/UPDATE DATA ACCESS AUTO CALLS * + * COPY CODE - SCREEN/INTERM * + ******************************************************** + SKIP1 + SKIP1 + * SCREEN/INTERM COPY CODE + SKIP1 + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY INTERM ! + *------------------------------------------------------------------- + * INTERM ! + * ! + * SI LISTE DE DETAIL DEMANDE ON RESTE SUR CET ECRAN TANT QU'ON ! + * N'EST PAS A LA FIN DE LA LISTE ! + * SI FIN RETOUR A L'ECRAN LISTE ! + IF CONTINUE-PROCESS ! + IF VALIDATION ! + AND DEMANDE-DE-VALIDATION ! + * INITIALISATION ZONE D'APPEL AU TN4ESPS ! + MOVE XF-AFF-MEMO-ZON1 TO YN4ESP-ZONE-ALLER(1:127) ! + MOVE XF-AFF-MEMO-ZON2 TO ! + YN4ESP-NO-PTN OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-MEMO-ZON3 TO ! + YN4ESP-NO-PRD-PTN OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-MEMO-ZON4 TO ! + YN4ESP-NO-CLI-PTN OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-MEMO-ZON5 TO ! + YN4ESP-NO-ORD-CTR OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-MEMO-ZON6 TO YN4ESP-ZONE-ALLER(138:124) ! + MOVE XF-AFF-MEMO-ZON7 TO ! + YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-MEMO-ZON8 TO YN4ESP-ZONE-ALLER(268:113) ! + ! + PERFORM ACCES-TN4ESPS-006 THRU ! + ACCES-TN4ESPS-006-FIN ! + IF CONTINUE-PROCESS ! + ADD 1 TO YC4ESD-NO-OCC-D ! + IF YC4ESD-DA-ENT-OPE OF ! + YC4ESD-ZONE-OCC-DET(YC4ESD-NO-OCC-D) NOT > SPACES ! + MOVE '4E3G0' TO NEXT-PROGRAM-NAME-ID ! + SUBTRACT 1 FROM YC4ESD-NO-OCC-D ! + SET DO-TRANSFER TO TRUE ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + ! + ! + *----------------------------------------------! END INTERM ---- + + SKIP1 + H-100-INPUT-TERM-RETURN. + EXIT. + EJECT + K-100-HOLD-RESTORE SECTION. + ******************************************************** + * K - 1 0 0 - H O L D - R E S T O R E * + ******************************************************** + * THIS ROUTINE RESTORES THE TRANSFER AREA UPON RETURN * + * FROM THE HELP OR HOLD FUNCTION. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * PROGRAM CUSTOM CONTROL K100I + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEK100I ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEK100I R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * HELP CURSEUR - custom code K100I * ! + * sauvegarde zone xfer-help-cur renseigne dans programme * ! + * appel de valeur. * ! + * * ! + * Dependance avec autres sections : * ! + * GIEE100T,GIEL100I,GIEK100T,GIEK200I,GIEM100T,GIEP100I * ! + **************************************************************** ! + MOVE XFER-HELP-CUR TO WORKFLD-ALPHA. ! + MOVE XFER-MODIFY-INDICATOR TO WS-TLN-MODIFY-INDICATOR. ! + *----------------------------------------------! END GIEK100I ---- + + SKIP1 + SKIP1 + MOVE EIBTRMID TO HOLD-AREA-LTERM. + MOVE HOLD-AREA-APPLID-DFLT TO HOLD-AREA-APPLID. + MOVE 8208 TO HOLD-AREA-SIZE. + SKIP1 + EXEC CICS READQ TS + INTO(HOLD-AREA) + LENGTH(HOLD-AREA-SIZE) + QUEUE(HOLD-AREA-KEY) + ITEM(1) + END-EXEC. + EXEC CICS DELETEQ TS + QUEUE(HOLD-AREA-KEY) + END-EXEC. + SKIP1 + MOVE SCREEN-IMAGE TO TP-OUTPUT-BUFFER-FIELDS. + MOVE LOW-VALUES TO SCREEN-IMAGE-AREA. + SKIP1 + IF HOLD-AREA-TYPE EQUAL 'D' + MOVE ERROR-MESSAGE-HOLD TO TPO-ERRMSG1 + ELSE + MOVE ERROR-MESSAGE-HELP TO TPO-ERRMSG1. + SKIP1 + K-100-HOLD-RESTORE-RETURN. + SKIP1 + * PROGRAM CUSTOM CONTROL K100T + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEK100T ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEK100T R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * HELP CURSEUR - custom code K100T * ! + * Restauration zones de help sauvegard�es en K100I, puis * ! + * r�cup�ration de la donn�e select�e dans le help. * ! + * * ! + * Dependance avec autres sections : * ! + * GIEE100T,GIEL100I,GIEK100I,GIEK200I,GIEM100T,GIEP100I * ! + **************************************************************** ! + MOVE WORKFLD-ALPHA TO XFER-HELP-CUR. ! + IF XFER-HELP-POS-COD > 0 ! + CALL 'HELPCURS' USING XFER-HELP-CUR HELP-CHAR ! + EIBCPOSN TAB-POS-NB TAB-POS TPO-INPUT-FIELDS ! + TELON-EATTR-FEATURE ! + MOVE 0 TO XFER-HELP-POS-COD XFER-HELP-POS-LIB. ! + *----------------------------------------------! END GIEK100T ---- + + SKIP1 + EJECT + K-200-HOLD-RESUME SECTION. + ******************************************************** + * K - 2 0 0 - H O L D - R E S U M E * + ******************************************************** + * THIS ROUTINE RETRIEVES THE HOLD AREA HEADER IF IT * + * EXISTS, SETS THE NEXT PROGRAM NAME BASED ON THE * + * HOLD-RESUME-PGM-ID AND INDICATES TO DO-TRANSFER. * + * IF NO RECORD IS ON HOLD, IT RETURNS AN ERROR. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * PROGRAM CUSTOM CONTROL K200I + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEK200I ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEK200I R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * HELP CURSEUR - custom code K200I * ! + * initialisation header a partir de la valeur contenu dans * ! + * xfer-hold-area-hdr initialise en L100I du pgm appelant * ! + * * ! + * Dependance avec autres sections : * ! + * GIEE100T,GIEL100I,GIEK100I,GIEK200T,GIEM100T,GIEP100I * ! + **************************************************************** ! + MOVE XFER-HELP-AREA-HDR TO NEXT-PROGRAM-NAME-HDR ! + HOLD-AREA-APPLID-DFLT. ! + *----------------------------------------------! END GIEK200I ---- + + SKIP1 + SKIP1 + MOVE EIBTRMID TO HOLD-AREA-LTERM. + MOVE HOLD-AREA-APPLID-DFLT TO HOLD-AREA-APPLID. + MOVE 16 TO HOLD-AREA-SIZE. + SKIP1 + EXEC CICS HANDLE CONDITION + QIDERR(K-200-HOLD-NOTFND) + LENGERR(K-200-RESUME-OK) + END-EXEC. + EXEC CICS READQ TS + INTO(HOLD-AREA) + LENGTH(HOLD-AREA-SIZE) + QUEUE(HOLD-AREA-KEY) + ITEM(1) + END-EXEC. + SKIP1 + K-200-RESUME-OK. + MOVE HOLD-RESUME-PGM-ID TO NEXT-PROGRAM-NAME-ID. + MOVE HOLD-AREA-TYPE TO XFER-HOLD-INDICATOR. + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR. + GO TO K-200-HOLD-RESUME-RETURN. + SKIP1 + K-200-HOLD-NOTFND. + MOVE ERROR-MESSAGE-RESUME TO TPO-ERRMSG1. + PERFORM N-100-CURSOR-POSITION. + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR. + SKIP2 + K-200-HOLD-RESUME-RETURN. + EXEC CICS HANDLE CONDITION QIDERR LENGERR END-EXEC. + SKIP1 + * PROGRAM CUSTOM CONTROL K200T + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEK300 ! + *------------------------------------------------------------------- + K-300-HOLD-SAVE SECTION. ! + ******************************************************** ! + * K - 3 0 0 - H O L D - S A V E * ! + ******************************************************** ! + * * ! + * CETTE ROUTINE SAUVEGARDE LA COMMAREA EN TS * ! + * * ! + ******************************************************** ! + SKIP1 ! + MOVE EIBTRMID TO WS-TLN-HOLD-AREA-LTERM. ! + SKIP1 ! + EXEC CICS HANDLE CONDITION ! + QIDERR(K-300-OK-TO-HOLD) ! + END-EXEC. ! + * ! + * SI EXISTE SUPPRESION DE LA TS ! + * ! + EXEC CICS DELETEQ TS ! + QUEUE(WS-TLN-HOLD-AREA-KEY) ! + END-EXEC. ! + K-300-OK-TO-HOLD. ! + * ! + * CREATION DE LA TS POUR SAUVEGARDE COMMAREA ! + * ! + EXEC CICS WRITEQ TS MAIN ! + FROM (SPA-AREA) ! + LENGTH(WS-TLN-SPA-LENGTH) ! + QUEUE(WS-TLN-HOLD-AREA-KEY) ! + END-EXEC. ! + SKIP1 ! + K-300-HOLD-SAVE-RETURN. ! + EXIT. ! + SKIP1 ! + K-300-HOLD-RESTORE SECTION. ! + ******************************************************** ! + * K - 3 0 0 - H O L D - R E S T O R E * ! + ******************************************************** ! + * CETTE ROUTINE PERMET DE RESTAURER LA COMMAREA * ! + * APRES ACTION DE L'OPERATEUR * ! + ******************************************************** ! + SKIP1 ! + EXEC CICS HANDLE CONDITION ! + QIDERR(K-300-ABNORMAL-RESTORE) ! + END-EXEC. ! + SKIP1 ! + MOVE EIBTRMID TO WS-TLN-HOLD-AREA-LTERM. ! + SKIP1 ! + EXEC CICS READQ TS ! + INTO(SPA-AREA) ! + LENGTH(WS-TLN-SPA-LENGTH) ! + QUEUE(WS-TLN-HOLD-AREA-KEY) ! + ITEM(1) ! + END-EXEC. ! + EXEC CICS DELETEQ TS ! + QUEUE(WS-TLN-HOLD-AREA-KEY) ! + END-EXEC. ! + SKIP1 ! + GO TO K-300-HOLD-RESTORE-RETURN. ! + SKIP1 ! + K-300-ABNORMAL-RESTORE. ! + ******************************************************** ! + * K - 3 0 0 - H O L D - R E S T O R E * ! + ******************************************************** ! + * SI PROBLEME DANS LECTURE TS, ON RENSEIGNE LES * ! + * DONN�ES RELATIVES � L'ANOMALIE DANS LA VARIABLE * ! + * ABNORMAL-TERMINATION-AREA PUIS ON CHAINE SUR LE * ! + * TRAITEMENT DE GESTION DE L'ANOMALIE * ! + ******************************************************** ! + SKIP1 ! + MOVE WS-TLN-HOLD-AREA-KEY TO ABT-DA-ACCESS-NAME. ! + MOVE 'READ ' TO ABT-DA-FUNCTION. ! + MOVE 'N' TO ABT-TEST-FACILITY-IND ! + ABT-IN-PROGRESS. ! + MOVE 'P' TO ABT-TEST-MODE-IND. ! + MOVE 'CICS' TO ABT-PGM-GEN-TYPE. ! + MOVE +3500 TO ABT-ERROR-ABEND-CODE. ! + MOVE 'QIE' TO ABT-DA-GENERIC-STATUS. ! + MOVE CURRENT-PROGRAM-NAME TO ABT-PGM-NAME. ! + MOVE 'QUEUE ' TO ABT-ERROR-ACTIVITY. ! + MOVE 'K-300 ' TO ABT-ERROR-SECTION-NAME. ! + MOVE SPA-AREA (17:24) TO XFER-DBT-ZON-APL. ! + MOVE WS-TLN-SPA-LENGTH TO SPA-LENGTH. ! + MOVE '00ABD' TO NEXT-PROGRAM-NAME-ID. ! + SKIP1 ! + PERFORM C-300-TERMIO-XFER. ! + SKIP1 ! + K-300-HOLD-RESTORE-RETURN. ! + *----------------------------------------------! END GIEK300 ---- + + SKIP1 + EJECT + L-100-HOLD-SAVE SECTION. + ******************************************************** + * L - 1 0 0 - H O L D - S A V E * + ******************************************************** + * THIS ROUTINE SAVES THE TRANSFER AREA IN THE HOLD * + * FILE. IT IS PERFORMED FOR THE HOLD OR HELP * + * FUNCTION. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + * PROGRAM CUSTOM CONTROL L100I + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEL100I ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEL100I R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * HELP CURSEUR - custom code L100I * ! + * Sauvegarde header programme declenchant l'appel de valeur * ! + * pour le nom de la ts a restaurer dans le pgm appele, et * ! + * le nom du pgm a reactiver. * ! + * * ! + * Dependance avec autres sections : * ! + * GIEE100T,GIEK100I,GIEK100T,GIEK200I,GIEM100T,GIEP100I * ! + **************************************************************** ! + MOVE TPO-INPUT-FIELDS TO SCREEN-IMAGE. ! + MOVE HOLD-AREA-APPLID-DFLT TO XFER-HELP-AREA-HDR. ! + MOVE SCI-MODIFY-INDICATOR TO XFER-MODIFY-INDICATOR. ! + *----------------------------------------------! END GIEL100I ---- + + SKIP1 + SKIP1 + MOVE PROGRAM-NAME OF SYS-WORK-AREA TO HOLD-RESUME-PGM-ID. + MOVE EIBTRMID TO HOLD-AREA-LTERM. + MOVE HOLD-AREA-APPLID-DFLT TO HOLD-AREA-APPLID. + MOVE 16 TO HOLD-AREA-SIZE. + SKIP1 + EXEC CICS HANDLE CONDITION + QIDERR(L-100-OK-TO-HOLD) + LENGERR(L-100-HOLD-ERROR) + END-EXEC. + EXEC CICS READQ TS + SET(UPDATE-PTR) + LENGTH(HOLD-AREA-SIZE) + QUEUE(HOLD-AREA-KEY) + ITEM(1) + END-EXEC. + L-100-HOLD-ERROR. + * + * FOR HELP FUNCTION, DELETE THE PRIOR HOLD RECORD + * FOR HOLD FUNCTION, MULTIPLE HOLDS ARE NOT ALLOWED + * + IF HOLD-AREA-TYPE = 'P' + EXEC CICS DELETEQ TS + QUEUE(HOLD-AREA-KEY) + END-EXEC + ELSE + MOVE ERROR-MESSAGE-HOLD-ISRT TO TPO-ERRMSG1 + PERFORM N-100-CURSOR-POSITION + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR + GO TO L-100-HOLD-SAVE-RETURN. + SKIP1 + L-100-OK-TO-HOLD. + * + * INSERT THE HOLD AREA TO TEMPORARY STORAGE + * + MOVE 8208 TO HOLD-AREA-SIZE. + EXEC CICS WRITEQ TS MAIN + FROM (HOLD-AREA) + LENGTH(HOLD-AREA-SIZE) + QUEUE(HOLD-AREA-KEY) + END-EXEC. + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR. + SKIP1 + L-100-HOLD-SAVE-RETURN. + EXEC CICS HANDLE CONDITION QIDERR LENGERR END-EXEC. + EJECT + N-100-CURSOR-POSITION SECTION. + ******************************************************** + * N - 1 0 0 - C U R S O R - P O S I T I O N * + ******************************************************** + * THIS SECTION POSITIONS THE CURSOR TO THE PROPER * + * FIELD FOR OUTPUT. * + * * + * GENERATED - MOVE CURSOR-ATTR TO SCREEN/CURSOR FIELD * + * COPY CODE - SCREEN/CURSCUS * + ******************************************************** + SKIP1 + MOVE CURSOR-ATTR TO TPO-DAPECJ-ATTR. + SKIP1 + * SCREEN/CURSCUS NOT CODED + SKIP1 + SKIP1 + N-100-CURSOR-POSITION-RETURN. + EXIT. + EJECT + P-100-PFKEYS SECTION. + ******************************************************** + * P - 1 0 0 - P F K E Y S * + ******************************************************** + * THIS SECTION PROCESSES PFKEYS. * + * * + * COPY CODE - SCREEN/PFKEYS * + ******************************************************** + SKIP1 + * PROGRAM CUSTOM CONTROL P100I + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEP100I ! + *------------------------------------------------------------------- + **************************************************************** ! + * Code personnalisation : CMB GIEP100I R1 V1 * ! + * Date de creation : 27/01/1992 * ! + * Date de modification : / / * ! + * * ! + * Fonctionnalites : * ! + * HELP CURSEUR - custom code P100I * ! + * recherche des zones initialis�es manuellement � '?' pour * ! + * initialisation de ces zones a space. * ! + * Si help demand� alors qu'il est d�j� actif, envoi d'un * ! + * message. Sinon, marquage du champ par un '?' si la * ! + * position du curseur est valide. * ! + * * ! + * Dependance avec autres sections : * ! + * GIEE100I,GIEL100I,GIEK100I,GIEK100T,GIEK200I,GIEM100I * ! + **************************************************************** ! + CALL 'HELPINIT' USING TAB-POS-NB TAB-POS ! + TPO-INPUT-FIELDS TELON-EATTR-FEATURE ! + IF APPVAL ! + IF XFER-HELP-POS-COD > 0 ! + MOVE '000158' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + GO TO P-100-PFKEYS-RETURN ! + ELSE ! + MOVE 0 TO XFER-HELP-POS-COD ! + CALL 'HELPCURS' USING XFER-HELP-CUR HELP-CHAR ! + EIBCPOSN TAB-POS-NB TAB-POS TPO-INPUT-FIELDS ! + TELON-EATTR-FEATURE ! + IF XFER-HELP-POS-COD = 0 ! + MOVE '000159' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + GO TO P-100-PFKEYS-RETURN ! + ELSE ! + MOVE BMSMAP-NAME TO XFER-HELP-MAP-NAME ! + GO TO P-100-PFKEYS-RETURN. ! + *----------------------------------------------! END GIEP100I ---- + + SKIP1 + SKIP1 + MOVE SPACES TO TPO-ERRMSG1. + SKIP1 + * + * PFKEY X ROUTINE + * + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY CPFKX ! + *------------------------------------------------------------------- + **************************************************************** ! + * COPY PERMETTANT UNE GESTION AUTOMATIQUE DES FONCTIONS * ! + * - RETOUR A L'ECRAN PRECEDENT * ! + * - RETOUR AU MENU PRECEDENT * ! + * - RETOUR AU MENU GENERAL * ! + **************************************************************** ! + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEMNGEN 2! + *------------------------------------------------------------------- + * !!!!! attention si maintenance * 2! + * lors de compil de program cics natif on ne va pas chercher * 2! + * la clause copy dans cette bibliotheque * 2! + * --> copy de eccx.ppo00.srctlib(giemngen) dans * 2! + * de ec00.ppo00.srclib(giemngen) * 2! + **************************************************************** 2! + * Code personnalisation : CMB GIEMNGEN R1 V1 * 2! + * Date de creation : 27/01/1992 * 2! + * Date de modification : / / * 2! + * * 2! + * Fonctionnalites : * 2! + * TRAITEMENT NORMALISE DE LA FONCTION RETOUR MENU PRINCIPAL * 2! + * * 2! + * Dependance avec autres sections : * 2! + **************************************************************** 2! + IF MENUGEN 2! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR 2! + IF XFER-NB > 1 2! + MOVE XFER-PROG(1) TO NEXT-PROGRAM-NAME 2! + WS-TLN-TYP-PROG 2! + IF NOT WS-TLN-PROG-TELON 2! + THEN MOVE 'C' TO WS-TLN-TYP-XCTL 2! + END-IF 2! + ELSE MOVE 'P001F4 ' TO NEXT-PROGRAM-NAME 2! + MOVE 'C' TO WS-TLN-TYP-XCTL. 2! + *----------------------------------------------! END GIEMNGEN ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEECPRE 2! + *------------------------------------------------------------------- + **************************************************************** 2! + * Code personnalisation : CMB GIEECPRE R1 V1 * 2! + * Date de creation : 27/01/1992 * 2! + * Date de modification : / / * 2! + * * 2! + * Fonctionnalites : * 2! + * TRAITEMENT NORMALISE POUR LA FONCTION ECRAN PRECEDENT * 2! + * * 2! + * Dependance avec autres sections : * 2! + * GIEMNGEN,GIEMNINT,GIEECRINT * 2! + **************************************************************** 2! + IF ECRPRE OR CLEAR 2! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR 2! + IF XFER-NB > 1 2! + COMPUTE XFER-NB = XFER-NB - 1 2! + MOVE XFER-PROG(XFER-NB) TO NEXT-PROGRAM-NAME 2! + WS-TLN-TYP-PROG 2! + IF NOT WS-TLN-PROG-TELON 2! + THEN MOVE 'C' TO WS-TLN-TYP-XCTL 2! + END-IF 2! + ELSE MOVE 'P001F3 ' TO NEXT-PROGRAM-NAME 2! + MOVE 'C' TO WS-TLN-TYP-XCTL. 2! + *----------------------------------------------! END GIEECPRE ---- + + + *TELON-------------------------------------------------------------- + *DS: PCFL.PPO00REF.COPY ! COPY GIEMNPRE 2! + *------------------------------------------------------------------- + * !!!!! attention si maintenance * 2! + * lors de compil de program cics natif on ne va pas chercher * 2! + * la clause copy dans cette bibliotheque * 2! + * --> copy de eccx.ppo00.srctlib(giemnpre) dans * 2! + * de ec00.ppo00.srclib(giemnpre) * 2! + **************************************************************** 2! + * CODE PERSONNALISATION : CMB GIEMNPRE R1 V1 * 2! + * Date de creation : 27/01/1992 * 2! + * Date de modification : / / * 2! + * * 2! + * Fonctionnalites : * 2! + * gestion de la fonction menu precedent * 2! + * * 2! + * Dependance avec autres sections : * 2! + **************************************************************** 2! + IF MENUPRE 2! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR 2! + IF XFER-NB > 1 2! + COMPUTE WS-TLN-IND = XFER-NB - 1 2! + PERFORM UNTIL WS-TLN-IND = ZERO 2! + IF XFER-MENU(WS-TLN-IND) = 'M' 2! + THEN MOVE WS-TLN-IND TO XFER-NB 2! + MOVE XFER-PROG(XFER-NB) TO NEXT-PROGRAM-NAME 2! + WS-TLN-TYP-PROG 2! + IF NOT WS-TLN-PROG-TELON 2! + THEN MOVE 'C' TO WS-TLN-TYP-XCTL 2! + END-IF 2! + MOVE ZERO TO WS-TLN-IND 2! + ELSE SUBTRACT 1 FROM WS-TLN-IND 2! + END-IF 2! + END-PERFORM 2! + ELSE MOVE 'P001F4 ' TO NEXT-PROGRAM-NAME 2! + MOVE 'C' TO WS-TLN-TYP-XCTL. 2! + *----------------------------------------------! END GIEMNPRE ---- + + ! + **************************************************************** ! + * GESTION DES TOUCHES DE FOCNTION NON AUTORISEES. * ! + **************************************************************** ! + ! + IF NOT (ENTER-KEY OR ECRPRE OR CLEAR OR ! + MENUPRE OR MENUGEN OR VALIDATION) ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + MOVE '000001' TO TPO-ERRMSG1. ! + ! + ! + *----------------------------------------------! END CPFKX ---- + + IF (CLEAR AND CONTINUE-PROCESS) + MOVE SPACES TO SPA-TRANSACTION-CODE + EXEC CICS SEND + FROM(SPA-TRANSACTION-CODE) + LENGTH(1) + END-EXEC + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR. + SKIP1 + P-100-PFKEYS-RETURN. + EXIT. + EJECT + Q-100-CICS-INIT SECTION. + ******************************************************** + * Q - 1 0 0 - C I C S - I N I T R O U T I N E * + ******************************************************** + * THIS ROUTINE OPTIONALLY CALLS THE TELON TEST * + * FACILITY FOR PROGRAM TRACE AND SCHEDULES THE DLI * + * PSB WHEN APPLICABLE. * + * * + * GENERATED - ENTIRE SECTION * + ******************************************************** + SKIP1 + CALL 'ADLAATI' USING DFHEIBLK DFHCOMMAREA. + SKIP1 + Q-100-CICS-INIT-RETURN. + EXIT. + EJECT + X-100-CONSIS-EDITS SECTION. + ******************************************************** + * X - 1 0 0 - C O N S I S - E D I T S * + ******************************************************** + * THIS SECTION CONTAINS THE COPY CODE FOR ALL * + * CONSISTENCY EDITS REQUIRED ON INPUT. * + * * + * COPY CODE - SCREEN/CONSIS * + ******************************************************** + SKIP1 + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY CONSIS ! + *------------------------------------------------------------------- + * CONTROLE DE SAISIE SUR ENTETE COMMUN ! + IF NOT VALIDATION ! + ! + INITIALIZE XF-AFF-MEMO-YN4ESPS ! + INITIALIZE Y00CIA-Y00CIA ! + INITIALIZE YN4ESP-ZONE-ALLER ! + ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + ! + PERFORM CTRL-SAISIE1 THRU CTRL-SAISIE1-FIN ! + IF CONTINUE-PROCESS ! + ! + EVALUATE YC4ESD-CD-APLI-OPE OF YC4ESD-ZONE-MODIF ! + WHEN 'CH' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLSCH THRU CTRLSCH-FIN ! + ! + END-IF ! + ! + WHEN 'P7' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLSP7 THRU CTRLSP7-FIN ! + ! + END-IF ! + ! + WHEN '4D' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLS4DF THRU CTRLS4DF-FIN ! + ! + END-IF ! + ! + WHEN '4F' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLS4DF THRU CTRLS4DF-FIN ! + ! + END-IF ! + ! + WHEN '37' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLS37 THRU CTRLS37-FIN ! + ! + END-IF ! + ! + WHEN '4G' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLS4G THRU CTRLS4G-FIN ! + ! + END-IF ! + ! + WHEN 'CO' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLSCO THRU CTRLSCO-FIN ! + ! + END-IF ! + ! + WHEN 'DG' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLSDG THRU CTRLSDG-FIN ! + ! + END-IF ! + ! + WHEN 'FI' ! + IF CONTINUE-PROCESS AND NOT VALIDATION ! + PERFORM CTRLSFI THRU CTRLSFI-FIN ! + ! + END-IF ! + END-EVALUATE ! + END-IF ! + ! + IF CONTINUE-PROCESS ! + * SAUVEGARDE DE LA ZONE DE COMMUNICATION YN4ESPS ! + MOVE YN4ESP-ZONE-ALLER(1:127) TO XF-AFF-MEMO-ZON1 ! + MOVE YN4ESP-NO-PTN OF YN4ESP-ZONE-ALLER ! + TO XF-AFF-MEMO-ZON2 ! + MOVE YN4ESP-NO-PRD-PTN OF YN4ESP-ZONE-ALLER ! + TO XF-AFF-MEMO-ZON3 ! + MOVE YN4ESP-NO-CLI-PTN OF YN4ESP-ZONE-ALLER ! + TO XF-AFF-MEMO-ZON4 ! + MOVE YN4ESP-NO-ORD-CTR OF YN4ESP-ZONE-ALLER ! + TO XF-AFF-MEMO-ZON5 ! + MOVE YN4ESP-ZONE-ALLER(138:124) TO XF-AFF-MEMO-ZON6 ! + MOVE YN4ESP-NO-DOS-SIN-DCS OF YN4ESP-ZONE-ALLER ! + TO XF-AFF-MEMO-ZON7 ! + MOVE YN4ESP-ZONE-ALLER(268:113) TO XF-AFF-MEMO-ZON8 ! + ! + * PROTEGER LES ZONES SAISISSABLES DE L'ECRAN ! + MOVE PROT-ATTR TO TPO-DAPECJ-ATTR ! + TPO-DAPECM-ATTR ! + TPO-DAPECA-ATTR ! + TPO-DAECNJ-ATTR ! + TPO-DAECNM-ATTR ! + TPO-DAECNA-ATTR ! + TPO-CDBQE1-ATTR ! + TPO-CDGUI1-ATTR ! + TPO-NOCPT1-ATTR ! + TPO-NOCHQ-ATTR ! + TPO-CDPTN-ATTR ! + TPO-REF1L15-ATTR ! + TPO-REF2L15-ATTR ! + TPO-REF1L16-ATTR ! + TPO-REF4L16-ATTR ! + TPO-REF1L17-ATTR ! + TPO-RF1L18J-ATTR ! + TPO-RF1L18M-ATTR ! + TPO-RF1L18A-ATTR ! + TPO-RF2L18J-ATTR ! + TPO-RF2L18M-ATTR ! + TPO-RF2L18A-ATTR ! + TPO-RF1L19J-ATTR ! + TPO-RF1L19M-ATTR ! + TPO-RF1L19A-ATTR ! + TPO-REF2L19-ATTR ! + TPO-REF3L19-ATTR ! + TPO-REF5L19-ATTR ! + ! + MOVE '000010' TO TPO-ERRMSG1 ! + SET DEMANDE-DE-VALIDATION TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + END-IF ! + END-IF. ! + ! + *----------------------------------------------! END CONSIS ---- + + SKIP1 + X-100-CONSIS-EDITS-RETURN. + EXIT. + EJECT + Z-100-SECTIONS-COPY SECTION. + ******************************************************** + * S E C T I O N C O P Y C O D E * + ******************************************************** + * THIS SECTION CONTAINS THE COPY CODE FOR THE SECTION * + * PARAMETER. * + * * + * NOTE: Z-100-SECTIONS-COPY SHOULD NEVER BE PERFORMED * + * DIRECTLY, AS THIS SECTION ALWAYS ABENDS. * + * * + * A USER 99 ABEND IS ISSUED BY THE COBOL ABEND * + * ROUTINE. THIS IS USUALLY CAUSED BY CUSTOM CODE IN * + * J-100 THAT DOES A "GO TO X-100-CONSIS-EDITS-RETURN" * + * (I.E. FIELD/SELECT/SCONSIS CODE). * + * * + * COPY CODE - SCREEN/SECTION * + ******************************************************** + EXEC CICS ABEND ABCODE(FALLOUT-ABEND-CODE) END-EXEC. + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY SPRACCES ! + *------------------------------------------------------------------- + * ACCES ACCESSEUR ! + * ! + ACCES-P4DTRANT. ! + *-------------- ! + MOVE '3' TO Y4DTRA-CD-TY-CTRL-E ! + MOVE ZERO TO Y4DTRA-NO-PTN-E ! + ! + MOVE WS-REF2L15 TO Y4DTRA-CD-PRD-E ! + MOVE WS-CD-PTN TO Y4DTRA-CD-PTN-E ! + MOVE SPACES TO Y4DTRA-CD-CLI-PTN-E ! + Y4DTRA-NO-CTR-PTN-E ! + EXEC CICS LINK PROGRAM ('P4DTRANT') ! + COMMAREA (Y4DTRA-Y4DTRAN) ! + LENGTH (Y4DTRA-LONG-SEG) ! + END-EXEC. ! + IF Y4DTRA-CD-RET-S NOT = ZERO AND ! + NOT = '0007' ! + MOVE 'P4DTRANT' TO ABT-ERROR-SECTION ! + MOVE 'DBM' TO ABT-DA-GENERIC-STATUS ! + MOVE Y4DTRA-NOM-PROC-S ! + TO ABT-DA-FUNCTION ! + MOVE 'DB2' TO ABT-ERROR-ACTIVITY ! + MOVE Y4DTRA-NOM-FIC-S ! + TO ABT-DA-ACCESS-NAME ! + MOVE Y4DTRA-CD-RET-SQL-S TO ABT-DB2-STATUS ! + MOVE '00ABD' TO NEXT-PROGRAM-NAME-ID ! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF Y4DTRA-CD-RET-S = ZERO ! + MOVE Y4DTRA-LIB-PRD-S TO WS-REF3L15 ! + ELSE ! + MOVE '4E0022' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE ERROR-ATTR TO TPO-CDPTN-ATTR ! + END-IF ! + END-IF. ! + ! + ACCES-P4DTRANT-FIN. ! + *------------------ ! + EXIT. ! + ! + * CALCUL DU RIB ! + ACCES-P00271. ! + ! + ! + IF NOT DO-TRANSFER ! + ! + MOVE SPACES TO ZL00271-ENR ! + MOVE 'P00271 ' TO ZL00271-NO-PGM ! + MOVE '2' TO ZL00271-CD-CHX ! + MOVE WS-CPT TO ZL00271-RIB-21-CAR ! + ! + EXEC CICS LINK PROGRAM ('P00271') ! + COMMAREA (ZL00271-ENR) ! + LENGTH (ZL00271-LG-COMM) ! + END-EXEC ! + ! + MOVE ZL00271-RIB-CLE TO WS-CPT-RIB-CLE ! + ! + END-IF. ! + ! + ACCES-P00271-FIN. EXIT. ! + **************************************************************** ! + * * ! + * SPRACCES * ! + * * ! + **************************************************************** ! + ! + ACCES-TN4ESPS-005. ! + ! + INITIALIZE Y00CIA-Y00CIA. ! + MOVE '005' TO Y00CIA-FCT-DEM ! + MOVE 'TN4ESPS' TO Y00CIA-NO-PGM-CICS-APP. ! + MOVE 'TC4E3H0' TO Y00CIA-NO-PGM-CICS-AT. ! + MOVE 'M' TO Y00CIA-CD-PVN-APP. ! + ! + MOVE SPACES TO Y00CIA-ZON-APLI. ! + ! + INITIALIZE WS-YN4ESPS-APLI. ! + ! + MOVE YC4ESD-NO-SEQ OF YC4ESD-ZONE-OCC-DET(YC4ESD-NO-OCC-D) ! + TO YN4ESP-NO-SEQ-SP OF YN4ESP-ZONE-ALLER. ! + MOVE YC4ESD-DA-ENT-OPE ! + OF YC4ESD-ZONE-OCC-DET(YC4ESD-NO-OCC-D) ! + TO YN4ESP-DA-ENT-OPE-SP OF YN4ESP-ZONE-ALLER. ! + MOVE 'N' TO YN4ESP-IDC-PEC-OPE-SP OF ! + YN4ESP-ZONE-ALLER. ! + ! + ! + EXEC CICS LINK PROGRAM ('TN4ESPS') ! + COMMAREA (Y00CIA) ! + LENGTH (16000) ! + END-EXEC. ! + ! + EVALUATE Y00CIA-CD-RET-PGM ! + WHEN 16 ! + MOVE Y00CIA-ZON-APLI TO ABNORMAL-TERMINATION-AREA ! + MOVE '00ABD ' TO NEXT-PROGRAM-NAME-ID ! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR ! + WHEN 08 ! + MOVE Y00CIA-CD-MES-ERR TO TPO-ERRMSG1 ! + MOVE Y00CIA-LIB-CPL-MES-ERR ! + TO WS-TLN-LIB-CPL-MES ! + SET DO-WRITE TO TRUE ! + END-EVALUATE. ! + ! + ACCES-TN4ESPS-005-FIN. ! + EXIT. ! + ! + ACCES-TN4ESPS-006. ! + ! + MOVE '006' TO Y00CIA-FCT-DEM ! + MOVE 'TN4ESPS' TO Y00CIA-NO-PGM-CICS-APP. ! + MOVE 'TC4E3H0' TO Y00CIA-NO-PGM-CICS-AT. ! + MOVE 'M' TO Y00CIA-CD-PVN-APP. ! + ! + MOVE YC4ESD-NO-SEQ OF YC4ESD-ZONE-OCC-DET(YC4ESD-NO-OCC-D) ! + TO YN4ESP-NO-SEQ-SP OF YN4ESP-ZONE-ALLER. ! + MOVE YC4ESD-DA-ENT-OPE ! + OF YC4ESD-ZONE-OCC-DET(YC4ESD-NO-OCC-D) ! + TO YN4ESP-DA-ENT-OPE-SP OF YN4ESP-ZONE-ALLER. ! + MOVE 'N' TO YN4ESP-IDC-PEC-OPE-SP OF YN4ESP-ZONE-ALLER. ! + MOVE YC4ESD-CD-APLI-OPE OF YC4ESD-ZONE-MODIF ! + TO YN4ESP-CD-APLI-OPE OF YN4ESP-ZONE-ALLER. ! + ! + ! + EXEC CICS LINK PROGRAM ('TN4ESPS') ! + COMMAREA (Y00CIA) ! + LENGTH (16000) ! + END-EXEC. ! + ! + EVALUATE Y00CIA-CD-RET-PGM ! + WHEN 16 ! + MOVE Y00CIA-ZON-APLI TO ABNORMAL-TERMINATION-AREA ! + MOVE '00ABD ' TO NEXT-PROGRAM-NAME-ID ! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR ! + WHEN 08 ! + MOVE Y00CIA-CD-MES-ERR TO TPO-ERRMSG1 ! + MOVE Y00CIA-LIB-CPL-MES-ERR ! + TO WS-TLN-LIB-CPL-MES ! + SET DO-WRITE TO TRUE ! + WHEN 00 ! + MOVE '000193' TO YC4ESD-CD-MES-ERR ! + END-EVALUATE. ! + ! + ACCES-TN4ESPS-006-FIN. ! + EXIT. ! + ACCES-TN4D101. ! + *---------------* ! + INITIALIZE Y4D101-Y4DN101. ! + MOVE WS-CD-PTN TO Y4D101-CD-PTN. ! + MOVE 'TN4D101' TO Y00WIA-NO-PGM-CICS-APP ! + MOVE 'TC4E3H0' TO Y00WIA-NO-PGM-CICS-AT ! + MOVE '002' TO Y00WIA-FCT-DEM ! + EXEC CICS LINK PROGRAM ('TN4D101') ! + COMMAREA (Y00WIA) ! + LENGTH (4096) ! + END-EXEC ! + IF Y00WIA-CD-RET-PGM = 16 ! + MOVE Y00WIA-ZON-APLI TO ABNORMAL-TERMINATION-AREA ! + MOVE '00ABD ' TO NEXT-PROGRAM-NAME-ID ! + MOVE DO-TRANSFER-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF Y00WIA-CD-RET-PGM NOT = 0 ! + MOVE Y00WIA-LIB-CPL-MES-ERR TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF Y4D101-LA-PTN = SPACES ! + MOVE Y4D101-NOM-PTN TO WS-LIB-PTN ! + ELSE ! + MOVE Y4D101-LA-PTN TO WS-LIB-PTN ! + END-IF ! + END-IF ! + END-IF. ! + ACCES-TN4D101-FIN. EXIT. ! + *----------------------------------------------! END SPRACCES ---- + + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY SPITAB ! + *------------------------------------------------------------------- + * ACCES SPITAB ! + * ACCES SPITAB ! + ************************************************************** ! + * ACCES A LA TABLE YSP4E013 POUR TROUVER LE LIBELLE COURT ! + * DU CRO ! + ************************************************************** ! + ! +056400 ACCES-SPI013. ! +056800 ! +058800 MOVE LOW-VALUES TO YSP4E013-YSP4E013. ! +058900 MOVE '00' TO SPI-RETCOD. ! + MOVE SPACE TO SPI-PARMCICS. ! + MOVE 'GP' TO SPI-FONCTION. ! +700 MOVE '= ' TO SPI-OPERATEUR. ! + MOVE 'YSP4E013' TO SPI-CODTAB. ! + MOVE +2500 TO SPI-LONG. ! + MOVE 'SPI2TAB' TO SPI-FICHIER. ! +900 MOVE WS-REF2L19 TO YSP4E013-CD-TY-CRO ! + MOVE YN4ESP-CD-APLI-OPE OF YN4ESP-DETAIL-SIT ! + TO YSP4E013-CD-APLI-OPE. ! + MOVE YSP4E013-YSP4E013 TO SPI-REF-POSTE. ! +000 ! + EXEC CICS LINK PROGRAM ('SPI2TCV') ! + COMMAREA (SPI-PARMCICS) ! + LENGTH (SPI-LONG) ! + END-EXEC. ! +400 ! +400 ! +500 EVALUATE SPI-RETCOD ! +600 WHEN '00' ! +700 MOVE SPI-IOAREA TO YSP4E013-YSP4E013 ! + MOVE YSP4E013-LIB-TY-VER TO WS-REF4L19 ! + ! + WHEN '02' ! + MOVE 'TYPE CRO INCONNU, VOIR TABLE YSP4E013' ! + TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! +300 WHEN OTHER ! + MOVE Y00CIA-ZON-APLI TO ABNORMAL-TERMINATION-AREA ! + MOVE '00ABD ' TO NEXT-PROGRAM-NAME-ID ! + SET DO-TRANSFER TO TRUE ! +900 END-EVALUATE. ! +065000 ! +056400 ACCES-SPI013-FIN. EXIT. ! +065000 ! +065000 ! + ************************************************************** ! + * ACCES A LA TABLE YSP4E053 POUR TROUVER LE LIBELLE MODE ! + * REGLEMENT ! + ************************************************************** ! + ! +056400 ACCES-SPI053. ! +056800 ! +058800 MOVE LOW-VALUES TO YSP4E053-YSP4E053. ! +058900 MOVE '00' TO SPI-RETCOD. ! + MOVE SPACE TO SPI-PARMCICS. ! + MOVE 'GP' TO SPI-FONCTION. ! +700 MOVE '= ' TO SPI-OPERATEUR. ! + MOVE 'YSP4E053' TO SPI-CODTAB. ! + MOVE +2500 TO SPI-LONG. ! + MOVE 'SPI2TAB' TO SPI-FICHIER. ! + MOVE YN4ESP-CD-MODE-RGL-OPE OF YN4ESP-DETAIL-SIT ! + TO YSP4E053-CD-MODE-RGL-OPE. ! + MOVE YSP4E053-YSP4E053 TO SPI-REF-POSTE. ! +000 ! + EXEC CICS LINK PROGRAM ('SPI2TCV') ! + COMMAREA (SPI-PARMCICS) ! + LENGTH (SPI-LONG) ! + END-EXEC. ! +400 ! +400 ! +500 EVALUATE SPI-RETCOD ! +600 WHEN '00' ! +700 MOVE SPI-IOAREA TO YSP4E053-YSP4E053 ! + WHEN '02' ! + MOVE SPACES TO TPO-LIBRGL ! +300 WHEN OTHER ! + MOVE Y00CIA-ZON-APLI TO ABNORMAL-TERMINATION-AREA ! + MOVE '00ABD ' TO NEXT-PROGRAM-NAME-ID ! + SET DO-TRANSFER TO TRUE ! +900 END-EVALUATE. ! +065000 ! +056400 ACCES-SPI053-FIN. EXIT. ! +065000 ! + ************************************************************** ! + * ACCES A LA TABLE YSP4E017 POUR TROUVER LE LIBELLE DU CODE ! + * REJET DU MOUVEMENT ! + ************************************************************** ! + ! +056400 ACCES-SPI017. ! +056800 ! +058800 MOVE LOW-VALUES TO YSP4E017-YSP4E017. ! +058900 MOVE '00' TO SPI-RETCOD. ! + MOVE SPACE TO SPI-PARMCICS. ! + MOVE 'GP' TO SPI-FONCTION. ! +700 MOVE '= ' TO SPI-OPERATEUR. ! + MOVE 'YSP4E017' TO SPI-CODTAB. ! + MOVE +2500 TO SPI-LONG. ! + MOVE 'SPI2TAB' TO SPI-FICHIER. ! + MOVE YN4ESP-CD-REJ-OPE OF YN4ESP-DETAIL-SIT ! + TO YSP4E017-CD-REJ-OPE. ! + MOVE YSP4E017-YSP4E017 TO SPI-REF-POSTE. ! +000 ! + EXEC CICS LINK PROGRAM ('SPI2TCV') ! + COMMAREA (SPI-PARMCICS) ! + LENGTH (SPI-LONG) ! + END-EXEC. ! +400 ! +400 ! +500 EVALUATE SPI-RETCOD ! +600 WHEN '00' ! +700 MOVE SPI-IOAREA TO YSP4E017-YSP4E017 ! +900 MOVE YSP4E017-LIB-REJ-OPE TO WS-LIB-REJ-OPE ! + WHEN '02' ! + MOVE SPACES TO TPO-LIBREJ ! +300 WHEN OTHER ! + MOVE Y00CIA-ZON-APLI TO ABNORMAL-TERMINATION-AREA ! + MOVE '00ABD ' TO NEXT-PROGRAM-NAME-ID ! + SET DO-TRANSFER TO TRUE ! +900 END-EVALUATE. ! +065000 ! +056400 ACCES-SPI017-FIN. EXIT. ! +065000 ! + *----------------------------------------------! END SPITAB ---- + + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY CTRL1 ! + *------------------------------------------------------------------- + * CONTROLE SAISIE UTILISATEUR ! + ! + * CONTROLE SAISIE UTILISATEUR ! + ****************************** ! + CTRL-SAISIE1. ! + ! + IF TPO-DAPECJ-ATTR = ERROR-ATTR ! + OR TPO-DAPECM-ATTR = ERROR-ATTR ! + OR TPO-DAPECA-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-DAPECJ NOT = XF-AFF-DA-PEC-DEM-JJ ! + OR TPI-DAPECM NOT = XF-AFF-DA-PEC-DEM-MM ! + OR TPI-DAPECA NOT = XF-AFF-DA-PEC-DEM-SA ! + MOVE TPI-DAPECJ TO WS-DA10-JJ ! + MOVE TPI-DAPECM TO WS-DA10-MM ! + MOVE TPI-DAPECA TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-PEC-DEM-SP ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-DA-PEC-DEM-JJ TO WS-DAFIC-JJ ! + MOVE XF-AFF-DA-PEC-DEM-MM TO WS-DAFIC-MM ! + MOVE XF-AFF-DA-PEC-DEM-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-PEC-DEM-SP ! + OF YN4ESP-ZONE-ALLER ! + END-IF. ! + ! + IF TPO-DAECNJ-ATTR = ERROR-ATTR ! + OR TPO-DAECNM-ATTR = ERROR-ATTR ! + OR TPO-DAECNA-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-DAECNJ NOT = XF-AFF-DA-ECN-OPE-JJ ! + OR TPI-DAECNM NOT = XF-AFF-DA-ECN-OPE-MM ! + OR TPI-DAECNA NOT = XF-AFF-DA-ECN-OPE-SA ! + MOVE TPI-DAECNJ TO WS-DA10-JJ ! + MOVE TPI-DAECNM TO WS-DA10-MM ! + MOVE TPI-DAECNA TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-ECN-OPE ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-DA-ECN-OPE-JJ TO WS-DAFIC-JJ ! + MOVE XF-AFF-DA-ECN-OPE-MM TO WS-DAFIC-MM ! + MOVE XF-AFF-DA-ECN-OPE-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-ECN-OPE OF ! + YN4ESP-ZONE-ALLER ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF WS-CD-BQE-DST1 NOT NUMERIC ! + MOVE '4E0041' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-CDBQE1-ATTR ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF WS-CD-GUI-DST1 NOT NUMERIC ! + MOVE '4E0042' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-CDGUI1-ATTR ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + END-IF. ! + ! + ! + IF CONTINUE-PROCESS ! + IF WS-CD-BQE-DST1 NOT = XF-AFF-CD-BQE-DST1 ! + OR WS-CD-GUI-DST1 NOT = XF-AFF-CD-GUI-DST1 ! + OR WS-NO-CPT-DST1 NOT = XF-AFF-NO-CPT-DST1 ! + ! + MOVE WS-CD-BQE-DST1 TO WS-CPT-BQE ! + MOVE WS-CD-GUI-DST1 TO WS-CPT-GUI ! + MOVE WS-NO-CPT-DST1 TO WS-CPT-CPT ! + MOVE ZERO TO WS-CPT-RIB-CLE ! + ! + PERFORM ACCES-P00271 THRU ACCES-P00271-FIN ! + MOVE WS-CPT-RIB-CLE TO WS-CLE-RIB1 ! + MOVE WS-CLE-RIB1 TO TPO-CLERIB1 ! + ! + MOVE WS-CD-BQE-DST1 TO YN4ESP-CD-BQE-DST ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-CD-GUI-DST1 TO YN4ESP-CD-GUI-DST ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-NO-CPT-DST1 TO YN4ESP-NO-CPT-DST ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-CD-BQE-DST1 TO YN4ESP-CD-BQE-DST ! + OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-CD-GUI-DST1 TO YN4ESP-CD-GUI-DST ! + OF YN4ESP-ZONE-ALLER ! + MOVE XF-AFF-NO-CPT-DST1 TO YN4ESP-NO-CPT-DST ! + OF YN4ESP-ZONE-ALLER ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF WS-NO-CHQ NOT NUMERIC AND WS-NO-CHQ NOT = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-NOCHQ-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF WS-NO-CHQ NOT = XF-AFF-NO-CHQ ! + MOVE WS-NO-CHQ TO YN4ESP-NO-CHQ ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-NO-CHQ TO YN4ESP-NO-CHQ ! + OF YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-CDAPL NOT = 'DG' AND NOT = '5G' ! + MOVE TPI-CDPTN TO WS-CD-PTN ! + * PERFORM ACCES-SPIPTN THRU ACCES-SPIPTN-FIN ! + * IF SPI-RETCOD NOT = '00' ! + * SET TOP-SAISIE-KO TO TRUE ! + * MOVE '000141' TO TPO-ERRMSG1 ! + * MOVE ERROR-ATTR TO TPO-CDPTN-ATTR ! + * MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + PERFORM ACCES-TN4D101 THRU ACCES-TN4D101-FIN ! + IF Y00CIA-CD-RET-PGM NOT = 0 ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE Y00CIA-CD-MES-ERR TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-CDPTN-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + MOVE WS-CD-PTN TO YN4ESP-CD-PTN ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-LIB-PTN TO TPO-LIBPTN ! + END-IF ! + IF TOP-SAISIE-OK ! + IF TPO-CDAPL = 'P7' OR '4D' OR '4F' ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S = '0007' ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + ! + CTRL-SAISIE1-FIN. ! + EXIT. ! + ! + *----------------------------------------------! END CTRL1 ---- + + + *TELON-------------------------------------------------------------- + *DS: H01 ! COPY CTRLS ! + *------------------------------------------------------------------- + * CONTROLE NIVEAU REFERENCE DE GESTION ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION CH * ! + ******************************************************** ! + CTRLSCH. ! + ! + * CONTROLE SAISIE DU PRENOM ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L17 > SPACES ! + MOVE TPI-REF1L17 TO WS-REF1L17 ! + MOVE WS-REF1L17 TO YN4ESP-LIB-NOM ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLSCH-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION P7 * ! + ******************************************************** ! + CTRLSP7. ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0060' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15(1:8) NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15 NOT = XF-AFF-REF1L15 ! + MOVE TPI-REF1L15 TO WS-REF1L15 ! + MOVE WS-REF1L15 TO YN4ESP-NO-POL-9 OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L15 TO YN4ESP-NO-POL-9 ! + OF YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L15(1:2) NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L15 NOT = XF-AFF-REF2L15 ! + MOVE TPI-REF2L15 TO WS-REF2L15 ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S = '0007' ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + MOVE WS-REF2L15 TO YN4ESP-CD-PRD OF ! + YN4ESP-ZONE-ALLER ! + MOVE WS-REF3L15 TO TPO-REF3L15 ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L15 TO YN4ESP-CD-PRD OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + * CONTROLE SAISIE DU PRENOM ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L17 NOT = XF-AFF-REF1L17 ! + MOVE TPI-REF1L17 TO WS-REF1L17 ! + MOVE WS-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L18J-ATTR = ERROR-ATTR ! + OR TPO-RF1L18M-ATTR = ERROR-ATTR ! + OR TPO-RF1L18A-ATTR = ERROR-ATTR ! + OR TPO-RF2L18J-ATTR = ERROR-ATTR ! + OR TPO-RF2L18M-ATTR = ERROR-ATTR ! + OR TPO-RF2L18A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + ! + IF TPI-RF1L18J NOT = XF-AFF-RF1L18-J ! + OR TPI-RF1L18M NOT = XF-AFF-RF1L18-M ! + OR TPI-RF1L18A NOT = XF-AFF-RF1L18-S ! + ! + MOVE TPI-RF1L18J TO WS-DA10-JJ ! + MOVE TPI-RF1L18M TO WS-DA10-MM ! + MOVE TPI-RF1L18A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-SCR-CTR OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L18-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L18-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L18-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-SCR-CTR OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + ! + IF TPI-RF2L18J NOT = XF-AFF-RF2L18-J ! + OR TPI-RF2L18M NOT = XF-AFF-RF2L18-M ! + OR TPI-RF2L18A NOT = XF-AFF-RF2L18-S ! + MOVE TPI-RF2L18J TO WS-DA10-JJ ! + MOVE TPI-RF2L18M TO WS-DA10-MM ! + MOVE TPI-RF2L18A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-EFF OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF2L18-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF2L18-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF2L18-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-EFF OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L19J-ATTR = ERROR-ATTR ! + OR TPO-RF1L19M-ATTR = ERROR-ATTR ! + OR TPO-RF1L19A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L19J NOT = XF-AFF-RF1L19-J ! + OR TPI-RF1L19M NOT = XF-AFF-RF1L19-M ! + OR TPI-RF1L19A NOT = XF-AFF-RF1L19-S ! + MOVE TPI-RF1L19J TO WS-DA10-JJ ! + MOVE TPI-RF1L19M TO WS-DA10-MM ! + MOVE TPI-RF1L19A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L19-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L19-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L19-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L19 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0065' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L19 NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L19 NOT = XF-AFF-REF2L19 ! + MOVE TPI-REF2L19 TO WS-REF2L19 ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + IF SPI-RETCOD = '00' ! + MOVE WS-REF2L19 TO YN4ESP-CD-TY-CRO ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-REF4L19 TO TPO-REF4L19 ! + ELSE ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0066' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L19 TO YN4ESP-CD-TY-CRO ! + OF YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF5L19 NOT = XF-AFF-REF5L19 ! + MOVE TPI-REF5L19 TO WS-REF5L19 ! + MOVE WS-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLSP7-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION CO * ! + ******************************************************** ! + CTRLSCO. ! + ! + * CONTROLE SAISIE DU NOM DU CORRESPONDANT ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L17 NOT = XF-AFF-REF1L17 ! + MOVE TPI-REF1L17 TO WS-REF1L17 ! + MOVE WS-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLSCO-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION DG * ! + ******************************************************** ! + CTRLSDG. ! + * TEST LA PERIODE DG RESAISIE ! + IF TPI-REF4L16 NOT > SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0064' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF4L16-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF4L16 NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF4L16-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF4L16 NOT = XF-AFF-REF4L16 ! + MOVE TPI-REF4L16 TO WS-REF4L16 ! + MOVE WS-REF4L16 TO YN4ESP-PER-DCR-DGI OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF4L16 TO YN4ESP-PER-DCR-DGI OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + CTRLSDG-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION FI * ! + ******************************************************** ! + CTRLSFI. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L19J-ATTR = ERROR-ATTR ! + OR TPO-RF1L19M-ATTR = ERROR-ATTR ! + OR TPO-RF1L19A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L19J NOT = XF-AFF-RF1L19-J ! + OR TPI-RF1L19M NOT = XF-AFF-RF1L19-M ! + OR TPI-RF1L19A NOT = XF-AFF-RF1L19-S ! + MOVE TPI-RF1L19J TO WS-DA10-JJ ! + MOVE TPI-RF1L19M TO WS-DA10-MM ! + MOVE TPI-RF1L19A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L19-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L19-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L19-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L19 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0065' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + MOVE 'O' TO WS-CHANGEMENT ! + ELSE ! + IF TPI-REF2L19 NOT = XF-AFF-REF2L19 ! + MOVE TPI-REF2L19 TO WS-REF2L19 ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + IF SPI-RETCOD = '00' ! + MOVE WS-REF2L19 TO YN4ESP-CD-TY-CRO ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-REF4L19 TO TPO-REF4L19 ! + ELSE ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0066' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L19 TO YN4ESP-CD-TY-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF5L19 NOT = XF-AFF-REF5L19 ! + MOVE TPI-REF5L19 TO WS-REF5L19 ! + MOVE WS-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLSFI-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION 37 * ! + ******************************************************** ! + CTRLS37. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15(1:7) NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0062' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15 NOT = XF-AFF-REF1L15 ! + MOVE TPI-REF1L15 TO WS-REF1L15 ! + MOVE WS-REF1L15 TO YN4ESP-NO-CLI-PTN ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L15 TO YN4ESP-NO-CLI-PTN OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L15(1:2) NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L15 NOT = XF-AFF-REF2L15 ! + MOVE TPI-REF2L15 TO WS-REF2L15 ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S = '0007' ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + MOVE WS-REF2L15 TO YN4ESP-CD-PRD OF ! + YN4ESP-ZONE-ALLER ! + MOVE WS-REF3L15 TO TPO-REF3L15 ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L15 TO YN4ESP-CD-PRD OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + * CONTROLE SAISIE DU NOM ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L17 NOT = XF-AFF-REF1L17 ! + MOVE TPI-REF1L17 TO WS-REF1L17 ! + MOVE WS-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L18J-ATTR = ERROR-ATTR ! + OR TPO-RF1L18M-ATTR = ERROR-ATTR ! + OR TPO-RF1L18A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L18J NOT = XF-AFF-RF1L18-J ! + OR TPI-RF1L18M NOT = XF-AFF-RF1L18-M ! + OR TPI-RF1L18A NOT = XF-AFF-RF1L18-S ! + MOVE TPI-RF1L18J TO WS-DA10-JJ ! + MOVE TPI-RF1L18M TO WS-DA10-MM ! + MOVE TPI-RF1L18A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-SCR-CTR OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L18-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L18-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L18-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-SCR-CTR OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L19J-ATTR = ERROR-ATTR ! + OR TPO-RF1L19M-ATTR = ERROR-ATTR ! + OR TPO-RF1L19A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L19J NOT = XF-AFF-RF1L19-J ! + OR TPI-RF1L19M NOT = XF-AFF-RF1L19-M ! + OR TPI-RF1L19A NOT = XF-AFF-RF1L19-S ! + MOVE TPI-RF1L19J TO WS-DA10-JJ ! + MOVE TPI-RF1L19M TO WS-DA10-MM ! + MOVE TPI-RF1L19A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L19-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L19-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L19-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L19 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0065' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L19 NOT = XF-AFF-REF2L19 ! + MOVE TPI-REF2L19 TO WS-REF2L19 ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + IF SPI-RETCOD = '00' ! + MOVE WS-REF2L19 TO YN4ESP-CD-TY-CRO ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-REF4L19 TO TPO-REF4L19 ! + ELSE ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0066' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L19 TO YN4ESP-CD-TY-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF5L19 NOT = XF-AFF-REF5L19 ! + MOVE TPI-REF5L19 TO WS-REF5L19 ! + MOVE WS-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLS37-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATIONS 4D ET 4F * ! + ******************************************************** ! + CTRLS4DF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15(1:8) NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0061' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPO-IDCPTN = 'CM' ! + MOVE 'O' ! + TO YN4ESP-IDC-PTN-CM OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE 'N' ! + TO YN4ESP-IDC-PTN-CM OF YN4ESP-ZONE-ALLER ! + END-IF ! + IF TPI-REF1L15 NOT = XF-AFF-REF1L15 ! + MOVE TPI-REF1L15 TO WS-REF1L15 ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-ZONE-ALLER= 'O' ! + MOVE WS-REF1L15 TO YN4ESP-RAC-CLE OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE WS-REF1L15 TO YN4ESP-NO-POL-9 OF YN4ESP-ZONE-ALLER ! + END-IF ! + ELSE ! + IF YN4ESP-IDC-PTN-CM OF YN4ESP-ZONE-ALLER= 'O' ! + MOVE XF-AFF-REF1L15 TO YN4ESP-RAC-CLE ! + OF YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L15 TO YN4ESP-NO-POL-9 ! + OF YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L15 NOT = XF-AFF-REF2L15 ! + MOVE TPI-REF2L15 TO WS-REF2L15 ! + PERFORM ACCES-P4DTRANT THRU ACCES-P4DTRANT-FIN ! + IF Y4DTRA-CD-RET-S = '0007' ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + MOVE WS-REF2L15 TO YN4ESP-CD-PRD OF ! + YN4ESP-ZONE-ALLER ! + MOVE WS-REF3L15 TO TPO-REF3L15 ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L15 TO YN4ESP-CD-PRD OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L16 NOT > 0 ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L16 NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000270' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L16 NOT = XF-AFF-REF1L16 ! + MOVE WS-REF1L16 TO YN4ESP-NO-ORD-CTR OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L16 TO YN4ESP-NO-ORD-CTR OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + * CONTROLE SAISIE DU NOM ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L17 NOT = XF-AFF-REF1L17 ! + MOVE TPI-REF1L17 TO WS-REF1L17 ! + MOVE WS-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L18J-ATTR = ERROR-ATTR ! + OR TPO-RF1L18M-ATTR = ERROR-ATTR ! + OR TPO-RF1L18A-ATTR = ERROR-ATTR ! + OR TPO-RF2L18J-ATTR = ERROR-ATTR ! + OR TPO-RF2L18M-ATTR = ERROR-ATTR ! + OR TPO-RF2L18A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L18J NOT = XF-AFF-RF1L18-J ! + OR TPI-RF1L18M NOT = XF-AFF-RF1L18-M ! + OR TPI-RF1L18A NOT = XF-AFF-RF1L18-S ! + ! + MOVE TPI-RF1L18J TO WS-DA10-JJ ! + MOVE TPI-RF1L18M TO WS-DA10-MM ! + MOVE TPI-RF1L18A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-SCR-CTR OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L18-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L18-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L18-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-SCR-CTR OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + ! + IF TPI-RF2L18J NOT = XF-AFF-RF2L18-J ! + OR TPI-RF2L18M NOT = XF-AFF-RF2L18-M ! + OR TPI-RF2L18A NOT = XF-AFF-RF2L18-S ! + MOVE TPI-RF2L18J TO WS-DA10-JJ ! + MOVE TPI-RF2L18M TO WS-DA10-MM ! + MOVE TPI-RF2L18A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-EFF OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF2L18-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF2L18-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF2L18-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-EFF OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L19J-ATTR = ERROR-ATTR ! + OR TPO-RF1L19M-ATTR = ERROR-ATTR ! + OR TPO-RF1L19A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L19J NOT = XF-AFF-RF1L19-J ! + OR TPI-RF1L19M NOT = XF-AFF-RF1L19-M ! + OR TPI-RF1L19A NOT = XF-AFF-RF1L19-S ! + MOVE TPI-RF1L19J TO WS-DA10-JJ ! + MOVE TPI-RF1L19M TO WS-DA10-MM ! + MOVE TPI-RF1L19A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L19-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L19-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L19-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L19 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0065' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L19 NOT = XF-AFF-REF2L19 ! + MOVE TPI-REF2L19 TO WS-REF2L19 ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + IF SPI-RETCOD = '00' ! + MOVE WS-REF2L19 TO YN4ESP-CD-TY-CRO ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-REF4L19 TO TPO-REF4L19 ! + ELSE ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0066' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L19 TO YN4ESP-CD-TY-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS AND ! + YC4ESD-CD-APLI-OPE OF YC4ESD-ZONE-MODIF = '4D' ! + IF TPI-REF3L19 NOT = XF-AFF-REF3L19 ! + MOVE XF-AFF-REF3L19 TO YN4ESP-CD-CLO-ECN OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF3L19 TO YN4ESP-CD-CLO-ECN OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF5L19 NOT = XF-AFF-REF5L19 ! + MOVE TPI-REF5L19 TO WS-REF5L19 ! + MOVE WS-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLS4DF-FIN. ! + EXIT. ! + ! + ******************************************************** ! + * CONTROLE ZONES SAISIES DANS REFERENCES DE GESTION * ! + * APPLICATION 4G * ! + ******************************************************** ! + CTRLS4G. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L15 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '000148' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15 NOT NUMERIC ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0063' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF1L15-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF1L15 NOT = XF-AFF-REF1L15 ! + MOVE TPI-REF1L15 TO WS-REF1L15 ! + MOVE WS-REF1L15 TO YN4ESP-NO-DOS-SIN-DCS OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L15 TO YN4ESP-NO-DOS-SIN-DCS OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF ! + END-IF. ! + ! + * CONTROLE SAISIE DU NOM ! + IF CONTINUE-PROCESS ! + IF TPI-REF1L17 NOT = XF-AFF-REF1L17 ! + MOVE TPI-REF1L17 TO WS-REF1L17 ! + MOVE WS-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF1L17 TO YN4ESP-LIB-NOM OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPO-RF1L19J-ATTR = ERROR-ATTR ! + OR TPO-RF1L19M-ATTR = ERROR-ATTR ! + OR TPO-RF1L19A-ATTR = ERROR-ATTR ! + MOVE '000029' TO TPO-ERRMSG1 ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + SET TOP-SAISIE-KO TO TRUE ! + ELSE ! + IF TPI-RF1L19J NOT = XF-AFF-RF1L19-J ! + OR TPI-RF1L19M NOT = XF-AFF-RF1L19-M ! + OR TPI-RF1L19A NOT = XF-AFF-RF1L19-S ! + MOVE TPI-RF1L19J TO WS-DA10-JJ ! + MOVE TPI-RF1L19M TO WS-DA10-MM ! + MOVE TPI-RF1L19A TO WS-DA10-SA ! + MOVE WS-DA10-JJ TO WS-DAFIC-JJ ! + MOVE WS-DA10-MM TO WS-DAFIC-MM ! + MOVE WS-DA10-SA TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-RF1L19-J TO WS-DAFIC-JJ ! + MOVE XF-AFF-RF1L19-M TO WS-DAFIC-MM ! + MOVE XF-AFF-RF1L19-S TO WS-DAFIC-SA ! + MOVE WS-DAFIC TO YN4ESP-DA-CRE-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF2L19 = SPACES ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0065' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + ELSE ! + IF TPI-REF2L19 NOT = XF-AFF-REF2L19 ! + MOVE TPI-REF2L19 TO WS-REF2L19 ! + PERFORM ACCES-SPI013 THRU ACCES-SPI013-FIN ! + IF SPI-RETCOD = '00' ! + MOVE WS-REF2L19 TO YN4ESP-CD-TY-CRO ! + OF YN4ESP-ZONE-ALLER ! + MOVE WS-REF4L19 TO TPO-REF4L19 ! + ELSE ! + SET TOP-SAISIE-KO TO TRUE ! + MOVE '4E0066' TO TPO-ERRMSG1 ! + MOVE ERROR-ATTR TO TPO-REF2L19-ATTR ! + MOVE DO-WRITE-LIT TO CONTROL-INDICATOR ! + END-IF ! + ELSE ! + MOVE XF-AFF-REF2L19 TO YN4ESP-CD-TY-CRO OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF ! + END-IF. ! + ! + IF CONTINUE-PROCESS ! + IF TPI-REF5L19 NOT = XF-AFF-REF5L19 ! + MOVE TPI-REF5L19 TO WS-REF5L19 ! + MOVE WS-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + ELSE ! + MOVE XF-AFF-REF5L19 TO YN4ESP-CD-MTL OF ! + YN4ESP-ZONE-ALLER ! + END-IF ! + END-IF. ! + ! + CTRLS4G-FIN. ! + EXIT. ! + ! + *----------------------------------------------! END CTRLS ---- + + EJECT + Z-900-SECTION-FALLOUT SECTION. + ******************************************************** + * Z - 9 0 0 - S E C T I O N - F A L L O U T * + ******************************************************** + * * + * THIS ROUTINE EXECUTES AN EXEC CICS ABEND WITH THE * + * ABEND CODE SPECIFIED BY FALLOUT-ABEND-CODE. * + * THE CODE IN THIS SECTION WILL ONLY BE EXECUTED IF * + * CONTROL FALLS OUT OF A PREVIOUS SECTION. * + * * + ******************************************************** + EXEC CICS ABEND ABCODE(FALLOUT-ABEND-CODE) END-EXEC. + EJECT + Z-990-PROGRAM-ERROR SECTION. + ******************************************************** + * Z - 9 9 0 - P R O G R A M - E R R O R * + ******************************************************** + * * + * THIS SECTION CALLS THE COBOL ABEND ROUTINE WITH AN * + * ABEND CODE SPECIFIED BY CNTLERR-ABEND-CODE. IT IS * + * PERFORMED IF CONTROL-INDICATOR IS AN UNDEFINED * + * VALUE IN THE MAINLINE. * + ******************************************************** + EXEC CICS ABEND ABCODE(CNTLERR-ABEND-CODE) END-EXEC. + SKIP1 diff --git a/it/it-projects/plugins/project/src/cpp/BiggestUnInt.cc b/it/it-projects/plugins/project/src/cpp/BiggestUnInt.cc new file mode 100644 index 00000000000..3cd1acff87b --- /dev/null +++ b/it/it-projects/plugins/project/src/cpp/BiggestUnInt.cc @@ -0,0 +1,51 @@ +// BiggestUnInt2.cc +// usage: +// BiggestUnInt2 <starting number> (optional argument, default is 1) +// example: +// BiggestUnInt2 4194305 +// features: + +#include <iostream> +#include <cstdlib> + +using namespace std; + +void bitsout( unsigned int n ); + +int main(int argc, char* argv[]) +{ + int N=0; + unsigned int i=1 , oldi , j ; + if(argc>1) { + sscanf( argv[1], "%u", &i ) ; // starting value + } + cout << "#\ti \ti+(i-1)\t2i\n" ; + cout << "#\t#### \t#######\t###\n" ; + do { + oldi = i ; + j = i-1 ; + j += i ; // this sets j = 2i-1 (we hope) + i *= 2 ; // this doubles i (we hope) + cout << N << ":\t" << oldi << "\t" << j << "\t" << i << "\t"; + bitsout(i); + cout << endl ; + N++; + } while ( j+1==i && i!=0 ) ; // keep going until something odd happens + // (Under normal arithmetic, + // we always expect A: j+1 to equal i, and + // we always expect B: i not to be 0 + // we keep going while _both_ A _and_ B are true.) + // ( '&&' means "_and_" ) +} + +void bitsout( unsigned int m ) +{ + int lastbit ; + unsigned int two_to_power_i ; + + for ( int i = 31 ; i >= 0 ; i -- ) { + two_to_power_i = (1<<i) ; + lastbit = ( two_to_power_i & m ) == 0 ? 0 : 1 ; + cout << lastbit ; + } +} diff --git a/it/it-projects/plugins/project/src/cpp/HelloWorld.cpp b/it/it-projects/plugins/project/src/cpp/HelloWorld.cpp new file mode 100644 index 00000000000..c8ad9555383 --- /dev/null +++ b/it/it-projects/plugins/project/src/cpp/HelloWorld.cpp @@ -0,0 +1,8 @@ +using namespace std; + +int main () +{ + // comment + cout << "Hello World!"; + return 0; +} diff --git a/it/it-projects/plugins/project/src/cpp/RandDemo.cc b/it/it-projects/plugins/project/src/cpp/RandDemo.cc new file mode 100644 index 00000000000..1f775a04e76 --- /dev/null +++ b/it/it-projects/plugins/project/src/cpp/RandDemo.cc @@ -0,0 +1,87 @@ +// RandDemo.cc +// features: +// * uses random() to get a random integer +// * gets interactive user input +// * uses ternary operator "q ? a : b" + +#include <iostream> +#include <cstdlib> +#include <ctime> + +using namespace std; + +#define ranf() \ + ((double)random()/(1.0+(double)RAND_MAX)) // Uniform from interval [0,1) */ + +int main() +{ + int outcome, N=0, count_in=0 ; + double fraction_in ; + + // Initialise random number generator with value of system time. + srandom(time(NULL)); + + // Get user input in correct range. + while(N<1) + { + cout << "Input the number of experiments: "; + cin >> N; + } + + // Perform N experiments. + for(int n=1; n<=N; n++) + { + double x = ranf(); + double y = ranf(); + outcome = ( x*x + y*y > 1.0 ) ? 0 : 1 ; + if(outcome==1) count_in++; + cout << outcome << "\t" << x << "\t" << y << "\t" + << count_in << "\t" << n << endl; + } + + // Sample goto to raise a violation + goto L1; + + //Sample switch with default + switch (bob) + { + case 1: { + cout << "1"; + break; + } + case 2: + { + cout <<"2"; + break; + } + default: + { + cout << "3"; + } + } + + //Sample switch without default + switch (bob) + { + case 1: { + cout << "1"; + break; + } + case 2: + { + cout <<"2"; + break; + } + } + + //Integer variables must be converted (cast) for correct division + fraction_in = static_cast<double>(count_in)/N; + + // Output results + cout << "# Proportion of outcomes 'in' " + << fraction_in << endl; + // Output results + cout << "# pi-hat = " + << 4.0 * fraction_in << endl; + return 0; +} diff --git a/it/it-projects/plugins/project/src/cpp/SimpleClass.cc b/it/it-projects/plugins/project/src/cpp/SimpleClass.cc new file mode 100644 index 00000000000..4f4ceba3aae --- /dev/null +++ b/it/it-projects/plugins/project/src/cpp/SimpleClass.cc @@ -0,0 +1,70 @@ +// DateClass.cc +// Program to demonstrate the definition of a simple class +// and member functions + +#include <iostream> +using namespace std; + + +// Declaration of Date class +class Date { + +public: + Date(int, int, int); + void set(int, int, int); + void print(); + +private: + int year; + int month; + int day; +}; + + +int main() +{ + // Declare today to be object of class Date + // Values are automatically intialised by calling constructor function + Date today(1,9,1999); + + cout << "This program was written on "; + today.print(); + + cout << "This program was modified on "; + today.set(5,10,1999); + today.print(); + + return 0; +} + +// Date constructor function definition +Date::Date(int d, int m, int y) +{ + if(d>0 && d<31) day = d; + if(m>0 && m<13) month = m; + if(y>0) year =y; +} + +// Date member function definitions +void Date::set(int d, int m, int y) +{ + if(d>0) { + if (d<31){ + if(m>0) { + if (m<13) { + if(y>0) { + year =y; + month = m; + day = d; + } + } + } + } + } +} + +void Date::print() +{ + cout << day << "-" << month << "-" << year << endl; +} + diff --git a/it/it-projects/plugins/project/src/cpp/main.c b/it/it-projects/plugins/project/src/cpp/main.c new file mode 100644 index 00000000000..05a68cccd30 --- /dev/null +++ b/it/it-projects/plugins/project/src/cpp/main.c @@ -0,0 +1,18 @@ +#include <stdio.h> /* NOK, according to the MISRA C 2004 20.9 rule, stdio.h must not be used in embedded system's production code */ + +#include <mylib.h> + +/* + * Compile & run from current folder: + * gcc -Wall -pedantic -std=c99 -I../lib -o main main.c && ./main + */ + +int main(void) { + int x = ADD(40, 2); + + if (x != 42) + { /* NOK, empty code blocks generate violations */ + } + + printf("40 + 2 = %d\n", x); +} diff --git a/it/it-projects/plugins/project/src/css/sample.css b/it/it-projects/plugins/project/src/css/sample.css new file mode 100644 index 00000000000..88a2ce9fdb4 --- /dev/null +++ b/it/it-projects/plugins/project/src/css/sample.css @@ -0,0 +1,89 @@ +.quality-gates-navigator .navigator-side { + display: table-cell; + vertical-align: top; + width: 250px; + min-width: 0; +} +.quality-gates-navigator .navigator-header { + margin-left: 0; +} +.quality-gates-navigator .navigator-header .spinner { + margin-top: 9px; +} +.quality-gates-navigator .navigator-actions { + height: 40px; + width: 230px; + margin: 10px; + padding: 0 10px; +} +.quality-gates-navigator .navigator-actions .navigator-header-title { + color: #444; + font-size: 13px; + font-weight: 700; + text-transform: uppercase; +} +.quality-gates-navigator .navigator-results { + width: 230px; + min-width: 0; +} +.quality-gates-navigator .navigator-details { + margin-left: 0; +} +.quality-gates-nav .navigator-results-list>li { + border-color: transparent; +} +.quality-gates-nav .navigator-results-list>li:hover:not(.active):not(.empty) { + background-color: #f3f3f3; +} +.quality-gates-nav .navigator-results-list>li.active { + border-color: #4B9FD5; +} +.quality-gates-nav .navigator-results-list>li.empty { + cursor: default; +} +.quality-gates-nav .navigator-results-list>li .line { + padding-top: 2px; + padding-bottom: 2px; +} +.quality-gates-nav .navigator-results-list>li .subtitle { + text-transform: lowercase; +} +.quality-gate-section+.quality-gate-section { + margin-top: 10px; + padding-top: 20px; +} +.quality-gate-section-empty+.quality-gate-section { + border-top: 1px solid #e6e6e6; +} +.quality-gate-section-name { + margin-bottom: 10px; + font-weight: 700; + text-transform: uppercase; +} +.quality-gate-introduction { + margin-bottom: 20px; +} +.quality-gate-new-condition { + margin-bottom: 10px; +} +.quality-gate-condition-actions { + position: relative; +} +.quality-gate-default-message { + padding: 6px 5px; + border: 1px solid #ddd; + background-color: #efefef; +} +.quality-gate-conditions-wrap { + border-left: 1px solid #ddd; + border-right: 1px solid #ddd; +} +.quality-gate-conditions .deprecated { + color: #777; + text-transform: lowercase; + font-variant: small-caps; +} +.quality-gate-conditions tbody { + border-left: none!important; + border-right: none!important; +} diff --git a/it/it-projects/plugins/project/src/flex/Circle.as b/it/it-projects/plugins/project/src/flex/Circle.as new file mode 100644 index 00000000000..29ebe94393f --- /dev/null +++ b/it/it-projects/plugins/project/src/flex/Circle.as @@ -0,0 +1,14 @@ +package { + + public class Circle { + public var diameter:int = 0; + + function Circle (d:int) { + if (d == 0) { + this.diameter = -1; + } else { + this.diameter = d; + } + } + } +} diff --git a/it/it-projects/plugins/project/src/flex/HasIssues.as b/it/it-projects/plugins/project/src/flex/HasIssues.as new file mode 100644 index 00000000000..410b52709b4 --- /dev/null +++ b/it/it-projects/plugins/project/src/flex/HasIssues.as @@ -0,0 +1,12 @@ +package { + + public class HasIssues { + + function HasIssues (d:int) { + if (d == 0) { + break + } + break + } + } +} diff --git a/it/it-projects/plugins/project/src/flex/UncoveredCircle.as b/it/it-projects/plugins/project/src/flex/UncoveredCircle.as new file mode 100644 index 00000000000..e0a6650345b --- /dev/null +++ b/it/it-projects/plugins/project/src/flex/UncoveredCircle.as @@ -0,0 +1,10 @@ +package { + + public class UncoveredCircle { + public var diameter:int = 0; + + function UncoveredCircle (d:int) { + this.diameter = d; + } + } +} diff --git a/it/it-projects/plugins/project/src/groovy/example/Greeting.groovy b/it/it-projects/plugins/project/src/groovy/example/Greeting.groovy new file mode 100644 index 00000000000..ef635498267 --- /dev/null +++ b/it/it-projects/plugins/project/src/groovy/example/Greeting.groovy @@ -0,0 +1,7 @@ +package example + +class Greeting { + def say() { + println 'Hello World' + } +} diff --git a/it/it-projects/plugins/project/src/groovy/innerclass/InnerClassExample.groovy b/it/it-projects/plugins/project/src/groovy/innerclass/InnerClassExample.groovy new file mode 100644 index 00000000000..caf298d205c --- /dev/null +++ b/it/it-projects/plugins/project/src/groovy/innerclass/InnerClassExample.groovy @@ -0,0 +1,14 @@ +package innerclass + +class InnerClassExample +{ + def show() { + println 'Hello World' + new ExampleInnerClass().show() + } + + class ExampleInnerClass { + def show() { println "Hello Inner"} + } + +} diff --git a/it/it-projects/plugins/project/src/java/foo/Foo.java b/it/it-projects/plugins/project/src/java/foo/Foo.java new file mode 100644 index 00000000000..20bf396881c --- /dev/null +++ b/it/it-projects/plugins/project/src/java/foo/Foo.java @@ -0,0 +1,15 @@ +package foo; + +/** + * Foo class + */ +public class Foo { + + public static int div(int a, int b) { + if (b == 0) { + throw new UnsupportedOperationException("Can't divide by zero!"); + } + return a / b; + } + +} diff --git a/it/it-projects/plugins/project/src/java/foo/Simplest.java b/it/it-projects/plugins/project/src/java/foo/Simplest.java new file mode 100644 index 00000000000..981db6738c3 --- /dev/null +++ b/it/it-projects/plugins/project/src/java/foo/Simplest.java @@ -0,0 +1,17 @@ +package foo; + +/** + * Simple class + */ +public class Simplest { + + public static int add(int a, int b) { + // introduce a variable that is not needed - just to get a violation + int result = a + b; + + System.out.println(""); + + return result; + } + +} diff --git a/it/it-projects/plugins/project/src/java/foo/Simplest2.java b/it/it-projects/plugins/project/src/java/foo/Simplest2.java new file mode 100644 index 00000000000..2d673e178bc --- /dev/null +++ b/it/it-projects/plugins/project/src/java/foo/Simplest2.java @@ -0,0 +1,7 @@ +package foo; + +public class Simplest2 { + + public static void foo() {} + +} diff --git a/it/it-projects/plugins/project/src/java/foo/Simplest3.java b/it/it-projects/plugins/project/src/java/foo/Simplest3.java new file mode 100644 index 00000000000..530fe4c4284 --- /dev/null +++ b/it/it-projects/plugins/project/src/java/foo/Simplest3.java @@ -0,0 +1,5 @@ +package foo; + +public class Simplest3 { + +} diff --git a/it/it-projects/plugins/project/src/js/HasIssues.js b/it/it-projects/plugins/project/src/js/HasIssues.js new file mode 100644 index 00000000000..8426dcf168c --- /dev/null +++ b/it/it-projects/plugins/project/src/js/HasIssues.js @@ -0,0 +1,18 @@ +// FIXME +alert("should not be used"); + +function strict() { + 'use strict'; +} + +function pow(a, b) { + if(b == 0) { + return 0; + } + var x = a; + for (var i = 1; i<b; i++) { + //Dead store because the last return statement should return x instead of returning a + x = x * a; + } + return a; +} diff --git a/it/it-projects/plugins/project/src/js/Person.js b/it/it-projects/plugins/project/src/js/Person.js new file mode 100644 index 00000000000..f536a4f4c5e --- /dev/null +++ b/it/it-projects/plugins/project/src/js/Person.js @@ -0,0 +1,14 @@ + +var Person = function(first, last, middle) { + this.first = first; + this.middle = middle; + this.last = last; +}; + +Person.prototype = { + + whoAreYou : function() { + return this.first + (this.middle ? ' ' + this.middle: '') + ' ' + this.last; + } + +};
\ No newline at end of file diff --git a/it/it-projects/plugins/project/src/js/com/company/Car.js b/it/it-projects/plugins/project/src/js/com/company/Car.js new file mode 100644 index 00000000000..40a9da7898c --- /dev/null +++ b/it/it-projects/plugins/project/src/js/com/company/Car.js @@ -0,0 +1,50 @@ +var Car = function(brand, model, year) { + this.brand = brand; + this.model = model; + this.year = year; + this.engineState = 'stopped'; + this.messageToDriver = ''; +}; + +Car.prototype = { + + getFullName : function() { + return this.brand + ' ' + this.model + ' ' + 'Y: ' + this.year; + }, + + calculatePrice : function() { + if (this.year < 1990) { + return '$1500'; + } else if (this.year > 2011) { + return '$30000'; + } else { + return '$1500 - 30000'; + } + }, + + startEngine : function() { + this.engineState = 'started'; + return 'engine started'; + }, + + stopEngine : function() { + this.engineState = 'stopped'; + return 'engine stopped'; + }, + + stopEngineWithCheck : function() { + if (this.engineState === 'started') { + this.engineState = 'stopped'; + this.messageToDriver = 'all good. c u later'; + return 'engine stopped'; + } else { + this.messageToDriver = 'engine not started. what do you want me to do?'; + return 'engine was not running'; + } + }, + + tuneCar : function() { + this.year = '2011'; + } + +};
\ No newline at end of file diff --git a/it/it-projects/plugins/project/src/js/com/company/Truck.js b/it/it-projects/plugins/project/src/js/com/company/Truck.js new file mode 100644 index 00000000000..98df0732527 --- /dev/null +++ b/it/it-projects/plugins/project/src/js/com/company/Truck.js @@ -0,0 +1,24 @@ +var Truck = function(brand, model, year) { + this.brand = brand; + this.model = model; + this.year = year; + this.engineState = 'stopped'; + this.messageToDriver = ''; +}; + +Truck.prototype = { + + getFullName : function() { + return this.brand + ' ' + this.model + ' ' + 'Y: ' + this.year; + }, + + calculatePrice : function() { + if (this.year < 1990) { + return '$15000'; + } else if (this.year > 2011) { + return '$300000'; + } else { + return '$15000 - 300000'; + } + } +};
\ No newline at end of file diff --git a/it/it-projects/plugins/project/src/js/com/company/Vehicle.js b/it/it-projects/plugins/project/src/js/com/company/Vehicle.js new file mode 100644 index 00000000000..e004a007b6c --- /dev/null +++ b/it/it-projects/plugins/project/src/js/com/company/Vehicle.js @@ -0,0 +1,53 @@ +/** + * This is copy/paste file from Car.js with couple methods removed + * + * Removed methods: + * - startEngine () + * - stopEngine () + * + */ +var Vehicle = function(brand, model, year) { + this.brand = brand; + this.model = model; + this.year = year; + this.engineState = 'stopped'; + this.messageToDriver = ''; +}; + + +// single line comments line 1 +// single line comments line 2 +// single line comments line 3 +// single line comments line 4 +Vehicle.prototype = { + + getFullName : function() { + return this.brand + ' ' + this.model + ' ' + 'Y: ' + this.year; + }, + + calculatePrice : function() { + if (this.year < 1990) { + return '$1500'; + } else if (this.year > 2011) { + return '$30000'; + } else { + return '$1500 - 30000'; + } + }, + + stopEngineWithCheck : function() { + if (this.engineState === 'started') { + this.engineState = 'stopped'; + this.messageToDriver = 'all good. c u later'; + return 'engine stopped'; + } else { + this.messageToDriver = 'engine not started. what do you want me to do?'; + return 'engine was not running'; + } + }, + + tuneCar : function() { + this.year = '2011'; + } + +};
\ No newline at end of file diff --git a/it/it-projects/plugins/project/src/php/Math.php b/it/it-projects/plugins/project/src/php/Math.php new file mode 100644 index 00000000000..5c1ab480233 --- /dev/null +++ b/it/it-projects/plugins/project/src/php/Math.php @@ -0,0 +1,214 @@ +<?php +/** + * This file is part of phpUnderControl. + * + * Copyright (c) 2007-2009, Manuel Pichler <mapi@phpundercontrol.org>. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * * Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in + * the documentation and/or other materials provided with the + * distribution. + * + * * Neither the name of Manuel Pichler nor the names of his + * contributors may be used to endorse or promote products derived + * from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + * + * @package Example + * @author Manuel Pichler <mapi@phpundercontrol.org> + * @copyright 2007-2009 Manuel Pichler. All rights reserved. + * @license http://www.opensource.org/licenses/bsd-license.php BSD License + * @version SVN: $Id: Math.php 4429 2009-01-04 15:39:45Z mapi $ + * @link http://www.phpundercontrol.org/ + */ +function add($v1 , $v2) + { + return ($v1 + $v2); + } + +/** + * Simple math class. + * + * @package Example + * @author Manuel Pichler <mapi@phpundercontrol.org> + * @copyright 2007-2009 Manuel Pichler. All rights reserved. + * @license http://www.opensource.org/licenses/bsd-license.php BSD License + * @version Release: 0.5.0 + * @link http://www.phpundercontrol.org/ + */ +class PhpUnderControl_Example_Math +{ + /** + * Adds the two given values. + * + * @param integer $v1 Value one. + * @param integer $v2 Value two. + * + * @return integer. + */ + public function add($v1 , $v2) + { + return ($v1 + $v2); + } + + /** + * Subtract param two from param one + * + * @param integer $v1 Value one. + * @param integer $v2 Value two. + * + * @return integer. + */ + public function sub($v1, $v2) + { + return ($v1 - $v2); + } + + /** + * Not tested method that should be visible with low coverage. + */ + public function div($v1, $v2) + { + $v3 = $v1 / ($v2 + $v1); + if ($v3 > 14) + { + $v4 = 0; + for ($i = 0; $i < $v3; $i++) + { + $v4 += ($v2 * $i); + } + } + $v5 = ($v4 < $v3 ? ($v3 - $v4) : ($v4 - $v3)); + + $v6 = ($v1 * $v2 * $v3 * $v4 * $v5); + + $d = array($v1, $v2, $v3, $v4, $v5, $v6); + + $v7 = 1; + for ($i = 0; $i < $v6; $i++) + { + shuffle( $d ); + $v7 = $v7 + $i * end($d); + } + + $v8 = $v7; + foreach ( $d as $x ) + { + $v8 *= $x; + } + + $v3 = $v1 / ($v2 + $v1); + if ($v3 > 14) + { + $v4 = 0; + for ($i = 0; $i < $v3; $i++) + { + $v4 += ($v2 * $i); + } + } + $v5 = ($v4 < $v3 ? ($v3 - $v4) : ($v4 - $v3)); + + $v6 = ($v1 * $v2 * $v3 * $v4 * $v5); + + $d = array($v1, $v2, $v3, $v4, $v5, $v6); + + $v7 = 1; + for ($i = 0; $i < $v6; $i++) + { + shuffle( $d ); + $v7 = $v7 + $i * end($d); + } + + $v8 = $v7; + foreach ( $d as $x ) + { + $v8 *= $x; + } + + return $v8; + } + + /** + * Simple copy for cpd detection. + */ + public function complex($v1, $v2) + { + $v3 = $v1 / ($v2 + $v1); + if ($v3 > 14) + { + $v4 = 0; + for ($i = 0; $i < $v3; $i++) + { + $v4 += ($v2 * $i); + } + } + $v5 = ($v4 < $v3 ? ($v3 - $v4) : ($v4 - $v3)); + + $v6 = ($v1 * $v2 * $v3 * $v4 * $v5); + + $d = array($v1, $v2, $v3, $v4, $v5, $v6); + + $v7 = 1; + for ($i = 0; $i < $v6; $i++) + { + shuffle( $d ); + $v7 = $v7 + $i * end( $d ); + } + + $v8 = $v7; + foreach ( $d as $x ) + { + $v8 *= $x; + } + + $v3 = $v1 / ($v2 + $v1); + if ($v3 > 14) + { + $v4 = 0; + for ($i = 0; $i < $v3; $i++) + { + $v4 += ($v2 * $i); + } + } + $v5 = ($v4 < $v3 ? ($v3 - $v4) : ($v4 - $v3)); + + $v6 = ($v1 * $v2 * $v3 * $v4 * $v5); + + $d = array($v1, $v2, $v3, $v4, $v5, $v6); + + $v7 = 1; + for ($i = 0; $i < $v6; $i++) + { + shuffle( $d ); + $v7 = $v7 + $i * end($d); + } + + $v8 = $v7; + foreach ( $d as $x ) + { + $v8 *= $x; + } + + return $v8; + } +} diff --git a/it/it-projects/plugins/project/src/pli/center.pli b/it/it-projects/plugins/project/src/pli/center.pli new file mode 100644 index 00000000000..d6d79e5bebd --- /dev/null +++ b/it/it-projects/plugins/project/src/pli/center.pli @@ -0,0 +1,212 @@ + /* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */ + /* Structured Programming". Permission is given to reproduce and to use these procedures */ + /* as part of a program, and to include them as part of a larger work to be sold for profit. */ + /* However, the user is not permitted to sell the procedures separately. Provided always */ + /* that these procedures and this copyright notice are reproduced in full. */ + + DECLARE CENTERLEFT GENERIC + (CENTER_LEFT_2 WHEN (*, *), + CENTER_LEFT_3 WHEN (*, *, *) ); + DECLARE CENTER GENERIC + (CENTER_LEFT_2 WHEN (*, *), + CENTER_LEFT_3 WHEN (*, *, *) ); + DECLARE CENTERRIGHT GENERIC + (CENTER_RIGHT_2 WHEN (*, *), + CENTER_RIGHT_3 WHEN (*, *, *) ); + DECLARE CENTRELEFT GENERIC + (CENTER_LEFT_2 WHEN (*, *), + CENTER_LEFT_3 WHEN (*, *, *) ); + DECLARE CENTRERIGHT GENERIC + (CENTER_RIGHT_2 WHEN (*, *), + CENTER_RIGHT_3 WHEN (*, *, *) ); + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the left of dead center if it cannot be dead center. */ + CENTER_LEFT_2: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 2)/2; + + WORK = ''; + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_LEFT_2; + + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the left of dead center if it cannot be dead center. A specified fill */ + /* character FILL extends STRING right and left. */ + CENTER_LEFT_3: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + /* FILL = a fill character used to extend STRING at both ends. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 2)/2; + + WORK = REPEAT (FILL, LEN-1); + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_LEFT_3; + + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the right of dead center if it cannot be dead center. */ + CENTER_RIGHT_2: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 3)/2; + + WORK = ''; + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_RIGHT_2; + + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the right of dead center if it cannot be dead center. A specified fill */ + /* character FILL extends STRING right and left. */ + CENTER_RIGHT_3: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + /* FILL = a fill character used to extend STRING at both ends. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 3)/2; + + WORK = REPEAT (FILL, LEN-1); + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_RIGHT_3; + + DECLARE LEFT GENERIC + (LEFT_blank WHEN (*,*), + LEFT_other WHEN (*,*,*) ); + + /* This procedure returns STRING in a string of length LEN, with blank characters padded on */ + /* the right. */ + LEFT_blank: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned left; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* placed. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = ''; + SUBSTR (WORK, 1, L) = STRING; + RETURN (WORK); + END LEFT_blank; + + /* This procedure returns STRING in a string of length LEN, padded with the character */ + /* FILL on the right. */ + LEFT_other: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned left; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* positioned left; */ + /* FILL = the character to be used to fill out the finished string. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = STRING || REPEAT (FILL, LEN-L-1); + RETURN (WORK); + END LEFT_other; + + DECLARE RIGHT GENERIC + (RIGHT_blank WHEN (*,*), + RIGHT_other WHEN (*,*,*) ); + + /* This procedure returns STRING right-adjusted in a string of length N, padded with blanks */ + /* on the left. */ + RIGHT_blank: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned right; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* positioned right. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = ''; + SUBSTR (WORK, LEN-L+1, L) = STRING; + RETURN (WORK); + END RIGHT_blank; + + /* This procedure returns STRING right-adjusted in a string of length N, padded with the */ + /* character FILL on the left. */ + RIGHT_other: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned right; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* positioned right; */ + /* FILL = the character to be used to fill out the finished string. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = REPEAT (FILL, LEN-L-1) || STRING; + RETURN (WORK); + END RIGHT_other; diff --git a/it/it-projects/plugins/project/src/pli/chess.pli b/it/it-projects/plugins/project/src/pli/chess.pli new file mode 100644 index 00000000000..f1e9c1aaed8 --- /dev/null +++ b/it/it-projects/plugins/project/src/pli/chess.pli @@ -0,0 +1,760 @@ + /* This is a chess program written in PL/I. */ + /* The original was written in Fortran 90 by Dean Menezes. */ + /* This translation by R. A. Vowels, 30 May 2008. */ + /* Moves are input in this form: */ + /* E2-E4 (start square, hyphen, end square). */ + + /* Sources: */ + + /* http://ai-depot.com/articles/minimax-explained/ */ + /* http://www.aihorizon.com/essays/chessai/index.htm */ + /* http://www.ascotti.org/programming/chess/Shannon%20-%20Programming + %20a%20computer%20for%20playing%20chess.pdf */ + + (SUBRG, SIZE, FOFL, STRINGRANGE, STRINGSIZE): + CHESS: PROCEDURE OPTIONS (MAIN, REORDER); + /* Global variables: */ + /* level = current recursion level for calculation */ + /* maxlevel = maximum recursion level */ + /* score = current score (evaluation) */ + /* besta, bestb, bestx, besty = holds best moves for each recursion level */ + /* wcksflag, wcqsflag = flags to detemine castling abilities */ + /* board = the 8x8 array to hold chessboard */ + DECLARE ( MAXLEVEL VALUE ( 5) ) FIXED BINARY; + DECLARE ( LEVEL, SCORE, BESTA(0:7) ) FIXED BINARY (31); + DECLARE ( BESTB(1:MAXLEVEL), BESTX(1:MAXLEVEL), BESTY(1:MAXLEVEL) ) FIXED + BINARY (31); + DECLARE ( WCKSFLAG, WCQSFLAG ) BIT(1) ALIGNED; + DECLARE ( A, B, X, Y, RES ) FIXED BINARY (31); + + + /* initialize board to starting position */ + DECLARE BOARD(0:7, 0:7) FIXED BINARY (31) STATIC INITIAL ( + -500, -270, -300, -900, -7500, -300, -270, -500, + -100, -100, -100, -100, -100, -100, -100, -100, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 100, 100, 100, 100, 100, 100, 100, 100, + 500, 270, 300, 900, 5000, 300, 270, 500 ); + + LEVEL=0; A=-1; RES=0; + WCKSFLAG = '0'B ; WCQSFLAG = '0'B; + /* main loop: get white move from user, calculate black move */ + DO FOREVER; + SCORE=0; + CALL IO(A, B, X, Y, RES); + RES=EVALUATE(-1, 10000); + A=BESTA(1); B=BESTB(1); X=BESTX(1); Y=BESTY(1); + END; + + /* figure out if white is in check */ + INCHECK: PROCEDURE () RETURNS( FIXED BINARY (31)) OPTIONS (REORDER); + DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31); + DECLARE (I, A, B, X, Y, NDX) FIXED BINARY (31); + + DO B = 0 TO 7; + DO A = 0 TO 7; + IF BOARD(B, A)>=0 THEN + ITERATE; + CALL MOVELIST(A, B, XX, YY, CC, NDX); + /* iterate through move list and see if */ + /* piece can get to king */ + DO I = 0 TO NDX BY 1; + X = XX(I); + Y = YY(I); + IF BOARD(Y, X) = 5000 THEN + RETURN (1); + END; + END; + END; + RETURN (0); + END INCHECK; + + EVALUATE: PROCEDURE (ID, PRUNE) RETURNS ( FIXED BINARY (31) ) RECURSIVE; + DECLARE ( ID, PRUNE ) FIXED BINARY (31); + /* local variables. */ + DECLARE ( XX(0:26), YY(0:26), CC(0:26) ) FIXED BINARY (31); + DECLARE ( A, B, X, Y, C, OLDSCORE, BESTSCORE, MOVER, TARG, NDX, + I ) FIXED BINARY (31); + + LEVEL=LEVEL+1; + BESTSCORE=10000*ID; + DO B=7 TO 0 BY -1; + DO A=7 TO 0 BY -1; + /* generate the moves for all the pieces */ + /* and iterate through them */ + IF SIGN(BOARD(B,A))^=ID THEN + ITERATE; + CALL MOVELIST (A, B, XX, YY, CC, NDX); + DO I=0 TO NDX BY 1; + X=XX(I); Y=YY(I); C=CC(I); + OLDSCORE=SCORE; MOVER=BOARD(B,A); TARG=BOARD(Y,X); + /* make the move and evaluate the new position */ + /* recursively. Targ holds the relative value of the piece */ + /* allowing use to calculate material gain/loss */ + CALL MAKEMOVE (A, B, X, Y, C); + IF LEVEL<MAXLEVEL THEN + DO; + SCORE=SCORE+EVALUATE(-ID, + BESTSCORE-TARG+ID*(8-ABS(4-X)-ABS(4-Y))); + END; + SCORE=SCORE+TARG-ID*(8-ABS(4-X)-ABS(4-Y)); + /* we want to minimize the maximum possible loss */ + /* for black */ + IF (ID<0 & SCORE>BESTSCORE) | (ID>0 & SCORE<BESTSCORE) THEN + DO; + BESTA(LEVEL)=A; BESTB(LEVEL)=B; + BESTX(LEVEL)=X; BESTY(LEVEL)=Y; + BESTSCORE=SCORE; + IF (ID<0 & BESTSCORE>=PRUNE) | (ID>0 & BESTSCORE<=PRUNE) THEN + DO; + BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE; + LEVEL=LEVEL-1; + RETURN (BESTSCORE); + END; + END; + BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE; + END; + END; + END; + LEVEL=LEVEL-1; + RETURN (BESTSCORE); + END EVALUATE; + + /* make a move given the start square and end square */ + /* currently always promotes to queen */ + /* Moves from position (A, B) to position (X,Y). */ + + MAKEMOVE: PROCEDURE (A, B, X, Y, C) OPTIONS (REORDER); + DECLARE (A, B, X, Y, C) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31); + + BOARD(Y, X)=BOARD(B, A); BOARD(B, A)=0; + IF Y = 0 & BOARD(Y, X) = 100 THEN + BOARD(Y, X)= C; + IF Y = 7 & BOARD(Y, X) = -100 THEN + BOARD(Y, X)= C; + RETURN; + END MAKEMOVE; + + /* select appropriate subprogram to populate xx and yy arrays */ + /* with piece moves */ + /* xx = x coordinates */ + /* yy = y coordinates */ + /* cc = pawn promotion if applicable */ + /* ndx = index into xx, yy, cc arrays showing the number of */ + /* elements that the arrays have been populated with */ + MOVELIST: PROCEDURE (A, B, XX, YY, CC, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31); + DECLARE (NDX) FIXED BINARY (31); + DECLARE (PIECE) FIXED BINARY (31); + + PIECE=ABS(BOARD(B, A)); NDX=-1; + SELECT (PIECE); + WHEN (100) CALL PAWN(A, B, XX, YY, CC, NDX); + WHEN (270) CALL KNIGHT(A, B, XX, YY, NDX); + WHEN (300) CALL BISHOP(A, B, XX, YY, NDX); + WHEN (500) CALL ROOK(A, B, XX, YY, NDX); + WHEN (900) CALL QUEEN(A, B, XX, YY, NDX); + OTHERWISE CALL KING(A, B, XX, YY, NDX); + END; + RETURN; + END MOVELIST; + + /* queen is a combination of rook and bishop */ + QUEEN: PROCEDURE (A, B, XX, YY, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31); + DECLARE NDX FIXED BINARY (31); + + CALL ROOK(A, B, XX, YY, NDX); + CALL BISHOP(A, B, XX, YY, NDX); + RETURN; + END QUEEN; + + + KING: PROCEDURE (A, B, XX, YY, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31); + DECLARE NDX FIXED BINARY (31); + DECLARE (ID, DX, DY) FIXED BINARY (31); + + ID=SIGN(BOARD(B, A)); + /* negative = left or up */ + /* positive = right or down */ + /* zero = no change */ + DO DY=-1 TO 1; + IF B+DY<0 | B+DY>7 THEN + ITERATE; + DO DX=-1 TO 1; + IF A+DX<0 | A+DX>7 THEN + ITERATE; + IF ID^=SIGN(BOARD(B+DY,A+DX)) THEN + DO; + NDX=NDX+1; XX(NDX)=A+DX; YY(NDX)=B+DY; + END; + END; + END; + RETURN; + END KING; + + + PAWN: PROCEDURE (A, B, XX, YY, CC, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31); + DECLARE NDX FIXED BINARY (31); + DECLARE (I, ID) FIXED BINARY (31); + + ID = SIGN(BOARD(B, A)); + IF ((A - 1) >= 0) & ((A - 1) <= 7) & ((B - ID) >= 0) & ((B - + ID) <= 7) THEN + DO; + IF SIGN(BOARD((B - ID), (A - 1))) = -ID THEN + DO; + IF ((ID<0) & (B = 6)) | ((ID>0) & (B = 1)) THEN + DO; + CC(NDX+1) = 270*ID; + CC(NDX+2) = 300*ID; + CC(NDX+3) = 500*ID; + CC(NDX+4) = 900*ID; + DO I=1 TO 4; + NDX = NDX + 1; + XX(NDX) = A - 1; + YY(NDX) = B - ID; + END; + END; + ELSE + DO; + NDX = NDX + 1; + XX(NDX) = A - 1; + YY(NDX) = B - ID; + END; + END; + END; + IF ((A + 1) >= 0) & ((A + 1) <= 7) & ((B - ID) >= 0) & ((B + - ID) <= 7) THEN + DO; + IF SIGN(BOARD((B - ID), (A + 1))) = -ID THEN + DO; + IF ((ID<0) & (B = 6)) | ((ID>0) & (B = 1)) THEN + DO; + CC(NDX+1) = 270*ID; + CC(NDX+2) = 300*ID; + CC(NDX+3) = 500*ID; + CC(NDX+4) = 900*ID; + DO I=1 TO 4; + NDX = NDX + 1; + XX(NDX) = A + 1; + YY(NDX) = B - ID; + END; + END; + ELSE + DO; + NDX = NDX + 1; + XX(NDX) = A + 1; + YY(NDX) = B - ID; + END; + END; + END; + IF (A >= 0) & (A <= 7) & ((B - ID) >= 0) & ((B - ID) <= 7) THEN + DO; + IF BOARD((B - ID), A) = 0 THEN + DO; + IF ((ID<0) & (B = 6)) | ((ID>0) & (B = 1)) THEN + DO; + CC(NDX+1) = 270*ID; + CC(NDX+2) = 300*ID; + CC(NDX+3) = 500*ID; + CC(NDX+4) = 900*ID; + DO I=1 TO 4; + NDX = NDX + 1; + XX(NDX) = A; + YY(NDX) = B - ID; + END; + END; + ELSE + DO; + NDX = NDX + 1; + XX(NDX) = A; + YY(NDX) = B - ID; + END; + IF ((ID < 0) & (B = 1)) | ((ID > 0) & (B = 6)) THEN + DO; + IF BOARD((B - ID - ID), A) = 0 THEN + DO; + NDX = NDX + 1; + XX(NDX) = A; + YY(NDX) = B - ID - ID; + END; + END; + END; + END; + END PAWN; + + + BISHOP: PROCEDURE (A, B, XX, YY, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31); + DECLARE NDX FIXED BINARY (31); + DECLARE (ID, DXY, X, Y) FIXED BINARY; + + ID=SIGN(BOARD(B, A)); + /* four diagonal directions */ + DO DXY=1 TO 7; + X=A-DXY; IF (X<0) THEN LEAVE; + Y=B+DXY; IF (Y>7) THEN LEAVE; + IF ID^=SIGN(BOARD(Y, X)) THEN /* cannot capture piece of same color */ + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + IF BOARD(Y, X)^=0 THEN + LEAVE /* cannot jump over pieces */; + END; + DO DXY=1 TO 7; + X=A+DXY; IF (X>7) THEN LEAVE; + Y=B+DXY; IF (Y>7) THEN LEAVE; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + IF BOARD(Y, X)^=0 THEN + LEAVE; + END; + DO DXY=1 TO 7; + X=A-DXY; IF (X<0) THEN LEAVE; + Y=B-DXY; IF (Y<0) THEN LEAVE; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + IF BOARD(Y, X)^=0 THEN + LEAVE; + END; + DO DXY=1 TO 7; + X=A+DXY; IF (X>7) THEN LEAVE; + Y=B-DXY; IF (Y<0) THEN LEAVE; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + IF BOARD(Y, X)^=0 THEN + LEAVE; + END; + END BISHOP; + + ROOK: PROCEDURE (A, B, XX, YY, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31); + DECLARE NDX FIXED BINARY (31); + DECLARE (ID, X, Y) FIXED BINARY (31); + + ID=SIGN(BOARD(B, A)); + /* four different orthagonal directions */ + DO X = A-1 TO 0 BY -1; + IF ID^=SIGN(BOARD(B, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=B; + END; + IF BOARD(B, X)^=0 THEN + LEAVE; + END; + DO X = A+1 TO 7 BY 1; + IF ID^=SIGN(BOARD(B, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=B; + END; + IF BOARD(B, X)^=0 THEN + LEAVE; + END; + DO Y = B-1 TO 0 BY -1; + IF ID^=SIGN(BOARD(Y, A)) THEN + DO; + NDX=NDX+1; XX(NDX)=A; YY(NDX)=Y; + END; + IF BOARD(Y, A)^=0 THEN + LEAVE; + END; + DO Y = B+1 TO 7 BY 1; + IF ID^=SIGN(BOARD(Y, A)) THEN + DO; + NDX=NDX+1; XX(NDX)=A; YY(NDX)=Y; + END; + IF BOARD(Y, A)^=0 THEN + LEAVE; + END; + RETURN; + END ROOK; + + + KNIGHT: PROCEDURE (A, B, XX, YY, NDX) OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31); + DECLARE NDX FIXED BINARY (31); + DECLARE (ID, X, Y) FIXED BINARY (31); + + ID=SIGN(BOARD(B, A)); + /* 2 vertical, 1 horizontal */ + /* or 2 horizontal, 1 vertical */ + X=A-1; Y=B-2; + IF X>=0 & Y>=0 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A-2; Y=B-1; + IF X>=0 & Y>=0 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A+1; Y=B-2; + IF X<=7 & Y>=0 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A+2; Y=B-1; + IF X<=7 & Y>=0 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A-1; Y=B+2; + IF X>=0 & Y<=7 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A-2; Y=B+1; + IF X>=0 & Y<=7 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A+1; Y=B+2; + IF X<=7 & Y<=7 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + X=A+2; Y=B+1; + IF X<=7 & Y<=7 THEN + DO; + IF ID^=SIGN(BOARD(Y, X)) THEN + DO; + NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y; + END; + END; + RETURN; + END KNIGHT; + + /* display chessboard */ + SHOW: PROCEDURE OPTIONS (REORDER); + DECLARE (A, B) FIXED BINARY (31); + + DO B=0 TO 7; + PUT SKIP EDIT ( ' +---+---+---+---+---+---+---+---+' )(COL(20), A); + PUT SKIP EDIT ( 8-B, ' |' )(COL(20), F(1), A); + DO A=0 TO 7; + SELECT (BOARD(B, A)); + WHEN (-7500) PUT EDIT ( ' *k|' )(A); + WHEN (-900) PUT EDIT ( ' *q|' )(A); + WHEN (-500) PUT EDIT ( ' *r|' )(A); + WHEN (-300) PUT EDIT ( ' *b|' )(A); + WHEN (-270) PUT EDIT ( ' *n|' )(A); + WHEN (-100) PUT EDIT ( ' *p|' )(A); + WHEN (0) PUT EDIT ( ' |' )(A); + WHEN (100) PUT EDIT ( ' P |' )(A); + WHEN (270) PUT EDIT ( ' N |' )(A); + WHEN (300) PUT EDIT ( ' B |' )(A); + WHEN (500) PUT EDIT ( ' R |' )(A); + WHEN (900) PUT EDIT ( ' Q |' )(A); + WHEN (5000) PUT EDIT ( ' K |' )(A); + END; + END; + END; + PUT SKIP EDIT ( ' +---+---+---+---+---+---+---+---+' )(COL(20), A); + PUT SKIP EDIT ( ' A B C D E F G H' )(COL(20), A); + RETURN; + END SHOW; + + /* io -- input/output: */ + /* display black move and get white move */ + IO: PROCEDURE (A, B, X, Y, RES) OPTIONS (REORDER); + DECLARE (A, B, X, Y, RES) FIXED BINARY (31); + DECLARE ( INPUT ) CHARACTER (10); + DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31); + DECLARE (I, K, NDX, PIECE, TARG, MOVER, C) FIXED BINARY (31); + DECLARE NULL FIXED BINARY; /* This variable is assigned but never used. */ + DECLARE LETTER (0:7) CHAR (1) STATIC INITIAL + ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H'); + + DECLARE SL FIXED BINARY; + + /* >>>>>>>>> CAUTION - WATCH FOR UNINITIALIZED XX, YY <<<<<<<<<<< */ + DECLARE ( WCKSOLD, WCQSOLD ) BIT(1) ALIGNED; + + ON ERROR SNAP BEGIN; + PUT SKIP LIST ('at line ' || TRIM(SL) ); + END; + + SL = SOURCELINE(); + + IF A>=0 THEN + DO; + IF RES<-2500 THEN + DO; + PUT SKIP LIST ( 'I RESIGN'); + CALL SHOW; + PUT SKIP; + STOP; + END; + PIECE=BOARD(Y, X); + CALL MAKEMOVE(A, B, X, Y, C); + PUT SKIP EDIT ( 'MY MOVE: ' )(A); + PUT EDIT ( LETTER(A), 8-B, '-', LETTER(X), 8-Y) + (A, F(1), A, A, F(1)); + + SELECT (PIECE); + WHEN (100) PUT SKIP LIST ( 'I TOOK YOUR PAWN'); + WHEN (270) PUT SKIP LIST ( 'I TOOK YOUR KNIGHT'); + WHEN (300) PUT SKIP LIST ( 'I TOOK YOUR BISHOP'); + WHEN (500) PUT SKIP LIST ( 'I TOOK YOUR ROOK'); + WHEN (900) PUT SKIP LIST ( 'I TOOK YOUR QUEEN'); + WHEN (5000) PUT SKIP LIST ( 'I TOOK YOUR KING'); + OTHERWISE ; + END; + END; + DO_FOREVER1: + DO FOREVER; + CALL SHOW; + PUT SKIP EDIT ( 'YOUR MOVE: ' )(A); + RETRY_MOVE: + GET EDIT (INPUT) (L); + CALL UPCASE(INPUT); + IF (INPUT = 'QUIT') | (INPUT = 'BYE') | (INPUT = 'EXIT') THEN + STOP; + /* castling */ + IF (INPUT = 'O-O') | (INPUT = '0-0') THEN + DO; + IF INCHECK() ^= 0 THEN + ITERATE DO_FOREVER1; /* cannot castle out of check */ + IF WCKSFLAG THEN + ITERATE DO_FOREVER1; + IF BOARD(7, 7) ^= 500 THEN + ITERATE DO_FOREVER1; + IF (BOARD (7,6) ^= 0) | (BOARD(7,5) ^=0) THEN + ITERATE DO_FOREVER1; + BOARD(7, 4) = 0; + BOARD(7, 5) = 5000; + IF INCHECK() ^= 0 THEN /* cannot castle through check */ + DO; + BOARD(7, 4) = 5000; + BOARD(7, 5) = 0; + ITERATE DO_FOREVER1; + END; + ELSE + DO; + BOARD(7, 4) = 5000; + BOARD(7, 5) = 0; + END; + BOARD(7, 6) = 5000; + BOARD(7, 4) = 0; + BOARD(7, 5) = 500; + BOARD(7, 7) = 0; + IF INCHECK() ^= 0 THEN /* cannot castle into check */ + DO; + BOARD(7, 6) = 0; + BOARD(7, 4) = 5000; + BOARD(7, 5) = 0; + BOARD(7, 7) = 500; + ITERATE DO_FOREVER1; + END; + ELSE + DO; + WCKSFLAG = '1'B; + WCQSFLAG = '1'B; + RETURN; + END; + END; + IF (INPUT = 'O-O-O') | (INPUT = '0-0-0') THEN + DO; + IF INCHECK() ^= 0 THEN + ITERATE DO_FOREVER1; /* cannot castle out of check */ + IF WCQSFLAG THEN + ITERATE DO_FOREVER1; + IF BOARD(7,0) ^= 500 THEN + ITERATE DO_FOREVER1; + IF (BOARD(7,1) ^= 0) | (BOARD(7,2) ^= 0) | (BOARD(7,3) ^= 0) THEN + ITERATE DO_FOREVER1; + BOARD(7, 4) = 0; + BOARD(7, 3) = 5000; + IF INCHECK() ^= 0 THEN /* cannot castle through check */ + DO; + BOARD(7, 4) = 5000; + BOARD(7, 3) = 0; + ITERATE DO_FOREVER1; + END; + ELSE + DO; + BOARD(7, 4) = 5000; + BOARD(7, 3) = 0; + END; + BOARD(7, 2) = 5000; + BOARD(7, 4) = 0; + BOARD(7, 3) = 500; + BOARD(7, 0) = 0; + IF INCHECK() ^= 0 THEN /* cannot castle into check */ + DO; + BOARD(7, 2) = 0; + BOARD(7, 4) = 5000; + BOARD(7, 3) = 0; + BOARD(7, 0) = 500; + ITERATE DO_FOREVER1; + END; + ELSE + DO; + WCKSFLAG = '1'B; + WCQSFLAG = '1'B; + RETURN; + END; + END; + + /* Check that only the proper letters A-H etc are used. */ + /* (this does not check that the letters are in their correct columns.) */ + I = VERIFY (TRIM(INPUT), 'ABCDEFGHO0-12345678'); + IF I > 0 THEN + DO; + PUT SKIP LIST ('That move was invalid. Please try again:'); + GO TO RETRY_MOVE; + END; + + SL = SOURCELINE(); + + /* (A,B) are co-ordinates of the from position. */ + /* (X,Y) are co-ordinates of the destination position. */ + + /* Translate algebraic notation to co-ordinates. */ + + B = 8 - INDEX ('12345678', SUBSTR(INPUT, 2, 1) ); + A = INDEX ('ABCDEFGH', SUBSTR(INPUT, 1, 1) ) - 1; + X = INDEX ('ABCDEFGH', SUBSTR(INPUT, 4, 1) ) - 1; + Y = 8 - INDEX ('12345678', SUBSTR(INPUT, 5, 1) ); + + PUT SKIP DATA (A, B); + PUT SKIP DATA (X, Y); + STOP; + IF B>7 | B<0 | A>7 | A<0 | X>7 | X<0 | Y>7 | Y<0 THEN + DO; + PUT SKIP LIST ('Illegal move. Please try again'); + ITERATE DO_FOREVER1; + END; + IF BOARD(B,A)<=0 THEN + ITERATE DO_FOREVER1; + /* en passant capture */ + IF (Y = 2) & (B = 3) & ((X = A-1) | (X = A+1)) THEN + DO; + IF (BOARD(B,A) = 100) & (BOARD(Y,X) = 0) & (BOARD(Y+1,X) =-100) THEN + DO; + IF (BESTB(1) = 1) & (BESTA(1) = X) THEN + DO; + MOVER = BOARD(B,A); + TARG = BOARD(Y,X); + CALL MAKEMOVE(A,B,X,Y,C); + BOARD(Y+1,X)=0; + IF (INCHECK()) = 0 THEN + RETURN; + BOARD(B,A) = MOVER; + BOARD(Y, X) = TARG; + BOARD(Y+1,X) = -100; + ITERATE DO_FOREVER1; + END; + END; + END; + /* check if selected white move is on list of moves */ + CALL MOVELIST(A, B, XX, YY, CC, NDX); + DOK_LOOP: + DO K = 0 TO NDX BY 1; + IF (X = XX(K)) & (Y = YY(K)) THEN + DO; + MOVER = BOARD(B, A); + TARG = BOARD(Y, X); + IF Y = 0 THEN + FOREVER_LOOP: + DO FOREVER; + PUT SKIP EDIT ( 'PROMOTION PIECE: ' )(A); + GET EDIT (INPUT) (L); + CALL UPCASE(INPUT); + SELECT (INPUT); + WHEN ('N', 'KT', 'KNIGHT', 'HORSE') C = 270; + WHEN ('B', 'BISHOP') C = 300; + WHEN ('R', 'ROOK') C = 500; + WHEN ('Q', 'QUEEN') C = 900; + OTHERWISE ITERATE; + END; + LEAVE FOREVER_LOOP; + END; + CALL MAKEMOVE(A, B, X, Y, C); + IF MOVER = 5000 THEN + DO; + WCQSOLD = WCQSFLAG; + WCKSOLD = WCKSFLAG; + WCKSFLAG = '1'B; + WCQSFLAG = '1'B; + END; + IF (A = 0) & (B = 7) & (MOVER = 500) THEN + DO; + WCQSOLD = WCQSFLAG; + WCQSFLAG = '1'B; + END; + IF (A = 7) & (B = 7) & (MOVER = 500) THEN + DO; + WCKSOLD = WCKSFLAG; + WCKSFLAG = '1'B; + END; + IF INCHECK() = 0 THEN + RETURN; + BOARD(B, A) = MOVER; + BOARD(Y, X) = TARG; + IF MOVER = 5000 THEN + DO; + WCQSFLAG = WCQSOLD; + WCKSFLAG = WCKSOLD; + END; + IF (A = 0) & (B = 7) & (MOVER = 500) THEN + WCQSFLAG = WCQSOLD; + IF (A = 7) & (B = 7) & (MOVER = 500) THEN + WCKSFLAG = WCKSOLD; + LEAVE DOK_LOOP; + END; + END; + END; + END IO; + + /* convert string to uppercase */ + UPCASE: PROCEDURE (STRING) OPTIONS (REORDER); + DECLARE ( STRING ) CHARACTER (*); + + STRING = TRANSLATE (STRING, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', + 'abcdefghijklmnopqrstuvwxyz' ); + + END UPCASE; + + END CHESS; diff --git a/it/it-projects/plugins/project/src/pli/hasissues.pli b/it/it-projects/plugins/project/src/pli/hasissues.pli new file mode 100644 index 00000000000..eaacb6c917c --- /dev/null +++ b/it/it-projects/plugins/project/src/pli/hasissues.pli @@ -0,0 +1,13 @@ +foo: proc options(main); + declare i fixed decimal init (0); + + if i = 42 then + put list ('The answer is... '); /* Non-Compliant - This statement should be enclosed in a DO ... END one */ + put list ('42!'); /* This statement will always and unconditionally be executed! Its indentation level is misleading. */ +end; + +bar: proc options(main); + /* Non-Compliant - The trailing space, following "Hello," is not readable and could be removed by some text editors */ + put list ('Hello, +world'); +end; diff --git a/it/it-projects/plugins/project/src/pli/maxlen.pli b/it/it-projects/plugins/project/src/pli/maxlen.pli new file mode 100644 index 00000000000..c7498b0936b --- /dev/null +++ b/it/it-projects/plugins/project/src/pli/maxlen.pli @@ -0,0 +1,67 @@ + /* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */ + /* Structured Programming". Permission is given to reproduce and to use these procedures */ + /* as part of a program, and to include them as part of a larger work to be sold for profit. */ + /* However, the user is not permitted to sell the procedures separately. Provided always */ + /* that these procedures and this copyright notice are reproduced in full. */ + + DECLARE MAXLENGTH GENERIC + (MAXLEN_graphic WHEN (GRAPHIC), + MAXLEN_bit WHEN (BIT), + MAXLEN_char WHEN (*) ); + + /* This procedure is provided for those who must have the */ + /* built-in function MAXLENGTH. Do not call it often, as */ + /* run-time is relatively high. */ + /* This procedure returns the maximum length that a VARYING character string may take. */ + MAXLEN_char: + PROCEDURE (STRING) RETURNS (FIXED BINARY); + DECLARE STRING CHARACTER (*) VARYING; + + DECLARE LENGTH BUILTIN; + DECLARE TEMP CHARACTER (32767) VARYING; + DECLARE STR CHARACTER (32767) STATIC INITIAL ( ' ' ); + DECLARE K FIXED BINARY; + + TEMP = STRING; /* Preserve a copy of the string. */ + (NOSTRINGSIZE): + STRING = STR; /* Assign something very long to it. */ + K = LENGTH (STRING); /* Find out how long the variable is. */ + STRING = TEMP; /* Restore the string. */ + RETURN (K); /* The declared length of the string. */ + END MAXLEN_char; + + /* This procedure returns the maximum length that a VARYING graphic string may take. */ + MAXLEN_graphic: + PROCEDURE (STRING) RETURNS (FIXED BINARY); + DECLARE STRING GRAPHIC (*) VARYING; + + DECLARE LENGTH BUILTIN; + DECLARE TEMP GRAPHIC (16383) VARYING; + DECLARE STR GRAPHIC (16383) STATIC INITIAL ( ' ' ); + DECLARE K FIXED BINARY; + + TEMP = STRING; /* Preserve a copy of the string. */ + (NOSTRINGSIZE): + STRING = STR; /* Assign something very long to it. */ + K = LENGTH (STRING); /* Find out how long the variable is. */ + STRING = TEMP; /* Restore the string. */ + RETURN (K); /* The declared length of the string. */ + END MAXLEN_graphic; + + /* This procedure returns the maximum length that a VARYING bit string may take. */ + MAXLEN_bit: + PROCEDURE (STRING) RETURNS (FIXED BINARY); + DECLARE STRING BIT (*) VARYING; + + DECLARE LENGTH BUILTIN; + DECLARE TEMP BIT (32767) VARYING; + DECLARE STR BIT (32767) STATIC INITIAL ( '0'B); + DECLARE K FIXED BINARY; + + TEMP = STRING; /* Preserve a copy of the string. */ + (NOSTRINGSIZE): + STRING = STR; /* Assign something very long to it. */ + K = LENGTH (STRING); /* Find out how long the variable is. */ + STRING = TEMP; /* Restore the string. */ + RETURN (K); /* The declared length of the string. */ + END MAXLEN_bit; diff --git a/it/it-projects/plugins/project/src/pli/search.pli b/it/it-projects/plugins/project/src/pli/search.pli new file mode 100644 index 00000000000..ed9a231427d --- /dev/null +++ b/it/it-projects/plugins/project/src/pli/search.pli @@ -0,0 +1,246 @@ + /* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */ + /* Structured Programming". Permission is given to reproduce and to use these procedures */ + /* as part of a program, and to include them as part of a larger work to be sold for profit. */ + /* However, the user is not permitted to sell the procedures separately. Provided always */ + /* that these procedures and this copyright notice are reproduced in full. */ + + DECLARE SEARCH GENERIC + (SEARCH_all_graphic WHEN ( GRAPHIC, GRAPHIC), + SEARCH_all_graphic WHEN ( GRAPHIC, *), + SEARCH_all_graphic WHEN (*, GRAPHIC), + SEARCH_all_bit WHEN ( BIT, BIT), + SEARCH_all WHEN (*,*), + SEARCH_sub_graphic WHEN ( GRAPHIC, GRAPHIC, *), + SEARCH_sub_graphic WHEN ( GRAPHIC, *, *), + SEARCH_sub_graphic WHEN (*, GRAPHIC, *), + SEARCH_sub_bit WHEN ( BIT, BIT, *), + SEARCH_sub WHEN (*,*,*) ); + + /* This function procedure searches the first string STRING for any characters given in the */ + /* second string SUB. If there are any such characters, the function returns the position */ + /* of the left-most. */ + SEARCH_all: + PROCEDURE (STRING, SUB) OPTIONS (REORDER) + RETURNS (FIXED BINARY (31)); + /* INCOMING: STRING = the string to be searched; */ + /* SUB = contains characters to look for. */ + DECLARE (STRING, SUB) CHARACTER (*); + + DECLARE (LENGTH, SUBSTR, + UNSPEC, INDEX) BUILTIN; + DECLARE Table (0:255) BIT (1) STATIC ALIGNED; + DECLARE (J, K) FIXED BINARY (31); + + IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */ + RETURN (0); + IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */ + RETURN (0); + IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */ + RETURN (INDEX (STRING, SUB)); + + /* SETS UP A LOOK-UP TABLE (which is independent of the character set). */ + Table = '0'B; /* All entries are FALSE. */ + DO J = 1 TO LENGTH (Sub); + K = UNSPEC (SUBSTR (Sub, J, 1)); + Table (K) = '1'B; /* Table(k) is TRUE for each character in SUB. */ + END; + + /* CONDUCT THE SEARCH. */ + DO J = 1 TO LENGTH (STRING); + K = UNSPEC (SUBSTR (STRING, J, 1)); + IF Table(K) THEN /* TRUE when a SUB character matches one in */ + RETURN (J); /* STRING. */ + END; + RETURN (0); /* Unsuccessful search. */ + END SEARCH_all; + + /* This function procedure searches the first string STRING for any characters given in the */ + /* second string SUB. If there are any such characters, the function returns the position */ + /* of the left-most. */ + /* The search is performed from left to right, commencing from character position */ + /* POSITION. */ + SEARCH_sub: + PROCEDURE (STRING, SUB, POSITION) RETURNS (FIXED BINARY (31)); + /* INCOMING: STRING = the string to be searched; */ + /* SUB = contains characters to look for; */ + /* POSITION = where to start the search (measured from the left-hand end of */ + /* STRING). */ + DECLARE (STRING, SUB) CHARACTER (*); + DECLARE POSITION FIXED BINARY (31); + + DECLARE (LENGTH, INDEX) BUILTIN; + DECLARE K FIXED BINARY (31); + + IF (Position > LENGTH (String)+1) | (Position <= 0) THEN + DO; + SIGNAL STRINGRANGE; + RETURN (0); + END; + IF LENGTH (STRING) = 0 THEN RETURN (0); + K = SEARCH_all ( SUBSTR (STRING, POSITION), SUB); + IF K = 0 THEN RETURN (0); + RETURN (POSITION+K-1); + END SEARCH_sub; + + /* This function procedure searches the first string STRING for any characters given in the */ + /* second string SUB. If there are any such characters, the function returns the position */ + /* of the left-most. */ + SEARCH_all_graphic: + PROCEDURE (STRING, SUB) OPTIONS (REORDER) + RETURNS ( FIXED BINARY (31)); + /* INCOMING: STRING = the string to be searched; */ + /* SUB = contains characters to look for. */ + DECLARE (STRING, SUB) GRAPHIC (*); + + DECLARE (LENGTH, + SUBSTR, + INDEX) BUILTIN; + DECLARE (J, K) FIXED BINARY (31); + DECLARE Ch GRAPHIC (1); + + IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */ + RETURN (0); + IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */ + RETURN (0); + IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */ + RETURN (INDEX (STRING, SUB)); + + DO J = 1 TO LENGTH(String); + Ch = SUBSTR(String, J, 1); /* Select one graphic character from the string to*/ + /* be searched. */ + K = INDEX (Sub, Ch); /* Check whether it is one of those on our search list.*/ + IF K ^= 0 THEN /* If it is, we are done. */ + RETURN (J); + END; + + RETURN (0); /* The search was unsuccessful. */ + END SEARCH_all_graphic; + + /* This function procedure searches the first string STRING for any graphic characters */ + /* given in the second string SUB. If there are any such graphic characters, the function */ + /* returns the position of the left-most. */ + /* The search is performed from left to right, commencing from graphic character position */ + /* POSITION. */ + SEARCH_sub_graphic: + PROCEDURE (STRING, SUB, POSITION) RETURNS (FIXED BINARY (31)); + /* INCOMING: STRING = the string to be searched; */ + /* SUB = contains characters to look for; */ + /* POSITION = where to start the search (measured from the left-hand end of */ + /* STRING). */ + DECLARE (STRING, SUB) GRAPHIC (*); + DECLARE POSITION FIXED BINARY (31); + + DECLARE (LENGTH, SUBSTR, + INDEX) BUILTIN; + DECLARE (J, K) FIXED BINARY (31); + DECLARE Ch GRAPHIC (1); + + IF (Position > LENGTH (String)+1) | (Position <= 0) THEN + DO; + SIGNAL STRINGRANGE; + RETURN (0); + END; + IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */ + RETURN (0); + IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */ + RETURN (0); + IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */ + RETURN (INDEX (SUBSTR (STRING, Position), SUB)+Position-1); + + DO J = Position TO LENGTH(String); + Ch = SUBSTR(String, J, 1); /* Select one graphic character from the string to */ + /* be searched. */ + K = INDEX (Sub, Ch); /* Check whether it is one of those on our search list.*/ + IF K ^= 0 THEN /* If it is, we are done. */ + RETURN (J); + END; + + RETURN (0); /* The search was unsuccessful. */ + + END SEARCH_sub_graphic; + + /* This function procedure searches the first string STRING for any bits given in the */ + /* second string SUB. If there are any such bits, the function returns the position */ + /* of the left-most. */ + SEARCH_all_bit: + PROCEDURE (STRING, SUB) OPTIONS (REORDER) + RETURNS ( FIXED BINARY (31)); + /* INCOMING: STRING = the string to be searched; */ + /* SUB = contains bits to look for. */ + DECLARE (STRING, SUB) BIT (*); + + DECLARE (LENGTH, SUBSTR, + INDEX) BUILTIN; + DECLARE (J, K) FIXED BINARY (31); + + IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */ + RETURN (0); + IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */ + RETURN (0); + IF LENGTH (SUB) = 1 THEN /* Looking for one bit is fast. */ + RETURN (INDEX (STRING, SUB)); + + /* When we come here, SUB has 2 or more bits. */ + + K = INDEX (SUB, ^SUBSTR(SUB, 1, 1)); /* Look for a bit of the opposite kind. */ + + IF K > 0 THEN /* No need for a search -- the key SUB consists */ + /* of both 0 and 1. */ + RETURN (1); /* Always get a match at position 1. */ + + /* The pattern SUB contains either all ones or all zeros. */ + + /* CONDUCT THE SEARCH. */ + IF SUBSTR(SUB, 1, 1) THEN + RETURN (INDEX(STRING, '1'B)); + ELSE + RETURN (INDEX(STRING, '0'B)); + + END SEARCH_all_bit; + + /* This function procedure searches the first string STRING for any bits given in the */ + /* second string SUB. If there are any such bits, the function returns the position */ + /* of the left-most. */ + SEARCH_sub_bit: + PROCEDURE (String, Sub, Position) OPTIONS (REORDER) + RETURNS ( FIXED BINARY (31)); + /* INCOMING: STRING = the string to be searched; */ + /* SUB = contains bits to look for. */ + DECLARE (String, Sub) BIT (*); + + DECLARE (LENGTH, SUBSTR, + INDEX) BUILTIN; + DECLARE (J, K) FIXED BINARY (31); + + IF (Position > LENGTH (String)+1) | (Position <= 0) THEN + DO; + SIGNAL STRINGRANGE; + RETURN (0); + END; + IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */ + RETURN (0); + IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */ + RETURN (0); + IF Position = LENGTH(String)+1 THEN + RETURN (0); + IF LENGTH (SUB) = 1 THEN /* Looking for one bit is fast. */ + RETURN (INDEX(SUBSTR(STRING, Position), SUB)+Position-1); + + /* When we come here, SUB has 2 or more bits. */ + + K = INDEX (SUBSTR(String, Position), ^SUBSTR(SUB, 1, 1)); + /* Look for a bit of the opposite kind. */ + + IF K > 0 THEN /* No need for a search -- the key SUB consists */ + /* of both 0 and 1. */ + RETURN (Position); /* Always get a match at position "Position". */ + + /* The pattern SUB contains either all ones or all zeros. */ + + /* CONDUCT THE SEARCH. */ + IF SUBSTR(SUB, 1, 1) THEN + RETURN (INDEX(SUBSTR(STRING, Position), '1'B)+Position-1); + ELSE + RETURN (INDEX(SUBSTR(STRING, Position), '0'B)+Position-1); + + END SEARCH_sub_bit; diff --git a/it/it-projects/plugins/project/src/plsql/ddl.sql b/it/it-projects/plugins/project/src/plsql/ddl.sql new file mode 100644 index 00000000000..78a3ddd1951 --- /dev/null +++ b/it/it-projects/plugins/project/src/plsql/ddl.sql @@ -0,0 +1,9 @@ +CREATE TABLE OWNER.TABLE01 (ID NUMBER(12)); +/ +ALTER TABLE OWNER.TABLE01 ADD (COL1 VARCHAR2(4000)); +/ + +CREATE TABLE OWNER.TABLE02 (ID NUMBER(12)); +/ +ALTER TABLE OWNER.TABLE02 ADD (COL1 VARCHAR2(4000)); +/ diff --git a/it/it-projects/plugins/project/src/plsql/ut_report.pkb b/it/it-projects/plugins/project/src/plsql/ut_report.pkb new file mode 100644 index 00000000000..15bdc4e4f66 --- /dev/null +++ b/it/it-projects/plugins/project/src/plsql/ut_report.pkb @@ -0,0 +1,213 @@ +/* Formatted on 2002/03/31 23:53 (Formatter Plus v4.5.2) */ +CREATE OR REPLACE PACKAGE BODY Utreport +IS + +/************************************************************************ +GNU General Public License for utPLSQL + +Copyright (C) 2000-2003 +Steven Feuerstein and the utPLSQL Project +(steven@stevenfeuerstein.com) + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program (see license.txt); if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +************************************************************************ +$Log: ut_report.pkb,v $ +Revision 1.3 2005/05/11 21:33:36 chrisrimmer +Added testing of reporter infrastructure + +Revision 1.2 2004/11/16 09:46:49 chrisrimmer +Changed to new version detection system. + +Revision 1.1 2004/07/14 17:01:57 chrisrimmer +Added first version of pluggable reporter packages + + +************************************************************************/ + + DEFAULT_REPORTER VARCHAR2(100) := 'Output'; + + DYNAMIC_PLSQL_FAILURE NUMBER(10) := -6550; + + --This is the reporter we have been asked to use + g_reporter VARCHAR2(100); + + --This is the reporter we are actually using + --(this differs from the above in the event of error) + g_actual VARCHAR2(100); + + FUNCTION parse_it(proc IN VARCHAR2, params IN NUMBER, force_reporter IN VARCHAR2) + RETURN INTEGER + IS + dyn_handle INTEGER := NULL; + query VARCHAR2(1000); + BEGIN + dyn_handle := DBMS_SQL.OPEN_CURSOR; + QUERY := 'BEGIN ut' || NVL(force_reporter, g_actual) || 'Reporter.' || proc ; + IF params = 1 THEN + QUERY := QUERY || '(:p)'; + END IF; + QUERY := QUERY || '; END;'; + DBMS_SQL.PARSE(dyn_handle, QUERY, DBMS_SQL.NATIVE); + RETURN dyn_handle; + EXCEPTION + WHEN OTHERS THEN + DBMS_SQL.CLOSE_CURSOR (dyn_handle); + RAISE; + END; + + PROCEDURE execute_it(dyn_handle IN OUT INTEGER) + IS + dyn_result INTEGER; + BEGIN + dyn_result := DBMS_SQL.EXECUTE (dyn_handle); + DBMS_SQL.CLOSE_CURSOR (dyn_handle); + END; + + --We use this to make dynamic calls to reporter packages + PROCEDURE call(proc IN VARCHAR2, + param IN VARCHAR2, + params IN NUMBER := 1, + force_reporter IN VARCHAR2 := NULL, + failover IN BOOLEAN := TRUE) + IS + dyn_handle INTEGER := NULL; + BEGIN + dyn_handle := parse_it(proc, params, force_reporter); + IF params = 1 THEN + DBMS_SQL.BIND_VARIABLE (dyn_handle, 'p', param); + END IF; + execute_it(dyn_handle); + EXCEPTION + WHEN OTHERS THEN + + IF dyn_handle IS NOT NULL THEN + DBMS_SQL.CLOSE_CURSOR (dyn_handle); + END IF; + + IF g_actual <> DEFAULT_REPORTER THEN + + IF NOT failover OR SQLCODE <> DYNAMIC_PLSQL_FAILURE THEN + g_actual := DEFAULT_REPORTER; + pl(SQLERRM); + pl('** REVERTING TO DEFAULT REPORTER **'); + END IF; + + ELSE + RAISE; + END IF; + + call(proc, param, params, force_reporter => DEFAULT_REPORTER); + END; + + PROCEDURE call(proc IN VARCHAR2, + failover IN BOOLEAN := TRUE) + IS + BEGIN + call(proc => proc, + param => '', + params => 0, + failover => failover); + END; + + PROCEDURE use(reporter IN VARCHAR2) + IS + BEGIN + g_reporter := NVL(reporter, DEFAULT_REPORTER); + g_actual := g_reporter; + END; + + FUNCTION using RETURN VARCHAR2 + IS + BEGIN + RETURN g_reporter; + END; + + PROCEDURE open + IS + BEGIN + g_actual := g_reporter; + call('open', failover => FALSE); + END; + + PROCEDURE pl (str IN VARCHAR2) + IS + BEGIN + call('pl', str); + END; + + PROCEDURE pl (bool IN BOOLEAN) + IS + BEGIN + pl (Utplsql.bool2vc (bool)); + END; + + PROCEDURE before_results(run_id IN utr_outcome.run_id%TYPE) + IS + BEGIN + call('before_results', run_id); + END; + + PROCEDURE show_failure(rec_result IN utr_outcome%ROWTYPE) + IS + BEGIN + outcome := rec_result; + call('show_failure'); + END; + + PROCEDURE show_result(rec_result IN utr_outcome%ROWTYPE) + IS + BEGIN + outcome := rec_result; + call('show_result'); + END; + + PROCEDURE after_results(run_id IN utr_outcome.run_id%TYPE) + IS + BEGIN + call('after_results', run_id); + END; + + PROCEDURE before_errors(run_id IN utr_error.run_id%TYPE) + IS + BEGIN + call('before_errors', run_id); + END; + + PROCEDURE show_error(rec_error IN utr_error%ROWTYPE) + IS + BEGIN + error := rec_error; + call('show_error'); + END; + + PROCEDURE after_errors(run_id IN utr_error.run_id%TYPE) + IS + BEGIN + call('after_errors', run_id); + END; + + PROCEDURE close + IS + BEGIN + call('close'); + END; + +BEGIN + + g_reporter := NVL(utconfig.getreporter, DEFAULT_REPORTER); + g_actual := g_reporter; + +END; +/ diff --git a/it/it-projects/plugins/project/src/python/__init__.py b/it/it-projects/plugins/project/src/python/__init__.py new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/it/it-projects/plugins/project/src/python/__init__.py diff --git a/it/it-projects/plugins/project/src/python/badfortune.py b/it/it-projects/plugins/project/src/python/badfortune.py new file mode 100644 index 00000000000..b0900dc1695 --- /dev/null +++ b/it/it-projects/plugins/project/src/python/badfortune.py @@ -0,0 +1,92 @@ + +# fortune.py -- chooses a random fortune, as the fortune(8) program in +# the BSD-games package does +# +# Copyright (c) 2010, Andrew M. Kuchling +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. + +import struct, random, string + +# C long variables are different sizes on 32-bit and 64-bit machines, +# so we have to measure how big they are on the machine where this is running. +LONG_SIZE = struct.calcsize('L') +is_64_bit = (LONG_SIZE == 8) + +def get(filename): + "Select a random quotation, using a pregenerated .dat file" + + # First, we open the .dat file, and read the header information. + # The C structure containing this info looks like: + ## typedef struct { /* information table */ + ## #define VERSION 1 + ## unsigned long str_version; /* version number */ + ## unsigned long str_numstr; /* # of strings in the file */ + ## unsigned long str_longlen; /* length of longest string */ + ## unsigned long str_shortlen; /* length of shortest string */ + ## #define STR_RANDOM 0x1 /* randomized pointers */ + ## #define STR_ORDERED 0x2 /* ordered pointers */ + ## #define STR_ROTATED 0x4 /* rot-13'd text */ + ## unsigned long str_flags; /* bit field for flags */ + ## unsigned char stuff[4]; /* long aligned space */ + ## #define str_delim stuff[0] /* delimiting character */ + ## } STRFILE; + + datfile = open(filename+'.dat', 'r') + data = datfile.read(5 * LONG_SIZE) + if is_64_bit: + v1, v2, n1, n2, l1, l2, s1, s2, f1, f2 = struct.unpack('!10L', data) + version = v1 + (v2 << 32) + numstr = n1 + (n2 << 32) + longlen = l1 + (l2 << 32) + shortlen = s1 + (s2 << 32) + flags = f1 + (f2 << 32) + else: + version, numstr, longlen, shortlen, flags = struct.unpack('5l', data) + + delimiter = datfile.read(1) + datfile.read(3) # Throw away padding bytes + if is_64_bit: datfile.read(4) # 64-bit machines align to 8 bytes + + # Pick a random number + r = random.randint(0, numstr) + datfile.seek(LONG_SIZE * r, 1) # Seek to the chosen pointer + data = datfile.read(LONG_SIZE * 2) + + if is_64_bit: + s1, s2, e1, e2 = struct.unpack('!4L', data) + start, end = s1 + (s2 << 32), e1 + (e2 << 32) + else: + start, end = struct.unpack('!ll', data) + datfile.close() + + file = open(filename, 'r') + file.seek(start) + quotation = file.read(end-start) + L=string.split(quotation, '\n') + while string.strip(L[-1]) == delimiter or string.strip(L[-1]) == "": + L=L[:-1] + return string.join(L, '\n') + +if __name__ == '__main__': + import sys + if len(sys.argv) == 1: + print 'Usage: fortune.py <filename>' + sys.exit() + print get(sys.argv[1]) diff --git a/it/it-projects/plugins/project/src/python/directory/file_in_directory.py b/it/it-projects/plugins/project/src/python/directory/file_in_directory.py new file mode 100644 index 00000000000..0708437a71f --- /dev/null +++ b/it/it-projects/plugins/project/src/python/directory/file_in_directory.py @@ -0,0 +1 @@ +lst = [] diff --git a/it/it-projects/plugins/project/src/python/hasissues.py b/it/it-projects/plugins/project/src/python/hasissues.py new file mode 100644 index 00000000000..df209065464 --- /dev/null +++ b/it/it-projects/plugins/project/src/python/hasissues.py @@ -0,0 +1,8 @@ +class MyClass: + while True: + return False #Noncompliant + + def __enter__(self): + pass + def __exit__(self, exc_type, exc_val): # Noncompliant + pass diff --git a/it/it-projects/plugins/project/src/python/package/__init__.py b/it/it-projects/plugins/project/src/python/package/__init__.py new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/it/it-projects/plugins/project/src/python/package/__init__.py diff --git a/it/it-projects/plugins/project/src/python/package/file_in_package.py b/it/it-projects/plugins/project/src/python/package/file_in_package.py new file mode 100644 index 00000000000..fc7f2ba0752 --- /dev/null +++ b/it/it-projects/plugins/project/src/python/package/file_in_package.py @@ -0,0 +1 @@ +dictionary = {} diff --git a/it/it-projects/plugins/project/src/python/samples/__init__.py b/it/it-projects/plugins/project/src/python/samples/__init__.py new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/it/it-projects/plugins/project/src/python/samples/__init__.py diff --git a/it/it-projects/plugins/project/src/python/samples/fortune.py b/it/it-projects/plugins/project/src/python/samples/fortune.py new file mode 100644 index 00000000000..b0900dc1695 --- /dev/null +++ b/it/it-projects/plugins/project/src/python/samples/fortune.py @@ -0,0 +1,92 @@ + +# fortune.py -- chooses a random fortune, as the fortune(8) program in +# the BSD-games package does +# +# Copyright (c) 2010, Andrew M. Kuchling +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. + +import struct, random, string + +# C long variables are different sizes on 32-bit and 64-bit machines, +# so we have to measure how big they are on the machine where this is running. +LONG_SIZE = struct.calcsize('L') +is_64_bit = (LONG_SIZE == 8) + +def get(filename): + "Select a random quotation, using a pregenerated .dat file" + + # First, we open the .dat file, and read the header information. + # The C structure containing this info looks like: + ## typedef struct { /* information table */ + ## #define VERSION 1 + ## unsigned long str_version; /* version number */ + ## unsigned long str_numstr; /* # of strings in the file */ + ## unsigned long str_longlen; /* length of longest string */ + ## unsigned long str_shortlen; /* length of shortest string */ + ## #define STR_RANDOM 0x1 /* randomized pointers */ + ## #define STR_ORDERED 0x2 /* ordered pointers */ + ## #define STR_ROTATED 0x4 /* rot-13'd text */ + ## unsigned long str_flags; /* bit field for flags */ + ## unsigned char stuff[4]; /* long aligned space */ + ## #define str_delim stuff[0] /* delimiting character */ + ## } STRFILE; + + datfile = open(filename+'.dat', 'r') + data = datfile.read(5 * LONG_SIZE) + if is_64_bit: + v1, v2, n1, n2, l1, l2, s1, s2, f1, f2 = struct.unpack('!10L', data) + version = v1 + (v2 << 32) + numstr = n1 + (n2 << 32) + longlen = l1 + (l2 << 32) + shortlen = s1 + (s2 << 32) + flags = f1 + (f2 << 32) + else: + version, numstr, longlen, shortlen, flags = struct.unpack('5l', data) + + delimiter = datfile.read(1) + datfile.read(3) # Throw away padding bytes + if is_64_bit: datfile.read(4) # 64-bit machines align to 8 bytes + + # Pick a random number + r = random.randint(0, numstr) + datfile.seek(LONG_SIZE * r, 1) # Seek to the chosen pointer + data = datfile.read(LONG_SIZE * 2) + + if is_64_bit: + s1, s2, e1, e2 = struct.unpack('!4L', data) + start, end = s1 + (s2 << 32), e1 + (e2 << 32) + else: + start, end = struct.unpack('!ll', data) + datfile.close() + + file = open(filename, 'r') + file.seek(start) + quotation = file.read(end-start) + L=string.split(quotation, '\n') + while string.strip(L[-1]) == delimiter or string.strip(L[-1]) == "": + L=L[:-1] + return string.join(L, '\n') + +if __name__ == '__main__': + import sys + if len(sys.argv) == 1: + print 'Usage: fortune.py <filename>' + sys.exit() + print get(sys.argv[1]) diff --git a/it/it-projects/plugins/project/src/python/samples/letters.py b/it/it-projects/plugins/project/src/python/samples/letters.py new file mode 100644 index 00000000000..0f54b31c512 --- /dev/null +++ b/it/it-projects/plugins/project/src/python/samples/letters.py @@ -0,0 +1,203 @@ + +# +# Copyright (c) 2010, Andrew M. Kuchling +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. + +import random, string + +# Logic game +# From a program by Judith Haris, John Swets, and Wallace Feurzeig +# Reference: The Secret Guide to Computers, by Russ Walter, 18th ed 1993. +# Written in Python by A.M. Kuchling (amk@amk.ca) + +# For each letter, we need the various characteristics: +# (curves, loose ends, obliques, horizontals, verticals). +# There should really be a sample character set for the user to look +# at; otherwise, there are ambiguities. For example, does B have +# horizontals? Does D? How about P and R? + +# There's a bug lurking in this data! Can you catch it? +# (See the bottom of the program for the answer.) + +letter_stats={'a': (0, 2, 2, 1, 0), 'b':(2, 0, 0, 3, 1), + 'c': (1, 2, 0, 0, 0), 'd':(1, 0, 0, 0, 1), + 'e': (0, 3, 0, 3, 1), 'f':(0, 3, 0, 2, 1), + 'g': (1, 2, 0, 1, 1), 'h':(0, 4, 0, 1, 2), + 'i': (0, 2, 0, 0, 1), 'j':(1, 2, 0, 0, 1), + 'k': (0, 4, 2, 0, 1), 'l':(0, 2, 0, 1, 1), + 'm': (0, 2, 2, 0, 2), 'n':(0, 2, 1, 0, 2), + 'o': (1, 0, 0, 0, 0), 'p':(1, 1, 0, 2, 1), + 'q': (1, 2, 1, 0, 0), 'r':(1, 2, 1, 0, 1), + 's': (1, 2, 0, 0, 0), 't':(0, 3, 0, 1, 1), + 'u': (1, 2, 0, 0, 2), 'v':(0, 2, 2, 0, 0), + 'w': (0, 2, 4, 0, 0), 'x':(0, 4, 2, 0, 0), + 'y': (0, 3, 2, 0, 1), 'z':(0, 2, 1, 2, 0)} + +# We'll define constants for the various statistics; each constant is +# equal to the position of the statistic in the tuples in +#letter_stats. +CURVES=0 ; LOOSE_ENDS=1 ; OBLIQUES=2 ; HORIZONTALS=3 ; VERTICALS=4 + +# This dictionary is used to map questions to corresponding +# statistics. Note that different keys can map to the same value; +# for example, 'obliques' and 'diagonals' both map to the OBLIQUES constant. +questions={'curves':CURVES, 'looseends':LOOSE_ENDS, + 'obliques':OBLIQUES, 'diagonals':OBLIQUES, + 'horizontals':HORIZONTALS, 'verticals':VERTICALS} + +# Play a single game + +def play_once(): + # Choose a random number between 0 and 26, inclusive. + choice=26*random.random() + # Convert the numeric choice to a letter: 0->a, 1->b, etc. + choice=chr(ord('a')+choice) + + #choice=raw_input("What should I choose?") # (for debugging) + + # We'll track how many possibilities the user still has available. + # Start with all of the letters. + possibilities=string.lower("ABCDEFGHIJKLMNOPQRSTUVWXYZ") + # We'll also track which questions have been asked, and chide the + # user when he repeats a question. + asked=[] + + # Loop forever; the play_once() function will exit by hitting a + # 'return' statement inside the loop. + while (1): + try: + #print possibilities # (for debugging) + + # Get input from the user + query=raw_input('Next? ') + # Convert the input to lowercase + query=string.lower(query) + # Remove all non-letter characters + query=filter(lambda x: x in string.lowercase, query) + # Remove whitespace + query=string.strip(query) + + except (EOFError, KeyboardInterrupt): + # End-Of-File : the user + print '\nOK; give up if you like.' + return + + if len(query)==1: + # The query is one character long, so it's a guess + if query not in possibilities: + print ("Wrong! That guess is inconsistent " + "with the information you've been given.\n" + "I think you made that guess just to see " + "what I would say.") + elif len(possibilities)>1: + print "You don't have enough information yet." + # Temporarily remove the user's guess from + # possibilities, and pick a random letter. + temp=filter(lambda x, query=query: x!=query, possibilities) + r=int(random.random()*len(temp)) + print "How do you know it isn't", temp[r]+',', + print "for example?" + else: + # query is in possibilities, and + # len(possibilities)==1, so the user is right. + print "Yes, you've done it. Good work!" ; return + elif questions.has_key(query): + # Get the field of the letter_stats tuple to compare. + field=questions[query] + # Determine the answer for the computer's letter + result=letter_stats[choice][field] + original_length=len(possibilities) + + # Exclude possibilities that don't match those of the + # mystery letter. + # filter(func, sequence) calls func() on each element in + # the sequence, and returns a new sequence object + # containing only elements for which func() returned true. + # For strings, each character is an element. Instead of + # defining a formal function, a lambda is used to create + # an anonymous function (one without a name). + # Various other things required by the function are set + # as default arguments, so they're accessible inside the + # scope of the anonymous function. + possibilities=filter(lambda letter, letter_stats=letter_stats, + field=field, result=result: + letter_stats[letter][field]==result, + possibilities) + new_length=len(possibilities) + if field in asked: + print "You asked me that already." + print "The answer is the same as before:", + else: asked.append(field) # Note that this question was asked. + print str(result)+'.' + if (original_length==new_length): + print 'That was a wasted question; it did not exclude any possibilities.' + elif (new_length<original_length/2 or new_length==1): + print "Good question." + else: + print "I don't understand the question." + +# Print the instructions +print """This is a guessing game about capital letters. +You can ask various questions about the features of the letter: +curves, loose ends, obliques (or diagonals), horizontals, verticals. +To make a guess, just enter the letter of your choice. + +Sample transcript: + Next? curves? + 1. + Good question. + Next? c + You don't have enough information yet. + How do you know it isn't s, for example? + Next? horizontals? + 0. + Next? s + You don't have enough information yet. + How do you know it isn't c, for example? +""" + +# Play a single game +play_once() +raw_input("Press Return>") + +# The solution to the bug-hunt is below... + + + + + + + + + + + +# It's not a bug that the Python interpreter can catch; instead, it's +# a specification bug: +# +# 'C' and 'S' both have the same stats: 1 curve, 2 loose ends, +# and no obliques, horizontals, or verticals. If either C or S is +# chosen as the computer's letter, the user can never get the right +# answer, because he/she can't narrow down the possibilities to just +# one! To fix this, you'd have to add another statistic, like +# number of intersections or number of closed loops. However, the +# statistic would have to be *different* for 'C' and 'S', and neither +# of those two suggestions qualify. Can you think of a property to +# distinguish between the two letters? diff --git a/it/it-projects/plugins/project/src/python/samples/strfile.py b/it/it-projects/plugins/project/src/python/samples/strfile.py new file mode 100644 index 00000000000..ca15a607c21 --- /dev/null +++ b/it/it-projects/plugins/project/src/python/samples/strfile.py @@ -0,0 +1,100 @@ + +# strfile.py -- write an index file for a fortune file, as the strfile(8) +# program in the BSD-games package does +# +# Copyright (c) 2010, Andrew M. Kuchling +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. + +import struct, string, sys + +if len(sys.argv)==1: + print "Usage: strfile.py <filename>" + sys.exit() + +# C long variables are different sizes on 32-bit and 64-bit machines, +# so we have to measure how big they are on the machine where this is running. +LONG_SIZE = struct.calcsize('L') +is_64_bit = (LONG_SIZE == 8) + +delimiter = '%' # The standard delimiter + +filename = sys.argv[1] +input = open(filename, 'r') +output = open(filename + '.dat', 'w') +output.seek(LONG_SIZE * 6) # Skip over the header for now + +# Output a 32- or 64-bit integer + +def write_long(x): + if is_64_bit: + output.write( struct.pack("!LL", x & 0xffffFFFFL, x >> 32) ) + else: + output.write( struct.pack("!L", x) ) + +write_long(0) # Write the first pointer + +# We need to track various statistics: the longest and shortest +# quotations, and their number + +shortest = sys.maxint ; longest = 0 +numstr = 0 +quotation = "" + +while (1): + L=input.readline() # Get a line + if L=="": break # Check for end-of-file + if string.strip(L) != delimiter: + # We haven't come to the end yet, so we just add the line to + # the quotation we're building and continue + quotation = quotation + L ; continue + + # If there's a leading % in the file, the first quotation will be + # empty; we'll just ignore it + if quotation == "": continue + + # Update the shortest and longest variables + shortest = min(shortest, len(quotation) ) + longest = max(longest, len(quotation) ) + + # Output the current file pointer + write_long( input.tell() ) + numstr = numstr + 1 + quotation = "" # Reset the quotation to null + +# To simplify the programming, we'll assume there's a trailing % line +# in the file, with no quotation following. +assert quotation == "" + +input.close() + +# We're done, so rewind to the beginning of the file and write the header +output.seek(0) +write_long( 1 ) # Version +write_long(numstr) # Number of strings +write_long(longest) # Longest string length +write_long(shortest) # Shortest string length +write_long(0) # Flags; we'll set them to zero +output.write(delimiter + '\0'*(LONG_SIZE-1)) +output.close() + +print '''"%s.dat" created +There were %i strings +Longest string: %i bytes +Shortest string: %i bytes''' % (filename, numstr, longest, shortest) diff --git a/it/it-projects/plugins/project/src/rpg/MYPROGRAM.rpg b/it/it-projects/plugins/project/src/rpg/MYPROGRAM.rpg new file mode 100644 index 00000000000..b7d36daaa02 --- /dev/null +++ b/it/it-projects/plugins/project/src/rpg/MYPROGRAM.rpg @@ -0,0 +1,53 @@ +123456789012 C* Expressions in Extended Factor 2 syntax +123456789012 C IF A=X OR A=Y AND A=Z +123456789012 C AND B=Y +123456789012 C READ Y +123456789012 C ENDIF +123456789012 C IF A=X OR A=Y AND A=Z +123456789012 C AND B=Y OR B=Z +123456789012 C READ Y +123456789012 C ENDIF +123456789012 C* Expressions composed over several operations in IF +123456789012 C A IFEQ X +123456789012 C A OREQ Y +123456789012 C A ANDEQ Z +123456789012 C B ANDEQ Y +123456789012 C READ Y +123456789012 C ENDIF +123456789012 C A IFEQ X +123456789012 C A OREQ Y +123456789012 C A ANDEQ Z +123456789012 C B ANDEQ Y +123456789012 C B OREQ Z +123456789012 C READ Y +123456789012 C ENDIF +123456789012 C* Expressions composed over several operations in DO +123456789012 C A DOUEQ X +123456789012 C A OREQ Y +123456789012 C A ANDEQ Z +123456789012 C B ANDEQ Y +123456789012 C READ Y +123456789012 C END +123456789012 C A DOUEQ X +123456789012 C A OREQ Y +123456789012 C A ANDEQ Z +123456789012 C B ANDEQ Y +123456789012 C B OREQ Z +123456789012 C READ Y +123456789012 C END +123456789012 C* Expressions composed over several operations in WHEN +123456789012 C SELECT +123456789012 C A WHENEQ X +123456789012 C A OREQ Y +123456789012 C A ANDEQ Z +123456789012 C B ANDEQ Y +123456789012 C READ Y +123456789012 C END +123456789012 C SELECT +123456789012 C A WHENEQ X +123456789012 C A OREQ Y +123456789012 C A ANDEQ Z +123456789012 C B ANDEQ Y +123456789012 C B OREQ Z +123456789012 C READ Y +123456789012 C END
\ No newline at end of file diff --git a/it/it-projects/plugins/project/src/swift/example.swift b/it/it-projects/plugins/project/src/swift/example.swift new file mode 100644 index 00000000000..194455d6b70 --- /dev/null +++ b/it/it-projects/plugins/project/src/swift/example.swift @@ -0,0 +1,10 @@ + +let names = ["Chris", "Alex", "Ewa", "Barry", "Daniella"] + +func backwards(s1: String, s2: String) -> Bool { + return s1 > s2 +} + +var reversed = sorted(names, backwards); + +if (true) { print(reversed) } diff --git a/it/it-projects/plugins/project/src/vb/Info.frm b/it/it-projects/plugins/project/src/vb/Info.frm new file mode 100644 index 00000000000..8487bb3af18 --- /dev/null +++ b/it/it-projects/plugins/project/src/vb/Info.frm @@ -0,0 +1,67 @@ +VERSION 5.00 +Begin VB.Form frmInfo + BorderStyle = 3 'Fixed Dialog + Caption = "Info" + ClientHeight = 3750 + ClientLeft = 45 + ClientTop = 330 + ClientWidth = 6270 + Icon = "Info.frx":0000 + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 3750 + ScaleWidth = 6270 + ShowInTaskbar = 0 'False + StartUpPosition = 1 'CenterOwner + Begin VB.CommandButton cmdOK + Caption = "&OK" + Default = -1 'True + Height = 375 + Left = 5100 + TabIndex = 1 + Top = 3300 + Width = 1095 + End + Begin VB.TextBox txtGPL + BackColor = &H8000000F& + BorderStyle = 0 'None + Height = 3075 + Left = 120 + Locked = -1 'True + MultiLine = -1 'True + TabIndex = 0 + Text = "Info.frx":000C + Top = 120 + Width = 6015 + End +End +Attribute VB_Name = "frmInfo" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +' --- GPL --- +' +' Copyright (C) 1999 SAP AG +' +' This program is free software; you can redistribute it and/or +' modify it under the terms of the GNU General Public License +' as published by the Free Software Foundation; either version 2 +' of the License, or (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program; if not, write to the Free Software +' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +' +' --- GPL --- +Option Explicit + +Private Sub cmdOK_Click() + Unload Me +End Sub diff --git a/it/it-projects/plugins/project/src/vb/Registry.bas b/it/it-projects/plugins/project/src/vb/Registry.bas new file mode 100644 index 00000000000..a7f18dee417 --- /dev/null +++ b/it/it-projects/plugins/project/src/vb/Registry.bas @@ -0,0 +1,166 @@ +Attribute VB_Name = "modRegistry" +' --- GPL --- +' +' Copyright (C) 1999 SAP AG +' +' This program is free software; you can redistribute it and/or +' modify it under the terms of the GNU General Public License +' as published by the Free Software Foundation; either version 2 +' of the License, or (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program; if not, write to the Free Software +' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +' +' --- GPL --- +Option Explicit + +'Structures Needed For Registry Prototypes +Public Type SECURITY_ATTRIBUTES + nLength As Long + lpSecurityDescriptor As Long + bInheritHandle As Boolean +End Type + +Public Type FILETIME + dwLowDateTime As Long + dwHighDateTime As Long +End Type + +'Registry Function Prototypes +Public Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _ + ByVal hKey As Long, _ + ByVal lpSubKey As String, _ + ByVal ulOptions As Long, _ + ByVal samDesired As Long, _ + phkResult As Long) As Long + +Public Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" ( _ + ByVal hKey As Long, _ + ByVal lpSubKey As String, _ + ByVal Reserved As Long, _ + ByVal lpClass As String, _ + ByVal dwOptions As Long, _ + ByVal samDesired As Long, _ + lpSecurityAttributes As SECURITY_ATTRIBUTES, _ + phkResult As Long, _ + lpdwDisposition As Long) As Long + +Public Declare Function RegQueryValueExNull Lib "advapi32.dll" Alias "RegQueryValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + ByVal lpData As Long, _ + lpcbData As Long) As Long + +Public Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + ByVal lpData As String, _ + lpcbData As Long) As Long + +Public Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + lpData As Long, _ + lpcbData As Long) As Long + +Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal Reserved As Long, _ + ByVal dwType As Long, _ + ByVal lpValue As String, _ + ByVal cbData As Long) As Long + +Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal Reserved As Long, _ + ByVal dwType As Long, _ + lpValue As Long, _ + ByVal cbData As Long) As Long + +Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _ + ByVal hKey As Long, _ + ByVal dwIndex As Long, _ + ByVal lpName As String, _ + lpcbName As Long, _ + ByVal lpReserved As Long, _ + ByVal lpClass As String, _ + lpcbClass As Long, _ + lpftLastWriteTime As FILETIME) As Long + +Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _ + ByVal hKey As Long, _ + ByVal dwIndex As Long, _ + ByVal lpValueName As String, _ + lpcbValueName As Long, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + lpData As Any, _ + lpcbData As Long) As Long + +Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _ + ByVal hKey As Long, _ + ByVal lpSubKey As String) As Long + +Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String) As Long + +Public Declare Function RegCloseKey Lib "advapi32" ( _ + ByVal hKey As Long) As Long + +' +''masks for the predefined standard access types +'Private Const STANDARD_RIGHTS_ALL = &H1F0000 +'Private Const SPECIFIC_RIGHTS_ALL = &HFFFF +' +''Define severity codes +' +''Public Const ERROR_ACCESS_DENIED = 5 +'' +''Global Const ERROR_NONE = 0 +''Global Const ERROR_BADDB = 1 +''Global Const ERROR_CANTOPEN = 3 +''Global Const ERROR_CANTREAD = 4 +''Global Const ERROR_CANTWRITE = 5 +''Global Const ERROR_OUTOFMEMORY = 6 +''Global Const ERROR_INVALID_PARAMETER = 7 +''Global Const ERROR_ACCESS_DENIED = 8 +''Global Const ERROR_INVALID_PARAMETERS = 87 +''Global Const ERROR_NO_MORE_ITEMS = 259 + +Public Type ByteValue + b(1024) As Byte +End Type + +Public Type LongValue + l As Long +End Type + +Public Function BytesToString(bValue As ByteValue) As String + Dim s As String + Dim i As Integer + s = StrConv(bValue.b(), vbUnicode) + i = InStr(s, Chr(0)) - 1 + BytesToString = Left(s, i) +End Function + +Public Function BytesToLong(bValue As ByteValue) As Long + Dim lValue As LongValue + LSet lValue = bValue + BytesToLong = lValue.l +End Function + diff --git a/it/it-projects/plugins/project/src/vb/Registry.cls b/it/it-projects/plugins/project/src/vb/Registry.cls new file mode 100644 index 00000000000..ee53025fb97 --- /dev/null +++ b/it/it-projects/plugins/project/src/vb/Registry.cls @@ -0,0 +1,428 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "Registry" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' --- GPL --- +' +' Copyright (C) 1999 SAP AG +' +' This program is free software; you can redistribute it and/or +' modify it under the terms of the GNU General Public License +' as published by the Free Software Foundation; either version 2 +' of the License, or (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program; if not, write to the Free Software +' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +' +' --- GPL --- +Option Explicit + +Public Enum RegistryHKeyConstants + HKEY_CLASSES_ROOT = &H80000000 + HKEY_CURRENT_USER = &H80000001 + HKEY_LOCAL_MACHINE = &H80000002 + HKEY_USERS = &H80000003 + HKEY_PERFORMANCE_DATA = &H80000004 + HKEY_CURRENT_CONFIG = &H80000005 + HKEY_DYN_DATA = &H80000006 +End Enum + +Public Enum RegistryTypeConstants + REG_NONE = (0) 'No value type + REG_SZ = (1) 'Unicode nul terminated string +' REG_EXPAND_SZ = (2) 'Unicode nul terminated string w/enviornment var +' REG_BINARY = (3) 'Free form binary + REG_DWORD = (4) '32-bit number +' REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same as REG_DWORD) +' REG_DWORD_BIG_ENDIAN = (5) '32-bit number +' REG_LINK = (6) 'Symbolic Link (unicode) +' REG_MULTI_SZ = (7) 'Multiple Unicode strings +' REG_RESOURCE_LIST = (8) 'Resource list in the resource map +' REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in the hardware description +' REG_RESOURCE_REQUIREMENTS_LIST = (10) +End Enum + +Public Enum RegistryAccessConstants + KEY_QUERY_VALUE = &H1 + KEY_SET_VALUE = &H2 + KEY_CREATE_SUB_KEY = &H4 + KEY_ENUMERATE_SUB_KEYS = &H8 + KEY_NOTIFY = &H10 + KEY_CREATE_LINK = &H20 + KEY_ALL_ACCESS = &H3F +End Enum + +Public Enum RegistryErrorConstants + ERROR_SUCCESS = 0 + ERROR_BADKEY = 2 + ERROR_OUTOFMEMORY = 6 + ERROR_MORE_DATA = 234 + ERROR_NO_MORE_ITEMS = 259 +End Enum + +Public Enum RegistryVolatileConstants + REG_OPTION_NON_VOLATILE = 0& + REG_OPTION_VOLATILE = &H1 +End Enum + +Public Enum RegistryDispositionConstants + REG_CREATED_NEW_KEY = &H1 + REG_OPENED_EXISTING_KEY = &H2 +End Enum + +Private oKeys As Keys + +Private bShowErrors As Boolean +Private bRaiseErrors As Boolean +' +' Public Properties +' +Public Property Get Keys() As Keys + If oKeys Is Nothing Then + Set oKeys = New Keys + With oKeys + Set .Registry = Me + Set .Parent = Me + .Root = True + End With + End If + Set Keys = oKeys +End Property + +Public Property Get ShowErrors() As Boolean + ShowErrors = bShowErrors +End Property +Public Property Let ShowErrors(ByVal NewVal As Boolean) + bShowErrors = NewVal +End Property + +Public Property Get RaiseErrors() As Boolean + RaiseErrors = bRaiseErrors +End Property +Public Property Let RaiseErrors(ByVal NewVal As Boolean) + bRaiseErrors = NewVal +End Property +' +' Public Sub/Function +' +' Base Functions +' +Public Function OpenKey(ByVal hKey As RegistryHKeyConstants, _ + ByVal Path As String, _ + ByVal Access As RegistryAccessConstants, _ + Key As Long) As Boolean + + Dim lRC As Long + + OpenKey = False + + lRC = RegOpenKeyEx(hKey, Path, 0&, Access, Key) + If lRC = ERROR_SUCCESS Then + OpenKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function CreateKey(ByVal hKey As RegistryHKeyConstants, _ + ByVal Path As String, _ + ByVal Volatile As RegistryVolatileConstants, _ + ByVal Access As RegistryAccessConstants, _ + Key As Long, _ + Disposition As Long) As Boolean + + Dim lRC As Long + Dim saKey As SECURITY_ATTRIBUTES + + CreateKey = False + + lRC = RegCreateKeyEx(hKey, Path, 0, "", Volatile, Access, saKey, Key, Disposition) + If lRC = ERROR_SUCCESS Then + CreateKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function DeleteKey(ByVal hKey As RegistryHKeyConstants, _ + ByVal Path As String) As Boolean + + Dim lRC As Long + + DeleteKey = False + + lRC = RegDeleteKey(hKey, Path) + If lRC = ERROR_SUCCESS Then + DeleteKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function CloseKey(ByVal Path, _ + Key As Long) As Boolean + + Dim lRC As Long + + CloseKey = False + + lRC = RegCloseKey(Key) + If lRC = ERROR_SUCCESS Then + Key = 0 + CloseKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function QueryValueNull(ByVal hKey As Long, _ + ByVal Name As String, _ + ValueType As RegistryTypeConstants, _ + ValueLen As Long) As Boolean + + Dim lRC As Long + + QueryValueNull = False + + lRC = RegQueryValueExNull(hKey, Name, 0&, ValueType, 0&, ValueLen) + If lRC = ERROR_SUCCESS Then + QueryValueNull = True + Else + HandleError lRC, Name + End If +End Function + +Public Function QueryValueString(ByVal hKey As Long, _ + ByVal Name As String, _ + Value As String, _ + ValueLen As Long) As Boolean + + Dim lRC As Long + + QueryValueString = False + + Value = String(ValueLen, 0) + + lRC = RegQueryValueExString(hKey, Name, 0&, REG_SZ, Value, ValueLen) + If lRC = ERROR_SUCCESS Then + Value = Left(Value, ValueLen - 1) + QueryValueString = True + Else + HandleError lRC, Name + End If +End Function + +Public Function QueryValueLong(ByVal hKey As Long, _ + ByVal Name As String, _ + Value As Long) As Boolean + + Dim lRC As Long + Dim lValueLen As Long + + QueryValueLong = False + + Value = 0 + + lRC = RegQueryValueExLong(hKey, Name, 0&, REG_DWORD, Value, 4) + If lRC = ERROR_SUCCESS Then + QueryValueLong = True + Else + HandleError lRC, Name + End If +End Function + +Public Function SetValueString(ByVal hKey As Long, _ + ByVal Name As String, _ + ByVal Value As String) As Boolean + + Dim lRC As Long + + SetValueString = False + + Value = Value & Chr(0) + + lRC = RegSetValueExString(hKey, Name, 0&, REG_SZ, Value, Len(Value)) + If lRC = ERROR_SUCCESS Then + SetValueString = True + Else + HandleError lRC, Name + End If +End Function + +Public Function SetValueLong(ByVal hKey As Long, _ + ByVal Name As String, _ + ByVal Value As Long) As Boolean + + Dim lRC As Long + + SetValueLong = False + + lRC = RegSetValueExLong(hKey, Name, 0&, REG_DWORD, Value, 4) + If lRC = ERROR_SUCCESS Then + SetValueLong = True + Else + HandleError lRC, Name + End If +End Function + +Public Function DeleteValue(ByVal hKey As Long, _ + ByVal Name As String) As Boolean + + Dim lRC As Long + + DeleteValue = False + + lRC = RegDeleteValue(hKey, Name) + If lRC = ERROR_SUCCESS Then + DeleteValue = True + Else + HandleError lRC, Name + End If +End Function +' +' +' +Public Function Check(ByVal WithSubKeys As Boolean, _ + ByVal WithValues As Boolean) As Boolean + + Dim oKey As Key + + Check = False + + For Each oKey In Keys + If Not oKey.Check(WithSubKeys, WithValues) Then + Exit Function + End If + Next + + Check = True +End Function + +Public Function Create(ByVal WithSubKeys As Boolean, _ + ByVal WithValues As Boolean) As Boolean + + Dim oKey As Key + + Create = False + + For Each oKey In Keys + If Not oKey.Create(WithSubKeys, WithValues) Then + Exit Function + End If + Next + + Create = True +End Function + +Public Function QueryValues(ByVal WithSubKeys As Boolean) As Boolean + + Dim oKey As Key + + QueryValues = False + + For Each oKey In Keys + If Not oKey.QueryValues(WithSubKeys) Then + Exit Function + End If + Next + + QueryValues = True +End Function + +Public Function SetValues(ByVal WithSubKeys As Boolean) As Boolean + + Dim oKey As Key + + SetValues = False + + For Each oKey In Keys + If Not oKey.SetValues(WithSubKeys) Then + Exit Function + End If + Next + + SetValues = True +End Function + +Public Function EnumKeys(ByVal WithSubKeys As Boolean, _ + ByVal WithValues As Boolean) As Boolean + + Dim oKey As Key + + EnumKeys = False + + For Each oKey In Keys + If Not oKey.EnumKeys(WithSubKeys, WithValues) Then + Exit Function + End If + Next + + EnumKeys = True +End Function + +Public Function FindKeyByPath(ByVal WithSubKeys As Boolean, _ + ByVal FindPath As String) As Key + Dim oKey As Key + + Set FindKeyByPath = Nothing + + For Each oKey In Keys + If FindPath = oKey.Path Then + Set FindKeyByPath = oKey + Exit Function + End If + If WithSubKeys Then + Set FindKeyByPath = oKey.FindKeyByPath(WithSubKeys, FindPath) + End If + Next +End Function + +Friend Sub HandleError(ByVal RC As Long, ByVal Text As String) + Dim sMsg As String + + If bShowErrors Then + sMsg = "Error: " & ErrorText(RC) & ". " & Text + MsgBox sMsg, vbExclamation + End If +End Sub +' +' Private Sub/Function +' +Private Sub Class_Initialize() + 'Debug.Print "INIT Registry" + Set oKeys = Nothing + bShowErrors = True + bRaiseErrors = False +End Sub + +Private Sub Class_Terminate() + 'Debug.Print "TERM Registry" +End Sub + +Private Function ErrorText(ByVal lRC As Long) As String + Dim s As String + Select Case lRC + Case ERROR_BADKEY: s = "Bad key" + Case ERROR_MORE_DATA: s = "More data" + Case ERROR_OUTOFMEMORY: s = "Out of memory" + Case ERROR_NO_MORE_ITEMS: s = "No more items" + Case Else: s = "RC=" & CStr(lRC) + End Select + ErrorText = s +End Function + diff --git a/it/it-projects/plugins/project/src/web/sample.xhtml b/it/it-projects/plugins/project/src/web/sample.xhtml new file mode 100644 index 00000000000..9207ba54200 --- /dev/null +++ b/it/it-projects/plugins/project/src/web/sample.xhtml @@ -0,0 +1,48 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" + xmlns:ui="http://java.sun.com/jsf/facelets" + xmlns:h="http://java.sun.com/jsf/html" + xmlns:f="http://java.sun.com/jsf/core"> + + <f:metadata> + <f:viewParam name="user" value="#{userEdit.user}" converter="#{userConvertor}" /> + <f:event listener="#{userEdit.preRenderView()}" type="preRenderView"/> + </f:metadata> + + <h:head> + <title>User list</title> + </h:head> + + <h:body> + + <h:messages /> + + <h:form> + + <h:panelGrid columns="2"> + <f:facet name="header">User</f:facet> + + <h:outputLabel value="Id" rendered="#{!empty userEdit.user.id}" /> + <h:outputLabel value="#{userEdit.user.id}" rendered="#{!empty userEdit.user.id}" /> + + <h:outputLabel for="firstName" value="First name" /> + <h:inputText id="firstName" value="#{userEdit.user.firstName}" label="First name" /> + + <h:outputLabel for="lastName" value="Last name" /> + <h:inputText id="lastName" value="#{userEdit.user.lastName}" label="Last name" /> + + <h:outputLabel for="birthDay" value="Birth day" /> + <h:inputText id="birthDay" value="#{userEdit.user.birthday}" label="Birth day"> + <f:convertDateTime pattern="dd-MM-yyyy"/> + </h:inputText> + + <h:outputLabel for="email" value="Email" /> + <h:inputText id="email" value="#{userEdit.user.email}" /> + + <h:commandButton action="#{userEdit.saveUser}" value="Submit" /> + <h:button outcome="index.xhtml" value="Cancel" /> + </h:panelGrid> + </h:form> + + </h:body> +</html>
\ No newline at end of file diff --git a/it/it-projects/plugins/project/target/classes/foo/Foo.class b/it/it-projects/plugins/project/target/classes/foo/Foo.class Binary files differnew file mode 100644 index 00000000000..97de0cb4b2f --- /dev/null +++ b/it/it-projects/plugins/project/target/classes/foo/Foo.class diff --git a/it/it-projects/plugins/project/target/classes/foo/Simplest.class b/it/it-projects/plugins/project/target/classes/foo/Simplest.class Binary files differnew file mode 100644 index 00000000000..d22988c5549 --- /dev/null +++ b/it/it-projects/plugins/project/target/classes/foo/Simplest.class diff --git a/it/it-projects/plugins/project/target/classes/foo/Simplest2.class b/it/it-projects/plugins/project/target/classes/foo/Simplest2.class Binary files differnew file mode 100644 index 00000000000..62c50cd0da0 --- /dev/null +++ b/it/it-projects/plugins/project/target/classes/foo/Simplest2.class diff --git a/it/it-projects/plugins/project/target/classes/foo/Simplest3.class b/it/it-projects/plugins/project/target/classes/foo/Simplest3.class Binary files differnew file mode 100644 index 00000000000..e6df2a8f278 --- /dev/null +++ b/it/it-projects/plugins/project/target/classes/foo/Simplest3.class diff --git a/it/it-projects/plugins/project/target/it-all-lang-1.0-SNAPSHOT.jar b/it/it-projects/plugins/project/target/it-all-lang-1.0-SNAPSHOT.jar Binary files differnew file mode 100644 index 00000000000..f50c4a3d1bd --- /dev/null +++ b/it/it-projects/plugins/project/target/it-all-lang-1.0-SNAPSHOT.jar diff --git a/it/it-projects/plugins/project/target/js/lcov.dat b/it/it-projects/plugins/project/target/js/lcov.dat new file mode 100644 index 00000000000..dc51a1c762b --- /dev/null +++ b/it/it-projects/plugins/project/target/js/lcov.dat @@ -0,0 +1,71 @@ +SF:src/js/Person.js +DA:2,1 +DA:3,2 +DA:4,2 +DA:5,2 +DA:8,1 +DA:11,2 +end_of_record +SF:src/js/com/company/Car.js +DA:1,1 +DA:2,3 +DA:3,3 +DA:4,3 +DA:5,3 +DA:6,3 +DA:9,1 +DA:12,1 +DA:16,1 +DA:17,0 +DA:18,1 +DA:19,1 +DA:21,0 +DA:26,0 +DA:27,0 +DA:31,0 +DA:32,0 +DA:36,1 +DA:37,0 +DA:38,0 +DA:39,0 +DA:41,1 +DA:42,1 +DA:47,0 +end_of_record +SF:src/jscom/company/Truck.js +DA:1,1 +DA:2,0 +DA:3,0 +DA:4,0 +DA:5,0 +DA:6,0 +DA:9,1 +DA:12,0 +DA:16,0 +DA:17,0 +DA:18,0 +DA:19,0 +DA:21,0 +end_of_record +SF:src/jscom/company/Vehicle.js +DA:9,1 +DA:10,0 +DA:11,0 +DA:12,0 +DA:13,0 +DA:14,0 +DA:22,1 +DA:25,0 +DA:29,0 +DA:30,0 +DA:31,0 +DA:32,0 +DA:34,0 +DA:39,0 +DA:40,0 +DA:41,0 +DA:42,0 +DA:44,0 +DA:45,0 +DA:50,0 +end_of_record diff --git a/it/it-projects/plugins/project/target/php/phpunit.coverage.xml b/it/it-projects/plugins/project/target/php/phpunit.coverage.xml new file mode 100644 index 00000000000..184a0dd8466 --- /dev/null +++ b/it/it-projects/plugins/project/target/php/phpunit.coverage.xml @@ -0,0 +1,101 @@ +<?xml version="1.0" encoding="UTF-8"?> +<coverage generated="1394164581"> + <project timestamp="1394164581"> + <file name="src/Math.php"> + <class name="PhpUnderControl_Example_Math" namespace="global" fullPackage="Example" package="Example"> + <metrics methods="4" coveredmethods="2" conditionals="0" coveredconditionals="0" statements="84" coveredstatements="2" elements="88" coveredelements="4"/> + </class> + <line num="46" type="stmt" count="0"/> + <line num="69" type="method" name="add" crap="1" count="1"/> + <line num="71" type="stmt" count="1"/> + <line num="82" type="method" name="sub" crap="1" count="10"/> + <line num="84" type="stmt" count="10"/> + <line num="90" type="method" name="div" crap="132" count="0"/> + <line num="92" type="stmt" count="0"/> + <line num="93" type="stmt" count="0"/> + <line num="94" type="stmt" count="0"/> + <line num="95" type="stmt" count="0"/> + <line num="96" type="stmt" count="0"/> + <line num="98" type="stmt" count="0"/> + <line num="99" type="stmt" count="0"/> + <line num="100" type="stmt" count="0"/> + <line num="101" type="stmt" count="0"/> + <line num="103" type="stmt" count="0"/> + <line num="105" type="stmt" count="0"/> + <line num="107" type="stmt" count="0"/> + <line num="108" type="stmt" count="0"/> + <line num="110" type="stmt" count="0"/> + <line num="111" type="stmt" count="0"/> + <line num="112" type="stmt" count="0"/> + <line num="114" type="stmt" count="0"/> + <line num="115" type="stmt" count="0"/> + <line num="117" type="stmt" count="0"/> + <line num="118" type="stmt" count="0"/> + <line num="120" type="stmt" count="0"/> + <line num="121" type="stmt" count="0"/> + <line num="122" type="stmt" count="0"/> + <line num="123" type="stmt" count="0"/> + <line num="124" type="stmt" count="0"/> + <line num="126" type="stmt" count="0"/> + <line num="127" type="stmt" count="0"/> + <line num="128" type="stmt" count="0"/> + <line num="129" type="stmt" count="0"/> + <line num="131" type="stmt" count="0"/> + <line num="133" type="stmt" count="0"/> + <line num="135" type="stmt" count="0"/> + <line num="136" type="stmt" count="0"/> + <line num="138" type="stmt" count="0"/> + <line num="139" type="stmt" count="0"/> + <line num="140" type="stmt" count="0"/> + <line num="142" type="stmt" count="0"/> + <line num="143" type="stmt" count="0"/> + <line num="145" type="stmt" count="0"/> + <line num="146" type="stmt" count="0"/> + <line num="148" type="stmt" count="0"/> + <line num="154" type="method" name="complex" crap="132" count="0"/> + <line num="156" type="stmt" count="0"/> + <line num="157" type="stmt" count="0"/> + <line num="158" type="stmt" count="0"/> + <line num="159" type="stmt" count="0"/> + <line num="160" type="stmt" count="0"/> + <line num="162" type="stmt" count="0"/> + <line num="163" type="stmt" count="0"/> + <line num="164" type="stmt" count="0"/> + <line num="165" type="stmt" count="0"/> + <line num="167" type="stmt" count="0"/> + <line num="169" type="stmt" count="0"/> + <line num="171" type="stmt" count="0"/> + <line num="172" type="stmt" count="0"/> + <line num="174" type="stmt" count="0"/> + <line num="175" type="stmt" count="0"/> + <line num="176" type="stmt" count="0"/> + <line num="178" type="stmt" count="0"/> + <line num="179" type="stmt" count="0"/> + <line num="181" type="stmt" count="0"/> + <line num="182" type="stmt" count="0"/> + <line num="184" type="stmt" count="0"/> + <line num="185" type="stmt" count="0"/> + <line num="186" type="stmt" count="0"/> + <line num="187" type="stmt" count="0"/> + <line num="188" type="stmt" count="0"/> + <line num="190" type="stmt" count="0"/> + <line num="191" type="stmt" count="0"/> + <line num="192" type="stmt" count="0"/> + <line num="193" type="stmt" count="0"/> + <line num="195" type="stmt" count="0"/> + <line num="197" type="stmt" count="0"/> + <line num="199" type="stmt" count="0"/> + <line num="200" type="stmt" count="0"/> + <line num="202" type="stmt" count="0"/> + <line num="203" type="stmt" count="0"/> + <line num="204" type="stmt" count="0"/> + <line num="206" type="stmt" count="0"/> + <line num="207" type="stmt" count="0"/> + <line num="209" type="stmt" count="0"/> + <line num="210" type="stmt" count="0"/> + <line num="212" type="stmt" count="0"/> + <metrics loc="214" ncloc="140" classes="1" methods="4" coveredmethods="2" conditionals="0" coveredconditionals="0" statements="85" coveredstatements="2" elements="89" coveredelements="4"/> + </file> + <metrics files="1" loc="214" ncloc="140" classes="1" methods="4" coveredmethods="2" conditionals="0" coveredconditionals="0" statements="85" coveredstatements="2" elements="89" coveredelements="4"/> + </project> +</coverage> diff --git a/it/it-projects/plugins/project/target/php/phpunit.xml b/it/it-projects/plugins/project/target/php/phpunit.xml new file mode 100644 index 00000000000..1942bdf47d6 --- /dev/null +++ b/it/it-projects/plugins/project/target/php/phpunit.xml @@ -0,0 +1,52 @@ +<?xml version="1.0" encoding="UTF-8"?> +<testsuites> + <testsuite name="Test Suite" tests="12" assertions="11" failures="7" errors="0" time="8.036518"> + <testsuite name="PhpUnderControl_Example_MathTest" file="tests/SomeTest.php" fullPackage="Example" package="Example" tests="12" assertions="11" failures="7" errors="0" time="8.036518"> + <testcase name="testAddSuccess" class="PhpUnderControl_Example_MathTest" file="tests/SomeTest.php" line="72" assertions="1" time="2.006604"/> + <testcase name="testSubSuccess" class="PhpUnderControl_Example_MathTest" file="tests/SomeTest.php" line="81" assertions="1" time="0.000842"/> + <testcase name="testSubFail" class="PhpUnderControl_Example_MathTest" file="tests/SomeTest.php" line="89" assertions="1" time="2.006533"> + <failure type="PHPUnit_Framework_ExpectationFailedException">PhpUnderControl_Example_MathTest::testSubFail + Failed asserting that 1 matches expected 0. + </failure> + </testcase> + <testsuite name="PhpUnderControl_Example_MathTest::testDataProviderOneWillFail" tests="4" assertions="4" failures="1" errors="0" time="4.008126"> + <testcase name="testDataProviderOneWillFail with data set #0" assertions="1" time="1.001100"/> + <testcase name="testDataProviderOneWillFail with data set #1" assertions="1" time="1.001209"/> + <testcase name="testDataProviderOneWillFail with data set #2" assertions="1" time="1.004137"> + <failure type="PHPUnit_Framework_ExpectationFailedException">PhpUnderControl_Example_MathTest::testDataProviderOneWillFail with data set #2 (7, 1) + Failed asserting that 6 matches expected 1. + </failure> + </testcase> + <testcase name="testDataProviderOneWillFail with data set #3" assertions="1" time="1.001680"/> + </testsuite> + <testsuite name="PhpUnderControl_Example_MathTest::testDataProviderAllWillFail" tests="4" assertions="4" failures="4" errors="0" time="0.012665"> + <testcase name="testDataProviderAllWillFail with data set #0" assertions="1" time="0.003173"> + <failure type="PHPUnit_Framework_ExpectationFailedException">PhpUnderControl_Example_MathTest::testDataProviderAllWillFail with data set #0 (17, 42) + Failed asserting that -25 matches expected 1. + + </failure> + </testcase> + <testcase name="testDataProviderAllWillFail with data set #1" assertions="1" time="0.003231"> + <failure type="PHPUnit_Framework_ExpectationFailedException">PhpUnderControl_Example_MathTest::testDataProviderAllWillFail with data set #1 (13, 23) + Failed asserting that -10 matches expected 1. + </failure> + </testcase> + <testcase name="testDataProviderAllWillFail with data set #2" assertions="1" time="0.003100"> + <failure type="PHPUnit_Framework_ExpectationFailedException">PhpUnderControl_Example_MathTest::testDataProviderAllWillFail with data set #2 (42, 17) + Failed asserting that 25 matches expected 1. + </failure> + </testcase> + <testcase name="testDataProviderAllWillFail with data set #3" assertions="1" time="0.003161"> + <failure type="PHPUnit_Framework_ExpectationFailedException">PhpUnderControl_Example_MathTest::testDataProviderAllWillFail with data set #3 (23, 13) + Failed asserting that 10 matches expected 1. + </failure> + </testcase> + </testsuite> + <testcase name="testFail" class="PhpUnderControl_Example_MathTest" file="tests/SomeTest.php" line="119" assertions="0" time="0.001748"> + <failure type="PHPUnit_Framework_AssertionFailedError">PhpUnderControl_Example_MathTest::testFail + Failed because... + </failure> + </testcase> + </testsuite> + </testsuite> +</testsuites> diff --git a/it/it-projects/plugins/project/target/surefire-reports/TEST-foo.FooTest.xml b/it/it-projects/plugins/project/target/surefire-reports/TEST-foo.FooTest.xml new file mode 100644 index 00000000000..74695fdea1e --- /dev/null +++ b/it/it-projects/plugins/project/target/surefire-reports/TEST-foo.FooTest.xml @@ -0,0 +1,66 @@ +<?xml version="1.0" encoding="UTF-8" ?> +<testsuite failures="0" time="0.004" errors="0" skipped="0" tests="1" name="foo.FooTest"> + <properties> + <property name="java.runtime.name" value="Java(TM) SE Runtime Environment"/> + <property name="sun.boot.library.path" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib"/> + <property name="java.vm.version" value="24.71-b01"/> + <property name="user.country.format" value="FR"/> + <property name="gopherProxySet" value="false"/> + <property name="java.vm.vendor" value="Oracle Corporation"/> + <property name="java.vendor.url" value="http://java.oracle.com/"/> + <property name="path.separator" value=":"/> + <property name="guice.disable.misplaced.annotation.check" value="true"/> + <property name="java.vm.name" value="Java HotSpot(TM) 64-Bit Server VM"/> + <property name="file.encoding.pkg" value="sun.io"/> + <property name="user.country" value="US"/> + <property name="sun.java.launcher" value="SUN_STANDARD"/> + <property name="sun.os.patch.level" value="unknown"/> + <property name="java.vm.specification.name" value="Java Virtual Machine Specification"/> + <property name="user.dir" value="/Users/sbrandhof/dev/core/sonar-tests-core/platform/projects/all-langs"/> + <property name="java.runtime.version" value="1.7.0_71-b14"/> + <property name="java.awt.graphicsenv" value="sun.awt.CGraphicsEnvironment"/> + <property name="java.endorsed.dirs" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/endorsed"/> + <property name="os.arch" value="x86_64"/> + <property name="java.io.tmpdir" value="/var/folders/ny/2lkywbzs63xc1n1k7rzprjj40000gn/T/"/> + <property name="line.separator" value=" +"/> + <property name="java.vm.specification.vendor" value="Oracle Corporation"/> + <property name="os.name" value="Mac OS X"/> + <property name="classworlds.conf" value="/usr/local/Cellar/maven32/3.2.5/libexec/bin/m2.conf"/> + <property name="sun.jnu.encoding" value="UTF-8"/> + <property name="java.library.path" value="/Users/sbrandhof/Library/Java/Extensions:/Library/Java/Extensions:/Network/Library/Java/Extensions:/System/Library/Java/Extensions:/usr/lib/java:."/> + <property name="java.specification.name" value="Java Platform API Specification"/> + <property name="java.class.version" value="51.0"/> + <property name="sun.management.compiler" value="HotSpot 64-Bit Tiered Compilers"/> + <property name="os.version" value="10.10.3"/> + <property name="http.nonProxyHosts" value="local|*.local|169.254/16|*.169.254/16"/> + <property name="user.home" value="/Users/sbrandhof"/> + <property name="user.timezone" value="Europe/Paris"/> + <property name="java.awt.printerjob" value="sun.lwawt.macosx.CPrinterJob"/> + <property name="java.specification.version" value="1.7"/> + <property name="file.encoding" value="UTF-8"/> + <property name="user.name" value="sbrandhof"/> + <property name="java.class.path" value="/usr/local/Cellar/maven32/3.2.5/libexec/boot/plexus-classworlds-2.5.2.jar"/> + <property name="java.vm.specification.version" value="1.7"/> + <property name="sun.arch.data.model" value="64"/> + <property name="java.home" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre"/> + <property name="sun.java.command" value="org.codehaus.plexus.classworlds.launcher.Launcher package"/> + <property name="java.specification.vendor" value="Oracle Corporation"/> + <property name="user.language" value="en"/> + <property name="awt.toolkit" value="sun.lwawt.macosx.LWCToolkit"/> + <property name="java.vm.info" value="mixed mode"/> + <property name="java.version" value="1.7.0_71"/> + <property name="java.ext.dirs" value="/Users/sbrandhof/Library/Java/Extensions:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/ext:/Library/Java/Extensions:/Network/Library/Java/Extensions:/System/Library/Java/Extensions:/usr/lib/java"/> + <property name="sun.boot.class.path" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/resources.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/rt.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/sunrsasign.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/jsse.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/jce.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/charsets.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/jfr.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/classes"/> + <property name="java.vendor" value="Oracle Corporation"/> + <property name="maven.home" value="/usr/local/Cellar/maven32/3.2.5/libexec"/> + <property name="file.separator" value="/"/> + <property name="java.vendor.url.bug" value="http://bugreport.sun.com/bugreport/"/> + <property name="sun.cpu.endian" value="little"/> + <property name="sun.io.unicode.encoding" value="UnicodeBig"/> + <property name="socksNonProxyHosts" value="local|*.local|169.254/16|*.169.254/16"/> + <property name="ftp.nonProxyHosts" value="local|*.local|169.254/16|*.169.254/16"/> + <property name="sun.cpu.isalist" value=""/> + </properties> + <testcase time="0.004" classname="foo.FooTest" name="testAdd"/> +</testsuite>
\ No newline at end of file diff --git a/it/it-projects/plugins/project/target/surefire-reports/TEST-foo.SimplestTest.xml b/it/it-projects/plugins/project/target/surefire-reports/TEST-foo.SimplestTest.xml new file mode 100644 index 00000000000..3023499428f --- /dev/null +++ b/it/it-projects/plugins/project/target/surefire-reports/TEST-foo.SimplestTest.xml @@ -0,0 +1,66 @@ +<?xml version="1.0" encoding="UTF-8" ?> +<testsuite failures="0" time="0" errors="0" skipped="0" tests="1" name="foo.SimplestTest"> + <properties> + <property name="java.runtime.name" value="Java(TM) SE Runtime Environment"/> + <property name="sun.boot.library.path" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib"/> + <property name="java.vm.version" value="24.71-b01"/> + <property name="user.country.format" value="FR"/> + <property name="gopherProxySet" value="false"/> + <property name="java.vm.vendor" value="Oracle Corporation"/> + <property name="java.vendor.url" value="http://java.oracle.com/"/> + <property name="path.separator" value=":"/> + <property name="guice.disable.misplaced.annotation.check" value="true"/> + <property name="java.vm.name" value="Java HotSpot(TM) 64-Bit Server VM"/> + <property name="file.encoding.pkg" value="sun.io"/> + <property name="user.country" value="US"/> + <property name="sun.java.launcher" value="SUN_STANDARD"/> + <property name="sun.os.patch.level" value="unknown"/> + <property name="java.vm.specification.name" value="Java Virtual Machine Specification"/> + <property name="user.dir" value="/Users/sbrandhof/dev/core/sonar-tests-core/platform/projects/all-langs"/> + <property name="java.runtime.version" value="1.7.0_71-b14"/> + <property name="java.awt.graphicsenv" value="sun.awt.CGraphicsEnvironment"/> + <property name="java.endorsed.dirs" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/endorsed"/> + <property name="os.arch" value="x86_64"/> + <property name="java.io.tmpdir" value="/var/folders/ny/2lkywbzs63xc1n1k7rzprjj40000gn/T/"/> + <property name="line.separator" value=" +"/> + <property name="java.vm.specification.vendor" value="Oracle Corporation"/> + <property name="os.name" value="Mac OS X"/> + <property name="classworlds.conf" value="/usr/local/Cellar/maven32/3.2.5/libexec/bin/m2.conf"/> + <property name="sun.jnu.encoding" value="UTF-8"/> + <property name="java.library.path" value="/Users/sbrandhof/Library/Java/Extensions:/Library/Java/Extensions:/Network/Library/Java/Extensions:/System/Library/Java/Extensions:/usr/lib/java:."/> + <property name="java.specification.name" value="Java Platform API Specification"/> + <property name="java.class.version" value="51.0"/> + <property name="sun.management.compiler" value="HotSpot 64-Bit Tiered Compilers"/> + <property name="os.version" value="10.10.3"/> + <property name="http.nonProxyHosts" value="local|*.local|169.254/16|*.169.254/16"/> + <property name="user.home" value="/Users/sbrandhof"/> + <property name="user.timezone" value="Europe/Paris"/> + <property name="java.awt.printerjob" value="sun.lwawt.macosx.CPrinterJob"/> + <property name="java.specification.version" value="1.7"/> + <property name="file.encoding" value="UTF-8"/> + <property name="user.name" value="sbrandhof"/> + <property name="java.class.path" value="/usr/local/Cellar/maven32/3.2.5/libexec/boot/plexus-classworlds-2.5.2.jar"/> + <property name="java.vm.specification.version" value="1.7"/> + <property name="sun.arch.data.model" value="64"/> + <property name="java.home" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre"/> + <property name="sun.java.command" value="org.codehaus.plexus.classworlds.launcher.Launcher package"/> + <property name="java.specification.vendor" value="Oracle Corporation"/> + <property name="user.language" value="en"/> + <property name="awt.toolkit" value="sun.lwawt.macosx.LWCToolkit"/> + <property name="java.vm.info" value="mixed mode"/> + <property name="java.version" value="1.7.0_71"/> + <property name="java.ext.dirs" value="/Users/sbrandhof/Library/Java/Extensions:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/ext:/Library/Java/Extensions:/Network/Library/Java/Extensions:/System/Library/Java/Extensions:/usr/lib/java"/> + <property name="sun.boot.class.path" value="/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/resources.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/rt.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/sunrsasign.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/jsse.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/jce.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/charsets.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/lib/jfr.jar:/Library/Java/JavaVirtualMachines/jdk1.7.0_71.jdk/Contents/Home/jre/classes"/> + <property name="java.vendor" value="Oracle Corporation"/> + <property name="maven.home" value="/usr/local/Cellar/maven32/3.2.5/libexec"/> + <property name="file.separator" value="/"/> + <property name="java.vendor.url.bug" value="http://bugreport.sun.com/bugreport/"/> + <property name="sun.cpu.endian" value="little"/> + <property name="sun.io.unicode.encoding" value="UnicodeBig"/> + <property name="socksNonProxyHosts" value="local|*.local|169.254/16|*.169.254/16"/> + <property name="ftp.nonProxyHosts" value="local|*.local|169.254/16|*.169.254/16"/> + <property name="sun.cpu.isalist" value=""/> + </properties> + <testcase time="0" classname="foo.SimplestTest" name="testAdd"/> +</testsuite>
\ No newline at end of file diff --git a/it/it-projects/plugins/project/target/surefire-reports/foo.FooTest.txt b/it/it-projects/plugins/project/target/surefire-reports/foo.FooTest.txt new file mode 100644 index 00000000000..81a35910169 --- /dev/null +++ b/it/it-projects/plugins/project/target/surefire-reports/foo.FooTest.txt @@ -0,0 +1,4 @@ +------------------------------------------------------------------------------- +Test set: foo.FooTest +------------------------------------------------------------------------------- +Tests run: 1, Failures: 0, Errors: 0, Skipped: 0, Time elapsed: 0.044 sec diff --git a/it/it-projects/plugins/project/target/surefire-reports/foo.SimplestTest.txt b/it/it-projects/plugins/project/target/surefire-reports/foo.SimplestTest.txt new file mode 100644 index 00000000000..1e8766a397f --- /dev/null +++ b/it/it-projects/plugins/project/target/surefire-reports/foo.SimplestTest.txt @@ -0,0 +1,4 @@ +------------------------------------------------------------------------------- +Test set: foo.SimplestTest +------------------------------------------------------------------------------- +Tests run: 1, Failures: 0, Errors: 0, Skipped: 0, Time elapsed: 0 sec diff --git a/it/it-projects/plugins/project/target/test-classes/foo/FooTest.class b/it/it-projects/plugins/project/target/test-classes/foo/FooTest.class Binary files differnew file mode 100644 index 00000000000..0970a8681a7 --- /dev/null +++ b/it/it-projects/plugins/project/target/test-classes/foo/FooTest.class diff --git a/it/it-projects/plugins/project/target/test-classes/foo/SimplestTest.class b/it/it-projects/plugins/project/target/test-classes/foo/SimplestTest.class Binary files differnew file mode 100644 index 00000000000..3f6daea7c54 --- /dev/null +++ b/it/it-projects/plugins/project/target/test-classes/foo/SimplestTest.class diff --git a/it/it-projects/plugins/project/test/java/foo/FooTest.java b/it/it-projects/plugins/project/test/java/foo/FooTest.java new file mode 100644 index 00000000000..d0eb283e151 --- /dev/null +++ b/it/it-projects/plugins/project/test/java/foo/FooTest.java @@ -0,0 +1,12 @@ +package foo; + +import org.junit.Test; +import static org.junit.Assert.*; + +public class FooTest { + + @Test + public void testAdd() throws Exception { + assertEquals(Foo.div(10, 5), 2); + } +} diff --git a/it/it-projects/plugins/project/test/java/foo/SimplestTest.java b/it/it-projects/plugins/project/test/java/foo/SimplestTest.java new file mode 100644 index 00000000000..8c28ff4c91e --- /dev/null +++ b/it/it-projects/plugins/project/test/java/foo/SimplestTest.java @@ -0,0 +1,12 @@ +package foo; + +import org.junit.Test; +import static org.junit.Assert.*; + +public class SimplestTest { + + @Test + public void testAdd() throws Exception { + assertEquals(Simplest.add(4, 5), 9); + } +} diff --git a/it/it-projects/plugins/project/test/js/PersonTest.js b/it/it-projects/plugins/project/test/js/PersonTest.js new file mode 100644 index 00000000000..36b8fb05af5 --- /dev/null +++ b/it/it-projects/plugins/project/test/js/PersonTest.js @@ -0,0 +1,13 @@ +TestCase('PersonTest', { + + testWhoAreYou : function() { + var p = new Person('John', 'Doe', 'P.'); + assertEquals('Should have responded with full name', 'John P. Doe', p.whoAreYou()); + }, + + testWhoAreYouWithNoMiddleName : function() { + var p = new Person('John', 'Doe'); + assertEquals('Should have used only first and last name', 'John Doe', p.whoAreYou()); + } + +});
\ No newline at end of file diff --git a/it/it-projects/plugins/project/test/js/com/company/CarTest.js b/it/it-projects/plugins/project/test/js/com/company/CarTest.js new file mode 100644 index 00000000000..b63b17d1f69 --- /dev/null +++ b/it/it-projects/plugins/project/test/js/com/company/CarTest.js @@ -0,0 +1,18 @@ +TestCase('com.company.CarTest', { + + testfullName : function() { + var car = new Car('VW', 'Beatle', 1971); + assertEquals('VW Beatle Y: 1971', car.getFullName()); + }, + + testStopEngineWithCheck : function() { + var car = new Car('VW', 'Beatle', 1971); + assertEquals('engine was not running', car.stopEngineWithCheck()); + }, + + testCalculatePrice : function() { + var car = new Car('Volvo', 'XC70', 2012); + assertEquals('$30000', car.calculatePrice()); + } + +});
\ No newline at end of file diff --git a/it/it-projects/plugins/project/test/php/SomeTest.php b/it/it-projects/plugins/project/test/php/SomeTest.php new file mode 100644 index 00000000000..5f8b96d2160 --- /dev/null +++ b/it/it-projects/plugins/project/test/php/SomeTest.php @@ -0,0 +1,169 @@ +<?php +/** + * This file is part of phpUnderControl. + * + * Copyright (c) 2007-2009, Manuel Pichler <mapi@phpundercontrol.org>. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * * Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in + * the documentation and/or other materials provided with the + * distribution. + * + * * Neither the name of Manuel Pichler nor the names of his + * contributors may be used to endorse or promote products derived + * from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +require_once dirname(__FILE__) . '/../../src/php/Math.php'; + +/** + * Simple math test class. + * + * @package Example + * @author Manuel Pichler <mapi@phpundercontrol.org> + * @copyright 2007-2009 Manuel Pichler. All rights reserved. + * @license http://www.opensource.org/licenses/bsd-license.php BSD License + * @version Release: 0.5.0 + * @link http://www.phpundercontrol.org/ + */ +class PhpUnderControl_Example_MathTest extends PHPUnit_Framework_TestCase +{ + /** + * The used math object. + * + * @var PhpUnderControl_Example_Math $math + */ + protected $math = null; + + /** + * Creates a new {@link PhpUnderControl_Example_Math} object. + */ + public function setUp() + { + parent::setUp(); + + $this->math = new PhpUnderControl_Example_Math(); + } + + /** + * Successful test. + */ + public function testAddSuccess() + { + sleep(2); + $this->assertEquals(4, $this->math->add(1, 3)); + } + + /** + * Successful test. + */ + public function testSubSuccess() + { + $this->assertEquals( -2, $this->math->sub( 1, 3 ) ); + } + + /** + * Failing test. + */ + public function testSubFail() + { + sleep(2); + $this->assertEquals( 0, $this->math->sub( 2, 1 ) ); + } + + /** + * Test case with data provider. + * + * @dataProvider dataProviderOne + */ + public function testDataProviderOneWillFail( $x, $y ) + { + sleep(1); + $this->assertEquals( 1, $this->math->sub( $x, $y ) ); + } + + /** + * Test case with data provider. + * + * @dataProvider dataProviderTwo + */ + public function testDataProviderAllWillFail( $x, $y ) + { + $this->assertEquals( 1, $this->math->sub( $x, $y ) ); + } + + /** + * Failing test. + */ + public function testFail() + { + $this->fail('Failed because...'); + } + + /** + * Skipping test. + */ + public function testMarkSkip() + { + $this->markTestSkipped('Skipped because...'); + } + + /** + * Skipping test. + */ + public function testMarkIncomplete() + { + $this->markTestIncomplete('Incomplete because...'); + } + + /** + * Example data provider. + * + * @return array(array) + */ + public static function dataProviderOne() + { + return array( + array( 2, 1 ), + array( 3, 2 ), + array( 7, 1 ), + array( 9, 8 ), + ); + } + + /** + * Example data provider. + * + * @return array(array) + */ + public static function dataProviderTwo() + { + return array( + array( 17, 42 ), + array( 13, 23 ), + array( 42, 17 ), + array( 23, 13 ), + ); + } +} |