INT013 - 付録C
iiiFN17を完成させるRDMLXソースコード ・社員用のPDF出力を作成
* Produce PDF document for employees selected by surname
When (= S)
#outsts := *blanks
#rep1page := 1
Select Fields(*all) From_File(pslmst2) With_Key(#surname) Nbr_Keys(*compute) Generic(*yes)
* Add Logo
Change Field(#JSMXCMD) To('ADD CONTENT(LOGO) ')
Use Builtin(JSMx_COMMAND) With_Args(#JSMXHDLE1 #JSMXCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
* Clear employee header list
Clr_List Named(#header)
#fullname := #surname + ', ' + #givename
Fetch Fields(#deptdesc) From_File(deptab) With_Key(#deptment)
Fetch Fields(#secdesc) From_File(sectab) With_Key(#deptment #section)
Add_Entry To_List(#header)
If_Status Is(*OKAY)
Change Field(#JSMXCMD) To('ADD CONTENT(HEADER) ')
Use Builtin(JSMx_COMMAND) With_Args(#JSMXHDLE1 #JSMXCMD #HEADER) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
#outsts := OK
Else
Message Msgtxt('Employees not found for surname: ' + #surname)
Leave
Endif
* Add Employee Skills List
* Get employee skills
* ======================
Clr_List Named(#skilltbl)
Select Fields(#skills) From_File(pslskl) With_Key(#empno) Nbr_Keys(*compute) Generic(*yes) Val_Error(*next)
Fetch Fields(#skills) From_File(skltab) With_Key(#skilcode) Val_Error(*next)
#std_text := #dateacq.asdate( DDMMYY ).asdisplayString( DDsMMsCCYY )
Execute Subroutine(grade)
Add_Entry To_List(#skilltbl)
Endselect
If_Status Is_Not(*error)
Change Field(#JSMXCMD) To('ADD CONTENT(SKILLTBL) SERVICE_LIST(SKILDESC,GRADEDES,DATEACQ,COMMENT)')
Use Builtin(JSMX_COMMAND) With_Args(#JSMXHDLE1 #JSMXCMD) To_Get(#JSMSTS #JSMMSG #SKILLTBL)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
Else
Message Msgtxt('Employee skills not found')
Endif
Execute Subroutine(footer)
#rep1page += 1
Endselect
If (#outsts = OK)
Execute Subroutine(CLOSE)
Else
Message Msgtxt('No output produced')
* Close the JSM
Use Builtin(JSMX_CLOSE) With_Args(#jsmxhdle1) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
Endif
* Produce PDF document for Employees by Department
When (= D)
#rep1page := 1
#outsts := *blanks
Select Fields(*all) From_File(pslmst1) With_Key(#deptment) Nbr_Keys(*compute)
* Add Logo
Change Field(#JSMXCMD) To('ADD CONTENT(LOGO) ')
Use Builtin(JSMx_COMMAND) With_Args(#JSMXHDLE1 #JSMXCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
* Clear employee header list
Clr_List Named(#header)
#fullname := #surname + ', ' + #givename
Fetch Fields(#deptdesc) From_File(deptab) With_Key(#deptment)
Fetch Fields(#secdesc) From_File(sectab) With_Key(#deptment #section)
Add_Entry To_List(#header)
If_Status Is(*OKAY)
Change Field(#JSMXCMD) To('ADD CONTENT(HEADER) ')
Use Builtin(JSMx_COMMAND) With_Args(#JSMXHDLE1 #JSMXCMD #HEADER) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
#outsts := OK
Else
Message Msgtxt('Employees not found for Dept ' + #deptment)
Leave
Endif
* Add Employee Skills List
* Get employee skills
* ======================
Clr_List Named(#skilltbl)
Select Fields(#skills) From_File(pslskl) With_Key(#empno) Nbr_Keys(*compute) Val_Error(*next)
Fetch Fields(#skills) From_File(skltab) With_Key(#skilcode) Val_Error(*next)
#std_text := #dateacq.asdate( DDMMYY ).asdisplayString( DDsMMsCCYY )
Execute Subroutine(grade)
Add_Entry To_List(#skilltbl)
Endselect
If_Status Is_Not(*error)
Change Field(#JSMXCMD) To('ADD CONTENT(SKILLTBL) SERVICE_LIST(SKILDESC,GRADEDES,DATEACQ,COMMENT)')
Use Builtin(JSMX_COMMAND) With_Args(#JSMXHDLE1 #JSMXCMD) To_Get(#JSMSTS #JSMMSG #SKILLTBL)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
Else
Message Msgtxt('Employee skills not found')
Endif
Execute Subroutine(footer)
#rep1page += 1
Endselect
If (#outsts = OK)
Execute Subroutine(CLOSE)
Else
* Close the JSM
Use Builtin(JSMX_CLOSE) With_Args(#jsmxhdle1) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK_STS) With_Parms(#JSMXHDLE1)
Message Msgtxt('No output produced')
Endif