Chinaunix首页 | 论坛 | 博客
  • 博客访问: 60822
  • 博文数量: 11
  • 博客积分: 1455
  • 博客等级: 上尉
  • 技术积分: 225
  • 用 户 组: 普通用户
  • 注册时间: 2008-01-10 12:28
文章分类

全部博文(11)

文章存档

2018年(1)

2012年(1)

2011年(5)

2009年(1)

2008年(3)

我的朋友
最近访客

分类:

2011-07-10 23:12:01

     F*--------------------------------------------------------------
     F* PROGRAM I.D.        : PURU02
     F* PROGRAM DESCRIPTION : PO#. LOCK MAINTENANCE - RPG
     F* WRITED  BY          : EDPLJL
     F*
     F*   MOD#    Date     Description
     F* ------- ---------  ------------------------------------------
     F* 080325  25 MAY 08  PROGRAM CREATED
     F* 080922  22 SEP 08  REMOVE THE DEPT OPTION
ML01+F* 080924  24 SEP 08  ADD APPROVE OR NOT FOR INQUIRY CONDITION
     F*--------------------------------------------------------------
     FPURU02FMCF  E                    WORKSTN
     F                                        RRNF1 KSFILE DSPS1
     FZPAL01  IF  E           K        DISK
     FPOLPF   UF  E           K        DISK
     E*---------------------------------------------------------------
     E                    MSG     1   5 78
     E*---------------------------------------------------------------
     ISDS        SDS
     I                                      244 253 WSID
     I                                      254 263 USER
     I            DS
     I                                        1   80MDY
     I                                        1   20M1
     I                                        3   40D1
     I                                        5   80Y1
     I            DS
     I                                        1   80YMD
     I                                        1   40Y2
     I                                        5   60M2
     I                                        7   80D2
     I* Workstation I/O Feedback Area
     ISFLDS       DS
     I                                    B 370 3710CURSOR
     I                                    B 378 3790RRNF
     I*
     C*****************************************************************
     C*  MAIN LOGIC
     C*****************************************************************
     C                     EXSR S000
     C*
     C           1         DOWEQ1
     C*
     C                     EXFMTDSPR1
     C                     MOVE *BLANKS   Z#MSG1
     C                     SETOF                       3132
     C                     SETOF                       3334
     C                     SETOF                       66
     C                     MOVEL'N'       ERR1    1
     C*
     C           *INKC     IFEQ *ON
     C                     GOTO ENDPGM
     C                     ENDIF
     C*
     C                     EXSR CHK1
     C*
     C           ERR1      IFEQ 'N'
     C                     EXSR SCRN2
     C                     ENDIF
     C*
     C                     ENDDO
     C*
     C           ENDPGM    TAG
     C                     SETON                     LR
     C**********************************************************************
     C* CHECK
     C**********************************************************************
     C           CHK1      BEGSR
     C*
     C*TO EVENT CANNOT BE ZEROS
     C           R1TPO     IFEQ *ZEROS
     C                     SETON                       32
     C                     MOVE 'Y'       ERR1
     C                     MOVELMSG,1     Z#MSG1    P
     C                     GOTO ENDCK1
     C                     ENDIF
     C*
     C*RECORD NOT EXIST
     C           R1TPO     IFLT R1FPO
     C                     SETON                       31
     C                     MOVE 'Y'       ERR1
     C                     MOVELMSG,2     Z#MSG1    P
     C                     GOTO ENDCK1
     C                     ENDIF
     C*
     C*TO CHACK DATE CANNOT BE ZEROS
     C           R1TDAT    IFEQ *ZEROS
     C                     SETON                       34
     C                     MOVE 'Y'       ERR1
     C                     MOVELMSG,3     Z#MSG1    P
     C                     GOTO ENDCK1
     C                     ENDIF
     C*
     C*RECORD NOT EXIST
     C           R1TDAT    IFLT R1FDAT
     C                     SETON                       33
     C                     MOVE 'Y'       ERR1
     C                     MOVELMSG,4     Z#MSG1    P
     C                     GOTO ENDCK1
     C                     ENDIF
     C*
     C           ENDCK1    TAG
     C                     ENDSR
     C**********************************************************************
     C* SCREEN 2
     C**********************************************************************
     C*
     C           SCRN2     BEGSR
     C*
     C*
     C                     EXSR S1LDSF                     Load subfile
     C*
     C           1         DOWEQ1
     C*
     C                     EXSR S1DPSF                     Display Subfile
     C*
     C           *INKC     IFEQ *ON
     C                     GOTO ENDSR2
     C                     ENDIF
     C*
     C           *INKD     IFEQ *ON
     C                     EXSR SLWIN
     C                     ENDIF
     C*
     C           *INKF     IFEQ *ON
     C                     EXSR SAVE
     C                     GOTO ENDSR2
     C                     ENDIF
     C*
     C                     ENDDO
     C*
     C*
     C           ENDSR2    TAG
     C                     ENDSR
     C*
     C*****************************************************************
     C*  S1CLSF - Clear Sub-File in Screen 1                          *
     C*****************************************************************
     C           S1LDSF    BEGSR
     C                     MOVE '0'       *IN62            SFLDSP
     C                     MOVE '0'       *IN63            SFLDSPCTL
     C                     MOVE '1'       *IN64            SFLCLR
     C                     WRITEDSPC1
     C                     MOVE '1'       *IN62            SFLDSP
     C                     MOVE '1'       *IN63            SFLDSPCTL
     C                     MOVE '0'       *IN64            SFLCLR
     C                     Z-ADD*ZEROS    RRNF1
     C********
     C*
     C                     SETOF                     86
     C                     SELEC
     C           R1LOCK    WHEQ 'A'
     C                     SETON                     86
     C           R1LOCK    WHEQ 'Y'
     C                     MOVEL'L'       LCKSTS  1
     C           R1LOCK    WHEQ 'N'
     C                     MOVEL'U'       LCKSTS  1
     C                     ENDSL
     C*
     C           R1FPO     SETLLPOLPF
     C                     READ POLPF               N    80
     C           *IN80     DOWEQ*OFF
     C           PLORD     ANDGER1FPO
     C           PLORD     ANDLER1TPO
     C           RRNF1     ANDLT9999
ML01+C*
   | C           PLPROS    IFEQ 'V'
   | C                     MOVEL'Y'       PLPROS
   | C                     ENDIF
   | C*
   | C           PLADMS    IFEQ 'V'
   | C                     MOVEL'Y'       PLPROS
   | C                     ENDIF
   | C*
   | C           PLSPES    IFEQ 'V'
   | C                     MOVEL'Y'       PLPROS
   | C                     ENDIF
   | C*
   | C           PLPURS    IFEQ 'V'
   | C                     MOVEL'Y'       PLPROS
   | C                     ENDIF
   | C*
   | C           PLPROA    IFNE *BLANKS
   | C           PLPROS    IFEQ R1APPR
   | C                     MOVEL'Y'       @A      1
   | C                     ELSE
   | C                     MOVEL'N'       @A      1
   | C                     ENDIF
   | C                     ENDIF
   | C*
   | C           PLADMA    IFNE *BLANKS
   | C           PLADMS    IFEQ R1APPR
   | C                     MOVEL'Y'       @A      1
   | C                     ELSE
   | C                     MOVEL'N'       @A      1
   | C                     ENDIF
   | C                     ENDIF
   | C*
   | C           PLSPEA    IFNE *BLANKS
   | C           PLSPES    IFEQ R1APPR
   | C                     MOVEL'Y'       @A      1
   | C                     ELSE
   | C                     MOVEL'N'       @A      1
   | C                     ENDIF
   | C                     ENDIF
   | C*
   | C           PLPURA    IFNE *BLANKS
   | C           PLPURS    IFEQ R1APPR
   | C                     MOVEL'Y'       @A      1
   | C                     ELSE
   | C                     MOVEL'N'       @A      1
   | C                     ENDIF
   | C                     ENDIF
   | C*
ML01+C           @A        IFEQ 'Y'
     C*
     C                     SETOF                     5859
     C                     SETOF                     6061
     C                     MOVEL*BLANKS   S1SEL1
     C                     MOVEL*BLANKS   S1SEL2
     C                     MOVEL*BLANKS   S1SEL3
     C                     MOVEL*BLANKS   S1SEL4
     C*
     C   88                MOVELUSER      PLLUSR
     C   86                MOVELPLLCK     LCKSTS
     C*
     C           PLEDTE    IFGE R1FDAT
     C           PLEDTE    ANDLER1TDAT
     C           PLLUSR    ANDEQUSER
     C           PLLCK     ANDEQLCKSTS
     C*
     C                     SELEC
     C           PLLCK     WHEQ 'L'
     C                     MOVEL'已上?'S1LOCK    P
     C                     MOVEL*BLANKS   S1SEL
     C           PLLCK     WHEQ 'U'
     C                     MOVEL'未上?'S1LOCK    P
     C                     MOVEL'X'       S1SEL
     C                     ENDSL
     C*
     C                     MOVE PLORD     S1PORD
     C                     MOVE PLEDTE    S1DATE
     C*
RZ01-C*D                   MOVELPLDEPT    S1DEPT
     C                     MOVELPLPROA    S1PROA
     C                     MOVELPLADMA    S1ADMA
     C                     MOVELPLSPEA    S1SPEA
     C                     MOVELPLPURA    S1PURA
     C                     MOVELPLPROS    S1PROS
     C                     MOVELPLADMS    S1ADMS
     C                     MOVELPLSPES    S1SPES
     C                     MOVELPLPURS    S1PURS
     C                     MOVELPLPRON    S1PRON
     C                     MOVELPLADMN    S1ADMN
     C                     MOVELPLSPEN    S1SPEN
     C                     MOVELPLPURN    S1PURN
     C                     MOVELPLPROD    S1PROD
     C                     MOVELPLADMD    S1ADMD
     C                     MOVELPLSPED    S1SPED
     C                     MOVELPLPURD    S1PURD
     C*
     C           PLPROS    IFEQ 'Y'
     C                     SETON                     60
     C                     MOVEL'*'       S1SEL1
     C                     ENDIF
     C           PLADMS    IFEQ 'Y'
     C                     SETON                     61
     C                     MOVEL'*'       S1SEL2
     C                     ENDIF
     C           PLSPES    IFEQ 'Y'
     C                     SETON                     58
     C                     MOVEL'*'       S1SEL3
     C                     ENDIF
     C           PLPURS    IFEQ 'Y'
     C                     SETON                     59
     C                     MOVEL'*'       S1SEL4
     C                     ENDIF
     C*
     C           PLPROS    IFEQ 'V'
     C                     SETON                     60
     C                     MOVEL'#'       S1SEL1
     C                     ENDIF
     C           PLADMS    IFEQ 'V'
     C                     SETON                     61
     C                     MOVEL'#'       S1SEL2
     C                     ENDIF
     C           PLSPES    IFEQ 'V'
     C                     SETON                     58
     C                     MOVEL'#'       S1SEL3
     C                     ENDIF
     C           PLPURS    IFEQ 'V'
     C                     SETON                     59
     C                     MOVEL'#'       S1SEL4
     C                     ENDIF
     C*
     C                     ADD  1         RRNF1   40
     C                     WRITEDSPS1
     C*
     C                     ENDIF
ML01+C*
ML01+C                     ENDIF
     C*
     C                     READ POLPF               N    80
     C*
     C                     ENDDO
     C*
     C           RRNF1     IFEQ 0
     C                     MOVE '0'       *IN62            SFLDSP
     C                     MOVE '1'       *IN63            SFLDSPCTL
     C                     MOVE '1'       *IN69            SFLEND
     C                     ELSE
     C                     MOVE '1'       *IN62            SFLDSP
     C                     MOVE '1'       *IN63            SFLDSPCTL
     C                     MOVE '1'       *IN69            SFLEND
     C                     ENDIF
     C*
     C                     ENDSR
     C*****************************************************************
     C*  S1DPSF - Display Sub-File in Screen 1                        *
     C*****************************************************************
     C           S1DPSF    BEGSR
     C*
     C           RRNF1     IFNE 0
     C                     Z-ADD1         RRNF1
     C                     SETON                     66
     C                     ENDIF
     C*
     C                     WRITEDSPK1
     C                     EXFMTDSPC1
     C*
     C                     MOVEL'N'       ERR2    1
     C                     MOVEL*BLANKS   Z#MSG2
     C*
     C                     ENDSR
     C********************************************************************
     C*  SAVE  -  SAVE LOCK PO#. TO TABLE POLPF                       *  *
     C********************************************************************
     C*
     C           SAVE      BEGSR
     C                     Z-ADD1         NN      50
     C           NN        CHAINDSPS1                80
     C           *IN80     DOWEQ*OFF
     C*
     C           S1SEL     IFEQ 'X'
     C                     MOVELMSG,5     Z#MSG1
     C*
     C           S1PORD    CHAINPOLPF                81
     C           *IN81     IFEQ *OFF
     C                     MOVEL'L'       PLLCK
     C                     MOVELUSER      PLLUSR
     C                     Z-ADD*DATE     MDY
     C                     Z-ADDM1        M2
     C                     Z-ADDD1        D2
     C                     Z-ADDY1        Y2
     C                     Z-ADDYMD       PLLDTE
     C                     TIME           PLLTIM
     C                     UPDATPOLR1
     C                     ENDIF
     C*
     C                     ENDIF
     C                     ADD  1         NN
     C           NN        CHAINDSPS1                80
     C                     ENDDO
     C*
     C                     ENDSR
     C********************************************************************
     C*  S000  -  Initial Subroutine                                  *  *
     C********************************************************************
     C           S000      BEGSR
     C*
     C* Retrieve company name
     C           'COMPANY 'CHAINZPAL01               90
     C           *IN90     IFEQ '0'
     C                     MOVELDATA      CONAME
     C                     ENDIF
     C*
     C                     Z-ADD*DATE     MDY
     C                     Z-ADDD1        D2
     C                     Z-ADDM1        M2
     C                     Z-ADDY1        Y2
     C*
     C*
     C           'PURU02UR'CHAINZPAL01               90
     C           *IN90     IFEQ *OFF
     C           DATA      ANDEQUSER
     C                     SETON                     88
     C                     ELSE
     C                     SETOF                     88
     C                     ENDIF
     C*
     C*
     C                     Z-ADD*ZEROS    R1FPO
     C                     Z-ADD99999999  R1TPO
     C                     MOVE YMD       R1FDAT
     C                     MOVE YMD       R1TDAT
     C                     MOVEL'N'       R1LOCK
ML01+C                     MOVEL*BLANKS   R1APPR
     C*
     C                     ENDSR
     C*****************************************************************
     C*  SLWIN - SELECT WINDOW FOR DEPTERMENT AND CONFIRM PEOPLE     *
     C*****************************************************************
     C           SLWIN     BEGSR
     C*
     C           CSRRN1    CHAINDSPS1                89
     C           *IN89     IFEQ *OFF
     C*
     C           CURSOR    DIV  256       XROW
     C                     MVR            XCOL
     C*
     C                     SELEC
RZ01-C*D         FNAM      WHEQ 'S1DEPT'
 |   C*D                   CALL 'WINDPD'
 |   C*D                   PARM           S1DEPT
 |   C*D                   PARM           XROW
 |   C*D                   PARM           XCOL
RZ01-C*D
     C           FNAM      WHEQ 'S1PROA'
     C                     MOVEL'M'         1
     C                     CALL 'WINDPP'
     C                     PARM           S1PROA
     C                     PARM           XROW
     C                     PARM           XCOL
     C                     PARM          
     C                     PARM           S1PROS
     C                     PARM           S1PRON
     C*
     C           FNAM      WHEQ 'S1ADMA'
     C                     MOVEL'O'      
     C                     CALL 'WINDPP'
     C                     PARM           S1ADMA
     C                     PARM           XROW
     C                     PARM           XCOL
     C                     PARM          
     C                     PARM           S1ADMS
     C                     PARM           S1ADMN
     C*
     C           FNAM      WHEQ 'S1SPEA'
     C                     MOVEL'S'      
     C                     CALL 'WINDPP'
     C                     PARM           S1SPEA
     C                     PARM           XROW
     C                     PARM           XCOL
     C                     PARM          
     C                     PARM           S1SPES
     C                     PARM           S1SPEN
     C*
     C           FNAM      WHEQ 'S1PURA'
     C                     MOVEL'P'      
     C                     CALL 'WINDPP'
     C                     PARM           S1PURA
     C                     PARM           XROW
     C                     PARM           XCOL
     C                     PARM          
     C                     PARM           S1PURS
     C                     PARM           S1PURN
     C*
     C                     OTHER
     C                     ENDSL
     C*
     C                     ENDIF
     C*
     C                     ENDSR
     C********************************************************************
** MSG
 TO PO#.不能?空!
自PO#.不能大於 TO  PO#.!
 TO DATE不能?空!
自DATE不能大於 TO DATE !
更新成功!
阅读(638) | 评论(0) | 转发(0) |
0

上一篇:SQLA

下一篇:PUR02FM

给主人留下些什么吧!~~