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

Appendix B 165
Sample Programs
COBOL II Program
015300*----------------------------------------------------*
015400 101000-BEGIN-HOUSEKEEPING SECTION.
015500*----------------------------------------------------*
015600* This section calls TPStarted to initialize resources
015700* for the local TP, and then it calls MCAllocate to
015800* allocate a conversation with the remote TP.
015900*
016000 MOVE NO-SW TO QUIT-SW.
016100*
016200 CALL INTRINSIC "TP'STARTED" USING LOCAL-TP-NAME,
016300 TPID,
016400 INTRINSIC-STATUS,
016500 TRACEON.
016600 IF INTRINSIC-STATUS IS NOT EQUAL TO ZERO
016700 MOVE YES-SW TO QUIT-SW
016800 MOVE INTRINSIC-STATUS-INFO TO TPSTART-RTRNCD
016900 DISPLAY STARTED-ERR-MSG,TPSTART-RTRNCD
017000 GO TO 101099-EXIT.
017100*
017200 CALL INTRINSIC "CTRANSLATE" USING TRANSLATE-TO-EBCDIC,
017300 REMOTE-TP-NAME-ASCII,
017400 REMOTE-TP-NAME-EBCDIC,
017500 LENGTH-REMOTE-TP-NAME.
017600 IF CCODE << ZERO
017700 DISPLAY CTRANSLATE-ERR-MSG,
017800 "CCL - REMOTE-TP-NAME NOT TRANSLATED"
017900 MOVE YES-SW TO QUIT-SW
018000 GO TO 101099-EXIT.
018100*
018200 CALL INTRINSIC "MCALLOCATE" USING TPID,
018300 SESSION-TYPE,
018400 REMOTE-TP-NAME-EBCDIC,
018500 LENGTH-REMOTE-TP-NAME,
018600 RESOURCE-ID,
018700 INTRINSIC-STATUS.
018800 IF INTRINSIC-STATUS IS NOT EQUAL TO ZERO
018900 MOVE YES-SW TO QUIT-SW
019000 MOVE INTRINSIC-STATUS-INFO TO ALLOCATE-RTRNCD
019100 DISPLAY ALLOCATE-ERR-MSG,ALLOCATE-RTRNCD
019200 GO TO 101099-EXIT.
019300*
019400 PERFORM 501000-FULL-SCREEN.
019500 101099-EXIT.
019600 EXIT.
019700*
019800*----------------------------------------------------*
019900 102000-PROCESS-RECORDS SECTION.
020000*----------------------------------------------------*
020100* This section calls SEND-DATA and RECEIVE-DATA.
020200*
020300 PERFORM 201000-SEND-DATA.
020400*