This is the last of my utility posts for the time being. Just like with the other utility programs on this site, use at your own risk. All source can be used for any purpose as long as you site me as the original author.
This has the same purpose for service programs as WRKILEMOD has for multi-module programs.
Without any more discussion, it’s on with the source code.
RPG Source-SY0040R
/Title SY0040R - Work with Service Program Modules.
H Optimize(*None) Option(*SrcStmt: *NoDebugIO)
H CopyRight('Copyright 2010. Jeffrey Lanham Programming Arts, Inc. All Rig-
Hhts Reserved.')
//*************************************************************************
// Module: SY0040R *
// Purpose: This module gets module information for Service Program *
// objects. Will eventually turn this into a service program *
// management system. *
//*************************************************************************
// Written by: Jeffrey Lanham *
//*************************************************************************
FSY0040FM CF E Workstn Sfile(SY0040S1: Recno1)
F Sfile(SY0040S5: Recno5)
F Infds(SY0040DS)
FSY0040P O E Printer UsrOpn
/Eject
//*************************************************************************
// Constants.
D CmdCol C 7
D CmdRow C 21
//*************************************************************************
// Work fields.
D Bin04 S 8B 0 Scrap 4.0 Binary
D Cancelled S N Function Cancelled?
D CommandLine S 32702 Command Line
D CommandLength S 15 5 Command Length
D ErrorMessage S 80 Error Message Parm.
D No_Selection S N No Selection Made
D NotExist S N Doesn't Exist?
D OverFlow S N OverFlow Indicator
D Recno1 S Like(SFLCT1) Subfile Record No.
D Recno5 S Like(SFLCT5) Subfile Record No.
D Sav_Cur_Page S Like(SFLCT1)
D Tick C X'7D' '
//*************************************************************************
// Entry Parameter Procedure definition.
D SY0040R PR
// This is also a parameter for QBNLPGMI API (List ILE Program Information).
D Bi_ILEPgmName 20
D SY0040R PI
D Bi_ILEPgmName 20
//*************************************************************************
// File information data structure.
D SY0040DS DS Infds Data Structure
D Cur_RRN 376 377B 0 Current Sfile RRN
D Cur_Page 378 379B 0 RRN Current Page
//*************************************************************************
// Program status data structure.
D SDS System Data Struct.
D ErrorData 91 170 Error data
//*************************************************************************
// Definitions for user space information.
D Gn_Pointer S * Generic Header Ptr
//*************************************************************************
// Generic user space header.
D Gn_Header DS Based(Gn_Pointer)
D Gn_UserArea 64 User Area
D Gn_HdrSize 8B 0 Generic Header Size
D Gn_RlsLevel 4 Release and Level
D Gn_Format 8 Format Name
D Gn_APIUsed 10 API Used
D Gn_CreateSt 13 TimeStamp Created
D Gn_InfoStat 1 Information Status
D Gn_SizeUsed 8B 0 Space Size Used
D Gn_InputOff 8B 0 Input Section Offset
D Gn_InputSize 8B 0 Input Section Size
D Gn_HeadrOff 8B 0 Header Offset
D Gn_HeadrSize 8B 0 Header Size
D Gn_ListOff 8B 0 Offset to List
D Gn_ListSize 8B 0 List Size
D Gn_Entries 8B 0 Number of Entries
D Gn_EntrySize 8B 0 Entry Size
//*************************************************************************
// List Pointers.
D Pt_SPGL0100 S *
D Pt_SPGL0200 S *
//*************************************************************************
// List module information section.
D Ls_SPGL0100 DS Based(Pt_SPGL0100)
D Md_Program 10 Program Name
D Md_Library 10 Library Name
D Md_Module 10 Module Name
D Md_ModuleLib 10 Module Library
D Md_SrcFile 10 Source File Name
D Md_SrcLib 10 Source Library Name
D Md_SrcMember 10 Source Member Name
D Md_ModuleAtt 10 Module Attribute
D Md_ModuleCrt 13 Creation Time Stamp
D Md_SrcUpdate 13 Last Update TimeStmp
D Md_SortTable 10 Sort Table
D Md_SortLib 10 Sort Library
D Md_LangId 10 Language Identifier
D Md_OptLevel 8B 0 Optimization Level
D Md_MaxOpt 8B 0 Max Optimization Lvl
D Md_ModCrtRls 6 Release Created On
D Md_ModCrtFor 6 Module Created For
D Md_Reserved 20 Reserved
D Md_UsrMod 1 User Modified
D Md_LicPgm 13 Licensed Program
D Md_PTFNumber 5 PTF Number
D Md_APARId 6 APAR Id
D Md_Reserv2 1 Reserved again
D Md_ModCCSID 8B 0 Module CCSID
D Md_ObjCtrLvl 8 Object Control Level
D Md_Reserv3 100 One more time
D Md_SqlStmt 8B 0 No SQL Statements
D Md_RelDbase 18 Relational Database
D Md_CommitCtr 10 Commitment Control
D Md_AlwCpyDta 10 Allow Copy of Data
D Md_CloseSql 10 Close SQL Cursors
D Md_NameConv 10 Naming Convention
D Md_DateFmt 10 Date Format
D Md_DateSep 1 Date Seperator
D Md_TimeFmt 10 Time Format
D Md_TimeSep 1 Time Seperator
D Md_DelayPrep 10 Delay PREPARE
D Md_AllowBlck 10 Allow Blocking
D Md_DftColl 10 Default Collection
D Md_SQLPkg 10 SQL Package Name
D Md_SQLPLib 10 SQL Package Library
D Md_DynUser 10 Dynamic User Profile
D Md_SQLSTbl 10 SQL Sort Table
D Md_SQLSLib 10 SQL Sort Library
D Md_SQLLang 10 SQL Language Id
D Md_ConnMth 10 Connection Method
//*************************************************************************
// Service program information data structure.
D Ls_SPGL0200 DS Based(Pt_SPGL0200)
D Sp_Program 10 Program Name
D Sp_Library 10 Program Library
D Sp_Service_Program... Service Program
D 10
D Sp_Service_Library... Service Library
D 10
D Sp_Service_Signature...
D 16 Signature
//*************************************************************************
// Retrieve Program Information Return Variable.
D Si_SPGI0100 DS
D Si_BytesAva 8B 0 Bytes Available
D Si_BytesRet 8B 0 Bytes Returned
D Si_Program_Name...
D 10 Program Name
D Si_Program_Library...
D 10 Program Library
D Si_Program_Owner...
D 10 Program Owner
D Si_Program_Attribute...
D 10 Program Attribute
D Si_Create_Date_Time...
D 13 Create Date/Time
D Si_Export_Source_File...
D 10 Export Source File
D Si_Export_Source_File_Library...
D 10 Export Source Lib
D Si_Export_Source_Member...
D 10 Export Source Member
D Si_Activation_Group_Attr...
D 30 Activation Group Atr
D Si_Current_Signature...
D 16 Current Export Sig.
D Si_User_Profile...
D 1 User Profile
D Si_Observable_Information_Compressed...
D 1 Observable Compress
D Si_Run_Time_Information_Compressed...
D 1 Run Time Compressed
D Si_Program_CCSID...
D 8B 0 Program CCSID
D Si_Number_of_Modules...
D 8B 0 Number of Modules
D Si_Number_of_Service_Programs...
D 8B 0 Number of Serv Pgms
D Si_Number_of_Copyrights...
D 8B 0 Number of Copyrights
D Si_Desciption...
D 50 Program Description
D Si_Shared_Activation_Group...
D 1 Shared Act. Group?
D Si_Allow_Update...
D 1 Allow Update?
D Si_Number_of_Unresolved_References...
D 8B 0 # of Unresolved Refs
D Si_Use_Adopted_Auth...
D 1 Use Adopted Auth.
D Si_Allow_Bound_Service_Library_Update...
D 1 Allow Service Update
D Si_Profiling_Data...
D 10 Profiling Data
D Si_Reserved1 82 IBM Reserved
D Si_Program_State...
D 1 Program State
D Si_Program_Domain...
D 1 Program Domain
D Si_Associated_Space_Size...
D 8B 0 Associated Size
D Si_Static_Storage...
D 8B 0 Static Storage
D Si_Program_Size...
D 8B 0 Program Size
D Si_Release_Created...
D 6 Release Created On
D Si_Earliest_Run_Release...
D 6 Earliest Run Rls.
D Si_Release_Created_For...
D 6 Release Created For
D Si_ReInit_Static_Storage...
D 1 Allow Reinit.
D Si_Conversion_Required...
D 1 Conversion Required?
D Si_All_Creation_Data...
D 1 All Creation Data
D Si_Reserved2 91 IBM Reserved
D Si_Paging_Pool...
D 1 Paging Pool
D Si_Paging_Amount...
D 1 Paging Amount
//*************************************************************************
// API Error code parameter for those that need it.
D DS_ErrorCode DS
D ER_BytesPrv 8B 0 Inz(256) Bytes Provided
D ER_BytesAva 8B 0 Bytes Available
D ER_ExcId 7 Exception Id
D ER_Reserved 1 Reserved
D ER_Data 256 Exception Data
//*************************************************************************
// API Dummy Error Code.
D DS_DummyError DS
D DE_BytesPrv 8B 0 Inz(0) Bytes Provided
//*************************************************************************
// Retrieve Object description return data.
D DS_OBJD0200 DS
D OB_BytesRet 8B 0 Bytes Returned
D OB_BytesAva 8B 0 Bytes Available
D OB_Object 10 Object Name
D OB_Library 10 Object Library
D OB_Type 10 Object Type
D OB_Return_Library...
D 10 Return Library
D OB_ASP 8B 0 Aux Storage Pool
D OB_Owner 10 Object Owner
D OB_Domain 2 Object Domain
D OB_Create_Date_Time...
D 13 Create Date/Time
D OB_Change_Date_Time...
D 13 Change Date/Time
D OB_Extended_Attribute...
D 10 Extended Attribute
D OB_Text 50 Text Description
D OB_SourceFile 10 Source File
D OB_SourceLib 10 Source Library
D OB_SourceMbr 10 Source Member
//*************************************************************************
// Retrieve Request Message return data.
D DS_RTVQ0100 DS
D RM_BytesRet 8B 0 Bytes Returned
D RM_BytesAva 8B 0 Bytes Available
D RM_MsgKey 4 Message Key
D RM_Reserved 20 IBM Reserved
D RM_LengthRet 8B 0 Length Returned
D RM_LengthAva 8B 0 Length Available
D RM_Text 32000 Message Data
// Retrieve Program Message return data.
D DS_RCVM0100 DS
D RC_BytesRet 8B 0 Bytes Returned
D RC_BytesAva 8B 0 Bytes Available
D RC_MsgSev 8B 0 Message Severity
D RC_MsgId 7 Message Identifier
D RC_MsgType 2 Message Type
D RC_MsgKey 4 Message Key
D RC_Reserved 7 Reserved
D RC_CCSIDStat 8B 0 CCSID Conv Status
D RC_CCSIDRepl 8B 0 CCSID Replace Data
D RC_ReplRet 8B 0 Replace Data Return
D RC_ReplAva 8B 0 Replace Data Avail
D RC_Text 32000 Message Data
//*************************************************************************
// Process commands control block.
D DS_CPOP0100 DS
D CP_Type 8B 0 Inz(3) Type of Processing
D CP_DBCS 1 Inz('0') DBCS Data Handling
D CP_PromptAct 1 Prompter Action
D CP_CmdSyntax 1 Inz('0') Command String Syntx
D CP_MsgKey 4 Inz(*Blanks) Message Retrieve Key
D CP_Reserved 9 Inz(X'000000000000000000') IBM Reserved
//*************************************************************************
// QUSROBJD - Retrieve object description.
D POB_Length S 8B 0 Inz(%Size(DS_OBJD0200))
D POB_Format S 8 Inz('OBJD0200')
D POB_QLObject S 20 Qualified Object
D POB_ObjectType S 10 Inz('*MODULE') Object Type
//*************************************************************************
// Parameters for QUSCRTUS API (Create User Space) for Modules
D Md_SpaceName S 20 Inz('ILEPGM QTEMP') Qualified Space Name
D Md_ExtAttr S 10 Inz('WRKILEPGM') Extended Attribute
D Md_InitSize S 8B 0 Inz(%Size(Ls_SPGL0100))
D Md_InitValue S 1 Inz(X'00')
D Md_PubAuth S 10 Inz('*ALL') Public Authority
D Md_Text S 50 Inz('User Space for WRKILEPGM') User Space Text
D Md_Replace S 10 Inz('*YES') Replace Object
//*************************************************************************
// Parameters for QUSCRTUS API (Create User Space) for Service Programs
D Sp_SpaceName S 20 Inz('SRVPGM QTEMP') Qualified Space Name
D Sp_ExtAttr S 10 Inz('WRKILEPGM') Extended Attribute
D Sp_InitSize S 8B 0 Inz(%Size(Ls_SPGL0200))
D Sp_InitValue S 1 Inz(X'00')
D Sp_PubAuth S 10 Inz('*ALL') Public Authority
D Sp_Text S 50 Inz('User Space for WRKILEPGM') User Space Text
D Sp_Replace S 10 Inz('*YES') Replace Object
//*************************************************************************
// Parameters for QBNLSPGM API (List ILE Program Information).
D Bi_Format S 10 API Format to Return
//*************************************************************************
// Parameters for QBNRSPGM API (Retrieve Program Information).
D Si_Data_Length S 4B 0 Inz(%Size(Si_SPGI0100)) Data Length
//*************************************************************************
// QMHRMVPM - Remove program messages API.
D PRM_CallQ S 10 Inz('*') Call Message Queue
D PRM_CallStack S 8B 0 Inz(1) Call Stack Counter
D PRM_MsgKey S 4 Message Key
D PRM_MsgToRemove...
D S 10 Inz('*ALL') Messages To Remove
//*************************************************************************
// QMHRSNDPM - Send program messages API.
D PSM_MsgID S 8 Inz('CPF9897') Message Identifier
D PSM_QLMsgFile S 20 Inz('QCPFMSG *LIBL') Qualified Msg File
D PSM_Length S 8B 0 Inz(%Size(ErrorMessage)) Message Length
D PSM_MsgType S 10 Inz('*INFO') Message Type
D PSM_CallQ S 10 Inz('*') Call Message Queue
D PSM_CallStack S 8B 0 Inz(1) Call Stack Counter
D PSM_MsgKey S 4 Message Key
//*************************************************************************
// QMHRSNDPM - Send program messages API parameters for request messages.
D RSM_MsgID S 8 Inz(' ') Message Identifier
D RSM_QLMsgFile S 20 Inz(' ') Qualified Msg File
D RSM_Length S 8B 0 Inz(%Size(CommandLine)) Message Length
D RSM_MsgType S 10 Inz('*RQS') Message Type
D RSM_CallQ S 10 Inz('*') Call Message Queue
D RSM_CallStack S 8B 0 Inz(0) Call Stack Counter
D RSM_MsgKey S 4 Message Key
/Eject
//*************************************************************************
// Procedure definitions.
//*************************************************************************
// Create User Space.
D QUsCrtUs PR ExtPgm('QUSCRTUS')
D SpaceName 20 Qualified Space Name
D ExtAttr 10 Extended Attribute
D InitSize 8B 0 Initial Size
D InitValue 1 Initial Value
D PubAuth 10 Public Authority
D Text 50 User Space Text
D Replace 10 Replace Object
D ErrorCode Like(DS_ErrorCode) Error Code
//*************************************************************************
// Delete User Space.
D QUsDltUs PR ExtPgm('QUSDLTUS')
D SpaceName 20 Qualified Space Name
D ErrorCode Like(DS_ErrorCode) Return Error Code
//*************************************************************************
// Retrieve Pointer to User Space.
D QUsPtrUs PR ExtPgm('QUSPTRUS')
D SpaceName 20 Qualified Space Name
D RetPointer * Return Pointer
D ErrorCode Like(DS_ErrorCode) Return Error Code
//*************************************************************************
// Retrieve ILE Program Information.
D QBnlSPgm PR ExtPgm('QBNLSPGM')
D SpaceName 20 Qualified Space Name
D FormatName 8 Format Name
D ILEProgram 20 Qualified Pgm Name
D ErrorCode Like(DS_ErrorCode) Error Code
//*************************************************************************
// Send program message API.
D Send_PgmMessage...
D PR ExtPgm('QMHSNDPM') Send Pgm Message
D 7 Message Id
D 20 Qualified Msg File
D 32767 Options(*VarSize) Message Data
D 8B 0 Length of Msg Data
D 10 Message Type
D 32767 Options(*VarSize) Call Message Queue
D 8B 0 Call Stack Counter
D 4 Message Key
D 32767 Options(*VarSize) Error Code
//*************************************************************************
// Receive request message API.
D Receive_RqsMessage...
D PR ExtPgm('QMHRTVRQ') Receive Pgm Message
D 32767 Options(*VarSize) Message Data
D 8B 0 Const Length of Msg Data
D 8 Const Format Name
D 10 Const Message Type
D 4 Const Message Key
D 32767 Options(*VarSize) Error Code
//*************************************************************************
// Receive program message API.
D Receive_PgmMessage...
D PR ExtPgm('QMHRCVPM') Receive Pgm Message
D 32767 Options(*VarSize) Message Data
D 8B 0 Const Length of Msg Data
D 8 Const Format Name
D 32767 Options(*VarSize) Const Call Stack Entry
D 8B 0 Const Call Stack Counter
D 10 Const Message Type
D 4 Const Message Key
D 8B 0 Const Wait Time
D 10 Const Message Action
D 32767 Options(*VarSize) Error Code
//*************************************************************************
// Remove program message API.
D Remove_PgmMessage...
D PR ExtPgm('QMHRMVPM') Remove Messages
D 32767 Options(*VarSize) Call Message Queue
D 8B 0 Call Stack Counter
D 4 Message Key
D 10 Messages to Remove
D 32767 Options(*VarSize) Error Code
//*************************************************************************
// Retrieve Program Information (QBNRSPGM)
D QBnrSPgm PR ExtPgm('QBNRSPGM')
D 32767 Options(*VarSize) Returned Data
D 4B 0 Receiver Var Length
D 8 Format Name
D 20 Qualified Program
D 32767 Options(*VarSize) Error Code
//*************************************************************************
// Commands for each module attribute.
D C S 5U 0 Lookup Array Index
D ModAtt S 10 Dim(10) CtData PerRcd(1) Module Attribute
D ModCmd S 10 Dim(%Elem(ModAtt)) CtData PerRcd(1) Module Create Cmds
D BndCmd S 10 Dim(%Elem(ModAtt)) CtData PerRcd(1) Bound Pgm Commands
//*************************************************************************
// Clear Message Procedure.
D Clear_Message PR
//*************************************************************************
// Send Message Procedure.
D Send_Message PR
D Message 32767 Options(*VarSize)
//*************************************************************************
// Display Service program procedure.
D Disp_Service_Program...
D PR N
//*************************************************************************
// Print list procedure.
D Print_List PR
//*************************************************************************
// Retrieve Object Description API.
D QUsrObjD PR ExtPgm('QUSROBJD') Retrieve Object Desc
D 32767 Options(*VarSize) Return Data
D 8B 0 Length of Receiver
D 8 Format Name
D 20 Qualified Obj Name
D 10 Object Type
D 32767 Options(*VarSize) Error Code
//*************************************************************************
// QCMDEXEC API.
D QCmdExec PR ExtPgm('QCMDEXC')
D CommandLine 32702 Options(*VarSize)
D CommandLength...
D 15 5
// QCMDCHK API.
D QCmdCheck PR ExtPgm('QCMDCHK')
D CommandLine 32702 Options(*VarSize)
D CommandLength...
D 15 5
//*************************************************************************
// QCAPCMD API.
D QCapCommand PR ExtPgm('QCAPCMD')
D 32702 Options(*VarSize) Const Command Line Passed
D 8B 0 Const Command Line Length
D 32702A Options(*VarSize) Const Options Block
D 8B 0 Const Options Block Length
D 8 Const Options Block Format
D 32702A Options(*VarSize) Changed Command Str
D 8B 0 Const Ret Cmd Available
D 8B 0 Length Returned
D 32702A Options(*VarSize: *Omit) Error Return Code
//*************************************************************************
// Build a binding directory.
D Build_Directory...
D PR N
//*************************************************************************
// Convert to Hex.
D CvtToHex PR OpDesc
D InString 16383 Const Options(*VarSize)
D HexString 32766 Options(*VarSize)
//*************************************************************************
// Add an entry to the command line history buffer.
D Add_Command_Line...
D PR OpDesc
D CommandLine 32702 Options(*VarSize)
//*************************************************************************
// Retrieve the next entry in the history buffer.
D Retrieve_Command_Line...
D PR Like(CommandLine)
//*************************************************************************
// Attach command line to command.
D Attach_Options...
D PR 32702 OpDesc
D 32702 Options(*VarSize) Command Line
D 32702 Options(*VarSize) Options to Attach
/Eject
/Free
//*************************************************************************
//* Create the user spaces in QTEMP.
PGMQ = '*';
Clear ER_ExcId;
//*************************************************************************
// Create user space for module display.
QUsCrtUs(Md_SpaceName: Md_ExtAttr:
Md_InitSize: Md_InitValue: Md_PubAuth:
Md_Text: Md_Replace: DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
Return;
Endif; //Not (ER_ExcId...
//*************************************************************************
// Create the user space for service program display.
QUsCrtUs(Sp_SpaceName: Sp_ExtAttr:
Sp_InitSize: Sp_InitValue: Sp_PubAuth:
Sp_Text: Sp_Replace: DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
Return;
Endif; //Not (ER_ExcId...
*IN88 = *Off; //Display Dft Keys
Dow Not *INLR;
//*************************************************************************
// Call the Retrieve Program Information API.
Clear ER_ExcId;
Bi_Format = 'SPGI0100';
QBnrSPgm(Si_SPGI0100: Si_Data_Length:
Bi_Format: Bi_ILEPgmName: DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Return;
Endif; //Not (ER_ExcId...
//*************************************************************************
// Call the Get ILE Program Information API for modules information.
Clear ER_ExcId;
Bi_Format = 'SPGL0100';
QBnlSPgm(Md_SpaceName: Bi_Format:
Bi_ILEPgmName: DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Return;
Endif; //Not (ER_ExcId...
//*************************************************************************
// Call the Get ILE Program Information API for service program information.
Clear ER_ExcId;
Bi_Format = 'SPGL0200';
QBnlSPgm(Sp_SpaceName: Bi_Format:
Bi_ILEPgmName: DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Return;
Endif; //Not (ER_ExcId...
//*************************************************************************
// Load the top of screen data.
SAPROGRAM = Si_Program_Name;
SAPGMLIB = Si_Program_Library;
CvtToHex(Si_Current_Signature: SASIGNAT);
//*************************************************************************
// Retrieve the pointer to the user space for module information.
Clear ER_ExcId;
QUsPtrUs(Md_SpaceName: Gn_Pointer:
DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Return;
Endif; //Not (ER_ExcId...
//*************************************************************************
// Now we can load the subfile for module information.
*IN66 = *On;
Write SY0040C1;
*IN66 = *Off;
Pt_SPGL0100 = Gn_Pointer + Gn_ListOff;
NotExist = *Off;
For Recno1 = 1 to Gn_Entries;
If Recno1 <= *Zeros;
Leave;
Endif; //Recno1<=*Zeros
*IN67 = *On;
Clear SAOPTION;
SAMODULE = Md_Module;
SALIBRARY = Md_ModuleLib;
SASOURCE = Md_SrcFile;
SASRCLIB = Md_SrcLib;
SAMEMBER = Md_SrcMember;
SAMODATTR = Md_ModuleAtt;
// If the create date is not blanks, convert the date and time.
If Not (Md_ModuleCrt = *Blanks);
SACREATEDT = %Char(%Date(%Subst(Md_ModuleCrt: 1: 7):
*CYMD0): *MDY/);
SACREATETM = %Char(%Time(%Subst(Md_ModuleCrt: 8: 6):
*HMS0): *HMS:);
Endif; //Not (Md_Module...
// If the source update date is not blanks, convert the date and time.
If Not (Md_SrcUpdate = *Blanks);
SASRCCHGDT = %Char(%Date(%Subst(Md_SrcUpdate: 1: 7):
*CYMD0): *MDY/);
SASRCCHGTM = %Char(%Time(%Subst(Md_SrcUpdate: 8: 6):
*HMS0): *HMS:);
Endif; //Not (Md_SrcUpdate...
// Clear the exception Id.
Clear Er_ExcId;
POB_QLObject = SAMODULE + SALIBRARY;
POB_ObjectType = '*MODULE';
QUsrObjD(DS_OBJD0200: POB_Length: POB_Format:
POB_QLObject: POB_ObjectType: DS_ErrorCode);
If Not (Er_ExcId = *Blanks);
NotExist = *On;
SAMODTEXT = '* Not Available';
Else;
SAMODTEXT = OB_Text;
Endif; //Not (Er_ExcId...
Write SY0040S1;
Pt_SPGL0100 = Pt_SPGL0100 + Gn_EntrySize;
EndFor; //Do Gn_Entries
//*************************************************************************
// Retrieve the pointer to the user space for service program information.
Clear ER_ExcId;
QUsPtrUs(Sp_SpaceName: Gn_Pointer:
DS_ErrorCode);
If Not (ER_ExcId = *Blanks);
Exsr Exception_Err;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Return;
Endif; //Not (ER_ExcId...
// Now we can load the subfile for module information.
*IN68 = *On;
Write SY0040C5;
*IN68 = *Off;
Pt_SPGL0200 = Gn_Pointer + Gn_ListOff;
NotExist = *Off;
For Recno5 = 1 to Gn_Entries;
If Recno5 <= *Zeros;
Leave;
Endif; //Recno5<=*Zeros
*IN69 = *On;
SESRVPGM = Sp_Service_Program;
SESRVLIB = Sp_Service_Library;
Clear Er_ExcId;
POB_ObjectType = '*SRVPGM';
POB_QLObject = Sp_Service_Program +
Sp_Service_Library;
QUsrObjD(DS_OBJD0200: POB_Length: POB_Format:
POB_QLObject: POB_ObjectType: DS_ErrorCode);
If Not (Er_ExcId = *Blanks);
NotExist = *On;
SETEXT = '* Not Available';
Else;
SETEXT = OB_Text;
Endif; //Not (Er_ExcId...
SESHTEXT = SETEXT;
Write SY0040S5;
Pt_SPGL0200 = Pt_SPGL0200 + Gn_EntrySize;
EndFor; //Do Gn_Entries
//*************************************************************************
// Clear the subfile message queue.
Clear_Message();
ErrorMessage = *Blanks;
Send_Message(ErrorMessage);
SFLCT1 = 1;
//*************************************************************************
// Read and process the screen.
Dow Not *INLR;
Write MSGSFC1;
Write SY0040B1;
If Not *IN67;
Write SY004002;
Endif; //Not *IN67
Write SY0040C1;
Read SY0040B1;
Read SY0040C1;
Sav_Cur_Page = Cur_Page;
*IN99 = *Off;
Clear_Message();
Clear ErrorMessage;
If Not (Sav_Cur_Page = 0);
SFLCT1 = Sav_Cur_Page;
Endif; //Not(Cur_Page...
// Set the cursor location.
CSRROW = RTNROW;
CSRCOL = RTNCOL;
//*************************************************************************
// Handle Function Keys.
Select;
//*************************************************************************
// Exit program.
When *IN03; //F3=Exit
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
*INLR = *On;
Leave;
//*************************************************************************
// Refresh list.
When *IN05; //F5=Refresh
Clear SACMDLINE;
Leave;
//*************************************************************************
// Add a module to program.
When *IN06; //F6=Add Module
ErrorMessage = 'Function not currently -
supported';
Send_Message(ErrorMessage);
Iter;
//*************************************************************************
// Retrieve a previous command line.
When *IN09; //F9=Retrieve
CSRROW = CmdRow;
CSRCOL = CmdCol;
*IN99 = *On;
SACMDLINE = Retrieve_Command_Line;
Iter;
//*************************************************************************
// Cancel from main screen.
When *IN12; //F12=Cancel
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
*INLR = *On;
Leave;
//*************************************************************************
// Build a binding directory from current module list.
When *IN13; //F13=Build Directory
If Si_Activation_Group_Attr = '*DFTACTGRP';
ErrorMessage = 'Cannot build binding direct-
ory for a DFTACTGRP program.';
Send_Message(ErrorMessage);
Iter;
Endif; //Si_Activation...
Cancelled = Build_Directory;
If Cancelled;
ErrorMessage = ErrorData;
Send_Message(ErrorMessage);
Iter;
Else;
ErrorMessage = 'Binding directory built for -
program ' + %Trimr(SAPGMLIB) + '/' +
%Trimr(SAPROGRAM) + '.';
Send_Message(ErrorMessage);
Iter;
Endif; //Cancelled
//*************************************************************************
// Display program information.
When *IN14;
CommandLine = 'DSPSRVPGM SRVPGM(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM) +
')';
CommandLength = %Size(CommandLine);
Callp(E) QCmdExec(CommandLine: CommandLength);
Iter;
//*************************************************************************
// Rebuild all modules in the list.
When *IN18; //F18=Rebuild All Mods
If Si_Activation_Group_Attr = '*DFTACTGRP';
ErrorMessage = 'Cannot rebuild a default act-
ivation group program. Use option 15.';
Send_Message(ErrorMessage);
Iter;
Endif; //Si_Activation...
CommandLength = %Size(CommandLine);
Recno1 = 1;
// Read through the entire subfile.
Chain Recno1 SY0040S1;
Dow %Found;
// Find the appropriate command for the create.
C = 1;
C = %Lookup(SAMODATTR: ModAtt);
If Not (C = 0);
/If Defined(Target_Release)
CommandLine = %Trimr(ModCmd(C)) +
' MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') SRCMBR(' +
%Trimr(SAMEMBER) + ') ' + 'TGTRLS(' +
Si_Release_Created_For + ')';
/Else
CommandLine = %Trimr(ModCmd(C)) +
' MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') SRCMBR(' +
%Trimr(SAMEMBER) + ')';
/Endif
Else;
ErrorMessage = 'Module attribute ' +
%Trimr(SAMODATTR) +
' for member ' + %Trimr(SAMEMBER) +
' is not supported.';
Send_Message(ErrorMessage);
Endif; //%Equal
// Submit it to batch.
ErrorMessage = 'The compile of ' +
%Trimr(SAMODULE) + ' has been submitted to batch';
Send_Message(ErrorMessage);
CommandLine = 'SBMJOB CMD(' +
%Trimr(CommandLine) + ') JOB(' +
%Trimr(SAMEMBER) + ')';
QCmdExec(CommandLine: CommandLength);
Recno1 = Recno1 + 1;
Chain Recno1 SY0040S1;
Enddo; //%Found
Iter;
//*************************************************************************
//* Rebuild program.
When *IN19; //F19=Rebuild Program
If Si_Activation_Group_Attr =
'*DFTACTGRP';
ErrorMessage = 'Cannot rebuild a default -
activation group service program. Use -
option 15.';
Send_Message(ErrorMessage);
Iter;
Endif; //Si_Activation...
If NotExist;
ErrorMessage = 'Cannot rebuild. One or more-
modules are missing.';
Send_Message(ErrorMessage);
Iter;
Else;
CommandLength = %Size(CommandLine);
CommandLine = '?CRTSRVPGM ?*SRVPGM(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM) +
') MODULE(';
// Build the module list.
Recno1 = 1;
Chain Recno1 SY0040S1;
Dow %Found;
CommandLine = %Trimr(CommandLine) + ' ' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE);
Recno1 = Recno1 + 1;
Chain Recno1 SY0040S1;
Enddo; //%Found
// Build the service program list.
CommandLine = %Trimr(CommandLine) +
') BNDSRVPGM(';
Recno5 = 1;
Chain Recno5 SY0040S5;
Dow %Found;
CommandLine = %Trimr(CommandLine) + ' ' +
%Trimr(SESRVLIB) + '/' + %Trimr(SESRVPGM);
Recno5 = Recno5 + 1;
Chain Recno5 SY0040S5;
Enddo; //%Found
// Tack on the compile release.
/If Defined(Target_Release)
CommandLine = %Trimr(CommandLine) +
') TGTRLS(' +
Si_Release_Created_For + ')';
/Else
CommandLine = %Trimr(CommandLine) +
')';
/Endif
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
// Display the command prior to submitting.
Clear_Message();
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
Iter;
Endif; //%Error
ErrorMessage = 'The create of program ' +
%Trimr(SAPROGRAM) + ' has been submitted to batch';
Send_Message(ErrorMessage);
CommandLine = 'SBMJOB CMD(' +
%Trimr(CommandLine) + ') JOB(' +
%Trimr(SAPROGRAM) + ')';
QCmdExec(CommandLine: CommandLength);
Iter;
Endif; //NotExist
//*************************************************************************
// Display service programs.
When *IN20; //F20=Display Service
*INLR = Disp_Service_Program; // Programs
If *INLR;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Leave;
Endif; //*INLR
Iter;
//*************************************************************************
// Print all modules and service programs.
When *IN21; //F21=Print List
Print_List();
ErrorMessage = 'The list has been printed';
Send_Message(ErrorMessage);
Iter;
//*************************************************************************
// Display next function key list.
When *IN24; //F24=More Keys
*IN88 = Not *IN88;
Iter;
//*************************************************************************
// Pageup
When *IN25; //PageUp
ErrorMessage =
'You have reached the top of the list.';
Send_Message(ErrorMessage);
Iter;
//*************************************************************************
// Pagedown
When *IN26; //PageDown
ErrorMessage =
'You have reached the bottom of the list.';
Send_Message(ErrorMessage);
Iter;
Endsl;
Readc SY0040S1;
//*************************************************************************
// Edit check options.
No_Selection = *On;
Dow Not %Eof;
*IN30 = *Off; //Reverse Image
Select;
When SAOPTION = *Blanks;
*IN50 = *Off; //SFLNXTCHG
//*************************************************************************
// Edit source member.
When SAOPTION = '2 ' or SAOPTION = '02' or
SAOPTION = ' 2';
*IN50 = *On; //SFLNXTCHG
No_Selection = *Off;
*IN99 = *Off;
//*************************************************************************
// Display source member.
When SAOPTION = '5 ' or SAOPTION = '05' or
SAOPTION = ' 5';
*IN50 = *On; //SFLNXTCHG
No_Selection = *Off;
*IN99 = *Off;
//*************************************************************************
// Display module details.
When SAOPTION = '8 ' or SAOPTION = '08' or
SAOPTION = ' 8';
*IN50 = *On; //SFLNXTCHG
No_Selection = *Off;
*IN99 = *Off;
//*************************************************************************
// Rebuild module.
When SAOPTION = '15';
*IN50 = *On; //SFLNXTCHG
No_Selection = *Off;
*IN99 = *Off;
//*************************************************************************
// Update program with current module.
When SAOPTION = '16';
*IN50 = *On; //SFLNXTCHG
No_Selection = *Off;
*IN99 = *Off;
//*************************************************************************
// Otherwise, an error.
Other;
*IN30 = *On; //Reverse Image
ErrorMessage =
'Specified option number is not allowed.';
Send_Message(ErrorMessage);
*IN50 = *On; //SFLNXTCHG
No_Selection = *Off;
*IN99 = *Off;
SFLCT1 = RECNO1;
Endsl;
Update SY0040S1;
Readc SY0040S1;
Enddo; //Not %Eof
//*************************************************************************
// Handle if a command line entered and no selection made.
If No_Selection and Not (SACMDLINE = *Blanks);
CommandLine = SACMDLINE;
CommandLength = %Size(CommandLine);
// Either edit check the command line or, if prompted, prompt.
If *IN04; //If prompted
CP_PromptAct = '1';
Callp(E) QCapCommand(CommandLine: CommandLength:
DS_CPOP0100: %Size(DS_CPOP0100): 'CPOP0100':
CommandLine: CommandLength: Bin04:
DS_DummyError);
Else;
Callp(E) QCmdCheck(CommandLine: CommandLength);
Endif; //*IN04
If %Error;
Add_Command_Line(CommandLine); //If error, retain.
*IN99 = *On; //Position to Line
CSRROW = CmdRow;
CSRCOL = CmdCol;
Iter;
Endif; //%Error
Add_Command_Line(CommandLine); //Save command
*IN99 = *On; //Position to Line
CSRROW = CmdRow;
CSRCOL = CmdCol;
// Then run it.
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
Iter;
Endif; //%Error
Clear SACMDLINE;
Iter;
Endif; //No_Selection...
//*************************************************************************
// If not selection made and F4=Prompt hasn't been pressed, assume exit.
If No_Selection and Not *IN04;
*INLR = *On;
QUsDltUs(Md_SpaceName: DS_ErrorCode);
QUsDltUs(Sp_SpaceName: DS_ErrorCode);
Leave;
Endif; //No_Selection...
//*************************************************************************
// If no selection was made and prompting was pressed,
// display error message.
If No_Selection and *IN04;
ErrorMessage =
'Prompting is not allowed at this time.';
Send_Message(ErrorMessage);
Iter;
Endif; //No_Selection...
If Not (ErrorMessage = *Blanks);
Iter;
Endif; //Not (ErrorMessage...
//*************************************************************************
// Handle options.
Readc SY0040S1;
Dow Not %Eof;
Select;
//*************************************************************************
// Edit module source with SEU.
When SAOPTION = '2 ' or SAOPTION = '02' or
SAOPTION = ' 2';
SFLCT1 = RECNO1;
CommandLength = %Size(CommandLine);
If *IN04; //F4=Prompt
CommandLine = '?STRSEU ?*SRCFILE(' +
%Trimr(SASRCLIB) + '/' + %Trimr(SASOURCE) +
') ?*SRCMBR(' + %Trimr(SAMEMBER) +
') ?*TYPE(' + %Trimr(SAMODATTR) +
') ?*OPTION(2)';
Else;
CommandLine = 'STRSEU SRCFILE(' +
%Trimr(SASRCLIB) + '/' + %Trimr(SASOURCE) +
') SRCMBR(' + %Trimr(SAMEMBER) +
') TYPE(' + %Trimr(SAMODATTR) + ') OPTION(2)';
Endif; //*IN04
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Clear SAOPTION;
Update SY0040S1;
//*************************************************************************
// Display module source with SEU.
When SAOPTION = '5 ' or SAOPTION = '05' or
SAOPTION = ' 5';
SFLCT1 = RECNO1;
CommandLength = %Size(CommandLine);
If *IN04; //F4=Prompt
CommandLine = '?STRSEU ?*SRCFILE(' +
%Trimr(SASRCLIB) + '/' + %Trimr(SASOURCE) +
') ?*SRCMBR(' + %Trimr(SAMEMBER) +
') ?*TYPE(' + %Trimr(SAMODATTR) +
') ?*OPTION(5)';
Else;
CommandLine = 'STRSEU SRCFILE(' +
%Trimr(SASRCLIB) + '/' + %Trimr(SASOURCE) +
') SRCMBR(' + %Trimr(SAMEMBER) +
') TYPE(' + %Trimr(SAMODATTR) + ') OPTION(5)';
Endif; //*IN04
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Clear SAOPTION;
Update SY0040S1;
//*************************************************************************
// Display module information.
When SAOPTION = '8 ' or SAOPTION = '08' or
SAOPTION = ' 8';
SFLCT1 = RECNO1;
If *IN04; //Prompted?
CommandLine = '?DSPMOD ?*MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
')';
Else; //Not Prompted
CommandLine = 'DSPMOD MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
')';
Endif; //*IN04
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
CommandLength = %Size(CommandLine);
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Clear SAOPTION;
Update SY0040S1;
//*************************************************************************
// Rebuild module.
When SAOPTION = '15';
SFLCT1 = RECNO1;
CommandLength = %Size(CommandLine);
// If prompted
If *IN04; //F4=Prompt
If Not (Si_Activation_Group_Attr =
'*DFTACTGRP');
// Find the appropriate command for the create.
C = 1;
C = %Lookup(SAMODATTR: ModAtt);
If Not (C = 0);
/If Defined(Target_Release)
CommandLine = '?' + %Trimr(ModCmd(C)) +
' ?*MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') ?*SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') ?*SRCMBR(' +
%Trimr(SAMEMBER) + ') ' + 'TGTRLS(' +
Si_Release_Created_For + ')';
/Else
CommandLine = '?' + %Trimr(ModCmd(C)) +
' ?*MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') ?*SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') ?*SRCMBR(' +
%Trimr(SAMEMBER) + ')';
/Endif
Else;
ErrorMessage = 'Module attribute ' +
%Trimr(SAMODATTR) +
' for member ' + %Trimr(SAMEMBER) +
' is not supported.';
Send_Message(ErrorMessage);
Endif; //%Equal
Else;
// Find the appropriate command for the create.
C = 1;
C = %Lookup(SAMODATTR: ModAtt);
If Not (C = 0);
/If Defined(Target_Release)
CommandLine = '?' + %Trimr(BndCmd(C)) +
' ?*PGM(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') ?*SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') ?*SRCMBR(' +
%Trimr(SAMEMBER) + ') ' + 'TGTRLS(' +
Si_Release_Created_For + ')';
/Else
CommandLine = '?' + %Trimr(BndCmd(C)) +
' ?*PGM(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') ?*SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') ?*SRCMBR(' +
%Trimr(SAMEMBER) + ')';
/Endif
Else;
ErrorMessage = 'Module attribute ' +
%Trimr(SAMODATTR) +
' for member ' + %Trimr(SAMEMBER) +
' is not supported.';
Send_Message(ErrorMessage);
Endif; //%Equal
Endif; //Not (Si_Activa...
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
// Edit check the command line.
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
// Submit the compile to batch.
ErrorMessage = 'The compile of ' +
%Trimr(SAMEMBER) + ' has been submitted to batch';
Send_Message(ErrorMessage);
CommandLine = 'SBMJOB CMD(' +
%Trimr(CommandLine) + ') JOB(' +
%Trimr(SAMEMBER) + ')';
QCmdExec(CommandLine: CommandLength);
Else;
// If unprompted
If Not (Si_Activation_Group_Attr =
'*DFTACTGRP');
// Find the appropriate command for the create.
C = 1;
C = %Lookup(SAMODATTR: ModAtt);
If Not (C = 0);
/If Defined(Target_Release)
CommandLine = %Trimr(ModCmd(C)) +
' MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') SRCMBR(' +
%Trimr(SAMEMBER) + ') ' + 'TGTRLS(' +
Si_Release_Created_For + ')';
/Else
CommandLine = %Trimr(ModCmd(C)) +
' MODULE(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') SRCMBR(' +
%Trimr(SAMEMBER) + ')';
/Endif
Else;
ErrorMessage = 'Module attribute ' +
%Trimr(SAMODATTR) +
' for member ' + %Trimr(SAMEMBER) +
' is not supported.';
Send_Message(ErrorMessage);
Endif; //%Equal
Else;
// Find the appropriate command for the create.
C = 1;
C = %Lookup(SAMODATTR: ModAtt);
If Not (C = 0);
/If Defined(Target_Release)
CommandLine = %Trimr(BndCmd(C)) + ' PGM(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') SRCMBR(' +
%Trimr(SAMEMBER) + ') ' + 'TGTRLS(' +
Si_Release_Created_For + ')';
/Else
CommandLine = %Trimr(BndCmd(C)) + ' PGM(' +
%Trimr(SALIBRARY) + '/' + %Trimr(SAMODULE) +
') SRCFILE(' + %Trimr(SASRCLIB) + '/' +
%Trimr(SASOURCE) + ') SRCMBR(' +
%Trimr(SAMEMBER) + ')';
/Endif
Else;
ErrorMessage = 'Module attribute ' +
%Trimr(SAMODATTR) +
' for member ' + %Trimr(SAMEMBER) +
' is not supported.';
Send_Message(ErrorMessage);
Endif; //%Equal
Endif; //Not (Si_Activa...
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
// Edit check the command line.
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
// Submit the compile to batch.
ErrorMessage = 'The compile of ' +
%Trimr(SAMEMBER) + ' has been submitted to batch';
Send_Message(ErrorMessage);
CommandLine = 'SBMJOB CMD(' +
%Trimr(CommandLine) +
') JOB(' + %Trimr(SAMEMBER) + ')';
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Endif; //*IN04
Clear SAOPTION;
Update SY0040S1;
//*************************************************************************
// Update Program with Module.
When SAOPTION = '16';
SFLCT1 = RECNO1;
CommandLength = %Size(CommandLine);
If Si_Allow_Update = 'Y';
// If prompted.
If *IN04; //F4=Prompt
CommandLine = '?UPDSRVPGM ?*SRVPGM(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM)
+ ') ?*MODULE(' + %Trimr(SALIBRARY) +
'/' + %Trimr(SAMODULE) + ')';
Else;
// Non-Prompted.
CommandLine = 'UPDSRVPGM SRVPGM(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM)
+ ') MODULE(' + %Trimr(SALIBRARY) +
'/' + %Trimr(SAMODULE) + ')';
Endif; //*IN04
// Attach any command lines entered.
If Not (SACMDLINE = *Blanks);
CommandLine = Attach_Options(CommandLine:
SACMDLINE);
Endif; //Not (SACMDLINE...
// Edit check command line.
Callp(E) QCmdCheck(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
// Submit the job to batch.
ErrorMessage = 'The update of ' +
%Trimr(SAPROGRAM) + ' has been submitted to batch';
Send_Message(ErrorMessage);
CommandLine = 'SBMJOB CMD(' +
%Trimr(CommandLine) +
') JOB(' + %Trimr(SAMEMBER) + ')';
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN50 = *On; //SFLNXTCHG
Update SY0040S1;
Leave;
Endif; //%Error
Else;
// Not updateable error message.
ErrorMessage = 'This program does not -
allow module updates.';
Send_Message(ErrorMessage);
*IN50 = *On;
Update SY0040S1;
Leave;
Endif; //Si_Activation...
Clear SAOPTION;
Update SY0040S1;
Endsl;
SFLCT1 = Recno1;
Readc SY0040S1;
Enddo; //Not %Eof
//*************************************************************************
If Not %Error;
Clear SACMDLINE;
If ErrorMessage = *Blanks;
ErrorMessage = *Blanks;
Send_Message(ErrorMessage);
Endif; //ErrorMessage...
Endif; //Not %Error
Enddo; //Not *INLR
Enddo; //Not *INLR
/Eject
//*************************************************************************
// Exception_Err - Subroutine to pass error up and quit. *
//*************************************************************************
Begsr Exception_Err;
PSM_MsgId = ER_ExcId;
PSM_Length = %Size(ER_Data);
PSM_MsgType = '*ESCAPE';
PSM_CallStack = 3;
Send_Message(ER_Data);
*INLR = *On;
Endsr; //Exception_Err
/Eject
/End-Free
//*************************************************************************
// Send_Message - Send message to program message queue. *
//*************************************************************************
P Send_Message B
D Send_Message PI
D ErrorMessage 32767 Options(*VarSize)
/Free
Send_PgmMessage(PSM_MsgID: PSM_QLMsgFile:
ErrorMessage: PSM_Length: PSM_MsgType:
PSM_CallQ: PSM_CallStack: PSM_MsgKey:
DS_ErrorCode);
/End-Free
P Send_Message E
/Eject
//*************************************************************************
// Clear_Message - Clear all messages from program message queue. *
//*************************************************************************
P Clear_Message B
D Clear_Message PI
/Free
Remove_PgmMessage(PRM_CallQ: PRM_CallStack:
PRM_MsgKey: PRM_MsgToRemove: DS_ErrorCode);
/End-Free
P Clear_Message E
/Eject
//*************************************************************************
// Print_List - Print the list to the printer. *
//*************************************************************************
P Print_List B
D Print_List PI
D CommandLine S 256
D CommandLength S 15P 5
/Free
CommandLine = 'OVRPRTF FILE(SY0040P) -
USRDTA(' + %Trimr(SAPROGRAM) + ')';
CommandLength = %Size(CommandLine);
QCmdExec(CommandLine: CommandLength);
Open SY0040P;
// Print module information.
Recno1 = 1;
Write SY0040H;
Write SY0040H1;
Chain Recno1 SY0040S1;
Dow %Found;
If OverFlow;
Write SY0040H;
Write SY0040H1;
Overflow = *Off;
Endif; //OverFlow
Write(E) SY0040D;
If %Error; //If End of File
OverFlow = *On; //turn OverFlow On.
Endif; //%Error
Recno1 = Recno1 + 1;
Chain Recno1 SY0040S1;
Enddo; //%Found
// Print service program information.
Recno5 = 1;
If Not OverFlow;
Write SY0040H2;
Endif; //Not *IN90
Chain Recno5 SY0040S5;
Dow %Found;
If OverFlow;
Write SY0040H;
Write SY0040H2;
OverFlow = *Off;
Endif; //OverFlow
Write(E) SY0040D2;
If %Error;
OverFlow = *On;
Endif; //%Error
Recno5 = Recno5 + 1;
Chain Recno5 SY0040S5;
Enddo; //%Found
Close SY0040P;
CommandLine = 'DLTOVR FILE(SY0040P)';
CommandLength = %Size(CommandLine);
QCmdExec(CommandLine: CommandLength);
/End-Free
P Print_List E
/Eject
//*************************************************************************
// Build_Directory - Build a binding directory. *
//*************************************************************************
P Build_Directory...
P B
D Build_Directory...
D PI N
// First see if the binding directory is there.
/Free
POB_QLObject = SAPROGRAM + SAPGMLIB;
Clear Er_ExcId;
POB_ObjectType = '*BNDDIR';
QUsrObjD(DS_OBJD0200: POB_Length: POB_Format:
POB_QLObject: POB_ObjectType: DS_ErrorCode);
If Er_ExcId = *Blanks;
SBOBJECT = SAPROGRAM;
SBLIBRARY = SAPGMLIB;
SBOBJTYPE = '*BNDDIR';
SBCONFIRM = 'N';
Exfmt SY004004;
If *IN12 or SBCONFIRM = 'N';
Return *On;
Endif; //*IN12
CommandLine = 'DLTBNDDIR BNDDIR(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM) +
')';
CommandLength = %Size(CommandLine);
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
Return *On;
Endif; //%Error
Endif; //Not (Er_ExcId...
// Now, create the binding directory.
CommandLine = 'CRTBNDDIR BNDDIR(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM) +
') TEXT(' + Tick + 'Binding directory for-
program ' + %Trimr(SAPROGRAM) + '.' + Tick +
')';
CommandLength = %Size(CommandLine);
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
Return *On;
Endif; //%Error
// Now add all of the binding directory entries.
Recno1 = 1;
Chain Recno1 SY0040S1;
Dow %Found;
CommandLine = 'ADDBNDDIRE BNDDIR(' +
%Trimr(SAPGMLIB) + '/' + %Trimr(SAPROGRAM) +
') OBJ((' + %Trimr(SALIBRARY) + '/' +
%Trimr(SAMODULE) + ' *MODULE))';
CommandLength = %Size(CommandLine);
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
Return *On;
Endif;
Recno1 = Recno1 + 1;
Chain Recno1 SY0040S1;
Enddo; //%Found
Return *Off;
/End-Free
P Build_Directory...
P E
/Eject
//*************************************************************************
// Disp_Service_Program - Display all service programs. *
//*************************************************************************
P Disp_Service_Program...
P B
D Disp_Service_Program...
D PI N
// Work fields.
D Exit_Proc S N
D No_Selection S N
// Display screen and process options and function keys.
/Free
Exit_Proc = *Off;
SFLCT5 = 1;
Dow Not Exit_Proc;
Write MSGSFC1;
Write SY0040B5;
If Not *IN69;
Write SY004006;
Endif; //Not *IN67
Exfmt SY0040C5;
Clear_Message();
Clear ErrorMessage;
SFLCT5 = Cur_Page;
//*************************************************************************
// Handle function keys.
Select;
//*************************************************************************
When *IN03; //F3=Exit
Exit_Proc = *On;
Return Exit_Proc;
//*************************************************************************
When *IN12; //F12=Cancel
Exit_Proc = *Off;
Return Exit_Proc;
//*************************************************************************
When *IN25; //PageUp
ErrorMessage =
'You have reached the top of the list.';
Send_Message(ErrorMessage);
Iter;
//*************************************************************************
When *IN26; //PageDown
ErrorMessage =
'You have reached the bottom of the list.';
Send_Message(ErrorMessage);
Iter;
Endsl;
Readc SY0040S5;
If %Eof and Not *IN04;
Return *Off;
Endif; //%Eof
//*************************************************************************
// Edit check options.
No_Selection = *On;
Clear SFLCT5;
Dow Not %Eof;
*IN30 = *Off; //Reverse Image
//*************************************************************************
Select;
//*************************************************************************
When SEOPTION = *Blanks;
*IN51 = *Off;
//*************************************************************************
When SEOPTION = '5';
*IN51 = *On;
No_Selection = *Off;
If SFLCT5 = *Zeros;
SFLCT5 = RECNO5;
Endif; //SFLCT5 = *Zeros
//*************************************************************************
Other;
*IN30 = *On; //Reverse Image
ErrorMessage =
'Specified option number is not allowed.';
Send_Message(ErrorMessage);
*IN51 = *On;
No_Selection = *Off;
If SFLCT5 = *Zeros;
SFLCT5 = RECNO5;
Endif; //SFLCT1 = *Zeros
Endsl;
Update SY0040S5;
Readc SY0040S5;
Enddo; //Not %Eof
//*************************************************************************
If No_Selection and Not *IN04;
Return *Off;
Endif; //No_Selection...
//*************************************************************************
If No_Selection and *IN04;
If SFLCT5 = *Zeros;
If Cur_Page = *Zeros;
SFLCT5 = 1;
Else;
SFLCT5 = Cur_Page;
Endif; //Cur_Page = 0
Endif; //SFLCT5 = *Zeros
ErrorMessage =
'Prompting is not allowed at this time.';
Send_Message(ErrorMessage);
Iter;
Endif; //Not_Selection...
If Not (ErrorMessage = *Blanks);
Iter;
Endif; //Not (ErrorMessage...
//*************************************************************************
// Handle options.
Readc SY0040S5;
Dow Not %Eof;
Select;
//*************************************************************************
// Display service program detail.
When SEOPTION = '5';
CommandLength = %Size(CommandLine);
If *IN04; //F4=Prompt
CommandLine = '?DSPSRVPGM ?*SRVPGM(' +
%Trimr(SESRVLIB) + '/' + %Trimr(SESRVPGM) +
')';
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN51 = *On;
Update SY0040S5;
Leave;
Endif; //%Error
Else;
CommandLine = 'DSPSRVPGM SRVPGM(' +
%Trimr(SESRVLIB) + '/' + %Trimr(SESRVPGM) +
')';
Callp(E) QCmdExec(CommandLine: CommandLength);
If %Error;
*IN51 = *On;
Update SY0040S5;
Leave;
Endif; //%Error
Endif; //*IN04
Clear SEOPTION;
Update SY0040S5;
Endsl;
SFLCT5 = Recno5;
Readc SY0040S5;
Enddo; //Not %Eof
//*************************************************************************
If ErrorMessage = *Blanks and Not %Error;
ErrorMessage = *Blanks;
Send_Message(ErrorMessage);
Endif; //ErrorMessage...
//*************************************************************************
// If a selection was made, redisplay screen.
If Not No_Selection;
Iter;
Endif; //No_Select = *Off
Return Exit_Proc;
Enddo; //Not (Exit_Proc ...
/End-Free
P Disp_Service_Program...
P E
/Eject
//*************************************************************************
// CvtToHex - Convert from Character to Hex. *
// Taken from the IBM ILE RPG Programmer's Guide. *
//*************************************************************************
P CvtToHex B
D CvtToHex PI OpDesc
D InString 16383 Const Options(*VarSize)
D HexString 32766 Options(*VarSize)
// Procedure prototype for CEEDOD (Retrieve operational descriptors)
D CEEDOD PR
D ParmNum 10I 0 Const
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 12A Options(*Omit)
// Parameters for CEEDOD
D DescType S 10I 0
D DataType S 10I 0
D DescInfo1 S 10I 0
D DescInfo2 S 10I 0
D InLen S 10I 0
D HexLen S 10I 0
D X1 S 5P 0
D X2 S 5P 0
// Work fields, etc.
D HexDigits C Const('0123456789ABCDEF')
D IntDS DS
D IntNum 5I 0 Inz(0)
D IntChar 1 Overlay(IntNum:2)
D HexDS DS
D HexC1 1
D HexC2 1
D InChar S 1
D Pos S 5P 0
D HexPos S 5P 0
// Call CEEDOD to get the types and legnths of the input parameters.
/Free
CEEDOD(1: DescType: DataType: DescInfo1:
DescInfo2: InLen: *Omit);
CEEDOD(2: DescType: DataType: DescInfo1:
DescInfo2: HexLen: *Omit);
// Determine the length to handle.
If InLen > HexLen/2;
InLen = HexLen/2;
Endif; //InLen>HexLen/2
// For each character in the input string, convert to a two character
// hex byte.
HexPos = 1;
/End-Free
C Do InLen Pos
/Free
InChar = %Subst(InString: Pos: 1);
Exsr GetHex;
%Subst(HexString: HexPos: 2) = HexDS;
HexPos = HexPos + 2;
Enddo; //Do InLen
// Ok, we're done. Return
Return;
//*************************************************************************
// GetHex - Convert InChar to HexDS.
//*************************************************************************
Begsr GetHex;
IntChar = InChar;
/End-Free
C IntNum Div 16 X1
C Mvr X2
/Free
HexC1 = %Subst(HexDigits: X1+1: 1);
HexC2 = %Subst(HexDigits: X2+1: 1);
Endsr; //GetHex
/End-Free
PCvtToHex E
/Eject
//*************************************************************************
// Add_Command_Line - Add a command line to the history array. *
//*************************************************************************
P Add_Command_Line...
P B
D Add_Command_Line...
D PI OpDesc
D CommandLine 32702 Options(*VarSize)
// Procedure prototype for CEEDOD (Retrieve operational descriptors)
D CEEDOD PR
D ParmNum 10I 0 Const
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 12A Options(*Omit)
// Parameters for CEEDOD
D DescType S 10I 0
D DataType S 10I 0
D DescInfo1 S 10I 0
D DescInfo2 S 10I 0
D InLen S 10I 0 Command Length
// Work fields
D CommandLength S 5U 0 Command Length
// Call CEEDOD to get the types and legnths of the input parameters.
/Free
CEEDOD(1: DescType: DataType: DescInfo1:
DescInfo2: InLen: *Omit);
// Check for the ? in position 1.
If %Subst(CommandLine:1:1) = '?';
CommandLength = %Len(%Trimr(%Subst(
CommandLine:2)));
CommandLine = %Subst(CommandLine:2:
CommandLength);
Endif; //%Subst(Command...
// Send the message to the call stack message queue.
RSM_Length = %Len(%Trimr(CommandLine));
Send_PgmMessage(RSM_MsgID: RSM_QLMsgFile:
CommandLine: RSM_Length: RSM_MsgType:
RSM_CallQ: RSM_CallStack: RSM_MsgKey:
DS_ErrorCode);
// Now pop the message back off.
Callp(E) Receive_PgmMessage(DS_RCVM0100:
%Len(DS_RCVM0100): 'RCVM0100':
'*EXT': 0: '*RQS': RSM_MsgKey:
0: '*OLD': DS_ErrorCode);
/End-Free
P Add_Command_Line...
P E
/Eject
//*************************************************************************
// Retrieve_Command_Line - Retrieve previous command. *
//*************************************************************************
P Retrieve_Command_Line...
P B
D Retrieve_Command_Line...
D PI Like(CommandLine)
D Current_Msg S 4 Static Current Message
D Hex_00 C X'00000000'
/Free
If Current_Msg = *Blanks or
SACMDLINE = *Blanks;
Current_Msg = Hex_00;
Endif; //Current_Msg...
Clear DS_RTVQ0100;
Callp(E) Receive_RqsMessage(DS_RTVQ0100:
%Len(DS_RTVQ0100): 'RTVQ0100':
'*PRV': Current_Msg: DS_ErrorCode);
If RM_BytesAva = 0;
Current_Msg = Hex_00;
Callp(E) Receive_RqsMessage(DS_RTVQ0100:
%Len(DS_RTVQ0100): 'RTVQ0100':
'*PRV': Current_Msg: DS_ErrorCode);
If RM_BytesAva = 0;
Return *Blanks;
Else;
Current_Msg = RM_MsgKey;
Return RM_Text;
Endif; //RM_BytesAva...
Else;
Current_Msg = RM_MsgKey;
Return RM_Text;
Endif; //RM_BytesAva...
/End-Free
P Retrieve_Command_Line...
P E
/Eject
//*************************************************************************
// Attach_Options - Attach options to end of command line for prompted *
// options. *
//*************************************************************************
P Attach_Options...
P B
D Attach_Options...
D PI 32702 OpDesc
D CommandLine 32702 Options(*VarSize)
D Options 32702 Options(*VarSize)
// Procedure prototype for CEEDOD (Retrieve operational descriptors)
D CEEDOD PR
D ParmNum 10I 0 Const
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 12A Options(*Omit)
// Parameters for CEEDOD
D DescType S 10I 0
D DataType S 10I 0
D DescInfo1 S 10I 0
D DescInfo2 S 10I 0
D InLen1 S 10I 0 Command Length
D InLen2 S 10I 0 Command Length
// Call CEEDOD to get the types and legnths of the input parameters.
/Free
CEEDOD(1: DescType: DataType: DescInfo1:
DescInfo2: InLen1: *Omit);
CEEDOD(2: DescType: DataType: DescInfo1:
DescInfo2: InLen2: *Omit);
Return %Trimr(%Subst(CommandLine: 1: InLen1)) + ' '
+ %Trim(%Subst(Options: 1: InLen2));
/End-Free
P Attach_Options...
P E
/Eject
** CtData ModAtt
RPGLE
CLLE
CBLLE
CLE
** CtData ModCmd
CRTRPGMOD
CRTCLMOD
CRTCBLMOD
CRTCMOD
** CtData BndCmd
CRTBNDRPG
CRTBNDCL
CRTBNDCBL
CRTBNDC
Display File Source-SY0040FM
A*%%TS SD 20010430 153157 LANHAMJ REL-V4R4M0 5769-PW1
A*%%EC
A DSPSIZ(24 80 *DS3)
A PRINT
A R SY0040S1 SFL
A*%%TS SD 20010430 153157 LANHAMJ REL-V4R4M0 5769-PW1
A 50 SFLNXTCHG
A SAMODATTR 10A H
A SACREATETM 10A H
A SASRCCHGDT 10A H
A SASRCCHGTM 10A H
A SAMODTEXT 50A H
A SAOPTION 2A B 12 2
A 30 DSPATR(RI)
A SAMODULE 10A O 12 7
A SALIBRARY 10A O 12 19
A SASOURCE 10A O 12 31
A SASRCLIB 10A O 12 43
A SAMEMBER 10A O 12 55
A SACREATEDT 10A O 12 67
A R SY0040C1 SFLCTL(SY0040S1)
A*%%TS SD 20010430 153157 LANHAMJ REL-V4R4M0 5769-PW1
A CA03(03 'Exit')
A CA12(12 'Cancel')
A PAGEUP(25 'Page Up')
A PAGEDOWN(26 'Page Down')
A CA13(13 'Build Binding Directory')
A CA18(18 'Recreate All')
A CA19(19 'Recreate Program')
A CA21(21 'Print List')
A CF04(04 'Prompt')
A CA05(05 'Refresh')
A CF09(09 'Retrieve')
A CA24(24 'More Keys')
A CA20(20 'Service Programs')
A CA06(06 'Add Module')
A CA14(14 'Display Program')
A RTNCSRLOC(*WINDOW &RTNROW &RTNCOL)
A 99 CSRLOC(CSRROW CSRCOL)
A OVERLAY
A 67 SFLDSP
A N66 SFLDSPCTL
A 66 SFLCLR
A N55 SFLEND(*MORE)
A SFLSIZ(0008)
A SFLPAG(0007)
A CSRROW 3S 0H
A CSRCOL 3S 0H
A RTNCOL 3S 0H
A RTNROW 3S 0H
A SFLCT1 4S 0H SFLRCDNBR(CURSOR)
A 1 28'Work with Service Modules'
A DSPATR(HI)
A 1 72SYSNAME
A 3 2'Service Program . :'
A SAPROGRAM 10A O 3 22
A 3 34'Signature . :'
A SASIGNAT 32A O 3 48
A 4 4'Library . . . . :'
A SAPGMLIB 10A O 4 24
A 6 2'Type options, press Enter.'
A COLOR(BLU)
A 7 4'2=Edit Source'
A COLOR(BLU)
A 7 24'5=Display Source'
A COLOR(BLU)
A 7 54'8=Display Details'
A COLOR(BLU)
A 8 4'15=Rebuild Module'
A COLOR(BLU)
A 8 24'16=Update Module in Program'
A COLOR(BLU)
A 10 7'Module'
A DSPATR(HI)
A 10 19'Library'
A DSPATR(HI)
A 10 31'Source'
A DSPATR(HI)
A 10 43'Source'
A DSPATR(HI)
A 10 55'Member'
A DSPATR(HI)
A 10 69'Create'
A DSPATR(HI)
A 11 2'Opt'
A DSPATR(HI)
A 11 7'Name'
A DSPATR(HI)
A 11 19'Name'
A DSPATR(HI)
A 11 31'File'
A DSPATR(HI)
A 11 43'Library'
A DSPATR(HI)
A 11 55'Name'
A DSPATR(HI)
A 11 70'Date'
A DSPATR(HI)
A R SY0040B1
A*%%TS SD 19990105 165113 ICILANHAM REL-V4R2M0 5769-PW1
A OVERLAY
A 20 2'Parameters or command'
A 21 2'===>'
A SACMDLINE 73A B 21 7CHECK(LC)
A N88 22 2'F3=Exit'
A COLOR(BLU)
A 22 2'F14=Display Program'
A COLOR(BLU)
A N88 22 16'F4=Prompt'
A COLOR(BLU)
A 88 22 24'F18=Rebuild All Modules'
A COLOR(BLU)
A N88 22 29'F5=Refresh'
A COLOR(BLU)
A 88 22 50'F19=Rebuild Program'
A COLOR(BLU)
A N88 22 51'F6=Add Module'
A COLOR(BLU)
A 88 23 2'F21=Print List'
A COLOR(BLU)
A N88 23 2'F9=Retrieve'
A COLOR(BLU)
A N88 23 16'F12=Cancel'
A COLOR(BLU)
A 88 23 24'F20=Service Programs'
A COLOR(BLU)
A N88 23 29'F13=Build Directory'
A COLOR(BLU)
A 88 23 50'F24=More Keys'
A COLOR(BLU)
A N88 23 51'F24=More Keys'
A COLOR(BLU)
A R SY004002
A*%%TS SD 19990105 163907 ICILANHAM REL-V4R2M0 5769-PW1
A OVERLAY
A 12 3'(No records to display.)'
A R SY004004
A*%%TS SD 19970428 162220 JLANHAM REL-V3R7M0 5716-PW1
A CA12(12 'Cancel')
A 1 23'Confirm Rebuild of Binding Directo-
A ry'
A DSPATR(HI)
A 1 72SYSNAME
A 3 2'The following object already exist-
A s for the rebuild operation:'
A COLOR(BLU)
A 5 4'Object which exists . . . . . . . -
A . :'
A SBOBJECT 10A O 5 42
A 6 6'Library . . . . . . . . . . . . . -
A :'
A SBLIBRARY 10A O 6 44
A 7 4'Object type . . . . . . . . . . . -
A . :'
A SBOBJTYPE 10A O 7 42
A 9 2'Type choice, press Enter.'
A COLOR(BLU)
A 10 2'Press F12=Cancel to return and not-
A perform rebuild operation.'
A COLOR(BLU)
A 12 4'Delete existing object . . . . . .-
A .'
A SBCONFIRM 1A B 12 42
A 12 46'Y=Yes, N=No'
A 23 2'F12=Cancel'
A COLOR(BLU)
A R SY0040S5 SFL
A*%%TS SD 19980616 134138 JLANHAM REL-V3R7M0 5716-PW1
A 51 SFLNXTCHG
A SETEXT 50A H
A SEOPTION 1A B 11 3
A 30 DSPATR(RI)
A SESRVPGM 10A O 11 7
A SESRVLIB 10A O 11 19
A SESHTEXT 49A O 11 31
A R SY0040C5 SFLCTL(SY0040S5)
A*%%TS SD 19980616 134138 JLANHAM REL-V3R7M0 5716-PW1
A SFLSIZ(0011)
A SFLPAG(0010)
A CA03(03 'Exit')
A CA12(12 'Cancel')
A PAGEUP(25 'Page Up')
A PAGEDOWN(26 'Page Down')
A CF09(09 'Command Line')
A CF04(04 'Prompt')
A OVERLAY
A 69 SFLDSP
A N68 SFLDSPCTL
A 68 SFLCLR
A N55 SFLEND(*MORE)
A SFLCT5 4S 0H SFLRCDNBR(CURSOR)
A 1 30'Work with ILE Program'
A DSPATR(HI)
A 1 72SYSNAME
A 3 2'Program . . . . . :'
A SAPROGRAM 10A O 3 22
A 4 4'Library . . . . :'
A SAPGMLIB 10A O 4 24
A 6 2'Type options, press Enter.'
A COLOR(BLU)
A 7 4'5=Service Program Information'
A COLOR(BLU)
A 9 7'Service'
A COLOR(WHT)
A 9 19'Library'
A DSPATR(HI)
A 10 2'Opt'
A COLOR(WHT)
A 10 7'Program'
A COLOR(WHT)
A 10 19'Name'
A DSPATR(HI)
A 10 31'Text'
A COLOR(WHT)
A R SY0040B5
A*%%TS SD 19990105 165113 ICILANHAM REL-V4R2M0 5769-PW1
A OVERLAY
A 22 2'F3=Exit'
A COLOR(BLU)
A 22 12'F4=Prompt'
A COLOR(BLU)
A 22 24'F12=Cancel'
A COLOR(BLU)
A R SY004006
A*%%TS SD 19980616 085131 JLANHAM REL-V3R7M0 5716-PW1
A OVERLAY
A 9 3'(No records to display.)'
A R MSGSFS1 SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMQ SFLPGMQ
A R MSGSFC1 SFLCTL(MSGSFS1)
A*%%TS SD 19970421 160823 JLANHAM REL-V3R7M0 5716-PW1
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N80 SFLEND
A SFLSIZ(0002)
A SFLPAG(0001)
A PGMQ SFLPGMQ(10)
Printer File Source-SY0040P
A*%%***********************************************************************
A*%%TS RD 19981229 145522 ICILANHAM REL-V4R2M0 5769-PW1
A*%%FI+10660100000000000000000000000000000000000000000000000000
A*%%FI 0000000000000000000000000000000000000000000000000
A*%%***********************************************************************
A R SY0040H
A*%%***********************************************************************
A*%%RI 00000
A*%%FS 001
A*%%***********************************************************************
A SKIPB(002)
A SPACEA(001)
A 1
A DATE
A EDTCDE(Y)
A +3
A TIME
A 54
A 'Work with Service Modules'
A 123
A 'Page:'
A +1
A PAGNBR
A EDTCDE(Z)
A 1
A 'Service Program . . . . :'
A SPACEB(002)
A SAPROGRAM 10A O +1
A +7
A 'Signature . . . . :'
A SASIGNAT 32A O +1
A 3
A 'Library . . . . . . . :'
A SPACEB(001)
A SAPGMLIB 10A O +1
A*%%***********************************************************************
A*%%SS
A*%%CL 002
A*%%CL 001
A*%%CL 001
A*%%***********************************************************************
A R SY0040H1
A*%%***********************************************************************
A*%%RI 00000
A*%%***********************************************************************
A SPACEB(001)
A 23
A 'Source'
A 34
A 'Source'
A +18
A '----- Change ------'
A 1
A 'Module'
A SPACEB(001)
A +5
A 'Library'
A +4
A 'File'
A +7
A 'Library'
A +4
A 'Member'
A +9
A 'Date'
A +7
A 'Time'
A +4
A 'Text'
A*%%***********************************************************************
A*%%SS
A*%%CL 001
A*%%***********************************************************************
A R SY0040D
A*%%***********************************************************************
A*%%RI 00000
A*%%***********************************************************************
A SPACEB(001)
A SAMODULE 10A O 1
A SALIBRARY 10A O +1
A SASOURCE 10A O +1
A SASRCLIB 10A O +1
A SAMEMBER 10A O +1
A SACREATEDT 10A O +1
A SACREATETM 10A O +1
A SAMODTEXT 50A O +2
A*%%***********************************************************************
A*%%SS
A*%%***********************************************************************
A R SY0040H2
A*%%***********************************************************************
A*%%RI 00000
A*%%***********************************************************************
A SPACEB(001)
A 1
A 'Service'
A SPACEB(001)
A 1
A 'Program'
A SPACEB(001)
A +4
A 'Library'
A +5
A 'Signature'
A +8
A 'Text'
A*%%***********************************************************************
A*%%SS
A*%%CL 001
A*%%CL 001
A*%%***********************************************************************
A R SY0040D2
A*%%***********************************************************************
A*%%RI 00000
A*%%***********************************************************************
A SPACEB(001)
A SESRVPGM 10A O 1
A SESRVLIB 10A O +1
A SESIGNAT 16A O +2
A SETEXT 50A O +1
A*%%***********************************************************************
A*%%SS
A*%%CP+999CRTPRTF
A*%%CP+ FILE(JLANHAM/SY0040P)
A*%%CP+ DEVTYPE(*SCS)
A*%%CP PAGESIZE(*N 132 *N )
A*%%***********************************************************************
Command Source-WRKSRVPGM
CMD PROMPT('Work with Service Modules')
PARM KWD(PGM) TYPE(QLPGMNAME) MIN(1) +
PROMPT('Service Program')
QLPGMNAME: QUAL TYPE(*NAME) LEN(10) MIN(1) CHOICE('Name')
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) CHOICE('Name, *LIBL') +
PROMPT('Library')
On the certificate request page enter the text from the rui.csr file and change the Certificate Template to Web Server. Then click Submit.
