* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * "If it's squinky, then you know it's BrilligWare!" * * * * * * * * Source available at http://pando.org/downloads * * * * Brillig Enterprises (aka Chris Pando) (C)2004 * * * * * * * * This work is licensed under a Creative Commons * * * * Attribution-NonCommercial-ShareAlike License: * * * * http://creativecommons.org/licenses/by-nc-sa/2.0/legalcode * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Table Driven File Comparison (matching records) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * h dftActGrp(*No) actGrp(*Caller) bndDir('QC2LE') * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... files ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * fcp1000f if e k disk finput1 if f 1000 disk finput2 if f 1000 disk fqsysprt o f 132 printer OflInd(*InOF) * * ... dspffd must exist at compile time. It has the same format * as the outfile from the DSPFFD command ... * fdspffd if e disk * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... procedure interfaces ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d cp1000r pr d rectype 4a d file1Nam 10a d file2Nam 10a d file1Lib 10a d file2Lib 10a d description 40a d exactMatch 1n d cp1000r pi d rectype 4a d file1Nam 10a d file2Nam 10a d file1Lib 10a d file2Lib 10a d description 40a d exactMatch 1n /EJECT * * internal procedures * d bldHeaders pr d center pr d * Const d 10u 0 Const d comp pr 1a d 3p 0 Value d 3p 0 Value d compDta pr 1a d compKey pr 1a d cvtPacked pr 30p 0 d * Const d 10u 0 Const d error1 pr d error2 pr d error3 pr d getClcLen pr 10u 0 d init pr d hndlNoErr pr d loadArrays pr d OFLogic pr d prtDta pr d * Const d prtKey pr d * Const d prt pr d * Const d 3p 0 Value d 3p 0 Value d read1 pr d read2 pr * * external procedures (from the C run-time library) * d memcmp pr 10i 0 ExtProc('memcmp') d * Value d * Value d 10i 0 Value d memcpy pr ExtProc('memcpy') d * Value d * Value d 10i 0 Value d memmove pr ExtProc('memmove') d * Value d * Value d 10i 0 Value d memset pr ExtProc('memset') d * Value d 10i 0 Value d 10i 0 Value * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... data structures ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * dbuffer1ds ds 1000 d buffer1 1a dim(1000) dbuffer2ds ds 1000 d buffer2 1a dim(1000) d ds d timer 1 12s 0 d hhmmss 6s 0 Overlay(timer:1) d mmddyy 6s 0 Overlay(timer:7) /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... standalone variables ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d hdr1 s 1a dim(132) d hdr2 s 1a dim(132) d detail s 1a dim(132) d fldNam s 10a dim(20) Inz(' ') Field Name d fldDsc s 40a dim(20) Inz(' ') Field Description d fldOff s 5p 0 dim(20) Inz(0) Field Offset (buffer d fldLnB s 10u 0 dim(20) Inz(0) Field Length (buffer) d fldLnO s 10u 0 dim(20) Inz(0) Field Length (output) d fldDLn s 10u 0 dim(20) Inz(0) Field Length (description) d fldTyp s 1a dim(20) Inz(' ') Field Type d fldPut s 5p 0 dim(20) Inz(0) Offset (output buffer) d keyCnt s 3p 0 Key Field Count d dtaCnt s 3p 0 Data Field Count d testVar s 1a d $I s 3p 0 d fldCnt s 3p 0 d errorFnd s n Inz(*Off) d prtFilNam s n Inz(*On) d lftFilNam s 21a d rghFilNam s 21a * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... constants ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d EQUAL c '0' d L_LESS c '1' d R_LESS c '2' d KEY c 'K' d FIELD c 'D' d PACKED c 'P' d EDITWORD c ' 0 -' d SPLATBLANK c ' ' d EQUALSIGN c x'7E' d DASHSIGN c x'60' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Mainline * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /free init(); read1(); read2(); DoW (Not %Eof(input1) Or Not %Eof(input2)); testVar = compKey(); Select; When (testVar = L_LESS); error1(); read1(); When (testVar = R_LESS); error2(); read2(); When (testVar = EQUAL); If (compDta() <> EQUAL); error3(); EndIf; read1(); read2(); EndSl; EndDo; hndlNoErr(); Return; /end-free /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... "O" specs ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * oqsysprt e header1 01 o 6 'CP1000' o 76 'Compare/Contrast Files' o mmddyy 132 ' 0/ / ' o e header1 02 04 o 6 'Page: ' o Page Z 15 o description 85 o hhmmss 132 ' 0: : ' o e header2 0 1 o 11 'Left File: ' o lftFilNam 33 o e header2 0 2 o 11 'Right File:' o rghFilNam 33 o e header3 0 0 o hdr1 o e header3 1 o hdr2 o e detail1 1 o detail o e noErrors 2 o '**** No Errors Found ****' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Procedures * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * load arrays with field offsets and lengths (both key and data) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ploadArrays b d pi d refNam s 10a Dim(999) d refOff s 5s 0 Dim(999) d refLen s 5s 0 Dim(999) d refDgt s 2s 0 Dim(999) d refTyp s 1a Dim(999) d arrIndex s 3s 0 /free // // first load information from DSPFFD // fldCnt = 0; Read dspffd; DoW ( Not %Eof(dspffd) ); fldCnt = fldCnt + 1; refNam(fldCnt) = whFLDI; refOff(fldCnt) = whFOBO; refLen(fldCnt) = whFLDB; refDgt(fldCnt) = whFLDD; refTyp(fldCnt) = whFLDT; Read dspffd; EndDo; /EJECT // // and then load information from driver file // aeRECTYP = recType; $I = 0; keyCnt = 0; dtaCnt = 0; Chain aeRECTYP cp1000f; DoW (Not %Eof(cp1000f)); arrIndex = %Lookup( aeNAM : refNam : 1 : fldCnt ); If (arrIndex <> 0); $I = $I + 1; If (aeFLDTYP = KEY); keyCnt = keyCnt + 1; Else; dtaCnt = dtaCnt + 1; EndIf; fldNam($I) = refNam(arrIndex); fldOff($I) = refOff(arrIndex); fldLnB($I) = refLen(arrIndex); // packed fields occupy more space in the output (print) // buffer than they do in the input buffer; when we are // ready to deal with other fields of a similar nature // (e.g. BINARY), this is where we'll do it. fldTyp($I) = refTyp(arrIndex); Select; When (fldTyp($I) = PACKED); fldLnO($I) = refDgt(arrIndex); Other; fldLnO($I) = refLen(arrIndex); EndSl; // Length of output is the greater of field & desc length fldDsc($I) = aeDSC; fldDLn($I) = %Scan( SPLATBLANK : aeDSC ) - 1; If (fldDLn($I) <= 0); fldDLn($I) = %Len(aeDSC); EndIf; EndIf; ReadE aeRECTYP cp1000f; EndDo; Return; /end-free ploadArrays e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * initialisation * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pinit b c Time timer /free center( %Addr(description) : %Len(description) ); lftFilNam = %trimR(file1Nam) + ' ' + file1Lib; rghFilNam = %trimR(file2Nam) + ' ' + file2Lib; loadArrays(); bldHeaders(); *InLR = *On; *InOF = *On; Return; /end-free pinit e /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * build report headers * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pbldHeaders b d pi d clcLen s 10u 0 d $J s 3p 0 Inz(3) output starts in 3rd /free for $I = 1 to keyCnt; fldPut($I) = $J; clcLen = getClcLen(); memcpy( %Addr(hdr1($J)) : %Addr(fldDsc($I)) : clcLen ); memset( %Addr(hdr2($J)) : EQUALSIGN : clcLen ); $J = $J + clcLen + 1; EndFor; For $I = (keyCnt + 1) to (keyCnt + dtaCnt); fldPut($I) = $J; clcLen = getClcLen(); memcpy( %Addr(hdr1($J)) : %Addr(fldDsc($I)) : clcLen ); memset( %Addr(hdr2($J)) : DASHSIGN : clcLen ); $J = $J + clcLen + 1; EndFor; Return; /end-free pbldHeaders e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * read from first file * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pread1 b d pi /free Read input1 buffer1ds; If (%Eof(input1)); // if eof, then load key fields with high values For $I = 1 to keyCnt; memset( %Addr(buffer1(fldOff($I))) : x'FF' : fldLnB($I) ); EndFor; EndIf; Return; /end-free pread1 e /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * read from second file * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pread2 b d pi /free Read input2 buffer2ds; If (%Eof(input2)); // if eof, then load key fields with high values For $I = 1 to keyCnt; memset( %Addr(buffer2(fldOff($I))) : x'FF' : fldLnB($I) ); EndFor; EndIf; Return; /end-free pread2 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * when first record key is less than second * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * perror1 b d pi /free If (Not exactMatch); OFLogic(); detail = *Blanks; prtKey( %Addr(buffer1) ); prtDta( %Addr(buffer1) ); detail(1) = 'L'; Except detail1; errorFnd = *On; EndIf; Return; /end-free perror1 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * when first record key is greater than second * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * perror2 b d pi /free If (Not exactMatch); OFLogic(); detail = *Blanks; prtKey( %Addr(buffer2) ); prtDta( %Addr(buffer2) ); detail(1) = 'R'; Except detail1; errorFnd = *On; EndIf; Return; /end-free perror2 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * keys equal but data different * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * perror3 b d pi /free OFLogic(); detail = *Blanks; prtKey( %Addr(buffer1) ); prtDta( %Addr(buffer1) ); Except detail1; detail = *Blanks; prtDta( %Addr(buffer2) ); Except detail1; errorFnd = *On; Return; /end-free perror3 e /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * compare keys * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pcompKey b d pi 1a /free Return comp( 1 // compare all : keyCnt // keyfields ); /end-free pcompKey e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * compare data * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pcompDta b d pi 1a /free Return comp( keyCnt + 1 // compare all : keyCnt + dtaCnt // data fields ); /end-free pcompDta e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * compare buffers by field number * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pcomp b d pi 1a d $start 3p 0 Value d $finis 3p 0 Value d memcmpstr s 10i 0 /free $I = $start; DoU ($I > $finis Or memcmpstr <> 0); memcmpstr = memcmp( %Addr(buffer1(fldOff($I))) : %Addr(buffer2(fldOff($I))) : fldLnB($I) ); $I = $I + 1; EndDo; Select; When (memcmpstr < 0); Return L_LESS; When (memcmpstr > 0); Return R_LESS; When (memcmpstr = 0); Return EQUAL; EndSl; /end-free pcomp e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Overflow Logic * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pOFLogic b d pi /free If (*InOF); Except header1; If (prtFilNam); Except header2; prtFilNam = *Off; EndIf; Except header3; *InOF = *Off; EndIf; Return; /end-free pOFLogic e /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * No Errors * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * phndlNoErr b d pi /free If (Not errorFnd); Except Header1; Except Header2; Except Header3; Except noErrors; EndIf; Return; /end-free phndlNoErr e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * transfer key information to output buffer * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pprtKey b d pi D buffer@ * Const /free prt( buffer@ : 1 // print all : keyCnt // keyfields ); Return; /end-free pprtKey e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * transfer data information to output buffer * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pprtDta b d pi d buffer@ * Const /free prt( buffer@ : keyCnt + 1 // print all : keyCnt + dtaCnt // data fields ); Return; /end-free pprtDta e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * move from input buffer to output buffer * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pprt b d pi d buffer@ * Const D $startA 3p 0 Value D $finisA 3p 0 Value d alpha s 30a /free For $I = $startA to $finisA; // packed fields occupy more space in the output (print) // buffer than they do in the input buffer; when we are // ready to deal with other fields of a similar nature // (e.g. BINARY), this is where we'll do it. Select; When (fldTyp($I) = PACKED); alpha = %EditW( cvtPacked( buffer@ + fldOff($I) - 1 : fldLnB($I) ) : EDITWORD ); memcpy( %Addr(detail(fldPut($I))) : %Addr(alpha) + %Len(alpha) - fldLnO($I) : fldLnO($I) ); Other; memcpy( %Addr(detail(fldPut($I))) : buffer@ + fldOff($I) - 1 : fldLnO($I) ); EndSl; /EJECT // // if description longer than field, then center // If (fldDLn($I) > fldLnO($I)); center( %Addr(detail(fldPut($I))) : fldDLn($I) ); EndIf; EndFor; Return; /end-free pprt e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * center * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pcenter b d pi d @ * Const description pointer d fldLen 10u 0 Const description length d char s 1a Based(l@) test character d l@ s * left pointer d r@ s * right pointer d moveCnt s 3u 0 /free l@ = @ + fldLen - 1; r@ = l@; DoW (@ <= l@ and char = *Blank); l@ = l@ - 1; EndDo; Select; // I certainly could have done: When (l@ < @); // // All blanks // If ( (l@ >= @) And (l@ < (r@ -1)) ); When (l@ = r@); // // No blanks // but that is not nearly as 'self-documenting'. Besides, When (l@ = r@ - 1); // how often does a center routine execute // One blank Other; moveCnt = %Div( r@ - l@ : 2 ); memmove( @ + moveCnt : @ : l@ - @ + 1 ); memset( @ : x'40' : moveCnt ); EndSl; Return; /end-free pcenter e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * get display length * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pgetClcLen b d pi 10u 0 /free If ( fldLnO($I) >= fldDLn($I) ); Return fldLnO($I); Else; Return fldDLn($I); EndIf; Return; /end-free pgetClcLen e /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * convert packed value to signed * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pcvtPacked b d pi 30p 0 d ptr * Const d fldLen 10u 0 Const d ds Based(ptr) d packed01 1 1p 0 d packed02 1 2p 0 d packed03 1 3p 0 d packed04 1 4p 0 d packed05 1 5p 0 d packed06 1 6p 0 d packed07 1 7p 0 d packed08 1 8p 0 d packed09 1 9p 0 d packed10 1 10p 0 d packed11 1 11p 0 d packed12 1 12p 0 d packed13 1 13p 0 d packed14 1 14p 0 d packed15 1 15p 0 d packed16 1 16p 0 PackEven /free Select; When (fldLen = 1); Return packed01; When (fldLen = 2); Return packed02; When (fldLen = 3); Return packed03; When (fldLen = 4); Return packed04; When (fldLen = 5); Return packed05; When (fldLen = 6); Return packed06; When (fldLen = 7); Return packed07; When (fldLen = 8); Return packed08; When (fldLen = 9); Return packed09; When (fldLen = 10); Return packed10; When (fldLen = 11); Return packed11; When (fldLen = 12); Return packed12; When (fldLen = 13); Return packed13; When (fldLen = 14); Return packed14; When (fldLen = 15); Return packed15; When (fldLen = 16); Return packed16; Other; Return packed16; EndSl; Return; /end-free pcvtPacked e A R CP1000 A AERECTYP 4A A AEFLDTYP 1A A AEFLDSEQ 3P 0 A AENAM 10A A AEDSC 30A A K AERECTYP A K AEFLDTYP DESCEND A K AEFLDSEQ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Table Driven Generic File Comparison */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ PGM PARM( &RECTYP + &FILE1 + &FILE2 + &LIBRARY1 + &LIBRARY2 + &DESCR + &XCTMTCH ) DCL VAR(&RECTYP ) TYPE(*CHAR) LEN( 4) DCL VAR(&FILE1 ) TYPE(*CHAR) LEN( 10) DCL VAR(&FILE2 ) TYPE(*CHAR) LEN( 10) DCL VAR(&LIBRARY1 ) TYPE(*CHAR) LEN( 10) DCL VAR(&LIBRARY2 ) TYPE(*CHAR) LEN( 10) DCL VAR(&DESCR ) TYPE(*CHAR) LEN( 40) DCL VAR(&XCTMTCH ) TYPE(*LGL ) LEN( 1) DCL VAR(&KEYFLD ) TYPE(*CHAR) LEN( 512) DCL VAR(&QRYSLT ) TYPE(*CHAR) LEN( 512) DCL VAR(&OPNQRYF1 ) TYPE(*CHAR) LEN(1024) DCL VAR(&OPNQRYF2 ) TYPE(*CHAR) LEN(1024) DCL VAR(&EOF ) TYPE(*LGL ) LEN( 1) DCL VAR(&CMDLEN ) TYPE(*DEC ) LEN(15 5) VALUE(1024) DCL VAR(&ERRFLG ) TYPE(*LGL ) LEN( 1) VALUE('0') DCL VAR(&MSGDTA ) TYPE(*CHAR) LEN( 512) DCL VAR(&MSGID ) TYPE(*CHAR) LEN( 7) DCL VAR(&MSGF ) TYPE(*CHAR) LEN( 10) DCL VAR(&MSGFLIB ) TYPE(*CHAR) LEN( 10) DCL VAR(&RTNTYPE ) TYPE(*CHAR) LEN( 2) DCLF FILE(CP1000F) MONMSG MSGID(CPF0000) EXEC(GOTO ERROR) /* */ /* Build KEYFLD Keyword */ /* */ OVRDBF FILE(CP1000F) SHARE(*YES) CHGVAR VAR(&QRYSLT) + VALUE('AERECTYP *EQ "' *CAT &RECTYP *CAT + '" *AND AEFLDTYP *EQ "K"') OPNQRYF FILE((CP1000F)) QRYSLT(&QRYSLT) KEYFLD(*FILE) CHGVAR VAR(&KEYFLD) VALUE('KEYFLD(') RTAG: RCVF MONMSG MSGID(CPF0000) EXEC(CHGVAR VAR(&EOF) VALUE('1')) IF COND(¬ &EOF) THEN(DO) CHGVAR VAR(&KEYFLD) + VALUE(&KEYFLD *TCAT '(' *CAT &AENAM *TCAT ')') GOTO CMDLBL(RTAG) ENDDO CHGVAR VAR(&KEYFLD) VALUE(&KEYFLD *TCAT ')') CLOF OPNID(CP1000F) DLTOVR FILE(CP1000F) /* */ /* Load file field description */ /* */ DSPFFD FILE(&LIBRARY1/&FILE1) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/DSPFFD) OVRPRTF FILE(QSYSPRT) MAXRCDS(*NOMAX) USRDTA(&FILE1) /* */ /* Build and execute OPNQRYFs */ /* */ OVRDBF FILE(INPUT1) TOFILE(&LIBRARY1/&FILE1) SHARE(*YES) OVRDBF FILE(INPUT2) TOFILE(&LIBRARY2/&FILE2) SHARE(*YES) CHGVAR VAR(&OPNQRYF1) + VALUE('OPNQRYF FILE(INPUT1) ' *CAT &KEYFLD) CHGVAR VAR(&OPNQRYF2) + VALUE('OPNQRYF FILE(INPUT2) ' *CAT &KEYFLD) CALL PGM(QCMDEXC) PARM(&OPNQRYF1 &CMDLEN) CALL PGM(QCMDEXC) PARM(&OPNQRYF2 &CMDLEN) /* */ /* Call the program */ /* */ CALL PGM(CP1000R) + PARM(&RECTYP + &FILE1 + &FILE2 + &LIBRARY1 + &LIBRARY2 + &DESCR + &XCTMTCH) /* */ /* Housecleaning */ /* */ CLOF OPNID(INPUT1) CLOF OPNID(INPUT2) DLTOVR FILE(INPUT1) DLTOVR FILE(INPUT2) RETURN /* */ /* Error Handling */ /* */ ERROR: IF COND(¬ &ERRFLG) THEN(DO) CHGVAR VAR(&ERRFLG) VALUE('1') RCLRSC ETAG: RCVMSG PGMQ(*SAME) MSGTYPE(*EXCP) MSGDTA(&MSGDTA) + MSGID(&MSGID) RTNTYPE(&RTNTYPE) + MSGF(&MSGF) MSGFLIB(&MSGFLIB) IF COND(&MSGID *NE ' ') THEN(DO) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*ESCAPE) GOTO CMDLBL(ETAG) ENDDO ENDDO RETURN ENDPGM