如何於 RPGIV 中顯示公司組織階層( RPGIV Recursive Calls Using Subprocedures 顯示公司組織階層範例)
File : QDDSSRC
Member: EMPMST 員工基本資料主檔
Type : PF
Usage : CRTPF FILE(XXX/EMPMST) SRCFILE(XXX/QDDSSRC)
*===============================================================
*
* To compile:
*
* CRTPF FILE(XXX/EMPMST) SRCFILE(XXX/QDDSSRC)
*
*===============================================================
A UNIQUE
A R PFR
A DBIDNM 7 0
A DBFNAM 20
A DBLNAM 20
A K DBIDNM
*
* DBIDNM : 員工編號
* DBFNAM : 員工名字
* DBLNAM : 員工姓氏
File : QDDSSRC
Member: EMPSUB 員工組織層級資料主檔
Type : PF
Usage : CRTPF FILE(XXX/EMPSUB) SRCFILE(XXX/QDDSSRC)
*===============================================================
*
* To compile:
*
* CRTPF FILE(XXX/EMPSUB) SRCFILE(XXX/QDDSSRC)
*
*===============================================================
A R PFR2
A EMPLOY 7 0
A SUBORD 7 0
A K EMPLOY
A
K SUBORD
*
* EMPLOY : 主管員工編號
* SUBORD : 下屬員工編號
File : QDDSSRC
Member: ORGLISTDF 組織階層顯示畫面
Type : DSPF
Usage : CRTDSPF FILE(XXX/ORGLISTDF) SRCFILE(XXX/QDDSSRC)
*===============================================================
*
* To compile:
*
* CRTDSPF FILE(XXX/ORGLISTDF) SRCFILE(XXX/QDDSSRC)
*
*===============================================================
A*
A*%%EC
A DSPSIZ(24 80 *DS3)
A PRINT
A ERRSFL
A CA03
A CA12
A*
A R SFL1 SFL
A*
A SUBNAM 60 O 6 2
A*
A*
A R SF1CTL SFLCTL(SFL1)
A SFLSIZ(0050)
A SFLPAG(0016)
A OVERLAY
A N32 SFLDSP
A N31 SFLDSPCTL
A 31 SFLCLR
A 90 SFLEND(*MORE)
A RRN1 4S 0H
A 1 2'ORGLIST '
A 1 28'Company Organization List'
A COLOR(WHT)
A 1 71DATE
A EDTCDE(Y)
A 2 71TIME
A 3 2'Employee . :'
A NAME 41A O 3 15
A 5 2'Hierarchy'
A COLOR(WHT)
A*
A R FKEY1
A*
A 23 2'F3=Exit'
A COLOR(BLU)
A 23 12'F12=Cancel'
A COLOR(BLU)
File : QRPGLESRC
Member: ORGLISTR 組織階層顯示程式
Type : DSPF
Usage : CRTBNDRPG PGM(XXX/ORGLIST) SRCFILE(XXX/QRPGLESRC)
*===============================================================
*
* To compile:
*
* CRTBNDRPG PGM(XXX/ORGLIST) SRCFILE(XXX/QRPGLESRC)
*
*===============================================================
H DftActGrp(*NO) ActGrp(*CALLER)
FOrgListDF cf e workstn
F sfile(sfl1:rrn1)
F infds(info)
FEmpMst if e k disk
FEmpSub if e k disk
* Information data structure to hold attention indicator (AID) byte.
* AID byte contains a code identifying the function
* key used to return control to the program from the display file.
* For more information see the DATA MANAGEMENT GUIDE.
Dinfo ds
D cfkey 369 369
* Constants to compare to AID - F3, F12, F6, and ENTER keys.
* Other values documented in DATA MANAGEMENT GUIDE.
Dexit C const(X'33')
Dcancel C const(X'3C')
Dadd C const(X'36')
Denter C const(X'F1')
* Input parameter: Employee number
D In_Employee DS 7
D P_Employee 7s 0
* Prototype for NextLevel procedure: Receives two parameters
D NextLevel pr
D level 3 0 value
D employee 7s 0 value
* Input parameter list - receives an employee number to start display
C *Entry PList
C Parm In_Employee
* Get master record for input employee
C P_Employee Chain EmpMst
C If not %found
C Eval name = *blanks
C Eval name = 'Employee not found.'
C Eval *In32 = *on
* If found, Trim blanks and form First /Last name field
C Else
C Eval name = (%trimr(dbfnam) + ' ' +
C %trimr(dblnam))
* Clear the subfile, then call the recursive NextLevel procedure
C ExSr clrsfl
C CallP NextLevel (1 : P_Employee)
C Eval *In90 = *on
C If rrn1 = 0
C Eval *in32 = *on
C EndIf
C EndIf
* Simply redisplay subfile until user hits Exit or Cancel
C DoU (cfkey = exit) or (cfkey = cancel)
C Write fkey1
C ExFmt sf1ctl
C EndDo
* Close files and terminate.
C Eval *inlr = *on
*********************************************************************
C ClrSfl BegSr
* Clear the subfile by activating SFLCLR and writing the subfile control
* format. Reset the subfile relative record number.
C Eval *in31 = *on
C Eval rrn1 = 0
C Write sf1ctl
C Eval *in31 = *off
*
C EndSr
*********************************************************************
* Recursive NextLevel subprocedure. Drills down through the subordinate
* tree, populating the subfile as it goes.
* Begin subprocedure NextLevel
P NextLevel B
*
* Procedure interface. Describes procedure parameters.
* VALUE keyword causes paramters to be passed by value, not reference.
D PI
D level 3 0 value
D employee 7s 0 value
* Local variables - visible only within this subprocedure.
D SaveSubord s like(employ)
* Key list for SFL002PF
C EmpSubKey KList
C KFld employee
C KFld SaveSubord
* Position to first subordinate record for this employee and read it.
C employee SetLL EmpSub
C employee ReadE EmpSub
* Loop until EOF is encountered.
C DoW not %eof
* Look up master record for the current subordinate.
C Subord Chain EmpMst
C If not %found
C Eval subnam = *blanks
C Eval subnam = 'Employee information not found'
C Else
* fill the subnam subfile field with '...................'
* Use %TRIM BIF to strip leading and trailing spaces from database fields.
* Assign INTO the subnam field through the %subst function, indenting based
* upon the current level.
C Eval subnam = *all'.'
C Eval %subst(subnam : 2*(Level+1))=%trim(dbfnam) +
C ' ' + %trim(dblnam)
* Update the global RRN counter, and write the new subfile record.
C Eval rrn1 = rrn1 + 1
C Write sfl1
C EndIf
* Save the subordinate in the local variable, and recursively
* call NextLevel, updating the level number, and passing the
* current subordinate as the input employee.
C Eval SaveSubord = Subord
C CallP NextLevel (Level + 1 : Subord)
* Get next subordinate for the current employee.
C EmpSubKey SetGT EmpSub
C employee ReadE EmpSub
C EndDo
* End the procedure
P E
使用方式:
依據上述 Source 編譯所有資料庫,畫面,程式
並於 Command Line 執行
建立員工基本資料 : UPDDTA EMPMST
建立員工組織階層資料 : UPDDTA EMPSUB
CALL ORGLISTR 'xxxxxxx'
x: 表示員工編號
星期三, 11月 01, 2023
2002-04-04 如何於 RPGIV 中顯示公司組織階層( RPGIV Recursive Calls Using Subprocedures 顯示公司組織階層範例)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言