Tweet
hi again!
here i just start to write programe in free format & i converted my Fixed source, line by line to Free! compiled it successfully!
when i run the programe, generate error messge "Permanent I/O error occurred in file CALADDR01 (C G D F)." so i debug it & problem is write message controler;
Please advice !
as well as i wanna go to fully free & hope to remove 'C' specs from my program, if so what happend to *inzsr??
is it my free format writing style is good? & advice to improve it pls!
thanks
regards
dhanuxp
here i just start to write programe in free format & i converted my Fixed source, line by line to Free! compiled it successfully!
when i run the programe, generate error messge "Permanent I/O error occurred in file CALADDR01 (C G D F)." so i debug it & problem is write message controler;
Please advice !
as well as i wanna go to fully free & hope to remove 'C' specs from my program, if so what happend to *inzsr??
is it my free format writing style is good? & advice to improve it pls!
Code:
H DEBUG DATEDIT(*YMD) TIMFMT(*HMS)
FCALADDR01 CF E WORKSTN INFDS(WSDS)
D @F03 C CONST(X'33')
D @F08 C CONST(X'38')
D @F12 C CONST(X'3C')
D @CLEAR C CONST(X'BD')
D @ENTER C CONST(X'F1')
D @HELP C CONST(X'F3')
D @PAGUP C CONST(X'F4')
D @PAGDN C CONST(X'F5')
D @PRINT C CONST(X'F6')
*
**----------------------------------------------------------------*
** Standard include for all interactive programs *
** Defines standard constants *
**================================================================*
*
D @FALSE C CONST('0')
D @TRUE C CONST('1')
D @FOLD C CONST('0')
D @DROP C CONST('1')
*
**----------------------------------------------------------------*
** Standard include for all interactive programs *
** display file information data structure *
**================================================================*
*
D WSDS DS
** Identifies the key pressed
D KEY 369 369
D PAGRRN 378 379B 0
D CURSOR 370 371B 0
D DS INZ
** Identifies the subfile page rrn
D STKCNT 1 4B 0
D DTALEN 5 8B 0
D ERRCOD 9 12B 0
** GET Local user ID.
D SDS
D USER 254 263
d @Exit S 1a
d @empno S 4 0
*
**================================================================*
D msgStat S 1A
D mSgid S 7A
D mSgdtasize C const(80)
**-------------------------------------------------------------------*
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MsgId 7 Const
D MsgFile 20 Const
D MsgDta 80 Const
D MsgDtaLen 10I 0 Const
D MsgType 10 Const
D MsgQ 10 Const
D Msgqnbr 10I 0 Const
D MsgKey 4
D ErroR Like(ErrorDS)
**-------------------------------------------------------------------*
D ClrmsgQ PR ExtPgm('QMHRMVPM')
D MsgQueue 276A const
D Callstack 10I 0 const
D MsgKey 4A const
D MsgRmv 10A const
D Error like(ErrorDS)
//
D ErrorDS DS 16
D bYtesprov 10i 0 inz(16)
D bYtesavaiL 10i 0
D eXceptionid 7
D
D
D
**================================================================*
*
/free
*inlr = *on;
Exsr MsfSnd;
dow @exit <>'1';
Write MsgCtl;
Exfmt Scr01;
EXSR MSFCLR;
select;
when key = @F03;
Exsr @f03sr;
when key = @f12;
Exsr @f12sr;
when key = @Enter;
Exsr @Entky;
endsl;
Enddo;
return;
Begsr @F03sr;
@Exit = '1';
Endsr;
Begsr @F12sr;
Endsr;
Begsr @entKy;
Endsr;
BegSr Msfsnd;
CallP SndPgmMsg(MsgID:'ATKEMSGF *LIBL':'ID':MsgDtaSize:'*INFO':
'*':0:MsgKey:ErrorDS);
Endsr;
//
BegSr MsfClr;
CallP ClrMsgQ('*':*Zero:*Blanks:'*ALL':ErrorDS);
Endsr;
/End-free
C *Inzsr BegSr
C Eval MsgID = 'ATK0000'
C Move *Blanks MsgKey 4
C Endsr
regards
dhanuxp
Comment