HP 3000 Manuals HP 3000 Manuals
Example of Record Output
The following program sorts the personnel files shown for the last
example. They are sorted by last name. The output records are altered
before they are output.
Example D-4. SORTREC_OUTPUT Program
$standard_level system
program SORTREC_OUTPUT
C
C This program reads the files TEMPEMP and PERMEMP, sorts them by last
C name, outputs them by record, alters the output recors, and prints the
C record to $STDLIST.
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,STATUS
C
common /PARMS/ TEMPFILENUM, PERMFILENUM, 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 ,PERMANENT
5 ,TEMPFILENUM
6 ,PERMFILENUM
7 ,STATUS
C
character TEMPFILE*10
2 ,PERMFILE*10
C
common /PARMS/ TEMPFILENUM, PERMFILENUM, STATUS
C
DESIGNATOR = 2
DOMAIN = 3
ACCESS = 11
Example D-4. SORTREC_OUTPUT Program, continued
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.'
call QUIT (1)
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
return
end
C
subroutine DO_SORT
C
system intrinsic HPSORTINIT
2 ,HPSORTERRORMESS
3 ,HPSORTEND
4 ,HPSORTINPUT
5 ,HPSORTOUTPUT
6 ,QUIT
C
integer OUTPUT_OPTION
2 ,NUMKEYS
3 ,LENGTH
4 ,INPUTFILES(3)
5 ,KEYS(4)
6 ,TEMPFILENUM
7 ,PERMFILENUM
8 ,STATUS
C
character ALTSEQ*2
2 ,MESSAGE*80
3 ,BUFFER*80
C
common /PARMS/ TEMPFILENUM, PERMFILENUM, STATUS
C
Example D-4. SORTREC_OUTPUT Program, continued
INPUTFILES(1) = TEMPFILENUM
INPUTFILES(2) = PERMFILENUM
INPUTFILES(3) = 0
LENGTH = 1
C
OUTPUT_OPTION = 0
C
NUMKEYS = 1
KEYS(1) = 1
KEYS(2) = 20
KEYS(3) = 0
KEYS(4) = 0
C
ALTSEQ(1:1) = CHAR(255)
ALTSEQ(2:2) = CHAR(255)
C
call HPSORTINIT (STATUS, INPUTFILES,, OUTPUT_OPTION
2 ,,, NUMKEYS, KEYS, ALTSEQ)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
C
do while (LENGTH .gt. 0)
call HPSORTOUTPUT (STATUS, BUFFER, LENGTH)
BUFFER(33:39) = 'Empl. #'
BUFFER(50:59) = 'Hire Date:'
print *,BUFFER
if (STATUS .ne. 0) then
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
end do
C
call HPSORTEND (STATUS)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
C
return
end
C
Example D-4. SORTREC_OUTPUT Program, continued
subroutine CLOSE_FILES
C
system intrinsic FCLOSE
C
integer*2 DISPOSITION
2 ,SECURITYCODE
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,STATUS
C
common /PARMS/ TEMPFILENUM, PERMFILENUM, STATUS
C
DISPOSITION = 0
SECURITYCODE = 0
C
call FCLOSE (TEMPFILENUM, DISPOSITION, SECURITYCODE)
call FCLOSE (PERMFILENUM, DISPOSITION, SECURITYCODE)
C
return
end
When this program is executed, the output is written to the screen:
_____________________________________________________________________________
| |
| |
| Everett, Joyce Empl. # 000029 Hire Date: 10/19/87 |
| Gangley, Tomas Empl. # 000003 Hire Date: 06/06/87 |
| Jackson, Jonathan Empl. # 000006 Hire Date: 06/06/87 |
| Jackson, Rosa Empl. # 000022 Hire Date: 08/15/87 |
| Jones, Eliza Empl. # 000001 Hire Date: 06/06/87 |
| Rields, Evelyn Empl. # 000007 Hire Date: 07/12/87 |
| Smith, James Empl. # 000005 Hire Date: 06/06/87 |
| Washington, Lois Empl. # 000014 Hire Date: 07/23/87 |
| |
_____________________________________________________________________________