DUTAS re-platformed to Raincode - 29Jul2025-update-from-Srujani
This commit is contained in:
Neeraj Kumar
146
ASMB/UCTRAN41.asm
Normal file
146
ASMB/UCTRAN41.asm
Normal file
@ -0,0 +1,146 @@
|
||||
* 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
|
||||
Reference in New Issue
Block a user