Example of Record Input
MPE documents | |
 Complete PDF | |
| Table of Contents | |
| Index |
- TEMPEMP
Information file about temporary employees:
- PERMEMP
Information file about permanent employees:
Last Name First Name Employee Number Hire Date Gangley, Tomas 000003 06/06/87 Rields, Evelyn 000007 07/12/87 Everett, Joyce 000029 10/19/87 0 1 2 3 4 5 6 7 1234567890123456789012345678901234567890123456789012345678901234567890
Last Name First Name Employee Number Hire Date Jones, Eliza 000001 06/06/87 Smith, James 000005 06/06/87 Jackson, Johnathon 000006 06/06/87 Washington, Lois 000014 07/23/87 Jackson, Rosa 000022 08/15/87 0 1 2 3 4 5 6 7 1234567890123456789012345678901234567890123456789012345678901234567890
$standard_level system
program SORTREC_INPUT
C
C This program reads the files TEMPEMP and PERMEMP, alters the
C TEMPEMP records, passes all records to SORT/XL, and outputs to
C the file ALLEMP.
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,OUTFILENUM
4 ,STATUS
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
call OPEN_FILES
call DO_SORT
call CLOSE_FILES
stop
end
C
subroutine OPEN_FILES
C
system intrinsic HPFOPEN
2 ,QUIT
C
integer DESIGNATOR
2 ,DOMAIN
3 ,ACCESS
4 ,RECORD_SIZE
5 ,PERMANENT
6 ,NEW
7 ,WRITE
8 ,SIZE
9 ,TEMPFILENUM
A ,PERMFILENUM
B ,OUTFILENUM
C ,STATUS
C
character TEMPFILE*10
2 ,PERMFILE*10
3 ,OUTFILE*10
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
DESIGNATOR = 2
DOMAIN = 3
ACCESS = 11
RECORD_SIZE = 19
C
TEMPFILE = '%TEMPEMP%'
PERMANENT = 1
call HPFOPEN (TEMPFILENUM, STATUS, DESIGNATOR,
2 ,TEMPFILE, DOMAIN, PERMANENT)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on TEMPFILE. Terminating.'
endif
C
PERMFILE = '%PERMEMP%'
call HPFOPEN (PERMFILENUM, STATUS, DESIGNATOR,
2 ,PERMFILE, DOMAIN, PERMANENT)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on PERMEMP. Terminating.'
call QUIT (2)
endif
C
NEW = 4
WRITE = 1
SIZE = 80
OUTFILE = '%ALLEMP%'
call HPFOPEN (OUTFILENUM, STATUS, DESIGNATOR,
2 ,OUTFILE, DOMAIN, NEW, ACCESS, WRITE,
3 ,RECORD_SIZE, SIZE)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on ALLEMP. Terminating.'
call QUIT (3)
endif
C
return
end
C
subroutine DO_SORT
C
system intrinsic HPSORTINIT
2 ,HPSORTERRORMESS
3 ,HPSORTEND
4 ,HPSORTINPUT
5 ,FREAD
6 ,QUIT
C
integer OUTPUT_OPTION
2 ,NUMKEYS
3 ,LENGTH
4 ,OUTPUTFILE(2)
5 ,KEYS(4)
6 ,TEMPFILENUM
7 ,PERMFILENUM
8 ,OUTFILENUM
9 ,STATUS
A ,RECLENGTH
C
integer*2 LNGTH
C
logical EOF
C
character ALTSEQ*2
2 ,MESSAGE*80
3 ,BUFFER*80
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
OUTPUTFILE(1) = OUTFILENUM
OUTPUTFILE(2) = 0
OUTPUT_OPTION = 0
RECLENGTH = 80
NUMKEYS = 1
KEYS(1) = 1
KEYS(2) = 20
KEYS(3) = 0
KEYS(4) = 0
ALTSEQ(1:1) = CHAR(255)
ALTSEQ(2:2) = CHAR(255)
call HPSORTINIT (STATUS,, OUTPUTFILE, OUTPUT_OPTION
2 ,RECLENGTH,, NUMKEYS, KEYS, ALTSEQ)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
LENGTH = 72
EOF = .false.
C Read TEMPEMP file. Start with a priming read. If EOF is not
C found on the priming read, call HPSORTINPUT to put the record
C into the sort, then read and input until EOF is found.
LNGTH = FREAD (TEMPFILENUM, BUFFER, LENGTH)
if (ccode()) 10,30,20
10 print *, 'FREAD error on TEMPFILE'
call QUIT (10)
20 EOF = .true.
30 continue
do while ( .not. EOF)
BUFFER(40:40) = '*'
call HPSORTINPUT (STATUS, BUFFER, LENGTH)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *, MESSAGE
endif
C Read the next record. CCG indicates EOF has been found.
LNGTH = FREAD (TEMPFILENUM, BUFFER, LENGTH)
if (ccode()) 40,60,50
40 print *, 'FREAD error on TEMPFILE'
call QUIT (40)
50 EOF = .true.
60 continue
end do
C Now read PERMEMP, as explained above.
EOF = .false.
LNGTH = FREAD (PERMFILENUM, BUFFER, LENGTH)
if (ccode()) 70,90,80
70 print *, 'FREAD error on PERMEMP.'
call QUIT (70)
80 EOF = .true.
90 continue
do while (.not. EOF)
call HPSORTINPUT (STATUS, BUFFER, LENGTH)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *, MESSAGE
endif
LNGTH = FREAD (PERMFILENUM, BUFFER, LENGTH)
if (ccode()) 100,120,110
100 print *, 'FREAD error on PERMEMP'
call QUIT (100)
110 EOF = .true.
120 continue
end do
call HPSORTEND (STATUS)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
return
end
C
subroutine CLOSE_FILES
C
system intrinsic FCLOSE
C
integer*2 DISPOSITION
2 ,SECURITYCODE
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,OUTFILENUM
4 ,STATUS
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
DISPOSITION = 0
SECURITYCODE = 0
C
call FCLOSE (TEMPFILENUM, DISPOSITION, SECURITYCODE)
call FCLOSE (PERMFILENUM, DISPOSITION, SECURITYCODE)
DISPOSITION = 1
call FCLOSE (OUTFILENUM, DISPOSITION, SECURITYCODE)
return
end
When this program is executed, the output is written to ALLEMP.
To view ALLEMP:
:print allemp Everett, Joyce *000029 10/19/87 Gangley, Tomas *000003 06/06/87 Jackson, Jonathan 000006 06/06/87 Jackson, Rosa 000022 08/15/87 Jones, Eliza 000001 06/06/87 Rields, Evelyn *000007 07/12/87 Smith, James 000005 06/06/87 Washington, Lois 000014 07/23/87
|
Example of Core Merging Routine |
Example of Record Output |