*PROC CIRREQ01 *----------------------------------------------------------------------------- * * Title: Patron Request Report * File: PATRQT01.PRC * Author: Information Dimensions, Inc. (TD) * * Description: A list of patron requests * * Input Parameters: * OUTPUT - may be 'REVIEW','PRINT'. Review displays report * on screen, print outputs to file for printing. * * START_DATE/END_DATE - find where CIRC_REQUEST.ADD_DT * is in range * * CIRC_SORT_KEY - option to sort by title, patron name, * or patron id * * HOLD_SORT_KEY - option to sort by title, patron id, * patron name, or call number. * * Other Selection Criteria: * LIBR_KEY - Restrict to certain libraries. * * ALL - Boolean value; set true by Slang if no params entered * * Output File: patrqt01.rpt * * Record Types Referenced: * TEMPLATE, COPY, CAT, CIRC_REQUEST * Buffers: @A @B @C @D * * Report Name: Cairculation Requests * * Report No.: PATRQT01 * * Menu Access: CATALOG REPORTS * * Parameter * Input Screen: CATRPT12 * * Templates: REPORT_HDR, BIB_PATRON, COPY_NOCIRC, COPY_NOCIRC_S, * PATRON_REQUEST. * *------------------------------------------------------------------------------ * * Revision History: * * Date Revised By Description * -------- ---------- ----------- * 11/20/89 DeFrench Initial Version * 03/28/91 Sandstrom Add LIBR_KEY to find commands. * 04/25/91 Sandstrom Add MATERIAL_TYPE to FIND commands. * 07/03/91 MChung Substitute tabs with 8 spaces and * spelling checks * *------------------------------------------------------------------------------ * START: ACQUIRE/PV MESSAGE 46707, C2=MSG TELL MSG,$B ON/BREAK BREAKERR ON/EXCEPTION EXCEPTION ON/SYNTAX SYNTAXERR SET/DEFAULT RESULT = N SET/PV PV_TODAY = $YYYYMMDD SET/PV PRINTTOP = 1 SET/PV RPTNM = 'PATRQT01' SET/PV RPTTTL = 'Circulation/Holds report' SET/PV PGNO = 0 * Set up for desired output method SELECT (OUTPUT) CASE 'REVIEW' SET/PV MAXLINES = 20 SET/PV PV_FILEID = '' CASE 'PRINT' SET/PV MAXLINES = 60 OPEN/F patrqt01.rpt, FID=A, INTENT=WRITE, + CARRIAGE=YES, ERR=OPENERR SET/PV PV_FILEID = ',FID=A' END_SELECT * GET/VIEW [TEMPLATE_KEY = 'REPORT_HDR']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV HEADER = TEXT@A GET/VIEW [TEMPLATE_KEY='REQ_HDR']TEMPLATE@A, ERR=VIEWERR ASSIGN/PV REQ_HDR = TEXT@A GET/VIEW [TEMPLATE_KEY = 'PATRON_REQUEST']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV RQTINFO = TEXT@A GET/VIEW [TEMPLATE_KEY = 'BIB_PATRON']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV CATINFO = TEXT@A GET/VIEW [TEMPLATE_KEY = 'COPY_NOCIRC']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV COPYINFO = TEXT@A GET/VIEW [TEMPLATE_KEY = 'COPY_NOCIRC_S']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV SCOPYINFO = TEXT@A SET/PV CALLOC = 'CATR' * * Begin construction of FIND command. * SET/PV PV_FINDCMD = 'FIND CIRC_REQUEST,CATR,COPY,material_type ' //+ 'WHERE CIRC_REQUEST.CATNO:=CATR.CATNO ' //+ 'AND CIRC_REQUEST.ITEMID:=COPY.ITEMID ' //+ 'AND MATERIAL_TYPE.TYPE:=CATR.MTYPE '//+ 'AND CIRC_REQUEST.REQUEST_TYPE=''C'' ' * * Add Library to find. * DELETE/GV OUTLC DELETE/GV OUTSTR DELETE/GV INSTR SET/GV INSTR = LIBR_KEY @/PL='$TLP_PROC/generpts' QTBLKS01, VFLDNM='COPY.LIBR_KEY' SET/PV SAVE_OUTSTR = '(' //OUTSTR SET/PV PV_FINDCMD = PV_FINDCMD // 'AND (' // OUTSTR //' ' * DELETE/GV OUTLC DELETE/GV OUTSTR DELETE/GV INSTR SET/GV INSTR = LIBR_KEY @/PL='$TLP_PROC/generpts' QTBLKS01, + VFLDNM='CIRC_REQUEST.PLACED_LIBR_KEY' SET/PV SAVE_OUTSTR = SAVE_OUTSTR// ' OR ' //OUTSTR //') ' SET/PV PV_FINDCMD = PV_FINDCMD // 'OR ' // OUTSTR //') ' * * Add the date fields if they were passed. * IF (START_DATE <> '') SET/PV PV_FINDCMD = PV_FINDCMD //+ ' AND CIRC_REQUEST.ADD_DT = '//START_DATE//':'//END_DATE//' ' END_IF * * Append FIND for sort options. * SET/PV PV_FINDCMD = PV_FINDCMD //+ ' ORDER BY !CIRC_SORT_KEY!, CATR.TI,CATR.PUBL, COPY.YEAR, ' //+ 'COPY.LIBR_KEY, COPY.ITEMID, COPY.COPY' * * If output option is equal to 'PRINT', then delete the records * as they are printed. * IF OUTPUT = 'PRINT' START/TRANS SW=CIRC_REQUEST END_IF * * Execute Find and set up for report generation * !PV_FINDCMD! END REF=NO ACQUIRE/PV MEMBERS, N1 = PV_NUMMEM ACQUIRE/PV LASTSET, N1 = PV_FOUNDSET JUMPIF (PV_NUMMEM = 0), DO_HOLDS * * Write initial header. * IF OUTPUT = 'REVIEW' CLEAR/SCREEN SET/PV LINE_CNT =2 ELSE TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! END_IF * SET/PV PGNO = PGNO + 1 TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! TYPE !REQ_HDR!, $S2, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 8 * * Step through members of set, generating correct output for each. * FOR PV_Q = 1, PV_NUMMEM * GET/VIEW [!PV_FOUNDSET!,!PV_Q!]CIRC_REQUEST@D, ERR = VIEWERR GET/VIEW [!PV_FOUNDSET!,!PV_Q!]CATR@B, ERR = VIEWERR GET/VIEW [!PV_FOUNDSET!,!PV_Q!]COPY@C, ERR = VIEWERR * ASSIGN/PV CATDOC = CATR.DOC@B IF CATDOC = 'SER' TYPE !CATINFO!,!SCOPYINFO!,!RQTINFO!,LABELS=NO, SKIP=1, + SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! SET/PV LINE_CNT = LINE_CNT + 12 ELSE TYPE !CATINFO!,!COPYINFO!,!RQTINFO!,LABELS=NO, SKIP=1, + SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! SET/PV LINE_CNT = LINE_CNT + 12 END_IF IF OUTPUT = 'PRINT' DELETE [!PV_FOUNDSET!,!PV_Q!]CIRC_REQUEST END_IF * * Check for a page break. * IF LINE_CNT > MAXLINES IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT =2 ELSE TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! END_IF * SET/PV PGNO = PGNO + 1 TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 7 END_IF * END_FOR ***************************************************** ***************************************************** DO_HOLDS: * * Begin construction of the HOLDS FIND command. * SET/PV PV_FINDCMD = 'FIND CIRC_REQUEST,CATR,COPY,MATERIAL_TYPE ' //+ 'WHERE CIRC_REQUEST.CATNO:=CATR.CATNO ' //+ 'AND CIRC_REQUEST.ITEMID:=COPY.ITEMID ' //+ 'AND MATERIAL_TYPE.TYPE:=CATR.MTYPE '//+ 'AND CIRC_REQUEST.REQUEST_TYPE=''H'' '//+ 'AND ' // SAVE_OUTSTR // ' ' * * Add the date fields if they were passed. * IF (START_DATE <> '') SET/PV PV_FINDCMD = PV_FINDCMD //+ ' AND CIRC_REQUEST.ADD_DT = '//START_DATE//':'//END_DATE//' ' END_IF * * Append FIND for sort options. * SET/PV PV_FINDCMD = PV_FINDCMD //+ ' ORDER BY !HOLD_SORT_KEY!, CATR.TI,CATR.PUBL, COPY.YEAR, ' //+ 'COPY.LIBR_KEY, COPY.ITEMID, COPY.COPY' * * Execute Find and set up for report generation * !PV_FINDCMD! END REF=NO ACQUIRE/PV MEMBERS, N1 = PV_NUMMEM ACQUIRE/PV LASTSET, N1 = PV_FOUNDSET JUMPIF (PV_NUMMEM = 0), CLEANUP * * Write initial header. * IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT =2 ELSE TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! END_IF * SET/PV PGNO = PGNO + 1 TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 7 * * Step through members of set, generating correct output for each. * FOR PV_Q = 1, PV_NUMMEM * GET/VIEW [!PV_FOUNDSET!,!PV_Q!]CIRC_REQUEST@D, ERR = VIEWERR GET/VIEW [!PV_FOUNDSET!,!PV_Q!]CATR@B, ERR = VIEWERR GET/VIEW [!PV_FOUNDSET!,!PV_Q!]COPY@C, ERR = VIEWERR * ASSIGN/PV HOLDTYPE = CIRC_REQUEST.HOLD_TYPE@D SET/PV RHOLDTYPE = $RAISE(HOLDTYPE) IF RHOLDTYPE = 'COPY' TYPE $S2, 'COPY level hold for:' + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! ELSE TYPE $S2, 'CAT level hold for:' + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! END_IF * * Choose the serials copy info if item is a serial. * ASSIGN/PV CATDOC = CATR.DOC@B IF CATDOC = 'SER' TYPE !CATINFO!,!SCOPYINFO!,!RQTINFO!,LABELS=NO, SKIP=1, + SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! SET/PV LINE_CNT = LINE_CNT + 12 ELSE TYPE !CATINFO!,!COPYINFO!,!RQTINFO!,LABELS=NO, SKIP=1, + SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! SET/PV LINE_CNT = LINE_CNT + 12 END_IF * * Delete the occurrence if print is selected * IF OUTPUT = 'PRINT' DELETE [!PV_FOUNDSET!,!PV_Q!]CIRC_REQUEST END_IF * * Check for a page break. * IF LINE_CNT > MAXLINES IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT =2 ELSE TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! END_IF * SET/PV PGNO = PGNO + 1 TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 7 END_IF * END_FOR * * Cleanup - close files and discard result sets. * CLEANUP: ACQUIRE/PV MESSAGE 46708, C2=MSG TELL MSG ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' QUIT: ACQUIRE/PV LASTSET, N1 = PV_LASTSET DISCARD !PV_FOUNDSET!:!PV_LASTSET! SET/DEF RESULT = Y IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE FINISH/TRANS END_IF * * DONE - successful report generation; return to caller * DONE: RETURN_TO_SCREEN * * Error - inform user and close file, if necessary. * SYNTAXERR: EXCEPTION: OPENERR: VIEWERR: SHOW/MESSAGE !DMSTAT! JUMP ERROR BREAKERR: SHOW/MESSAGE 46700 ERROR: SHOW/MESSAGE 46703 IF (OUTPUT <> 'REVIEW') CLOSE/FILE FID = A,ERR=$CONTINUE ABORT/TRANSACTION, ERR=$CONTINUE END_IF SET/DEF RESULT = Y ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' RETURN_TO_SCREEN *PROC FILOPN01 *----------------------------------------------------------------------------- * * Title: Generic File Open * File: FILOPN01.PRC * Author: Information Dimensions, Inc. (BPM) * * Description: This proc is designed as a subroutine that is called from * other TLP procs to correctly open files in cases where the * file may already exist. * * Input Parameters: * FIL The file descriptor to be opened. * ID The file ID to be assigned to this file. * Called by: Any report that has an OPEN/FILE. * Call: @/PL='$TLP_PROC/generpts' FILOPN01 FIL=!A!, ID=!B! *------------------------------------------------------------------------------ * Revision History * * Date Rev. Revised By Description * --------- ---------- -------------------------------- * 04/07/93 BMOORE Initial version *----------------------------------------------------------------------------- * START: * * Open the file. * OPEN/FILE FD=!FIL! FID=!ID! INTENT=WRITE CARRIAGE=NO ERR=OPENERR SET/GV FILE_STATUS = 'OK' RETURN * * If error occurs, attempt to delete existing file and then open the file. * OPENERR: * DELETE/FILE !FIL! OPEN/FILE FD=!FIL! FID=!ID! INTENT=WRITE CARRIAGE=NO ERR=OPENER2 SET/GV FILE_STATUS = 'OK' RETURN * * If still unable to open the file, display message and return. * OPENER2: * SET/GV FILE_STATUS = 'OPEN_ERROR' TELL 'File cannot be opened. Contact your DBA' RETURN *PROC GENPRT01 *----------------------------------------------------------------------------- * * Title: Generic Print Routine * File: GENPRT01.PRC * Author: Information Dimensions, Inc. (BPM) * * Description: This proc is designed as a subroutine that is called from * other TLP procs to allow custom printing of reports. * The proc uses the ROUTE/FILE command to route a file to the * printer of chice. Consult the BASISplus Command Procedures * manual for additional parameters. Optionally, you can use * a SPAWN command to call local procedures for printing. * * Input Parameters: * FIL The file descriptor to be sent to the printer. * ERROR_FLG is 'Y' if called from within error branch of * the calling proc. * * Called by: Any report that generates a printable file. * * Call: @/PL=TLP$PROC:GENERPTS.LIB GENPRT01 FIL=!A! ERROR_FLG='N' *------------------------------------------------------------------------------ * Revision History * * Date Rev. Revised By Description * --------- ---------- -------------------------------- * 04/08/93 BMOORE Initial version *----------------------------------------------------------------------------- * ON/EXCEPTION $RETURN START: * **** ROUTE/FILE FD=!FIL! RETURN *PROC MAROUT01 *----------------------------------------------------------------------------- * * Title: Marc Output * File: MAROUT01.PRC * Author: Information Dimensions, Inc. (HB) * * Description: Create Marc Input file records that can be run using the Marc * program * * Input Parameters: * OUTPUT - may be 'REVIEW','PRINT'. Review displays report * on screen, print outputs to file. * * FORMAT - may be set to OCLC, LC, or PC * * BLOCKSIZE - the length of each line in output file * * FIND_CAT - where part of find command for cat record * * FIND_COPY - where part of find command for copy record * * CATNO - a string of CATNO's to search on * * Valid Combinations: * OUTPUT, FORMAT, and BLOCKSIZE are required. * User may enter one of: FIND_CAT OR FIND_COPY OR CATNO * * Output File: marout01.rpt * marout01.log * * Record Types Referenced: * MARC * Buffers: @A * * Report Name: MARC OUTPUT * * Report No.: MAROUT01 * * Menu Access: CATRPT01 * * Parameter * Input Screen: MARRPT10 * * Templates: none * *------------------------------------------------------------------------------ * * Revision History: * * Date Revised By Description * -------- ---------- ----------- * 04/25/90 Berger Initial version * 04/26/90 Sandstrom Added PC format code * 05/10/90 Sandstrom Added LC format code * 05/11/90 Berger Revisions to FIND_CAT and FIND_COPY * 07/03/91 MChung Substitute tabs with 8 spaces and * spelling checks * 12/02/91 Sandstrom Changed log file open to handle * error if log file already exists. * *------------------------------------------------------------------------------ * START: ACQUIRE/PV MESSAGE 46707, C2=MSG TELL MSG,$B ON/BREAK BREAKERR ON/EXCEPTION EXCEPTION ON/SYNTAX SYNTAXERR SET/DEFAULT RESULT = N SET/PV LINE_CNT = 1 * Check for bad blocksize IF BLOCKSIZE < 80 SET/PV BLOCKSIZE = 80 ELSE_IF BLOCKSIZE > 2048 SET/PV BLOCKSIZE = 2048 END_IF * Set up for desired output method SELECT (OUTPUT) CASE 'REVIEW' SET/PV BLOCKSIZE = 80 CASE 'PRINT' OPEN/FILE marout01.rpt, FID=A, + INTENT=WRITE,ERR=OPENERR, RECORDLC=!BLOCKSIZE! SET/PV PV_FILEID = ',FID=A' END_SELECT * * Construct find command for search on CAT record * IF FIND_CAT <> NULL SET/PV PV_FINDCMD = 'FIND CAT,MARC ' //+ 'WHERE CAT.CATNO:=MARC.CATNO AND ' SET/PV FIND_CAT = $RAISE(FIND_CAT) * * Add CAT. to ambiguous fields in find command where it is not specified * SET/PV PV_ADD = $MATCH('ADD_DT',FIND_CAT) SET/PV PV_EXISTS = $MATCH('.ADD_DT',FIND_CAT) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_CAT = FIND_CAT[1:(PV_ADD-1)] // 'CAT.' //+ FIND_CAT[PV_ADD:*] END_IF * SET/PV PV_ADD = $MATCH('CATNO',FIND_CAT) SET/PV PV_EXISTS = $MATCH('.CATNO',FIND_CAT) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_CAT = FIND_CAT[1:(PV_ADD-1)] // 'CAT.' //+ FIND_CAT[PV_ADD:*] END_IF * SET/PV PV_ADD = $MATCH('REV_DT',FIND_CAT) SET/PV PV_EXISTS = $MATCH('.REV_DT',FIND_CAT) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_CAT = FIND_CAT[1:(PV_ADD-1)] // 'CAT.' //+ FIND_CAT[PV_ADD:*] END_IF * SET/PV PV_ADD = $MATCH('REV_UID',FIND_CAT) SET/PV PV_EXISTS = $MATCH('.REV_UID',FIND_CAT) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_CAT = FIND_CAT[1:(PV_ADD-1)] // 'CAT.' //+ FIND_CAT[PV_ADD:*] END_IF * Append restrictive condition to find command SET/PV PV_FINDCMD = PV_FINDCMD // FIND_CAT * * Construct find command for search on COPY record * ELSE_IF FIND_COPY <> NULL SET/PV PV_FINDCMD = 'FIND COPY,MARC ' //+ 'WHERE COPY.CATNO:=MARC.CATNO AND ' SET/PV FIND_COPY = $RAISE(FIND_COPY) * * Add COPY. to ambiguous fields in find command where it is not specified * SET/PV PV_ADD = $MATCH('ADD_DT',FIND_COPY) SET/PV PV_EXISTS = $MATCH('.ADD_DT',FIND_COPY) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_COPY = FIND_COPY[1:(PV_ADD-1)] // 'COPY.' //+ FIND_COPY[PV_ADD:*] END_IF * SET/PV PV_ADD = $MATCH('CATNO',FIND_COPY) SET/PV PV_EXISTS = $MATCH('.CATNO',FIND_COPY) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_COPY = FIND_COPY[1:(PV_ADD-1)] // 'COPY.' //+ FIND_COPY[PV_ADD:*] END_IF * SET/PV PV_ADD = $MATCH('REV_DT',FIND_COPY) SET/PV PV_EXISTS = $MATCH('.REV_DT',FIND_COPY) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_COPY = FIND_COPY[1:(PV_ADD-1)] // 'COPY.' //+ FIND_COPY[PV_ADD:*] END_IF * SET/PV PV_ADD = $MATCH('REV_UID',FIND_COPY) SET/PV PV_EXISTS = $MATCH('.REV_UID',FIND_COPY) IF (PV_ADD > 0) AND (PV_EXISTS = 0) SET/PV FIND_COPY = FIND_COPY[1:(PV_ADD-1)] // 'COPY.' //+ FIND_COPY[PV_ADD:*] END_IF * Append restrictive condition to find command SET/PV PV_FINDCMD = PV_FINDCMD // FIND_COPY * * Construct find command for search on selected CATNO's * ELSE_IF CATNO <> NULL SET/PV PV_FINDCMD = 'FIND MARC WHERE MARC.CATNO =' //!CATNO! * * Construct default find command for no selected search criteria * ELSE SET/PV PV_FINDCMD = 'FIND MARC' END_IF * * Add sort to the find command * SET/PV PV_FINDCMD = PV_FINDCMD // ' ORDER BY MARC.CATNO END REF=NO' * * Write find command to log file * * OPEN/FILE marout01.log,FID=B,INTENT=WRITE,CREATE=YES, + * CARRIAGE=YES, ERR=OPENERR * smls19911202 changed error branch on log file open to $continue * and added test for dmstat. OPEN/FILE marout01.log,FID=B,INTENT=WRITE,CREATE=YES, + ERR=$CONTINUE IF DMSTAT <> 0 OPEN/FILE marout01.log,FID=B,INTENT=UPDATE,ERR=OPENERR END_IF PUT/FILE ' Log File for MAROUT01',FID=B PUT/FILE ' ---------------------',FID=B PUT/FILE $S2,'FIND COMMAND',$B,'------------',FID=B SET/PV PV_FINDLEN = $LC(PV_FINDCMD) SET/PV PV_POINT = 1 WHILE (PV_POINT <= PV_FINDLEN) PUT/FILE PV_FINDCMD[PV_POINT:(PV_POINT+79)],FID=B SET/PV PV_POINT = PV_POINT + 80 END_WHILE * * Execute find, store members and set in variables * !PV_FINDCMD!,ERR=FNDERR ACQUIRE/PV MEMBERS, N1 = PV_NUMMEM ACQUIRE/PV LASTSET, N1 = PV_SET * * Write members to log file and close file * PUT/FILE $S2,'NUMBER OF MEMBERS = ',PV_NUMMEM,FID=B CLOSE/FILE FID=B * * Check for no hits * IF (PV_NUMMEM <= 0) SHOW/MESSAGE 46705 JUMP CLEANUP END_IF * * Type output for specified formats * SELECT (FORMAT) CASE 'OCLC' * * Step through members of set, generating correct output for each. * FOR PV_MEM = 1, PV_NUMMEM GET/VIEW[!PV_SET!,!PV_MEM!]MARC@A ASSIGN/PV PV_OUTDATA = MARC_DATA@A SET/PV PV_LENGTH = $LC(PV_OUTDATA) SET/PV PV_POINT = 1 ****** Loop through printing one record at a time ****** WHILE (PV_POINT <= PV_LENGTH) IF OUTPUT = 'REVIEW' SET/PV LINE_CNT = LINE_CNT + 1 ******* Check for page break ******** IF LINE_CNT >= 20 ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT = 1 END_IF TELL PV_OUTDATA[PV_POINT:(PV_POINT+BLOCKSIZE-1)] ELSE PUT/F PV_OUTDATA[PV_POINT:(PV_POINT+BLOCKSIZE-1)] + ,FID=A END_IF SET/PV PV_POINT = PV_POINT + BLOCKSIZE END_WHILE END_FOR * CASE 'PC' * * SET/PV PV_MEM = 1 SET/PV PV_POINT_OUT = 1 GETPC: WHILE PV_MEM LE PV_NUMMEM * * Get record * GET/VIEW[!PV_SET!,!PV_MEM!]MARC@A ASSIGN/PV PV_MARCDATA = MARC_DATA@A SET/PV PV_MARCDATA = $TRIM (PV_MARCDATA) SET/PV PV_MEM = PV_MEM + 1 SET/PV PV_LENGTH = PV_MARCDATA[1:5] SET/PV PV_SEGLEN = PV_LENGTH SET/PV PV_POINT_IN = 1 * * Loop to build and write buffer * BLDPC: * * Record will begin and end in this block.... IF (PV_SEGLEN EQ PV_LENGTH) AND + PV_SEGLEN LE (BLOCKSIZE - PV_POINT_OUT + 1) THEN SET/PV PV_BUFFER[PV_POINT_OUT:PV_POINT_OUT+PV_SEGLEN-1]=+ PV_MARCDATA[1:PV_LENGTH] SET/PV PV_POINT_OUT = PV_POINT_OUT + PV_SEGLEN SET/PV PV_SEGLEN = 0 IF PV_POINT_OUT GT BLOCKSIZE THEN SET/PV PV_POINT_OUT = 1 JUMP OUTPC END_IF JUMP GETPC END_IF * Record will begin but not end in this block.... IF (PV_SEGLEN EQ PV_LENGTH) AND + PV_SEGLEN GT (BLOCKSIZE - PV_POINT_OUT + 1) THEN SET/PV PV_BUFFER[PV_POINT_OUT:BLOCKSIZE] = + PV_MARCDATA[1:BLOCKSIZE-PV_POINT_OUT+1] SET/PV PV_SEGLEN = PV_SEGLEN - (BLOCKSIZE-PV_POINT_OUT+1) SET/PV PV_POINT_IN = PV_POINT_IN+BLOCKSIZE-PV_POINT_OUT+1 SET/PV PV_POINT_OUT = 1 JUMP OUTPC END_IF * Record will end but not begin in this block.... IF (PV_SEGLEN NE PV_LENGTH) AND + PV_SEGLEN LE (BLOCKSIZE - PV_POINT_OUT + 1) THEN SET/PV PV_BUFFER[PV_POINT_OUT:*] = + PV_MARCDATA[PV_POINT_IN:PV_POINT_IN+PV_SEGLEN-1] SET/PV PV_POINT_OUT = PV_SEGLEN + 1 IF PV_POINT_OUT GT BLOCKSIZE THEN SET/PV PV_POINT_OUT = 1 SET/PV PV_SEGLEN = 0 JUMP OUTPC END_IF JUMP GETPC END_IF * Record will not begin or end in this block.... IF (PV_SEGLEN NE PV_LENGTH) AND + PV_SEGLEN GT (BLOCKSIZE - PV_POINT_OUT + 1) THEN SET/PV PV_BUFFER[PV_POINT_OUT:BLOCKSIZE] = + PV_MARCDATA[PV_POINT_IN:PV_POINT_IN+BLOCKSIZE-1] SET/PV PV_SEGLEN = PV_SEGLEN - BLOCKSIZE SET/PV PV_POINT_IN = PV_POINT_IN + BLOCKSIZE JUMP OUTPC END_IF OUTPC: IF OUTPUT = 'REVIEW' SET/PV LINE_CNT = LINE_CNT + 1 ******* Check for page break ******** IF LINE_CNT >= 20 ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT = 1 END_IF TELL PV_BUFFER[1:BLOCKSIZE] ELSE PUT/F PV_BUFFER[1:BLOCKSIZE] ,FID=A END_IF * IF PV_SEGLEN EQ 0 THEN JUMP GETPC ELSE JUMP BLDPC END_IF END_WHILE * "Put" last line IF OUTPUT = 'REVIEW' TELL PV_BUFFER[1:BLOCKSIZE] ELSE PUT/F PV_BUFFER[1:BLOCKSIZE] ,FID=A END_IF * * CASE 'LC' * SET/PV PV_MEM = 1 SET/PV PV_POINT_OUT = 1 GETLC: WHILE PV_MEM LE PV_NUMMEM * * Get record * GET/VIEW[!PV_SET!,!PV_MEM!]MARC@A ASSIGN/PV PV_MARCDATA = MARC_DATA@A SET/PV PV_MARCDATA = $TRIM (PV_MARCDATA) SET/PV PV_MEM = PV_MEM + 1 SET/PV PV_LENGTH = PV_MARCDATA[1:5] SET/PV PV_SEGLEN = PV_LENGTH SET/PV PV_POINT_IN = 1 * * Loop to build and write buffer * BLDLC: * * Record will begin and end in this block....0 IF (PV_SEGLEN EQ PV_LENGTH) AND + PV_SEGLEN LE (BLOCKSIZE - PV_POINT_OUT + 1 - 5) THEN * Set segment control word SET/PV PV_BUFFER[PV_POINT_OUT:PV_POINT_OUT] = '0' SET/PV PV_SCW_I = PV_SEGLEN + 5 SET/PV PV_SCW_S[1:4] = $PADZ(PV_SCW_I,4) SET/PV PV_BUFFER[PV_POINT_OUT+1:PV_POINT_OUT+4] = + PV_SCW_S[1:4] * Add record segment SET/PV PV_POINT_OUT = PV_POINT_OUT + 5 SET/PV PV_BUFFER[PV_POINT_OUT:PV_POINT_OUT+PV_SEGLEN-1]=+ PV_MARCDATA[1:PV_LENGTH] SET/PV PV_POINT_OUT = PV_POINT_OUT + PV_SEGLEN SET/PV PV_SEGLEN = 0 IF PV_POINT_OUT GE (BLOCKSIZE-5) THEN SET/PV PV_POINT_OUT = 1 JUMP OUTLC END_IF JUMP GETLC END_IF * Record will begin but not end in this block....1 IF (PV_SEGLEN EQ PV_LENGTH) AND + PV_SEGLEN GT (BLOCKSIZE - PV_POINT_OUT + 1 - 5) THEN * Set segment control word SET/PV PV_BUFFER[PV_POINT_OUT:PV_POINT_OUT] = '1' SET/PV PV_SCW_I = BLOCKSIZE - PV_POINT_OUT + 1 SET/PV PV_SCW_S[1:4] = $PADZ(PV_SCW_I,4) SET/PV PV_BUFFER[PV_POINT_OUT+1:PV_POINT_OUT+4] = + PV_SCW_S[1:4] * Add record segment SET/PV PV_POINT_OUT = PV_POINT_OUT + 5 SET/PV PV_BUFFER[PV_POINT_OUT:BLOCKSIZE] = + PV_MARCDATA[1:BLOCKSIZE-PV_POINT_OUT+1] SET/PV PV_SEGLEN = PV_SEGLEN - (BLOCKSIZE-PV_POINT_OUT+1) SET/PV PV_POINT_IN = PV_POINT_IN+BLOCKSIZE-PV_POINT_OUT+1 SET/PV PV_POINT_OUT = 1 JUMP OUTLC END_IF * Record will end but not begin in this block....3 IF (PV_SEGLEN NE PV_LENGTH) AND + PV_SEGLEN LE (BLOCKSIZE - PV_POINT_OUT + 1 - 5) THEN * Set segment control word SET/PV PV_BUFFER[PV_POINT_OUT:PV_POINT_OUT] = '3' SET/PV PV_SCW_I = PV_SEGLEN + 5 SET/PV PV_SCW_S[1:4] = $PADZ(PV_SCW_I,4) SET/PV PV_BUFFER[PV_POINT_OUT+1:PV_POINT_OUT+4] = + PV_SCW_S[1:4] * Add record segment SET/PV PV_POINT_OUT = PV_POINT_OUT + 5 SET/PV PV_BUFFER[PV_POINT_OUT:*] = + PV_MARCDATA[PV_POINT_IN:PV_POINT_IN+PV_SEGLEN-1] SET/PV PV_POINT_OUT = PV_SEGLEN + 1 + 5 IF PV_POINT_OUT GE (BLOCKSIZE-5) THEN SET/PV PV_POINT_OUT = 1 SET/PV PV_SEGLEN = 0 JUMP OUTLC END_IF JUMP GETLC END_IF * Record will not begin or end in this block....2 IF (PV_SEGLEN NE PV_LENGTH) AND + PV_SEGLEN GT (BLOCKSIZE - PV_POINT_OUT + 1 - 5) THEN * Set segment control word SET/PV PV_BUFFER[PV_POINT_OUT:PV_POINT_OUT] = '2' SET/PV PV_SCW_I = BLOCKSIZE SET/PV PV_SCW_S[1:4] = $PADZ(PV_SCW_I,4) SET/PV PV_BUFFER[PV_POINT_OUT+1:PV_POINT_OUT+4] = + PV_SCW_S[1:4] * Add record segment SET/PV PV_POINT_OUT = PV_POINT_OUT + 5 SET/PV PV_BUFFER[PV_POINT_OUT:BLOCKSIZE] = + PV_MARCDATA[PV_POINT_IN:PV_POINT_IN+BLOCKSIZE-6] SET/PV PV_SEGLEN = PV_SEGLEN - (BLOCKSIZE - 5) SET/PV PV_POINT_IN = PV_POINT_IN + (BLOCKSIZE - 5) SET/PV PV_POINT_OUT = 1 JUMP OUTLC END_IF OUTLC: IF OUTPUT = 'REVIEW' SET/PV LINE_CNT = LINE_CNT + 1 ******* Check for page break ******** IF LINE_CNT >= 20 ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT = 1 END_IF TELL PV_BUFFER[1:BLOCKSIZE] ELSE PUT/F PV_BUFFER[1:BLOCKSIZE] ,FID=A END_IF * IF PV_SEGLEN EQ 0 THEN JUMP GETLC ELSE JUMP BLDLC END_IF END_WHILE * "Put" last line IF OUTPUT = 'REVIEW' TELL PV_BUFFER[1:BLOCKSIZE] ELSE PUT/F PV_BUFFER[1:BLOCKSIZE] ,FID=A END_IF * END_SELECT * * Cleanup - close files and discard result sets. * CLEANUP: ACQUIRE/PV MESSAGE 46708, C2=MSG TELL MSG ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' QUIT: ACQUIRE/PV LASTSET, N1 = PV_LASTSET IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE END_IF DISCARD !PV_SET!:!PV_LASTSET! SET/DEF RESULT = Y * * DONE - successful report generation; return to caller * DONE: RETURN_TO_SCREEN * * Error - inform user and close file, if necessary. * SYNTAXERR: EXCEPTION: OPENERR: VIEWERR: SHOW/MESSAGE !DMSTAT! JUMP ERROR FNDERR: SHOW/MESSAGE 46702 JUMP ERROR BREAKERR: SHOW/MESSAGE 46700 ERROR: SHOW/MESSAGE 46703 IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE CLOSE/F FID = B,ERR=$CONTINUE END_IF SET/DEF RESULT = Y ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' RETURN_TO_SCREEN *PROC MRT tell 'TLP ENU 920430 L1F P004 TLPV3.3' return *PROC NWBLST01 *----------------------------------------------------------------------------- * * Title: New Books List * File: NWBLST01.PRC * Author: Information Dimensions, Inc. (HB) * * Description: List of Titles newly received in the library * * Input Parameters: * OUTPUT - may be 'REVIEW','PRINT'. Review displays report * on screen, print outputs to file for printing. * * START_DT/END_DT - find where COPY.ADD_DT is in range * * SUBJECT - restrict to certain CAT.SUBJs * * SORT_KEY - option to sort by title or subject * * MONTH_YEAR - Inputted month and year for heading * * LOGIN_LIBR - User's login library * * Other Selection Criteria: * LIBR_KEY - Restrict to certain libraries. * * ALL - Boolean value; set true by Slang if no params entered * * Valid Combinations: * Presence or absence of SUBJECT. Subject must be present for * sort_key = 'SUBJECT'. All other parameters are required to * be inputted to the proc. * * Output File: nwblst01.rpt * * Record Types Referenced: * TEMPLATE, LIBR, COPY, CATR, SUB * Buffers: @A @B @C @D * * Report Name: New Books List * * Report No.: NWBLST01 * * Menu Access: ??? * * Parameter * Input Screen: CATRPT10 * * Templates: REPORT_HDR, UNION_CAT, COPY_NEWBOOK * *------------------------------------------------------------------------------ * * Revision History: * * Date Revised By Description * -------- ---------- ----------- * 11/16/89 Berger Initial version * 09/27/90 Berger Fix paging problem, problem with type * 01/07/91 Sandstrom 20 libs fix * 05/08/91 Sandstrom Moved file opens and template gets * to be after the find command. * 07/03/91 MChung Substitute tabs with 8 spaces and * spelling check * *------------------------------------------------------------------------------ * START: ACQUIRE/PV MESSAGE 46707, C2=MSG TELL MSG,$B ON/BREAK BREAKERR ON/EXCEPTION EXCEPTION ON/SYNTAX SYNTAXERR SET/DEFAULT RESULT = N SET/PV PV_TODAY = $YYYYMMDD SET/PV PRINTTOP = 1 SET/PV RPTNM = 'NWBLST01' SET/PV RPTTTL = 'New Books list for '// MONTH_YEAR SET/PV PGNO = 0 * *set/mode echoproc=yes * Begin construction of FIND command. * * 910107smls added 20 libs fix DELETE/GV OUTSTR DELETE/GV OUTLC DELETE/GV INSTR SET/GV INSTR = LIBR_KEY @/PL='$TLP_PROC/generpts' QTBLKS01, VFLDNM='COPY.LIBR_KEY' SET/PV PV_FINDCMD = 'FIND SUB,RCAT,COPY,LIBR ' //+ 'WHERE RCAT.CATNO:=>>SUB.CATNO ' //+ 'AND RCAT.CATNO:=>>COPY.CATNO ' //+ 'AND LIBR.LIBR_KEY:=COPY.LIBR_KEY ' //+ ' AND ((RCAT.ADD_DT = '//START_DT//':'//END_DT// + ' ) '// + 'OR (SUB.ADD_DT = '//START_DT//':'//END_DT// + ' AND DOC inc ''SER''* AND RNUM=0)) ' * * Append FIND command based on options. * * IF (SUBJECT <> '') * SET/PV PV_FINDCMD = PV_FINDCMD //+ * 'AND RCAT.SHELF INC ' // SUBJECT * END_IF * * Append FIND for sort options. * * Removed copy.libr_key from order by * SET/PV PV_FINDCMD = PV_FINDCMD //+ * ' ORDER BY !SORT_KEY! RCAT.TI, RCAT.PUBL, ' //+ * 'COPY.YEAR, COPY.ITEMID, COPY.COPY' SET/PV PV_FINDCMD = PV_FINDCMD //+ ' ORDER BY rcat.shelf' * * Execute Find and set up for report generation * !PV_FINDCMD! END REF=NO ACQUIRE/PV MEMBERS, N1 = PV_NUMMEM ACQUIRE/PV LASTSET, N1 = PV_FOUNDSET IF (PV_NUMMEM <= 0) SHOW/MESSAGE 46705 JUMP CLEANUP END_IF * smls 910508 moved this to be after the FIND command. * Set up for desired output method SELECT (OUTPUT) CASE 'REVIEW' SET/PV MAXLINES = 20 SET/PV PV_FILEID = '' CASE 'PRINT' SET/PV MAXLINES = 60 spawn rm -f nwblst01.rpt OPEN/F nwblst01.rpt, FID=A, INTENT=WRITE,ERR=OPENERR put/f fid=a $t20,rptttl SET/PV PV_FILEID = ',FID=A' END_SELECT * * GET/VIEW [TEMPLATE_KEY = 'REPORT_HDR']TEMPLATE@A, ERR = VIEWERR * ASSIGN/PV HEADER = TEXT@A GET/VIEW [TEMPLATE_KEY = 'UNION_CAT']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV CATINFO = TEXT@A * GET/VIEW [TEMPLATE_KEY = 'COPY_NEWBOOK']TEMPLATE@A, ERR = VIEWERR * ASSIGN/PV COPYINFO = TEXT@A * * Step through members of set, generating correct output for each. FOR PV_Q = 1, PV_NUMMEM * GET/VIEW [!PV_FOUNDSET!,!PV_Q!]LIBR@B, ERR = VIEWERR ASSIGN/PV LIBR_NAME = LIBR_NAME@B ASSIGN/PV LOC_NAME = LOC_NAME@B ASSIGN/PV CALLOC = CALL_NUM_LOC@B IF CALLOC = 'CAT' OR CALLOC = NULL THEN SET/PV CALLOC = 'RCAT' END_IF * * Generate report header, then data for each item * * IF LIBR_NAME <> PV_OLD_LIBR_NAME OR PV_Q = 1 IF PV_Q = 1 IF OUTPUT = 'REVIEW' IF PV_Q <> 1 ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT END_IF CLEAR/SCREEN SET/PV LINE_CNT = 2 * ELSE_IF PV_Q <> 1 * TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! END_IF * SET/PV PGNO = 1 * TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + * SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 1 END_IF SET/PV PV_OLD_LIBR_NAME = LIBR_NAME * * Check for new Subject (if subject is entered) * IF SUBJECT <> '' GET/VIEW [PV_FOUNDSET,PV_Q]RCAT@D,ERR=VIEWERR ASSIGN/PV PV_CURSUBJ = SUBJ@D IF PV_CURSUBJ <> PV_OLDSUBJ SET/PV PV_OLDSUBJ = PV_CURSUBJ * Check for page break SET/PV LINE_CNT = LINE_CNT + 2 IF LINE_CNT > MAXLINES IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT = 2 ELSE * TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! SET/PV PGNO = PGNO + 1 * TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + * SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT =1 END_IF END_IF * TYPE $S2, RCAT.SUBJ, LABELS = N, SKIP = 0, + * SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! END_IF END_IF * GET/VIEW [PV_FOUNDSET,PV_Q]COPY@C, ERR = VIEWERR ASSIGN/PV PV_CURCATNO = CATNO@C IF PV_CURCATNO = NULL GET/VIEW [PV_FOUNDSET,PV_Q]RCAT@D, ERR = VIEWERR ASSIGN/PV PV_CURCATNO = CATNO@D END_IF ASSIGN/PV PV_CURITEMID = ITEMID@C * If new catno, print catalog info IF (PV_CURCATNO <> PV_LSTCATNO) SET/PV LINE_CNT = LINE_CNT + 7 * Check for page break IF LINE_CNT > MAXLINES IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT = 2 ELSE * TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! SET/PV PGNO = PGNO + 1 * TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + * SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 1 END_IF END_IF TYPE $S2, !CATINFO!, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! SET/PV PV_LSTCATNO = PV_CURCATNO set/pv line_cnt=line_cnt+dm_lines END_IF * Aviod duplicates from FIND command IF (PV_CURITEMID <> PV_LSTITEMID) SET/PV LINE_CNT = LINE_CNT + 1 * Check for page break IF LINE_CNT > MAXLINES IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN SET/PV LINE_CNT = 2 ELSE * TYPE $P, MEMBERS=1, SET=!PV_FOUNDSET! !PV_FILEID! SET/PV PGNO = PGNO + 1 * TYPE !HEADER!, $S2, LABELS = N, SKIP = 0, + * SET = !PV_FOUNDSET!, MEMBERS = 1 !PV_FILEID! SET/PV LINE_CNT = 1 END_IF END_IF TYPE !COPYINFO!, LABELS = N, SKIP = 0, + SET = !PV_FOUNDSET!, MEMBERS = !PV_Q! !PV_FILEID! SET/PV PV_LSTITEMID = PV_CURITEMID set/pv line_cnt=line_cnt+dm_lines END_IF * END_FOR * * Cleanup - close files and discard result sets. * CLEANUP: ACQUIRE/PV MESSAGE 46708, C2=MSG TELL MSG ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' QUIT: ACQUIRE/PV LASTSET, N1 = PV_LASTSET IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE END_IF DISCARD !PV_FOUNDSET!:!PV_LASTSET! SET/DEF RESULT = Y * * DONE - successful report generation; return to caller * DONE: RETURN_TO_SCREEN * * Error - inform user and close file, if necessary. * SYNTAXERR: EXCEPTION: OPENERR: VIEWERR: SHOW/MESSAGE !DMSTAT! JUMP ERROR BREAKERR: SHOW/MESSAGE 46700 ERROR: SHOW/MESSAGE 46703 IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE END_IF SET/DEF RESULT = Y ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' RETURN_TO_SCREEN *PROC QTBLKS01 *----------------------------------------------------------------------------- * * Title: Build Library Key String * File: QTBLKS01 * Author: Information Dimensions, Inc. (BB/SMLS) * * Description: This proc is called to build a string of library keys that * can be used within a find command. This routine handles the * >20 terms/field limit. * * Directions: * * Input: * Passed as a global variable: * INSTR[*] - Input character string that contains the list of * library keys with single quotes around each key. * Multiple keys are separated by commas. * Passed on call: * VFLDNM[*] - Contains the name of the view field with a source * of the library key to be used in the find command. * Output: * The following global variables are set: * OUTSTR[*] - The product of this routine, the field test. * OUTLC - The length of the field test value. * BSTAT - Return status....0=ok, -1=error. * *------------------------------------------------------------------------------ * * Revision History: * * Date Revised By Description * -------- ---------- ----------- * 12/20/90 Beaber Initial Version * 01/03/91 Sandstrom Revisions * 07/08/91 MChung Substitute tabs with 8 spaces & * spelling checks * *------------------------------------------------------------------------------ * * * Initialize variables. * SET/PV VFNSC = 1 SET/PV VFNEC = $LC(VFLDNM) SET/PV INEC = $LC(INSTR) SET/PV INSC = 1 SET/PV OUTSC = 1 SET/PV SC = 1 SET/PV SC20 = 1 SET/PV COUNT = 0 SET/GV BSTAT = 0 * * Begin building output string by adding on '(', field name, '='. * SET/GV OUTSTR[*] = '(' // VFLDNM[VFNSC:VFNEC] // '=' SET/PV OUTSC = OUTSC + VFNEC - VFNSC + 4 * * Loop through input string searching for commas. * SET/PV COMMA = $MATCH(',',INSTR[SC:INEC]) WHILE (COMMA NE 0) SET/PV COUNT = COUNT + 1 * * Continue building the string as every 20th comma is found. * IF ($MOD(COUNT,20) EQ 0) THEN * * Add on "OR Field_name=", if necessary. * IF (OUTSTR[OUTSC-2] <> '=') THEN SET/GV OUTSTR[OUTSC+1:OUTSC+VFNEC-VFNSC+7] = + ' OR ' // VFLDNM[VFNSC:VFNEC] // '=' SET/PV OUTSC = OUTSC + VFNEC - VFNSC + 7 END_IF * * Add on next 20 keys. * IF SC20 = INSC THEN SET/GV OUTSTR[OUTSC:OUTSC+SC+COMMA-SC20-2] = + INSTR[SC20:SC+COMMA-2] ELSE SET/GV OUTSTR[OUTSC:OUTSC+SC+COMMA-SC20-2] = + INSTR[SC20+1:SC+COMMA-2] END_IF * * Increment index (SC) and continue looking for commas. * SET/PV OUTSC = OUTSC + SC + COMMA - SC20 - 2 SET/PV SC20 = SC + COMMA END_IF * * Increment index (SC) and continue looking for commas. * SET/PV SC = SC + COMMA BREAK_IF (SC GT INEC) SET/PV COMMA = $MATCH(',',INSTR[SC:INEC]) END_WHILE * * Add on "OR Field_name=", if necessary. * IF (OUTSTR[OUTSC-2] <> '=') THEN SET/GV OUTSTR[OUTSC+1:OUTSC+VFNEC-VFNSC+7] = + ' OR ' // VFLDNM[VFNSC:VFNEC] // '=' SET/PV OUTSC = OUTSC + VFNEC - VFNSC + 7 END_IF * * Add on last set of characters. * SET/PV OUTEC = OUTSC + INEC - SC20 + 2 SET/GV OUTSTR[OUTSC:OUTEC] = INSTR[SC20:INEC] // ')' * SET/GV OUTLC = OUTEC RETURN *PROC SPILAB01 *----------------------------------------------------------------------------- * * Title: Spine Labels * File: SPILAB01.PRC * Author: Information Dimensions, Inc. (HB) * * Description: Spine labels for cataloged books * * Input Parameters: * OUTPUT - may be 'REVIEW','PRINT'. Review displays report * on screen, print outputs to file for printing. * * START_DT/END_DT - find where COPY.ADD_DT is in range * * CALL - restrict to certain CATR.CALLs * * ITEMID - restrict to certain COPY.ITEMIDs * * LOGIN_LIBR - User's login library * * Other Selection Criteria: * LIBR_KEY - Restrict to certain libraries. * * ALL - Boolean value; set true by Slang if no params entered * * Valid Combinations: * START AND END DT REQUIRED. CALL and ITEMID are optional. * * Output File: spilab01.rpt * * Record Types Referenced: * TEMPLATE, LIBR, SYS_PARM, COPY, CATR, SUB * Buffers: @A @C @B @E @D * * Report Name: Spine Labels * * Report No.: SPILAB01 * * Menu Access: ??? * * Parameter * Input Screen: CATRPT11 * * Templates: * *------------------------------------------------------------------------------ * * Revision History: * * Date Revised By Description * -------- ---------- ----------- * 10/16/89 Berger Initial version * 11/14/90 Berger Fixed bug in dewey form on the * line counter * 01/07/91 Sandstrom 20 libs fix * 05/08/91 Sandstrom Moved file opens and template gets to * after the find command. * 07/03/91 MChung Substitute tabs with 8 spaces and * spelling check * 04/14/92 Sandstrom Fix for TLP-1291-7. Output for * call number was not correct. * *------------------------------------------------------------------------------ * START: ACQUIRE/PV MESSAGE 46707, C2=MSG TELL MSG,$B ON/BREAK BREAKERR ON/EXCEPTION EXCEPTION ON/SYNTAX SYNTAXERR SET/DEFAULT RESULT = N SET/PV PV_TODAY = $YYYYMMDD * * Begin construction of FIND command. * * 910107smls added 20 libs fix DELETE/GV OUTSTR DELETE/GV OUTLC DELETE/GV INSTR SET/GV INSTR = LIBR_KEY @/PL='$TLP_PROC/generpts' QTBLKS01, VFLDNM='COPY.LIBR_KEY' SET/PV PV_FINDCMD = 'FIND CATR,COPY,LIBR ' //+ 'WHERE COPY.CATNO:=CATR.CATNO ' //+ 'AND LIBR.LIBR_KEY:=COPY.LIBR_KEY AND ' //+ OUTSTR[1:OUTLC]//' ' IF START_DT <> '' THEN SET/PV PV_FINDCMD = PV_FINDCMD//+ 'AND COPY.ADD_DT = '//START_DT//':'//END_DT//' ' END_IF * GET/VIEW [ID=1]SYS_PARM@B,ERR=VIEWERR ASSIGN/PV RPT_MULT_ENT = RPT_MULT_ENTITY@B ASSIGN/PV COPY_RPT_SORT = COPY_RPT_SORT@B GET/VIEW[LIBR_KEY=!LOGIN_LIBR!]LIBR@C,ERR=VIEWERR ASSIGN/PV CALLOC = CALL_NUM_LOC@C IF CALLOC = 'CAT' OR CALLOC = NULL SET/PV CALLOC = 'CATR' END_IF * * Append FIND command based on options. * IF (ITEMID <> '') SET/PV PV_FINDCMD = PV_FINDCMD //+ 'AND COPY.ITEMID = ' // ITEMID ELSE_IF (CALL <> '') SET/PV PV_FINDCMD = PV_FINDCMD //+ 'AND !CALLOC!.CALL = ' // CALL END_IF * * Build sortkey to reflect correct call no. field, depending on * SYS_PARM and LIBR flags * GET/VIEW [ID=1]SYS_PARM@B,ERR=VIEWERR ASSIGN/PV RPT_MULT_ENT = RPT_MULT_ENTITY@B ASSIGN/PV COPY_RPT_SORT = COPY_RPT_SORT@B IF (RPT_MULT_ENTITY = 'N') ASSIGN/PV CAT_LC = CAT_LC_FLG@B IF (CAT_LC = 'Y') SET/PV LCADD = '_LC_SORT' ELSE SET/PV CATRADD = '(1)' END_IF ELSE GET/VIEW[LIBR_KEY=!LOGIN_LIBR!]LIBR@C,ERR=VIEWERR ASSIGN/PV CAT_LC = CAT_LC_FLG@C ASSIGN/PV COPY_LC = COPY_LC_FLG@C IF (CALLOC = 'CATR') AND (CAT_LC = 'Y') SET/PV LCADD = '_LC_SORT' SET/PV CATRADD = '' ELSE_IF (CALLOC = 'CATR') SET/PV LCADD = '' SET/PV CATRADD = '(1)' ELSE_IF (CALLOC = 'COPY') AND (COPY_LC = 'Y') SET/PV LCADD = '_LC_SORT' SET/PV CATRADD = '' ELSE SET/PV LCADD = '' SET/PV CATRADD = '' END_IF END_IF SET/PV SORTKEY = '!CALLOC!.CALL!LCADD!' // '!CATRADD!' * SET/PV PV_FINDCMD = PV_FINDCMD //+ ' ORDER BY COPY.LIBR_KEY, !SORTKEY! ' IF (COPY_RPT_SORT <> '') SET/PV PV_FINDCMD = PV_FINDCMD // ', !COPY_RPT_SORT! ' END_IF * * Execute Find and set up for report generation * !PV_FINDCMD! END REF=NO ACQUIRE/PV MEMBERS, N1 = PV_NUMMEM ACQUIRE/PV LASTSET, N1 = PV_FOUNDSET IF (PV_NUMMEM <= 0) SHOW/MESSAGE 46705 JUMP CLEANUP END_IF * smls moved file opens and template get. * Set up for desired output method SELECT (OUTPUT) CASE 'REVIEW' SET/PV PV_FILEID = '' CASE 'PRINT' OPEN/F spilab01.rpt, FID=A, INTENT=WRITE, + CARRIAGE=YES, ERR=OPENERR SET/PV PV_FILEID = ',FID=A' END_SELECT * GET/VIEW [TEMPLATE_KEY = 'SPINE_LABEL']TEMPLATE@A, ERR = VIEWERR ASSIGN/PV PV_SPINE_LABEL = TEXT@A * Step through members of set, generating correct output for each. FOR PV_Q = 1, PV_NUMMEM * * get calloc * GET/VIEW [PV_FOUNDSET,PV_Q]LIBR@C, ERR=VIEWERR ASSIGN/PV CALLOC = CALL_NUM_LOC@C IF CALLOC = 'CAT' OR CALLOC = NULL THEN SET/PV CALLOC = 'CATR' END_IF * * Parse the Call Number to print it in the template * IF CALLOC = 'CATR' GET/VIEW [PV_FOUNDSET,PV_Q]CATR@D,ERR=VIEWERR ASSIGN/PV PV_CALL = CALL@D ELSE GET/VIEW [PV_FOUNDSET,PV_Q]COPY@E,ERR=VIEWERR * smls19920414 changed field name being assigned to PV_CALL * from ASSIGN/PV PV_CALL = COPY@E to ASSIGN/PV PV_CALL = CALL@E END_IF SET/PV LENGTH = $LC(PV_CALL) SET/PV LINENUM = 1 * Reset temp variables to give to template FOR I = 1,9 SET/PV LINE!I! = '' END_FOR * * Parse LC call numbers * * smls19920414 added reference to COPY_LC. * Old IF was: IF CAT_LC = 'Y' IF (CALLOC = 'CATR' AND CAT_LC = 'Y') + OR (CALLOC = 'COPY' AND COPY_LC = 'Y') THEN FOR PV_P = 1,LENGTH SET/PV PV_CHAR = PV_CALL[PV_P] IF PV_P <> LENGTH SET/PV PV_Z = PV_P + 1 SET/PV PV_NEXT = PV_CALL[PV_Z] ELSE SET/PV PV_NEXT = ' ' END_IF SELECT LINENUM CASE 1 * Check for letter IF $ABS(PV_CHAR) = 0 AND PV_CHAR <> '0' SET/PV LINE1 = LINE1 // PV_CHAR ELSE SET/PV LINE2 = PV_CHAR SET/PV LINENUM = 2 END_IF CASE 2 * Check for period followed by a letter IF PV_CHAR = '.' AND $ABS(PV_NEXT) = 0 AND + PV_NEXT <> '0' SET/PV LINENUM = 3 ELSE SET/PV LINE2 = LINE2 // PV_CHAR END_IF DEFAULT SET/PV LINE!LINENUM! = LINE!LINENUM! // PV_CHAR * Check for a space or next character to be a letter IF ($ABS(PV_NEXT) = 0 AND PV_NEXT <> '0') SET/PV LINENUM = LINENUM + 1 END_IF END_SELECT END_FOR * * Parse Dewey call numbers * ELSE FOR PV_P = 1,LENGTH SET/PV PV_CHAR = PV_CALL[PV_P] SELECT LINENUM CASE 1 * Break on period IF PV_CHAR = '.' SET/PV LINENUM = 2 END_IF SET/PV LINE!LINENUM! = LINE!LINENUM! // PV_CHAR DEFAULT SET/PV LINE!LINENUM! = LINE!LINENUM! // PV_CHAR * Break on spaces IF PV_CHAR = ' ' SET/PV LINENUM = LINENUM + 1 END_IF END_SELECT END_FOR END_IF * Type the Spine Label TYPE !PV_SPINE_LABEL!, SKIP=0, + SET=!PV_FOUNDSET!,MEMBERS=!PV_Q! !PV_FILEID! IF OUTPUT = 'REVIEW' ACQUIRE/PV MESSAGE 46710, C2=MSG INQUIRE/PV PV_QUIT, '!MSG!' JUMPIF PV_QUIT[1] = 'N' OR PV_QUIT[1] = 'n',QUIT CLEAR/SCREEN END_IF END_FOR * * Cleanup - close files and discard result sets. * CLEANUP: ACQUIRE/PV MESSAGE 46708, C2=MSG TELL MSG ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' QUIT: ACQUIRE/PV LASTSET, N1 = PV_LASTSET IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE END_IF DISCARD !PV_FOUNDSET!:!PV_LASTSET! SET/DEF RESULT = Y * * DONE - successful report generation; return to caller * DONE: RETURN_TO_SCREEN * * Error - inform user and close file, if necessary. * SYNTAXERR: EXCEPTION: OPENERR: VIEWERR: SHOW/MESSAGE !DMSTAT! JUMP ERROR BREAKERR: SHOW/MESSAGE 46700 ERROR: SHOW/MESSAGE 46703 IF (OUTPUT <> 'REVIEW') CLOSE/F FID = A,ERR=$CONTINUE END_IF SET/DEF RESULT = Y ACQUIRE/PV MESSAGE 46709, C2=MSG INQUIRE/PV DUMMY, '!MSG!' RETURN_TO_SCREEN