今まで注文書を印刷出力していたプログラムがあったとします。
そのプログラムを使ってある取引先にはFAXで注文書を送信して
またある取引先にはメールで送信するという混在した処理を
行うこともできます。
このような送信を導入しても既存の発注プログラムを
なるべく変えずに利用する方法を紹介します。
_
この解説はFAXだけ出力する場合やメールだけで発注を
する場合に対しても参考になります。
まず従来の注文書を出力していたプログラムは
発注デーータを取引先別に読んで取引先が変わる都度に
FAXで注文するかそれともメールで発注するかの判断が必要です。
この識別は取引先、つまり具体的には仕入先マスターの区分によって
判断することができます。
もうひとつ処理を追加しなければならないのは
取引先別にスプールを区別して出力する必要があるので
スプールは最初から最後まで同じひとつにスプールになるのではなく
取引先別に個別に出力する必要があります。
従ってスプールはファイル仕様書ではユーザー・オープンとして
定義しておく必要があります。
0007.00 FQPRINT O F 132 PRINTER OFLIND(*INOF) USROPN 0008.00 F FORMLEN(66) 0009.00 F FORMOFL(62)
のように USROPN を指定してください。
USROPNを指定したファイルは暗黙的にシステムによって自動的にオープンされませんので
ユーザーがプログラムの中で明示的に OPEN 命令でオープンして CLOSE命令で閉じる必要が
あります。
次のサンプルは取引先によってFAXまたはメール送信を実行している例です。
仕入先マスターには 1=FAXという区分が登録されている取引先にはＦＡＸ送信して
それ以外はMAIL送信を行うプログラムです。
データが取引先別に変わる都度にスプールのオープン/クローズを繰り返していることに
注意してください。
[ コマンド: FAXMAIL ]
ソースはこちらから
0001.00 CMD PROMPT(' 注文書 FAX メール送信 ')
0002.00 PARM KWD(FROMSIR) TYPE(*CHAR) LEN(4) +
0003.00 PROMPT(' 仕入先 から ')
0004.00 PARM KWD(TOSIR) TYPE(*CHAR) LEN(4) +
0005.00 DFT(9999) PROMPT(' +
0006.00 まで ')
0007.00 PARM KWD(DATEFROM) TYPE(*DEC) LEN(8 0) +
0008.00 PROMPT(' 発注日 (YYMMDD) から ')
0009.00 PARM KWD(DATEEND) TYPE(*DEC) LEN(8 0) +
0010.00 DFT(99999999) PROMPT(' +
0011.00 (YYMMDD) まで ')
0012.00 PARM KWD(OUTPUT) TYPE(*CHAR) LEN(8) RSTD(*YES) +
0013.00 DFT(*PRINT) VALUES(* *PRINT *FAXMAIL) +
0014.00 PROMPT(' 出力 ')
0015.00 PARM KWD(LOG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
0016.00 DFT(*NO) VALUES(*YES *NO) PMTCTL(MAIL) +
0017.00 PROMPT(' ログ出力 ')
0018.00 MAIL: PMTCTL CTL(OUTPUT) COND((*EQ *MAIL))
[コンパイル]
CRTCMD CMD(QTROBJ/FAXMAIL) PGM(QTROBJ/FAXMAILCL) SRCFILE(QTRSRC/QCMDSRC) AUT(*ALL)
[ CLP: FAXMAILCL ]
ソースはこちらから
0001.00 PGM PARM(&SIRFROM &SIREND &DATEFROM &DATEEND +
0002.00 &OUTPUT &LOG)
0003.00 /*-------------------------------------------------------------------*/
0004.00 /* SNDHATCL : 注文書 FAX メール送信 */
0005.00 /* */
0006.00 /* 2023/03/31 作成 */
0007.00 /*-------------------------------------------------------------------*/
0008.00 DCL VAR(&SIRFROM) TYPE(*CHAR) LEN(4)
0009.00 DCL VAR(&SIREND) TYPE(*CHAR) LEN(4)
0010.00 DCL VAR(&DATEFROM) TYPE(*DEC) LEN(8 0)
0011.00 DCL VAR(&DATEEND) TYPE(*DEC) LEN(8 0)
0012.00 DCL VAR(&OUTPUT) TYPE(*CHAR) LEN(8)
0013.00 DCL VAR(&LOG) TYPE(*CHAR) LEN(4)
0014.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0015.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0016.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0019.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0020.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0021.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0022.00 VALUE('*ESCAPE ')
0023.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0024.00 VALUE(X'000074') /* 2 進数 */
0025.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0026.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0027.00 VALUE(X'00000000')
0028.00 DCL VAR(&DFTCCSID) TYPE(*DEC) LEN(5 0)
0029.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0030.00
0031.00 /*( 環境の取得 )*/
0032.00 RTVJOBA TYPE(&TYPE) DFTCCSID(&DFTCCSID)
0033.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0034.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0035.00 ENDDO /* バッチ */
0036.00 ELSE CMD(DO) /* 対話式 */
0037.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0038.00 ENDDO /* 対話式 */
0039.00
0040.00 /*( パラメータの検査 )*/
0041.00 CHGJOB CCSID(5035)
0042.00
0043.00 /*( プログラムの実行 )*/
0044.00 OVRDBF FILE(HATTUL1) TOFILE(QTRFIL/HATTUL1) +
0045.00 SECURE(*YES) OVRSCOPE(*JOB)
0046.00 CALL PGM(QTROBJ/FAXMAIL) PARM(&SIRFROM &SIREND +
0047.00 &DATEFROM &DATEEND &OUTPUT &LOG)
0048.00 DLTOVR FILE(HATTUL1) LVL(*JOB)
0049.00 CHGJOB CCSID(&DFTCCSID)
0050.00 RETURN
0051.00
0052.00 APIERR:
0053.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0054.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0055.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0056.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0057.00 GOTO SNDMSG
0058.00
0059.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0060.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0061.00 SNDMSGFLIB(&MSGFLIB)
0062.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0063.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0064.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0065.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0066.00 ENDDO
0067.00 ELSE CMD(DO)
0068.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0069.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0070.00 MSGTYPE(&MSGTYPE)
0071.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0072.00 ENDDO
0073.00 ENDPGM
[コンパイル]
CRTCLPGM PGM(QTROBJ/FAXMAILCL) SRCFILE(QTRSRC/QCLSRC) OPTION(*SRCDBG) AUT(*ALL)
_
[ RPG : FAXMAIL ]
ソースはこちらから
0001.00 H DFTNAME(FAXMAIL) DATEDIT(*YMD/) BNDDIR('QC2LE')
0002.00 F********** 注文書 FAX メール送信 **************************************
0003.00 FHATTUL1 IF E K DISK
0004.00 FSIREMT IF E K DISK
0005.00 FBUHINM IF E K DISK
0006.00 FMAILADR IF E K DISK EXTFILE('QUSRTEMP/MAILADR')
0007.00 FQPRINT O F 132 PRINTER OFLIND(*INOF) USROPN
0008.00 F FORMLEN(66)
0009.00 F FORMOFL(62)
0010.00 F**********************************************************************
0011.00
0012.00 * CRTBNDRPG PGM(QTROBJ/FAXMAIL) SRCFILE(QTRSRC/QRPGLESRC)
0013.00 * DFTACTGRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
0014.00
0015.00 *-------------------------------------------------------------------*
0016.00 * 2023/03/31 : 作成
0017.00 *-------------------------------------------------------------------*
0018.00 *( 作業変数 )
0019.00 D AR S 1A DIM(256)
0020.00 D CMD S 1024A
0021.00 D N S 4S 0
0022.00 D TRUE S 1A DIM(256)
0023.00 D TRUE# S 4B 0 INZ(0)
0024.00 D FALSE# S 4B 0 INZ(-1)
0025.00 D QUOT C CONST(X'7D')
0026.00 D OE C CONST(X'0E')
0027.00 D OF C CONST(X'0F')
0028.00 D NULL C CONST(X'00')
0029.00
0030.00 D HDR S 32 DIM(1) CTDATA PERRCD(1) 見出し
0031.00 D LIN S 1 DIM(132)
0032.00
0033.00 D SYSTEM PR 10I 0 EXTPROC('system')
0034.00 D CMD * VALUE OPTIONS(*STRING)
0035.00
0036.00 C*-------------------------------------------------------------------------+
0037.00 C *ENTRY PLIST |
0038.00 C PARM FROMSIR 4 |
0039.00 C PARM TOSIR 4 |
0040.00 C PARM DATEFROM 8 0 |
0041.00 C PARM DATEEND 8 0 |
0042.00 C PARM OUTPUT_ 8 |
0043.00 C PARM LOG_ 4 |
0044.00 C*-------------------------------------------------------------------------+
0045.00 C*----------------------------------------------------+
0046.00 C SETKEY KLIST
0047.00 C KFLD HTSRCD
0048.00 C KFLD HTDATE
0049.00 C KFLD HTHTNO
0050.00 C KFLD HTGYO
0051.00 C*----------------------------------------------------+
0052.00 C MOVEA *ALL'-' LIN
0053.00 C MOVEL FROMSIR HTSRCD
0054.00 C MOVEL DATEFROM HTDATE
0055.00 C MOVE *LOVAL HTHTNO
0056.00 C MOVE *LOVAL HTGYO
0057.00 C SETKEY SETLL HATTUL1
0058.00 C DO *HIVAL DO-*HIVAL
0059.00 C SETOFF 50
0060.00 C READ HATTUL1 50
0061.00 C 50 LEAVE
0062.00 C SETKEY SETLL HATTUL1
0063.00 C*----------------------------------------------------+
0064.00 C EQLKEY KLIST
0065.00 C KFLD HTSRCD
0066.00 C KFLD HTDATE
0067.00 C*----------------------------------------------------+
0068.00 C EXSR OVRPRTF
0069.00 C OPEN QPRINT 90
0070.00 C *IN90 IFEQ *OFF QPRINT
0071.00 C DO *HIVAL DO-*HIVAL-EQL
0072.00 C SETOFF 50
0073.00 C EQLKEY READE HATTUL1 50
0074.00 C 50 LEAVE
0075.00 C SETOFF 99
0076.00 C HTSRCD CHAIN SIREMT 99
0077.00 C SETOFF 99
0078.00 C HTBHCD CHAIN BUHINM 99
0079.00 C MOVEL(P) HTSRCD USER
0080.00 C USER CHAIN MAILADR 99
0081.00 C*( 明細印刷 )
0082.00 C*-------------------------------------------------------------------------+
0083.00 C SETON 42 |
0084.00 C EXSR OUTPUT |
0085.00 C*-------------------------------------------------------------------------+
0086.00 C ADD 1 KENSU 7 0 件数
0087.00 C ENDDO DO-*HIVAL-EQL
0088.00 C CLOSE QPRINT
0089.00 *
0090.00 C SELECT SELECT
0091.00 C WHEN OUTPUT_ = '* '
0092.00 C EXSR DSPLY
0093.00 C WHEN OUTPUT_ = '*PRINT '
0094.00 C EXSR PRINT
0095.00 C WHEN OUTPUT_ = '*FAXMAIL'
0096.00 C IF SRFORD = '1' FAX 注文
0097.00 C EXSR SNDFAX
0098.00 C ELSE
0099.00 C EXSR SNDMAIL
0100.00 C ENDIF
0101.00 C ENDSL SELECT
0102.00 C EXSR DLTOVR
0103.00 *
0104.00 C ENDIF QPRINT
0105.00 *
0106.00 C ENDDO DO-*HIVAL
0107.00 C SETON LR
0108.00 C RETURN
0109.00 C******************************************************
0110.00 C OVRPRTF BEGSR
0111.00 C******************************************************
0112.00 C IF OUTPUT_ = '* ' OR OVRPRTF
0113.00 C OUTPUT_ = '*MAIL '
0114.00 /FREE
0115.00 SYSTEM('OVRPRTF FILE(QPRINT) HOLD(*YES) USRDTA('' 注文書 '') -
0116.00 SECURE(*YES) OVRSCOPE(*JOB)');
0117.00 /END-FREE
0118.00 C ELSE OVRPRTF
0119.00 /FREE
0120.00 SYSTEM('OVRPRTF FILE(QPRINT) USRDTA('' 注文書 '') -
0121.00 SECURE(*YES) OVRSCOPE(*JOB)');
0122.00 /END-FREE
0123.00 C ENDIF OVRPRTF
0124.00 C ENDSR
0125.00 C******************************************************
0126.00 C DLTOVR BEGSR
0127.00 C******************************************************
0128.00 /FREE
0129.00 SYSTEM('DLTOVR FILE(QPRINT) LVL(*JOB)');
0130.00 IF OUTPUT_ = '*';
0131.00 SYSTEM('DLTSPLF FILE(QPRINT) SPLNBR(*LAST)');
0132.00 ENDIF;
0133.00 /END-FREE
0134.00 C ENDSR
0135.00 C******************************************************
0136.00 C DSPLY BEGSR
0137.00 C******************************************************
0138.00 /FREE
0139.00 SYSTEM('DSPSPLF FILE(QPRINT) SPLNBR(*LAST)');
0140.00 /END-FREE
0141.00 C ENDSR
0142.00 C******************************************************
0143.00 C PRINT BEGSR
0144.00 C******************************************************
0145.00 C ENDSR
0146.00 C******************************************************
0147.00 C SNDFAX BEGSR
0148.00 C******************************************************
0149.00 /FREE
0150.00 CMD = 'SPOOLWTR/CVTSPLF SPLF(QPRINT) JOB(*) SPLNO(*LAST) ' +
0151.00 ' OUTPUT(*PDF) ' +
0152.00 'OPTION(*FAX) RECIPIENT((' + %TRIMR(SRFAX) + ' ''' +
0153.00 %TRIMR(SRNMJ) + ''')) ' +
0154.00 ' FROM(0669938746) FAX_SUBJ('' 注文書 '')' +
0155.00 ' FAXFROM('' 株式会社オフィスクアトロ '')' +
0156.00 ' COVERPAGE(*NO)';
0157.00 SYSTEM(CMD);
0158.00 /END-FREE
0159.00 C ENDSR
0160.00 C******************************************************
0161.00 C SNDMAIL BEGSR
0162.00 C******************************************************
0163.00 /FREE
0164.00 CMD = 'SPOOLWTR/CVTSPLF SPLF(QPRINT) JOB(*) SPLNO(*LAST) ' +
0165.00 ' OUTPUT(*PDF) ' +
0166.00 'OPTION(*MAIL) FROMADR(info@officequattro.com) TOADDR(' +
0167.00 %TRIMR(ADDR) +
0168.00 ') SUBJECT('' 注文書 '') ADDFILE(*SPLF) ' +
0169.00 ' SMTPLOG(' + %TRIMR(LOG_) + ') ' +
0170.00 ' SMTPSERVER(*FROMADR) SMTPPORT(25)';
0171.00 SYSTEM(CMD);
0172.00 /END-FREE
0173.00 C ENDSR
0174.00 C******************************************************
0175.00 C OUTPUT BEGSR
0176.00 C******************************************************
0177.00 C N40 SETON 4041
0178.00 C EXCEPT
0179.00 C OF SETOFF 40OF
0180.00 C SETOFF 414243
0181.00 C SETOFF 444546
0182.00 C SETOFF 474849
0183.00 C ENDSR
0184.00 OQPRINT E 41 2 06
0185.00 O UDATE Y 8
0186.00 O 14 ' 作成 '
0187.00 O HDR(1) 82
0188.00 O 128 'PAGE.'
0189.00 O PAGE Z 131
0190.00 O E 41 1
0191.00 O HTSRCD 4
0192.00 O SRNMJ 38
0193.00 O 42 ' 様 '
0194.00 O E 41 1
0195.00 O LIN 132
0196.00 O E 41 1
0197.00 O 8 ' コード '
0198.00 O 20 ' 品 名 '
0199.00 O 42 ' 単価 '
0200.00 O 60 ' 発注数 '
0201.00 O 80 ' 金額 '
0202.00 O E 41 1
0203.00 O LIN 132
0204.00 O E 42 2
0205.00 O HTBHCD 12
0206.00 O BHNAME 33
0207.00 O HTTANK J 44
0208.00 O HTSUR J 60
0209.00 O HTKING J 80
0210.00 DR
0210.00 ** HDR
0211.00 注文書
[コンパイル]
CRTBNDRPG PGM(QTROBJ/FAXMAIL) SRCFILE(QTRSRC/QRPGLESRC) DFTACTGRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
[解説]
二重LOOP構造で処理している。
まず
0053.00 C MOVEL FROMSIR HTSRCD 0054.00 C MOVEL DATEFROM HTDATE 0055.00 C MOVE *LOVAL HTHTNO 0056.00 C MOVE *LOVAL HTGYO 0057.00 C SETKEY SETLL HATTUL1 0058.00 C DO *HIVAL DO-*HIVAL 0059.00 C SETOFF 50 0060.00 C READ HATTUL1 50 0061.00 C 50 LEAVE : : 0105.00 * 0106.00 C ENDDO DO-*HIVAL
で全体の HATTUL1 を読むのだが
最初に見つかった 取引先に対して
0068.00 C EXSR OVRPRTF 0069.00 C OPEN QPRINT 90 0070.00 C *IN90 IFEQ *OFF QPRINT 0071.00 C DO *HIVAL DO-*HIVAL-EQL 0072.00 C SETOFF 50 0073.00 C EQLKEY READE HATTUL1 50 0074.00 C 50 LEAVE : 0087.00 C ENDDO DO-*HIVAL-EQL 0088.00 C CLOSE QPRINT
のようにして同一の取引先だけをまとめて読んで OPEN QPRINT ～ CLOSE QPRINT によって
スプールを区切って出力している。
スプールが取引先別に出力されたら
0090.00 C SELECT SELECT 0091.00 C WHEN OUTPUT_ = '* ' 0092.00 C EXSR DSPLY 0093.00 C WHEN OUTPUT_ = '*PRINT ' 0094.00 C EXSR PRINT 0095.00 C WHEN OUTPUT_ = '*FAXMAIL' 0096.00 C IF SRFORD = '1' FAX 注文 0097.00 C EXSR SNDFAX 0098.00 C ELSE 0099.00 C EXSR SNDMAIL 0100.00 C ENDIF 0101.00 C ENDSL SELECT 0102.00 C EXSR DLTOVR
で、FAX, メール送信、または印刷、表示の処理に分岐している。
このような構造化された二重LOOPの処理は一般的なRPGのテクニックとしても参考になるはずである。
_