免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
最近访问板块 发新帖
查看: 11024 | 回复: 0

【分享】CLRL关键字在显示文件中的应用 [复制链接]

论坛徽章:
0
发表于 2010-08-19 17:13 |显示全部楼层
本帖最后由 pantierui 于 2010-08-19 17:28 编辑

CLRL关键字的作用是在写当前的record的时候清除先前显示文件的指定内容。
reference的sample如下:
CLRL.jpg
这样有什么好处?运用此关键字可以实现用一个record去覆盖另一个record的部分内容。
如下面的例子,效果如图:
sfr.jpg
代码如下:
PTRLIB/QDDSSRC(STATES)
     A                                      UNIQUE
     A          R RSTATES
     A            STATCD         2
     A            STATDS        15
     A          K STATCD

PTRLIB/QDDSSRC(SFD600)
     A                                      DSPSIZ(24 80 *DS3)
     A                                      CF03(03 'EXIT')
     A          R SFD600A                   SFL
     A            STATCD    R        B  8  3REFFLD(RSTATES/STATCD *LIBL/STATES)
     A                                      COLOR(WHT)
     A            STATDS    R        B  8 13REFFLD(RSTATES/STATDS *LIBL/STATES)
     A                                      COLOR(WHT)
     A          R SFD600B                   SFLCTL(SFD600A)
     A                                      OVERLAY
     A  30                                  SFLDSP
     A                                      SFLDSPCTL
     A  31                                  SFLINZ
     A                                      SFLSIZ(0100)
     A                                      SFLPAG(0010)
     A  35                                  SFLEND(*MORE)
     A                                  1  4DATE
     A                                      EDTCDE(Y)
     A                                      COLOR(BLU)
     A                                  2  4TIME
     A                                      COLOR(BLU)
     A                                  1 26'Input State Codes'
     A                                      COLOR(WHT)
     A                                  1 69USER
     A                                      COLOR(BLU)
     A                                  2 69'SFR600'
     A                                      COLOR(BLU)
     A                                  6  1'State code'
     A                                      COLOR(PNK)
     A                                      DSPATR(UL)
     A                                  6 13'Description     '
     A                                      COLOR(PNK)
     A                                      DSPATR(UL)
     A          R TRAILER
     A                                 23  2'F3-Exit'
     A                                      COLOR(WHT)
     A          R READS
     A                                      CLRL(*NO)
     A                                 15 44'Number of Reads'
     A                                 16 44'Number of Records Entered'
     A            @READS         5Y 0O 15 73COLOR(PNK)
     A                                      EDTCDE(Z)
     A            @RCDS          5Y 0O 16 73COLOR(PNK)
     A                                      EDTCDE(Z)
     A
PTRLIB/QRPGSRC(SFR600)
     FSFD600  CF  E                    WORKSTN
     F                                        @RRN  KSFILE SFD600A
     C**************************************************************************
     C* MAIN ROUTINE                                                           *
     C**************************************************************************
     C           #CTL      CASEQ'MAIN'    @MAIN
     C           #CTL      CASEQ'END '    @END
     C                     ENDCS
     C**************************************************************************
     C* MAIN SUBROUTINE                                                        *
     C**************************************************************************
     C           @MAIN     BEGSR
     C*
     C           #CTL      DOWEQ'MAIN'
     C*
     C                     WRITETRAILER
     C                     MOVE *ON       *IN30
     C  N88                WRITESFD600B
     C   88                EXFMTSFD600B
     C  N88                EXFMTREADS
     C*
     C                     SELEC
     C* F3 KEY
     C           *IN03     WHEQ *ON
     C                     MOVEL'END '    #CTL
     C* ENTER KEY
     C                     OTHER
     C                     EXSR @READ
     C           @RCDS     IFNE *ZERO
     C                     SETOF                     88
     C                     ELSE
     C                     SETON                     88
     C                     ENDIF
     C                     ENDSL
     C*
     C                     ENDDO
     C*
     C                     ENDSR
     C**************************************************************************
     C* END SUBROUTINE                                                         *
     C**************************************************************************
     C           @END      BEGSR
     C*
     C                     SETON                     LR
     C                     RETRN
     C*
     C                     ENDSR
     C**************************************************************************
     C* @READ Read the records inputted from the subfile                       *
     C**************************************************************************
     C           @READ     BEGSR
     C*
     C                     Z-ADD*ZERO     @READS
     C                     Z-ADD*ZERO     @RCDS
     C                     Z-ADD*ZERO     @RRN
     C                     MOVE *OFF      *IN99
     C*
     C           *IN99     DOWEQ*OFF
     C                     ADD  1         @RRN
     C           @RRN      CHAINSFD600A              99
     C*
     C           *IN99     IFEQ *ON
     C                     LEAVE
     C                     ENDIF
     C*
     C                     ADD  1         @READS
     C*
     C           STATCD    IFNE *BLANKS
     C           STATDS    ANDNE*BLANKS
     C                     ADD  1         @RCDS
     C                     ENDIF
     C*
     C                     ENDDO
     C*
     C*
     C                     ENDSR
     C**************************************************************************
     C* *INZSR                                                                 *
     C**************************************************************************
     C           *INZSR    BEGSR
     C*
     C                     Z-ADD*ZERO     @RRN    50
     C                     MOVEL'MAIN'    #CTL    4
     C                     SETON                     3588
     C*
     C                     MOVE *ON       *IN31
     C                     WRITESFD600B
     C                     MOVE *OFF      *IN31
     C*
     C                     ENDSR

程序只是实现了简单的功能。欢迎大家拍砖。  呵呵。                                            
更多此关键字的内容请参照IBM AS/400信息中心
http://publib.boulder.ibm.com/infocenter/iseries/v5r4/index.jsp
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

DTCC2020中国数据库技术大会

【架构革新 高效可控】2020年12月21日-23日第十一届中国数据库技术大会将在北京隆重召开。

大会设置2大主会场,20+技术专场,将邀请超百位行业专家,重点围绕数据架构、AI与大数据、传统企业数据库实践和国产开源数据库等内容展开分享和探讨,为广大数据领域从业人士提供一场年度盛会和交流平台。

http://dtcc.it168.com


大会官网>>
  

北京盛拓优讯信息技术有限公司. 版权所有 16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122
中国互联网协会会员  联系我们:huangweiwei@it168.com
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP