This program prints detailed employee records for all male employees from a personnel file. The input records are arranged in ascending order of employee number. Both the input file and output file are externally described.
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
A* PHYSICAL FILE DDS FOR PERSONNEL FILE IN FORMATFILE EXAMPLE
A
A UNIQUE
A R PERSREC
A EMPLNO 6S
A NAME 30
A ADDRESS1 35
A ADDRESS2 20
A BIRTHDATE 6
A MARSTAT 1
A SPOUSENAME 30
A NUMCHILD 2S
A K EMPLNO ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
A* PRINTER FILE DDS FOR FORMATFILE EXAMPLE
A*
A 1 INDARA REF(PERSFILE)
A R HEADING 2 SKIPB(1) SPACE(3) 3
A 15'PERSONNEL LISTING'
A UNDERLINE
A 33'- ORDERED BY'
A ORDERTYPE 15 46
A 80DATE EDTCDE(Y)
A 93TIME 4
A 115'PAGE:'
A +1PAGNBR EDTCDE(3)
A*
A R DETAIL 5 SPACEA(3) 6
A* LINE 1
A 1'NAME:'
A NAME R 11UNDERLINE
A 55'EMPLOYEE NUMBER:'
A EMPLNO R 73
A 87'DATE OF BIRTH:'
A BIRTHDATE R 103SPACEA(1) 7
A* LINE 2
A 1'ADDRESS:'
A ADDRESS1 R 11
A 55'MARITAL STATUS:'
A MARSTAT R 73
A 01 87'SPOUSE''S NAME:'
A 01 8 SPOUSENAMER 103
A* LINE 3
A ADDRESS2 R 11SPACEB(1)
A 55'CHILDREN:'
A NUMCHILD R 73EDTCDE(3) 9 5722WDS V5R4M0 060210 LN IBM CBLGUIDE/FRMTFILE ISERIES1 06/02/15 14:35:57 Page 2 S o u r c e STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 1 000100 IDENTIFICATION DIVISION. 2 000200 PROGRAM-ID. FRMTFILE. 000300 3 000400 ENVIRONMENT DIVISION. 4 000500 CONFIGURATION SECTION. 5 000600 SOURCE-COMPUTER. IBM-ISERIES 6 000700 OBJECT-COMPUTER. IBM-ISERIES 7 000800 INPUT-OUTPUT SECTION. 8 000900 FILE-CONTROL. 9 001000 SELECT PERSREPT ASSIGN TO FORMATFILE-PERSREPT-SI 1 11 001100 ORGANIZATION IS SEQUENTIAL. 12 001200 SELECT PERSFILE ASSIGN TO DATABASE-PERSFILE 14 001300 ORGANIZATION IS INDEXED 15 001400 ACCESS MODE IS SEQUENTIAL 16 001500 RECORD IS EXTERNALLY-DESCRIBED-KEY. 001600 17 001700 DATA DIVISION. 18 001800 FILE SECTION. 19 001900 FD PERSREPT. 20 002000 01 PERSREPT-REC. 002100 COPY DDS-ALL-FORMATS-O OF PERSREPT. 2 21 +000001 05 PERSREPT-RECORD PIC X(130). <-ALL-FMTS +000002* OUTPUT FORMAT:HEADING FROM FILE PERSREPT OF LIBRARY CBLGUIDE <-ALL-FMTS +000003* <-ALL-FMTS 22 +000004 05 HEADING-O REDEFINES PERSREPT-RECORD. <-ALL-FMTS 23 +000005 06 ORDERTYPE PIC X(15). <-ALL-FMTS +000006* OUTPUT FORMAT:DETAIL FROM FILE PERSREPT OF LIBRARY CBLGUIDE <-ALL-FMTS +000007* <-ALL-FMTS 24 +000008 05 DETAIL-O REDEFINES PERSREPT-RECORD. 3 <-ALL-FMTS 25 +000009 06 NAME PIC X(30). <-ALL-FMTS 26 +000010 06 EMPLNO PIC S9(6). <-ALL-FMTS 27 +000011 06 BIRTHDATE PIC X(6). <-ALL-FMTS 28 +000012 06 ADDRESS1 PIC X(35). <-ALL-FMTS 29 +000013 06 MARSTAT PIC X(1). <-ALL-FMTS 30 +000014 06 SPOUSENAME PIC X(30). <-ALL-FMTS 31 +000015 06 ADDRESS2 PIC X(20). <-ALL-FMTS 32 +000016 06 NUMCHILD PIC S9(2). <-ALL-FMTS 33 002200 FD PERSFILE. 34 002300 01 PERSFILE-REC. 002400 COPY DDS-ALL-FORMATS-O OF PERSFILE. 35 +000001 05 PERSFILE-RECORD PIC X(130). <-ALL-FMTS +000002* I-O FORMAT:PERSREC FROM FILE PERSFILE OF LIBRARY CBLGUIDE <-ALL-FMTS +000003* <-ALL-FMTS +000004*THE KEY DEFINITIONS FOR RECORD FORMAT PERSREC <-ALL-FMTS +000005* NUMBER NAME RETRIEVAL ALTSEQ <-ALL-FMTS +000006* 0001 EMPLNO ASCENDING NO <-ALL-FMTS 36 +000007 05 PERSREC REDEFINES PERSFILE-RECORD. <-ALL-FMTS 37 +000008 06 EMPLNO PIC S9(6). <-ALL-FMTS 38 +000009 06 NAME PIC X(30). <-ALL-FMTS 39 +000010 06 ADDRESS1 PIC X(35). <-ALL-FMTS 40 +000011 06 ADDRESS2 PIC X(20). <-ALL-FMTS 41 +000012 06 BIRTHDATE PIC X(6). <-ALL-FMTS 42 +000013 06 MARSTAT PIC X(1). <-ALL-FMTS
5722WDS V5R4M0 060210 LN IBM CBLGUIDE/FRMTFILE ISERIES1 06/02/15 14:35:57 Page 3 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 43 +000014 06 SPOUSENAME PIC X(30). <-ALL-FMTS 44 +000015 06 NUMCHILD PIC S9(2). <-ALL-FMTS 002500 45 002600 WORKING-STORAGE SECTION. 46 002700 77 HEAD-ORDER PIC X(15) 002800 VALUE "EMPLOYEE NUMBER". 47 002900 01 PERSREPT-INDICS. 003000 COPY DDS-ALL-FORMATS-O-INDIC OF PERSREPT. 4 48 +000001 05 PERSREPT-RECORD. <-ALL-FMTS +000002* OUTPUT FORMAT:HEADING FROM FILE PERSREPT OF LIBRARY CBLGUIDE <-ALL-FMTS +000003* <-ALL-FMTS +000004* 06 HEADING-O-INDIC. <-ALL-FMTS +000005* OUTPUT FORMAT:DETAIL FROM FILE PERSREPT OF LIBRARY CBLGUIDE <-ALL-FMTS +000006* <-ALL-FMTS 49 +000007 06 DETAIL-O-INDIC. <-ALL-FMTS 50 +000008 07 IN01 PIC 1 INDIC 01. <-ALL-FMTS 003100 51 003200 77 EOF-FLAG PIC X(1) 003300 VALUE "0". 52 003400 88 NOT-END-OF-FILE VALUE "0". 53 003500 88 END-OF-FILE VALUE "1". 54 003600 77 MARRIED PIC X(1) 003700 VALUE "M". 003800 55 003900 PROCEDURE DIVISION. 004000 MAIN-PROGRAM SECTION. 004100 MAINLINE. 56 004200 OPEN INPUT PERSFILE 004300 OUTPUT PERSREPT. 57 004400 PERFORM HEADING-LINE. 58 004500 PERFORM UNTIL END-OF-FILE 59 004600 READ PERSFILE 60 004700 AT END SET END-OF-FILE TO TRUE 61 004800 NOT AT END PERFORM PRINT-RECORD 5 004900 END-READ 005000 END-PERFORM 62 005100 CLOSE PERSFILE 005200 PERSREPT. 63 005300 STOP RUN. 005400 005500 PRINT-RECORD. 64 005600 MOVE CORR PERSREC TO DETAIL-O. 6 *** CORRESPONDING items for statement 64: *** EMPLNO *** NAME *** ADDRESS1 *** ADDRESS2 *** BIRTHDATE *** MARSTAT *** SPOUSENAME *** NUMCHILD *** End of CORRESPONDING items for statement 64 65 005700 IF MARSTAT IN PERSFILE-REC IS EQUAL MARRIED THEN 7 66 005800 MOVE B"1" TO IN01 IN DETAIL-O-INDIC 005900 ELSE 67 006000 MOVE B"0" TO IN01 IN DETAIL-O-INDIC 006100 END-IF 68 006200 WRITE PERSREPT-REC FORMAT IS "DETAIL" 8 006300 INDICATORS ARE DETAIL-O-INDIC 69 006400 AT EOP PERFORM HEADING-LINE 9 006500 END-WRITE. 006600 006700 HEADING-LINE. 70 006800 MOVE HEAD-ORDER TO ORDERTYPE 71 006900 WRITE PERSREPT-REC FORMAT IS "HEADING" 007000 END-WRITE. 007100 * * * * * E N D O F S O U R C E * * * * *
(C) Copyright IBM Corporation 1992, 2006. All Rights Reserved.