* DATA SET UCTRAN41 AT LEVEL 002 AS OF 08/25/98 * DATA SET UCTRAN41 AT LEVEL 001 AS OF 12/23/97 00001 TITLE 'U C T R A N SWITCH UPPER CASE TRANSLATION OPTION' 00002 *********************************************************************** 00003 * * 00004 * U C T R A N SWITCH UPPER CASE TRANSLATION OPTION * 00005 * * 00006 * CODE FOR CICS 4.1.0 * 00007 * * 00008 * THIS PROGRAM IS USED TO SWITCH THE UCTRAN OPTION FOR THE * 00009 * TERMINAL. AN APPLICATION PROGRAM CAN CALL THIS PROGRAM * 00010 * AS FOLLOWS: * 00011 * EXEC CICS LINK PROGRAM(UCTRAN) END-EXEC. * 00012 * OR * 00013 * EXEC CICS LINK PROGRAM(UCTRAN) COMMAREA(UCPARM) END-EXEC. * 00014 * * 00015 * THE FIRST FORM WILL FLIP THE CURRENT STATUS REGARDLESS OF * 00016 * THE CURRENT VALUE. THE SECOND FORM WILL SET THE OPTION TO * 00017 * THE REQUESTED VALUE IF NEEDED. UCPARM IS A 1 BYTE CHARACTER * 00018 * DEFINED AS 'U' FOR UPPERCASE TRANSLATION, OR 'L' FOR NO * 00019 * UPPERCASE TRANSLATION. * 00020 * * 00021 * IF THE TRANSACTION ID IS 'LC' SET THE LC OPTION. * 00022 * IF THE TRANSACTION ID IS 'UC' SET THE UC OPTION. * 00023 * * 00024 * IF THE PROGRAM IS INVOKED IN AN AOR THE PROGRAM WILL START * 00025 * ITSELF IN THE TOR WITH A 5 BYTE COMMAREA. THIS AREA WILL * 00026 * SPECIFY THE FUNCTION, 'U OR L' FOLLOWED BY THE TERMID TO BE * 00027 * SWITCHED. * 00028 * * 00029 * REGISTER USAGE: * 00030 * * 00031 * R0 RESERVED * 00032 * R1 PARM POINTER * 00033 * R2 * 00034 * R3 1ST CODE BASE REGISTER * 00035 * R4 2ND CODE BASE REGISTER * 00036 * R5 1ST DATA BASE REGISTER * 00037 * R6 WORK * 00038 * R7 EIB POINTER * 00039 * R8 WORK * 00040 * R9 BCT REGISTER / TEMP TIOA POINTER * 00041 * R10 TCTTE POINTER * 00042 * R11 EIB POINTER * 00043 * R12 * 00044 * R13 RESERVED * 00045 * R14 RESERVED * 00046 * R15 RESERVED * 00047 * * 00048 * * 00049 * * 00050 * * 00051 *********************************************************************** 00052 EJECT 00053 * XEQU 00054**2 DFHREGS ADDED BY WB 00055**2 EJECT 00056 DFHEISTG DSECT 00057 SPACE 3 00058 UCTRANST DS F 00059 LENGTH DS H 00060 CAPARM DS 0CL5 * COMMAREA PARM 00061 CATYPE DS CL1 * TYPE OF COMMAREA 00062 UCTRANU EQU C'U' * UPPERCASE TRANSLATION 00063 UCTRANL EQU C'L' * NO UPPERCASE TRANSLATION 00064 UCTRANF EQU C'F' * FLIP UPPERCASE TRANSLATION 00065 CATERM DS CL4 * TERMID FOR UCTRAN 00066 SYSID DS CL4 * SYSID FOR TOR 00067 SPACE 3 00068 ******************************************************************* 00069 EJECT 00070 UCTRAN DFHEIENT CODEREG=(3,4),DATAREG=(5),EIBREG=7 00071 CLI EIBTRMID,X'40' Q-TERMINAL TASK 00072 BH GOODTERM BIF YES 00073 MVC LENGTH,=H'5' 00074 EXEC CICS RETRIEVE INTO(CAPARM) LENGTH(LENGTH) 00075 CLC LENGTH,=H'5' 00076 BNE ABEND BIF NO 00077 B CKPARM 00078 ABEND DS 0H 00079 EXEC CICS ABEND ABCODE('UCTR') 00080 GOODTERM DS 0H 00081 MVC CATERM,EIBTRMID 00082 MVI CATYPE,UCTRANU SET UP FOR UCTRAN ON 00083 CLC EIBTRNID,=CL4'UC' Q-UPPERCASE TRANSLATE REQUESTED 00084 BE UCYES BIF YES 00085 CLC EIBTRNID,=X'A4834040' 00086 BE UCYES 00087 MVI CATYPE,UCTRANL SET UP FOR UCTRAN OFF 00088 CLC EIBTRNID,=CL4'LC' Q-LOWERCASE REQUESTED 00089 BE UCNO BIF YES 00090 CLC EIBTRNID,=X'93834040' 00091 BE UCNO 00092 CLC EIBCALEN,=H'0' Q-COMMAREA 00093 BE UCFLIP BIF NO, 00094 L R1,DFHEICAP GET ADDRESS OF COMMAREA 00095 MVC CATYPE,0(R1) COPY IT 00096 CKPARM DS 0H 00097 CLI CATYPE,UCTRANU Q-UPPERCASE TRANSLATE REQUESTED 00098 BE UCYES BIF YES 00099 CLI CATYPE,UCTRANL Q-LOWERCASE REQUESTED 00100 BE UCNO BIF YES 00101 UCFLIP DS 0H 00102 EXEC CICS INQUIRE TERMINAL(CATERM) UCTRANST(UCTRANST) 00103 CLC UCTRANST,DFHVALUE(UCTRAN) Q-UCTRAN ACTIVE 00104 BE UCNO BIF YES, TURN IF OFF 00105 SPACE 1 00106 UCYES DS 0H 00107 MVC UCTRANST,DFHVALUE(UCTRAN) 00108 B UCSET 00109 UCNO DS 0H 00110 MVC UCTRANST,DFHVALUE(NOUCTRAN) 00111 SPACE 1 00112 UCSET DS 0H ** RETURN ** 00113 EXEC CICS SET TERMINAL(CATERM) UCTRANST(UCTRANST) 00114 EXEC CICS INQUIRE TERMINAL(CATERM) REMOTESYSTEM(SYSID) 00115 CLI SYSID,X'40' 00116 BNH CKTRAN 00117 MVC LENGTH,=Y(L'CAPARM) LENGTH OF COMMAREA 00118 EXEC CICS START TRANSID('UCTR') SYSID(SYSID) FROM(CAPARM) *00119 LENGTH(LENGTH) 00120 * IT MAY BE NECESSARY AT A FUTURE TIME TO BUILD A WAIT/POST MECHANISM 00121 * INTO THE PROCESS HERE TO ENSURE THAT THE BIT IS FLIPPED BEFORE THE 00122 * USER CAN ENTER THEIR NEXT TRAN. 00123 B RETURN 00124 CKTRAN DS 0H ** RETURN ** 00125 CLC EIBTRNID,=CL4'UC' Q-WAS THIS FOR UC TRAN 00126 BE CLEAR BIF YES 00127 CLC EIBTRNID,=X'A4834040' Q-WAS THIS FOR UC TRAN 00128 BE CLEAR BIF YES 00129 CLC EIBTRNID,=CL4'LC' Q-WAS THIS FOR LC TRAN 00130 BE CLEAR BIF YES 00131 CLC EIBTRNID,=X'93834040' Q-WAS THIS FOR LC TRAN 00132 BNE RETURN BIF NO 00133 CLEAR DS 0H 00134 EXEC CICS SEND CONTROL ERASE FREEKB 00135 RETURN DS 0H 00136 EXEC CICS RETURN 00137 SPACE 3 00138 PRINT OFF 00139 LTORG 00140 PRINT ON 00141 SPACE 3 00142 CSECT 001424 DC CL21'002UCTRAN41 08/25/98' 001425 END 00143