000010**************************************************************
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. SAMPLE01.
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000060 SPECIAL-NAMES.
000070 COPY XTXSPNM. *> ASPSymfo用
000080 CONSOLE IS CONSOLE.
000090*
000100**************************************************************
000110 INPUT-OUTPUT SECTION.
000120**************************************************************
000130*
000140 FILE-CONTROL.
000150* SELECT KAN-F ASSIGN TO VI-KANSTL1
000160* ORGANIZATION IS INDEXED
000170* ACCESS MODE IS DYNAMIC
000180* FILE STATUS IS F-STS
000190* LOCK MODE IS AUTOMATIC
000200* RECORD KEY IS DAT-KBN DAT-CODE.
000210*
000220**************************************************************
000230 DATA DIVISION.
000240 FILE SECTION.
000250**************************************************************
000260*
000270*FD KAN-F.
000280*01 DAT-REC.
000290* 02 DAT-KBN PIC 9(02).
000300* 02 DAT-CODE PIC 9(03).
000310* 02 DAT-SUCHI1 PIC S9(09)V9(02) PACKED-DECIMAL.
000320* 02 DAT-SUCHI2 PIC S9(09)V9(02) PACKED-DECIMAL.
000330* 02 DAT-KANJI PIC N(20).
000340* 02 DAT-KANA PIC X(40).
000350* 02 DAT-AKI PIC X(23).
000360*
000370**************************************************************
000380 WORKING-STORAGE SECTION.
000390**************************************************************
000400*
000410 01 IX1 PIC 9(08) BINARY.
000420 01 IX2 PIC 9(08) BINARY.
000430 01 TODAY.
000440 02 WK-YEAR PIC 9(04).
000450 02 WK-MONTH PIC 9(02).
000460 02 WK-DAY PIC 9(02).
000470 02 WK-HH PIC 9(02).
000480 02 WK-MM PIC 9(02).
000490 02 WK-SS PIC 9(02).
000500 02 FILLER PIC X(07).
000510 01 WORK-AREA.
000520 02 F-STS PIC X(02).
000530 02 ERR-SW PIC X(03).
000540 02 END-SW PIC X(03).
000550 02 WK-CNT PIC 9(08) BINARY.
000560*
000570* ASPSymfo用(BEGIN)
000580 01 DAT-REC.
000590 02 DAT-KBN PIC 9(02).
000600 02 DAT-CODE PIC 9(03).
000610 02 DAT-SUCHI1 PIC S9(09)V9(02) PACKED-DECIMAL.
000620 02 DAT-SUCHI2 PIC S9(09)V9(02) PACKED-DECIMAL.
000630 02 DAT-KANJI PIC N(20).
000640 02 DAT-KANA PIC X(40).
000650 02 DAT-AKI PIC X(23).
000660*
000670 COPY XTXWK.
000680 COPY KANMSTL1 REPLACING ==KAN1-REC== BY ==CSV-KAN1-R==
000690 ==PACKED-DECIMAL== BY ====.
000700 COPY KANMSTL1 REPLACING ==KAN1-REC== BY ==WK-KAN1-R==.
000710* ASPSymfo用(END)
000720*
000730**************************************************************
000740 PROCEDURE DIVISION.
000750**************************************************************
000760*
000770 PERFORM INIT-RTN.
000780 PERFORM MAIN-RTN UNTIL END-SW = "END".
000790 PERFORM TERM-RTN.
000800*
000810**************************************************************
000820 MAIN-RTN SECTION.
000830**************************************************************
000840*
000850 PERFORM READ-NEXT-KAN-F
000860 IF XTXO5510-COND = XTX-ATEND
000870 MOVE "END" TO END-SW
000880 ELSE
000890 ADD 1 TO WK-CNT
000900 END-IF.
000910*
000920****************************************************************
000930 INIT-RTN SECTION.
000940****************************************************************
000950*
000960 INITIALIZE WORK-AREA.
000970 MOVE SPACE TO END-SW.
000980 PERFORM OPEN-INPUT-KAN-F.
000990 IF F-STS NOT = ZERO
001000 DISPLAY "KAN-F OPEN ERR STS=" F-STS UPON CONSOLE
001010 EXIT PROGRAM.
001020 INITIALIZE DAT-REC.
001030 MOVE 1 TO DAT-KBN.
001040 MOVE 100 TO DAT-CODE.
001050 PERFORM START-G-E-KAN-F.
001060 IF XTXO5510-COND = XTX-INVALID
001070 DISPLAY "KAN-F START INVALID STS=" F-STS UPON CONSOLE
001080 MOVE "END" TO END-SW.
001090*
001100****************************************************************
001110 TERM-RTN SECTION.
001120****************************************************************
001130*
001140 PERFORM CLOSE-KAN-F.
001150 IF F-STS NOT = ZERO
001160 DISPLAY "KAN-F CLOSE ERR STS=" F-STS UPON CONSOLE.
001170 DISPLAY "KAN-F CNT=" WK-CNT UPON CONSOLE.
001180 EXIT PROGRAM.
001190*
001200****************************************************************
001210*
001220* ASPSymfo用(BEGIN)
001230 COPY XTXPROC.
001240 COPY XTXFILE REPLACING ==(FNAME)== BY ==KAN-F==
001250 ==(FNAME-VALUE)== BY =="KAN-F"==
001260 ==(ENVNAME-VALUE)== BY =="KANMSTL1"==
001270 ==(PGMID-VALUE)== BY =="SAMPLE01"==
001280 ==(ACCESS)== BY ==DYNAMIC==
001290 ==(CSVREC)== BY ==CSV-KAN1-R==
001300 ==(WORKREC)== BY ==WK-KAN1-R==
001310 ==(DATAREC)== BY ==DAT-REC==
001320 ==(F-STS)== BY ==F-STS==
001330 ==(EXCEPTION)== BY ==CONTINUE==.
001340* ASPSymfo用(END)
001350*
001360****************************************************************