H DFTNAME(PGM109) DATEDIT(*YMD/) BNDDIR('QC2LE') F********** 部課マスターの登録 *************************************** FPGM109FM CF E WORKSTN F SFILE(SFREC01:RRN1) F INFDS(INFDS) FBUKAM UF A E K DISK F********************************************************************** * QTRSRC/QRPGLESRC(PGM109) * 使用目的 : 更新 (*UPDATE) * 作成日 : 2017/07/28 11:24:14 * 作成者 : QTR D SYSTEM PR 10I 0 EXTPROC('ﾍﾓﾍﾎｵﾃ') D PATH * VALUE OPTIONS(*STRING) D AR S 1 DIM(80) D SAVDTA S 1 DIM(1024) SAVE-ﾃﾞｰﾀ D STRGYO S 2S 0 INZ(6) D GYOSU S 3S 0 D ENDRRN S 3S 0 D SFLPAG S 2S 0 INZ(13) D SFLSIZ S 3S 0 INZ(14) D CURLNG S 3A 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: 今表示している SFL の先頭の RRN D TOPRRN 378 379B 0 D* BRRN : SFL レコードY 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 JAPAN C CONST('/AS400-NET.USR/TEMPLATE- D /QTROBJ/PGM109FM/JAPAN.PNG') D CHINA C CONST('/AS400-NET.USR/TEMPLATE- D /QTROBJ/PGM109FM/CHINA.PNG') D BEGIMG C CONST('') C*[ 注意 ] C* このプログラムはパラメータつきで呼び出すことができます。 C* パラメータなしで呼び出された場合は単独で動作します。 C*----------------------------------------------------+ C *ENTRY PLIST | C PARM SEL001 C*----------------------------------------------------+ C *LIKE DEFINE BKCODE SEL001 C IF %PARMS > 0 C MOVE SEL001 LANG /FREE FLGIMG = BEGIMG + CHINA + ENDIMG; /END-FREE C GOTO GET_RECORD C ENDIF C GOTO GET_RECORD 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*----------------------------------------------------+ C SETKEY KLIST | C KFLD BKCODE C*----------------------------------------------------+ C GET_RECORD TAG C EXSR SFLCLR C MOVE BKFROM BKCODE C SETKEY SETLL BUKAM 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*( CF12 )- 前画面 C *IN12 IFEQ *ON CF12 C SETOFF 12 C *NOKEY CLEAR @BUKAM C GOTO START C END CF12 C*( ROLL UP )- 次ページ C *IN14 IFEQ *ON ROLLUP C EXSR ROLLUP C GOTO DSPLY C END ROLLUP C*( 実行キー ) * ( 言語選択 ) C LANG IFNE CURLNG C LANG IFEQ 'CHN' * 中国語をセット C EXSR CHINA_ C ELSE * 日本語に戻す C EXSR JAPAN_ C ENDIF C MOVE LANG CURLNG C GOTO DSPLY C ENDIF C* C 1 DO *HIVAL RRN1 RRN1=1-*HIVAL C SETOFF 50 C READC SFREC01 50 C 50 LEAVE C EXSR CHECK C*----------------------------------------------------+ C UPDATE SFREC01 | C*----------------------------------------------------+ C Z-ADD BRRN DSPREC C 99 GOTO DSPLY C ENDDO C*( CF10 )- 更新 C *IN10 IFEQ *ON CF12 C*( CF23 )- 削除 C *IN23 OREQ *ON C SETOFF 10 C*----------------------------------------------------+ C RECKEY KLIST | C KFLD BKCODE C*----------------------------------------------------+ C 1 DO *HIVAL RRN1 RRN1=1-*HIVAL C SETOFF 50 C RRN1 CHAIN SFREC01 90 C 90 LEAVE C MOVE DSPDTA SAVDTA C SETOFF 90 C RECKEY CHAIN BUKAM 90 C MOVE SAVDTA DSPDTA C *IN23 IFEQ *OFF C*----------------------------------------------------+ C 90 WRITE @BUKAM C N90 UPDATE @BUKAM C ELSE C N90 DELETE @BUKAM C*----------------------------------------------------+ C ENDIF C 90 ADD 1 ADDREC C N90 ADD 1 CHGREC C ENDDO C SETOFF 23 C ENDIF C GOTO DSPLY C****************************************************** C *INZSR BEGSR C****************************************************** C* 初期サイクルのみの実行 C CLEAR SAVEDS C CLEAR DATEDS C*( U8 = HTML インターフェースで実行中 ) C U8 SETON 08 C N08 MOVE SFLPAG GYOSU 行数 C 08 MOVE SFLSIZ GYOSU 行数 C*( DS の数字フィールドのクリヤー ) C CLEAR SFREC01 C MOVE 'JPN' LANG C* EXSR JAPAN_ /FREE FLGIMG = BEGIMG + JAPAN + ENDIMG; /END-FREE C INZEND ENDSR C****************************************************** C READ BEGSR C****************************************************** C*( データ・ベースの検索 ) C*----------------------------------------------------+ C EQLKEY KLIST | C KFLD BKCODE C*----------------------------------------------------+ /FREE ENDRRN = TOPRRN + GYOSU - 1; DSPREC = 0; /END-FREE C TOPRRN DO ENDRRN RRN1 4 0 READ C SETOFF 45 C READ BUKAM 45 C 45 LEAVE C*( 行 NO に入れる ) C MOVE RRN1 GYO 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 CHECK BEGSR C****************************************************** C*( 明細チエック ) C CHKEND ENDSR C****************************************************** C CHINA_ BEGSR C****************************************************** *( 中国語 ) /FREE SYSTEM('OVRMSGF MSGF(USRMSG) TOMSGF(CHINALIB/USRMSG) SECURE(*YES)'); FLGIMG = BEGIMG + CHINA + ENDIMG; /END-FREE C ENDSR C****************************************************** C JAPAN_ BEGSR C****************************************************** *( 日本語 ) /FREE SYSTEM('DLTOVR FILE(USRMSG) LVL(*)'); FLGIMG = BEGIMG + JAPAN + ENDIMG; /END-FREE 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 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 CURSOR BEGSR C***************************************************** C LINE DIV 256 LIN 3 0 ｶﾞﾒﾝ の行数 C MVR POS 3 0 ｶﾞﾒﾝ の桁数 C ENDSR