During day to day application support activities, sometimes an anomaly or bugs was identified. But hard to identified which program that caused the problem. Finally, I come up with the idea to create a program that can display journal entry with field level selection criteria.
For example, we have Customer Master File (CIFMST) with key Customer Number (CIFNBR) on the first 10 bytes (the field is 19 digit pack signed) followed by 40 bytes Customer Name (CIFNME).
In case we need to display changes for customer number 1, we can do with:
Call DSPMYJRN parm('CIFMST' X'00001F' X'00010F' X'0000000000000000001F').
If we want to see customer with name of HADI SANTOSO then we do with:
Call DSPMYJRN parm('CIFMST' X'00011F' X'00040F' 'HADI SANTOSO').
To add more flexibility, we can use fifth optional parameter with default value '*CURRENT' and can be change to '*CURCHAIN' or '*CURAVLCHN'.
Here is the complete codes:
0001.00 ********************************************************************
0002.00 * REF NO. CHANGED DATE DESCRIPTION OF CHANGE *
0003.00 * -------- ------------ ---------------------- *
0004.00 * *
0005.00 * INIT REF.# DATE DESCRIPTION *
0006.00 * ---- ----- -------- ---------------------------------------- *
0007.00 * HADI Init 20230501 Display journal with selection criteria *
0008.00 ********************************************************************
0009.00 **-- Header specifications: --------------------------------------------**
0010.00 ctl-opt DFTACTGRP(*NO) DatEdit(*DMY/) BndDir('QC2LE')
0011.00 Option(*SrcStmt : *DEBUGIO:*SHOWCPY :*EXPDDS);
0012.00 FQSYSPRT O F 132 Printer USROPN
0013.00
0014.00 D cmdStr1 s 256 inz('OVRPRTF FILE(QSYSPRT) PAGESIZE(-
0015.00 D *N 132) CPI(15) OVRSCOPE(*JOB)')
0016.00 D cmdStr2 s 256 inz('DLTOVR FILE(QSYSPRT) LVL(*JOB)')
0017.00
0018.00
0019.00
0020.00
0021.00
0022.00
0023.00
0024.00 **-- Global variables: -------------------------------------------------**
0025.00 dcl-s w_Rcvr char(30);
0026.00 dcl-s w_RcvrLngth int(10) inz(%len(w_Rcvr));
0027.00 dcl-s w_NbrToRtv int(10) inz(1);
0028.00 dcl-s w_SysVal char(10) inz('QDECFMT');
0029.00 dcl-s w_DecSign char(1);
0030.00 dcl-s w_3DigGrp char(1);
0031.00 dcl-s w_DifFound char(1);
0032.00 dcl-s w_DifPos int(10);
0033.00 dcl-ds DS_SysValTbl;
0034.00 d_ValsRtn int(10);
0035.00 d_Offset int(10);
0036.00 d_SysVal char(10);
0037.00 d_ValType char(1);
0038.00 d_InfoSts char(1);
0039.00 d_DecFmt int(10);
0040.00 end-ds;
0041.00
0042.00 dcl-ds *N;
0043.00 MSGDTA char(256);
0044.00 MESSG1 char(10) overlay(MSGDTA:1);
0045.00 MESSG2 char(10) overlay(MSGDTA:11);
0046.00 end-ds;
0047.00
0048.00 dcl-s INFLEN bindec(9:0) INZ(280);
0049.00 dcl-s DTALEN bindec(9:0);
0050.00 dcl-ds *N;
0051.00 MSGFMT char(573);
0052.00 MSGTON char(3) overlay(MSGFMT:1);
0053.00 MSGCON packed(3:0) overlay(MSGFMT:1);
0054.00 MSGTXT char (570) overlay(MSGFMT:4);
0055.00 end-ds;
0056.00
0057.00 dcl-s MESGFL char(20);
0058.00 dcl-s TXTOUT char(57);
0059.00 dcl-s FRTVM0100 char(8) Inz('RTVM0100');
0060.00 dcl-s RPLSUB char(10) INZ('*YES');
0061.00 dcl-s RTNFMT char(10) INZ('*YES');
0062.00
0063.00 dcl-ds MSGINF;
0064.00 MSBYTR bindec(9:0);
0065.00 MSBYTL bindec(9:0);
0066.00 MSMLNR bindec(9:0);
0067.00 MSMLNL bindec(9:0);
0068.00 MSHLNR bindec(9:0);
0069.00 MSHLNL bindec(9:0);
0070.00 MSMSGV char(256);
0071.00 end-ds;
0072.00
0073.00 dcl-ds ERRCDE;
0074.00 EBPRTN bindec(9:0) inz(40);
0075.00 EBAVAL bindec(9:0) inz(40);
0076.00 EXCPID char(7);
0077.00 RESERV char(1);
0078.00 EXCDTA char(256);
0079.00 end-ds;
0080.00
0081.00 dcl-s UsrSpcHdr char(20) Inz('HDRLIST QTEMP');
0082.00 dcl-s UsrSpcFld char(20) Inz('FLDLIST QTEMP');
0083.00 dcl-s DtlLine char(132);
0084.00 dcl-s Count packed(15:0);
0085.00 dcl-s Idx int(10);
0086.00 **dcl-s @Idx int(10);
0087.00 dcl-s Start uns(5:0);
0088.00 dcl-s EntDtaV varchar(8194);
0089.00 dcl-s EntDta char(8192);
0090.00 dcl-s EntDtaB char(8192);
0091.00 dcl-s EntDtaA char(8192);
0092.00 dcl-s OVRRID char(1);
0093.00 dcl-s LENDTA bindec(9:0);
0094.00 dcl-s STRPOS bindec(9:0);
0095.00 dcl-s NXTPOS bindec(9:0);
0096.00 dcl-s FFValue char(50);
0097.00 dcl-s FmtHalfValue char(25);
0098.00
0099.00 dcl-ds FmtDtlLine;
0100.00 FmtFldNme char(10);
0101.00 FmtEqual char(3) Inz(' = ') ;
0102.00 FmtValue char(50);
0103.00 FmtFldDesc char(50);
0104.00 end-ds;
0105.00
0106.00 dcl-s a int(10);
0107.00 dcl-s b int(10);
0108.00 dcl-s c int(10);
0109.00 dcl-s i int(10);
0110.00 dcl-s j int(10);
0111.00 dcl-s k int(10);
0112.00
0113.00 dcl-ds Sav2HdrDS;
0114.00 Sv2UserArea char(64);
0115.00 Sv2HdrSize int(10);
0116.00 Sv2StrLvl char(4);
0117.00 Sv2Format char(8);
0118.00 Sv2APIUsed char(10);
0119.00 Sv2CrtDate char(13);
0120.00 Sv2InfoSts char(1);
0121.00 Sv2SizeOfUS int(10);
0122.00 Sv2OffsetToInp int(10);
0123.00 Sv2SizeOfInp int(10);
0124.00 Sv2OffsetToHdr int(10);
0125.00 Sv2SizeOfHdr int(10);
0126.00 Sv2OffsetToDtl int(10);
0127.00 Sv2SizeOfDtl int(10);
0128.00 Sv2NumberOfDtl int(10);
0129.00 Sv2EntrySize int(10);
0130.00 Sv2CCSID int(10);
0131.00 Sv2Country int(10);
0132.00 Sv2LangID char(3);
0133.00 Sv2SubsetInd char(1);
0134.00 Sv2Reserved1 char(42);
0135.00 end-ds;
0136.00 '* List Record Format Header DS
0137.00 dcl-s RcdFmtHdrPtr pointer;
0138.00 dcl-ds RcdFmtHdrDS Based(RcdFmtHdrPtr);
0139.00 RcdPFName char(10);
0140.00 RcdPFLib char(10);
0141.00 RcdPFType char(10);
0142.00 RcdPFText char(50);
0143.00 RcdPFCCSID int(10);
0144.00 RcdPFCrtDate char(13);
0145.00 end-ds;
0146.00
0147.00 '* List Record Formats DS
0148.00 dcl-s RcdFmtPtr pointer;
0149.00 dcl-ds RcdFmtDS Based(RcdFmtPtr);
0150.00 RcdFmtName char(10);
0151.00 RcdLvlChkID char(13);
0152.00 RcdReserved char(1);
0153.00 RcdLength int(10);
0154.00 RcdNumFlds int(10);
0155.00 RcdFmtDesc char(50);
0156.00 RcdReserved1 char(2);
0157.00 RcdCCSID int(10);
0158.00 end-ds;
0159.00
0160.00 dcl-ds LstFldDS Based(FldPtr);
0161.00 FldName char(10);
0162.00 FldDataType char(1);
0163.00 FldUsage char(1);
0164.00 FldOutBuffPos int(10);
0165.00 FldInBuffPos int(10);
0166.00 FldLength int(10);
0167.00 FldDigits int(10);
0168.00 FldDecimals int(10);
0169.00 FldDesc char(50);
0170.00 FldEditC char(2);
0171.00 FldEditWLen int(10);
0172.00 FldEditWord char(64);
0173.00 FldColHdg1 char(20);
0174.00 FldColHdg2 char(20);
0175.00 FldColHdg3 char(20);
0176.00 FldIntName char(10);
0177.00 FldAltName char(30);
0178.00 FldAltLen int(10);
0179.00 FldDBCS# int(10);
0180.00 FldAllowNull char(01);
0181.00 FldHostVar char(01);
0182.00 FldDateFormat char(04);
0183.00 FldDateSep char(01);
0184.00 FldVarSize char(01);
0185.00 FldDescCCSID int(10);
0186.00 FldDataCCSID int(10);
0187.00 FldColHCCSID int(10);
0188.00 FldEdtWCCSID int(10);
0189.00 FldUSC2Len int(10);
0190.00 FldDataEncode int(10);
0191.00 FldMaxObjLen int(10);
0192.00 FldPadLen int(10);
0193.00 FldUDTLen int(10);
0194.00 FldUDTName char(132);
0195.00 FldUDTLib char(10);
0196.00 FldDLCntl char(1);
0197.00 FldDLInteg char(1);
0198.00 FldDxxx char(112);
0199.00 end-ds;
0200.00
0201.00 '* List File Description Header DS
0202.00 dcl-ds FDHDS;
0203.00 FDHBytesRet int(10);
0204.00 FDHBytesAvail int(10);
0205.00 FDHMaxKeyLen int(5);
0206.00 FDHKeyCount int(5);
0207.00 FDHReserved char(10);
0208.00 FDHFormatCnt int(5);
0209.00 KeyRecFmt char(10);
0210.00 KeyReserve char(2);
0211.00 Key#OfKeys int(5);
0212.00 KeyReserv1 char(14);
0213.00 KeyInfoOffset int(10);
0214.00 end-ds;
0215.00
0216.00 '* User Space Header DS
0217.00 dcl-ds USHeader Based(CUSPointer);
0218.00 HdrUserArea char(64);
0219.00 HdrHdrSize int(10);
0220.00 HdrStrLvl char(4);
0221.00 HdrFormat char(8);
0222.00 HdrAPIUsed char(10);
0223.00 HdrCrtDate char(13);
0224.00 HdrInfoSts char(1);
0225.00 HdrSizeOfUS int(10);
0226.00 HdrOffsetToInp int(10);
0227.00 HdrSizeOfInp int(10);
0228.00 HdrOffsetToHdr int(10);
0229.00 HdrSizeOfHdr int(10);
0230.00 HdrOffsetToDtl int(10);
0231.00 HdrSizeOfDtl int(10);
0232.00 HdrNumberOfDtl int(10);
0233.00 HdrEntrySize int(10);
0234.00 HdrCCSID int(10);
0235.00 HdrCountry char(2);
0236.00 HdrLangID char(3);
0237.00 HdrSubsetInd char(1);
0238.00 HdrReserved1 char(42);
0239.00 end-ds;
0240.00
0241.00 dcl-ds SaveHdrDS;
0242.00 SavUserArea char(64);
0243.00 SavHdrSize int(10);
0244.00 SavStrLvl char(4);
0245.00 SavFormat char(8);
0246.00 SavAPIUsed char(10);
0247.00 SavCrtDate char(13);
0248.00 SavInfoSts char(1);
0249.00 SavSizeOfUS int(10);
0250.00 SavOffsetToInp int(10);
0251.00 SavSizeOfInp int(10);
0252.00 SavOffsetToHdr int(10);
0253.00 SavSizeOfHdr int(10);
0254.00 SavOffsetToDtl int(10);
0255.00 SavSizeOfDtl int(10);
0256.00 SavNumberOfDtl int(10);
0257.00 SavEntrySize int(10);
0258.00 SavCCSID int(10);
0259.00 SavCountry char(2);
0260.00 SavLangID char(3);
0261.00 SavSubsetInd char(1);
0262.00 SavReserved1 char(42);
0263.00 end-ds;
0264.00
0265.00 dcl-ds PFile;
0266.00 PInFile char(10);
0267.00 PInLib char(10);
0268.00 end-ds;
0269.00 dcl-s PStart packed(5:0);
0270.00 dcl-s PLen packed(5:0);
0271.00 dcl-s PSearched char(128);
0272.00 dcl-s PJrnRange char(10);
0273.00 dcl-s @Start packed(5:0);
0274.00 dcl-s @Len packed(5:0);
0275.00 dcl-s xSearched char(128);
0276.00 dcl-s ySearched char(256);
0277.00 dcl-s DspMsg char(52);
0278.00 dcl-s SDSDATE char(6);
0279.00 dcl-s SDSTIME char(6);
0280.00 dcl-s PackSignInd char(1);
0281.00 dcl-s PackSignDsp packed(19:0) DIM(10);
0282.00 **
0283.00 dcl-s JrnEntDts char(20) Inz( *All'0' );
0284.00
0285.00 D SearchDS DS
0286.00 D @Searched 1 128
0287.00 D @Pack01bytes 01P 0 Overlay(@Searched: 1 )
0288.00 D @Pack02bytes 03P 0 Overlay(@Searched: 1 )
0289.00 D @Pack03bytes 05P 0 Overlay(@Searched: 1 )
0290.00 D @Pack04bytes 07P 0 Overlay(@Searched: 1 )
0291.00 D @Pack05bytes 09P 0 Overlay(@Searched: 1 )
0292.00 D @Pack06bytes 11P 0 Overlay(@Searched: 1 )
0293.00 D @Pack07bytes 13P 0 Overlay(@Searched: 1 )
0294.00 D @Pack08bytes 15P 0 Overlay(@Searched: 1 )
0295.00 D @Pack09bytes 17P 0 Overlay(@Searched: 1 )
0296.00 D @Pack10bytes 19P 0 Overlay(@Searched: 1 )
0297.00 dcl-ds QualName;
0298.00 ObjName char(10) Inz(' ');
0299.00 LibName char(10) Inz('*LIBL');
0300.00 end-ds;
0301.00 dcl-ds QualJrn;
0302.00 QUSJN20x char(10);
0303.00 QUSJLIB02x char(10);
0304.00 end-ds;
0305.00
0306.00 **dcl-ds ApiErr2;
0307.00 ** AeBytPro2 int(10) Inz(%Size(ApiErr2));
0308.00 ** AeBytAvl2 int(10);
0309.00 ** AeExcpId2 char(7);
0310.00 ** AeExcpIdx char(1);
0311.00 ** AaExcpDta2 char(256);
0312.00 **end-ds;
0313.00
0314.00 D/Copy qsysinc/qrpglesrc,qusec
0315.00 D/Copy qsysinc/qrpglesrc,qusrobjd
0316.00 D/Copy qsysinc/qrpglesrc,qdbrtvfd
0317.00 D/copy qsysinc/qrpglesrc,qmhrtvm
0318.00 **-- Retrieve journal entry data: --------------------------------------**
0319.00 D JeRcvVar Ds Align
0320.00 D JhJrnHdr
0321.00 D JhBytRtn 10i 0 Overlay( JhJrnHdr: 1 )
0322.00 D JhOfsHdrJrnE 10i 0 Overlay( JhJrnHdr: *Next )
0323.00 D JhNbrEntRtv 10i 0 Overlay( JhJrnHdr: *Next )
0324.00 D JhConInd 1a Overlay( JhJrnHdr: *Next )
0325.00 D JhConRcvStr 10a Overlay( JhJrnHdr: *Next )
0326.00 D JhConLibStr 10a Overlay( JhJrnHdr: *Next )
0327.00 D JhConSeqNbr 20s 0 Overlay( JhJrnHdr: *Next )
0328.00 D 11a Overlay( JhJrnHdr: *Next )
0329.00 D JeData 32754a
0330.00 **-- Entry header:
0331.00 D JeEntHdr Ds Based( pEntHdr )
0332.00 D JeOfsHdrJrnE 10u 0
0333.00 D JeOfsNulValI 10u 0
0334.00 D JeOfsEntDta 10u 0
0335.00 D JeOfsTrnId 10u 0
0336.00 D JeOfsLglUoW 10u 0
0337.00 D JeOfsRcvInf 10u 0
0338.00 D JeSeqNbr 20u 0
0339.00 D JeTimStp 20u 0
0340.00 D JeTimStpC 8a Overlay( JeTimStp )
0341.00 D JeThrId 20u 0
0342.00 D JeSysSeqNbr 20u 0
0343.00 D JeCntRrn 20u 0
0344.00 D JeCmtCclId 20u 0
0345.00 D JePtrHdl 10u 0
0346.00 D JeRmtPort 5u 0
0347.00 D JeArmNbr 5u 0
0348.00 D JePgmLibAsp 5u 0
0349.00 D JeRmtAdr 16a
0350.00 D JeJrnCde 1a
0351.00 D JeEntTyp 2a
0352.00 D JeJobNam 10a
0353.00 D JeUsrNam 10a
0354.00 D JeJobNbr 6a
0355.00 D JePgmNam 10a
0356.00 D JePgmLib 10a
0357.00 D JePgmLibAspDv 10a
0358.00 D JeObject 30a
0359.00 D JeUsrPrf 10a
0360.00 D JeJrnId 10a
0361.00 D JeAdrFam 1a
0362.00 D JeSysNam 8a
0363.00 D JeIndFlg 1a
0364.00 D JeObjNamInd 1a
0365.00 D JeBitFld 1a
0366.00 D JeRsv 9a
0367.00 **
0368.00 ** JeBitFld:
0369.00 D Ds
0370.00 D JbRefCst 1s 0
0371.00 D JbTrg 1s 0
0372.00 D JbIncDta 1s 0
0373.00 D JbIgnApyRmvJ 1s 0
0374.00 D JbMinEntDta 1s 0
0375.00 D JbRsv 3a
0376.00 **-- Null values - *VARLEN:
0377.00 D JeNulValVar Ds Based( pNulVal )
0378.00 D JnNulValLen 10i 0
0379.00 D JnNulValIndV 512a
0380.00 **-- Null values - length:
0381.00 D JeNulValLen Ds Based( pNulVal )
0382.00 D JnNulValIndL 512a
0383.00 **-- Entry data:
0384.00 D JeEntDta Ds Based( pEntDta )
0385.00 D JdEntDtaLen 5s 0
0386.00 D 11a
0387.00 D JdEntDta 4096a
0388.00 **-- Logical unit of work:
0389.00 D JeLglUoW Ds Based( pLglUow )
0390.00 D JuLglUoW 39a
0391.00 **-- Receiver information:
0392.00 D JeRcvInf Ds Based( pRcvInf )
0393.00 D JrRcvNam 10a
0394.00 D JrRcvLib 10a
0395.00 D JrRcvLibAspDv 10a
0396.00 D JrRcvLibAspNb 5i 0
0397.00 **
0398.00 **-- Retrieve journal entry selection records: -------------------------**
0399.00 D JrnEntRtv Ds
0400.00 D JeNbrVarRcd 10i 0
0401.00 **-- RCVRNG - *CURRENT, *CURCHAIN
0402.00 D JrnVarR01 Ds
0403.00 D JvR01RcdLen 10i 0 Inz( %Size( JrnVarR01 ))
0404.00 D JvR01Key 10i 0 Inz( 1 )
0405.00 D JvR01DtaLen 10i 0 Inz( %Size( JvR01Dta ))
0406.00 D JvR01Dta 40a Inz( '*CURRENT' )
0407.00 D JvR01RcvStr 10a Overlay( JvR01Dta: 1 )
0408.00 D JvR01LibStr 10a Overlay( JvR01Dta: *Next )
0409.00 D JvR01RcvEnd 10a Overlay( JvR01Dta: *Next )
0410.00 D JvR01LibEnd 10a Overlay( JvR01Dta: *Next )
0411.00 **-- FROMENT - *FIRST
0412.00 D JrnVarR02 Ds
0413.00 D JvR02RcdLen 10i 0 Inz( %Size( JrnVarR02 ))
0414.00 D JvR02Key 10i 0 Inz( 2 )
0415.00 D JvR02DtaLen 10i 0 Inz( %Size( JvR02Dta ))
0416.00 D JvR02Dta 20a Inz( '*FIRST' )
0417.00 D JvR02SeqNbr 20s 0 Overlay( JvR02Dta )
0418.00 **-- FROMTIME
0419.00 D JrnVarR03 Ds
0420.00 D JvR03RcdLen 10i 0 Inz( %Size( JrnVarR03 ))
0421.00 D JvR03Key 10i 0 Inz( 3 )
0422.00 D JvR03DtaLen 10i 0 Inz( %Size( JvR03Dta ))
0423.00 D JvR03Dta 26a
0424.00 **-- TOENT - *LAST
0425.00 D JrnVarR04 Ds
0426.00 D JvR04RcdLen 10i 0 Inz( %Size( JrnVarR04 ))
0427.00 D JvR04Key 10i 0 Inz( 4 )
0428.00 D JvR04DtaLen 10i 0 Inz( %Size( JvR04Dta ))
0429.00 D JvR04Dta 20a Inz( '*LAST' )
0430.00 **-- TOTIME
0431.00 D JrnVarR05 Ds
0432.00 D JvR05RcdLen 10i 0 Inz( %Size( JrnVarR05 ))
0433.00 D JvR05Key 10i 0 Inz( 5 )
0434.00 D JvR05DtaLen 10i 0 Inz( %Size( JvR05Dta ))
0435.00 D JvR05Dta 26a
0436.00 **-- NBRENT
0437.00 D JrnVarR06 Ds
0438.00 D JvR06RcdLen 10i 0 Inz( %Size( JrnVarR06 ))
0439.00 D JvR06Key 10i 0 Inz( 6 )
0440.00 D JvR06DtaLen 10i 0 Inz( %Size( JvR06Dta ))
0441.00 D JvR06Dta 10i 0 Inz( NbrOfEntry )
0442.00 **-- JRNCDE - *ALL, *CTL / *ALLSLT, *IGNFILSLT
0443.00 D JrnVarR07 Ds
0444.00 D JvR07RcdLen 10i 0 Inz( %Size( JrnVarR07 ))
0445.00 D JvR07Key 10i 0 Inz( 7 )
0446.00 D JvR07DtaLen 10i 0 Inz( %Size( JvR07Dta ))
0447.00 D JvR07Dta
0448.00 D JcNbrCod 10i 0 Overlay( JvR07Dta: 1 )
0449.00 D JcJrnCod 20a Overlay( JvR07Dta: *Next )
0450.00 D Dim( 16 )
0451.00 D JcJrnCodVal 10a Overlay( JcJrnCod: 1 )
0452.00 D JcJrnCodSlt 10a Overlay( JcJrnCod: *Next )
0453.00 **-- ENTTYP - *ALL, *RCD
0454.00 D JrnVarR08 Ds
0455.00 D JvR08RcdLen 10i 0 Inz( %Size( JrnVarR08 ))
0456.00 D JvR08Key 10i 0 Inz( 8 )
0457.00 D JvR08DtaLen 10i 0 Inz( %Size( JvR08Dta ))
0458.00 D JvR08Dta
0459.00 D JcNbrTyp 10i 0 Overlay( JvR08Dta: 1 )
0460.00 D JcEntTyp 10a Overlay( JvR08Dta: *Next )
0461.00 D Dim( 16 )
0462.00 **-- JOB - *ALL
0463.00 D JrnVarR09 Ds
0464.00 D JvR09RcdLen 10i 0 Inz( %Size( JrnVarR09 ))
0465.00 D JvR09Key 10i 0 Inz( 9 )
0466.00 D JvR09DtaLen 10i 0 Inz( %Size( JvR09Dta ))
0467.00 D JvR09Dta 26a Inz( '*ALL' )
0468.00 **-- PGM - *ALL
0469.00 D JrnVarR10 Ds
0470.00 D JvR10RcdLen 10i 0 Inz( %Size( JrnVarR10 ))
0471.00 D JvR10Key 10i 0 Inz( 10 )
0472.00 D JvR10DtaLen 10i 0 Inz( %Size( JvR10Dta ))
0473.00 D JvR10Dta 10a Inz( '*ALL' )
0474.00 **-- USRPRF * *ALL
0475.00 D JrnVarR11 Ds
0476.00 D JvR11RcdLen 10i 0 Inz( %Size( JrnVarR11 ))
0477.00 D JvR11Key 10i 0 Inz( 11 )
0478.00 D JvR11DtaLen 10i 0 Inz( %Size( JvR11Dta ))
0479.00 D JvR11Dta 10a Inz( '*ALL' )
0480.00 **-- CMTCYCID - *ALL
0481.00 D JrnVarR12 Ds
0482.00 D JvR12RcdLen 10i 0 Inz( %Size( JrnVarR12 ))
0483.00 D JvR12Key 10i 0 Inz( 12 )
0484.00 D JvR12DtaLen 10i 0 Inz( %Size( JvR12Dta ))
0485.00 D JvR12Dta 20a Inz( '*ALL' )
0486.00 **-- DEPENT - *ALL, *NONE
0487.00 D JrnVarR13 Ds
0488.00 D JvR13RcdLen 10i 0 Inz( %Size( JrnVarR13 ))
0489.00 D JvR13Key 10i 0 Inz( 13 )
0490.00 D JvR13DtaLen 10i 0 Inz( %Size( JvR13Dta ))
0491.00 D JvR13Dta 10a Inz( '*ALL' )
0492.00 **-- INCENT - *CONFIRMED, *ALL
0493.00 D JrnVarR14 Ds
0494.00 D JvR14RcdLen 10i 0 Inz( %Size( JrnVarR14 ))
0495.00 D JvR14Key 10i 0 Inz( 14 )
0496.00 D JvR14DtaLen 10i 0 Inz( %Size( JvR14Dta ))
0497.00 D JvR14Dta 10a Inz( '*CONFIRMED' )
0498.00 **-- NULLINDLEN - *VARLEN
0499.00 D JrnVarR15 Ds
0500.00 D JvR15RcdLen 10i 0 Inz( %Size( JrnVarR15 ))
0501.00 D JvR15Key 10i 0 Inz( 15 )
0502.00 D JvR15DtaLen 10i 0 Inz( %Size( JvR15Dta ))
0503.00 D JvR15Dta 10a Inz( '*VARLEN' )
0504.00 **-- FILE - *ALLFILE, *ALL
0505.00 D JrnVarR16 Ds
0506.00 D JvR16RcdLen 10i 0 Inz( %Size( JrnVarR16 ))
0507.00 D JvR16Key 10i 0 Inz( 16 )
0508.00 D JvR16DtaLen 10i 0 Inz( %Size( JvR16Dta ))
0509.00 D JvR16Dta
0510.00 D JcNbrFil 10i 0 Overlay( JvR16Dta: 1 )
0511.00 D JcFilNamQ 30a Overlay( JvR16Dta: *Next )
0512.00 D Dim(300)
0513.00 D JfFilNam 10a Overlay( JcFilNamQ: 1 )
0514.00 D JfLibNam 10a Overlay( JcFilNamQ: *Next )
0515.00 D JfMbrNam 10a Overlay( JcFilNamQ: *Next )
0516.00 **-- Call system command: ---------------------------------------
0517.00 D system PR 10I 0 extproc('system')
0518.00 D i_cmd * value options(*string)
0519.00 **-- Retrieve System Message---------------------------------------------**
0520.00 dcl-pr RtvMsgs EXTPGM('QMHRTVM');
0521.00 pMsgInfo char(32767) options(*varsize);
0522.00 pMsgInfoLen int(10) const;
0523.00 pReturnFmt char(8) const;
0524.00 pMsgId char(7) const;
0525.00 pMsgFile char(20) const;
0526.00 pMsgData char(32767) const options(*varsize);
0527.00 pMsgDataLen int(10) const;
0528.00 pReplSubst char(10) const;
0529.00 pRtnCtrl char(10) const;
0530.00 pApiErrorDS char(32767) options(*nopass:*varsize);
0531.00 pRtvOption char(10) options(*nopass);
0532.00 pCCSID int(10) const options(*nopass);
0533.00 pReplCCSID int(10) const options(*nopass);
0534.00 end-pr;
0535.00 **-- Retrieve System Value ----------------------------------------------**
0536.00 dcl-pr RtvSystemValue extpgm('QWCRSVAL');
0537.00 p_Rcvr Like(w_Rcvr);
0538.00 p_RcvrLngth Like(w_RcvrLngth);
0539.00 p_NbrToRtv Like(w_NbrToRtv);
0540.00 p_SysVal Like(w_SysVal);
0541.00 p_Error like(QUSEC);
0542.00 end-pr;
0543.00 **-- Retrieve user space ----------------------------------------------**
0544.00 dcl-pr rtvUsrSpsHdr extpgm('QUSRTVUS');
0545.00 pr_user_space char(20) const;
0546.00 pr_us_str_pos bindec(4) Const;
0547.00 pr_us_item_len bindec(4) Const;
0548.00 pr_rec_var char(32048) Const;
0549.00 pr_error_code like(QUSEC);
0550.00 end-pr;
0551.00 **-- List Fields API Procedure ----------------------------------------**
0552.00 dcl-pr ListFields ExtPgm('QUSLFLD');
0553.00 CUSFldUSName char(20) Const;
0554.00 CUSRcdFmt char(8) Const;
0555.00 CUSPFName char(20) Const;
0556.00 PFRcdFmt char(10) Const;
0557.00 OverrideProc char(1) Const;
0558.00 ErrorCode char(32766) options(*varsize);
0559.00 end-pr;
0560.00 **-- List Record Formats-API-Procedure-----------------------------------**
0561.00 dcl-pr ListRcdFmts ExtPgm('QUSLRCD');
0562.00 CUSQualUSName char(20) Const;
0563.00 CUSRcdFmt char(8) Const;
0564.00 CUSPFName char(20) Const;
0565.00 OverrideProc char(1) Const;
0566.00 ErrorCode char(32766) options(*varsize);
0567.00 end-pr;
0568.00 **-- Create user space: -------------------------------------------------**
0569.00 dcl-pr CrtUsrSpc ExtPgm('QUSCRTUS');
0570.00 CsSpcNamQ char(20) Const;
0571.00 CsExtAtr char(10) Const;
0572.00 CsInzSiz int(10) Const;
0573.00 CsInzVal char(1) Const;
0574.00 CsPubAut char(10) Const;
0575.00 CsText char(50) Const;
0576.00 **-- Optional 1:
0577.00 CsReplace char(10) Const Options(*NoPass);
0578.00 CsError char(32767) Options(*NoPass:*VarSize);
0579.00 **-- Optional 2:
0580.00 CsDomain char(10) Const Options(*NoPass);
0581.00 end-pr;
0582.00 **-- Delete user space: -------------------------------------------------**
0583.00 dcl-pr DltUsrSpsHdr ExtPgm('QUSDLTUS');
0584.00 DsSpcNamQ char(20) Const;
0585.00 DsError char(32767) Options(*VarSize);
0586.00 end-pr;
0587.00 **-- Retrieve pointer to user space: ------------------------------------**
0588.00 dcl-pr RtvPtrSpc ExtPgm('QUSPTRUS');
0589.00 RpSpcNamQ char(20) Const;
0590.00 RpPointer Pointer;
0591.00 RpError char(32767) Options(*NoPass:*VarSize);
0592.00 end-pr;
0593.00 **-- Retrieve journal entries: -----------------------------------------**
0594.00 dcl-pr RtvJrnE ExtProc('QjoRetrieveJournalEntries');
0595.00 RjRcvVar char(32767) Options(*VarSize);
0596.00 RjRcvVarLen int(10) Const;
0597.00 RjJrnNamQ char(20) Const;
0598.00 RjRcvInfFmt char(8) Const;
0599.00 RjSltInf char(32767) Const Options(*NoPass:*VarSize);
0600.00 RjError char(32767) Options(*NoPass:*VarSize);
0601.00 end-pr;
0602.00 **-- Delete pointer handle: --------------------------------------------**
0603.00 dcl-pr DltPtrHdl ExtProc('QjoDeletePointerHandle');
0604.00 DhPtrHdl int(10) COnst;
0605.00 DhError char(32767) Options(*NoPass:*VarSize);
0606.00 end-pr;
0607.00 **-- Test bit in string: -----------------------------------------------**
0608.00 dcl-pr tstbts int(10) ExtProc('tstbts');
0609.00 String pointer value;
0610.00 BitOfs int(10) Value;
0611.00 end-pr;
0612.00 **-- Convert date & time: ----------------------------------------------**
0613.00 dcl-pr CvtDtf ExtPgm('QWCCVTDT');
0614.00 CdInpFmt char(10) Const;
0615.00 CdInpVar char(17) Const Options(*VarSize);
0616.00 CdOutFmt char(10) Const;
0617.00 CdOutVar char(17) Options(*VarSize);
0618.00 CdError int(10) Const;
0619.00 end-pr;
0620.00 **
0621.00 **-- Retrieve object description: --------------------------------------**
0622.00 dcl-pr RtvObjD ExtPgm('QUSROBJD');
0623.00 RoRcvVar like(QUSEC) Options(*varsize);
0624.00 RoRcvVarLen int(10) Const;
0625.00 RoFmtNam char(8) Const;
0626.00 RoObjNamQ char(20) Const;
0627.00 RoObjTyp char(10) Const;
0628.00 RoError like(QUSEC) Options(*varsize);
0629.00 end-pr;
0630.00 **-- Retrieve File Description: ----------------------------------------**
0631.00 dcl-pr ListFileDesc ExtPgm('QDBRTVFD');
0632.00 OutputData char(32766) Options(*Varsize);
0633.00 OutputDataLen int(10) Const;
0634.00 CUSPFNameRet char(20) Const;
0635.00 PFRcdFmt char(8) Const;
0636.00 CUSPFName char(20) Const;
0637.00 RcdFmt char(8) Const;
0638.00 OverrideProc char(1) Const;
0639.00 System char(10) Const;
0640.00 FormatType char(10) Const;
0641.00 ErrorCode like(QUSEC) Options(*varsize);
0642.00 end-pr;
0643.00 **-- Characters to Hexacharacter ----------------------------------------**
0644.00 dcl-pr CharToHex extproc('cvthc');
0645.00 CTHHex pointer value;
0646.00 CTHChar pointer value;
0647.00 CTHCharSize int(10) value;
0648.00 end-pr;
0649.00
0650.00 dcl-s FILE_USED char(20);
0651.00 dcl-c NbrOfEntry 200;
0652.00 dcl-s WSFileInfo varchar(32767);
0653.00 dcl-s JrnVar5 varchar(32767);
0654.00 dcl-s PrvFName char(10);
0655.00 dcl-s CalcNbrOfEnt int(10);
0656.00 dcl-s pos packed(5:0);
0657.00 dcl-s SaveSeqNbr uns(20);
0658.00
0659.00 **-- System information: -----------------------------------------------**
0660.00 dcl-ds ProgStatus psds;
0661.00 Proc char(10) ; // Module or main procedure name
0662.00 StsCde zoned(5) ; // Status code
0663.00 PrvStsCde zoned(5) ; // Previous status
0664.00 SrcLineNbr char(8) ; // Source line number
0665.00 Routine char(8) ; // Name of the RPG routine
0666.00 Parms zoned(3) ; // Number of parms passed to program
0667.00 ExceptionType char(3) ; // Exception type
0668.00 ExceptionNbr char(4) ; // Exception number
0669.00 Exception char(7) samepos(ExceptionType) ;
0670.00 Reserved1 char(4) ; // Reserved
0671.00 MsgWrkArea char(30) ; // Message work area
0672.00 PgmLib char(10) ; // Program library
0673.00 ExceptionData char(80) ; // Retrieved exception data
0674.00 Rnx9001Exception char(4) ; // Id of exception that caused RNX9001
0675.00 LastFile1 char(10) ; // Last file operation occurred on
0676.00 Unused1 char(6) ; // Unused
0677.00 DteEntered char(8) ; // Date entered system
0678.00 StrDteCentury zoned(2) ; // Century of job started date
0679.00 LastFile2 char(8) ; // Last file operation occurred on
0680.00 LastFileSts char(35) ; // Last file used status information
0681.00 JobName char(10) ; // Job name
0682.00 JobUser char(10) ; // Job user
0683.00 JobNbr zoned(6) ; // Job number
0684.00 StrDte zoned(6) ; // Job started date
0685.00 PgmDte zoned(6) ; // Date of program running
0686.00 PgmTime zoned(6) ; // Time of program running
0687.00 CompileDte char(6) ; // Date program was compiled
0688.00 CompileTime char(6) ; // Time program was compiled
0689.00 CompilerLevel char(4) ; // Level of compiler
0690.00 SrcFile char(10) ; // Source file name
0691.00 SrcLib char(10) ; // Source file library
0692.00 SrcMbr char(10) ; // Source member name
0693.00 ProcPgm char(10) ; // Program containing procedure
0694.00 ProcMod char(10) ; // Module containing procedure
0695.00 SrcLineNbrBin bindec(2) ; // Source line number as binary
0696.00 LastFileStsBin bindec(2) ; // Source id matching positions 228-235
0697.00 User char(10) ; // Current user
0698.00 ExtErrCode int(10) ; // External error code
0699.00 IntoElements int(20) ; // Elements set by XML-INTO or DATA-INTO (7.3)
0700.00 InternalJobId char(16) ; // Internal job id (7.3 TR6)
0701.00 SysName char(8) ; // System name (7.3 TR6)
0702.00 end-ds ;
0703.00
0704.00 **-- Mainline: ---------------------------------------------------------**
0705.00 **
0706.00 **dcl-pr ReadJrn extpgm('READJRN');
0707.00 ** PrFile char(20);
0708.00 ** PrStart packed(5:0);
0709.00 ** PrLen packed(5:0);
0710.00 ** PrSearched char(128);
0711.00 ** PrJrnRange char(10);
0712.00 **end-pr;
0713.00
0714.00 dcl-pi *n;
0715.00 PiFile char(20);
0716.00 PiStart packed(5:0);
0717.00 PiLen packed(5:0);
0718.00 PiSearched char(128);
0719.00 PiJrnRange char(10);
0720.00 end-pi;
0721.00
0722.00 If (Parms > *Zeros);
0723.00 PFile = PiFile;
0724.00 ObjName = PInFile;
0725.00 If PInLib = '';
0726.00 LibName ='*LIBL';
0727.00 Else;
0728.00 LibName =PInLib;
0729.00 EndIf;
0730.00 If Parms >=4;
0731.00 @Start = PiStart;
0732.00 @Len = PiLen;
0733.00 @Searched = %SubSt(PiSearched:1:@Len);
0734.00 If Parms = 4;
0735.00 JvR01Dta = '*CURRENT';
0736.00 Else;
0737.00 JvR01Dta = PiJrnRange;
0738.00 EndIf;
0739.00 Else;
0740.00 Dsply ( 'No search criteria') '*EXT' ;
0741.00 *InLr = *On;
0742.00 Return;
0743.00 EndIf;
0744.00
0745.00 callp system(cmdStr1);
0746.00 open QSYSPRT;
0747.00
0748.00
0749.00 w_SysVal = 'QDECFMT';
0750.00 Callp RtvSystemValue(
0751.00 w_Rcvr :
0752.00 w_RcvrLngth :
0753.00 w_NbrToRtv :
0754.00 w_SysVal :
0755.00 QUSEC);
0756.00 If QUsbAvl = *Zero;
0757.00 DS_SysValTbl = w_Rcvr;
0758.00 If d_DecFmt = 1;
0759.00 w_DecSign ='.';
0760.00 w_3DigGrp =',';
0761.00 Else;
0762.00 w_DecSign =',';
0763.00 w_3DigGrp ='.';
0764.00 EndIf;
0765.00 Else;
0766.00 MSGDTA =w_SysVal;
0767.00 DTALEN = %checkr(' ' : MSGDTA);
0768.00 Exsr ShowErr;
0769.00 RETURN;
0770.00 EndIf;
0771.00 CallP ListFileDesc(
0772.00 QDBQ25
0773.00 : %Size( QDBQ25 )
0774.00 : FILE_USED
0775.00 : 'FILD0100'
0776.00 : QualName
0777.00 : ' '
0778.00 : '0'
0779.00 : '*LCL'
0780.00 : '*INT'
0781.00 : QUSEC
0782.00 );
0783.00
0784.00 If (QUSBAVL > 0);
0785.00 MESSG1 = ObjName;
0786.00 MESSG2 = LibName;
0787.00 DTALEN = %checkr(' ' : MSGDTA);
0788.00 Exsr ShowErr;
0789.00 RETURN;
0790.00 EndIF;
0791.00
0792.00 xSearched = %SubSt(@Searched:1:@Len);
0793.00 callp CharToHex (%addr(ySearched)
0794.00 : %addr(xSearched)
0795.00 : %size(ySearched));
0796.00 If (%SubSt(ySearched:2*@Len:1) = 'F') //unsigned
0797.00 OR (%SubSt(ySearched:2*@Len:1) = 'C') //signed positive
0798.00 OR (%SubSt(ySearched:2*@Len:1) = 'D'); //signed negative
0799.00 PackSignInd ='1';
0800.00 select;
0801.00 when @len = 1;
0802.00 PackSignDsp(@Len) = @Pack01bytes;
0803.00 when @len = 2;
0804.00 PackSignDsp(@Len) = @Pack02bytes;
0805.00 when @len = 3;
0806.00 PackSignDsp(@Len) = @Pack03bytes;
0807.00 when @len = 4;
0808.00 PackSignDsp(@Len) = @Pack04bytes;
0809.00 when @len = 5;
0810.00 PackSignDsp(@Len) = @Pack05bytes;
0811.00 when @len = 6;
0812.00 PackSignDsp(@Len) = @Pack06bytes;
0813.00 when @len = 7;
0814.00 PackSignDsp(@Len) = @Pack07bytes;
0815.00 when @len = 8;
0816.00 PackSignDsp(@Len) = @Pack08bytes;
0817.00 when @len = 9;
0818.00 PackSignDsp(@Len) = @Pack09bytes;
0819.00 when @len = 10;
0820.00 PackSignDsp(@Len) = @Pack10bytes;
0821.00 endSl;
0822.00 Else;
0823.00 PackSignInd ='0';
0824.00 EndIf;
0825.00 Exsr CrtUsrSpace;
0826.00 Exsr PrcJrnEnt;
0827.00 Else;
0828.00 DspMsg = 'Usage READJRN Parm(P1 P2 P3 P4 P5)';
0829.00 Dsply (DspMsg) '*EXT' ;
0830.00 DspMsg = 'P1=File P2=Start P3=Len P4=Search P5=Jrn Range';
0831.00 Dsply (DspMsg) '*EXT' ;
0832.00 EndIf;
0833.00 close QSYSPRT;
0834.00 callp system(cmdStr2);
0835.00
0836.00 *InLr = *On;
0837.00 Return;
0838.00
0839.00
0840.00 **
0841.00 BegSr PrcJrnEnt;
0842.00 CallP RtvObjD( QUSD0400
0843.00 : %Size( QUSD0400 )
0844.00 : 'OBJD0400'
0845.00 : QualName
0846.00 : '*FILE'
0847.00 : QUSEC
0848.00 );
0849.00
0850.00 If (QUSBAVL > 0);
0851.00 MESSG1 = ObjName;
0852.00 MESSG2 = LibName;
0853.00 DTALEN = %checkr(' ' : MSGDTA);
0854.00 Exsr ShowErr;
0855.00 RETURN;
0856.00 EndIF;
0857.00 QUSJN20x = QUSJN20;
0858.00 QUSJLIB02x = QUSJLIB02;
0859.00 CalcNbrOfEnt = 100;
0860.00 JvR06Dta = CalcNbrOfEnt;
0861.00 JvR08Dta ='';
0862.00 JcNbrTyp = 6;
0863.00 JcEntTyp(1) = 'PT';
0864.00 JcEntTyp(2) = 'UB';
0865.00 JcEntTyp(3) = 'UP';
0866.00 JcEntTyp(4) = 'DL';
0867.00 JcEntTyp(5) = 'PX';
0868.00 JcEntTyp(6) = 'DR';
0869.00 Exsr MoveFileList;
0870.00 JeNbrVarRcd = 5;
0871.00 DoU ((JhConInd = '0') Or (QUsbAvl > *Zero)) AND
0872.00 (JhNbrEntRtv < CalcNbrOfEnt);
0873.00 QUSEI =' ';
0874.00 CallP RtvJrnE( JeRcvVar
0875.00 : %Size( JeRcvVar )
0876.00 : QualJrn
0877.00 : 'RJNE0200'
0878.00 : JrnEntRtv +
0879.00 JrnVarR01 +
0880.00 JrnVarR02 +
0881.00 JrnVarR06 +
0882.00 JrnVarR08 +
0883.00 JrnVarR16
0884.00 : QUSEC
0885.00 );
0886.00 If QUsbAvl = *Zero;
0887.00 pEntHdr = %Addr( JeRcvVar ) + JhOfsHdrJrnE;
0888.00 If JeOfsRcvInf > *Zero ;
0889.00 pRcvInf = pEntHdr + JeOfsRcvInf;
0890.00 EndIf;
0891.00 For Idx = 1 to JhNbrEntRtv;
0892.00 Exsr PrcLstEnt;
0893.00 If JePtrHdl > *Zero;
0894.00 CallP(e) DltPtrHdl( JePtrHdl );
0895.00 EndIf;
0896.00 If Idx < JhNbrEntRtv;
0897.00 Eval pEntHdr = pEntHdr + JeOfsHdrJrnE;
0898.00 EndIf;
0899.00 EndFor;
0900.00 If JhConInd = '1';
0901.00 Eval JvR01RcvStr = JhConRcvStr;
0902.00 Eval JvR01LibStr = JhConLibStr;
0903.00 Eval JvR01RcvEnd = '*CURRENT';
0904.00 Eval JvR02SeqNbr = JhConSeqNbr;
0905.00 EndIf;
0906.00 If JhNbrEntRtv = CalcNbrOfEnt;
0907.00 JvR02SeqNbr = SaveSeqNbr;
0908.00 EndIf;
0909.00 EndIf;
0910.00 EndDo;
0911.00 EndSr;
0912.00 **-- Process list entry: -----------------------------------------------**
0913.00 BegSr PrcLstEnt;
0914.00 JbRefCst = tstbts( %Addr( JeBitFld ): 0 );
0915.00 JbTrg = tstbts( %Addr( JeBitFld ): 1 );
0916.00 JbIncDta = tstbts( %Addr( JeBitFld ): 2 );
0917.00 JbIgnApyRmvJ = tstbts( %Addr( JeBitFld ): 3 );
0918.00 JbMinEntDta = tstbts( %Addr( JeBitFld ): 4 );
0919.00 pEntDta = pEntHdr + JeOfsEntDta;
0920.00 EntDtaV = %SubSt( JdEntDta
0921.00 : 1
0922.00 : JdEntDtaLen
0923.00 );
0924.00 If JeOfsNulValI > *Zero;
0925.00 pNulVal = pEntHdr + JeOfsNulValI;
0926.00 EndIf;
0927.00 If JeOfsLglUoW > *Zero;
0928.00 pLglUow = pEntHdr + JeOfsLglUoW;
0929.00 EndIf;
0930.00 If JeOfsRcvInf > *Zero;
0931.00 pRcvInf = pEntHdr + JeOfsRcvInf;
0932.00 EndIf;
0933.00 EntDta = EntDtaV;
0934.00
0935.00 CallP CvtDtf( '*DTS'
0936.00 : JeTimStpC
0937.00 : '*YYMD'
0938.00 : JrnEntDts
0939.00 : 0
0940.00 );
0941.00 SDSTIME = %SubSt( JrnEntDts:9:6);
0942.00 SDSDATE = %SubSt( JrnEntDts:7:2)
0943.00 +%SubSt( JrnEntDts:5:2)
0944.00 +%SubSt( JrnEntDts:3:2);
0945.00 If (JeEntTyp = 'PT') OR (JeEntTyp = 'PX');
0946.00 If %SubSt(ENtDta:@Start:@Len)=%SubSt(@Searched:1:@Len);
0947.00 DspMsg = '============== Insert ==============';
0948.00 Exsr DspMessages;
0949.00 EndIf;
0950.00 EndIf;
0951.00 ** Save Before Image
0952.00 If (JeEntTyp = 'UB');
0953.00 If %SubSt(ENtDta:@Start:@Len)=%SubSt(@Searched:1:@Len);
0954.00 EntDtaB = EntDta;
0955.00 DspMsg = '========== Before changes ==========';
0956.00 Exsr DspMessages;
0957.00 EndIf;
0958.00 EndIf;
0959.00 ** Changes for Updated data
0960.00 If (JeEntTyp = 'UP');
0961.00 If %SubSt(ENtDta:@Start:@Len)=%SubSt(@Searched:1:@Len);
0962.00 EntDtaA = EntDta;
0963.00 DspMsg = '========== After changes ==========';
0964.00 Exsr DspMessages;
0965.00 DtlLine='';
0966.00 %Subst(DtlLine:30) =
0967.00 '========== Summary changes ==========';
0968.00 Except DETAIL;
0969.00 DtlLine='';
0970.00 %Subst(DtlLine:5) = 'Field';
0971.00 %Subst(DtlLine:14) = 'Old value';
0972.00 %Subst(DtlLine:64) = 'New value';
0973.00 Except DETAIL;
0974.00 DtlLine='';
0975.00 %Subst(DtlLine:1) = '----------';
0976.00 %Subst(DtlLine:14) = '------------------------------';
0977.00 %Subst(DtlLine:64) = '------------------------------';
0978.00 Except DETAIL;
0979.00 Exsr ShowDiff;
0980.00 EndIf;
0981.00 EndIf;
0982.00 ** If need for deleted data put your logic here
0983.00 If (JeEntTyp = 'DL') or (JeEntTyp = 'DR');
0984.00 EndIf;
0985.00 **
0986.00 EndSr;
0987.00 BegSr MoveFileList;
0988.00 JVR16DTA = ' ';
0989.00 pos = 1;
0990.00 JfFilNam(pos)=ObjName;
0991.00 JfLibNam(pos)=LibName;
0992.00 JfMbrNam(pos)='*FIRST';
0993.00 JcNbrFil = pos;
0994.00 JvR16DtaLen = (JcNbrFil * 30) + 4;
0995.00 JvR16RcdLen = JvR16DtaLen + 12;
0996.00 EndSr;
0997.00
0998.00 BegSr DspMessages;
0999.00 DTLLINE=DSPMsg;
1000.00 Except DETAIL;
1001.00 DTLLINE='File name: ' + PFile;
1002.00 Except DETAIL;
1003.00 DTLLINE='Date/Time: ' + sdsdATE +' / '+sdstime;
1004.00 Except DETAIL;
1005.00 DtlLine = 'Search: '+%Subst(xSearched:1:@Len);
1006.00 If PackSignInd ='1';
1007.00 DTLLINE=%TRIM(DtlLine) + ' / ' + %EDITC(PackSignDsp(@Len):'X');
1008.00 EndIf;
1009.00 Except DETAIL;
1010.00 DtlLine='Journal name: ' + QualJrn;
1011.00 Except DETAIL;
1012.00 DtlLine='Journal Seq Nbr: ' + %Char(JeSeqNbr);
1013.00 Except DETAIL;
1014.00 DtlLine='Job Name: ' + JeJobNam;
1015.00 Except DETAIL;
1016.00 DtlLine='Pgm Name: ' + JePgmNam;
1017.00 Except DETAIL;
1018.00 DtlLine='User Name: ' + JeUsrNam + 'User Profile: ' +
1019.00 JeUsrPrf;
1020.00 Except DETAIL;
1021.00 Exsr PrcFldLst;
1022.00 EndSr;
1023.00
1024.00 BegSr PrcFldLst;
1025.00 '* Access Data via Pointer
1026.00 CallP(E) RtvPtrSpc(UsrSpcFld :CUSPointer);
1027.00
1028.00 For j = 1 to HdrNumberOfDtl;
1029.00 FldPtr=CUSPointer+HdrOffsetToDtl
1030.00 + ((j-1) * %Size(LstFldDS));
1031.00 DtlLine='';
1032.00 FmtFldNme = ' ';
1033.00 Start = 10 - %LEN(%TRIM(FldName)) + 1;
1034.00 %Subst(FmtFldNme:Start) = %TRIM(FldName);
1035.00 FmtValue = ' ';
1036.00 If FLDDATATYPE = 'A';
1037.00 %Subst(FmtValue:1) =%SubSt(ENtDta:FldInBuffPos:FldLength);
1038.00 EndIf;
1039.00 If FLDDATATYPE = 'P';
1040.00 FmtHalfValue = %SubSt(ENtDta:FldInBuffPos:FldLength);
1041.00 callp CharToHex (%addr(FFValue )
1042.00 : %addr(FmtHalfValue)
1043.00 : %size(FFValue ));
1044.00 Start = (FldLength * 2) - FldDigits;
1045.00 If FldDecimals = 0;
1046.00 %Subst(FmtValue:1:FldDigits) = %SubSt(FFValue:Start:FldDigits);
1047.00 Else;
1048.00 %Subst(FmtValue:1:FldDigits+1) =
1049.00 %SubSt(FFValue:Start:FldDigits-FldDecimals) + w_DecSign +
1050.00 %SubSt(FFValue:FldDigits-FldDecimals+1:FldDecimals);
1051.00 EndIf;
1052.00 EndIf;
1053.00 FmtFldDesc = FldDesc;
1054.00 DtlLine = FmtDtlLine;
1055.00 Except DETAIL;
1056.00 EndFor;
1057.00 EndSr;
1058.00
1059.00 BegSr CrtUsrSpace;
1060.00 CallP CrtUsrSpc( UsrSpcHdr
1061.00 : *Blanks
1062.00 : 65535
1063.00 : x'00'
1064.00 : '*CHANGE'
1065.00 : *Blanks
1066.00 : '*YES'
1067.00 : QUSEC
1068.00 );
1069.00 If QUSBAvl = 0;
1070.00 OVRRID = '1';
1071.00 CallP(E) ListRcdFmts(UsrSpcHdr
1072.00 :'RCDL0200'
1073.00 : QualName
1074.00 : OVRRID
1075.00 : QUSEC
1076.00 );
1077.00 Else;
1078.00 MSGDTA = '';
1079.00 DTALEN = 0;
1080.00 Exsr ShowErr;
1081.00 RETURN;
1082.00 EndIf;
1083.00 If QUSBAvl = 0;
1084.00 CALLP(E) RtvPtrSpc(UsrSpcHdr
1085.00 : CUSPointer
1086.00 : QUSEC
1087.00 );
1088.00 Else;
1089.00 MSGDTA = '';
1090.00 DTALEN = 0;
1091.00 Exsr ShowErr;
1092.00 RETURN;
1093.00 EndIf;
1094.00 If QUSBAvl = 0;
1095.00 SaveHdrDS=USHeader;
1096.00 RcdFmtHdrPtr=CUSPointer+SavOffsetToHdr
1097.00 + ((a-1) * %Size(RcdFmtHdrDS));
1098.00 For i = 1 to SavNumberOfDtl;
1099.00 RcdFmtPtr=CUSPointer+SavOffsetToDtl
1100.00 + ((i-1) * %Size(RcdFmtDS));
1101.00 CallP CrtUsrSpc(UsrSpcFld
1102.00 : *Blanks
1103.00 : 65535
1104.00 : x'00'
1105.00 : '*CHANGE'
1106.00 : *Blanks
1107.00 : '*YES'
1108.00 : QUSEC
1109.00 );
1110.00 EndFor;
1111.00 Else;
1112.00 MSGDTA = '';
1113.00 DTALEN = 0;
1114.00 Exsr ShowErr;
1115.00 RETURN;
1116.00 EndIf;
1117.00 If QUSBAvl = 0;
1118.00 ''* Create Field List
1119.00 CallP(E) ListFields(UsrSpcFld
1120.00 :'FLDL0100'
1121.00 : QualName
1122.00 : RcdFmtName
1123.00 : OVRRID
1124.00 : QUSEC);
1125.00 Else;
1126.00 MSGDTA = '';
1127.00 DTALEN = 0;
1128.00 Exsr ShowErr;
1129.00 RETURN;
1130.00 EndIf;
1131.00 EndSr;
1132.00
1133.00 BegSr ShowDiff;
1134.00 '* Access Data via Pointer
1135.00 CallP(E) RtvPtrSpc(UsrSpcFld :CUSPointer);
1136.00
1137.00 For j = 1 to HdrNumberOfDtl;
1138.00 FldPtr=CUSPointer+HdrOffsetToDtl
1139.00 + ((j-1) * %Size(LstFldDS));
1140.00 If %SubSt(EntDtaB:FldInBuffPos:FldLength) <>
1141.00 %SubSt(EntDtaA:FldInBuffPos:FldLength);
1142.00 DtlLine='';
1143.00 FmtFldNme = '';
1144.00 Start = 10 - %LEN(%TRIM(FldName)) + 1;
1145.00 %Subst(FmtFldNme:Start) = %TRIM(FldName);
1146.00 FmtValue = '';
1147.00 FmtFldDesc = '';
1148.00 If FLDDATATYPE = 'A';
1149.00 %Subst(FmtValue:1) =%SubSt(ENtDtaB:FldInBuffPos:FldLength);
1150.00 %Subst(FmtFldDesc:1) =%SubSt(ENtDtaA:FldInBuffPos:FldLength);
1151.00 EndIf;
1152.00 If FLDDATATYPE = 'P';
1153.00 FmtHalfValue = %SubSt(ENtDtaB:FldInBuffPos:FldLength);
1154.00 callp CharToHex (%addr(FFValue )
1155.00 : %addr(FmtHalfValue)
1156.00 : %size(FFValue ));
1157.00 Start = (FldLength * 2) - FldDigits;
1158.00 If FldDecimals = 0;
1159.00 %Subst(FmtValue:1:FldDigits) =
1160.00 %SubSt(FFValue:Start:FldDigits);
1161.00 Else;
1162.00 %Subst(FmtValue:1:FldDigits+1) =
1163.00 %SubSt(FFValue:Start:FldDigits-FldDecimals) + w_DecSign +
1164.00 %SubSt(FFValue:FldDigits-FldDecimals+1:FldDecimals);
1165.00 EndIf;
1166.00 FmtHalfValue = %SubSt(ENtDtaA:FldInBuffPos:FldLength);
1167.00 callp CharToHex (%addr(FFValue )
1168.00 : %addr(FmtHalfValue)
1169.00 : %size(FFValue ));
1170.00 Start = (FldLength * 2) - FldDigits;
1171.00 If FldDecimals = 0;
1172.00 %Subst(FmtFldDesc:1:FldDigits) =
1173.00 %SubSt(FFValue:Start:FldDigits);
1174.00 Else;
1175.00 %Subst(FmtFldDesc:1:FldDigits+1) =
1176.00 %SubSt(FFValue:Start:FldDigits-FldDecimals) + w_DecSign +
1177.00 %SubSt(FFValue:FldDigits-FldDecimals+1:FldDecimals);
1178.00 EndIf;
1179.00 EndIf;
1180.00 DtlLine = FmtDtlLine;
1181.00 Except DETAIL;
1182.00 EndIf;
1183.00 EndFor;
1184.00 EndSr;
1185.00
1186.00 BegSr ShowErr;
1187.00 %SUBST(MESGFL:1:10) = 'QCPFMSG ';
1188.00 %SUBST(MESGFL:11:10) = '*LIBL ';
1189.00 CallP RtvMsgs (
1190.00 MSGINF
1191.00 :INFLEN
1192.00 :FRTVM0100
1193.00 :QUSEI
1194.00 :MESGFL
1195.00 :MSGDTA
1196.00 :DTALEN
1197.00 :RPLSUB
1198.00 :RTNFMT
1199.00 : QUSEC
1200.00 );
1201.00 DspMsg = QUSEI + ' ' +%SUBST(MSMSGV:1:MSMLNL);
1202.00 Dsply (DspMsg)'*EXT' ;
1203.00 EndSr;
1204.00 OQSYSPRT E DETAIL 1
1205.00 O DTLLINE 132