LU 6.2 API Application Programmer's Reference Guide (30294-90008)

Appendix B 163
Sample Programs
COBOL II Program
006200 05 DEALLOCATE-RTRNCD PIC X(5).
006300 05 ENDED-RTRNCD PIC X(5).
006400 05 SENDDATA-RTRNCD PIC X(5).
006500 05 TPSTART-RTRNCD PIC X(5).
006600 05 RCVANDWAIT-RTRNCD PIC X(5).
006700*
006800 01 DISPLAY-WHAT-RECEIVED PIC X(5).
006900*
007000 01 API-PARAMETERS.
007100 05 TPSTARTED-PARAMETERS.
007200 10 LOCAL-TP-NAME PIC X(8) VALUE "USERTP ".
007300 05 ALLOCATE-PARAMETERS.
007400 10 SESSION-TYPE PIC X(8) VALUE "DISOSS1 ".
007500 05 REMOTE-TP-NAME.
007600 10 REMOTE-TP-NAME-EBCDIC PIC X(4) VALUE SPACES.
007700 10 REMOTE-TP-NAME-ASCII PIC X(4) VALUE "Z027".
007800*
007900 01 DEBUGGING-ERROR-MESSAGES.
008000 05 STARTED-ERR-MSG PIC X(20) VALUE 'TP STARTED ERROR'.
008100 05 ALLOCATE-ERR-MSG PIC X(20) VALUE 'ALLOCATE ERROR'.
008200 05 SENDDATA-ERR-MSG PIC X(20) VALUE 'SEND DATA ERROR'.
008300 05 DEALLOCATE-ERR-MSG PIC X(20) VALUE 'DEALLOCATE ERROR'.
008400 05 ENDED-ERR-MSG PIC X(20) VALUE 'ENDED ERROR'.
008500 05 CTRANSLATE-ERR-MSG PIC X(20) VALUE 'CTRANSLATE ERROR'.
008600 05 RCVANDWAIT-ERR-MSG PIC X(20) VALUE 'RCVANDWAIT ERROR'.
008700 05 WHAT-RECEIVED-MSG PIC X(20) VALUE 'WHAT RECEIVED ERROR'.
008800*
008900 01 CONTROL-FLAGS.
009000 05 QUIT-SW PIC X.
009100*
009200 01 TRANSACTION-ERROR-CODES.
009300 05 SYSTEM-ERROR-CD PIC 9(4) VALUE 0003.
009400 05 SOCSEC-ERROR-CD PIC 9(4) VALUE 0001.
009500*
009600 01 CONTROL-VALUES.
009700 05 YES-SW PIC X VALUE 'Y'.
009800 05 NO-SW PIC X VALUE 'N'.
009900*
010000 01 CONSOLE-HEADING PIC X(17) VALUE
010100 "CREDIT RISK CHECK".
010200*
010300 01 ACCEPT-CODE PIC X VALUE "3".
010400*
010500 01 MASTER-DATA.
010600 05 SOCSEC-MASTER.
010700 10 SOCSEC1-MASTER PIC X(3).
010800 10 SOCSEC2-MASTER PIC X(2).
010900 10 SOCSEC3-MASTER PIC X(4).
011000 05 NAME-MASTER.
011100 10 LAST-NAME-MASTER PIC X(10).
011200 10 FIRST-NAME-MASTER PIC X(10).
011300 10 MI-NAME-MASTER PIC X.