Typical DCL Command Procedure to run the program :
$!
$! FA_ADMS_CODE_2000.COM
$!
$! Description: Creates batch transactions to put ADMS code on screen
$! 306 for those who meet the criteria. This program
$! is for the 1999-2000 award year.
$!
$! CREATE TEMPORARY COMMAND PROCEDURE THE RUN FOCUS JOB.
$!
$ WF := WRITE FILE
$ COM_FILE = "SYS$LOGIN:FOCTEMP.COM"
$!
$ OPEN/WRITE FILE 'COM_FILE'
$ WF "$ SET DEFAULT SYS$LOGIN"
$ WF "$ DEFINE FOC$DIR1 SI$DATA"
$ WF "$ DEFINE FOC$DIR2 SI$MFD"
$ WF "$ FOCUS"
$ WF "EXEC SI$FOCUS:FA_ADMS_CODE_2000"
$ WF "FIN"
$ WF "$ EXIT"
$ CLOSE FILE
$ @'COM_FILE'
$!
$! MOVE RESULTING BATCH TRANSACTIONS TO MAINTENANCE CYCLE FEED FILE.
$!
$ CONVERT/APPEND SYS$LOGIN:FAADMS.FTM SI$DATA:AIB2FL.DAT
$!
$! CLEAN UP.
$!
$ DELETE/LOG SYS$LOGIN:*.FTM;*
$ DELETE/LOG SYS$LOGIN:*.MAS;*
$ DELETE/LOG SYS$LOGIN:*.WP;*
$ DELETE/LOG SYS$LOGIN:FOCTEMP.COM;*
$EXIT
FOCUS program :
-*begin doc
-*
-*FEX: FA_ADMS_CODE
-*
-* This produces a list of students who need to have the
-* ADMS code placed on screen 306 for them. Either they do
-* not have an active matriculation record for the
-* academic/enrollment year, are not active in Admissions,
-* or do not have an application on file. The update
-* is done through batch transactions.
-*
-*INPUT
-* AWD_YR : AWARD YEAR
-* AWD_PD : AWARD PERIOD
-* TERM : ENROLLMENT TERM
-*
-*end doc
-**********************************************************************
SET COMPUTE = OLD
SET PAGE = NOPAGE
SET LINES = 999999
-SET &AWD_YR = '2000';
-SET &AWD_PD = '2000A';
-SET &TERM1 = '19991';
-SET &TERM2 = '19993';
JOIN CLEAR *
FILEDEF FAADMS DISK FAADMS.FTM APPEND LREC 80 RECFM F
-*
-* Create The Batch Header
-*
DEFINE FILE AAFILE
BATCH_HEADER1/A40 = '$$$MSC513 ADMS IN FA UPD YFA ';
BATCH_HEADER2/A40 = ' ';
END
TABLE FILE AAFILE
PRINT BATCH_HEADER1 AS ''
BATCH_HEADER2 AS ''
BY STU_ID NOPRINT
ON TABLE SAVE AS FAADMS
IF RECORDLIMIT EQ 1
END
-*
-* Select all students who are being tracked on screen 306.
-*
TABLE FILE STFILE
PRINT AWD_YR BY STU_ID
WHERE AWD_YR EQ '&AWD_YR';
WHERE TRK_FORM NE '';
WHERE TRK_CNTR GT 0;
ON TABLE HOLD AS STTEMP1
END
-*
-* Remove duplicates.
-*
DEFINE FILE STTEMP1
THS_REC/A1=IF STU_ID NE LAST STU_ID THEN 'Y' ELSE 'N';
END
TABLE FILE STTEMP1
PRINT AWD_YR BY STU_ID
WHERE THS_REC EQ 'Y';
ON TABLE HOLD AS SATEMP1
END
-*
-* Select students not active in Admissions.
-*
MATCH FILE SATEMP1
PRINT AWD_YR BY STU_ID
RUN
FILE MMFILE
PRINT MM_HOUS_STAT BY STU_ID
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
-*
-* Save results into hold file.
-*
TABLE FILE HOLD
PRINT AWD_YR BY STU_ID
ON TABLE HOLD AS SATEMP2
END
-*
-* Select students who do not have an application on file.
-*
MATCH FILE SATEMP1
PRINT AWD_YR BY STU_ID
RUN
FILE MMFILE
PRINT AP_SEG_CNTR BY STU_ID
WHERE AP_SEG_CNTR EQ 0;
AFTER MATCH HOLD OLD-AND-NEW
END
-RUN
-*
-* Save results into hold file.
-*
TABLE FILE HOLD
PRINT AWD_YR BY STU_ID
ON TABLE HOLD AS SATEMP9
END
-*
-* Get all open matriculations for the academic/enrollment year.
-*
TABLE FILE AAFILE
PRINT ENTRY_TERM BY STU_ID
ON TABLE HOLD AS AATEMP1
WHERE (ENTRY_TERM LE '&TERM2') AND (EXIT_TERM GE '&TERM1');
WHERE COLLEGE NE 'CE';
WHERE AA060_ORDER LE AP_CNTR;
END
-*
-* Remove duplicates.
-*
DEFINE FILE AATEMP1
THS_REC/A1=IF STU_ID NE LAST STU_ID THEN 'Y' ELSE 'N';
END
TABLE FILE AATEMP1
PRINT ENTRY_TERM BY STU_ID
WHERE THS_REC EQ 'Y';
ON TABLE HOLD AS AATEMP2
END
-*
-* Select students who do not have an active matriculation.
-*
MATCH FILE SATEMP1
PRINT AWD_YR BY STU_ID
RUN
FILE AATEMP2
PRINT ENTRY_TERM BY STU_ID
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
-*
-* Save results into hold file.
-*
TABLE FILE HOLD
PRINT AWD_YR BY STU_ID
ON TABLE HOLD AS SATEMP3
END
-*
-* Combine lists from above
-*
MATCH FILE SATEMP2
PRINT AWD_YR BY STU_ID
RUN
FILE SATEMP3
PRINT AWD_YR BY STU_ID
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
-*
MATCH FILE HOLD
PRINT AWD_YR BY STU_ID
RUN
FILE SATEMP9
PRINT AWD_YR BY STU_ID
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
-*
-* Elminate students already being tracked for ADMS
-*
MATCH FILE HOLD
PRINT AWD_YR BY STU_ID
RUN
FILE STFILE
PRINT AWD_YR BY STU_ID
WHERE AWD_YR EQ '&AWD_YR';
WHERE TRK_FORM EQ 'ADMS';
WHERE ST020_ORDER LE TRK_CNTR;
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
-*
-* Eliminate duplicates
-*
DEFINE FILE HOLD
THS_REC/A1=IF STU_ID NE LAST STU_ID THEN 'Y' ELSE 'N';
END
TABLE FILE HOLD
PRINT AWD_YR BY STU_ID
WHERE THS_REC EQ 'Y';
ON TABLE HOLD AS SATEMP4
END
-*
-* Create batch transactions to update screen 306.
-*
DEFINE FILE SATEMP4
BTH_TRANS/A80 = ('72B'|STU_ID|' &AWD_PD ADMS '|
' A');
END
TABLE FILE SATEMP4
PRINT BTH_TRANS AS '' BY STU_ID NOPRINT
ON TABLE SAVE AS FAADMS
END
JOIN CLEAR *
This page hosted by 
Get your own Free Homepage