Typical DCL Command Procedure to run the program :
$ ASSIGN IRMTMP2.FTM FBM091IN
$ ASSIGN AUDITOR_OUT.RPT FBM091OUT
$!
$ RUN FMT_FBM091
$!
$ EXIT
FOCUS program :
JOIN CLEAR *
FILEDEF FBM091 DISK (file name for FBM091.PRT)
FILEDEF IRMTMP2 DISK IRMTMP2.FTM APPEND LREC 113 RECFM F
DEFINE FILE FBM091
THS_FLD/A1=IF EDIT(FBM091_CHK,'99999') EQ 'ACCT:' OR
EDIT(FBM091_CHK,'$$$$$$99999999') EQ '** TOTAL'
THEN 'Y' ELSE 'N';
END
TABLE FILE FBM091
PRINT FBM091_CHK FBM091_DET
ON TABLE HOLD AS IRMTMP1
WHERE THS_FLD EQ 'Y'
END
-*
DEFINE FILE IRMTMP1
DUP_FLD/A1=IF (EDIT(FBM091_CHK,'99999') EQ 'ACCT:' AND
(FBM091_CHK NE LAST FBM091_CHK)) OR
(EDIT(FBM091_CHK,'$$$$$$99999999') EQ '** TOTAL')
THEN 'Y' ELSE 'N';
END
TABLE FILE IRMTMP1
PRINT FBM091_CHK FBM091_DET
ON TABLE SAVE AS IRMTMP2
WHERE DUP_FLD EQ 'Y'
END
JOIN CLEAR *
Master File Description (MFD) for FBM091 :
FILE=FBM091,SUFFIX=FIX
SEGNAME=ROOT
FIELD=FBM091_CHK, ,A14,A14,$
FIELD=FBM091_DET, ,A99,A99,$
FIELD=GEN_FIL001, ,A19,A19,$
COBOL program :
IDENTIFICATION DIVISION.
PROGRAM-ID. FMT_FBM091.
AUTHOR. ME.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. ALPHA-4000.
OBJECT-COMPUTER. ALPHA-4000.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FBM091-FILE-IN ASSIGN TO FBM091IN.
SELECT FBM091-FILE-OUT ASSIGN TO FBM091OUT.
DATA DIVISION.
FILE SECTION.
FD FBM091-FILE-IN
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 113 CHARACTERS.
01 FBM091-RECORD-IN PIC X(113).
FD FBM091-FILE-OUT
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 82 CHARACTERS.
01 FBM091-RECORD-OUT PIC X(82).
WORKING-STORAGE SECTION.
01 WS-FBM091-IN.
05 WS-FBM091-OBJ-CODE PIC X(04).
05 FILLER PIC X(02).
05 WS-FBM091-TOTAL-VERB PIC X(08).
05 WS-FBM091-TOTAL-DESC PIC X(20).
05 FILLER PIC X(53).
05 WS-FBM091-TOTAL-AMT.
10 WS-FBM091-TOTAL-AMT-A PIC X(03).
10 FILLER PIC X(01).
10 WS-FBM091-TOTAL-AMT-B PIC X(03).
10 FILLER PIC X(01).
10 WS-FBM091-TOTAL-AMT-C PIC X(06).
05 WS-FBM091-NEG-IND PIC X(01).
05 FILLER PIC X(11).
01 REDEFINES WS-FBM091-IN.
05 WS-FBM091-ACCT-VERB PIC X(05).
05 FILLER PIC X(01).
05 WS-FBM091-ACCT-NUM1 PIC X(01).
05 FILLER PIC X(01).
05 WS-FBM091-ACCT-NUM2 PIC X(05).
05 WS-FBM091-ACCT-DESC PIC X(95).
05 FILLER PIC X(05).
01 WS-FBM091-OUT.
05 WS-FBM091-OUT-ACCT-NUM PIC X(10).
05 FILLER PIC X(02).
05 WS-FBM091-OUT-ACCT-DESC PIC X(51).
05 FILLER PIC X(02).
05 WS-FBM091-OUT-ACCT-AMT PIC X(17).
01 WS-EOF PIC X.
01 WS-HLD-FLD PIC X(95).
01 WS-FBM091-HOLD-ACCT-NUM PIC X(06).
01 WS-FBM091-ACCT-DESC-1.
05 WS-FBM091-ACCT-DESC-1A PIC X(01).
05 WS-FBM091-ACCT-DESC-1B PIC X(94).
01 WS-FBM091-HOLD-ACCT-DESC PIC X(31).
PROCEDURE DIVISION.
000-START-PROCESSING.
OPEN INPUT FBM091-FILE-IN.
OPEN OUTPUT FBM091-FILE-OUT.
MOVE "N" TO WS-EOF.
PERFORM 100-CREATE-FILE UNTIL WS-EOF IS EQUAL TO "Y".
CLOSE FBM091-FILE-IN
FBM091-FILE-OUT.
STOP RUN.
100-CREATE-FILE.
MOVE SPACES TO WS-FBM091-IN.
READ FBM091-FILE-IN INTO WS-FBM091-IN
AT END
MOVE "Y" TO WS-EOF.
IF WS-FBM091-ACCT-VERB IS EQUAL TO "ACCT:"
MOVE SPACES TO WS-FBM091-ACCT-DESC-1
MOVE SPACES TO WS-FBM091-HOLD-ACCT-NUM
MOVE SPACES TO WS-FBM091-HOLD-ACCT-DESC
STRING WS-FBM091-ACCT-NUM1 DELIMITED BY SIZE
WS-FBM091-ACCT-NUM2 DELIMITED BY SIZE
INTO WS-FBM091-HOLD-ACCT-NUM
UNSTRING WS-FBM091-ACCT-DESC DELIMITED BY ALL " "
INTO WS-HLD-FLD
WS-FBM091-ACCT-DESC-1
IF WS-FBM091-ACCT-DESC-1A IS EQUAL TO " "
STRING WS-FBM091-ACCT-DESC-1B DELIMITED BY " "
" -" DELIMITED BY SIZE
INTO WS-FBM091-HOLD-ACCT-DESC
ELSE
STRING WS-FBM091-ACCT-DESC-1 DELIMITED BY " "
" -" DELIMITED BY SIZE
INTO WS-FBM091-HOLD-ACCT-DESC
ELSE
PERFORM 200-PROCESS-OBJ-CODE.
200-PROCESS-OBJ-CODE.
MOVE SPACES TO WS-FBM091-OUT.
STRING WS-FBM091-HOLD-ACCT-NUM DELIMITED BY SIZE
WS-FBM091-OBJ-CODE DELIMITED BY SIZE
INTO WS-FBM091-OUT-ACCT-NUM.
STRING WS-FBM091-HOLD-ACCT-DESC DELIMITED BY " "
WS-FBM091-TOTAL-DESC DELIMITED BY SIZE
INTO WS-FBM091-OUT-ACCT-DESC.
IF WS-FBM091-NEG-IND IS EQUAL TO "-"
STRING "-" DELIMITED BY SIZE
WS-FBM091-TOTAL-AMT-A DELIMITED BY SIZE
WS-FBM091-TOTAL-AMT-B DELIMITED BY SIZE
WS-FBM091-TOTAL-AMT-C DELIMITED BY SIZE
INTO WS-FBM091-OUT-ACCT-AMT
ELSE
STRING " " DELIMITED BY SIZE
WS-FBM091-TOTAL-AMT-A DELIMITED BY SIZE
WS-FBM091-TOTAL-AMT-B DELIMITED BY SIZE
WS-FBM091-TOTAL-AMT-C DELIMITED BY SIZE
INTO WS-FBM091-OUT-ACCT-AMT.
WRITE FBM091-RECORD-OUT FROM WS-FBM091-OUT.
This page hosted by 
Get your own Free Homepage