以下是 taderc25.cbl 中的代码:
identification division. program-id. TADERC25. environment division. data division. working-storage section. 01 tmp pic a(40). 01 ICOMMAREA. 02 ICustNo PIC X(5). 02 Ifiller PIC X(11). 01 GENCUST. 02 GCUSTCODE PIC X(4). 02 GFILLER PIC X(40). 01 PREFCUST. 02 PCUSTCODE PIC X(4). 02 PCUSTNO PIC X(5). 02 ASSETS PIC S9(6)V99. 01 REGCUST. 02 RCUSTCODE PIC X(4). 02 RCUSTNO PIC X(5). 02 ACCOUNTNAME PIC A(10). 02 BALANCE PIC S9(6)V99. 01 BADCUST. 02 BCUSTCODE PIC X(4). 02 BCUSTNO PIC X(5). 02 DAYSOVERDUE PIC X(4). 02 AMOUNT PIC S9(6)V99. LINKAGE SECTION. 01 DFHCOMMAREA. 02 inputfield pic x(50). procedure division. start-para. move DFHCOMMAREA to ICOMMAREA. IF ICustNo EQUAL '12345' move 'PREC' to PCUSTCODE move ICustNo to PCUSTNO move 43456.33 to ASSETS move PREFCUST TO DFHCOMMAREA ELSE IF ICustNo EQUAL '34567' move 'REGC' to RCUSTCODE move ICustNo to RCUSTNO move 'SAVINGS' TO ACCOUNTNAME move 11456.33 to BALANCE move REGCUST TO DFHCOMMAREA ELSE move 'BADC' to BCUSTCODE move ICustNo to BCUSTNO move '132' to DAYSOVERDUE move -8965.33 to AMOUNT move BADCUST TO DFHCOMMAREA * END-IF. END-IF. EXEC CICS RETURN END-EXEC.