HP 3000 Manuals HP 3000 Manuals
Examples The following examples of user procedures will all compile into one segment named "userprcs".
NOTE Use these examples for reference only.
Example of an #RJIN Integer Procedure This is an example of an integer procedure for use in an #RJIN command. It reads records from an input file and passes them to RJE. $control subprogram,uslinit,segment=userprcs begin intrinsic print,quit,fopen,fclose,fread,fwrite,fcheck,ascii; intrinsic command; << EXAMPLE 1 >> << This is an example of a INTEGER PROCEDURE for use in a #RJIN command >> << It reads records from an input file and passes them to RJE. >> INTEGER PROCEDURE inproc(target);array target; begin logical array infile (0:20); <<Array to contain input file name >> integer ccode = q-1; <<Condition Code passed through Q-1 >> integer rec'size = db+0; <<Global DB+0 contains infile record size >> integer length; << parameter of FREAD function >> integer in'fnum=db+1; <<Global DB+1 contains the FILE # >> logical file'open=db+2; <<Global DB+2 contains a file open flag >> integer fs'errcode; << parameter of RCHECK >> byte array error'msg (0:40); << to print error messages >> if (not file'open) then <<check if input file is open >> begin rec'size := -80; <<Input record size equals 80 bytes >> move infile := "anyfile "; <<Assign the input file name >> in'fnum := fopen(infile,1,0); <<Open input file "anyfile >> if <> then <<check for file system error during>> begin << FOPEN failed - call FCHECK to determine error and print >> << error message to RJE user. Also return >> << condition code CCL to indicate error. >> FCHECK(in'fnum,fs'errcode); move error'msg := "INFILE FOPEN FAILED (FSERR = ) "; ASCII(fs'errcode,10,error'msg(30)); PRINT (error'msg,-35,%40); ccode.(6:2) :=1; end else << FOPEN was successful - set file open flag >> file'open := true; end; << if not file'open>> if file'open then begin <<Infile is open - read the next record in the file >> length := FREAD(in'fnum,target,rec'size); if = then begin <<FREAD was successful - set condition code to CCE and >> << length of new record to INPROC >> ccode.(6:2):=2; inproc := length; end else if > then begin <<FREAD returned an EOT condition >> << All records have been read >> << condition code to CCG, close input file, >> << and reset file'open >> ccode.(6:2):= 0; FCLOSE(in'fnum,1,0); file'open :=false; end begin <<FREAD failed - call FCHECK to determine error and print >> << message to RJE user. Also return a >> << code CCL to indicate error. >> FCHECK(in'fnum,fs'errcode); move error'msg :="INFILE FREAD FAILED (FSERR = )"; ASCII(fs'errcode,10,error'msg(30)); PRINT (error'msg,-35,%40); ccode.(6:2) :=1; FCLOSE(in'fnum,1,0); in'fnum := 0; file'open := false; end; end; << file'open >> end; << procedure INPROC >> #RJOUT, #RJLIST, #RJPUNCH Output Procedure Example This is an example of an #RJOUT, #RJLIST, or #RJPUNCH output procedure. This procedure accepts output records from RJE and writes them to an output file. PROCEDURE outproc(target,count); value count; integer count; array target; begin logical eot= Q-7; << flag passed from RJE >> logical array outfile(0:20); <<Array to contain output file name integer out'fnum=db+4; <<Global DB+4 contains the FILE # >> logical file'open=db+5; <<Global DB+5 is file open flag >> integer fs'errcode; <<Return parameter of RCHECK >> integer error,parm; <<and Intrinsic parameters >> byte array error'msg(0:40); << to print error messages >> byte array cmdstring(0:40); << for input to command >> if (not eot) and (count <> 0 ) then begin if (not file'open) then <<check if output file is open >> begin move cmdstring := "purge anyfile2 ",2; move * := %15; command(cmdstring,error,parm); if <> then quit(error); move cmdstring := "build anyfile2;rec=-80,1,f,ascii ",2; move * := %15; command(cmdstring,error,parm); if <> then quit(error); move outfile := "anyfile2 "; out'fnum := fopen(outfile,1,1);<< outfile file "anyfile2 >> if <> then <<check for file system error during FOPEN >> begin << FOPEN failed - call FCHECK to determine error and print >> << error message to RJE user. Also call the MPE>> << intrinsic QUIT to abort RJE >> FCHECK(out'fnum,fs'errcode); move error'msg := "OUTFILE FOPEN FAILED (FSERR = )"; ASCII(fs'errcode,10,error'msg(31)); PRINT (error'msg,-40,%40); QUIT(fs'errcode); end else <<FOPEN was successful - set file open flag >> file'open := true; end; << IF not file'open >> << Outfile is open - write output record to OUTFILE >> FWRITE (out'fnum,target,count,0); if <> then begin <<FWRITE failed - call FCHECK to determine error and print >> << error message to RJE user. Also call the MPE >> << intrinsic QUIT to abort RJE >> FCHECK(out'fnum,fs'errcode); move error'msg := "OUTFILE FWRITE FAILED (FSERR = )"; ASCII(fs'errcode,10,error'msg(31)); PRINT (error'msg,-40,%40); FCLOSE(out'fnum,1,0); QUIT(fs'errcode); end; < <> then> > end << of not eot >> else << RJE sent EOT indicator in Q-7,>> << all output records have been received>> <<CLOSE the outfile and reset file'open.>> begin FCLOSE(out'fnum,1,0); file'open := false; out'fnum :=0; end; end; << procedure outproc>> Example of an #RJSTAT User-Written Procedure This procedure accepts statistic records from the #RJSTAT commands and is intended to describe the structure of such a procedure. PROCEDURE statproc(target,count); value count; integer count; array target; begin byte pointer bptr; @bptr :=@target&lsl(1); if bptr <> "***" then <<check if end of statistic screen >> begin << USER PROVIDED APPLICATION HERE >> end else begin << STATISTIC records complete - finish application >> end; end; << procedure statproc>> Example of an #RJCONTINUE User-Written Procedure The following procedure determines whether the error that occurred was an RVI and, if so, prints a message and switches execution to another command file. procedure rvi (filenum,errors,comimage,newfname,action); integer filenum, action; integer array errors; byte array comimage; byte array newfname; begin intrinsic print; integer irrecov; byte array message (0:28); irrecov:=errors(2).(8:8); if((errors(0)=1) land (errors(1)=2) land (irrecov=206))then begin move message:="SWITCHING TO RVI COMMAND FILE"; move newfname:="RVIFILE"; print (message,-29,0); action:=2; end; end; END. << Of user procedures >>