ARRAY DS of DSPFD
From MidrangeWiki
ARRAY DS Program
Compile code
PGM (&lib &srcf)
DCL &LIB *CHAR 10
DCL &SRCF *CHAR 10
CRTSQLRPGI OBJ(&LIB/DSPFINFO) SRCFILE(&LIB/&SRCF) +
SRCMBR(DSPFINFO) OBJTYPE(*MODULE) REPLACE(*YES) DBGVIEW(*SOURCE)
CRTSRVPGM SRVPGM(&LIB/DSPFINFO) +
MODULE(&LIB/DSPFINFO) +
EXPORT(*ALL)
CRTRPGMOD MODULE(&LIB/DSMFD) SRCFILE(&LIB/&SRCF) +
SRCMBR(DSMFD) DBGVIEW(*ALL) REPLACE(*YES)
CRTPGM PGM(&LIB/DSMFD) MODULE(&LIB/DSMFD) +
BNDSRVPGM((&LIB/DSPFINFO *IMMED))
ENDPGM
DSMFD
h Option(*NODEBUGIO)
// CRTRPGMOD MODULE(urlib/DSMFD)
// SRCFILE(urlib/ursrcfile)
// SRCMBR(DSMFD) REPLACE(*YES)
// CRTSRVPGM SRVPGM(urlib/DSPFINFO)
// MODULE(urlib /DSPFINFO)
// EXPORT(*ALL)
// CRTPGM PGM(urlib/DSMFD) MODULE(urlib/DSMFD)
// BNDSRVPGM((urlib/DSPFINFO *IMMED) )
// CALL urlib/DSMFD ('*LIBL ' 'CDISPRF ')
D DSMFD PR
D 10
D 10
D DSMFD PI
D $Lib 10
D $Fil 10
D $FilQul S 20
/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)
*-------------------------------------------------------------
* QsnPutBuf(): Send command output buffer to terminal
*-------------------------------------------------------------
D QsnPutBuf PR 10I 0 extproc('QsnPutBuf')
D CmdBufHandle 10I 0 const
D LowEnvHandle 10I 0 const 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
d $SelFmts pr
d 10A Dim(100)
d 10I 0
d 100A
d $PutRecords Pr
d $PutRecord Pr
d Record 10A const
d Add 1A const
d ReadScr 1A const
d Lines s 78A dim(24)
d length s 10i 0
d Q s 1 inz('''')
D APIErrorDS DS
D 10I 0 Inz( %Size( APIErrorDS ) )
D BytesAvail 10I 0 Inz( *Zero )
D MsgID 7 Inz( *Blanks )
D 1 Inz( X'00' )
D MsgDta 256 Inz( *Blanks )
*
d InputData ds qualified
d based(p_InputData)
d Row 3U 0
d Col 3U 0
d AID 1A
d Field 500A
*
*
d dataout ds 256 qualified inz
d F3 n overlay(dataout:1)
d Choice 1 overlay(dataout:*next)
**---------------------------------------------------------------
D SavFmt s 10A
D #FFW s 2A
D #FLEN s 5I 0
d screenatr s 1
d ssize s 4 0
d #GotFlds s 10i 0
D FDS DS QUALIFIED DIM(2000)
D #FmtNam 10A
D #FldNam 10A
D #FldLen 5I 0
D #FldPlen 5I 0
D #FldDec 1
D #FldIO 1
D #FldAtr 1
D #FldDTUS 1
D #FldEdt 20A
D #FldRow 10I 0
D #FldCol 10I 0
D #FldCom 1000A varying
D RTVFLDS PR N
D $FilQul 20 Value
D $NumFlds 10I 0
D FDS like(FDS) DIM(2000)
d #Fmts s 10A Dim(100)
d fx s 10I 0
d Ans s 100A
d z s 10I 0
d z1 s 10I 0
d zx s 10I 0
d main PR
/free
*INLR = *ON;
main();
return;
/end-free
//###################################################//
P main b
d main PI
/free
$FilQul = $Fil + $lib;
#GotFlds = 0 ;
clear FDS ;
*IN10 = RTVFLDS ($FilQul : #GotFlds : FDS);
$SelFmts(#Fmts : fx : Ans);
zx = 0;
for z = 1 to 50;
if %subst(Ans : z*2 -1 : 2) <> *blank;
zx += 1;
endif;
endfor;
if zx > 0;
for z = 1 to 50;
if %subst(Ans : z*2 -1 : 2) <> *blank;
z1 += 1;
select;
when z1 = 1 and z1 = zx;
$PutRecord(#Fmts(z) : '0':'1');
when z1 = 1 ;
$PutRecord(#Fmts(z) : '0':'0');
when z1 = zx;
$PutRecord(#Fmts(z) : '1':'1');
other;
$PutRecord(#Fmts(z) : '1':'0');
endsl;
endif;
endfor;
endif;
return;
/end-free
p main e
*--------------------------------------------------------
* $SelFmts( ): Show Screen1 (Remote files via FTP)
*
*--------------------------------------------------------
p $SelFmts B
d $SelFmts PI
d #Fmts 10A Dim(100)
d fx 10I 0
d Ans 100A
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 3I 0
d Col s 3I 0
d Answer s 500A varying
*
D DS
D SFmts 14 DIM(100)
D SFmtx 10 OVERLAY(Sfmts:5)
d RowFmt ds
d srowfmt 1 14
d srow 1 4
d sfmt 5 14
d srowb 1 4B 0
*
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 Records Formats to Display .';
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 records on rows 3+ of the output buf
// ----------------------------------------------
row = 3;
col = -9;
fx = 0;
#Fmts = *blank;
// Sort the formats with input fields into screen order
// This is to help alleviate the requirement
// that input fields need to be in the proper order in the buffer
for x = 1 to #Gotflds;
// %occur(FlddtaDS) = x;
If FDS(x).#FmtNam <> SavFmt or x = #GotFlds ;
SavFmt = FDS(x).#FmtNam;
fx += 1;
sFmt = FDS(x).#Fmtnam;
sRowb = 0;
if FDS(x).#FldIO = x'02' or
FDS(x).#FldIO = x'04' or
FDS(x).#FldIO = x'05' ;
sRowb = FDS(x).#Fldrow;
endif;
sFmts(fx) = srowfmt;
Endif;
If FDS(x).#FmtNam = SavFmt;
If sRowb < FDS(x).#Fldrow and
FDS(x).#FldIO = x'02' or
FDS(x).#FldIO = x'04' or
FDS(x).#FldIO = x'05';
sRowb = FDS(x).#Fldrow;
sFmts(fx) = srowfmt;
Endif;
Endif;
endfor;
sorta sFmts;
fx = 0 ;
for x = 1 to 100;
If SFmtx(x) <> *blank ;
fx += 1;
#Fmts(fx) = sFmtx(x);
col += 14;
if col >= 69;
col = 5;
row +=1;
Endif;
// temp fix
if row < 24 ;
QsnWrtDta( sFmtx(x)
: 10
: *omit
: row
: col
: QSN_SA_NORM
: QSN_SA_NORM
: QSN_SA_GRN
: QSN_SA_GRN
: cmdbuf
: *omit
: *omit
);
QsnSetFld( *omit
: 2
: row
: col -3
: QSN_FFW_ALPHA_SHIFT
: *omit
: 0
: QSN_SA_UL
: QSN_SA_GRN_UL
: cmdbuf
: *omit
: *omit );
endif;
endif;
endfor;
// ----------------------------------------------
// 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
// ----------------------------------------------
ans = *blank;
if (Len > 0);
Answer = %trimr( %subst( InputData.field: 1: len) );
ans = 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 ;
/end-free
P E
*--------------------------------------------------------
* $PutRecord(): Send a record to Screen
*
*--------------------------------------------------------
p $PutRecord B
d $PutRecord PI
d Record 10A const
d Add 1A const
d ReadScr 1A const
d cmdbuf s like(Qsn_Cmd_Buf_T)
d inpbuf s like(Qsn_Inp_Buf_T)
d prompt s 70A varying
d skipthis s n
d len s 10I 0
d x s 10I 0
d Row s 3U 0
d y s 10I 0
d yx s 10I 0
d w s 10I 0
D DS
D SFldss 12 DIM(6000)
D SOcurs 10I 0 OVERLAY(SFldss:9)
d RowCol ds
d sfld 1 12
d srow 1 4
d scol 5 8
d socur 9 12
d srowb 1 4B 0
d scolb 5 8B 0
d socurb 9 12B 0
/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 );
if add = '0';
// ----------------------------------------------
// Add the "Clear Screen" command to the output
// so that the terminal starts with an empty
// screen.
// ----------------------------------------------
QsnClrScr( *omit : cmdbuf : *omit : *omit );
endif;
exsr ShowFile;
if Readscr = '0';
// ----------------------------------------------
// send the output buffer to the terminal,
// ----------------------------------------------
QsnPutBuf( cmdbuf: *omit: *omit);
else;
// ----------------------------------------------
// 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);
endif;
QsnDltBuf(cmdbuf: *omit);
QsnDltBuf(inpbuf: *omit);
return ;
begsr ShowFile;
// For the record sort the occurances into row col sequence
// then process the occurs in the sorted sequence.
clear SFldss;
yx = 0;
for y = 1 to #Gotflds;
// %occur(FlddtaDS) = y;
If FDS(y).#FmtNam = record;
srowb = FDS(y).#FldRow;
scolb = FDS(y).#FldCol;
socurb = y;
yx += 1;
Sfldss(yx) = sfld;
Endif;
endfor;
sorta Sfldss;
for y = 1 to 6000;
if SFldss(y) = *blank;
iter;
endif;
// %occur(FlddtaDS) = SOcurs(y);
w = SOcurs(y);
// ----------------------------------------------
// Put a field in the output buffer
// ----------------------------------------------
// data = 'Select File to download and process.';
// Construct the fields to paint the screen
//
//*Field attribute.
//*X'01' indicates Constant (see structure QDFFFCON,
//*X'02' indicates Output (O),
//*X'03' indicates Message (M), h (B),
//*X'04' indicates Input (I), (P)
//*X'05' indicates Both (B),
//*X'06' indicates Hidden (H), and
//*X'07' indicates Program to System (P)
If FDS(w).#FmtNam = record;
select;
when FDS(w).#FldIO = x'01';
Select;
when FDS(w).#FldDTUS = 'D';
FDS(w).#Fldlen = 8;
FDS(w).#FldCom = 'dd/mm/yy';
when FDS(w).#FldDTUS = 'Y';
FDS(w).#Fldlen = 8;
FDS(w).#FldCom = 'dd/mm/yy';
when FDS(w).#FldDTUS = 'T';
FDS(w).#Fldlen = 8;
FDS(w).#FldCom = 'hh:mm:ss';
when FDS(w).#FldDTUS = 'U';
FDS(w).#Fldlen = 10;
FDS(w).#FldCom = 'User_Name';
when FDS(w).#FldDTUS = 'S';
FDS(w).#Fldlen = 10;
FDS(w).#FldCom = 'Sys_Name';
endsl;
QsnWrtDta( %trim(FDS(w).#FldCom)
: FDS(w).#FldLen
: *omit
: FDS(w).#FldRow
: FDS(w).#FldCol +1
: QSN_SA_HI
: QSN_SA_HI
: QSN_SA_WHT
: QSN_SA_WHT
: cmdbuf
: *omit
: *omit
);
when FDS(w).#FldIO = x'02' or
FDS(w).#FldIO = x'04' or
FDS(w).#FldIO = x'05' ;
//* Keyboard shift and data type.
//* X'00' indicates Alpha shift/character (A),
//* X'01' indicates Alpha only (X),
//* X'02' indicates Numeric shift (N),
//* X'03' indicates Numeric only (Y),
//* X'04' indicates Katakana (K),
//* X'05' indicates Digits only (D),
//* X'06' indicates Inhibit keyboard (I),
//* X'07' indicates Signed numeric/zoned (S),
//* X'08' indicates Binary (B),
//* X'09' indicates Packed (P),
//* X'0A' indicates Floating (F),
//* X'0B' indicates DBCS (J),
//* X'0C' indicates Open (O), X'0D' indicates Either (E),
//* X'0E' indicates Numeric-only character (M),
//* X'0F' indicates Graphic (G),
//* X'10' indicates Date (L),
//* X'11' indicates Time (T), and
//* X'12' indicates Timestamp (Z)
select;
when FDS(w).#FLDIO = x'02';
#FFW = QSN_NO_FFW;
when FDS(w).#Fldatr = x'00';
#FFW = QSN_FFW_ALPHA_SHIFT;
when FDS(w).#Fldatr = x'01';
#FFW = QSN_FFW_ALPHA_ONLY;
when FDS(w).#Fldatr = x'02';
#FFW = QSN_FFW_NUM_SHIFT;
when FDS(w).#Fldatr = x'03';
#FFW = QSN_FFW_NUM_ONLY;
when FDS(w).#Fldatr = x'04';
#FFW = QSN_FFW_KATA;
when FDS(w).#Fldatr = x'05';
#FFW = QSN_FFW_DIGIT_ONLY;
when FDS(w).#Fldatr = x'06';
#FFW = QSN_FFW_IO;
when FDS(w).#Fldatr = x'07';
#FFW = QSN_FFW_SIGNED_NUMERIC;
endsl;
select;
when FDS(w).#FldLen <> 0 ;
#FLen = FDS(w).#FldLen;
when FDS(w).#FldPLen <> 0 ;
#FLen = FDS(w).#FldPLen;
endsl;
QsnSetFld( *omit
: #FLen
: FDS(w).#FldRow
: FDS(w).#FldCol + 1
: #FFW
: *omit
: 0
: QSN_SA_UL
: QSN_SA_GRN_UL
: cmdbuf
: *omit
: *omit );
endsl;
endif;
endfor;
endsr;
/end-free
P E
DSPFINFO
*-------------------------------------------------------------------
* = Service program... DspFInfo=
* = Description....... Retrieve display file information routines=
*-------------------------------------------------------------------
* CRTSQLRPGI OBJ(urlib/DSPFINFO)
* SRCFILE(urlib/ursrcfile)
* SRCMBR(DSPFINFO)
* OBJTYPE(*MODULE) REPLACE(*yes)
*
* CRTSRVPGM SRVPGM(urlib/DSPFINFO)
* MODULE(urlib/DSPFINFO)
* EXPORT(*ALL)
*
*
H NoMain
*-------------------------------------------------------------------
* - RtvDspFDesc - Retrieve display file description (QDFRTVFD API)-
*-------------------------------------------------------------------
D RtvDspFDesc PR ExtPgm( 'QDFRTVFD' )
D 8
D 10I 0 Const
D 8 Const
D 20 Const
D 272
D Flddta DS qualified dim(2000)
D #FmtNam 10A
D #FldNam 10A
D #FldLen 5I 0
D #FldPlen 5I 0
D #FldDec 1
D #FldIO 1
D #FldAtr 1
D #FldDTUS 1
D #FldEdt 20A
D #FldRow 10I 0
D #FldCol 10I 0
D #FldCom 1000A varying
D
D RtvFlds PR N
D DspFil 20A Value
D NumFlds 10I 0
D FDS likeds(Flddta) dim(2000)
D
*---------------------------------------------------------------*
* Retrieve Display File Fields *
*---------------------------------------------------------------*
P RtvFlds B Export
D RtvFlds PI Like(LglTyp)
D QDspFil Like( QNamTyp ) Value
D Numflds 10I 0
D FDS likeds(Flddta) dim(2000)
*-------------------------------------------------------------------
* - Base -
*-------------------------------------------------------------------
D QDFFBASE DS Based( p_QDFFBASE) qualified
D WDFFINFO 5I 0 Overlay( QDFFBASE : 9 )
D WDFFRCS 5I 0 Overlay( QDFFBASE : 11 )
D WDFFSCR 5I 0 Overlay( QDFFBASE : 14 )
D WDFFSCRS 1A Overlay( QDFFBASE : 20 )
* p_QDFFSCRA = %addr( QDFFBASE.WDFFSCRS) first
* p_QDFFSCRA = P_QDFFSCRA + %size(QDFFSCRA) * n next
DQDFFSCRA DS Based( p_QDFFSCRA ) qualified
D WDFFSCIA 1 1
D WDFRVED2 2 5
DQDFFSSEQ DS Based( p_QDFFSSEQ ) qualified
D WDFFFSST 1 256
D WDFFFSSC 257 260U 0
D WDFFFSSN 261 270
D WDFFFSSL 271 280
D WDFBITS00 281 282
D WDFRVED4 283 308
*-------------------------------------------------------------------
* - File Header -
* p_QDFFINFO = p_QDFFBASE + QDFFBASE.WDFFINFO
*-------------------------------------------------------------------
D QDFFINFO DS Based( p_QDFFINFO) qualified
D WDFFDFLO 10I 0 Overlay( QDFFINFO : 1 )
D WDFFWUOF 10I 0 Overlay( QDFFINFO : 5 )
D WDFFFMWU 10I 0 Overlay( QDFFINFO : 9 )
D WDFFXDOF 5I 0 Overlay( QDFFINFO : 35)
D ZDFF 1 50A
*-------------------------------------------------------------------
* - File Where Used -
* p_QDFWFLEI = p_QDFFINFO + QDFFINFO.WDFFWUOF
*-------------------------------------------------------------------
D QDFWFLEI DS Based( p_QDFWFLEI) qualified
D WDFWXLEN 5I 0 Overlay( QDFWFLEI : 1 )
D WDFWXOKW 5I 0 Overlay( QDFWFLEI : 3 )
D WDFWWULN 10I 0 Overlay( QDFWFLEI : 5 )
D WDFWNTBO 10I 0 Overlay( QDFWFLEI : 9 )
D WDFFWXIN 5I 0 Overlay( QDFWFLEI : 12)
// pointer
D WDFWINDX 1A Overlay( QDFWFLEI : 19)
*-------------------------------------------------------------------
* - File Dev Dept -
* p_QDFFDPDD = p_QDFFINFO + QDFFINFO.WDFFXDOF
*-------------------------------------------------------------------
D QDFFDPDD DS Based( p_QDFFDPDD) qualified
D WDFFFKWD 5I 0 Overlay( QDFFDPDD : 9 )
D WDFFSHB1 5I 0 Overlay( QDFFDPDD : 13)
D WDFFSHRA 5I 0 Overlay( QDFFDPDD : 16)
D WDFFCKY1 5I 0 Overlay( QDFFDPDD : 17)
D WDFFCKY2 5I 0 Overlay( QDFFDPDD : 18)
D WDFFCKY3 5I 0 Overlay( QDFFDPDD : 19)
D WDFFMKWD 5I 0 Overlay( QDFFDPDD : 20)
D WDFFMKW2 5I 0 Overlay( QDFFDPDD : 21)
D WDFFXDOC 5I 0 Overlay( QDFFDPDD : 25)
*-------------------------------------------------------------------
* - Name Table-
* p_QDFFNTBL = p_QDFWFLEI + QDFWFLEI.WDFWNTBO
*-------------------------------------------------------------------
D QDFFNTBL DS Based( p_QDFFNTBL) qualified
D WDFFNMS 10I 0 Overlay( QDFFNTBL : 1 )
// pointer to array char(10)
D WDFFNMES 1A
// Field Name
D QDFFNTB DS Based( p_QDFFNTB ) qualified
D WDFFNAM 10A
*-------------------------------------------------------------------
* - Record Where Used -
* p_QDFWRCDI = p_QDFWFLEI + QDFWFLEI.WDFWXLEN first
*-------------------------------------------------------------------
D QDFWRCDI DS Based( p_QDFWRCDI ) qualified
D WDFWRLEN 5I 0 Overlay( QDFWRCDI : 1 )
D WDFWROKW 5I 0 Overlay( QDFWRCDI : 3 )
D WDFWNXTR 10I 0 Overlay( QDFWRCDI : 5 )
D WDFWRIN 5I 0 Overlay( QDFWRCDI : 9 )
// pointer to indicator table
D WDFWINDR 1A Overlay( QDFWRCDI : 13)
*-------------------------------------------------------------------
* - Record Format Table-
* p_QDFARFTE = p_QDFFINFO + QDFFINFO.WDFFDFLO first
* p_QDFARFTE = p_QDFARFTE + %Len( QDFARFTE ) next
* alt p_QDFARFTE = p_QDFFINFO + QDFFINFO.WDFFDFLO +
* (%size(QDFARFTE) * x)
*-------------------------------------------------------------------
D QDFARFTE DS Based ( p_QDFARFTE ) qualified
D WDFARFNM 10 Overlay( QDFARFTE : 1 )
D WDFARCND 5I 0 Overlay( QDFARFTE : 11 )
D WDFARFOF 10I 0 Overlay( QDFARFTE : 13 )
DQDFFSEQT DS Based ( p_QDFFSEQT ) qualified
D WDFFFSEQ 1 13
D WDFVED17 14 16
*-------------------------------------------------------------------
* - Record Header -
* p_QDFFRINF = p_QDFFINFO + QDFARFTE.WDFARFOF
*-------------------------------------------------------------------
D QDFFRINF DS Based ( p_QDFFRINF ) qualified
D WDFFRDDO 10I 0 Overlay( QDFFRINF : 1 )
D WDFFOFIT 10I 0 Overlay( QDFFRINF : 5 )
D WDFFSTBO 10I 0 Overlay( QDFFRINF : 9 )
D WDFFRFLG1 1A Overlay( QDFFRINF : 13 )
D WDFFRFLG2 1A Overlay( QDFFRINF : 14 )
D WDFFFLD 5I 0 Overlay( QDFFRINF : 17 )
D WDFFINDO 5I 0 Overlay( QDFFRINF : 23 )
D WDFFRAOF 5I 0 Overlay( QDFFRINF : 29 )
*-------------------------------------------------------------------
* Display-Record-Level Device-Dependent
* p_QDFFXRDP = p_QDFFRINF + QDFFRDPD.WDFFXRDO
DQDFFXRDP DS Based (p_QDFFXRDP ) qualified
D WDFFFOTO 1 4B 0
D WDFFNRCO 5 8B 0
D WDFVED33 9 12
D WDFFSEGS 13 14B 0
D WDFVED34 15 16
D WDFHCTLO 17 18B 0
D WDFVED35 19 24
D
DQDFFSFCR DS Based (p_QDFFSFCR ) qualified
D WDFFSFLG 1 34
D WDFFSFEN 35 35
D WDFFSFDR 36 36
D WDFBITS19 37 37
D WDFBITS20 38 38
D WDFFSFPQ 39 40B 0
D WDFFSFVL 41 42B 0
D WDFFSFVO 43 44B 0
D WDFFSFFI 45 46B 0
D WDFFFSFL01 47 48B 0
D WDFFFSFO 49 50B 0
D WDFXTOFF 51 52B 0
D WDFBITS21 53 53
D WDFVED37 54 54
D WDFFSFPM 55 55
D
DQDFSFSRU DS Based (p_QDFSFSRU ) qualified
D WDFVED39 1 1
D WDFFSFSR 2 2
DQDFSFERU DS Based (p_QDFSFERU ) qualified
D WDFVED40 1 1
D WDFFSFER 2 2
DQDFSFH2U DS Based (p_QDFSFH2U ) qualified
D WDFFSFH1 1 2B 0
D WDFFSFH2 3 4B 0
D
DQDFCREXT DS Based (p_QDFCREXT ) qualified
D WDFCRLLO 1 2B 0
D WDFIZSFO 3 4B 0
D WDFELOFF 5 6B 0
D WDFELCH1 7 7
D WDFELCH2 8 8
D WDFVED42 9 16
*-------------------------------------------------------------------
* - Record Device-Dependent (QDFFRDPD)
* p_QDFFRDPD = p_QDFFRINF + WDFFRAOF
*-------------------------------------------------------------------
D QDFFRDPD DS Based (p_QDFFRDPD ) qualified
D WDFFDRCO 10I 0 Overlay( QDFFRDPD : 1 )
D WDFFINCP 5I 0 Overlay( QDFFRDPD : 5 )
D WDFFIBF 5I 0 Overlay( QDFFRDPD : 7 )
D WDFFOIS 5I 0 Overlay( QDFFRDPD : 9 )
D WDFACKYS 4A Overlay( QDFFRDPD : 13 )
D WDFFPUTK 2A Overlay( QDFFRDPD : 17 )
D WDFFGETK 2A Overlay( QDFFRDPD : 19 )
D WDFFERRM 5I 0 Overlay( QDFFRDPD : 21 )
D WDFFBITS 1A Overlay( QDFFRDPD : 23 )
D WDFFBITF 1A Overlay( QDFFRDPD : 24 )
D WDFFCGRI 5I 0 Overlay( QDFFRDPD : 25 )
D WDFFHFLG 2A Overlay( QDFFRDPD : 27 )
D WDFFXRDO 5I 0 Overlay( QDFFRDPD : 29 )
D WDFFRDOC 5I 0 Overlay( QDFFRDPD : 33 )
*-------------------------------------------------------------------
* - Row Column Table -
* p_QDFFRCTB = p_QDFFRINF + WDFFDRCO
* SizeIndex = 0 to WDFFSCR -1
*-------------------------------------------------------------------
D QDFFRCTB DS Based ( p_QDFFRCTB) qualified
D WDFFFRRO 1A Overlay( QDFFRCTB : 1 )
D WDFFFRCO 1A Overlay( QDFFRCTB : 2 )
D WDFFTORO 1A Overlay( QDFFRCTB : 3 )
D WDFFTOCO 1A Overlay( QDFFRCTB : 4 )
D WDFFRBIT 1A Overlay( QDFFRCTB : 5 )
D WDFFRC 1A Overlay( QDFFRCTB : 7 )
*-------------------------------------------------------------------
* - Row Column Table Entries -
* p_QDFFRCTE = %addr(QDFFRCTB.WDFFRC) first
* p_QDFFRCTE = p_QDFFRCTE + %size(QDFFRCTE) next
D QDFFRCTE DS Based ( p_QDFFRCTE) qualified
D WDFFSROW 1 1A
D WDFFSCOL 2 2A
*-------------------------------------------------------------------
* - Field Where Used -
* p_QDFWFLDI = p_QDFWRCDI + QDFWRCDI.WDFWRLEN first
* p_QDFWFLDI = p_QDFWFLDI + WDFWFLDL next
*-------------------------------------------------------------------
D QDFWFLDI DS Based ( p_QDFWFLDI ) qualified
D WDFWFLDL 5I 0 Overlay( QDFWFLDI : 1 )
D WDFWFOKW 5I 0 Overlay( QDFWFLDI : 3 )
D WDFWRRDX 5I 0 Overlay( QDFWFLDI : 5 )
// index into Field Name Table p_QDFFNTBL
D WDFWNMEI 10I 0 Overlay( QDFWFLDI : 7 )
D WDFWLFLD 5I 0 Overlay( QDFWFLDI : 11 )
D WDFWFFLG 1A Overlay( QDFWFLDI : 13 )
*-------------------------------------------------------------------
* - Field Index -
* QDFFRINF is at variable WDFFOFIT in QDFFRINF.
*-------------------------------------------------------------------
D QDFFFITB DS Based ( p_QDFFFITB ) qualified
D WDFFFOFS 10I 0 Overlay( QDFFFITB : 1 )
D WDFFSELI 5I 0 Overlay( QDFFFITB : 5 )
D WDFFDLEN 5I 0 Overlay( QDFFFITB : 7 )
*-------------------------------------------------------------------
*-------------------------------------------------------------------
* - Constant Field Header -
* p_QDFFFCON = WDFFFTBE
*-------------------------------------------------------------------
D QDFFFCON DS Based ( p_QDFFFCON ) qualified
D WDFFFAOC 5I 0 Overlay( QDFFFCON : 3 )
*-------------------------------------------------------------------
* - Named Field Header -
* p_QDFFFNAM = WDFFFTBE
*-------------------------------------------------------------------
D QDFFFNAM DS Based ( p_QDFFFNAM ) qualified
D WDFFINPO 5I 0 Overlay( QDFFFNAM : 1 )
D WDFFOUTO 5I 0 Overlay( QDFFFNAM : 3 )
D WDFFPLEN 5I 0 Overlay( QDFFFNAM : 5 )
D WDFFDEC 1A Overlay( QDFFFNAM : 7 )
D WDFFKBDT 1A Overlay( QDFFFNAM : 8 )
D WDFFFAOF 5I 0 Overlay( QDFFFNAM : 11 )
*-------------------------------------------------------------------
* - Field Header
* p_QDFFFINF = p_QDFFRINF + WDFFFOFS
*-------------------------------------------------------------------
D QDFFFINF DS Based ( p_QDFFFINF ) qualified
D WDFFFLEN 1A Overlay( QDFFFINF : 1 )
D WDFFFIOA 1A Overlay( QDFFFINF : 3 )
D WDFFBFLG 1A Overlay( QDFFFINF : 4 )
D WDFFFBIT 1A Overlay( QDFFFINF : 5 )
// pointer to QDFFFCON or QDFFFNAM
D WDFFFTBE 1A Overlay( QDFFFINF : 7 )
*-------------------------------------------------------------------
* - Field Dev Dept
* p_QDFFFDPD = p_QDFFFINF + WDFFFAOF named
* p_QDFFFDPD = p_QDFFFINF + WDFFFAOC constant
*-------------------------------------------------------------------
D QDFFFDPD DS Based ( p_QDFFFDPD ) qualified
D WDFFFLGS 1A Overlay( QDFFFDPD : 1 )
D WDFFSA 1A Overlay( QDFFFDPD : 2 )
D WDFFXFDO 5I 0 Overlay( QDFFFDPD : 3 )
D WDFFFDOC 5I 0 Overlay( QDFFFDPD : 5 )
// pointer
D WDFFFICE 1A Overlay( QDFFFDPD : 7 )
*-------------------------------------------------------------------
* - Input-Capable Display Field-Level Device-Dep
* p_QDFFFDIC = WDFFFICE
*-------------------------------------------------------------------
D QDFFFDIC DS Based ( p_QDFFFDIC ) qualified
D WDFFFWFW 2A Overlay( QDFFFDIC : 1 )
D WDFFSSKW 1A Overlay( QDFFFDIC : 3 )
D WDFFCHKB 1A Overlay( QDFFFDIC : 4 )
*-------------------------------------------------------------------
* - Field-Dependent Extension -
* p_QDFFXFDP = p_QDFFFINF + WDFFXFDO
*-------------------------------------------------------------------
D QDFFXFDP DS Based ( p_QDFFXFDP ) qualified
D WDFFKFLG 2A Overlay( QDFFXFDP : 1 )
D WDFFFLDINX 5I 0 Overlay( QDFFXFDP : 3 )
D WDFFXLFLGS 1A Overlay( QDFFXFDP : 4 )
// this is a BIN 16
D WDFF_UCS2_ 2A Overlay( QDFFXFDP : 6 )
*-------------------------------------------------------------------
* - Keyword Category Displacement
* file p_QDFFCOSA = p_QDFFINFO + WDFFXDOC
* record p_QDFFCOSA = p_QDFFRINF + WDFFRDOC
* field p_QDFFCOSA = p_QDFFFINF + WDFFFDOC
*-------------------------------------------------------------------
D QDFFCOSA DS Based ( p_QDFFCOSA ) qualified
D WDFFCCT 5I 0 Overlay( QDFFCOSA : 1 )
// pointer
D WDFFCCOS 1A Overlay( QDFFCOSA : 3 )
*-------------------------------------------------------------------
* - Keyword Category Displacement String Entry
* p_QDFFCCOA = %addr(WDFFCCOS)
*-------------------------------------------------------------------
D QDFFCCOA DS Based ( p_QDFFCCOA ) qualified
D WDFFCAID 1A Overlay( QDFFCCOA : 1 )
D WDFFCAOF 5I 0 Overlay( QDFFCCOA : 2 )
*-------------------------------------------------------------------
* - Subfile Control Record-
*-------------------------------------------------------------------
DQDFFSFHR DS Based (p_QDFFSFHR ) qualified
D WDFFSFSZ 1 2B 0
D WDFFSFPG 3 4B 0
D WDFVED38 5 6
D WDFFFSFT 7 8B 0
D WDFSFR1U 9 10
D WDFFSFR1 9 10B 0
D WDFVED3900 9 9
D WDFFSFSR00 10 10
D WDFSFR2U 11 12
D WDFFSFR2 11 12B 0
D WDFVED4000 11 11
D WDFFSFER00 12 12
D WDFSFLNU 13 16
D WDFFSFLN 13 16
D WDFFSFH100 13 14B 0
D WDFFSFH200 15 16B 0
D WDFFFSFF 17 18B 0
D WDFVED41 19 24
DQDFKFILK DS Based (p_QDFKFILK ) qualified
D WDFFKFIL 5I 0 Overlay( QDFKFILK : 1 )
D WDFKFILE 1A Overlay( QDFKFILK : 3 )
DQDFKFLPM DS Based (p_QDFKFLPM ) qualified
D WDFKFLID 1 Overlay( QDFKFLPM : 1 )
D WDFKFLST 5I 0 Overlay( QDFKFLPM : 2 )
D WDFKFLRS 5I 0 Overlay( QDFKFLPM : 4 )
D WDFFKFLP 5I 0 Overlay( QDFKFLPM : 6 )
D WDFKFLEX 1A Overlay( QDFKFLPM : 8 )
DQDFKFLPP DS Based (p_QDFKFLPP ) qualified
D WDFKFLLN 5I 0 Overlay( QDFKFLPP : 1 )
D WDFKFLNM 1A Overlay( QDFKFLPP : 3 )
DQDFKFLSZ DS Based (p_QDFKFLSZ ) qualified
D WDFKFLML 1 2B 0
D WDFVED57 3 6
DQDFKICVP DS Based (p_QDFKICVP ) qualified
D WDFKICVN 1 2B 0
D WDFKICVK 3 4B 0
D WDFKICVT 5 6B 0
DQDFKHARD DS Based (p_QDFKHARD ) qualified
D WDFKHRFM 1 10
D WDFKHFIL 11 20
D WDFKHLIB 21 30
DQDFKHXPS DS Based (p_QDFKHXPS ) qualified
D WDFKHXHG 1 10
D WDFKHXHL 11 20
D WDFKHXML 21 22B 0
DQDFKHDOC DS Based (p_QDFKHDOC ) qualified
D WDFKHDLA 1 10
D WDFKHDDO 11 22
D WDFKHDFL 23 24B 0
DQDFKSIDX DS Based (p_QDFKSIDX ) qualified
D WDFKSIOB 1 10
D WDFKSILB 11 20
DQDFKFALX DS Based (p_QDFKFALX ) qualified
D WDFFKALT 1 2B 0
DQDFKFALK DS Based (p_QDFKFALK ) qualified
D WDFKANME 1 10
D WDFKAINX 11 12B 0
DQDFKESFL DS Based (p_QDFKESFL ) qualified
D WDFKESCR 1 10
DQDFKBODR DS Based (p_QDFKBODR ) qualified
D WDFKCLOR 1 1
D WDFKDATR 2 2
D WDFKCHRS 3 10
DQDFKCKKW DS Based (p_QDFKCKKW ) qualified
D WDFFKCKS 1 2B 0
D WDFKCKCM 3 3
DQDFKCKKE DS Based (p_QDFKCKKE ) qualified
D WDFKCKID 1 1
D WDFKCKIN 2 3B 0
D WDFKCKRS 4 5B 0
D WDFKCKMA 6 9
DQDFKOVRR DS Based (p_QDFKOVRR ) qualified
D WDFFKOLS 1 2B 0
DQDFKOVRE DS Based (p_QDFKOVRE ) qualified
D WDFKOLAD 1 1
D WDFKOLAN 2 3B 0
DQDFKOVRP DS Based (p_QDFKOVRP ) qualified
D WDFKOLID 1 1
D WDFKOLIN 2 3B 0
DQDFKOLER DS Based (p_QDFKOLER ) qualified
D WDFFKOLE 1 2B 0
DQDFKOLCL DS Based (p_QDFKOLCL ) qualified
D WDFFKOLC 1 2B 0
D WDFKOLCN 3 4B 0
DQDFKMSRL DS Based (p_QDFKMSRL ) qualified
D WDFFKMSS 5I 0 Overlay( QDFKMSRL : 1 )
D WDFKMSKW 1A Overlay( QDFKMSRL : 3 )
DQDFKMSAP DS Based (p_QDFKMSAP ) qualified
D WDFKMSAD 1 1
D WDFKMSAN 2 3B 0
DQDFKMSCP DS Based (p_QDFKMSCP ) qualified
D WDFKMSID 1 1
D WDFKMSIN 2 3B 0
DQDFKMSK1 DS Based (p_QDFKMSK1 ) qualified
D WDFKMSLC 1 2B 0
D WDFVED58 3 3
D WDFKMSRW 4 5B 0
D WDFKMSCL 6 7B 0
D WDFKMSFA 8 11B 0
D WDFKMSFB 12 15B 0
DQDFKMSK2 DS Based (p_QDFKMSK2 ) qualified
D WDFKMSLN 1 2B 0
DQDFKMSK3 DS Based (p_QDFKMSK3 ) qualified
D WDFKMSDM 1 2B 0
DQDFMSCLN DS Based (p_QDFMSCLN ) qualified
D WDFSCROU 1 2
D WDFMSCRO 1 2B 0
D WDFKRCLR 1 2B 0
D WDFSCFOU 3 4
D WDFMSCFO 3 4B 0
D WDFKRCLC 3 4B 0
D WDFSCLOU 5 6
D WDFMSCLO 5 6B 0
D WDFKCLWR 5 6B 0
D WDFRCLWC 7 8B 0
D WDFCTYPE 9 9
D WDFBITS32 10 10
DQDFMBDSP DS Based (p_QDFMBDSP ) qualified
D WDFBDRCN 1 10
D WDFBDCFO 11 12B 0
D WDFBDPIO 13 14B 0
DQDFK0BPR DS Based (p_QDFK0BPR ) qualified
D WDF0BPCT 1 2B 0
DQDF0BXWP DS Based (p_QDF0BXWP ) qualified
D WDF0BPID 1 1
D WDF0BPIN 2 3B 0
D WDF0BPLN 4 5B 0
DQDFBGATR DS Based (p_QDFBGATR ) qualified
D WDF0BCLR 1 1
D WDFVED59 2 2
D WDFK0BLT 3 3
D WDFVED60 4 4
DQDFBKPRM DS Based (p_QDFBKPRM ) qualified
D WDFBKNAM 1 8
DQDFKMRPR DS Based (p_QDFKMRPR ) qualified
D WDFFKRPS 1 2B 0
DQDFKMRWP DS Based (p_QDFKMRWP ) qualified
D WDFKMPID 1 1
D WDFKMPIN 2 3B 0
D WDFKMPLN 4 5B 0
DQDFKHSTR DS Based (p_QDFKHSTR ) qualified
D WDFWDFKH 1 2B 0
DQDFKHPRM DS Based (p_QDFKHPRM ) qualified
D WDFKHOFS 1 2B 0
D WDFBITS33 3 4
D WDFKHSRO 5 6B 0
D WDFKHCRD 7 8B 0
D WDFKHCBY 9 10B 0
D WDFKHARO 11 12B 0
D WDFKHCEX 13 14B 0
D WDFVED62 15 17
DQDFKHNMS DS Based (p_QDFKHNMS ) qualified
D WDFKHRCD 1 10
D WDFKHFLE 11 20
D WDFKHRLB 21 30
DQDFKHPS DS Based (p_QDFKHPS ) qualified
D WDFKHPNN 1 10
D WDFKHPLB 11 20
D WDFKHMLN 21 22B 0
DQDFKHRDC DS Based (p_QDFKHRDC ) qualified
D WDFKHRLA 1 10
D WDFKHRDO 11 22
D WDFKHRFL 23 24B 0
DQDFKHARA DS Based (p_QDFKHARA ) qualified
D WDFKHFRO 1 1
D WDFKHFCO 2 2
D WDFKHTRO 3 3
D WDFKHTCO 4 4
DQDFKHARX DS Based (p_QDFKHARX ) qualified
D WDFBITS34 1 1
D WDFHFLDI 2 3B 0
D WDFHCHID 4 5
DQDFKHSEQ DS Based (p_QDFKHSEQ ) qualified
D WDFKHSGN 1 10
D WDFFKHSS 11 12B 0
D WDFKHSIF 13 14B 0
D WDFKHSIL 15 16B 0
D WDFKHSIN 17 18B 0
D WDFKHSIP 19 20B 0
DQDFKPRTR DS Based (p_QDFKPRTR ) qualified
D WDFKRLRS 1 2B 0
D WDFFKRLP 3 4B 0
DQDFKPPRM DS Based (p_QDFKPPRM ) qualified
D WDFKPLEN 1 2B 0
DQDFKBRDR DS Based (p_QDFKBRDR ) qualified
D WDFKCOLR 1 1
D WDFKDSPA 2 2
D WDFKCHAR 3 10
DQDFKLINU DS Based (p_QDFKLINU ) qualified
D WDFFKLIN 1 2B 0
D WDFFKPOS 3 4B 0
D WDFKLINW 5 6B 0
D WDFKPOSW 7 8B 0
D WDFVED66 9 10
DQDFKWDTA DS Based (p_QDFKWDTA ) qualified
D WDFBITS35 1 2
D WDFWNAMU 3 12
D WDFKWNAM 3 12
D WDFFKLIN00 3 4B 0
D WDFFKPOS00 5 6B 0
D WDFKLINW00 7 8B 0
D WDFKPOSW00 9 10B 0
D WDFVED6600 11 12
DQDFOLORU DS Based (p_QDFOLORU ) qualified
D WDFVED68 1 1
D WDFCOLOR 2 2
DQDFDSPAU DS Based (p_QDFDSPAU ) qualified
D WDFVED69 1 1
D WDFTDSPA 2 2
DQDFLIGNU DS Based (p_QDFLIGNU ) qualified
D WDFVED70 1 1
D WDFALIGN 2 2
DQDFDWTTL DS Based (p_QDFDWTTL ) qualified
D WDFDWOVL 1 5
D WDFBITS36 6 6
D WDFLRPFU 7 8
D WDFCLRPF 7 8B 0
D WDFVED6800 7 7
D WDFCOLOR00 8 8
D WDFSPPFU 9 10
D WDFDSPPF 9 10B 0
D WDFVED6900 9 9
D WDFTDSPA00 10 10
D WDFALGNU 11 12
D WDFTALGN 11 12B 0
D WDFVED7000 11 11
D WDFALIGN00 12 12
D WDFTTXTO 13 14B 0
D WDFTTXTL 15 16B 0
D WDFVED71 17 26
DQDFKMB DS Based (p_QDFKMB ) qualified
D WDFBITS37 1 1
D WDFFIRST 2 2
D WDFECOND 3 3
D WDFMBAID 4 4
DQDFKSCSF DS Based (p_QDFKSCSF ) qualified
D WDFFKSCS 1 2B 0
DQDFKSCCP DS Based (p_QDFKSCCP ) qualified
D WDFKSCID 1 1
D WDFKSCIN 2 3B 0
DQDFKSCSM DS Based (p_QDFKSCSM ) qualified
D WDFKSCRS 1 2B 0
D WDFKSCTY 3 3
D WDFKSCLN 4 5B 0
DQDFKSCSI DS Based (p_QDFKSCSI ) qualified
D WDFKSCMI 1 7
D WDFKSCMF 8 17
D WDFKSCML 18 27
D WDFKSCDL 28 29B 0
D WDFKSCMO 30 31B 0
DQDFKSFLM DS Based (p_QDFKSFLM ) qualified
D WDFKMORE 1 12
D WDFKBOTT 13 24
DQDFKSFLS DS Based (p_QDFKSFLS ) qualified
D WDFNDSPM 1 1
D WDFLMORE 2 13
D WDFLBOTT 14 25
DQDFSRRRN DS Based (p_QDFSRRRN ) qualified
D WDFCSRNO 1 2B 0
DQDFKMODE DS Based (p_QDFKMODE ) qualified
D WDFSCMDO 1 2B 0
DQDFKSASA DS Based (p_QDFKSASA ) qualified
D WDFFKSAS 1 2B 0
DQDFKSAPM DS Based (p_QDFKSAPM ) qualified
D WDFKSAIA 1 1
D WDFKSAII 2 3B 0
D WDFKSAOA 4 4
DQDFKFFWR DS Based (p_QDFKFFWR ) qualified
D WDFFKFWS 1 2B 0
DQDFKCHKP DS Based (p_QDFKCHKP ) qualified
D WDFKFWID 1 1
D WDFKFWIN 2 3B 0
D WDFKFWOV 4 5
DQDFKMFDK DS Based (p_QDFKMFDK ) qualified
D WDFFKMFS 1 2B 0
D WDFKMFNO 3 4B 0
D WDFKMFEN 5 5A
* p_QDFKMFDP = %ADDR(QDFKMFDK.WDFKMFEN)
DQDFKMFDP DS Based (p_QDFKMFDP ) qualified
D WDFKMFID 1 1
D WDFKMFIN 2 3B 0
D WDFKMFEX 4 4A
* Response Indicator Structure (QDFKMFRS)
* p_QDFKMFRS = %ADDR(QDFKMFDP.WDFKMFEX)
DQDFKMFRS DS Based (p_QDFKMFRS ) qualified
D WDFKMFRP 1 2B 0
D WDFKMFEE 3 3A
* ERRMSG and ERRMSGID Keyword Structure (QDFKMFEM)
* p_QDFKMFEM = %ADDR(QDFKMFRS.WDFKMFEE)
DQDFKMFEM DS Based (p_QDFKMFEM ) qualified
D WDFKMFTP 1 1
D WDFKMFEL 2 3B 0
D WDFKMFTX 4 4A
DQDFKMFSI DS Based (p_QDFKMFSI ) qualified
D WDFKMFMI 1 7
D WDFKMFMF 8 17
D WDFKMFML 18 27
D WDFKMFDL 28 29B 0
D WDFKMFMO 30 31B 0
DQDFKMFMV DS Based (p_QDFKMFMV ) qualified
D WDFKMFMM 1 1
D WDFKMFMP 2 4
D WDFKMFFL 5 6B 0
D WDFKMFFV 7 16
D WDFKMFLV 17 26
DQDFKMFM3 DS Based (p_QDFKMFM3 ) qualified
D WDFFKMF1 1 3
D WDFFKMF2 4 7
DQDFKMFM4 DS Based (p_QDFKMFM4 ) qualified
D WDFKMFD4 1 1
DQDFKDFLD DS Based (p_QDFKDFLD ) qualified
D WDFKDFLO 1 2B 0
DQDFK_DATTIMFmat DS Based (p_QDFK_DATTIMFmat) qualified
D WDFK_DATTIM 1 2B 0
DQDFK_DATTIM_Sep DS Based (p_QDFK_DATTIM_Sep ) qualified
D WDFK_DATTIMSep 1 1A
DQDFK_DATEP DS Based (p_QDFK_DATEP) qualified
* 0 BIT(1) WDFK_DATE_SYS If on, the *SYS parameter is specified on th
* 1 BIT(1) WDFK_DATE_YY If on, the *YY parameter is specified on the
* 2 BIT(1) WDFK_DATE_EDTCDEY If on, the EDTCDE(Y) keyword was specifi
D WDFK_DATE 1 1A
* Length of this structure is
* is WDFK_MAPVAL_C * WDFK_MAPVAL_L
* p_QDFK_MAPVAL = %ADDR(QDFKMFDP.WDFKMFEX)
* Number of MAPVAL keyword parameters.
* Length of each MAPVAL keyword parameter.
* MAPVAL parameter
DQDFK_MAPVAL DS Based (p_QDFK_MAPVAL) qualified
D WDFK_MAPVAL_C 1 2B 0
D WDFK_MAPVAL_L 3 4B 0
D WDFK_MAPVAL 1 1A
DQDFKDTFT DS Based (p_QDFKDTFT ) qualified
D WDFKDTFT00 1 2B 0
DQDFKDTSP DS Based (p_QDFKDTSP ) qualified
D WDFKDTSP00 1 1
DQDFKDATP DS Based (p_QDFKDATP ) qualified
D WDFBITS56 1 1
DQDFKMPVL DS Based (p_QDFKMPVL ) qualified
D WDFPVLCT 1 2B 0
D WDFPVLLN 3 4B 0
DQDFKDFT DS Based (p_QDFKDFT ) qualified
D WDFFKDFS 5I 0 Overlay( QDFKDFT : 1 )
D WDFKDFPE 1A Overlay( QDFKDFT : 3 )
DQDFKDFPM DS Based (p_QDFKDFPM ) qualified
D WDFKDFID 1 1
D WDFKDFTY 2 2
D WDFKDFIN 3 4B 0
D WDFKDFLN 5 6B 0
DQDFKDFMM DS Based (p_QDFKDFMM ) qualified
D WDFKDFMI 1 7
D WDFKDFMF 8 17
D WDFKDFML 18 27
DQDFFHTML00 DS Based (p_QDFFHTML00 ) qualified
D WDFBITS57 1 1
D WDFFHLEN 2 3B 0
D WDFFHOFF 4 5B 0
D WDFLTEXT 6 6
DQDFKEDTR DS Based (p_QDFKEDTR ) qualified
D WDFFKEDS 1 2B 0
D WDFKEDKW 3 3A
D xDFKEDID 4 4
D xDFKEDSY 5 5
D xDFKEDML 6 7B 0
D xDFVED73 8 8
D xDFKEDMS 9 9A
D xDFKEDMSx 10 24A
DQDFKEDTP DS Based (p_QDFKEDTP ) qualified
D WDFKEDID 1 1
D WDFKEDSY 2 2
D WDFKEDML 3 4B 0
D WDFVED73 5 5
D WDFKEDMS 6 6A
D WDFKEDMSx 6 40A
DQDFKEDTMSK DS Based (p_QDFKEDTMSK) qualified
D WDFKEDMNUM 5I 0 Overlay( QDFKEDTMSK : 1)
D WDFKEDMSEG 1A Overlay( QDFKEDTMSK : 3)
DQDFKEDTSEG DS Based (p_QDFKEDTSEG) qualified
D WDFKEDMPOS 5I 0 Overlay( QDFKEDTSEG : 1)
D WDFKEDMLEN 5I 0 Overlay( QDFKEDTSEG : 3)
DQDFKVAKW DS Based (p_QDFKVAKW ) qualified
D WDFFKVAL 1 2B 0
DQDFKVARL DS Based (p_QDFKVARL ) qualified
D WDFBITS38 1 1
D WDFBITS39 2 2
D WDFVED76 3 3
D WDFKVATP 4 4
D WDFFKLAP 5 6B 0
D WDFKLATP 7 8B 0
DQDFKCKMI DS Based (p_QDFKCKMI ) qualified
D WDFKCKMD 1 7
D WDFKCKMF 8 17
D WDFKCKML 18 27
D WDFKCKDL 28 29B 0
D WDFFKCKB 30 31B 0
DQDFKFCPR DS Based (p_QDFKFCPR ) qualified
D WDFFKFCS 1 2B 0
DQDFKFC DS Based (p_QDFKFC ) qualified
D WDFKFCID 1 1
D WDFKFCIN 2 3B 0
D WDFKFCLN 4 5B 0
DQDFKCHC DS Based (p_QDFKCHC ) qualified
D WDFCHCCT 1 2B 0
D WDFCHCFN 3 12
D WDFKCHCR 13 14B 0
D WDFKCHCC 15 16B 0
D WDFCHAR1 17 17
D WDFCHAR2 18 18
D WDFVED77 19 19
DQDFDREXP DS Based (p_QDFDREXP ) qualified
D WDFXPLEN 1 2B 0
D WDFOWCOL 3 4B 0
D WDFUTTER 5 6B 0
D WDFBITS40 7 8
D WDFVED81 9 18
DQDFKCHCE DS Based (p_QDFKCHCE ) qualified
D WDFVED82 1 1
D WDFKCLEN 2 3B 0
D WDFBITS41 4 4
D WDFWDFKC 5 6
D WDFINX26 7 8B 0
D WDFCTXTO 9 10B 0
D WDFCTXTL 11 12B 0
D WDFCMSGO 13 14B 0
D WDFCACCO 15 16B 0
D WDFPRCDU 17 18
D WDFCPRCD 17 18B 0
D WDFBCAID 17 17
D WDFCRTNO 19 20B 0
D WDFCRTNL 21 22B 0
D WDFCCTLO 23 24B 0
D WDFCTLIO 25 26B 0
DQDFKCTXT DS Based (p_QDFKCTXT ) qualified
D WDFCMNEM 1 2B 0
DQDFKCACC DS Based (p_QDFKCACC ) qualified
D WDFACCSL 1 2B 0
D WDFCACCL 3 4B 0
D WDFACCFO 5 6B 0
DQDFKCMSG DS Based (p_QDFKCMSG ) qualified
D WDFBITS42 1 1
D WDFID26U 2 8
D WDFMID26 2 8
D WDFKMIDO 2 3B 0
D WDFCMFLU 9 18
D WDFKCMFL 9 18
D WDFCMFLO 9 10B 0
D WDFCMLBU 19 28
D WDFKCMLB 19 28
D WDFCMLBO 19 20B 0
DQDFBSEPS DS Based (p_QDFBSEPS ) qualified
D WDFBITS43 1 1
D WDFBSCOU 2 3
D WDFMBSCO 2 3B 0
D WDFBSCLR 2 2
D WDFBSAOU 4 5
D WDFMBSAO 4 5B 0
D WDFBSATR 4 4
D WDFSCHOU 6 7
D WDFBSCHO 6 7B 0
D WDFBSCHR 6 6
DQDFKCHCX DS Based (p_QDFKCHCX ) qualified
D WDFVED92 1 1
D WDFHCCLR 2 2
D WDFVED93 3 3
D WDFHCATR 4 4
D WDFVED94 5 5
DQDFEFATR DS Based (p_QDFEFATR ) qualified
D WDFBITS44 1 1
D WDFFACLR 2 2
D WDFVED96 3 3
D WDFFAATR 4 4
D WDFVED97 5 5
DQDFFLDCP DS Based (p_QDFFLDCP ) qualified
D WDFLDNUM 1 2B 0
D WDFVED98 3 3
DQDFNTFLD DS Based (p_QDFNTFLD ) qualified
D WDFLDNUM00 1 2B 0
D WDFVED99 3 3
DQDFDTMSK00 DS Based (p_QDFDTMSK00 ) qualified
D WDFDMNUM 1 2B 0
DQDFDTSEG DS Based (p_QDFDTSEG ) qualified
D WDFDMPOS 1 2B 0
D WDFDMLEN 3 4B 0
DQDFKSMSG DS Based (p_QDFKSMSG ) qualified
D WDFBITS45 1 1
D WDFSMIDU 2 8
D WDFKSMID 2 8
D WDFSMIDO 2 3B 0
D WDFSMFLU 9 18
D WDFKSMFL 9 18
D WDFSMFLO 9 10B 0
D WDFSMLBU 19 28
D WDFKSMLB 19 28
D WDFSMLBO 19 20B 0
DQDFKGRPR DS Based (p_QDFKGRPR ) qualified
D WDFKPCNT 1 2B 0
DQDFKGRWP DS Based (p_QDFKGRWP ) qualified
D WDFKGPID 1 1
D WDFKGPIN 2 3B 0
D WDFKGPLN 4 5B 0
DQDFRDATR DS Based (p_QDFRDATR ) qualified
D WDFCLROU 1 2
D WDFGCLRO 1 2B 0
D WDFGCLOR 1 1
D WDFLNTOU 3 4
D WDFGLNTO 3 4B 0
D WDFFKGLT 3 3
D WDFBITS46 5 5
DQDFRDCLR DS Based (p_QDFRDCLR ) qualified
D WDFBITS47 1 1
D WDFSROWU 2 3
D WDFCSROW 2 3B 0
D WDFGCSRO 2 3B 0
D WDFSCOLU 4 5
D WDFCSCOL 4 5B 0
D WDFGCSCO 4 5B 0
D WDFCDEPU 6 7
D WDFGCDEP 6 7B 0
D WDFGCDEO 6 7B 0
D WDFCWIDU 8 9
D WDFGCWID 8 9B 0
D WDFGCWIO 8 9B 0
DQDFRDBOX DS Based (p_QDFRDBOX ) qualified
D WDFBITS48 1 1
D WDFGBTOB 2 2
D WDFBHZOU 3 4
D WDFGBHZO 3 4B 0
D WDFKGHZV 3 4B 0
D WDFBVTOU 5 6
D WDFGBVTO 5 6B 0
D WDFKGVTV 5 6B 0
D WDFBCLOU 7 8
D WDFGBCLO 7 8B 0
D WDFGBCLR 7 7
D WDFBLTOU 9 10
D WDFGBLTO 9 10B 0
D WDFGBLNT 9 9
D WDFBCTLO 11 12B 0
DQDFOXDFM DS Based (p_QDFOXDFM ) qualified
D WDFBITS49 1 1
D WDFSROWU00 2 3
D WDFBSROW 2 3B 0
D WDFGBSRO 2 3B 0
D WDFSCOLU00 4 5
D WDFBSCOL 4 5B 0
D WDFGBSCO 4 5B 0
D WDFBDEPU 6 7
D WDFGBDEP 6 7B 0
D WDFGBDEO 6 7B 0
D WDFBWIDU 8 9
D WDFGBWID 8 9B 0
D WDFGBWIO 8 9B 0
DQDFRDLIN DS Based (p_QDFRDLIN ) qualified
D WDFBITS50 1 1
D WDFLTYPL 2 2
D WDFLINOU 3 4
D WDFGLINO 3 4B 0
D WDFGLINT 3 4B 0
D WDFLRPOU 5 6
D WDFGLRPO 5 6B 0
D WDFGLRPT 5 6B 0
D WDFLCLOU 7 8
D WDFGLCLO 7 8B 0
D WDFGLCLR 7 7
D WDFLLTOU 9 10
D WDFGLLTO 9 10B 0
D WDFGLLNT 9 9
D WDFLCTLO 11 12B 0
DQDFINDFM DS Based (p_QDFINDFM ) qualified
D WDFBITS51 1 1
D WDFSROWU01 2 3
D WDFLSROW 2 3B 0
D WDFGLSRO 2 3B 0
D WDFSCOLU01 4 5
D WDFLSCOL 4 5B 0
D WDFGLSCO 4 5B 0
D WDFLLENU 6 7
D WDFGLLEN 6 7B 0
D WDFGLLNO 6 7B 0
DQDFWITBE DS Based (p_QDFWITBE ) qualified
D WDFWINBR 1 1
D WDFWIOBF 2 2
D WDFWIIBF 3 3
D WDFWITXT 4 5B 0
DQDFWKWDA DS Based (p_QDFWKWDA ) qualified
D WDFWKWDC 1 2B 0
DQDFKWIDU DS Based (p_QDFKWIDU ) qualified
D WDFED117 1 1
D WDFWKWID 2 2
DQDFWATTR DS Based (p_QDFWATTR ) qualified
D WDFKTYPU 1 2
D WDFWKTYP 1 2B 0
D WDFED11700 1 1
D WDFWKWID00 2 2
D WDFWKLEN 3 4B 0
DQDFWATYP DS Based (p_QDFWATYP ) qualified
D WDFWALEN 1 2B 0
D WDFED118 3 3
D WDFWPRMT 4 4
DQDFWBTYP DS Based (p_QDFWBTYP ) qualified
D WDFFWATS 1 2B 0
DQDFWRSTR DS Based (p_QDFWRSTR ) qualified
D WDFBITS53 1 1
D WDFBITS54 2 2
D WDFWRFEI 3 6B 0
D WDFWRLBI 7 10B 0
D WDFWRRFI 11 14B 0
D WDFWRFDI 15 18B 0
D SmlIntTyp S 5I 0
D IntTyp S 10I 0
D ChrTyp S 1
D QNamTyp S 20A
D NamTyp S 10A
D LglTyp S N
D Buftyp S 32000A
*-------------------------------------------------------------------
* - Work fields-
*-------------------------------------------------------------------
D NoAPIError C Const( *Zero )
D QualDspF S 20
D RtvSizeInfo DS
D 4
D RtvSize 10I 0
D Counter S 5I 0
D #NumFlds S 10I 0
D TotFlds S 10I 0
D RecordName S 10A
D FindStr s 32A varying
D x s 10I 0
D c s 10I 0
D f s 10I 0
D k s 10I 0
D
D xx s 10I 0
D xc s 10I 0
D xf s 10I 0
D xk s 10I 0
D
D lx s 10I 0
D lc s 10I 0
D lf s 10I 0
D lk s 10I 0
D
D rx s 10I 0
D rc s 10I 0
D rf s 10I 0
D rk s 10I 0
D
D fx s 10I 0
D fc s 10I 0
D ff s 10I 0
D fk s 10I 0
D
D cx s 10I 0
D cc s 10I 0
D cf s 10I 0
D ck s 10I 0
D
D len s 10I 0
D FldIdx s 10I 0
D SizeIdx s 10I 0
D ScrnSize s 1
D SflCtl s N
D RcvVarLen S Like( IntTyp )
D Idx S Like( IntTyp )
D APIErrDS DS
D ApiErrLen 10I 0 Inz( %Size( APIErrDS ) )
D BytesAvail 10I 0 Inz( *Zero )
D 7 Inz( *Blanks )
D 1 Inz( X'00' )
D 256 Inz( *Blanks )
D CONSTANT C x'01'
D DFT C x'01'
D Bit0 C X'80'
D Bit1 C X'40'
D Bit2 C X'20'
D Bit3 C X'10'
D Bit4 C X'08'
D Bit5 C X'04'
D Bit6 C X'02'
D Bit7 C X'01'
* How to test for bits
* If %Bitand(Hexval:Bit0) = Bit0;
* Dsply 'Bit 0 is *On';
* Else;
* Dsply 'Bit 0 is *Off';
* Endif;
D KwdData s 3564A varying based(p_KwdData)
D temp s like(KwdData)
*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
D col s 5I 0
D row s 5I 0
D wBinDS DS
D hx1 1 1
D hx2 2 2
D wBin 1 2B 0
D XI S 10I 0
C CallP RtvDspFDesc(
C RtvSizeInfo :
C 8 :
C 'DSPF0100' :
C QDspFil :
C APIErrDS
C )
C If BytesAvail > 0
C Return *Off
C EndIf
C eval p_QDFFBASE = %alloc(RtvSize)
*-------------------------------------------------------------------
C Reset APIErrDS
* Retrieve display file description ( QDFRTVFD ) API
C CallP RtvDspFDesc(
C QDFFBASE :
C RtvSize :
C 'DSPF0100' :
C QDspFil :
C APIErrDS
C )
C If BytesAvail > 0
C Return *Off
C EndIf
C
C* Eval p_FDS = %addr(FldDta)
C
C
C Eval NumFlds = 1
C Eval XI = NumFlds
C* Eval %OCCUR(FldDtaDS) = NumFlds
// file header
C Eval p_QDFFINFO = p_QDFFBASE + QDFFBASE.WDFFINFO
// file where used
C Eval p_QDFWFLEI = p_QDFFINFO + QDFFINFO.WDFFWUOF
// file Dev Dep
C Eval p_QDFFDPDD = p_QDFFINFO + QDFFINFO.WDFFXDOF
// rec where used (first)
C Eval p_QDFWRCDI = p_QDFWFLEI + QDFWFLEI.WDFWXLEN
// name table
C Eval p_QDFFNTBL = p_QDFWFLEI + QDFWFLEI.WDFWNTBO
// File Keywords
C EXSR FileKwds
// process record formats
C for xx = 0 to (QDFFBASE.WDFFRCS - 1)
C if xx <> 0
C Eval p_QDFWRCDI = p_QDFWRCDI + QDFWRCDI.WDFWNXTR
C Endif
// record format
C eval p_QDFARFTE = p_QDFFINFO + QDFFINFO.WDFFDFLO +
C (%size(QDFARFTE) * xx)
C eval RecordName = QDFARFTE.WDFARFNM
C
C if %subst(RecordName:1:1) <> '*'
C EXSR ProcessRecFmt
C endif
C endfor
C
C DeAlloc p_QDFFBASE
C Return *On
*------------------------------------------------
* Process a record format.
*------------------------------------------------
CSR ProcessRecFmt begsr
// record header
C eval p_QDFFRINF = p_QDFFINFO + QDFARFTE.WDFARFOF
// record dev dept
C eval p_QDFFRDPD = p_QDFFRINF + QDFFRINF.WDFFRAOF
* SFLCTL
* 12 C BIN(31) WDFFRFLG Miscellaneous record contents.
* 12 C 0 BIT(1) WDFFUDDS If on, USRDFN keyword is specified.
* 12 C 1 BIT(1) WDFFSFL If on, SFL keyword is specified (next record
* 12 C 2 BIT(1) WDFFSFLC If on, SFLCTL keyword is specified (prev
C eval SflCtl = *off
C if %bitand(QDFFRINF.WDFFRFLG1 : Bit2) = Bit2
C eval p_QDFFSFCR = p_QDFFRINF + QDFFRINF.WDFFRAOF
C eval p_QDFFSFHR = %addr(QDFFSFCR.WDFFSFPM)
C eval SflCtl = *on
C endif
C for SizeIdx = 0 to QDFFBASE.WDFFSCR -1
C eval p_QDFFSCRA = %addr( QDFFBASE.WDFFSCRS) +
C %size(QDFFSCRA) * SizeIdx
// *DS3 = X'03' *DS4 = X'04'
C eval ScrnSize = QDFFSCRA.WDFFSCIA
C endfor
// Row Col table
C eval p_QDFFRCTB = p_QDFFRINF + QDFFRDPD.WDFFDRCO
C
C eval TotFlds = QDFFRINF.WDFFFLD
// Record Keywords
C EXSR RcdKwds
C
C EXSR ProcessRcdFld
CSR endsr
CSR ProcessRcdFld begsr
* - Field Where Used -
C eval p_QDFWFLDI = p_QDFWRCDI + QDFWRCDI.WDFWRLEN
C eval p_QDFFFITB = p_QDFFRINF + QDFFRINF.WDFFOFIT
C +( QDFWFLDI.WDFWRRDX -1) * %len(QDFFFITB)
C for FldIdx = 0 to QDFFRINF.WDFFFLD -1
C Exsr GetFldInfo
C Exsr FieldKwds
* p_QDFWFLDI = p_QDFWFLDI + WDFWFLDL next
C if FldIdx < QDFFRINF.WDFFFLD -1
C eval p_QDFWFLDI = p_QDFWFLDI +
C QDFWFLDI.WDFWFLDL
* Field Indexing Table (QDFFFITB) for next Field
C eval p_QDFFFITB = p_QDFFRINF + QDFFRINF.WDFFOFIT
C +( QDFWFLDI.WDFWRRDX -1) * %len(QDFFFITB)
C endif
C Eval #NumFlds = NumFlds
C Eval NumFlds += 1
C Eval XI = NumFlds
C* Eval %OCCUR(FldDtaDS) = NumFlds
C Eval FDS(XI).#FmtNam = *blank
C Eval FDS(XI).#FldNam = *blank
C Eval FDS(XI).#FldDTUS = *blank
C Eval FDS(XI).#FldEdt = *blank
C Eval FDS(XI).#FldLen = *zero
C Eval FDS(XI).#FldPlen = *zero
C Eval FDS(XI).#FldDec = *blank
C Eval FDS(XI).#FldAtr = *blank
C Eval FDS(XI).#FldRow = *zero
C Eval FDS(XI).#FldCol = *zero
C Eval FDS(XI).#FldCom = *blank
C
C endfor
C
C
C
CSR endsr
CSR GetFldInfo begsr
*
C eval FDS(XI).#FmtNam = RecordName
* - Field Header
C eval p_QDFFFINF = p_QDFFRINF + QDFFFITB.WDFFFOFS
C if QDFFFINF.WDFFFIOA = x'01'
C eval p_QDFFFCON = %ADDR(QDFFFINF.WDFFFTBE)
C eval p_QDFFFDPD = p_QDFFFINF + QDFFFCON.WDFFFAOC
C else
* Variable
C eval p_QDFFFNAM = %ADDR(QDFFFINF.WDFFFTBE)
C eval p_QDFFFDPD = p_QDFFFINF + QDFFFNAM.WDFFFAOF
C eval p_QDFFFDIC = %addr(QDFFFDPD.WDFFFICE)
C endif
* Field Extension
C eval p_QDFFXFDP = p_QDFFFINF + QDFFFDPD.WDFFXFDO
* Row Column
C eval p_QDFFRCTB = p_QDFFRINF + QDFFRDPD.WDFFDRCO
C + (QDFWFLDI.WDFWRRDX -1) *2
C eval p_QDFFRCTE = %addr(QDFFRCTB.WDFFRC)
*
C eval hx1 = x'00'
C eval hx2 = QDFFRCTE.WDFFSROW
C eval row = wBin
C eval hx1 = x'00'
C eval hx2 = QDFFRCTE.WDFFSCOL
C eval col = wBin
C eval FDS(XI).#FldRow = row
C eval FDS(XI).#FldCol = col
* date time flags
C if %bitand(QDFFFINF.WDFFBFLG : Bit0) = Bit0
C eval FDS(XI).#FldCom = 'DATE'
C eval FDS(XI).#FldDTUS = 'D'
C endif
C if %bitand(QDFFFINF.WDFFBFLG : Bit1) = Bit1
C eval FDS(XI).#FldDTUS = 'Y'
C endif
C if %bitand(QDFFFINF.WDFFBFLG : Bit2) = Bit2
C eval FDS(XI).#FldDTUS = 'T'
C endif
C if %bitand(QDFFFINF.WDFFFBIT : Bit4) = Bit4
C eval FDS(XI).#FldDTUS = 'U'
C endif
C if %bitand(QDFFFINF.WDFFFBIT : Bit5) = Bit5
C eval FDS(XI).#FldDTUS = 'S'
C endif
*
* CONSTANTS
C if QDFFFINF.WDFFFIOA = x'01'
C EXSR ProcessCons
C ELSE
* Field Name
C eval p_QDFFNTB = %addr(QDFFNTBL.WDFFNMES) +
C + 10 * (QDFWFLDI.WDFWNMEI -1)
*
* QDFFFINF.WDFFFIOA
*Field attribute.
*X'01' indicates Constant (see structure QDFFFCON, Constant Field Header
*X'02' indicates Output (O),
*X'03' indicates Message (M), h (B),
*X'04' indicates Input (I), (P)
*X'05' indicates Both (B),
*X'06' indicates Hidden (H), and
*X'07' indicates Program to System (P)
C eval FDS(XI).#FldIO = QDFFFINF.WDFFFIOA
* WDFFKBDT
* Keyboard shift and data type.
* X'00' indicates Alpha shift/character (A),
* X'01' indicates Alpha only (X),
* X'02' indicates Numeric shift (N),
* X'03' indicates Numeric only (Y),
* X'04' indicates Katakana (K),
* X'05' indicates Digits only (D),
* X'06' indicates Inhibit keyboard (I),
* X'07' indicates Signed numeric/zoned (S),
* X'08' indicates Binary (B), X'09' indicates Packed (P),
* X'0A' indicates Floating (F),
* X'0B' indicates DBCS (J),
* X'0C' indicates Open (O), X'0D' indicates Either (E),
* X'0E' indicates Numeric-only character (M),
* X'0F' indicates Graphic (G),
* X'10' indicates Date (L),
* X'11' indicates Time (T), and
* X'12' indicates Timestamp (Z)
C eval FDS(XI).#FldAtr = QDFFFNAM.WDFFKBDT
C eval FDS(XI).#FldNam = QDFFNTB.WDFFNAM
C eval FDS(XI).#FldCom = *blank
C eval FDS(XI).#FldPlen = QDFFFNAM.WDFFPLEN
C eval FDS(XI).#FldDec = QDFFFNAM.WDFFDEC
C endif
CSR endsr
*------------------------------------------------
* This loops through all keyword categories
* for a constant field (text on the screen.)
*------------------------------------------------
CSR ProcessCons begsr
C
C*
C if (QDFFFDPD.WDFFFDOC > 0)
C*
C eval p_QDFFCOSA = p_QDFFFINF +
C QDFFFDPD.WDFFFDOC
C*
C for cc = 0 to (QDFFCOSA.WDFFCCT - 1)
C*
C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS)
C + (cc * %size(QDFFCCOA))
C if (QDFFCCOA.WDFFCAID = x'22')
C eval p_QDFKMFDK= p_QDFFFINF +
C QDFFCCOA.WDFFCAOF
C exsr ProcessCat22
C endif
C if (QDFFCCOA.WDFFCAID = x'23')
C eval p_QDFKDFT = p_QDFFFINF +
C QDFFCCOA.WDFFCAOF
C exsr ProcessCat23
C endif
C
C if (QDFFCCOA.WDFFCAID = x'24')
C eval p_QDFKEDTR = p_QDFFFINF +
C QDFFCCOA.WDFFCAOF
C exsr ProcessCat24
C endif
C endfor
C
C endif
C
CSR endsr
*------------------------------------------------
* Process File Keywords.
*------------------------------------------------
CSR FileKwds begsr
C
C if (QDFFDPDD.WDFFXDOC > 0)
C*
C eval p_QDFFCOSA = p_QDFFINFO +
C QDFFDPDD.WDFFXDOC
C*
C for lc = 0 to (QDFFCOSA.WDFFCCT - 1)
C*
C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS)
C + (lc * %size(QDFFCCOA))
C eval p_QDFKFILK = p_QDFFINFO +
C QDFFCCOA.WDFFCAOF
C for lk = 1 to QDFKFILK.WDFFKFIL
C if (lk=1)
C eval p_QDFKFLPM = %addr(QDFKFILK.WDFKFILE)
C else
C eval p_QDFKFLPM = p_QDFKFLPM +
C %size(QDFKFLPM )
C endif
C
C eval p_QDFKFLPP = %addr(QDFKFLPM.WDFKFLEX)
C for lx = 1 to QDFKFLPM.WDFFKFLP
C
C select
C when QDFKFLPM.WDFKFLID = x'02'
C eval p_QDFKFLSZ = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'04'
C eval p_QDFKICVP = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'05'
C eval p_QDFKHARD = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'06'
C eval p_QDFKHXPS = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'07'
C eval p_QDFKHDOC = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'08'
C eval p_QDFKSIDX = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'0A'
C eval p_QDFKFALX = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'0B'
C eval p_QDFKESFL = %addr(QDFKFLPP.WDFKFLNM)
C when QDFKFLPM.WDFKFLID = x'0C'
C eval p_QDFKBODR = %addr(QDFKFLPP.WDFKFLNM)
C endsl
C eval p_QDFKFLPP =
C p_QDFKFLPP + (QDFKFLPP.WDFKFLLN)
C endfor
C endfor
C
C
C endfor
C
C endif
C
CSR endsr
*------------------------------------------------
* Process Record Keywords.
*------------------------------------------------
CSR RcdKwds begsr
C if (QDFFRDPD.WDFFRDOC > 0)
C*
C eval p_QDFFCOSA = p_QDFFRINF +
C QDFFRDPD.WDFFRDOC
C for rc = 0 to (QDFFCOSA.WDFFCCT - 1)
C*
C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS)
C + (rc * %size(QDFFCCOA))
* Miscellaneous record-level keywords (uses (QDFKMSAP))
* no structures for IDs X'01', X'02', X'03', X'04', X'05', X'06', X'07',
* ID Keyword ID Keyword
* X'01' LOCK X'09' RMVWDW
* X'02' ALARM X'0F' DSPMOD
* X'03' BLINK X'10' CSRLOC
* X'04' LOGOUT X'11' INDARA
* X'05' ALWGPH X'13' SETOFF
* X'06' MSGALARM X'15' RTNCSRLOC
* X'07' RETLCKSTS X'16' MNUBARDSP
* X'08' USRRSTDSP
C eval p_QDFKMSRL = p_QDFFRINF +
C QDFFCCOA.WDFFCAOF
* Command Key Keyword Structure (QDFKCKKW) (uses (QDFKCKKE))
* Use structure QDFKCKKE for category 2 keyword IDs X'01' through X'25' an
* Use structure QDFKCKKE for category 2 keyword IDs X'01' through X'25' an
* ID Keyword ID Keyword ID Keyword
* X'01' CA/CF01 X'0E' CA/CF14 X'1A' ROLLDOWN
* X'02' CA/CF02 X'0F' CA/CF15 X'1B' PRINT
* X'03' CA/CF03 X'10' CA/CF16 X'1C' HOME
* X'04' CA/CF04 X'11' CA/CF17 X'1D' CLEAR
* X'05' CA/CF05 X'12' CA/CF18 X'1E' HELP
* X'06' CA/CF06 X'13' CA/CF19 X'20' HLPRTN
* X'07' CA/CF07 X'14' CA/CF20 X'21' VLDCMDKEY
* X'08' CA/CF08 X'15' CA/CF21 X'22' ALTHELP
* X'09' CA/CF09 X'16' CA/CF22 X'23' ALTPAGEUP
* X'0A' CA/CF10 X'17' CA/CF23 X'24' ALTPAGEDWN
* X'0B' CA/CF11 X'18' CA/CF24 X'25' MNUBARSW
* X'0C' CA/CF12 X'19' ROLLUP X'30' MNUCNL
* X'0D' CA/CF13
C eval p_QDFKCKKW = p_QDFFRINF +
C QDFFCCOA.WDFFCAOF
C for rk = 1 to QDFKCKKW.WDFFKCKS
C if (rk=1)
C eval p_QDFKCKKE = %addr(QDFKCKKW.WDFKCKCM)
C else
C eval p_QDFKCKKE = p_QDFKCKKE +
C %size(QDFKCKKE )
C endif
C
C eval p_QDFKFLPP = %addr(QDFKFLPM.WDFKFLEX)
C for rx = 1 to QDFKFLPM.WDFFKFLP
C
C* this is unfinished
C eval p_QDFKFLPP =
C p_QDFKFLPP + (QDFKFLPP.WDFKFLLN)
C endfor
C endfor
C
C
C endfor
C
C endif
C
CSR endsr
*------------------------------------------------
* Process Record Keywords.
*------------------------------------------------
CSR FieldKwds begsr
C*
C if (QDFFFDPD.WDFFFDOC > 0)
C*
C eval p_QDFFCOSA = p_QDFFFINF +
C QDFFFDPD.WDFFFDOC
C*
C for fc = 0 to (QDFFCOSA.WDFFCCT - 1)
C*
C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS)
C + (fc * %size(QDFFCCOA))
C if (QDFFCCOA.WDFFCAID = x'23')
C eval p_QDFKDFT = p_QDFFFINF +
C QDFFCCOA.WDFFCAOF
C exsr ProcessCat23
C endif
C
C endfor
C
C endif
C
CSR endsr
*------------------------------------------------
* This loops through all keywords that fall into
* category 22
*------------------------------------------------
CSR ProcessCat22 begsr
C for ck = 1 to QDFKMFDK.WDFFKMFS
C if (ck=1)
C eval p_QDFKMFDP = %ADDR(QDFKMFDK.WDFKMFEN)
C else
C eval p_QDFKMFDP = p_QDFKMFDP +
C %size(QDFKMFDP )
C endif
C select
C when QDFKMFDP.WDFKMFID = x'10'
C eval p_QDFKMFMV = %ADDR(QDFKMFDP.WDFKMFEX)
C when QDFKMFDP.WDFKMFID = x'15'
C eval p_QDFKMFRS = %ADDR(QDFKMFDP.WDFKMFEX)
C eval p_QDFKMFEM = %ADDR(QDFKMFRS.WDFKMFEE)
C when QDFKMFDP.WDFKMFID = x'16'
C eval p_QDFKMFRS = %ADDR(QDFKMFDP.WDFKMFEX)
C eval p_QDFKMFEM = %ADDR(QDFKMFRS.WDFKMFEE)
C eval p_QDFKMFSI = %ADDR(QDFKMFEM.WDFKMFTX)
C when QDFKMFDP.WDFKMFID = x'17'
C eval p_QDFKDFLD = %ADDR(QDFKMFDP.WDFKMFEX)
C when QDFKMFDP.WDFKMFID = x'18'
C eval p_QDFK_DATTIMFmat = %ADDR(QDFKMFDP.WDFKMFEX)
* WDFK_DATTIM
* Format used for a field with the date or time data type.
* X'01' indicates *JOB,
* X'02' indicates *MDY,
* X'03' indicates *DMY,
* X'04' indicates *YMD,
* X'05' indicates *JUL,
* X'06' indicates *ISO,
* X'07' indicates *USA,
* X'08' indicates *EUR,
* X'09' indicates *JIS,
* X'0A' indicates *H
C when QDFKMFDP.WDFKMFID = x'19'
C eval p_QDFK_DATTIM_Sep = %ADDR(QDFKMFDP.WDFKMFEX)
C eval QDFK_DATTIM_Sep.WDFK_DATTIMSep =
C QDFK_DATTIM_Sep.WDFK_DATTIMSep
C
C when QDFKMFDP.WDFKMFID = x'1A'
C eval p_QDFK_DATEP = %ADDR(QDFKMFDP.WDFKMFEX)
C eval QDFK_DATEP.WDFK_DATE = QDFK_DATEP.WDFK_DATE
* 0 BIT(1) WDFK_DATE_SYS If on, the *SYS parameter is specified
* 1 BIT(1) WDFK_DATE_YY If on, the *YY parameter is specified
* 2 BIT(1) WDFK_DATE_EDTCDEY If on, the EDTCDE(Y) keyword was specify
C* If %Bitand(WDFK_DATE:Bit0) = Bit0
C* If %Bitand(WDFK_DATE:Bit1) = Bit1
C* If %Bitand(WDFK_DATE:Bit2) = Bit2
C when QDFKMFDP.WDFKMFID = x'1B'
C eval p_QDFK_MAPVAL = %ADDR(QDFKMFDP.WDFKMFEX)
C endsl
C endfor
C
C
C
CSR endsr
*------------------------------------------------
* This loops through all keywords that fall into
* category 23 (DFT, MSGCON, DFTVAL, HTML)
*------------------------------------------------
CSR ProcessCat23 begsr
C for ck = 1 to QDFKDFT.WDFFKDFS
C if (ck=1)
C eval p_QDFKDFPM = %addr(QDFKDFT.WDFKDFPE)
C else
C eval p_QDFKDFPM = p_QDFKDFPM +
C %size(QDFKDFPM )
C endif
C if (QDFKDFPM.WDFKDFID = DFT)
C eval p_KwdData = p_QDFKDFPM +
C %size(QDFKDFPM ) - 2
C eval Temp = KwdData
C
C eval FDS(XI).#FldLen = QDFKDFPM.WDFKDFLN
C eval FDS(XI).#FldIO = QDFFFINF.WDFFFIOA
C eval FDS(XI).#FldCom = Temp
C
C endif
C
C endfor
CSR endsr
*------------------------------------------------
* This loops through all keywords that fall into
* category 24 (Date, Time)
*------------------------------------------------
CSR ProcessCat24 begsr
C for ck = 1 to QDFKEDTR.WDFFKEDS
C if (ck=1)
C eval p_QDFKEDTP = %addr(QDFKEDTR.WDFKEDKW )
C else
C eval p_QDFKEDTP = p_QDFKEDTP +
C %size(QDFKEDTP )
C endif
C
C
* EDIT Keyword Structure (QDFKEDTP)
* Use this structure for category 24 keywords that
* have keyword IDs of X'01' and X'02'.
* Type Variable Name Field
* CHAR(1) WDFKEDID Keyword ID.
* CHAR(1) WDFKEDSY Zero suppress or fill character for the EDTCDE k
* BIN(15) WDFKEDML Length of the edit mask.
* CHAR(1) * Reserved.
* CHAR(*) WDFKEDMS The edit mask for the EDTCDE and EDTWRD keywords
*
C eval FDS(XI).#FldEdt = %subst(QDFKEDTP.WDFKEDMSX
C : 1 : QDFKEDTP.WDFKEDML)
C eval FDS(XI).#FldLen = QDFKEDTP.WDFKEDML
C eval FDS(XI).#FldIO = QDFFFINF.WDFFFIOA
C endfor
CSR endsr
P RtvFlds E
