Typical DCL Command Procedure to run the program :
$!
$! RE-CURR-LABELS-SEL.COM
$!
$! Description: Produces mailing labels (SYS$LOGIN:LASER_LABELS.TXT)
$! for currently enrolled students for select zip codes.
$!
$ SET NOVERIFY
$ SAY :== "WRITE SYS$OUTPUT"
$ SET TERMINAL/WIDTH=80
$!
$ SAY "This will create mailing labels for currently enrolled"
$ SAY "students for select zip codes."
$ SAY " "
$ SAY "(RE-CURR-LABELS-SEL)"
$ SAY " "
$!
$! Prompt for term
$!
$ENTER_PARM_TERM:
$ READ SYS$COMMAND/TIME=60/END=EXIT/ERROR=EXIT/PROMPT= -
"Enter the five digit term to run labels for (CCYYX) >>> " TERMIN
$ LEN_TERMIN = F$LENGTH(TERMIN)
$ IF LEN_TERMIN .NE. 5 THEN GOTO ENTER_PARM_TERM
$ TYP_TERMIN = F$TYPE(TERMIN)
$ IF TYP_TERMIN .NES. "INTEGER" THEN GOTO ENTER_PARM_TERM
$!
$! Create zip code file
$!
$ OPEN/WRITE output_file SYS$LOGIN:ZIP.TXT
$!
$! Prompt for zip code
$!
$ENTER_INZIP:
$ READ SYS$COMMAND/TIME=60/END=EXIT_INZIP/ERROR=EXIT_INZIP/PROMPT= -
"Enter the zip code to run labels for >>> " INZIP
$ LEN_INZIP = F$LENGTH(INZIP)
$ IF LEN_INZIP .NE. 5 THEN GOTO ENTER_INZIP
$ TYP_INZIP = F$TYPE(INZIP)
$ IF TYP_INZIP .NES. "INTEGER" THEN GOTO ENTER_INZIP
$ WRITE output_file INZIP
$!
$ READ SYS$COMMAND/TIME=60/END=EXIT_INZIP/ERROR=EXIT_INZIP/PROMPT= -
"Enter more zip codes? [Y,N ... default is Y] >>> " MOZIP
$ IF (MOZIP .EQS. "Y") .OR (MOZIP .EQS. "") THEN GOTO ENTER_INZIP
$ GOTO CREATE_JOB
$!
$EXIT_INZIP:
$ CLOSE output_file
$!
$! Create and execute the FOCUS command procedure.
$!
$CREATE_JOB:
$ CLOSE output_file
$ NAME = F$GETJPI("","USERNAME")
$ 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 "$ SET DEFAULT SYS$LOGIN"
$ WRITE output_file "$ FOCUS"
$ WRITE output_file "EXEC SI$FOCUS:RE-CURR-LABELS-SEL TERM=" + TERMIN
$ WRITE output_file "FIN"
$ WRITE output_file "$ EXIT"
$!
$ CLOSE output_file
$ SUBMIT/NOPRINT/NOTIFY 'COM_FILE'
$ SYNCHRONIZE FOCTEMP
$!
$ IF F$SEARCH ("SYS$LOGIN:LABELS.FTM") .EQS. "" THEN GOTO EXIT
$ SAY " "
$ SAY " "
$ SAY "Producing Laser labels"
$ RUN LASER-LABELS
$ SAY " "
$ SAY " "
$!
$EXIT:
$!
$ SAY " "
$ SAY "All done..."
$ SAY " "
$!
$! CLEAN UP.
$!
$ DELETE/LOG SYS$LOGIN:*.FTM;*
$ DELETE/LOG SYS$LOGIN:*.MAS;*
$ DELETE/LOG SYS$LOGIN:*.WP;*
$ DELETE/LOG SYS$LOGIN:ZIP.TXT;*
$ DELETE/LOG SYS$LOGIN:FOCTEMP.COM;*
$!
$ SET DEFAULT SYS$LOGIN
$ EXIT
FOCUS program :
-*begin doc
-*
-*FEX: RE-CURR-LABELS-SEL
-*
-*input
-* Term
-* Zip Codes To Select On
-*
-* This procedure produces a file that can be run through the
-* label program to produce mailing labels for currently enrolled
-* students. The user is prompted for the zip codes to use.
-*
-*end doc
-*
-* Select students enrolled for input term.
-*
SET LINES=56
FILEDEF ZIP DISK SYS$LOGIN:ZIP.TXT
JOIN CLEAR *
TABLE FILE RTFILE
PRINT MAJOR_1 CURR_ATTEMPTED_HRS BY STU_ID
ON TABLE HOLD AS RTTEMP1
WHERE TERM EQ '&TERM';
WHERE CURR_ATTEMPTED_HRS GT 1;
END
-*
-* Get address information for students living in specified
-* zip codes.
-*
JOIN STU_ID IN RTTEMP1 TO STU_ID IN ADFILE
-*
DEFINE FILE RTTEMP1
ST_ZIP/A5=EDIT(ZIP_CODE_DPBC,'99999');
OUT_ZIP/A13=STATE|' '|ST_ZIP|' ';
END
TABLE FILE RTTEMP1
PRINT STREET_1 STREET_2 CITY OUT_ZIP BY STU_ID
IF ST_ZIP IS (ZIP)
WHERE AD020_ORDER LE ADDRESS_CTR;
ON TABLE HOLD AS RTTEMP2
END
-*
-* Get student name and produce file for label program.
-*
JOIN STU_ID IN RTTEMP2 TO STU_ID IN AAFILE
-*
TABLE FILE RTTEMP2
PRINT STU_NAME STREET_1 STREET_2 CITY OUT_ZIP
BY OUT_ZIP NOPRINT
ON TABLE HOLD AS LABELS
END
JOIN CLEAR *
LASER-LABELS.COB :
IDENTIFICATION DIVISION.
PROGRAM-ID. LASER-LABELS.
AUTHOR. ME.
INSTALLATION. IRM.
DATE-WRITTEN. 08-10-89.
**************************************************************
** 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