(J
H DATEDIT(*YMD/)
**************************************************************************
*$B;HMQ%U%!%$%k$NDj5A(J
**************************************************************************
*<<$B>&IJ%^%9%?!<(J>>
FSYOHIN IF E K DISK PREFIX(XX)
**************************************************************************
*$B%G!<%?9=B$(J
**************************************************************************
*<< PROGRAM DATA STRUCTURE >>
D SDS
Dproc_name *PROC
*<< PAGING CONTROLL >>
D pag_mod S 6 INZ
*<< LINE COUNTER >>
D l_cnt S 5 0 INZ
D l_cnt_max S 5 0 INZ(15)
*<< CR/LF >>
D CR S 1 INZ(X'15')
*<< (I>/<.]$Bt~(J/ (I<09]=$Bt~(J>>
D iw_session S 9
D iw_seqno S 4
D seq_mode S 1
*<< HTML STATEMENTE $B:n@.(J>>
D cnt S 4 0
D ctd_cnt_max S 4 0 INZ(200)
D rep_cnt S 4 0
D op_html S 3
D st_html S 1500
D rep_str S LIKE(st_html)
D df_html S 80 DIM(200)
**************************************************************************
*$B%3%s%Q%$%k;~G[Ns(J(HTML)
**************************************************************************
D hed_html S 80 DIM(200) CTDATA $B%\%G%#2hLLMQ(J
D dtl_html S 80 DIM(200) CTDATA $B%\%G%#2hLLMQ(J
D fot1_html S 80 DIM(60) CTDATA $B%\%G%#2hLLMQ(J
D fot2_html S 80 DIM(60) CTDATA $B%\%G%#2hLLMQ(J
D fot3_html S 80 DIM(60) CTDATA $B%\%G%#2hLLMQ(J
**************************************************************************
*$B#W#E#B%D!<%k$NDj5A(J
**************************************************************************
*<<$B=i4|=hM}(J>>
D #IWIN PR 1 EXTPROC('#IWIN')
D 10 value
D sts_in S 1 INZ
D pgm_id S 10 INZ
*<<$BJQ?tCM3MF@(J>>
D #IWVAL PR 1000 EXTPROC('#IWVAL')
D 32 const
D get_val S 1000 INZ
*<<$BJQ?tCM%;%C%H(J>>
D #IWSET PR 1 EXTPROC('#IWSET')
D 32 const
D 1000 value
D sts_set S 1
D set_val S 1000 INZ
**************************************************************************
*$B30It%W%m%7!<%8%c$NDj5A(J
**************************************************************************
*<<$BJ8;zNs?tCMJQ49(J>>
D #CHR2NUM PR 31 EXTPROC('#CHR2NUM')
D 50 value
D 2 0 const
D 2 0 const
*
D cnv_str S 50 INZ
D dec_len S 2 0 INZ
D dec_plen S 2 0 INZ
*
D DS
D dec_str 1 31
D d_minus 1 1
D d_numeric 2 31
**************************************************************************
*$B#K#E#Y%j%9%H(J
**************************************************************************
*<<$B>&IJ%^%9%?!<(J>>
C K@01 KLIST
C KFLD W@HINCOD
**************************************************************************
*$B%a%$%s(J
**************************************************************************
*<<$B=i4|=hM}(J>>
C EXSR INZPRC
*<<$B%X%C%@!<=PNO(J>>
C CLEAR df_html
C MOVEA hed_html df_html
C EXSR CRTHTML
*<<$BL@:Y=PNO(J>>
C 1 DO l_cnt_max l_cnt
C READ SYOHINR 90
C IF *IN90 = *ON
C LEAVE
C ENDIF
C CLEAR df_html
C MOVEA dtl_html df_html
C EXSR CRTHTML
* STORE KEY DATA
C EVAL lst_key1 = XXHINCOD
C ENDDO
*<<$B#F#O#O#T#E#R=PNO#1(J>>
C CLEAR df_html
C MOVEA fot1_html df_html
C EXSR CRTHTML
*<<$B#F#O#O#T#E#R=PNO#2!J>
C IF *IN90 = *OFF
C CLEAR df_html
C MOVEA fot2_html df_html
C EXSR CRTHTML
C ENDIF
*<<$B#F#O#O#T#E#R=PNO#3(J>>
C CLEAR df_html
C MOVEA fot3_html df_html
C EXSR CRTHTML
*<<$B;D$j=PNO(J>>
C IF std_str <> *BLANK
C CALLB '#STD_OUT'
C PARM std_str 2048
C ENDIF
*<<$B:G=*%-!<$NJ]4I(J>>
C EVAL set_val = %TRIM(lst_key1)
C EVAL sts_set = #IWSET('lst_key1':set_val)
*<<$B=*N;(J>>
C SETON LR
C RETURN
**************************************************************************
*$B=i4|=hM}(J
**************************************************************************
C INZPRC BEGSR
*<<$BJQ?t$NDj5A(J>>
C *LIKE DEFINE XXHINCOD W@HINCOD
C *LIKE DEFINE XXHINCOD lst_key1
C *LIKE DEFINE XXHINCOD @@HINCOD
*<< WEB OPERATION INITIALIZE >>
C EVAL pgm_id = proc_name
C EVAL sts_in = #IWIN(pgm_id)
*<<$B%;%C%7%g%st~!?>
C CALLB '#IWNBR'
C PARM iw_session
C PARM iw_seqno
C PARM 'N' seq_mode
*<<$B=hM}FbMF!J=i2s!&2~JG!&:F8!:w!K(J>>
C EVAL pag_mod = #IWVAL('pag_mod')
*<<$B8!:w%-!<(J>>
*<<$B>&IJ%3!<%I(J>>
C EVAL W@HINCOD = #IWVAL('XXHINCOD')
C EVAL @@HINCOD = %TRIM(W@HINCOD)
*<<$B=i2sI=<(!?:F8!:w(J>>
C SELECT
C WHEN (%TRIM(pag_mod) = '*BEGIN') OR
C (%TRIM(pag_mod) = '*RESCH') OR
C (%TRIM(pag_mod) = *BLANK)
C K@01 SETLL SYOHINR
*<<$B2~JG(J>>
C WHEN (%TRIM(pag_mod) = '*NEXTP')
*$B:G=*I=<(%-!<$N3MF@(J
*<<$B>&IJ%3!<%I(J>>
C (J EVAL lst_key1 = #IWVAL('lst_key1')
*$B:G=*I=<(%-!<0J9_$h$j%j%9%H(J
C EVAL W@HINCOD = lst_key1
C K@01 SETGT SYOHINR
C ENDSL
*
C ENDSR
**************************************************************************
*$B#H#T#M#LJ8:n@.!J%3%s%Q%$%k;~G[Ns%G!<%?$h$j:n@.!K(J
**************************************************************************
C CRTHTML BEGSR
*
C 1 DO ctd_cnt_max cnt
C EVAL op_html = %SUBST(df_html(cnt):1:3)
C EVAL st_html = %SUBST(df_html(cnt):4:77)
C SELECT
C WHEN op_html = 'END'
C LEAVE
C WHEN op_html <> *BLANK
C EXSR REPSTM
C ENDSL
*
C EXSR STDOUT
C ENDDO
*
C ENDSR
**************************************************************************
*$B#H#T#M#LJ8:n@.!JCV49=hM}!K(J
**************************************************************************
C REPSTM BEGSR
*
C CLEAR rep_str
C SELECT
C WHEN op_html = 'SNO'
C EVAL rep_str=%TRIM(iw_session)
C WHEN op_html = 'SQN'
C EVAL rep_str=%TRIM(iw_seqno)
C WHEN op_html = 'S01'
C EVAL rep_str=%TRIM(@@HINCOD)
C WHEN op_html = 'K01'
C EVAL rep_str=%TRIM(XXHINCOD)
C WHEN op_html = 'D01'
C EVAL rep_str=%TRIM(XXHINCOD)
C WHEN op_html = 'D02'
C EVAL rep_str=%TRIM(XXMAKER)
C WHEN op_html = 'D03'
C EVAL rep_str=%TRIM(XXHINRYK)
C ENDSL
*
C EVAL rep_cnt = %SCAN(op_html:st_html)
C IF rep_cnt > 0
C EVAL st_html = %REPLACE(%TRIM(rep_str):
C st_html:rep_cnt:3)
C ENDIF
*
C ENDSR
**************************************************************************
*$B#H#T#M#L=PNO=hM}(J(STD_OUT)
**************************************************************************
C STDOUT BEGSR
*<<$B#19T#1#5#0#07e$^$G(J>>
C IF %LEN(%TRIM(st_html)) >
C (2000-%LEN(%TRIM(std_str))-1)
C CALLB '#STD_OUT'
C PARM std_str 2048
C CLEAR std_str
C ENDIF
*
C EVAL std_str = %TRIM(std_str)
C +%TRIM(st_html) + CR
C CLEAR st_html
*
C ENDSR
**************************************************************************
** hed_html
CONTENT-TYPE: TEXT/HTML
<HTML>
<HEAD>
<TITLE>
$B>&IJ8!:w(J
</TITLE>
<SCRIPT LANGUAGE="JavaScript">
<!--
function rtn_back(){
var i;
if (document.FORM2.XXHINCODS.length){
for(i=0; i<document.FORM2.XXHINCODS.length; i++){
if(document.FORM2.XXHINCODS[i].checked){
opener.document.FORMX.XXHINCOD.value
= document.FORM2.XXHINCODS[i].value;
}
}
} else {
if (document.FORM2.XXHINCODS.checked){
opener.document.FORMX.XXHINCOD.value
= document.FORM2.XXHINCODS.value;
}
}
window.close();
opener.window.focus();
}
// -->
</SCRIPT>
</HEAD>
<BODY bgcolor="lightGrey">
<!---$B%?%$%H%k$NI=<((J--->
<CENTER>
<TABLE border="3">
<TR><TD bgcolor="navy">
<P align="center"><B><FONT size="4" color="White">
$B>&IJ8!:w(J
</FONT></B></P>
</TD></TR>
</TABLE>
</CENTER><BR><BR>
<!---$B%-!<>pJsI=<((J--->
<FORM name="FORM1" method="GET" action="SP0130.PGM">
<TABLE border="0" align="center"><TR>
<TD>
<TABLE border="1" cellspacing="0" align="center">
<TR>
<TH bgcolor="#6666FF"><P align="center"><B><FONT color="white">
$B>&IJ%3!<%I(J
</FONT></B></TH>
<TD bgcolor="white">
<INPUT type="TEXT" name="XXHINCOD" maxlength="6"
S01 value="S01">
</TD>
</TR>
</TABLE>
</TD>
<TD>
<TABLE border="0" align="right">
<TR><TD>
<INPUT type="SUBMIT" value=" $B:F8!:w(J " action="SP0130.PGM">
<INPUT type="HIDDEN" name="pag_mod" value="*RESCH">
SNO <INPUT type="HIDDEN" name="SESSION" value="SNO">
SQN <INPUT type="HIDDEN" name="SEQNO" value="SQN">
</TD></TR>
</TABLE>
</TD>
</TR></TABLE>
</FORM>
<!--$B0lMw8+=P$7$NI=<((J-->
<CENTER>
<FORM name="FORM2" method="GET">
<TABLE border="1" cellspacing="0">
<TR bgcolor=#6666FF>
<TH><FONT color="white">$BA*Br(J</TH>
<TH><FONT color="white">$B>&IJ%3!<%I(J</TH>
<TH><FONT color="white">$B%a!<%+!<(J</TH>
<TH><FONT color="white">$BN,L>(J</TH>
</TR>
END
** dtl_html
<TR>
<TD bgcolor="white"><FONT color="black">
K01<INPUT type="RADIO" name="XXHINCODS" value="K01"
onclick="JavaScript:rtn_back()">
</FONT></TD>
D01<TD bgcolor="white">D01</TD>
D02<TD bgcolor="white">D02</TD>
D03<TD bgcolor="white">D03</TD>
</TR>
END
** fot1_html
</TABLE>
</FORM>
END
** fot2_html
<FORM name="FORM3" method="GET" action="SP0130.PGM">
<TABLE border="0" align="right">
<TR><TD>
<INPUT type="SUBMIT" value="$B