*          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
