This is the DISPLAY of a simple COBOL program.
This program is used in several examples of different
SVCommand functions.
The program reads input cards, does some calculations,
and prints a report. The program includes one COPY
member, which is expanded by the DISPLAY function.
SV RELEASE: C306M1C FUNCTION: WHERE
VBASE: O : ADPRBH1.ZEX.VBASE DATE: 06/14/2003
SYSLIB: O : ADPRBH1.ZEX.SOURCE TIME: 11:17
ALTLIB: N : *** NOT ALLOCATED *** EXEC: BACKGROUND
COPYLIB: O : ADPRBH1.ZEX.COPY TAPE: D00110
C2COPY: O : ADPRBH1.ZEX.COPY2 USERID: ADPRBH1H
P1PROC: O : ADPRBH1.ZEX.PROC
P2PROC: N : *** NOT ALLOCATED ***
JOBCNTL: O : ADPRBH1.ZEX.JOB
OUTLIB: O : ADPRBH1.ZEX.OUTLIB
PMHELP: N : *** NOT ALLOCATED ***
S1SCEN: N : *** NOT ALLOCATED ***
S2SCEN: N : *** NOT ALLOCATED ***
L1LOAD: I : ADPRBH1.ZEX.LOAD
L2LOAD: N : *** NOT ALLOCATED ***
@SV INPUT:
@SV.DISPLAY TITLE='DIS: DISPLAY.'
@SV MEM=E*
@SV ERR=GO,PMR=NO
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 1
EEEEEEEE M M PPPPPPP LL FFFFFFFF NN NN
EEEEEEEE MM MM PPPPPPPP LL FFFFFFFF NNN NN
EE MMM MMM PP PP LL FF NNNN NN
EEEEEEE MM MM MM PPPPPPP LL FFFFFFF NNNNN NN
EEEEEEE MM MM MM PPPPPP LL FFFFFFF NN NNNNN
EE MM MM PP LL FF NN NNNN
EEEEEEEE MM MM PP LLLLLLLL FF NN NNN
EEEEEEEE MM MM PP LLLLLLLL FF NN NN
SEQ DISPLAY OF EMPLFN FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
1 /* EMPLOYEE RECORDS */ 00010003 000001
2 EMPLFN: PROC OPTIONS(MAIN); /*EMPLOYEE UPDATE FUNCTION */ 00020003 000002
3 %INCLUDE EMPLDCL; /*DCL & DEFINE VARIABLES*/ 00030000 000003
4 C /* */ 00010000 000001 EMPLDCL
5 C /* DECLARE STATEMENTS AND VARIABLE DEFINITIONS FOR 'EMPLFN ' */ 00020000 000002 EMPLDCL
6 C /* */ 00030000 000003 EMPLDCL
7 C DCL ISPLINK EXTERNAL ENTRY OPTIONS(ASM INTER RETCODE) ; 00040000 000004 EMPLDCL
8 C DCL PLIRETV BUILTIN ; 00050000 000005 EMPLDCL
9 C DCL LENGTH BUILTIN ; 00060000 000006 EMPLDCL
10 C DCL RC FIXED BIN(31,0) INIT(0); 00070000 000007 EMPLDCL
11 C DCL EMPSER CHAR(6) INIT((6)' '); 00080000 000008 EMPLDCL
12 C DCL FNAME CHAR(16) INIT((16)' '); 00090000 000009 EMPLDCL
13 C DCL LNAME CHAR(16) INIT((16)' '); 00100000 000010 EMPLDCL
14 C DCL I CHAR(1) INIT(' '); 00110000 000011 EMPLDCL
15 C DCL ADDR1 CHAR(40) INIT((40)' '); 00120000 000012 EMPLDCL
16 C DCL ADDR2 CHAR(40) INIT((40)' '); 00130000 000013 EMPLDCL
17 C DCL ADDR3 CHAR(40) INIT((40)' '); 00140000 000014 EMPLDCL
18 C DCL ADDR4 CHAR(40) INIT((40)' '); 00150000 000015 EMPLDCL
19 C DCL PHA CHAR(3) INIT((3)' '); 00160000 000016 EMPLDCL
20 C DCL PHNUM CHAR(8) INIT((8)' '); 00170000 000017 EMPLDCL
21 C DCL MSG CHAR(8) INIT((8)' '); 00180000 000018 EMPLDCL
22 C DCL TYPECHG CHAR(1) INIT(' '); 00190000 000019 EMPLDCL
23 C DCL CHKTYPE CHAR(1) INIT(' '); 00200000 000020 EMPLDCL
24 C DCL STATE CHAR(1) INIT('1'); /*INITIAL ENTRY STATE */ 00210000 000021 EMPLDCL
25 C /* */ 00220000 000022 EMPLDCL
26 C /* LENGTH PARAMETER IN 'CALL ISPLINK VDEFINE' MUST BE FULL WORD. */ 00230000 000023 EMPLDCL
27 C /* */ 00240000 000024 EMPLDCL
28 C DCL LEMPSER FIXED BIN(31,0) ; 00250000 000025 EMPLDCL
29 C DCL LFNAME FIXED BIN(31,0) ; 00260000 000026 EMPLDCL
30 C DCL LLNAME FIXED BIN(31,0) ; 00270000 000027 EMPLDCL
31 C DCL LI FIXED BIN(31,0) ; 00280000 000028 EMPLDCL
32 C DCL LADDR1 FIXED BIN(31,0) ; 00290000 000029 EMPLDCL
33 C DCL LADDR2 FIXED BIN(31,0) ; 00300000 000030 EMPLDCL
34 C DCL LADDR3 FIXED BIN(31,0) ; 00310000 000031 EMPLDCL
35 C DCL LADDR4 FIXED BIN(31,0) ; 00320000 000032 EMPLDCL
36 C DCL LPHA FIXED BIN(31,0) ; 00330000 000033 EMPLDCL
37 C DCL LPHNUM FIXED BIN(31,0) ; 00340000 000034 EMPLDCL
38 C DCL LTYPECH FIXED BIN(31,0) ; 00350000 000035 EMPLDCL
39 C DCL LCHKTYP FIXED BIN(31,0) ; 00360000 000036 EMPLDCL
40 C LEMPSER = LENGTH(EMPSER) ; /*NOTE: */ 00370000 000037 EMPLDCL
41 C LFNAME = LENGTH(FNAME) ; /* LENGTH FUNCTION SHOULD */ 00380000 000038 EMPLDCL
42 C LLNAME = LENGTH(LNAME) ; /* NOT BE USED FOR */ 00390000 000039 EMPLDCL
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 2
SEQ DISPLAY OF EMPLFN FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
43 C LI = LENGTH(I) ; /* DETERMINING THE LENGTH */ 00400000 000040 EMPLDCL
44 C LADDR1 = LENGTH(ADDR1) ; /* OF FIXED FORMAT */ 00410000 000041 EMPLDCL
45 C LADDR2 = LENGTH(ADDR2) ; /* VARIABLES. */ 00420000 000042 EMPLDCL
46 C LADDR3 = LENGTH(ADDR3) ; 00430000 000043 EMPLDCL
47 C LADDR4 = LENGTH(ADDR4) ; 00440000 000044 EMPLDCL
48 C LPHA = LENGTH(PHA) ; 00450000 000045 EMPLDCL
49 C LPHNUM = LENGTH(PHNUM) ; 00460000 000046 EMPLDCL
50 C LTYPECH = LENGTH(TYPECHG) ; 00470000 000047 EMPLDCL
51 C LCHKTYP = LENGTH(CHKTYPE) ; 00480000 000048 EMPLDCL
52 C /* */ 00490000 000049 EMPLDCL
53 C 00500000 000050 EMPLDCL
54 C /*DEFINE VARIABLES FOR DIALOG SERVICE USE */ 00510000 000051 EMPLDCL
55 C CALL ISPLINK('VDEFINE ','(EMPSER)',EMPSER,'CHAR ',LEMPSER) ; 00520000 000052 EMPLDCL
56 C CALL ISPLINK('VDEFINE ','(FNAME)',FNAME,'CHAR ',LFNAME) ; 00530000 000053 EMPLDCL
57 C CALL ISPLINK('VDEFINE ','(LNAME)',LNAME,'CHAR ',LLNAME) ; 00540000 000054 EMPLDCL
58 C CALL ISPLINK('VDEFINE ','(I)',I,'CHAR ',LI) ; 00550000 000055 EMPLDCL
59 C CALL ISPLINK('VDEFINE ','(ADDR1)',ADDR1,'CHAR ',LADDR1) ; 00560000 000056 EMPLDCL
60 C CALL ISPLINK('VDEFINE ','(ADDR2)',ADDR2,'CHAR ',LADDR2) ; 00570000 000057 EMPLDCL
61 C CALL ISPLINK('VDEFINE ','(ADDR3)',ADDR3,'CHAR ',LADDR3) ; 00580000 000058 EMPLDCL
62 C CALL ISPLINK('VDEFINE ','(ADDR4)',ADDR4,'CHAR ',LADDR4) ; 00590000 000059 EMPLDCL
63 C CALL ISPLINK('VDEFINE ','(PHA)',PHA,'CHAR ',LPHA) ; 00600000 000060 EMPLDCL
64 C CALL ISPLINK('VDEFINE ','(PHNUM)',PHNUM,'CHAR ',LPHNUM) ; 00610000 000061 EMPLDCL
65 C CALL ISPLINK('VDEFINE ','(TYPECHG)',TYPECHG,'CHAR ',LTYPECH); 00620000 000062 EMPLDCL
66 C CALL ISPLINK('VDEFINE ','(CHKTYPE)',CHKTYPE,'CHAR ',LCHKTYP); 00630000 000063 EMPLDCL
67 C /* */ 00640000 000064 EMPLDCL
68 C 00650000 000065 EMPLDCL
69 MSG = ' '; /*INITIALIZE MESSAGE */ 00040000 000069
70 CALL ISPLINK('TBOPEN ', 'EMPLTBL '); /*OPEN TABLE */ 00050000 000070
71 IF PLIRETV() ^= 0 THEN /*IF TABLE DOESN'T EXIST*/ 00060001 000071
72 CALL ISPLINK('TBCREATE', 'EMPLTBL ', '(EMPSER)', /*CREATE IT */ 00070000 000072
73 '(LNAME FNAME I ADDR1 ADDR2 ADDR3 ADDR4 PHA PHNUM)' ); 00080000 000073
74 DO WHILE (STATE ^= '4'); /*LOOP UNTIL TERM SET */ 00090001 000074
75 CALL ISPLINK('DISPLAY ', 'EMPLA ', MSG); /*SELECT EMPLOYEE */ 00100000 000075
76 IF PLIRETV() = 8 THEN /*IF END KEY PRESSED */ 00110000 000076
77 STATE = '4'; /* TERMINATE */ 00120000 000077
78 ELSE DO; /*ENTER KEY PRESSED */ 00130000 000078
79 MSG = ' ' ; /*RESET MESSAGE */ 00140000 000079
80 STATE = '2'; /*PROCESS EMPLOYEE PANEL*/ 00150000 000080
81 CALL ISPLINK('TBGET ', 'EMPLTBL '); /*OBTAIN EMPLOYEE DATA */ 00160000 000081
82 IF PLIRETV() = 0 THEN /*IF RECORD EXISTS */ 00170000 000082
83 TYPECHG ='U'; /* SET UPDATE FLAG */ 00180000 000083
84 ELSE DO; /*RECORD DOES NOT EXIST */ 00190000 000084
85 TYPECHG = 'N' ; /* SET TYPE = NEW */ 00200000 000085
86 LNAME = ' ' ; 00210003 000086
87 FNAME = ' ' ; /* INITIALIZE */ 00220000 000087
88 I = ' ' ; /* PANEL */ 00230000 000088
89 ADDR1 = ' ' ; /* VARIABLES */ 00240000 000089
90 ADDR2 = ' ' ; /* TO NULLS */ 00250000 000090
91 ADDR3 = ' ' ; 00260003 000091
92 ADDR4 = ' ' ; 00270003 000092
93 PHA = ' ' ; 00280003 000093
94 PHNUM = ' ' ; 00290003 000094
95 END; 00300003 000095
96 CHKTYPE = TYPECHG; /*SAVE TYPE OF CHANGE */ 00310000 000096
97 CALL ISPLINK('DISPLAY ', 'EMPLB '); /*DISPLAY EMPLOYEE DATA */ 00320000 000097
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 3
SEQ DISPLAY OF EMPLFN FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
98 00330000 000098
99 00340000 000099
100 IF PLIRETV() ^= 8 THEN DO; /*END KEY NOT PRESSED */ 00350001 000100
101 IF TYPECHG = 'N' THEN DO; /*IF NEW EMPLOYEE */ 00360000 000101
102 CALL ISPLINK('TBADD ', 'EMPLTBL '); /* ADD TO TABLE */ 00370000 000102
103 MSG = 'EMPX217 '; /*EMPLOYEE ADDED MESSAGE*/ 00380000 000103
104 END; 00390003 000104
105 ELSE DO; /* */ 00400000 000105
106 IF TYPECHG = 'U' THEN DO; /*IF UPDATE REQUESTED */ 00410000 000106
107 CALL ISPLINK('TBPUT ', 'EMPLTBL '); /* UPDATE TABLE */ 00420000 000107
108 MSG = 'EMPX218 '; /* UPDATE MESSAGE */ 00430000 000108
109 END; 00440003 000109
110 ELSE DO; /*ELSE ASSUME DELETE */ 00450000 000110
111 CALL ISPLINK('TBDELETE', 'EMPLTBL '); 00460000 000111
112 MSG = 'EMPX219 ' ; /*EMPLOYEE DELETED MSG */ 00470000 000112
113 END; 00480003 000113
114 END; /*END TABLE MODS */ 00490003 000114
115 END; /*END 2ND PANEL PROCESS */ 00500003 000115
116 END; /*END 1ST PANEL PROCESS */ 00510003 000116
117 IF MSG ^= ' ' THEN CALL ISPLINK('LOG ', MSG); /*LOG MSG */ 00520003 000117
118 END; /*END DO LOOP */ 00530003 000118
119 CALL ISPLINK('TBCLOSE ', 'EMPLTBL '); /*CLOSE TABLE */ 00540000 000119
120 %INCLUDE EMPLDEL; /*DELETE DEFINED VARS */ 00550003 000120
121 C /* */ 00010000 000001 EMPLDEL
122 C /* DELETE VARIABLE DEFINITIONS FOR 'EMPLFN ' */ 00020000 000002 EMPLDEL
123 C /* */ 00030000 000003 EMPLDEL
124 C CALL ISPLINK('VDELETE ','(EMPSER)'); 00040000 000004 EMPLDEL
125 C CALL ISPLINK('VDELETE ','(FNAME)') ; 00050000 000005 EMPLDEL
126 C CALL ISPLINK('VDELETE ','(LNAME)') ; 00060000 000006 EMPLDEL
127 C CALL ISPLINK('VDELETE ','(I)') ; 00070000 000007 EMPLDEL
128 C CALL ISPLINK('VDELETE ','(ADDR1)') ; 00080000 000008 EMPLDEL
129 C CALL ISPLINK('VDELETE ','(ADDR2)') ; 00090000 000009 EMPLDEL
130 C CALL ISPLINK('VDELETE ','(ADDR3)') ; 00100000 000010 EMPLDEL
131 C CALL ISPLINK('VDELETE ','(ADDR4)') ; 00110000 000011 EMPLDEL
132 C CALL ISPLINK('VDELETE ','(PHA)') ; 00120000 000012 EMPLDEL
133 C CALL ISPLINK('VDELETE ','(PHNUM)') ; 00130000 000013 EMPLDEL
134 C CALL ISPLINK('VDELETE ','(TYPECHG)'); 00140000 000014 EMPLDEL
135 C CALL ISPLINK('VDELETE ','(CHKTYPE)'); 00150000 000015 EMPLDEL
136 C /* */ 00160000 000016 EMPLDEL
137 C 00170000 000017 EMPLDEL
138 RETURN(0); 00560003 000138
139 END EMPLFN; 00570003 000139
DISPLAY END: EMPLFN
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 1
EEEEEEEE UU UU RRRRRRR OOOOOO CCCCCC UU UU RRRRRRR
EEEEEEEE UU UU RRRRRRRR OOOOOOOO CCCCCCCC UU UU RRRRRRRR
EE UU UU RR RR OO OO CC CC UU UU RR RR
EEEEEEE UU UU RRRRRRR OO OO CC UU UU RRRRRRR
EEEEEEE UU UU RRRRRR OO OO CC UU UU RRRRRR
EE UU UU RR RR OO OO CC CC UU UU RR RR
EEEEEEEE UUUUUUUU RR RR OOOOOOOO CCCCCCCC UUUUUUUU RR RR
EEEEEEEE UUUU RR RR OOOOOO CCCCCC UUUU RR RR
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
1 IDENTIFICATION DIVISION. 00010000 000001
2 PROGRAM-ID. EUROCUR. 00020000 000002
3 AUTHOR. ADPAC CORPORATION. 00030000 000003
4 DATE-WRITTEN. 00040000 000004
5 THE 28TH DAY OF DECEMBER, 1998. 00050000 000005
6 DATE-COMPILED. 00060000 000006
7 REMARKS. WITHOUT COBOL, LIFE ITSELF WOULD BE IMPOSSIBLE! 00070000 000007
8 00080000 000008
9 * THIS IS A SIMPLE SAMPLE OF A COBOL PROGRAM THAT TRIES 00090000 000009
10 * TO DO EURO-CURRENCY CONVERSION PROCESSING. 00100000 000010
11 00110000 000011
12 ENVIRONMENT DIVISION. 00120000 000012
13 CONFIGURATION SECTION. 00130000 000013
14 SOURCE-COMPUTER. IBM-370. 00140000 000014
15 OBJECT-COMPUTER. IBM-370. 00150000 000015
16 INPUT-OUTPUT SECTION. 00160000 000016
17 FILE-CONTROL. 00170000 000017
18 SELECT INPUT-FILE ASSIGN TO UT-S-INPUT. 00180000 000018
19 SELECT REPORT-FILE ASSIGN TO UT-S-PRINTER. 00190000 000019
20 00200000 000020
21 DATA DIVISION. 00210000 000021
22 FILE SECTION. 00220000 000022
23 00230000 000023
24 FD INPUT-FILE 00240000 000024
25 RECORDING MODE IS F 00250000 000025
26 RECORD CONTAINS 80 CHARACTERS 00260000 000026
27 BLOCK CONTAINS 0 RECORDS 00270000 000027
28 LABEL RECORDS ARE STANDARD 00280000 000028
29 DATA RECORD IS INPUT-RECORD. 00290000 000029
30 01 INPUT-RECORD. 00300000 000030
31 05 INPUT-COMMENT PIC X(01). 00310000 000031
32 05 INPUT-COUNTRY-NAME PIC X(20). 00320000 000032
33 05 INPUT-CURRENCY-CODE PIC X(02). 00330000 000033
34 05 FILLER PIC X(01). 00340000 000034
35 05 INPUT-CURRENCY-NAME PIC X(10). 00350000 000035
36 05 INPUT-CURRENCY-IN-DOLLAR PIC 9(6)V9(6). 00360000 000036
37 05 FILLER PIC X(01). 00370000 000037
38 05 INPUT-DOLLAR-IN-CURRENCY PIC 9(6)V9(6). 00380000 000038
39 05 FILLER PIC X(21). 00390000 000039
40 00400000 000040
41 FD REPORT-FILE 00410000 000041
42 RECORDING MODE IS F 00420000 000042
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 2
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
43 RECORD CONTAINS 133 CHARACTERS 00430000 000043
44 DATA RECORD IS PRINT-RECORD. 00440000 000044
45 01 PRINT-RECORD. 00450000 000045
46 05 FILLER PIC X(133). 00460000 000046
47 00470000 000047
48 WORKING-STORAGE SECTION. 00480000 000048
49 * DATE & TIME FIELDS. 00490000 000049
50 * SYSTEM DATE: YYMMDD. 00500000 000050
51 01 SYSTEM-DATE. 00510000 000051
52 05 DATE-FIELDS. 00520000 000052
53 07 YEAR PIC 99. 00530000 000053
54 07 MONTH PIC 99. 00540000 000054
55 07 DEY PIC 99. 00550000 000055
56 * FORMATTED DATE: MM-DD-YY. 00560000 000056
57 01 FORMATTED-SYSTEM-DATE. 00570000 000057
58 05 DATE-FIELDS. 00580000 000058
59 07 MONTH PIC 99. 00590000 000059
60 07 DASH-1 PIC X VALUE '-'. 00600000 000060
61 07 DEY PIC 99. 00610000 000061
62 07 DASH-2 PIC X VALUE '-'. 00620000 000062
63 07 YEAR PIC 99. 00630000 000063
64 00640000 000064
65 * SYSTEM TIME: HHMMSSHH. 00650000 000065
66 01 SYSTEM-TIME. 00660000 000066
67 05 TIME-FIELDS. 00670000 000067
68 07 HOURS PIC 99. 00680000 000068
69 07 MINUTES PIC 99. 00690000 000069
70 07 SECONDS PIC 99. 00700000 000070
71 05 UNTIME-FIELDS. 00710000 000071
72 07 HUNDREDTHS-OF-SECONDS PIC 99. 00720000 000072
73 * FORMATTED TIME: HH:MM:SS. 00730000 000073
74 01 FORMATTED-SYSTEM-TIME. 00740000 000074
75 05 TIME-FIELDS. 00750000 000075
76 07 HOURS PIC 99. 00760000 000076
77 07 FILLER PIC X VALUE ':'. 00770000 000077
78 07 MINUTES PIC 99. 00780000 000078
79 07 FILLER PIC X VALUE ':'. 00790000 000079
80 07 SECONDS PIC 99. 00800000 000080
81 00810000 000081
82 *---1----+----2----+----3----+----4----+----5----+----6--`-+----7 00820000 000082
83 *99 16:35:58 FOREIGN MOOLA 00830000 000083
84 00840000 000084
85 * COMPILED: 12/45/78 PAGE 1. 00850000 000085
86 *7----+----8----+----9----+----0----+----1----+----2----+----3--. 00860000 000086
87 01 HEADINGS. 00870000 000087
88 03 HD1. 00880000 000088
89 05 HD1-DATE PIC X(08) VALUE ' '. 00890000 000089
90 05 FILLER PIC X(02) VALUE SPACES. 00900000 000090
91 05 HD1-TIME PIC X(08) VALUE ' '. 00910000 000091
92 05 FILLER PIC X(34) VALUE SPACES. 00920000 000092
93 05 FILLER PIC X(13) VALUE 'FOREIGN MOOLA'. 00930000 000093
94 05 FILLER PIC X(39) VALUE SPACES. 00940000 000094
95 05 FILLER PIC X(10) VALUE 'COMPILED:'. 00950000 000095
96 05 HD1-COMPILED PIC X(08) VALUE '12/45/78'. 00960000 000096
97 05 FILLER PIC X(02) VALUE SPACES. 00970000 000097
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 3
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
98 05 FILLER PIC X(05) VALUE 'PAGE '. 00980000 000098
99 05 HD1-PAGE PIC Z9. 00990000 000099
100 05 FILLER PIC X(01) VALUE '.'. 01000000 000100
101 *---1----+----2----+----3----+----4----+----5----+----6--`-+----7 01010000 000101
102 * FOREIGN CURRENCY DOLLARS IN . 01020000 000102
103 *Y CURRENCY IN DOLLARS FOREIGN CURREN. 01030000 000103
104 *--------- ---------- ---------------- --------------. 01040000 000104
105 * 654321.123456 01050000 000105
106 01060000 000106
107 * FOREIGN CURRENCY EUROS IN . 01070000 000107
108 *CY IN EUROS FOREIGN CURRENCY . 01080000 000108
109 *--- ---------------- ---------------- . 01090000 000109
110 *7----+----8----+----9----+----0----+----1----+----2----+----3--. 01100000 000110
111 03 HD2. 01110000 000111
112 05 FILLER PIC X(37) VALUE SPACES. 01120000 000112
113 05 FILLER PIC X(16) VALUE 'FOREIGN CURRENCY'.01130000 000113
114 05 FILLER PIC X(03) VALUE SPACES. 01140000 000114
115 05 FILLER PIC X(16) VALUE ' DOLLARS IN'. 01150000 000115
116 05 FILLER PIC X(13) VALUE SPACES. 01160000 000116
117 05 FILLER PIC X(16) VALUE 'FOREIGN CURRENCY'.01170000 000117
118 05 FILLER PIC X(03) VALUE SPACES. 01180000 000118
119 05 FILLER PIC X(16) VALUE ' EUROS IN'. 01190000 000119
120 05 FILLER PIC X(11) VALUE SPACES. 01200000 000120
121 05 FILLER PIC X(01) VALUE '.'. 01210000 000121
122 03 HD3. 01220000 000122
123 05 FILLER PIC X(17) VALUE 'COUNTRY'. 01230000 000123
124 05 FILLER PIC X(02) VALUE 'CD'. 01240000 000124
125 05 FILLER PIC X(01) VALUE SPACES. 01250000 000125
126 05 FILLER PIC X(10) VALUE 'CURRENCY'. 01260000 000126
127 05 FILLER PIC X(07) VALUE SPACES. 01270000 000127
128 05 FILLER PIC X(16) VALUE ' IN DOLLARS'. 01280000 000128
129 05 FILLER PIC X(03) VALUE SPACES. 01290000 000129
130 05 FILLER PIC X(16) VALUE 'FOREIGN CURRENCY'.01300000 000130
131 05 FILLER PIC X(13) VALUE SPACES. 01310000 000131
132 05 FILLER PIC X(16) VALUE ' IN EUROS'. 01320000 000132
133 05 FILLER PIC X(03) VALUE SPACES. 01330000 000133
134 05 FILLER PIC X(16) VALUE 'FOREIGN CURRENCY'.01340000 000134
135 05 FILLER PIC X(11) VALUE SPACES. 01350000 000135
136 05 FILLER PIC X(01) VALUE '.'. 01360000 000136
137 03 HD4. 01370000 000137
138 05 FILLER PIC X(17) VALUE '----------------'.01380000 000138
139 05 FILLER PIC X(02) VALUE '--'. 01390000 000139
140 05 FILLER PIC X(01) VALUE SPACES. 01400000 000140
141 05 FILLER PIC X(10) VALUE '----------'. 01410000 000141
142 05 FILLER PIC X(07) VALUE SPACES. 01420000 000142
143 05 FILLER PIC X(16) VALUE '----------------'.01430000 000143
144 05 FILLER PIC X(03) VALUE SPACES. 01440000 000144
145 05 FILLER PIC X(16) VALUE '----------------'.01450000 000145
146 05 FILLER PIC X(13) VALUE SPACES. 01460000 000146
147 05 FILLER PIC X(16) VALUE '----------------'.01470000 000147
148 05 FILLER PIC X(03) VALUE SPACES. 01480000 000148
149 05 FILLER PIC X(16) VALUE '----------------'.01490000 000149
150 05 FILLER PIC X(11) VALUE SPACES. 01500000 000150
151 05 FILLER PIC X(01) VALUE '.'. 01510000 000151
152 * 01520000 000152
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 4
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
153 03 D-TAIL. 01530000 000153
154 05 REPORT-COUNTRY-NAME PIC X(16) VALUE SPACES. 01540000 000154
155 05 FILLER PIC X(01) VALUE SPACES. 01550000 000155
156 05 REPORT-CURRENCY-CODE PIC X(02) VALUE SPACES. 01560000 000156
157 05 FILLER PIC X(01) VALUE SPACES. 01570000 000157
158 05 REPORT-CURRENCY-NAME PIC X(10) VALUE SPACES. 01580000 000158
159 05 FILLER PIC X(07) VALUE SPACES. 01590000 000159
160 05 FILLER PIC X(02) VALUE SPACES. 01600000 000160
161 05 REPORT-CURRENCY-IN-DOLLAR PIC Z(6).9(6). 01610000 000161
162 05 FILLER PIC X(01) VALUE SPACES. 01620000 000162
163 05 FILLER PIC X(03) VALUE SPACES. 01630000 000163
164 05 FILLER PIC X(02) VALUE SPACES. 01640000 000164
165 05 REPORT-DOLLAR-IN-CURRENCY PIC Z(6).9(6). 01650000 000165
166 05 FILLER PIC X(01) VALUE SPACES. 01660000 000166
167 05 FILLER PIC X(13) VALUE SPACES. 01670000 000167
168 05 FILLER PIC X(02) VALUE SPACES. 01680000 000168
169 05 REPORT-CURRENCY-IN-EUROS PIC Z(6).9(6). 01690000 000169
170 05 FILLER PIC X(01) VALUE SPACES. 01700000 000170
171 05 FILLER PIC X(03) VALUE SPACES. 01710000 000171
172 05 FILLER PIC X(02) VALUE SPACES. 01720000 000172
173 05 REPORT-EUROS-IN-CURRENCY PIC Z(6).9(6). 01730000 000173
174 05 FILLER PIC X(01) VALUE SPACES. 01740000 000174
175 05 FILLER PIC X(11) VALUE SPACES. 01750000 000175
176 05 FILLER PIC X(01) VALUE '.'. 01760000 000176
177 01770000 000177
178 COPY ECRATEC. 1780000 000178
179 C * >>>>>>>> ECRATEC >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 00010000 000001 ECRATEC
180 C 01 TABLE-OF-EXCHANGE-RATES. 00020000 000002 ECRATEC
181 C 03 TABLE-CODES. 00030000 000003 ECRATEC
182 C 05 FILLER PIC X(2) VALUE 'AS'. 00040000 000004 ECRATEC
183 C 05 FILLER PIC X(2) VALUE 'AU'. 00050000 000005 ECRATEC
184 C 05 FILLER PIC X(2) VALUE 'BE'. 00060000 000006 ECRATEC
185 C 05 FILLER PIC X(2) VALUE 'BR'. 00070000 000007 ECRATEC
186 C 05 FILLER PIC X(2) VALUE 'CA'. 00080000 000008 ECRATEC
187 C 05 FILLER PIC X(2) VALUE 'DE'. 00090000 000009 ECRATEC
188 C 05 FILLER PIC X(2) VALUE 'EU'. 00100000 000010 ECRATEC
189 C 05 FILLER PIC X(2) VALUE 'FI'. 00110000 000011 ECRATEC
190 C 05 FILLER PIC X(2) VALUE 'FR'. 00120000 000012 ECRATEC
191 C 05 FILLER PIC X(2) VALUE 'GE'. 00130000 000013 ECRATEC
192 C 05 FILLER PIC X(2) VALUE 'GR'. 00140000 000014 ECRATEC
193 C 05 FILLER PIC X(2) VALUE 'IR'. 00150000 000015 ECRATEC
194 C 05 FILLER PIC X(2) VALUE 'IT'. 00160000 000016 ECRATEC
195 C 05 FILLER PIC X(2) VALUE 'KO'. 00170000 000017 ECRATEC
196 C 05 FILLER PIC X(2) VALUE 'LX'. 00180000 000018 ECRATEC
197 C 05 FILLER PIC X(2) VALUE 'ME'. 00190000 000019 ECRATEC
198 C 05 FILLER PIC X(2) VALUE 'NE'. 00200000 000020 ECRATEC
199 C 05 FILLER PIC X(2) VALUE 'NO'. 00210000 000021 ECRATEC
200 C 05 FILLER PIC X(2) VALUE 'NZ'. 00220000 000022 ECRATEC
201 C 05 FILLER PIC X(2) VALUE 'PO'. 00230000 000023 ECRATEC
202 C 05 FILLER PIC X(2) VALUE 'PR'. 00240000 000024 ECRATEC
203 C 05 FILLER PIC X(2) VALUE 'SP'. 00250000 000025 ECRATEC
204 C 05 FILLER PIC X(2) VALUE 'SW'. 00260000 000026 ECRATEC
205 C 05 FILLER PIC X(2) VALUE 'SZ'. 00270000 000027 ECRATEC
206 C 05 FILLER PIC X(2) VALUE 'TA'. 00280000 000028 ECRATEC
207 C 05 FILLER PIC X(2) VALUE 'UK'. 00290000 000029 ECRATEC
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 5
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
208 C 05 FILLER PIC X(2) VALUE 'US'. 00300000 000030 ECRATEC
209 C 03 TABLE-FACTORS. 00310000 000031 ECRATEC
210 C 05 FILLER PIC 9(4)V9(6) VALUE 1.76635. 00320000 000032 ECRATEC
211 C 05 FILLER PIC 9(4)V9(6) VALUE 13.7603. 00330000 000033 ECRATEC
212 C 05 FILLER PIC 9(4)V9(6) VALUE 40.3399. 00340000 000034 ECRATEC
213 C 05 FILLER PIC 9(4)V9(6) VALUE 1.27972. 00350000 000035 ECRATEC
214 C 05 FILLER PIC 9(4)V9(6) VALUE 1.62747. 00360000 000036 ECRATEC
215 C 05 FILLER PIC 9(4)V9(6) VALUE 7.53931. 00370000 000037 ECRATEC
216 C 05 FILLER PIC 9(4)V9(6) VALUE 1.00000. 00380000 000038 ECRATEC
217 C 05 FILLER PIC 9(4)V9(6) VALUE 5.94573. 00390000 000039 ECRATEC
218 C 05 FILLER PIC 9(4)V9(6) VALUE 6.55957. 00400000 000040 ECRATEC
219 C 05 FILLER PIC 9(4)V9(6) VALUE 1.95583. 00410000 000041 ECRATEC
220 C 05 FILLER PIC 9(4)V9(6) VALUE 328.359. 00420000 000042 ECRATEC
221 C 05 FILLER PIC 9(4)V9(6) VALUE .787564. 00430000 000043 ECRATEC
222 C 05 FILLER PIC 9(4)V9(6) VALUE 1936.27. 00440000 000044 ECRATEC
223 C 05 FILLER PIC 9(4)V9(6) VALUE 1544.96. 00450000 000045 ECRATEC
224 C 05 FILLER PIC 9(4)V9(6) VALUE 40.8800. 00460000 000046 ECRATEC
225 C 05 FILLER PIC 9(4)V9(6) VALUE 9.84235. 00470000 000047 ECRATEC
226 C 05 FILLER PIC 9(4)V9(6) VALUE 2.20371. 00480000 000048 ECRATEC
227 C 05 FILLER PIC 9(4)V9(6) VALUE 8.37049. 00490000 000049 ECRATEC
228 C 05 FILLER PIC 9(4)V9(6) VALUE 2.09041. 00500000 000050 ECRATEC
229 C 05 FILLER PIC 9(4)V9(6) VALUE 202.385. 00510000 000051 ECRATEC
230 C 05 FILLER PIC 9(4)V9(6) VALUE 200.482. 00520000 000052 ECRATEC
231 C 05 FILLER PIC 9(4)V9(6) VALUE 166.386. 00530000 000053 ECRATEC
232 C 05 FILLER PIC 9(4)V9(6) VALUE 8.77306. 00540000 000054 ECRATEC
233 C 05 FILLER PIC 9(4)V9(6) VALUE 1.65461. 00550000 000055 ECRATEC
234 C 05 FILLER PIC 9(4)V9(6) VALUE 37.7768. 00560000 000056 ECRATEC
235 C 05 FILLER PIC 9(4)V9(6) VALUE .661787. 00570000 000057 ECRATEC
236 C 05 FILLER PIC 9(4)V9(6) VALUE 1.10750. 00580000 000058 ECRATEC
237 C 00590000 000059 ECRATEC
238 C 01 TBL-OF-EXCHANGE-RATES REDEFINES TABLE-OF-EXCHANGE-RATES. 00600000 000060 ECRATEC
239 C 03 TBL-CODE PIC X(2) OCCURS 27 TIMES 00610000 000061 ECRATEC
240 C INDEXED BY CD-CNT. 00620000 000062 ECRATEC
241 C 03 TBL-FACTOR PIC 9(4)V9(6) OCCURS 27 TIMES 00630000 000063 ECRATEC
242 C INDEXED BY CD-CNT. 00640000 000064 ECRATEC
243 C * <<<<<<<< ECRATEC <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 00650000 000065 ECRATEC
244 01790000 000244
245 01 STUFF. 01800000 000245
246 03 SWITCHES. 01810000 000246
247 05 EOF-SWITCH PIC X(1) VALUE 'E'. 01820000 000247
248 05 FILE-STATUS PIC X(1) VALUE ' '. 01830000 000248
249 88 ITS-END-OF-FILE VALUE 'E'. 01840000 000249
250 05 K-01 PIC 9(1)V9(4) VALUE .01. 01850000 000250
251 05 K-02 PIC 9(1)V9(4) VALUE .02. 01860000 000251
252 01870000 000252
253 03 HEADING-STUFF. 01880000 000253
254 05 PAGE-LENGTH PIC 9(2) VALUE 60. 01890000 000254
255 05 PAGE-NUMBER PIC 9(2) VALUE 0. 01900000 000255
256 05 LINE-NUMBER PIC 9(4) VALUE 999. 01910000 000256
257 01920000 000257
258 03 EURO-WORK-AREAS. 01930000 000258
259 05 EC-WORK PIC 9(6)V9(6) COMP-3. 01940000 000259
260 05 EC-ROUND PIC 9(6)V9(6) COMP-3. 01950000 000260
261 01960000 000261
262 PROCEDURE DIVISION. 01970000 000262
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 6
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
263 * SETUP DATE & TIME. 01980000 000263
264 ACCEPT SYSTEM-DATE FROM DATE. 01990000 000264
265 MOVE CORRESPONDING 02000000 000265
266 DATE-FIELDS OF SYSTEM-DATE TO 02010000 000266
267 DATE-FIELDS OF FORMATTED-SYSTEM-DATE. 02020000 000267
268 MOVE FORMATTED-SYSTEM-DATE TO HD1-DATE. 02030000 000268
269 MOVE '-' TO DASH-1, DASH-2. 02040000 000269
270 02050000 000270
271 ACCEPT SYSTEM-TIME FROM TIME. 02060000 000271
272 MOVE CORRESPONDING 02070000 000272
273 TIME-FIELDS OF SYSTEM-TIME TO 02080000 000273
274 TIME-FIELDS OF FORMATTED-SYSTEM-TIME. 02090000 000274
275 MOVE FORMATTED-SYSTEM-TIME TO HD1-TIME. 02100000 000275
276 MOVE WHEN-COMPILED TO HD1-COMPILED. 02110000 000276
277 02120000 000277
278 * INITIALIZE REPORT FIELDS. 02130000 000278
279 MOVE K-01 TO EC-WORK. 02140000 000279
280 MOVE K-02 TO EC-ROUND. 02150000 000280
281 02160000 000281
282 OPEN INPUT INPUT-FILE 02170000 000282
283 OUTPUT REPORT-FILE. 02180000 000283
284 02190000 000284
285 PERFORM PRINT-REPORT 02200000 000285
286 UNTIL ITS-END-OF-FILE. 02210000 000286
287 02220000 000287
288 CLOSE INPUT-FILE REPORT-FILE. 02230000 000288
289 02240000 000289
290 GOBACK. 02250000 000290
291 02260000 000291
292 PRINT-REPORT. 02270000 000292
293 READ INPUT-FILE 02280000 000293
294 AT END 02290000 000294
295 MOVE EOF-SWITCH TO FILE-STATUS. 02300000 000295
296 IF INPUT-COMMENT NOT = '*' 02310000 000296
297 IF ITS-END-OF-FILE 02320000 000297
298 NEXT SENTENCE 02330000 000298
299 ELSE 02340000 000299
300 PERFORM PRINT-DETAIL-LINE. 02350000 000300
301 02360000 000301
302 PRINT-DETAIL-LINE. 02370000 000302
303 IF LINE-NUMBER IS GREATER THAN PAGE-LENGTH 02380000 000303
304 PERFORM PRINT-HEADING. 02390000 000304
305 PERFORM MOVE-AND-PRINT. 02400000 000305
306 02410000 000306
DISPLAY DIS: DISPLAY. ADPAC, USE BY AGREEMENT ONLY 06/14/2003 PAGE 7
SEQ DISPLAY OF EUROCUR FROM LIBRARY:ADPRBH1.ZEX.SOURCE SOURCE COPY
NUMBER 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80 LINENO MEMBER
308 MOVE-AND-PRINT. 02430000 000308
309 MOVE INPUT-COUNTRY-NAME TO REPORT-COUNTRY-NAME. 02440000 000309
310 MOVE INPUT-CURRENCY-CODE TO REPORT-CURRENCY-CODE. 02450000 000310
311 MOVE INPUT-CURRENCY-NAME TO REPORT-CURRENCY-NAME. 02460000 000311
312 02470000 000312
313 MOVE INPUT-CURRENCY-IN-DOLLAR TO REPORT-CURRENCY-IN-DOLLAR. 02480000 000313
314 MOVE INPUT-DOLLAR-IN-CURRENCY TO REPORT-DOLLAR-IN-CURRENCY. 02490000 000314
315 02500000 000315
316 MOVE EC-WORK TO REPORT-CURRENCY-IN-EUROS. 02510000 000316
317 MOVE EC-ROUND TO REPORT-EUROS-IN-CURRENCY. 02520000 000317
318 02530000 000318
319 WRITE PRINT-RECORD FROM D-TAIL. 02540000 000319
320 ADD 1 TO LINE-NUMBER. 02550000 000320
321 02560000 000321
322 PRINT-HEADING. 02570000 000322
323 ADD 1 TO PAGE-NUMBER. 02580000 000323
324 MOVE PAGE-NUMBER TO HD1-PAGE. 02590000 000324
325 MOVE 0 TO LINE-NUMBER. 02600000 000325
326 WRITE PRINT-RECORD FROM HD1. ADD 1 TO LINE-NUMBER. 02610000 000326
327 MOVE SPACES TO PRINT-RECORD. 02620000 000327
328 WRITE PRINT-RECORD. ADD 1 TO LINE-NUMBER. 02630000 000328
329 WRITE PRINT-RECORD FROM HD2. ADD 1 TO LINE-NUMBER. 02640000 000329
330 WRITE PRINT-RECORD FROM HD3. ADD 1 TO LINE-NUMBER. 02650000 000330
331 WRITE PRINT-RECORD FROM HD4. ADD 1 TO LINE-NUMBER. 02660000 000331
332 MOVE SPACES TO PRINT-RECORD. 02670000 000332
333 02680000 000333
DISPLAY END: EUROCUR
LINE COUNTS: 267=SOURCE 39=COMMENT 35=BLANK 131=COPY/INC 472=TOTAL
1
START: EMPLFN
START: EUROCUR
PM@000-10 NORMAL EOJ CPU HRS:00 MIN:00 SEC:01.65
--------------------