Program Code

Typical DCL Command Procedure to set up the program :

$ SET NOVERIFY
$ SAY :== "WRITE SYS$OUTPUT"
$!
$ SAY "This report produces the graduate index card labels for the"
$ SAY "specified academic terms.  The graduate name, the full major"
$ SAY "name, and any honors are listed."
$ SAY " "
$ SAY "CHECK TO MAKE SURE CORRECT MAJOR DECODE FILE IS BEING USED..."
$ 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
$ COPY SI$FOCUS_USER:PUNCH2.MFD; SI$FOCUS_USER:PLAY5.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
$!
$ OPEN/READ INPUT_FILE PLAY3.FTM
$ OPEN/WRITE OUTPUT_FILE TEMPFILE.TMP
$ PG_BK_REC = "<FF>"
$!
$ READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$ OUTFILE_REC = "      "
$ WRITE OUTPUT_FILE OUTFILE_REC
$ WRITE OUTPUT_FILE OUTFILE_REC
$!
$ LAB_CNT = 1
$ LINE_CNT = 1
$READ_MORE_SHA:
$ READ/END_OF_FILE=BEGIN_SHA INPUT_FILE IN_RECORD
$ CHK_FST_SP = F$EXTRACT(0,1,IN_RECORD)
$ IF CHK_FST_SP .EQS. "?"
$ THEN
$    GOSUB FIX_LABEL
$    LINE_CNT = 1
$    LAB_CNT = LAB_CNT + 1
$    GOSUB CHECK_NEW_PAGE
$ ELSE
$    FST_CHUNK1 = F$EXTRACT(0,62,IN_RECORD)
$    FST_CHUNK2 = F$EXTRACT(62,62,IN_RECORD)
$    OUTFILE_REC = FST_CHUNK1 + "          " + FST_CHUNK2 
$    WRITE OUTPUT_FILE OUTFILE_REC
$    LINE_CNT = LINE_CNT + 1
$ ENDIF
$ GOTO READ_MORE_SHA
$BEGIN_SHA:
$ CLOSE OUTPUT_FILE
$ CLOSE INPUT_FILE
$ RENAME TEMPFILE.TMP TEMPFILE.DOC;/LOG
$ COPY TEMPFILE.DOC Z$PRT:(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="INDEX CARD LABELS" -
  SI$FOCUS_USER:EMPTY_FILE_(FOCEXEC name).DOC 'NAME'
$ DELETE/LOG SI$FOCUS_USER:EMPTY_FILE_(FOCEXEC name).DOC;*
$ EXIT
$FIX_LABEL:
$ IF LINE_CNT .LT. 13
$ THEN
$    OUTFILE_REC = "      "
$    WRITE OUTPUT_FILE OUTFILE_REC
$    LINE_CNT = LINE_CNT + 1
$    GOTO FIX_LABEL
$ ELSE
$    RETURN
$ ENDIF
$CHECK_NEW_PAGE:
$ IF LAB_CNT .EQ. 6
$ THEN
$    OUTFILE_REC = PG_BK_REC 
$    WRITE OUTPUT_FILE OUTFILE_REC
$    OUTFILE_REC = "      "
$    WRITE OUTPUT_FILE OUTFILE_REC
$    WRITE OUTPUT_FILE OUTFILE_REC
$    LAB_CNT = 1
$ ENDIF
$ RETURN

FOCUS program :

-*  THIS FOCEXEC WILL PRODUCE THE GRADUATE INDEX CARD LABELS.
-*  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
-*
OFFLINE CLOSE
FILEDEF OFFLINE DISK Z$PRT:TEMPFILE.DOC
-*
-*    CHANGE FILE DEFINITION IF THE COMPLETE DEGREE NAME IS NEEDED.
-*
FILEDEF D_MAJOR DISK SI$FOCUS_USER:D_MAJOR_ENH.DOC
SET PAGE=NOPAGE
SET LINES=999999
SET FOCSTACK=32
JOIN CLEAR *
DEFINE FILE RPFILE
TERM_DEG_OUT/A3=IF TRM_DEG_EXPC NE '   ' THEN TRM_DEG_EXPC ELSE
                   DEG_TRM_RP;
END
TABLE FILE RPFILE
PRINT ROOT_KEY_RP SID_RP TERM_DEG_OUT
ON TABLE HOLD AS RPTEMP1
WHERE (TRM_DEG_EXPC EQ '&FSTTRM' OR '&SECTRM' OR '&THDTRM') OR
(DEG_TRM_RP EQ '&FSTTRM' OR '&SECTRM' OR '&THDTRM');
IF DEG_STAT_RP EQ '1' OR '2' OR '3'
END
JOIN ROOT_KEY_RP IN RPTEMP1 TO KEY IN RPFILE AS J1
TABLE FILE RPTEMP1
PRINT ROOT_KEY_RP SID_RP GPA_RP LST_TRM_STAT TERM_DEG_OUT
ON TABLE HOLD AS RPTEMP2
IF STU_LVL_STAT EQ 'CR'
END
JOIN CLEAR *
JOIN TEMP_KEY WITH ROOT_KEY_RP IN RPTEMP2 TO KEY IN RTFILE AS J1
DEFINE FILE RPTEMP2
TEMP_KEY/A14=(TERM_DEG_OUT|ROOT_KEY_RP);
END
TABLE FILE RPTEMP2
PRINT ROOT_KEY_RP SID_RP GPA_RP LST_TRM_STAT TERM_DEG_OUT 
      RPT9_FLG_RT RPT3_FLG_RT
ON TABLE HOLD AS RPTEMP3
WHERE TERM_RT EQ TERM_DEG_OUT;
END
JOIN TEMP_KEY WITH ROOT_KEY_RP IN RPTEMP3 TO KEY IN RTFILE AS J2
DEFINE FILE RPTEMP3
TEMP_KEY/A14=(TERM_DEG_OUT|ROOT_KEY_RP);
END
TABLE FILE RPTEMP3
PRINT GPA_RP LST_TRM_STAT TERM_DEG_OUT RPT9_FLG_RT RPT3_FLG_RT
      PRIM_MJR1_RT PRIM_MJR2_RT PRIM_MNR_RT PRIM_CERT_RT 
      SCND_MJR1_RT SCND_MJR2_RT SCND_MNR_RT SCND_CERT_RT
      GRAD_CD_RT PRIM_DEG_RT
BY SID_RP
ON TABLE HOLD AS RPTEMP5
WHERE TERM_RT EQ TERM_DEG_OUT;
END
DEFINE FILE RQFILE
GRAD_NAME_124/A54=TSCR_TXT_RQ;
JN_KEY_RQ/A11=('XX'|SID_RQ);
END
TABLE FILE RQFILE
PRINT GRAD_NAME_124 SID_RQ BY JN_KEY_RQ
ON TABLE HOLD AS RQTEMP1
IF POSITION_RQ EQ 'G'
IF TXT_LINE_NUM EQ '1'
END
DEFINE FILE RQFILE
CHK_FLD/A3=
EDIT(TSCR_TXT_RQ,'$$$$$$$$$999$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$');
END
MATCH FILE RQFILE
PRINT TSCR_TXT_RQ AS PHI_TEXT BY SID_RQ
IF CHK_FLD EQ 'PHI'
RUN
FILE RQFILE
PRINT TSCR_TXT_RQ AS WHO_TEXT BY SID_RQ
IF CHK_FLD EQ 'WHO'
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
MATCH FILE HOLD
PRINT PHI_TEXT WHO_TEXT BY SID_RQ
RUN
FILE RQFILE
PRINT TSCR_TXT_RQ AS ALL_TEXT BY SID_RQ
IF CHK_FLD EQ 'ALL'
AFTER MATCH HOLD OLD-OR-NEW
END
-RUN
DEFINE FILE HOLD
JN_KEY/A11=('XX'|SID_RQ);
END
TABLE FILE HOLD
PRINT PHI_TEXT WHO_TEXT ALL_TEXT SID_RQ BY JN_KEY
ON TABLE HOLD AS RPTEMP10
END
JOIN CLEAR *
JOIN TEMP_KEY WITH SID_RP IN RPTEMP5 TO KEY IN AAFILE AS J1
JOIN TEMP_KEY WITH SID_RP IN RPTEMP5 TO JN_KEY_RQ IN RQTEMP1 AS J5
JOIN TEMP_KEY WITH SID_RP IN RPTEMP5 TO JN_KEY IN RPTEMP10 AS J6
DEFINE FILE RPTEMP5
TEMP_KEY/A11=('XX'|SID_RP);
WHICH_NAME/A54=IF GRAD_NAME_124 NE ' ' THEN GRAD_NAME_124 ELSE
                  STU_NAME_AA;
TMP_NAME/A54 = GETTOK(WHICH_NAME,54,2,',',54,TMP_NAME);
SFX_NAME/A5 = GETTOK(WHICH_NAME,54,3,',',5,SFX_NAME);
FMN_NAME/A54 = LJUST(54,TMP_NAME,FMN_NAME);
FST_NAME/A54 = GETTOK(FMN_NAME,54,1,' ',54,FST_NAME);
MDL_NAME/A54 = GETTOK(WHICH_NAME,54,3,' ',54,MDL_NAME);
LST_NAME/A54 = GETTOK(WHICH_NAME,54,1,',',54,LST_NAME);
EXPNDNME/A116 = FMN_NAME || (' '|LST_NAME|' ') || SFX_NAME || '*';
CMPRSNME/A54 = GETTOK (EXPNDNME,110,1,'*',54,CMPRSNME);
R_NAME/A54 = LJUST(54,CMPRSNME,R_NAME);
-*
OUT_PROGRAM1/A60=DECODE PRIM_MJR1_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM2/A60=DECODE PRIM_MJR2_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM3/A60=DECODE PRIM_MNR_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM4/A60=DECODE PRIM_CERT_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM5/A60=DECODE SCND_MJR1_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM6/A60=DECODE SCND_MJR2_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM7/A60=DECODE SCND_MNR_RT (D_MAJOR ELSE '     ');
OUT_PROGRAM8/A60=DECODE SCND_CERT_RT (D_MAJOR ELSE '     ');
-*
HONORS_LINE1/A30=IF (GPA_RP GE 03.50 AND GPA_RP LT 04.00) 
                  THEN 'WITH HONORS'
               ELSE IF (GPA_RP GE 04.00) THEN 'WITH HIGHEST HONORS'
               ELSE ' ';
HONORS_LINE2/A63=(PHI_TEXT);
HONORS_LINE3/A63=(WHO_TEXT);
HONORS_LINE4/A63=(ALL_TEXT);
END
TABLE FILE RPTEMP5
PRINT SID_RP R_NAME OUT_PROGRAM1 OUT_PROGRAM2 OUT_PROGRAM3 OUT_PROGRAM4
                    OUT_PROGRAM5 OUT_PROGRAM6 OUT_PROGRAM7 OUT_PROGRAM8 
                    HONORS_LINE1 HONORS_LINE2 HONORS_LINE3 HONORS_LINE4
      AND COMPUTE CNTR/I1 = IF SID_RP EQ LAST SID_RP THEN CNTR + 1 ELSE 1;
BY NAME_SORT_AA
ON TABLE HOLD AS LBLDATA
IF TOTAL CNTR EQ 1
END
SET LINES=999999, PAGE=NOPAGE
DEFINE FILE LBLDATA
MAIL_LN3_OUT/A35=SUBSTR(63,HONORS_LINE2,1,35,35,MAIL_LN3_OUT);
MAIL_LN4_OUT/A35=SUBSTR(63,HONORS_LINE3,1,35,35,MAIL_LN4_OUT);
MAIL_LN5_OUT/A35=SUBSTR(63,HONORS_LINE4,1,35,35,MAIL_LN5_OUT);
EXTRA_LINE/A5='?    ';
XCOLMN/I4 WITH SID_RP = IF LAST XCOLMN EQ 2 THEN 1 ELSE LAST XCOLMN + 1;
XROW/I4 WITH SID_RP = IF XCOLMN EQ 1 THEN LAST XROW + 1
                         ELSE LAST XROW;
END
TABLE FILE LBLDATA
SUM R_NAME AS '' IN 1 
      OVER OUT_PROGRAM1 AS '' IN 1
      OVER OUT_PROGRAM2 AS '' IN 1
      OVER OUT_PROGRAM3 AS '' IN 1
      OVER OUT_PROGRAM4 AS '' IN 1
      OVER OUT_PROGRAM5 AS '' IN 1
      OVER OUT_PROGRAM6 AS '' IN 1
      OVER OUT_PROGRAM7 AS '' IN 1
      OVER OUT_PROGRAM8 AS '' IN 1
      OVER HONORS_LINE1 AS '' IN 1
      OVER MAIL_LN3_OUT AS '' IN 1
      OVER MAIL_LN4_OUT AS '' IN 1
      OVER MAIL_LN5_OUT AS '' IN 1
      OVER EXTRA_LINE AS '' IN 1
ACROSS XCOLMN NOPRINT
BY XROW SKIP-LINE NOPRINT
ON TABLE SAVE AS TEMP FORMAT WP
END
FILEDEF PLAY5 DISK TEMP.WP
TABLE FILE PLAY5
PRINT D2
ON TABLE HOLD AS PLAY3
IF D2 NE ' '
END
JOIN CLEAR *

Master File Description (MFD) for PUNCH2 :

FILE=PUNCH,SUFFIX=FIX
SEGNAME=ROOT
  FIELD=D1, ,A4,A4,$
  FIELD=D2, ,A124,A124,$

This page hosted by Get your own Free Homepage

Hosted by www.Geocities.ws