Google
オフコン練習帳内を検索
インターネット全体を検索

NECオフコン関連
オフコン一般
情報
Re:分割で旨く投稿できました。その2

投稿者: 江須扇 投稿日時: 2011-6-15 17:24:34


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*    1画面目を表示するサブルーティン
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*    1画面目を表示するサブルーティン
004870 SCREEN-RTN.
004880*    レコード件数を保持する
004890     MOVE REC-CNT TO REC-END.
004900*    1画面目を表示する為に20レコードを読み込む
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*    1行目にカーソルを合わせる為20レコードを逆読みする
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*    1行前進サブルーティン
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*    1行後退サブルーティン
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*    1行表示サブルーティン
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*    #TEDIT呼出項目移送サブルーティン
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*    CBL85呼出項目移送サブルーティン
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*    #LBM呼出項目移送サブルーティン
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*    LM実行呼出項目移送サブルーティン
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*    #LBM複写呼出項目移送サブルーティン
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.



名前※
題名
メッセージ url email imgsrc image code quote
サンプル
bold italic underline linethrough  



 [もっと...]
パスワード※
オプション ※印の項目をクッキーに保存