WebDocs iSeries Sample Document Pointer Import RPG Program
From Support
The following program listing and file attachment contains a sample RPG program for importing document pointers into WebDocs iSeries Edition. This is a good way to test import documents into WebDocs.
HBNDDIR('QC2LE') DFTACTGRP(*NO)
H******************************************************************
H* *
H* PROGRAM: DOCIMP01R *
H* PURPOSE: This is a template example that shows how to *
H* import document indexes and their IFS file *
H* pointers into the Image Server/400 system. *
H* DATE: 03/28/2004 *
H* AUTHOR: RICHARD J. SCHOEN. *
H* MOD LEVEL: 1.00 *
H* *
H******************************************************************
FINPUTFILE UF E K DISK
FDOCS00 UF A E K DISK
FDOCVER00 UF A E K DISK
D*** check for IFS file existence
Daccess PR 10I 0 EXTPROC('access')
D filename * VALUE
D accessmode 10I 0 VALUE
*-------------------------------------------------------------
* StrExtParm - Extract parameter from delimited string
*-------------------------------------------------------------
D StrExtParm PR 32767A Varying
D 32767A Const
D Varying
D 32767A Const
D Varying
D 10I 0 Value
*-------------------------------------------------------------
* StrScanReplOne - Scan and Replace all Instances of String
*-------------------------------------------------------------
D StrScanReplOne PR 2048A Varying
D 2048A Const
D Varying
D 2048A Const
D Varying
D 2048A Const
D Varying
D KeyValAry S 200A Dim( 50 )
D InputPath S 255A VARYING
D outputpath S 255A VARYING
D TempIFSPAth S 512A
D IFSDestFile S 255A VARYING
D DateChar S 26A
D*****
D* Timestamp data area
D*****
D tstamp s z
D date s d datfmt(*iso)
D time s t timfmt(*iso)
D date1 s 8A
D ds
D timeres 12s 0
D timetime 6s 0 overlay(timeres:1)
D timedate 6s 0 overlay(timeres:7)
D*** File Existence Mode for access()
D F_OK S 10I 0 INZ(0)
D Null S 1A Inz(X'00')
C* ** For this example we set a default
C* ** input IFS folder and a default output folder
C EVAL INPUTPATH = '/RJSIMAGEDOCNFS2'
C EVAL OUTPUTPATH = '/RJSIMAGEDOCNFS2'
C Z-ADD 0 RTNCOUNT 9 0
C Z-ADD 0 EOF1 1 0
C Z-ADD 0 Found 1 0
C Z-ADD 0 COUNT 9 0
C DOW EOF1 = 0
C READ INPUTFILE 73
C 73 Z-ADD 1 EOF1
C* ** PROCESS IF NOT EOF
C IF EOF1 <> 1
* ** Concat IFSPreFIX from INPUTFILE to get IFS name
C EVAL IFSDestFile = StrScanReplOne(IFSPREFIX:
C %trimr(INPUTPATH):%trimr(OUTPUTPATH))
* ** Make sure IFS file exists
C Eval Found = 0
C Eval tempifspath = *blanks
C Eval tempifspath = IFSDESTFILE + null
C If access(%ADDR(tempifspath): F_OK) = 0
C Eval Found = 1
C Endif
* ** If IFS image found, write to Image Server DB
C IF FOUND=1
* ** Get new Image Server document key
C CALL 'DOCKEYC'
C PARM NEWKEY 100
* ** Write new document index record to DOCS00
C CLEAR DOCS00R
C Eval DOCID = %trim(newkey) SET STATUS TO READY
C Eval REVISION = 0 SET STATUS TO READY
C Eval TITLE = 'Test Document'
C EVAL DOCPATH = IFSDestFile
C Eval DOCFILE = IFSDestFile
C Eval FOLDER1 = 'TEST'
C Eval FOLDER2 = ''
C Eval FOLDER3 = ''
C Clear Cat1
C Clear Cat2
C Clear Cat3
C Eval KEYWORD1 = %trim(INPUTFIELD1)
C Eval KEYWORD2 = ''
C Eval KEYWORD3 = ''
C Eval KEYWORD4 = ''
C Eval KEYWORD5 = ''
C Eval KEYWORD6 = ''
C Eval KEYWORD7 = ''
C Eval KEYWORD8 = ''
C Eval KEYWORD9 = ''
C Eval KEYWORD10 = ''
C Eval DOCTYPE = ''
C Eval DOCTYPE2 = ' '
C TIME CHKDATE
C*** Clear EXPDATE
C Clear EXPACTION
C Clear EXPDEST
C Clear FTPPATH
C Clear FTPFILE
C Clear FTPSERVER
C*** Clear REVDATE
C Clear REVUSER
C Eval CHKUSER = 'CONVERT'
C Eval DCSPOOL = ''
C Eval DCUSERID = ''
C Eval DCUSRDTA = ''
C Clear DCSTATUS
C Eval DCPAGES = 0
C Eval DCCOPIES = 0
C Eval DCFORM = ''
C Clear DCPTY
C Eval DCSPNUM = ''
C Eval DCJOB = ''
C Eval DCJOBNBR = ''
C
C Clear DCDATE
C** Clear DCDDATE
C** Clear DCDTIME
C** Clear DCETIME
C Eval DCOUTQ = ''
C Eval DCOLIB = ''
C Clear DCPRTCTL
C Eval DCUSRDFN = ''
C Clear DCUSER1
C Clear DCUSER2
C Clear DCUSER3
C**** Z-ADD IFILESIZE DIFSSIZE
C Clear DVOLID
C Eval CHKOUTSTS = 'N'
C WRITE DOCS00R
* ** Write new version record
* ** if document key was not found
C CLEAR DOCV00R
C Eval VDOCID = %trim(newkey) SET STATUS TO READY
C Eval VREVISION = 0 SET STATUS TO READY
C Eval VCOMMENT = 'Initial Checkin'
C Eval VDOCPATH = IFSDestFile
C Eval VDOCFILE = IFSDestFile
C** Z-ADD IFILESIZE VIFSSIZE
C Eval VERDATE = DOCDATE
C Eval VERUSER = 'CONVERT'
C Clear VEXPDEST
C Clear VFTPPATH
C Clear VFTPFILE
C Clear VFTPSERVER
C Clear VDISKSTAT
C Clear VARCHSEL
C Clear VVOLID
C WRITE DOCV00R
* ** Set processed flag
C Z-ADD 1 PROCESSED
C UPDATE INPUTFILER
* ** Increment processed counter
C Eval Count = Count + 1
C* ** ENDIF IFS FOUND=1
C ENDIF
C* ** ENDIF EOF1
C ENDIF
C* ** ENDDO INPUTFILE
C ENDDO
C* ** Exit after check
C MOVE *ON *INLR
C RETURN
*---------------------------------------------------------------------
* Procedure Name: StrExtParm
* Desc : Procedure to Scan Data String and Extract the Selected
* field number from the delimited string.
* Parm 1: Input Data Record
* Parm 2: Delimiter
* Parm 3: Field number to extract
* Return value: New string after extract
*---------------------------------------------------------------------
P StrExtParm B Export
D PI 32767 Varying
D iaInput 32767 Const
D Varying
D iaDelim 32767 Const
D Varying
D iaParmNumber 10I 0 Value
D iAllDone S 5I 0
D iaExtractValue S 4096A Varying
D ilenDelim S 5I 0
D iFound S 5I 0
D iStartPos S 5I 0
D iCurParm S 5I 0
D iExtStart S 5I 0
D iExtEnd S 5I 0
D ilenInput S 5I 0
C*** Extract the selected parm value from within the specified string
C Eval iAllDone=0
C Eval iStartPos = 1
C Eval iCurParm = 0
C Eval ilenInput = %len(iaInput)
* ** Process until the selected parm number found
C Dow iAllDone = 0
* ** Find starting position for scan for search value
* ** in the current parm if we haven't already
* ** scanned all bytes in the string
C If iStartPos <= iLenInput
C Eval iFound=%scan(iaDelim: iaInput :
C iStartPos)
C Else
C Eval iAllDone = 1
C Endif
* ** If delimiter found, increment cur parm and
* ** start position of parm
C If iFound > 0
C and iAllDone <> 1
* ** Increment parm number
C Eval iCurParm = iCurParm + 1
* ** Calculate start/end offsets for current parm
C Eval iExtStart = iStartPos
C Eval iExtEnd = iFound
* ** Start next scan after delimiter for cur parm
C Eval iStartPos = iFound + 1
* ** If this is the parm we want, get it and exit
C If iCurParm = iaParmNumber
C Eval iaExtractValue = %subst(iaInput:
C iExtStart:
C (iExtEnd - iExtStart))
C Eval iAllDone = 1
C Endif
C Else
C* ** We didn't find selected parm number
C Eval iaExtractValue = '*ERROR*'
C Eval iAllDone = 1
C* ** ENDIF - If delimiter data found in line
C Endif
C Enddo
C* ** Return data value to caller
C RETURN iaExtractValue
P StrExtParm E
*---------------------------------------------------------------------
* Procedure Name: StrScanReplOne (Smaller strings)
* Desc : Procedure to Scan and Replace Single Occurrence of String
* Parm 1: Input Data Record
* Parm 2: String to Scan For
* Parm 3: String to Replace With
* Return value: New string after scan/replace
*---------------------------------------------------------------------
P StrScanReplOne B Export
D PI 2048 Varying
D iaInput 2048 Const
D Varying
D iaScanFor 2048 Const
D Varying
D iaReplWith 2048 Const
D Varying
D wkOutput S 2048 Varying
D iAllDone S 5I 0
D ilenScanFor S 5I 0
D iFound S 5I 0
C*** Scan and replace the selected string with the specified string
C Eval iAllDone=0
* ** Set working data record
C Eval wkOutput=iaInput
* ** Determine length of scan for string value
C Eval ilenScanFor=%len(%trim(iaScanFor))
* ** Process all occurrences of string in line
C Dow iAllDone = 0
* ** Find starting position for scan for search value
C Eval iFound=%scan(iaScanfor: wkOutput)
* ** Replace string value if found in original
C If iFound > 0
* ** Replace string value
C Eval wkOutput = %REPLACE(iaReplwith:
C wkOutput: iFound : ilenScanFor)
* ** Bail out after first replace to avoid endless
* ** loop caused if scan for and replace with
* ** are similar, thus causing an endless loop
* ** condition.
C Eval iAllDone = 1
C* ** Data not found. Exit loop
C Else
C* ** Bail out of scan/replace loop. We're done
C Eval iAllDone = 1
C* ** ENDIF - If data found in line
C Endif
C Enddo
C* ** Return data value to caller
C RETURN wkOutput
P StrScanReplOne E
