H DFTNAME(HTY002R) DATEDIT(*YMD/) BNDDIR('QC2LE') F********** 品名マスター照会 ****************************************** FHTY002FM CF E WORKSTN "F EXTFILE('HOTEI/HTY002FM') "F HANDLER(HANDLER:HPARM) F SFILE(SFREC01:RRN1) F INFDS(INFDS) FHIMSK IF E K DISK FHIMZK IF E K DISK F********************************************************************** " *( 2017/07/11 14:26:40 ) 5250 ハンドラーを組み込みました。 "D HANDLER S 20A INZ('ASNET.COM/P5250HLR') " " * ハンドラーに渡すパラメータの定義 * "D HPARM DS QUALIFIED "D HSIZE 4S 0 INZ(%SIZE(HPARM)) "D STATUS 1A "D HTMTYPE 10A INZ('TONAKAI ') "D HTM_DIR 128A INZ('/AS400-NET.USR/PROJECT/- "D HTY002R') "D INFDSF_PTR * INZ(%ADDR(INFDS)) "D INFDSP_PTR * INZ(%ADDR(INFDSP)) "D INGID_PTR * INZ(%ADDR(*IN)) "D CFKEY_PTR * INZ(%ADDR(CFKEYS)) " * 現在の SFL コントロール・レコード名 "D SFLCTL 10A " *ﾗ 注意 ﾝ - - - - - - - - - - - - - - - - - - - - - - - - - - - - " * SFL の表示行数を拡張するには DSPF の SFLSIZ を拡張して " * この行数 (HPARM.GYOSU) の分だけ SFL レコードを出力してください。 "D GYOSU 10I 0 "D EOF 1N " * 現在の DSPF の SFLPAG, SFLSIZ を取出します。 "D SFLPAG 4S 0 "D SFLSIZ 4S 0 " /COPY ASNET.USR/QRPGLESRC,CFKEYS " "D*( プログラム状況データ構造 ) "D INFDSP SDS "D PROC_NAM *PROC "D ROUTINE *ROUTINE "D PGM 1 10 "D 512A "D PGMINFO 1 512 "D LINE_NUM 21 28 "D ERRMSGID 46 51 "D JOB 244 253 "D USER 254 263 "D NBR 264 269 *" コマンドの実行： ｳﾅﾄﾍﾎｱﾄﾎ Tﾓﾆｵ D QCMDEXC PR EXTPGM('QCMDEXC') D CMDSTR 1024 CONST D CMDLEN 15 5 CONST * HOTEI/QRPGLESRC(HTY001) * 使用目的 : 更新 (*UPDATE) * 作成日 : 2017/07/07 14:56:34 * 作成者 : QTR D AR S 1 DIM(80) D SAVDTA S 1 DIM(1024) SAVE-ｺﾞｰn D STRGYO S 2S 0 INZ(6) D GYOSU S 3S 0 D ENDRRN S 3S 0 D SFLPAG S 2S 0 D SFLSIZ S 3S 0 D CMD S 1024 D CMDLEN S 15P 5 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: 今表示している SFL の先頭の RRN D TOPRRN 378 379B 0 D* BRRN : SFL レコードY D BRRN 376 377B 0 D*( WORK 日付 YYMMDD ｺﾞｰn 構造 ) 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 BEG_IMG C CONST('') D VALUE S 512A D HTY003 C CONST('HOTEI/HTY003') C*ﾗ 注意 ﾝ C* このプログラムはパラメータつきで呼び出すことができます。 C* パラメータなしで呼び出された場合は単独で動作します。 C*----------------------------------------------------+ C *ENTRY PLIST | C PARM SEL001 C*----------------------------------------------------+ C *LIKE DEFINE HI01 SEL001 C IF %PARMS > 0 C MOVE SEL001 HI01 C GOTO GET_RECORD C ENDIF C*( 初期画面 ) C GOTO GET_RECORD 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*----------------------------------------------------+ C SETKEY KLIST | C KFLD HI01S C*----------------------------------------------------+ C GET_RECORD TAG C EXSR SFLCLR C SETKEY SETLL HIMSK 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 CF03 C EXSR CURSOR /FREE RRN1 = LIN - STRGYO + TOPRRN; /END-FREE C SETOFF 04 C RRN1 CHAIN SFREC01 99 C*----------------------------------------------------+ C CALL HTY003 99 C PARM HI01 C*----------------------------------------------------+ C GOTO DSPLY C ENDIF CF03 C*( CF12 )- 前画面 C *IN12 IFEQ *ON CF12 C SETOFF 12 C *NOKEY CLEAR HIMSKREC C GOTO START C ENDIF CF12 C*( ROLL UP )- 次ページ C *IN14 IFEQ *ON ROLLUP C EXSR ROLLUP C GOTO DSPLY C END ROLLUP C*( 実行キー ) C 1 DO *HIVAL RRN1 RRN1=1-*HIVAL C SETOFF 50 C READC SFREC01 50 C 50 LEAVE C*----------------------------------------------------+ C* UPDATE SFREC01 | C*----------------------------------------------------+ C Z-ADD BRRN DSPREC C 99 GOTO DSPLY C ENDDO C GOTO DSPLY C****************************************************** C *INZSR BEGSR C****************************************************** C* 初期サイクルのみの実行 C CLEAR DATEDS C*( 引用符 ) C BITOFF '06' QUOT 1 C BITON '123457' QUOT C*( U8 = HTML インターフェースで実行中 ) C U8 SETON 08 C N08 MOVE SFLPAG GYOSU 行数 C 08 MOVE SFLSIZ GYOSU 行数 C*( DS の数字フィールドのクリヤー ) C CLEAR SFREC01 C INZEND ENDSR C****************************************************** C READ BEGSR C****************************************************** C*( データ・ベースの検索 ) C*----------------------------------------------------+ C EQLKEY KLIST | C KFLD HI01 C*----------------------------------------------------+ /FREE ENDRRN = TOPRRN + HPARM.GYOSU - 1; DSPREC = 0; /END-FREE C TOPRRN DO ENDRRN RRN1 4 0 READ C SETOFF 45 C READ HIMSK 45 C 45 LEAVE C* 画像イメージの追加 C EXSR ADD_IMAGE C*( SFL レコードを追加 ) C*----------------------------------------------------+ C WRITE SFREC01 | C*----------------------------------------------------+ C IF DSPREC = 0 C EVAL DSPREC = RRN1 C ENDIF C END READ C REDEND TAG C ENDSR C***************************************************** C ADD_IMAGE BEGSR C***************************************************** C SETOFF 99 C HI01 CHAIN HIMZK 99 C *IN99 IFEQ *ON C MOVE *BLANKS IMGTAG C ELSE /FREE VALUE = BEG_IMG + %TRIMR(HZ02) + END_IMG + X'00'; IMGTAG = VALUE; /END-FREE C END C ENDSR C****************************************************** C CHECK BEGSR C****************************************************** C*( 明細チエック ) C ENDSR C****************************************************** C SFLCLR BEGSR C****************************************************** C*( SFL のクリヤー ) C*----------------------------------------------------+ C SETON 44 | C WRITE SFCTL01 | C SETOFF 44 | C*----------------------------------------------------+ C ENDSR C****************************************************** C ROLLUP BEGSR C****************************************************** C *IN45 IFEQ *ON C SETON 6199 C ELSE C ENDRRN ADD 1 TOPRRN C EXSR READ C ENDIF C UPEND ENDSR C***************************************************** C LRRTN BEGSR C***************************************************** C* C LREND ENDSR C***************************************************** C CURSOR BEGSR C***************************************************** C LINE DIV 256 LIN 3 0 eﾞﾘﾜ の行数 C MVR POS 3 0 eﾞﾘﾜ の桁数 C ENDSR