033700 SHRKNR-RTN SECTION. 033800* 033900 PERFORM VARYING IX1 FROM 1 BY 1 034000 UNTIL IX1 > 5 034100 MOVE V-ATTR-PRT TO YA-B(IX1) 034200 MOVE V-ATTR-PRT TO SGRP-B(IX1) 034300 MOVE V-ATTR-PRT TO SGRPMEI-B(IX1) 034400 END-PERFORM. 034500* 034900 MOVE SPACE TO SPA-DATA. 035000 MOVE ZERO TO CNT. 035100 IF SPA-PAGE = 1 035200 MOVE SPACE TO B0290-SKEY 035300 MOVE SPA-KAISYA TO B0290-KAISYACD 035400 B0290-SHRGPL(1:1) 035500***************************************** 035600 PERFORM CODE-RTN 035700 MOVE SPA-CODE TO B0290-SHRGPL(2:1) 035800 PERFORM FKUBUN-RTN 035900 PERFORM VARYING IX1 FROM 1 BY 1 036000 UNTIL IX1 > 3 036100 IF SPA-F-CODE(IX1) NOT = SPACE 036200 MOVE SPA-F-CODE(IX1) TO B0290-SHRGPL 036300 READ SHRKNR-M INVALID CONTINUE 036400 NOT INVALID 036500 IF ((B0290-KAKUTEI(1) = SPACE) AND 036600 (B0290-ISHIME2(1) = SPACE) AND 036700 (B0290-SHRYTI(1) >= TODAY)) OR 036800 ((B0290-KAKUTEI(2) = SPACE) AND 036900 (B0290-ISHIME2(2) = SPACE) AND 037000 (B0290-SHRYTI(2) >= TODAY)) OR 037100 ((B0290-KAKUTEI(3) = SPACE) AND 037200 (B0290-ISHIME2(3) = SPACE) AND 037300 (B0290-SHRYTI(3) >= TODAY)) 037400 ADD 1 TO CNT 037500 MOVE NC"⇒" TO YA(CNT) 037600 MOVE V-ATTR-1JIC TO YA-C(CNT) 037700 MOVE B0290-SHRGPL TO SGRP(CNT) 037800 SPA-SGRP(CNT) 037900 MOVE B0290-SHRGLMEI TO SGRPMEI(CNT) 038000 MOVE V-ATTR-PRT TO SGRP-C(CNT) 038100 MOVE V-ATTR-PRT TO SGRPMEI-C(CNT) 038200 END-IF 038300 ELSE 038400 MOVE 4 TO IX1 038500 END-IF 038600 END-PERFORM 038700 MOVE SPACE TO B0290-SKEY 038800 MOVE SPA-KAISYA TO B0290-KAISYACD 038900 B0290-SHRGPL(1:1) 039000 MOVE SPA-CODE TO B0290-SHRGPL(2:1) 039100 ELSE 039200 IF PF8-FLG = "Y" 039300 MOVE SPA-NEXT-KEY TO B0290-SKEY 039400 MOVE SPACE TO PF8-FLG 039500 ELSE 039600 MOVE SPA-SKEY(SPA-PAGE) TO B0290-SKEY 039700 END-IF 039800 END-IF. 039900 MOVE SPACE TO SPA-NEXT-KEY. 040000 START SHRKNR-M KEY NOT < B0290-SKEY 040100 INVALID GO TO SHRKNR-EXIT 040200 END-START. 040300 ADD 1 TO CNT. 040400 PERFORM VARYING IX1 FROM CNT BY 1 040500 UNTIL IX1 > 6 040600 READ SHRKNR-M NEXT AT END MOVE 8 TO IX1 040700 END-READ 040800 IF SPA-KAISYA NOT = B0290-KAISYACD 040900 MOVE 7 TO IX1 041000 ELSE 041100 IF SPA-KAISYA NOT = B0290-SHRGPL(1:1) 041200 MOVE 7 TO IX1 041300 ELSE 041400 IF (SPA-KAISYA = "A") AND 041500 (SPA-CODE NOT = B0290-SHRGPL(2:1)) 041600 MOVE 7 TO IX1 041700 ELSE 041800 IF IX1 > 5 041900 IF IX1 = 8 042000 CONTINUE 042100 ELSE 042200 MOVE B0290-SKEY TO SPA-NEXT-KEY 042300 END-IF 042400 ELSE 042500 IF IX1 = 1 042600 IF SPA-PAGE > 10 042700 MOVE 8 TO IX1 042800 ELSE 042900 MOVE B0290-SKEY TO 043000 SPA-SKEY(SPA-PAGE) 043100 END-IF 043200 END-IF 043300 IF SPA-PAGE > 10 043400 MOVE "E" TO SW-ERR 043500 MOVE NC"表示限界！！" TO ERMSG 043600 MOVE 8 TO IX1 043700 ELSE 043800 MOVE SPACE TO CHK-FLG 043900 PERFORM VARYING IX2 FROM 1 BY 1 044000 UNTIL IX2 > 3 044100 IF SPA-F-CODE(IX2) NOT = SPACE 044200 IF SPA-F-CODE(IX2) = B0290-SHRGPL 044300 MOVE "Y" TO CHK-FLG 044400 END-IF 044500 END-IF 044600 END-PERFORM 044700 IF CHK-FLG = "Y" 044800 COMPUTE IX1 = IX1 - 1 044900 ELSE 045000 IF ((B0290-KAKUTEI(1) = SPACE) AND 045100 (B0290-ISHIME2(1) = SPACE) AND 045200 (B0290-SHRYTI(1) >= TODAY)) OR 045300 ((B0290-KAKUTEI(2) = SPACE) AND 045400 (B0290-ISHIME2(2) = SPACE) AND 045500 (B0290-SHRYTI(2) >= TODAY)) OR 045600 ((B0290-KAKUTEI(3) = SPACE) AND 045700 (B0290-ISHIME2(3) = SPACE) AND 045800 (B0290-SHRYTI(3) >= TODAY)) 045900 MOVE NC"⇒" TO YA(IX1) 046000 MOVE V-ATTR-1JIC TO YA-C(IX1) 046100 MOVE B0290-SHRGPL TO SGRP(IX1) 046200 SPA-SGRP(IX1) 046300 MOVE B0290-SHRGLMEI TO SGRPMEI(IX1) 046400 MOVE V-ATTR-PRT TO SGRP-C(IX1) 046500 MOVE V-ATTR-PRT TO SGRPMEI-C(IX1) 046600 ELSE 046700 COMPUTE IX1 = IX1 - 1 046800 END-IF 046900 END-IF 047000 END-IF 047100 END-IF 047200 END-IF 047300 END-IF 047400 END-IF 047500 END-PERFORM. 047600* 047700 SHRKNR-EXIT. 047800 EXIT.