× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



You can look at this and see if it helps.

It tests the cobol call with positive and negative 1234.56 and quits.

Mark Villa in Charleston SC 

=============================================
===================CLP=======================
=============================================
0002.00              PGM
0003.00              DCL        VAR(&N0) TYPE(*DEC) LEN(6 2)
0004.00              DCL        VAR(&N1) TYPE(*DEC) LEN(6)
0005.00              DCL        VAR(&C1) TYPE(*CHAR) LEN(7)
0006.00              DCL        VAR(&C2) TYPE(*CHAR) LEN(6)
0007.00              DCL        VAR(&ZEROCHK) TYPE(*DEC) LEN(1)
0008.00              DCL        VAR(&NEGCHAR) TYPE(*CHAR) LEN(9) +
0009.00                           VALUE(JKLMNOPQR)
0010.00  LOOP:
0011.00              IF         COND(&N0 < 0) THEN(GOTO CMDLBL(ENDPGM))
0012.00              IF         COND(&N0 = 0) THEN(CHGVAR VAR(&N0) +
0013.00                           VALUE(1234.56))
0014.00              ELSE       CMD(CHGVAR VAR(&N0) VALUE(&N0 * -1))
0015.00              CHGVAR     VAR(&N1) VALUE(&N0 * 100)
0016.00              CHGVAR     VAR(&C1) VALUE(&N1)
0017.00              CHGVAR     VAR(&C2) VALUE(%SST(&C1 2 6))
0018.00              IF         COND(&N0 < 0) THEN(DO)
0019.00              CHGVAR     VAR(&ZEROCHK) VALUE(%SST(&C2 6 1))
0020.00              IF         COND(&ZEROCHK *NE 0) THEN(CHGVAR +
0021.00                           VAR(%SST(&C2 6 1)) VALUE(%SST(&NEGCHAR +
0022.00                           &ZEROCHK 1)))
0023.00              ENDDO
0024.00              SNDPGMMSG  MSG('c1= ' *CAT &C1)
0025.00              SNDPGMMSG  MSG('c2= ' *CAT &C2)
0026.00              CALL       PGM(MARK/T1) PARM(&C2)
0027.00              GOTO       CMDLBL(LOOP)
0028.00  ENDPGM:
0029.00              ENDPGM
=============================================
==================COBOL======================
=============================================
01  WSAREA.
    05  WS-T                           PIC 9999.99-.
LINKAGE SECTION.
01  LS-T                               PIC S9(4)V99.
PROCEDURE DIVISION USING LS-T.

MAIN.
    MOVE LS-T TO WS-T.
    DISPLAY 'THE TEST NUMBER IS: '  WS-T UPON CONSOLE.
    STOP RUN.
=============================================

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.