H DFTNAME(PGM201) DATEDIT(*YMD/) F********** 受注の入力 ****************************************** FPGM201FM CF E WORKSTN F SFILE(SFREC01:RRN1) F INFDS(INFDS) FJUCHU UF A E K DISK FTOKMAS IF E K DISK FSHOHIN IF E K DISK FSHZAIKO IF E K DISK FTANTO IF E K DISK F***************************************************************** * CRTBNDRPG QTROBJ/PGM201 SRCFILE(QTRSRC/QRPGLESRC) * DFTACTGRP(*NO) ACTGRP(*NEW) AUT(*ALL) D AR S 1 DIM(80) D SAVDTA S 1 DIM(1024) SAVE-ﾃﾞｰﾀ D* D* -( ｻﾌﾞ･ﾌｧｲﾙ の ﾌｧｲﾙ 情報 )- D* D* SAVE-RESTORE のための ﾌｧｲﾙ の DATA-STRUCTURE D* 読み取り ﾌｧｲﾙ の FORMAT を外部 DS として READ D SAVEDS E DS EXTNAME(JUCHU) D DSPDTA 1 1024 D DIM(1024) 入力 ﾃﾞｰﾀ D INFDS DS D NUM_ROWS 152 153B 0 D NUM_COLS 154 155B 0 D NUM_RCDS 156 159I 0 D*( ｶｰｿﾙ の行と桁の取り込み ) D LINE 370 371B 0 D* TOPRRN: 今表示している ｻﾌﾞ･ﾌｧｲﾙ の先頭の RRN D TOPRRN 378 379B 0 D* BRRN : ｻﾌﾞﾌｧｲﾙ の ﾚｺｰﾄﾞNO ( 2 進数 ) D BRRN 376 377B 0 D*( WORK 日付 YYMMDD ﾃﾞｰﾀ 構造 ) D DATEDS DS D SRY 1 2 0 D SRYMD 1 8 0 D YYMMDD 3 8 0 D YYMM 3 6 0 D MMDD 5 8 0 D YY 3 4 0 D MM 5 6 0 D DD 7 8 0 D*( 在庫数の配列 ) D DS D DDS001 E DS EXTNAME(TOKMAS) D DDS002 E DS EXTNAME(SHOHIN) D PNLOBJ DS D GRP 1 10 D GRPLIB 11 20 D* ＬＩＢ名付きＰＧＭ名 * D JHCOD C CONST('JHCODE ') D ANS005 C CONST('QTROBJ/POP005') D WEBFAC C CONST('ASNET.COM/WEBFACE') D PGM101 C CONST('QTROBJ/PGM101') D MSG01 C CONST(' 商品コード ') D MSG02 C CONST(' の誤りです。 ') C* C*( 初期画面 ) C*----------------------------------------------------+ C START TAG | C EXFMT DSPHEAD | C*----------------------------------------------------+ C SETOFF 99 C*( CF03 )- 終了 C *IN03 IFEQ *ON CF03 C SETON LR C LR EXSR LRRTN C LR RETURN C GOTO START C END CF03 C*( CF05 )- 得意先マスターの登録 C *IN05 IFEQ *ON CF05 C CALL PGM101 C GOTO START C END CF03 C*( 実行キー ) C* : ＫＥＹをファイルにセット C*----------------------------------------------------+ C SETKEY KLIST | C KFLD JUCNO | C KFLD JUGYO | C*----------------------------------------------------+ C MOVE *ZEROS JUGYO C EXSR SFLCLR C SETKEY SETLL JUCHU C* : ファイルの読み取り C MOVE ' 入力 ' DSPMOD 6 C Z-ADD 1 TOPRRN C EXSR READ C Z-ADD 1 DSPREC C*( サブ・ファイルの表示 ) C*----------------------------------------------------+ C DSPLY TAG | C WRITE DSPEND01 | C SETON 4142 |SFL-DSPLY C EXFMT SFCTL01 | C SETOFF 4142 | C*----------------------------------------------------+ C SETOFF 99 C*( CF03 )- 終了 C *IN03 IFEQ *ON CF03 C SETON LR C LR EXSR LRRTN C LR RETURN C GOTO DSPLY C END CF03 C*( CF04 )- プロンプト C *IN04 IFEQ *ON CF04 C FLD IFEQ JHCOD C CSRP ANDGT *ZEROS C EXSR PROMPT C 99 GOTO DSPLY C ELSE C SETON 6799 ERR C GOTO DSPLY C END C END CF04 C* C*( CF12 )- 前画面 C *IN12 IFEQ *ON CF12 C SETOFF 12 C EXSR SFLDLT C EXSR CLEAR C GOTO START C END CF12 C* | C*( ROLL UP )- 次ページ C *IN14 IFEQ *ON ROLLUP C EXSR ROLLUP C GOTO DSPLY C END ROLLUP C*-( ROLL DOWN )- 前ページ C *IN15 IFEQ *ON ROLLDOWN C Z-ADD 1 DSPREC C SETON 6299 ERRMSG C GOTO DSPLY C END ROLLDOWN C* | C TOPRRN IFNE *ZEROS C Z-ADD TOPRRN DSPREC C END C* : 見出し画面のチエック C N23 EXSR MIDCHK C 99 GOTO DSPLY C* : 見出し項目のＳＡＶＥ C MOVE JUCNO MIB001 C *LIKE DEFINE JUCNO MIB001 C MOVE JUTKCD MIB002 C *LIKE DEFINE JUTKCD MIB002 C MOVE JUDATE MIB003 C *LIKE DEFINE JUDATE MIB003 C MOVE JUNOKI MIB004 C *LIKE DEFINE JUNOKI MIB004 C MOVE TKNAME MIB005 C *LIKE DEFINE TKNAME MIB005 C MOVE JUSHOR MIB006 C *LIKE DEFINE JUSHOR MIB006 C MOVE JSNAME MIB007 C *LIKE DEFINE JSNAME MIB007 C* : 明細画面のチエック C 1 DO *HIVAL RRN1 RRN1=1-*HIVAL C SETOFF 50 C*( 実行キー ) C N10 CANN23 READC SFREC01 50 C* C*( CF10 )- 更新 C*( CF23 )- 削除 C 10 COR 23RRN1 CHAIN SFREC01 50 C* C 50 GOTO RECEND C* : ﾌﾞﾗﾝｸ ｷｰ 入力の ｵﾐｯﾄ C JHCODE IFEQ *BLANKS C JUKING ANDEQ *ZEROS C GOTO UPDBPS C END C Z-ADD BRRN DSPREC C MOVE MIB001 JUCNO C MOVE MIB002 JUTKCD C MOVE MIB003 JUDATE C MOVE MIB004 JUNOKI C MOVE MIB005 TKNAME C MOVE MIB006 JUSHOR C MOVE MIB006 JSNAME C N23 EXSR MIDCHK C* | C*---------------------+ C* 入力明細行のチエック C*---------------------+ C MOVEL GYO FLD1 1 C FLD1 IFNE 'D' 削除 ? C *IN23 ANDNE '1' C MOVE RRN1 DSPREC 4 0 表示 RRN C EXSR CHECK C 99 GOTO SFLWRT C END C* | C*---------------------+ C* データ・ベース更新 C*---------------------+ C* | C *IN10 IFEQ *ON F10,F23 C *IN23 OREQ *ON C*----------------------------------------------------+ C TRNKEY KLIST | C KFLD JUCNO | C KFLD JUGYO | C*----------------------------------------------------+ C* : 更新キーを生成 C* C MOVE DSPDTA SAVDTA C* : データ・ベース検索 C EXSR CLEAR C SETOFF 90 C TRNKEY CHAIN JUCHU 90 C 90 GOTO ADDCHG C* | C* : 変更 / 削除 C MOVEL GYO FLD1 1 C FLD1 CABEQ 'D' TRNUPD 削除 ? C 23 GOTO TRNUPD C* | C* : 追加 / 変更 C ADDCHG TAG C MOVE SAVDTA DSPDTA C MOVE MIB001 JUCNO C MOVE MIB002 JUTKCD C MOVE MIB003 JUDATE C MOVE MIB004 JUNOKI C MOVE MIB005 TKNAME C MOVE MIB006 JUSHOR C MOVE MIB006 JSNAME C* | C TRNUPD TAG C MOVEL GYO FLD1 1 C FLD1 COMP 'D' 50 C 23 SETON 50 C* : データ・ベースへ追加・更新 C*----------------------------------------------------+ C 90 CANN50 WRITE JUCHUR | ADD C N90 CANN50 UPDATE JUCHUR | CHG C N90 CAN 50 DELETE JUCHUR | DLT C*----------------------------------------------------+ C N50 MOVE BRRN GYO C 90 ADD 1 ADDREC 5 0 C N90 CANN50 ADD 1 CHGREC 5 0 C N90 CAN 50 ADD 1 DLTREC 5 0 C END F10,F23 C* | C*---------------------+ C* サブ・ファイル更新 C*---------------------+ C SFLWRT TAG C MOVE TOPRRN TOPSAV C*----------------------------------------------------+ C UPDATE SFREC01 | C*----------------------------------------------------+ C Z-ADD BRRN DSPREC C MOVE TOPSAV TOPRRN C UPDBPS TAG C 99 GOTO DSPLY エラー C END RRN1=1-*HIVAL C* : 実行キーの終了 C RECEND TAG C* : コマンド部のチエック ( DSPEND01 C N23 EXSR CMDCHK C 99 GOTO DSPLY C* C *IN10 IFEQ *ON C *IN23 OREQ *ON C GOTO START C END C GOTO DSPLY C* C END TAG C****************************************************** C *INZSR BEGSR C****************************************************** C* 初期 ｻｲｸﾙ のみの実行 C *LIKE DEFINE TOPRRN TOPSAV C CLEAR SAVEDS C MOVE *ZEROS JUDATE C MOVE *ZEROS JUNOKI C CLEAR DATEDS C MOVE 910101 DATE 6 0 C*( U8 = HTML インターフェースで実行中 ) C U8 SETON 08 C N08NUM_COLS COMP 132 08 C*( ｻﾌﾞﾌｧｲﾙ END-FLAG を ON にする ) C SETON 45 C SETON 2310 C SETOFF 2310 C N08 MOVE 10 GYOSU 2 0 行数 C 08 MOVE 12 GYOSU 行数 C*( DS の数字 ﾌｨｰﾙﾄﾞ の ｸﾘﾔｰ ) C CLEAR SFREC01 C MOVE 09 STRGYO 2 0 開始行Y C Z-ADD UDATE JUDATE 初期値 C Z-ADD 1 JUCNO C Z-ADD 0 CSRP C INZEND ENDSR C****************************************************** C MIDCHK BEGSR C****************************************************** C*( 見出しチエック ) C*----------------------------------------------------* C*( JUTKCD : 得意先コード :( CHAIN ファイル ) C*----------------------------------------------------* C MOVE *BLANKS TKNMJ C SETOFF 99 C JUTKCD CHAIN TOKMAS 99 C 99 SETON 63 99 ERRMSG C 99 GOTO MIDEND C MOVEL TKNMJ TKNAME C* C*----------------------------------------------------* C*( JUDATE : 受注日 :( DATCHK 日付 ) C*----------------------------------------------------* C JUDATE IFEQ *ZEROS 省略値 C MOVEL UDATE JUDATE C END 省略値 C* C JUDATE IFNE *ZEROS IF- C MOVE JUDATE DATE 6 0 C EXSR DATCHK C END ENDRTN C 99 SETON 64 ERRMSG C 99 GOTO MIDEND GOTO XXX C JUNOKI IFNE *ZEROS JUNOKI= C*----------------------------------------------------* C*( JUNOKI : 納期 :( DATCHK 日付 ) C*----------------------------------------------------* C JUNOKI IFNE *ZEROS IF- C MOVE JUNOKI DATE 6 0 C EXSR DATCHK C END ENDRTN C 99 SETON 65 ERRMSG C 99 GOTO MIDEND GOTO XXX C END C*----------------------------------------------------* C*( JUKBN : 受注区分 C*----------------------------------------------------* C MOVE *BLANKS JUNAME C JUKBN IFNE *BLANKS C JUKBN IFEQ '01' C MOVE ' 売上 ' JUNAME C END C JUKBN IFEQ '02' C MOVE ' 返品 ' JUNAME C END C END C*----------------------------------------------------* C*( JUSHOR : 処理区分 C*----------------------------------------------------* C MOVE *BLANKS JSNAME C JUSHOR IFNE *BLANKS C JUSHOR IFEQ '01' C MOVE ' 通常 ' JSNAME C END C JUSHOR IFEQ '02' C MOVE ' 来勘 ' JSNAME C END C END C*----------------------------------------------------* C*( JUTANT : 担当者コード :( CHAIN ファイル ) C*----------------------------------------------------* C MOVE *BLANKS TTNAM C SETOFF 99 C JUTANT CHAIN TANTO 99 C 99 SETON 63 99 ERRMSG C 99 GOTO MIDEND C MIDEND ENDSR C****************************************************** C READ BEGSR C****************************************************** C*( データ・ベースの検索 ) C*----------------------------------------------------+ C EQLKEY KLIST | C KFLD JUCNO | C*----------------------------------------------------+ C SETON 51 C SETOFF 71 C RTNRED TAG C* C TOPRRN ADD GYOSU ENDRRN 4 0 C SUB 1 ENDRRN C* C Z-ADD TOPRRN DSPREC C TOPRRN DO ENDRRN RRN1 4 0 READ C SETOFF 50 C EQLKEY READE JUCHU 50 C *IN50 IFEQ *ON EOF C SETOFF 1129 C CLEAR SFREC01 C U8 SETON 08 C N08NUM_COLS COMP 132 08 C Z-ADD 0 SZZSU C ELSE EOF C MOVE ' 変更 ' DSPMOD C U8 SETON 08 C N08NUM_COLS COMP 132 08 C*( CHECK : READ した ﾚｺｰﾄﾞ の ﾁｴｯｸ ) C 51 EXSR MIDCHK C EXSR CHECK C END EOF C*( 行 NO に入れる ) C MOVE RRN1 GYO C MOVE TOPRRN TOPSAV C*( ｻﾌﾞﾌｧｲﾙ へ更新 ) C*----------------------------------------------------+ C WRITE SFREC01 | C*----------------------------------------------------+ C 51 MOVE RRN1 DSPREC C 51 SETOFF 51 C Z-ADD RRN1 LSTRRN 4 0 C MOVE TOPSAV TOPRRN C END READ C REDEND TAG C *IN11 IFEQ *ON C ENDRRN ADD 1 TOPRRN C GOTO RTNRED C END C ENDSR C****************************************************** C CHECK BEGSR C****************************************************** C*( 明細チエック ) C MOVE GYO JUGYO C*----------------------------------------------------* C*( JHCODE : 商品 ｺｰﾄﾞ :( CHAIN ファイル ) C*----------------------------------------------------* C CLEAR DDS002 外部 DS C SETOFF 99 C JHCODE CHAIN SHOHIN 99 C *IN99 IFEQ *ON C SETON 66 99 ERRMSG C MSG01 CAT(P) JHCODE:0 MSGDTA C CAT MSG02:0 MSGDTA C GOTO CHKEND C ENDIF C* C JUTANK IFEQ *ZEROS JUTANK= C Z-ADD SHTANK JUTANK C END C JUSUR MULT JUTANK JUKING C*----------------------------------------------------* C* SHZAIKO : 在庫マスターより在庫数を取得 C* 在庫数は HTML にのみ表示されます C*----------------------------------------------------* C Z-ADD 0 SZZSU C SETOFF 99 C JHCODE CHAIN SHZAIKO 99 C SETOFF 99 C Z-ADD SZZSU ZKSU C CHKEND ENDSR C****************************************************** C CMDCHK BEGSR C****************************************************** C* : コマンド部のチエック ( DSPEND01 C READ DSPEND01 50 C 50 GOTO CMDEND C CMDEND ENDSR C****************************************************** C SFLCLR BEGSR C****************************************************** C*( ｻﾌﾞﾌｧｲﾙ の ｸﾘﾔｰ ) C*----------------------------------------------------+ C SETON 44 | C WRITE SFCTL01 | C SETOFF 44 | C*----------------------------------------------------+ C ENDSR C****************************************************** C SFLDLT BEGSR C****************************************************** C*( ｻﾌﾞﾌｧｲﾙ の削除 ) C*----------------------------------------------------+ C SETON 46 | C WRITE SFCTL01 | C SETOFF 46 | C*----------------------------------------------------+ C ENDSR C****************************************************** C INZVAR BEGSR C****************************************************** C*( 初期値 ) C Z-ADD UDATE JUDATE 初期値 C ENDSR C****************************************************** C ROLLUP BEGSR C****************************************************** C SETOFF 45 C ENDRRN ADD 1 TOPRRN C EXSR READ C SETON 45 C UPEND ENDSR C****************************************************** C CLEAR BEGSR C****************************************************** C *NOKEY CLEAR JUCHUR C EXSR INZVAR 初期値 C ENDSR C***************************************************** C LRRTN BEGSR C***************************************************** C*( 終了画面 ) C ADDREC IFGT *ZEROS C CHGREC ORGT *ZEROS C DLTREC ORGT *ZEROS C MOVE 'Y' ANS 1 C*----------------------------------------------------+ C EXFMT ENDOPT | C*----------------------------------------------------+ C SETOFF 99 C*( CF12 )- 前画面 C *IN12 IFEQ *ON CF12 C SETOFF 12LR C GOTO LREND C END CF12 C*( 実行キー ) C ANS IFEQ 'N' C SETOFF LR C GOTO LREND C END C END C* C LREND ENDSR C****************************************************** C DATCHK BEGSR C****************************************************** C*( 日付 ﾁｴｯｸ ｻﾌﾞ･ﾙｰﾁﾝ ) FOR YY/MM/DD C MOVE *IN51 IN51 1 C MOVE *IN52 IN52 1 C DATE MULT .0001 #YEAR 2 0 99 C** SUB 88 #YEAR 平成 C N99DATE MULT .01 #MONTH 2 0 99 C N99 Z-ADD DATE #DAY 2 0 99 C N99#MONTH COMP 12 99 C N99#YEAR MULT .25 #CHKLY 1 1 50 C N99#MONTH COMP 2 51 C N99#MONTH MULT(H) 1.07 #MONTH C N99#MONTH DIV 2 #CHKLY 52 C N99 CANN51 CAN 52#DAY COMP 30 99 C N99 CANN51 CANN52#DAY COMP 31 99 C N99 CAN 51 CANN50#DAY COMP 28 99 C N99 CAN 51 CAN 50#DAY COMP 29 99 C MOVE IN51 *IN51 C MOVE IN52 *IN52 C DATEND ENDSR C****************************************************** C PROMPT BEGSR C****************************************************** C EXSR CURSOR C EXSR LINCHK C 99 GOTO DSPLY C*( ポップ・アップ・ウインドウ・パネルの呼出し ) C*----------------------------------------------------+ C CALL ANS005 |ｳｨﾝﾄﾞｳ 表示 C PARM SEL001 10 | C*----------------------------------------------------+ C*( 選択結果を更新 ) C MOVEL SEL001 JHCODE C SEL001 IFNE *BLANKS C MOVE *ZEROS JUTANK C MOVE *ZEROS JUSUR C MOVE *ZEROS JUKING C EXSR CHECK C SETON 71 C*----------------------------------------------------+ C UPDATE SFREC01 | C*----------------------------------------------------+ C SETOFF 71 C END C ENDSR C***************************************************** C CURSOR BEGSR C***************************************************** C LINE DIV 256 LIN 3 0 ｶﾞﾒﾝ の行数 C MVR POS 3 0 ｶﾞﾒﾝ の桁数 C ENDSR C****************************************************** C LINCHK BEGSR C****************************************************** C STRGYO ADD GYOSU ENDGYO 2 0 C SUB 1 ENDGYO C* ｶｰｿﾙ は開始行と終了行とのあいだにあるか C LIN COMP STRGYO 50 50 C 50LIN COMP ENDGYO 5050 C* 94: ｶｰｿﾙ が適切な位置になかった C N50 SETON 9967 C 99 GOTO LINEND C LIN SUB STRGYO RRN1 C ADD TOPRRN RRN1 C SETOFF 90 C RRN1 CHAIN SFREC01 90 C 90 GOTO LINEND C Z-ADD RRN1 DSPREC C*( 更新する ﾌｧｲﾙ に CHAIN ) C SETOFF 90 C TRNKEY CHAIN(N) JUCHU 90 C*( DUMMY EXCPT ) C*----------------------------------------------------+ C* N90 UPDATJUCHUR | CHG C*----------------------------------------------------+ C LINEND ENDSR