Typical DCL Command Procedure to set up the program :
$ SET NOVERIFY $ SAY :== "WRITE SYS$OUTPUT" $! $ SAY "This report produces the mailing labels for the University" $ SAY "attendance area based on the specified academic terms." $ SAY " " $! $ENTER_PARM: $ READ SYS$COMMAND/TIME=60/END=EXIT/ERROR=EXIT/PROMPT= - "Enter the first academic term to run this report for >>> " FSTTRMIN $ LEN_FSTTRMIN = F$LENGTH(FSTTRMIN) $ IF LEN_FSTTRMIN .NE. 3 THEN GOTO ENTER_PARM $ TYP_FSTTRMIN = F$TYPE(FSTTRMIN) $ IF TYP_FSTTRMIN .NES. "INTEGER" THEN GOTO ENTER_PARM $! $ SAY " " $ READ SYS$COMMAND/TIME=60/END=EXIT/ERROR=EXIT/PROMPT= - "Enter the second academic term to run this report for >>> " SECTRMIN $ LEN_SECTRMIN = F$LENGTH(SECTRMIN) $ IF LEN_SECTRMIN .NE. 3 THEN GOTO ENTER_PARM $ TYP_SECTRMIN = F$TYPE(SECTRMIN) $ IF TYP_SECTRMIN .NES. "INTEGER" THEN GOTO ENTER_PARM $! $ SAY " " $ READ SYS$COMMAND/TIME=60/END=EXIT/ERROR=EXIT/PROMPT= - "Enter the third academic term to run this report for >>> " THDTRMIN $ LEN_THDTRMIN = F$LENGTH(THDTRMIN) $ IF LEN_THDTRMIN .NE. 3 THEN GOTO ENTER_PARM $ TYP_THDTRMIN = F$TYPE(THDTRMIN) $ IF TYP_THDTRMIN .NES. "INTEGER" THEN GOTO ENTER_PARM $! $! Build parameter for (FOCEXEC name) $! $ EXEC1_REC = "EXEC (FOCEXEC name) FSTTRM=" + FSTTRMIN + - ", SECTRM=" + SECTRMIN + ", THDTRM=" + THDTRMIN $ OPEN/READ INPUT_FILE SI$FOCUS_USER:(FOCEXEC name).COM $ OPEN/WRITE OUTPUT_FILE SI$FOCUS_USER:(FOCEXEC name).TMP $READ_MORE_001: $ READ/END_OF_FILE=BEGIN_001 INPUT_FILE IN_RECORD $ IF F$EXTRACT(0,4,IN_RECORD) .EQS. "EXEC" $ THEN $ WRITE OUTPUT_FILE EXEC1_REC $ ELSE $ OUTFILE_REC = IN_RECORD $ WRITE OUTPUT_FILE OUTFILE_REC $ ENDIF $ GOTO READ_MORE_001 $BEGIN_001: $ CLOSE OUTPUT_FILE $ CLOSE INPUT_FILE $ OPEN/WRITE OUTPUT_FILE SI$FOCUS_USER:EMPTY_FILE_(FOCEXEC name).DOC $ EXEC1_REC = "PARAMETERS USED : First term = " + FSTTRMIN + - ", Second Term = " + SECTRMIN + ", Third term = " + THDTRMIN $ WRITE OUTPUT_FILE EXEC1_REC $ CLOSE OUTPUT_FILE $ RENAME SI$FOCUS_USER:(FOCEXEC name).TMP SI$FOCUS_USER:(FOCEXEC name).COM;/LOG $ SUBMIT/QUE=SYS$FOCUS SI$FOCUS_USER:(FOCEXEC name).COM $! $EXIT: $ EXIT
Typical DCL Command Procedure to actually run the program :
$ DELETE SI$FOCUS_USER:*.FTM;*/LOG
$ DELETE SI$FOCUS_USER:*.MAS;*/LOG
$ DEFINE FOC$DIR1 SI$DATA
$ SET DEFAULT SI$FOCUS_USER
$ FOCUS
EXEC (FOCEXEC name) FSTTRM=(First enrollment term), SECTRM=(Second enrollment term), THDTRM=(Third enrollment term)
FIN
$!
$! REFORMAT MAILING LABELS
$!
$ SET DEFAULT Z$PRT
$ OPEN/READ INPUT_FILE TEMPFILE.DOC
$ OPEN/WRITE OUTPUT_FILE TEMPFILE.TMP
$ PG_BK_REC = "<FF>"
$!
$ READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$! OUTFILE_REC = PG_BK_REC
$ OUTFILE_REC = " "
$ WRITE OUTPUT_FILE OUTFILE_REC
$!
$ READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$ READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$! READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$!
$ LAB_CNT = 1
$READ_MORE_SHA:
$ READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$ IF LAB_CNT .EQ. 61
$ THEN
$ OUTFILE_REC = PG_BK_REC
$ WRITE OUTPUT_FILE OUTFILE_REC
$ OUTFILE_REC = " "
$ WRITE OUTPUT_FILE OUTFILE_REC
$ OUTFILE_REC = F$EXTRACT(5,80,IN_RECORD)
$ WRITE OUTPUT_FILE OUTFILE_REC
$ LAB_CNT = 2
$ ELSE
$ OUTFILE_REC = F$EXTRACT(5,80,IN_RECORD)
$ WRITE OUTPUT_FILE OUTFILE_REC
$ LAB_CNT = LAB_CNT + 1
$ ENDIF
$ GOTO READ_MORE_SHA
$BEGIN_SHA:
$ CLOSE OUTPUT_FILE
$ CLOSE INPUT_FILE
$ RENAME TEMPFILE.TMP TEMPFILE.DOC;/LOG
$ RENAME TEMPFILE.DOC (FOCEXEC name).PRT;/LOG
$ DELETE TEMPFILE.DOC;*/LOG
$ OPEN/APPEND OUTPUT_FILE SI$FOCUS_USER:EMPTY_FILE_(FOCEXEC name).DOC
$ OUTFILE_REC=" "
$ WRITE OUTPUT_FILE OUTFILE_REC
$ OUTFILE_REC="FILE NAME : Z$PRT:" + -
F$EXTRACT(21,16,F$SEARCH("Z$PRT:(FOCEXEC name).PRT"))
$ WRITE OUTPUT_FILE OUTFILE_REC
$ OUTFILE_REC=" "
$ WRITE OUTPUT_FILE OUTFILE_REC
$ OUTFILE_REC="DATE/TIME FILE CREATED : " + F$TIME()
$ WRITE OUTPUT_FILE OUTFILE_REC
$ OUTFILE_REC=" "
$ WRITE OUTPUT_FILE OUTFILE_REC
$ CLOSE OUTPUT_FILE
$ NAME = F$GETJPI("","USERNAME")
$ MAIL/SUBJECT="UNIVERSITY MAILING LABELS/(FOCEXEC name)" -
SI$FOCUS_USER:EMPTY_FILE_(FOCEXEC name).DOC 'NAME'
$ DELETE/LOG SI$FOCUS_USER:EMPTY_FILE_(FOCEXEC name).DOC;*
$ EXIT
FOCUS program :
-* THIS FOCEXEC WILL PRODUCE THE MAILING LABELS FOR THE
-* UNIVERSITY ATTENDANCE AREA.
-* VARIABLES USED :
-* FSTTRM : THE FIRST ACADEMIC TERM TO EXTRACT FROM
-* SECTRM : THE SECOND ACADEMIC TERM TO EXTRACT FROM
-* THDTRM : THE THIRD ACADEMIC TERM TO EXTRACT FROM
-*
JOIN CLEAR *
OFFLINE CLOSE
FILEDEF OFFLINE DISK Z$PRT:TEMPFILE.DOC
TABLE FILE RTFILE
PRINT CAREER_RT TERM_RT BY SID_RT
ON TABLE HOLD AS RTTEMP1
IF TERM_RT EQ '&FSTTRM' OR '&SECTRM' OR '&THDTRM'
IF CAREER_RT NE 'CE'
END
DEFINE FILE RTTEMP1
THS_REC/A1=IF SID_RT NE LAST SID_RT THEN 'Y' ELSE 'N';
END
TABLE FILE RTTEMP1
PRINT CAREER_RT TERM_RT BY SID_RT
ON TABLE HOLD AS RTTEMP2
IF THS_REC EQ 'Y'
END
JOIN TEMP_KEY WITH SID_RT IN RTTEMP2 TO KEY IN AAFILE AS J1
DEFINE FILE RTTEMP2
TEMP_KEY/A11=('HG'|SID_RT);
END
MATCH FILE RTTEMP2
PRINT CAREER_RT BY SID_RT
WHERE (ZIP_AA EQ '{ZIP codes of target area}');
RUN
FILE RTTEMP2
PRINT TERM_RT BY SID_RT
WHERE (CNTY_ORIG_AA EQ '{County codes of target area}');
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
DEFINE FILE HOLD
THS_REC/A1=IF SID_RT NE LAST SID_RT THEN 'Y' ELSE 'N';
END
TABLE FILE HOLD
PRINT CAREER_RT TERM_RT BY SID_RT
ON TABLE HOLD AS RTTEMP3
IF THS_REC EQ 'Y'
END
JOIN CLEAR *
JOIN TEMP_KEY WITH SID_RT IN RTTEMP3 TO KEY IN AAFILE AS J1
DEFINE FILE RTTEMP3
TEMP_KEY/A11=('HG'|SID_RT);
TMP_NAME/A32 = GETTOK(STU_NAME_AA,32,2,',',32,TMP_NAME);
SFX_NAME/A5 = GETTOK(STU_NAME_AA,32,3,',',5,SFX_NAME);
FMN_NAME/A32 = LJUST(32,TMP_NAME,FMN_NAME);
FST_NAME/A32 = GETTOK(FMN_NAME,32,1,',',32,FST_NAME);
MDL_NAME/A32 = GETTOK(STU_NAME_AA,32,2,',',32,MDL_NAME);
LST_NAME/A32 = GETTOK(STU_NAME_AA,32,1,',',32,LST_NAME);
EXPNDNME/A72 = FMN_NAME || (' '|LST_NAME|' ') || SFX_NAME || '*';
CMPRSNME/A32 = GETTOK (EXPNDNME,66,1,'*',32,CMPRSNME);
R_NAME/A32 = LJUST(32,CMPRSNME,R_NAME);
END
-*
TABLE FILE RTTEMP3
PRINT SID_RT R_NAME STREET1_AA STREET2_AA CITY_AA STATE_AA ZIP_AA CNTRY_AA
AND COMPUTE CNTR/I1 = IF SID_RT EQ LAST SID_RT THEN CNTR + 1 ELSE 1;
BY NAME_SORT_AA
ON TABLE HOLD AS LBLDATA
WHERE (ADDR_TYP1_AA EQ 'M') OR (ADDR_TYP2_AA EQ 'M') OR
(ADDR_TYP3_AA EQ 'M') OR (ADDR_TYP4_AA EQ 'M') OR
(ADDR_TYP5_AA EQ 'M');
IF TOTAL CNTR EQ 1
END
SET LINES=999999, PAGE=NOPAGE
DEFINE FILE LBLDATA
TRL_CNTRY/A20 = IF CNTRY_AA NE 'US' AND CNTRY_AA NE ' ' THEN CNTRY_AA;
STATE/A2 = IF STATE_AA NE ' ' THEN STATE_AA;
ZIP/A10 = EDIT(ZIP_AA, '99999$$$$');
MAIL_CSZ/A32 = IF CNTRY_AA EQ 'US' OR ' ' THEN
( CITY_AA|' '|STATE_AA|' '|ZIP )
ELSE ( CITY_AA|' '|STATE );
MAIL_CNTRY/A32 = IF CNTRY_AA NE 'US' AND CNTRY_AA NE ' ' THEN
( TRL_CNTRY|' '|ZIP ) ELSE ' ';
MAIL_LN1/A32 = STREET1_AA;
MAIL_LN2/A32 = IF STREET2_AA EQ ' ' THEN MAIL_CSZ
ELSE STREET2_AA;
MAIL_LN3/A32 = IF STREET2_AA EQ ' ' THEN MAIL_CNTRY
ELSE MAIL_CSZ;
MAIL_LN4/A32 = IF STREET2_AA NE ' ' THEN MAIL_CNTRY
ELSE ' ';
R_NAME_OUT/A26=SUBSTR(32,R_NAME,1,26,26,R_NAME_OUT);
MAIL_LN1_OUT/A26=SUBSTR(32,MAIL_LN1,1,26,26,MAIL_LN1_OUT);
MAIL_LN2_OUT/A26=SUBSTR(32,MAIL_LN2,1,26,26,MAIL_LN2_OUT);
MAIL_LN3_OUT/A26=SUBSTR(32,MAIL_LN3,1,26,26,MAIL_LN3_OUT);
MAIL_LN4_OUT/A26=SUBSTR(32,MAIL_LN4,1,26,26,MAIL_LN4_OUT);
XCOLMN/I4 WITH SID_RT = IF LAST XCOLMN EQ 3 THEN 1 ELSE LAST XCOLMN + 1;
XROW/I4 WITH SID_RT = IF XCOLMN EQ 1 THEN LAST XROW + 1
ELSE LAST XROW;
END
TABLE FILE LBLDATA
SUM R_NAME_OUT AS ' ' IN 1 OVER
MAIL_LN1_OUT AS ' ' IN 1 OVER
MAIL_LN2_OUT AS ' ' IN 1 OVER
MAIL_LN3_OUT AS ' ' IN 1 OVER
MAIL_LN4_OUT AS ' ' IN 1
ACROSS XCOLMN NOPRINT
BY XROW SKIP-LINE NOPRINT
END
JOIN CLEAR *
This page hosted by 
Get your own Free Homepage