pgm (&CvtText) /* Convert this text */
/*--------------------------------------------------------*/
/* declaration */
/*--------------------------------------------------------*/
dcl &CvtText *char 80
dcl &ReqUpper *char 22
dcl &ReqLower *char 22
dcl &Pos *dec 3 1
dcl &Posl *dec 3 0
dcl &Len *dec 3 0
dcl &upper *lgl
dcl &CCSIDReq *char 4 x'00000001'
dcl &CCSIDInp *char 4 x'00000000'
dcl &Uppercase *char 4 x'00000000'
dcl &Lowercase *char 4 x'00000001'
dcl &Reserved *char 10 x'00000000000000000000'
/*----------------------------------------------*/
/* QLGCNVCS - Convert Case QlgConvertCase */
/*----------------------------------------------*/
dcl &Input *char 80
dcl &Output *char 80
dcl &DataLen *char 4 x'00000050'
dcl &ErrCde *char 4 x'00000000'
/*--------------------------------------------------------*/
/* error message variables */
/*--------------------------------------------------------*/
dcl &error *lgl /* std err */
dcl &msgid *char 7 /* std err */
dcl &msgkey *char 4 /* std err */
dcl &msgdta *char 100 /* std err */
dcl &msgf *char 10 /* std err */
dcl &msgflib *char 10 /* std err */
dcl &msgtyp *char 10 '*DIAG' /* std err */
dcl &msgtypctr *char 4 x'00000001' /* std err */
dcl &pgmmsgq *char 10 '*' /* std err */
dcl &stkctr *char 4 x'00000001' /* std err */
dcl &errbytes *char 4 x'00000000' /* std err */
monmsg msgid(cpf0000) exec(goto error)
/*--------------------------------------------------------*/
/* Setup Request Control Block */
/*--------------------------------------------------------*/
chgvar &ReqUpper (&CCSIDReq || +
&CCSIDInp || +
&Uppercase || +
&Reserved)
chgvar &ReqLower (&CCSIDReq || +
&CCSIDInp || +
&Lowercase || +
&Reserved)
chgvar &upper '1'
/*--------------------------------------------------------*/
/* Convert Upper (First letter), then lower case */
/*--------------------------------------------------------*/
loop:
if (&Pos *ge 80) goto endloop
/*----------------------------------------------*/
/* Convert to Lower */
/*----------------------------------------------*/
if (%sst(&CvtText &Pos 1) = ' ') do
if (*Not &Upper) do
chgvar &output ' '
chgvar %bin(&Datalen) &len
Call Pgm(QLGCNVCS) +
parm(&Reqlower +
&input +
&output +
&Datalen +
&ErrCde )
chgvar %sst(&CvtText &Posl &len) &Output
enddo
chgvar &upper '1'
chgvar &Pos (&Pos + 1)
enddo
/*----------------------------------------------*/
/* Convert to Upper */
/*----------------------------------------------*/
if (%sst(&CvtText &Pos 1) *ne ' ') do
if &upper do
chgvar &input %sst(&CvtText &Pos 1)
chgvar &output ' '
chgvar %bin(&Datalen) 1
Call Pgm(QLGCNVCS) +
parm(&ReqUpper +
&input +
&output +
&Datalen +
&ErrCde )
chgvar %sst(&CvtText &Pos 1) %sst(&Output 1 1)
chgvar &Pos (&Pos + 1)
chgvar &Posl &Pos
chgvar &upper '0'
chgvar &len 0
enddo
else do
chgvar &len (&len + 1)
chgvar %sst(&input &len 1) %sst(&CvtText &Pos 1)
chgvar &Pos (&Pos + 1)
enddo
enddo
goto loop
endloop:
Goto End
/*--------------------------------------------------------*/
/* error routine: */
/*--------------------------------------------------------*/
error:
if &error (goto errordone)
else chgvar &error '1'
/*----------------------------------------------*/
/* move all *DIAG message to *PRV program queue*/
/*----------------------------------------------*/
call QMHMOVPM (&msgkey +
&msgtyp +
&msgtypctr +
&pgmmsgq +
&stkctr +
&errbytes)
/*----------------------------------------------*/
/* resend the last *ESCAPE message */
/*----------------------------------------------*/
errordone:
call QMHRSNEM (&msgkey +
&errbytes)
monmsg cpf0000 exec(do)
sndpgmmsg msgid(cpf3cf2) msgf(QCFPMSG) +
msgdta('QMHRSNEM') msgtype(*escape)
monmsg cpf0000
enddo
end: endpgm (
geocities.com/siliconvalley/pines) (
geocities.com/siliconvalley)