Typical DCL Command Procedure to run the program :
(1)
$ SET NOON
$ DELETE SI$FOCUS:*.FTM;*/LOG
$ DELETE SI$FOCUS:*.MAS;*/LOG
$ COPY SI$FOCUS:ADFILE.MFD SI$FOCUS:*.MAS;/LOG
$ SET DEF SI$FOCUS
$ DEFINE FOC$DIR1 SI$DATA
$ FOCUS
EXEC (FOCEXEC name) ADTERM=(Admissions term)
FIN
$ NAME = F$GETJPI("","USERNAME")
$ MAIL/SUBJ="(FOCEXEC name)/NOT EXIST IN SIS" -
SI$FOCUS:PLAY1.FTM 'NAME'
$ MAIL/SUBJ="(FOCEXEC name)/BR HOLD FLAG ACTIVE" -
SI$FOCUS:PLAY2.FTM 'NAME'
$ MAIL/SUBJ="(FOCEXEC name)/ACTIVE FOR CURRENT TERM" -
SI$FOCUS:PLAY3.FTM 'NAME'
$ MAIL/SUBJ="(FOCEXEC name)/HAS PREVIOUSLY ENROLLED" -
SI$FOCUS:PLAY4.FTM 'NAME'
$ MAIL/SUBJ="(FOCEXEC name)/HAS APPLICATION FOR FUTURE TERM" -
SI$FOCUS:PLAY5.FTM 'NAME'
$ MAIL/SUBJ="(FOCEXEC name)/ORIGINAL LIST" -
SI$FOCUS:PLAY7.FTM 'NAME'
$ CONVERT/APPEND/PAD=%D32 SI$FOCUS:PLAY.FTM SI$DATA:AIBBFL.DAT
$ COPY/LOG SI$FOCUS:HOLD.*; DISK$DATA1:['NAME']*.*;
$ EXIT
(2)
$ SET NOON
$ DELETE SI$FOCUS:*.FTM;*/LOG
$ DELETE SI$FOCUS:*.MAS;*/LOG
$ DEFINE FOC$DIR1 SI$DATA
$ COPY DISK$DATA1:['NAME']HOLD.*; SI$FOCUS:*.*;/LOG
$ SET DEFAULT SI$FOCUS
$ FOCUS
EXEC (FOCEXEC name)
FIN
$ NAME = F$GETJPI("","USERNAME")
$ MAIL/SUBJ="(FOCEXEC name)/HAS BR, FA, OR TERM INDICATOR ON" -
SI$FOCUS:PLAY6.FTM 'NAME'
$ CONVERT/APPEND/PAD=%D32 SI$FOCUS:PLAY.FTM SI$DATA:AIBBFL.DAT
$ SET DEF SI$COM
$ SUBMIT/NOPRINT/NOTIFY/QUE=(VMS batch queue with a job limit of 1) AJMNTCYCL.COM
$ EXIT
COBOL program :
IDENTIFICATION DIVISION.
PROGRAM-ID. (COBOL program).
AUTHOR. ME.
DATE-COMPILED.
***************************************************************************
* *
* THIS PROGRAM ALLOWS THE ADMISSIONS OFFICE TO LOAD A STUDENT'S ID *
* INTO A HOLD FILE SO THAT ITS DATA CAN BE REMOVED. *
* *
***************************************************************************
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INDX-FILE
ASSIGN TO ADFILE.
DATA DIVISION.
FILE SECTION.
FD INDX-FILE.
**
01 INDX-RECORD.
03 INDX-REC-KEY.
05 AD-RECORD-KEY PIC X(09).
05 AD-RECORD-TERM PIC X(03).
**
*
WORKING-STORAGE SECTION.
*
*
01 WS-AD-SSN-ID PIC X(09).
01 WS-AD-SSN-ID-ARRAY REDEFINES WS-AD-SSN-ID.
03 WS-AD-SSN-ID-CHAR OCCURS 9 TIMES INDEXED BY IX.
05 WS-AD-SSN-ID-POS PIC X(01).
01 WS-AD-TERM PIC X(03).
01 WS-FUNCT PIC X(01).
01 WS-FUNCT-AD PIC X(01).
01 WS-GO-ON PIC X(01).
*
*
PROCEDURE DIVISION.
*
*
0000-MAINLINE.
OPEN
OUTPUT INDX-FILE.
MOVE SPACES TO WS-AD-TERM.
DISPLAY 'PLEASE ENTER (E) TO ENTER STUDENT ID OR (Q) TO QUIT '
AT LINE 1 AT COLUMN 1 ERASE SCREEN.
ACCEPT WS-FUNCT.
PERFORM 0010-PROCESS-SEL
UNTIL WS-FUNCT EQUAL TO 'Q' OR 'q'.
CLOSE INDX-FILE.
STOP RUN.
0010-PROCESS-SEL.
IF (WS-FUNCT EQUAL TO 'E' OR 'e') AND (WS-AD-TERM EQUAL TO SPACES) THEN
DISPLAY 'PLEASE ENTER CURRENT TERM '
ACCEPT WS-AD-TERM
MOVE SPACES TO WS-FUNCT-AD
PERFORM 1550-CHECK-AD-TERM
UNTIL WS-FUNCT-AD EQUAL TO 'Q' OR 'q'.
IF WS-FUNCT EQUAL TO 'E' OR 'e' THEN PERFORM 1300-ENTER-RECORD.
DISPLAY 'PLEASE ENTER (E) TO ENTER STUDENT ID OR (Q) TO QUIT '
AT LINE 1 AT COLUMN 1 ERASE SCREEN.
ACCEPT WS-FUNCT.
1300-ENTER-RECORD.
DISPLAY 'PLEASE ENTER STUDENT ID '.
ACCEPT WS-AD-SSN-ID.
MOVE SPACES TO WS-FUNCT.
PERFORM 1450-CHECK-STU-ID
UNTIL WS-FUNCT EQUAL TO 'Q' OR 'q'.
PERFORM 1350-WRITE-RECORD.
1350-WRITE-RECORD.
MOVE SPACES TO INDX-REC-KEY.
MOVE WS-AD-SSN-ID TO AD-RECORD-KEY.
MOVE WS-AD-TERM TO AD-RECORD-TERM.
WRITE INDX-RECORD.
1450-CHECK-STU-ID.
MOVE 'Y' TO WS-GO-ON.
PERFORM 1500-CHECK-EACH-CHAR VARYING IX FROM 1 BY 1
UNTIL IX GREATER THAN 9.
IF WS-GO-ON IS EQUAL TO 'N' THEN
DISPLAY 'INVALID CHARACTER IN STUDENT ID. PLEASE RE-ENTER.'
DISPLAY 'PLEASE ENTER STUDENT ID '
ACCEPT WS-AD-SSN-ID
ELSE
MOVE 'Q' TO WS-FUNCT.
1500-CHECK-EACH-CHAR.
IF WS-AD-SSN-ID-POS (IX) EQUAL TO '1' OR '2' OR '3' OR '4' OR '5' OR
'6' OR '7' OR '8' OR '9' OR '0' THEN
NEXT SENTENCE
ELSE
MOVE 'N' TO WS-GO-ON.
1550-CHECK-AD-TERM.
IF WS-AD-TERM IS EQUAL TO '951' OR '952' OR '953' OR
'961' OR '962' OR '963' OR
'971' OR '972' OR '973' OR
'981' OR '982' OR '983' OR
'991' OR '992' OR '993' THEN
MOVE 'Q' TO WS-FUNCT-AD
ELSE
DISPLAY 'INCORRECT TERM. PLEASE RE-ENTER.'
DISPLAY 'PLEASE ENTER CURRENT TERM '
ACCEPT WS-AD-TERM.
FOCUS program :
(1)
-* THIS FOCEXEC GENERATES BATCH TRANSACTIONS TO PURGE ADMISSIONS
-* DATA FOR THE STUDENTS IN THE INCOMING HOLD FILE.
-* VARIABLES USED:
-* ADTERM : THE ADMISSIONS TERM TO CHECK
-*
-SET &HDRKEY = '$$$MSC207 SR DRP COR YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
FILEDEF ADFILE DISK DISK$DATA1:['NAME']ADFILE.DAT
-*
-* SORT INPUT FILE
-*
TABLE FILE ADFILE
PRINT D2 BY D1
ON TABLE HOLD AS ADTEMP1
END
TABLE FILE ADTEMP1
PRINT D1
ON TABLE SAVE AS PLAY7
END
-*
-* CHECK TO SEE IF IDS EXIST IN SIS
-*
JOIN TEMP_KEY WITH D1 IN ADTEMP1 TO KEY IN AAFILE AS J1
DEFINE FILE ADTEMP1
TEMP_KEY/A11=('XX'|D1);
JN_KEY/A14=(D2|'XX'|D1);
END
TABLE FILE ADTEMP1
PRINT D1
ON TABLE SAVE AS PLAY1
IF ROOT_KEY_AA EQ ' '
END
-*
-* CHECK TO SEE IF BR HOLD FLAG IS ACTIVE
-*
TABLE FILE ADTEMP1
PRINT D1
ON TABLE SAVE AS PLAY2
WHERE (HOLD_FLG2 EQ '02') OR (HOLD_FLG5 EQ '05') OR (HOLD_FLG6 EQ '06')
OR (HOLD_FLG7 EQ '07') OR (HOLD_FLG8 EQ '08') OR
(HOLD_FLG14 EQ '14') OR (HOLD_FLG19 EQ '19') OR (HOLD_FLG20 EQ '20');
END
-*
-* SAVE THOSE WHO EXIST IN SIS AND DO NOT HAVE A BR HOLD FLAG ACTIVE
-*
TABLE FILE ADTEMP1
PRINT JN_KEY BY D1
ON TABLE HOLD AS ADTEMP2
WHERE (HOLD_FLG2 NE '02') AND (HOLD_FLG5 NE '05') AND (HOLD_FLG6 NE '06')
AND (HOLD_FLG7 NE '07') AND (HOLD_FLG8 NE '08') AND
(HOLD_FLG14 NE '14') AND (HOLD_FLG19 NE '19') AND (HOLD_FLG20 NE '20');
IF ROOT_KEY_AA NE ' '
END
-*
-* CHECK TO SEE IF THERE IS AN APPLICATION FOR A FUTURE TERM
-*
JOIN CLEAR *
JOIN TEMP_KEY WITH D1 IN ADTEMP2 TO KEY IN MMFILE AS J1
DEFINE FILE ADTEMP2
TEMP_KEY/A11=('XX'|D1);
END
TABLE FILE ADTEMP2
PRINT D1
ON TABLE SAVE AS PLAY5
IF APP_TERM GT '&ADTERM'
END
TABLE FILE ADTEMP2
PRINT D1
ON TABLE HOLD AS ADTEMP2A
IF APP_TERM GT '&ADTERM'
END
DEFINE FILE ADTEMP2A
THS_REC/A1=IF D1 NE LAST D1 THEN 'Y' ELSE 'N';
END
TABLE FILE ADTEMP2A
PRINT THS_REC BY D1
ON TABLE HOLD AS ADTEMP2B
IF THS_REC EQ 'Y'
END
-*
-* SAVE THOSE WHO DO NOT HAVE AN APPLICATION FOR A FUTURE TERM
-*
TABLE FILE ADTEMP2
PRINT APP_TERM JN_KEY BY D1
ON TABLE HOLD AS ADTEMP3
IF APP_TERM LE '&ADTERM'
END
DEFINE FILE ADTEMP3
THS_REC/A1=IF D1 NE LAST D1 THEN 'Y' ELSE 'N';
END
TABLE FILE ADTEMP3
PRINT JN_KEY BY D1
ON TABLE HOLD AS ADTEMP3A
IF THS_REC EQ 'Y'
END
TABLE FILE ADTEMP2
PRINT JN_KEY BY D1
ON TABLE HOLD AS ADTEMP2C
IF ROOT_KEY_MM EQ ' '
END
DEFINE FILE ADTEMP2C
THS_REC/A1=IF D1 NE LAST D1 THEN 'Y' ELSE 'N';
END
TABLE FILE ADTEMP2C
PRINT JN_KEY AS PLAY_JN_KEY BY D1
ON TABLE HOLD AS ADTEMP2D
IF THS_REC EQ 'Y'
END
MATCH FILE ADTEMP2D
PRINT JN_KEY BY D1
RUN
FILE ADTEMP3A
PRINT JN_KEY BY D1
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
-*
MATCH FILE HOLD
PRINT JN_KEY BY D1
RUN
FILE ADTEMP2B
PRINT THS_REC BY D1
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
TABLE FILE HOLD
PRINT D1 BY JN_KEY
ON TABLE HOLD AS ADTEMP3B
END
-*
-* CHECK TO SEE IF ACTIVE FOR THE CURRENT TERM
-*
JOIN CLEAR *
JOIN JN_KEY IN ADTEMP3B TO KEY IN RTFILE AS J2
TABLE FILE ADTEMP3B
PRINT D1
ON TABLE SAVE AS PLAY3
IF KEY NE ' '
IF CURR_AHRS_RT GT 00.00
END
-*
-* SAVE THOSE WHO ARE NOT ACTIVE FOR THE CURRENT TERM
-*
TABLE FILE ADTEMP3B
PRINT D1
ON TABLE HOLD AS ADTEMP4
IF KEY EQ ' '
END
JOIN CLEAR *
-*
-* CHECK TO SEE IF STUDENT HAS EVER ENROLLED
-*
JOIN TEMP_KEY WITH D1 IN ADTEMP4 TO KEY IN RPFILE AS J1
DEFINE FILE ADTEMP4
TEMP_KEY/A11=('XX'|D1);
SUPER_JN_KEY/A14=(ACTV_TERM_RP|'XX'|D1);
END
TABLE FILE ADTEMP4
PRINT D1 BY SUPER_JN_KEY
ON TABLE HOLD AS ADTEMP5
WHERE (ACTV_TERM_RP NE ' ');
END
JOIN SUPER_JN_KEY IN ADTEMP5 TO KEY IN RTFILE AS J2
TABLE FILE ADTEMP5
PRINT D1
ON TABLE SAVE AS PLAY4
IF CURR_AHRS_RT GT 00.00
END
-*
-* SAVE THOSE STUDENTS WHO HAVE NEVER ENROLLED
-*
TABLE FILE ADTEMP5
PRINT SUPER_JN_KEY BY D1
ON TABLE HOLD AS ADTEMP5A
IF CURR_AHRS_RT GT 00.00
END
DEFINE FILE ADTEMP5A
THS_REC/A1=IF D1 NE LAST D1 THEN 'Y' ELSE 'N';
END
TABLE FILE ADTEMP5A
PRINT THS_REC BY D1
ON TABLE HOLD AS ADTEMP5B
IF THS_REC EQ 'Y'
END
TABLE FILE ADTEMP5
PRINT SUPER_JN_KEY BY D1
ON TABLE HOLD AS ADTEMP5C
END
DEFINE FILE ADTEMP5C
THS_REC/A1=IF D1 NE LAST D1 THEN 'Y' ELSE 'N';
END
TABLE FILE ADTEMP5C
PRINT SUPER_JN_KEY BY D1
ON TABLE HOLD AS ADTEMP5D
IF THS_REC EQ 'Y'
END
MATCH FILE ADTEMP5D
PRINT SUPER_JN_KEY BY D1
RUN
FILE ADTEMP5B
PRINT THS_REC BY D1
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
JOIN CLEAR *
-*
-* IF STUDENT HAS NEVER ENROLLED, DROP ALL NON-CE COURSES
-*
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN RPFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
SUPER_JN_KEY/A14=(ACTV_TERM_RP|'XX'|D1);
END
TABLE FILE HOLD
PRINT D1 BY SUPER_JN_KEY
ON TABLE HOLD AS ADTEMP6
WHERE (ACTV_TERM_RP NE ' ');
END
JOIN SUPER_JN_KEY IN ADTEMP6 TO KEY IN RTFILE AS J2
DEFINE FILE ADTEMP6
OUT_RECORD1/A60=('45B'|SID_RT|' DRP'|TERM_RT|SPE_SECT_RT|
' 0');
OUT_RECORD2/A21=('49D'|SID_RT|' '|TERM_RT);
END
TABLE FILE ADTEMP6
PRINT OUT_RECORD1
ON TABLE SAVE AS PLAY
IF CURR_AHRS_RT EQ 00.00
IF CRS_LVL_RT NE 'CE'
WHERE RT_020_ORDER LE SPE_CTR_RT;
END
-SET &HDRKEY = '$$$MSC208 SR DRP TRM YRE';
-INCLUDE (SIS Batch Header).SEG
-*
-* DELETE ALL ACTIVE TERMS
-*
TABLE FILE ADTEMP6
PRINT OUT_RECORD2
ON TABLE SAVE AS PLAY
END
-*
-* SAVE THOSE STUDENTS WHO HAVE NEVER ENROLLED AND HAVE NO ACTIVE TERMS
-*
DEFINE FILE ADTEMP4
TEMP_FLD/A11=('XX'|D1);
END
MATCH FILE ADTEMP4
PRINT TEMP_FLD BY D1
RUN
FILE ADTEMP5B
PRINT THS_REC BY D1
AFTER MATCH HOLD OLD-NOT-NEW
END
-RUN
-*
-* DELETE ALL HIGH SCHOOL INFORMATION
-*
-SET &HDRKEY = '$$$MSC209 SR DEL HS YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN RBFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
OUT_RECORD/A22=('32D'|D1|' 0'|HS_CODE);
END
TABLE FILE HOLD
PRINT OUT_RECORD
ON TABLE SAVE AS PLAY
IF HS_CODE NE ' '
WHERE RB_020_ORDER LE HS_CTR;
END
-*
-* DELETE ALL COLLEGE INFORMATION
-*
-SET &HDRKEY = '$$$MSC210 SR DEL COL YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN RBFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
OUT_RECORD/A22=('33D'|D1|' '|PREV_COLL_CD);
END
TABLE FILE HOLD
PRINT OUT_RECORD
ON TABLE SAVE AS PLAY
IF PREV_COLL_CD NE ' '
WHERE RB_040_ORDER LE PRV_COLL_CTR;
END
-*
-* DELETE ALL TEST SCORES
-*
-SET &HDRKEY = '$$$MSC211 SR DEL TST YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN RBFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
DT_YR/A2=EDIT(TEST_DT, '99$$$$');
DT_MON/A2=EDIT(TEST_DT, '$$99$$');
DT_DAY/A2=EDIT(TEST_DT, '$$$$99');
OUT_RECORD/A27=('31D'|D1|' '|TEST_CD|DT_MON|DT_DAY|DT_YR);
END
TABLE FILE HOLD
PRINT OUT_RECORD
ON TABLE SAVE AS PLAY
IF TEST_CD NE ' '
WHERE RB_030_ORDER LE TEST_CTR;
END
-*
-* DELETE ALL ADMISSIONS INFORMATION
-*
JOIN CLEAR *
-SET &HDRKEY = '$$$MSC212 SR DEL ADM YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN MMFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
OUT_RECORD/A13=('30D'|D1);
END
TABLE FILE HOLD
PRINT OUT_RECORD
ON TABLE SAVE AS PLAY
IF ROOT_KEY_MM NE ' '
END
-*
-* DELETE ALL ADVISOR INFORMATION
-*
-SET &HDRKEY = '$$$MSC213 SR DEL ADV YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN RPFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
OUT_RECORD/A34=('10B'|D1|' * *');
END
TABLE FILE HOLD
PRINT OUT_RECORD
ON TABLE SAVE AS PLAY
WHERE (ADVSR1_ID_RP NE ' ') OR (ADVSR2_ID_RP NE ' ');
END
-*
-* DELETE ALL TRANSFER CREDIT
-*
-SET &HDRKEY = '$$$MSC214 SR DEL TRN YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
JOIN TEMP_KEY WITH D1 IN HOLD TO KEY IN RAFILE AS J1
DEFINE FILE HOLD
TEMP_KEY/A11=('XX'|D1);
OUT_RECORD1/A30=('59D'|D1|' '|TRNF_ACTV);
OUT_RECORD2/A20=('58D'|D1|' '|INIT_CRER);
END
TABLE FILE HOLD
PRINT OUT_RECORD1
ON TABLE SAVE AS PLAY
IF TRNF_ACTV NE ' '
END
-*
-* DELETE ALL INITIAL STATISTICS
-*
-SET &HDRKEY = '$$$MSC215 SR DEL STA YRE';
-INCLUDE (SIS Batch Header).SEG
TABLE FILE HOLD
PRINT OUT_RECORD2
ON TABLE SAVE AS PLAY
IF INIT_CRER NE ' '
END
JOIN CLEAR *
(2)
-* THIS FOCEXEC GENERATES DELETE SHARED BATCH TRANSACTIONS FOR THE STUDENTS
-* WHOSE ADMISSIONS DATA WAS PURGED IN THE PREVIOUS REPORT.
-*
JOIN CLEAR *
FILEDEF HOLD DISK HOLD.FTM
-*
-* DELETE STUDENT FROM SHARED
-*
-SET &HDRKEY = '$$$MSC216 SR DEL STU YRE';
-INCLUDE (SIS Batch Header).SEG
TABLE FILE HOLD
PRINT TEMP_FLD BY D1
ON TABLE HOLD AS ADTEMP1
END
JOIN TEMP_KEY WITH D1 IN ADTEMP1 TO KEY IN AAFILE AS J1
DEFINE FILE ADTEMP1
TEMP_KEY/A11=('XX'|D1);
OUT_RECORD/A13=('02D'|D1);
END
TABLE FILE ADTEMP1
PRINT OUT_RECORD
ON TABLE SAVE AS PLAY
WHERE (BR_IND_AA EQ 'N') AND (CRER_STAT_AA EQ 'N') AND (FAM_LOC_AA EQ 'N');
END
TABLE FILE ADTEMP1
PRINT D1
ON TABLE SAVE AS PLAY6
WHERE (BR_IND_AA EQ 'Y') OR (CRER_STAT_AA EQ 'Y' OR 'A')
AND (FAM_LOC_AA EQ 'Y' OR 'A');
END
JOIN CLEAR *
Master File Description (MFD) for ADFILE :
FILE=ADFILE,SUFFIX=FIX SEGNAME=ROOT FIELD=D1, ,A9,A9,$ FIELD=D2, ,A3,A3,$
This page hosted by 
Get your own Free Homepage