OpenVMS DCL Command Procedure :
Be sure to include your variable information within the FOCUS program; for
example :
-PROMPT &(variable)/(type & length).(verbiage for prompt) :
To produce a report, put the following statement at the end of FOCUS program :
ON TABLE HOLD AS REPORT FORMAT WP
To produce labels, put the following statement at the end of FOCUS program :
ON TABLE HOLD AS LABELS
Be sure to extract and compile/link the LASER-LABELS.COB file.
Usage : @FOCREPORT (FOCUS program)
$!
$! FOCREPORT.COM
$!
$! This procedure will execute the specified FOCUS program.
$!
$ SET NOVERIFY
$ SET NOCONTROL_Y
$ ON ERROR THEN CONTINUE
$!
$ SAY := WRITE SYS$OUTPUT
$ ASK := READ/END=END_PROGRAM/PROMPT =
$ USER = F$EDIT(F$GETJPI("","USERNAME"),"UPCASE,COLLAPSE")
$ READ_FILE = "SI$FOCUS:" +"'P1'" + ".FEX"
$ CL*EAR := "SET TERM/WIDTH=80"
$ SET DEFAULT SYS$LOGIN
$!
$! Retrieve and execute FOCUS prompts.
$!
$ CL
$ SAY ""
$ OPEN/READ focfile 'READ_FILE'
$ INX = 0
$!
$READ_FOC:
$!
$ READ/ERROR=END_READ_FOC/END=END_READ_FOC focfile frecord
$ IF F$EXTRACT(0,7,frecord) .EQS. "-PROMPT"
$ THEN
$ INX = INX + 1
$ QBEG = F$LOCATE(".",frecord) + 1
$ RECLEN = F$LENGTH(frecord)
$ VPLEN = (RECLEN - QBEG)
$ VPROMPT = F$EXTRACT(QBEG,VPLEN,frecord)
$ READ/PROMPT= " ''VPROMPT' " /END=END_FOC_ALL SYS$COMMAND ANS
$ ANS'INX' = ANS
$ ENDIF
$ GOTO READ_FOC
$!
$END_FOC_ALL:
$!
$ CLOSE focfile
$ GOTO END_PROGRAM
$!
$END_READ_FOC:
$!
$ CLOSE focfile
$!
$! Capture user and FOCUS program ran; this can be used to track
$! usage of the available FOCEXECs.
$!
$ OPEN/APPEND/SHARE=WRITE output_file FOC_RUN_DATA.DAT
$ WRITE output_file USER + " " + "''P1'"
$ CLOSE output_file
$!
$! Execute FOCUS program.
$!
$ COM_FILE = "SYS$LOGIN:FOCTEMP.COM"
$!
$ OPEN/WRITE output_file 'COM_FILE'
$!
$ WRITE output_file "$ DEFINE FOC$DIR1 SI$DATA"
$ WRITE output_file "$ DEFINE FOC$DIR2 SI$FEX,SI$MFD"
$ WRITE output_file "$ ASSIGN SI$DATA:XFOC01.DAT XFOC01"
$ WRITE output_file "$ SET DEFAULT SYS$LOGIN"
$ WRITE output_file "$ FOCUS"
$ WRITE output_file "EXEC " + "SI$FOCUS:" + "''P1'" + ".FEX"
$!
$! Write out variable information to be used within FOCUS program
$!
$ DUP_INX = 0
$!
$WR_FOC_VAR:
$!
$ IF DUP_INX .LT. INX
$ THEN
$ DUP_INX = DUP_INX + 1
$ WRITE output_file ANS'DUP_INX'
$ ELSE
$ GOTO END_FOC_VAR
$ ENDIF
$!
$ GOTO WR_FOC_VAR
$!
$END_FOC_VAR:
$!
$ WRITE output_file "FIN"
$ WRITE output_file "$ EXIT"
$!
$ CLOSE output_file
$ CL
$ SAY ""
$ SAY "Please wait while FOCUS program executes..."
$ SAY ""
$ SUBMIT/NOPRINT/NOTIFY 'COM_FILE'
$ SYNCHRONIZE FOCTEMP
$!
$! Check to see if output has been produced, if not generate error.
$!
$ IF (F$SEARCH("SYS$LOGIN:REPORT.WP") .EQS. "") .AND. -
(F$SEARCH("SYS$LOGIN:LABELS.FTM") .EQS. "")
$ THEN
$ SAY " "
$ SAY " "
$ SAY "Error producing report or no data meeting selection criteria "
$ ASK "<RETURN> to exit ..... " SYS$COMMAND DUMMY
$ SAY " "
$ GOTO END_PROGRAM
$ ENDIF
$!
$! If regular report is produced, e-mail to user.
$!
$ IF F$SEARCH("SYS$LOGIN:REPORT.WP") .NES. ""
$ THEN
$ COPY SYS$LOGIN:REPORT.WP SYS$LOGIN:REPORT.DOC;
$ HOLDNAME = "SYS$LOGIN:REPORT.DOC;"
$ GOSUB MAIL_REPORT
$ GOTO END_PROGRAM
$ ENDIF
$!
$! If mailing labels are produced, format and e-mail to user.
$!
$ IF F$SEARCH("SYS$LOGIN:LABELS.FTM") .NES. ""
$ THEN
$ GOSUB MAIL_LABELS
$ GOTO END_PROGRAM
$ ENDIF
$!
$END_PROGRAM:
$!
$! Clean up all temporary FOCUS files.
$!
$ DELETE/NOLOG SYS$LOGIN:*.FTM;*
$ DELETE/NOLOG SYS$LOGIN:*.MAS;*
$ DELETE/NOLOG SYS$LOGIN:*.WP;*
$ DELETE/NOLOG SYS$LOGIN:FOCTEMP.COM;*
$ EXIT
$!
$! Subroutine to e-mail report.
$!
$MAIL_REPORT:
$!
$ CL
$ SAY " "
$ SAY " *** REPORT HAS BEEN PRODUCED ***"
$ SAY " "
$ SAY " To send other users a copy of the report, answer Y to the next"
$ SAY " question and enter the name(s) of additional users who will get a copy."
$ SAY " The usernames need to be seperated by a comma."
$ SAY " "
$ SAY " To send the report to only yourself then answer N to the next question."
$ SAY " "
$ SAY " "
$ MAIL/SUBJECT="''P1'" 'HOLDNAME' 'USER'
$ SAY " "
$ ASK "Do you want others to get the results? " SYS$COMMAND ANSWER
$ IF ANSWER
$ THEN
$ SAY " "
$ ASK "Enter the username(s) " SYS$COMMAND USERLIST
$ USERLIST = F$EDIT(USERLIST,"COLLAPSE")
$ MAIL/SUBJECT="''P1'" 'HOLDNAME' 'USERLIST'
$ SAY " Report has been sent to ",USERLIST
$ ENDIF
$ RETURN
$!
$! Subroutine to create and e-mail mailing labels.
$!
$MAIL_LABELS:
$!
$ CL
$ TYPE SYS$INPUT
Labels can now be produced in laser printer format. The supported laser
printers are :
DECLaser 2100 and DEC Printserver 17
The tested labels were Avery 5160 Laser Printer Labels. Specifications
as listed on the box :
100 sheets : 8.5 x 11 inches
3000 labels : 1 inch x 2 5/8 inches
30 labels per sheet
These labels may be obtained by submitting a purchase request
Item Description: laser labels 1 by 2 5/8
Order Number : 615-51-85-112-6
These labels must be printed by using the Print Laser Labels option on
the SIS menu.
****************************************************************************
$!
$ WAIT 00:00:03
$ SAY " "
$ SAY " "
$ SAY "Producing Laser labels"
$ RUN LASER-LABELS
$ SAY " "
$ SAY "Mailing Laser labels to your e-mail account"
$ WAIT 00:00:03
$ MAIL/SUBJECT="''P1'" SYS$LOGIN:LASER_LABELS.TXT 'USER'
$!
$ CL
$ SAY " "
$ SAY " *** LABELS HAVE BEEN PRODUCED ***"
$ SAY " "
$ SAY " To send other users a copy of the mailing labels, answer y to the next"
$ SAY " question and enter the name(s) of the all users who will get a copy."
$ SAY " The usernames need to be seperated by a comma."
$ SAY " "
$ SAY " To send the labels to only yourself then answer N to the next question."
$ SAY " "
$ ASK "Do you want others to get the results? [N] " -
SYS$COMMAND ANSWER
$ IF ANSWER
$ THEN
$ SAY " "
$ ASK "Enter the username(s) " SYS$COMMAND USERLIST
$ USERLIST = F$EDIT(USERLIST,"COLLAPSE")
$ MAIL/SUBJECT="''P1'" SYS$LOGIN:LASER_LABELS.TXT 'USERLIST'
$ SAY " Labels have been sent to ",USERLIST
$ ENDIF
$ RETURN
LASER-LABELS.COB :
IDENTIFICATION DIVISION.
PROGRAM-ID. LASER-LABELS.
AUTHOR. IRM.
**************************************************************
** M A I L I N G L A B E L S
**************************************************************
**
** This program reads in a sort file created from FOCUS
** called LABELS.FTM which will reside in SYS$LOGIN. The
** input file will use the sort-file. This program will build
** 3 across labels only, at this time. The print file will be
** created in SYS$LOGIN directory as LASER-LABELS.TXT.
**************************************************************
**************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. ALPHA-4000.
OBJECT-COMPUTER. ALPHA-4000.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PRINT-FILE ASSIGN TO 'SYS$LOGIN:LASER_LABELS.TXT'.
SELECT SORT-FILE ASSIGN TO 'SYS$LOGIN:LABELS.FTM'.
DATA DIVISION.
FILE SECTION.
FD PRINT-FILE
RECORD CONTAINS 96 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS PRINT-RECS.
01 PRINT-RECS PIC X(96).
FD SORT-FILE
RECORD CONTAINS 144 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS SORT-RECORD.
01 SORT-RECORD.
03 SORT-NAME PIC X(32).
03 SORT-ADDRESS1 PIC X(32).
03 SORT-ADDRESS2 PIC X(32).
03 SORT-CITY PIC X(16).
03 SORT-STATE PIC X(2).
03 FILLER PIC X(2).
03 SORT-ZIP-CODE PIC X(9).
03 FILLER PIC X(3).
03 SORT-LAST-NAME PIC X(16).
WORKING-STORAGE SECTION.
01 PRINT-RECORD.
03 PRINT-REC OCCURS 3 TIMES.
05 LABEL-REC PIC X(33).
01 EOF-SORT-FILE PIC X(1) VALUE "N".
01 YES PIC X(1) VALUE "Y".
01 CTR1 PIC 9(1).
01 CTR2 PIC 9(1).
01 CTR3 PIC 9(1).
01 HOLD-RECORD.
03 HOLD-RECS OCCURS 3 TIMES.
05 HOLD-NAME PIC X(30).
05 FILLER PIC X(3).
05 ADDRESS1 PIC X(30).
05 FILLER PIC X(3).
05 ADDRESS2 PIC X(30).
05 FILLER PIC X(3).
05 CITY PIC X(13).
05 FILLER PIC X(1).
05 STATE PIC X(2).
05 FILLER PIC X(1).
05 ZIP-CODE PIC X(9).
05 FILLER PIC X(7).
01 I-O-STATUS PIC XX.
88 OK VALUE "00".
88 WARNING-MESSAGE VALUE "01".
88 NO-NEXT VALUE "13".
88 OP-FILE VALUE "15".
88 NO-VALID VALUE "16".
88 DUPL VALUE "22".
88 NOT-FOUND VALUE "23".
88 FULLs VALUE "24".
88 RECORD-NOT-FOUND VALUE "32".
88 BOUND VALUE "34".
88 SOFT-LOCK VALUE "90".
88 IN-USE VALUE "92".
PROCEDURE DIVISION.
PROGRAM-EXECUTION SECTION.
CONTROL-PARA.
OPEN INPUT SORT-FILE.
OPEN OUTPUT PRINT-FILE.
INITIALIZE PRINT-RECORD.
PERFORM WRITE-RECORD.
MOVE ALL "X" TO PRINT_RECORD.
PERFORM WRITE-RECORD 4 TIMES.
INITIALIZE PRINT-RECORD.
PERFORM WRITE-RECORD.
READ SORT-FILE
AT END MOVE YES TO EOF-SORT-FILE
END-READ.
PERFORM BUILD-LABELS UNTIL EOF-SORT-FILE = YES.
CLOSE SORT-FILE,PRINT-FILE.
STOP RUN.
BUILD-LABELS.
INITIALIZE HOLD-RECORD.
PERFORM VARYING CTR1 FROM 1 BY 1 UNTIL CTR1 > 3 OR
EOF-SORT-FILE = YES
MOVE SORT-NAME TO HOLD-NAME(CTR1)
MOVE SORT-ADDRESS1 TO ADDRESS1(CTR1)
MOVE SORT-ADDRESS2 TO ADDRESS2(CTR1)
MOVE SORT-CITY TO CITY(CTR1)
MOVE SORT-STATE TO STATE(CTR1)
MOVE SORT-ZIP-CODE TO ZIP-CODE(CTR1)
INITIALIZE SORT-RECORD
READ SORT-FILE
AT END MOVE YES TO EOF-SORT-FILE
END-READ
END-PERFORM.
** LINE 2
PERFORM VARYING CTR2 FROM 1 BY 1 UNTIL CTR2 > 3
MOVE HOLD-NAME(CTR2) TO LABEL-REC(CTR2)
END-PERFORM.
PERFORM WRITE-RECORD.
** LINE 3
PERFORM VARYING CTR2 FROM 1 BY 1 UNTIL CTR2 > 3
MOVE ADDRESS1(CTR2) TO LABEL-REC(CTR2)
END-PERFORM.
PERFORM WRITE-RECORD.
** LINE 4
PERFORM VARYING CTR2 FROM 1 BY 1 UNTIL CTR2 > 3
IF ADDRESS2(CTR2) = SPACES
THEN STRING CITY(CTR2) DELIMITED BY SIZE " "
STATE(CTR2) DELIMITED BY SIZE " "
ZIP-CODE(CTR2) DELIMITED BY SIZE " "
DELIMITED BY SIZE INTO LABEL-REC(CTR2)
ELSE MOVE ADDRESS2(CTR2) TO LABEL-REC(CTR2)
END-IF
END-PERFORM.
PERFORM WRITE-RECORD.
** LINE 5
PERFORM VARYING CTR2 FROM 1 BY 1 UNTIL CTR2 > 3
IF ADDRESS2(CTR2) NOT = SPACES
THEN STRING CITY(CTR2) DELIMITED BY SIZE " "
STATE(CTR2) DELIMITED BY SIZE " "
ZIP-CODE(CTR2) DELIMITED BY SIZE " "
DELIMITED BY SIZE INTO LABEL-REC(CTR2)
ELSE MOVE SPACES TO LABEL-REC(CTR2)
END-IF
END-PERFORM.
PERFORM WRITE-RECORD.
** LINE 6 IS BLANK
INITIALIZE PRINT-RECORD.
PERFORM WRITE-RECORD 2 TIMES.
WRITE-RECORD.
IF NOT (EOF-SORT-FILE = YES AND CTR1 = 1)
THEN
WRITE PRINT-RECS FROM PRINT-RECORD
INITIALIZE PRINT-RECORD
END-IF.
This page hosted by 
Get your own Free Homepage