*=====================================================================
* RPG ILE MODULE CGIDEV2/READCSFL
*
* After compiling this RPG MODULE,
* create the related program with the following command:
*
* CRTPGM CGIDEV2/READCSFL MODULE(CGIDEV2/READCSFL CGIDEV2/QDECFMT) ACTGRP(READCSFL)
*
* To execute this program,
* enter the following in your WEB browser command line:
* http://.../cgidev2p/READCSFL.pgm
*
*=====================================================================
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
FITEMINV uf a e k disk usropn
F extfile('CGIDEV2/ITEMINV')
*=====================================================================
* Includes to be used in CGIs
*=====================================================================
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
/copy CGIDEV2/qrpglesrc,variables3
*=====================================================================
* Variables specific to this module
*=====================================================================
* Client input variables
D request s 10a
D prvitmcod s like(itmcod)
D prvitmdes s like(itmdes)
D prvitmprc s 10a
D prvitmqty s 7a
D newitmcod s like(itmcod)
D newitmdes s like(itmdes)
D newitmprc s 10a
D newitmqty s 9a
*
* Other variables
D decfmt s 1
D nbrlines s 10i 0
D i s 10i 0
D l s 10i 0
* External HTML
D extHtml s 2000 inz('/cgidev/html/readcsfl.txt')
* Indicators for GetHtmlIfsMult subprocedure
D IfsMultIndicators...
d ds
D NoErrors n
D NameTooLong n
D NotAccessible n
D NoFilesUsable n
D DupSections n
D FileIsEmpty n
* Fields required by CHKNBR subprocedure
D ChkNbrDs ds
D anyerrs n
D invalidchrs n
D multdecpts n
D multsigns n
D nonbrs n
D toobig n
D lessthan0 n
D maxdigits s 10i 0
D badNumSW s n
* Fields required by C2N2 subprocedure
D c2n2itmprc s 30p 9
D c2n2itmqty s 30p 9
*=====================================================================
* Main line
*=====================================================================
/copy CGIDEV2/qrpglesrc,prolog3
C eval request = zhbgetvarupper('request')
* Open file
C exsr OpenDbf
* Load external html
C eval IfsMultIndicators = getHtmlIfsMult(
C %trim(exthtml):'«as400»')
* Retrieve decimal format
C callb 'QDECFMT'
C parm decfmt
C callp updhtmlvar('qdecfmt':decfmt)
*
C select
C when request=' '
C exsr Case1
C when request='READC'
C exsr Case2
C endsl
*
C exsr Exit
*=====================================================================
* Display the subfile
*=====================================================================
C Case1 begsr
C callp wrtsection('top')
C eval itmcod=' '
C itmcod setll itmrcd
C read itmrcd
*
C dow not %eof
C update itmrcd
C callp updhtmlvar('itmcod':itmcod)
C callp updhtmlvar('itmdes':itmdes)
C callp updhtmlvar('itmprc':
C %trim(%editc(itmprc:'3')))
C callp updhtmlvar('itmqty':
C %trim(%editc(itmqty:'3')))
C callp wrtsection('tabrow')
C read itmrcd
C enddo
*
C callp wrtsection('newitem')
*
C endsr
*=====================================================================
* ReadChange the subfile, then re-display it
*=====================================================================
C Case2 begsr
* ReadChange the subfile
* 1- Get the number of subfile lines
C eval nbrlines = zhbGetVarCnt('newitmcod')
* 2- Process each subfile line
C IF nbrlines»0
C 1 do nbrlines i
C eval prvitmcod = zhbgetvar('prvitmcod':i)
C eval prvitmdes = zhbgetvar('prvitmdes':i)
C eval prvitmprc = zhbgetvar('prvitmprc':i)
C eval prvitmqty = zhbgetvar('prvitmqty':i)
C eval newitmcod = zhbgetvarupper('newitmcod':i)
C eval newitmdes = zhbgetvarupper('newitmdes':i)
C eval newitmprc = zhbgetvarupper('newitmprc':i)
C eval newitmqty = zhbgetvarupper('newitmqty':i)
C exsr AddUpd
C enddo
C ENDIF
* Re-display the subfile
C exsr Case1
*
C endsr
*=====================================================================
* Update the database file
*=====================================================================
C AddUpd begsr
* 1-Add a new record
C IF prvitmcod=' ' and
C prvitmdes=' ' and
C prvitmprc=' ' and
C prvitmqty=' ' and
C newitmcod«»' ' and
C newitmdes«»' ' and
C newitmprc«»' ' and
C newitmqty«»' '
C newitmcod chain itmrcd
C if not %found
C exsr wrkNumFlds
C iF badNumSw=*off
C eval itmcod = newitmcod
C eval itmdes = newitmdes
C eval itmprc = c2n2itmprc
C eval itmqty = c2n2itmqty
C write itmrcd
C endif
C elsE
C update itmrcd
C endiF
*
C ELSE
*
* 2-Update an existing record
C If prvitmcod«»newitmcod or
C prvitmdes«»newitmdes or
C prvitmprc«»newitmprc or
C prvitmqty«»newitmqty
C prvitmcod chain itmrcd
C iF %found
C exsr wrkNumFlds
C if badNumSw=*off
C eval itmcod = newitmcod
C eval itmdes = newitmdes
C eval itmprc = c2n2itmprc
C eval itmqty = c2n2itmqty
C endif
C update itmrcd
C endiF
C endIf
*
C ENDIF
*
C AddUpdX tag
C endsr
*=====================================================================
* Work with numeric input fields
*=====================================================================
C WrkNumFlds begsr
* Align right numeric input fields
C exsr AlignR
* Check numeric input fields
C exsr ChkNum
* Convert numeric input fields
C if badNumSw=*off
C exsr C2N2Cvt
C endif
C*
C endsr
*=====================================================================
* Align right numeric input fields,
* convert leading blanks to zeroes
*=====================================================================
C AlignR begsr
C ' ' checkr newitmprc l
C if l«%size(newitmprc)
C eval newitmprc=%subst(newitmprc:l+1:
C %size(newitmprc)-l) +
C %subst(newitmprc:1:l)
C endif
C ' ':'0' xlate newitmprc newitmprc
*
C ' ' checkr newitmqty l
C if l«%size(newitmqty)
C eval newitmqty=%subst(newitmqty:l+1:
C %size(newitmqty)-l) +
C %subst(newitmqty:1:l)
C endif
C ' ':'0' xlate newitmqty newitmqty
*
C endsr
*=====================================================================
* Check numeric input fields
*=====================================================================
C ChkNum begsr
C eval badNumSW=*off
* Check numeric inputs through subprocedure ChkNbr
C eval maxdigits=%size(newitmprc)
C eval ChkNbrDs=chkNbr(newitmprc:maxdigits)
C if anyerrs=*on
C eval badNumSw=*on
C endif
C eval maxdigits=%size(newitmqty)
C eval ChkNbrDs=chkNbr(newitmqty:maxdigits)
C if anyerrs=*on
C eval badNumSw=*on
C endif
*
C endsr
*=====================================================================
* Convert numeric input fields
*=====================================================================
C C2N2Cvt begsr
C eval c2n2itmprc=c2n2(newitmprc)
C eval c2n2itmqty=c2n2(newitmqty)
*
C endsr
*=====================================================================
* Override and open database files
*=====================================================================
/free
Begsr OpenDbf;
if request=' ';
if %open(ITEMINV);
close ITEMINV;
endif;
monitor;
rc = docmd('clrpfm cgidev2/ITEMINV');
on-error;
rc = -1;
endmon;
endif;
open ITEMINV;
Endsr;
/end-free
*=====================================================================
* Send response html and quit
*=====================================================================
C Exit begsr
C callp wrtsection('*fini')
C close ITEMINV
C return
C endsr
|
