CONVERTS STUDENT NAME, SALUTATION, & NICKNAME TO UPPER CASE.
DCL command procedure :
$ DEFINE FOC$DIR1 SI$DATA $ SET DEFAULT SI$FOCUS $ FOCUS EXEC (FOCEXEC name #1) FIN $ RENAME FILETOCK.FTM *.DAT $ ASSIGN/NOLOG FILETOCK.DAT FILETOCK $ RUN (COBOL program) $ FOCUS EXEC (FOCEXEC name #2) FIN $ EXIT
FOCUS program #1 :
DEFINE FILE AAFILE
OUT_FIELD/A44=('$$$'|STU_NAME_AA|SID_AA);
END
TABLE FILE AAFILE
PRINT OUT_FIELD BY SID_AA NOPRINT
ON TABLE SAVE AS FILETOCK
END
COBOL program :
IDENTIFICATION DIVISION.
PROGRAM-ID. (COBOL program).
AUTHOR. ME.
DATE-COMPILED.
***************************************************************************
* *
* THIS PROGRAM READS A FILE, CHECKS TO SEE IF ANY FIELD HAS LOWER CASE *
* LETTERS, AND THEN MARKS THOSE THAT DO. *
* *
***************************************************************************
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILE-TO-CHECK
ASSIGN TO FILETOCK.
DATA DIVISION.
FILE SECTION.
FD FILE-TO-CHECK.
*
01 RECORD-TO-CHECK.
03 RECORD-TO-CHECK-CONTENTS.
05 RECORD-TO-CHECK-KEY PIC X(03).
05 RECORD-TO-CHECK-REST PIC X(32).
05 FILLER PIC X(09).
*
WORKING-STORAGE SECTION.
*
01 WS-FIELD-TO-CHECK PIC X(32).
01 WS-FIELD-TO-CHECK-ARRAY REDEFINES WS-FIELD-TO-CHECK.
03 WS-FIELD-TO-CHECK-CHAR OCCURS 32 TIMES INDEXED BY IX.
05 WS-CHECK-CHAR PIC X(01).
01 FILE-STAT PIC X(03).
01 ANY-LOWER PIC X(01).
*
PROCEDURE DIVISION.
0000-MAINLINE.
OPEN
I-O FILE-TO-CHECK.
MOVE SPACES TO FILE-STAT.
READ FILE-TO-CHECK
AT END MOVE 'END' TO FILE-STAT.
PERFORM 0010-READ-RECORD UNTIL FILE-STAT IS EQUAL TO 'END'.
CLOSE FILE-TO-CHECK.
STOP RUN.
0010-READ-RECORD.
MOVE 'N' TO ANY-LOWER.
MOVE RECORD-TO-CHECK-REST TO WS-FIELD-TO-CHECK.
PERFORM 0015-PROCESS-CHAR VARYING IX FROM 1 BY 1 UNTIL
IX GREATER THAN 32 OR ANY-LOWER IS EQUAL TO 'Y'.
IF ANY-LOWER IS EQUAL TO 'Y' THEN
MOVE '***' TO RECORD-TO-CHECK-KEY
REWRITE RECORD-TO-CHECK.
READ FILE-TO-CHECK
AT END MOVE 'END' TO FILE-STAT.
0015-PROCESS-CHAR.
IF WS-CHECK-CHAR (IX) EQUAL TO 'a' OR 'b' OR 'c' OR 'd' OR
'e' OR 'f' OR 'g' OR 'h' OR 'i' OR 'j' OR 'k' OR
'l' OR 'm' OR 'n' OR 'o' OR 'p' OR 'q' OR 'r' OR
's' OR 't' OR 'u' OR 'v' OR 'w' OR 'x' OR 'y' OR
'z' THEN
MOVE 'Y' TO ANY-LOWER.
FOCUS program #2 :
-SET &HDRKEY = '$$$MSC104 UPPER STU NAME YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
FILEDEF FILETOCK DISK FILETOCK.DAT
TABLE FILE FILETOCK
ON TABLE HOLD AS AATEMP1
PRINT D2 BY D3
IF D1 EQ '***'
END
JOIN TEMP_KEY WITH D3 IN AATEMP1 TO KEY IN AAFILE AS J1
FILEDEF PLAY DISK PLAY.FTM APPEND
DEFINE FILE AATEMP1
TEMP_KEY/A11=('XX'|D3);
UPCASE_STU_NAME/A32=UPCASE(32, STU_NAME_AA, UPCASE_STU_NAME);
UPCASE_NICKNAME/A15=UPCASE(15, NICKNAME_AA, UPCASE_NICKNAME);
OUT_RECORD/A74=('02B'|D3|' '|UPCASE_STU_NAME|' '|SALU_AA|
UPCASE_NICKNAME);
END
TABLE FILE AATEMP1
PRINT OUT_RECORD AS '' BY D3 NOPRINT
ON TABLE SAVE AS PLAY
END
JOIN CLEAR *
Master File Description {MFD} :
FILE=FILETOCK,SUFFIX=FIX SEGNAME=ROOT FIELD=D1, ,A3,A3,$ FIELD=D2, ,A32,A32,$ FIELD=D3, ,A9,A9,$
CONVERTS STREET 1, CITY, STATE, ZIP CODE INFO TO UPPER CASE.
DCL command procedure :
$ DEFINE FOC$DIR1 SI$DATA $ SET DEFAULT SI$FOCUS $ FOCUS EXEC (FOCEXEC name #1) FIN $ RENAME FILETOCK.FTM *.DAT $ ASSIGN/NOLOG FILETOCK.DAT FILETOCK $ RUN (COBOL program) $ FOCUS EXEC (FOCEXEC name #2) FIN $ EXIT
FOCUS program #1 :
DEFINE FILE AAFILE
ALPHA_ADDR_NUM/A2=EDIT(ADDR_NUM_AA);
OUT_FIELD/A78=('$$$'|SID_AA|ALPHA_ADDR_NUM|ADDR_TYP1_AA|
ADDR_TYP2_AA|ADDR_TYP3_AA|ADDR_TYP4_AA|ADDR_TYP5_AA|
STREET1_AA|CITY_AA|ZIP_AA|STATE_AA|'$$$');
END
TABLE FILE AAFILE
PRINT OUT_FIELD BY SID_AA NOPRINT
ON TABLE SAVE AS FILETOCK
END
COBOL program :
IDENTIFICATION DIVISION.
PROGRAM-ID. (COBOL program).
AUTHOR. ME.
DATE-COMPILED.
***************************************************************************
* *
* THIS PROGRAM READS A FILE, CHECKS TO SEE IF ANY FIELD HAS LOWER CASE *
* LETTERS, AND THEN MARKS THOSE THAT DO. *
* *
***************************************************************************
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILE-TO-CHECK
ASSIGN TO FILETOCK.
DATA DIVISION.
FILE SECTION.
FD FILE-TO-CHECK.
*
01 RECORD-TO-CHECK.
03 RECORD-TO-CHECK-CONTENTS.
05 RECORD-TO-CHECK-KEY PIC X(03).
05 RECORD-TO-CHECK-REST PIC X(72).
05 FILLER PIC X(03).
*
WORKING-STORAGE SECTION.
*
01 WS-FIELD-TO-CHECK PIC X(72).
01 WS-FIELD-TO-CHECK-ARRAY REDEFINES WS-FIELD-TO-CHECK.
03 WS-FIELD-TO-CHECK-CHAR OCCURS 72 TIMES INDEXED BY IX.
05 WS-CHECK-CHAR PIC X(01).
01 FILE-STAT PIC X(03).
01 ANY-LOWER PIC X(01).
*
PROCEDURE DIVISION.
0000-MAINLINE.
OPEN
I-O FILE-TO-CHECK.
MOVE SPACES TO FILE-STAT.
READ FILE-TO-CHECK
AT END MOVE 'END' TO FILE-STAT.
PERFORM 0010-READ-RECORD UNTIL FILE-STAT IS EQUAL TO 'END'.
CLOSE FILE-TO-CHECK.
STOP RUN.
0010-READ-RECORD.
MOVE 'N' TO ANY-LOWER.
MOVE RECORD-TO-CHECK-REST TO WS-FIELD-TO-CHECK.
PERFORM 0015-PROCESS-CHAR VARYING IX FROM 1 BY 1 UNTIL
IX GREATER THAN 72 OR ANY-LOWER IS EQUAL TO 'Y'.
IF ANY-LOWER IS EQUAL TO 'Y' THEN
MOVE '***' TO RECORD-TO-CHECK-KEY
REWRITE RECORD-TO-CHECK.
READ FILE-TO-CHECK
AT END MOVE 'END' TO FILE-STAT.
0015-PROCESS-CHAR.
IF WS-CHECK-CHAR (IX) EQUAL TO 'a' OR 'b' OR 'c' OR 'd' OR
'e' OR 'f' OR 'g' OR 'h' OR 'i' OR 'j' OR 'k' OR
'l' OR 'm' OR 'n' OR 'o' OR 'p' OR 'q' OR 'r' OR
's' OR 't' OR 'u' OR 'v' OR 'w' OR 'x' OR 'y' OR
'z' THEN
MOVE 'Y' TO ANY-LOWER.
FOCUS program #2 :
-SET &HDRKEY = '$$$MSC105 UPPER ADDR 1 YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
FILEDEF FILETOCK DISK FILETOCK.DAT
TABLE FILE FILETOCK
ON TABLE HOLD AS AATEMP1
PRINT D3 BY D2
IF D1 EQ '***'
END
JOIN TEMP_KEY WITH D2 IN AATEMP1 TO KEY IN AAFILE AS J1
FILEDEF PLAY DISK PLAY.FTM APPEND
DEFINE FILE AATEMP1
TEMP_KEY/A11=('XX'|D2);
UPCASE_STREET1/A32=UPCASE(32, STREET1_AA, UPCASE_STREET1);
UPCASE_CITY/A13=UPCASE(13, CITY_AA, UPCASE_CITY);
UPCASE_STATE/A2=UPCASE(2, STATE_AA, UPCASE_STATE);
UPCASE_ZIP/A9=UPCASE(9, ZIP_AA, UPCASE_ZIP);
ALPHA_ADDR_NUM/A2=EDIT(ADDR_NUM_AA);
OUT_RECORD/A81=('06B'|D2|' '|ALPHA_ADDR_NUM|ADDR_TYP1_AA|
ADDR_TYP2_AA|ADDR_TYP3_AA|ADDR_TYP4_AA|ADDR_TYP5_AA|
UPCASE_STREET1|UPCASE_CITY|UPCASE_STATE|UPCASE_ZIP);
END
TABLE FILE AATEMP1
PRINT OUT_RECORD AS '' BY D2 NOPRINT
ON TABLE SAVE AS PLAY
END
JOIN CLEAR *
Master File Description {MFD} :
FILE=FILETOCK,SUFFIX=FIX SEGNAME=ROOT FIELD=D1, ,A3,A3,$ FIELD=D2, ,A9,A9,$ FIELD=D3, ,A63,A63,$
CONVERTS STREET 2 & COUNTRY INFO TO UPPER CASE.
DCL command procedure :
$ DEFINE FOC$DIR1 SI$DATA $ SET DEFAULT SI$FOCUS $ FOCUS EXEC (FOCEXEC name #1) FIN $ RENAME FILETOCK.FTM *.DAT $ ASSIGN/NOLOG FILETOCK.DAT FILETOCK $ RUN (COBOL program) $ FOCUS EXEC (FOCEXEC name #1) FIN $ EXIT
FOCUS program #1 :
DEFINE FILE AAFILE
ALPHA_ADDR_NUM/A2=EDIT(ADDR_NUM_AA);
OUT_FIELD/A78=('$$$'|SID_AA|ALPHA_ADDR_NUM|ADDR_TYP1_AA|
ADDR_TYP2_AA|ADDR_TYP3_AA|ADDR_TYP4_AA|ADDR_TYP5_AA|
STREET2_AA|CNTRY_AA|'$$$');
END
TABLE FILE AAFILE
PRINT OUT_FIELD BY SID_AA NOPRINT
ON TABLE SAVE AS FILETOCK
IF STREET2_AA NE ' '
END
COBOL program :
IDENTIFICATION DIVISION.
PROGRAM-ID. (COBOL program).
AUTHOR. ME.
DATE-COMPILED.
***************************************************************************
* *
* THIS PROGRAM READS A FILE, CHECKS TO SEE IF ANY FIELD HAS LOWER CASE *
* LETTERS, AND THEN MARKS THOSE THAT DO. *
* *
***************************************************************************
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILE-TO-CHECK
ASSIGN TO FILETOCK.
DATA DIVISION.
FILE SECTION.
FD FILE-TO-CHECK.
*
01 RECORD-TO-CHECK.
03 RECORD-TO-CHECK-CONTENTS.
05 RECORD-TO-CHECK-KEY PIC X(03).
05 RECORD-TO-CHECK-REST PIC X(50).
05 FILLER PIC X(03).
*
WORKING-STORAGE SECTION.
*
01 WS-FIELD-TO-CHECK PIC X(34).
01 WS-FIELD-TO-CHECK-ARRAY REDEFINES WS-FIELD-TO-CHECK.
03 WS-FIELD-TO-CHECK-CHAR OCCURS 34 TIMES INDEXED BY IX.
05 WS-CHECK-CHAR PIC X(01).
01 FILE-STAT PIC X(03).
01 ANY-LOWER PIC X(01).
*
PROCEDURE DIVISION.
0000-MAINLINE.
OPEN
I-O FILE-TO-CHECK.
MOVE SPACES TO FILE-STAT.
READ FILE-TO-CHECK
AT END MOVE 'END' TO FILE-STAT.
PERFORM 0010-READ-RECORD UNTIL FILE-STAT IS EQUAL TO 'END'.
CLOSE FILE-TO-CHECK.
STOP RUN.
0010-READ-RECORD.
MOVE 'N' TO ANY-LOWER.
MOVE RECORD-TO-CHECK-REST TO WS-FIELD-TO-CHECK.
PERFORM 0015-PROCESS-CHAR VARYING IX FROM 1 BY 1 UNTIL
IX GREATER THAN 34 OR ANY-LOWER IS EQUAL TO 'Y'.
IF ANY-LOWER IS EQUAL TO 'Y' THEN
MOVE '***' TO RECORD-TO-CHECK-KEY
REWRITE RECORD-TO-CHECK.
READ FILE-TO-CHECK
AT END MOVE 'END' TO FILE-STAT.
0015-PROCESS-CHAR.
IF WS-CHECK-CHAR (IX) EQUAL TO 'a' OR 'b' OR 'c' OR 'd' OR
'e' OR 'f' OR 'g' OR 'h' OR 'i' OR 'j' OR 'k' OR
'l' OR 'm' OR 'n' OR 'o' OR 'p' OR 'q' OR 'r' OR
's' OR 't' OR 'u' OR 'v' OR 'w' OR 'x' OR 'y' OR
'z' THEN
MOVE 'Y' TO ANY-LOWER.
FOCUS program #2 :
-SET &HDRKEY = '$$$MSC105 UPPER ADDR 1 YRE';
-INCLUDE (SIS Batch Header).SEG
JOIN CLEAR *
FILEDEF FILETOCK DISK FILETOCK.DAT
TABLE FILE FILETOCK
ON TABLE HOLD AS AATEMP1
PRINT D3 BY D2
IF D1 EQ '***'
END
JOIN TEMP_KEY WITH D2 IN AATEMP1 TO KEY IN AAFILE AS J1
FILEDEF PLAY DISK PLAY.FTM APPEND
DEFINE FILE AATEMP1
TEMP_KEY/A11=('XX'|D2);
UPCASE_STREET2/A32=UPCASE(32, STREET2_AA, UPCASE_STREET2);
UPCASE_COUNTRY/A2=UPCASE(2, CNTRY_AA, UPCASE_COUNTRY);
ALPHA_ADDR_NUM/A2=EDIT(ADDR_NUM_AA);
OUT_RECORD/A69=('06C'|D2|' '|ALPHA_ADDR_NUM|ADDR_TYP1_AA|
ADDR_TYP2_AA|ADDR_TYP3_AA|ADDR_TYP4_AA|ADDR_TYP5_AA|
' '|UPCASE_STREET2|UPCASE_COUNTRY);
END
TABLE FILE AATEMP1
PRINT OUT_RECORD AS '' BY D2 NOPRINT
ON TABLE SAVE AS PLAY
END
JOIN CLEAR *
Master File Description {MFD} :
FILE=FILETOCK,SUFFIX=FIX SEGNAME=ROOT FIELD=D1, ,A3,A3,$ FIELD=D2, ,A9,A9,$ FIELD=D3, ,A44,A44,$
This page hosted by 
Get your own Free Homepage