Typical DCL Command Procedure to set up the program :
$!
$! BO-PURGE-BILLS.COM
$!
$! Description: Will purge the bill file of those that do not need
$! to be sent out.
$!
$ SAY := WRITE SYS$OUTPUT
$ ASSIGN Z$PRT:BBB312RPT.PRT BILLIN
$ ASSIGN Z$PRT:BBB312RPT.SAV BILLOUT
$!
$ CL
$ SAY "Please wait while SIS bill purge program runs..."
$ SAY " "
$ RUN EXE:BO-PURGE-BILLS
$!
$! Rename resulting file back to original name and copy into
$! user's account
$!
$ SAY " "
$ SAY "Finished..."
$ SAY " "
$ WAIT 00:00:05
$ REN Z$PRT:BBB312RPT.SAV Z$PRT:BBB312RPT.PRT;
$ USER = F$EDIT(F$GETJPI("","USERNAME"),"UPCASE,COLLAPSE")
$ OLDFILE = "Z$PRT:BBB312RPT.PRT;"
$ NEWFILE = "SYS$LOGIN:*.*;"
$ COPY 'OLDFILE' 'NEWFILE'
$!
$ EXIT
COBOL program :
IDENTIFICATION DIVISION.
PROGRAM-ID. BO-PURGE-BILLS.
AUTHOR. ME.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. ALPHA-4000.
OBJECT-COMPUTER. ALPHA-4000.
INPUT-OUTPUT SECTION.
********************************************************************
* *
* This program will purge the bill file of those that do not need *
* to be sent out. *
* *
********************************************************************
FILE-CONTROL.
SELECT BILL-FILE-IN ASSIGN TO BILLIN.
SELECT BILL-FILE-OUT ASSIGN TO BILLOUT.
DATA DIVISION.
FILE SECTION.
FD BILL-FILE-IN
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 110 CHARACTERS.
01 BILL-RECORD-IN PIC X(110).
FD BILL-FILE-OUT
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 110 CHARACTERS.
01 BILL-RECORD-OUT PIC X(110).
WORKING-STORAGE SECTION.
01 WS-FD-BILL-RECORD.
05 WS-FD-BILL-DATA OCCURS 41 TIMES INDEXED BY BILL-INDEX.
07 FILLER PIC X(18).
07 WS-FD-BILL-SUBCD PIC X(05).
07 WS-FD-BILL-TEXT PIC X(20).
07 FILLER PIC X(26).
07 WS-FD-DUE PIC X(1) OCCURS 12 TIMES
INDEXED BY DUE-INDEX.
07 FILLER PIC X(29).
01 WS-FND-SUBCD PIC X.
01 WS-FND-TEXT PIC X.
01 WS-FND-NEG PIC X.
01 WS-FND-AMT PIC X.
01 WS-END-FILE PIC X.
01 WS-REC-CNT PIC 9(4).
PROCEDURE DIVISION.
000-START-PROCESSING.
OPEN INPUT BILL-FILE-IN
OUTPUT BILL-FILE-OUT.
MOVE ZEROS TO WS-REC-CNT.
MOVE "N" TO WS-END-FILE.
PERFORM 100-PROCESS-FILE UNTIL WS-END-FILE IS EQUAL TO "Y".
CLOSE BILL-FILE-IN
BILL-FILE-OUT.
**
** Display number of resulting bills.
**
DISPLAY "*******************************".
DISPLAY "The total number of bills is".
DISPLAY WS-REC-CNT.
DISPLAY "*******************************".
STOP RUN.
**
** Process each bill to determine if it should be kept or not.
**
100-PROCESS-FILE.
SET BILL-INDEX TO 1.
PERFORM 200-LOAD-BILL 41 TIMES.
IF WS-END-FILE IS EQUAL TO "N"
MOVE "N" TO WS-FND-SUBCD
SET BILL-INDEX TO 1
PERFORM 300-FIND-SUBCD 41 TIMES
IF WS-FND-SUBCD IS EQUAL TO "Y"
NEXT SENTENCE
ELSE
MOVE "N" TO WS-FND-TEXT
SET BILL-INDEX TO 1
PERFORM 400-FIND-TEXT 41 TIMES
IF WS-FND-TEXT IS EQUAL TO "Y"
SET BILL-INDEX TO 1
PERFORM 500-WRITE-BILL 41 TIMES
ADD 1 TO WS-REC-CNT
ELSE
MOVE "N" TO WS-FND-AMT
SET BILL-INDEX TO 1
PERFORM 600-FIND-AMT 41 TIMES
IF (WS-FND-AMT IS EQUAL TO "Y") AND
(WS-FND-NEG IS EQUAL TO "N")
SET BILL-INDEX TO 1
PERFORM 500-WRITE-BILL 41 TIMES
ADD 1 TO WS-REC-CNT.
**
** Read in each individual bill from file.
**
200-LOAD-BILL.
IF WS-END-FILE IS EQUAL TO "N"
SET BILL-INDEX UP BY 1
READ BILL-FILE-IN INTO WS-FD-BILL-DATA(BILL-INDEX - 1)
AT END
MOVE "Y" TO WS-END-FILE.
**
** Determine if this bill is getting financial aid and the student has
** been by the business office; these bills are purged.
**
300-FIND-SUBCD.
IF WS-FD-BILL-SUBCD(BILL-INDEX) IS EQUAL TO "99999"
MOVE "Y" TO WS-FND-SUBCD.
SET BILL-INDEX UP BY 1.
**
** Determine if this bill is getting financial aid and the student has
** not been by the business office; these bills are kept.
**
400-FIND-TEXT.
IF WS-FD-BILL-TEXT(BILL-INDEX) IS EQUAL TO " EST. FINANCIAL AID "
MOVE "Y" TO WS-FND-TEXT.
SET BILL-INDEX UP BY 1.
**
** If it is determined that this bill is to be kept, write out to
** temporary bill file.
**
500-WRITE-BILL.
WRITE BILL-RECORD-OUT FROM WS-FD-BILL-DATA(BILL-INDEX).
SET BILL-INDEX UP BY 1.
**
** Check to see if amount due is positive or negative; if positive
** amount, keep bill.
**
600-FIND-AMT.
IF WS-FD-BILL-TEXT(BILL-INDEX) IS EQUAL TO " CURRENT DUE: "
MOVE "N" TO WS-FND-NEG
SET DUE-INDEX TO 1
PERFORM 700-CHK-AMT 12 TIMES
IF WS-FND-NEG IS EQUAL TO "N"
IF (WS-FD-DUE(BILL-INDEX,8) IS EQUAL TO " ") AND
(WS-FD-DUE(BILL-INDEX,9) IS EQUAL TO "0") AND
(WS-FD-DUE(BILL-INDEX,10) IS EQUAL TO ".") AND
(WS-FD-DUE(BILL-INDEX,11) IS EQUAL TO "0") AND
(WS-FD-DUE(BILL-INDEX,12) IS EQUAL TO "0")
NEXT SENTENCE
ELSE
MOVE "Y" TO WS-FND-AMT.
SET BILL-INDEX UP BY 1.
700-CHK-AMT.
IF WS-FD-DUE(BILL-INDEX,DUE-INDEX) IS EQUAL TO "-"
MOVE "Y" TO WS-FND-NEG.
SET DUE-INDEX UP BY 1.
This page hosted by 
Get your own Free Homepage