オフコン練習帳 - 掲示板

NECオフコン関連

ホーム NECオフコンの歴史 A-VX入門 A-VXの説明書 NECオフコン用語辞典過去ニュース

オフコン一般

オフコンについていろいろなオフコンオフコン昔の広告オフコン掲示板 = ノウハウ = NECオフコン = オフコン総合サイト更新履歴リンク

情報

[掲示板に戻る]

Re:江須扇さんの開発支援プログラム公開江須扇 2011-1-7 10:45

Re:分割で旨く投稿できました。江須扇 2011-6-15 17:21

Re:分割で旨く投稿できました。その２江須扇 2011-6-15 17:24

3	Re:江須扇さんの開発支援プログラム公開
	江須扇 2011-1-7 10:45 [返信] [編集] 早速のリリースありがとうございます。拙いプログラムですが、皆様の開発支援にお役にたてばありがたいです。バグだし、アイデアがあれば、よろしくお願いします。特にプログラムが暴走することはありませんが、１点ご注意をお願いします。実行機能も組み込んでおります、特に警告などもなく即実行しますので、誤って実行機能をさせることだけはご注意ください。処理モードが「ＲＵＮ」になっている時は「Ｅｎｔｅｒ」のみでも実行してしまします。よろしくお願いします。
4	Re:分割で旨く投稿できました。
	江須扇 2011-6-15 17:21 [返信] [編集] 000010 IDENTIFICATION DIVISION. 000020************************************************************************** 000030* SOFTWARE DEVELOPMENT AIDING TOOL * 000040* ソフトウェア開発支援ツール　　　　　　(DEVLOP) * 000050************************************************************************** 000060------------------------------------------------------------------------ 000070 PROGRAM-ID. DEVLOP. 000080 AUTHOR. SCEN. 000090------------------------------------------------------------------------ 000100* 環境部 000110 ENVIRONMENT DIVISION. 000120------------------------------------------------------------------------ 000130* 構成節 000140 CONFIGURATION SECTION. 000150 SOURCE-COMPUTER. EXPRESS5800-600AI. 000160 OBJECT-COMPUTER. EXPRESS5800-600XI. 000170------------------------------------------------------------------------ 000180* 入出力節 000190 INPUT-OUTPUT SECTION. 000200 FILE-CONTROL. 000210------------------------------------------------------------------------ 000220* メンバー履歴管理ファイル 000230 SELECT MBRKF ASSIGN TO MBRKFB-RDB. 000240 I-O-CONTROL. 000250 APPLY SHARED-MODE ON MBRKF. 000260------------------------------------------------------------------------ 000270* データー部 000280 DATA DIVISION. 000290------------------------------------------------------------------------ 000300* ファイル節 000310 FILE SECTION. 000320 FD MBRKF 000330 LABEL RECORD IS STANDARD 000340 VALUE OF IDENTIFICATION "MEMBERKANRIFILE-B". 000350 01 MEMBER-REC. 000360 02 MKF-KEY. 000370 03 MKF-MBNM PIC X(06). 000380* メンバー名 000390 03 MKF-LBFL PIC X(17). 000400* ライブラリーファイル名 000410 03 MKF-LBDV PIC X(06). 000420* ライブラリー装置名 000430 02 MKF-MBTP PIC X(03). 000440* メンバー種別　 000450 02 MKF-MBSM PIC X(30). 000460* メンバー説明文 000470 02 MKF-LBF2 PIC X(17). 000480* ライブラリーファイル名２ 000490 02 MKF-LBD2 PIC X(06). 000500* ライブラリー装置名２ 000510 02 FILLER PIC X(151). 000520* １５１桁の予備 000530 02 MKF-STNO PIC X(06). 000540* ステーション番号 000550 02 MKF-KSHI PIC X(06). 000560* 更新日 000570 02 MKF-KSTM PIC X(08). 000580* 更新時間 000590------------------------------------------------------------------------ 000600* 作業場所節 000610 WORKING-STORAGE SECTION. 000620------------------------------------------------------------------------ 000630* ＥＮＤ　ＳＴＡＴＵＳ　項目名定義 000640 01 END-STATUS. 000650 02 NON PIC X(2) VALUE "00". 000660 02 HTB PIC X(2) VALUE "01". 000670 02 C1 PIC X(2) VALUE "02". 000680 02 C2 PIC X(2) VALUE "03". 000690 02 ADV PIC X(2) VALUE "04". 000700 02 RTN PIC X(2) VALUE "05". 000710 02 SKP PIC X(2) VALUE "06". 000720 02 UARW PIC X(2) VALUE "07". 000730 02 DARW PIC X(2) VALUE "08". 000740 02 BSKP PIC X(2) VALUE "09". 000750 02 FWD PIC X(2) VALUE "FW". 000760 02 BWD PIC X(2) VALUE "BW". 000770 02 UPK PIC X(2) VALUE "UP". 000780 02 DWN PIC X(2) VALUE "DW". 000790 02 FRM PIC X(2) VALUE "FM". 000800 02 HLP PIC X(2) VALUE "P0". 000810 02 PF1 PIC X(2) VALUE "P1". 000820 02 PF2 PIC X(2) VALUE "P2". 000830 02 PF3 PIC X(2) VALUE "P3". 000840 02 PF4 PIC X(2) VALUE "P4". 000850 02 PF5 PIC X(2) VALUE "P5". 000860 02 PF6 PIC X(2) VALUE "P6". 000870 02 PF7 PIC X(2) VALUE "P7". 000880 02 PF8 PIC X(2) VALUE "P8". 000890 02 PF9 PIC X(2) VALUE "P9". 000900 02 PF10 PIC X(2) VALUE "PA". 000910 02 PF11 PIC X(2) VALUE "PB". 000920 02 PF12 PIC X(2) VALUE "PC". 000930 02 PF13 PIC X(2) VALUE "PD". 000940 02 PF14 PIC X(2) VALUE "PE". 000950 02 PF15 PIC X(2) VALUE "PF". 000960 02 PF16 PIC X(2) VALUE "PG". 000970 02 ALFA PIC X(2) VALUE "AL". 000980 02 MATK PIC X(2) VALUE "MA". 000990 02 IDKY PIC X(2) VALUE "ID". 001000------------------------------------------------------------------------ 001010* ＳＹＳＣＨＡＩＮ　レコード 001020 01 SYSCHAIN-REC. 001030 02 FILLER PIC X(256). 001040 01 CHN-CNT PIC 9(04). 001050------------------------------------------------------------------------ 001060* ＳＹＳＣＨＡＩＮ　＃ＴＥＤＩＴ　レコード 001070 01 EDTCHAIN-REC. 001080 02 FILLER PIC X(11) VALUE "#TEDIT;TYP=". 001090 02 EDT-MBTP PIC X(03) VALUE "COB". 001100 02 FILLER PIC X(13) VALUE "_WKD=TEM_WSZ=". 001110 02 EDT-WKSZ PIC 9(05) VALUE 02400. 001120 02 FILLER PIC X(07) VALUE "_RALL [". 001130 02 EDT-MBNM PIC X(06) VALUE "DEVLOP". 001140 02 FILLER PIC X(02) VALUE "] ". 001150 02 EDT-LBDV PIC X(06) VALUE "MSD". 001160 02 FILLER PIC X(01) VALUE " ". 001170 02 EDT-LBFL PIC X(17) VALUE "USERSUL". 001180 02 FILLER PIC X(03) VALUE "_/>". 001190 01 EDT-CNT PIC 9(04) VALUE 74. 001200------------------------------------------------------------------------ 001210* ＳＹＳＣＨＡＩＮ　ＣＯＭＰＩＬＥ　レコード 001220 01 CBLCHAIN-REC. 001230 02 FILLER PIC X(19) VALUE "CBL85 ,SSW1=ON;SUD=". 001240 02 CBL-LBDV PIC X(06) VALUE "MSD ". 001250 02 FILLER PIC X(05) VALUE "_SUF=". 001260 02 CBL-LBFL PIC X(17) VALUE "USERSUL". 001270 02 FILLER PIC X(05) VALUE "_LBD=". 001280 02 CBL-LBD2 PIC X(06) VALUE "MSD ". 001290 02 FILLER PIC X(05) VALUE "_LBF=". 001300 02 CBL-LBF2 PIC X(17) VALUE "USERSUL". 001310 02 FILLER PIC X(05) VALUE "_CUD=". 001320 02 FILLER PIC X(06) VALUE "MSD ". 001330 02 FILLER PIC X(05) VALUE "_CUF=". 001340 02 FILLER PIC X(17) VALUE "USERCUL". 001350 02 FILLER PIC X(13) VALUE "_WKD=TEM_WSZ=". 001360 02 FILLER PIC 9(05) VALUE 02400. 001370 02 FILLER PIC X(13) VALUE "_PRD=STN_PRG=". 001380 02 CBL-MBNM PIC X(06) VALUE "DEVLOP". 001390 02 FILLER PIC X(08) VALUE "_MOD=REP". 001400 02 FILLER PIC X(08) VALUE "_COD=SOU". 001410 02 FILLER PIC X(08) VALUE "_DBG=SOU". 001420 02 FILLER PIC X(07) VALUE "_OPT=NO". 001430 02 FILLER PIC X(08) VALUE "_NXT=LIN". 001440 02 FILLER PIC X(03) VALUE "_/>". 001450 01 CBL-CNT PIC 9(04) VALUE 192. 001460------------------------------------------------------------------------ 001470* ＳＹＳＣＨＡＩＮ　メンバー表示　レコード 001480 01 DIRCHAIN-REC. 001490 02 FILLER PIC X(18) VALUE "#LBM ;PRD=PRN999_". 001500 02 FILLER PIC X(19) VALUE "MDE=NO_ACT=DIR_IDE=". 001510 02 DIR-LBDV PIC X(06) VALUE "MSD". 001520 02 FILLER PIC X(05) VALUE "_IFI=". 001530 02 DIR-LBFL PIC X(17) VALUE "USERSUL". 001540 02 FILLER PIC X(09) VALUE "_ODE=STN_". 001550 02 FILLER PIC X(08) VALUE "ACT=999_". 001560 02 FILLER PIC X(07) VALUE "MDE=NO_". 001570 02 FILLER PIC X(03) VALUE "_/>". 001580 01 DIR-CNT PIC 9(04) VALUE 92. 001590------------------------------------------------------------------------ 001600* ＳＹＳＣＨＡＩＮ　実行　　　　　レコード 001610 01 RUNCHAIN-REC. 001620 02 RUN-MBNM PIC X(06) VALUE "DEVLOP". 001630 02 FILLER PIC X(05) VALUE ",DEV=". 001640 02 RUN-LBDV PIC X(06) VALUE "MSD". 001650 02 FILLER PIC X(05) VALUE ",FIL=". 001660 02 RUN-LBFL PIC X(17) VALUE "USERLML". 001670 02 FILLER PIC X(02) VALUE ",(". 001680 02 RUN-ADVN PIC X(07) VALUE "ADV=YES". 001690 02 FILLER PIC X(02) VALUE ");". 001700 01 RUN-CNT PIC 9(04) VALUE 50. 001710------------------------------------------------------------------------ 001720* ＳＹＳＣＨＡＩＮ　メンバー追加　レコード 001730 01 CPYCHAIN-REC. 001740 02 FILLER PIC X(18) VALUE "#LBM ;PRD=PRN999_". 001750 02 FILLER PIC X(04) VALUE "MDE=". 001760 02 CPY-LBD2 PIC X(06) VALUE "MSD ". 001770 02 FILLER PIC X(05) VALUE "_MFI=". 001780 02 CPY-LBF2 PIC X(17) VALUE "WORKLML". 001790 02 FILLER PIC X(05) VALUE "_ACT=". 001800 02 CPY-MBTP PIC X(03) VALUE "ADD". 001810 02 FILLER PIC X(05) VALUE "_IDE=". 001820 02 CPY-LBDV PIC X(06) VALUE "MSD". 001830 02 FILLER PIC X(05) VALUE "_IFI=". 001840 02 CPY-LBFL PIC X(17) VALUE "SAVELML". 001850 02 FILLER PIC X(09) VALUE "_SCS=YES_". 001860 02 FILLER PIC X(08) VALUE "IDE=999_". 001870 02 FILLER PIC X(08) VALUE "ACT=999_". 001880 02 FILLER PIC X(08) VALUE "MDE=END_". 001890 02 FILLER PIC X(03) VALUE "_/>". 001900 01 CPY-CNT PIC 9(04) VALUE 127. 001910------------------------------------------------------------------------ 001920* 画面保存　　　　　　　　　　　　レコード 001930 01 DSP-REC. 001940 02 DSP-SREC1. 001950 04 DSP-KSHI PIC 99/99B. 001960 04 DSP-KSTMH PIC 99. 001970 04 DSP-COLON PIC X VALUE ":". 001980 04 DSP-KSTMM PIC 99B. 001990 02 DSP-SREC2. 002000 04 DSP-MBNM PIC X(06). 002010 04 FILLER PIC X(01) VALUE SPACE. 002020 04 DSP-LBFL PIC X(17). 002030 04 FILLER PIC X(01) VALUE SPACE. 002040 04 DSP-LBDV PIC X(06). 002050 04 FILLER PIC X(01) VALUE SPACE. 002060 04 DSP-MBTP PIC X(03). 002070 04 FILLER PIC X(01) VALUE SPACE. 002080 04 DSP-SREC21. 002090 06 DSP-MBSM PIC X(30) VALUE SPACE. 002100 06 FILLER PIC X(02) VALUE SPACE. 002110 04 DSP-SREC21R REDEFINES DSP-SREC21. 002120 06 DSP-LBF2R PIC X(17). 002130 06 FILLER PIC X(01). 002140 06 DSP-LBD2R PIC X(06). 002150 06 FILLER PIC X(01). 002160 06 DSP-MBS2R PIC X(07). 002170 01 WRK-REC. 002180 02 REC-TOP PIC 9(04) VALUE 1. 002190 02 REC-CUR PIC 9(04) VALUE ZERO. 002200 02 REC-END PIC 9(04) VALUE 1. 002210 02 LN PIC 9(02) VALUE 2. 002220 02 I PIC 9(02) VALUE 1. 002230 02 FLD-CNT PIC 9(03) VALUE ZERO. 002240 02 REC-CNT PIC 9(04) VALUE ZERO. 002250 02 WRK-STNO PIC X(06) VALUE SPACE. 002260 02 WRK-IN PIC X(68) VALUE SPACE. 002270 02 DSP-SREC22. 002280 06 DSP-LBF2 PIC X(17). 002290 06 FILLER PIC X(01) VALUE SPACE. 002300 06 DSP-LBD2 PIC X(06). 002310 06 FILLER PIC X(01) VALUE SPACE. 002320 06 DSP-MBS2 PIC X(07). 002330 01 TBL-REC. 002340 02 FILLER PIC X(13) VALUE "JSL JCL 00240". 002350 02 FILLER PIC X(13) VALUE "LML RUN 02400". 002360 02 FILLER PIC X(13) VALUE "MNL PAR 00240". 002370 02 FILLER PIC X(13) VALUE "PML PAR 00240". 002380 02 FILLER PIC X(13) VALUE "SGL SGL 00240". 002390 02 FILLER PIC X(13) VALUE "SUL COB 02400". 002400 01 TBL-RECR REDEFINES TBL-REC. 002410 02 TBL-REC2 OCCURS 6. 002420 03 TBL-LBTP PIC X(03). 002430 03 FILLER PIC X(01). 002440 03 TBL-MBTP PIC X(03). 002450 03 FILLER PIC X(01). 002460 03 TBL-WKSZ PIC 9(05). 002470 01 MODE-REC. 002480 02 CALL-MOD PIC N(04) VALUE NC"編集". 002490 01 ENDSW PIC X(03) VALUE "OFF". 002500 88 ENDSW-ON VALUE "ON ". 002510 88 ENDSW-OFF VALUE "OFF". 002520------------------------------------------------------------------------ 002530* 画面節 002540 SCREEN SECTION. 002550 SD GAMEN END STATUS IS ENDSTS. 002560 01 DISP-CLR. 002570 02 CLEAR SCREEN. 002580 01 DISP-HEAD. 002590 02 LINE 01 COLUMN 01 VALUE "TOP :". 002600 02 LINE 01 COLUMN 07 PIC 9(04) FROM REC-TOP. 002610 02 LINE 01 COLUMN 13 VALUE "CUR :". 002620 02 LINE 01 COLUMN 19 PIC 9(04) FROM REC-CUR. 002630 02 LINE 01 COLUMN 26 VALUE "END :". 002640 02 LINE 01 COLUMN 32 PIC 9(04) FROM REC-END. 002650 02 LINE 01 COLUMN 54 VALUE "TEXT :". 002660 02 LINE 01 COLUMN 61 PIC X(07) FROM DSP-MBNM. 002670 02 LINE 01 COLUMN 70 VALUE "TYPE :". 002680 02 LINE 01 COLUMN 77 PIC X(03) FROM DSP-MBTP. 002690 02 LINE 01 COLUMN 01 VALUE ""27"S0101060". 002700 02 LINE 01 COLUMN 19 VALUE ""27"S0119064". 002710 02 LINE 01 COLUMN 23 VALUE ""27"S0123060". 002720 02 LINE 22 COLUMN 13 VALUE "". 002730 02 LINE 22 COLUMN 20 VALUE "". 002740 02 LINE 22 COLUMN 38 VALUE "". 002750 02 LINE 22 COLUMN 45 VALUE "". 002760 02 LINE 22 COLUMN 49 VALUE "". 002770 02 LINE 22 COLUMN 67 VALUE "". 002780 02 LINE 22 COLUMN 01 002790 OVER LINE TO 80 002800 UNDER LINE TO 80. 002810 02 LINE 24 COLUMN 01 VALUE "MODE : ". 002820 02 DISP-MOD 002830 LINE 24 COLUMN 08 PIC N(04) FROM CALL-MOD. 002840 02 DISP-STNO 002850 LINE 24 COLUMN 64 PIC X(06) FROM WRK-STNO. 002860 02 DISP-ADV 002870 LINE 24 COLUMN 74 PIC X(07) FROM RUN-ADVN. 002880 02 LINE 24 COLUMN 01 002890 OVER LINE TO 80 002900 UNDER LINE TO 80. 002910 01 DISP-CBL. 002920 02 CLEAR SCREEN. 002930 02 LINE 01 COLUMN 01 VALUE "A-VXX". 002940 02 LINE 01 COLUMN 11 VALUE "REL. X.XX". 002950 02 LINE 01 COLUMN 24 VALUE "CBL85". 002960 02 LINE 01 COLUMN 34 VALUE "REV. XXXX". 002970 02 LINE 01 COLUMN 48 VALUE "PROGRAM:". 002980 02 LINE 01 COLUMN 57 PIC X(06) FROM DSP-MBNM. 002990 02 LINE 01 COLUMN 66 VALUE "REV. XXXX". 003000 02 LINE 03 COLUMN 11 VALUE 003010 NC"Ｃ　Ｏ　Ｂ　Ｏ　Ｌ　８　５". 003020 02 LINE 03 COLUMN 41 VALUE 003030 NC"Ｃ　Ｏ　Ｍ　Ｐ　Ｉ　Ｌ　Ｅ　Ｒ". 003040 02 LINE 05 COLUMN 04 VALUE "SOURCE UNIT DEVICE;". 003050 02 LINE 05 COLUMN 37 VALUE "SUD=". 003060 02 LINE 05 COLUMN 41 PIC X(06) FROM DSP-LBDV. 003070 02 LINE 06 COLUMN 04 VALUE "SOURCE UNIT FILE NAME;". 003080 02 LINE 06 COLUMN 37 VALUE "SUF=". 003090 02 LINE 06 COLUMN 41 PIC X(17) FROM DSP-LBFL. 003100 02 LINE 07 COLUMN 04 VALUE "COPY LIBRALY DEVICE;". 003110 02 LINE 07 COLUMN 37 VALUE "LBD=". 003120 02 LINE 07 COLUMN 41 PIC X(06) FROM DSP-LBD2. 003130 02 LINE 08 COLUMN 04 VALUE "COPY LIBRALY FILE NAME;". 003140 02 LINE 08 COLUMN 37 VALUE "LBF=". 003150 02 LINE 08 COLUMN 41 PIC X(17) FROM DSP-LBF2. 003160 02 LINE 09 COLUMN 04 VALUE "COMPILE UNIT DEVICE;". 003170 02 LINE 09 COLUMN 37 VALUE "CUD=MSD". 003180 02 LINE 10 COLUMN 04 VALUE "COMPILE UNIT FILE NAME;". 003190 02 LINE 10 COLUMN 37 VALUE "CUF=USERCUL". 003200 02 LINE 11 COLUMN 04 VALUE "WORK DEVICE;". 003210 02 LINE 11 COLUMN 37 VALUE "WKD=TEMPORARY". 003220 02 LINE 12 COLUMN 04 VALUE "WORK FILE SIZE;". 003230 02 LINE 12 COLUMN 37 VALUE "WSZ=02400". 003240 02 LINE 13 COLUMN 04 VALUE "PRINT DEVICE;". 003250 02 LINE 13 COLUMN 37 VALUE "PRD=STN". 003260 02 LINE 14 COLUMN 04 VALUE "PROGRAM NAME;". 003270 02 LINE 14 COLUMN 37 VALUE "PRG=". 003280 02 LINE 14 COLUMN 41 PIC X(06) FROM DSP-MBNM. 003290 02 LINE 15 COLUMN 04 VALUE "COMPILE UNIT OUTPUT MODE;". 003300 02 LINE 15 COLUMN 37 VALUE "MOD=REPLACE". 003310 02 LINE 16 COLUMN 04 VALUE "CU CHARACTER CODE;". 003320 02 LINE 16 COLUMN 37 VALUE "COD=SOURCE". 003330 02 LINE 17 COLUMN 04 VALUE "DEBUG MODE;". 003340 02 LINE 17 COLUMN 37 VALUE "DBG=SOURCE". 003350 02 LINE 18 COLUMN 04 VALUE "OPTIONAL FUNCTION;". 003360 02 LINE 18 COLUMN 37 VALUE "OPT=NO". 003370 02 LINE 19 COLUMN 04 VALUE "NEXT;". 003380 02 LINE 19 COLUMN 37 VALUE "NXT=LINK". 003390 02 LINE 01 COLUMN 01 VALUE ""27"S0101024". OVERLINE 003400 02 LINE 01 COLUMN 01 VALUE ""27"S0101405". PURPLE 003410 02 LINE 01 COLUMN 01 VALUE ""27"S0201024". OVERLINE 003420 02 LINE 01 COLUMN 01 VALUE ""27"S0201406". CYAN 003430 02 LINE 01 COLUMN 01 VALUE ""27"S0301044". UNDERLIN 003440 02 LINE 01 COLUMN 01 VALUE ""27"S0401407". WHITE 003450 02 LINE 01 COLUMN 01 VALUE ""27"S2110000". NORMAL 003460 02 LINE 01 COLUMN 01 VALUE ""27"S2110404". BLUE 003470 02 LINE 01 COLUMN 01 VALUE ""27"S2175004". REVERSE 003480 02 LINE 01 COLUMN 01 VALUE ""27"S2175407". WHITE 003490 01 DISP-DIR. 003500 02 CLEAR SCREEN. 003510 02 LINE 01 COLUMN 01 VALUE ""27"S0101024". OVERLINE 003520 02 LINE 01 COLUMN 01 VALUE ""27"S0101405". PURPLE 003530 02 LINE 01 COLUMN 01 VALUE ""27"S0201024". OVERLINE 003540 02 LINE 01 COLUMN 01 VALUE ""27"S0201406". CYAN 003550 02 LINE 01 COLUMN 01 VALUE ""27"S0301044". UNDERLIN 003560 02 LINE 01 COLUMN 01 VALUE ""27"S0401407". WHITE 003570 01 DISP-CPY. 003580 02 CLEAR SCREEN. 003590 02 LINE 01 COLUMN 01 VALUE ""27"S0101024". OVERLINE 003600 02 LINE 01 COLUMN 01 VALUE ""27"S0101405". PURPLE 003610 02 LINE 01 COLUMN 01 VALUE ""27"S0301024". OVERLINE 003620 02 LINE 01 COLUMN 01 VALUE ""27"S0301406". CYAN 003630 02 LINE 01 COLUMN 01 VALUE ""27"S0401044". UNDERLIN 003640 02 LINE 01 COLUMN 01 VALUE ""27"S0501407". WHITE 003650 01 DISP-LINE. 003660 02 LINE LN COLUMN 01 PIC X(80) FROM DSP-REC. 003670 01 DISP-LINE-R. 003680 02 LINE LN COLUMN 01 PIC X(80) FROM DSP-REC 003690 REVERSE. 003700 01 ACEP-LINE. 003710 02 LINE 23 COLUMN 01 PIC X(12) FROM DSP-SREC1. 003720 02 LINE 23 COLUMN 13 PIC X(68) USING WRK-IN 003730 NO IFC CHECK OVERFLOW. 003740* 混在モードにすると画面を引き継いだときに画面がクリアされるの 003750* で削除する 003760* USAGE IS MIXED. 003770 01 ACEP-STNO. 003780 02 LINE 24 COLUMN 64 PIC X(06) INTO WRK-STNO 003790 NO IFC CHECK OVERFLOW. 003800 01 DISPUP. 003810 02 LINE 01 COLUMN 01 VALUE ""27"A0221"27"F01". 003820 01 DISPDWN. 003830 02 LINE 01 COLUMN 01 VALUE ""27"A0221"27"G01".
5	Re:分割で旨く投稿できました。その２
	江須扇 2011-6-15 17:24 [返信] [編集] 003840------------------------------------------------------------------------ 003850* 手続き部 003860 PROCEDURE DIVISION. 003870 OPEN-RTN. 003880* 画面をクリアーする。 003890 DISPLAY DISP-CLR. 003900 CALL "CBLSTNNO" USING WRK-STNO. 003910 OPEN I-O MBRKF. 003920* 自分のステーション番号のデータを選び、 003930* 　日付、時間の降順に分類する 003940 PERFORM SELECT-TIME. 003950* １画面目を表示するサブルーティン 003960 PERFORM SCREEN-RTN. 003970* コマンド行の入力ルーティン 003980 PERFORM UNTIL ENDSTS = PF9 003990 PERFORM DISP-RTN 004000* コマンド行にデータを送る 004010 MOVE DSP-SREC2 TO WRK-IN 004020* ヘッダー行とカーソル行リバースとコマンド行を表示する 004030 DISPLAY DISP-HEAD 004040 DISP-LINE-R 004050 ACEP-LINE 004060 ACCEPT ACEP-LINE 004070 EVALUATE ENDSTS 004080 WHEN HTB 004090 WHEN SKP PERFORM CALL-RTN 004100 WHEN BSKP 004110 WHEN UARW 004120 WHEN DWN 004130 WHEN BWD PERFORM BSKP-RTN 004140 WHEN RTN 004150 WHEN DARW 004160 WHEN UPK 004170 WHEN FWD PERFORM RTN-RTN 004180 WHEN ADV MOVE NC"翻訳　　" TO CALL-MOD 004190 PERFORM CALL-RTN 004200 WHEN C1 MOVE NC"一覧表示" TO CALL-MOD 004210 PERFORM CALL-RTN 004220 WHEN C2 MOVE NC"実行　　" TO CALL-MOD 004230 PERFORM CALL-RTN 004240 WHEN PF1 MOVE NC"編集　　" TO CALL-MOD 004250 DISPLAY DISP-MOD 004260 WHEN PF2 MOVE NC"翻訳　　" TO CALL-MOD 004270 DISPLAY DISP-MOD 004280 WHEN PF3 MOVE NC"一覧表示" TO CALL-MOD 004290 DISPLAY DISP-MOD 004300 WHEN PF4 MOVE NC"実行　　" TO CALL-MOD 004310 DISPLAY DISP-MOD 004320 WHEN PF5 MOVE NC"追加　　" TO CALL-MOD 004330 DISPLAY DISP-MOD 004340 WHEN PF6 MOVE NC"置換　　" TO CALL-MOD 004350 DISPLAY DISP-MOD 004360 WHEN PF7 PERFORM SELECT-MEMBER 004370 PERFORM SCREEN-RTN 004380 WHEN PF8 PERFORM SELECT-LIBRARY 004390 PERFORM SCREEN-RTN 004400 WHEN PF15 ACCEPT ACEP-STNO 004410 PERFORM SELECT-TIME 004420 PERFORM SCREEN-RTN 004430 WHEN PF16 MOVE "ADV=NO " TO RUN-ADVN 004440 DISPLAY DISP-ADV 004450 END-EVALUATE 004460 END-PERFORM. 004470 PERFORM CLOSE-RTN. 004480 PERFORM STOP-RTN. 004490------------------------------------------------------------------------ 004500* 抽出サブルーティン　日付時間降順 004510 SELECT-TIME. 004520 SCRATCH MBRKF. 004530 SELECT MBRKF WHERE MKF-STNO = WRK-STNO 004540 ORDER BY DESCENDING KEY MKF-KSHI 004550 DESCENDING KEY MKF-KSTM 004560 COUNT IN REC-CNT. 004570 MOVE ZERO TO REC-CUR. 004580 SELECT-TIME-EXT. 004590 EXIT. 004600------------------------------------------------------------------------ 004610* 抽出サブルーティン　メンバー名昇順、日付時間降順 004620 SELECT-MEMBER. 004630 SCRATCH MBRKF. 004640 SELECT MBRKF WHERE MKF-STNO = WRK-STNO 004650 ORDER BY ASCENDING KEY MKF-MBNM 004660 DESCENDING KEY MKF-KSHI 004670 DESCENDING KEY MKF-KSTM 004680 COUNT IN REC-CNT. 004690 MOVE ZERO TO REC-CUR. 004700 SELECT-MEMBER-EXT. 004710 EXIT. 004720------------------------------------------------------------------------ 004730* 抽出サブルーティン　ライブラリ、メンバー名昇順、日付時間降順 004740 SELECT-LIBRARY. 004750 SCRATCH MBRKF. 004760 SELECT MBRKF WHERE MKF-STNO = WRK-STNO 004770 ORDER BY ASCENDING KEY MKF-LBFL 004780 ASCENDING KEY MKF-MBNM 004790 DESCENDING KEY MKF-KSHI 004800 DESCENDING KEY MKF-KSTM 004810 COUNT IN REC-CNT. 004820 MOVE ZERO TO REC-CUR. 004830 SELECT-LIBRARY-EXT. 004840 EXIT. 004850------------------------------------------------------------------------ 004860* １画面目を表示するサブルーティン 004870 SCREEN-RTN. 004880* レコード件数を保持する 004890 MOVE REC-CNT TO REC-END. 004900* １画面目を表示する為に２０レコードを読み込む 004910 PERFORM WITH TEST AFTER 004920 VARYING LN FROM 2 BY 1 004930 UNTIL LN >= 21 OR ENDSW-ON OR REC-CUR >= REC-END 004940 PERFORM READ-NEXT 004950 END-PERFORM. 004960* １行目にカーソルを合わせる為２０レコードを逆読みする 004970 PERFORM WITH TEST BEFORE 004980 VARYING LN FROM LN BY -1 004990 UNTIL LN <= 2 OR ENDSW-ON OR REC-CUR <= 1 005000 PERFORM DISP-RTN 005010 PERFORM READ-PRIOR 005020 END-PERFORM. 005030 SCRN-EXT. 005040 EXIT. 005050------------------------------------------------------------------------ 005060* 呼出実行サブルーティン 005070 CALL-RTN. 005080* 入力データの編集 005090* 項目毎に分解し、スペースの場合は画面値又は規定値を設定する 005100 MOVE SPACE TO DSP-SREC2 005110 DSP-SREC22. 005120 UNSTRING WRK-IN DELIMITED BY ALL SPACE 005130 INTO DSP-MBNM DSP-LBFL DSP-LBDV 005140 DSP-MBTP DSP-MBSM. 005150 UNSTRING WRK-IN DELIMITED BY ALL SPACE 005160 INTO DSP-MBNM DSP-LBFL DSP-LBDV 005170 DSP-MBTP DSP-LBF2 DSP-LBD2 DSP-MBS2. 005180 IF DSP-LBFL(1:3) = "MSD" OR "RMS" OR "FDU" 005190 THEN MOVE DSP-LBD2 TO DSP-MBS2 005200 MOVE DSP-LBF2(1:3) TO DSP-LBD2 005210 MOVE DSP-MBTP TO DSP-LBF2 005220 DSP-MBSM 005230 MOVE DSP-LBDV(1:3) TO DSP-MBTP 005240 MOVE DSP-LBFL(1:6) TO DSP-LBDV 005250 MOVE DSP-MBNM TO DSP-LBFL 005260 MOVE "" TO DSP-MBNM. 005270 IF DSP-MBNM = SPACE MOVE MKF-MBNM TO DSP-MBNM. 005280 IF DSP-LBFL = SPACE 005290 IF MKF-LBFL = SPACE MOVE "USERSUL" TO DSP-LBFL 005300 ELSE MOVE MKF-LBFL TO DSP-LBFL. 005310 IF DSP-LBDV(1:3) NOT = "MSD" AND "RMS" AND "FDU" 005320 MOVE "MSD" TO DSP-LBDV. 005330 IF DSP-LBD2(1:3) NOT = "MSD" AND "RMS" AND "FDU" 005340 MOVE "MSD" TO DSP-LBD2. 005350 IF DSP-MBTP = SPACE PERFORM TBL-RTN. 005360 EVALUATE CALL-MOD ALSO DSP-MBTP ALSO MKF-MBTP 005370 WHEN NC"翻訳　　" ALSO "COB" ALSO ANY 005380 MOVE "COM" TO DSP-MBTP 005390 WHEN NC"実行　　" ALSO "COB" ALSO "COM" 005400 MOVE "COM" TO DSP-MBTP 005410 WHEN NC"一覧表示" ALSO ANY ALSO ANY 005420 MOVE "DIR" TO DSP-MBTP 005430 WHEN NC"実行　　" ALSO "COB" ALSO ANY 005440 MOVE "COB" TO DSP-MBTP 005450 WHEN NC"実行　　" ALSO "SGL" ALSO ANY 005460 MOVE "SGL" TO DSP-MBTP 005470 WHEN NC"実行　　" ALSO ANY ALSO ANY 005480 MOVE "RUN" TO DSP-MBTP 005490 WHEN NC"追加　　" ALSO ANY ALSO ANY 005500 MOVE "ADD" TO DSP-MBTP 005510 WHEN NC"置換　　" ALSO ANY ALSO ANY 005520 MOVE "REP" TO DSP-MBTP 005530 END-EVALUATE. 005540 IF DSP-MBSM = SPACE MOVE MKF-MBSM TO DSP-MBSM. 005550 EVALUATE DSP-MBTP 005560 WHEN "COM" PERFORM CBL-RTN 005570 WHEN "DIR" PERFORM DIR-RTN 005580 WHEN "RUN" PERFORM RUN-RTN 005590 WHEN "ADD" 005600 WHEN "REP" PERFORM CPY-RTN 005610 WHEN OTHER PERFORM EDIT-RTN 005620 END-EVALUATE 005630 SCRATCH MBRKF. 005640=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 005650* キー無しの場合 005660 CALL "CBLSTNNO" USING WRK-STNO. 005670 SELECT MBRKF WHERE MKF-STNO = WRK-STNO 005680 AND MKF-MBNM = DSP-MBNM 005690 AND MKF-LBFL = DSP-LBFL 005700 AND MKF-LBDV = DSP-LBDV 005710 COUNT IN REC-CNT. 005720 IF REC-CNT > 0 005730 THEN READ MBRKF NEXT 005740 AT END SET ENDSW-ON TO TRUE 005750 NOT END PERFORM MOVE-DATA-RTN 005760 REWRITE MEMBER-REC 005770 END-REWRITE 005780 END-READ 005790 ELSE CLOSE MBRKF 005800 OPEN EXTEND MBRKF 005810 INITIALIZE MEMBER-REC 005820 PERFORM MOVE-KEY-RTN 005830 PERFORM MOVE-DATA-RTN 005840 WRITE MEMBER-REC 005850 END-WRITE 005860 END-IF. 005870 PERFORM CLOSE-RTN. 005880 PERFORM CHAIN-RTN. 005890 PERFORM STOP-RTN. 005900 CALL-EXT. 005910 EXIT. 005920------------------------------------------------------------------------ 005930* １行前進サブルーティン 005940 RTN-RTN. 005950 IF REC-CUR NOT = REC-END 005960 DISPLAY DISP-LINE 005970 IF LN = 21 005980 THEN DISPLAY DISPUP 005990 ADD 1 TO REC-TOP 006000 ELSE ADD 1 TO LN 006010 END-IF 006020 PERFORM READ-NEXT 006030 END-IF. 006040 RTN-EXT. 006050 EXIT. 006060------------------------------------------------------------------------ 006070* 読込みサブルーティン 006080 READ-NEXT. 006090 READ MBRKF NEXT UNLOCK 006100 AT END SET ENDSW-ON TO TRUE 006110 NOT END ADD 1 TO REC-CUR 006120 END-READ. 006130 READ-NXT-EXT. 006140 EXIT. 006150------------------------------------------------------------------------ 006160* １行後退サブルーティン 006170 BSKP-RTN. 006180 IF REC-CUR NOT = 0001 006190 DISPLAY DISP-LINE 006200 IF LN = 02 006210 THEN DISPLAY DISPDWN 006220 SUBTRACT 1 FROM REC-TOP 006230 ELSE SUBTRACT 1 FROM LN 006240 END-IF 006250 PERFORM READ-PRIOR 006260 END-IF. 006270 BSKP-EXT. 006280 EXIT. 006290------------------------------------------------------------------------ 006300* 逆読込みサブルーティン 006310 READ-PRIOR. 006320 READ MBRKF PRIOR UNLOCK 006330 AT END SET ENDSW-ON TO TRUE 006340 NOT END SUBTRACT 1 FROM REC-CUR 006350 END-READ. 006360 READ-PRR-EXT. 006370 EXIT. 006380------------------------------------------------------------------------ 006390* １行表示サブルーティン 006400 DISP-RTN. 006410* スペースの場合は規定値を設定する 006420 MOVE SPACE TO DSP-REC. 006430 MOVE MKF-MBNM TO DSP-MBNM. 006440 MOVE MKF-LBFL TO DSP-LBFL. 006450 MOVE MKF-LBDV TO DSP-LBDV. 006460 MOVE MKF-MBTP TO DSP-MBTP. 006470 IF MKF-MBTP = "ADD" OR "REP" 006480 THEN MOVE MKF-LBF2 TO DSP-LBF2R 006490 MOVE MKF-LBD2 TO DSP-LBD2R 006500 MOVE MKF-MBSM(1:7) TO DSP-MBS2R 006510 ELSE MOVE MKF-MBSM TO DSP-MBSM. 006520 MOVE MKF-KSHI(3:4) TO DSP-KSHI. 006530 MOVE MKF-KSTM(1:2) TO DSP-KSTMH. 006540 MOVE ":" TO DSP-COLON. 006550 MOVE MKF-KSTM(3:2) TO DSP-KSTMM. 006560 DISPLAY DISP-LINE. 006570 DISP-EXT. 006580 EXIT. 006590------------------------------------------------------------------------ 006600* メンバータイプの決定サブルーティン 006610 TBL-RTN. 006620 PERFORM WITH TEST AFTER 006630 VARYING I FROM 1 BY 1 UNTIL I >= 6 OR FLD-CNT > 0 006640 INSPECT DSP-LBFL TALLYING FLD-CNT FOR ALL TBL-LBTP(I) 006650 END-PERFORM. 006660 MOVE TBL-MBTP(I) TO DSP-MBTP. 006670 TBL-EXT. 006680 EXIT. 006690------------------------------------------------------------------------ 006700* ＃ＴＥＤＩＴ呼出項目移送サブルーティン 006710 EDIT-RTN. 006720 MOVE DSP-MBNM TO EDT-MBNM. 006730 MOVE DSP-LBDV TO EDT-LBDV. 006740 MOVE DSP-LBFL TO EDT-LBFL. 006750* ワークファイルサイズ決定サブルーティン 006760 PERFORM WITH TEST AFTER 006770 VARYING I FROM 1 BY 1 UNTIL I >= 6 006780 OR TBL-MBTP(I) = DSP-MBTP 006790 MOVE DSP-MBTP TO EDT-MBTP 006800 END-PERFORM. 006810 MOVE TBL-WKSZ(I) TO EDT-WKSZ. 006820 MOVE EDTCHAIN-REC TO SYSCHAIN-REC. 006830 MOVE EDT-CNT TO CHN-CNT. 006840 EDIT-EXT. 006850 EXIT. 006860------------------------------------------------------------------------ 006870* ＣＢＬ８５呼出項目移送サブルーティン 006880 CBL-RTN. 006890 MOVE DSP-MBNM TO CBL-MBNM. 006900 MOVE DSP-LBDV TO CBL-LBDV. 006910 MOVE DSP-LBFL TO CBL-LBFL. 006920 IF DSP-LBD2 = SPACE 006930 THEN MOVE DSP-LBDV TO CBL-LBD2 006940 ELSE MOVE DSP-LBD2 TO CBL-LBD2. 006950 IF DSP-LBF2 = SPACE 006960 THEN MOVE DSP-LBFL TO CBL-LBF2 006970 ELSE MOVE DSP-LBF2 TO CBL-LBF2. 006980 MOVE CBLCHAIN-REC TO SYSCHAIN-REC. 006990 MOVE CBL-CNT TO CHN-CNT. 007000 DISPLAY DISP-CBL. 007010 CBL-EXT. 007020 EXIT. 007030------------------------------------------------------------------------ 007040* ＃ＬＢＭ呼出項目移送サブルーティン 007050 DIR-RTN. 007060 MOVE DSP-LBDV TO DIR-LBDV. 007070 MOVE DSP-LBFL TO DIR-LBFL. 007080 MOVE DIRCHAIN-REC TO SYSCHAIN-REC. 007090 MOVE DIR-CNT TO CHN-CNT. 007100 DISPLAY DISP-DIR. 007110 DIR-EXT. 007120 EXIT. 007130------------------------------------------------------------------------ 007140* ＬＭ実行呼出項目移送サブルーティン 007150 RUN-RTN. 007160 MOVE DSP-MBNM TO RUN-MBNM. 007170 MOVE DSP-LBDV TO RUN-LBDV. 007180 MOVE DSP-LBFL TO RUN-LBFL. 007190 MOVE RUNCHAIN-REC TO SYSCHAIN-REC. 007200 MOVE RUN-CNT TO CHN-CNT. 007210 RUN-EXT. 007220 EXIT. 007230------------------------------------------------------------------------ 007240* ＃ＬＢＭ複写呼出項目移送サブルーティン 007250 CPY-RTN. 007260* MOVE DSP-MBNM TO CPY-MBNM. 007270 MOVE DSP-LBDV TO CPY-LBDV. 007280 MOVE DSP-LBFL TO CPY-LBFL. 007290 MOVE DSP-LBD2 TO CPY-LBD2. 007300 MOVE DSP-LBF2 TO CPY-LBF2. 007310 MOVE DSP-MBTP TO CPY-MBTP. 007320 MOVE CPYCHAIN-REC TO SYSCHAIN-REC. 007330 MOVE CPY-CNT TO CHN-CNT. 007340 DISPLAY DISP-CPY. 007350 CPY-EXT. 007360 EXIT. 007370------------------------------------------------------------------------ 007380* キー項目移送サブルーティン 007390 MOVE-KEY-RTN. 007400 MOVE WRK-STNO TO MKF-STNO. 007410 MOVE DSP-MBNM TO MKF-MBNM. 007420 MOVE DSP-LBFL TO MKF-LBFL. 007430 MOVE DSP-LBDV TO MKF-LBDV. 007440 MOVE-KEY-EXT. 007450 EXIT. 007460------------------------------------------------------------------------ 007470* データー項目移送サブルーティン 007480 MOVE-DATA-RTN. 007490 MOVE DSP-MBTP TO MKF-MBTP. 007500 IF DSP-MBTP = "ADD" OR "REP" 007510 THEN MOVE DSP-LBF2 TO MKF-LBF2 007520 MOVE DSP-LBD2 TO MKF-LBD2 007530 MOVE DSP-MBS2 TO MKF-MBSM 007540 ELSE MOVE DSP-MBSM TO MKF-MBSM. 007550 ACCEPT MKF-KSHI FROM DATE. 007560 ACCEPT MKF-KSTM FROM TIME. 007570 MOVE-DATA-EXT. 007580 EXIT. 007590* ファイルクローズサブルーティン 007600 CLOSE-RTN. 007610 CLOSE MBRKF. 007620 CLOSE-EXT. 007630 EXIT. 007640------------------------------------------------------------------------ 007650* チェーンサブルーティン 007660 CHAIN-RTN. 007670 CALL "SYSCHAIN" USING SYSCHAIN-REC CHN-CNT. 007680 CHAIN-EXT. 007690 EXIT. 007700------------------------------------------------------------------------ 007710* 終了サブルーティン 007720 STOP-RTN. 007730 STOP RUN. 007740 STOP-EXT. 007750 EXIT.

BluesBB ©Sting_Band