Eval-CORR Example
The eval-corr is a convenient way to move data
The EVAL-CORR operation assigns data and null-indicators from the corresponding subfields of the source data structure to the subfields of the target data structure. The subfields that are assigned are the subfields that have the same name and compatible data type in both data structures.
ctl-Opt DEBUG(*YES) Main(Main) PgmInfo( *PCML : *Module )
OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE');
*----------------------------------------------------------------
* Update hold file
*----------------------------------------------------------------
Dcl-F WRPCLMR0 disk(*ext) keyed usage(*input:*output) usrOpn;
Dcl-Pr CEETREC extproc('CEETREC');
rc Int(10) const options(*omit);
user_rc Int(10) const options(*omit);
End-Pr;
/Copy QCopySrc,SQLOptions
*---------------------------------------------------------------
* Global variables
*---------------------------------------------------------------
Dcl-C SQLstsOK Const( '00000' );
Dcl-C SQLstsEOF Const( '02000' );
Dcl-S thisYear int(5);
Dcl-S thisPeriod int(5);
Dcl-S errorOccurred ind;
Dcl-S noMoreRecords ind;
*---------------------------------------------------------------
* Mainline
*---------------------------------------------------------------
Dcl-Proc Main;
Dcl-DS WarrantyRecord LikeRec(RCLMR:*OUTPUT) ;
Dcl-DS thisRecord Qualified ;
dtype char(4) ;
docNo char(8) ;
ref packed(9:0) ;
dxref3 char(20) ;
dacct1 char(12) ;
dacct2 char(12) ;
dacct3 char(12) ;
dacct4 char(12) ;
ddstat char(1) ;
dddesc char(30) ;
Yr zoned(4:0) ;
Per zoned(4:0) ;
dxref2 char(10) ;
ivdat zoned(8:0) ;
ddAlph char(20) ;
ddvalu packed(18:3) ;
End-DS ;
Dcl-S NullInds int(5) dim(16) ;
Dcl-S NullAddr pointer inz(%addr(NullInds)) ;
Dcl-DS Nullfields based(NullAddr) ;
NullDocTyp like(NullInds) ;
NullDocNo like(NullInds) ;
NullRef like(NullInds) ;
NullRef3 like(NullInds) ;
NullAcct1 like(NullInds) ;
NullAcct2 like(NullInds) ;
NullAcct3 like(NullInds) ;
NullAcct4 like(NullInds) ;
Nullstat like(NullInds) ;
Nulldesc like(NullInds) ;
Nullyear like(NullInds) ;
Nullperiod like(NullInds) ;
NullRef2 like(NullInds) ;
Nullivdat like(NullInds) ;
Nullalph like(NullInds) ;
Nullvalu like(NullInds) ;
End-Ds ;
Dcl-S NullValue like(NullInds) inz(-1) ;
Dcl-PI Main ExtPGM('WR1010R1');
p_YEARMN CHAR(6) options(*noPass);
END-PI;
If %parms = 1;
errorOccurred = Init(p_YearMn);
Else;
thisYear = %SubDt( %Date() : *Years );
thisPeriod = %subDt( %Date() : *Months);
EndIf;
If errorOccurred;
exitProgram();
ENDIF;
setCursor();
DoU noMoreRecords;
Exec SQL
Fetch WR1010cursor Into :thisRecord :nullInds ;
If SQLSTT = SQLstsOK;
Chain (thisRecord.dtype :
thisRecord.docno :
thisRecord.ref ) WRPCLMR0 ;
If not %found(WRPCLMR0);
Eval-Corr WarrantyRecord = ThisRecord;
Write RCLMR WarrantyRecord;
ENDIF;
Else;
noMoreRecords = *ON;
ENDIF;
ENDDO;
exitProgram();
end-Proc Main;
Dcl-Proc setCursor ;
Dcl-PI setCursor end-PI ;
Exec SQL
Declare WR1010cursor Cursor For
Select
Substr (doccode,1,4) as Dtype,
subStr (docNum,5,8) as docNo,
cast(doclinenum as decimal(9,0)) as ieRef,
substr(ref5,1,20) as dxref3,
substr (el2,1,12) as dacct1,
substr (el3,1,12) as dacct2,
substr (el4,1,12) as dacct3,
substr (el5,1,12) as dacct4,
case when(statpay = 84) then 'A'
when(statpay = 87) then 'H'
when(statpay = 89) then 'P'
when(statpay = 93) then 'R'
when(statpay = 171) then 'X'
Else ' '
End as DDstat,
substr(DDescr,1,30) as Dddesc,
yr,
period,
substr(ref2,1,10) as Dxref2,
ifNull(Cast(Replace(Char(DOCDATE, ISO), '-', '')
as dec(8, 0)),'0') as iVdat,
substr(ref1,1,20),
Cast(valueHome as decimal(18,3)) as ddValu
From OAS_DOCV1
Where el2 = '12801'
and yr = :thisyear
and period = :thisPeriod
and cmpCode = 'THOMPSON'
Order by docCode, DocNum ;
Exec SQL Open WR1010cursor ;
end-Proc setCursor;
Dcl-Proc Init;
Dcl-PI Init ind ;
I_YearMM char(6);
end-PI;
Dcl-S wkYear char(4);
Dcl-S wkPeriod char(2);
dcl-S inError ind;
inError = *off;
If not %open(WRPCLMR0);
Open WRPCLMR0;
ENDIF;
wkYear = %subst(I_YearMM:1:4);
wkPeriod = %subst(I_YearMM:5:2);
Monitor;
thisYear = %int(wkYear);
thisPeriod = %int(wkPeriod);
on-error;
inError = *on;
ENDMON;
If not inError;
If thisYear < 2000 or thisYear > 9999;
inError = *On;
ENDIF;
ENDIF;
If not inError;
If thisPeriod < 1 or thisPeriod > 12;
inError = *On;
ENDIF;
ENDIF;
Return inError;
END-PROC Init;
Dcl-Proc exitProgram;
Dcl-PI *n end-PI;
Exec SQL Close WR1010cursor ; // Close SQL cursor
If %open(WRPCLMR0) ; // Check DB file
Close WRPCLMR0 ; // Close
ENDIF ; // if Open
*INLR = *ON ; // set on LR and
CEETREC(*omit: 0) ; // exit Program
Return;
END-PROC;
The operands may be qualified or unqualified data structures. However, for the operation to be successful, at least one of the operands must be a subfield of a qualified data structure; otherwise, it would not be possible for the two data structures to share subfields with the same name.The code above illustrates the process.