000010******************************************************************
000020*
000030* POPPY OF THE DAY (POTD) - 今日の花言葉を表示する
000040* $Id: POTD.cbl,v 1.5 2007/08/02 12:37:40 nzawa Exp nzawa $
000050*
000060******************************************************************
000070 IDENTIFICATION DIVISION.
000080 PROGRAM-ID. POTD.
000090 DATA DIVISION.
000100 WORKING-STORAGE SECTION.
000110 01 FLOWER-TBL.
000120* *** 01 *************************************************
000130 03 FILLER PIC X(30)
000140 VALUE 'アジサイ'.
000150 03 FILLER PIC X(48)
000160 VALUE '移り気'.
000170* *** 02 *************************************************
000180 03 FILLER PIC X(30)
000190 VALUE 'カバノキ'.
000200 03 FILLER PIC X(48)
000210 VALUE 'あなたの落ち着きと優しさが素敵'.
000220* *** 03 *************************************************
000230 03 FILLER PIC X(30)
000240 VALUE 'スイセン'.
000250 03 FILLER PIC X(48)
000260 VALUE 'もう一度愛してほしい'.
000270* *** 04 *************************************************
000280 03 FILLER PIC X(30)
000290 VALUE 'ツユクサ'.
000300 03 FILLER PIC X(48)
000310 VALUE 'なつかしい関係'.
000320* *** 05 *************************************************
000330 03 FILLER PIC X(30)
000340 VALUE 'ノーゼンハレン'.
000350 03 FILLER PIC X(48)
000360 VALUE '勝利'.
000370* *** 06 *************************************************
000380 03 FILLER PIC X(30)
000390 VALUE 'ハナミズキ'.
000400 03 FILLER PIC X(48)
000410 VALUE '私の想ひを受けてください'.
000420* *** 07 *************************************************
000430 03 FILLER PIC X(30)
000440 VALUE 'ムラサキツユクサ'.
000450 03 FILLER PIC X(48)
000460 VALUE '尊敬してゐます'.
000470* *** 08 *************************************************
000480 03 FILLER PIC X(30)
000490 VALUE 'ヤマユリ'.
000500 03 FILLER PIC X(48)
000510 VALUE '荘厳'.
000520* *** 09 *************************************************
000530 03 FILLER PIC X(30)
000540 VALUE 'リンドウ'.
000550 03 FILLER PIC X(48)
000560 VALUE '悲しんでゐるあなたを愛する'.
000570* *** 10 *************************************************
000580 03 FILLER PIC X(30)
000590 VALUE 'ワスレナグサ'.
000600 03 FILLER PIC X(48)
000610 VALUE '私を忘れないで'.
000620* *** 11 *************************************************
000630 03 FILLER PIC X(30)
000640 VALUE 'アイスランドポピー'.
000650 03 FILLER PIC X(48)
000660 VALUE '慰め'.
000670* *** 12 *************************************************
000680 03 FILLER PIC X(30)
000690 VALUE 'コスモス'.
000700 03 FILLER PIC X(48)
000710 VALUE '乙女の真心'.
000720* *** 13 *************************************************
000730 03 FILLER PIC X(30)
000740 VALUE 'ストレリチア'.
000750 03 FILLER PIC X(48)
000760 VALUE '全てを手に入れる'.
000770* *** 14 *************************************************
000780 03 FILLER PIC X(30)
000790 VALUE 'ディモルフォセカ'.
000800 03 FILLER PIC X(48)
000810 VALUE '元気'.
000820* *** 15 *************************************************
000830 03 FILLER PIC X(30)
000840 VALUE 'ナナカマド'.
000850 03 FILLER PIC X(48)
000860 VALUE '慎重'.
000870* *** 16 *************************************************
000880 03 FILLER PIC X(30)
000890 VALUE 'ヒマラヤユキノシタ'.
000900 03 FILLER PIC X(48)
000910 VALUE '順応'.
000920* *** 17 *************************************************
000930 03 FILLER PIC X(30)
000940 VALUE 'ムギワラギク'.
000950 03 FILLER PIC X(48)
000960 VALUE 'いつも覚えてゐたい'.
000970* *** 18 *************************************************
000980 03 FILLER PIC X(30)
000990 VALUE 'ユーカリ'.
001000 03 FILLER PIC X(48)
001010 VALUE '新生'.
001020* *** 19 *************************************************
001030 03 FILLER PIC X(30)
001040 VALUE 'レモン'.
001050 03 FILLER PIC X(48)
001060 VALUE '心からの思慕'.
001070* *** 20 *************************************************
001080 03 FILLER PIC X(30)
001090 VALUE 'ワサビ'.
001100 03 FILLER PIC X(48)
001110 VALUE 'うれし涙'.
001120* *** 21 *************************************************
001130 03 FILLER PIC X(30)
001140 VALUE 'エンゼルトランペット'.
001150 03 FILLER PIC X(48)
001160 VALUE '偽りの魅力'.
001170* *** 22 *************************************************
001180 03 FILLER PIC X(30)
001190 VALUE 'ビオラ'.
001200 03 FILLER PIC X(48)
001210 VALUE '私の事を想つて'.
001220* *** 23 *************************************************
001230 03 FILLER PIC X(30)
001240 VALUE 'タチアオイ'.
001250 03 FILLER PIC X(48)
001260 VALUE '野心'.
001270* *** 24 *************************************************
001280 03 FILLER PIC X(30)
001290 VALUE 'サクラソウ'.
001300 03 FILLER PIC X(48)
001310 VALUE '初恋'.
001320* *** 25 *************************************************
001330 03 FILLER PIC X(30)
001340 VALUE 'ヒガンバナ'.
001350 03 FILLER PIC X(48)
001360 VALUE '悲しい想ひ出'.
001370* *** 26 *************************************************
001380 03 FILLER PIC X(30)
001390 VALUE 'カトレア'.
001400 03 FILLER PIC X(48)
001410 VALUE '優美な貴婦人'.
001420* *** 27 *************************************************
001430 03 FILLER PIC X(30)
001440 VALUE 'ユキヤナギ'.
001450 03 FILLER PIC X(48)
001460 VALUE '愛らしさ'.
001470* *** 28 *************************************************
001480 03 FILLER PIC X(30)
001490 VALUE 'オミナエシ'.
001500 03 FILLER PIC X(48)
001510 VALUE '美人'.
001520* *** 29 *************************************************
001530 03 FILLER PIC X(30)
001540 VALUE 'シャスターデージー'.
001550 03 FILLER PIC X(48)
001560 VALUE '平和'.
001570* *** 30 *************************************************
001580 03 FILLER PIC X(30)
001590 VALUE 'ヨイマチグサ'.
001600 03 FILLER PIC X(48)
001610 VALUE '浴後の美人'.
001620* *** 31 *************************************************
001630 03 FILLER PIC X(30)
001640 VALUE 'アガパンサス'.
001650 03 FILLER PIC X(48)
001660 VALUE '恋の訪れ'.
001670*
001680 01 FILLER REDEFINES FLOWER-TBL.
001690 03 FILLER OCCURS 31.
001700 05 FLOWER-NAME PIC X(30).
001710 05 FLOWER-LANG PIC X(48).
001720*
001730 01 WORK-AREA.
001740 03 TODAY.
001750 05 FILLER PIC 9(06) VALUE ZERO.
001760 05 TODAY-DD PIC 9(02) VALUE ZERO.
001770 03 STREND PIC 9(03) VALUE ZERO.
001780 03 RESULT PIC X(94) VALUE SPACE.
001790*
001800 PROCEDURE DIVISION.
001810 MAIN SECTION.
001820 ACCEPT TODAY FROM DATE YYYYMMDD.
001830 STRING
001840 '' DELIMITED BY SIZE
001850 FLOWER-NAME (TODAY-DD) DELIMITED BY SPACE
001860 ' （' DELIMITED BY SIZE
001870 FLOWER-LANG (TODAY-DD) DELIMITED BY SPACE
001880 '）
' DELIMITED BY SIZE
001890 INTO RESULT
001900 END-STRING.
001910 INSPECT RESULT TALLYING STREND
001920 FOR CHARACTERS BEFORE INITIAL ' '.
001930 DISPLAY 'Content-Type: text/plain; charset=UTF-8'.
001940 DISPLAY ''.
001950 DISPLAY '今日の花言葉
'.
001960 DISPLAY RESULT ( 1 : STREND ).
001970 STOP RUN.
001980** END OF PROGRAM