Smart/400开发上手3: 练习实践
练习题
- 在2006年1月1日之前入职且在职的营销员，给予年资补贴2000元；
- 符合以上条件的，再按以下标准一次性发放职级补贴：
|
职级代码 |
简称 |
补偿金额 |
|
A1 |
AD |
6000 |
|
B1 |
SBM |
5000 |
|
C1 |
BM |
4000 |
|
其他职级 |
2000 |
要求：
新增一FILE记录此类奖金的发放明细，要求记录公司号、分支号、营销员代码、职级、年资补贴金额、职级补贴金额，新增一COBOL程序完成奖金计算，然后新建Schedule执行批处理，要求可以重复执行Batch；
备注：
营销员的基础信息为AA01PF，请找出其最合适的LF来使用；
字段说明：公司号COMPANY、分支BRANCH、营销员代码AGNTNUM、营销员职级DUTYDEG、入职日期DTEAPP、离职日期DTETRM（等于99999999为在职）、渠道COMTYPE（AG为营销员）；
主要程序段
DELETE逻辑
5000-DEL-TIM5 SECTION.
*
5010-START.
*
INITIALIZE TIM5-PARAMS. MOVE TIM5REC TO TIM5-FORMAT.
MOVE BEGNH TO TIM5-FUNCTION.
*
5020-READ.
*
CALL 'TIM5IO' USING TIM5-PARAMS. IF TIM5-STATUZ NOT = O-K AND ENDP
MOVE TIM5-STATUZ TO SYSR-STATUZ
MOVE TIM5-PARAMS TO SYSR-PARAMS
PERFORM 600-FATAL-ERROR
END-IF. IF TIM5-STATUZ = ENDP
GO TO 5090-EXIT
END-IF. MOVE DELET TO TIM5-FUNCTION.
CALL 'TIM5IO' USING TIM5-PARAMS. IF TIM5-STATUZ NOT = O-K
MOVE TIM5-STATUZ TO SYSR-STATUZ
MOVE TIM5-PARAMS TO SYSR-PARAMS
PERFORM 600-FATAL-ERROR
END-IF. *
5080-NEXTR.
MOVE NEXTR TO TIM5-FUNCTION.
GO TO 5020-READ.
*
5090-EXIT.
EXIT.
/
INSERT逻辑
7000-INSERT-TIM5 SECTION.
*
7010-START.
*
MOVE AA01-COMPANY TO TIM5-COMPANY.
MOVE AA01-BRANCH TO TIM5-BRANCH.
MOVE AA01-AGNTNUM TO TIM5-AGNTNUM.
MOVE AA01-DUTY-DEG TO TIM5-DUTY-DEG.
MOVE WSAA-PAYBYYEAR TO TIM5-PAYBYYEAR.
MOVE WSAA-PAYBYDUTY TO TIM5-PAYBYDUTY. MOVE TIM5REC TO TIM5-FORMAT.
MOVE WRITR TO TIM5-FUNCTION. CALL 'TIM5IO' USING TIM5-PARAMS. IF TIM5-STATUZ NOT = O-K
MOVE TIM5-STATUZ TO SYSR-STATUZ
MOVE TIM5-PARAMS TO SYSR-PARAMS
PERFORM 600-FATAL-ERROR
END-IF. 7090-EXIT.
EXIT.
/
主要的读操作
Columns . . . : 1 71 Edit Pending . . . . . : CC
SEU==>
FMT CB ......-A+++B+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 0301.00 6000-READ-AA01 SECTION.
0302.00 *
0303.00 6010-START.
0304.00 *
0305.00 INITIALIZE AA01-PARAMS.
0306.00
0307.00 MOVE AA01REC TO AA01-FORMAT.
0308.00 MOVE BEGN TO AA01-FUNCTION.
0309.00 *
0310.00 6020-READ.
0311.00 *
0312.00 CALL 'AA01IO' USING AA01-PARAMS.
0313.00
0314.00 IF AA01-STATUZ NOT = O-K AND ENDP
0315.00 MOVE AA01-STATUZ TO SYSR-STATUZ
0316.00 MOVE AA01-PARAMS TO SYSR-PARAMS
0317.00 PERFORM 600-FATAL-ERROR
0318.00 END-IF.
0319.00
0320.00 IF AA01-STATUZ = ENDP
0321.00 GO TO 6090-EXIT
0322.00 END-IF.
0323.00
0324.00 IF AA01-COM-TYPE = 'AG'
0325.00 AND AA01-DTETRM = 99999999
0326.00 AND AA01-DTEAPP < 20060000
0327.00
0328.00 MOVE 2000 TO WSAA-PAYBYYEAR
0329.00 EVALUATE AA01-DUTY-DEG
0330.00 WHEN 'A1'
0331.00 MOVE 6000 TO WSAA-PAYBYDUTY
0332.00 WHEN 'B1'
0333.00 MOVE 5000 TO WSAA-PAYBYDUTY
0334.00 WHEN 'C1'
0335.00 MOVE 4000 TO WSAA-PAYBYDUTY
0336.00 WHEN OTHER
0337.00 MOVE 2000 TO WSAA-PAYBYDUTY
0338.00 END-EVALUATE
0338.01 PERFORM 7000-INSERT-TIM5
0339.00 END-IF.
0340.00
0341.00 IF AA01-STATUZ NOT = O-K
0342.00 MOVE AA01-STATUZ TO SYSR-STATUZ
0343.00 MOVE AA01-PARAMS TO SYSR-PARAMS
0344.00 PERFORM 600-FATAL-ERROR
0345.00 END-IF.
0347.00 *
0348.00 6080-NEXTR.
0349.00 MOVE NEXTR TO AA01-FUNCTION.
0350.00 GO TO 6020-READ.
0351.00 6090-EXIT.
0352.00 EXIT.
0353.00 /
完整的按照Smart/400 规范写的代码：
select count(*) from CL4DEVDTA.TIM5Pf
Columns . . . : 1 71 Browse CL4DEVSRC/QLBLSRC
SEU==> TIM07
FMT CB ......-A+++B+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data *************************************
0001.00 IDENTIFICATION DIVISION.
0002.00 PROGRAM-ID. TIM07.
0003.00 *
0004.00 *(C) Copyright CSC Corporation Limited 1986 - 2000.
0005.00 * All rights reserved. CSC Confidential.
0006.00 *
0007.00 *REMARKS.
0008.00 * This is a skeleton for a batch mainline program.
0056.00 **DD/MM/YY*******************************************************
0057.00 *
0058.00 ENVIRONMENT DIVISION.
0059.00 CONFIGURATION SECTION.
0060.00 SOURCE-COMPUTER. IBM-AS400.
0061.00 OBJECT-COMPUTER. IBM-AS400.
0062.00 *
0063.00 INPUT-OUTPUT SECTION.
0064.00 FILE-CONTROL.
0065.00 /
0066.00 DATA DIVISION.
0067.00 FILE SECTION.
0068.00 /
0069.00 WORKING-STORAGE SECTION.
0070.00 *
0071.00 01 WSAA-PROG PIC X(05) VALUE 'TIM07'.
0072.00 01 WSAA-VERSION PIC X(02) VALUE '01'.
0073.00 *
0074.00 * These fields are required by MAINB processing and should not
0075.00 * be deleted.
0076.00 *
0077.00 01 WSAA-COMMIT-CNT PIC S9(08) COMP-3.
0078.00 01 WSAA-CYCLE-CNT PIC S9(08) COMP-3.
0079.00 01 WSAA-CNT PIC 9(02).
0080.00 01 WSSP-EDTERROR PIC X(04).
0081.00 01 WSAA-PAYBYYEAR PIC 9(04).
0082.00 01 WSAA-PAYBYDUTY PIC 9(04).
0083.00 *
0084.00 ****************************************************************
0085.00 *
0086.00 * The formats BUPA BSSC BPRD BSPR and BMSG are required by MAINB
0087.00 * processing and should not be deleted.
0088.00 *
0089.00 01 FORMATS.
0090.00 03 BMSGREC PIC X(10) VALUE 'BMSGREC'.
0091.00 03 BPRDREC PIC X(10) VALUE 'BPRDREC'.
0092.00 03 BSPRREC PIC X(10) VALUE 'BSPRREC'.
0093.00 03 BSSCREC PIC X(10) VALUE 'BSSCREC'.
0094.00 03 BUPAREC PIC X(10) VALUE 'BUPAREC'.
0095.00 03 DESCREC PIC X(10) VALUE 'DESCREC'.
0096.00 03 AA01REC PIC X(10) VALUE 'AA01REC'.
0097.00 03 TIM5REC PIC X(10) VALUE 'TIM5REC'.
0098.00 *
0099.00 01 TABLES.
0100.00 03 T1692 PIC X(06) VALUE 'T1692'.
0101.00 03 T1693 PIC X(06) VALUE 'T1693'.
0102.00 03 T3629 PIC X(06) VALUE 'T3629'.
0103.00 *
0104.00 01 CONTROL-TOTALS.
0105.00 03 CT01 PIC 9(02) VALUE 01.
0106.00 *
0107.00 01 WSAA-OVERFLOW PIC X(01) VALUE 'Y'.
0108.00 88 NEW-PAGE-REQ VALUE 'Y'.
0109.00 *
0110.00 01 WSAA-EOF PIC X(01) VALUE 'N'.
0111.00 88 END-OF-FILE VALUE 'Y'.
0112.00 *
0113.00 01 INDIC-AREA.
0114.00 03 INDIC-TABLE OCCURS 99 PIC 1 INDICATOR 1.
0115.00 88 IND-OFF VALUE B'0'.
0116.00 88 IND-ON VALUE B'1'.
0117.00 *
0118.00 * Main, standard page headings
0119.00 *
0120.00 * Detail line - add as many detail and total lines as required.
0121.00 * - use redefines to save WS space where applicable.
0122.00 *
0123.00 /
0124.00 COPY BATCDORREC.
0125.00 /
0126.00 COPY BATCUPREC.
0127.00 /
0128.00 COPY BSSCSKM.
0129.00 /
0130.00 COPY BSPRSKM.
0131.00 /
0132.00 COPY BUPASKM.
0133.00 /
0134.00 COPY BPRDSKM.
0135.00 /
0136.00 COPY CONLOGREC.
0137.00 /
0138.00 COPY CONTOTREC.
0139.00 /
0140.00 COPY DATCON1REC.
0141.00 /
0142.00 COPY DESCSKM.
0143.00 /
0144.00 COPY SFTLOCKREC.
0145.00 /
0146.00 COPY SYSERRREC.
0147.00 /
0148.00 COPY VARCOM.
0149.00 COPY AA01SKM.
0150.00 COPY TIM5SKM.
0151.00 /
0152.00 *
0153.00 LINKAGE SECTION.
0154.00 *****************
0155.00 *
0156.00 01 LSAA-STATUZ PIC X(04).
0157.00 01 LSAA-BSSCREC PIC X(1024).
0158.00 01 LSAA-BSPRREC PIC X(1024).
0159.00 01 LSAA-BPRDREC PIC X(1024).
0160.00 01 LSAA-BUPAREC PIC X(1024).
0161.00 /
0162.00 PROCEDURE DIVISION USING LSAA-STATUZ
0163.00 LSAA-BSSCREC
0164.00 LSAA-BSPRREC
0165.00 LSAA-BPRDREC
0166.00 LSAA-BUPAREC.
0167.00 *
0168.00 COPY MAINB.
0169.00 /
0170.00 0900-RESTART SECTION.
0171.00 **********************
0172.00 *
0173.00 0910-RESTART.
0174.00 *
0175.00 * Place any additional restart processing in here.
0176.00 *
0177.00 0990-EXIT.
0178.00 EXIT.
0179.00 /
0180.00 1000-INITIALISE SECTION.
0181.00 *************************
0182.00 *
0183.00 1010-INITIALISE.
0184.00 *
0185.00 PERFORM 5000-DEL-TIM5.
0186.00 *
0187.00 *
0188.00 INITIALIZE AA01-PARAMS.
0189.00
0190.00 MOVE AA01REC TO AA01-FORMAT.
0191.00 MOVE BEGN TO AA01-FUNCTION.
0192.00 *
0193.00 1090-EXIT.
0194.00 EXIT.
0195.00 /
0196.00 2000-READ-FILE SECTION.
0197.00 ************************
0198.00 *
0199.00 2010-READ-FILE.
0200.00 *
0201.00 * Call the I/O module or do a Standard COBOL read on
0202.00 * the primary file.
0203.00 *
0204.00 IF WSAA-EOF = 'Y'
0205.00 MOVE ENDP TO WSSP-EDTERROR
0206.00 END-IF.
0207.00 *
0208.00 MOVE O-K TO WSSP-EDTERROR.
0209.00 CALL 'AA01IO' USING AA01-PARAMS.
0210.00
0211.00 IF AA01-STATUZ NOT = O-K AND ENDP
0212.00 MOVE AA01-STATUZ TO SYSR-STATUZ
0213.00 MOVE AA01-PARAMS TO SYSR-PARAMS
0214.00 PERFORM 600-FATAL-ERROR
0215.00 END-IF.
0216.00
0217.00 IF AA01-STATUZ = ENDP
0218.00 MOVE ENDP TO WSSP-EDTERROR
0220.00 END-IF.
0221.00
0222.00 /
0223.00 2500-EDIT SECTION.
0224.00 *******************
0225.00 *
0226.00 2510-EDIT.
0227.00 *
0228.00 * Check record is required for processing.
0229.00 * Softlock the record if it is to be updated.
0230.00 *
0231.00 * MOVE O-K TO WSSP-EDTERROR.
0232.00 *
0233.00 2080-NEXTR.
0234.00 MOVE NEXTR TO AA01-FUNCTION.
0235.00 2590-EXIT.
0236.00 EXIT.
0237.00 /
0238.00 3000-UPDATE SECTION.
0239.00 *********************
0240.00 *
0241.00 3010-UPDATE.
0242.00 *
0243.00 * Update database records.
0244.00 *
0245.00
0247.00 IF AA01-COM-TYPE = 'AG'
0248.00 AND AA01-DTETRM = 99999999
0249.00 AND AA01-DTEAPP < 20060000
0250.00
0251.00 MOVE 2000 TO WSAA-PAYBYYEAR
0252.00 EVALUATE AA01-DUTY-DEG
0253.00 WHEN 'A1'
0254.00 MOVE 6000 TO WSAA-PAYBYDUTY
0255.00 WHEN 'B1'
0256.00 MOVE 5000 TO WSAA-PAYBYDUTY
0257.00 WHEN 'C1'
0258.00 MOVE 4000 TO WSAA-PAYBYDUTY
0259.00 WHEN OTHER
0260.00 MOVE 2000 TO WSAA-PAYBYDUTY
0261.00 END-EVALUATE
0262.00 PERFORM 7000-INSERT-TIM5
0263.00 END-IF.
0279.00 *
0280.00 3090-EXIT.
0281.00 EXIT.
0282.00 /
0283.00 3500-COMMIT SECTION.
0284.00 **********************
0285.00 *
0286.00 3510-COMMIT.
0287.00 *
0288.00 * Place any additional commitment processing in here.
0289.00 *
0290.00 3590-EXIT.
0291.00 EXIT.
0292.00 /
0293.00 3600-ROLLBACK SECTION.
0294.00 **********************
0295.00 *
0296.00 3610-ROLLBACK.
0297.00 *
0298.00 * Place any additional rollback processing in here.
0299.00 *
0300.00 3690-EXIT.
0301.00 EXIT.
0302.00 /
0303.00 4000-CLOSE SECTION.
0304.00 ********************
0305.00 *
0306.00 4010-CLOSE-FILES.
0307.00 *
0308.00 * Close any open files.
0309.00 *
0310.00 MOVE O-K TO LSAA-STATUZ.
0311.00 *
0312.00 4090-EXIT.
0313.00 EXIT.
0314.00 /
0315.00 5000-DEL-TIM5 SECTION.
0316.00 *
0317.00 5010-START.
0318.00 *
0319.00 INITIALIZE TIM5-PARAMS.
0320.00
0321.00 MOVE TIM5REC TO TIM5-FORMAT.
0322.00 MOVE BEGNH TO TIM5-FUNCTION.
0323.00 *
0324.00 5020-READ.
0325.00 *
0326.00 CALL 'TIM5IO' USING TIM5-PARAMS.
0327.00
0328.00 IF TIM5-STATUZ NOT = O-K AND ENDP
0329.00 MOVE TIM5-STATUZ TO SYSR-STATUZ
0330.00 MOVE TIM5-PARAMS TO SYSR-PARAMS
0331.00 PERFORM 600-FATAL-ERROR
0332.00 END-IF.
0333.00
0334.00 IF TIM5-STATUZ = ENDP
0335.00 GO TO 5090-EXIT
0336.00 END-IF.
0337.00
0338.00 MOVE DELET TO TIM5-FUNCTION.
0339.00 CALL 'TIM5IO' USING TIM5-PARAMS.
0340.00
0341.00 IF TIM5-STATUZ NOT = O-K
0342.00 MOVE TIM5-STATUZ TO SYSR-STATUZ
0343.00 MOVE TIM5-PARAMS TO SYSR-PARAMS
0344.00 PERFORM 600-FATAL-ERROR
0345.00 END-IF.
0346.00 *
0347.00 5080-NEXTR.
0348.00 MOVE NEXTR TO TIM5-FUNCTION.
0349.00 GO TO 5020-READ.
0350.00 *
0351.00 5090-EXIT.
0352.00 EXIT.
0353.00 /
0354.00 7000-INSERT-TIM5 SECTION.
0355.00 *
0356.00 7010-START.
0357.00 *
0358.00 INITIALIZE TIM5-PARAMS.
0359.00 MOVE AA01-COMPANY TO TIM5-COMPANY.
0360.00 MOVE AA01-BRANCH TO TIM5-BRANCH.
0361.00 MOVE AA01-AGNTNUM TO TIM5-AGNTNUM.
0362.00 MOVE AA01-DUTY-DEG TO TIM5-DUTY-DEG.
0363.00 MOVE WSAA-PAYBYYEAR TO TIM5-PAYBYYEAR.
0364.00 MOVE WSAA-PAYBYDUTY TO TIM5-PAYBYDUTY.
0365.00 MOVE TIM5REC TO TIM5-FORMAT.
0366.00 MOVE WRITR TO TIM5-FUNCTION.
0367.00 CALL 'TIM5IO' USING TIM5-PARAMS.
0368.00
0369.00 IF TIM5-STATUZ NOT = O-K
0370.00 MOVE TIM5-STATUZ TO SYSR-STATUZ
0371.00 MOVE TIM5-PARAMS TO SYSR-PARAMS
0372.00 PERFORM 600-FATAL-ERROR
0373.00 END-IF.
0374.00 7090-EXIT.
0375.00 EXIT.
0376.00 /
****************** End of data ****************************************
Smart/400开发上手3: 练习实践的更多相关文章
- Smart/400开发上手1:入门
1.介绍 Smart/400是在AS/400之上的开发平台,管理开发.运维的全生命周期. 2.设计基础 Introducing Fields Smart通过字段字典Field Dictionary来存 ...
- Smart/400开发上手2: COBOL批处理程序处理过程
开发目的:1.建立DB2数据库表:2.建立逻辑视图:3.通过Cobol程序将一个源数据表的数据通过一定公式计算后导出到另一个目的数据库表源数据表:TIM3PF目的数据表:TIM4PF4.在AS400中 ...
- Smart/400开发上手5: Cobol开发标准
ENVIRONMENT DIVISION. CONFIGURATION SECTION.SOURCE-COMPUTER. IBM-AS400.OBJECT-COMPUTER. IBM-AS400. 这 ...
- Smart/400开发上手4: 调试Cobol代码 （DEBUG with QBATCH）
Step1:Compile Cobol source CB TIM07 using *SRCDBG option例如:CB MEMBER(TIM07) OPTION(*SRCDBG) WORKU(TI ...
- 微信小程序快速开发上手
微信小程序快速开发上手 介绍: 从实战开发角度,完整系统地介绍了小程序的开发环境.小程序的结构.小程序的组件与小程序的API,并提供了多个开发实例帮助读者快速掌握小程序的开发技能,并能自己动手开发出小 ...
- 使用Bootstrap 3开发响应式网站实践07,页脚
页脚部分比较简单,把一个12列的Grid切分. <footer> <div class="container"> <div class="r ...
- 使用Bootstrap 3开发响应式网站实践06,使用ListGroup、Thumbnails展示内容
□ ListGroup展示内容 当希望把同类型的内容以列表.区块展示的时候,ListGroup是不错的选择. <div class="col-sm-6"> <h3 ...
- 使用Bootstrap 3开发响应式网站实践05,使用Tab、Modal、Form展示内容,使用Popover、Tooltip展示提示信息
本篇体验用Tab插件显示内容.Html部分为: <div class="row" id="moreInfo"> <div class=&quo ...
- 使用Bootstrap 3开发响应式网站实践04,使用Panels展示内容
在Bootstrap页面中,通常用Panels来展示主要功能的内容.该部分Html为: <div class="row" id="featureHeading&qu ...
随机推荐
- 前端之javascript的数据类型1和BOM对象
一 js对象 BOM对象:browser object model浏览器模型对象 window对象:定时器 DOM对象:文档对象模型 js对象:字符串对象,数组对象,日期对象,math对象 new关键 ...
- 2019.01.14 bzoj5343: [Ctsc2018]混合果汁（整体二分+权值线段树）
传送门 整体二分好题. 题意简述:nnn种果汁,每种有三个属性:美味度,单位体积价格,购买体积上限. 现在有mmm个询问,每次问能否混合出总体积大于某个值,总价格小于某个值的果汁,如果能,求所有方案中 ...
- 2018.11.18 bzoj2194: 快速傅立叶之二（fft）
传送门 模板题. 将bbb序列反过来然后上fftfftfft搞定. 代码: #include<bits/stdc++.h> #define ri register int using na ...
- jQuery动态控制下拉列表的被选项[转]
<form id="form" action="/query!query.action"> <select> <option va ...
- Winform自定义表单(转)
出处:http://www.newlifex.com/showtopic-167.aspx 好吧,附件真的损坏了,原始代码我也没有了,再提取我也没精力了,不好意思,哪位之前下过可以重发一遍吗?不过即使 ...
- TCP/IP协议（6）：传输层之UDP
一. UDP用户数据报协议,它是一个无连接的,面向数据报的协议,它不提供可靠性但传输速度比TCP要快. UDP数据报中的“UDP长度”为两个字节,所以我们要发送的UDP数据最多支持65507大约68K ...
- C#控件之：进度条（ProgressBar）
一.重绘进度条 public class CustomProgressBar:ProgressBar { public CustomProgressBar() { this.SetStyle(Cont ...
- 你可能不知道的Shell
Shell也叫做命令行界面,它是*nix操作系统下用户和计算机的交互界面.Shell这个词是指操作系统中提供访问内核服务的程序. 这篇文章向大家介绍Shell一些非广为人知.但却实用有趣的知识,权当品 ...
- Java案例：随机点名器
案例介绍: 随机点名器,即在全班同学中随机的找出一名同学,打印这名同学的个人信息.需具备以下3个内容:1)存储所有同学姓名2)总览全班同学姓名3)随机点名其中一人,打印到控制台 案例需求分析: 全班同 ...
- openresty + lua 3、openresty http 调用
http 的话,openresty 已经集成,ng 的话,自己引入即可. github 地址:https://github.com/pintsized/lua-resty-http github 里提 ...