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 !
更新成功！
阅读(863) | 评论(0) | 转发(0) |
