◆ No.79(1998年6月号)の回答-1
基本表
----------------------------- カレンダーの作成は（株）ピップスワールドのテキ
日付 曜 当番 スト応用編に載っております。これを参考に左の基本
----------------------------- 表を当番カレンダーバインダーの１ページに作成して
木 おきます。完成当番カレンダー用として２ページも用
金 意しておきます。プログラムを実行する前に、左表の
土 "曜"項目の４行の曜日を作成年度の４月１日の曜日に
日 ROLL指令で修正します。
月 "日付"列の桁数=14
火 "曜 "列の桁数= 4 項目名は右寄せ
水 "当番"列の桁数= 5 項目名は右寄せ
-----------------------------
このプログラムはプログラム集にテキストファイルがあります。
<TOUBAN>
G;当番ｶﾚﾝﾀﾞｰ/1;DEFINE "#ERR"="IF ERR(0)=55 THEN GOTO $END";
$S: ACCEPT "4行の曜日を作成年度の4月1日の曜日に修正しましたか？(Y/N)",V1;
#ERR;IF V1<>"N" AND "Y" THEN GOTO $S;IF V1="N" THEN GOTO $END;
$SS: ACCEPT "作成するカレンダーは西暦何年ですか？ ",V2;#ERR;
DISP OPEN(8,26,18,26)/N,COLOR(R),V2; /* V2=西暦 */
$SSS: ACCEPT "入力した西暦はＯＫですか？(Y/N) ",V1;CLOSE;#ERR;
IF V1<>"N" AND "Y" THEN GOTO $SSS;IF V1="N" THEN GOTO $SS;
$H: ACCEPT "班編成は何班ですか？",V3;#ERR; /* V3=班数=X3 */
DISP OPEN(8,26,18,26)/N,COLOR(R),V3;LET X3=VAL(V3);
$HH: ACCEPT "入力した班数はＯＫ？(Y/N),V1;CLOSE;#ERR;
IF V1<>"N" AND "Y" THEN GOTO $H;IF V1="N" THEN GOTO $H;
$D: ACCEPT "4月に第一班が最初に就労する日は何日ですか？",V4;#ERR;
DISP OPEN(8,26,18,26)/N,COLOR(R),V4; /* V4=1班就労日=X4 */
$DD: ACCEPT "入力した日にちはＯＫ？(Y/N)",V1;CLOSE;#ERR;
IF V1<>"N" AND "Y" THEN GOTO $DD;IF V1="N" THEN GOTO $DD;
DISP OPEN/N,[24,10],COLOR(G,RV),V2+"年度 当番カレンダー作成中";
LET X4=VAL(V4);LET X5=X4+3;LET V4=V2+"0401"; /* X5=1班就労日行 */
G;当番ｶﾚﾝﾀﾞｰ/2;SET;M;;3;;;;CPR;A;4*55;ATR;N;D;1;NUM;M;C;1;4;%V4;1;
NF;S;1;6/2*4;DC;1/3/5;
P;当番ｶﾚﾝﾀﾞｰ/2;NUM;M;C;4;%X5;1;1/%V3/C;DRL;C;1;DRL;C;N;
CJ;N;N;A;2;CJ;N;N;A;3;IR;;2;;DRL;R;3;ATR;R;2,3;P;*;GROUP;;;2;;AAA/D;
FILL/P;AAA;AAA;日;4;3;Y;Y;FILL/P;AAA;AAA;月;2;5;Y;Y;
FOR X1=1 TO 13; /* V6=月名 */
G;AAA/%X1;LET V6=[6,2];LET V6=FORM$(V6,5);FILL;%V6;2;4;;P;*;NEXT;
DC/P;AAA;AAA;2;Y;Y;G;AAA/1;IR;S;T+1;;INFO;;250;P;*;
FOR X1=2 TO 13;CA;;%X1;A;SA;;;;NEXT;IF X4=1 THEN GOTO $新;
LET X7=X3-X4+2;LET V7=NUM$(X7);LET [6,4]=V7;IF X4=2 THEN GOTO $新;
FILL;@N;7,%(X5+1);4;; /* V7=4月1日の班番 */
$新: FILL;@N;32,35;62/64;;CPB;6,63;14;63;27,63;LET V2=FORM$(V2,5);
CT;%V2年 当番カレンダー;P;当番ｶﾚﾝﾀﾞｰ/2;CLOSE;
$END: STOP
