              <<< VAXAXP::NOTES$:[NOTES$LIBRARY]VMSNOTES.NOTE;1 >>>
               -< VAX and Alpha VMS - Digital Internal Use Only >-
================================================================================
Note 295.5               PSM$ Filter Routine in Fortran                   5 of 5
PADKOA::VOUTERS "Philippe VOUTERS, Evry (France)"   150 lines  15-APR-1997 09:57
                                -< This works >-
--------------------------------------------------------------------------------
    Hello Volker,
    
    Below is a User Written Print Symbiont which works (i.e.: the lat port
    returns to the Idle State). 
    The INPUT_FILTER routine does not filter anything.
    Best regards,
    Philippe VOUTERS (working with Gerard-Louis)
    
$ create extern.for
c
c
c       These are the external symbols used by both the main
c       program and the subroutine
c
       EXTERNAL psm$k_page_header,psm$k_start_task,psm$k_read
       EXTERNAL smbmsg$k_file_specification,ss$_normal
       EXTERNAL psm$k_open,psm$_funnotsup,psm$_eof,psm$k_format
       EXTERNAL psm$k_input_filter,psm$m_lat_protocol
       EXTERNAL smbmsg$k_account_name,smbmsg$k_user_name
$ create testsymbiont.for
c
c       This is the main program. It modifies the VMS print symbiont
c       to put a header at the top of each page containing the account,
c       filename, and username.  The steps here are
c       1) call psm$replace to tell the VMS symbiont which routine you
c          want to replace
c       2) call psm$print to tell the symbiont we're ready to start
c          processing requests
c
       PROGRAM testsymbiont
       IMPLICIT INTEGER*4(A-Z)
       PARAMETER STREAMS = 1              ! Single stream
       EXTERNAL header
       EXTERNAL input_filter
       INCLUDE 'EXTERN.FOR'
       code = %LOC(psm$k_page_header)     ! Replace page header routine
       stat = psm$replace(code,header)    ! Tell the job controller
       IF (.NOT.stat) CALL lib$signal(%VAL(stat))
       code = %LOC(psm$k_input_filter)     ! Replace page header routine
       stat = psm$replace(code,input_filter)! Tell the job controller
       IF (.NOT.stat) CALL lib$signal(%VAL(stat))
       options = %LOC(psm$m_lat_protocol)
       stream = STREAMS
       stat = psm$print(stream,,,,options)! Tell the job controller
c                                          ! We're ready
       IF (.NOT.stat) CALL lib$signal(%VAL(stat))
       END

       INTEGER*4 function input_filter(context,work_area,func,
     1     funcdesc,funcarg,funcdesc2,funcarg2)
       IMPLICIT INTEGER*4(A-Z)
       INCLUDE 'extern.for'

       IF (func.EQ.%LOC(psm$k_format)) GOTO 100
       stat = %LOC(psm$_funnotsup)
       GOTO 200
100    funcarg2 = funcarg
       stat = str$copy_dx(funcdesc2,funcdesc)
       stat = %LOC(SS$_NORMAL)
200    input_filter = stat
       RETURN
       END
       INTEGER*4 function header(context,work_area,func,
     1     funcdesc,funcarg)
       IMPLICIT INTEGER*4(A-Z)
       INCLUDE 'extern.for'
       CHARACTER*12 user,account
       CHARACTER*60 file
       CHARACTER*126 header_line
       CHARACTER*132 output_line
c
c       Select the correct routine to branch to depending on the
c       function code that the job controller sent us
c       In this example, only two functions are performed.
c       More could be added.
c
       IF (func.EQ.%LOC(psm$k_start_task)) GOTO 220
       IF (func.EQ.%LOC(psm$k_read))       GOTO 250
       stat = %LOC(psm$_funnotsup)
       GOTO 1000

*
*       Start a new file
*
220    page = 0
       line = 2
       code = %LOC(smbmsg$k_account_name)        ! Get the acct name
       stat = psm$read_item_dx(context,code,account)
       IF (.NOT.stat) GOTO 1000
       code = %LOC(smbmsg$k_file_specification)  ! Get the filespec
       stat = psm$read_item_dx(context,code,file)
       IF (.NOT.stat) GOTO 1000
       code = %LOC(smbmsg$k_user_name)
       stat = psm$read_item_dx(context,code,user) ! Get the user name
       IF (.NOT.stat) GOTO 1000
       stat = str$trim(account,account,acct_len)  ! Trim spaces
       stat = str$trim(file,file,file_len)
       stat = str$trim(user,user,user_len)
       header_line = ' '
c
c       Here, we format the line that will appear at the top of each
c       page.  The page number is added in the page header routine
c       itself (starting at line 250).
       WRITE(header_line,30)account(1:acct_len),user(1:user_len),
     1    file(1:file_len)
30     FORMAT('Account [',a,',',a,'] File:',a,'  page:')
       stat = %LOC(SS$_NORMAL)
       GOTO 1000
*
*       Read a page header
*

250    line = line -1
       IF (line.EQ.0) GOTO 260
       IF (line.LT.0) GOTO 270
       page = page + 1
       stat = str$trim(header_line,header_line,header_line_len)
c
c       Take the prototype line that we build as a result of being
c       called the first time and append the page number
c
       WRITE(output_line,60)header_line(1:header_line_len),page
60     FORMAT(a,I4)
       stat = str$trim(output_line,output_line,output_line_len)
       stat = str$copy_dx(funcdesc,output_line(1:output_line_len))
       GOTO 1000
c
c       output a line of dashes
c
260    DO i=1,80
       output_line(i:i) = '-'
       ENDDO
       stat = str$copy_dx(funcdesc,output_line(1:80))
       GOTO 1000
270    line = 2          !Here if we're done with the header
       stat = %LOC(PSM$_EOF)
1000   header = stat
       RETURN
       END
$ create symbols.mar
       .LIBRARY/SYS$LIBRARY:LIB.MLB/
;
;       This routine gives us the psm and smb symbols used above
;
       $PSMDEF       GLOBAL
       $SMBDEF GLOBAL
       .END
$ mac/list symbols
$ fort/list/machine testsymbiont
$ link/exe=sys$system:testsymbiont.exe testsymbiont,symbols
