H Y/ PGMID F********** 商品マスター照会 ************************************ FSMP006FMCF E WORKSTN F RRN1 KSFILE SFREC01 F KINFDS INFDS FSHOHIN IF E K DISK F***************************************************************** E DSPDTA 1024 1 入力 データ E SAVDTA 1024 1 SAVE-データ I* 読み取り ファイル の FORMAT を外部 DS として READ IDATADS E DSSHOHIN I 11024 DSPDTA I* I* -( サブ・ファイル の ファイル 情報 )- I* IINFDS DS I*( カーソル の行と桁の取り込み ) I B 370 3710LINE I* TOPRRN: 今表示している サブ・ファイル の先頭の RRN I B 378 3790TOPRRN I* BRRN : サブファイル の レコードNO ( 2 進数 ) I B 376 3770BRRN I*( WORK 日付 YYMMDD データ 構造 ) IDATEDS DS I 1 20SRY I 1 80SRYMD I 3 80YYMMDD I 3 60YYMM I 5 80MMDD I 3 40YY I 5 60MM I 7 80DD C*( 初期画面 ) C*----------------------------------------------------+ C START TAG | C EXFMTDSPHEAD | C*----------------------------------------------------+ C SETOF 99 C*( CF03 )- 終了 C *IN03 IFEQ '1' CF03 C 03 SETON LR C LR RETRN C GOTO START C END CF03 C*( 実行キー ) C* | C* | C* : 初期画面のチエック C HEDSTR TAG C EXSR HEDCHK C 99 GOTO START C* | C* : KEYをファイルにセット C*----------------------------------------------------+ C SETKEY KLIST | C KFLD SHCODE | C*----------------------------------------------------+ C*( *LOVAL のセット ) C MOVE *BLANKS SHCODE C* C* | C SETKEY SETLLSHOHIN C EXSR SFLCLR C* : ファイルの読み取り C Z-ADD1 TOPRRN C EXSR READ C Z-ADD1 DSPREC C MOVE MIB001 DMYFLD C *LIKE DEFN DMYFLD MIB001 C MOVE MIB002 SHCODE C *LIKE DEFN SHCODE MIB002 C EXSR MIDCHK C SETOF 99 C MOVEA'00000000'*IN,61 C MOVEA'00000000'*IN,69 C MOVEA'000' *IN,77 C*( 該当する レコード が何もなかった ) C *IN59 IFEQ '0' C*----------------------------------------------------+ C NOFUND TAG | C WRITENOREC | C SETON 41 |SFL-DSPLY C EXFMTSFCTL01 | C SETOF 41 | C*----------------------------------------------------+ C*( CF03 )- 終了 C *IN03 IFEQ '1' CF03 C 03 SETON LR C LR RETRN C GOTO NOFUND C END CF03 C*( 実行キー ) C GOTO START C END C*( サブ・ファイルの表示 ) C WRITEDSPEND01 C*----------------------------------------------------+ C DSPLY TAG | C SETON 4142 |SFL-DSPLY C EXFMTSFCTL01 | C SETOF 4142 | C*----------------------------------------------------+ C SETOF 99 C*( CF03 )- 終了 C *IN03 IFEQ '1' CF03 C 03 SETON LR C LR RETRN C GOTO DSPLY C END CF03 C* C*( CF12 )- 前画面 C *IN12 IFEQ '1' CF12 C SETOF 12 C EXSR SFLDLT C GOTO START C END CF12 C* | C*( ROLL UP )- 次ページ C *IN14 IFEQ '1' C EXSR ROLLUP C GOTO DSPLY C END C*( ROLL DOWN )- 前ページ C *IN15 IFEQ '1' C Z-ADD1 DSPREC C SETON 6299 ERRMSG C GOTO DSPLY C END C* C*( 実行キー ) C GOTO DSPLY C* C END TAG C****************************************************** C *INZSR BEGSR C****************************************************** C* 初期 サイクル のみの実行 C*( サブファイル END-FLAG を ON にする ) CSR SETON 45 C*( DS の数字 フィールド の クリヤー ) CSR EXSR SFLBLK CSR MOVE 13 GYOSU 20 行数 CSR MOVE 08 STRGYO 20 開始行Y CSR MOVE 19910101 SRYMD CSR MOVE 910101 DATE 60 CSR MOVE *BLANKS FLD9 CSR MOVEL' 終り ' FLD9 9 CSR MOVE FLD9 ENDMSG 9 CSR MOVE *BLANKS FLD9 CSR MOVEL' 続く ..'FLD9 9 CSR MOVE '.' FLD9 CSR MOVE FLD9 CNTMSG 9 CSR SETON 11 CSR SETOF 11 CSR ENDSR C****************************************************** C HEDCHK BEGSR C****************************************************** C*( 初期画面チエック ) CSR HEDEND ENDSR C****************************************************** C MIDCHK BEGSR C****************************************************** C*( 見出しチエック ) CSR MIDEND ENDSR C****************************************************** C READ BEGSR C****************************************************** CSR MOVE *BLANKS EOF 1 CSR SETOF 5945 C*( データ・ベースの検索 ) C*----------------------------------------------------+ C* EQLKEY KLIST | C*----------------------------------------------------+ CSR RTNRED TAG C* CSR TOPRRN ADD GYOSU ENDRRN 40 CSR SUB 1 ENDRRN C* CSR TOPRRN DO ENDRRN RRN1 40 READ CSR AGAIN TAG CSR SETOF 50 CSR READ SHOHIN 50 C*( 終り ) CSR *IN50 IFEQ '1' EOF CSR MOVE 'E' EOF CSR SETOF 1129 CSR SETON 45 CSR GOTO REDEND CSR ELSE EOF CSR MOVE DMYFLD MIB001 CSR MOVE SHCODE MIB002 C*( CHECK : READ した レコード の チエック ) CSR EXSR CHECK C*( 行 NO に入れる ) CSR MOVE RRN1 GYO C*( サブファイル へ更新 ) C*----------------------------------------------------+ C WRITESFREC01 | C*----------------------------------------------------+ CSRN59 Z-ADDRRN1 DSPREC CSRN59 SETON 59 CSR Z-ADDRRN1 LSTRRN 40 CSR END EOF CSR END READ CSR REDEND TAG CSR ENDSR C****************************************************** C CHECK BEGSR C****************************************************** C*( 明細チエック ) CSR CHKEND ENDSR C****************************************************** C SFLCLR BEGSR C****************************************************** C*( サブファイル の クリヤー ) C*----------------------------------------------------+ CSR SETON 44 | CSR WRITESFCTL01 | CSR SETOF 44 | C*----------------------------------------------------+ CSR ENDSR C****************************************************** C SFLDLT BEGSR C****************************************************** C*( サブファイル の削除 ) C*----------------------------------------------------+ CSR SETON 46 | CSR WRITESFCTL01 | CSR SETOF 46 | C*----------------------------------------------------+ CSR ENDSR C****************************************************** C SFLBLK BEGSR C****************************************************** C*( サブファイル の初期化 ) CSR CLEARSFREC01 CSR EXSR INZVAR 初期値 CSR ENDSR C****************************************************** C INZVAR BEGSR C****************************************************** C*( 初期値 ) CSR ENDSR C****************************************************** C ROLLUP BEGSR C****************************************************** CSR EOF IFEQ 'E' CSR SETON 6199 ERRMSG CSR 99 Z-ADDLSTRRN DSPREC CSR 99 GOTO UPEND CSR END CSR ENDRRN ADD 1 TOPRRN CSR EXSR READ CSR MOVE MIB001 DMYFLD CSR MOVE MIB002 SHCODE CSR UPEND ENDSR