0% found this document useful (0 votes)
132 views29 pages

All XRef

This document contains code for an RPGLE program that processes object references from an object library and inserts the reference information into a database file. It defines program variables to hold the object name, type, file, and library for each reference. The program is called with parameters for the object name, type, file, and library and inserts each reference as a record into the XREF database file.
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
132 views29 pages

All XRef

This document contains code for an RPGLE program that processes object references from an object library and inserts the reference information into a database file. It defines program variables to hold the object name, type, file, and library for each reference. The program is called with parameters for the object name, type, file, and library and inserts each reference as a record into the XREF database file.
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 29

X Command

/*/PCMD */
/* */
/* */
/* CRTCMD CMD(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* PGM(XREF0011) */
/* */
/*/ECMD */
/* */
CMD PROMPT('VIEW THE X-REF FOR AN OBJECT ')
PARM KWD(X_OBJECT) TYPE(*CHAR) LEN(10) +
ALWUNPRT(*NO) DTAARA(*NO) FILE(*UNSPFD) +
CHOICE('UPTO 10 CHARACTERS') +
PROMPT('ENTER OBJECT TO XREF')
PARM KWD(X_LIB) TYPE(*CHAR) LEN(10) DFT(*LIBL) +
ALWUNPRT(*NO) ALWVAR(*NO) DTAARA(*NO) +
FILE(*NO) CHOICE('*LIBL IS THE DEFAULT +
VALUE') PROMPT('ENTER LIBRARY FOR XREF')
PARM KWD(X_USAGE) TYPE(*DEC) LEN(2) DFT(9) +
CHOICE('A # FROM 0 TO 13. 9(DEFAULT)') +
PROMPT('ENTER USAGE NUMBER')
PARM KWD(X_MOS) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(M) VALUES('M' 'S') +
CHOICE('M(ATCH(DEFAULT)) OR S(EARCH)') +
PROMPT('ENTER MATCH TYPE')


XREF0001.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
PGM
DCL &Thislib *CHAR LEN(10)
DCL &FirstTime *CHAR LEN( 1)
DCL &BatchStat *CHAR LEN( 1)
DCLF XRefLib
/* é**************************************************************** +
¹ See if this is running interactively, if then submit. +
é**************************************************************** */
RtvJobA Type(&BatchStat)
If Cond(&BatchStat = '1') Then(Do)
SBMJOB CMD(CALL PGM(XREF0001)) +
JOB(XREF_BUILD) +
JOBQ(QTXTSRCH) +
LOGCLPGM(*YES)
goto EndNow
EndDo

/* é**************************************************************** +
¹ Loop through the XRef Library file. Process each one. +
é**************************************************************** */
ChgVar &FirstTime Value('Y')
LOOP: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOJ))
CHGVAR VAR(&ThisLib) VALUE(&LibLib)
Call XRef0002 Parm(&ThisLib +
&FirstTime )
ChgVar &FirstTime Value('N')
GoTo Loop
EOJ:
/* é**************************************************************** +
¹ Remove any blank references +
é**************************************************************** */
RUNSQL SQLSTRING('Delete From XRef where +
substr(whfnam,1,1) in ('' +
'',''&'',''$'',''*'',''#'',''@'',''1'')')
ENDNOW: ENDPGM


XERF0002.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
*/

PGM Parm(&ThisLIb &FirstTime)


DCL &Thislib *CHAR LEN(10)
DCL &FirstTime *CHAR LEN( 1)
/* é**************************************************************** +
¹ Only for the fist time, replace the file, otherwise add 2 it. +
é**************************************************************** */
If Cond(&FirstTime = 'Y') Then(Do)
DspPgmRef Pgm(&ThisLib/*All) +
OutPut(*OutFile) +
ObjType(*All) +
OutFile(XRef) +
OutMbr(*First *RePlace)
MONMSG MSGID(CPF3064 CPF3033)
EndDo
Else Do
DspPgmRef Pgm(&ThisLib/*All) +
OutPut(*OutFile) +
ObjType(*All) +
OutFile(XRef) +
OutMbr(*First *Add)
MONMSG MSGID(CPF3064 CPF3033)
EndDo
/* é**************************************************************** +
¹ Now Add the Qry info for the library +
é**************************************************************** */
SBMJOB CMD(CALL PGM(XREF0003) PARM(&THISLIB)) +
JOB(XREF_BLD_Q)

ENDPGM


XREF0003.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
*/

PGM Parm(&ThisLIb)
DCL &Thislib *CHAR LEN(10)
DCL &FirstTime *CHAR LEN( 1)
DCLF FILE(QADSPOBJ) /* IBM object */
DSPOBJD OBJ(&ThisLib/*ALL) OBJTYPE(*QRYDFN) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/X_QRY_DOD)
MONMSG MSGID(CPF2123 CPF2124) EXEC(GOTO CMDLBL(EOJ))
OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/X_QRY_DOD)
CRTPF FILE(QTEMP/XREFINLINE) SRCFILE(SRC) +
OPTION(*NOSRC *NOLIST)
MONMSG MSGID(CPF7302) /* Object already exists in qtemp */
LOOP: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOJ))
/* DUMP THE OBJECT */
DMPOBJ OBJ(&ODLBNM/&ODOBNM) OBJTYPE(*QRYDFN)
MONMSG MSGID(CPF3562) EXEC(GOTO CMDLBL(LOOP))
/* OBJECT NOT IN *LIBL */
/* COPY THE REPORT TO A DB FILE AND DELETE SPLF WHEN DONE */
CLRPFM FILE(QTEMP/XREFINLINE) MBR(XREFINLINE)
CPYSPLF FILE(QPSRVDMP) TOFILE(QTEMP/XREFINLINE) +
SPLNBR(*LAST)
DLTSPLF FILE(QPSRVDMP) SPLNBR(*LAST)
/* PLACE THE RECORDS FROM XREFINLINE INTO THE XREF FILE */
OVRDBF FILE(XREFINLINE) TOFILE(QTEMP/XREFINLINE)
CALL PGM(XREF0004) PARM(&ODOBNM &ODOBTX &ODLBNM)
DLTOVR FILE(XREFINLINE)
GOTO CMDLBL(LOOP)
EOJ:
ENDPGM


XREF0004.RPGLE
*/PCMD *MODULE
* CRTRPGMOD MODULE(QTEMP/*OBJNAM) +
* SRCFILE(*SRCLIB/*SRCFIL) +
* SRCMBR(*SRCMBR) +
* DBGVIEW(*ALL )
*/ECMD
*/PCMD *PGM
* CRTPGM PGM(*OBJLIB/*OBJNAM) +
* MODULE(QTEMP/*OBJNAM) +
* ACTGRP(*CALLER) +
* DETAIL(*BASIC)
* /ECMD
ÿ H Option(*NoDebugIo:*SrcStmt:*NoExpDds)
H Debug( *Yes )
H AlwNull(*UsrCtl)
é // Modification Highlights
// Date Programmer Description
¹ //
é //
Fxref UF A E DISK
FxrefinlineIF E DISK
temp file
¹ *---------------------------------------------------------------------------
-------------
D r_line ds
D type 12 20A
D file_r 22 31A
D lib_r 66 75
¹ *---------------------------------------------------------------------------
-------------
C *ENTRY PLIST
C PARM obj_r 10
C PARM obj_d 50
C PARM obj_l 10
C
C READ xinline 99
C DOW *IN99 = *OFF
C IF type = 'SYP 19 01'
C CLEAR QWHDRPPR
C EVAL whpnam = obj_r
C EVAL whtext = obj_d
C EVAL whfnam = file_r
C EVAL whlib = obj_l
C EVAL whfusg = 11
C EVAL whlnam = lib_r
C EVAL whspkg = 'Q'
C WRITE QWHDRPPR
C ENDIF
C
C READ xinline 99
C ENDDO
C
C SETON LR
¹ *---------------------------------------------------------------------------
-------------


XREF0010.SQLRPGLE
*/PCMD
*
* CRTSQLRPGI OBJ(QTEMP/*OBJNAM) +
* SRCFILE(*SRCLIB/*SRCFIL) +
* SRCMBR(*SRCMBR) +
* OBJTYPE(*MODULE) +
* CLOSQLCSR(*ENDMOD) +
* COMMIT(*NONE) +
* DBGVIEW(*SOURCE)
*
* CRTPGM PGM(*OBJLIB/*OBJNAM) +
* MODULE(QTEMP/*OBJNAM) +
* ACTGRP(*NEW)
*
*
* /ECMD
é * Purpose : This allows the user to search for an object and find out
é * what has references to it.
é *
ÿ H Option(*NoDebugIo:*SrcStmt:*NoExpDds)
H Debug( *Yes )
H AlwNull(*UsrCtl)
é // Modification Highlights
// Date Programmer Description
¹ //
é //
¹ *-------------------------------------------------------------------------
Fxref IF E K DISK
FMMenuoL4 IF E K DISK
FXRef0010DfCF E WORKSTN
F SFILE(sfl1:rr1)
¹ *-------------------------------------------------------------------------
* Program status data structure
D PSDS SDS
D Df_Pgm 1 10
D prgstatus *STATUS
D errtype 40 42
D errcode 43 46
D JunkIso S D
D rr1Save S 10I 0
D rr1 S 10I 0
D lvl S 2 0
D sav_SubSet S 11A
D sav_xobj S 11A
D sav_xlib S 10A
D sav_xusage S 2 0
D sav_mos S 1A
D last_obj S 10A
D xdbr_parm S 23A
D xRef_parm S 120A
D dbf_parm S 27A
D len_parm S 15 5
D file_parm S 10A
D PAssBack S 10A
¹ //-----------------------------------------------------------------------
¹ * the index for the xarray is the level of indenture for the object.
D xary S 11A DIM(99) INZ(*BLANKS)
D xLib S 11A DIM(99) INZ(*BLANKS)
D xSub S 11A DIM(99) INZ(*BLANKS)
D usg S 25A DIM(15) CTDATA PERRCD(1)
¹ //-----------------------------------------------------------------------
D GetDates PR ExtPgm('XREF0013')
D 10A
D 10A
D 10A
D 13A
D 7A
D 5 0
¹ //-----------------------------------------------------------------------
D GetXRefD PR ExtPgm('XREF0012')
D 10A
D 50A
D 50A
D 50A
D 13A
D 7A
D 5 0
¹ //-----------------------------------------------------------------------
D p_obj S 10
D p_desc S 50
D s_desc S 50
D f_desc S 50
D PCreate S 13
D PLast S 7
D Pused S 5 0
¹ //-----------------------------------------------------------------------
D BrowseObj PR ExtPgm('XREFCL10')
D 10A
D 10A
¹ //-----------------------------------------------------------------------
D SystemCommand PR ExtPgm('QCMDEXC')
D 51A
D 15 5
¹ //-----------------------------------------------------------------------
D PopUp PR ExtPgm('QUSCMDLN')
¹ //-----------------------------------------------------------------------
D CommandLine S 51A
D CommandLength S 15 5
¹ //-----------------------------------------------------------------------
D XFile PR ExtPgm('XREFRI2')
D 10A
D 10A
D 10A
¹ //-----------------------------------------------------------------------
D SendMessage PR ExtPgm('QMHSNDPM')
D 7A
D 20A
D 75A
D 9B 0
D 10A
D 20A
D 9B 0
D 4A
D 256A
¹ //-----------------------------------------------------------------------
D Qm_MsgId S 7A Inz('CPF9897')
D Qm_MsgTxt S 75A
D Qm_MsgTyp S 10A Inz('*STATUS')
D Qm_MsgQ S 20A Inz('*EXT')
D Qm_MsgKy S 7A
¹ //-----------------------------------------------------------------------
¹ // Error return code for the apis
¹ //-----------------------------------------------------------------------
D apierr ds
D $bytpv 1 4b 0 inz(8)
D $bytav 5 8b 0 inz(8)
D $msgid 9 15
D $resvd 16 16
D $exdta 17 256
¹ //-----------------------------------------------------------------------
¹ // define message Parms for status messages.
D ds
D QM_msgf 1 20 INZ('QCPFMSG *LIBL ')
D QM_stkctr 21 24B 0 INZ(0)
D QM_msgdln 25 28B 0 INZ(75)
¹ //-----------------------------------------------------------------------
D ThisSearch S 10A varying
D ThisPosition S 2 0
D jde_item S 10
D jda_pgm S 8
D Opt_Out S 5
D Crap S 2 0
D SqlOpen S N Inz(*Off)
D JDEOpen S N Inz(*Off)
D JDAOpen S N Inz(*Off)
¹ *-------------------------------------------------------------------------
D SqlStmt S 1024 Varying
D SqlObject S 13 Varying
D SqlLibrary S 13 Varying
D SqlSubSet S 13 Varying
D
D DS1 DS
D ThisLibrary 10
D ThisProgram 10
D ThisText 50
D ThisObject 11
D ThisFusg 3 0
D ThisSpkg 1
¹ *-------------------------------------------------------------------------
D
C *ENTRY PLIST
C PARM x_obj 10
C PARM x_lib 10
C PARM x_usage 2 0
C PARM x_mos 1
C PARM rtn_err 5
/Free
é ExSr @Initial;
DoW *IN03 = *OFF and but2 <> 3;
Write Footer;
ExFmt sfc1;
Read Footer;
QM_msgtxt = '';
é ExSr @WrtMsg;
Select;
When *IN13;
ExFmt help;
When *In04 OR but2 = 4;
é ExSr @XUsage;
é ExSr @Position;
é ExSr @LoadSf;
¹ // Bring up the source for the object on the top of the screen'
When *In09 OR but2 = 9;
CallP BrowseObj (Df_XObj:
Df_XLib);
When *In08;
CommandLine = 'WRKOBJ OBJ(*AllUsr/' +
%Trim(df_Xobj) + ')';
CommandLength = %Len(CommandLine);
CallP SystemCommand(CommandLine :
CommandLength);
When *IN06 OR but2 = 6;
If DF_TYPE = 'File ';
file_parm = df_xobj;
CommandLine = 'WRKDBF FILENAME(' + file_parm+')';
CommandLength = 27;
CallP SystemCommand(CommandLine :
CommandLength);
Else;
QM_msgtxt = 'You can not use F6 '+
'unless the X-Object is a file.';
é ExSr @WrtMsg;
EndIf;
When *IN12 OR but2 = 7;
If lvl <= 1;
QM_msgtxt = 'You can not go back a '+
' level. Already at base level.';
é ExSr @WrtMsg;
Else;
lvl = lvl - 1;
df_level = lvl;
df_xobj = xary(lvl);
df_xlib = xLib(lvl);
df_SubSet = xSub(lvl);
Sav_Subset = xSub(lvl);
Sav_XLib= xLib(lvl);
SAV_xobj = xary(lvl);
é ExSr @Position;
é ExSr @LoadSf;
EndIf;
When *IN21 OR but2 = 8;
Callp PopUp();
When *IN03 OR but2 = 3;
Other;
If (df_mos = 'M') OR (df_mos = 'S');
é ExSr @Main;
Else;
QM_msgtxt = 'The Match or Search field ' +
'has to be "M" or "S". Try again.';
é ExSr @Wrtmsg;
EndIf;
EndSl;
EndDO;
If SqlOpen;
é ExSr @Close;
EndIf;
*InLr = *On;
Return;
/End-Free
¹ //-----------------------------------------------------------------------
¹ // End of main control. Subroutines follow.
¹ //----------------------------------------------------------------------
/Free
é BegSr @Initial;
é ExSr @ClearSf;
Clear sfl1;
Rr1 = 1;
Write sfl1;
¹ // Set for first usage
df_xlib = x_lib;
df_xusage = x_usage;
df_mos = x_mos;
df_level = lvl;
df_xobj = x_obj;
df_hits = 0;
df_unique = 0;
Last_obj = '';
*IN89 = *ON;
¹ // Was a parm sent in
If df_xobj <> '';
Rr1 = 0;
é ExSr @Main;
EndIf;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
/Free
é BegSr @ClearSf;
*In57 = *ON;
Write sfc1;
*IN57 = *Off;
rr1 = 0;
df_hits = 0;
df_unique = 0;
sflrcd = rr1 + 1;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
¹ // Subroutine to send status messages
¹ //-----------------------------------------------------------------------
/Free
é BegSr @wrtmsg;
CallP(E) SendMessage( QM_MsgId :
QM_MsgF :
QM_MsgTxt :
QM_Msgdln :
QM_MsgTyp :
Qm_MsgQ :
Qm_StkCtr :
Qm_MsgKy :
APIERR );
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
/Free
é BegSr @XUsage;
w_usage = df_xusage;
ExFmt WIN1;
df_xusage = w_usage;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
¹ //Determine if the user changed the Xobject or pressed enter with a selec
¹ //-----------------------------------------------------------------------
/Free
é BegSr @Main;
*In89 = *Off;
If (sav_xobj <> df_xobj) OR
(sav_xlib <> df_xlib) OR
(sav_xusage <> df_xusage) OR
(sav_SubSet <> df_SubSet) OR
(sav_mos <> df_mos);
lvl += 1;
df_level = lvl;
xary(lvl) = df_xobj;
xLib(lvl) = df_xlib;
xSub(lvl) = df_SubSet;
sav_xobj = df_xobj;
Sav_xlib = df_xlib;
sav_xusage = df_xusage;
sav_SubSet = df_SubSet;
sav_mos = df_mos;
é ExSr @Position;
é ExSr @LoadSf;
Else;
IF *IN25;
é ExSr @LoadSf;
Else;
é ExSr @readSf;
EndIf;
EndIf;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
¹ // Get the stuff for the top of the screen, build the SQL
¹ //-----------------------------------------------------------------------
/Free
é BegSr @Position;
If df_xlib = '';
df_xlib = '*LIBL ';
SqlLibrary = '%';
ElseIf Df_XLib = '*LIBL';
SqlLibrary = '%';
Else;
SqlLibrary = '%' + %Trim(Df_XLib) + '%';
EndIf;
If df_SubSet = '';
SqlSubSet = '%';
Else;
SqlSubSet = '%' + %Trim(Df_SubSet) + '%';
EndIf;
If df_mos = 'M';
df_search = '';
SqlObject = %Trim(Df_XObj);
¹ // Build the basic statement
SqlStmt =
'select WhLib, WhPnam, WhText, WhFNam, ' +
' WhFusg, WhSpkg ' +
' From XRef Where Whfnam = ? ' +
' And WhLib Like ? ' +
' And WhPNam Like ? ' +
' order by whlib , whpnam ';
Else;
df_search = 'Search XObj';
SqlObject = '%' + %Trim(Df_XObj) + '%';
¹ // Build the basic statement
SqlStmt =
'select WhLib, WhPnam, WhText, WhFNam, ' +
' WhFusg, WhSpkg ' +
' From XRef Where Whfnam like ? ' +
' And WhLib Like ? ' +
' And WhPNam Like ? ' +
' order by whlib ,whpnam ' ;
EndIf;
é ExSr @ClearSf;
QM_msgtxt = 'please Wait, Fetching records...';
é ExSr @WrtMsg;
If SqlOpen;
é ExSr @Close;
EndIf;
¹ // Prepare the statement
é ExSr @Prepare;
¹ // Declare the cursor
é ExSr @Declare;
é ExSr @OpenCursor;
SqlOpen = *on;
¹ //Get the Obs type and description and place on scree.
p_obj = xary(lvl);
p_desc = *blanks;
f_desc = *blanks;
s_desc = *blanks;
Df_Create = 0;
Df_Last = 0;
Df_Used = 0;
CallP GetXRefD (p_obj :
P_desc :
S_desc :
F_desc :
PCreate :
PLast :
PUsed );
Select;
When p_desc <> '';
df_desc = p_desc;
df_type = 'Program';
When f_desc <> '';
df_desc = f_desc;
df_type = 'File';
When s_desc <> '';
f_desc = s_desc;
df_type = 'Service PG';
Other;
df_desc = 'Unresolved by system';
df_type = 'Unresolved';
EndSl;
If PCreate <> '';
Df_Create = %UNS(%SubSt(PCreate:2:6));
JunkIso = %Date(Df_Create:*YMD);
Df_Create = %UNS(%CHAR(JunkIso:*MDY0));
EndIf;
If PLast <> '';
Df_Last = %UNS(%SubSt(PLast:2:6));
JunkIso = %Date(Df_Last:*YMD);
Df_Last = %UNS(%CHAR(JunkIso:*MDY0));
EndIf;
Df_Used = PUsed;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
¹ // load subfile with the selected xobject and options
¹ //-----------------------------------------------------------------------
/Free
é BegSr @LoadSf;
If SqlCod = 0;
sflrcd = rr1 + 1;
For Crap = 1 to 17;
é ExSr @Fetch;
If SqlCod <> 0;
é ExSr @GetMenus;
Leave;
EndIf;
If last_obj <> ThisProgram;
df_unique = df_unique + 1;
*In52 = *On;
Else;
*In52 = *Off;
EndIf;
Clear Sfl1;
If *In52 = *On;
*In51 = *On;
EndIf;
sf_sel = ' ';
sf_obj = ThisProgram;
sf_lib = ThisLibrary;
sf_desc = ThisText;
sf_usage = usg(Thisfusg + 1);
last_obj = ThisProgram;
If df_mos = 'M';
sf_xobj = *blanks;
Else;
sf_xobj = ThisObject;
EndIf;
Select;
When Thisspkg = 'P';
sf_type = 'Program';
Sf_ThisTyp = '*PGM';
When ThisSpkg = 'S';
sf_type = 'SQLPackage';
sf_ThisTyp = '*SQLPKG';
When ThisSpkg = 'V';
sf_type = 'Service PG';
Sf_ThisTyp = '*SRVPGM';
When ThisSpkg = 'M';
sf_type = 'Module ILE';
Sf_ThisTyp = '*MODULE';
When ThisSpkg = 'Q';
sf_type = 'Query/400 ';
Sf_ThisTyp = '*QRYDFN';
When ThisSpkg = 'I';
sf_type = 'Inter Quer';
Sf_ThisTyp = '*USRSPC';
When ThisSpkg = 'L';
sf_type = '*QmQry SQL';
Sf_ThisTyp = '*QMQRY';
Other;
sf_type = 'System hlp';
EndSl;
rr1 = rr1 + 1;
df_hits = rr1;
Sf_Create = 0;
Sf_Last = 0;
Sf_Used = 0;
CallP GetDates ( ThisProgram:
ThisLibrary:
Sf_ThisTyp:
PCreate:
PLast:
Pused);
If PCreate <> '';
Sf_Create = %UNS(%SubSt(PCreate:2:6));
JunkIso = %Date(Sf_Create:*YMD);
Sf_Create = %UNS(%CHAR(JunkIso:*MDY0));
EndIf;
If PLast <> '';
Sf_Last = %UNS(%SubSt(PLast:2:6));
JunkIso = %Date(Sf_Last:*YMD);
Sf_Last = %UNS(%CHAR(JunkIso:*MDY0));
EndIf;
Sf_Used = PUsed;
Write sfl1;
EndFor;
Else;
é ExSr @GetMenus;
EndIf;
QM_msgtxt = '';
é ExSr @WrtMsg;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
/Free
é BegSr @ReadSf;
*In70 = *Off;
rr1Save = rr1;
rr1 = 1;
Chain rr1 Sfl1;
DoW %Found();
If sf_sel = '2' or Sf_Sel = '5';
CallP BrowseObj (Sf_Obj:
Sf_Lib);
sflrcd = rr1;
sf_sel = '';
Update Sfl1;
Leave;
elseIf sf_sel = '8';
CommandLine = XRef_parm = 'WRKOBJ OBJ(' + %Trim(sf_lib) +
'/' + %Trim(sf_obj) + ')';
CommandLength = %Len(CommandLine);
CallP SystemCommand(CommandLine :
CommandLength);
sflrcd = rr1;
sf_sel = '';
Update Sfl1;
Leave;
elseIf sf_sel = '9';
CommandLine = 'WRKOBJ OBJ(*AllUsr/' +
%Trim(sf_obj) + ')';
CommandLength = %Len(CommandLine);
CallP SystemCommand(CommandLine :
CommandLength);
sflrcd = rr1;
sf_sel = '';
Update Sfl1;
Leave;
elseIf sf_sel <> *blanks;
lvl = lvl + 1;
df_level = lvl;
df_xobj = sf_obj;
df_xLib = sf_Lib;
xary(lvl) = sf_obj;
xLib(lvl) = sf_Lib;
xSub(lvl) = Df_SubSet;
sav_xobj = sf_obj;
sav_xlib = Sf_lib;
sav_xusage = df_xusage;
sav_mos = df_mos;
*In70 = *ON;
Leave;
Else;
rr1 += 1;
Chain rr1 Sfl1;
EndIf;
EndDo;
If *IN70;
sav_xusage = 9;
df_xusage = 9;
é ExSr @Position;
é ExSr @LoadSf;
Else;
Rr1 = Rr1Save;
EndIf;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
/Free
é BegSr @GetMenus;
Clear Sfl1;
Jda_Pgm = %SUbST( xary(lvl) :1:08);
SetLl (Jda_Pgm) MMenuoL4;
ReadE (Jda_Pgm) MMenuoL4;
JDAOpen = *Off;
DoW Not %EOF(MMenuoL4);
JDAOpen = *On;
Opt_Out = %EditC(OptNbr:'Z');
sf_desc = 'Found on Menu : ' + OptMnu +
' Option : ' + opt_out;
sflrcd = rr1 + 1;
rr1 = rr1 + 1;
Write sfl1;
ReadE (Jda_Pgm) MMenuoL4;
EndDo;
If Not JDAOpen And Rr1 = 0;
Clear Sfl1;
sf_desc = 'Object not found for selections';
sflrcd = rr1 + 1;
rr1 = rr1 + 1;
Write sfl1;
EndIf;
é EndSr;
/End-Free
¹ //-----------------------------------------------------------------------
C *PSSR BEGSR
C MOVE errcode rtn_err
C MOVE '*CANCL' ReturnPt 6
C ENDSR ReturnPt
¹ //------------------------------------------------------------------
¹ // Prepare the statement
éC @Prepare BegSr
C/exec sql
C+ PREPARE P1 FROM :SqlStmt
C/end-exec
éC EndSr
¹ //------------------------------------------------------------------
¹ // Declare the cursor
éC @Declare BegSr
C/exec sql
C+ DECLARE C1 CURSOR FOR P1
C/end-exec
éC EndSr
¹ //------------------------------------------------------------------
¹ // Fetch the records
éC @Fetch BegSr
C/exec sql
C+ FETCH C1 INTO :DS1
C/end-exec
éC EndSr
¹ //------------------------------------------------------------------
éC @Close BegSr
C/exec sql
C+ CLOSE C1
C/end-exec
éC EndSr
¹ //------------------------------------------------------------------
¹ // Open the Cursor
éC @OpenCursor BegSr
C/EXEC SQL
C+ Open C1 Using: SqlObject,
C+ : SqlLibrary,
C+ : SqlSubSet
C/END-EXEC
éC EndSr
2737¹ //------------------------------------------------------------------
** Usage Array 1 is added to the usage for the index to get this data.
call/DtaAra
Inpt file
Prt/Out file
Dspf
Upd Only
OvR/OPNQRYF
Up w/ ADD
I/O/A
Not Reslvd by system
*ALL Default
Variable used in program
Qry/400 input
IQuery Input
IQuery Output


XREF0010DF.DSPF
A*/PCMD
A*
A* CRTDSPF FILE(*OBJLIB/*OBJNAM) +
A* SRCFILE(*SRCLIB/*SRCFIL) +
A* SRCMBR(*SRCMBR) +
A* RSTDSP(*YES)
A*/ECMD
A*%%EC
A DSPSIZ(27 132 *DS4)
A PRINT
A R FOOTER
A OVERLAY
A BUT2 2Y 0B 26 2PSHBTNFLD((*NUMROW 1) (*GUTTER 1))
A PSHBTNCHC(1 ' Enter ')
A PSHBTNCHC(2 ' ')
A PSHBTNCHC(3 'F1/F3Exit')
A PSHBTNCHC(4 'F4X-Usage')
A PSHBTNCHC(5 ' ')
A PSHBTNCHC(6 'F6 WRKDBF')
A PSHBTNCHC(7 'F12 Back')
A PSHBTNCHC(8 'F21 CLine')
A PSHBTNCHC(9 'F9 Source')
A R SFL1 SFL
A SF_THISTYP 10A H
A SF_SEL 1A B 8 2
A SF_OBJ 11A O 8 4
A 51 COLOR(BLU)
A N51 COLOR(GRN)
A SF_LIB 10A O 8 16
A SF_DESC 50A O 8 27
A SF_USAGE 10A O 8 78
A SF_TYPE 7A O 8 89
A SF_CREATE 6Y 0O 8 97EDTCDE(Y)
A COLOR(WHT)
A SF_LAST 6Y 0O 8106EDTCDE(Y)
A COLOR(PNK)
A SF_USED 5Y 0O 8115EDTCDE(Z)
A COLOR(BLU)
A SF_XOBJ 9A O 8121
A R SFC1 SFLCTL(SFL1)
A SFLSIZ(0018)
A SFLPAG(0017)
A CF13(13 'HELP')
A CF01(03 'Exit')
A CA03(03)
A CF04(04 'USAGE SELECT')
A CF05(05 'X-DATABASE RELATIONS')
A CF06(06 'WORK DATA BASE FILE')
A CF08(08 'WORK Object Top')
A CF12(12 'BACK 1 LEVEL')
A CF21(21 'COMMAND LINE')
A CF09(09 'View Source of XObj')
A CF10(10 'View J- File')
A CF11(11 'Powerlock')
A OVERLAY
A N57 SFLDSP
A N57 SFLDSPCTL
A 57 SFLCLR
A 47 SFLEND(*SCRBAR *MORE)
A ROLLUP(25 'RollUp')
A SFLRCD 4S 0H SFLRCDNBR(CURSOR)
A 1 3'Date :'
A 1 10DATE
A EDTCDE(Y)
A 1 54'X-Object Cross Refference'
A COLOR(WHT)
A 1116'User :'
A 1123USER
A 2 3'Time :'
A 2 10TIME
A 2 27'X-Type '
A COLOR(YLW)
A 2 39'X-Description -
A '
A COLOR(YLW)
A 2116'Pgm :'
A DF_PGM 10 O 2123
A 3 2'X-Obj '
A COLOR(YLW)
A DF_XOBJ 11A B 3 13ENTFLDATR((*DSPATR UL))
A 89 DSPATR(PC)
A DF_TYPE 10A O 3 27
A DF_DESC 50A O 3 39
A 3 94'Creation Date:'
A DF_CREATE 6Y 0O 3109EDTCDE(Y)
A DSPATR(UL)
A COLOR(WHT)
A 4 2'X-Lib '
A COLOR(YLW)
A DF_XLIB 10A B 4 13ENTFLDATR((*DSPATR UL))
A 4 27'SubSet -->'
A COLOR(YLW)
A DF_SUBSET 10A B 4 39ENTFLDATR((*DSPATR UL))
A 4 93'Last Used Date:'
A DF_LAST 6Y 0O 4109EDTCDE(Y)
A COLOR(PNK)
A DSPATR(UL)
A 4121'Level:'
A DF_LEVEL 2Y 0O 4128COLOR(WHT)
A EDTCDE(3)
A 5 2'X-Usage '
A COLOR(YLW)
A DF_XUSAGE 2Y 0B 5 13EDTCDE(Z)
A ENTFLDATR((*DSPATR UL))
A 5 16'(M)atch or (S)earch'
A COLOR(YLW)
A DF_MOS 1A B 5 36
A 5 40'Number of X-Refs'
A COLOR(YLW)
A DF_HITS 4Y 0O 5 57EDTCDE(Z)
A 5 63'Number of Unique X-Refs'
A COLOR(YLW)
A DF_UNIQUE 4Y 0O 5 87EDTCDE(Z)
A COLOR(WHT)
A 5 93'Day Used Count:'
A DF_USED 5Y 0O 5112DSPATR(UL)
A EDTCDE(Z)
A COLOR(BLU)
A 6 2'2/5='
A COLOR(WHT)
A 6 7'Source'
A COLOR(BLU)
A 6 15'8='
A COLOR(WHT)
A 6 18'WrkObj/Lib'
A COLOR(BLU)
A 6 30'9='
A COLOR(WHT)
A 6 33'WrkObj/*AllUsr'
A COLOR(BLU)
A 6 69'Any Key='
A COLOR(WHT)
A 6 79'Drill Down'
A COLOR(BLU)
A 6115'F8='
A COLOR(WHT)
A 6119'WrkObj(XObj)'
A COLOR(BLU)
A 7 2'S'
A DSPATR(UL)
A 7 4'Ref Object'
A DSPATR(UL)
A 7 16'Ref Lib '
A DSPATR(UL)
A 7 27'Description -
A '
A DSPATR(UL)
A 7 78'Usage '
A DSPATR(UL)
A 7 89'Type '
A DSPATR(UL)
A 7 97' Create'
A DSPATR(UL)
A 7106' Last'
A DSPATR(UL)
A 7115' Days'
A DSPATR(UL)
A DF_SEARCH 11A O 7121DSPATR(UL)
A R WIN1
A WINDOW(*DFT 17 40)
A 1 10'Select An Usage Number'
A COLOR(WHT)
A W_USAGE 2Y 0B 2 1EDTCDE(Z)
A COMP(LE 14)
A 2 4'0'
A COLOR(WHT)
A 2 6'Program call Or Data Area'
A 3 4'1'
A COLOR(WHT)
A 3 6'Input file'
A 4 4'2'
A COLOR(WHT)
A 4 6'Printer Or Output file'
A 5 4'3'
A COLOR(WHT)
A 5 6'Display file'
A 6 4'4'
A COLOR(WHT)
A 6 6'Update Only'
A 7 4'5'
A COLOR(WHT)
A 7 6'OverRide Or OPNQRYF'
A 8 4'6'
A COLOR(WHT)
A 8 6'Update with ADD'
A 9 4'7'
A COLOR(WHT)
A 9 6'DFU or Display file'
A 10 4'8'
A COLOR(WHT)
A 10 6'Not Resolved by system'
A 11 4'9'
A COLOR(WHT)
A 11 6'*ALL'
A 11 12'Default'
A 12 3'10'
A COLOR(WHT)
A 12 6'Variable used in program'
A 13 3'11'
A COLOR(WHT)
A 13 6'Query/400 input'
A 14 3'12'
A COLOR(WHT)
A 14 6'Interactive Query - NGS Inc. Input'
A 15 3'13'
A COLOR(WHT)
A 15 6'Interactive Query - NGS Inc. Outpu-
A t'
A 16 3'14'
A COLOR(WHT)
A 16 6'*QmQry (SQL)'
A R HELP
A 1 3'Date :'
A 1 10DATE
A EDTCDE(Y)
A 1 29'HELP'
A DSPATR(RI)
A COLOR(BLU)
A 1 57' '
A COLOR(WHT)
A 1116'User :'
A 1123USER
A 2 3'Time :'
A 2 10TIME
A 2 54'X-Object Cross Refference'
A COLOR(WHT)
A 2116'Pgm :'
A 2123'XREFMMBR1'
A 4 3'Scope: This program shows how an o-
A bject is referenced by the AS/400. -
A This is accomplished by using the -
A DSPPGMREF for all user'
A 5 10'libaries.'
A 5 21'You can see how a file/data area/p-
A gm/srv pgm is being used and where -
A program calls can be found.'
A 7 3'How to Use: the XMMB command start-
A s this program. The command can be-
A prompted to provide automatic acti-
A on. Once in the program'
A 8 15'enter an object and press enter. -
A The subfile builds with all hits fo-
A r this object. You can then enter -
A select a '
A 9 15'entry and press enter. This will -
A then show you how this object is re-
A ferenced. The Level on the top rig-
A ht of the '
A 10 15'screen increases by 1. This alows-
A you to press F12 and go back to th-
A e previous Xobject.'
A 12 3'Options: The Xlib should be 1. *LI-
A BL to search all user created libar-
A ies.'
A 13 31'2. Any user created libary.'
A 15 12'The Xusage can be a number from 0 -
A through 11. Use F4 to select and se-
A e descriptions of each usage.'
A 17 12'The Match or Search can be M. The -
A will perform an exact match for the-
A Xobject.'
A 18 39'S. The Search will posistion the f-
A ile at the first or nearest record -
A of the object.'
A 19 42'The left most column will contain -
A the Xobject that is being reference-
A .'
A 20 42'The search is mainly intended for -
A logical refference, but is not limi-
A ted to this.'
A 22 12'The F12 Back function is used to g-
A o back and see what were previous s-
A elections from the subfile.'
A BUT3 2Y 0B 26 66PSHBTNFLD((*NUMROW 1) (*GUTTER 1))
A PSHBTNCHC(1 'PRESS ENTER WHEN DONE')
A 1 90'HELP'
A DSPATR(RI)
A COLOR(BLU)
A 24 3'Any object that comes back as Unre-
A solved as the X-Type is just an obj-
A ect that is not in your *LIBL but i-
A s in the *ALLUSRLIBL.'


XREF0011.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
PGM PARM(&OBJ &LIB &USAGE &MOS)
/* IN PARM */DCL VAR(&OBJ) TYPE(*CHAR) LEN(10) /* THE OBJECT */
/* IN PARM */DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* THE LIBRARY */
/* IN PARM */DCL VAR(&USAGE) TYPE(*DEC) LEN(2 0) /* THE USAGE */
/* IN PARM */DCL VAR(&MOS) TYPE(*CHAR) LEN(1) /* THE MATCH */
/* RETURN */DCL VAR(&RTN_ERR) TYPE(*CHAR) LEN(5) /* RETURN ERROR */
CHGJOB INQMSGRPY(*DFT)

CALL PGM(XREF0010) PARM(&OBJ &LIB &USAGE &MOS &RTN_ERR)


MONMSG MSGID(CEE9901) EXEC(GOTO CMDLBL(ERROR))
GOTO CMDLBL(OK)
ERROR: SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('You +
have to be using a session with 27 x 132 +
Lines. XRef has been cancelled.')
OK: RCLRSC
CHGJOB INQMSGRPY(*SYSRPYL)
ENDPGM


XREF0012.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
PGM PARM(&OBJ &P_DESC &S_DESC &F_DESC +
&PCreate &PLast &PCount)
/* IN PARM */DCL VAR(&OBJ) TYPE(*CHAR) LEN(10) /* THE OBJECT
*/
/* RETURNED*/DCL VAR(&P_DESC) TYPE(*CHAR) LEN(50) /* PROGRAM DESCRIPTION
*/
/* RETURNED*/DCL VAR(&S_DESC) TYPE(*CHAR) LEN(50) /* SERVICE PGM DESCRIPT
*/
/* RETURNED*/DCL VAR(&F_DESC) TYPE(*CHAR) LEN(50) /* FILE DESCRIPTION
*/
/* RETURNED*/DCL VAR(&PCreate) TYPE(*Char) LEN(13 ) /* Create Date
*/
/* RETURNED*/DCL VAR(&PLast ) TYPE(*Char) LEN(7 ) /* last used Date
*/
/* RETURNED*/DCL VAR(&PCount ) TYPE(*Dec ) LEN(5 0) /* Days Used COunt
*/

MONMSG MSGID(CPF9811 CPF9812 CPF9801 CPF0001) /* +


The object does not exist in one ore more +
of the chioces */
RTVOBJD OBJ(&OBJ) OBJTYPE(*PGM) TEXT(&P_DESC) +
CRTDATE(&PCREATE) USEDATE(&PLAST) +
USECOUNT(&PCOUNT)
RTVOBJD OBJ(&OBJ) OBJTYPE(*SrvPgm) TEXT(&s_DESC) +
CRTDATE(&PCREATE) USEDATE(&PLAST) +
USECOUNT(&PCOUNT)

RTVOBJD OBJ(&OBJ) OBJTYPE(*File) TEXT(&F_DESC) +


CRTDATE(&PCREATE) USEDATE(&PLAST) +
USECOUNT(&PCOUNT)

ENDPGM


XREF0013.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
PGM PARM(&OBJ &Lib &Type +
&PCreate &PLast &PCount)
/* IN PARM */DCL VAR(&OBJ) TYPE(*CHAR) LEN(10) /* THE OBJECT
*/
/* IN PARM */DCL VAR(&Lib) TYPE(*CHAR) LEN(10) /* THE Library
*/
/* IN PARM */DCL VAR(&Type) TYPE(*CHAR) LEN(10) /* THE Type
*/
/* RETURNED*/DCL VAR(&PCreate) TYPE(*Char) LEN(13 ) /* Create Date
*/
/* RETURNED*/DCL VAR(&PLast ) TYPE(*Char) LEN(7 ) /* last used Date
*/
/* RETURNED*/DCL VAR(&PCount ) TYPE(*Dec ) LEN(5 0) /* Days Used COunt
*/
MONMSG MSGID(CPF9811 CPF9812 CPF9801 CPF0001 +
CPF9821) /* The object does not exist in +
one ore more of the chioces */
RTVOBJD OBJ(&LIB/&OBJ) OBJTYPE(&TYPE) +
CRTDATE(&PCREATE) USEDATE(&PLAST) +
USECOUNT(&PCOUNT)
MONMSG MSGID(CPF9802 CPF9820)
ENDPGM
ENDPGM

XREF0014.RPGLE
*/PCMD *MODULE
* CRTRPGMOD MODULE(QTEMP/*OBJNAM) +
* SRCFILE(*SRCLIB/*SRCFIL) +
* SRCMBR(*SRCMBR) +
* DBGVIEW(*ALL )
*/ECMD
*/PCMD *PGM
* CRTPGM PGM(*OBJLIB/*OBJNAM) +
* MODULE(QTEMP/*OBJNAM) +
* ACTGRP(*CALLER) +
* DETAIL(*BASIC)
* /ECMD
ÿ H Option(*NoDebugIo:*SrcStmt:*NoExpDds)
H Debug( *Yes )
H AlwNull(*UsrCtl)
é // Modification Highlights
// Date Programmer Description
¹ //
é //
* List ILE program information API
D QBNLPGMI PR ExtPgm('QBNLPGMI')
D UsrSpc 20A const
D Format 8A const
D PgmName 20A const
D Errors 32766A options(*varsize)
* List ILE service program information API
D QBNLSPGM PR ExtPgm('QBNLSPGM')
D UsrSpc 20A const
D Format 8A const
D SrvPgm 20A const
D Errors 32766A options(*varsize)
* Create User Space API
D QUSCRTUS PR ExtPgm('QUSCRTUS')
D UsrSpc 20A const
D ExtAttr 10A const
D InitSize 10I 0 const
D InitVal 1A const
D PublicAuth 10A const
D Text 50A const
D Replace 10A const
D Errors 32766A options(*varsize)
* Retrieve pointer to user space API
D QUSPTRUS PR ExtPgm('QUSPTRUS')
D UsrSpc 20A const
D Pointer *
* API error code structure
D dsEC DS
D dsECBytesP 10I 0 inz(%size(dsEC))
D dsECBytesA 10I 0 inz(0)
D dsECMsgID 7A
D dsECReserv 1A
D dsECMsgDta 240A
* List API generic header structure
D p_Header S *
D dsLH DS BASED(p_Header)
D* Filler
D dsLHFill1 103A
D* Status (I=Incomplete,C=Complete
D* F=Partially Complete)
D dsLHStatus 1A
D* Filler
D dsLHFill2 12A
D* Header Offset
D dsLHHdrOff 10I 0
D* Header Size
D dsLHHdrSiz 10I 0
D* List Offset
D dsLHLstOff 10I 0
D* List Size
D dsLHLstSiz 10I 0
D* Count of Entries in List
D dsLHEntCnt 10I 0
D* Size of a single entry
D dsLHEntSiz 10I 0
* PGML0100 format: modules in program
* SPGL0100 format: modules in service program
* (these fields are the same in both APIs)
D p_Entry S *
D dsPgm DS based(p_Entry)
D dsPgm_Pgm 10A
D dsPgm_PgmLib 10A
D dsPgm_Module 10A
D dsPgm_ModLib 10A
D dsPgm_SrcF 10A
D dsPgm_SrcLib 10A
D dsPgm_SrcMbr 10A
D dsPgm_Attrib 10A
D dsPgm_CrtDat 13A
D dsPgm_SrcDat 13A
D peProgram S 10A
D peLibrary S 10A
D oeSrcFile S 10A
D oeSrcLib S 10A
D oeSrcMember S 10A
D ComboPgmLib S 20A
D Entry S 10I 0
c *entry plist
c parm peProgram
c parm peLibrary
c parm oeSrcFile
c parm oeSrcLib
c parm oeSrcMember
c eval ComboPgmLib = peProgram + peLibrary
c eval oeSrcFile = ''
c eval oeSrcLib = ''
c eval oeSrcMember = ''
* Create a user space to stuff module info into
c callp QUSCRTUS('MODULES QTEMP': 'USRSPC':
c 1024*1024: x'00': '*ALL':
c 'List of modules': '*YES': dsEC)
c callp QUSPTRUS('MODULES QTEMP': p_Header)
* List all ILE programs modules to space
c callp QBNLPGMI('MODULES QTEMP': 'PGML0100':
c ComboPgmLib : dsEC)
* Only get the first module.
c eval p_Entry = p_Header + dsLHLstOff
c eval oeSrcFile = dsPgm_SrcF
c eval oeSrcLib = dsPgm_SrcLib
c eval oeSrcMember = dsPgm_SrcMbr
* And that's about the size of it
c eval *inlr = *on


XREF.PF
**********************************************************************
* PRECOMPILER DIRECTIVES
*/PCMD
* CRTPF FILE(*OBJLIB/*OBJNAM) +
* SRCFILE(*SRCLIB/*SRCFIL) +
* SRCMBR(*SRCMBR) +
* SIZE(*NOMAX)
*/ECMD
A*
A R QWHDRPPR TEXT('DSPPGMREF format')
A*
A WHLIB 10A COLHDG('Library')
A TEXT('Library')
A*
A WHPNAM 10A COLHDG('Program')
A TEXT('Program')
A*
A WHTEXT 50A COLHDG('Description')
A TEXT('Text description')
A*
A WHFNUM 5S 0 COLHDG('Number Of' 'Object-
A s Referenced')
A TEXT('Number of objects re-
A ferenced')
A*
A WHDTTM 13A COLHDG('Retrieval' 'Date A-
A nd Time')
A TEXT('Retrieval date: cen-
A tury/date/time')
A*
A WHFNAM 11A COLHDG('Object' 'Reference-
A d')
A TEXT('Object referenced: 1-
A =*EXPR')
A*
A WHLNAM 11A COLHDG('Library')
A TEXT('Library referenced:-
A 1=*EXPR')
A*
A WHSNAM 11A COLHDG('Source' 'File Name-
A ')
A TEXT('File name in source-
A program: 1=*EXPR')
A*
A WHRFNO 3S 0 COLHDG('Number Of' 'Record-
A Formats')
A TEXT('Number of record for-
A mats referenced. -1=See WH-
A RFNB')
A*
A WHFUSG 2S 0 COLHDG('File Usage')
A TEXT('1=I,2=O,3=I/O,4=U,5=-
A I/U,6=O/U,7=I/O/U,8=N/S,0=-
A N/A')
A*
A WHRFNM 10A COLHDG('Record' 'Format')
A TEXT('Record format refere-
A nced')
A*
A WHRFSN 13A COLHDG('Format Level' 'Ide-
A ntifier')
A TEXT('Format level identif-
A ier')
A*
A WHRFFN 5S 0 COLHDG('Number Of' 'Fields-
A ')
A TEXT('Number of fields')
A*
A WHOBJT 1A COLHDG('Object' 'Type')
A TEXT('Object type: F=File,-
A P=Program, D=Data area')
A*
A WHOTYP 10A COLHDG('Object' 'Type')
A TEXT('Object type')
A*
A WHSYSN 8A COLHDG('System' 'Name')
A TEXT('System Name (Source-
A System, if file is DDM)')
A*
A WHSPKG 1A COLHDG('Referencing' 'Obje-
A ct' 'Type')
A TEXT('PGM=P, SQLPKG=S, SRV-
A PGM=V, MODULE=M')
A*
A WHRFNB 5S 0 COLHDG('Number Of' 'Record-
A Formats')
A TEXT('Number of record for-
A mats referenced.')
A*
K WHFNAM
K WHLIB
K WHPNAM

XREFBLD.CMD
/*/PCMD */
/* */
/* */
/* CRTCMD CMD(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* PGM(XREF0001) */
/* */
/*/ECMD */
/* */
CMD PROMPT('Submits The XRef (Re)Build')


XREFCL10.CLP
/*/PCMD */
/* */
/* CRTCLPGM PGM(*OBJLIB/*OBJNAM) + */
/* SRCFILE(*SRCLIB/*SRCFIL) + */
/* SRCMBR(*SRCMBR) + */
/* OPTION(*SRCDBG) */
/* */
/*/ECMD */
*/
PGM PARM(&ThisObj &ThisLib )
DCL &ThisObj *CHAR LEN(10)
DCL &Thislib *CHAR LEN(10)
DCL &ThisSFile *CHAR LEN(10)
DCL &ThisSLib *CHAR LEN(10)
DCL &ThisSMem *CHAR LEN(10)

/* é**************************************************************** +
¹ Try and retreive the values for this object +
é**************************************************************** */
Call Xref0017 Parm(&ThisObj +
&Thislib +
&ThisSFile +
&ThisSLib +
&ThisSMem )
StrSeu SrcFile(&ThisSLib/&ThisSFile) +
SrcMBR(&ThisSMem) OPTION(5)
/* INDRPG SRCMBR(&ThisSMem) SRCFILE(&ThisSLib/&ThisSFile) *
/
MONMSG MSGID(CPF0001 CPF9810)
enddo
ENDPGM

XREFINLINE.PF
*/PCMD
* CRTPF FILE(*OBJLIB/*OBJNAM) +
* SRCFILE(*SRCLIB/*SRCFIL) +
* SRCMBR(*SRCMBR) +
* SIZE(*NOMAX)
*/ECMD
A*
A R XINLINE TEXT('DUMP Receiver')
A*
A R_LINE 132A COLHDG('Dump')
A TEXT('DUmp')


You might also like