Example of Record Output

   $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


   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


         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


         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