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 ****************************************
关于作者：
王昕（QQ:475660）
在广州工作生活30余年。十多年开发经验，在Java、即时通讯、NoSQL、BPM、大数据等领域较有经验。
目前维护的开源产品：https://gitee.com/475660
目前维护的开源产品：https://gitee.com/475660
