You are here:
DBG/400
>
DBG400 Web
>
SourceCodeList
>
RpgleSource
>
RpgleDBG005R4
(26 May 2005,
MartinRowe
)
(raw view)
E
dit
A
ttach
<verbatim> ************************************************************************** * DBG005R4: Work with On-line Documents * Copyright (C) 2000 Martin Rowe <martin@dbg400.net> * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ********************************************************************************************** * Indicator usage ********************************************************************************************** * 01: F1=Help * 03: F3=Exit * 08: F8=Edit header/footer * 12: F12=Previous * 27: ROLLUP * 28: ROLLDOWN * 35: SFLEND * 36: SFLDSP * 50: DISPLAY mode on - disable all options except view & print * 51: DSPATR(PR) on screen titles (selective by 'lock' state) * 52: DSPATR(PR) on screen titles (all/none ('locked' documents excluded)) * 80 - 84: File I/O * 90: General error trap ********************************************************************************************** H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT) ********************************************************************************************** * FILES: ********************************************************************************************** * Document index (title, headers & footers, etc) FDBGDFTH1 UF A E K DISK * Document text FDBGDFTD1 UF A E K DISK * Workfile for keyword limited documents FDBGOLD0W UF A E K DISK * Keyword file by document & keyword FDBGDFTK1 UF E K DISK * Keyword file by keyword & document FDBGDFTK2 IF E K DISK * Screen display FDBG005DF CF E WORKSTN F SFILE(SFL:RRN) ********************************************************************************************** * DATA STRUCTURES: ********************************************************************************************** * PROGRAM NAME D SDS D PGM 10 D #@User 254 263 * D DS D Ovrdb1 60 INZ('OVRDBF FILE(DBGDFTD1- D ) TOFILE(DBGDFTD1) S- D ECURE(*YES) ') * D DS D Ovrdb2 60 INZ('OVRDBF FILE(DBGDFTH1- D ) TOFILE(DBGDFTH1) S- D ECURE(*YES) ') * D DS D Ovrdb3 60 INZ('OVRDBF FILE(DBGDFTK1- D ) TOFILE(DBGDFTK1) S- D ECURE(*YES) ') * D DS D Dltovr 60 INZ('DLTOVR FILE(DBGDFTD1- D DBGDFTH1 DBGDFTK1) - D LVL(*) ') * D DS D Clrpfm 40 INZ('CLRPFM FILE(QTEMP/DB- D GOLD0W ) ') ********************************************************************************************** * CONSTANTS: ********************************************************************************************** D Symb C CONST('{}[]<>') D Atrb C CONST(X'222024202620') D Text01 C CONST('Subsetted list') ********************************************************************************************** * WORK FIELDS: ********************************************************************************************** D #Docd S 10 D #Errid S 7 D #1 S 3 0 D #2 S 3 0 D #3 S 3 0 D Cmdlen S 15 5 D Cmdstr S 256 D Docfil S 10 D Doclib S 10 D Dtalen S 5 0 D K#Docd S 10 D K#Word S 10 D LDA S 512 D Lockok S 1 D Msgdta S 512 D Msgfil S 10 D Msgid S 7 D Msglib S 10 D Msgtyp S 10 D P#Docd S 10 D P#Edit S 1 D P#Pgm S 10 D P#Titl S 50 D Pagful S 3 0 D Pgmmod S 4 D Pgmq S 10 D Pgmstk S 5 0 D Rcdrqd S 1 D Reload S 1 D Rrn S 4 0 D Strpos S 3 0 D Subset S 1 ********************************************************************************************** * ENTRY PARAMETERS: ********************************************************************************************** C *ENTRY PLIST C PARM Doclib C PARM Docfil C PARM Pgmmod ********************************************************************************************** * KEY LISTS: ********************************************************************************************** C Wrdky1 KLIST C KFLD K#Docd C KFLD K#Word * C Wrdky2 KLIST C KFLD KWORD1 C KFLD #Docd ********************************************************************************************** * MAINLINE: ********************************************************************************************** * Get company name C *DTAARA DEFINE DBGCOMP COMPNY C IN COMPNY C *DTAARA DEFINE *LDA LDA C MOVE *off Subset * Display only if not in edit mode B001 C IF Pgmmod <> '*EDT' C EVAL *IN50 = *on E001 C ENDIF * Show the document & index files being worked with C Doclib CAT(P) '/':0 #SDFIL C CAT Docfil:0 #SDFIL C EVAL SUBTXT = *blanks * Build subfile and display C *loval SETLL DBGDFTH1 C EXSR PAGUP * Repeat display until exit requested B001 C DOW *IN03 = *off * Don't display subfile if empty C EVAL *IN36 = Rrn > 0 C WRITE FOOTER1 C WRITE MSFLC MSG SUBFILE C EXFMT SFLCTL DISPLAY SCREEN * Remove messages from queue after display C CALL 'DBG045CL' 90 C MOVE *off Reload * Process response B002 C SELECT * F1/Help pressed S002 C WHEN *IN01 = *on C CALL 'QCMDEXC' 90 C PARM Ovrdb1 Cmdstr C PARM 60 Cmdlen * C CALL 'QCMDEXC' 90 C PARM Ovrdb2 Cmdstr C PARM 60 Cmdlen * C CALL 'QCMDEXC' 90 C PARM Ovrdb3 Cmdstr C PARM 60 Cmdlen * Call the Helptext Viewer C CALL 'DBG010R4' 90 Trap errors C PARM PGM P#Pgm C CALL 'QCMDEXC' 90 C PARM Dltovr Cmdstr C PARM 60 Cmdlen * F3=Exit or F12=Previous S002 C WHEN *IN03 = *on C OR *IN12 = *on C LEAVE * F17=Subset S002 C WHEN *IN17 = *on C EXSR KEYWRD * RollUp S002 C WHEN *IN27 = *on C EXSR PAGUP * RollDown S002 C WHEN *IN28 = *on C EXSR PAGDWN * Reposition list S002 C WHEN #PDOCD <> *blanks * Use workfile if subsetted by keyword(s) B003 C IF Subset = *on C #PDOCD SETLL DBGOLD0W 35 * Otherwise use the full header X003 C ELSE C #PDOCD SETLL DBGDFTH1 35 E003 C ENDIF C EVAL #PDOCD = *blanks C EXSR PAGUP * Create a new document S002 C WHEN #CTL01 = '1' C NEWDOC SETLL DBGDFTH1 81 B003 C SELECT * Error if no document specified S003 C WHEN NEWDOC = *blanks C MOVE 'GSM0305' Msgid C EVAL Msgdta = *blanks C EVAL Dtalen = 0 C EVAL Pgmstk = 0 C EXSR SNDMSG * Error if document already exists S003 C WHEN *IN81 = *on C MOVE 'GSM0304' Msgid C MOVEL NEWDOC Msgdta C EVAL Dtalen = 10 C EVAL Pgmstk = 0 C EXSR SNDMSG * Otherwise create a new index record, and run the edit program S003 C OTHER C MOVE NEWDOC DFDOCD C EVAL DFDOCH = *blanks C EVAL NEWDOC = *blanks C EVAL DFCDTE = *DATE C EVAL DFADTE = *DATE C MOVE #@User DFCUSR C MOVE #@User DFAUSR C MOVE 'T' DFLOCK C MOVE 'N' DFHEAD C WRITE DB1DFTH C MOVE DFDOCD #Docd C CALL 'DBG020R4' 90 C PARM #Docd P#Docd C PARM *blanks P#Titl C MOVE *on Reload E003 C ENDSL C EVAL #CTL01 = *blanks * Process subfile requests (if subfile not empty) S002 C OTHER B003 C IF Rrn <> 0 C READC SFL 80 * Process changed records B004 C DOW *IN80 = *off B005 C SELECT * 2=Edit S005 C WHEN #SEL1 = '2' C EVAL #SEL1 = *blanks C UPDATE SFL * Option only available in Edit mode B006 C IF Pgmmod = '*EDT' * If record free for editing B007 C IF #SLOCK = 'F' * Set the lock on the index C MOVE #SDOCD K#Docd C K#Docd CHAIN DBGDFTH1 81 B008 C IF *IN81 = *off C MOVE 'T' DFLOCK C UPDATE DB1DFTH E008 C ENDIF * Run the edit program C CALL 'DBG020R4' 90 C PARM #SDOCD P#Docd C PARM #SDOCH P#Titl * Flag to reload screen (show new change date if document amended) C MOVE *on Reload * Otherwise document is locked & unlocked first (either someone else is * editing it, or it has been permanently locked by the author. X007 C ELSE C MOVE 'GSM0306' Msgid C MOVEL #SDOCD Msgdta C EVAL Dtalen = 10 C EVAL Pgmstk = 0 C EXSR SNDMSG E007 C ENDIF E006 C ENDIF * 3=Copy S005 C WHEN #SEL1 = '3' C EVAL #SEL1 = *blanks C UPDATE SFL * Option only available in Edit mode B006 C IF Pgmmod = '*EDT' * Request 'Copy to' name C MOVE #SDOCD CPYDOC C EXFMT WINDOW1 * If continuing with request B007 C IF *IN12 = *off C CPYDOC SETLL DBGDFTH1 81 * Error if document already exists B008 C IF *IN81 = *on C MOVE 'GSM0304' Msgid C MOVEL CPYDOC Msgdta C EVAL Dtalen = 10 C EVAL Pgmstk = 0 C EXSR SNDMSG * Otherwise loop through all records for the original, creating copies * with the new name X008 C ELSE C MOVE #SDOCD K#Docd C K#Docd CHAIN(N) DBGDFTD1 81 B009 C DOW *IN81 = *off C MOVE CPYDOC DFDOCD C WRITE DB1DFT0 C K#Docd READE(N) DBGDFTD1 81 E009 C ENDDO * Copy the index entry to the new name C K#Docd CHAIN(N) DBGDFTH1 81 B009 C IF *IN81 = *off C MOVE CPYDOC DFDOCD C EVAL DFCDTE = *DATE C EVAL DFADTE = *DATE C MOVE #@User DFCUSR C MOVE #@User DFAUSR C MOVE 'F' DFLOCK C WRITE DB1DFTH E009 C ENDIF * Refresh screen from point of new document C EVAL CPYDOC = *blanks C MOVE DFDOCD #Docd C MOVE *on Reload E008 C ENDIF E007 C ENDIF E006 C ENDIF * 4=Delete S005 C WHEN #SEL1 = '4' C EVAL #SEL1 = *blanks C UPDATE SFL * Option only available in Edit mode B006 C IF Pgmmod = '*EDT' * If record free for deletion B007 C IF #SLOCK = 'F' * Request confirmation C MOVE 'Y' #SDLTF C EXFMT WINDOW2 * If confirmed B008 C IF *IN12 = *off C AND #SDLTF = 'Y' * Delete document record(s) C MOVE #SDOCD K#Docd B009 C DOU *IN81 = *on C K#Docd DELETE DB1DFT0 81 E009 C ENDDO * Delete document keyword record(s) C MOVE #SDOCD K#Docd B009 C DOU *IN81 = *on C K#Docd DELETE DB1DFTK1 81 E009 C ENDDO * Delete index record C K#Docd DELETE DB1DFTH 81 * Delete workfile record (if there is one) B009 C IF Subset = *on C K#Docd DELETE DB1OLDWF 81 E009 C ENDIF * Reload screen C MOVE *on Reload E008 C ENDIF * Otherwise document is locked & must be unlocked before deleting X007 C ELSE C MOVE 'GSM0306' Msgid C MOVEL #SDOCD Msgdta C EVAL Dtalen = 10 C EVAL Pgmstk = 0 C EXSR SNDMSG E007 C ENDIF E006 C ENDIF * 5=Display S005 C WHEN #SEL1 = '5' C EVAL #SEL1 = *blanks C UPDATE SFL * Run the display program C CALL 'DBG030R4' 90 C PARM #SDOCD P#Docd C PARM #SDOCH P#Titl C PARM *off P#Edit * 6=Print S005 C WHEN #SEL1 = '6' C EVAL #SEL1 = *blanks C UPDATE SFL * Run the print program C CALL 'DBG015R4' 90 C PARM #SDOCD P#Docd C PARM #SDOCH P#Titl * Inform user that report has been printed C MOVE 'GSM0301' Msgid C P#Docd CAT(P) P#Titl Msgdta C EVAL Dtalen = 60 C EVAL Pgmstk = 0 C EXSR SNDMSG * 7=Rename S005 C WHEN #SEL1 = '7' C EVAL #SEL1 = *blanks C UPDATE SFL * Option only available in Edit mode B006 C IF Pgmmod = '*EDT' * Request the 'Rename to' name C MOVE #SDOCD RNMDOC C EXFMT WINDOW3 * If continuing B007 C IF *IN12 = *off C RNMDOC SETLL DBGDFTH1 81 * Error if document already exists B008 C IF *IN81 = *on C MOVE 'GSM0304' Msgid C MOVEL RNMDOC Msgdta C EVAL Dtalen = 10 C EVAL Pgmstk = 0 C EXSR SNDMSG * Otherwise loop through all records for the original, & change the name X008 C ELSE C MOVE #SDOCD K#Docd C K#Docd CHAIN DBGDFTD1 81 B009 C DOW *IN81 = *off C MOVE RNMDOC DFDOCD C UPDATE DB1DFT0 C K#Docd READE DBGDFTD1 81 E009 C ENDDO * Update the index with the change of name C K#Docd CHAIN DBGDFTH1 81 B009 C IF *IN81 = *off C MOVE RNMDOC DFDOCD C EVAL DFADTE = *DATE C MOVE #@User DFAUSR C UPDATE DB1DFTH E009 C ENDIF * Set screen for reload at the new name C EVAL RNMDOC = *blanks C MOVE DFDOCD #Docd C MOVE *on Reload E008 C ENDIF E007 C ENDIF E006 C ENDIF * 8=Details S005 C WHEN #SEL1 = '8' C EVAL #SEL1 = *blanks C UPDATE SFL C EXSR DETAIL E005 C ENDSL * Read next changed record in subfile C READC SFL 80 E004 C ENDDO E003 C ENDIF E002 C ENDSL * Reload screen if required B002 C IF Reload = *on B003 C IF Subset = *on C #Docd SETLL DBGOLD0W 35 X003 C ELSE C #Docd SETLL DBGDFTH1 35 E003 C ENDIF C EXSR PAGUP C MOVE *off Reload E002 C ENDIF * Loop back to screen display if not F3 E001 C ENDDO * Exit program C EVAL *INLR = *on C RETURN ********************************************************************************************** * PAGUP: Display next page ********************************************************************************************** C PAGUP BEGSR * If not end of file B001 C IF *IN35 = *off * Clear the subfile C EVAL Rrn = 0 C EVAL Pagful = 0 C EVAL *IN36 = *off C WRITE SFLCTL * Load up a page of records B002 C DO 16 * If F17=Subset in use, restrict document to those containing keyword(s) B003 C IF Subset = *on C READ(N) DBGOLD0W 82 * Get the matching document header B004 C IF *IN82 = *off C DFDOCD CHAIN(N) DBGDFTH1 82 E004 C ENDIF * Otherwise process the full index file X003 C ELSE C READ(N) DBGDFTH1 82 E003 C ENDIF * If index record found, write to subfile B003 C IF *IN82 = *off C EVAL Rrn = Rrn + 1 C MOVE DFDOCD #SDOCD C MOVE DFDOCH #SDOCH C EVAL #SADTE = DFADTE C EVAL #SCDTE = DFCDTE C MOVE DFCUSR #SCUSR C MOVE DFAUSR #SAUSR C MOVE DFLOCK #SLOCK C MOVE DFHEAD #SHEAD C MOVE DFHTX1 #SHTX1 C MOVE DFHTX2 #SHTX2 C MOVE DFHTX3 #SHTX3 C MOVE DFHTX4 #SHTX4 C MOVE DFHTX5 #SHTX5 C MOVE DFHTX6 #SHTX6 C MOVE DFFTX1 #SFTX1 C MOVE DFFTX2 #SFTX2 C MOVE DFFTX3 #SFTX3 C MOVE DFADD1 #SADD1 C MOVE DFADD2 #SADD2 C MOVE DFADD3 #SADD3 C WRITE SFL * Store key of first subfile record for RollDown requests B004 C IF Rrn = 1 C MOVE DFDOCD #Docd E004 C ENDIF * Otherwise no (more) records found, so set on SFLEND X003 C ELSE C EVAL *IN35 = *on C LEAVE E003 C ENDIF E002 C ENDDO * Look ahead to see if last record read was last on file: SFLEND if so B002 C IF Subset = *on * Use workfile if processing subset request B003 C IF *IN35 = *off C DFDOCD SETGT DBGOLD0W 35 E003 C ENDIF * Otherwise use full file X002 C ELSE B003 C IF *IN35 = *off C DFDOCD SETGT DBGDFTH1 35 E003 C ENDIF E002 C ENDIF E001 C ENDIF * C ENDSR ********************************************************************************************** * PAGDWN: Display previous page ********************************************************************************************** C PAGDWN BEGSR * Set off SFLEND C EVAL *IN35 = *off C EVAL Pagful = 0 * Position file pointer to first record in subfile B001 C IF Subset = *on C #Docd SETLL DBGOLD0W X001 C ELSE C #Docd SETLL DBGDFTH1 E001 C ENDIF * Set pointer key to first record in case already at beginning C MOVE #Docd DFDOCD * Read back a page + one record to reposition file at correct point B001 C DO 17 B002 C IF Subset = *on C READP(N) DBGOLD0W 82 B003 C IF *IN82 = *off C DFDOCD CHAIN(N) DBGDFTH1 82 E003 C ENDIF X002 C ELSE C READP(N) DBGDFTH1 82 E002 C ENDIF * If no earlier records, this one is the first, so leave now B002 C IF *IN82 = *on B003 C IF Subset = *on C DFDOCD SETLL DBGOLD0W X003 C ELSE C DFDOCD SETLL DBGDFTH1 C LEAVE E003 C ENDIF E002 C ENDIF E001 C ENDDO * File is set up to one page back, so reload screen from that point C EXSR PAGUP * C ENDSR ********************************************************************************************** * DETAIL: Display/amend document details ********************************************************************************************** C DETAIL BEGSR * Display the details screen C MOVE #SDOCH #WDOCH C MOVE #SHEAD #WHEAD * If document free for changes, and in edit mode B001 C IF #SLOCK = 'F' C AND Pgmmod = '*EDT' C #SDOCD CHAIN DBGDFTH1 81 * Put a temporary lock on the document B002 C IF *IN81 = *off C MOVE 'T' DFLOCK C UPDATE DB1DFTH C MOVE *on Lockok C EVAL *IN51 = *off E002 C ENDIF * Otherwise show all fields as output only X001 C ELSE C MOVE *off Lockok C EVAL *IN51 = *on E001 C ENDIF * B001 C DOW *IN03 = *off C WRITE MSFLC C WRITE FOOTER2 C EXFMT SCREEN1 B002 C SELECT * F1/Help pressed S002 C WHEN *IN01 = *on C CALL 'QCMDEXC' 90 C PARM Ovrdb1 Cmdstr C PARM 60 Cmdlen * C CALL 'QCMDEXC' 90 C PARM Ovrdb2 Cmdstr C PARM 60 Cmdlen * Call the Helptext Viewer C CALL 'DBG010R4' 90 Trap errors C PARM PGM P#Pgm C CALL 'QCMDEXC' 90 C PARM Dltovr Cmdstr C PARM 40 Cmdlen * F3=Exit S002 C WHEN *IN03 = *on * Release the document lock B003 C IF Lockok = *on C #SDOCD CHAIN DBGDFTH1 81 B004 C IF *IN81 = *off C MOVE 'F' DFLOCK C UPDATE DB1DFTH E004 C ENDIF E003 C ENDIF * F12=Previous S002 C WHEN *IN12 = *on * Release the document lock B003 C IF Lockok = *on C #SDOCD CHAIN DBGDFTH1 81 B004 C IF *IN81 = *off C MOVE 'F' DFLOCK C UPDATE DB1DFTH E004 C ENDIF E003 C ENDIF C LEAVE * Update details S002 C OTHER * Update the index if document free for update B003 C IF Lockok = *on C #SDOCD CHAIN DBGDFTH1 81 B004 C IF *IN81 = *off C MOVE #WDOCH DFDOCH C MOVE #WHEAD DFHEAD C MOVE 'F' DFLOCK C Symb:Atrb XLATE(P) #SHTX1 DFHTX1 C Symb:Atrb XLATE(P) #SHTX2 DFHTX2 C Symb:Atrb XLATE(P) #SHTX3 DFHTX3 C Symb:Atrb XLATE(P) #SHTX4 DFHTX4 C Symb:Atrb XLATE(P) #SHTX5 DFHTX5 C Symb:Atrb XLATE(P) #SHTX6 DFHTX6 C Symb:Atrb XLATE(P) #SFTX1 DFFTX1 C Symb:Atrb XLATE(P) #SFTX2 DFFTX2 C Symb:Atrb XLATE(P) #SFTX3 DFFTX3 C EVAL DFADTE = *DATE C MOVE #@User DFAUSR C UPDATE DB1DFTH E004 C ENDIF C MOVE *on Reload E003 C ENDIF C LEAVE E002 C ENDSL E001 C ENDDO * C ENDSR ********************************************************************************************** * KEYWRD: Subset display by keyword(s) ********************************************************************************************** C KEYWRD BEGSR * C EXFMT WINDOW4 B001 C SELECT * F1/Help pressed S001 C WHEN *IN01 = *on C CALL 'QCMDEXC' 90 C PARM Ovrdb1 Cmdstr C PARM 60 Cmdlen * C CALL 'QCMDEXC' 90 C PARM Ovrdb2 Cmdstr C PARM 60 Cmdlen * Call the Helptext Viewer C CALL 'DBG010R4' 90 Trap errors C PARM PGM P#Pgm C CALL 'QCMDEXC' 90 C PARM Dltovr Cmdstr C PARM 40 Cmdlen * F12=Previous S001 C WHEN *IN12 = *on * S001 C OTHER * The first keyword is required to trigger subset processing B002 C IF KWORD1 <> *blanks C MOVE *on Subset C MOVE Text01 SUBTXT * Set *LDA to first keyword for F16 search in matching documents C IN LDA C EVAL %SUBST(LDA:503:10) = KWORD1 C OUT LDA * Set the length of each keyword entered C ' ' CHECKR KWORD1 #1 70 B003 C IF *IN70 = *off C EVAL #1 = 0 E003 C ENDIF * C ' ' CHECKR KWORD2 #2 70 B003 C IF *IN70 = *off C EVAL #2 = 0 E003 C ENDIF * C ' ' CHECKR KWORD3 #3 70 B003 C IF *IN70 = *off C EVAL #3 = 0 E003 C ENDIF * Load the workfile with document(s) that contain above keyword(s) C EXSR LOADWF * Otherwise cancel subset processing X002 C ELSE C MOVE *off Subset C EVAL SUBTXT = *blanks E002 C ENDIF C EVAL #Docd = *blanks C MOVE *on Reload E001 C ENDSL * C ENDSR ********************************************************************************************** * LOADWF: Load workfile with documents containing keyword(s) ********************************************************************************************** C LOADWF BEGSR * Start with the first document that contains this word C KWORD1 SETLL DBGDFTK2 * Clear out the workfile C CLOSE DBGOLD0W C CALL 'QCMDEXC' 90 C PARM Clrpfm Cmdstr C PARM 40 Cmdlen C OPEN DBGOLD0W * Remove messages from queue after display C CALL 'DBG045CL' 90 * Read all the entries for this word, including words that start with it C READ DBGDFTK2 83 * B001 C DOW *IN83 = *off C MOVE DFDOCD K#Docd C MOVE *off Rcdrqd * Look for a match B002 C IF %TRIM(KWORD1) = C %SUBST(DFWORD:1:%LEN(%TRIM(KWORD1))) C MOVE *on Rcdrqd X002 C ELSE C LEAVE E002 C ENDIF * If keyword two entered, it must exist on the same document as keyword 1 * to be selected for display B002 C IF KWORD2 <> *blanks C MOVE *off Rcdrqd C MOVE KWORD2 K#Word C Wrdky1 SETLL DBGDFTK1 C READ(N) DBGDFTK1 84 B003 C IF *IN84 = *off C AND DFDOCD = K#Docd * Look for a match B004 C IF %TRIM(KWORD2) = C %SUBST(DFWORD:1:%LEN(%TRIM(KWORD2))) C MOVE *on Rcdrqd E004 C ENDIF E003 C ENDIF E002 C ENDIF * If keyword three entered, it must exist on the same document as the * previous keywords to be selected for display B002 C IF KWORD3 <> *blanks C AND Rcdrqd = *on C MOVE *off Rcdrqd C MOVE KWORD3 K#Word C Wrdky1 SETLL DBGDFTK1 C READ(N) DBGDFTK1 84 B003 C IF *IN84 = *off C AND DFDOCD = K#Docd * Look for a match B004 C IF %TRIM(KWORD3) = C %SUBST(DFWORD:1:%LEN(%TRIM(KWORD3))) C MOVE *on Rcdrqd X004 C ELSE C LEAVE E004 C ENDIF E003 C ENDIF E002 C ENDIF * If this document holds all entered keyword(s), make sure it's on file B002 C IF Rcdrqd = *on C DFDOCD CHAIN DBGOLD0W 84 B003 C IF *IN84 = *off C UPDATE DB1OLDWF X003 C ELSE C WRITE DB1OLDWF E003 C ENDIF E002 C ENDIF * C READ DBGDFTK2 83 * E001 C ENDDO * C ENDSR ********************************************************************************************** * SNDMSG: Send Program Message ********************************************************************************************** C SNDMSG BEGSR * Use in-house utility (via system API 'QMHSNDPM') * Name of message file used. GSM0000 is the standard on the F70/35 C CALL 'DBG044R3' C PARM Msgid C PARM 'DBGMSGF' Msgfil C PARM '*LIBL' Msglib C PARM Msgdta C PARM Dtalen C PARM '*INFO' Msgtyp C PARM PGM Pgmq C PARM Pgmstk C PARM ' ' #Errid * C ENDSR ********************************************************************************************** </verbatim> -- Main.MartinRowe - 26 May 2005
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r1 - 26 May 2005 - 18:54:01 -
MartinRowe
DBG400
Log In
DBG400 Web
Index
Search
Changes
Notifications
Statistics
Site Map
Downloads
Webs
DBG400
Jamaro
Main
Sandbox
Sandtub
System
Send a link to this page
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback