121 lines
8.8 KiB
HTML
121 lines
8.8 KiB
HTML
<?xml version="1.0" encoding="utf-8"?>
|
|
<!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" lang="en-US" xml:lang="en-us">
|
|
<head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
|
<meta name="dc.language" scheme="rfc1766" content="en-us" />
|
|
<!-- All rights reserved. Licensed Materials Property of IBM -->
|
|
<!-- US Government Users Restricted Rights -->
|
|
<!-- Use, duplication or disclosure restricted by -->
|
|
<!-- GSA ADP Schedule Contract with IBM Corp. -->
|
|
<meta name="dc.date" scheme="iso8601" content="2005-09-06" />
|
|
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
|
|
<meta name="security" content="public" />
|
|
<meta name="Robots" content="index,follow"/>
|
|
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
|
|
<title>COBOL positioning source code</title>
|
|
<link rel="stylesheet" type="text/css" href="ibmidwb.css" />
|
|
<link rel="stylesheet" type="text/css" href="ic.css" />
|
|
</head>
|
|
<body>
|
|
<a id="Top_Of_Page" name="Top_Of_Page"></a><!-- Java sync-link -->
|
|
<script language = "Javascript" src = "../rzahg/synch.js" type="text/javascript"></script>
|
|
|
|
|
|
<a name="rzaluuseddscobolsource"></a>
|
|
<h4 id="rzaluuseddscobolsource">COBOL positioning source code</h4>
|
|
<a name="wq252"></a>
|
|
<div class="notetitle" id="wq252">Note:</div>
|
|
<div class="notebody">Read the <a href="rzalucodedisclaimer.htm#rzalucodedisclaimer">Code disclaimer information</a> for important
|
|
legal information.</div>
|
|
<pre class="xmp">STMT SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..
|
|
IDENTFCN S COPYNAME CHG DATE
|
|
1 000100 IDENTIFICATION DIVISION. 10/20/91
|
|
2 000200 PROGRAM-ID. CBLLBL. 10/20/91
|
|
3 000300 ENVIRONMENT DIVISION. 10/20/91
|
|
4 000400 INPUT-OUTPUT SECTION. 10/20/91
|
|
5 000500 FILE-CONTROL. 10/20/91
|
|
6 000600 SELECT PRINTER-FILE 10/20/91
|
|
7 000700 ASSIGN TO FORMATFILE-LABELS. 10/23/91
|
|
8 000800 SELECT VENDOR-FILE 10/20/91
|
|
9 000900 ASSIGN TO DATABASE-VENDORS. 10/20/91
|
|
10 001000 DATA DIVISION. 10/20/91
|
|
11 001100 FILE SECTION. 10/20/91
|
|
12 001200 FD PRINTER-FILE 10/20/91
|
|
13 001300 DATA RECORD IS PRINT-REC. 10/23/91
|
|
14 001400 01 PRINT-REC. 10/23/91
|
|
15 001500 COPY DDS-ALL-FORMATS-O OF LABELS. 10/23/91
|
|
16 +000001 05 LABELS-RECORD PIC X(72). <-ALL-FMTS
|
|
+000002* OUTPUT FORMAT;LABEL FROM FILE LABELS OF LIBRARY SGAFP <-ALL-FMTS
|
|
+000003* <-ALL-FMTS
|
|
17 +000004 05 LABEL-O REDEFINES LABELS-RECORD. <-ALL-FMTS
|
|
18 +000005 06 NAME PIC X(25). <-ALL-FMTS
|
|
19 +000006 06 ADDR1 PIC X(25). <-ALL-FMTS
|
|
20 +000007 06 CITY PIC X(15). <-ALL-FMTS
|
|
21 +000008 06 STATE PIC X(2). <-ALL-FMTS
|
|
22 +000009 06 ZIPCD PIC S9(5). <-ALL-FMTS
|
|
23 001600 FD VENDOR-FILE 10/23/91
|
|
24 001700 DATA RECORD IS VENDOR-REC. 10/23/91
|
|
25 001800 01 VENDOR-REC. 10/23/91
|
|
26 001900 COPY DDS-ALL-FORMATS-I OF VENDORS. 10/23/91
|
|
27 +000001 05 VENDORS-RECORD PIC X(82). <-ALL-FMTS
|
|
+000002* I-O FORMAT;VNDMSTR FROM FILE VENDORS OF LIBRARY SGAFP <-ALL-FMTS
|
|
+000003* VENDMAST DB FORMAT <-ALL-FMTS
|
|
28 +000004 05 VNDMSTR REDEFINES VENDORS-RECORD. <-ALL-FMTS
|
|
29 +000005 06 VNDNBR PIC S9(5) COMP-3. <-ALL-FMTS
|
|
+000006* VENDOR NUMBER <-ALL-FMTS
|
|
30 +000007 06 NAME PIC X(25). <-ALL-FMTS
|
|
+000008* NAME <-ALL-FMTS
|
|
31 +000009 06 ADDR1 PIC X(25). <-ALL-FMTS
|
|
+000010* ADDRESS LINE 1 <-ALL-FMTS
|
|
32 +000011 06 CITY PIC X(15). <-ALL-FMTS
|
|
+000012* CITY <-ALL-FMTS
|
|
33 +000013 06 STATE PIC X(2). <-ALL-FMTS
|
|
+000014* STATE <-ALL-FMTS
|
|
34 +000015 06 ZIPCD PIC S9(5) COMP-3. <-ALL-FMTS
|
|
+000016* ZIP CODE <-ALL-FMTS
|
|
35 +000017 06 VNDCLS PIC S9(2) COMP-3. <-ALL-FMTS
|
|
+000018* VENDOR CLASS <-ALL-FMTS
|
|
36 +000019 06 VNDSTS PIC X(1). <-ALL-FMTS
|
|
+000020* A=ACTIVE, D=DELETE, S=SUSPEND <-ALL-FMTS
|
|
37 +000021 06 BALOWE PIC S9(7)V9(2) COMP-3. <-ALL-FMTS
|
|
+000022* BALANCE OWED <-ALL-FMTS
|
|
38 +000023 06 SRVRTG PIC X(1). <-ALL-FMTS
|
|
+000024* G=GOOD, A=AVERAGE, B=BAD, P=PREFERRED<-ALL-FMTS
|
|
39 002000 WORKING-STORAGE SECTION. 10/20/91
|
|
40 002100 77 EOF-FLAG PIC X. 10/23/91
|
|
41 002200 88 NOT-END-OF-FILE VALUE " ". 10/23/91
|
|
</pre>
|
|
<pre class="xmp">5738CB1 V2R1M0 910524
|
|
AS/400 COBOL Source SGAFP/CBLLBL RCHASA12 10/24/91 10:18:16 Page 3
|
|
STMT SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..
|
|
IDENTFCN S COPYNAME CHG DATE
|
|
42 002300 88 END-OF-FILE VALUE "1". 10/23/91
|
|
002400 10/23/91
|
|
43 002500 PROCEDURE DIVISION. 10/23/91
|
|
002600 MAIN-PARA. 10/23/91
|
|
44 002700 OPEN INPUT VENDOR-FILE 10/23/91
|
|
002800 OUTPUT PRINTER-FILE. 10/23/91
|
|
45 002900 PERFORM PRINT-LABELS UNTIL END-OF-FILE. 10/23/91
|
|
46 003000 CLOSE VENDOR-FILE, PRINTER-FILE. 10/23/91
|
|
003100 GOBACK. 10/23/91
|
|
003200 10/23/91
|
|
47 003300 PRINT-LABELS. 10/23/91
|
|
48 003400 READ VENDOR-FILE 10/23/91
|
|
49 003500 AT END SET END-OF-FILE TO TRUE. 10/23/91
|
|
50 003600 IF NOT-END-OF-FILE 10/23/91
|
|
51 003700 MOVE CORRESPONDING VNDMSTR TO LABEL-O 10/23/91
|
|
* ** CORRESPONDING items for statement 51:
|
|
* ** NAME
|
|
* ** ADDR1
|
|
* ** CITY
|
|
* ** STATE
|
|
* ** ZIPCD
|
|
* ** End of CORRESPONDING items for statement 51
|
|
52 003800 WRITE PRINT-REC FORMAT IS "LABEL". 10/23/91
|
|
* * * * * E N D O F S O U R C E * * * * *</pre>
|
|
<a id="Bot_Of_Page" name="Bot_Of_Page"></a>
|
|
</body>
|
|
</html>
|