Tweet
Program FTP's to a directory lists the files then allows users to download.
You will need to make adjustments for this to work for you..
Copy book
You will need to make adjustments for this to work for you..
PHP Code:
h Option(*NODEBUGIO) DFTACTGRP(*NO)
/copy current,DYNO_CP
d $Screen1 pr 500a varying
d Line 78a const dim(24) options(*varsize)
d NumLines 10i 0 value
d AnsLen 10i 0 value
d DataOut 256
*
* local variables
*
d Abort s 1n
d Choice# s 10i 0
d cmdlength s 15 5
d cmdstring s 512
d dec8 s 8 0
d decimalanswer s 1 0
d end s 3 0
d endscreen1 s n
d Essay s 500A
d filename s 80
d foundAS400 s 3 0
d Directory s 256 varying
d GrapTheFile s n
d itemnumber s 7 0
d length s 10i 0
d Lines s 78A dim(24)
d Mycount s 10i 0
d newname s 512
d password s 10 inz('@PASSWORD')
d processing s n
d Q s 1 inz('''')
* dns name or Ip address
d remoteIP s 15 inz('@SERVERNAME')
d*remoteIP s 15 inz('192.168.1.100')
d reply s 1
d screenatr s 1
d screenerror s n
d start s 3 0
d string s 512
d sqlstmt s 2500 varying
d teststring s 512
d theanswer s 1
d userid s 10 inz('@USERID')
d workfile s 80
d workPO# s 7 0
d workPOLine# s 3 0
*
* This is the return data from subprocedure $screen
* left at 256 so you can add bunch more return values
*
d dataout ds 256 qualified inz
d F3 n overlay(dataout:1)
d Choice 1 overlay(dataout:*next)
**---------------------------------------------------------------
* external calls
**---------------------------------------------------------------
d $command pr extpgm( 'QCMDEXC' )
d cmdstring 2000 options( *varsize ) const
d cmdlength 15 5 const
*
d mysqldata ds qualified inz
d String 512
*
d mysqldata2 ds qualified inz
d String 512
*
d mysqldata3 ds qualified inz
d String 512
*
* Sql functions
*
d openlist pr
d fetchnext pr n
d closelist pr
**---------------------------------------------------------------
/free
*inlr = *on;
directory = '/pdm/data/wkgshare/pfs/AS400_AuxiliaryFolder_wl ';
exec sql set option commit=*none,datfmt=*iso,
closqlcsr=*ENDMOD;
//--------------------------------------------------------
// M A I N L I N E
//--------------------------------------------------------
// ftp to server and get directory listing
exsr $OverrideFiles;
exsr $ftpDirList;
exsr $startftp;
exsr $readoutput;
return;
//--------------------------------------------------------
// $ReadOutput - read the output file
//--------------------------------------------------------
begsr $ReadOutput;
reset choice#;
// setup the title
Mycount +=1;
Lines(Mycount) = 'Select File to Process';
// add blank line
Mycount +=1;
Lines(Mycount) = *blanks;
sqlstmt = 'Select * from OUTPUT';
openList();
dow fetchNext();
// look for the direcotry listing and the file name
start = %scan('6-':mysqldata3.string);
// don't loop forever!
FoundAS400 = %scan('AS400':mysqldata3.string);
if start > *zeros and FoundAS400 > *zeros;
end = %scan('.txt':mysqldata3.string);
if end > *zeros;
length = end+4 - start;
filename = %subst(mysqldata3.string:start:length);
// increment the letter
Choice#+=1;
Mycount+=1;
lines(Mycount) = ' ' + %char(Choice#) + ') ' +
%trim(filename);
exsr $processfile;
endif;
endif;
enddo;
closeList();
// all files .txt are listed now show screen
if Mycount <= 2;
Mycount+=1;
lines(Mycount) = '** No Records Found **';
endif;
reset endscreen1;
dow not(EndScreen1);
if not(screenerror);
lines(20) = *blanks;
endif;
reset dataout;
Dataout = $Screen1(lines:20:1:DataOut);
reset screenerror;
// this is the error line
select;
when dataout.F3 = *on;
EndScreen1 = *on;
return;
other; // check answer
TheAnswer = dataout.choice;
exsr $validate;
if not(screenerror);
exsr $getthefile;
endif;
endsl;
enddo;
endsr;
//--------------------------------------------------------
// $Validate - validate the return selection
//--------------------------------------------------------
begsr $Validate;
reset screenerror;
// validate the answer
if %check(' 0123456789':TheAnswer) > *zeros;
lines(20) = 'Entry ' + TheAnswer + ' is invalid';
screenerror = *on;
else;
TheAnswer = %xlate(' ':'0':TheAnswer);
DecimalAnswer = %dec(TheAnswer:1:0);
if DecimalAnswer > Choice#;
lines(20) = 'Entry ' + TheAnswer + ' is Greater than ' +
%char(choice#);
screenerror = *on;
endif;
endif;
endsr;
//--------------------------------------------------------
// $GettheFile - get the file from FTP and process it
//--------------------------------------------------------
begsr $GettheFile;
endsr;
//--------------------------------------------------------
// $ProcessFile - grab the file and do the work
//--------------------------------------------------------
begsr $ProcessFile;
// create pf in qtemp and do processing
cmdstring = 'CRTPF QTEMP/MYFILE RCDLEN(512) ';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring : cmdlength);
on-error;
cmdstring = 'CLRPFM QTEMP/MYFILE ';
cmdlength = %len(%trim(cmdstring));
endmon;
// remove any get commands from the imput file
exec sql
delete from QTEMP/MYFILE
where myfile like '%MYFILE%';
exec sql
delete from QTEMP/INPUT
where myfield like '%DIR%';
processing = *on;
exsr $OverrideFiles;
exsr $FtpDirList;
processing = *off;
mysqldata2.String = 'Get ' + %trim(filename) + ' QTEMP/MYFILE' +
' (replace ';
exec sql
insert into QTEMP/INPUT values(:mysqldata2);
// change extension of .txt file to .done
workfile = Filename;
end = %scan('.txt':workfile);
%subst(workfile:end:5) = '.done';
mysqldata2.String = 'Rename ' + %trim(filename) +
' ' + %trim(workfile);
// exec sql
// insert into QTEMP/INPUT values(:mysqldata2);
exsr $startFTP;
endsr;
//--------------------------------------------------------
// $OverrideFiles - create input & output override files
//--------------------------------------------------------
begsr $OverrideFiles;
cmdstring = 'DLTOVR INPUT';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring : cmdlength);
on-error;
endmon;
cmdstring = 'DLTOVR OUTPUT';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring : cmdlength);
on-error;
endmon;
cmdstring = 'CLRPFM FILE(QTEMP/INPUT)';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring : cmdlength);
on-error;
exec sql
create table QTEMP/INPUT
(MyField char(512));
endmon;
cmdstring = 'CLRPFM FILE(QTEMP/OUTPUT)';
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring : cmdlength);
on-error;
exec sql
create table QTEMP/OUTPUT
(MyField char(512));
endmon;
endsr;
//--------------------------------------------------------
// $FtpDirList - get direcotory listing
//--------------------------------------------------------
begsr $FtpDirList;
// commands to run on server
mysqldata2.string = %trim(userid) + ' ' + %trim(password);
exec sql
insert into QTEMP/INPUT values(:mysqldata2);
mysqldata2.String = 'ASCII';
exec sql
insert into QTEMP/INPUT values(:mysqldata2);
mysqldata2.String =
'cd ' + directory;
exec sql
insert into QTEMP/INPUT values(:mysqldata2);
if processing = *off;
mysqldata2.String = 'Dir ' ;
endif;
exec sql
insert into QTEMP/INPUT values(:mysqldata2);
cmdstring = 'OVRDBF FILE(INPUT) TOFILE(QTEMP/INPUT)' +
' OVRSCOPE(*JOB) ';
cmdlength = %len(%trim(cmdstring));
$command(cmdstring : cmdlength);
cmdstring = 'OVRDBF FILE(OUTPUT) TOFILE(QTEMP/OUTPUT)' +
' OVRSCOPE(*JOB) ';
cmdlength = %len(%trim(cmdstring));
$command(cmdstring : cmdlength);
endsr;
//--------------------------------------------------------
// $StartFTP; Start FTP...
//--------------------------------------------------------
begsr $StartFTP;
cmdstring = 'STRTCPFTP ' + Q + %trim(remoteIp) + Q ;
cmdlength = %len(%trim(cmdstring));
monitor;
$command(cmdstring : cmdlength);
on-error;
endmon;
endsr;
/end-free
*--------------------------------------------------------
* $Screen1(): Show Screen1 (Remote files via FTP)
*
* Line = (input) array of lines of text containing
* the question to ask
* NumLines = (input) number of lines in the Line array
* AnsLen = (input) size of answer blank
* DataOut = (output) position 1 F3 positon 2 answer
*
* Returns the user's answer
*--------------------------------------------------------
p $Screen1 B
d $Screen1 PI 500A varying
d Line 78A const
d dim(24) options(*varsize)
d NumLines 10I 0 value
d AnsLen 10I 0 value
d DataOut 256
d cmdbuf s like(Qsn_Cmd_Buf_T)
d inpbuf s like(Qsn_Inp_Buf_T)
d prompt s 70A varying
d NRF s 50 inz('** No Records Found **')
d skipthis s n
d len s 10I 0
d data s 132A varying
d x s 10I 0
d Row s 3U 0
d Answer s 500A varying
*
d InputData ds qualified
d based(p_InputData)
d Row 3U 0
d Col 3U 0
d AID 1A
d Field 500A
/free
// ----------------------------------------------
// Create Input/Output buffers and clear them
// ----------------------------------------------
cmdbuf = QsnCrtCmdBuf(100: 50: 0: *OMIT: *OMIT);
inpbuf = QsnCrtInpBuf(200: 50: 0: *OMIT: *OMIT);
QsnClrBuf( cmdbuf : *omit );
QsnClrBuf( inpbuf : *omit );
// ----------------------------------------------
// Add the "Clear Screen" command to the output
// so that the terminal starts with an empty
// screen.
// ----------------------------------------------
QsnClrScr( *omit : cmdbuf : *omit : *omit );
// ----------------------------------------------
// Put a screen title in the output buffer
// ----------------------------------------------
data = 'Select File to download and process.';
QsnWrtDta( data
: %len(data)
: *omit
: 1
: 40 - (%len(data)/2) // center
: QSN_SA_HI
: QSN_SA_HI
: QSN_SA_WHT
: QSN_SA_WHT
: cmdbuf
: *omit
: *omit
);
// ----------------------------------------------
// Put the filename on rows 3+ of the output buf
// ----------------------------------------------
row = 2;
for x = 1 to NumLines;
row +=1;
Select;
when row = 3;
ScreenAtr = QSN_SA_PNK_UL;
Length = 22;
when row = 22;
ScreenAtr = QSN_SA_RED;
Length = %len(line(x));
other;
ScreenAtr = QSN_SA_GRN;
Length = %len(line(x));
endsl;
if %scan(%trim(NRF):Line(x)) > *zeros;
SkipThis = *on;
endif;
QsnWrtDta( Line(x)
: Length
: *omit
: row
: 2
: QSN_SA_NORM
: QSN_SA_NORM
: ScreenAtr
: QSN_SA_GRN
: cmdbuf
: *omit
: *omit
);
endfor;
// ----------------------------------------------
// Put an underlined blank input field into the
// output buffer so the user has a place to
// answer.. This is on Row 21
// ----------------------------------------------
if not(SkipThis);
QsnSetFld( *omit
: AnsLen
: 21
: 2
: QSN_FFW_ALPHA_SHIFT
: *omit
: 0
: QSN_SA_UL
: QSN_SA_GRN_UL
: cmdbuf
: *omit
: *omit );
endif;
// ----------------------------------------------
// Let the user know how to exit (color blue)
// ----------------------------------------------
QsnWrtDta( 'F3=Exit'
: %len('F3=Exit')
: *omit
: 23
: 2
: QSN_SA_HI
: QSN_SA_NORM
: QSN_SA_BLU
: QSN_SA_GRN
: cmdbuf
: *omit
: *omit
);
// ----------------------------------------------
// put the "unlock keyboard" command into the
// output buffer
// ----------------------------------------------
QsnReadInp( QSN_CC1_MDTALL_CLRALL
: QSN_CC2_UNLOCKBD
: *omit
: *omit
: cmdbuf
: *omit
: *omit );
// ----------------------------------------------
// send the output buffer to the terminal, and
// wait for input from the user
// ----------------------------------------------
QsnPutGetBuf( cmdbuf: inpbuf: *omit: *omit);
// ----------------------------------------------
// Get a pointer to the input data, and the
// length of the input data.
// ----------------------------------------------
p_InputData = QsnRtvDta( inpbuf: *omit: *omit );
Len = QsnRtvDtaLen(inpbuf: *omit: *omit)
- %size(InputData.ROW)
- %size(InputData.COL)
- %size(InputData.AID);
// ----------------------------------------------
// Copy the answer from the buffer
// ----------------------------------------------
if (Len > 0);
Answer = %trim( %subst( InputData.field: 1: len) );
%subst(dataout:2:1) = Answer;
endif;
// ----------------------------------------------
// Clean up the buffers, and return to caller
// ----------------------------------------------
QsnDltBuf(cmdbuf: *omit);
QsnDltBuf(inpbuf: *omit);
%subst(dataout:1:1) = '0';
if (InputData.AID = QSN_F3);
%subst(dataout:1:1) = '1';
endif;
// return Variable
return dataout;
/end-free
P E
*--------------------------------------------------------
* openList - Open a cursor to read file
*--------------------------------------------------------
p openList b
d openList pi
/free
exec sql
declare MyCursor cursor for statement;
exec sql
prepare statement from :sqlstmt;
exec sql
open mycursor;
/End-Free
p openList e
*--------------------------------------------------------
* fetchNext - read one record at a time
*--------------------------------------------------------
p fetchNext b
d fetchNext pi n
/free
exec sql
fetch next from mycursor into : mysqldata3;
if sqlstt < '02000';
return *on;
else;
return *off;
endif;
/end-free
p fetchnext e
*--------------------------------------------------------
* closeOrderList - Close the OrderHdr cursor
*--------------------------------------------------------
p closeList b
d closeList pi
/free
exec sql
close MyCursor;
/end-free
p closeList e
*--------------------------------------------------------
PHP Code:
/if defined(QSNAPI_H)
/eof
/endif
/define QSNAPI_H
*-------------------------------------------------------------
* Simple data types
*-------------------------------------------------------------
D Q_Handle_T s 10I 0 based(Template)
D Qsn_Cmd_Buf_T s like(Q_Handle_T) based(Template)
D Qsn_Inp_Buf_T s like(Q_Handle_T) based(Template)
D Qsn_Env_T s like(Q_Handle_T) based(Template)
D QSN_FAIL c -1
*-------------------------------------------------------------
* QsnCrtCmdBuf(): Create command buffer
*-------------------------------------------------------------
D QsnCrtCmdBuf PR 10I 0 extproc('QsnCrtCmdBuf')
D InitSize 10I 0 const
D IncrAmt 10I 0 const options(*omit)
D MaxSize 10I 0 const options(*omit)
D Handle 10I 0 options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnCrtInpBuf(): Create Input Buffer
*-------------------------------------------------------------
D QsnCrtInpBuf PR 10I 0 extproc('QsnCrtInpBuf')
D BufSize 10I 0 const
D IncrAmt 10I 0 const options(*omit)
D MaxSize 10I 0 const options(*omit)
D Handle 10I 0 options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnClrBuf(): Clear/Reset Buffer (any type)
*-------------------------------------------------------------
D QsnClrBuf PR 10I 0 extproc('QsnClrBuf')
D BufHandle 10I 0 const
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnDltBuf(): Delete buffer (any type)
*-------------------------------------------------------------
D QsnDltBuf PR 10I 0 extproc('QsnDltBuf')
D BufHandle 10I 0 const
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnClrScr(): Clear screen
*-------------------------------------------------------------
D QsnClrScr PR 10I 0 extproc('QsnClrScr')
D mode 1A const options(*omit)
D cmdbuf 10I 0 const options(*omit)
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnWrtDta(): Write data to the display
*-------------------------------------------------------------
D QsnWrtDta PR 10I 0 extproc('QsnWrtDta')
D Data 32767A const options(*varsize)
D DataLen 10I 0 const
D FieldID 10I 0 const options(*omit)
D Row 10I 0 const options(*omit)
D Column 10I 0 const options(*omit)
D StrMonoAttr 1A const options(*omit)
D EndMonoAttr 1A const options(*omit)
D StrColorAttr 1A const options(*omit)
D EndColorAttr 1A const options(*omit)
D CmdBufHandle 10I 0 const options(*omit)
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnSetFld(): Add a field to the display
*-------------------------------------------------------------
D QsnSetFld PR 10I 0 extproc('QsnSetFld')
D FieldID 10I 0 const options(*omit)
D FieldLen 10I 0 const options(*omit)
D Row 10I 0 const options(*omit)
D Column 10I 0 const options(*omit)
D FFW 2A const options(*omit)
D FCW 2A const dim(32767)
D options(*omit: *varsize)
D NumOfFCW 10I 0 const options(*omit)
D MonoAttr 1A const options(*omit)
D ColorAttr 1A const options(*omit)
D CmdBufHandle 10I 0 const options(*omit)
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnReadInp(): Read data and wait for AID key
*-------------------------------------------------------------
D QsnReadInp PR 10I 0 extproc('QsnReadInp')
D CC1 1A const
D CC2 1A const
D DataBytes 10I 0 options(*omit)
D InpBufHandle 10I 0 options(*omit)
D CmdBufHandle 10I 0 options(*omit)
D LowEnvHandle 10I 0 options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnPutGetBuf(): Send command output buffer to terminal
* then wait for input buffer from terminal
*-------------------------------------------------------------
D QsnPutGetBuf PR 10I 0 extproc('QsnPutGetBuf')
D CmdBufHandle 10I 0 const
D InpBufHandle 10I 0 const
D LowEnvHandle 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnRtvDta(): Get pointer to input data in input buffer
*-------------------------------------------------------------
D QsnRtvDta PR * extproc('QsnRtvDta')
D InpBufHandle 10I 0 const
D PtrToData * const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
* QsnRtvDtaLen(): Get length of input data in input buffer
*-------------------------------------------------------------
D QsnRtvDtaLen PR 10I 0 extproc('QsnRtvDtaLen')
D InpBufHandle 10I 0 const
D DataLen 10I 0 const options(*omit)
D ErrorCode 32767A options(*omit: *varsize)
*-------------------------------------------------------------
*
*-------------------------------------------------------------
D Qsn_Env_Desc_T...
D DS qualified based(Template)
D color_support 1A
D CDRA 1A
D CDRA_3F 1A
D DBCS_support 1A
D coexist 1A
D alt_help 1A
D tgt_dev 10A
D disp_file 20A
D invite_active 1A
D prevent_ovrd 1A
*-------------------------------------------------------------
*
*-------------------------------------------------------------
D Qsn_Env_Rtv_Desc_T...
D DS qualified based(Template)
D bytes_rtn 10I 0
D bytes_avail 10I 0
D color_support 1A
D CDRA 1A
D CDRA_3F 1A
D DBCS_support 1A
D coexist 1A
D alt_help 1A
D tgt_dev 10A
D dsp_file 20A
D invite_active 1A
D prevent_ovrd 1A
*-------------------------------------------------------------
* Constants used for creating/querying the environment
*-------------------------------------------------------------
D QSN_COLOR_NO...
D C '1'
D QSN_COLOR_YES...
D C '2'
D QSN_COLOR_SELECT...
D C '3'
D QSN_CDRA_STD...
D C '1'
D QSN_CDRA_CNVT...
D C '2'
D QSN_DBCS_STD...
D C '1'
D QSN_DBCS_ONLY...
D C '2'
D QSN_DBCS_EITHER...
D C '3'
D QSN_DBCS_MIXED...
D C '4'
D QSN_COEXIST_YES...
D C '1'
D QSN_COEXIST_NO...
D C '2'
D QSN_ALTHELP_NO...
D C '1'
D QSN_TGT_REQ...
D C '*REQUESTER'
D QSN_INVITE_NO...
D C '1'
D QSN_INVITE_YES...
D C '2'
D QSN_PREVENT_OVERRIDE_NO...
D C '1'
D QSN_PREVENT_OVERRIDE_YES...
D C '2'
D QSN_SAME C '0'
D QSN_DSP03 C '3'
D QSN_DSP04 C '4'
*-------------------------------------------------------------
* AID keys (function keys, et al)
*-------------------------------------------------------------
D Qsn_F1 C X'31'
D Qsn_F2 C X'32'
D Qsn_F3 C X'33'
D Qsn_F4 C X'34'
D Qsn_F5 C X'35'
D Qsn_F6 C X'36'
D Qsn_F7 C X'37'
D Qsn_F8 C X'38'
D Qsn_F9 C X'39'
D Qsn_F10 C X'3A'
D Qsn_F11 C X'3B'
D Qsn_F12 C X'3C'
D Qsn_F13 C X'B1'
D Qsn_F14 C X'B2'
D Qsn_F15 C X'B3'
D Qsn_F16 C X'B4'
D Qsn_F17 C X'B5'
D Qsn_F18 C X'B6'
D Qsn_F19 C X'B7'
D Qsn_F20 C X'B8'
D Qsn_F21 C X'B9'
D Qsn_F22 C X'BA'
D Qsn_F23 C X'BB'
D Qsn_F24 C X'BC'
D Qsn_SLP C X'3F'
D Qsn_FET C X'50'
D Qsn_PA1 C X'6C'
D Qsn_PA2 C X'6E'
D Qsn_PA3 C X'6B'
D Qsn_Clear C X'BD'
D Qsn_Enter C X'F1'
D Qsn_Help C X'F3'
D Qsn_RollDown C X'F4'
D Qsn_RollUp C X'F5'
D Qsn_PageUp C X'F4'
D Qsn_PageDown C X'F5'
D Qsn_Print C X'F6'
D Qsn_RecBS C X'F8'
DQsn5250QY C '1'
DQsn5250QN C '2'
DQsn5250QF C '3'
*-------------------------------------------------------------
* Control Characters ( CC1 & CC2 )
*-------------------------------------------------------------
D QSN_CC1_NULL...
D C X'00'
D QSN_CC1_LOCKBD...
D C X'20'
D QSN_CC1_MDTNBY...
D C X'40'
D QSN_CC1_MDTALL...
D C X'60'
D QSN_CC1_CLRMOD...
D C X'80'
D QSN_CC1_MDTNBY_CLRALL...
D C X'A0'
D QSN_CC1_MDTNBY_CLRMOD...
D C X'C0'
D QSN_CC1_MDTALL_CLRALL...
D C X'E0'
D QSN_CC2_NULL...
D C X'00'
D QSN_CC2_NO_IC...
D C X'40'
D QSN_CC2_RST_CSR_BL...
D C X'20'
D QSN_CC2_SET_CSR_BL...
D C X'10'
D QSN_CC2_UNLOCKBD...
D C X'08'
D QSN_CC2_ALARM...
D C X'04'
D QSN_CC2_MSG_OFF...
D C X'02'
D QSN_CC2_MSG_ON...
D C X'01'
*-------------------------------------------------------------
* Screen Attributes
*-------------------------------------------------------------
D QSN_NO_SA...
D C X'00'
D QSN_SA_NORM...
D C X'20'
D QSN_SA_CS...
D C X'30'
D QSN_SA_BL...
D C X'28'
D QSN_SA_UL...
D C X'24'
D QSN_SA_HI...
D C X'22'
D QSN_SA_RI...
D C X'21'
D QSN_SA_ND...
D C X'27'
D QSN_SA_GRN...
D C X'20'
D QSN_SA_GRN_RI...
D C X'21'
D QSN_SA_WHT...
D C X'22'
D QSN_SA_WHT_RI...
D C X'23'
D QSN_SA_GRN_UL...
D C X'24'
D QSN_SA_GRN_UL_RI...
D C X'25'
D QSN_SA_WHT_UL...
D C X'26'
D QSN_SA_RED...
D C X'28'
D QSN_SA_RED_RI...
D C X'29'
D QSN_SA_RED_BL...
D C X'2A'
D QSN_SA_RED_RI_BL...
D C X'2B'
D QSN_SA_RED_UL...
D C X'2C'
D QSN_SA_RED_UL_RI...
D C X'2D'
D QSN_SA_RED_UL_BL...
D C X'2E'
D QSN_SA_ND_2F...
D C X'2F'
D QSN_SA_TRQ_CS...
D C X'30'
D QSN_SA_TRQ_CS_RI...
D C X'31'
D QSN_SA_YLW_CS...
D C X'32'
D QSN_SA_YLW_CS_RI...
D C X'33'
D QSN_SA_TRQ_UL...
D C X'34'
D QSN_SA_TRQ_UL_RI...
D C X'35'
D QSN_SA_YLW_UL...
D C X'36'
D QSN_SA_ND_37...
D C X'37'
D QSN_SA_PNK...
D C X'38'
D QSN_SA_PNK_RI...
D C X'39'
D QSN_SA_BLU...
D C X'3A'
D QSN_SA_BLU_RI...
D C X'3B'
D QSN_SA_PNK_UL...
D C X'3C'
D QSN_SA_PNK_UL_RI...
D C X'3D'
D QSN_SA_BLU_UL...
D C X'3E'
D QSN_SA_ND_3F...
D C X'3F'
*-------------------------------------------------------------
* Ideographic shift-in and shift-out
*-------------------------------------------------------------
D QSN_SO C X'0E'
D QSN_SI C X'0F'
*-------------------------------------------------------------
* Field Format Words
*-------------------------------------------------------------
D QSN_NO_FFW C X'0000'
D QSN_FFW_BYPASS C X'6000'
D QSN_FFW_DUP C X'5000'
D QSN_FFW_MDT C X'4800'
D QSN_FFW_ALPHA_SHIFT...
D C X'4000'
D QSN_FFW_ALPHA_ONLY...
D C X'4100'
D QSN_FFW_NUM_SHIFT...
D C X'4200'
D QSN_FFW_NUM_ONLY...
D C X'4300'
D QSN_FFW_KATA...
D C X'4400'
D QSN_FFW_DIGIT_ONLY...
D C X'4500'
D QSN_FFW_IO...
D C X'4600'
D QSN_FFW_SIGNED_NUMERIC...
D C X'4700'
D QSN_FFW_AUTO_ENTER...
D C X'4080'
D QSN_FFW_FER...
D C X'4040'
D QSN_FFW_AUTO_FER...
D C X'4040'
D QSN_FFW_MONOCASE...
D C X'4020'
D QSN_FFW_AUTO_MONOCASE...
D C X'4020'
D QSN_FFW_ME...
D C X'4008'
D QSN_FFW_NOADJUST...
D C X'4000'
D QSN_FFW_RA_ZERO...
D C X'4005'
D QSN_FFW_RA_BLANK...
D C X'4006'
D QSN_FFW_MF...
D C X'4007'
D QSN_FCW_RESEQ...
D C X'8000'
D QSN_FCW_MSR...
D C X'8101'
D QSN_FCW_SLP...
D C X'8102'
D QSN_FCW_MSR_SLP...
D C X'8103'
D QSN_FCW_SLP_SA...
D C X'8106'
D QSN_FCW_DBCS_ONLY...
D C X'8200'
D QSN_FCW_DBCS_PURE...
D C X'8220'
D QSN_FCW_DBCS_EITHER...
D C X'8240'
D QSN_FCW_DBCS_OPEN...
D C X'8280'
D QSN_FCW_DBCS_OPEN_CO...
D C X'82C0'
D QSN_FCW_TRANSPARENT...
D C X'8400'
D QSN_FCW_FET...
D C X'8501'
D QSN_FCW_CONT_FIRST...
D C X'8601'
D QSN_FCW_CONT_LAST...
D C X'8602'
D QSN_FCW_CONT_MIDDLE...
D C X'8603'
D QSN_FCW_CP...
D C X'8800'
D QSN_FCW_HL...
D C X'8900'
D QSN_FCW_PDS...
D C X'8A00'
D QSN_FCW_MOD11...
D C X'B140'
D QSN_FCW_MOD10...
D C X'B1A0'
D QSN_READ_INP...
D C X'42'
D QSN_READ_MDT...
D C X'52'
D QSN_READ_IMM...
D C X'72'
D QSN_READ_MDT_ALT...
D C X'82'
/if defined(TO_BE_CONVERTED_LATER)
*
* Structure definitions.
*
DQsnEnvExtI DS
* Data structure for QsnCrtEnv API.
D QsnEEDta *
D QsnEEChg * procptr
D QsnEEDlt * procptr
DQsnEnvWM DS
* Data structures for QsnSetEnvWinMod API.
D QsnEWAtrC 1A
D QsnEWULR 10I 0
D QsnEWULC 10I 0
D QsnEWNumR 10I 0
D QsnEWNumC 10I 0
DQsnREnvWM DS
* Data structures for QsnRtvEnvWinMod API.
D QsnREWRet 10I 0
D QsnREWAvl 10I 0
D QsnREWMode 1A
D QsnREWAtr 1A
D QsnREWULR 10I 0
D QsnREWULC 10I 0
D QsnREWNumR 10I 0
D QsnREWNumC 10I 0
DQsnQ5250 DS
* Data structure for QsnQry5250 API.
D QsnQ5Ret 10I 0
D QsnQ5Avl 10I 0
D QsnQ5Stat 1A
D QsnQ5Wkstn 4B 0
D QsnQ5CLvl 3A
D QsnQ5R1 16A
D QsnQ5WType 1A
D QsnQ5MType 4A
D QsnQ5Model 3A
D QsnQ5KbdID 1A
D QsnQ5EKbd 1A
D QsnQ5PcKbd 1A
D QsnQ5SNum 4A
D QsnQ5MaxIn 4B 0
D QsnQ5WSCSp 2A
D QsnQ5R2 1A
D QsnQ5WSCB1 1A
D QsnQ5WSCB2 1A
D QsnQ5WSCB3 1A
D QsnQ5WSCB4 1A
D QsnQ5WSCB5 1A
D QsnQ5R3 5A
D QsnQ5Prt 1A
D QsnQ5R4 1A
D QsnQ5GrdBf 1A
D QsnQ5R5 9A
*Note: this may be expanded in the future
DQsnReadInf DS
* Data structure for QsnRtvReadInf API.
D QsnRIRet 10I 0
D QsnRIAvl 10I 0
D QsnRIR1 8A
D QsnRIDta *
D QsnRIFDta *
D QsnRIDtaL 10I 0
D QsnRIFDtaL 10I 0
D QsnRINumF 10I 0
D ReadLen 10I 0
D QsnRIRow 10I 0
D QsnRICol 10I 0
D QsnRIAID 1A
D QsnRIR2 7A
DQsnFldInf DS
* Data structure for QsnRtvFldInf API.
D QsnFIRet 10I 0
D QsnFIAvl 10I 0
D QsnFIType 1A
D QsnFIRow 10I 0
D QsnFICol 10I 0
D QsnFIFDtaL 10I 0
D QsnFIR1 11A
D QsnFIDta *
DQsnWinExtI DS
* Data structure for QsnCrtWin API
D QsnWEDta *
D QsnWEChg * procptr
D QsnWEDlt * procptr
D QsnWECoord * procptr
D QsnWEDraw * procptr
D QsnWECur * procptr
DQsnWinD DS
* Data structures for QsnCrtWin and QsnChgWin APIs.
D QsnWTopR 10I 0
D QsnWLeftC 10I 0
D QsnWNumR 10I 0
D QsnWNumC 10I 0
D QsnWMinR 10I 0
D QsnWMinC 10I 0
D QsnWMaxR 10I 0
D QsnWMaxC 10I 0
D QsnWFS 1A
D QsnWAtrM1 1A
D QsnWAtrM2 1A
D QsnWAtrM3 1A
D QsnWAtrC1 1A
D QsnWAtrC2 1A
D QsnWAtrC3 1A
D QsnWShowB 1A
D QsnWShowBA 1A
D QsnWShowLA 1A
D QsnWShowRA 1A
D QsnWMsgL 1A
D QsnWULCh 1A
D QsnWTopCh 1A
D QsnWURCh 1A
D QsnWLCh 1A
D QsnWRCh 1A
D QsnWLLCh 1A
D QsnWBotCh 1A
D QsnWLRCh 1A
D QsnWGUI 1A
D QsnWFlg1 1A
D QsnWFlg2 1A
D QsnWR1 1A
D QsnWBdrF 1A
D QsnWTtlF 1A
D QsnWTAtrM 1A
D QsnWTAtrC 1A
D QsnWR2 1A
D QsnWR3 3A
D QsnWTtlO 10I 0
D QsnWTtlL 10I 0
D QsnWR4 10I 0
DQsnRWinD DS
* Data structure for QsnRtvWinD API.
D QsnRWRet 10I 0
D QsnRWAvl 10I 0
D QsnRWTopR 10I 0
D QsnRWLeftC 10I 0
D QsnRWNumR 10I 0
D QsnRWNumC 10I 0
D QsnRWMinR 10I 0
D QsnRWMinC 10I 0
D QsnRWMaxR 10I 0
D QsnRWMaxC 10I 0
D QsnRWFS 1A
D QsnRWAtrM1 1A
D QsnRWAtrM2 1A
D QsnRWAtrM3 1A
D QsnRWAtrC1 1A
D QsnRWAtrC2 1A
D QsnRWAtrC3 1A
D QsnRWShwB 1A
D QsnRWShwBA 1A
D QsnRWShwLA 1A
D QsnRWShwRA 1A
D QsnRWMsgL 1A
D QsnRWULCh 1A
D QsnRWTopCh 1A
D QsnRWURCh 1A
D QsnRWLCh 1A
D QsnRWRCh 1A
D QsnRWLLCh 1A
D QsnRWBotCh 1A
D QsnRWLRCh 1A
D QsnRWGUI 1A
D QsnRWFlg1 1A
D QsnRWFlg2 1A
D QsnRWR1 1A
D QsnRWBdrF 1A
D QsnRWTtlF 1A
D QsnRWTAtrM 1A
D QsnRWTAtrC 1A
D QsnRWR2 1A
D QsnRWR3 3A
D QsnRWTtlO 10I 0
D QsnRWTtlL 10I 0
D QsnRWR4 10I 0
DQsnSsnExtI DS
* Data structure for QsnCrtSsn API
D QsnSEDta *
D QsnSEChg * procptr
D QsnSEDlt * procptr
D QsnSECoord * procptr
D QsnSEDraw * procptr
D QsnSECur * procptr
DQsnSsnD DS
* Data structure for QsnCrtSsn and QsnChgSsn APIs
D QsnSActn * procptr Dim(24)
D QsnSTRow 10I 0
D QsnSLCol 10I 0
D QsnSNRows 10I 0
D QsnSNCols 10I 0
D QsnSRollA 10I 0
D QsnSShftA 10I 0
D QsnSISize 10I 0
D QsnSMSize 10I 0
D QsnSIncr 10I 0
D QsnSIRows 10I 0
D QsnSR1 1A
D QsnSWrap 1A
D QsnSR2 1A
D QsnEBCDIC 1A
D QsnSEcho 1A
D QsnSLDsp 1A
D QsnSCDsp 1A
D QsnSShowC 1A
D QsnSCmdAM 1A
D QsnSCmdAC 1A
D QsnSInLAM 1A
D QsnSInLAC 1A
D QsnSPmtO 10I 0
D QsnSPmtL 10I 0
D QsnSCmdO1 10I 0
D QsnSCmdL1 10I 0
D QsnSCmdO2 10I 0
D QsnSCmdL2 10I 0
D QsnSR4 20A
DQsnRSsnD DS
* Data structure for QsnRtvSsnD APIs
D QsnRSRet 10I 0
D QsnRSAvl 10I 0
D QsnRSR1 8A
D QsnRSActn * procptr Dim(24)
D QsnRSTRow 10I 0
D QsnRSLCol 10I 0
D QsnRSNRows 10I 0
D QsnRSNCols 10I 0
D QsnRSRollA 10I 0
D QsnRSShftA 10I 0
D QsnRSISize 10I 0
D QsnRSMSize 10I 0
D QsnRSIncr 10I 0
D QsnRSIRows 10I 0
D QsnRSR2 1A
D QsnRSWrap 1A
D QsnRSR3 1A
D QsnREBCDIC 1A
D QsnRSEcho 1A
D QsnRSLDsp 1A
D QsnRSCDsp 1A
D QsnRSShowC 1A
D QsnRSCmdAM 1A
D QsnRSCmdAC 1A
D QsnRSInLAM 1A
D QsnRSInLAC 1A
D QsnRSPmtO 10I 0
D QsnRSPmtL 10I 0
D QsnRSCmdO1 10I 0
D QsnRSCmdL1 10I 0
D QsnRSCmdO2 10I 0
D QsnRSCmdL2 10I 0
D QsnRSR5 20A
/endif
Comment