DSN8MC1
RETRIEVES LAST CONVERSATION.
***** DSN8MC1 - SQL 1 COMMON MODULE FOR IMS AND CICS - COBOL **** 00010000
* * 00020000
* MODULE NAME = DSN8MC1 * 00030000
* * 00040000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00050000
* SQL 1 COMMON MODULE * 00060000
* IMS & CICS * 00070000
* COBOL * 00080000
* * 00090000
* LICENSED MATERIALS - PROPERTY OF IBM * 00100000
* 5615-DB2 * 00106000
* (C) COPYRIGHT 1995, 2013 IBM CORP. ALL RIGHTS RESERVED. * 00113000
* * 00120000
* STATUS = VERSION 11 * 00127000
* * 00134000
* * 00142000
* FUNCTION = RETRIEVES LAST CONVERSATION. * 00150000
* HANDLES 'RESEND' AND 'END' CASES. * 00160000
* CALLS VALIDATION ROUTINES DSN8MC3 THRU DSN8MC5. * 00170000
* CALLS SQL2 ROOT (DSN8CC2 OR DSN8IC2). * 00180000
* * 00190000
* NOTES = NONE * 00200000
* * 00210000
* MODULE TYPE = * 00220000
* PROCESSOR = DB2 PRECOMPILER, VS COBOL * 00230000
* MODULE SIZE = SEE LINKEDIT * 00240000
* ATTRIBUTES = REUSABLE * 00250000
* * 00260000
* ENTRY POINT = DSN8MC1 * 00270000
* PURPOSE = SEE FUNCTION * 00280000
* LINKAGE = INCLUDED BY MODULE DSN8IC1 OR DSN8CC1 * 00290000
* * 00300000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00310000
* SYMBOLIC LABEL/NAME = NONE * 00320000
* DESCRIPTION = NONE * 00330000
* * 00340000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00350000
* SYMBOLIC LABEL/NAME = NONE * 00360000
* DESCRIPTION = NONE * 00370000
* * 00380000
* EXIT-NORMAL = DROP THRU TO NEXT LINE OF CODE IN DSN8CP1/IP1 * 00390000
* * 00400000
* EXIT-ERROR = IF SQLERROR OR SQLWARNING, SQL WHENEVER * 00410000
* CONDITION SPECIFIED IN DSN8CC1/IC1 WILL BE RAISED* 00420000
* AND PROGRAM WILL GO TO THE LABEL DB-ERROR. * 00430000
* * 00440000
* * 00450000
* RETURN CODE = NONE * 00460000
* * 00470000
* ABEND CODES = NONE * 00480000
* * 00490000
* ERROR MESSAGES = * 00500000
* DSN8051I - PROGRAM ENDED * 00510000
* * 00520000
* EXTERNAL REFERENCES = MOST VARIABLES ARE GLOBAL AND DEFINED * 00530000
* IN DSN8CC1/IC1. * 00540000
* ROUTINES/SERVICES = * 00550000
* INCLUDING DSN8MC3 THRU DSN8MC5. * 00560000
* DSN8MCG - ERROR MESSAGE ROUTINE * 00570000
* * 00580000
* DATA-AREAS = NONE * 00590000
* * 00600000
* CONTROL-BLOCKS = * 00610000
* SQLCA - SQL COMMUNICATION AREA * 00620000
* * 00630000
* TABLES = NONE * 00640000
* * 00650000
* CHANGE-ACTIVITY = NONE * 00660000
* * 00670000
* * 00680000
* *PSEUDOCODE* * 00690000
* * 00700000
* PROCEDURE * 00710000
* ELIMINATE LEADING BLANKS ON DATA LINE IF NOT ALL OF DATA * 00720000
* LINE IS BLANK. * 00730000
* * 00740000
* SET UP CONTROL FLAGS FOR 'RESEND' 'END' 'NEXT' * 00750000
* FIRST BY EXAMINING THE DATA LINE AND THEN COMPARING THE * 00760000
* PF KEYS (COMPARM.PFKIN) * 00770000
* * 00780000
* RETRIEVE LAST CONVERSATION (FROM VCONA.) * 00790000
* * 00800000
* IF LAST CONVERSATION IS NOT FOUND THEN DO. * 00810000
* COMPARM.NEWCONV = 'Y'. * 00820000
* PCONVSTA = '' . * 00830000
* END. * 00840000
* * 00850000
* ELSE DO. * 00860000
* PCONVSTA = LAST CONVERSATION RETRIEVED. * 00870000
* IF RESEND, BYPASS VALIDATION AND SAVE, JUST RESEND. * 00880000
* IF END, DELETE CONVERSATION, SEND MESSAGE & GOTO CC1EXIT* 00890000
* IF NO SYSTEMS FIELD WAS CHANGED, BYPASS VALIDATION. * 00900000
* END; * 00910000
* * 00920000
* WHILE RETURN CODE IS 0 DO * 00930000
* CALL VALIDATION MODULES DSN8MC3 THRU DSN8MC5 * 00940000
* OTHERWISE * 00950000
* GO TO MC1SAVE. * 00960000
* * 00970000
* GO TO CC1CALL IN DSN8CC1/IC1 TO CALL DSN8CC2/IC2. * 00980000
* * 00990000
* MC1SAVE: * 01000000
* INSERT/UPDATE CURRENT CONVERSATION INTO VCONA. * 01010000
* * 01020000
* END. * 01030000
* * 01040000
***************************************************************** 01050000
**************************************************************** 01060000
* * 01070000
* INITIAL EDITING FOR DATA INPUT * 01080000
* * 01090000
* 1. THE DATA LINE IS SHIFTED LEFT UNTIL ALL LEADING BLANKS * 01100000
* HAVE BEEN ELIMINATED. * 01110000
* 2. THE APPROPRIATE BITS FOR 'RESEND','END' ETC. ARE THEN * 01120000
* SET ACCORDING TO INPUT ON DATA LINE. * 01130000
* 3. IF PFKEYS 1,2, OR 8 HAS BEEN USED, THE APPROPRIATE BIT * 01140000
* IS SET FOR 'RESEND' 'END' ETC.. THIS TAKES PRECEDENCE * 01150000
* OVER THE SETTING OF THE SAME BITS IN STEP2.* * 01160000
* * 01170000
* * I.E. IF SOMEONE TYPES IN 'RESEND' ON THE DATA LINE AND * 01180000
* USES THE PF1 KEY AT THE SAME TIME, THE PF1 (END) * 01190000
* FUNCTION IS ASSUMED TO BE THE ACTUAL REQUEST. * 01200000
**************************************************************** 01210000
01220000
DSN8MC1. 01230000
01240000
**************************************************************** 01250000
* **INITIALIZE CONTROL FLAGS 01260000
**************************************************************** 01270000
MOVE '0' TO OFF-1. 01280000
MOVE '1' TO ON-1. 01290000
MOVE '0' TO SENDBIT. 01300000
MOVE '0' TO ENDBIT. 01310000
MOVE '0' TO NEXTBIT. 01320000
01330000
MOVE 'DSN8MC1' TO MAJOR IN DSN8-MODULE-NAME. 01340000
01350000
IF DATAIN IN INAREA = SPACE THEN GO TO MC1-18. 01360000
MOVE 0 TO I. 01370000
**************************************************************** 01380000
* **GET RID OF LEADING BLANKS IN DATA 01390000
**************************************************************** 01400000
MC1-10. 01410000
* **SKIP LEADING BLANKS 01420000
ADD 1 TO I. 01430000
* **IF ALL OF LINE 01440000
* **IS OF BLANKS 01450000
* **SEE IF A CONTROL 01460000
* **FLAG IS SET 01470000
IF I > 60 THEN GO TO MC1-18. 01480000
01490000
01500000
* **MC1-10 LOOP 01510000
MC1-LOOP10. 01520000
PERFORM MC1-10 01530000
UNTIL DATAIN1(I) NOT = SPACE. 01540000
01550000
01560000
* **IF FIRST CHARACTER IS 01570000
* **NON-BLANK, SEE IF A 01580000
* **CONTROL FLAG IS SET 01590000
IF I = 1 THEN 01600000
GO TO MC1-18. 01610000
MOVE 1 TO J. 01620000
01630000
MC1-12. 01640000
* **GET NON-BLANK 01650000
* **CHARACTERS 01660000
MOVE DATAIN1(I) TO DATAIN1(J). 01670000
ADD 1 TO I. 01680000
ADD 1 TO J. 01690000
01700000
* **MC1-12 LOOP 01710000
MC1-LOOP12. 01720000
PERFORM MC1-12 01730000
UNTIL I > 60. 01740000
01750000
MC1-14. 01760000
* **PUT BLANKS AT END 01770000
* **OF LINE 01780000
MOVE SPACE TO DATAIN1(J). 01790000
ADD 1 TO J. 01800000
01810000
* **MC1-14 LOOP 01820000
MC1-LOOP14. 01830000
PERFORM MC1-14 01840000
UNTIL J > 60. 01850000
01860000
**************************************************************** 01870000
* **SET UP CONTROL FLAGS FOR 'RESEND' 'END' 'NEXT' 01880000
**************************************************************** 01890000
MC1-18. 01900000
IF DATAIN = 'RESEND' OR 01910000
* **RESEND COMMAND OR 01920000
* **PF KEY 02 01930000
PFKIN IN INAREA = '02' THEN 01940000
MOVE ON-1 TO SENDBIT 01950000
ELSE 01960000
IF DATAIN = 'END' OR 01970000
* **END COMMAND OR 01980000
* **PF KEY 03 01990000
PFKIN IN INAREA = '03' THEN 02000000
MOVE ON-1 TO ENDBIT 02010000
ELSE 02020000
IF DATAIN = 'NEXT' OR 02030000
* **NEXT COMMAND OR 02040000
* **PF KEY 08 02050000
PFKIN IN INAREA = '08' THEN 02060000
MOVE ON-1 TO NEXTBIT. 02070000
MC1-20. 02080000
***************************************************************** 02090000
* * 02100000
* RESTORE LAST MESSAGE AND DETERMINE IF VALIDATION IS NECESSARY * 02110000
* * 02120000
* 1. ATTEMPT TO RETRIEVE LAST MESSAGE STORED IN VCONA. IF * 02130000
* NOT SUCCESSFUL, THEN CONVERSATION IS NEW. * 02140000
* 2. IF RETRIEVAL IS SUCCESSFUL, THEN TRANSFER THE DATA * 02150000
* INTO PCONVSTA. * 02160000
* 3. IF RESEND REQUEST,DON'T VALIDATE & DON'T SAVE,JUST RESEND * 02170000
* 4. IF END REQUEST,DELETE CONVERSATION,SEND END MESSAGE, EXIT * 02180000
* 5. IF ALL SYSTEM FIELDS HAVE NOT CHANGED SINCE THEY WERE * 02190000
* LAST SAVED, BYPASS VALIDATION ALSO. * 02200000
* 6. OTHERWISE VALIDATE EACH OF THE SYSTEM FIELDS. * 02210000
***************************************************************** 02220000
02230000
MOVE 'N' TO NEWREQ IN COMPARM. 02240000
MOVE CONVID IN PCONVSTA TO SAVE-CONVID. 02250000
MOVE 'N' TO NEWCONV IN COMPARM. 02260000
* 02270000
EXEC SQL SELECT * 02280000
INTO :PCONA 02290000
FROM VCONA 02300000
WHERE CONVID = :SAVE-CONVID END-EXEC. 02310000
02320000
* **RETRIEVAL NOT SUCCESSFUL- 02330000
* **INITIALIZE TO NEW CONVERSATION 02340000
02350000
IF SQLCODE = +100 THEN 02360000
MOVE 'Y' TO NEWCONV IN COMPARM 02370000
MOVE SPACE TO PCONVSTA 02380000
MOVE SAVE-CONVID TO CONVID IN PCONVSTA 02390000
MOVE SAVE-CONVID TO CONVID IN PCONA 02400000
MOVE 'DSN8001 ' TO LASTSCR IN PCONVSTA 02410000
GO TO MC1-VAL. 02420000
02430000
* **RETRIEVAL SUCCESSFUL- 02440000
* **TRANSFER DATA TO PCONVSTA 02450000
02460000
MOVE LASTSCR IN PCONA TO LASTSCR IN PCONVSTA 02470000
MOVE LASTPOS IN PCONA TO LASTPOS0 IN PCONVSTA 02480000
MOVE LASTPOSC IN PCONA TO LASTPOSC IN PCONVSTA 02490000
MOVE LASTMSG-TEXT IN PCONA TO OUTAREA0. 02500000
02510000
* **IF CONVERSATION EXISTS BUT DATA 02520000
* **ENTERED FROM CLEARED SCREEN, 02530000
* **THEN TREAT LIKE RESEND 02540000
02550000
IF PFKIN IN INAREA = '00' OR 02560000
SENDBIT = ON-1 THEN GO TO CC1-EXIT. 02570000
02580000
* **IF END REQUEST THEN DELETE CON- 02590000
* **VERSATION AND SEND END MESSAGE 02600000
02610000
IF ENDBIT NOT = ON-1 THEN GO TO MC1-30. 02620000
MOVE 'DELETE ' TO MINOR IN DSN8-MODULE-NAME 02630000
MOVE '1' TO EXITCODE 02640000
MOVE SPACE TO OUTAREA 02650000
EXEC SQL DELETE 02660000
FROM VCONA 02670000
WHERE CONVID = :PCONA.CONVID END-EXEC 02680000
02690000
* **PRINT MESSAGE: 02700000
* **PROGRAM ENDED 02710000
MOVE '051I' TO MSGCODE 02720000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG 02730000
MOVE OUTMSG TO MSG IN OUTAREA. 02740000
MOVE MAJSYS IN INAREA TO MAJSYS IN OUTAREA. 02750000
GO TO CC1-EXIT. 02760000
MC1-30. 02770000
* 02780000
***************************************************************** 02790000
* **IF OLD CONVERSATION AND SYSTEM 02800000
* **FIELDS HAVE NOT CHANGED THEN 02810000
* **BYPASS VALIDATION 02820000
***************************************************************** 02830000
* ** NEW CONVERSATION 02840000
IF ACTION IN INAREA NOT = ACTION IN OUTAREA OR 02850000
OBJFLD IN INAREA NOT = OBJFLD IN OUTAREA OR 02860001
SRCH IN INAREA NOT = SRCH IN OUTAREA THEN 02870000
GO TO MC1-VAL. 02880000
02890000
* ** OLD CONVERSATION 02900000
IF PREV IN PCONVSTA = 'D' AND 02910000
(PFKIN IN INAREA NOT = '10' OR 02913000
OBJFLD IN INAREA NOT = 'DS') AND 02916001
((DATAIN IN INAREA NOT = DATAOUT IN OUTAREA) OR 02920000
(ACTION IN INAREA = 'D')) THEN 02925000
MOVE 'Y' TO NEWREQ IN COMPARM. 02930000
GO TO MC1-BOTH. 02940000
***************************************************************** 02950000
* **VALIDATES FIELDS 02960000
***************************************************************** 02970000
MC1-VAL. 02980000
MOVE 'Y' TO NEWREQ IN COMPARM. 02990000
MOVE MAJSYS IN INAREA TO MAJSYS IN OUTAREA. 03000000
MOVE OBJFLD IN INAREA TO OBJFLD IN OUTAREA. 03010001
MOVE SRCH IN INAREA TO SRCH IN OUTAREA. 03020000
MOVE SPACES TO DESC3 IN OUTAREA. 03030000
MOVE SPACES TO DESC4 IN OUTAREA. 03040000
03050000
* ** VALIDATE ACTION 03060000
PERFORM DSN8MC3 THRU END-DSN8MC3. 03070000
IF RETCODE = '1' THEN GO TO MC1-SAVE. 03080000
03090000
* ** VALIDATE OBJECT 03100000
PERFORM DSN8MC4 THRU END-DSN8MC4. 03110000
IF RETCODE = '1' THEN GO TO MC1-SAVE. 03120000
03130000
* ** VALIDATE SEARCH 03140000
PERFORM DSN8MC5 THRU END-DSN8MC5. 03150000
IF RETCODE = '1' THEN GO TO MC1-SAVE. 03160000
03170000
03180000
***************************************************************** 03190000
* **IF ALL SYSTEM FIELDS ARE OK, CONTINUE 03200000
***************************************************************** 03210000
03220000
MC1-BOTH. 03230000
03240000
* **NEW REQUEST 03250000
IF ( PREV IN PCONVSTA = SPACE ) OR 03260000
(( PREV IN PCONVSTA = 'S' ) AND 03270000
( DATA01 IN INAREA NOT = SPACE) AND 03280000
( NEXTBIT = OFF-1 )) THEN 03290000
MOVE 'Y' TO NEWREQ IN COMPARM. 03300000
03310000
* **GO TO CC1-CALL WHERE A CALL 03320000
* **TO EITHER DSN8CC2 OR DSN8IC2 03330000
* **IS PERFORMED. 03340000
03350000
GO TO CC1-CALL. 03360000
***************************************************************** 03370000
* **DSN8CC1 OR DSN8IC1 WILL 03380000
* **BRANCH BACK TO MC1SAVE AFTER 03390000
* **CALLING SQL2. AT MC1SAVE, 03400000
* **THE DATA RETURNED BY SQL2 OR THE 03410000
* **VALIDATION ROUTINES WILL BE 03420000
* **SAVED IN VCONA 03430000
***************************************************************** 03440000
MC1-SAVE. 03450000
MOVE DATAIN IN INAREA TO DATAOUT IN OUTAREA. 03460000
MOVE +1609 TO LASTMSG-LEN. 03470000
MOVE OUTAREA0 TO LASTMSG-TEXT. 03480000
MOVE CONVID IN PCONVSTA TO CONVID IN PCONA. 03490000
MOVE LASTSCR IN PCONVSTA TO LASTSCR IN PCONA. 03500000
MOVE LASTPOS0 IN PCONVSTA TO LASTPOS IN PCONA. 03510000
MOVE LASTPOSC IN PCONVSTA TO LASTPOSC IN PCONA. 03520000
MOVE 'MC1SAVE' TO MINOR IN DSN8-MODULE-NAME. 03530000
03540000
* **INSERT NEW VALUES 03550000
IF NEWCONV = 'Y' THEN 03560000
EXEC SQL INSERT 03570000
INTO VCONA 03580000
VALUES (:PCONA) END-EXEC. 03590000
03600000
* **UPDATE OLD VALUES 03610000
IF NEWCONV NOT = 'Y' THEN 03620000
EXEC SQL UPDATE VCONA 03630000
SET LASTSCR = :PCONA.LASTSCR , 03640000
LASTPOS = :PCONA.LASTPOS , 03650000
LASTPOSC = :PCONA.LASTPOSC , 03660000
LASTMSG = :PCONA.LASTMSG 03670000
WHERE CONVID = :SAVE-CONVID END-EXEC. 03680000