Typical DCL Command Procedure to run the program :
$!
$! COM:ADM-PROS-INDVAL-LIST.COM
$!
$! THIS COMMAND PROCEDURE WILL CREATE THE ADMISSIONS INDIVIDUAL VALUE
$! LETTERS.
$!
$ SET NOVERIFY
$ SET NOCONTROL_Y
$ ASK := READ/PROMPT=
$ SAY := WRITE SYS$OUTPUT
$!
$ MONTH_01 = "January"
$ MONTH_02 = "February"
$ MONTH_03 = "March"
$ MONTH_04 = "April"
$ MONTH_05 = "May"
$ MONTH_06 = "June"
$ MONTH_07 = "July"
$ MONTH_08 = "August"
$ MONTH_09 = "September"
$ MONTH_10 = "October"
$ MONTH_11 = "November"
$ MONTH_12 = "December"
$!
$ FLD_1 = "Prospect Source"
$ FLD_2 = "Ethnic Origin"
$ FLD_3 = "School Code"
$ FLD_4 = "Prospect Level"
$ FLD_5 = "Academic Interest"
$ FLD_6 = "Admissions Counselor"
$!
$ASK_LOOP:
$!
$ CL
$!
$! Prompt for "individual value".
$!
$ SAY ""
$ SAY "The fields to be selected from are as follows:"
$ SAY ""
$ SAY "1 - Prospect Source"
$ SAY "2 - Ethnic Origin"
$ SAY "3 - School Code"
$ SAY "4 - Prospect Level"
$ SAY "5 - Academic Interest"
$ SAY "6 - Admissions Counselor"
$ SAY ""
$!
$ENTER_PARM_VAL:
$!
$ READ SYS$COMMAND/TIME=60/END=EXIT_LOOP/ERROR=EXIT_LOOP/PROMPT= -
"Enter field to be used >>> " VALIN
$ TYP_VALIN = F$TYPE(VALIN)
$ IF TYP_VALIN .NES. "INTEGER" THEN GOTO ENTER_PARM_VAL
$ LEN_VALIN = F$LENGTH(VALIN)
$ IF LEN_VALIN .NE. 1 THEN GOTO ENTER_PARM_VAL
$ IF (VALIN .NES. "1") .AND. (VALIN .NES. "2") .AND. (VALIN .NES. "3") .AND. -
(VALIN .NES. "4") .AND. (VALIN .NES. "5") .AND. (VALIN .NES. "6") -
THEN GOTO ENTER_PARM_VAL
$ SAY ""
$ READ SYS$COMMAND/TIME=60/END=EXIT_LOOP/ERROR=EXIT_LOOP/PROMPT= -
"Enter individual value to be used >>> " INDIN
$!
$! Prompt for dates to be used on letter.
$!
$! Create today's date to be used as default.
$!
$ DAY = F$CVTIME("TODAY",,"DAY")
$ MON = F$CVTIME("TODAY",,"MONTH")
$ YEAR = F$CVTIME("TODAY",,"YEAR")
$!
$ IF F$EXTRACT(0,1,DAY) .EQS. "0"
$ THEN
$ DAY = F$EXTRACT(1,1,DAY)
$ ENDIF
$!
$ DATE = MONTH_'MON' + " " + DAY + ", " + F$EXTRACT(0,4,YEAR)
$!
$ SAY ""
$ SAY "Date to appear on letter [''DATE']"
$ READ SYS$COMMAND/TIME=60/END=EXIT_LOOP/ERROR=EXIT_LOOP/PROMPT= -
"Press <ENTER> to select today's date >>> " DATEIN1
$ IF DATEIN1 .EQS. ""
$ THEN
$ DATEIN1 = DATE
$ ENDIF
$!
$! Prompt for beginning date to extract prospects.
$!
$ENTER_PARM_BDAY:
$ SAY ""
$ READ SYS$COMMAND/TIME=60/END=EXIT_LOOP/ERROR=EXIT_LOOP/PROMPT= -
"Enter the beginning date (YYYYMMDD) to extract prospects >>> " BDAYIN
$ LEN_BDAYIN = F$LENGTH(BDAYIN)
$ IF LEN_BDAYIN .NE. 8 THEN GOTO ENTER_PARM_BDAY
$ TYP_BDAYIN = F$TYPE(BDAYIN)
$ IF TYP_BDAYIN .NES. "INTEGER" THEN GOTO ENTER_PARM_BDAY
$!
$! Prompt for ending date to extract prospects.
$!
$ENTER_PARM_EDAY:
$ SAY ""
$ READ SYS$COMMAND/TIME=60/END=EXIT_LOOP/ERROR=EXIT_LOOP/PROMPT= -
"Enter the ending date (YYYYMMDD) to extract prospects >>> " EDAYIN
$ LEN_EDAYIN = F$LENGTH(EDAYIN)
$ IF LEN_EDAYIN .NE. 8 THEN GOTO ENTER_PARM_EDAY
$ TYP_EDAYIN = F$TYPE(EDAYIN)
$ IF TYP_EDAYIN .NES. "INTEGER" THEN GOTO ENTER_PARM_EDAY
$!
$! Let user check parameters before running program.
$!
$ FLD_DESC = FLD_'VALIN'
$ CL
$ SAY " "
$ SAY "Field ''FLD_DESC' "
$ SAY "Value ''INDIN' "
$ SAY "Beginning date ''BDAYIN' "
$ SAY "Ending date ''EDAYIN' "
$ SAY "Letter date ''DATEIN1' "
$ SAY " "
$ ASK "Is the above information correct Y/N [Y]? " SYS$COMMAND YN
$ IF YN .EQS. "" THEN YN = "Y"
$ IF .NOT. YN THEN GOTO ASK_LOOP
$!
$! Create and execute the FOCUS command procedure to generate the data
$! source.
$!
$ CL
$ SAY ""
$ SAY "Please wait while program executes..."
$ SAY ""
$!
$ COPY SI$FOCUS:WORDFMT.MFD SYS$LOGIN:*.MAS;
$ 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:ADM-PROS-INDVAL-LIST"
$ WRITE output_file VALIN
$ WRITE output_file BDAYIN
$ WRITE output_file EDAYIN
$ WRITE output_file INDIN
$ WRITE output_file "FIN"
$ WRITE output_file "$ EXIT"
$!
$ CLOSE output_file
$ SUBMIT/NOPRINT/NOTIFY 'COM_FILE'
$ SYNCHRONIZE FOCTEMP
$!
$! Format the resulting output to include the letter date.
$!
$ OPEN/READ input_file SYS$LOGIN:INDVALIN.FTM
$ OPEN/WRITE output_file SYS$LOGIN:INDVALOUT.DOC
$!
$! Extract "header" records.
$!
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$!
$READ_LOOP:
$!
$! Read in "static" fields.
$!
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ WRITE output_file in_record
$!
$ READ/END_OF_FILE=EXIT_LOOP input_file hold_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$ READ/END_OF_FILE=EXIT_LOOP input_file in_record
$!
$ WRITE output_file hold_record + DATEIN1 + "|END*"
$!
$ GOTO READ_LOOP
$!
$EXIT_LOOP:
$!
$ CLOSE input_file
$ CLOSE output_file
$ 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:FOCTEMP.COM;*
$ DELETE/LOG SYS$LOGIN:INDVALHD.DOC;*
$ EXIT
FOCUS program :
-*begin doc
-*
-*FEX: ADM-PROS-INDVAL-LIST
-*
-* This produces a list of prospects who need to be sent
-* an admissions prospect individual value letter. The output
-* is generated in a format that can be used to create a MS
-* Word data source.
-*
-*INPUT
-* Beginning Date : Begining Contact Date In YYYYMMDD Format
-* Ending Date : Ending Contact Date In YYYYMMDD Format
-* Individual Value : Type/Value Of Prospect To Select From
-*
-*USAGE
-* Used to determine how many initial contacts were made for specific
-* dates. (Recruitment reporting)
-*
-*end doc
-**********************************************************************
-*
-PROMPT &SORTKEY/A1.REPORT TO RUN 1 - SOURCE 2 - RACE 3 - SCHOOL CODE 4 - ACAD LVL 5 - ACAD INT 6 - ADM COUNS :
-PROMPT &BDATE/A8.ENTER THE BEGINING CONTACT DATE (YYYYMMDD) :
-PROMPT &EDATE/A8.ENTER THE ENDING CONTACT DATE (YYYYMMDD) :
-PROMPT &INDVAL/A6.ENTER THE INDIVIDUAL VALUE :
-*
-SET &SKEY = DECODE &SORTKEY (1 'PRSPCT_SOURCE_1' 2 'ETHNIC_ORIGIN' 3 'INSTITUTION'
- 4 'PRSPCT_LVL' 5 'ACAD_INT_1' 6 'ADMIS_REP'
- ELSE ' ');
JOIN CLEAR *
SET PAGE=NOPAGE
SET LINES=999999
SET COMPUTE=OLD
-*
-* Select students from Admissions who meet criteria.
-*
TABLE FILE MMFILE
PRINT PRSPCT_SOURCE_1 PRSPCT_LVL PRE_APP_TERM INSTITUTION ADMIS_REP
INITIAL_CONTACT_DT ACAD_INT_1 ACAD_INT_2 ACAD_INT_3
BY STU_ID
WHERE (INITIAL_CONTACT_DT GE &BDATE) AND (INITIAL_CONTACT_DT LE &EDATE);
ON TABLE HOLD AS MMTEMP1
END
-*
-* Exclude students who have already applied for Admissions.
-*
MATCH FILE MMTEMP1
PRINT PRSPCT_SOURCE_1 PRSPCT_LVL PRE_APP_TERM INSTITUTION ADMIS_REP
INITIAL_CONTACT_DT ACAD_INT_1 ACAD_INT_2 ACAD_INT_3
BY STU_ID
RUN
FILE MMFILE
PRINT MAJOR_1 BY STU_ID
WHERE MAJOR_1 NE '';
WHERE MM030_ORDER LE AP_SEG_CNTR;
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
-*
-* Get student address information.
-*
JOIN STU_ID IN HOLD TO STU_ID IN ADFILE AS J1
TABLE FILE HOLD
PRINT PRSPCT_SOURCE_1 PRSPCT_LVL PRE_APP_TERM INSTITUTION ADMIS_REP
ACAD_INT_1 ACAD_INT_2 ACAD_INT_3 INITIAL_CONTACT_DT
STREET_1 STREET_2 CITY STATE ZIP_CODE_DPBC
BY STU_ID
WHERE AD020_ORDER LE ADDRESS_CTR;
WHERE (ADDR_TYPE_1 EQ 'P') OR (ADDR_TYPE_2 EQ 'P') OR (ADDR_TYPE_3 EQ 'P') OR
(ADDR_TYPE_4 EQ 'P') OR (ADDR_TYPE_5 EQ 'P');
ON TABLE HOLD AS MMTEMP2
END
-*
-* Get student name information.
-*
JOIN STU_ID IN MMTEMP2 TO STU_ID IN AAFILE AS J2
TABLE FILE MMTEMP2
PRINT PRSPCT_SOURCE_1 PRSPCT_LVL PRE_APP_TERM INSTITUTION ADMIS_REP
ACAD_INT_1 ACAD_INT_2 ACAD_INT_3 INITIAL_CONTACT_DT
STREET_1 STREET_2 CITY STATE ZIP_CODE_DPBC
STU_NAME SEX ETHNIC_ORIGIN STU_SALU
BY STU_ID
ON TABLE HOLD AS MMTEMP3
END
-*
-* Select students based upon "individual value".
-*
FILEDEF PRDECODE DISK SI$FOCUS:PR_TABLE.DAT
DEFINE FILE MMTEMP3
AINT1/A47 = IF ACAD_INT_1 EQ '' THEN '' ELSE
DECODE ACAD_INT_1 (PRDECODE ELSE ' ');
AINT2/A47 = IF ACAD_INT_2 EQ '' THEN '' ELSE
DECODE ACAD_INT_2 (PRDECODE ELSE ' ');
AINT3/A47 = IF ACAD_INT_3 EQ '' THEN '' ELSE
DECODE ACAD_INT_3 (PRDECODE ELSE ' ');
SRT_KEY/A41 = STU_NAME|STU_ID;
END
TABLE FILE MMTEMP3
PRINT PRSPCT_SOURCE_1 PRSPCT_LVL PRE_APP_TERM
AINT1 AINT2 AINT3 INITIAL_CONTACT_DT
STREET_1 STREET_2 CITY STATE ZIP_CODE_DPBC
STU_NAME SEX ETHNIC_ORIGIN STU_SALU SRT_KEY
BY &SKEY NOPRINT
BY STU_ID
WHERE (&SKEY EQ '&INDVAL');
ON TABLE HOLD AS MMTEMP4
END
-*
-* Make an output file in MS Word data source format.
-*
DEFINE FILE MMTEMP4
-INCLUDE SI$FOCUS:NAMEPARS.SEG
FOR_SID/A11 = EDIT (STU_ID, '999-99-9999');
SEM/A1 = EDIT(PRE_APP_TERM,'$$$$9');
SEMDEC/A6 = DECODE SEM (1 'Fall' 2 'Spring' 3 'Summer');
AY2/A4 = EDIT(PRE_APP_TERM,'9999$');
IY2/I4 = EDIT(AY2);
INY/I4 = IY2 + 1;
ANY/A4 = EDIT(INY);
-*
CONTACT_DT_ALP/A8=EDIT(INITIAL_CONTACT_DT);
TI_FLD/A4 = MXCASE(4,STU_SALU,'A4');
TRMDEC_FLD/A20 = IF PRE_APP_TERM EQ '' THEN '' ELSE SEMDEC|' '|AY2|'-'|ANY;
-*
L1/A70 = 'START' || '|' || TI_FLD || '|' || FUL_NAME || '|' || FOR_SID;
L2/A70 = '|' || STREET_1 || '|' || STREET_2;
L3/A70 = '|' || CITY || '|' || STATE || '|' || ZIP_CODE_DPBC;
L4/A70 = '|' || LST_NAME || '|' || PRSPCT_SOURCE_1;
L5/A70 = '|' || CONTACT_DT_ALP || '|' || TRMDEC_FLD || '|' ||
PRE_APP_TERM || '
';
L6/A70 = '|' || AINT1 || '
';
L7/A70 = '|' || AINT2 || '
';
L8/A70 = '|' || AINT3 || '|';
EOR/A5 = '|END*';
END
TABLE FILE MMTEMP4
"START|TI|NA|SID|A1|A2|CY|ST|ZP|LSTNAM|PSTSRC|CNTDATE|"
"TRMDEC|APPTRM|AINT1|AINT2|AINT3|ldate|END*"
-*
PRINT SEX AS ''
BY SRT_KEY NOPRINT
ON SRT_KEY SUBHEAD
"<1 <L1"
"<1 <L2"
"<1 <L3"
"<1 <L4"
"<1 <L5"
"<1 <L6"
"<1 <L7"
"<1 <L8"
ON SRT_KEY SUBFOOT
"<1 <EOR"
ON TABLE SAVE AS INDVALHD FORMAT DOC
END
-*
FILEDEF WORDFMT DISK INDVALHD.DOC
TABLE FILE WORDFMT
PRINT DATA_FIELD
ON TABLE SAVE AS INDVALIN
END
JOIN CLEAR *
Master File Description (MFD) for WORDFMT :
FILE=WORDFMT,SUFFIX=FIX
SEGNAME=ROOT
FIELD=GEN_FIL001, ,A01,A01,$
FIELD=DATA_FIELD, ,A79,A79,$
This page hosted by 
Get your own Free Homepage