Typical DCL Command Procedure to run the program :
$!
$! AM-ADV-ASSIGN.COM
$!
$! Description: Creates batch transactions for
$! 1) those students without advisors.
$! 2) those students who changed majors and/or
$! the major they are in was assigned another
$! advisor.
$!
$! Process students without advisors.
$!
$! 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:AM-NO-ADV-ASSIGN"
$ WF "FIN"
$ WF "$ EXIT"
$ CLOSE FILE
$ @'COM_FILE'
$!
$! RENAME RESULTING HOLD FILE FOR USE IN NEXT PROGRAM.
$!
$ RENAME SYS$LOGIN:PLAY.FTM SYS$LOGIN:AM-ADV-IN.DAT;
$!
$! RUN PROGRAM TO DETERMINE ADVISOR ID.
$!
$ ASSIGN AM_ADV_ASSIGN_DATA.DAT ADVDATA
$ ASSIGN SYS$LOGIN:AM-ADV-IN.DAT ADVIN
$ ASSIGN SYS$LOGIN:AM-ADV-OUT.DAT ADVOUT
$!
$ RUN AM_ASSIGN_ADV_NEW
$!
$! Process students with advisors.
$!
$! CREATE TEMPORARY COMMAND PROCEDURE THE RUN FOCUS JOB.
$!
$ 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:AM-CHG-ADV-ASSIGN"
$ WF "FIN"
$ WF "$ EXIT"
$ CLOSE FILE
$ @'COM_FILE'
$!
$! RENAME RESULTING HOLD FILE FOR USE IN NEXT PROGRAM.
$!
$ RENAME SYS$LOGIN:PLAY.FTM SYS$LOGIN:AM-ADV-IN.DAT;
$!
$! RUN PROGRAM TO DETERMINE ADVISOR ID.
$!
$ ASSIGN AM_ADV_ASSIGN_DATA.DAT ADVDATA
$ ASSIGN SYS$LOGIN:AM-ADV-IN.DAT ADVIN
$ ASSIGN SYS$LOGIN:AM-ADV-OUT.DAT ADVOUT
$!
$ RUN AM_ASSIGN_ADV_CHG
$!
$ COPY SYS$LOGIN:AM-ADV-OUT.DAT;-1,SYS$LOGIN:AM-ADV-OUT.DAT; -
SYS$LOGIN:AM-ADV-OUT.TMP;
$!
$ COPY SI$FOCUS:ADVTRA.MFD SYS$LOGIN:*.MAS;
$!
$! CREATE TEMPORARY COMMAND PROCEDURE THE RUN FOCUS JOB TO
$! GENERATE TRANSACTIONS TO ASSIGN ADVISORS TO STUDENTS.
$!
$ 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:AM-TRANS-ADV-ASSIGN"
$ WF "FIN"
$ WF "$ EXIT"
$ CLOSE FILE
$ @'COM_FILE'
$!
$! MOVE RESULTING BATCH TRANSACTIONS TO MAINTENANCE CYCLE FEED FILE.
$!
$ CONVERT/APPEND SYS$LOGIN:ADMADV.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;*
$ DELETE/LOG SYS$LOGIN:AM-ADV*.DAT;*
$ DELETE/LOG SYS$LOGIN:AM-ADV*.TMP;*
$ EXIT
-*begin doc
-*
-*FEX: AM-NO-ADV-ASSIGN
-*
-*input
-* Term
-*
-* This FOCUS program will select students who have not been assigned
-* an advisor.
-*
-*end doc
-*
JOIN CLEAR *
-SET &INTERM='(input term to select from)';
-*
-* Select students accepted in admissions for the input term.
-*
TABLE FILE MMFILE
PRINT APP_TERM MAJOR_3 BY STU_ID
ON TABLE HOLD AS MMTEMP1
WHERE APP_TERM GE '&INTERM';
WHERE MM030_ORDER LE AP_SEG_CNTR;
WHERE MAJOR_3 NE '';
END
-*
-* Get list of students without advisors assigned.
-*
TABLE FILE AAFILE
PRINT ADVISOR_ID_1 BY STU_ID
ON TABLE HOLD AS AATEMP1
WHERE ADVISOR_ID_1 EQ 000000000;
WHERE AA050_ORDER LE SR_CNTR;
END
-*
-* Select students accepted in admissions without an assigned advisor.
-*
MATCH FILE MMTEMP1
PRINT APP_TERM MAJOR_3 BY STU_ID
RUN
FILE AATEMP1
PRINT ADVISOR_ID_1 BY STU_ID
AFTER MATCH HOLD OLD-AND-NEW
END
-RUN
-*
TABLE FILE HOLD
PRINT APP_TERM MAJOR_3 BY STU_ID
ON TABLE HOLD AS MMTEMP2
END
-*
-* Select students who are currently registered without an assigned
-* advisor.
-*
MATCH FILE RTFILE
PRINT MAJOR_1 TERM BY STU_ID
WHERE TERM GE '&INTERM';
WHERE CURR_ATTEMPTED_HRS GT 0;
RUN
FILE AATEMP1
PRINT ADVISOR_ID_1 BY STU_ID
AFTER MATCH HOLD OLD-AND-NEW
END
-RUN
-*
-* Combine two lists.
-*
MATCH FILE HOLD
PRINT MAJOR_1 TERM BY STU_ID
RUN
FILE MMTEMP2
PRINT MAJOR_3 APP_TERM BY STU_ID
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
-*
JOIN STU_ID IN HOLD TO STU_ID IN AAFILE AS J1
DEFINE FILE HOLD
-INCLUDE SI$FOCUS:NAMEPARS.SEG
WHC_MAJOR/A4=IF MAJOR_1 EQ '' THEN MAJOR_3 ELSE MAJOR_1;
CHK_MAJOR/A2=EDIT(WHC_MAJOR,'99');
CHK_STU_NAME/A3=IF (EDIT(LST_NAME,'9') EQ 'M') AND (CHK_MAJOR EQ 'TR')
THEN EDIT(LST_NAME,'99')|' '
ELSE EDIT(LST_NAME,'9')|' ';
UP_STU_NAME/A3=UPCASE(3,CHK_STU_NAME,UP_STU_NAME);
END
TABLE FILE HOLD
PRINT UP_STU_NAME STU_ID BY WHC_MAJOR
ON TABLE SAVE AS PLAY
END
JOIN CLEAR *
IDENTIFICATION DIVISION.
PROGRAM-ID. AM_ASSIGN_ADV_NEW.
AUTHOR. JAY THOMPSON.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. ALPHA-4000.
OBJECT-COMPUTER. ALPHA-4000.
*************************************************************************
* *
* This program is used to assign advisors to students who currently *
* do not have an advisor assigned to them. *
* *
*************************************************************************
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ADV-FILE-IN ASSIGN TO ADVIN.
SELECT ADV-FILE-OUT ASSIGN TO ADVOUT.
SELECT ADV-DATA ASSIGN TO ADVDATA.
DATA DIVISION.
FILE SECTION.
FD ADV-FILE-IN
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 16 CHARACTERS.
01 ADV-RECORD-IN PIC X(16).
FD ADV-FILE-OUT
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 22 CHARACTERS.
01 ADV-RECORD-OUT PIC X(22).
FD ADV-DATA
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 93 CHARACTERS.
01 ADV-DATA-IN PIC X(93).
WORKING-STORAGE SECTION.
01 WS-FD-ADV-RECORD.
05 WS-FD-ADV-DATA OCCURS 1000 TIMES INDEXED BY ADV-INDEX.
07 WS-FD-ADV-MAJOR PIC X(04).
07 FILLER PIC X(01).
07 WS-FD-ADV-ID PIC X(09).
07 FILLER PIC X(01).
07 WS-FD-ADV-ASSIGN PIC X(03) OCCURS 26 TIMES
INDEXED BY ALP-INDEX.
01 WS-FD-ADV-IN.
05 WS-FD-ADV-IN-MAJOR PIC X(04).
05 WS-FD-ADV-IN-NAME PIC X(03).
05 WS-FD-ADV-IN-SSN PIC X(09).
01 WS-FD-ADV-OUT.
05 WS-FD-ADV-OUT-MAJOR PIC X(04).
05 WS-FD-ADV-OUT-SSN PIC X(09).
05 WS-FD-ADV-OUT-ASSIGN PIC X(09).
01 WS-EOF PIC X.
01 WS-GOT-ADV PIC X.
01 WS-ARRAY-CNT PIC 9(04).
01 WS-FD-SEA-ADV-MAJOR.
05 WS-FD-SEA-ADV-TYPE PIC X(02).
05 WS-FD-SEA-ADV-DESC PIC X(02).
PROCEDURE DIVISION.
000-START-PROCESSING.
OPEN INPUT ADV-DATA.
MOVE "N" TO WS-EOF.
MOVE ZERO TO WS-ARRAY-CNT.
SET ADV-INDEX TO 1.
MOVE SPACES TO WS-FD-ADV-RECORD.
PERFORM 100-LOAD-ADV-ARRAY UNTIL WS-EOF IS EQUAL TO "Y".
SET ADV-INDEX DOWN BY 1.
SUBTRACT 1 FROM WS-ARRAY-CNT.
CLOSE ADV-DATA.
OPEN INPUT ADV-FILE-IN
OUTPUT ADV-FILE-OUT.
MOVE "N" TO WS-EOF.
PERFORM 200-CREATE-ADV-ASSIGN UNTIL WS-EOF IS EQUAL TO "Y".
CLOSE ADV-FILE-IN
ADV-FILE-OUT.
STOP RUN.
**
** Load array that has advisor assignment data.
**
100-LOAD-ADV-ARRAY.
MOVE SPACES TO WS-FD-ADV-DATA(ADV-INDEX)
ADV-DATA-IN.
READ ADV-DATA INTO WS-FD-ADV-DATA(ADV-INDEX)
AT END
MOVE "Y" TO WS-EOF.
SET ADV-INDEX UP BY 1.
ADD 1 TO WS-ARRAY-CNT.
**
** Process each input record to determine advisor assignment.
**
200-CREATE-ADV-ASSIGN.
READ ADV-FILE-IN INTO WS-FD-ADV-IN
AT END
MOVE "Y" TO WS-EOF.
MOVE WS-FD-ADV-IN-MAJOR TO WS-FD-SEA-ADV-MAJOR.
IF WS-FD-SEA-ADV-TYPE IS EQUAL TO "TR"
MOVE "**" TO WS-FD-SEA-ADV-DESC.
SET ADV-INDEX TO 1.
SET ALP-INDEX TO 1.
MOVE "N" TO WS-GOT-ADV.
PERFORM 300-GET-ADV-ASSIGN UNTIL WS-GOT-ADV IS EQUAL TO "Y" OR
ADV-INDEX IS EQUAL TO WS-ARRAY-CNT.
**
** Determine advisor assignment.
**
300-GET-ADV-ASSIGN.
SET ALP-INDEX TO 1.
IF WS-FD-ADV-MAJOR(ADV-INDEX) IS EQUAL TO WS-FD-SEA-ADV-MAJOR
IF WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX) IS EQUAL TO "ALL"
MOVE WS-FD-ADV-IN-MAJOR TO WS-FD-ADV-OUT-MAJOR
MOVE WS-FD-ADV-IN-SSN TO WS-FD-ADV-OUT-SSN
MOVE WS-FD-ADV-ID(ADV-INDEX) TO WS-FD-ADV-OUT-ASSIGN
WRITE ADV-RECORD-OUT FROM WS-FD-ADV-OUT
MOVE "Y" TO WS-GOT-ADV
ELSE
PERFORM 400-LOOK-AT-ALPHA UNTIL (WS-GOT-ADV IS EQUAL TO "Y") OR
(ALP-INDEX IS EQUAL TO 26) OR
(WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX)
IS EQUAL TO SPACES).
SET ADV-INDEX UP BY 1.
**
** Look through letters assigned to advisor id to find match.
**
400-LOOK-AT-ALPHA.
IF (WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX) IS EQUAL TO
WS-FD-ADV-IN-NAME) OR
((WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX) IS EQUAL TO "MC") AND
(WS-FD-ADV-IN-NAME IS EQUAL TO "MD " OR "ME " OR "MF " OR "MG " OR
"MH " OR "MI " OR "MJ " OR "MK " OR
"ML " OR "MM " OR "MN " OR "MO " OR
"MP " OR "MQ " OR "MR " OR "MS " OR
"MT " OR "MU " OR "MV " OR "MW" OR
"MX " OR "MY " OR "MZ "))
MOVE WS-FD-ADV-IN-MAJOR TO WS-FD-ADV-OUT-MAJOR
MOVE WS-FD-ADV-IN-SSN TO WS-FD-ADV-OUT-SSN
MOVE WS-FD-ADV-ID(ADV-INDEX) TO WS-FD-ADV-OUT-ASSIGN
WRITE ADV-RECORD-OUT FROM WS-FD-ADV-OUT
MOVE "Y" TO WS-GOT-ADV
ELSE
SET ALP-INDEX UP BY 1.
-*begin doc
-*
-*FEX: AM-CHG-ADV-ASSIGN
-*
-*input
-* Term
-*
-* This FOCUS program will select students who have been assigned
-* an advisor.
-*
-*end doc
-*
JOIN CLEAR *
-SET &INTERM='(input term to select from)';
-*
-* Select students accepted in admissions for the input term.
-*
TABLE FILE MMFILE
PRINT APP_TERM MAJOR_3 BY STU_ID
ON TABLE HOLD AS MMTEMP1
WHERE APP_TERM GE '&INTERM';
WHERE MM030_ORDER LE AP_SEG_CNTR;
WHERE MAJOR_3 NE '';
END
-*
-* Get list of students with advisors assigned.
-*
TABLE FILE AAFILE
PRINT ADVISOR_ID_1 BY STU_ID
ON TABLE HOLD AS AATEMP1
WHERE ADVISOR_ID_1 NE 000000000;
WHERE AA050_ORDER LE SR_CNTR;
END
-*
-* Select students accepted in admissions with an assigned advisor.
-*
MATCH FILE MMTEMP1
PRINT APP_TERM MAJOR_3 BY STU_ID
RUN
FILE AATEMP1
PRINT ADVISOR_ID_1 BY STU_ID
AFTER MATCH HOLD OLD-AND-NEW
END
-RUN
-*
TABLE FILE HOLD
PRINT APP_TERM MAJOR_3 BY STU_ID
ON TABLE HOLD AS MMTEMP2
END
-*
-* Select students who are currently registered with an assigned
-* advisor.
-*
MATCH FILE RTFILE
PRINT MAJOR_1 TERM BY STU_ID
WHERE TERM GE '&INTERM';
WHERE CURR_ATTEMPTED_HRS GT 0;
RUN
FILE AATEMP1
PRINT ADVISOR_ID_1 BY STU_ID
AFTER MATCH HOLD OLD-AND-NEW
END
-RUN
-*
-* Combine two lists.
-*
MATCH FILE HOLD
PRINT MAJOR_1 TERM BY STU_ID
RUN
FILE MMTEMP2
PRINT MAJOR_3 APP_TERM BY STU_ID
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
-*
MATCH FILE HOLD
PRINT MAJOR_1 MAJOR_3 TERM BY STU_ID
RUN
FILE AATEMP1
PRINT ADVISOR_ID_1 BY STU_ID
AFTER MATCH HOLD OLD
END
-RUN
-*
JOIN STU_ID IN HOLD TO STU_ID IN AAFILE AS J1
DEFINE FILE HOLD
-INCLUDE SI$FOCUS:NAMEPARS.SEG
WHC_MAJOR/A4=IF MAJOR_1 EQ '' THEN MAJOR_3 ELSE MAJOR_1;
CHK_MAJOR/A2=EDIT(WHC_MAJOR,'99');
CHK_STU_NAME/A3=IF (EDIT(LST_NAME,'9') EQ 'M') AND (CHK_MAJOR EQ 'TR')
THEN EDIT(LST_NAME,'99')|' '
ELSE EDIT(LST_NAME,'9')|' ';
UP_STU_NAME/A3=UPCASE(3,CHK_STU_NAME,UP_STU_NAME);
THS_REC/A1=IF STU_ID NE LAST STU_ID THEN 'Y' ELSE 'N';
END
TABLE FILE HOLD
PRINT UP_STU_NAME STU_ID ADVISOR_ID_1 BY WHC_MAJOR
ON TABLE SAVE AS PLAY
WHERE THS_REC EQ 'Y';
END
JOIN CLEAR *
IDENTIFICATION DIVISION.
PROGRAM-ID. AM_ASSIGN_ADV_CHG.
AUTHOR. JAY THOMPSON.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. ALPHA-4000.
OBJECT-COMPUTER. ALPHA-4000.
*************************************************************************
* *
* This program is used to assign advisors to students who either *
* changed majors and/or the major they were in was assigned another *
* advisor. *
* *
*************************************************************************
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ADV-FILE-IN ASSIGN TO ADVIN.
SELECT ADV-FILE-OUT ASSIGN TO ADVOUT.
SELECT ADV-DATA ASSIGN TO ADVDATA.
DATA DIVISION.
FILE SECTION.
FD ADV-FILE-IN
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 25 CHARACTERS.
01 ADV-RECORD-IN PIC X(25).
FD ADV-FILE-OUT
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 22 CHARACTERS.
01 ADV-RECORD-OUT PIC X(22).
FD ADV-DATA
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 93 CHARACTERS.
01 ADV-DATA-IN PIC X(93).
WORKING-STORAGE SECTION.
01 WS-FD-ADV-RECORD.
05 WS-FD-ADV-DATA OCCURS 1000 TIMES INDEXED BY ADV-INDEX.
07 WS-FD-ADV-MAJOR PIC X(04).
07 FILLER PIC X(01).
07 WS-FD-ADV-ID PIC X(09).
07 FILLER PIC X(01).
07 WS-FD-ADV-ASSIGN PIC X(03) OCCURS 26 TIMES
INDEXED BY ALP-INDEX.
01 WS-FD-ADV-IN.
05 WS-FD-ADV-IN-MAJOR PIC X(04).
05 WS-FD-ADV-IN-NAME PIC X(03).
05 WS-FD-ADV-IN-SSN PIC X(09).
05 WS-FD-ADV-IN-ADV PIC X(09).
01 WS-FD-ADV-OUT.
05 WS-FD-ADV-OUT-MAJOR PIC X(04).
05 WS-FD-ADV-OUT-SSN PIC X(09).
05 WS-FD-ADV-OUT-ASSIGN PIC X(09).
01 WS-EOF PIC X.
01 WS-GOT-ADV PIC X.
01 WS-ADV-CHK PIC X.
01 WS-ARRAY-CNT PIC 9(04).
01 WS-FD-SEA-ADV-MAJOR.
05 WS-FD-SEA-ADV-TYPE PIC X(02).
05 WS-FD-SEA-ADV-DESC PIC X(02).
PROCEDURE DIVISION.
000-START-PROCESSING.
OPEN INPUT ADV-DATA.
MOVE "N" TO WS-EOF.
MOVE ZERO TO WS-ARRAY-CNT.
SET ADV-INDEX TO 1.
MOVE SPACES TO WS-FD-ADV-RECORD.
PERFORM 100-LOAD-ADV-ARRAY UNTIL WS-EOF IS EQUAL TO "Y".
SET ADV-INDEX DOWN BY 1.
SUBTRACT 1 FROM WS-ARRAY-CNT.
CLOSE ADV-DATA.
OPEN INPUT ADV-FILE-IN
OUTPUT ADV-FILE-OUT.
MOVE "N" TO WS-EOF.
PERFORM 200-CREATE-ADV-ASSIGN UNTIL WS-EOF IS EQUAL TO "Y".
CLOSE ADV-FILE-IN
ADV-FILE-OUT.
STOP RUN.
**
** Load array that has advisor assignment data.
**
100-LOAD-ADV-ARRAY.
MOVE SPACES TO WS-FD-ADV-DATA(ADV-INDEX)
ADV-DATA-IN.
READ ADV-DATA INTO WS-FD-ADV-DATA(ADV-INDEX)
AT END
MOVE "Y" TO WS-EOF.
SET ADV-INDEX UP BY 1.
ADD 1 TO WS-ARRAY-CNT.
**
** Process each input record to determine advisor assignment.
**
200-CREATE-ADV-ASSIGN.
READ ADV-FILE-IN INTO WS-FD-ADV-IN
AT END
MOVE "Y" TO WS-EOF.
MOVE WS-FD-ADV-IN-MAJOR TO WS-FD-SEA-ADV-MAJOR.
IF WS-FD-SEA-ADV-TYPE IS EQUAL TO "TR"
MOVE "**" TO WS-FD-SEA-ADV-DESC.
SET ADV-INDEX TO 1.
SET ALP-INDEX TO 1.
MOVE "N" TO WS-GOT-ADV.
PERFORM 300-GET-ADV-ASSIGN UNTIL WS-GOT-ADV IS EQUAL TO "Y" OR
ADV-INDEX IS EQUAL TO WS-ARRAY-CNT.
**
** Determine advisor assignment; if different, write out results.
**
300-GET-ADV-ASSIGN.
SET ALP-INDEX TO 1.
IF WS-FD-ADV-MAJOR(ADV-INDEX) IS EQUAL TO WS-FD-SEA-ADV-MAJOR
IF WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX) IS EQUAL TO "ALL"
MOVE WS-FD-ADV-IN-MAJOR TO WS-FD-ADV-OUT-MAJOR
MOVE WS-FD-ADV-IN-SSN TO WS-FD-ADV-OUT-SSN
MOVE WS-FD-ADV-ID(ADV-INDEX) TO WS-FD-ADV-OUT-ASSIGN
MOVE "Y" TO WS-GOT-ADV
IF WS-FD-ADV-ID(ADV-INDEX) IS NOT EQUAL TO WS-FD-ADV-IN-ADV
MOVE "N" TO WS-ADV-CHK
PERFORM 500-CHECK-ADV-ID UNTIL WS-ADV-CHK IS EQUAL TO "Y" OR
ADV-INDEX IS EQUAL TO
WS-ARRAY-CNT
IF WS-ADV-CHK IS EQUAL TO "N"
WRITE ADV-RECORD-OUT FROM WS-FD-ADV-OUT
ELSE
PERFORM 400-LOOK-AT-ALPHA UNTIL (WS-GOT-ADV IS EQUAL TO "Y") OR
(ALP-INDEX IS EQUAL TO 26) OR
(WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX)
IS EQUAL TO SPACES).
SET ADV-INDEX UP BY 1.
**
** Look through letters assigned to advisor id to find match; if
** different, write out results.
**
400-LOOK-AT-ALPHA.
IF (WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX) IS EQUAL TO
WS-FD-ADV-IN-NAME) OR
((WS-FD-ADV-ASSIGN(ADV-INDEX,ALP-INDEX) IS EQUAL TO "MC") AND
(WS-FD-ADV-IN-NAME IS EQUAL TO "MD " OR "ME " OR "MF " OR "MG " OR
"MH " OR "MI " OR "MJ " OR "MK " OR
"ML " OR "MM " OR "MN " OR "MO " OR
"MP " OR "MQ " OR "MR " OR "MS " OR
"MT " OR "MU " OR "MV " OR "MW" OR
"MX " OR "MY " OR "MZ "))
MOVE WS-FD-ADV-IN-MAJOR TO WS-FD-ADV-OUT-MAJOR
MOVE WS-FD-ADV-IN-SSN TO WS-FD-ADV-OUT-SSN
MOVE WS-FD-ADV-ID(ADV-INDEX) TO WS-FD-ADV-OUT-ASSIGN
MOVE "Y" TO WS-GOT-ADV
IF WS-FD-ADV-ID(ADV-INDEX) IS NOT EQUAL TO WS-FD-ADV-IN-ADV
MOVE "N" TO WS-ADV-CHK
PERFORM 500-CHECK-ADV-ID UNTIL WS-ADV-CHK IS EQUAL TO "Y" OR
ADV-INDEX IS EQUAL TO
WS-ARRAY-CNT
IF WS-ADV-CHK IS EQUAL TO "N"
WRITE ADV-RECORD-OUT FROM WS-FD-ADV-OUT
ELSE
SET ALP-INDEX UP BY 1.
**
** Check to see if "old" advisor id is in the same major as the selected
** advisor id.
**
500-CHECK-ADV-ID.
SET ALP-INDEX TO 1.
IF ((WS-FD-ADV-MAJOR(ADV-INDEX) IS EQUAL TO WS-FD-SEA-ADV-MAJOR) AND
(WS-FD-ADV-ID(ADV-INDEX) IS EQUAL TO WS-FD-ADV-IN-ADV))
MOVE "Y" TO WS-ADV-CHK.
SET ADV-INDEX UP BY 1.
-*begin doc
-*
-*FEX: AM-TRANS-ADV-ASSIGN
-*
-*input
-*
-* This FOCUS program will create transactions to assign advisors to
-* students.
-*
-*end doc
-*
JOIN CLEAR *
FILEDEF ADVTRA DISK SYS$LOGIN:AM-ADV-OUT.TMP
FILEDEF ADMADV DISK ADMADV.FTM APPEND LREC 80 RECFM F
-*
-* Create The Batch Header
-*
DEFINE FILE AAFILE
BATCH_HEADER1/A40 = '$$$MSC507 ADMS ADV UPD YAM ';
BATCH_HEADER2/A40 = ' ';
END
TABLE FILE AAFILE
PRINT BATCH_HEADER1 AS ''
BATCH_HEADER2 AS ''
BY STU_ID NOPRINT
ON TABLE SAVE AS ADMADV
IF RECORDLIMIT EQ 1
END
-*
DEFINE FILE ADVTRA
BTH_TRANS/A80 = ('10B'|SSN_ADV|' '|ID_ADV);
END
TABLE FILE ADVTRA
PRINT BTH_TRANS AS ''
ON TABLE SAVE AS ADMADV
END
JOIN CLEAR *
-*begin doc
-*
-*FEX: AM-ADVISOR-ASSIGN-LIST
-*
-* This produces a list of advisor assignments (majors they
-* are responsible for and student groupings).
-*
-*end doc
-**********************************************************************
-*
JOIN CLEAR *
SET COMPUTE=OLD
SET LINES=999999
-VMS COPY SI$FOCUS:ADVLIS.MFD *.MAS;
-*
FILEDEF ADVLIS DISK AM_ADV_ASSIGN_DATA.DAT
FILEDEF PRDECODE DISK SI$FOCUS:PR_TABLE.DAT
TABLE FILE ADVLIS
PRINT MAJOR_ADV ASSIGN_ADV BY ID_ADV
ON TABLE HOLD AS ADVTMP1
END
-*
JOIN ID_ADV IN ADVTMP1 TO KEY IN AYFILE AS J1
DEFINE FILE ADVTMP1
CHK_MJR/A2=EDIT(MAJOR_ADV,'$$99');
MJRDEC/A60 = DECODE MAJOR_ADV(PRDECODE);
BLK_LINE/A5= ' ';
END
TABLE FILE ADVTMP1
HEADING CENTER
"Advisor Assignment Listing"
-*
PRINT MAJOR_ADV AS '' MJRDEC AS ''
OVER FAC_NAME AS ''
OVER ASSIGN_ADV AS ''
OVER BLK_LINE AS ''
BY CHK_MJR NOPRINT
ON TABLE SAVE AS REPORT FORMAT WP
END
JOIN CLEAR *
Master File Description (MFD) for ADVTRA :
FILE=ADVTRA,SUFFIX=FIX
SEGNAME=ROOT
FIELD=MAJOR_ADV, ,A04,A04,$
FIELD=SSN_ADV, ,A09,A09,$
FIELD=ID_ADV, ,A09,A09,$
Master File Description (MFD) for ADVLIS :
FILE=ADVLIS,SUFFIX=FIX
SEGNAME=ROOT
FIELD=MAJOR_ADV, ,A04,A04,$
FIELD=GEN_FIL001, ,A01,A01,$
FIELD=ID_ADV, ,A09,A09,$
FIELD=GEN_FIL002, ,A01,A01,$
FIELD=ASSIGN_ADV, ,A76,A76,$
File layout for AM_ADV_ASSIGN_DATA.DAT file :
Positions 1-4 : Major code (can use wildcard of **)
Positions 6-14 : Id number of advisor
Positions 16-93 : Characters (up to two) of the student's last name; use
"ALL" if one advisor covers all students within a major.
Example :
TR** 999999990 A G I O
TR** 999999991 B K N
TR** 999999992 C F
TR** 999999993 E H MA MB
TR** 999999994 J L
TR** 999999995 MC
TR** 999999996 P Q R
TR** 999999997 D S
TR** 999999998 T U V W X Y Z
ABCD 999999999 ALL
EFGH 000000001 A B C D E F G H I J K L
EFGH 000000002 M N O P Q R S T U V W X Y Z
This page hosted by 
Get your own Free Homepage