You must be logged in to use the copy button.
**Free
ctl-opt
copyright('Copyright JAS, Inc. 2024')
nomain debug
option(*srcstmt : *nodebugio) ccsid(*char:*jobrun)
decedit(*jobrun) alwnull(*usrctl);
//***********************************************************************************
// PURPOSE: This application is designed to retrieve the row and column coordinates
// for a specified field within a Display File (DSPF) record format.
// **********************************************************************************
// COMPILE Module: CRTRPGMOD MODULE(*CURLIB/JSFLDLOC) SRCFILE(*CURLIB/QRPGLESRC)
// SRCMBR(JSFLDLOC) DBGVIEW(*SOURCE) REPLACE(*YES)
// COMPILE SrvPgm: CRTSRVPGM SRVPGM(*CURLIB/JSFLDLOC) EXPORT(*ALL) ACTGRP(*CALLER)
// **********************************************************************************
dcl-ds QUsec; // Qus EC
QUSBPRV bindec(9) pos(1); // Bytes Provided
QUSBAVL bindec(9) pos(5); // Bytes Available
QUSEI char(7) pos(9); // Exception Id
QUSERVED char(1) pos(16); // Reserved
end-ds;
dcl-ds QUSD0100;
QUSBRTN06 bindec(4) pos(1);
QUSBAVL07 bindec(8) pos(5);
QUSOBJN00 char(10) pos(9);
QUSOBJLN char(10) pos(19);
QUSOBJT00 char(10) pos(29);
QUSRL01 char(10) pos(39);
QUSASP04 bindec(9) pos(49);
QUSOBJO04 char(10) pos(53);
QUSOBJD04 char(2) pos(63);
QUSCDT10 char(13) pos(65);
QUSCDT11 char(13) pos(78);
end-ds;
dcl-s FileLib char(20);
dcl-s Lib char(10);
dcl-s Index int(10);
dcl-s FileHeader int(10);
dcl-s RecordHeader int(10);
dcl-s RecordDevDep int(10);
dcl-s FieldIndexTable int(10);
dcl-s ScreenSizeNbr int(5);
dcl-s ScreenWidth int(5);
dcl-s ScreenLength int(5);
dcl-s RowColTable int(10);
dcl-s FileWhereUsed int(10);
dcl-s RcdWhereUsed int(10) inz(0);
dcl-s FldWhereUsed int(10);
dcl-s FldIndex int(10);
dcl-s NamIndex int(10);
dcl-s Nametable int(10);
dcl-s Char2 char(2);
dcl-s TotalFields int(5);
dcl-s Field char(10);
dcl-s ForceScrSize char(1);
dcl-s FormatLoc int(10);
dcl-s w_i packed(4:0) inz;
dcl-ds RowDs;
FieldRow# int(5) inz(0);
FieldRow char(1) overlay(Fieldrow#:2);
end-ds;
dcl-ds ColDs;
FieldCol# int(5) inz(0);
FieldCol char(1) overlay(FieldCol#:2);
end-ds;
// Get Heap space data
dcl-s Pos int(10);
dcl-s Len int(10);
dcl-s Data char(32767);
dcl-s HeapData char(32767) based(HeapData_Ptr);
dcl-s StrHeap char(1) based(StrHeap_Ptr);
dcl-s HeapData_Ptr pointer;
dcl-ds *n;
ReturnData char(32);
// ReturndBytes bindec(9) overlay( ReturnData:1 );
BytesAvail bindec(9) overlay( ReturnData:5 );
end-ds;
/Copy qProtosrc,QDFRTVFD_
dcl-pr QDFRTVFD2 extpgm('QDFRTVFD');
ReturnData char(32) options(*varsize); // Can be a pointer or a character variable
LengthVar int(10) const;
Format char(8) const;
FileLib char(20) const; // Adjust the size according to the expected size of FileLib
QUsec likeds(QUsec); // Assuming QUsec is a previously defined data structure
end-pr;
dcl-pr QUSROBJD extpgm('QUSROBJD');
QUSD0100 likeds(QUSD0100);
LengthVar int(10) const;
Format char(8) const;
FileLib char(20) const; // Adjust the size according to the expected size of FileLib
ObjectType char(10) const;
end-pr;
dcl-pr CharToHex extproc('cvthc');
CTHHex pointer value;
CTHChar pointer value;
CTHCharSize int(10) value;
end-pr;
//*****************************************************************************
/define Fld_Loc_pr
/copy qProtosrc,jsFldLoc
dcl-proc Fld_Loc export;
/define Fld_Loc_pi
/copy qProtosrc,jsFldLoc
//** Main *********************************************************************
col# = 0; // Initialize Return Row/Col
row# = 0;
// Retrieve Info from API
exsr RtvFd;
QDFFBASE = $getData(1 :%size(QDFFBASE));
fileheader = QDFFINOF;
QDFFINFO = $getData(fileheader + 1 :%size(QDFFINFO));
// QDFWFLEI File Where Used
filewhereused = QDFFWUOF + fileheader;
QDFWFLEI = $getData(filewhereused + 1 :%size(QDFWFLEI));
// for the 1st record format
rcdwhereused = filewhereused + QDFWXLEN;
nametable = filewhereused + QDFWNTBO;
// Retrieve Format Index Ptr
// Get QDFARFTE Record Format Table
// Get Record Format Name and Offset to Record Header Section
index= QDFFDFLO + fileheader + 1;
for w_i = 1 to QDFFFRCS;
pos=index;
QDFARFTE = $getData(pos :%size(QDFARFTE));
if QDFARFNM = FormatName;
formatloc = QDFARFOF;
leave;
endif;
index=index + 16;
pos = rcdwhereused + 1;
QDFWRCDI = $getData(pos :%size(QDFWRCDI));
endfor;
// Was format Found?
if QDFARFNM <> FormatName;
clear col#;
clear row#;
exsr $Exit;
endif;
// Get QDFFRINF Record Header Section
recordheader=fileheader + formatloc;
QDFFRINF = $getData(recordheader + 1 :%size(QDFFRINF));
// Get record level device dependent
recorddevdep = recordheader + QDFFRAOF;
QDFFRDPD = $getData(recorddevdep + 1 :%size(QDFFRDPD));
// Get Field indexing Table for this record format for the 1st field
fieldindextable =recordheader + QDFFOFIT;
QDFFFITB = $getData(fieldindextable + 1 :%size(QDFFFITB));
if %parms = %parmnum(ForceSize); // Screen sizes
forcescrsize = ForceSize;
else;
forcescrsize = *blanks;
endif;
select; // -- retrieve screen size from Parm
when forcescrsize = '3';
screensizenbr = 3;
when forcescrsize = '4';
screensizenbr = 4;
other; // -- retrieve screen size from API
callp(e) CharToHex(%addr(QDFFSCRS) :%addr(Char2)
:%size(QDFFSCRS));
Monitor;
ScreenSizeNbr = %int(QDFFSCRS);
On-Error;
ScreenSizeNbr = 3;
endMon;
endsl;
select; // -- determine length and width of screen
when screensizenbr = 3;
screenlength= 24;
screenwidth = 80;
when screensizenbr = 4;
screenlength= 27;
screenwidth = 132;
other;
endsl;
// Total number of fields to loop through
totalfields = QDFFFFLD;
// Field where used 1st field
QDFWRCDI = $getData(rcdwhereused + 1 :%size(QDFWRCDI));
fldwhereused = rcdwhereused + QDFWRLEN;
//-----------------------------
// Loop through all fields (constant, variable, hidden ....)
// find Field Name
//-----------------------------
for w_i = 1 to totalfields;
// Field where used
QDFWFLDI = $getData(fldwhereused + 1 :%size(QDFWFLDI));
namindex = QDFWNMEI - 1; // Name table ptr
fldindex = QDFWRRDX - 1; // Field index table ptr
pos = nametable+5+namindex *10;
Data = $getData(pos :10);
QDFFNTBL = Data;
field = %subst(Data:1:10);
if field = FieldName;
leave;
endif;
// Set FldWhereUsed ptr for next time
fldwhereused = fldwhereused + QDFWFLDL;
endfor;
// Was the Field Found?
if field <> FieldName;
clear col#;
clear row#;
exsr $Exit;
endif;
// Get Row Columns for field Name
// RowColTable=recordheaderptr+recordleveldeviceptr
rowcoltable=recordheader + QDFFDRCO;
len=((totalfields+1) * 2) + 6;
if %parms = %parmnum(ForceSize); // Screen sizes;
QDFFSCRA = QDFFSCRS;
// Forcing Size and not the current screen default
if QDFFSCIA = x'04' and ForceSize = '3' or
QDFFSCIA = x'03' and ForceSize = '4';
rowcoltable = rowcoltable + len -2;
endif;
endif;
// exsr GetData;
Data = $getData(rowcoltable + 1 :len);
clear rowds;
clear colds;
// Get Row and Column for this field
fieldrow = %subst(Data:Fldindex*2+7:1);
fieldcol = %subst(Data:Fldindex*2+8:1);
fieldcol# = fieldcol#+1;
if fieldrow# <= screenlength and fieldcol# > screenwidth;
fieldcol# = fieldcol# - screenwidth;
fieldrow# = fieldrow# + 1;
endif;
col#=fieldcol#;
row#=fieldrow#;
exsr $Exit;
//*******************************************************
begsr $Exit;
dealloc StrHeap_Ptr;
return;
endsr;
//******************************************************
// Retrieve Info from DSPFD API
// and set a pointer to that information
//******************************************************
begsr RtvFd;
clear QUsec; // Set Error Id Section message Length
QUSBPRV = 16;
if %parms < %parmnum(Library); // Library not passed, then default
lib = '*LIBL';
else;
lib = Library;
endif;
clear filelib;
%subst(FileLib: 1:10) = Filename;
%subst(FileLib:11:10) = lib;
// Check if object exists
len = %size(QUSD0100);
callp(e) QUSROBJD(QUSD0100 : len : 'OBJD0100' : filelib : '*FILE');
if %error;
return;
endif;
if lib = '*LIBL'; // LIBL used? then insert return library
%subst(FileLib:11:10) = QUSRL01;
endif;
// Copy display file into heap space
// Retrieve display file's description.
callp(e) QDFRTVFD2(ReturnData : 8 : 'DSPF0100' : filelib : QUsec);
if %error;
return;
endif;
StrHeap_Ptr = %alloc(BytesAvail);
callp(e) QDFRTVFD2(StrHeap : BytesAvail : 'DSPF0100' : filelib : QUsec);
if %error;
exsr $exit;
endif;
endsr;
end-proc;
//******************************************************
dcl-Proc $getData;
dcl-Pi *n like(Data);
pPos like(pos) const;
pLen like(Len) const;
end-Pi;
dcl-s rData like(Data) inz;
HeapData_Ptr = StrHeap_Ptr + pPos - 1;
rData = %subst(HeapData:1:pLen);
return rData;
end-Proc;